Specify package for "filter" function

change !!!sym_link for .data[[exclude_group]].

DESCRIPTION

@@ -7,5 +7,6 @@ Maintainer: Marcel Costa <marcelcosta@mcosta.cat>
 Description: Funciones internas para el laboratorio CIT
 License: GPL
 Encoding: UTF-8
+Suggests: rmarkdown
 VignetteBuilder: knitr
 LazyData: true

R/ggheatmap.R

@@ -16,7 +16,33 @@ ggheatmap<-function(df, x=NULL, y=NULL, value=NULL, grouping="mean", exclude_gro
   if (grouping == "median"){
     df<-df %>% summarise(Value=median(Value)) %>% ungroup
   }
-  order<-clustsort(df %>% spread(VarY,Value) %>% select(!all_of(exclude_group)) %>% as.data.frame)
+
+  if (length(unique(df$VarX)) > 1 & length(unique(df$VarY)) >
+      1) {
+    order <- clustsort(df %>% spread(VarY, Value) %>% select(!all_of(exclude_group)) %>%
+                         as.data.frame)
+  }
+  else {
+    order <- list()
+    if (length(unique(df$VarX)) > 1) {
+      xhclust <- df %>% spread(VarY, Value) %>%
+        select(!all_of(exclude_group)) %>% as.data.frame
+      order[["x"]] <- pull(xhclust, 1)[hclust(dist(xhclust %>%
+                                                     select(-1)))$order]
+    }
+    else {
+      order[["x"]] <- df %>% pull(VarX) %>% unique
+    }
+    if (length(unique(df$VarY)) > 1) {
+      yhclust <- clustsort(df %>% spread(VarY, Value) %>%
+                             select(!all_of(exclude_group)) %>% as.data.frame)
+      order[["y"]] <- colnames(yhclust)[2:ncol(yhclust)][hclust(dist(t(yhclust %>%
+                                                                         select(-1))))$order]
+    }
+    else {
+      order[["y"]] <- df %>% pull(VarY) %>% unique
+    }
+  }
 
   if (scale != "none"){
     if (scale == "rows"){

R/ggstats_add_xy.R

@@ -1,62 +1,82 @@
-ggstats_add_xy<-function(table_stat, table, group, xcol=NULL, y="max", bracket.offset=0.05, bracket.inspace=0.05, exclude_group=NULL){
+ggstats_add_xy<-function(table_stat, table, xcol=NULL, group, y="max", bracket.offset=0.05, bracket.inspace=0.05, exclude_group=NULL, dodge=0.75){
   ## Adapted version to fit rstatix output
   value.var<-table_stat[[1,".y."]]
   if (is.null(xcol)){
     x<-colnames(table_stat)[1]
   }else{x<-xcol}
 
-  table[,group]<-as.factor(table[,group])
+  if(!is.null(group)){table[,group]<-as.factor(pull(table,group))}
-  table[,x]<-as.factor(table[,x])
+  table[,x]<-as.factor(pull(table,x))
   if (is.null(exclude_group)){
     table_agg<-table %>% group_by(.data[[x]])
   }else{
-    table_agg<-table %>% group_by(.data[[x]], .data[[exclude_group]])
+    table_agg<-table %>% group_by(.data[[x]], !!!syms(exclude_group))
   }
   if (y == "max"){
-    agg<-table_agg %>% summarise(max=max(.data[[value.var]]))
+    agg<-table_agg %>% summarise(max=max(.data[[value.var]], na.rm = T))
+    if(!is.null(exclude_group)){agg<-table_agg %>% group_by(!!!syms(exclude_group)) %>% summarise(max=max(.data[[value.var]], na.rm=T))}
   }else if (y == "mean"){
-    agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]])) %>% spread(group, mean)
+    agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]], na.rm=T)) %>% spread(group, mean)
     agg<- data.frame(x=agg[,1], "max"=apply(agg[,2:ncol(agg)], 1, max, na.rm=T))
     colnames(agg)[1]<-x
   }else if (y == "mean+sd"){
-    agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]])+sd(.[[value.var]])) %>% spread(group, mean)
+    agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]], na.rm=T)+sd(.[[value.var]], na.rm=T)) %>% spread(group, mean)
     agg<- data.frame(x=agg[,1], "max"=apply(agg[,2:ncol(agg)], 1, max, na.rm=T))
     colnames(agg)[1]<-x
   }else if (y == "mean+sem"){
-    agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]])+sem(.[[value.var]])) %>% spread(group, mean)
+    agg<-table %>% group_by(.data[[x]],.data[[group]]) %>% summarise(mean=mean(.data[[value.var]], na.rm=T)+sem(.[[value.var]], na.rm=T)) %>% spread(group, mean)
     agg<- data.frame(x=agg[,1], "max"=apply(agg[,2:ncol(agg)], 1, max, na.rm=T))
     colnames(agg)[1]<-x
   }
 
   group.list<-list()
   count<-1
