diff --git a/panels/tree-server.R b/panels/tree-server.R index d3fc839a0078eaa321b4d5456ee944e7a396db8c..8e0e832bd9fb33e093a7bf5a9befe183f0a907fd 100644 --- a/panels/tree-server.R +++ b/panels/tree-server.R @@ -1,5 +1,5 @@ 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() + ) + ) + } +) diff --git a/panels/tree-ui.R b/panels/tree-ui.R index cbc51f5d65f6faa056dc4ff1622bb08aa31f9b5e..13b52021e255d33b20ee7d27a39333fa1804ff2c 100644 --- a/panels/tree-ui.R +++ b/panels/tree-ui.R @@ -1,2 +1,2 @@ -tree <- fluidPage(withLoader(plotOutput("tree", height = 700)), - uiOutput("treeUI")) +tree <- fluidPage(outputCodeButton(withLoader(plotOutput("tree", height = 700))), + uiOutput("treeUI")) diff --git a/ui.R b/ui.R index 3f1e3fb14b862023ced1d4da9a5f96de1b622c39..2646836b52ba997a916022ca6a5d77d5db68bb6d 100644 --- a/ui.R +++ b/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")) )),