Commit f41208ce authored by Midoux Cedric's avatar Midoux Cedric

rework barplot

parent 5706c777
output$histFocusUIfocusRank <- renderUI({
output$barplotShowRankUI <- renderUI({
validate(need(data16S(), ""))
radioButtons(
"focusRank",
label = "Taxonomic rank : ",
choices = rank_names(data16S())[-length(rank_names(data16S()))],
"barplotShowRank",
label = "Taxonomic rank used for coloring : ",
choices = c(rank_names(data16S()), "OTU"),
selected = "Phylum",
inline = TRUE
)
})
output$histFocusUIfocusTaxa <- renderUI({
output$barplotFilterRankUI <- renderUI({
validate(need(data16S(), ""))
radioButtons(
"barplotFilterRank",
label = "Taxonomic rank used for filtering : ",
choices = c("NULL" = 0, rank_names(data16S())),
inline = TRUE
)
})
output$barplotTaxaUI <- renderUI({
validate(need(data16S(), ""),
need(input$focusRank, ""))
need(input$barplotFilterRank, ""),
need(input$barplotFilterRank!=0, ""))
selectInput(
"focusTaxa",
label = "Selected taxa : ",
choices = unique(as.vector(tax_table(data16S(
))[, input$focusRank])),
"barplotTaxa",
label = "Selected filter taxa : ",
choices = unique(as.vector(tax_table(data16S())[, input$barplotFilterRank])),
selected = TRUE
)
})
output$histFocusUIfocusNbTaxa <- renderUI({
output$barplotNbTaxaUI <- renderUI({
validate(need(data16S(), ""))
sliderInput(
"focusNbTaxa",
"barplotNbTaxa",
label = "Number of sub-taxa : ",
min = 0,
#max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
min = 1,
#max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$barplotFilterRank)]))[, as.integer(input$barplotFilterRank)]==input$barplotTaxa)
max = 30,
value = 10
)
})
output$histFocusUIfocusGrid <- renderUI({
output$barplotGridUI <- renderUI({
validate(need(data16S(), ""))
selectInput("focusGrid",
selectInput("barplotGrid",
label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S())))
})
output$histFocusUIfocusX <- renderUI({
output$barplotXUI <- renderUI({
validate(need(data16S(), ""))
selectInput("focusX",
selectInput("barplotX",
label = "X : ",
choices = c("..." = 0, sample_variables(data16S())))
})
output$histFocusUI <- renderUI({
output$barplotUI <- renderUI({
validate(need(data16S(), ""))
box(
title = "Setting : ",
width = NULL,
status = "primary",
uiOutput("histFocusUIfocusRank"),
uiOutput("histFocusUIfocusTaxa"),
uiOutput("histFocusUIfocusNbTaxa"),
uiOutput("histFocusUIfocusGrid"),
uiOutput("histFocusUIfocusX"),
collapsedBox(verbatimTextOutput("histFocusScript"), title = "RCode")
uiOutput("barplotShowRankUI"),
uiOutput("barplotFilterRankUI"),
uiOutput("barplotTaxaUI"),
uiOutput("barplotNbTaxaUI"),
uiOutput("barplotGridUI"),
uiOutput("barplotXUI"),
collapsedBox(verbatimTextOutput("barplotScript"), title = "RCode")
)
})
output$histFocusScript <- renderText({
output$barplotScript <- renderText({
scriptArgs <- c(
"physeq = data",
glue("taxaRank1 = \"{input$focusRank}\""),
glue("taxaSet1 = \"{input$focusTaxa}\""),
glue(
"taxaRank2 = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
),
glue("numberOfTaxa = {input$focusNbTaxa}"),
glue(
"fill = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
)
glue("taxaRank1 = \"{input$barplotFilterRank}\""),
glue("taxaSet1 = \"{input$barplotTaxa}\""),
glue("taxaRank2 = \"{input$barplotShowRank}\""),
glue("numberOfTaxa = {input$barplotNbTaxa}")
)
if (!is.null(checkNull(input$focusX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$focusX}\""))
if (!is.null(checkNull(input$barplotX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$barplotX}\""))
}
script <- c(
scriptHead,
......@@ -85,38 +91,34 @@ output$histFocusScript <- renderText({
"p <- plot_composition({glue_collapse(scriptArgs, sep=', ')})"
)
)
if (!is.null(checkNull(input$focusGrid))) {
if (!is.null(checkNull(input$barplotGrid))) {
script <- c(
script,
glue(
"p <- p + facet_grid(\". ~ {input$focusGrid}\", scales = \"free_x\")"
"p <- p + facet_grid(\". ~ {input$barplotGrid}\", scales = \"free_x\")"
)
)
}
script <- c(script, "", "plot(p)")
return(glue_collapse(script, sep = "\n"))
})
output$histFocus <- renderPlot({
output$barplot <- renderPlot({
validate(
need(data16S(),
"Requires an abundance dataset"),
need(input$focusRank, ""),
need(input$focusTaxa, "")
need(data16S(), "Requires an abundance dataset"),
need(input$barplotShowRank, "")
)
p <- plot_composition(
physeq = data16S(),
taxaRank1 = input$focusRank,
taxaSet1 = input$focusTaxa,
taxaRank2 = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
numberOfTaxa = input$focusNbTaxa,
fill = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
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$focusGrid))) {
p <-
p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
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)),
uiOutput("barplotUI"))
output$histUI <- renderUI({
validate(need(data16S(), ""))
box(
title = "Setting : ",
width = NULL,
status = "primary",
radioButtons(
"barFill",
label = "Taxonomic rank : ",
choices = rank_names(data16S()),
inline = TRUE
),
textInput("barTitle",
label = "Title : ",
value = "OTU abundance barplot"),
selectInput(
"barGrid",
label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"barX",
label = "X : ",
choices = c("..." = 0, sample_variables(data16S()))
),
collapsedBox(verbatimTextOutput("histScript"), title = "RCode")
)
})
output$histScript <- renderText({
scriptArgs <- c("physeq = data",
glue("fill = \"{input$barFill}\""))
if (!is.null(checkNull(input$barX))) {
scriptArgs <- c(scriptArgs, glue("x = \"{input$barX}\""))
}
if (!is.null(checkNull(input$barTitle))) {
scriptArgs <- c(scriptArgs, glue("title = \"{input$barTitle}\""))
}
script <- c(
scriptHead,
"# Plot barplot",
glue("p <- plot_bar({glue_collapse(scriptArgs, sep=', ')})")
)
if (!is.null(checkNull(input$barGrid))) {
script <- c(script,
glue(
"p <- p + facet_grid(\". ~ {input$barGrid}\", scales = \"free_x\")"
))
}
script <- c(script, "", "plot(p)")
return(glue_collapse(script, sep = "\n"))
})
output$histo <- renderPlot({
validate(need(data16S(),
"Requires an abundance dataset"))
p <- plot_bar(
physeq = data16S(),
fill = input$barFill,
x = ifelse(is.null(checkNull(input$barX)), "Sample", input$barX),
title = checkNull(input$barTitle)
)
if (!is.null(checkNull(input$barGrid))) {
p <-
p + facet_grid(paste(".", "~", input$barGrid), scales = "free_x")
}
return(p)
})
histo <- fluidPage(withLoader(plotOutput("histo", height = 700)),uiOutput("histUI"))
histFocus <-fluidPage(withLoader(plotOutput("histFocus", height = 700)),
uiOutput("histFocusUI"))
......@@ -13,8 +13,7 @@ shinyServer
{
source("panels/Sidebar-server.R", local = TRUE)
source("panels/Summary-server.R", local = TRUE)
source("panels/histo-server.R", local = TRUE)
source("panels/histoFocus-server.R", local = TRUE)
source("panels/barplot-server.R", local = TRUE)
source("panels/heatmap-server.R", local = TRUE)
source("panels/rarefactionCurve-server.R", local = TRUE)
source("panels/richnessA-server.R", local = TRUE)
......
......@@ -2,8 +2,7 @@ library(shinydashboard)
library(shinycustomloader)
source("panels/Sidebar-ui.R", local = TRUE)
source("panels/Summary-ui.R", local = TRUE)
source("panels/histo-ui.R", local = TRUE)
source("panels/histoFocus-ui.R", local = TRUE)
source("panels/barplot-ui.R", local = TRUE)
source("panels/heatmap-ui.R", local = TRUE)
source("panels/rarefactionCurve-ui.R", local = TRUE)
source("panels/richnessA-ui.R", local = TRUE)
......@@ -21,10 +20,8 @@ shinyUI(dashboardPage(
tabsetPanel(
tabPanel("Summary",
Summary),
tabPanel("Global barplot",
histo),
tabPanel("Filtered barplot",
histFocus),
tabPanel("Barplot",
barplot),
tabPanel("Heatmap",
heatmap),
tabPanel("Rarefaction curves",
......
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