update

lot of changes!!!

R/bars_fun.R

@@ -31,6 +31,32 @@ rarefaction <- function(data = data, col = NULL, step = 100, ggplotly = TRUE){
 }
 
 
+#' aggregate_top_taxa from microbiome package
+#'
+#'
+#' @param x phyloseq object
+#' @param top Keep the top-n taxa, and merge the rest under the category 'Other'. Instead of top-n numeric this can also be a character vector listing the groups to combine.
+#' @param level Summarization level (from ‘rank_names(pseq)’)
+#'
+#' @importFrom microbiome aggregate_taxa
+#' @importFrom microbiome top_taxa
+#'
+#' @export
+
+aggregate_top_taxa <- function (x, top, level){
+    x <- aggregate_taxa(x, level)
+    tops <- top_taxa(x, top)
+    tax <- tax_table(x)
+    inds <- which(!rownames(tax) %in% tops)
+    tax[inds, level] <- "Other"
+    tax_table(x) <- tax
+    tt <- tax_table(x)[, level]
+    tax_table(x) <- tax_table(tt)
+    aggregate_taxa(x, level)
+}
+
+
+
 #' Barplots plotly
 #'
 #'
@@ -38,16 +64,16 @@ rarefaction <- function(data = data, col = NULL, step = 100, ggplotly = TRUE){
 #' @param rank Taxonomy rank to merge features that have same taxonomy at a certain taxonomic rank (among rank_names(data), or 'ASV' for no glom)
 #' @param top Number of top taxa to plot
 #' @param Ord1 Variable used to order sample (X axis) or split the barplot if split = TRUE
-#' @param Fact1 Variable used to change X axis tick labels and color (when split = FALSE)
+#' @param sample_labels If true, x axis labels are sample IDS, if false labels displayed are levels from Ord1 argument. Ignored if split = TRUE (FALSE)
 #' @param split if TRUE make a facet_wrap like grouped by Ord1 (default FALSE)
 #' @param relative Plot relative (TRUE, default) or raw abundance plot (FALSE)
+#' @param autoorder Automatic ordering xaxis labels based on Ord1 factor levels with gtools::mixedorder function (TRUE).
 #' @param ylab Y axis title ("Abundance")
 #' @param outfile Output html file.
 #'
 #' @return Returns barplots in an interactive plotly community plot
 #'
 #' @import plotly
-#' @importFrom microbiome aggregate_top_taxa
 #' @importFrom reshape2 melt
 #' @importFrom gtools mixedsort
 #' @importFrom dplyr group_map group_by across
@@ -56,8 +82,8 @@ rarefaction <- function(data = data, col = NULL, step = 100, ggplotly = TRUE){
 #' @export
 
 
-bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 = NULL, split = FALSE,
-                     relative = TRUE, ylab = "Abundance", outfile="plot_compo.html", verbose = TRUE){
+bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, sample_labels = FALSE, split = FALSE, split_sid_order = FALSE,
+                     relative = TRUE, autoorder = TRUE, ylab = "Abundance", outfile="plot_compo.html", verbose = TRUE){
 
   if(verbose){
     invisible(flog.threshold(INFO))
@@ -66,15 +92,14 @@ bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 =
   }
 
 
-if( all(Ord1 != sample_variables(data)) | all(Fact1 != sample_variables(data))){
-  stop(paste("Wrong value in Ord1 or Fact1 arguments, please use variables existing in the phyloseq object:", toString(sample_variables(data))))
+if( all(Ord1 != sample_variables(data))){
+  stop(paste("Wrong value in Ord1, please use variables existing in the phyloseq object:", toString(sample_variables(data))))
 }
-#{paste(sample_variables(data), collapse = ",")}
+
   flog.info('Preprocess...')
   Fdata = data
   psobj.top <- aggregate_top_taxa(Fdata, rank, top = top)
 
-  # print("get data")
   sdata <- as.data.frame(sample_data(psobj.top), stringsAsFactors = TRUE)
   sdata$sample.id = sample_names(psobj.top)
   otable = as.data.frame(otu_table(psobj.top))
@@ -83,6 +108,8 @@ if( all(Ord1 != sample_variables(data)) | all(Fact1 != sample_variables(data))){
   # print("melt data")
   dat <- as.data.frame(t(otable))
   dat <- cbind.data.frame(sdata, dat)
+
+  flog.info('  Melting table...')
   meltdat <- reshape2::melt(dat, id.vars=1:ncol(sdata))
   tt <- levels(meltdat$variable)
   meltdat$variable <- factor(meltdat$variable, levels= c("Other", tt[tt!="Other"]))
@@ -92,29 +119,49 @@ if( all(Ord1 != sample_variables(data)) | all(Fact1 != sample_variables(data))){
   # print(levels(meltdat$sample.id))
   # save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment())
 
-  # TODO: Message d'erreur si factor n'est pas dans les sample_data
 
-  fun = glue( "xform <- list(categoryorder = 'array',
-                    categoryarray = unique(meltdat$sample.id[gtools::mixedorder(as.character(meltdat${Ord1}))]),
-                    title = 'Samples',
-                    tickmode = 'array',
-                    tickvals = 0:nrow(sdata),
-                    ticktext = sdata[unique(meltdat$sample.id[gtools::mixedorder(as.character(meltdat${Ord1}))]), '{Fact1}']@.Data[[1]],
-                    tickangle = -90)")
-  eval(parse(text=fun))
+  if(autoorder){
+  flog.info('  Ordering samples...')
+      fun = glue( "labs = gtools::mixedorder(as.character(meltdat${Ord1}))" )
+      eval(parse(text=fun))
 
-  # subplot to vizualize groups
+      orderedIDS <- unique(meltdat$sample.id[gtools::mixedorder(as.character(meltdat[,Ord1]))])
+      orderedOrd1 <- meltdat[,Ord1][gtools::mixedorder(as.character(meltdat[,Ord1]))]
+      orderedOrd1 <- factor(orderedOrd1, levels = gtools::mixedsort(levels(orderedOrd1)))
+    }else{
+      labs = 1:nrow(meltdat)
+
+      orderedIDS <- unique(meltdat$sample.id)
+      orderedOrd1 <- meltdat[,Ord1]
+    }
+
+
+
+  if(sample_labels){
+      lab1 = "sample.id"
+    }else{
+      lab1 = Ord1
+    }
+
+  flog.info('  Set labels...')
+  xform <- list(categoryorder = 'array',
+                categoryarray = unique(meltdat$sample.id[labs]),
+                title = 'Samples',
+                tickmode = 'array',
+                tickvals = 0:nrow(sdata),
+                ticktext = sdata[as.character(unique(meltdat$sample.id[labs])), lab1]@.Data[[1]],
+                tickangle = -90)
 
-  orderedIDS <- unique(meltdat$sample.id[gtools::mixedorder(as.character(meltdat[,Ord1]))])
-  orderedOrd1 <- meltdat[,Ord1][gtools::mixedorder(as.character(meltdat[,Ord1]))]
+  # subplot to vizualize groups
 
+  flog.info('  Subplot...')
   df1 <- cbind.data.frame(x=sdata[orderedIDS, "sample.id"]@.Data[[1]],
-                          g=sdata[orderedIDS, Fact1]@.Data[[1]],
+                          g=sdata[orderedIDS, Ord1]@.Data[[1]],
                           y=1)
 
   fun = glue( "df1$g <- factor(df1$g, levels = as.character(unique(orderedOrd1)))")
   eval(parse(text=fun))
-  fun = glue( "meltdat${Ord1} <- factor(meltdat${Ord1}, levels = as.character(unique(orderedOrd1)))")
+  fun = glue( "meltdat${Ord1} <- factor(meltdat${Ord1}, levels = as.character(unique(orderedOrd1)))") # keep sample ids order from metadata.
   eval(parse(text=fun))
 
   subp1 <- df1 %>% plot_ly(
@@ -134,6 +181,7 @@ if( all(Ord1 != sample_variables(data)) | all(Fact1 != sample_variables(data))){
     otable=apply(otable,2, function(x){Tot=sum(x); x/Tot})
     dat= as.data.frame(t(otable))
     dat <- cbind.data.frame(sdata, dat)
+
     meltdat <- reshape2::melt(dat, id.vars=1:ncol(sdata))
     tt <- levels(meltdat$variable)
     meltdat$variable <- factor(meltdat$variable, levels= c("Other", tt[tt!="Other"]))
@@ -160,7 +208,7 @@ if( all(Ord1 != sample_variables(data)) | all(Fact1 != sample_variables(data))){
     }
   }
 
-  # facet_wrap output
+  # Splitted plot output
   if(!split) {
     if(!is.null(outfile)){
       htmlwidgets::saveWidget(p1, outfile)
@@ -169,15 +217,20 @@ if( all(Ord1 != sample_variables(data)) | all(Fact1 != sample_variables(data))){
     return(p1)
   } else {
   flog.info('Splitted plot...')
-    p1 = meltdat %>% group_by(across({Ord1})) %>%
-      dplyr::group_map(~ plot_ly(data=., x = ~sample.id, y = ~value, type = 'bar',
-                                 name = ~variable,
-                                 color = ~variable, legendgroup = ~variable,
-                                 showlegend = (.y == levels(meltdat[, Ord1])[1])),
-                       keep = TRUE)  %>%
+    if(split_sid_order){
+    meltdat$sample.id = factor(meltdat$sample.id, levels = unique(meltdat$sample.id)) # keep sample ids order from metadata.
+    }
+
+    p1 = meltdat  %>% arrange(across({Ord1})) %>% group_by(across({Ord1})) %>%
+        mutate(across(where(is.character), as.factor)) %>%
+        dplyr::group_map(~ plot_ly(data=., x = ~sample.id, y = ~value, type = 'bar',
+                                   name = ~variable,
+                                   color = ~variable, legendgroup = ~variable,
+                                   showlegend = (.y == levels(meltdat[, Ord1])[1])),
+                         keep = TRUE)  %>%
       subplot(nrows = 1, shareX = TRUE, shareY=TRUE, titleX = FALSE) %>%
       layout(title="",
-             xaxis = list(title = glue("{Ord1} = {unique(meltdat[, Ord1])[1]}")),
+             xaxis = list(title = glue("{Ord1} = {levels(meltdat[, Ord1])[1]}")),
              yaxis = list(title = ylab),
              barmode = 'stack')