Commit 9cbef098 authored by Midoux Cedric's avatar Midoux Cedric

panels/rarefactionCurve

parent 27619157
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"))
})
rarefactionCurve <- fluidPage(withLoader(plotOutput("rarefactionCurve", height = 700)),
uiOutput("rarefactionCurveUI"))
tree <- fluidPage(
tree <- fluidPage(withLoader(plotOutput("tree", height = 700)),
uiOutput("treeUI"))
......@@ -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(
......
......@@ -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("&alpha;-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")),
......
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