diff --git a/panels/pca-server.R b/panels/pca-server.R
index 495d7421aedf7b2b4c6396515b89409b47a73554..6d0995c4b2e5d509fc997437b2aa2d6b47c7b3b3 100644
--- a/panels/pca-server.R
+++ b/panels/pca-server.R
@@ -1,5 +1,5 @@
output$pcaUI <- renderUI({
- validate(need(data16S(), ""))
+ validate(need(physeq(), ""))
box(
title = "Setting : " ,
width = NULL,
@@ -48,7 +48,7 @@ output$pcaUI <- renderUI({
selectInput(
"pcaHabillage",
label = "Group : ",
- choices = c("..." = 0, sample_variables(data16S()))
+ choices = c("..." = 0, sample_variables(physeq()))
),
checkboxInput("pcaEllipse",
label = "Add ellipses",
@@ -65,178 +65,96 @@ output$pcaUI <- renderUI({
"pcaSelect",
label = "Select top contrib variables : ",
min = 1,
- max = ntaxa(data16S()),
+ max = ntaxa(physeq()),
value = 50,
step = 1
- ),
- collapsedBox(verbatimTextOutput("pcaScript"), title = "RCode")
+ )
)
})
-output$pcaScript <- renderText({
- script <- c(
- scriptHead,
- "# PCA",
- "library(factoextra)",
- "m <- as.data.frame(t(otu_table(data)))"
- )
- if ("perc" %in% input$pcaSetting) {
- script <- c(script,
- "m <- m / rowSums(m)")
- }
- if ("sqrt" %in% input$pcaSetting) {
- script <- c(script,
- "m <- sqrt(m)")
- }
- script <- c(
- script,
- glue(
- "pca <- prcomp(m[colSums(m) != 0], center = {\"center\" %in% input$pcaSetting}, scale = {\"scale\" %in% input$pcaSetting})"
- ),
- ""
- )
- scriptArgs <-
- c("pca",
- glue("axes = c({glue_collapse(input$pcaAxes, sep = ', ')})"))
- if (input$pcaType %in% c("biplot", "ind"))
- {
- if (length(input$pcaGeomInd) == 0)
- {
- scriptArgs <- c(scriptArgs, "geom.ind = \"\"")
- } else if (length(input$pcaGeomInd) == 1)
- {
- scriptArgs <-
- c(scriptArgs, glue("geom.ind = \"{input$pcaGeomInd}\""))
- } else if (length(input$pcaGeomInd) == 2)
- {
- scriptArgs <- c(scriptArgs, "geom.ind = c(\"point\", \"text\")")
- }
- if (!is.null(checkNull(input$pcaHabillage)))
- {
- scriptArgs <- c(
- scriptArgs,
- glue(
- "habillage = get_variable(data, \"{input$pcaHabillage}\")"
- ),
- "invisible = \"quali\"",
- glue("addEllipses = {input$pcaEllipses}")
- )
- }
- }
- if (input$pcaType %in% c("biplot", "var"))
- {
- if (length(input$pcaGeomVar) == 0)
- {
- scriptArgs <- c(scriptArgs, "geom.var = \"\"")
- } else if (length(input$pcaGeomVar) == 1)
- {
- scriptArgs <-
- c(scriptArgs, glue("geom.var = \"{input$pcaGeomVar}\""))
- } else if (length(input$pcaGeomVar) == 2)
- {
- scriptArgs <- c(scriptArgs, "geom.var = c(\"arrow\", \"text\")")
+output$pca <- metaRender2(renderPlot, {
+ validate(
+ need(physeq(), "Requires an abundance dataset"),
+ need(length(input$pcaAxes) == 2, "Requires two projections axes"))
+ data <- physeq()
+
+ data_matrix <- if ("norm" %in% input$pcaSetting && "sqrt" %in% input$pcaSetting) {
+ metaExpr({as.data.frame(t(otu_table(data))) %>% {./ rowSums(.)} %>% sqrt() })
+ } else if ("norm" %in% input$pcaSetting) {
+ metaExpr({as.data.frame(t(otu_table(data))) %>% {./ rowSums(.)} })
+ } else if ("sqrt" %in% input$pcaSetting) {
+ metaExpr({as.data.frame(t(otu_table(data))) %>% sqrt() })
+ } else {
+ metaExpr({as.data.frame(t(otu_table(data))) })
}
- scriptArgs <- c(scriptArgs,
- glue("select.var = list(contrib = {input$pcaSelect})"))
- }
- if (!is.null(checkNull(input$pcaTitle))) {
- scriptArgs <- c(scriptArgs, glue("title = \"{input$pcaTitle}\""))
- }
- if (input$pcaType == "biplot")
- {
- script <- c(script,
- glue(
- "p <- fviz_pca_biplot({glue_collapse(scriptArgs, sep=', ')})"
- ))
- }
- if (input$pcaType == "ind")
- {
- script <- c(script,
- glue(
- "p <- fviz_pca_ind({glue_collapse(scriptArgs, sep=', ')})"
- ))
- }
- if (input$pcaType == "var")
- {
- script <- c(script,
- glue(
- "p <- fviz_pca_var({glue_collapse(scriptArgs, sep=', ')})"
- ))
- }
- script <- c(script, "", "plot(p + theme_bw())")
- return(glue_collapse(script, sep = "\n"))
-})
-
-output$pca <- renderPlot({
- validate(
- need(data16S(), "Requires an abundance dataset"),
- need(length(input$pcaAxes) == 2, "Requires two projections axes")
- )
- m <- as.data.frame(t(otu_table(data16S())))
- if ("norm" %in% input$pcaSetting) {
- m <- m / rowSums(m)
- }
- if ("sqrt" %in% input$pcaSetting) {
- m <- sqrt(m)
- }
- pca <-
- prcomp(
- m[colSums(m) != 0],
- center = ("center" %in% input$pcaSetting),
- scale = ("scale" %in% input$pcaSetting)
- )
+ pca <- metaExpr({
+ prcomp(data_matrix[colSums(data_matrix) != 0],
+ center = ..("center" %in% input$pcaSetting),
+ scale = ..("scale" %in% input$pcaSetting)
+ )
+ })
- if (!is.null(checkNull(input$pcaHabillage)))
- {
- h <- get_variable(data16S(), input$pcaHabillage)
- } else {
- h <- "none"
- }
+ habillage <- if (!is.null(checkNull(input$pcaHabillage))) {
+ metaExpr({
+ get_variable(data, ..(input$pcaHabillage))
+ })
+ } else metaExpr({"none"})
- if (input$pcaType == "biplot")
- {
- p <- fviz_pca_biplot(
- pca,
- axes = as.numeric(input$pcaAxes),
- geom.ind = c(input$pcaGeomInd, ""),
- geom.var = c(input$pcaGeomVar, ""),
- habillage = h,
- invisible = "quali",
- addEllipses = input$pcaEllipse,
- title = input$pcaTitle,
- select.var = list(contrib = input$pcaSelect)
- #select.ind
- #labelsize = 4,
- #pointsize = 2
+ pcaType <-
+ switch(input$pcaType,
+ "biplot" = metaExpr({
+ fviz_pca_biplot(pca,
+ axes = ..(as.numeric(input$pcaAxes)),
+ geom.ind = ..(c(input$pcaGeomInd, "")),
+ geom.var = ..(c(input$pcaGeomVar, "")),
+ habillage = habillage,
+ invisible = "quali",
+ addEllipses = ..(input$pcaEllipse),
+ title = ..(input$pcaTitle),
+ select.var = ..(list(contrib = input$pcaSelect))
+ )
+ }),
+ "ind" = metaExpr({
+ fviz_pca_ind(pca,
+ axes = ..(as.numeric(input$pcaAxes)),
+ geom.ind = ..(c(input$pcaGeomInd, "")),
+ habillage = habillage,
+ invisible = "quali",
+ addEllipses = ..(input$pcaEllipse),
+ title = ..(input$pcaTitle)
+ )
+ }),
+ "var" = metaExpr({
+ fviz_pca_var(pca,
+ axes = ..(as.numeric(input$pcaAxes)),
+ geom.var = ..(c(input$pcaGeomVar, "")),
+ invisible = "quali",
+ title = ..(input$pcaTitle),
+ select.var = ..(list(contrib = input$pcaSelect))
+ )
+ })
)
- }
- if (input$pcaType == "ind")
- {
- p <- fviz_pca_ind(
- pca,
- axes = as.numeric(input$pcaAxes),
- geom.ind = c(input$pcaGeomInd, ""),
- habillage = h,
- invisible = "quali",
- addEllipses = input$pcaEllipse,
- title = input$pcaTitle
- #select.ind
- #labelsize = 4,
- #pointsize = 2
- )
- }
- if (input$pcaType == "var")
- {
- p <- fviz_pca_var(
- pca,
- axes = as.numeric(input$pcaAxes),
- geom.var = c(input$pcaGeomVar, ""),
- invisible = "quali",
- title = input$pcaTitle,
- select.var = list(contrib = input$pcaSelect)
- #labelsize = 4,
- )
- }
- return(p + theme_bw())
+
+ metaExpr({
+ data_matrix <- ..(data_matrix)
+ pca <- ..(pca)
+ habillage <- ..(habillage)
+ p <- ..(pcaType)
+ p + theme_bw()
+ })
})
+
+observeEvent(input$pca_output_code,
+ {
+ displayCodeModal(
+ expandChain(
+ quote(library(phyloseq)),
+ quote(library(phyloseq.extended)),
+ quote(library(factoextra)),
+ "# Replace `data` with you own data.",
+ output$pca()
+ )
+ )
+ }
+)
diff --git a/panels/pca-ui.R b/panels/pca-ui.R
index 90ca56e69b43fb8e162ccfb30af8a4d69bf8b34f..218cefc38d46284074955e84cae16eaadc722d9b 100644
--- a/panels/pca-ui.R
+++ b/panels/pca-ui.R
@@ -1,2 +1,2 @@
-pca <- fluidPage(withLoader(plotOutput("pca", height = 700)),
+pca <- fluidPage(outputCodeButton(withLoader(plotOutput("pca", height = 700))),
uiOutput("pcaUI"))
diff --git a/server.R b/server.R
index a8732bb2e724197383fa6374f54bdc61111e9b3e..3cb6b60b05791eb9f6b6994053efbcb27b85c183 100644
--- a/server.R
+++ b/server.R
@@ -7,6 +7,7 @@ library(phyloseq.extended)
library(ggplot2)
library(dplyr)
library(glue)
+library(magrittr)
library(factoextra)
shinyServer
diff --git a/ui.R b/ui.R
index a2edcbaa5f1f7476e866d51baed923e49ef137df..3f1e3fb14b862023ced1d4da9a5f96de1b622c39 100644
--- a/ui.R
+++ b/ui.R
@@ -35,8 +35,8 @@ dashboardHeader(title = "Easy16S"),
menuItem("Rarefaction curves", tabName = "rarefactionCurve", icon = icon("chart-line")),
menuItem(HTML("α-diversity"), tabName = "richnessA", icon = icon("dashboard")),
menuItem(HTML("β-diversity"), tabName = "richnessB", icon = icon("dashboard")),
- menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("spinner")),
- menuItem("PCA", tabName = "pca", icon = icon("dashboard")),
+ menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dot-circle")),
+ menuItem("PCA", tabName = "pca", icon = icon("bullseye")),
menuItem("Phylogenetic tree", tabName = "tree", icon = icon("dashboard")),
menuItem("Clustering", tabName = "cluster", icon = icon("dashboard")),
menuItem("Help", tabName = "Help", icon = icon("dashboard"))