Une mise-à-jour de Gitlab vers la version 14.0 est prévue le 24 juin entre 14:00 et 15:00. Le service sera inaccessible ou instable pendant cette période. Merci de votre compréhension.

Commit 197c12a1 authored by Midoux Cedric's avatar Midoux Cedric
Browse files

rework rarefactionCurve with shinymeta

parent 232c0c2e
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({ output$rarefactionCurveUI <- renderUI({
validate(need(data16S(), "")) validate(need(physeq(), ""))
box( box(
title = "Setting : " , title = "Setting : " ,
width = NULL, width = NULL,
status = "primary", status = "primary",
# sliderInput(
# "rarefactionStep",
# label = "Etapes de calcul : ",
# min = 1,
# max = 1000,
# value = 100
# ),
checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE), checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE),
textInput("rarefactionTitle", textInput("rarefactionTitle",
label = "Title : ", label = "Title : ",
...@@ -41,56 +11,60 @@ output$rarefactionCurveUI <- renderUI({ ...@@ -41,56 +11,60 @@ output$rarefactionCurveUI <- renderUI({
selectInput( selectInput(
"rarefactionColor", "rarefactionColor",
label = "Color : ", label = "Color : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(physeq()))
), ),
selectInput( selectInput(
"rarefactionLabel", "rarefactionLabel",
label = "Label : ", label = "Label : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(physeq()))
), ),
selectInput( selectInput(
"rarefactionGrid", "rarefactionGrid",
label = "Subplot : ", label = "Subplot : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(physeq()))
), )
collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode")
) )
}) })
output$rarefactionCurveScript <- renderText({ output$rarefactionCurve <- metaRender2(renderPlot, {
scriptArgs <- c("physeq = data", validate(need(physeq(), "Requires an abundance dataset"))
"step = 100", data <- physeq()
"se = FALSE")
if (!is.null(checkNull(input$rarefactionColor))) { rarefactionMin <- if (input$rarefactionMin) {
scriptArgs <- metaExpr({
c(scriptArgs, geom_vline(xintercept = min(sample_sums(data)), color = "gray60")
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, rarefactionGrid <- if (!is.null(checkNull(input$rarefactionGrid))) {
glue("p <- p + ggtitle({input$rarefactionTitle})")) 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()
)
)
}
)
rarefactionCurve <- fluidPage(withLoader(plotOutput("rarefactionCurve", height = 700)), rarefactionCurve <- fluidPage(outputCodeButton(withLoader(plotOutput("rarefactionCurve", height = 700))),
uiOutput("rarefactionCurveUI")) uiOutput("rarefactionCurveUI"))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment