From 8ed00454e4f4f1d67274c1fe3d7ea35e1918c8c2 Mon Sep 17 00:00:00 2001
From: Cedric Midoux <cedric.midoux@inra.fr>
Date: Thu, 13 Sep 2018 17:24:18 +0200
Subject: [PATCH] treeScript
---
server.R | 46 +++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 45 insertions(+), 1 deletion(-)
diff --git a/server.R b/server.R
index 79ee451..4e38f3d 100644
--- a/server.R
+++ b/server.R
@@ -1044,7 +1044,7 @@ shinyServer
})
output$treeUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(phy_tree(data16S(), errorIfNULL = FALSE), ""))
box(
title = "Setting : " ,
width = NULL,
@@ -1078,8 +1078,52 @@ shinyServer
"treeShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S()))
+ ),
+ collapsedBox(verbatimTextOutput("treeScript"), title = "RCode")
+ )
+ })
+
+ 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\")")
+ }
+ script <- c(script, "", "plot(p)")
+
+ return(glue_collapse(script, sep = "\n"))
})
output$tree <- renderPlot({
--
GitLab