Commit 1aa62623 authored by Midoux Cedric's avatar Midoux Cedric

panels/mds

parent cce9427d
output$mdsUI <- renderUI({
validate(need(data16S(), ""))
box(
title = "Setting : " ,
width = NULL,
status = "primary",
checkboxGroupInput(
"mdsAxes",
label = "Axes : ",
choices = seq(10),
selected = c(1, 2),
inline = TRUE
),
selectInput(
"mdsDist",
label = "Distance : ",
selected = "bray",
choices = list(
"bray",
"jaccard",
"unifrac",
"wunifrac",
"dpcoa",
"jsd",
"euclidean"
)
),
selectInput(
"mdsMethod",
label = "Method : ",
selected = "MDS",
choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA")
),
textInput("mdsTitle",
label = "Title : ",
value = "Samples ordination graphic"),
selectInput(
"mdsLabel",
label = "Label : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsCol",
label = "Color : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsEllipse",
label = "Ellipses : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsRep",
label = "Barycenters : ",
choices = c("..." = 0, sample_variables(data16S()))
),
collapsedBox(verbatimTextOutput("mdsScript"), title = "RCode")
)
})
output$mdsScript <- renderText({
scriptArgs <- c(
"physeq = data",
glue(
"ordination = ordinate(data, method = \"{input$mdsMethod}\", distance = \"{input$mdsDist}\")"
),
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$mdsRep))) {
scriptArgs <- c(scriptArgs, glue("replicate = \"{input$mdsRep}\""))
} else {
scriptArgs <- c(scriptArgs, glue("replicate = NULL"))
}
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_samples({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"))
})
output$mds <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
need(length(input$mdsAxes) == 2, "Requires two projections axes")
)
p <- plot_samples(
data16S(),
ordination = ordinate(
data16S(),
method = input$mdsMethod,
distance = input$mdsDist
),
axes = as.numeric(input$mdsAxes),
title = checkNull(input$mdsTitle),
color = checkNull(input$mdsCol),
replicate = if (is.null(checkNull(input$mdsRep))) {
NULL
} else {
checkNull(input$mdsRep)
},
shape = checkNull(input$mdsShape),
label = checkNull(input$mdsLabel)
)
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)),
uiOutput("mdsUI"))
......@@ -14,6 +14,7 @@ shinyServer
source("panels/rarefactionCurve-server.R", local = TRUE)
source("panels/richnessA-server.R", local = TRUE)
source("panels/richnessB-server.R", local = TRUE)
source("panels/mds-server.R", local = TRUE)
source("panels/tree-server.R", local = TRUE)
source("panels/cluster-server.R", local = TRUE)
......@@ -248,143 +249,6 @@ shinyServer
beautifulTable(joinGlom)
})
output$mdsUI <- renderUI({
validate(need(data16S(), ""))
box(
title = "Setting : " ,
width = NULL,
status = "primary",
checkboxGroupInput(
"mdsAxes",
label = "Axes : ",
choices = seq(10),
selected = c(1, 2),
inline = TRUE
),
selectInput(
"mdsDist",
label = "Distance : ",
selected = "bray",
choices = list(
"bray",
"jaccard",
"unifrac",
"wunifrac",
"dpcoa",
"jsd",
"euclidean"
)
),
selectInput(
"mdsMethod",
label = "Method : ",
selected = "MDS",
choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA")
),
textInput("mdsTitle",
label = "Title : ",
value = "Samples ordination graphic"),
selectInput(
"mdsLabel",
label = "Label : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsCol",
label = "Color : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsEllipse",
label = "Ellipses : ",
choices = c("..." = 0, sample_variables(data16S()))
),
selectInput(
"mdsRep",
label = "Barycenters : ",
choices = c("..." = 0, sample_variables(data16S()))
),
collapsedBox(verbatimTextOutput("mdsScript"), title = "RCode")
)
})
output$mdsScript <- renderText({
scriptArgs <- c(
"physeq = data",
glue(
"ordination = ordinate(data, method = \"{input$mdsMethod}\", distance = \"{input$mdsDist}\")"
),
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$mdsRep))) {
scriptArgs <- c(scriptArgs, glue("replicate = \"{input$mdsRep}\""))
} else {
scriptArgs <- c(scriptArgs, glue("replicate = NULL"))
}
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_samples({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"))
})
output$mds <- renderPlot({
validate(
need(data16S(), "Requires an abundance dataset"),
need(length(input$mdsAxes) == 2, "Requires two projections axes")
)
p <- plot_samples(
data16S(),
ordination = ordinate(
data16S(),
method = input$mdsMethod,
distance = input$mdsDist
),
axes = as.numeric(input$mdsAxes),
title = checkNull(input$mdsTitle),
color = checkNull(input$mdsCol),
replicate = if (is.null(checkNull(input$mdsRep))) {
NULL
} else {
checkNull(input$mdsRep)
},
shape = checkNull(input$mdsShape),
label = checkNull(input$mdsLabel)
)
if (!is.null(checkNull(input$mdsEllipse))) {
p <- p + stat_ellipse(aes_string(group = input$mdsEllipse))
}
return(p + theme_bw())
})
output$pcaUI <- renderUI({
validate(need(data16S(), ""))
box(
......
......@@ -6,6 +6,7 @@ source("panels/heatmap-ui.R", local = TRUE)
source("panels/rarefactionCurve-ui.R", local = TRUE)
source("panels/richnessA-ui.R", local = TRUE)
source("panels/richnessB-ui.R", local = TRUE)
source("panels/mds-ui.R", local = TRUE)
source("panels/tree-ui.R", local = TRUE)
source("panels/cluster-ui.R", local = TRUE)
......@@ -120,11 +121,8 @@ shinyUI(dashboardPage(
richnessA),
tabPanel(HTML("&beta;-diversity"),
richnessB),
tabPanel(
"MultiDimensional Scaling",
withLoader(plotOutput("mds", height = 700)),
uiOutput("mdsUI")
),
tabPanel("MultiDimensional Scaling",
mds),
tabPanel("PCA",
withLoader(plotOutput("pca", height = 700)),
uiOutput("pcaUI")),
......
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