Commit ed7f0207 authored by Midoux Cedric's avatar Midoux Cedric

rework mds with shinymeta

parent 79834835
output$mdsUI <- renderUI({
validate(need(data16S(), ""))
validate(need(physeq(), ""))
box(
title = "Setting : " ,
width = NULL,
......@@ -37,85 +37,65 @@ output$mdsUI <- renderUI({
selectInput(
"mdsLabel",
label = "Label : ",
choices = c("..." = 0, sample_variables(data16S()))
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"mdsCol",
label = "Color : ",
choices = c("..." = 0, sample_variables(data16S()))
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"mdsShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S()))
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"mdsEllipse",
label = "Ellipses : ",
choices = c("..." = 0, sample_variables(data16S()))
),
collapsedBox(verbatimTextOutput("mdsScript"), title = "RCode")
choices = c("..." = 0, sample_variables(physeq()))
)
)
})
output$mdsScript <- renderText({
scriptArgs <- c(
"physeq = data",
glue("ordination = ordinate(data, method = \"{input$mdsMethod}\", distance = \"{input$mdsDist}\")"),
"type = \"samples\"",
glue("axes = c({glue_collapse(input$mdsAxes, sep = ', ')})")
)
if (!is.null(checkNull(input$mdsCol))) {
scriptArgs <- c(scriptArgs, glue("color = \"{input$mdsCol}\""))
}
if (!is.null(checkNull(input$mdsShape))) {
scriptArgs <- c(scriptArgs, glue("shape = \"{input$mdsShape}\""))
}
if (!is.null(checkNull(input$mdsLabel))) {
scriptArgs <- c(scriptArgs, glue("label = \"{input$mdsLabel}\""))
}
if (!is.null(checkNull(input$mdsTitle))) {
scriptArgs <- c(scriptArgs, glue("title = \"{input$mdsTitle}\""))
}
script <- c(
scriptHead,
"# MultiDimensional scaling",
glue("p <- plot_ordination({glue_collapse(scriptArgs, sep=', ')})")
)
if (!is.null(checkNull(input$mdsEllipse))) {
script <- c(
script,
glue(
"p <- p + stat_ellipse(aes_string(group = \"{input$mdsEllipse}\"))"
)
)
output$mds <- metaRender2(renderPlot, {
validate(need(physeq(), "Requires an abundance dataset"),
need(length(input$mdsAxes) == 2, "Requires two projections axes"))
data <- physeq()
mdsEllipse <- if (!is.null(checkNull(input$mdsEllipse))) {
metaExpr({
stat_ellipse(aes_string(group = ..(input$mdsEllipse)))
})
}
script <- c(script, "", "plot(p + theme_bw())")
return(glue_collapse(script, sep = "\n"))
metaExpr({
ord <- ordinate(data,
method = ..(input$mdsMethod),
distance = ..(input$mdsDist))
p <- plot_ordination(
physeq = data,
ordination = ord,
type = "samples",
axes = ..(as.numeric(input$mdsAxes)),
color = ..(checkNull(input$mdsCol)),
shape = ..(checkNull(input$mdsShape)),
label = ..(checkNull(input$mdsLabel)),
title = ..(checkNull(input$mdsTitle))
)
p <- p + ..(mdsEllipse)
p + theme_bw()
})
})
output$mds <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
need(length(input$mdsAxes) == 2, "Requires two projections axes")
observeEvent(input$mds_output_code,
{
displayCodeModal(
expandChain(
quote(library(phyloseq)),
quote(library(phyloseq.extended)),
"# Replace `data` with you own data.",
output$mds()
)
p <- plot_ordination(
data16S(),
ordination = ordinate(
data16S(),
method = input$mdsMethod,
distance = input$mdsDist
),
type = "samples",
axes = as.numeric(input$mdsAxes),
color = checkNull(input$mdsCol),
shape = checkNull(input$mdsShape),
label = checkNull(input$mdsLabel),
title = checkNull(input$mdsTitle)
)
if (!is.null(checkNull(input$mdsEllipse))) {
p <- p + stat_ellipse(aes_string(group = input$mdsEllipse))
}
return(p + theme_bw())
})
)
mds <- fluidPage(withLoader(plotOutput("mds", height = 700)),
mds <- fluidPage(outputCodeButton(withLoader(plotOutput("mds", height = 700))),
uiOutput("mdsUI"))
......@@ -35,7 +35,7 @@ dashboardHeader(title = "Easy16S"),
menuItem("Rarefaction curves", tabName = "rarefactionCurve", icon = icon("chart-line")),
menuItem(HTML("&alpha;-diversity"), tabName = "richnessA", icon = icon("dashboard")),
menuItem(HTML("&beta;-diversity"), tabName = "richnessB", icon = icon("dashboard")),
menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dashboard")),
menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("spinner")),
menuItem("PCA", tabName = "pca", icon = icon("dashboard")),
menuItem("Phylogenetic tree", tabName = "tree", icon = icon("dashboard")),
menuItem("Clustering", tabName = "cluster", icon = icon("dashboard")),
......
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