panels/rarefactionCurve

panels/rarefactionCurve-server.R

+output$rarefactionCurve <- renderPlot({
+  validate(need(data16S(),
+                "Requires an abundance dataset"))
+  p <- ggrare(
+    physeq = data16S(),
+    step = 100,
+    #step = input$rarefactionStep,
+    color = checkNull(input$rarefactionColor),
+    label = checkNull(input$rarefactionLabel),
+    se = FALSE
+  )
+  if (!is.null(checkNull(input$rarefactionGrid))) {
+    p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
+  }
+  
+  if (input$rarefactionMin) {
+    p <-
+      p + geom_vline(xintercept = min(sample_sums(data16S())),
+                     color = "gray60")
+  }
+  return(p + ggtitle(input$rarefactionTitle))
+})
+
+output$rarefactionCurveUI <- renderUI({
+  validate(need(data16S(), ""))
+  box(
+    title = "Setting : " ,
+    width = NULL,
+    status = "primary",
+    # sliderInput(
+    #   "rarefactionStep",
+    #   label = "Etapes de calcul : ",
+    #   min = 1,
+    #   max = 1000,
+    #   value = 100
+    # ),
+    checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE),
+    textInput("rarefactionTitle",
+              label = "Title : ",
+              value = "Rarefaction curves"),
+    selectInput(
+      "rarefactionColor",
+      label = "Color : ",
+      choices = c("..." = 0, sample_variables(data16S()))
+    ),
+    selectInput(
+      "rarefactionLabel",
+      label = "Label : ",
+      choices = c("..." = 0, sample_variables(data16S()))
+    ),
+    selectInput(
+      "rarefactionGrid",
+      label = "Subplot : ",
+      choices = c("..." = 0, sample_variables(data16S()))
+    ),
+    collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode")
+  )
+})
+
+output$rarefactionCurveScript <- renderText({
+  scriptArgs <- c("physeq = data",
+                  "step = 100",
+                  "se = FALSE")
+  if (!is.null(checkNull(input$rarefactionColor))) {
+    scriptArgs <-
+      c(scriptArgs,
+        glue("color = \"{input$rarefactionColor}\""))
+  }
+  if (!is.null(checkNull(input$rarefactionLabel))) {
+    scriptArgs <-
+      c(scriptArgs,
+        glue("label = \"{input$rarefactionLabel}\""))
+  }
+  script <- c(
+    scriptHead,
+    "# Plot rarefaction curves",
+    glue("p <- ggrare({glue_collapse(scriptArgs, sep=', ')})")
+  )
+  if (!is.null(checkNull(input$rarefactionGrid))) {
+    script <- c(script,
+                glue("p <- p + facet_grid(\". ~ {input$rarefactionGrid}\")"))
+  }
+  if (input$rarefactionMin) {
+    script = c(
+      script,
+      "p <- p + geom_vline(xintercept = min(sample_sums(data)), color = \"gray60\")"
+    )
+  }
+  if (!is.null(checkNull(input$rarefactionTitle))) {
+    script <- c(script,
+                glue("p <- p + ggtitle({input$rarefactionTitle})"))
+  }
+  script <- c(script, "", "plot(p)")
+  
+  return(glue_collapse(script, sep = "\n"))
+})

panels/rarefactionCurve-ui.R

+rarefactionCurve <- fluidPage(withLoader(plotOutput("rarefactionCurve", height = 700)),
+                              uiOutput("rarefactionCurveUI"))

panels/tree-ui.R

-tree <- fluidPage(
+tree <- fluidPage(withLoader(plotOutput("tree", height = 700)),
+                  uiOutput("treeUI"))

server.R

@@ -11,7 +11,8 @@ shinyServer
   source("panels/histo-server.R", local = TRUE)
   source("panels/histoFocus-server.R", local = TRUE)
   source("panels/heatmap-server.R", local = TRUE)
-  source("panels/tree.R", local = TRUE)
+  source("panels/rarefactionCurve-server.R", local = TRUE)
+  source("panels/tree-server.R", local = TRUE)
   
   checkNull <- function(x) {
     if (!exists(as.character(substitute(x)))) {
@@ -668,103 +669,6 @@ shinyServer
     )))
   })
   
