diff --git a/panels/rarefactionCurve-server.R b/panels/rarefactionCurve-server.R index 14d0bb2d1d61e4a086991e38ad595cb363e5ea77..90dba9bac18b5404c58d25680670896db4854793 100644 --- a/panels/rarefactionCurve-server.R +++ b/panels/rarefactionCurve-server.R @@ -1,39 +1,9 @@ -output$rarefactionCurve <- renderPlot({ - validate(need(data16S(), - "Requires an abundance dataset")) - p <- ggrare( - physeq = data16S(), - step = 100, - #step = input$rarefactionStep, - color = checkNull(input$rarefactionColor), - label = checkNull(input$rarefactionLabel), - se = FALSE - ) - if (!is.null(checkNull(input$rarefactionGrid))) { - p <- p + facet_grid(paste(".", "~", input$rarefactionGrid)) - } - - if (input$rarefactionMin) { - p <- - p + geom_vline(xintercept = min(sample_sums(data16S())), - color = "gray60") - } - return(p + ggtitle(input$rarefactionTitle)) -}) - output$rarefactionCurveUI <- renderUI({ - validate(need(data16S(), "")) + validate(need(physeq(), "")) box( title = "Setting : " , width = NULL, status = "primary", - # sliderInput( - # "rarefactionStep", - # label = "Etapes de calcul : ", - # min = 1, - # max = 1000, - # value = 100 - # ), checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE), textInput("rarefactionTitle", label = "Title : ", @@ -41,56 +11,60 @@ output$rarefactionCurveUI <- renderUI({ selectInput( "rarefactionColor", label = "Color : ", - choices = c("..." = 0, sample_variables(data16S())) + choices = c("..." = 0, sample_variables(physeq())) ), selectInput( "rarefactionLabel", label = "Label : ", - choices = c("..." = 0, sample_variables(data16S())) + choices = c("..." = 0, sample_variables(physeq())) ), selectInput( "rarefactionGrid", label = "Subplot : ", - choices = c("..." = 0, sample_variables(data16S())) - ), - collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode") + choices = c("..." = 0, sample_variables(physeq())) + ) ) }) -output$rarefactionCurveScript <- renderText({ - scriptArgs <- c("physeq = data", - "step = 100", - "se = FALSE") - if (!is.null(checkNull(input$rarefactionColor))) { - scriptArgs <- - c(scriptArgs, - glue("color = \"{input$rarefactionColor}\"")) - } - if (!is.null(checkNull(input$rarefactionLabel))) { - scriptArgs <- - c(scriptArgs, - glue("label = \"{input$rarefactionLabel}\"")) - } - script <- c( - scriptHead, - "# Plot rarefaction curves", - glue("p <- ggrare({glue_collapse(scriptArgs, sep=', ')})") - ) - if (!is.null(checkNull(input$rarefactionGrid))) { - script <- c(script, - glue("p <- p + facet_grid(\". ~ {input$rarefactionGrid}\")")) - } - if (input$rarefactionMin) { - script = c( - script, - "p <- p + geom_vline(xintercept = min(sample_sums(data)), color = \"gray60\")" - ) +output$rarefactionCurve <- metaRender2(renderPlot, { + validate(need(physeq(), "Requires an abundance dataset")) + data <- physeq() + + rarefactionMin <- if (input$rarefactionMin) { + metaExpr({ + geom_vline(xintercept = min(sample_sums(data)), color = "gray60") + }) } - if (!is.null(checkNull(input$rarefactionTitle))) { - script <- c(script, - glue("p <- p + ggtitle({input$rarefactionTitle})")) + + rarefactionGrid <- if (!is.null(checkNull(input$rarefactionGrid))) { + metaExpr({ + facet_grid(..(paste(".", "~", input$rarefactionGrid)), scales = "free_x") + }) } - script <- c(script, "", "plot(p)") - return(glue_collapse(script, sep = "\n")) + metaExpr({ + p <- ggrare( + physeq = data, + step = 100, + color = ..(checkNull(input$rarefactionColor)), + label = ..(checkNull(input$rarefactionLabel)), + se = FALSE + ) + p <- p + ..(rarefactionMin) + p <- p + ..(rarefactionGrid) + p + ggtitle(..(input$rarefactionTitle)) + }) }) + +observeEvent(input$rarefactionCurve_output_code, + { + displayCodeModal( + expandChain( + quote(library(phyloseq)), + quote(library(phyloseq.extended)), + "# Replace `data` with you own data.", + output$rarefactionCurve() + ) + ) + } +) diff --git a/panels/rarefactionCurve-ui.R b/panels/rarefactionCurve-ui.R index dccd7a0dfc163b09fc7ff8c384b92d12445d4194..7ee8685f315b325c00108691cb3a2937a8d7e6b0 100644 --- a/panels/rarefactionCurve-ui.R +++ b/panels/rarefactionCurve-ui.R @@ -1,2 +1,2 @@ -rarefactionCurve <- fluidPage(withLoader(plotOutput("rarefactionCurve", height = 700)), +rarefactionCurve <- fluidPage(outputCodeButton(withLoader(plotOutput("rarefactionCurve", height = 700))), uiOutput("rarefactionCurveUI"))