diff --git a/panels/mds-server.R b/panels/mds-server.R index d07f185f7f4bc5bbd014c2df465c21087907e040..20d6546c9888a2895f2d0351c1ed5c10b1fa6c92 100644 --- a/panels/mds-server.R +++ b/panels/mds-server.R @@ -1,5 +1,5 @@ output$mdsUI <- renderUI({ - validate(need(data16S(), "")) + validate(need(physeq(), "")) box( title = "Setting : " , width = NULL, @@ -37,85 +37,65 @@ output$mdsUI <- renderUI({ selectInput( "mdsLabel", label = "Label : ", - choices = c("..." = 0, sample_variables(data16S())) + choices = c("..." = 0, sample_variables(physeq())) ), selectInput( "mdsCol", label = "Color : ", - choices = c("..." = 0, sample_variables(data16S())) + choices = c("..." = 0, sample_variables(physeq())) ), selectInput( "mdsShape", label = "Shape : ", - choices = c("..." = 0, sample_variables(data16S())) + choices = c("..." = 0, sample_variables(physeq())) ), selectInput( "mdsEllipse", label = "Ellipses : ", - choices = c("..." = 0, sample_variables(data16S())) - ), - collapsedBox(verbatimTextOutput("mdsScript"), title = "RCode") + choices = c("..." = 0, sample_variables(physeq())) + ) ) }) -output$mdsScript <- renderText({ - scriptArgs <- c( - "physeq = data", - glue("ordination = ordinate(data, method = \"{input$mdsMethod}\", distance = \"{input$mdsDist}\")"), - "type = \"samples\"", - glue("axes = c({glue_collapse(input$mdsAxes, sep = ', ')})") - ) - if (!is.null(checkNull(input$mdsCol))) { - scriptArgs <- c(scriptArgs, glue("color = \"{input$mdsCol}\"")) - } - if (!is.null(checkNull(input$mdsShape))) { - scriptArgs <- c(scriptArgs, glue("shape = \"{input$mdsShape}\"")) - } - if (!is.null(checkNull(input$mdsLabel))) { - scriptArgs <- c(scriptArgs, glue("label = \"{input$mdsLabel}\"")) - } - if (!is.null(checkNull(input$mdsTitle))) { - scriptArgs <- c(scriptArgs, glue("title = \"{input$mdsTitle}\"")) - } - script <- c( - scriptHead, - "# MultiDimensional scaling", - glue("p <- plot_ordination({glue_collapse(scriptArgs, sep=', ')})") - ) - if (!is.null(checkNull(input$mdsEllipse))) { - script <- c( - script, - glue( - "p <- p + stat_ellipse(aes_string(group = \"{input$mdsEllipse}\"))" - ) - ) +output$mds <- metaRender2(renderPlot, { + validate(need(physeq(), "Requires an abundance dataset"), + need(length(input$mdsAxes) == 2, "Requires two projections axes")) + data <- physeq() + + mdsEllipse <- if (!is.null(checkNull(input$mdsEllipse))) { + metaExpr({ + stat_ellipse(aes_string(group = ..(input$mdsEllipse))) + }) } - script <- c(script, "", "plot(p + theme_bw())") - return(glue_collapse(script, sep = "\n")) + metaExpr({ + ord <- ordinate(data, + method = ..(input$mdsMethod), + distance = ..(input$mdsDist)) + p <- plot_ordination( + physeq = data, + ordination = ord, + type = "samples", + axes = ..(as.numeric(input$mdsAxes)), + color = ..(checkNull(input$mdsCol)), + shape = ..(checkNull(input$mdsShape)), + label = ..(checkNull(input$mdsLabel)), + title = ..(checkNull(input$mdsTitle)) + ) + p <- p + ..(mdsEllipse) + p + theme_bw() + }) }) -output$mds <- renderPlot({ - validate( - need(data16S(), "Requires an abundance dataset"), - need(length(input$mdsAxes) == 2, "Requires two projections axes") - ) - p <- plot_ordination( - data16S(), - ordination = ordinate( - data16S(), - method = input$mdsMethod, - distance = input$mdsDist - ), - type = "samples", - axes = as.numeric(input$mdsAxes), - color = checkNull(input$mdsCol), - shape = checkNull(input$mdsShape), - label = checkNull(input$mdsLabel), - title = checkNull(input$mdsTitle) - ) - if (!is.null(checkNull(input$mdsEllipse))) { - p <- p + stat_ellipse(aes_string(group = input$mdsEllipse)) - } - return(p + theme_bw()) -}) +observeEvent(input$mds_output_code, + { + displayCodeModal( + expandChain( + quote(library(phyloseq)), + quote(library(phyloseq.extended)), + "# Replace `data` with you own data.", + output$mds() + ) + ) + } +) diff --git a/panels/mds-ui.R b/panels/mds-ui.R index 76497f04094813db13688d90097da271bef4055f..466cc73e3bb594bb355ceebe61081599de2a3563 100644 --- a/panels/mds-ui.R +++ b/panels/mds-ui.R @@ -1,2 +1,2 @@ -mds <- fluidPage(withLoader(plotOutput("mds", height = 700)), - uiOutput("mdsUI")) +mds <- fluidPage(outputCodeButton(withLoader(plotOutput("mds", height = 700))), + uiOutput("mdsUI")) diff --git a/ui.R b/ui.R index f1d4bb75905bc2d9e12faa53b27388116cd46260..a2edcbaa5f1f7476e866d51baed923e49ef137df 100644 --- a/ui.R +++ b/ui.R @@ -35,7 +35,7 @@ dashboardHeader(title = "Easy16S"), menuItem("Rarefaction curves", tabName = "rarefactionCurve", icon = icon("chart-line")), menuItem(HTML("α-diversity"), tabName = "richnessA", icon = icon("dashboard")), menuItem(HTML("β-diversity"), tabName = "richnessB", icon = icon("dashboard")), - menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dashboard")), + menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("spinner")), menuItem("PCA", tabName = "pca", icon = icon("dashboard")), menuItem("Phylogenetic tree", tabName = "tree", icon = icon("dashboard")), menuItem("Clustering", tabName = "cluster", icon = icon("dashboard")),