rework rarefactionCurve with shinymeta

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(), ""))
+  validate(need(physeq(), ""))
   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 : ",
@@ -41,56 +11,60 @@ output$rarefactionCurveUI <- renderUI({
     selectInput(
       "rarefactionColor",
       label = "Color : ",
-      choices = c("..." = 0, sample_variables(data16S()))
+      choices = c("..." = 0, sample_variables(physeq()))
     ),
     selectInput(
       "rarefactionLabel",
       label = "Label : ",
-      choices = c("..." = 0, sample_variables(data16S()))
+      choices = c("..." = 0, sample_variables(physeq()))
     ),
     selectInput(
       "rarefactionGrid",
       label = "Subplot : ",
-      choices = c("..." = 0, sample_variables(data16S()))
-    ),
-    collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode")
+      choices = c("..." = 0, sample_variables(physeq()))
+    )
   )
 })
 
-output$rarefactionCurveScript <- renderText({
-  scriptArgs <- c("physeq = data",
-                  "step = 100",
-                  "se = FALSE")
-  if (!is.null(checkNull(input$rarefactionColor))) {
-    scriptArgs <-
-      c(scriptArgs,
-        glue("color = \"{input$rarefactionColor}\""))
+output$rarefactionCurve <- metaRender2(renderPlot, {
+  validate(need(physeq(), "Requires an abundance dataset"))
+  data <- physeq()
+
+  rarefactionMin <- if (input$rarefactionMin) {
+    metaExpr({
+      geom_vline(xintercept = min(sample_sums(data)), color = "gray60")
+    })
   }
-  if (!is.null(checkNull(input$rarefactionLabel))) {
-    scriptArgs <-
-      c(scriptArgs,
-        glue("label = \"{input$rarefactionLabel}\""))
+  
+  rarefactionGrid <- if (!is.null(checkNull(input$rarefactionGrid))) {
+    metaExpr({
+      facet_grid(..(paste(".", "~", input$rarefactionGrid)), scales = "free_x")
+    })
   }
-  script <- c(
-    scriptHead,
-    "# Plot rarefaction curves",
-    glue("p <- ggrare({glue_collapse(scriptArgs, sep=', ')})")
+  
+  metaExpr({
+    p <- ggrare(
+      physeq = data,
+      step = 100,
+      color = ..(checkNull(input$rarefactionColor)),
+      label = ..(checkNull(input$rarefactionLabel)),
+      se = FALSE
+      )
+    p <- p + ..(rarefactionMin)
+    p <- p + ..(rarefactionGrid)
+    p + ggtitle(..(input$rarefactionTitle))
+  })
+})
+
+observeEvent(input$rarefactionCurve_output_code,
+             {
+               displayCodeModal(
+                 expandChain(
+                   quote(library(phyloseq)),
+                   quote(library(phyloseq.extended)),
+                   "# Replace `data` with you own data.",
+                   output$rarefactionCurve()
                  )
-  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)),
+rarefactionCurve <- fluidPage(outputCodeButton(withLoader(plotOutput("rarefactionCurve", height = 700))),
                               uiOutput("rarefactionCurveUI"))