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

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({
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()
)
)
}
)
rarefactionCurve <- fluidPage(withLoader(plotOutput("rarefactionCurve", height = 700)),
rarefactionCurve <- fluidPage(outputCodeButton(withLoader(plotOutput("rarefactionCurve", height = 700))),
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