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

rework barplot with shinymeta

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