Skip to content

Commit

Permalink
Added batch Correction as an option to processing the data
Browse files Browse the repository at this point in the history
  • Loading branch information
@PaulJonasJost
PaulJonasJost committed Jun 26, 2024
1 parent 5454847 commit 7c7eb2e
Show file tree
Hide file tree
Showing 15 changed files with 231 additions and 61 deletions.
1 change: 1 addition & 0 deletions program/shinyApp/R/enrichment_analysis/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,6 +77,7 @@ ea_sidebar <- function(ns){
id = "sidebar_enrichment_analysis",
uiOutput(outputId = ns("OrganismChoice_ui")) %>% helper(type = "markdown", content = "EA_Options"),
uiOutput(outputId = ns("ORA_or_GSE_ui")),
uiOutput(outputId = ns("UseBatch_ui")),
uiOutput(outputId = ns("ValueToAttach_ui")),
uiOutput(outputId = ns("sample_annotation_types_cmp_GSEA_ui")),
uiOutput(outputId = ns("Groups2Compare_ref_GSEA_ui")),
Expand Down
20 changes: 17 additions & 3 deletions program/shinyApp/R/heatmap/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,16 @@ heatmap_server <- function(id, data, params, updates){
hide(id = "cluster_rows", anim = T )
}
})


output$UseBatch_ui <- renderUI({
req(par_tmp[[session$token]]$BatchColumn != "NULL")
selectInput(
inputId = ns("UseBatch"),
label = "Use batch corrected data?",
choices = c("No","Yes"),
selected = "No"
)
})

