rework beta-cluster with shinymeta

panels/cluster-server.R

-output$clustUI <- renderUI({
-  validate(need(data16S(), ""))
-  box(
-    title = "Setting : " ,
-    width = NULL,
-    status = "primary",
-    selectInput(
-      "clustDist",
-      label = "Distance : ",
-      choices = list(
-        "bray",
-        "jaccard",
-        "unifrac",
-        "wunifrac",
-        "dpcoa",
-        "jsd",
-        "euclidean"
-      )
-    ),
-    selectInput(
-      "clustMethod",
-      label = "Method : ",
-      choices = list(
-        "ward.D2",
-        "ward.D",
-        "single",
-        "complete",
-        "average",
-        "mcquitty",
-        "median",
-        "centroid"
-      )
-    ),
-    selectInput(
-      "clustCol",
-      label = "Color : ",
-      choices = c("..." = 0, sample_variables(data16S()))
-    ),
-    collapsedBox(verbatimTextOutput("clustScript"), title = "RCode")
-  )
-})
-
-output$clustScript <- renderText({
-  scriptArgs <- c(
-    "physeq = data",
-    glue("dist = \"{input$clustDist}\""),
-    glue("method = \"{input$clustMethod}\"")
-  )
-  if (!is.null(checkNull(input$clustCol))) {
-    scriptArgs <- c(scriptArgs, glue("color = \"{input$clustCol}\""))
-  }
-  script <- c(
-    scriptHead,
-    "# Plot samples clustering",
-    glue("p <- plot_clust({glue_collapse(scriptArgs, sep=', ')})")
-  )
-  script <- c(script, "", "plot(p)")
-  
-  return(glue_collapse(script, sep = "\n"))
-})
-
-output$clust <- renderPlot({
-  validate(need(data16S(),
-                "Requires an abundance dataset"))
-  plot_clust(
-    physeq = data16S(),
-    dist = input$clustDist,
-    method = input$clustMethod,
-    color = checkNull(input$clustCol)
-  )
-})

panels/cluster-ui.R

-cluster <- fluidPage(withLoader(plotOutput("clust", height = 700)),
-                     uiOutput("clustUI"))

panels/richnessB-server.R

-# output$betaClusterUI
-# output$betaCluster
+output$betaClusterUI <- renderUI({
+  validate(need(physeq(), ""))
+  box(
+    title = "Setting : " ,
+    width = NULL,
+    status = "primary",
+    selectInput("betaClusterMethod",
+                label = "Method : ",
+                choices = list("ward.D2", "ward.D", "single", "complete", "average", "mcquitty", "median", "centroid")),
+    selectInput("betaClusterCol",
+                label = "Color : ",
+                choices = c("..." = 0, sample_variables(physeq())))
+  )
+})
+
+
+output$betaCluster <- metaRender2(renderPlot, {
+  validate(need(physeq(), "Requires an abundance dataset"))
+  data <- physeq()
+  
+  metaExpr({
+    p <- plot_clust(physeq = data,
+                    dist = ..(input$betaDistance),
+                    method = ..(input$betaClusterMethod),
+                    color = ..(checkNull(input$betaClusterCol))
+                    )
+    p
+  })
+})
+
+observeEvent(input$betaCluster_output_code,
+             {
+               displayCodeModal(
+                 expandChain(
+                   quote(library(phyloseq)),
+                   quote(library(phyloseq.extended)),
+                   "# Replace `data` with you own data.",
+                   output$betaCluster()
+                 )
+               )
+             }
+)
 
 output$betaHeatmapUI <- renderUI({
   validate(need(physeq(), ""))

server.R

@@ -24,7 +24,6 @@ shinyServer
   source("panels/mds-server.R", local = TRUE)
   source("panels/pca-server.R", local = TRUE)
   source("panels/tree-server.R", local = TRUE)
-  source("panels/cluster-server.R", local = TRUE)
 
   physeq <- reactiveVal()
 

ui.R

@@ -10,7 +10,6 @@ source("panels/richnessB-ui.R", local = TRUE)
 source("panels/mds-ui.R", local = TRUE)
 source("panels/pca-ui.R", local = TRUE)
 source("panels/tree-ui.R", local = TRUE)
-source("panels/cluster-ui.R", local = TRUE)
 source("panels/Help-ui.R", local = TRUE)
 
 shinyUI(dashboardPage(