bars_fun: fix ordering groups

R/bars_fun.R

@@ -57,20 +57,25 @@ rarefaction <- function(data = data, col = NULL, step = 100, ggplotly = TRUE){
 
 bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 = NULL, split = FALSE,
                      relative = TRUE,
-                     outfile="plot_compo.html"){
+                     outfile="plot_compo.html", verbose = TRUE){
+
+  if(verbose){
+    invisible(flog.threshold(INFO))
+  } else {
+    invisible(flog.threshold(ERROR))
+  }
 
-  # Fdata <- prune_samples(sample_names(r$data16S())[r$rowselect()], r$data16S())
-  # Fdata <- prune_taxa(taxa_sums(Fdata) > 0, Fdata)
-  # if( r$RankGlom() == "ASV"){
-  #   Fdata <- prune_taxa(r$asvselect(), Fdata)
-  # }
 
+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))))
+}
+#{paste(sample_variables(data), collapse = ",")}
+  flog.info('Preprocess...')
   Fdata = data
-  # print("top")
   psobj.top <- aggregate_top_taxa(Fdata, rank, top = top)
 
   # print("get data")
-  sdata = as.data.frame(sample_data(psobj.top))
+  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))
   row.names(otable) = tax_table(psobj.top)[,rank]
@@ -90,20 +95,28 @@ bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 =
   # 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(meltdat${Ord1})]),
+                    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(meltdat${Ord1})]), '{Fact1}']@.Data[[1]],
+                    ticktext = sdata[unique(meltdat$sample.id[gtools::mixedorder(as.character(meltdat${Ord1}))]), '{Fact1}']@.Data[[1]],
                     tickangle = -90)")
   eval(parse(text=fun))
 
   # subplot to vizualize groups
-  # print(head(sdata))
 
-  df1 <- cbind.data.frame(x=sdata[unique(meltdat$sample.id[gtools::mixedorder(meltdat[,Ord1])]), "sample.id"]@.Data[[1]],
-                          g=sdata[unique(meltdat$sample.id[gtools::mixedorder(meltdat[,Ord1])]), Fact1]@.Data[[1]],
+  orderedIDS <- unique(meltdat$sample.id[gtools::mixedorder(as.character(meltdat[,Ord1]))])
+  orderedOrd1 <- meltdat[,Ord1][gtools::mixedorder(as.character(meltdat[,Ord1]))]
+
+  df1 <- cbind.data.frame(x=sdata[orderedIDS, "sample.id"]@.Data[[1]],
+                          g=sdata[orderedIDS, Fact1]@.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)))")
+  eval(parse(text=fun))
+
   subp1 <- df1 %>% plot_ly(
     type = 'bar',
     x = ~x,
@@ -116,14 +129,18 @@ bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 =
 
 
   if(relative){
+  flog.info('Plotting relative...')
     #relative abondance
     plottitle = "Relative abundance"
     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"]))
+    meltdat <- reshape2::melt(dat, id.vars=1:ncol(sdata))
+    tt <- levels(meltdat$variable)
+    meltdat$variable <- factor(meltdat$variable, levels= c("Other", tt[tt!="Other"]))
+
+    fun = glue( "meltdat${Ord1} <- factor(meltdat${Ord1}, levels = as.character(unique(orderedOrd1)))")
+    eval(parse(text=fun))
 
     p1=plot_ly(meltdat, x = ~sample.id, y = ~value, type = 'bar', name = ~variable, color = ~variable) %>% #, color = ~variable
       layout(title="Relative abundance", yaxis = list(title = 'Relative abundance'), xaxis = xform, barmode = 'stack')
@@ -133,6 +150,7 @@ bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 =
       layout(xaxis = xform)
     }
   }else{
+  flog.info('Plotting raw...')
     #raw abundance
     plottitle = "Raw abundance"
     p1=plot_ly(meltdat, x = ~sample.id, y = ~value, type = 'bar', name = ~variable, color = ~variable) %>% #, color = ~variable
@@ -144,14 +162,15 @@ bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 =
     }
   }
 
-
   # facet_wrap output
   if(!split) {
     if(!is.null(outfile)){
       htmlwidgets::saveWidget(p1, outfile)
     }
+  flog.info('Finish...')
     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,
@@ -166,11 +185,12 @@ bars_fun <- function(data = data, rank = "Genus", top = 10, Ord1 = NULL, Fact1 =
 
     for (i in 2:length(unique(meltdat[, Ord1]))) {
       p1$x$layoutAttrs[[1]][[paste0("xaxis", i)]] = NULL
-      p1$x$layoutAttrs[[1]][[paste0("xaxis", i)]]$title <- glue("{Ord1} = {unique(meltdat[, Ord1])[i]}")
+      p1$x$layoutAttrs[[1]][[paste0("xaxis", i)]]$title <- glue("{Ord1} = {levels(meltdat[, Ord1])[i]}")
     }
     if(!is.null(outfile)){
       htmlwidgets::saveWidget(p1, outfile)
     }
+  flog.info('Finish...')
     return(p1)
   }
 }