rework tree with shinymeta

panels/tree-server.R

 output$treeUI <- renderUI({
-  validate(need(phy_tree(data16S(), errorIfNULL = FALSE), ""))
+  validate(need(phy_tree(physeq(), errorIfNULL = FALSE), ""))
   box(
     title = "Setting : " ,
     width = NULL,
@@ -7,8 +7,8 @@ output$treeUI <- renderUI({
     radioButtons(
       "treeRank",
       label = "Taxonomic rank captioned : ",
-      choices = c(aucun = "",
-                  rank_names(data16S()),
+      choices = c(None = "",
+                  rank_names(physeq()),
                   OTU = "taxa_names"),
       inline = TRUE
     ),
@@ -16,9 +16,16 @@ output$treeUI <- renderUI({
       "treeTopOtu",
       label = "Show the n most abundant OTU : ",
       min = 1,
-      max = ntaxa(data16S()),
+      max = ntaxa(physeq()),
       value = 20
     ),
+    sliderInput(
+      "treeSize",
+      label = "Abundance size based on a logarithm basis : ",
+      min = 2,
+      max = 10,
+      value = 5
+    ),
     checkboxInput("treeRadial", label = "Radial tree", value = FALSE),
     checkboxInput("treeSample", label = "Show samples", value = TRUE),
     textInput("treeTitle",
@@ -27,85 +34,54 @@ output$treeUI <- renderUI({
     selectInput(
       "treeCol",
       label = "Color : ",
-      choices = c("..." = 0, sample_variables(data16S()))
+      choices = c("..." = 0, sample_variables(physeq()), rank_names(physeq()))
     ),
     selectInput(
       "treeShape",
       label = "Shape : ",
-      choices = c("..." = 0, sample_variables(data16S()))
-    ),
-    collapsedBox(verbatimTextOutput("treeScript"), title = "RCode")
+      choices = c("..." = 0, sample_variables(physeq()), rank_names(physeq()))
+    )
   )
 })
 
-output$treeScript <- renderText({
-  scriptArgs <- c(
-    glue(
-      "physeq = prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$treeTopOtu}]), data)"
-    )
-  )
-  if (input$treeSample) {
-    scriptArgs <- c(scriptArgs, "method = \"sampledodge\"")
-  } else {
-    scriptArgs <- c(scriptArgs, "method = \"treeonly\"")
-  }
-  if (!is.null(checkNull(input$treeCol))) {
-    scriptArgs <- c(scriptArgs, glue("color = \"{input$treeCol}\""))
-  }
-  if (!is.null(checkNull(input$treeShape))) {
-    scriptArgs <- c(scriptArgs, glue("shape = \"{input$treeShape}\""))
-  }
-  scriptArgs <- c(scriptArgs, "size = \"abundance\"")
-  if (!is.null(checkNull(input$treeRank))) {
-    scriptArgs <-
-      c(scriptArgs, glue("label.tips = \"{input$treeRank}\""))
-  }
-  scriptArgs <- c(scriptArgs,
-                  "sizebase = 5",
-                  "ladderize = \"left\"",
-                  "plot.margin = 0")
-  if (!is.null(checkNull(input$treeTitle))) {
-    scriptArgs <- c(scriptArgs, glue("title = \"{input$treeTitle}\""))
-  }
-  script <- c(
-    scriptHead,
-    "# Plot phylogenetic tree",
-    glue("p <- plot_tree({glue_collapse(scriptArgs, sep=', ')})")
-  )
-  if (input$treeRadial) {
-    script <- c(script,
-                "p <- p + coord_polar(theta = \"y\")")
+output$tree <- metaRender2(renderPlot, {
+  validate(need(physeq(), "Requires an abundance dataset"),
+           need(phy_tree(physeq(), errorIfNULL = FALSE), "Requires a phylogenetic tree"))
+  data <- physeq()
+  
+  treeRadial <- if (input$treeRadial) {
+    metaExpr({
+      coord_polar(theta = "y")
+    })
   }
-  script <- c(script, "", "plot(p)")
   
-  return(glue_collapse(script, sep = "\n"))
-})
-
-output$tree <- renderPlot({
-  validate(
-    need(data16S(), "Requires an abundance dataset"),
-    need(
-      phy_tree(data16S(), errorIfNULL = FALSE),
-      "Requires a phylogenetic tree"
+  metaExpr({
+    data_select <- prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:..(input$treeTopOtu)]), data)
+    p <- plot_tree(
+      physeq = data_select,
+      method = ..(ifelse(input$treeSample, "sampledodge", "treeonly")),
+      color = ..(checkNull(input$treeCol)),
+      shape = ..(checkNull(input$treeShape)),
+      size = "abundance",
+      label.tips = ..(checkNull(input$treeRank)),
+      sizebase = ..(checkNull(input$treeSize)),
+      ladderize = "left",
+      plot.margin = 0.1,
+      title = ..(checkNull(input$treeTitle))
     )
-  )
-  p <- plot_tree(
-    physeq = prune_taxa(names(sort(
-      taxa_sums(data16S()), decreasing = TRUE
-    )[1:input$treeTopOtu]), data16S()),
-    method = ifelse(input$treeSample, "sampledodge", "treeonly"),
-    color = checkNull(input$treeCol),
-    shape = checkNull(input$treeShape),
-    size = "abundance",
-    label.tips = checkNull(input$treeRank),
-    sizebase = 5,
-    ladderize = "left",
-    plot.margin = 0,
-    title = checkNull(input$treeTitle)
-  )
-  if (checkNull(input$treeRadial)) {
-    return(p + coord_polar(theta = "y"))
-  } else {
-    return(p)
-  }
+    p + ..(treeRadial)
+  })
 })
+
+observeEvent(input$tree_output_code,
+             {
+               displayCodeModal(
+                 expandChain(
+                   quote(library(phyloseq)),
+                   quote(library(phyloseq.extended)),
+                   "# Replace `data` with you own data.",
+                   output$tree()
+                 )
+               )
+             }
+)

panels/tree-ui.R

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

ui.R

@@ -37,7 +37,7 @@ dashboardHeader(title = "Easy16S"),
       menuItem(HTML("β-diversity"), tabName = "richnessB", icon = icon("dashboard")),
       menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dot-circle")),
       menuItem("PCA", tabName = "pca", icon = icon("bullseye")),
-      menuItem("Phylogenetic tree", tabName = "tree", icon = icon("dashboard")),
+      menuItem("Phylogenetic tree", tabName = "tree", icon = icon("tree")),
       menuItem("Clustering", tabName = "cluster", icon = icon("dashboard")),
       menuItem("Help", tabName = "Help", icon = icon("dashboard"))
   )),