Commit ed7f0207 authored by Midoux Cedric's avatar Midoux Cedric

rework mds with shinymeta

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