-  output$rarefactionCurve <- renderPlot({
-    validate(need(data16S(),
-                  "Requires an abundance dataset"))
-    p <- ggrare(
-      physeq = data16S(),
-      step = 100,
-      #step = input$rarefactionStep,
-      color = checkNull(input$rarefactionColor),
-      label = checkNull(input$rarefactionLabel),
-      se = FALSE
-    )
-    if (!is.null(checkNull(input$rarefactionGrid))) {
-      p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
-    }
-    
-    if (input$rarefactionMin) {
-      p <-
-        p + geom_vline(xintercept = min(sample_sums(data16S())),
-                       color = "gray60")
-    }
-    return(p + ggtitle(input$rarefactionTitle))
-  })
-  
-  output$rarefactionCurveUI <- renderUI({
-    validate(need(data16S(), ""))
-    box(
-      title = "Setting : " ,
-      width = NULL,
-      status = "primary",
-      # sliderInput(
-      #   "rarefactionStep",
-      #   label = "Etapes de calcul : ",
-      #   min = 1,
-      #   max = 1000,
-      #   value = 100
-      # ),
-      checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE),
-      textInput("rarefactionTitle",
-                label = "Title : ",
-                value = "Rarefaction curves"),
-      selectInput(
-        "rarefactionColor",
-        label = "Color : ",
-        choices = c("..." = 0, sample_variables(data16S()))
-      ),
-      selectInput(
-        "rarefactionLabel",
-        label = "Label : ",
-        choices = c("..." = 0, sample_variables(data16S()))
-      ),
-      selectInput(
-        "rarefactionGrid",
-        label = "Subplot : ",
-        choices = c("..." = 0, sample_variables(data16S()))
-      ),
-      collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode")
-    )
-  })
-  
-  output$rarefactionCurveScript <- renderText({
-    scriptArgs <- c("physeq = data",
-                    "step = 100",
-                    "se = FALSE")
-    if (!is.null(checkNull(input$rarefactionColor))) {
-      scriptArgs <-
-        c(scriptArgs,
-          glue("color = \"{input$rarefactionColor}\""))
-    }
-    if (!is.null(checkNull(input$rarefactionLabel))) {
-      scriptArgs <-
-        c(scriptArgs,
-          glue("label = \"{input$rarefactionLabel}\""))
-    }
-    script <- c(
-      scriptHead,
-      "# Plot rarefaction curves",
-      glue("p <- ggrare({glue_collapse(scriptArgs, sep=', ')})")
-    )
-    if (!is.null(checkNull(input$rarefactionGrid))) {
-      script <- c(script,
-                  glue("p <- p + facet_grid(\". ~ {input$rarefactionGrid}\")"))
-    }
-    if (input$rarefactionMin) {
-      script = c(
-        script,
-        "p <- p + geom_vline(xintercept = min(sample_sums(data)), color = \"gray60\")"
-      )
-    }
-    if (!is.null(checkNull(input$rarefactionTitle))) {
-      script <- c(script,
-                  glue("p <- p + ggtitle({input$rarefactionTitle})"))
-    }
-    script <- c(script, "", "plot(p)")
-    
-    return(glue_collapse(script, sep = "\n"))
-  })
-  
   output$mdsUI <- renderUI({
     validate(need(data16S(), ""))
     box(

ui.R

@@ -3,6 +3,7 @@ library(shinycustomloader)
 source("panels/histo-ui.R", local = TRUE)
 source("panels/histoFocus-ui.R", local = TRUE)
 source("panels/heatmap-ui.R", local = TRUE)
+source("panels/rarefactionCurve-ui.R", local = TRUE)
 source("panels/tree-ui.R", local = TRUE)
 
 shinyUI(dashboardPage(
@@ -110,11 +111,8 @@ shinyUI(dashboardPage(
                histFocus),
       tabPanel("Heatmap",
                heatmap),
-      tabPanel(
-        "Rarefaction curves",
-        withLoader(plotOutput("rarefactionCurve", height = 700)),
-        uiOutput("rarefactionCurveUI")
-      ),
+      tabPanel("Rarefaction curves",
+               rarefactionCurve),
       tabPanel(HTML("α-diversity"),
                box(
                  width = NULL, tabsetPanel(
@@ -162,8 +160,7 @@ shinyUI(dashboardPage(
                withLoader(plotOutput("pca", height = 700)),
                uiOutput("pcaUI")),
       tabPanel("Phylogenetic tree",
-               tree)
-      ),
+               tree),
       tabPanel("Clustering",
                withLoader(plotOutput("clust", height = 700)),
                uiOutput("clustUI")),