Skip to content

Commit

Permalink
Cleanup main (#175)
Browse files Browse the repository at this point in the history
* UI cleanup.

* Removed unused security

* removed assignment

* Made Jokes a global variable. Tidied up data inspection

* Moved preprocessing away. Made some if/else statments clearer. TODO: "addWarning" seems quite unintuitive right now

* Apply suggestions from code review

Co-authored-by: Lea Seep <[email protected]>

* Moved getCurrentVersion to util

---------

Co-authored-by: Lea Seep <[email protected]>
  • Loading branch information
PaulJonasJost and LeaSeep authored Feb 26, 2024
1 parent f59a345 commit 4697fdc
Show file tree
Hide file tree
Showing 10 changed files with 323 additions and 259 deletions.
4 changes: 4 additions & 0 deletions program/shinyApp/R/C.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,10 @@
NOTES_PlACEHOLDER <<- "Notes you want to take alongside the Plot (will be saved in the report) \nYou may want to use markdown syntay for structering the notes "
NOTES_HELP <<- "Notes: For structure reasons you should start with Heading Level 4 (hence #### My personal Title)"

# Jokes
JOKES <<- read.csv("joke-db.csv")
JOKES <<- JOKES[nchar(JOKES$Joke)>0 & nchar(JOKES$Joke)<180,]

# Test correction list
PADJUST_METHOD <<- list(
"None" = "none",
Expand Down
3 changes: 2 additions & 1 deletion program/shinyApp/R/SourceAll.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,4 +19,5 @@ source("R/sample_correlation/server.R", local = T)
source("R/sample_correlation/util.R", local = T)
source("R/significance_analysis/server.R", local = T)
source("R/significance_analysis/util.R", local = T)
source("R/fun_getCurrentVersionFromChangeLog.R",local = T)
source("R/pre_processing/util.R", local = T)
source("R/util.R", local = T)
21 changes: 9 additions & 12 deletions program/shinyApp/R/data_selection/ui.R
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
data_selection_sidebar_panel <- sidebarPanel(
id = "sidebar_data_selection",
div(class = "omicType",
div(class = "omic_type",
selectInput(
inputId = "omicType", # RNAorLIPID
inputId = "omic_type",
label = "Omic Type that is uploaded",
choices = c("Transcriptomics", "Lipidomics", "Metabolomics"),
selected = ""
Expand All @@ -13,7 +13,6 @@ data_selection_sidebar_panel <- sidebarPanel(
uiOutput(outputId = "AddGeneSymbols_ui"),
uiOutput(outputId = "AddGeneSymbols_organism_ui")
),
#uiOutput("AddGeneSymbols_organism_ui"),
actionButton(
inputId = "refresh1",
label = "Do"
Expand All @@ -29,7 +28,6 @@ data_selection_sidebar_panel <- sidebarPanel(
uiOutput(outputId = "row_selection_ui"),
uiOutput(outputId = "propensityChoiceUser_ui")
),
# Outlier Selection -> for fixed removal pre-processing needs to be redone!
div(
class = "SampleSelection",
h4("Sample selection"),
Expand Down Expand Up @@ -62,17 +60,17 @@ data_selection_main_panel <- mainPanel(
NULL
),
hr(style = "border-top: 2px solid #90DBF4;"),
a(id = "toggleAdvanced",
a(
id = "toggleAdvanced",
"Data Upload via file input",
style = "background-color: #90DBF4; color: black; padding: 7px 10px; "
) %>% helper(type = "markdown", content = "DataSelection_DataUploadFileInput"),
shinyjs::hidden(
div(
) %>% helper(type = "markdown", content = "DataSelection_DataUploadFileInput"),
shinyjs::hidden(div(
id = "advanced",
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("50%", "50%"),
uiOutput(outputId = "data_matrix1_ui"), # %>% helper(type = "markdown", content = "DataSelection_Matrix"),
uiOutput(outputId = "data_sample_anno1_ui"), # %>% helper(type = "markdown", content = "DataSelection_SampleAnno")
uiOutput(outputId = "data_matrix1_ui"),
uiOutput(outputId = "data_sample_anno1_ui"),
),
splitLayout(
style = "border: 1px solid silver:", cellWidths = c("50%", "50%"),
Expand All @@ -81,8 +79,7 @@ data_selection_main_panel <- mainPanel(
outputId = "data_preDone_ui"
) %>% helper(type = "markdown", content = "DataSelection_SummarizedExp")
)
)
),
)),
hr(style = "border-top: 2px solid #90DBF4;"),
uiOutput(outputId = "metadataInput_ui") %>% helper(type = "markdown", content = "DataSelection_MetaData"),
hr(style = "border-top: 2px solid #90DBF4;"),
Expand Down
2 changes: 1 addition & 1 deletion program/shinyApp/R/fun_LogIt.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ fun_LogIt <- function(
addPlot = F,
tableSaved = F,
Filename = NULL,
jokes = jokesDF
jokes = JOKES
){
# sophisticated "Where to place log file"
LogfileName <- "www/Report.md" # DO NOT CHANGE THE NAME!
Expand Down
14 changes: 0 additions & 14 deletions program/shinyApp/R/fun_getCurrentVersionFromChangeLog.R

This file was deleted.

19 changes: 3 additions & 16 deletions program/shinyApp/R/pre_processing/ui.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,7 @@ pre_processing_sidebar_panel <- sidebarPanel(
) %>% 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"),
switchInput(
inputId = "DESeq_show_advanced",
label = "Advanced formula options for DESeq2",
inline = T,
size = "mini",
value = F
),
uiOutput(outputId = "DESeq_show_advanced_ui"),
uiOutput(outputId = "DESeq_formula_advanced_ui"),
actionButton(
inputId = "Do_preprocessing",
Expand All @@ -36,24 +30,17 @@ pre_processing_main_panel <- mainPanel(
id = "mainpanel_pre_processing",
# Statistics to the data
helpText("general statistics to the input data, stuff like dimensions"),
# hidden(div(id = 'Spinner_Statisitcs_Data', plotOutput("Statisitcs_Data")%>% withSpinner(type=8))),
htmlOutput(outputId = "Statisitcs_Data") %>% withSpinner(type = 8),
HTML(text = "<br>"),
HTML(text = "<br>"),
splitLayout(
cellWidths = c("25%", "25%", "25%"),
# uiOutput(outputId = "NextPanel2_ui"),
# uiOutput(outputId = "NextPanel3_ui"),
# uiOutput(outputId = "NextPanel4_ui")
)
HTML(text = "<br>")
)


pre_processing_panel <- tabPanel(
title = "Pre-processing",
id = "pre_processing_panel",
fluid = T,
h4("Data Pre-processing"), # %>% helper(type = "markdown", content = "PreProcessing_help"),
h4("Data Pre-processing"),
pre_processing_sidebar_panel,
pre_processing_main_panel
)
129 changes: 129 additions & 0 deletions program/shinyApp/R/pre_processing/util.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,129 @@
# preprocessing procedures

prefiltering <- function(data, omic_type){
# Filter out low abundant entities for Metabol- and Transcriptomics.
if(omic_type == "Transcriptomics"){
print("Remove anything of rowCount <=10")
return(data[which(rowSums(assay(data)) > 10),])
}
if(omic_type == "Metabolomics"){
print("Remove anything which has a row median of 0")
return(data[which(apply(assay(data),1,median)!=0),])
}
}


simple_center_scaling <- function(data, omic_type){
# Center and scale the data
print("Do chosen Preprocessing: simpleCenterScaling")
# prefilter the data
data <- prefiltering(data, omic_type)
# center and scale the data
processedData <- as.data.frame(t(scale(
x = as.data.frame(t(as.data.frame(assay(data)))),
scale = T,
center = T
)))
assay(data) <- processedData
return(data)
}


scaling_normalisation <- function(data, omic_type, scaling_procedure){
# Center and scale the data
print(paste0("Do chosen Preprocessing: ", scaling_procedure))
# prefilter the data
data <- prefiltering(data, omic_type)
# scaling functions
fun_scale <- function(x){
return((x-min(x))/(max(x)-min(x)))
}
fun_pareto <- function(x){
return((x-mean(x))/sqrt(var(x)))
}
scaling_function <- ifelse(scaling_procedure == "Scaling_0_1", fun_scale, fun_pareto)
processedData <- as.data.frame(t(apply(
X = assay(data),
MARGIN = 1,
FUN = scaling_function
)))
assay(data) <- processedData
return(data)
}


ln_normalisation <- function(data, omic_type, logarithm_procedure){
# Center and scale the data
print(paste0("Do chosen Preprocessing: ", logarithm_procedure))
logarithm <- ifelse(logarithm_procedure == "log10", log10, log)
# prefilter the data
data <- prefiltering(data, omic_type)
# log the data and always add 1 to avoid -Inf
processedData <- as.data.frame(logarithm(as.data.frame(assay(data)) + 1))
assay(data) <- processedData
return(data)
}


deseq_processing <- function(
data, omic_type, formula_main, formula_sub, session_token, advanced_formula = NULL
){
# Center and scale the data
print("Do chosen Preprocessing: vst_DESeq")
# prefilter the data
data <- prefiltering(data, omic_type)
# DESeq2
par_tmp[[session_token]]["DESeq_advanced"] <<- FALSE
if(omic_type == "Transcriptomics"){
design_formula <- paste("~", formula_main)
# only do this locally
colData(data)[,formula_main] <- as.factor(
colData(data)[,formula_main]
)
if(length(formula_sub) > 0){
design_formula <- paste(
design_formula, " + ",
paste(formula_sub, collapse = " + ")
)
# turn each factor into a factor
for(i in formula_sub){
colData(data)[,i] <- as.factor(
colData(data)[,i]
)
}
par_tmp[[session_token]][["DESeq_factors"]] <<- c(
formula_main,formula_sub
)
}
else{
par_tmp[[session_token]][["DESeq_factors"]] <<- c(formula_main)
}
# if advanced formula is used, overwrite the other formula
if(!(advanced_formula == "") & startsWith(advanced_formula, "~")){
print("Advanced formula used")
design_formula <- advanced_formula
par_tmp[[session_token]]["DESeq_advanced"] <<- TRUE
}
print(design_formula)
par_tmp[[session_token]]["DESeq_formula"] <<- design_formula
# on purpose local
print(colData(data)[,formula_main])

dds <- DESeq2::DESeqDataSetFromMatrix(
countData = assay(data),
colData = colData(data),
design = as.formula(design_formula)
)

de_seq_result <- DESeq2::DESeq(dds)
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)
}
21 changes: 20 additions & 1 deletion program/shinyApp/R/util.R
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
### general utility functions will be defined here


update_data <- function(session_id){
# for stability reasons, data is ALWAYS pulled here
print("Updating data...")
data <- res_tmp[[session_id]]
return(data)
}


select_data <- function(data, selected_samples, sample_type){
# select data for e.g. pca's or alike
samples_selected <- c()
Expand All @@ -25,6 +25,7 @@ select_data <- function(data, selected_samples, sample_type){
return(data)
}


update_params <- function(session_id){
# update parameter if updates is larger than current_updates
# could force to always update
Expand All @@ -33,6 +34,7 @@ update_params <- function(session_id){
return(params)
}


read_file <- function(filename, check.names=T){
# reads in the file of either a .csv or a .xlsx filetype
if (base::endsWith(filename, ".csv")){
Expand Down Expand Up @@ -72,6 +74,7 @@ getUserReactiveValues <- function(data = input){
return(tmp[to_include])
}


save_pheatmap <- function(x, filename,type = "pdf") {
# Saves a heatmap to a file in different formats
stopifnot(!missing(x))
Expand All @@ -98,3 +101,19 @@ save_pheatmap <- function(x, filename,type = "pdf") {
dev.off()
}
}


getCurrentVersion <- function(updateDESCRIPTION = T){
# Write function to insert current release absed on CHANGE log to DESCRIPTIOn
# Return current version
ChangeLog <- readLines("../../CHANGELOG.md")
# take the first hit as it is the most recent
recentSeries <- which(grepl("series$",ChangeLog))[1]
recentVersion <- ChangeLog[recentSeries+4]
DESCRIPTION <- readLines("DESCRIPTION")
DESCRIPTION_new <- gsub("Version:.*$",paste0("Version: ",recentVersion),DESCRIPTION)
writeLines(DESCRIPTION_new,con ="DESCRIPTION" )

# take the + next line to get version
return(recentVersion)
}
Loading

0 comments on commit 4697fdc

Please sign in to comment.