Transformation

panels/dataInput.R

+### 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",

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()

server.R

@@ -38,6 +38,10 @@ shinyServer
     showModal(filterSample())
   })
   
+  observeEvent(input$transformButton, {
+    showModal(transformSample())
+  })
+  
   observeEvent(input$downloadButton, {
     showModal(dataDownload())
   })

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")),