Reppo for internal functions.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

74 lines
4.2 KiB

  1. ggstats_add_xy_test<-function(table_stat, table, xcol=NULL, group, y="max", bracket.offset=0.05, bracket.inspace=0.05, exclude_group=NULL){
  2. ## Adapted version to fit rstatix output
  3. value.var<-table_stat[[1,".y."]]
  4. if (is.null(xcol)){
  5. x<-colnames(table_stat)[1]
  6. }else{x<-xcol}
  7. if(!is.null(group)){table[,group]<-as.factor(table[,group])}
  8. table[,x]<-as.factor(table[,x])
  9. if (is.null(exclude_group)){
  10. table_agg<-table %>% group_by(.data[[x]])
  11. }else{
  12. table_agg<-table %>% group_by(.data[[x]], .data[[exclude_group]])
  13. }
  14. if (y == "max"){
  15. agg<-table_agg %>% summarise(max=max(.data[[value.var]]))
  16. if(!is.na(exclude_group)){agg<-table_agg %>% group_by(.data[[exclude_group]]) %>% summarise(max=max(.data[[value.var]]))}
  17. }else if (y == "mean"){
  18. agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]])) %>% spread(group, mean)
  19. agg<- data.frame(x=agg[,1], "max"=apply(agg[,2:ncol(agg)], 1, max, na.rm=T))
  20. colnames(agg)[1]<-x
  21. }else if (y == "mean+sd"){
  22. agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]])+sd(.[[value.var]])) %>% spread(group, mean)
  23. agg<- data.frame(x=agg[,1], "max"=apply(agg[,2:ncol(agg)], 1, max, na.rm=T))
  24. colnames(agg)[1]<-x
  25. }else if (y == "mean+sem"){
  26. agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]])+sem(.[[value.var]])) %>% spread(group, mean)
  27. agg<- data.frame(x=agg[,1], "max"=apply(agg[,2:ncol(agg)], 1, max, na.rm=T))
  28. colnames(agg)[1]<-x
  29. }
  30. group.list<-list()
  31. count<-1
  32. if(!is.null(group)){table_stat<-mutate(table_stat, {{x}}:=as.factor(.data[[x]]))}
  33. for (i in 1:nrow(table_stat)){
  34. group.list[[count]]<-c(table_stat %>% slice(i) %>% pull(group1),table_stat%>% slice(i) %>% pull(group2))
  35. count<-count+1
  36. }
  37. if(!is.null(group)){
  38. x.index<-sapply(table_stat %>% pull(x), function(y) which(levels(table_stat %>% pull(x)) == y))
  39. t<-tibble("y.position"=merge(table_stat, agg ,sort=F)[,"max"]+diff(range(table[value.var], na.rm = T))*bracket.offset,
  40. "groups"=group.list,
  41. "x.temp"=x.index,
  42. "xmin"=(match(table_stat %>% pull(x), levels(table[,x]))+0.75*((match(table_stat$group1, levels(table[,group]))-0.5)/length(levels(table[,group]))-0.5)),
  43. "xmax"=match(table_stat %>% pull(x), unique(table[,x]))+0.75*((match(table_stat$group2, levels(table[,group]))-0.5)/length(levels(table[,group]))-0.5)
  44. ) %>% rename("x"="x.temp")
  45. }else{
  46. t<-tibble("y.position"=merge(table_stat, agg ,sort=F)[,"max"]+diff(range(table[value.var], na.rm = T))*bracket.offset,
  47. "groups"=group.list,
  48. # "x.temp"=x.index,
  49. )# %>% rename("x"="x.temp")
  50. }
  51. if (!is.null(group)){
  52. if (!is.null(exclude_group)){
  53. for (j in unique(pull(table_stat, all_of(exclude_group)))){
  54. for (dia in unique(pull(table_stat,all_of(xcol)))){
  55. if (stat.test %>% filter(p < 0.05) %>% filter(.data[[x]] == dia & .data[[exclude_group]] == j) %>% nrow() > 0){
  56. t[table_stat[,x] == dia & table_stat[,exclude_group] == j,"y.position"]<-seq(t[table_stat[,x] == dia & table_stat[,exclude_group] == j,"y.position"][[1,1]],
  57. t[table_stat[,x] == dia & table_stat[,exclude_group] == j,"y.position"][[1,1]]+diff(range(table[,value.var], na.rm = T))*bracket.inspace*(nrow(table_stat[table_stat[,x] == dia & table_stat[,exclude_group] == j,])-1),
  58. by=diff(range(table[,value.var], na.rm = T))*bracket.inspace)
  59. }
  60. }
  61. }
  62. }else{
  63. for (dia in unique(pull(table_stat,all_of(xcol)))){
  64. t[table_stat[,x] == dia,"y.position"]<-seq(t[table_stat[,x] == dia,"y.position"][[1,1]],
  65. t[table_stat[,x] == dia,"y.position"][[1,1]]+diff(range(table[,value.var], na.rm = T))*bracket.inspace*(nrow(table_stat[table_stat[,x] == dia,])-1),
  66. by=diff(range(table[,value.var], na.rm = T))*bracket.inspace)
  67. }
  68. }
  69. }
  70. return(cbind(table_stat,t) %>% as_tibble)
  71. }