diff --git a/panels/dataInput.R b/panels/dataInput.R index 8e1bf22830f2dc0bb313455f50295ed92e008ef5..c3fc0ba01b078a9fcc910a18648222d77bdd02fc 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 6d0995c4b2e5d509fc997437b2aa2d6b47c7b3b3..10b539a3836783bb2414ef1bf6825ca8db10c3fc 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 d61f997408c84da3d3fec8bcd6fa9563bad40b42..a03682f8907831826c8158a1ff830dcb001518ba 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 f8cdfae2f0f3ffeaf5acd3b30fb24e031ff8c277..011da158cc9a2ecdd0116aec56d0cdf263f3203d 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")),