-  table_stat<-mutate(table_stat, {{x}}:=as.factor(.data[[x]]))
+  if(!is.null(group)){table_stat<-mutate(table_stat, {{x}}:=as.factor(.data[[x]]))}
-  for (i in 1:nrow(table_stat)){group.list[[count]]<-c(table_stat %>% slice(i) %>% pull(group1),table_stat%>% slice(i) %>% pull(group2)); count<-count+1}
-  x.index<-sapply(table_stat %>% pull(x), function(y) which(levels(table_stat %>% pull(x)) == y))
-  t<-tibble("y.position"=merge(table_stat, agg ,sort=F)[,"max"]+diff(range(table[value.var], na.rm = T))*bracket.offset,
-            "groups"=group.list,
-            "x.temp"=x.index,
-            "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)),
-            "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)
-  ) %>% rename("x"="x.temp")
 
-  if (!is.null(exclude_group)){
+  for (i in 1:nrow(table_stat)){
-    for (j in unique(pull(table_stat, all_of(exclude_group)))){
+    group.list[[count]]<-c(table_stat %>% slice(i) %>% pull(group1),table_stat%>% slice(i) %>% pull(group2))
-      for (dia in unique(pull(table_stat,all_of(xcol)))){
+    count<-count+1
-        if (stat.test %>% filter(p < 0.05) %>% filter(.data[[x]] == dia & .data[[exclude_group]] == j) %>% nrow() > 0){
+  }
-          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]],
+  if(!is.null(group)){
-                                                                                       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),
+    x.index<-sapply(table_stat %>% pull(x), function(y) which(levels(table_stat %>% pull(x)) == y))
-                                                                                       by=diff(range(table[,value.var], na.rm = T))*bracket.inspace)
+    t<-tibble("y.position"=merge(table_stat, agg ,sort=F)[,"max"]+diff(range(table[value.var], na.rm = T))*bracket.offset,
+              "groups"=group.list,
+              "x.temp"=x.index,
+              "xmin"=(match(table_stat %>% pull(x), levels(table[,x]))+dodge*((match(table_stat$group1, levels(table[,group]))-0.5)/length(levels(table[,group]))-0.5)),
+              "xmax"=match(table_stat %>% pull(x), unique(table[,x]))+dodge*((match(table_stat$group2, levels(table[,group]))-0.5)/length(levels(table[,group]))-0.5)
+    ) %>% rename("x"="x.temp")
+  }else{
+    t<-tibble("y.position"=merge(table_stat, agg ,sort=F)[,"max"]+diff(range(table[value.var], na.rm = T))*bracket.offset,
+              "groups"=group.list,
+              # "x.temp"=x.index,
+    )# %>% rename("x"="x.temp")
+  }
+  if (!is.null(group)){
+    if (!is.null(exclude_group)){
+      for (j in unique(pull(table_stat, all_of(exclude_group)))){
+        for (dia in unique(pull(table_stat,all_of(xcol)))){
+          if (table_stat %>% dplyr::filter(p < 0.05) %>% dplyr::filter(.data[[x]] == dia & .data[[exclude_group]] == j) %>% nrow() > 0){
+            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]],
+                                                                                         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),
+                                                                                         by=diff(range(table[,value.var], na.rm = T))*bracket.inspace)
+          }
         }
       }
+    }else{
+      for (dia in unique(pull(table_stat,all_of(xcol)))){
+        t[table_stat[,x] == dia,"y.position"]<-seq(t[table_stat[,x] == dia,"y.position"][[1,1]],
+                                                   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),
+                                                   by=diff(range(table[,value.var], na.rm = T))*bracket.inspace)
+      }
     }
   }else{
-    for (dia in unique(pull(table_stat,all_of(xcol)))){
+    for (dia in unique(pull(mutate(table_stat,dia=paste0(!!!syms(exclude_group))),dia))){
-      t[table_stat[,x] == dia,"y.position"]<-seq(t[table_stat[,x] == dia,"y.position"][[1,1]],
+      t[apply(table_stat[,exclude_group], 1, paste, collapse="") == dia, "y.position"]<-seq(t[apply(table_stat[,exclude_group], 1, paste, collapse="") == dia,"y.position"][[1,1]],
-                                                 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),
+                                                                                            t[apply(table_stat[,exclude_group], 1, paste, collapse="") == dia,"y.position"][[1,1]]+
-                                                 by=diff(range(table[,value.var], na.rm = T))*bracket.inspace)
+                                                                                              diff(range(table[,value.var], na.rm = T))*
+                                                                                              bracket.inspace*(nrow(table_stat[apply(table_stat[,exclude_group], 1, paste, collapse="") == dia,])-1),
+                                                                                            by=diff(range(table[,value.var], na.rm = T))*bracket.inspace)
     }
   }
