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