Commit 5cdae939 authored by Midoux Cedric's avatar Midoux Cedric
Browse files

mdsUI

No related merge requests found
Showing with 41 additions and 41 deletions
+41 -41
...@@ -1185,21 +1185,21 @@ shinyServer ...@@ -1185,21 +1185,21 @@ shinyServer
} }
}) })
output$acpUI <- renderUI({ output$mdsUI <- renderUI({
validate(need(data16S(), "")) validate(need(data16S(), ""))
box( box(
title = "Setting : " , title = "Setting : " ,
width = NULL, width = NULL,
status = "primary", status = "primary",
checkboxGroupInput( checkboxGroupInput(
"acpAxes", "mdsAxes",
label = "Axes : ", label = "Axes : ",
choices = seq(10), choices = seq(10),
selected = c(1, 2), selected = c(1, 2),
inline = TRUE inline = TRUE
), ),
selectInput( selectInput(
"acpDist", "mdsDist",
label = "Distance : ", label = "Distance : ",
selected = "bray", selected = "bray",
choices = list( choices = list(
...@@ -1213,78 +1213,78 @@ shinyServer ...@@ -1213,78 +1213,78 @@ shinyServer
) )
), ),
selectInput( selectInput(
"acpMethod", "mdsMethod",
label = "Method : ", label = "Method : ",
selected = "MDS", selected = "MDS",
choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA") choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA")
), ),
textInput("acpTitle", textInput("mdsTitle",
label = "Title : ", label = "Title : ",
value = "Samples ordination graphic"), value = "Samples ordination graphic"),
selectInput( selectInput(
"acpLabel", "mdsLabel",
label = "Label : ", label = "Label : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(data16S()))
), ),
selectInput( selectInput(
"acpCol", "mdsCol",
label = "Color : ", label = "Color : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(data16S()))
), ),
selectInput( selectInput(
"acpShape", "mdsShape",
label = "Shape : ", label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(data16S()))
), ),
selectInput( selectInput(
"acpEllipse", "mdsEllipse",
label = "Ellipses : ", label = "Ellipses : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(data16S()))
), ),
selectInput( selectInput(
"acpRep", "mdsRep",
label = "Barycenters : ", label = "Barycenters : ",
choices = c("..." = 0, sample_variables(data16S())) choices = c("..." = 0, sample_variables(data16S()))
), ),
collapsedBox(verbatimTextOutput("acpScript"), title = "RCode") collapsedBox(verbatimTextOutput("mdsScript"), title = "RCode")
) )
}) })
output$acpScript <- renderText({ output$mdsScript <- renderText({
scriptArgs <- c( scriptArgs <- c(
"physeq = data", "physeq = data",
glue( glue(
"ordination = ordinate(data, method = \"{input$acpMethod}\", distance = \"{input$acpDist}\")" "ordination = ordinate(data, method = \"{input$mdsMethod}\", distance = \"{input$mdsDist}\")"
), ),
glue("axes = c({glue_collapse(input$acpAxes, sep = ', ')})") glue("axes = c({glue_collapse(input$mdsAxes, sep = ', ')})")
) )
if (!is.null(checkNull(input$acpCol))) { if (!is.null(checkNull(input$mdsCol))) {
scriptArgs <- c(scriptArgs, glue("color = \"{input$acpCol}\"")) scriptArgs <- c(scriptArgs, glue("color = \"{input$mdsCol}\""))
} }
if (!is.null(checkNull(input$acpShape))) { if (!is.null(checkNull(input$mdsShape))) {
scriptArgs <- c(scriptArgs, glue("shape = \"{input$acpShape}\"")) scriptArgs <- c(scriptArgs, glue("shape = \"{input$mdsShape}\""))
} }
if (!is.null(checkNull(input$acpRep))) { if (!is.null(checkNull(input$mdsRep))) {
scriptArgs <- c(scriptArgs, glue("replicate = \"{input$acpRep}\"")) scriptArgs <- c(scriptArgs, glue("replicate = \"{input$mdsRep}\""))
} else { } else {
scriptArgs <- c(scriptArgs, glue("replicate = NULL")) scriptArgs <- c(scriptArgs, glue("replicate = NULL"))
} }
if (!is.null(checkNull(input$acpLabel))) { if (!is.null(checkNull(input$mdsLabel))) {
scriptArgs <- c(scriptArgs, glue("label = \"{input$acpLabel}\"")) scriptArgs <- c(scriptArgs, glue("label = \"{input$mdsLabel}\""))
} }
if (!is.null(checkNull(input$acpTitle))) { if (!is.null(checkNull(input$mdsTitle))) {
scriptArgs <- c(scriptArgs, glue("title = \"{input$acpTitle}\"")) scriptArgs <- c(scriptArgs, glue("title = \"{input$mdsTitle}\""))
} }
script <- c( script <- c(
scriptHead, scriptHead,
"# MultiDimensional scaling", "# MultiDimensional scaling",
glue("p <- plot_samples({glue_collapse(scriptArgs, sep=', ')})") glue("p <- plot_samples({glue_collapse(scriptArgs, sep=', ')})")
) )
if (!is.null(checkNull(input$acpEllipse))) { if (!is.null(checkNull(input$mdsEllipse))) {
script <- c( script <- c(
script, script,
glue( glue(
"p <- p + stat_ellipse(aes_string(group = \"{input$acpEllipse}\"))" "p <- p + stat_ellipse(aes_string(group = \"{input$mdsEllipse}\"))"
) )
) )
} }
...@@ -1293,31 +1293,31 @@ shinyServer ...@@ -1293,31 +1293,31 @@ shinyServer
return(glue_collapse(script, sep = "\n")) return(glue_collapse(script, sep = "\n"))
}) })
output$acp <- renderPlot({ output$mds <- renderPlot({
validate( validate(
need(data16S(), "Requires an abundance dataset"), need(data16S(), "Requires an abundance dataset"),
need(length(input$acpAxes) == 2, "Requires two projections axes") need(length(input$mdsAxes) == 2, "Requires two projections axes")
) )
p <- plot_samples( p <- plot_samples(
data16S(), data16S(),
ordination = ordinate( ordination = ordinate(
data16S(), data16S(),
method = input$acpMethod, method = input$mdsMethod,
distance = input$acpDist distance = input$mdsDist
), ),
axes = as.numeric(input$acpAxes), axes = as.numeric(input$mdsAxes),
title = checkNull(input$acpTitle), title = checkNull(input$mdsTitle),
color = checkNull(input$acpCol), color = checkNull(input$mdsCol),
replicate = if (is.null(checkNull(input$acpRep))) { replicate = if (is.null(checkNull(input$mdsRep))) {
NULL NULL
} else { } else {
checkNull(input$acpRep) checkNull(input$mdsRep)
}, },
shape = checkNull(input$acpShape), shape = checkNull(input$mdsShape),
label = checkNull(input$acpLabel) label = checkNull(input$mdsLabel)
) )
if (!is.null(checkNull(input$acpEllipse))) { if (!is.null(checkNull(input$mdsEllipse))) {
p <- p + stat_ellipse(aes_string(group = input$acpEllipse)) p <- p + stat_ellipse(aes_string(group = input$mdsEllipse))
} }
return(p + theme_bw()) return(p + theme_bw())
}) })
......
...@@ -155,8 +155,8 @@ shinyUI(dashboardPage( ...@@ -155,8 +155,8 @@ shinyUI(dashboardPage(
), ),
tabPanel( tabPanel(
"MultiDimensional Scaling", "MultiDimensional Scaling",
withLoader(plotOutput("acp", height = 700)), withLoader(plotOutput("mds", height = 700)),
uiOutput("acpUI") uiOutput("mdsUI")
), ),
tabPanel( tabPanel(
"Phylogenetic tree", "Phylogenetic tree",
......
Supports Markdown
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