From 12ba96442f21e319ae02e3511bb2684ad01e6af8 Mon Sep 17 00:00:00 2001
From: Midoux Cedric <cedric.midoux@irstea.fr>
Date: Tue, 14 Apr 2020 20:06:04 +0200
Subject: [PATCH] Transformation
---
panels/dataInput.R | 83 +++++++++++++++++++++++++++++++++++++++++++++
panels/pca-server.R | 26 ++++----------
server.R | 4 +++
ui.R | 6 +++-
4 files changed, 99 insertions(+), 20 deletions(-)
diff --git a/panels/dataInput.R b/panels/dataInput.R
index 8e1bf22..c3fc0ba 100644
--- a/panels/dataInput.R
+++ b/panels/dataInput.R
@@ -1,3 +1,4 @@
+### Upload Data ###
dataInput <- function(failed = FALSE) {
modalDialog(
title = "Select your data",
@@ -167,6 +168,7 @@ observeEvent(input$okData, {
}
})
+### Filter ###
filterSample <- function() {
modalDialog(
title = "Select some sample",
@@ -254,6 +256,86 @@ observeEvent(input$selectData, {
}
})
+### Transformation ###
+transformSample <- function() {
+ modalDialog(
+ title = "Transform abundance data",
+
+ radioButtons(
+ inputId = "transformFun",
+ label = "Transform function : ",
+ selected = character(0),
+ choices = c("Proportional Transformation" = "prop",
+ "Square Root Transformation" = "sqrt",
+ "Centered Log-Ratio (CLR) Transformation" = "clr")
+ ),
+
+ wellPanel(verbatimTextOutput("transformFun")),
+
+ footer = tagList(modalButton("Cancel"),
+ actionButton(inputId = "okData", label = "Refresh transformation"),
+ actionButton(inputId = "transformData", label = "Transforme")
+ )
+ )
+}
+
+output$transformFun <- renderText({
+ validate(need(input$transformFun, ""))
+ switch (input$transformFun,
+ "prop" = paste("count_to_prop <- function(x) {return( x / sum(x) )}",
+ "data_prop <- transform_sample_counts(data, count_to_prop)",
+ sep = "\n"),
+ "sqrt" = "data_sqrt <- transform_sample_counts(data, sqrt)",
+ "clr" = paste("gm_mean <- function(x, na.rm=TRUE) {",
+ " exp(sum(log(x[x > 0 & !is.na(x)]), na.rm=na.rm) / length(x))",
+ " }",
+ "clr <- function(x, base=2) {",
+ " x <- log((x / gm_mean(x)), base)",
+ " x[!is.finite(x) | is.na(x)] <- 0.0",
+ " return(x)",
+ "}",
+ "data_clr <- transform_sample_counts(data, clr)",
+ sep = "\n")
+ )
+})
+
+observeEvent(input$transformData, {
+ if (is.null(input$transformData))
+ {
+ removeModal()
+ } else {
+ try(
+ switch (input$transformFun,
+ "prop" = {
+ count_to_prop <- function(x) {return( x / sum(x) )}
+ physeq(transform_sample_counts(physeq(), count_to_prop))
+ },
+ "sqrt" = {
+ physeq(transform_sample_counts(physeq(), sqrt))
+ },
+ "clr" = {
+ gm_mean <- function(x, na.rm=TRUE) {
+ exp(sum(log(x[x > 0 & !is.na(x)]), na.rm=na.rm) / length(x))
+ }
+ clr <- function(x, base=2) {
+ x <- log((x / gm_mean(x)), base)
+ x[!is.finite(x) | is.na(x)] <- 0.0
+ return(x)
+ }
+ physeq(transform_sample_counts(physeq(), clr))
+ }
+ ),
+ silent = TRUE,
+ outFile = showModal(dataInput(failed = TRUE)))
+
+ if (class(physeq()) == "phyloseq") {
+ removeModal()
+ } else {
+ showModal(dataInput(failed = TRUE))
+ }
+ }
+})
+### Download Data ###
dataDownload <- function() {
modalDialog(
title = "Download data",
@@ -280,6 +362,7 @@ output$okDownload <- downloadHandler(
}
)
+### Download Plot ###
plotDownload <- function() {
modalDialog(
title = "Download last modified plot",
diff --git a/panels/pca-server.R b/panels/pca-server.R
index 6d0995c..10b539a 100644
--- a/panels/pca-server.R
+++ b/panels/pca-server.R
@@ -8,8 +8,6 @@ output$pcaUI <- renderUI({
"pcaSetting",
label = "PCA setting",
choices = list(
- "Ratio normalization" = "norm",
- "Square root normalization" = "sqrt",
"Center" = "center",
"Scale" = "scale"
),
@@ -78,22 +76,13 @@ output$pca <- metaRender2(renderPlot, {
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))) })
- }
-
pca <- metaExpr({
- prcomp(data_matrix[colSums(data_matrix) != 0],
- center = ..("center" %in% input$pcaSetting),
- scale = ..("scale" %in% input$pcaSetting)
- )
- })
+ data_matrix <- as.data.frame(t(otu_table(data)))
+ pca <- prcomp(data_matrix[colSums(data_matrix) != 0],
+ center = ..("center" %in% input$pcaSetting),
+ scale = ..("scale" %in% input$pcaSetting)
+ )
+ })
habillage <- if (!is.null(checkNull(input$pcaHabillage))) {
metaExpr({
@@ -137,8 +126,7 @@ output$pca <- metaRender2(renderPlot, {
)
metaExpr({
- data_matrix <- ..(data_matrix)
- pca <- ..(pca)
+ ..(pca)
habillage <- ..(habillage)
p <- ..(pcaType)
p + theme_bw()
diff --git a/server.R b/server.R
index d61f997..a03682f 100644
--- a/server.R
+++ b/server.R
@@ -38,6 +38,10 @@ shinyServer
showModal(filterSample())
})
+ observeEvent(input$transformButton, {
+ showModal(transformSample())
+ })
+
observeEvent(input$downloadButton, {
showModal(dataDownload())
})
diff --git a/ui.R b/ui.R
index f8cdfae..011da15 100644
--- a/ui.R
+++ b/ui.R
@@ -24,13 +24,17 @@ dashboardHeader(title = "Easy16S"),
"Select some samples",
icon = icon("filter"),
style = "width: 80% ; color: black ; background-color: gray90"),
+ actionButton("transformButton",
+ "Transform abundance",
+ icon = icon("square-root-alt"),
+ style = "width: 80% ; color: black ; background-color: gray90"),
actionButton("downloadButton",
"Download data",
icon = icon("download"),
style = "width: 80% ; color: black ; background-color: gray90"),
actionButton("plotButton",
"Download last plot",
- icon = icon("download"),
+ icon = icon("file-image"),
style = "width: 80% ; color: black ; background-color: gray90"),
sidebarMenu(
menuItem("Summary", tabName = "Summary", icon = icon("dna")),
--
GitLab