output$LFC_toHeatmap_ui <-renderUI({
req(data_input_shiny())
Expand Down Expand Up @@ -217,6 +226,7 @@ heatmap_server <- function(id, data, params, updates){
)
req(selectedData_processed())
# update the data
useBatch <- ifelse(input$UseBatch == "Yes",T,F)
data <- update_data(session$token)
print("Heatmap on selected Data")
# Value need to be setted in case there is nothing to plot to avoid crash
Expand All @@ -234,8 +244,11 @@ heatmap_server <- function(id, data, params, updates){
input$PreProcessing_Procedure
)

### atm raw data plotted
data2Plot <- data$data
if(useBatch){
data2Plot <- data$data_batch_corrected
} else {
data2Plot <- data$data
}

print(customTitleHeatmap)
mycolors <- list()
Expand Down Expand Up @@ -324,6 +337,7 @@ heatmap_server <- function(id, data, params, updates){
print(paste0("plot LFC's?",input$LFC_toHeatmap))
# Dependent to plot raw data or LFC if calculation is needed
calculate <- 1
# TODO: Lea for code snippet?
# check whether we have to calculate
# Does not find funtion
# check <- check_calculations(list(
Expand Down
1 change: 1 addition & 0 deletions program/shinyApp/R/heatmap/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ heatmap_sidebar<- function(ns){
#########################################
# Heatmap
#########################################
uiOutput(outputId = ns("UseBatch_ui")),
uiOutput(outputId = ns("row_selection_options_ui")) %>% helper(type = "markdown", content = "Heatmap_Options"),
uiOutput(outputId = ns("LFC_toHeatmap_ui")),
h5("Further row selection (LFC based)") %>% helper(type = "markdown", content = "Heatmap_FurtherOptions"),
Expand Down
42 changes: 29 additions & 13 deletions program/shinyApp/R/pca/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,15 @@ pca_Server <- function(id, data, params, row_select){
ns <- session$ns

## UI Section ----
output$UseBatch_ui <- renderUI({
req(par_tmp[[session$token]]$BatchColumn != "NULL")
selectInput(
inputId = ns("UseBatch"),
label = "Use batch corrected data?",
choices = c("No","Yes"),
selected = "No"
)
})
output$x_axis_selection_ui <- renderUI({radioGroupButtons(
inputId = ns("x_axis_selection"),
label = "PC for x-Axis",
Expand Down Expand Up @@ -136,9 +145,9 @@ pca_Server <- function(id, data, params, row_select){
req(input$Do_PCA > pca_reactives$counter)
pca_reactives$counter <- input$Do_PCA
check <- check_calculations(list(
dummy = "dummy",
sample_selection_pca = input$sample_selection_pca,
SampleAnnotationTypes_pca = input$SampleAnnotationTypes_pca
SampleAnnotationTypes_pca = input$SampleAnnotationTypes_pca,
batch = ifelse(input$UseBatch == "Yes",T,F)
), "PCA")
if (check == "No Result yet"){
output$PCA_Info <- renderText("PCA computed.")
Expand Down Expand Up @@ -176,22 +185,29 @@ pca_Server <- function(id, data, params, row_select){
# only calculate PCA, Score and Loadings if the counter is >= 0
if(pca_reactives$calculate >= 0){
# update the data
useBatch <- ifelse(input$UseBatch == "Yes",T,F)
data2plot <- update_data(session$token)
# select the neccesary data
if(input$data_selection_pca){
data2plot <- select_data(
data2plot,
input$sample_selection_pca,
input$SampleAnnotationTypes_pca
input$SampleAnnotationTypes_pca,
useBatch
)
}
if(useBatch){
data2plot <- data2plot$data_batch_corrected
} else {
data2plot <- data2plot$data
}
# set the counter to -1 to prevent any further plotting
pca_reactives$calculate <- -1
print("Calculate PCA")
# PCA, for safety measures, wrap in tryCatch
tryCatch({
pca <- prcomp(
x = as.data.frame(t(as.data.frame(assay(data2plot$data)))),
x = as.data.frame(t(as.data.frame(assay(data2plot)))),
center = T,
scale. = FALSE
)
Expand All @@ -206,7 +222,7 @@ pca_Server <- function(id, data, params, row_select){
percentVar <- round(100 * explVar, digits = 1)

# Define data for plotting
pcaData <- data.frame(pca$x,colData(data2plot$data))
pcaData <- data.frame(pca$x,colData(data2plot))

df_out_r <- NULL
if(input$Show_loadings == "Yes"){
Expand Down Expand Up @@ -238,8 +254,8 @@ pca_Server <- function(id, data, params, row_select){
if(!is.null(input$EntitieAnno_Loadings)){
req(data_input_shiny())
df_out_r$chosenAnno <- factor(
make.unique(as.character(rowData(data2plot$data)[rownames(df_out_r),input$EntitieAnno_Loadings])),
levels = make.unique(as.character(rowData(data2plot$data)[rownames(df_out_r),input$EntitieAnno_Loadings]))
make.unique(as.character(rowData(data2plot)[rownames(df_out_r),input$EntitieAnno_Loadings])),
levels = make.unique(as.character(rowData(data2plot)[rownames(df_out_r),input$EntitieAnno_Loadings]))
)
}
}
Expand All @@ -265,8 +281,8 @@ pca_Server <- function(id, data, params, row_select){
if(!is.null(input$EntitieAnno_Loadings)){
req(data_input_shiny())
LoadingsDF$entitie <- factor(
make.unique(as.character(rowData(data2plot$data)[rownames(LoadingsDF),input$EntitieAnno_Loadings])),
levels = make.unique(as.character(rowData(data2plot$data)[rownames(LoadingsDF),input$EntitieAnno_Loadings]))
make.unique(as.character(rowData(data2plot)[rownames(LoadingsDF),input$EntitieAnno_Loadings])),
levels = make.unique(as.character(rowData(data2plot)[rownames(LoadingsDF),input$EntitieAnno_Loadings]))
)
}
# Loadings Matrix plot
Expand All @@ -292,8 +308,8 @@ pca_Server <- function(id, data, params, row_select){
if(!is.null(input$EntitieAnno_Loadings_matrix)){
req(data_input_shiny())
df_loadings$chosenAnno <- factor(
make.unique(as.character(rowData(data2plot$data)[unique(df_loadings$entity),input$EntitieAnno_Loadings_matrix])),
levels = make.unique(as.character(rowData(data2plot$data)[unique(df_loadings$entity),input$EntitieAnno_Loadings_matrix]))
make.unique(as.character(rowData(data2plot)[unique(df_loadings$entity),input$EntitieAnno_Loadings_matrix])),
levels = make.unique(as.character(rowData(data2plot)[unique(df_loadings$entity),input$EntitieAnno_Loadings_matrix]))
)
} else{
df_loadings$chosenAnno <- df_loadings$entity
Expand All @@ -311,8 +327,8 @@ pca_Server <- function(id, data, params, row_select){
# assign par_temp as empty list
par_tmp[[session$token]][["PCA"]] <<- list(
sample_selection_pca = input$sample_selection_pca,
SampleAnnotationTypes_pca = input$SampleAnnotationTypes_pca

SampleAnnotationTypes_pca = input$SampleAnnotationTypes_pca,
UseBatch = useBatch
)
} else {
# otherwise read the reactive values
Expand Down
1 change: 1 addition & 0 deletions program/shinyApp/R/pca/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ pca_sidebar_panel <- function(ns){
# PCA
#########################################
h4("Explorative Analysis") %>% helper(type = "markdown", content = "PCA_Choices"),
uiOutput(outputId = ns("UseBatch_ui")),
### data selection
switchInput(
inputId = ns("data_selection_pca"),
Expand Down
8 changes: 6 additions & 2 deletions program/shinyApp/R/pre_processing/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,8 +13,12 @@ pre_processing_sidebar_panel <- sidebarPanel(
),
selected = "none"
) %>% helper(type = "markdown", content = "PreProcessing_Procedures"),
uiOutput(outputId = "DESeq_formula_main_ui") %>% helper(type = "markdown", content = "PreProcessing_DESeqMain"),
uiOutput(outputId = "DESeq_formula_sub_ui") %>% helper(type = "markdown", content = "PreProcessing_DESeqSub"),

uiOutput(outputId = "DESeq_formula_main_ui"),
uiOutput(outputId = "DESeq_formula_sub_ui"),

uiOutput(outputId = "batch_effect_ui"),

actionButton(
inputId = "Do_preprocessing",
label = "Get Pre-Processing",
Expand Down
11 changes: 7 additions & 4 deletions program/shinyApp/R/pre_processing/util.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ ln_normalisation <- function(data, omic_type, logarithm_procedure){


deseq_processing <- function(
data, omic_type, formula_main, formula_sub, session_token, advanced_formula = NULL
data, omic_type, formula_main, formula_sub, session_token, batch_correct
){
# Center and scale the data
# prefilter the data
Expand Down Expand Up @@ -125,14 +125,17 @@ deseq_processing <- function(
)

de_seq_result <- DESeq2::DESeq(dds)
res_tmp[[session_token]]$DESeq_obj <<- de_seq_result
if (batch_correct){
res_tmp[[session_token]]$DESeq_obj_batch_corrected <<- de_seq_result
} else {
res_tmp[[session_token]]$DESeq_obj <<- de_seq_result
}
dds_vst <- vst(
object = de_seq_result,
blind = TRUE
)
)
assay(data) <- as.data.frame(assay(dds_vst))
return(data)
}
addWarning <- "<font color=\"#FF0000\"><b>DESeq makes only sense for transcriptomics data - data treated as if 'filterOnly' was selected!</b></font>"
return(data)
}
35 changes: 26 additions & 9 deletions program/shinyApp/R/sample_correlation/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,15 @@ sample_correlation_server <- function(id, data, params){

ns <- session$ns
# UI Section ----
output$UseBatch_ui <- renderUI({
req(par_tmp[[session$token]]$BatchColumn != "NULL")
selectInput(
inputId = ns("UseBatch"),
label = "Use batch corrected data?",
choices = c("No","Yes"),
selected = "No"
)
})
output$SampleAnnotationChoice_ui <- renderUI({
req(selectedData_processed())
selectInput(
Expand All @@ -37,19 +46,26 @@ sample_correlation_server <- function(id, data, params){

if(sample_corr_reactive$calculate == 1){
# update the data if needed
useBatch <- ifelse(input$UseBatch == "Yes",T,F)
data <- update_data(session$token)
if(useBatch){
data <- data$data_batch_corrected
} else {
data <- data$data
}
# set the counter to 0 to prevent any further plotting
sample_corr_reactive$calculate <- 0

# check value of input$Do_SampleCorrelation
annotationDF <- colData(data$data)[,input$SampleAnnotationChoice,drop = F]
annotationDF <- colData(data)[,input$SampleAnnotationChoice,drop = F]
check <- check_calculations(
list(
corrMethod = input$corrMethod,
data_info = list(
rows = length(rownames(data$data)),
cols = length(colnames(data$data)),
preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure
rows = length(rownames(data)),
cols = length(colnames(data)),
preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure,
batch = useBatch
)
),
"SampleCorrelation"
Expand All @@ -61,7 +77,7 @@ sample_correlation_server <- function(id, data, params){
"Correlation Matrix successfully computed."
)
cormat <- cor(
x = as.matrix(assay(data$data)),
x = as.matrix(assay(data)),
method = input$corrMethod
)
} else if (check == "Result exists"){
Expand All @@ -74,7 +90,7 @@ sample_correlation_server <- function(id, data, params){
"Correlation Matrix result overwritten with different parameters."
)
cormat <- cor(
x = as.matrix(assay(data$data)),
x = as.matrix(assay(data)),
method = input$corrMethod
)
}
Expand Down Expand Up @@ -106,9 +122,10 @@ sample_correlation_server <- function(id, data, params){
par_tmp[[session$token]][["SampleCorrelation"]] <<- list(
corrMethod = input$corrMethod,
data_info = list(
rows = length(rownames(data$data)),
cols = length(colnames(data$data)),
preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure
rows = length(rownames(data)),
cols = length(colnames(data)),
preprocessing = par_tmp[[session$token]]$PreProcessing_Procedure,
batch = useBatch
)
)

Expand Down
1 change: 1 addition & 0 deletions program/shinyApp/R/sample_correlation/ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ sampleCorrelation_sidebar_panel <- function(ns){
sidebarPanel(
id = "sidebar_sampleCorrelation",
h4("Sample Correlation") %>% helper(type = "markdown", content = "SampleCorr_Choices"),
uiOutput(outputId = ns("UseBatch_ui")),
selectInput(
inputId = ns("corrMethod"),
label = "Choose the correlation method",
Expand Down
Loading

0 comments on commit 7c7eb2e

Please sign in to comment.