Skip to content

Commit

Permalink
Self sufficient snippets (#305)
Browse files Browse the repository at this point in the history
* moved sourcing to a function to make dynamic

* make sure no package appears twice
  • Loading branch information
LeaSeep authored Aug 12, 2024
1 parent da8ee67 commit e194c56
Show file tree
Hide file tree
Showing 3 changed files with 89 additions and 32 deletions.
13 changes: 0 additions & 13 deletions program/shinyApp/R/C.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,19 +19,6 @@ PADJUST_METHOD <<- list(
)

CODE_DOWNLOAD_PREFACE <<- "
# ShinyOmics R Code Download\n# Load necassary packages ----
# (if errors please install respective packages - e.g. install.packages('ggplot2'))
library(ggplot2)
library(ggvenn)
library(ggpubr)
library(rstudioapi)
library(SummarizedExperiment)
library(pheatmap)
library(ComplexUpset)
library(clusterProfiler)
libraray(msigdbr)
# Load the data ----
# The following will try to detect the directory of the file and load the data
# this is succesfull if
Expand Down
26 changes: 24 additions & 2 deletions program/shinyApp/R/fun_getCodeSnippets.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,11 @@ getPlotCode <- function(numberOfScenario) {
row_selection <- par_tmp[[session$token]]$row_selection
col_selection <- par_tmp[[session$token]]$sample_selection
omic_type <- par_tmp[[session$token]]$omic_type

# Always needed packages
stringSource <- c("SummarizedExperiment",
"rstudioapi",
"ggplot2")

#TODO change all data download to par_tmp and res_tmp
# Selection ----
Expand Down Expand Up @@ -93,6 +98,7 @@ selected <- unique(
'
}
if(PreProcessing_Procedure == "vst_DESeq"){
stringSource <- c(stringSource, "DESeq2")
stringPreProcessing <- 'dds <- DESeq2::DESeqDataSetFromMatrix(
countData = assay(res_tmp$data),
colData = colData(res_tmp$data),
Expand Down Expand Up @@ -146,6 +152,7 @@ selected <- unique(
'
}
if(par_tmp[[session$token]]['BatchColumn'] != "NULL" & PreProcessing_Procedure != "vst_DESeq"){
stringSource <- c(stringSource, "sva")
string_batchCorrection <- 'res_tmp$data_batch_corrected <- res_tmp$data
assay(res_tmp$data_batch_corrected) <- sva::ComBat(
dat = assay(res_tmp$data_batch_corrected),
Expand Down Expand Up @@ -412,6 +419,7 @@ if(!is.null(par_tmp$PCA$EntitieAnno_Loadings_matrix)){

## Heatmap ----
if(numberOfScenario >= 10 & numberOfScenario <= 11){
stringSource <- c(stringSource, "pheatmap")
prequel_stringtosave <- '
colorTheme <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c","#fdbf6f", "#ff7f00", "#fb9a99", "#e31a1c")
paletteLength <- 25
Expand Down Expand Up @@ -523,6 +531,7 @@ stringtosave <- paste0(prequel_stringtosave,"\n",stringtosave)

## Single Gene Visualisation ----
if(numberOfScenario %in% c(12,13)){
stringSource <- c(stringSource, "ggpubr")
if(par_tmp[[session$token]]$SingleEntVis$type_of_data_gene == "preprocessed"){
prequel_stringtosave <- '#get IDX to data
idx_selected <- which(par_tmp$SingleEntVis$Select_Gene == rowData(res_tmp$data)[,par_tmp$SingleEntVis$Select_GeneAnno])
Expand Down Expand Up @@ -640,6 +649,11 @@ P_boxplots <- ggplot(res_tmp$SingleEntVis,
}
stringtosave <- paste0(prequel_stringtosave,"\n",stringtosave,"\n","lapply(ls(pattern='boxplots'), get)")
}

if(numberOfScenario %in% c(14,15,16,17)){
stringSource <- c(stringSource, "clusterProfiler","msigdbr")
}


## TODO ensure this remains working with new output from Enrichment, needs a potential update!
if(numberOfScenario == 14){
Expand All @@ -658,6 +672,7 @@ P_boxplots <- ggplot(res_tmp$SingleEntVis,

## Sample Correlation plot ----
if(numberOfScenario == 18){
stringSource <- c(stringSource, "pheatmap")
stringtosave <- 'annotationDF <- colData(res_tmp$data)[,par_tmp$SampleCorr$SampleAnnotationChoice,drop = F]
cormat <- cor(
x = as.matrix(assay(res_tmp$data)),
Expand All @@ -674,6 +689,7 @@ SampleCorrelationPlot <- pheatmap(

## Significance Analysis -----
if(numberOfScenario >= 20 & numberOfScenario < 24){
stringSource <- c(stringSource, "DESeq2")
# Calculate all necessary intermediate data sets
prequel_stringtosave <- '
# Test correction list
Expand Down Expand Up @@ -801,6 +817,7 @@ if(numberOfScenario == 20 | numberOfScenario == 21){
}'

if(numberOfScenario == 20){
stringSource <- c(stringSource, "ggvenn")
stringtosave_2 <- '
Venn_plot <- ggvenn::ggvenn(
res2plot,
Expand All @@ -812,6 +829,7 @@ if(numberOfScenario == 20 | numberOfScenario == 21){

### UpSet Plot ----
if(numberOfScenario == 21){
stringSource <- c(stringSource,"ComplexUpset")
stringtosave_2 <- '
overlap_list <- prepare_upset_plot(res2plot=res2plot)
Upset_plot <- ComplexUpset::upset(
Expand Down Expand Up @@ -955,6 +973,7 @@ data4Volcano <- data4Volcano[complete.cases(data4Volcano),]
## Enrichment Analysis ----
if(numberOfScenario >= 14 & numberOfScenario <= 15){
if(numberOfScenario == 14){
stringSource <- c(stringSource, "msigdbr","clusterProfiler")
stringtosave_1 <- '
# if you want to upload a different set of genes than uploaded to the App
# uncomment the following lines
Expand Down Expand Up @@ -1101,8 +1120,11 @@ for(i in names(enrichment_results)){
if(numberOfScenario == 0){
stringtosave <- '# No_code_yet'
}

return(paste0(CODE_DOWNLOAD_PREFACE,

stringSource_complete <- get_package_source(unique(stringSource))
return(paste0(stringSource_complete,
"\n",
CODE_DOWNLOAD_PREFACE,
"\n",
"# Data Selection ----",
"\n",
Expand Down
82 changes: 65 additions & 17 deletions program/shinyApp/R/util.R
Original file line number Diff line number Diff line change
Expand Up @@ -111,31 +111,29 @@ save.function.from.env <- function(wanted,file="utils.R")
# and find wanted function
funs <- Filter(is.function, sapply(ls( ".GlobalEnv"), get))
funs <- funs[names(funs) %in% wanted]

func_text <- paste(capture.output(funs[[i]]), collapse = "\n")

# Perform the replacements
func_text <- gsub("res_tmp\\[\\[session\\$token\\]\\]", "res_tmp", func_text)
func_text <- gsub("par_tmp\\[\\[session\\$token\\]\\]", "par_tmp", func_text)
func_text <- gsub("req\\(data_input_shiny\\(\\)\\)", "", func_text)


for (i in seq_along(funs)) {
func_text <- paste(capture.output(funs[[i]]), collapse = "\n")

# Perform the replacements
func_text <- gsub("res_tmp\\[\\[session\\$token\\]\\]", "res_tmp", func_text)
func_text <- gsub("par_tmp\\[\\[session\\$token\\]\\]", "par_tmp", func_text)
func_text <- gsub("req\\(data_input_shiny\\(\\)\\)", "", func_text)

# Write function to the file
for(i in seq_along(funs))
{
cat( # number the function we are about to add
paste("\n", "#------ Function number ", i, "-----------------------------------", "\n"),
append = TRUE, file = file
paste("\n" , "#------ Function number ", i , "-----------------------------------" ,"\n"),
append = T, file = file
)
cat( # print the function into the file
paste(names(funs)[i], "<-", func_text, collapse = "\n"),
append = TRUE, file = file
paste(names(funs)[i] , "<-", paste(capture.output(funs[[i]]), collapse = "\n"), collapse = "\n"),
append = T, file = file
)
cat(
paste("\n", "#-----------------------------------------", "\n"),
append = TRUE, file = file
paste("\n" , "#-----------------------------------------" ,"\n"),
append = T, file = file
)
}

cat( # writing at the end of the file how many new functions where added to it
paste("# A total of ", length(funs), " Functions where written into utils"),
append = T, file = file
Expand Down Expand Up @@ -238,3 +236,53 @@ violin_plot <- function(data, color_by){
return(plot2return)
}

get_package_source <- function(package_name, lockfile = "../renv.lock"){
# Read and parse the renv.lock file
lockfile_content <- fromJSON(lockfile)
snippet <- paste0('
# ShinyOmics R Code Download
# Load necassary packages ----
# Note that you do not need to install packages everytime you run the script
# The following will check whether the package is installed and if not, installs it
# We provide the version and repo of the package that was used in the project
# in case the you run into problems try to install the specifc version
# This command is requried only once per R installation. (uncomment if needed)
# install.packages("BiocManager", repos = "https://cloud.r-project.org")
# BiocManager::install(version = "',lockfile_content$Bioconductor$Version,'")
check_and_install_package <- function(package_name) {
for(package in package_name){
# Check if the package is installed
if (!requireNamespace(package, quietly = TRUE)) {
# If not installed, install the package
BiocManager::install(package)
}
}
}')
# Navigate to the specific package's source information
for(package in package_name){
if (package %in% names(lockfile_content$Packages)) {
package_info <- lockfile_content$Packages[[package]]
source_repo <- package_info$Repository
if(is.null(source_repo)){
# Biconductor Version
snippet <- paste0(snippet,"\n",
'check_and_install_package("',package,'")\n',
'library("',package,'") #tested with: source ',package_info$Source,', v.',package_info$Version)

}else{
# CRAN
# Biconductor Version
snippet <- paste0(snippet,"\n",
'check_and_install_package("',package,'")\n',
'library("',package,'") #tested with: source ',source_repo,', v.',package_info$Version)

}
} else {
# If the package is not found in the lockfile, return an error message
warning(paste(package, "not found in the lockfile"))
}
}
return(snippet)
}

0 comments on commit e194c56

Please sign in to comment.