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

mdsUI

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