richnessBScript

server.R

@@ -578,13 +578,8 @@ shinyServer
     script <- c(script, "", "# Tables")
     script <- c(
       script,
-      glue(
-        "t <- estimate_richness({glue_collapse(c(\"data\", measures), sep=', ')})"
-      )
-    )
-    script <-
-      c(script,
-        "write.table(t, file = \"richness.tsv\", sep = \"\\t\", col.names = NA)")
+      glue("t <- estimate_richness({glue_collapse(c(\"data\", measures), sep=', ')})"),
+      "write.table(t, file = \"richness.tsv\", sep = \"\\t\", col.names = NA)")
     
     return(glue_collapse(script, sep = "\n"))
   })
@@ -632,10 +627,64 @@ shinyServer
       ),
       textInput("richnessBTitle",
                 label = "Title : ",
-                value = "Beta diversity heatmap")
+                value = "Beta diversity heatmap"),
+      collapsedBox(verbatimTextOutput("richnessBScript"), title = "RCode")
     )
   })
   
+  output$richnessBScript <- renderText({
+    script <- c(
+      scriptHead,
+      "# Plot heatmap of beta diversity",
+      glue(
+        "beta <- melt(as(distance(data, method = \"{input$richnessBDist}\"), \"matrix\"))"
+      ),
+      "colnames(beta) <- c(\"x\", \"y\", \"distance\")"
+    )
+    if (!is.null(checkNull(input$richnessBOrder))) {
+      script <- c(
+        script,
+        glue(
+          "new_factor = as.factor(get_variable(data, \"{input$richnessBOrder}\"))"
+        ),
+        glue(
+          "variable_sort <- as.factor(get_variable(data, \"{input$richnessBOrder}\")[order(new_factor)])"
+        ),
+        "L = levels(reorder(sample_names(data), as.numeric(new_factor)))",
+        "beta$x <- factor(beta$x, levels = L)",
+        "beta$y <- factor(beta$y, levels = L)",
+        "palette <- hue_pal()(length(levels(new_factor)))",
+        "tipColor <- col_factor(palette, levels = levels(new_factor))(variable_sort)"
+      )
+    } else {
+      script <- c(script, "tipColor <- NULL")
+    }
+    script <-
+      c(script,
+        "",
+        "p1 <- ggplot(beta, aes(x = x, y = y, fill = distance))",
+        "p1 <- p1 + geom_tile()")
+    if (!is.null(checkNull(input$richnessBTitle))) {
+      script <- c(script,
+                  glue("p1 <- p1 + ggtitle(\"{input$richnessBTitle}\")"))
+    }
+    script <- c(
+      script,
+      glue(
+        "p1 <- p1 + theme(axis.text.x = element_text(angle = 90, hjust = 1, color = tipColor), axis.text.y = element_text(color = tipColor), axis.title.x = element_blank(), axis.title.y = element_blank())"
+      )
+    )
+    script <- c(script, "", "plot(p1 + scale_fill_gradient2())")
+    script <- c(script, "", "# Tables")
+    script <- c(
+      script,
+      glue("t <- distance(data, method = \"{input$richnessBDist}\")"),
+      "write.table(t, file = \"distance.tsv\", sep = \"\\t\", col.names = NA)"
+    )
+    
+    return(glue_collapse(script, sep = "\n"))
+  })
+  
   output$richnessB <- renderPlot({
     validate(need(data16S(),
                   "Requires an abundance dataset"))
@@ -816,7 +865,7 @@ shinyServer
     }
     script <- c(
       scriptHead,
-      "# Plot filtered barplot",
+      "# Plot rarefaction curves",
       glue("p <- ggrare({glue_collapse(scriptArgs, sep=', ')})")
     )
     if (!is.null(checkNull(input$rarefactionGrid))) {