Skip to content

GitLab

Commit 2a09efac authored by Midoux Cedric's avatar Midoux Cedric
Browse files

rework pca with shinymeta

parent ed7f0207
Hide whitespace changes
Inline Side-by-side
Showing with 88 additions and 169 deletions
panels/pca-server.R
View file @ 2a09efac
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()
)
)
}
)
panels/pca-ui.R
View file @ 2a09efac
pca <- fluidPage(withLoader(plotOutput("pca", height = 700)),
pca <- fluidPage(outputCodeButton(withLoader(plotOutput("pca", height = 700))),
uiOutput("pcaUI"))
server.R
View file @ 2a09efac
......@@ -7,6 +7,7 @@ library(phyloseq.extended)
library(ggplot2)
library(dplyr)
library(glue)
library(magrittr)
library(factoextra)
shinyServer
......
ui.R
View file @ 2a09efac
......@@ -35,8 +35,8 @@ dashboardHeader(title = "Easy16S"),
menuItem("Rarefaction curves", tabName = "rarefactionCurve", icon = icon("chart-line")),
menuItem(HTML("&alpha;-diversity"), tabName = "richnessA", icon = icon("dashboard")),
menuItem(HTML("&beta;-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"))
......
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