Commit 12ba9644 authored by Midoux Cedric's avatar Midoux Cedric

Transformation

parent 902121ff
### 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",
......
......@@ -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()
......
......@@ -38,6 +38,10 @@ shinyServer
showModal(filterSample())
})
observeEvent(input$transformButton, {
showModal(transformSample())
})
observeEvent(input$downloadButton, {
showModal(dataDownload())
})
......
......@@ -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")),
......
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