diff --git a/panels/rarefactionCurve-server.R b/panels/rarefactionCurve-server.R new file mode 100644 index 0000000000000000000000000000000000000000..14d0bb2d1d61e4a086991e38ad595cb363e5ea77 --- /dev/null +++ b/panels/rarefactionCurve-server.R @@ -0,0 +1,96 @@ +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(), "")) + 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 : ", + value = "Rarefaction curves"), + selectInput( + "rarefactionColor", + label = "Color : ", + choices = c("..." = 0, sample_variables(data16S())) + ), + selectInput( + "rarefactionLabel", + label = "Label : ", + choices = c("..." = 0, sample_variables(data16S())) + ), + selectInput( + "rarefactionGrid", + label = "Subplot : ", + choices = c("..." = 0, sample_variables(data16S())) + ), + collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode") + ) +}) + +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\")" + ) + } + if (!is.null(checkNull(input$rarefactionTitle))) { + script <- c(script, + glue("p <- p + ggtitle({input$rarefactionTitle})")) + } + script <- c(script, "", "plot(p)") + + return(glue_collapse(script, sep = "\n")) +}) diff --git a/panels/rarefactionCurve-ui.R b/panels/rarefactionCurve-ui.R new file mode 100644 index 0000000000000000000000000000000000000000..dccd7a0dfc163b09fc7ff8c384b92d12445d4194 --- /dev/null +++ b/panels/rarefactionCurve-ui.R @@ -0,0 +1,2 @@ +rarefactionCurve <- fluidPage(withLoader(plotOutput("rarefactionCurve", height = 700)), + uiOutput("rarefactionCurveUI")) diff --git a/panels/tree-ui.R b/panels/tree-ui.R index 8d95666d8b4e10b355fe9ad53410b1e74ad7a23f..cbc51f5d65f6faa056dc4ff1622bb08aa31f9b5e 100644 --- a/panels/tree-ui.R +++ b/panels/tree-ui.R @@ -1 +1,2 @@ -tree <- fluidPage( +tree <- fluidPage(withLoader(plotOutput("tree", height = 700)), + uiOutput("treeUI")) diff --git a/server.R b/server.R index a3ee89b9840702e5b193a730f08831877624151a..96fd10adad4d8cd83743e6274eb80d6a96cb9518 100644 --- a/server.R +++ b/server.R @@ -11,7 +11,8 @@ shinyServer source("panels/histo-server.R", local = TRUE) source("panels/histoFocus-server.R", local = TRUE) source("panels/heatmap-server.R", local = TRUE) - source("panels/tree.R", local = TRUE) + source("panels/rarefactionCurve-server.R", local = TRUE) + source("panels/tree-server.R", local = TRUE) checkNull <- function(x) { if (!exists(as.character(substitute(x)))) { @@ -668,103 +669,6 @@ shinyServer ))) }) - 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(), "")) - 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 : ", - value = "Rarefaction curves"), - selectInput( - "rarefactionColor", - label = "Color : ", - choices = c("..." = 0, sample_variables(data16S())) - ), - selectInput( - "rarefactionLabel", - label = "Label : ", - choices = c("..." = 0, sample_variables(data16S())) - ), - selectInput( - "rarefactionGrid", - label = "Subplot : ", - choices = c("..." = 0, sample_variables(data16S())) - ), - collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode") - ) - }) - - 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\")" - ) - } - if (!is.null(checkNull(input$rarefactionTitle))) { - script <- c(script, - glue("p <- p + ggtitle({input$rarefactionTitle})")) - } - script <- c(script, "", "plot(p)") - - return(glue_collapse(script, sep = "\n")) - }) - output$mdsUI <- renderUI({ validate(need(data16S(), "")) box( diff --git a/ui.R b/ui.R index b1d8caec368dc16c6e3d3203613676305f2cc9ba..aee95c38f498028a8f9d32556a357173471529d0 100644 --- a/ui.R +++ b/ui.R @@ -3,6 +3,7 @@ library(shinycustomloader) source("panels/histo-ui.R", local = TRUE) source("panels/histoFocus-ui.R", local = TRUE) source("panels/heatmap-ui.R", local = TRUE) +source("panels/rarefactionCurve-ui.R", local = TRUE) source("panels/tree-ui.R", local = TRUE) shinyUI(dashboardPage( @@ -110,11 +111,8 @@ shinyUI(dashboardPage( histFocus), tabPanel("Heatmap", heatmap), - tabPanel( - "Rarefaction curves", - withLoader(plotOutput("rarefactionCurve", height = 700)), - uiOutput("rarefactionCurveUI") - ), + tabPanel("Rarefaction curves", + rarefactionCurve), tabPanel(HTML("α-diversity"), box( width = NULL, tabsetPanel( @@ -162,8 +160,7 @@ shinyUI(dashboardPage( withLoader(plotOutput("pca", height = 700)), uiOutput("pcaUI")), tabPanel("Phylogenetic tree", - tree) - ), + tree), tabPanel("Clustering", withLoader(plotOutput("clust", height = 700)), uiOutput("clustUI")),