rework barplot

panels/histoFocus-server.R → panels/barplot-server.R

-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)
 })

panels/barplot-ui.R

+barplot <-fluidPage(withLoader(plotOutput("barplot", height = 700)),
+                      uiOutput("barplotUI"))

panels/histo-server.R

-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)
-})

panels/histo-ui.R

-histo <- fluidPage(withLoader(plotOutput("histo", height = 700)),uiOutput("histUI"))

panels/histoFocus-ui.R

-histFocus <-fluidPage(withLoader(plotOutput("histFocus", height = 700)),
-                      uiOutput("histFocusUI"))

server.R

@@ -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)

ui.R

@@ -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",