Commit 28cd7b47 authored by Midoux Cedric's avatar Midoux Cedric

rework barplot with shinymeta

parent 5a66fa87
output$barplotShowRankUI <- renderUI({
validate(need(data16S(), ""))
validate(need(physeq(), ""))
radioButtons(
"barplotShowRank",
label = "Taxonomic rank used for coloring : ",
choices = c(rank_names(data16S()), "OTU"),
choices = c(rank_names(physeq()), "OTU"),
selected = "Phylum",
inline = TRUE
)
})
output$barplotFilterRankUI <- renderUI({
validate(need(data16S(), ""))
validate(need(physeq(), ""))
radioButtons(
"barplotFilterRank",
label = "Taxonomic rank used for filtering : ",
choices = c("NULL" = 0, rank_names(data16S())),
choices = c("NULL" = 0, rank_names(physeq())),
inline = TRUE
)
})
output$barplotTaxaUI <- renderUI({
validate(need(data16S(), ""),
validate(need(physeq(), ""),
need(input$barplotFilterRank, ""),
need(input$barplotFilterRank!=0, ""))
selectInput(
"barplotTaxa",
label = "Selected filter taxa : ",
choices = unique(as.vector(tax_table(data16S())[, input$barplotFilterRank])),
choices = unique(as.vector(tax_table(physeq())[, input$barplotFilterRank])),
selected = TRUE
)
})
output$barplotNbTaxaUI <- renderUI({
validate(need(data16S(), ""))
validate(need(physeq(), ""))
sliderInput(
"barplotNbTaxa",
label = "Number of sub-taxa : ",
min = 1,
#max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$barplotFilterRank)]))[, as.integer(input$barplotFilterRank)]==input$barplotTaxa)
#max = sum(tax_table(tax_glom(physeq(), rank_names(physeq())[1+as.integer(input$barplotFilterRank)]))[, as.integer(input$barplotFilterRank)]==input$barplotTaxa)
max = 30,
value = 10
)
})
output$barplotGridUI <- renderUI({
validate(need(data16S(), ""))
validate(need(physeq(), ""))
selectInput("barplotGrid",
label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S())))
choices = c("..." = 0, sample_variables(physeq())))
})
output$barplotXUI <- renderUI({
validate(need(data16S(), ""))
validate(need(physeq(), ""))
selectInput("barplotX",
label = "X : ",
choices = c("..." = 0, sample_variables(data16S())))
choices = c("..." = "Sample", sample_variables(physeq())))
})
output$barplotUI <- renderUI({
validate(need(data16S(), ""))
validate(need(physeq(), ""))
box(
title = "Setting : ",
width = NULL,
......@@ -68,57 +68,41 @@ output$barplotUI <- renderUI({
uiOutput("barplotTaxaUI"),
uiOutput("barplotNbTaxaUI"),
uiOutput("barplotGridUI"),
uiOutput("barplotXUI"),
collapsedBox(verbatimTextOutput("barplotScript"), title = "RCode")
uiOutput("barplotXUI")
)
})
output$barplotScript <- renderText({
scriptArgs <- c(
"physeq = data",
glue("taxaRank1 = \"{input$barplotFilterRank}\""),
glue("taxaSet1 = \"{input$barplotTaxa}\""),
glue("taxaRank2 = \"{input$barplotShowRank}\""),
glue("numberOfTaxa = {input$barplotNbTaxa}")
)
if (!is.null(checkNull(input$barplotX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$barplotX}\""))
output$barplot <- metaRender2(renderPlot, {
validate(need(physeq(), "Requires an abundance dataset"),
need(input$barplotShowRank, ""))
barplotGrid <- if (!is.null(checkNull(input$barplotGrid))) {
metaExpr({
facet_grid(..(paste(".", "~", input$barplotGrid)), scales = "free_x")
})
}
script <- c(
scriptHead,
"# Plot filtered barplot",
glue(
"p <- plot_composition({glue_collapse(scriptArgs, sep=', ')})"
)
)
if (!is.null(checkNull(input$barplotGrid))) {
script <- c(
script,
glue(
"p <- p + facet_grid(\". ~ {input$barplotGrid}\", scales = \"free_x\")"
)
metaExpr({
p <- plot_composition(
physeq = physeq(),
taxaRank1 = ..(checkNull(input$barplotFilterRank)),
taxaSet1 = ..(input$barplotTaxa),
taxaRank2 = ..(input$barplotShowRank),
numberOfTaxa = ..(input$barplotNbTaxa),
x = ..(input$barplotX)
)
}
script <- c(script, "", "plot(p)")
return(glue_collapse(script, sep = "\n"))
p + ..(barplotGrid)
})
})
output$barplot <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
need(input$barplotShowRank, "")
)
p <- plot_composition(
physeq = data16S(),
taxaRank1 = checkNull(input$barplotFilterRank),
taxaSet1 = input$barplotTaxa,
taxaRank2 = input$barplotShowRank,
numberOfTaxa = input$barplotNbTaxa,
x = ifelse(is.null(checkNull(input$barplotX)), "Sample", input$barplotX)
)
if (!is.null(checkNull(input$barplotGrid))) {
p <- p + facet_grid(paste(".", "~", input$barplotGrid), scales = "free_x")
}
return(p)
})
observeEvent(input$barplot_output_code,
{
displayCodeModal(
expandChain(
quote(library(phyloseq)),
quote(library(phyloseq.extended)),
output$barplot()
)
)
}
)
barplot <-fluidPage(withLoader(plotOutput("barplot", height = 700)),
uiOutput("barplotUI"))
barplot <-fluidPage(outputCodeButton(withLoader(plotOutput("barplot", height = 700))),
uiOutput("barplotUI"))
options(shiny.maxRequestSize = 30 * 1024 ^ 2)
library(shinydashboard)
library(shinymeta)
library(phyloseq)
library(phyloseq.extended)
library(ggplot2)
......
library(shinydashboard)
library(shinymeta)
library(shinycustomloader)
source("panels/Summary-ui.R", local = TRUE)
source("panels/barplot-ui.R", local = TRUE)
......
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