Commit 54820cf2 authored by Etienne Rifa's avatar Etienne Rifa
Browse files

bars_fun: fix ordering groups

parent 6f783900
Pipeline #39487 passed with stage
in 12 seconds
......@@ -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)
}
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment