Commit ca7904d8 authored by Midoux Cedric's avatar Midoux Cedric
Browse files

betaMDS

parent b02107b9
output$mdsUI <- renderUI({
validate(need(physeq(), ""))
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 (Detrended Correspondence Analysis)" = "DCA",
"CCA (Constrained Correspondence Analysis)" = "CCA",
"RDA (Redundancy Analysis)" = "RDA",
"CAP (Constrained Analysis of Principal Coordinates)" = "CAP",
"DPCoA (Double Principle Coordinate Analysis)" = "DPCoA",
"NMDS (Non-metric MultiDimenstional Scaling)" = "NMDS",
"MDS / PCoA (Principal Coordinate Analysis)" = "MDS")
),
textInput("mdsTitle",
label = "Title : ",
value = "Samples ordination graphic"),
selectInput(
"mdsLabel",
label = "Label : ",
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"mdsCol",
label = "Color : ",
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"mdsShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"mdsEllipse",
label = "Ellipses : ",
choices = c("..." = 0, sample_variables(physeq()))
)
)
})
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)))
})
}
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()
})
})
observeEvent(input$mds_output_code,
{
displayCodeModal(
expandChain(
quote(library(phyloseq)),
quote(library(phyloseq.extended)),
"# Replace `data` with you own data.",
output$mds()
)
)
}
)
mds <- fluidPage(outputCodeButton(withLoader(plotOutput("mds", height = 700))),
uiOutput("mdsUI"))
output$betaMdsUI <- renderUI({
validate(need(physeq(), ""))
box(
title = "Setting : " ,
width = NULL,
status = "primary",
checkboxGroupInput(
"betaMdsAxes",
label = "Axes : ",
choices = seq(10),
selected = c(1, 2),
inline = TRUE
),
selectInput(
"betaMdsMethod",
label = "Method : ",
selected = "MDS",
choices = list("DCA (Detrended Correspondence Analysis)" = "DCA",
"CCA (Constrained Correspondence Analysis)" = "CCA",
"RDA (Redundancy Analysis)" = "RDA",
"CAP (Constrained Analysis of Principal Coordinates)" = "CAP",
"DPCoA (Double Principle Coordinate Analysis)" = "DPCoA",
"NMDS (Non-metric MultiDimenstional Scaling)" = "NMDS",
"MDS / PCoA (Principal Coordinate Analysis)" = "MDS")
),
textInput("betaMdsTitle",
label = "Title : ",
value = "Samples ordination graphic"),
selectInput(
"betaMdsLabel",
label = "Label : ",
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"betaMdsCol",
label = "Color : ",
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"betaMdsShape",
label = "Shape : ",
choices = c("..." = 0, sample_variables(physeq()))
),
selectInput(
"betaMdsEllipse",
label = "Ellipses : ",
choices = c("..." = 0, sample_variables(physeq()))
)
)
})
output$betaMds <- metaRender2(renderPlot, {
validate(need(physeq(), "Requires an abundance dataset"),
need(length(input$betaMdsAxes) == 2, "Requires two projections axes"))
data <- physeq()
betaMdsEllipse <- if (!is.null(checkNull(input$betaMdsEllipse))) {
metaExpr({
stat_ellipse(aes_string(group = ..(input$betaMdsEllipse)))
})
}
metaExpr({
ord <- ordinate(data,
method = ..(input$betaMdsMethod),
distance = ..(input$betaDistance))
p <- plot_ordination(
physeq = data,
ordination = ord,
type = "samples",
axes = ..(as.numeric(input$betaMdsAxes)),
color = ..(checkNull(input$betaMdsCol)),
shape = ..(checkNull(input$betaMdsShape)),
label = ..(checkNull(input$betaMdsLabel)),
title = ..(checkNull(input$betaMdsTitle))
)
p <- p + ..(betaMdsEllipse)
p + theme_bw()
})
})
observeEvent(input$betaMds_output_code,
{
displayCodeModal(
expandChain(
quote(library(phyloseq)),
quote(library(phyloseq.extended)),
"# Replace `data` with you own data.",
output$betaMds()
)
)
}
)
output$betaClusterUI <- renderUI({
validate(need(physeq(), ""))
box(
......@@ -13,7 +107,6 @@ output$betaClusterUI <- renderUI({
)
})
output$betaCluster <- metaRender2(renderPlot, {
validate(need(physeq(), "Requires an abundance dataset"))
data <- physeq()
......
betaMds <- fluidPage(outputCodeButton(withLoader(plotOutput("betaMds", height = 700))),
uiOutput("betaMdsUI"))
betaCluster <- fluidPage(outputCodeButton(withLoader(plotOutput("betaCluster", height = 700))),
uiOutput("betaClusterUI"))
betaHeatmap <- fluidPage(outputCodeButton(withLoader(plotOutput("betaHeatmap", height = 700))),
......
......@@ -22,7 +22,6 @@ 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/pca-server.R", local = TRUE)
source("panels/tree-server.R", local = TRUE)
......
......@@ -9,7 +9,6 @@ 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/pca-ui.R", local = TRUE)
source("panels/tree-ui.R", local = TRUE)
source("panels/Help-ui.R", local = TRUE)
......@@ -68,12 +67,12 @@ dashboardHeader(title = "Easy16S"),
selectInput("betaDistance",
label = "Distance : ",
choices = list("bray", "jaccard", "unifrac", "wunifrac", "dpcoa", "jsd", "euclidean")),
menuSubItem("MultiDimensional Scaling", tabName = "betaMds"),
menuSubItem("Samples clustering", tabName = "betaCluster"),
menuSubItem("Samples heatmap", tabName = "betaHeatmap"),
menuSubItem("Network", tabName = "betaNetwork"),
menuSubItem("Table", tabName = "betaTable")
),
menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dot-circle")),
menuItem("PCA", tabName = "pca", icon = icon("bullseye")),
menuItem("Phylogenetic tree", tabName = "tree", icon = icon("tree")),
menuItem("Help", tabName = "Help", icon = icon("info-circle"))
......@@ -90,11 +89,11 @@ dashboardHeader(title = "Easy16S"),
tabItem(tabName = "rarefactionCurve", rarefactionCurve),
tabItem(tabName = "alphaPlot", alphaPlot),
tabItem(tabName = "alphaTable", alphaTable),
tabItem(tabName = "betaMds", betaMds),
tabItem(tabName = "betaCluster", betaCluster),
tabItem(tabName = "betaHeatmap", betaHeatmap),
tabItem(tabName = "betaNetwork", betaNetwork),
tabItem(tabName = "betaTable", betaTable),
tabItem(tabName = "mds", mds),
tabItem(tabName = "pca", pca),
tabItem(tabName = "tree", tree),
tabItem(tabName = "Help", Help)
......
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