-
   return(cbind(table_stat,t) %>% as_tibble)
 }

R/md2csv.R

@@ -0,0 +1,7 @@
+md2csv<-function(text, rm_blank=T){
+  text<-strsplit(text, "\n")[[1]]
+  text<-gsub("^[ |]*|[|][ ]*$","",text)
+  if(rm_blank){text<-gsub(" ","",text)}
+  text<-gsub("[|]",",",text)
+  return(cat(text,sep = "\n"))
+}

R/tab2md.R

@@ -0,0 +1,10 @@
+tab2md<-function(table){
+  samples_csv<-table
+  table<-apply(table, 1, paste, collapse="|")
+  table<-gsub("^","|",table)
+  table<-gsub("$","|",table)
+  table<-c(paste0("|",paste(colnames(samples_csv), collapse="|"),"|"),
+          paste0("|",paste(rep("---",ncol(samples_csv)), collapse="|"),"|"),
+          table)
+  cat(table, sep="\n")
+}

man/ggstats_add_xy.Rd

@@ -2,17 +2,18 @@
 \alias{ggstats_add_xy}
 \title{ggstats_add_xy}
 \usage{
-ggstats_add_xy(table_stat, table, group, xcol=NULL, y="max", bracket.offset=0.05, bracket.inspace=0.05, exclude_group=NULL)
+ggstats_add_xy(table_stat, table, group, xcol=NULL, y="max", bracket.offset=0.05, bracket.inspace=0.05, exclude_group=NULL, dodge=0.75)
 }
 \arguments{
   \item{table_stat}{A table generated by a rstatix funcion such as t_test() or wilcox_test().}
   \item{table}{The original table that was introduced to ggplot.}
-  \item{group}{The grouping variable.}
+  \item{xcol}{The X-axis variable. If null (the default), the function will pick the first column. This is intended when exclude_group is null.}
-  \item{group}{The X-axis variable. If null (the default), the function will pick the first column. This is intended when exclude_group is null.}
+  \item{group}{The grouping variable. If null, the function will emulate the add_y_position function instead of add_xy_position.}
   \item{y}{The algorithm used to calculate the y height. Is useful to adapt to plots that show all events, bars with the mean, etc... Options are "max" (default), "mean", "mean+sd", "mean+sem".}
   \item{bracket.offset}{Increasing this parameter incresases the y position of the brackets.}
   \item{bracket.inspace}{Increasing this parameter increases the space between brackets.}
   \item{exclude_group}{Variable(s) that will not be grouped. This aims to preserve the variable in order to facet.}
+  \item{dodge}{How much dodge to perform (different ggplot geoms have different dodge values).}
 }
 \description{
 Generates a table with the coordinates that is required by the ggpubr function "stat_pvalue_manual".
@@ -32,5 +33,5 @@ g<-ggplot(mdf, aes(Cytokine, Value, color=Group))+
   geom_point(position=position_dodge(width = 0.75))
 
 stat.test<-mdf \%>\% group_by(Cytokine) \%>\% t_test(Value~Group)
-g+stat_pvalue_manual(ggstats_add_xy(stat.test, mdf, "Group"),  label = "p", tip.length = 0.02, hide.ns = T)
+g+stat_pvalue_manual(ggstats_add_xy(stat.test, mdf, "Cytokine","Group"),  label = "p", tip.length = 0.02, hide.ns = T)
 }

man/md2csv.Rd

@@ -0,0 +1,28 @@
+\name{md2csv}
+\alias{md2csv}
+\title{md2csv}
+\usage{
+md2csv(text, rm_blank =T)
+}
+\arguments{
+  \item{text}{An md text that you want to convert to csv. Note that you must eliminate the line that separates title from the rest.}
+  \item{text}{Bolean to specify if you want to remove spaces or not.}
+}
+\description{
+This function converts an  Markdown (md) table into csv format.
+}
+\examples{
+text<-"|Letter|Number|
+|A| 1|
+|B| 2|
+|C| 3|
+|D| 4|
+|E| 5|
+|F| 6|
+|G| 7|
+|H| 8|
+|I| 9|
+|J|10|"
+md2csv(text)
+
+}

man/tab2md.Rd

@@ -0,0 +1,17 @@
+\name{tab2md}
+\alias{tab2md}
+\title{tab2md}
+\usage{
+tab2md(text)
+}
+\arguments{
+  \item{text}{A data.frame that you want to convert to Markdown.}
+}
+\description{
+This function converts a data.frame into Markdown (md) format.
+}
+\examples{
+table<-data.frame("Letter"=LETTERS[1:10], "Number"=1:10)
+tab2md(table)
+
+}