diff --git a/.Rbuildignore b/.Rbuildignore index bd1d928..76bdd95 100755 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -20,3 +20,5 @@ _pkgdown.yml$ ^CITATION\.cff$ ^CHANGELOG\.md$ +^SplineOmics.BiocCheck$ + diff --git a/DESCRIPTION b/DESCRIPTION index 8516938..45dae9b 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,44 +3,67 @@ Type: Package Title: Streamlines the process of analysing omics timeseries data with splines Version: 0.1.0 Date: 2024-08-13 -Authors@R: person("Thomas", "Rauter", email = "thomas.rauter@plus.ac.at", role = c("aut", "cre")) -Maintainer: Thomas Rauter -Description: Timeseries analysis of omics data can be carried out by fitting spline curves to the data and using limma for hypothesis testing. For this, the right spline freedom and further hyperparameters must be identified, and the obtained hits clustered based on the spline shape.The R package splinetime streamlines this whole process and generates reports. -Depends: R (>= 4.3.0) +Authors@R: person("Thomas", "Rauter", + email = "thomas.rauter@plus.ac.at", + role = c("aut", "cre"), + comment = c(ORCID = "0009-0004-5578-3628")) +Description: SplineOmics streamlines the analysis of time-series omics data + by fitting spline curves and using limma for hypothesis testing. It requires + a data matrix with features (e.g., proteins, metabolites) in rows and time + point samples in columns, with no missing values. Metadata about the samples + can be provided through a separate meta table, and an optional annotation + table can supply additional feature identifiers. The package provides several + capabilities: exploratory data analysis through HTML reports with plots like + PCA and heatmaps, hyperparameter screening for limma splines, and spline-based + limma analysis to identify significant features. Users can cluster these + significant features and perform gene set enrichment analysis (GSEA) on the + clusters. All results are presented in HTML reports to facilitate easy + interpretation and visualization. License: MIT + file LICENSE URL: https://csbg.github.io/SplineOmics +BugReports: https://github.com/csbg/SplineOmics/issues +biocViews: TimeCourse, GeneExpression, Proteomics, Metabolomics, Transcriptomics, + Clustering, StatisticalMethod, Visualization, Software, GeneSetEnrichment +Depends: R (>= 4.3.0) Imports: - ComplexHeatmap(>= 2.18.0), - base64enc(>= 0.1-3), - dendextend(>= 1.17.1), - dplyr(>= 1.1.4), - ggplot2(>= 3.5.1), - ggrepel(>= 0.9.5), - here(>= 1.0.1), - limma(>= 3.58.1), - openxlsx(>= 4.2.5.2), - patchwork(>= 1.2.0), - pheatmap(>= 1.0.12), - progress(>= 1.2.3), - purrr(>= 1.0.2), - rlang(>= 1.1.4), - scales(>= 1.3.0), - svglite(>= 2.1.3), - tibble(>= 3.2.1), - tidyr(>= 1.3.1), - zip(>= 2.3.1) + ComplexHeatmap (>= 2.18.0), + base64enc (>= 0.1-3), + dendextend (>= 1.17.1), + dplyr (>= 1.1.4), + ggplot2 (>= 3.5.1), + ggrepel (>= 0.9.5), + here (>= 1.0.1), + limma (>= 3.58.1), + openxlsx (>= 4.2.5.2), + patchwork (>= 1.2.0), + pheatmap (>= 1.0.12), + progress (>= 1.2.3), + purrr (>= 1.0.2), + rlang (>= 1.1.4), + scales (>= 1.3.0), + svglite (>= 2.1.3), + tibble (>= 3.2.1), + tidyr (>= 1.3.1), + variancePartition (>= 1.14.0), + zip (>= 2.3.1), + grDevices, + grid, + splines, + stats, + tools, + utils Suggests: BiocManager, - edgeR(>= 4.0.16), - clusterProfiler(>= 4.10.1), + edgeR (>= 4.0.16), + clusterProfiler (>= 4.10.1), rmarkdown (>= 2.7), knitr, testthat, readxl, - rstudioapi(>= 0.16.0), + rstudioapi (>= 0.16.0), conflicted (>= 1.2.0) Encoding: UTF-8 -LazyData: true +LazyData: false RoxygenNote: 7.3.2 Config/testthat/edition: 3 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 42813d7..6433fa1 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -143,4 +143,7 @@ importFrom(tools,file_path_sans_ext) importFrom(utils,combn) importFrom(utils,head) importFrom(utils,tail) +importFrom(variancePartition,dream) +importFrom(variancePartition,eBayes) +importFrom(variancePartition,topTable) importFrom(zip,zip) diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..9877bc1 --- /dev/null +++ b/NEWS @@ -0,0 +1,7 @@ +PackageName 0.1.0 +================= +- Initial release of the package. + + + + diff --git a/R/SplineOmics-package.R b/R/SplineOmics-package.R index 7960872..532ca2c 100755 --- a/R/SplineOmics-package.R +++ b/R/SplineOmics-package.R @@ -1,12 +1,12 @@ #' Package Name: SplineOmics #' #' @description -#' The R package SplineOmics finds the significant features (hits) of +#' The R package SplineOmics finds the significant features (hits) of #' time-series -omics data by using splines and limma for hypothesis testing. -#' It then clusters the hits based on the spline shape while showing all +#' It then clusters the hits based on the spline shape while showing all #' results in summary HTML reports. -#' -#' For detailed documentation, vignettes, and examples, please visit the +#' +#' For detailed documentation, vignettes, and examples, please visit the #' [SplineOmics GitHub page](https://github.com/csbg/SplineOmics.git). #' #' @section Key Functions and Classes: @@ -17,30 +17,30 @@ #' an HTML report containg various plots, such as density plots #' and correlation heatmaps. #' - screen_limma_hyperparams: Allows the specify lists of different hyperparameters -#' to test, such as a degree of freedom of 2, 3, 4, -#' and adj.p-val thresholds, such as 0.1 and 0.05, +#' to test, such as a degree of freedom of 2, 3, 4, +#' and adj.p-val thresholds, such as 0.1 and 0.05, #' and tests all specified different values for all #' limma spline hyperparameters in a semi-combinatorial #' way. -#' - update_splineomics: Allows to change values of the SplineOmics object, for +#' - update_splineomics: Allows to change values of the SplineOmics object, for #' example after observing that outliers should be removed #' from the data (update the data parameter). -#' - run_limma_splines: Central function of the script, is called by the +#' - run_limma_splines: Central function of the script, is called by the #' screen_limma_hyperparams function and can be called to -#' get the limma spline analysis results (p-values for all +#' get the limma spline analysis results (p-values for all #' features (e.g. proteins)) with the hyperparameters, that #' were selected finally. -#' - create_limma_report: Creates an HTML report showing the run_limma_splines +#' - create_limma_report: Creates an HTML report showing the run_limma_splines #' results #' - cluster_hits: Clusters the splines of the hits (significant features) based #' on their shape and shows all results as plots in an HTML #' report. -#' - download_enrichr_databases: Allows to download the Enrichr databases for +#' - download_enrichr_databases: Allows to download the Enrichr databases for #' runnin clusterProfiler in the run_gsea function #' with them. #' - run_gsea: Runs clusterProfiler with the clustered hits by using the Enrichr #' databases. -#' +#' #' @section Package Options: #' None #' @@ -67,23 +67,23 @@ #' Optional dependencies #' #' These dependencies are only necessary for some functions: -#' +#' #' - **edgeR**: For preprocessing RNA-seq data in the run_limma_splines() fun. #' - **clusterProfiler**: For the run_gsea() function (gene set enrichment). #' - **rstudioapi**: For the open_tutorial() and open_template() functions. #' #' @section Authors: -#' - [Thomas-Rauter](https://github.com/Thomas-Rauter) - Wrote the package and -#' developed the approach with VSchaepertoens under guidance from nfortelny +#' - [Thomas-Rauter](https://github.com/Thomas-Rauter) - Wrote the package and +#' developed the approach with VSchaepertoens under guidance from nfortelny #' and skafdasschaf. -#' - [nfortelny](https://github.com/nfortelny) - Principal Investigator, +#' - [nfortelny](https://github.com/nfortelny) - Principal Investigator, #' provided guidance and support. -#' - [skafdasschaf](https://github.com/skafdasschaf) - Helped review code and +#' - [skafdasschaf](https://github.com/skafdasschaf) - Helped review code and #' provided improvement suggestions. -#' - [VSchaepertoens](https://github.com/VSchaepertoens) - Developed an internal -#' plotting function and contributed to exploratory data analysis and the +#' - [VSchaepertoens](https://github.com/VSchaepertoens) - Developed an internal +#' plotting function and contributed to exploratory data analysis and the #' overall approach. -#' +#' #' @section Maintainer: #' - Name: Thomas Rauter #' - Email: thomas.rauter@plus.ac.at diff --git a/R/cluster_hits.R b/R/cluster_hits.R index ad3429e..4a64a9e 100755 --- a/R/cluster_hits.R +++ b/R/cluster_hits.R @@ -20,47 +20,47 @@ #' specified directory and #' compiled into an HTML report. #' -#' @param splineomics An S3 object of class `SplineOmics` that contains all the +#' @param splineomics An S3 object of class `SplineOmics` that contains all the #' necessary data and parameters for the analysis, including: #' \itemize{ -#' \item \code{data}: The original expression dataset used for differential +#' \item \code{data}: The original expression dataset used for differential #' expression analysis. -#' \item \code{meta}: A dataframe containing metadata corresponding to the -#' \code{data}, must include a 'Time' column and any columns specified by +#' \item \code{meta}: A dataframe containing metadata corresponding to the +#' \code{data}, must include a 'Time' column and any columns specified by #' \code{conditions}. -#' \item \code{design}: A character of length 1 representing the limma +#' \item \code{design}: A character of length 1 representing the limma #' design formula. -#' \item \code{condition}: Character of length 1 specifying the column name +#' \item \code{condition}: Character of length 1 specifying the column name #' in \code{meta} used to define groups for analysis. #' \item \code{spline_params}: A list of spline parameters for the analysis. -#' \item \code{meta_batch_column}: A character string specifying the column +#' \item \code{meta_batch_column}: A character string specifying the column #' name in the metadata used for batch effect removal. -#' \item \code{meta_batch2_column}: A character string specifying the second +#' \item \code{meta_batch2_column}: A character string specifying the second #' column name in the metadata used for batch effect removal. #' \item \code{limma_splines_result}: A list of data frames, each representing -#' a top table from differential expression analysis, containing at least +#' a top table from differential expression analysis, containing at least #' 'adj.P.Val' and expression data columns. #' } #' @param clusters Character or integer vector specifying the number of clusters -#' @param adj_pthresholds Numeric vector of p-value thresholds for filtering +#' @param adj_pthresholds Numeric vector of p-value thresholds for filtering #' hits in each top table. #' @param adj_pthresh_avrg_diff_conditions p-value threshold for the results #' from the average difference of the condition limma result. Per default 0 ( #' turned off). -#' @param adj_pthresh_interaction_condition_time p-value threshold for the -#' results from the interaction of condition and time limma result. Per default +#' @param adj_pthresh_interaction_condition_time p-value threshold for the +#' results from the interaction of condition and time limma result. Per default #' 0 (turned off). #' @param genes A character vector containing the gene names of the features to #' be analyzed. -#' @param plot_info List containing the elements y_axis_label (string), +#' @param plot_info List containing the elements y_axis_label (string), #' time_unit (string), treatment_labels (character vector), -#' treatment_timepoints (integer vector). All can also be NA. -#' This list is used to add this info to the spline plots. +#' treatment_timepoints (integer vector). All can also be NA. +#' This list is used to add this info to the spline plots. #' time_unit is used to label the x-axis, and treatment_labels #' and -timepoints are used to create vertical dashed lines, -#' indicating the positions of the treatments (such as +#' indicating the positions of the treatments (such as #' feeding, temperature shift, etc.). -#' @param plot_options List with specific fields (cluster_heatmap_columns = +#' @param plot_options List with specific fields (cluster_heatmap_columns = #' Bool) that allow for customization of plotting behavior. #' @param report_dir Character string specifying the directory path where the #' HTML report and any other output files should be saved. @@ -84,26 +84,24 @@ cluster_hits <- function( adj_pthresholds = c(0.05), adj_pthresh_avrg_diff_conditions = 0, adj_pthresh_interaction_condition_time = 0, - genes = NULL, # Underlying genes of the features + genes = NULL, # Underlying genes of the features plot_info = list( y_axis_label = "Value", time_unit = "min", treatment_labels = NA, treatment_timepoints = NA - ), + ), plot_options = list( cluster_heatmap_columns = FALSE, meta_replicate_column = NULL ), report_dir = here::here(), - report = TRUE - ) { - + report = TRUE) { report_dir <- normalizePath( report_dir, mustWork = FALSE - ) - + ) + check_splineomics_elements( splineomics = splineomics, func_type = "cluster_hits" @@ -114,7 +112,7 @@ cluster_hits <- function( input_control <- InputControl$new(args) input_control$auto_validate() - top_tables <- splineomics[['limma_splines_result']][['time_effect']] + top_tables <- splineomics[["limma_splines_result"]][["time_effect"]] data <- splineomics[["data"]] meta <- splineomics[["meta"]] annotation <- splineomics[["annotation"]] @@ -129,20 +127,20 @@ cluster_hits <- function( # To set the default p-value threshold for ALL levels. if (is.numeric(adj_pthresholds) && - length(adj_pthresholds) == 1 && adj_pthresholds[1] == 0.05) { + length(adj_pthresholds) == 1 && adj_pthresholds[1] == 0.05) { levels <- unique(meta[[condition]]) adj_pthresholds <- rep(adj_pthresholds[1], length(levels)) } - + within_level_top_tables <- filter_top_tables( top_tables = top_tables, adj_pthresholds = adj_pthresholds, meta = meta, condition = condition - ) + ) huge_table_user_prompter(within_level_top_tables) - + all_levels_clustering <- perform_clustering( top_tables = within_level_top_tables, clusters = clusters, @@ -150,7 +148,7 @@ cluster_hits <- function( condition = condition, spline_params = spline_params, mode = mode - ) + ) report_info$limma_design <- c(design) report_info$meta_condition <- c(condition) @@ -158,12 +156,11 @@ cluster_hits <- function( meta_batch_column, meta_batch2_column, sep = ", " - ) - - - if (adj_pthresh_avrg_diff_conditions > 0 || - adj_pthresh_interaction_condition_time > 0) { - + ) + + + if (adj_pthresh_avrg_diff_conditions > 0 || + adj_pthresh_interaction_condition_time > 0) { spline_comp_plots <- generate_spline_comparisons( splineomics = splineomics, all_levels_clustering = all_levels_clustering, @@ -177,7 +174,7 @@ cluster_hits <- function( } else { spline_comp_plots <- NULL } - + if (!is.null(genes)) { genes <- clean_gene_symbols(genes) @@ -194,7 +191,7 @@ cluster_hits <- function( spline_params = spline_params, adj_pthresholds = adj_pthresholds, adj_pthresh_avrg_diff_conditions = adj_pthresh_avrg_diff_conditions, - adj_pthresh_interaction_condition_time = + adj_pthresh_interaction_condition_time = adj_pthresh_interaction_condition_time, report_dir = report_dir, mode = mode, @@ -206,7 +203,7 @@ cluster_hits <- function( plot_options = plot_options, feature_name_columns = feature_name_columns, spline_comp_plots = spline_comp_plots - ) + ) } else { plots <- "no plots, because report arg of cluster_hits() was set to FALSE" } @@ -219,44 +216,43 @@ cluster_hits <- function( return(x) } }) - + clustered_hits_levels <- list() - + for (i in seq_along(all_levels_clustering)) { clustering_level <- all_levels_clustering[[i]] element_name <- names(all_levels_clustering)[i] - + if (any(is.character(clustering_level))) { - clustered_hits_levels[[element_name]] <- + clustered_hits_levels[[element_name]] <- clustering_level - } - else { # normal list result - clustered_hits_levels[[element_name]] <- + } else { # normal list result + clustered_hits_levels[[element_name]] <- clustering_level$clustered_hits } } - + if (!is.null(genes)) { # Add gene column for the run_gsea() function. clustered_hits_levels <- lapply(clustered_hits_levels, function(df) { if (is.character(df)) { - return(df) + return(df) } df$gene <- genes[df$feature] return(df) }) } - + print_info_message( message_prefix = "Clustering the hits", report_dir = report_dir ) - + list( all_levels_clustering = all_levels_clustering, plots = plots, clustered_hits_levels = clustered_hits_levels - ) + ) } @@ -268,37 +264,35 @@ filter_top_tables <- function( top_tables, adj_pthresholds, meta, - condition - ) { - + condition) { result <- check_between_level_pattern(top_tables) - if (result$between_levels) { # between_level analysis + if (result$between_levels) { # between_level analysis if (result$index_with_pattern == 1) { within_level_top_tables_index <- 2 between_level_top_tables_index <- 1 - } else { # between level top_tables are at index 2 + } else { # between level top_tables are at index 2 within_level_top_tables_index <- 1 between_level_top_tables_index <- 2 } within_level_top_tables <- top_tables[[within_level_top_tables_index]] between_level_top_tables <- top_tables[[between_level_top_tables_index]] - - } else { # no between level analysis + } else { # no between level analysis within_level_top_tables <- top_tables } for (i in seq_along(within_level_top_tables)) { - within_level_top_table <- within_level_top_tables[[i]] level <- unique(meta[[condition]])[i] if (result$between_levels) { - hit_indices <- get_level_hit_indices(between_level_top_tables, - level, - adj_pthresholds) - } else { # within level + hit_indices <- get_level_hit_indices( + between_level_top_tables, + level, + adj_pthresholds + ) + } else { # within level hit_indices <- within_level_top_table[["feature_nr"]][ within_level_top_table[["adj.P.Val"]] < adj_pthresholds[i] ] @@ -306,16 +300,17 @@ filter_top_tables <- function( top_table_filtered <- within_level_top_table[within_level_top_table[["feature_nr"]] - %in% hit_indices, ] + %in% hit_indices, ] if (nrow(top_table_filtered) < 2) { - message(paste("Level", level, "has < 2 hits. Skipping clustering for", - "this level")) + message(paste( + "Level", level, "has < 2 hits. Skipping clustering for", + "this level" + )) within_level_top_tables[[i]] <- NA } else { within_level_top_tables[[i]] <- top_table_filtered } - } if (all(is.na(within_level_top_tables))) { @@ -326,7 +321,7 @@ filter_top_tables <- function( } -#' Check if any table in a list has more than 300 rows and prompt user for +#' Check if any table in a list has more than 300 rows and prompt user for #' input. #' #' This function iterates over a list of tables and checks if any table has @@ -334,40 +329,38 @@ filter_top_tables <- function( #' If such a table is found, it prompts the user to proceed or stop. #' #' @param tables A list of data frames. -#' @return NULL. This function is used for its side effects (prompting the +#' @return NULL. This function is used for its side effects (prompting the #' user and potentially stopping the script). -#' +#' huge_table_user_prompter <- function(tables) { - for (i in seq_along(tables)) { - if (any(is.logical(tables[[i]]))) { next } - + if (nrow(tables[[i]]) > 500) { # Prompt the user for input while (TRUE) { user_input <- readline(prompt = paste( "The table", - names(tables)[i], + names(tables)[i], "has more than 500 rows. Do you want to proceed? (y/n): " - )) + )) user_input <- tolower(user_input) - + # Check user input - if (user_input == 'y') { + if (user_input == "y") { # Proceed print("Proceeding...") - break - } else if (user_input == 'n') { - stop("Script stopped. User chose not to proceed.", call. = FALSE) + break + } else if (user_input == "n") { + stop_call_false("Script stopped. User chose not to proceed.") } else { # Invalid input, ask the user again - cat(paste( - "Invalid input. Please type 'y' to proceed or 'n' to stop", - "the script.\n" - )) + message( + "Invalid input. Please type 'y' to proceed or 'n' to stop", + "the script." + ) } } } @@ -400,9 +393,7 @@ perform_clustering <- function( meta, condition, spline_params, - mode - ) { - + mode) { levels <- unique(meta[[condition]]) all_levels_clustering <- mapply( @@ -415,10 +406,10 @@ perform_clustering <- function( condition = condition, spline_params = spline_params, mode = mode - ), + ), SIMPLIFY = FALSE - ) # Return a list - + ) # Return a list + return(all_levels_clustering) } @@ -438,10 +429,10 @@ perform_clustering <- function( #' such as gene and uniprotID, for example. #' @param genes Character vector containing the genes of the features. #' @param spline_params A list of spline parameters for the analysis. -#' @param adj_pthresholds Numeric vector, containing a float < 1 > 0 as each +#' @param adj_pthresholds Numeric vector, containing a float < 1 > 0 as each #' value. There is one float for every level, and this is -#' the adj. p-value threshold. -#' @param adj_pthresh_avrg_diff_conditions Float +#' the adj. p-value threshold. +#' @param adj_pthresh_avrg_diff_conditions Float #' @param adj_pthresh_interaction_condition_time Float #' @param report_dir A character string specifying the report directory. #' @param mode A character string specifying the mode @@ -449,24 +440,24 @@ perform_clustering <- function( #' @param report_info An object containing report information. #' @param design A string representing the limma design formula #' @param meta_batch_column A character string specifying the meta batch column. -#' @param meta_batch2_column A character string specifying the second meta +#' @param meta_batch2_column A character string specifying the second meta #' batch column. -#' @param plot_info List containing the elements y_axis_label (string), +#' @param plot_info List containing the elements y_axis_label (string), #' time_unit (string), treatment_labels (character vector), -#' treatment_timepoints (integer vector). All can also be NA. -#' This list is used to add this info to the spline plots. +#' treatment_timepoints (integer vector). All can also be NA. +#' This list is used to add this info to the spline plots. #' time_unit is used to label the x-axis, and treatment_labels #' and -timepoints are used to create vertical dashed lines, -#' indicating the positions of the treatments (such as +#' indicating the positions of the treatments (such as #' feeding, temperature shift, etc.). -#' @param plot_options List with specific fields (cluster_heatmap_columns = +#' @param plot_options List with specific fields (cluster_heatmap_columns = #' Bool) that allow for customization of plotting behavior. -#' @param feature_name_columns Character vector containing the column names of +#' @param feature_name_columns Character vector containing the column names of #' the annotation info that describe the features. -#' This argument is used to specify in the HTML +#' This argument is used to specify in the HTML #' report how exactly the feature names displayed #' above each individual spline plot have been -#' created. Use the same vector that was used to +#' created. Use the same vector that was used to #' create the row headers for the data matrix! #' @param spline_comp_plots List containing the list of lists with all #' the plots for all the pairwise comparisons of the condition in terms of @@ -505,9 +496,7 @@ make_clustering_report <- function( plot_info, plot_options, feature_name_columns, - spline_comp_plots - ) { - + spline_comp_plots) { # Optionally remove the batch-effect with the batch column and design matrix # For mode == "integrated", the batch-effect is removed from the whole data # For mode == "isolated", the batch-effect is removed for every level @@ -520,15 +509,14 @@ make_clustering_report <- function( design = design, mode = mode, spline_params = spline_params - ) + ) # To extract the stored value for the potential auto cluster decision. clusters <- c() for (i in seq_along(all_levels_clustering)) { - if (is.null(all_levels_clustering[[i]]) || - all(is.na(all_levels_clustering[[i]]))) { + all(is.na(all_levels_clustering[[i]]))) { next } @@ -550,7 +538,7 @@ make_clustering_report <- function( all_levels_clustering = all_levels_clustering, time_unit_label = time_unit_label, cluster_heatmap_columns = plot_options[["cluster_heatmap_columns"]] - ) + ) # log2_intensity_shape <- plot_log2_intensity_shapes() @@ -560,10 +548,9 @@ make_clustering_report <- function( q <- 0 for (i in seq_along(all_levels_clustering)) { - # When a level has < 2 hits if (is.null(all_levels_clustering[[i]]) || - all(is.na(all_levels_clustering[[i]]))) { + all(is.na(all_levels_clustering[[i]]))) { next } else { q <- q + 1 @@ -574,19 +561,18 @@ make_clustering_report <- function( levels <- unique(meta[[condition]]) if (length(levels) >= i) { - level <- levels[i] # Construct header name header_name <- level - + nr_hits <- nrow(level_clustering$clustered_hits) header_info <- list( header_name = header_name, nr_hits = nr_hits, adj_pvalue_threshold = adj_pthresholds[i] - ) + ) level_headers_info[[i]] <- header_info } @@ -597,19 +583,19 @@ make_clustering_report <- function( hc = level_clustering$hc, clusters = level_clustering[["clustered_hits"]][["cluster"]], k = clusters[q] - ) + ) p_curves <- plot_all_mean_splines( curve_values = curve_values, plot_info = plot_info, level = level - ) + ) cluster_mean_splines <- plot_cluster_mean_splines( # Plot for each cluster curve_values = curve_values, plot_info = plot_info, level = level - ) + ) top_table <- level_clustering$top_table levels <- as.character(unique(meta[[condition]])) @@ -618,27 +604,26 @@ make_clustering_report <- function( if (mode == "integrated") { data_level <- datas[[i]][, col_indices] - } else { # mode == "isolated" + } else { # mode == "isolated" data_level <- datas[[i]] } meta_level <- meta |> dplyr::filter(.data[[condition]] == levels[i]) clusters_spline_plots <- list() - - for (nr_cluster in unique(stats::na.omit(top_table$cluster))) { + for (nr_cluster in unique(stats::na.omit(top_table$cluster))) { nr_of_hits <- sum( level_clustering$clustered_hits$cluster == nr_cluster, na.rm = TRUE - ) + ) main_title <- paste( "Cluster", nr_cluster, " | Hits:", - nr_of_hits, + nr_of_hits, sep = " " - ) + ) top_table_cluster <- top_table |> dplyr::filter(!!rlang::sym("cluster") == nr_cluster) @@ -655,60 +640,59 @@ make_clustering_report <- function( adj_pthreshold = adj_pthresholds[i], replicate_column = plot_options[["meta_replicate_column"]], level = level - ) + ) clusters_spline_plots[[length(clusters_spline_plots) + 1]] <- list( spline_plots = spline_plots, cluster_main_title = main_title - ) + ) } plots <- c( plots, - new_level = "level_header", # is the signal for the plotting code + new_level = "level_header", # is the signal for the plotting code dendrogram = list(dendrogram), p_curves = list(p_curves), cluster_mean_splines = list(cluster_mean_splines), heatmap = heatmaps[[i]], - individual_spline_plots = clusters_spline_plots # gets expanded like this - ) + individual_spline_plots = clusters_spline_plots # gets expanded like this + ) # For every plot in plots, this determines the size in the HTML plots_sizes <- c( plots_sizes, - 999, # dummy size for "next_level" signal + 999, # dummy size for "next_level" signal 1.5, 1.5, 1, 1.5, rep(1, length(clusters_spline_plots)) - ) + ) } topTables <- list() # Loop over each element in all_levels_clustering for (i in seq_along(all_levels_clustering)) { - if (is.logical(all_levels_clustering[[i]])) next - + # Get the current element, which is a list current_element <- all_levels_clustering[[i]] - + # Extract the top_table element top_table_element <- current_element$top_table - + # Get the name of the outer list element element_name <- names(all_levels_clustering)[i] - + # Trim the name to 30 characters if necessary if (nchar(element_name) > 30) { element_name <- substr(element_name, 1, 30) } - + topTables[[element_name]] <- top_table_element } - + if (!is.null(genes)) { enrichr_format <- prepare_gene_lists_for_enrichr( all_levels_clustering, @@ -717,7 +701,7 @@ make_clustering_report <- function( } else { enrichr_format <- NA } - + all_levels_clustering <- merge_annotation_all_levels_clustering( all_levels_clustering = all_levels_clustering, annotation = annotation @@ -738,14 +722,14 @@ make_clustering_report <- function( enrichr_format = enrichr_format, adj_pthresholds = adj_pthresholds, adj_pthresh_avrg_diff_conditions = adj_pthresh_avrg_diff_conditions, - adj_pthresh_interaction_condition_time = + adj_pthresh_interaction_condition_time = adj_pthresh_interaction_condition_time, report_type = "cluster_hits", feature_name_columns = feature_name_columns, mode = mode, filename = "report_clustered_hits", report_dir = report_dir - ) + ) return(plots) } @@ -754,90 +738,90 @@ make_clustering_report <- function( #' Generate spline comparison plots for all condition pairs #' #' @description -#' This function generates spline comparison plots for all pairwise -#' combinations of conditions in the metadata. For each condition pair, it -#' compares the time effects of two conditions, plots the data points, and -#' overlays the fitted spline curves. The function only generates plots if -#' the adjusted p-values for the average difference between conditions and the +#' This function generates spline comparison plots for all pairwise +#' combinations of conditions in the metadata. For each condition pair, it +#' compares the time effects of two conditions, plots the data points, and +#' overlays the fitted spline curves. The function only generates plots if +#' the adjusted p-values for the average difference between conditions and the #' interaction between condition and time are below the specified thresholds. #' #' @param splineomics A list containing the splineomics results, including -#' time effects, -#' average difference between conditions, and interaction between condition +#' time effects, +#' average difference between conditions, and interaction between condition #' and time. -#' @param all_levels_clustering A list containing the X matrices for each -#' condition, used +#' @param all_levels_clustering A list containing the X matrices for each +#' condition, used #' for spline fitting. #' @param data The data matrix containing the measurements. #' @param meta The metadata associated with the measurements, which includes #' the condition. #' @param condition Column name of meta that contains the levels of the #' experiment. -#' @param plot_info A list containing plotting information such as time unit +#' @param plot_info A list containing plotting information such as time unit #' and axis labels. #' @param adj_pthresh_avrg_diff_conditions The adjusted p-value threshold for -#' the average +#' the average #' difference between conditions. -#' @param adj_pthresh_interaction The adjusted p-value threshold for the -#' interaction +#' @param adj_pthresh_interaction The adjusted p-value threshold for the +#' interaction #' between condition and time. -#' +#' #' @return A list of lists containing the comparison plots and feature names #' for each condition pair. -#' +#' generate_spline_comparisons <- function( splineomics, - all_levels_clustering, # This list contains the X matrices + all_levels_clustering, # This list contains the X matrices data, meta, condition, - plot_info, - adj_pthresh_avrg_diff_conditions, - adj_pthresh_interaction -) { + plot_info, + adj_pthresh_avrg_diff_conditions, + adj_pthresh_interaction) { # Initialize the list that will store the results comparison_plots <- list() - + # Check if all three elements are present - if (length(splineomics[['limma_splines_result']]) == 3) { + if (length(splineomics[["limma_splines_result"]]) == 3) { # Extract the three named elements - time_effect <- splineomics[['limma_splines_result']][['time_effect']] - avrg_diff_conditions <- - splineomics[['limma_splines_result']][['avrg_diff_conditions']] - interaction_condition_time <- - splineomics[['limma_splines_result']][['interaction_condition_time']] + time_effect <- splineomics[["limma_splines_result"]][["time_effect"]] + avrg_diff_conditions <- + splineomics[["limma_splines_result"]][["avrg_diff_conditions"]] + interaction_condition_time <- + splineomics[["limma_splines_result"]][["interaction_condition_time"]] # Get the unique conditions from the meta data conditions <- unique(meta[[condition]]) - + # Generate all pairwise combinations of conditions condition_pairs <- utils::combn(conditions, 2, simplify = FALSE) - + # Loop over all condition pairs and generate plots for (pair in condition_pairs) { condition_1 <- pair[1] condition_2 <- pair[2] - + # Sort the current pair of conditions sorted_conditions <- sort(c(condition_1, condition_2)) - + # Initialize matched dataframes as NULL matched_avrg_diff <- NULL matched_interaction_cond_time <- NULL - + # Search for the correct dataframe in avrg_diff_conditions for (df_name in names(avrg_diff_conditions)) { # Extract the part after 'avrg_diff_' and split it by '_vs_' - conditions_in_df <- strsplit(sub( - "avrg_diff_", - "", - df_name + conditions_in_df <- strsplit( + sub( + "avrg_diff_", + "", + df_name ), "_vs_" - )[[1]] - + )[[1]] + sorted_conditions_in_df <- sort(conditions_in_df) - + # Check if the sorted conditions in the dataframe match the current pair if (identical(sorted_conditions, sorted_conditions_in_df)) { matched_avrg_diff <- avrg_diff_conditions[[df_name]] @@ -849,16 +833,17 @@ generate_spline_comparisons <- function( for (df_name in names(interaction_condition_time)) { # Extract the part after 'time_interaction_condition_' # and split it by '_vs_' - conditions_in_df <- strsplit(sub( - "time_interaction_", - "", - df_name + conditions_in_df <- strsplit( + sub( + "time_interaction_", + "", + df_name ), "_vs_" - )[[1]] - + )[[1]] + sorted_conditions_in_df <- sort(conditions_in_df) - + # Check if the sorted conditions in the dataframe match the # current pair if (identical(sorted_conditions, sorted_conditions_in_df)) { @@ -868,12 +853,12 @@ generate_spline_comparisons <- function( } # If both matched dataframes are found, generate plots - if (!is.null(matched_avrg_diff) - && !is.null(matched_interaction_cond_time)) { + if (!is.null(matched_avrg_diff) && + !is.null(matched_interaction_cond_time)) { # Get the corresponding dataframes from time_effect time_effect_1 <- time_effect[[paste0(condition, "_", condition_1)]] time_effect_2 <- time_effect[[paste0(condition, "_", condition_2)]] - + # Get the respective X matrices from all_levels_clustering X_1 <- all_levels_clustering[[paste0(condition, "_", condition_1)]]$X X_2 <- all_levels_clustering[[paste0(condition, "_", condition_2)]]$X @@ -895,7 +880,7 @@ generate_spline_comparisons <- function( adj_pthresh_avrg_diff_conditions = adj_pthresh_avrg_diff_conditions, adj_pthresh_interaction = adj_pthresh_interaction ) - + # Add the plot list to the comparison_plots list, # naming it by the condition pair plot_list_name <- paste0(condition_1, "_vs_", condition_2) @@ -905,25 +890,24 @@ generate_spline_comparisons <- function( } else { message("The required elements are not present in the splineomics list.") } - + # Return the list containing all plot lists return(comparison_plots) } - #' Clean the Gene Symbols #' #' @description -#' This function preprocesses a vector of gene names by cleaning and -#' formatting them. It removes any non-alphanumeric characters after the -#' first block of alphanumeric characters and converts the remaining +#' This function preprocesses a vector of gene names by cleaning and +#' formatting them. It removes any non-alphanumeric characters after the +#' first block of alphanumeric characters and converts the remaining #' characters to uppercase. #' #' @param genes A character vector containing gene names to be cleaned. #' -#' @return A character vector of cleaned gene symbols (names) with the same -#' length as the input. The cleaned names will be in uppercase, and any +#' @return A character vector of cleaned gene symbols (names) with the same +#' length as the input. The cleaned names will be in uppercase, and any #' invalid or empty gene names will be replaced with NA. #' clean_gene_symbols <- function(genes) { @@ -933,30 +917,30 @@ clean_gene_symbols <- function(genes) { "before the first whitespace or end of the string. The extracted ", "substring is then converted to uppercase.\033[0m" )) - + message(paste0( - "\033[38;5;214mIf this does not produce valid gene symbols for your gene", + "\033[38;5;214mIf this does not produce valid gene symbols for your gene", "set enrichment analysis, modify ", "the genes argument of this function (cluster_hits) accordingly!\033[0m" )) - + # Apply cleaning process to each gene - cleaned_genes <- sapply(genes, function(gene_name) { + cleaned_genes <- vapply(genes, function(gene_name) { if (!is.na(gene_name) && gene_name != "") { # Replace all non-alphanumeric characters with whitespace gene_name <- gsub("[^A-Za-z0-9]", " ", gene_name) - - # Extract the first block of alphanumeric characters before the + + # Extract the first block of alphanumeric characters before the # first whitespace clean_gene_name <- sub("^([A-Za-z0-9]+).*", "\\1", gene_name) - + # Convert to uppercase toupper(clean_gene_name) } else { NA } - }) - + }, character(1)) + # Return cleaned genes, keeping the same index as input return(cleaned_genes) } @@ -968,31 +952,30 @@ clean_gene_symbols <- function(genes) { #' Check for Between-Level Patterns in Top Tables #' #' @description -#' This function checks if any of the elements within a list of top tables +#' This function checks if any of the elements within a list of top tables #' contain element names that match the specified between-level pattern. #' -#' @param top_tables A list where each element is itself a list containing +#' @param top_tables A list where each element is itself a list containing #' named elements. #' #' @return A list with two elements: #' \describe{ -#' \item{between_levels}{A logical value indicating whether any element names +#' \item{between_levels}{A logical value indicating whether any element names #' match the between-level pattern.} -#' \item{index_with_pattern}{The index of the first element in `top_tables` -#' where all names match the between-level pattern, or NA if no match is +#' \item{index_with_pattern}{The index of the first element in `top_tables` +#' where all names match the between-level pattern, or NA if no match is #' found.} #' } #' #' @details -#' The function iterates over each element in `top_tables`. For each element -#' that -#' is a list, it checks if all names within that inner list match the pattern -#' `".+_vs_.+"`. If a match is found, the function sets `between_levels` to TRUE -#' and records the index of the matching element. The search stops at the first +#' The function iterates over each element in `top_tables`. For each element +#' that +#' is a list, it checks if all names within that inner list match the pattern +#' `".+_vs_.+"`. If a match is found, the function sets `between_levels` to TRUE +#' and records the index of the matching element. The search stops at the first #' match. -#' +#' check_between_level_pattern <- function(top_tables) { - # Initialize variables between_levels <- FALSE index_with_pattern <- NA @@ -1021,39 +1004,37 @@ check_between_level_pattern <- function(top_tables) { return(list( between_levels = between_levels, index_with_pattern = index_with_pattern - )) + )) } #' Get Hit Indices for a Specific Level #' #' @description -#' This function retrieves unique feature indices from a list of between-level +#' This function retrieves unique feature indices from a list of between-level #' top tables for a specified level, based on adjusted p-value thresholds. #' -#' @param between_level_top_tables A list of data frames containing the +#' @param between_level_top_tables A list of data frames containing the #' between-level top tables. -#' @param level A string specifying the level to search for within the names +#' @param level A string specifying the level to search for within the names #' of the data frames. -#' @param adj_pthresholds A numeric vector of adjusted p-value thresholds for +#' @param adj_pthresholds A numeric vector of adjusted p-value thresholds for #' each data frame in `between_level_top_tables`. #' -#' @return A vector of unique feature indices that meet the adjusted p-value +#' @return A vector of unique feature indices that meet the adjusted p-value #' threshold criteria for the specified level. #' #' @details -#' The function iterates over each data frame in `between_level_top_tables`. For -#' each data frame whose name contains the specified level (case insensitive), -#' it identifies the rows where the adjusted p-value is below the corresponding -#' threshold. The function then extracts the feature indices from these rows and +#' The function iterates over each data frame in `between_level_top_tables`. For +#' each data frame whose name contains the specified level (case insensitive), +#' it identifies the rows where the adjusted p-value is below the corresponding +#' threshold. The function then extracts the feature indices from these rows and #' compiles a unique list of these indices. -#' +#' get_level_hit_indices <- function( between_level_top_tables, level, - adj_pthresholds - ) { - + adj_pthresholds) { unique_hit_indices <- c() # Loop through the elements of the list @@ -1073,11 +1054,13 @@ get_level_hit_indices <- function( # Extract the feature indices from the identified rows feature_indices <- within_level_top_table[hit_indices, "feature_nr"] feature_indices <- within_level_top_table[hit_indices, - "feature_nr", drop = TRUE] + "feature_nr", + drop = TRUE + ] unique_hit_indices <- c( unique_hit_indices, feature_indices - ) + ) } } @@ -1115,14 +1098,12 @@ process_level_cluster <- function( meta, condition, spline_params, - mode - ) { - + mode) { # means that it had < 2 hits. if (is.null(top_table) || all(is.na(top_table))) { return(NA) } - + curve_results <- get_curve_values( top_table = top_table, level = level, @@ -1130,7 +1111,7 @@ process_level_cluster <- function( condition = condition, spline_params = spline_params, mode = mode - ) + ) normalized_curves <- normalize_curves(curve_results$curve_values) @@ -1140,7 +1121,7 @@ process_level_cluster <- function( k = cluster_size, smooth_timepoints = curve_results$smooth_timepoints, top_table = top_table - ) + ) clustering_result$X <- curve_results$X return(clustering_result) @@ -1150,20 +1131,20 @@ process_level_cluster <- function( #' Remove Batch Effect from Cluster Hits #' #' @description -#' This function removes batch effects from the data for each level specified -#' by the condition. It supports both isolated and integrated modes, with +#' This function removes batch effects from the data for each level specified +#' by the condition. It supports both isolated and integrated modes, with #' optional handling for a second batch column. #' #' @param data A dataframe containing the main data. #' @param meta A dataframe containing meta information. -#' @param condition A string specifying the column in `meta` that divides the +#' @param condition A string specifying the column in `meta` that divides the #' experiment into levels. -#' @param meta_batch_column A string specifying the column in `meta` that +#' @param meta_batch_column A string specifying the column in `meta` that #' indicates batch information. -#' @param meta_batch2_column A string specifying the second batch column in +#' @param meta_batch2_column A string specifying the second batch column in #' `meta`, if applicable. #' @param design A design matrix for the experiment. -#' @param mode A string indicating the mode of operation: "isolated" or +#' @param mode A string indicating the mode of operation: "isolated" or #' "integrated". #' @param spline_params A list of spline parameters for the design matrix. #' @@ -1172,16 +1153,16 @@ process_level_cluster <- function( #' @details #' The function operates in two modes: #' \describe{ -#' \item{isolated}{Processes each level independently, using only data from +#' \item{isolated}{Processes each level independently, using only data from #' that level.} #' \item{integrated}{Processes the entire dataset together.} #' } -#' If `meta_batch_column` is specified, the function removes batch effects using -#' `removeBatchEffect`. If a second batch column (`meta_batch2_column`) is +#' If `meta_batch_column` is specified, the function removes batch effects using +#' `removeBatchEffect`. If a second batch column (`meta_batch2_column`) is #' specified, it is also included in the batch effect removal. #' #' @importFrom limma removeBatchEffect -#' +#' remove_batch_effect_cluster_hits <- function( data, meta, @@ -1190,18 +1171,14 @@ remove_batch_effect_cluster_hits <- function( meta_batch2_column, design, mode, - spline_params - ) { - + spline_params) { datas <- list() n <- length(unique(meta[[condition]])) level_indices <- as.integer(1:n) unique_levels <- unique(meta[[condition]]) if (!is.null(meta_batch_column)) { - for (level_index in level_indices) { - # Take only the data from the level for mode == "isolated" if (mode == "isolated") { level <- unique_levels[level_index] @@ -1209,17 +1186,19 @@ remove_batch_effect_cluster_hits <- function( data_copy <- data[, level_columns] meta_copy <- meta[meta[[condition]] == level, , drop = FALSE] } else { - data_copy <- data # Take the full data for mode == "integrated" + data_copy <- data # Take the full data for mode == "integrated" meta_copy <- meta - level_index <- 1L # spline_params here has only one set of params + level_index <- 1L # spline_params here has only one set of params } - design_matrix <- design2design_matrix( + result <- design2design_matrix( meta = meta_copy, spline_params = spline_params, level_index = level_index, design = design - ) + ) + + design_matrix <- result[["design_matrix"]] # The batch columns are not allowed to be in the design_matrix for # removeBatchEffect. Instead the batch column is specified with batch = @@ -1227,10 +1206,10 @@ remove_batch_effect_cluster_hits <- function( paste0( "^", meta_batch_column - ), + ), colnames(design_matrix) - ) - + ) + design_matrix <- design_matrix[, -batch_columns] args <- list( @@ -1238,20 +1217,19 @@ remove_batch_effect_cluster_hits <- function( batch = meta_copy[[meta_batch_column]], design = design_matrix ) - + if (mode == "isolated") { - level <- unique_levels[level_index] meta_copy <- meta[meta[[condition]] == level, , drop = FALSE] - + if (!is.null(meta_batch2_column) && - length(unique(meta_copy[[meta_batch2_column]])) > 1) { + length(unique(meta_copy[[meta_batch2_column]])) > 1) { args$batch2 <- meta_copy[[meta_batch2_column]] } - } else { # mode == integrated - + } else { # mode == integrated + if (!is.null(meta_batch2_column) && - length(unique(meta_copy[[meta_batch2_column]])) > 1) { + length(unique(meta_copy[[meta_batch2_column]])) > 1) { args$batch2 <- meta_copy[[meta_batch2_column]] } } @@ -1259,26 +1237,24 @@ remove_batch_effect_cluster_hits <- function( data_copy <- do.call( limma::removeBatchEffect, args - ) + ) # For mode == "integrated", all elements are identical datas <- c( datas, list(data_copy) - ) + ) } - - } else { # no meta batch column specified, just return right data + } else { # no meta batch column specified, just return right data for (level_index in level_indices) { - # Take only the data from the level for mode == "isolated" if (mode == "isolated") { level <- unique_levels[level_index] level_columns <- which(meta[[condition]] == level) data_copy <- data[, level_columns] } else { - data_copy <- data # Take the full data for mode == "integrated" + data_copy <- data # Take the full data for mode == "integrated" } datas <- c(datas, list(data_copy)) @@ -1298,13 +1274,13 @@ remove_batch_effect_cluster_hits <- function( #' @param meta A dataframe containing metadata. #' @param mode A character vector with length 1, specifying the type of limma #' design formula (integrated for formulas with interaction effects -#' between the levels, isolated for formulas where each level is +#' between the levels, isolated for formulas where each level is #' analysed in isolation (no interaction effects)) #' @param condition A character string specifying the condition. #' @param all_levels_clustering A list containing clustering results for each #' level within the condition. #' @param time_unit_label A character string specifying the time unit label. -#' @param cluster_heatmap_columns Boolean specifying wether to cluster the +#' @param cluster_heatmap_columns Boolean specifying wether to cluster the #' columns of the heatmap or not. #' #' @return A list of ComplexHeatmap heatmap objects for each level. @@ -1326,9 +1302,7 @@ plot_heatmap <- function( condition, all_levels_clustering, time_unit_label, - cluster_heatmap_columns - ) { - + cluster_heatmap_columns) { BASE_TEXT_SIZE_PT <- 5 ht_opt( @@ -1346,18 +1320,17 @@ plot_heatmap <- function( legend_title_gp = gpar(fontsize = BASE_TEXT_SIZE_PT), legend_border = FALSE ) - - ht_opt$message = FALSE + + ht_opt$message <- FALSE levels <- unique(meta[[condition]]) heatmaps <- list() - + # Generate a heatmap for every level for (i in seq_along(all_levels_clustering)) { - # When a level has < 2 hits if (is.null(all_levels_clustering[[i]]) || - all(is.na(all_levels_clustering[[i]]))) { + all(is.na(all_levels_clustering[[i]]))) { heatmaps[[length(heatmaps) + 1]] <- NA next } @@ -1372,28 +1345,28 @@ plot_heatmap <- function( if (mode == "integrated") { data_level <- datas[[i]][, level_indices] - } else { # mode == "isolated" + } else { # mode == "isolated" data_level <- datas[[i]] } - data_level <- data_level[as.numeric(clusters$feature),] + data_level <- data_level[as.numeric(clusters$feature), ] z_score <- t(scale(t(data_level))) meta_level <- meta[level_indices, ] - + row_labels <- truncate_row_names(rownames(data_level)) - - if (is.null(cluster_heatmap_columns)) { # set default value + + if (is.null(cluster_heatmap_columns)) { # set default value cluster_heatmap_columns <- FALSE } - + ht <- ComplexHeatmap::Heatmap( z_score, name = paste0( - "left-labels = cluster,", + "left-labels = cluster,", "top-labels = time" - ), + ), use_raster = TRUE, column_split = meta_level$Time, cluster_columns = cluster_heatmap_columns, @@ -1402,7 +1375,7 @@ plot_heatmap <- function( heatmap_legend_param = list( title = "z-score of log2 values", title_position = "lefttop-rot" - ), + ), row_gap = unit(2, "pt"), column_gap = unit(2, "pt"), # width = unit(2, "mm") * ncol(z_score) + @@ -1413,7 +1386,8 @@ plot_heatmap <- function( row_labels = row_labels, show_column_names = TRUE, column_names_rot = 70, - column_names_gp = gpar(fontsize = 5)) + column_names_gp = gpar(fontsize = 5) + ) heatmaps[[length(heatmaps) + 1]] <- ht } @@ -1445,9 +1419,7 @@ plot_heatmap <- function( plot_dendrogram <- function( hc, clusters, - k -) { - + k) { # Convert hc to dendrogram dend <- stats::as.dendrogram(hc) @@ -1467,7 +1439,7 @@ plot_dendrogram <- function( ordered_colors <- colors[match( unique_cluster_order, sort(unique(clusters)) - )] + )] # Apply the reordered colors to the branches of the dendrogram dend_colored <- dendextend::color_branches( @@ -1505,7 +1477,8 @@ plot_dendrogram <- function( axis.ticks.x = ggplot2::element_blank(), axis.text.y = ggplot2::element_blank(), axis.ticks.y = ggplot2::element_blank(), - plot.title = ggplot2::element_text(size = 9) + plot.title = ggplot2::element_text(size = 9), + legend.position = "none" ) return(p_dend) @@ -1520,13 +1493,13 @@ plot_dendrogram <- function( #' #' @param curve_values A dataframe containing curve values and cluster #' assignments. -#' @param plot_info List containing the elements y_axis_label (string), +#' @param plot_info List containing the elements y_axis_label (string), #' time_unit (string), treatment_labels (character vector), -#' treatment_timepoints (integer vector). All can also be NA. -#' This list is used to add this info to the spline plots. +#' treatment_timepoints (integer vector). All can also be NA. +#' This list is used to add this info to the spline plots. #' time_unit is used to label the x-axis, and treatment_labels #' and -timepoints are used to create vertical dashed lines, -#' indicating the positions of the treatments (such as +#' indicating the positions of the treatments (such as #' feeding, temperature shift, etc.). #' @param level One of the unique values of the meta condition column. This is #' a factor that separates the experiment. @@ -1541,9 +1514,7 @@ plot_dendrogram <- function( plot_all_mean_splines <- function( curve_values, plot_info, - level - ) { - + level) { time <- as.numeric(colnames(curve_values)[-length(colnames(curve_values))]) clusters <- unique(curve_values$cluster) @@ -1554,43 +1525,44 @@ plot_all_mean_splines <- function( # Filter rows for the current cluster subset_hits <- curve_values[curve_values$cluster == current_cluster, ] last_timepoint <- (which(names(curve_values) == "cluster")) - 1 - average_curve <- colMeans(subset_hits[,1:last_timepoint]) + average_curve <- colMeans(subset_hits[, 1:last_timepoint]) # Create a data frame for the average curve with an additional 'Cluster' # column curve_df <- data.frame( Time = time, Value = average_curve, cluster = as.factor(current_cluster) - ) + ) # Bind the curve data frame to the cumulative data frame average_curves <- rbind( average_curves, curve_df - ) + ) } average_curves$cluster <- factor( average_curves$cluster, levels = sort( - unique(as.numeric(average_curves$cluster))) + unique(as.numeric(average_curves$cluster)) ) - - time_unit_label = paste0("[", plot_info$time_unit, "]") - + ) + + time_unit_label <- paste0("[", plot_info$time_unit, "]") + cluster_colors <- scales::hue_pal()(length(unique(average_curves$cluster))) - + if (length(cluster_colors) > length(unique(average_curves$cluster))) { cluster_colors <- cluster_colors[1:length(unique(average_curves$cluster))] } names(cluster_colors) <- paste( "Cluster", levels(average_curves$cluster) - ) - + ) + color_values <- c(cluster_colors) distinct_colors <- c() - + # Create the base plot p_curves <- ggplot2::ggplot( average_curves, @@ -1607,32 +1579,32 @@ plot_all_mean_splines <- function( ggplot2::theme_minimal() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)) - # Call the wrapper function to conditionally add dashed lines and get + # Call the wrapper function to conditionally add dashed lines and get # treatment colors result <- maybe_add_dashed_lines( p = p_curves, plot_info = plot_info, level = level - ) - + ) + p_curves <- result$p treatment_colors <- result$treatment_colors - + # Combine cluster colors and treatment colors for a single color scale all_colors <- c(cluster_colors, treatment_colors) - + # Finalize color scale and theme adjustments p_curves <- p_curves + ggplot2::scale_color_manual( - values = all_colors, # Combine both cluster and treatment colors - name = NULL # No legend title + values = all_colors, # Combine both cluster and treatment colors + name = NULL # No legend title ) + ggplot2::theme( - legend.key.size = grid::unit(0.6, "cm"), + legend.key.size = grid::unit(0.6, "cm"), legend.key.height = grid::unit(0.3, "cm"), legend.title = ggplot2::element_text(size = 8) ) - + return(p_curves) } @@ -1645,13 +1617,13 @@ plot_all_mean_splines <- function( #' #' @param curve_values A dataframe containing curve values and cluster #' assignments. -#' @param plot_info List containing the elements y_axis_label (string), +#' @param plot_info List containing the elements y_axis_label (string), #' time_unit (string), treatment_labels (character vector), -#' treatment_timepoints (integer vector). All can also be NA. -#' This list is used to add this info to the spline plots. +#' treatment_timepoints (integer vector). All can also be NA. +#' This list is used to add this info to the spline plots. #' time_unit is used to label the x-axis, and treatment_labels #' and -timepoints are used to create vertical dashed lines, -#' indicating the positions of the treatments (such as +#' indicating the positions of the treatments (such as #' feeding, temperature shift, etc.). #' #' @return A list containing a plot for every cluster @@ -1662,9 +1634,7 @@ plot_all_mean_splines <- function( plot_cluster_mean_splines <- function( curve_values, plot_info, - level - ) { - + level) { clusters <- sort(unique(curve_values$cluster)) plots <- list() @@ -1672,16 +1642,16 @@ plot_cluster_mean_splines <- function( subset_df <- subset( curve_values, curve_values$cluster == current_cluster - ) + ) subset_df$cluster <- NULL nr_of_hits <- nrow(subset_df) current_title <- paste( "Cluster", - current_cluster, + current_cluster, "| Hits:", nr_of_hits, sep = " " - ) + ) plots[[length(plots) + 1]] <- plot_single_and_mean_splines( @@ -1689,9 +1659,9 @@ plot_cluster_mean_splines <- function( current_title, plot_info = plot_info, level - ) + ) } - + return(plots) } @@ -1715,17 +1685,17 @@ plot_cluster_mean_splines <- function( #' @param X The limma design matrix that defines the experimental conditions. #' @param time_unit_label A string shown in the plots as the unit for the time, #' such as min or hours. -#' @param plot_info List containing the elements y_axis_label (string), +#' @param plot_info List containing the elements y_axis_label (string), #' time_unit (string), treatment_labels (character vector), -#' treatment_timepoints (integer vector). All can also be NA. -#' This list is used to add this info to the spline plots. +#' treatment_timepoints (integer vector). All can also be NA. +#' This list is used to add this info to the spline plots. #' time_unit is used to label the x-axis, and treatment_labels #' and -timepoints are used to create vertical dashed lines, -#' indicating the positions of the treatments (such as +#' indicating the positions of the treatments (such as #' feeding, temperature shift, etc.). #' @param adj_pthreshold Double > 0 and < 1 specifying the adj. p-val threshold. #' @param replicate_column String specifying the column of the meta dataframe -#' that contains the labels of the replicate measurents. When that is not +#' that contains the labels of the replicate measurents. When that is not #' given, this argument is NULL. #' #' @return A list containing the composite plot and the number of rows used in @@ -1742,65 +1712,63 @@ plot_splines <- function( top_table, data, meta, - X, + X, time_unit_label, plot_info, adj_pthreshold, replicate_column, - level -) { - + level) { # Sort so that HTML reports are easier to read and comparisons are easier. top_table <- top_table |> dplyr::arrange(.data$feature_names) - + DoF <- which(names(top_table) == "AveExpr") - 1 time_points <- meta$Time - + titles <- data.frame( FeatureID = top_table$feature_nr, feature_names = top_table$feature_names ) - + plot_list <- list() - + for (hit in 1:nrow(top_table)) { hit_index <- as.numeric(top_table$feature_nr[hit]) y_values <- data[hit_index, ] - + intercept <- top_table$intercept[hit] spline_coeffs <- as.numeric(top_table[hit, 1:DoF]) - + Time <- seq( meta$Time[1], meta$Time[length(meta$Time)], - length.out = 1000 # To ensure smoothness of the curve + length.out = 1000 # To ensure smoothness of the curve ) - + fitted_values <- X %*% spline_coeffs + intercept - + plot_data <- data.frame( Time = time_points, Y = y_values ) - + # If replicate_column is specified (i.e., a string), use replicate info if (!is.null(replicate_column) && is.character(replicate_column)) { - replicates <- meta[[replicate_column]] # Get the replicate information - plot_data$Replicate <- replicates # Add replicate info to plot data - + replicates <- meta[[replicate_column]] # Get the replicate information + plot_data$Replicate <- replicates # Add replicate info to plot data + # Create color palette for replicates replicate_colors <- scales::hue_pal()(length(unique(replicates))) names(replicate_colors) <- unique(replicates) - + color_values <- c( "Spline" = "red", replicate_colors - ) + ) } else { color_values <- c( "Data" = "blue", "Spline" = "red" - ) + ) } # Get adjusted p-value and significance stars @@ -1818,122 +1786,123 @@ plot_splines <- function( ) ) ) - + avg_cv <- calc_cv( time_values = time_points, response_values = y_values - ) - + ) + # Use local environment to avoid unwanted updating dynamic legend label. p <- local({ - plot_spline <- data.frame( Time = Time, Fitted = fitted_values ) - + x_max <- as.numeric(max(time_points)) x_extension <- x_max * 0.05 # Define color column outside aes() - color_column_values <- if (!is.null(replicate_column) - && is.character(replicate_column)) { - plot_data$Replicate # Use replicate column if it exists + color_column_values <- if (!is.null(replicate_column) && + is.character(replicate_column)) { + plot_data$Replicate # Use replicate column if it exists } else { rep("Data", nrow(plot_data)) } - + plot_data$color_column <- factor(color_column_values) - + p <- ggplot2::ggplot() + ggplot2::geom_point( - data = plot_data, + data = plot_data, ggplot2::aes( - x = Time, + x = Time, y = .data$Y, color = color_column ), - alpha = 0.5 # 50% transparent data dots + alpha = 0.5 # 50% transparent data dots ) + ggplot2::geom_line( - data = plot_spline, + data = plot_spline, ggplot2::aes( - x = .data$Time, - y = .data$Fitted, + x = .data$Time, + y = .data$Fitted, color = "Spline" ) ) + ggplot2::theme_minimal() + ggplot2::scale_x_continuous( limits = c(min(time_points), x_max + x_extension), - breaks = filter_timepoints(time_points), + breaks = filter_timepoints(time_points), labels = function(x) { x } ) + ggplot2::labs( - x = paste0("Time ", time_unit_label), + x = paste0("Time ", time_unit_label), y = plot_info$y_axis_label ) + ggplot2::guides( - color = ggplot2::guide_legend(title = NULL) # Remove the legend title + color = ggplot2::guide_legend(title = NULL) # Remove the legend title ) + ggplot2::theme( - legend.position = "right", + legend.position = "right", legend.justification = "center", - legend.box = "vertical", - legend.background = ggplot2::element_blank(), - legend.title = ggplot2::element_blank(), + legend.box = "vertical", + legend.background = ggplot2::element_blank(), + legend.title = ggplot2::element_blank(), legend.text = ggplot2::element_text( - size = 6, + size = 6, margin = ggplot2::margin(t = 4, b = 4) ), axis.text.x = ggplot2::element_text( - size = 8, - angle = 45, # Tilt labels by 45 degrees - hjust = 1 # Adjust horizontal justification + size = 8, + angle = 45, # Tilt labels by 45 degrees + hjust = 1 # Adjust horizontal justification ), axis.title.y = ggplot2::element_text( - size = 8, + size = 8, margin = ggplot2::margin(t = 0, r = 2, b = 0, l = 0) ), axis.text.y = ggplot2::element_text( margin = ggplot2::margin(t = 0, r = 5, b = 0, l = 0) ) ) - - y_pos = max( + + y_pos <- max( max(y_values, na.rm = TRUE), max(fitted_values, na.rm = TRUE) - ) - + ) + result <- maybe_add_dashed_lines( - p = p, + p = p, plot_info = plot_info, level = level, y_pos = y_pos - ) + ) + + p <- result$p # Updated plot with dashed lines + treatment_colors <- result$treatment_colors # Colors used for treatments - p <- result$p # Updated plot with dashed lines - treatment_colors <- result$treatment_colors # Colors used for treatments - color_values <- c(color_values, treatment_colors) - + # Add title and annotations matched_row <- dplyr::filter( titles, !!rlang::sym("FeatureID") == hit_index ) - + title <- as.character(matched_row$feature_name) - + if (nchar(title) > 100) { title_before <- title title <- paste0(substr(title, 1, 100), " ...") - message(paste("The feature ID", title_before, "is > 100 characters.", - "Truncating it to 100 chars:", title)) + message(paste( + "The feature ID", title_before, "is > 100 characters.", + "Truncating it to 100 chars:", title + )) } - + if (is.na(title)) { title <- paste("feature:", hit_index) } @@ -1956,19 +1925,19 @@ plot_splines <- function( plot.title = ggplot2::element_text(size = 6), axis.title.x = ggplot2::element_text(size = 8), axis.title.y = ggplot2::element_text(size = 8), - legend.key.size = grid::unit(0.6, "cm"), + legend.key.size = grid::unit(0.6, "cm"), legend.key.height = grid::unit(0.3, "cm"), legend.title = ggplot2::element_text(size = 8), legend.text = ggplot2::element_text(size = 6), axis.text.x = ggplot2::element_text(size = 6) ) - + p }) - + plot_list[[hit]] <- p } - + return(plot_list) } @@ -1976,11 +1945,11 @@ plot_splines <- function( #' Create spline comparison plots for two conditions #' #' @description -#' This function generates comparison plots for spline fits of two conditions -#' over time. It compares the time effects of two conditions, plots the data -#' points, and overlays the fitted spline curves. The function checks if the -#' adjusted p-values for the average difference between conditions and the -#' interaction between condition and time are below the specified thresholds +#' This function generates comparison plots for spline fits of two conditions +#' over time. It compares the time effects of two conditions, plots the data +#' points, and overlays the fitted spline curves. The function checks if the +#' adjusted p-values for the average difference between conditions and the +#' interaction between condition and time are below the specified thresholds #' before generating plots. #' #' @param time_effect_1 A data frame containing the time effects for the first @@ -1990,10 +1959,10 @@ plot_splines <- function( #' condition. #' @param condition_2 The name of the second condition. #' @param avrg_diff_conditions A data frame with the adjusted p-values for the -#' average difference +#' average difference #' between conditions. #' @param interaction_condition_time A data frame with the adjusted p-values -#' for the interaction between +#' for the interaction between #' condition and time. #' @param data The data matrix containing the measurements. #' @param meta The metadata associated with the measurements. @@ -2001,23 +1970,23 @@ plot_splines <- function( #' experiment. #' @param X_1 A matrix of spline basis values for the first condition. #' @param X_2 A matrix of spline basis values for the second condition. -#' @param plot_info A list containing plotting information such as time unit +#' @param plot_info A list containing plotting information such as time unit #' and axis labels. -#' @param adj_pthresh_avrg_diff_conditions The adjusted p-value threshold for -#' the average difference +#' @param adj_pthresh_avrg_diff_conditions The adjusted p-value threshold for +#' the average difference #' between conditions. -#' @param adj_pthresh_interaction The adjusted p-value threshold for the -#' interaction between +#' @param adj_pthresh_interaction The adjusted p-value threshold for the +#' interaction between #' condition and time. -#' +#' #' @return A list containing: #' \describe{ #' \item{plots}{A list of ggplot2 plots comparing the two conditions.} #' \item{feature_names}{A list of feature names for the plotted features.} #' } -#' +#' #' @importFrom rlang .data -#' +#' plot_spline_comparisons <- function( time_effect_1, condition_1, @@ -2032,15 +2001,13 @@ plot_spline_comparisons <- function( X_2, plot_info, adj_pthresh_avrg_diff_conditions, - adj_pthresh_interaction -) { - + adj_pthresh_interaction) { # Sort and prepare data (sorting based on feature name for easy navigation) time_effect_1 <- time_effect_1 |> dplyr::arrange(.data$feature_names) time_effect_2 <- time_effect_2 |> dplyr::arrange(.data$feature_names) - avrg_diff_conditions <- + avrg_diff_conditions <- avrg_diff_conditions |> dplyr::arrange(.data$feature_names) - interaction_condition_time <- + interaction_condition_time <- interaction_condition_time |> dplyr::arrange(.data$feature_names) # Get relevant parameters @@ -2073,34 +2040,33 @@ plot_spline_comparisons <- function( avrg_diff_pval <- as.numeric(avrg_diff_conditions[hit, "adj.P.Val"]) interaction_pval <- as.numeric(interaction_condition_time[hit, "adj.P.Val"]) - if (avrg_diff_pval < adj_pthresh_avrg_diff_conditions - || interaction_pval < adj_pthresh_interaction) { - + if (avrg_diff_pval < adj_pthresh_avrg_diff_conditions || + interaction_pval < adj_pthresh_interaction) { # Define the number of stars for avrg_diff_conditions avrg_diff_stars <- ifelse( - avrg_diff_pval < adj_pthresh_avrg_diff_conditions / 50, - "***", + avrg_diff_pval < adj_pthresh_avrg_diff_conditions / 50, + "***", ifelse( - avrg_diff_pval < adj_pthresh_avrg_diff_conditions / 5, - "**", + avrg_diff_pval < adj_pthresh_avrg_diff_conditions / 5, + "**", ifelse( - avrg_diff_pval < adj_pthresh_avrg_diff_conditions, - "*", + avrg_diff_pval < adj_pthresh_avrg_diff_conditions, + "*", "" ) ) ) - + # Define the number of stars for interaction_condition_time interaction_stars <- ifelse( - interaction_pval < adj_pthresh_interaction / 50, - "***", + interaction_pval < adj_pthresh_interaction / 50, + "***", ifelse( - interaction_pval < adj_pthresh_interaction / 5, - "**", + interaction_pval < adj_pthresh_interaction / 5, + "**", ifelse( - interaction_pval < adj_pthresh_interaction, - "*", + interaction_pval < adj_pthresh_interaction, + "*", "" ) ) @@ -2112,17 +2078,17 @@ plot_spline_comparisons <- function( Y1 = ifelse(meta[[condition]] == condition_1, y_values_1, NA), Y2 = ifelse(meta[[condition]] == condition_2, y_values_2, NA) ) - + # Calculate average CV for Y1 and Y2 across all time points cv_1 <- calc_cv( - time_values = plot_data$Time, + time_values = plot_data$Time, response_values = plot_data$Y1 - ) - + ) + cv_2 <- calc_cv( time_values = plot_data$Time, response_values = plot_data$Y2 - ) + ) # Create the plot p <- ggplot2::ggplot() + @@ -2132,20 +2098,20 @@ plot_spline_comparisons <- function( x = .data$Time, y = .data$Y1, color = paste("Data", condition_1) - ), + ), na.rm = TRUE, - alpha = 0.5 # Make data dots transparent + alpha = 0.5 # Make data dots transparent ) + ggplot2::geom_line( data = data.frame( Time = Time, Fitted = fitted_values_1 - ), + ), ggplot2::aes( x = .data$Time, y = .data$Fitted, color = paste("Spline", condition_1) - ) + ) ) + ggplot2::geom_point( data = plot_data, @@ -2153,20 +2119,20 @@ plot_spline_comparisons <- function( x = .data$Time, y = .data$Y2, color = paste("Data", condition_2) - ), + ), na.rm = TRUE, - alpha = 0.5 # Make data dots transparent + alpha = 0.5 # Make data dots transparent ) + ggplot2::geom_line( data = data.frame( Time = Time, Fitted = fitted_values_2 - ), + ), ggplot2::aes( x = .data$Time, y = .data$Fitted, color = paste("Spline", condition_2) - ) + ) ) + ggplot2::scale_color_manual(values = setNames( c( @@ -2174,27 +2140,28 @@ plot_spline_comparisons <- function( "orange", "purple", "purple" + ), + c( + paste( + "Data", + condition_1 ), - c(paste( - "Data", - condition_1 - ), paste( "Spline", condition_1 - ), + ), paste( "Data", condition_2 - ), + ), paste( "Spline", condition_2 - ) ) + ) )) + ggplot2::scale_x_continuous( - breaks = filter_timepoints(time_points) + breaks = filter_timepoints(time_points) ) + ggplot2::labs( title = paste( @@ -2244,14 +2211,12 @@ plot_spline_comparisons <- function( #' dataframe with a `feature_nr` column. Some elements may be logical values. #' @param annotation A dataframe containing the annotation information. #' -#' @return A list with updated `top_table` dataframes containing merged +#' @return A list with updated `top_table` dataframes containing merged #' annotation information. #' merge_annotation_all_levels_clustering <- function( all_levels_clustering, - annotation = NULL -) { - + annotation = NULL) { all_levels_clustering <- lapply( all_levels_clustering, function(x) { @@ -2265,7 +2230,7 @@ merge_annotation_all_levels_clustering <- function( return(x) } ) - + return(all_levels_clustering) } @@ -2273,8 +2238,8 @@ merge_annotation_all_levels_clustering <- function( #' Prepare Gene Lists for Enrichr and Return as String #' #' @description -#' This function processes the clustered hits in each element of -#' `all_levels_clustering`, formats the gene names for easy copy-pasting into +#' This function processes the clustered hits in each element of +#' `all_levels_clustering`, formats the gene names for easy copy-pasting into #' Enrichr, and returns the formatted gene lists as a string. #' #' @param all_levels_clustering A list where each element contains a dataframe @@ -2285,47 +2250,44 @@ merge_annotation_all_levels_clustering <- function( #' prepare_gene_lists_for_enrichr <- function( all_levels_clustering, - genes -) { - + genes) { formatted_gene_lists <- list() - + for (i in seq_along(all_levels_clustering)) { - if (is.logical(all_levels_clustering[[i]])) next - + level_name <- names(all_levels_clustering)[i] clustered_hits <- all_levels_clustering[[i]]$clustered_hits - + # Process each cluster clusters <- split( clustered_hits$feature, clustered_hits$cluster ) - + level_gene_lists <- list() - + for (cluster_id in names(clusters)) { cluster_genes <- clusters[[cluster_id]] gene_list <- genes[cluster_genes] - gene_list <- na.omit(gene_list) # Remove NAs if any - + gene_list <- na.omit(gene_list) # Remove NAs if any + if (length(gene_list) > 0) { - level_gene_lists[[paste0("Cluster ", cluster_id)]] <- + level_gene_lists[[paste0("Cluster ", cluster_id)]] <- paste(gene_list, collapse = "\n") } } - + formatted_gene_lists[[level_name]] <- level_gene_lists } - + # Prepare the background genes list using preprocessed genes background_gene_list <- paste( na.omit(genes), collapse = "\n" - ) - + ) + return(list( gene_lists = formatted_gene_lists, background = background_gene_list @@ -2351,7 +2313,7 @@ prepare_gene_lists_for_enrichr <- function( #' @param level_headers_info A list of header information for each level. #' @param spline_params A list of spline parameters. #' @param adj_pthresholds Float vector with values for any level for adj.p.tresh -#' @param adj_pthresh_avrg_diff_conditions Float +#' @param adj_pthresh_avrg_diff_conditions Float #' @param adj_pthresh_interaction_condition_time Float #' @param mode A character string specifying the mode #' ('isolated' or 'integrated'). @@ -2377,13 +2339,11 @@ build_cluster_hits_report <- function( adj_pthresh_interaction_condition_time, mode, report_info, - output_file_path - ) { - + output_file_path) { html_content <- paste(header_section, "", sep = "\n") - + toc <- create_toc() - + styles <- define_html_styles() section_header_style <- styles$section_header_style toc_style <- styles$toc_style @@ -2392,12 +2352,12 @@ build_cluster_hits_report <- function( j <- 0 level_headers_info <- Filter(Negate(is.null), level_headers_info) - + pb <- create_progress_bar(plots) header_index <- 0 level_index <- 0 - + # Generate the sections and plots for (index in seq_along(plots)) { header_index <- header_index + 1 @@ -2410,30 +2370,29 @@ build_cluster_hits_report <- function( # means this is the section of a new level # The very first level is also a new level if (names(plots)[index] == "new_level") { - level_index <- level_index + 1 - + time_effect_section_header <- paste( "Time Effect of Condition:", header_info$header_name ) - + section_header <- sprintf( "

%s

", section_header_style, header_index, time_effect_section_header - ) + ) html_content <- paste( html_content, section_header, sep = "\n" - ) + ) if (mode == "integrated") { j <- 1 - } else { # mode == "isolated" or mode == NA + } else { # mode == "isolated" or mode == NA j <- j + 1 } @@ -2441,13 +2400,13 @@ build_cluster_hits_report <- function( get_spline_params_info( spline_params = spline_params, j = j - ) + ) html_content <- paste( html_content, spline_params_info, sep = "\n" - ) + ) hits_info <- sprintf( paste0( @@ -2465,19 +2424,19 @@ build_cluster_hits_report <- function( html_content, hits_info, sep = "\n" - ) + ) toc_entry <- sprintf( "
  • %s
  • ", toc_style, header_index, time_effect_section_header - ) + ) toc <- paste( toc, toc_entry, sep = "\n" - ) + ) current_header_index <- current_header_index + 1 @@ -2496,14 +2455,13 @@ build_cluster_hits_report <- function( ) if (element_name %in% header_levels) { - if (element_name == "dendrogram") { header_text <- "Overall Clustering" } else if (element_name == "cluster_mean_splines") { header_text <- "Min-max normalized individual and mean splines" } else if (element_name == "heatmap") { header_text <- "Z-Score of log2 Value Heatmap" - + heatmap_description <- paste( "
    ", "Rows = features (labels on the right, cluster labels on the left),", @@ -2511,7 +2469,7 @@ build_cluster_hits_report <- function( of the row;", "
    " ) - } else { # element_name == "individual_spline_plots" + } else { # element_name == "individual_spline_plots" adjusted_p_val <- adj_pthresholds[level_index] header_text <- "Individual Significant Features (Hits) Splines" asterisks_definition <- paste( @@ -2523,8 +2481,8 @@ build_cluster_hits_report <- function( sep = "
    " ) } - - # Add the main title as a section title with an anchor + + # Add the main title as a section title with an anchor # before the first plot header <- paste0( "

    ", asterisks_definition, - "") - - rm(asterisks_definition) # Otherwise, the next level has it everywhere + "" + ) + + rm(asterisks_definition) # Otherwise, the next level has it everywhere } - + html_content <- paste( html_content, header, sep = "\n" ) - + toc_entry <- paste0( "
  • ", "", - header_text, + header_text, "
  • " ) - + toc <- paste(toc, toc_entry, sep = "\n") } - + header_index <- header_index + 1 - + result <- process_plots( plots_element = plots[[index]], element_name = names(plots)[index], @@ -2576,11 +2535,11 @@ build_cluster_hits_report <- function( html_content = html_content, toc = toc, header_index = header_index - ) - + ) + html_content <- result$html_content toc <- result$toc - + pb$tick() } @@ -2588,7 +2547,7 @@ build_cluster_hits_report <- function( if (length(limma_result_2_and_3_plots) > 0) { # Create a new main header for the limma result plots header_index <- header_index + 1 - + # Add the main header and anchor it limma_main_header <- sprintf( "

    %s

    ", @@ -2596,14 +2555,14 @@ build_cluster_hits_report <- function( header_index, "Avrg diff conditions & interaction condition time" ) - + html_content <- paste( html_content, limma_main_header, sep = "\n" ) - - # Define the asterisks definition for both adjusted p-values, + + # Define the asterisks definition for both adjusted p-values, # centered, with larger p-value text asterisks_definition_avrg_diff <- paste( "
    ", @@ -2614,27 +2573,27 @@ build_cluster_hits_report <- function( adj_pthresh_avrg_diff_conditions, "--> *", sep = " " - ), + ), "
    ", paste( "Adj. p-value <", adj_pthresh_avrg_diff_conditions / 5, "--> **", sep = " " - ), + ), "
    ", paste( "Adj. p-value <", adj_pthresh_avrg_diff_conditions / 50, "--> ***", sep = " " - ), + ), "
    ", sep = "\n" ) - + asterisks_definition_interaction <- paste( - "
    ", + "
    ", "Asterisks definition (Interaction):
    ", paste( @@ -2642,25 +2601,25 @@ build_cluster_hits_report <- function( adj_pthresh_interaction_condition_time, "--> *", sep = " " - ), + ), "
    ", paste( "Adj. p-value <", adj_pthresh_interaction_condition_time / 5, "--> **", sep = " " - ), + ), "
    ", paste( "Adj. p-value <", adj_pthresh_interaction_condition_time / 50, "--> ***", sep = " " - ), + ), "
    ", sep = "\n" ) - + # Add the asterisks definitions to the HTML content html_content <- paste( html_content, @@ -2668,7 +2627,7 @@ build_cluster_hits_report <- function( asterisks_definition_interaction, sep = "\n" ) - + # Add an entry in the table of contents for this new section toc_entry <- sprintf( "
  • %s
  • ", @@ -2681,10 +2640,9 @@ build_cluster_hits_report <- function( toc_entry, sep = "\n" ) - + # Loop over each element in limma_result_2_and_3_plots for (comparison_name in names(limma_result_2_and_3_plots)) { - # Create a subheader for each comparison header_index <- header_index + 1 subheader <- sprintf( @@ -2693,59 +2651,59 @@ build_cluster_hits_report <- function( header_index, comparison_name ) - + html_content <- paste( html_content, subheader, sep = "\n" ) - + # Add an entry in the TOC for this subheader toc_entry <- paste0( "
  • ", "", - comparison_name, + comparison_name, "
  • " ) - + toc <- paste( toc, toc_entry, sep = "\n" ) - + # Extract plot_list and feature_names_list for the current comparison comparison <- limma_result_2_and_3_plots[[comparison_name]] comparison_plots <- comparison$plots comparison_feature_names <- comparison$feature_names - + # Iterate through each plot and its corresponding feature name for (i in seq_along(comparison_plots)) { # Add the feature name as a copyable text above the plot feature_name_div <- sprintf( - '
    %s
    ', comparison_feature_names[[i]] ) - + html_content <- paste( html_content, - feature_name_div, # Add the feature name above the plot + feature_name_div, # Add the feature name above the plot sep = "\n" ) - + # Now add the plot itself result <- process_plots( plots_element = comparison_plots[[i]], - plots_size = 1.5, + plots_size = 1.5, html_content = html_content, toc = toc, header_index = header_index, - element_name = "" + element_name = "" ) - + html_content <- result$html_content toc <- result$toc } @@ -2799,23 +2757,20 @@ get_curve_values <- function( meta, condition, spline_params, - mode - ) { - + mode) { subset_meta <- meta[meta[[condition]] == level, ] if (mode == "isolated") { level_index <- match(level, unique(meta[[condition]])) - } - else if (mode == "integrated") { - level_index <- 1 # Different spline params not supported for this mode + } else if (mode == "integrated") { + level_index <- 1 # Different spline params not supported for this mode } smooth_timepoints <- seq( subset_meta$Time[1], subset_meta$Time[length(subset_meta$Time)], - length.out = 1000 # To ensure smoothness of the curve. - ) + length.out = 1000 # To ensure smoothness of the curve. + ) args <- list(x = smooth_timepoints, intercept = FALSE) @@ -2833,7 +2788,7 @@ get_curve_values <- function( if (spline_params$spline_type[level_index] == "b") { args$degree <- spline_params$degree[level_index] X <- do.call(splines::bs, args) - } else { # natural cubic splines + } else { # natural cubic splines X <- do.call(splines::ns, args) } @@ -2848,26 +2803,26 @@ get_curve_values <- function( curve_values <- matrix( nrow = nrow(splineCoeffs), ncol = length(smooth_timepoints) - ) + ) - for(i in 1:nrow(splineCoeffs)) { + for (i in 1:nrow(splineCoeffs)) { current_coeffs <- matrix( splineCoeffs[i, ], ncol = ncol(splineCoeffs), byrow = TRUE - ) + ) curve_values[i, ] <- current_coeffs %*% t(X) } curve_values <- as.data.frame(curve_values) rownames(curve_values) <- rownames(splineCoeffs) - + list( curve_values = curve_values, smooth_timepoints = smooth_timepoints, X = X - ) + ) } @@ -2888,13 +2843,12 @@ get_curve_values <- function( #' has been normalized. #' normalize_curves <- function(curve_values) { - normalized_curves <- apply(curve_values, 1, function(row) { (row - min(row)) / (max(row) - min(row)) }) normalized_curves <- t(normalized_curves) - curve_values[,] <- normalized_curves + curve_values[, ] <- normalized_curves curve_values } @@ -2918,9 +2872,7 @@ hierarchical_clustering <- function( curve_values, k, smooth_timepoints, - top_table - ) { - + top_table) { distance_matrix <- stats::dist(curve_values, method = "euclidean") hc <- stats::hclust(distance_matrix, method = "complete") @@ -2944,7 +2896,7 @@ hierarchical_clustering <- function( curve_values = curve_values, top_table = top_table, clusters = k - ) + ) } @@ -2974,46 +2926,45 @@ hierarchical_clustering <- function( #' get_spline_params_info <- function( spline_params, - j - ) { - + j) { if (!is.null(spline_params$spline_type) && - length(spline_params$spline_type) >= j) { + length(spline_params$spline_type) >= j) { spline_params$spline_type[j] <- spline_params$spline_type[j] } else { spline_params$spline_type[j] <- NA } if (!is.null(spline_params$degree) && - length(spline_params$degree) >= j) { + length(spline_params$degree) >= j) { spline_params$degree[j] <- spline_params$degree[j] } else { spline_params$degree[j] <- NA } if (!is.null(spline_params$dof) && - length(spline_params$dof) >= j) { + length(spline_params$dof) >= j) { spline_params$dof[j] <- spline_params$dof[j] } else { spline_params$dof[j] <- NA } if (!is.null(spline_params$knots) && - length(spline_params$knots) >= j) { + length(spline_params$knots) >= j) { spline_params$knots[j] <- spline_params$knots[j] } else { spline_params$knots[j] <- NA } if (!is.null(spline_params$bknots) && - length(spline_params$bknots) >= j) { + length(spline_params$bknots) >= j) { spline_params$bknots[j] <- spline_params$bknots[j] } else { spline_params$bknots[j] <- NA } if (spline_params$spline_type[j] == "b") { - spline_params_info <- sprintf(" + spline_params_info <- sprintf( + "

    Spline-type: B-spline
    Degree: %s
    @@ -3021,18 +2972,21 @@ get_spline_params_info <- function( Knots: %s
    Boundary-knots: %s

    ", - spline_params$degree[j], spline_params$dof[j], - spline_params$knots[j], spline_params$bknots[j]) - } else { # spline_type == "n" - spline_params_info <- sprintf(" + spline_params$degree[j], spline_params$dof[j], + spline_params$knots[j], spline_params$bknots[j] + ) + } else { # spline_type == "n" + spline_params_info <- sprintf( + "

    Spline-type: Natural cubic spline
    DoF: %s
    Knots: %s
    Boundary-knots: %s

    ", - spline_params$dof[j], spline_params$knots[j], - spline_params$bknots[j]) + spline_params$dof[j], spline_params$knots[j], + spline_params$bknots[j] + ) } return(spline_params_info) } @@ -3053,97 +3007,92 @@ get_spline_params_info <- function( #' truncate_row_names <- function( names, - max_length = 40 - ) { - sapply(names, function(x) { + max_length = 40) { + vapply(names, function(x) { if (nchar(x) > max_length) { return(paste0(substr(x, 1, max_length - 3), " ...")) } else { return(x) } - }) + }, character(1)) } filter_timepoints <- function( time_points, - percentage_threshold = 0.05 - ) { - + percentage_threshold = 0.05) { x_max <- as.numeric(max(time_points)) - + # Calculate the minimum spacing based on the threshold - min_spacing <- x_max * percentage_threshold - + min_spacing <- x_max * percentage_threshold + all_time_points <- unique(c(time_points)) - + # Calculate the differences between consecutive time points time_diffs <- diff(all_time_points) - + # Keep labels that are more than the minimum spacing apart keep_labels <- c(TRUE, time_diffs > min_spacing) filtered_time_points <- all_time_points[keep_labels] - + return(filtered_time_points) } - #' Calculate average CV across unique time points #' #' @description -#' This function calculates the coefficient of variation (CV) for each unique -#' time point based on the provided time values and response values. It then -#' returns the average CV across all time points. The CV is only calculated if -#' there are more than one valid (non-NA) values for a given time point and +#' This function calculates the coefficient of variation (CV) for each unique +#' time point based on the provided time values and response values. It then +#' returns the average CV across all time points. The CV is only calculated if +#' there are more than one valid (non-NA) values for a given time point and #' the mean of the values is non-zero. #' -#' @param time_values A numeric vector containing the time points. Time points +#' @param time_values A numeric vector containing the time points. Time points #' may repeat across replicates. -#' @param response_values A numeric vector of response values corresponding to +#' @param response_values A numeric vector of response values corresponding to #' the time points. #' -#' @return The average coefficient of variation (CV) across all time points. +#' @return The average coefficient of variation (CV) across all time points. #' Returns NA if all CVs are NA. #' calc_cv <- function( - time_values, - response_values - ) { - + time_values, + response_values) { time_data <- data.frame( - Time = time_values, + Time = time_values, Response = response_values ) - + unique_times <- unique(time_data$Time) - - cvs <- sapply( + + cvs <- vapply( unique_times, - function(t) - { + function(t) { # Subset for the specific time point values_at_time <- time_data$Response[time_data$Time == t] # Calculate CV if the mean is not zero and there are enough data points - if (mean(values_at_time, na.rm = TRUE) != 0 - && sum(!is.na(values_at_time)) > 1) { + if (mean(values_at_time, na.rm = TRUE) != 0 && + sum(!is.na(values_at_time)) > 1) { (sd( - values_at_time, + values_at_time, na.rm = TRUE - ) / + ) / mean( - values_at_time, + values_at_time, na.rm = TRUE )) * 100 } else { - NA # Return NA for CV when mean is 0 or insufficient data points + NA # Return NA for CV when mean is 0 or insufficient data points } - }) + }, + numeric(1) + ) # Return the average CV across time points return(mean( cvs, na.rm = TRUE - )) + )) } @@ -3155,13 +3104,13 @@ calc_cv <- function( #' #' @param time_series_data A dataframe or matrix with time series data. #' @param title A character string specifying the title of the plot. -#' @param plot_info List containing the elements y_axis_label (string), +#' @param plot_info List containing the elements y_axis_label (string), #' time_unit (string), treatment_labels (character vector), -#' treatment_timepoints (integer vector). All can also be NA. -#' This list is used to add this info to the spline plots. +#' treatment_timepoints (integer vector). All can also be NA. +#' This list is used to add this info to the spline plots. #' time_unit is used to label the x-axis, and treatment_labels #' and -timepoints are used to create vertical dashed lines, -#' indicating the positions of the treatments (such as +#' indicating the positions of the treatments (such as #' feeding, temperature shift, etc.). #' #' @return A ggplot object representing the single and consensus shapes. @@ -3181,12 +3130,10 @@ plot_single_and_mean_splines <- function( time_series_data, title, plot_info, - level -) { - + level) { time_col <- rlang::sym("time") feature_col <- rlang::sym("feature") - + # Convert data to long format df_long <- as.data.frame(t(time_series_data)) |> tibble::rownames_to_column(var = "time") |> @@ -3197,32 +3144,33 @@ plot_single_and_mean_splines <- function( ) |> dplyr::arrange(!!feature_col) |> dplyr::mutate(time = as.numeric(.data$time)) - + # Compute consensus (mean of each column) consensus <- colMeans(time_series_data, na.rm = TRUE) - + consensus_df <- data.frame( time = as.numeric(colnames(time_series_data)), consensus = consensus ) - - time_unit_label = paste0("[", plot_info$time_unit, "]") - + + time_unit_label <- paste0("[", plot_info$time_unit, "]") + color_values <- c( "Mean" = "darkblue", "Spline" = "#6495ED" ) - + p <- ggplot2::ggplot() + ggplot2::geom_line( - data = df_long, + data = df_long, ggplot2::aes( x = !!rlang::sym("time"), y = !!rlang::sym("intensity"), group = !!rlang::sym("feature"), colour = "Spline" - ), - alpha = 0.3, linewidth = 0.5) + + ), + alpha = 0.3, linewidth = 0.5 + ) + ggplot2::geom_line( data = consensus_df, ggplot2::aes( @@ -3230,22 +3178,23 @@ plot_single_and_mean_splines <- function( y = consensus, colour = "Mean" ), - linewidth = 1.5) - + linewidth = 1.5 + ) + treatment_labels <- NA result <- maybe_add_dashed_lines( p = p, plot_info = plot_info, level = level - ) - + ) + p <- result$p treatment_colors <- result$treatment_colors - + # Combine the original colors with the treatment colors color_values <- c(color_values, treatment_colors) - + # Add the final scale for colors and adjust legend p <- p + ggplot2::scale_colour_manual( @@ -3279,7 +3228,7 @@ plot_single_and_mean_splines <- function( legend.key.size = grid::unit(0.6, "cm"), legend.key.height = grid::unit(0.3, "cm") ) - + return(p) } @@ -3287,21 +3236,21 @@ plot_single_and_mean_splines <- function( #' Conditionally add dashed lines for treatment timepoints #' #' @description -#' This internal function checks whether there are valid treatment -#' timepoints and labels in the `plot_info` list. If found, it adds +#' This internal function checks whether there are valid treatment +#' timepoints and labels in the `plot_info` list. If found, it adds #' dashed vertical lines and their corresponding x-axis values to the plot. -#' The treatment timepoints and labels can either be named lists (for +#' The treatment timepoints and labels can either be named lists (for #' multiple levels) or unnamed single elements. #' -#' @param p A ggplot object. The plot to which dashed lines and labels +#' @param p A ggplot object. The plot to which dashed lines and labels #' will be added. -#' @param plot_info A list containing the treatment timepoints and -#' treatment labels. Treatment timepoints and labels can either be -#' unnamed elements or named lists where each element corresponds +#' @param plot_info A list containing the treatment timepoints and +#' treatment labels. Treatment timepoints and labels can either be +#' unnamed elements or named lists where each element corresponds #' to a different `level`. -#' @param level A character string. Used to extract the treatment +#' @param level A character string. Used to extract the treatment #' timepoints and labels when they are stored in named lists. -#' @param y_pos A numeric value specifying the y-axis position where +#' @param y_pos A numeric value specifying the y-axis position where #' the text labels should be placed. Defaults to 1. #' #' @return A list containing: @@ -3309,68 +3258,60 @@ plot_single_and_mean_splines <- function( #' - `treatment_colors`: A named vector of colors used for the treatment labels. #' #' @importFrom scales hue_pal -#' +#' maybe_add_dashed_lines <- function( p, plot_info, level, - y_pos = 1 - ) { - + y_pos = 1) { # Initialize an empty vector to store treatment colors treatment_colors <- c() # Check if there are treatment labels if (!all(is.na(plot_info$treatment_labels))) { - # Initialize variables to store treatment_timepoints and treatment_labels treatment_timepoints <- NULL treatment_labels <- NULL - + # Case when there is a single unnamed element in the lists if (is.null(names(plot_info$treatment_labels))) { - # Take the single unnamed element treatment_timepoints <- plot_info$treatment_timepoints[[1]] treatment_labels <- plot_info$treatment_labels[[1]] - } else { - # Check if the key (level) is in the named lists if (level %in% names(plot_info$treatment_labels) && - level %in% names(plot_info$treatment_timepoints)) { - + level %in% names(plot_info$treatment_timepoints)) { # Extract the corresponding named elements treatment_timepoints <- plot_info$treatment_timepoints[[level]] treatment_labels <- plot_info$treatment_labels[[level]] } } - + # If we have valid treatment_timepoints and treatment_labels, add the dashed lines - if (!is.null(treatment_timepoints) && - !is.null(treatment_labels) && - all(!is.na(treatment_timepoints)) && - all(!is.na(treatment_labels))) { - + if (!is.null(treatment_timepoints) && + !is.null(treatment_labels) && + all(!is.na(treatment_timepoints)) && + all(!is.na(treatment_labels))) { # Generate colors for the treatment labels treatment_colors <- scales::hue_pal()(length(treatment_labels)) names(treatment_colors) <- treatment_labels - + # Call the function to add dashed lines p <- add_dashed_lines( - p = p, - treatment_timepoints = treatment_timepoints, + p = p, + treatment_timepoints = treatment_timepoints, treatment_labels = treatment_labels, y_pos = y_pos ) } } - + # Return both the updated plot and the treatment colors return(list( p = p, treatment_colors = treatment_colors - )) + )) } @@ -3380,44 +3321,41 @@ maybe_add_dashed_lines <- function( #' Add dashed lines for treatment timepoints to a plot #' #' @description -#' This internal function adds dashed vertical lines at specified -#' treatment timepoints to a plot, along with text labels that +#' This internal function adds dashed vertical lines at specified +#' treatment timepoints to a plot, along with text labels that #' display the corresponding x-axis values. #' -#' @param p A ggplot object. The plot to which dashed lines and labels +#' @param p A ggplot object. The plot to which dashed lines and labels #' will be added. -#' @param treatment_timepoints A numeric vector of timepoints where +#' @param treatment_timepoints A numeric vector of timepoints where #' dashed lines should be drawn. -#' @param treatment_labels A character vector of labels corresponding -#' to each treatment timepoint. These labels are used for coloring +#' @param treatment_labels A character vector of labels corresponding +#' to each treatment timepoint. These labels are used for coloring #' the lines, but the x-axis coordinates are displayed as the labels. -#' @param y_pos A numeric value specifying the y-axis position where +#' @param y_pos A numeric value specifying the y-axis position where #' the text labels should be placed. #' #' @return A ggplot object with added dashed lines and labels. #' #' @importFrom ggplot2 geom_vline geom_text aes #' @importFrom scales hue_pal -#' +#' add_dashed_lines <- function( - p, - treatment_timepoints, - treatment_labels, - y_pos - ) { - + p, + treatment_timepoints, + treatment_labels, + y_pos) { # Check if treatment labels and timepoints are valid - if (!is.null(treatment_timepoints) && - !is.null(treatment_labels) && - all(!is.na(treatment_timepoints)) && - all(!is.na(treatment_labels))) { - + if (!is.null(treatment_timepoints) && + !is.null(treatment_labels) && + all(!is.na(treatment_timepoints)) && + all(!is.na(treatment_labels))) { # Create a data frame for the treatment lines treatment_df <- data.frame( Time = treatment_timepoints, Label = treatment_labels ) - + # Generate distinct colors for the treatment labels treatment_colors <- scales::hue_pal()(length(treatment_labels)) names(treatment_colors) <- treatment_labels @@ -3436,18 +3374,18 @@ add_dashed_lines <- function( ggplot2::geom_text( data = treatment_df, ggplot2::aes( - x = Time - max(Time) * 0.005, # Slight offset from the vertical line - y = y_pos, + x = Time - max(Time) * 0.005, # Slight offset from the vertical line + y = y_pos, label = round(Time, 2), color = Label ), - angle = 90, # Rotate the labels + angle = 90, # Rotate the labels vjust = 0, hjust = 1, - size = 3, # Text size - show.legend = FALSE # Prevent text labels from appearing in the legend - ) + size = 3, # Text size + show.legend = FALSE # Prevent text labels from appearing in the legend + ) } - - return(p) # Return the updated plot object + + return(p) # Return the updated plot object } diff --git a/R/create_limma_report.R b/R/create_limma_report.R index 898fc64..17fe6fa 100755 --- a/R/create_limma_report.R +++ b/R/create_limma_report.R @@ -1,6 +1,6 @@ -# The function create_limma_report() takes the top_tables of the three different -# categories (within level time diff, between level average diff, and -# between level average and time diff) and makes histogram and vulcano plots +# The function create_limma_report() takes the top_tables of the three different +# categories (within level time diff, between level average diff, and +# between level average and time diff) and makes histogram and vulcano plots # and places them into a nice HTML report. @@ -11,13 +11,13 @@ #' Create a limma report #' #' @description -#' Generates an HTML report based on the results of a limma analysis with -#' splines. -#' The report includes various plots and sections summarizing the analysis -#' results for time effects, average differences between conditions, +#' Generates an HTML report based on the results of a limma analysis with +#' splines. +#' The report includes various plots and sections summarizing the analysis +#' results for time effects, average differences between conditions, #' and interaction effects between condition and time. #' -#' @param splineomics An S3 object of class `SplineOmics` that contains all the +#' @param splineomics An S3 object of class `SplineOmics` that contains all the #' necessary data and parameters for the analysis, including: #' \itemize{ #' \item \code{limma_splines_result}: A list containing top tables from @@ -25,142 +25,139 @@ #' \item \code{meta}: A data frame with sample metadata. Must contain a column #' "Time". #' \item \code{condition}: A character string specifying the column name in -#' the metadata (\code{meta}) that defines groups +#' the metadata (\code{meta}) that defines groups #' for analysis. This column contains levels such as -#' "exponential" and "stationary" for phases, or +#' "exponential" and "stationary" for phases, or #' "drug" and "no_drug" for treatments. -#' \item \code{annotation}: A data frame containing feature information, -#' such as gene and protein names, associated with +#' \item \code{annotation}: A data frame containing feature information, +#' such as gene and protein names, associated with #' the expression data. -#' \item \code{report_info}: A list containing metadata about the analysis +#' \item \code{report_info}: A list containing metadata about the analysis #' for reporting purposes. #' } -#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold +#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold #' for significance. Default is 0.05. Must be > 0 and < 1. -#' @param report_dir A string specifying the directory where the report should +#' @param report_dir A string specifying the directory where the report should #' be saved. Default is the current working directory. #' #' @return A list of plots included in the generated HTML report. #' #' @importFrom here here -#' +#' #' @export -#' +#' create_limma_report <- function( splineomics, adj_pthresh = 0.05, - report_dir = here::here() - ) { - + report_dir = here::here()) { report_dir <- normalizePath( report_dir, mustWork = FALSE ) - + check_splineomics_elements( splineomics = splineomics, func_type = "create_limma_report" ) - + # Control the function arguments args <- lapply(as.list(match.call()[-1]), eval, parent.frame()) check_null_elements(args) input_control <- InputControl$new(args) input_control$auto_validate() - + limma_splines_result <- splineomics[["limma_splines_result"]] meta <- splineomics[["meta"]] condition <- splineomics[["condition"]] annotation <- splineomics[["annotation"]] report_info <- splineomics[["report_info"]] - + # Get the top_tables of the three limma analysis categories time_effect <- limma_splines_result$time_effect avrg_diff_conditions <- limma_splines_result$avrg_diff_conditions interaction_condition_time <- limma_splines_result$interaction_condition_time - + plots <- list() plots_sizes <- list() section_headers_info <- list() - + result <- generate_time_effect_plots( time_effect, adj_pthresh - ) - + ) + plots <- c( plots, result$plots - ) + ) plots_sizes <- c( plots_sizes, result$plots_sizes - ) + ) section_headers_info <- c( section_headers_info, result$section_headers_info - ) + ) + - # length == 0 when there was just one level or no interaction effect if (length(avrg_diff_conditions) > 0) { - result <- generate_avrg_diff_plots( avrg_diff_conditions, adj_pthresh - ) - + ) + plots <- c( plots, result$plots - ) + ) plots_sizes <- c( plots_sizes, result$plots_sizes - ) + ) section_headers_info <- c( section_headers_info, result$section_headers_info - ) + ) } # length == 0 when there was just one level or no interaction effect if (length(interaction_condition_time) > 0) { - result <- generate_interaction_plots( interaction_condition_time, adj_pthresh - ) - + ) + plots <- c( plots, result$plots - ) + ) plots_sizes <- c( plots_sizes, result$plots_sizes - ) + ) section_headers_info <- c( section_headers_info, result$section_headers_info - ) + ) } - + all_top_tables <- c( time_effect, avrg_diff_conditions, interaction_condition_time - ) - + ) + unique_values <- unique(meta[[condition]]) - new_names <- sapply( + new_names <- vapply( names(all_top_tables), shorten_names, - unique_values = unique_values - ) + unique_values = unique_values, + FUN.VALUE = character(1) + ) names(all_top_tables) <- new_names - + if (!is.null(annotation)) { # Add annotation info into the top_tables for (index in seq_along(all_top_tables)) { @@ -172,16 +169,16 @@ create_limma_report <- function( } generate_report_html( - plots, - plots_sizes, + plots, + plots_sizes, report_info, topTables = all_top_tables, level_headers_info = section_headers_info, report_type = "create_limma_report", filename = "create_limma_report", report_dir = report_dir - ) - + ) + print_info_message( message_prefix = "Limma report generation", report_dir = report_dir @@ -198,182 +195,174 @@ create_limma_report <- function( #' Generate Plots for Time Effect #' #' @description -#' Creates p-value histograms for each time effect in the LIMMA analysis. This +#' Creates p-value histograms for each time effect in the LIMMA analysis. This #' function is used internally in the `create_limma_report` function. #' -#' @param time_effect A list of top tables from the LIMMA analysis representing +#' @param time_effect A list of top tables from the LIMMA analysis representing #' the time effects. -#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold +#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold #' for significance. #' -#' @return A list containing the plots and their sizes, as well as the +#' @return A list containing the plots and their sizes, as well as the #' section header information. #' generate_time_effect_plots <- function( time_effect, - adj_pthresh - ) { - + adj_pthresh) { plots <- list("Time Effect") plots_sizes <- c(999) - + header_info <- list(header_name = "Time Effect") section_headers_info <- list(header_info) - + for (i in seq_along(time_effect)) { element_name <- names(time_effect)[i] top_table <- time_effect[[i]] - + title <- paste("P-Value Histogram:", element_name) - + p_value_hist <- create_p_value_histogram( top_table = top_table, title = title - ) - + ) + plots <- c( plots, list(p_value_hist) - ) + ) plots_sizes <- c(plots_sizes, 1) } - + list( - plots = plots, - plots_sizes = plots_sizes, + plots = plots, + plots_sizes = plots_sizes, section_headers_info = section_headers_info - ) + ) } #' Generate Plots for Average Difference Conditions #' #' @description -#' Creates p-value histograms and volcano plots for each condition in the -#' average difference conditions. This function is used internally in the +#' Creates p-value histograms and volcano plots for each condition in the +#' average difference conditions. This function is used internally in the #' `create_limma_report` function. #' -#' @param avrg_diff_conditions A list of top tables from the LIMMA analysis +#' @param avrg_diff_conditions A list of top tables from the LIMMA analysis #' representing the average difference between conditions. -#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold +#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold #' for significance. #' -#' @return A list containing the plots and their sizes, as well as the +#' @return A list containing the plots and their sizes, as well as the #' section header information. #' generate_avrg_diff_plots <- function( avrg_diff_conditions, - adj_pthresh - ) { - + adj_pthresh) { plots <- list("Average Difference Conditions") plots_sizes <- c(999) - + header_info <- list(header_name = "Average Difference Conditions") section_headers_info <- list(header_info) - + for (i in seq_along(avrg_diff_conditions)) { element_name <- names(avrg_diff_conditions)[i] top_table <- avrg_diff_conditions[[i]] - + comparison <- remove_prefix(element_name, "avrg_diff_") title <- paste("P-Value Histogram:", comparison) - + p_value_hist <- create_p_value_histogram( top_table = top_table, title = title - ) - + ) + compared_levels <- strsplit(comparison, "_vs_")[[1]] - + volcano_plot <- create_volcano_plot( top_table = top_table, adj_pthresh = adj_pthresh, compared_levels - ) - + ) + plots <- c(plots, list(p_value_hist), list(volcano_plot)) plots_sizes <- c(plots_sizes, 1, 1.5) } - + list( - plots = plots, - plots_sizes = plots_sizes, + plots = plots, + plots_sizes = plots_sizes, section_headers_info = section_headers_info - ) + ) } #' Generate Plots for Interaction of Condition and Time #' #' @description -#' Creates p-value histograms for each interaction condition in the -#' interaction of condition and time. This function is used internally in the +#' Creates p-value histograms for each interaction condition in the +#' interaction of condition and time. This function is used internally in the #' `create_limma_report` function. #' -#' @param interaction_condition_time A list of top tables from the LIMMA -#' analysis +#' @param interaction_condition_time A list of top tables from the LIMMA +#' analysis #' representing the interaction effects between condition and time. -#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold +#' @param adj_pthresh A numeric value specifying the adjusted p-value threshold #' for significance. #' -#' @return A list containing the plots and their sizes, as well as the +#' @return A list containing the plots and their sizes, as well as the #' section header information. #' generate_interaction_plots <- function( interaction_condition_time, - adj_pthresh - ) { - + adj_pthresh) { plots <- list("Interaction of Condition and Time") plots_sizes <- c(999) - + header_info <- list(header_name = "Interaction of Condition and Time") section_headers_info <- list(header_info) - + for (i in seq_along(interaction_condition_time)) { element_name <- names(interaction_condition_time)[i] title <- paste(element_name, ": Adj. p-value vs. F-statistic") top_table <- interaction_condition_time[[i]] - + comparison <- remove_prefix(element_name, "time_interaction_") title <- paste("P-Value Histogram:", comparison) - + p_value_hist <- create_p_value_histogram( top_table = top_table, title = title - ) - + ) + plots <- c(plots, list(p_value_hist)) plots_sizes <- c(plots_sizes, 1) } - + list( - plots = plots, - plots_sizes = plots_sizes, + plots = plots, + plots_sizes = plots_sizes, section_headers_info = section_headers_info - ) + ) } #' Shorten Names #' #' @description -#' Replaces occurrences of unique values within a name with their first three -#' characters. This function is useful for abbreviating long condition names +#' Replaces occurrences of unique values within a name with their first three +#' characters. This function is useful for abbreviating long condition names #' in a dataset. #' #' @param name A string representing the name to be shortened. -#' @param unique_values A vector of unique values whose abbreviations will +#' @param unique_values A vector of unique values whose abbreviations will #' replace their occurrences in the name. #' #' @return A string with the unique values replaced by their abbreviations. #' shorten_names <- function( name, - unique_values - ) { - + unique_values) { for (val in unique_values) { short_val <- substr(val, 1, 3) name <- gsub(val, short_val, name, fixed = TRUE) @@ -385,7 +374,7 @@ shorten_names <- function( #' Build Cluster Hits Report #' #' @description -#' Generates an HTML report for clustered hits, including plots and +#' Generates an HTML report for clustered hits, including plots and #' spline parameter details, with a table of contents. #' #' @param header_section A character string containing the HTML header section. @@ -394,90 +383,86 @@ shorten_names <- function( #' @param level_headers_info A list of header information for each level. #' @param report_info A named list containg the report info fields. Here used #' for the email hotkey functionality. -#' @param output_file_path A character string specifying the path to save the +#' @param output_file_path A character string specifying the path to save the #' HTML report. #' #' @return No return value, called for side effects. #' #' @seealso #' \code{\link{plot2base64}}, \code{\link{create_progress_bar}} -#' +#' build_create_limma_report <- function( - header_section, - plots, - plots_sizes, + header_section, + plots, + plots_sizes, level_headers_info, report_info, - output_file_path = here::here() - ) { - + output_file_path = here::here()) { # Read the text file and split it into blocks descriptions_path <- system.file( "descriptions", "create_limma_report_html_plot_descriptions.txt", package = "SplineOmics" - ) + ) text_blocks <- readLines(descriptions_path) text_blocks <- split( text_blocks, cumsum(text_blocks == "") - ) # Split by empty lines - + ) # Split by empty lines + # Remove empty elements created by split text_blocks <- Filter(function(x) length(x) > 0, text_blocks) - - + + html_content <- paste( header_section, "", sep = "\n" - ) - + ) + toc <- create_toc() - + styles <- define_html_styles() section_header_style <- styles$section_header_style toc_style <- styles$toc_style - + current_header_index <- 1 level_headers_info <- Filter(Negate(is.null), level_headers_info) - + pb <- create_progress_bar(plots) # Generate the sections and plots for (index in seq_along(plots)) { - if (current_header_index <= length(level_headers_info)) { header_info <- level_headers_info[[current_header_index]] # means jump to next section - if (any(class(plots[[index]]) == "character")) { - + if (any(is(plots[[index]], "character"))) { section_header <- sprintf( - "

    %s

    ", - section_header_style, - index, + "

    %s

    ", + section_header_style, + index, header_info$header_name - ) - + ) + html_content <- paste( html_content, - section_header, + section_header, sep = "\n" - ) - + ) + # Add text block after the main headers. if (current_header_index <= length(text_blocks)) { # Convert text block to a single string with HTML paragraph format text_block_html <- paste( - "

    ", + "

    ", paste( text_blocks[[current_header_index]], collapse = " " - ), + ), "

    ", sep = "" - ) - + ) + html_content <- paste( html_content, text_block_html, @@ -486,33 +471,33 @@ build_create_limma_report <- function( } hits_info <- sprintf( - "

    " + "

    " ) - + html_content <- paste( html_content, hits_info, sep = "\n" - ) - + ) + toc_entry <- sprintf( - "

  • %s
  • ", + "
  • %s
  • ", toc_style, index, header_info[[1]] - ) - + ) + toc <- paste( toc, toc_entry, sep = "\n" - ) - + ) + current_header_index <- current_header_index + 1 - + pb$tick() next - } + } } result <- process_plots( @@ -524,10 +509,10 @@ build_create_limma_report <- function( ) html_content <- result$html_content toc <- result$toc - + pb$tick() } - + generate_and_write_html( toc = toc, html_content = html_content, @@ -558,9 +543,7 @@ build_create_limma_report <- function( #' create_p_value_histogram <- function( top_table, - title = "P-Value Histogram" -) { - + title = "P-Value Histogram") { # Check if the top_table has a P.Value column if (!"P.Value" %in% colnames(top_table)) { stop("The top_table must contain a column named 'P.Value'.") @@ -591,110 +574,108 @@ create_p_value_histogram <- function( #' Create a Volcano Plot #' #' @description -#' This function creates a volcano plot from a limma top table, plotting +#' This function creates a volcano plot from a limma top table, plotting #' log fold changes against the negative log10 of adjusted p-values. #' -#' @param top_table A data frame from limma containing 'logFC' and 'adj.P.Val' +#' @param top_table A data frame from limma containing 'logFC' and 'adj.P.Val' #' columns. #' @param adj_pthresh A numeric value for the adjusted p-value threshold. -#' @param compared_levels A character vector of length 2 specifying the +#' @param compared_levels A character vector of length 2 specifying the #' compared levels. #' #' @return A ggplot object representing the volcano plot. #' -#' @importFrom ggplot2 ggplot aes geom_point theme_minimal labs geom_hline +#' @importFrom ggplot2 ggplot aes geom_point theme_minimal labs geom_hline #' annotate scale_color_manual #' @importFrom rlang .data -#' +#' create_volcano_plot <- function( - top_table, - adj_pthresh, - compared_levels -) { - + top_table, + adj_pthresh, + compared_levels) { logFC <- NULL adj.P.Val <- NULL - + top_table <- top_table |> dplyr::mutate( Regulation = ifelse( - logFC > 0, - compared_levels[2], + logFC > 0, + compared_levels[2], compared_levels[1] ), Alpha = ifelse( - adj.P.Val < adj_pthresh, - 1, + adj.P.Val < adj_pthresh, + 1, 0.5 ) ) - + # Create a named vector for the colors colors <- c("blue", "darkgrey") |> setNames(c( compared_levels[2], compared_levels[1] )) - + # Calculate the number of hits num_hits <- sum(top_table$adj.P.Val < adj_pthresh) total_tests <- nrow(top_table) percent_hits <- (num_hits / total_tests) * 100 - + volcano_plot <- ggplot2::ggplot( data = top_table, mapping = ggplot2::aes( - x = logFC, - y = -log10(adj.P.Val), + x = logFC, + y = -log10(adj.P.Val), color = .data$Regulation, alpha = .data$Alpha ) ) + # Add a shaded region below the adjusted p-value threshold ggplot2::annotate( - "rect", - xmin = -Inf, - xmax = Inf, - ymin = 0, - ymax = -log10(adj_pthresh), - fill = "gray90" # Light gray color for visual distinction + "rect", + xmin = -Inf, + xmax = Inf, + ymin = 0, + ymax = -log10(adj_pthresh), + fill = "gray90" # Light gray color for visual distinction ) + ggplot2::geom_point() + ggplot2::theme_minimal() + ggplot2::labs( title = paste( - "Volcano Plot:", - compared_levels[1], - "vs", + "Volcano Plot:", + compared_levels[1], + "vs", compared_levels[2] ), x = paste( - "Log2 Fold Change (", - compared_levels[2], - " / ", - compared_levels[1], - ")", + "Log2 Fold Change (", + compared_levels[2], + " / ", + compared_levels[1], + ")", sep = "" ), y = "-Log10 Adjusted P-value" ) + # Add a dashed red line for the adjusted p-value threshold ggplot2::geom_hline( - yintercept = -log10(adj_pthresh), - linetype = "dashed", + yintercept = -log10(adj_pthresh), + linetype = "dashed", color = "red" ) + # Add a label for the adjusted p-value threshold ggplot2::annotate( - geom = "text", - x = Inf, - y = -log10(adj_pthresh), + geom = "text", + x = Inf, + y = -log10(adj_pthresh), label = paste( - "adj.p-thresh:", + "adj.p-thresh:", adj_pthresh - ), - hjust = 1.1, - vjust = -1.5, + ), + hjust = 1.1, + vjust = -1.5, color = "red" ) + ggplot2::scale_color_manual( @@ -704,49 +685,49 @@ create_volcano_plot <- function( range = c(0.5, 1) ) + ggplot2::annotate( - geom = "text", - x = max(top_table$logFC) * 0.8, - y = Inf, + geom = "text", + x = max(top_table$logFC) * 0.8, + y = Inf, label = paste( - compared_levels[2], + compared_levels[2], "higher" - ), - hjust = 1.1, - vjust = 1.1, - color = "blue", + ), + hjust = 1.1, + vjust = 1.1, + color = "blue", size = 3 ) + ggplot2::annotate( - geom = "text", - x = min(top_table$logFC) * 0.8, - y = Inf, + geom = "text", + x = min(top_table$logFC) * 0.8, + y = Inf, label = paste( - compared_levels[1], + compared_levels[1], "higher" - ), - hjust = -0.1, - vjust = 1.1, - color = "darkgrey", + ), + hjust = -0.1, + vjust = 1.1, + color = "darkgrey", size = 3 ) + ggplot2::annotate( - geom = "text", - x = 0, - y = Inf, + geom = "text", + x = 0, + y = Inf, label = paste( - "Hits:", - num_hits, + "Hits:", + num_hits, "(", round(percent_hits, 2), "%)" - ), - hjust = 0.5, - vjust = 3, - color = "black", + ), + hjust = 0.5, + vjust = 3, + color = "black", size = 3 ) + ggplot2::theme( legend.position = "none" ) - + return(volcano_plot) } @@ -754,7 +735,7 @@ create_volcano_plot <- function( #' Remove Prefix from String #' #' @description -#' Removes a specified prefix from the beginning of a string. This function +#' Removes a specified prefix from the beginning of a string. This function #' is useful for cleaning or standardizing strings by removing known prefixes. #' #' @param string A string from which the prefix should be removed. @@ -763,10 +744,8 @@ create_volcano_plot <- function( #' @return A string with the prefix removed. #' remove_prefix <- function( - string, - prefix - ) { - + string, + prefix) { pattern <- paste0("^", prefix) result <- sub(pattern, "", string) } diff --git a/R/download_enrichr_databases.R b/R/download_enrichr_databases.R index 99b87f2..7790d38 100755 --- a/R/download_enrichr_databases.R +++ b/R/download_enrichr_databases.R @@ -5,10 +5,10 @@ #' #' @description #' This function downloads gene sets from specified Enrichr databases and saves -#' them to a specified output directory as a .tsv file. The file is named with +#' them to a specified output directory as a .tsv file. The file is named with #' a timestamp to ensure uniqueness. #' -#' @param gene_set_lib A character vector of database names to download from +#' @param gene_set_lib A character vector of database names to download from #' Enrichr. #' @param output_dir A character string specifying the output directory #' where the .tsv file will be saved. Defaults to the current @@ -17,33 +17,31 @@ #' present in some terms, .tsv is recommendet). When ommited, #' the file is named all_databases_{timestamp}.tsv. #' -#' @return This function does not return a value but saves a .tsv file in the -#' specified directory containing the gene sets from the specified +#' @return This function does not return a value but saves a .tsv file in the +#' specified directory containing the gene sets from the specified #' Enrichr databases. #' #' @importFrom here here #' @importFrom rlang .data -#' +#' #' @export #' download_enrichr_databases <- function( gene_set_lib, output_dir = here::here(), - filename = NULL - ) { - + filename = NULL) { # Control the user inputs if (!is.character(gene_set_lib) || length(gene_set_lib) == 0) { stop_call_false("gene_set_lib must be a character vector with length > 0") } - + # Control the filename input (must be NULL or a valid string) - if (!is.null(filename) - && (!is.character(filename) - || length(filename) != 1)) { + if (!is.null(filename) && + (!is.character(filename) || + length(filename) != 1)) { stop_call_false("filename must be a single string or NULL.") } - + # Control the inputs args <- lapply(as.list(match.call()[-1]), eval, parent.frame()) check_null_elements(args) @@ -51,7 +49,7 @@ download_enrichr_databases <- function( input_control$auto_validate() genesets <- enrichr_get_genesets(databases = gene_set_lib) - + genesets <- do.call(rbind, lapply(names(genesets), function(db.nam) { do.call(rbind, lapply(names(genesets[[db.nam]]), function(set.nam) { tibble::tibble( @@ -61,16 +59,16 @@ download_enrichr_databases <- function( ) })) })) - + genesets <- genesets |> mutate(Gene = gsub(",.+$", "", .data$Gene)) - + dir.create( output_dir, recursive = TRUE, showWarnings = FALSE - ) - + ) + # Create filename if not specified if (is.null(filename)) { timestamp <- format( @@ -82,23 +80,23 @@ download_enrichr_databases <- function( timestamp, ".tsv" ) } - + filename_path <- here::here( output_dir, filename - ) + ) utils::write.table( x = genesets, file = filename_path, - sep = "\t", - row.names = FALSE, - col.names = TRUE, - quote = FALSE # Do not quote strings + sep = "\t", + row.names = FALSE, + col.names = TRUE, + quote = FALSE # Do not quote strings ) - + message("Download complete! The file has been saved as: ", filename_path) - + return(invisible(filename_path)) } @@ -113,48 +111,46 @@ download_enrichr_databases <- function( #' It returns a list where each element is a list corresponding to a database, #' with each element containing a vector of human gene symbols for a gene set. #' -#' @param databases A character vector of database names to download from +#' @param databases A character vector of database names to download from #' Enrichr. #' #' @return A named list of gene sets from the specified Enrichr databases. Each -#' database is represented as a list, with gene set names as list +#' database is represented as a list, with gene set names as list #' names and vectors of human gene symbols as list elements. #' enrichr_get_genesets <- function(databases) { - pb <- create_progress_bar( databases, message = "Downloading" - ) - + ) + setNames(lapply(databases, function(dbx) { - # Update the progress bar pb$tick() - + fpath <- paste0( - "http://amp.pharm.mssm.edu/Enrichr/geneSetLibrary?", + "http://amp.pharm.mssm.edu/Enrichr/geneSetLibrary?", "mode=text&libraryName=", dbx - ) - + ) + fhandle <- file(fpath) - dblines <- tryCatch({ - readLines(con = fhandle) - }, error = function(e){ - message(e, "\nFailed reading database: ", dbx) - NULL - }) + dblines <- tryCatch( + { + readLines(con = fhandle) + }, + error = function(e) { + message(e, "\nFailed reading database: ", dbx) + NULL + } + ) close(fhandle) - + if (is.null(dblines)) { - return(list()) - } else { - res <- strsplit(dblines, "\t") - names(res) <- sapply(res, function(x) x[1]) + names(res) <- vapply(res, function(x) x[1], character(1)) res <- lapply(res, function(x) x[3:length(x)]) return(res) } diff --git a/R/explore_data.R b/R/explore_data.R index 424c475..b81b4d8 100755 --- a/R/explore_data.R +++ b/R/explore_data.R @@ -4,11 +4,11 @@ #' Generate Exploratory Plots #' #' @description -#' This function takes a data matrix, checks its validity, and generates a list -#' of exploratory plots including density plots, boxplots, PCA plots, MDS plots, +#' This function takes a data matrix, checks its validity, and generates a list +#' of exploratory plots including density plots, boxplots, PCA plots, MDS plots, #' variance explained plots, and violin plots. #' -#' @param splineomics A SplineOmics object, containing the data, meta, +#' @param splineomics A SplineOmics object, containing the data, meta, #' condition, report_info, meta_batch_column, and #' meta_batch2_column; #' @param report_dir A non-empty string specifying the report directory. @@ -20,30 +20,28 @@ #' @return A list of ggplot objects representing various exploratory plots. #' #' @export -#' +#' explore_data <- function( splineomics, report_dir = here::here(), - report = TRUE - ) { - + report = TRUE) { report_dir <- normalizePath( report_dir, mustWork = FALSE ) - + check_splineomics_elements( splineomics = splineomics, func_type = "explore_data" ) - + # Control the function arguments args <- lapply(as.list(match.call()[-1]), eval, parent.frame()) check_null_elements(args) input_control <- InputControl$new(args) input_control$auto_validate() - - + + data <- splineomics[["data"]] meta <- splineomics[["meta"]] annotation <- splineomics[["annotation"]] @@ -54,9 +52,8 @@ explore_data <- function( meta_batch2_column <- splineomics[["meta_batch2_column"]] data_list <- list(data = data) - + if (!is.null(meta_batch_column)) { - args <- list( x = data, batch = meta[[meta_batch_column]], @@ -68,27 +65,26 @@ explore_data <- function( } batch_corrected_data <- do.call(removeBatchEffect, args) - + data_list$batch_corrected_data <- batch_corrected_data } - + all_plots <- list() report_info$meta_condition <- c(condition) report_info$meta_batch <- paste( - meta_batch_column, + meta_batch_column, meta_batch2_column, sep = ", " - ) - timestamp = format(Sys.time(), "%d_%m_%Y-%H_%M_%S") + ) + timestamp <- format(Sys.time(), "%d_%m_%Y-%H_%M_%S") for (data_name in names(data_list)) { - current_data <- data_list[[data_name]] plots_and_plots_sizes <- generate_explore_plots( - current_data, - meta, + current_data, + meta, condition - ) + ) if (report) { generate_report_html( @@ -100,12 +96,12 @@ explore_data <- function( filename = paste0("explore_", data_name), timestamp = timestamp, report_dir = report_dir - ) + ) } - + all_plots[[data_name]] <- plots_and_plots_sizes$plots } - + print_info_message( message_prefix = "Exploratory data analysis", report_dir = report_dir @@ -121,30 +117,28 @@ explore_data <- function( #' Generate exploratory plots #' #' @description -#' This function generates various exploratory plots including density plots, -#' box plots, violin plots, PCA plots, and correlation heatmaps based on the +#' This function generates various exploratory plots including density plots, +#' box plots, violin plots, PCA plots, and correlation heatmaps based on the #' provided data and metadata. #' #' @param data A data frame or matrix containing the data to be plotted. #' @param meta A data frame containing metadata associated with the data. -#' @param condition A string specifying the column in the metadata that contains +#' @param condition A string specifying the column in the metadata that contains #' the condition or grouping variable. #' #' @return A list containing two elements: #' \describe{ #' \item{plots}{A list of ggplot objects representing the generated plots.} -#' \item{plots_sizes}{A vector of numeric values indicating the sizes of the +#' \item{plots_sizes}{A vector of numeric values indicating the sizes of the #' corresponding plots.} #' } -#' +#' generate_explore_plots <- function( data, meta, - condition - ) { - + condition) { meta[[condition]] <- as.factor(meta[[condition]]) - + plot_functions_and_sizes <- list( list(func = make_density_plots, size = 1), list(func = make_violin_box_plots, size = 1.5), @@ -156,24 +150,25 @@ generate_explore_plots <- function( list(func = plot_first_lag_autocorrelation, size = 1.5), list(func = plot_cv, size = 1.5) ) - + apply_plot_function <- function(entry) { plot_result <- entry$func(data, meta, condition) - list(plots = plot_result, size = entry$size, - flatten = if ("flatten" %in% names(entry)) entry$flatten else TRUE) + list( + plots = plot_result, size = entry$size, + flatten = if ("flatten" %in% names(entry)) entry$flatten else TRUE + ) } - + plot_results <- lapply(plot_functions_and_sizes, apply_plot_function) all_plots <- list() all_plots_sizes <- c() - + # Flatten the results and sizes conditionally for (result in plot_results) { - all_plots <- c(all_plots, "section_break") all_plots_sizes <- c(all_plots_sizes, NA) - + if (is.null(result$size)) { # Special handling for make_correlation_heatmaps all_plots <- c(all_plots, result$plots$heatmaps) @@ -190,197 +185,192 @@ generate_explore_plots <- function( rep( result$size, length(result$plots) - ) ) + ) } } list( - plots = all_plots, + plots = all_plots, plots_sizes = all_plots_sizes - ) + ) } #' Build Explore Data Report #' #' @description -#' This function generates an HTML report containing a header section, table of -#' contents, and a series of plots. Each plot is included in the report with +#' This function generates an HTML report containing a header section, table of +#' contents, and a series of plots. Each plot is included in the report with #' specified sizes. #' -#' @param header_section A string containing the HTML content for the header +#' @param header_section A string containing the HTML content for the header #' section of the report. -#' @param plots A list of ggplot objects representing the plots to be included +#' @param plots A list of ggplot objects representing the plots to be included #' in the report. -#' @param plots_sizes A list of sizes corresponding to each plot, defining the +#' @param plots_sizes A list of sizes corresponding to each plot, defining the #' dimensions to be used when rendering the plots. #' @param report_info A named list containg the report info fields. Here used #' for the email hotkey functionality. -#' @param output_file_path A string specifying the file path where the HTML +#' @param output_file_path A string specifying the file path where the HTML #' report will be saved. #' #' @importFrom purrr discard #' #' @return None. This function writes the HTML content to the specified file. -#' +#' build_explore_data_report <- function( - header_section, - plots, - plots_sizes, + header_section, + plots, + plots_sizes, report_info, - output_file_path - ) { - + output_file_path) { html_content <- paste(header_section, "", sep = "\n") - + toc <- create_toc() - + styles <- define_html_styles() section_header_style <- styles$section_header_style toc_style <- styles$toc_style - + just_plots <- plots |> purrr::discard(~ is.character(.)) pb <- create_progress_bar(just_plots) - + plot_names <- c( - "Density Plots", + "Density Plots", "Violin Box Plots", - "PCA ", + "PCA ", "MDS", "Correlation Heatmaps", "Mean Time Correlation", "Lag1 Differences", "First Lag Autocorrelation", "Coefficient of Variation" - ) - + ) + plot_explanations <- get_explore_plots_explanations() - + major_headers <- c( - "Distribution and Variability Analysis", + "Distribution and Variability Analysis", "Dimensionality Reduction and Clustering", "Time Series Analysis" - ) + ) - major_header_style <- + major_header_style <- "font-size: 6em; font-family: Arial, sans-serif; display: inline-block;" - + toc_index <- 0 toc_index_memory <- toc_index major_header_index <- 0 - + # Generate the sections and plots for (index in seq_along(plots)) { - - if (is.character(plots[[index]])) { # Section break - + if (is.character(plots[[index]])) { # Section break + toc_index <- toc_index + 1 - - if ( - toc_index == 1 || # positions of major headers. - toc_index == 3 || - toc_index == 6 - ) { + if ( + toc_index == 1 || # positions of major headers. + toc_index == 3 || + toc_index == 6 + ) { major_header_index <- major_header_index + 1 - + section_id <- paste0( "section_major_", major_header_index - ) + ) toc <- paste( - toc, + toc, sprintf( - '
  • %s
  • ', - toc_style, + '
  • %s
  • ', + toc_style, section_id, major_headers[major_header_index] - ), + ), sep = "\n" - ) - - group_header <- sprintf( + ) + group_header <- sprintf( '

    %s

    ', - section_id, - major_header_style, + section_id, + major_header_style, major_headers[major_header_index] - ) - - if (toc_index == 3) { + ) + + if (toc_index == 3) { group_header <- paste( - group_header, - '

    If you are unsure - which dimensionality reduction plot to consult, - choose PCA.

    ', + group_header, + '

    If you are unsure + which dimensionality reduction plot to consult, + choose PCA.

    ', sep = "\n" - ) + ) } - + html_content <- paste( html_content, group_header, sep = "\n" - ) + ) } next } - - + + if (toc_index != toc_index_memory) { - section_id <- paste0("section_", toc_index) - toc <- + toc <- paste( - toc, + toc, sprintf( paste0( '
  • ', '%s
  • ' - ), + ), section_id, - plot_names[toc_index]), + plot_names[toc_index] + ), sep = "\n" - ) - + ) + section_header <- sprintf( - '

    %s

    ', - section_id, - section_header_style, + '

    %s

    ', + section_id, + section_header_style, plot_names[toc_index] - ) - + ) + plot_description <- sprintf( '

    %s

    ', plot_explanations[toc_index] - ) - + ) + html_content <- paste( - html_content, - section_header, - plot_description, + html_content, + section_header, + plot_description, sep = "\n" - ) - + ) + toc_index_memory <- toc_index } - + # Process each plot plot <- plots[[index]] plot_size <- plots_sizes[[index]] img_tag <- plot2base64(plot, plot_size) - + html_content <- paste( html_content, img_tag, - "
    ", # Add horizontal line after each plot + "
    ", # Add horizontal line after each plot sep = "\n" - ) + ) pb$tick() } - + generate_and_write_html( toc = toc, html_content = html_content, @@ -410,11 +400,9 @@ build_explore_data_report <- function( #' @importFrom dplyr everything #' make_density_plots <- function( - data, - meta, - condition - ) { - + data, + meta, + condition) { custom_theme <- ggplot2::theme( panel.background = ggplot2::element_rect(fill = "white", color = "white"), plot.background = ggplot2::element_rect(fill = "white", color = "white"), @@ -422,7 +410,7 @@ make_density_plots <- function( panel.grid.major.y = ggplot2::element_line(color = "grey"), panel.grid.minor = ggplot2::element_blank() ) - + density_plots <- list() # Melt the data to long format using tidyr @@ -432,61 +420,60 @@ make_density_plots <- function( names_to = "variable", values_to = "value" ) - - - if (length(unique(meta[[condition]])) > 1) { # Only when > 2 levels + + + if (length(unique(meta[[condition]])) > 1) { # Only when > 2 levels # Create the overall density plot for all data overall_plot <- ggplot2::ggplot( - data_long, + data_long, ggplot2::aes(x = !!rlang::sym("value")) - ) + + ) + ggplot2::geom_density( fill = "blue", alpha = 0.5 - ) + + ) + ggplot2::ggtitle("All Levels") + custom_theme - + density_plots <- c( density_plots, list(overall_plot) - ) + ) } - - + + # Create density plots for each level of the condition levels <- unique(meta[[condition]]) - + for (level in levels) { - # Filter the data for the current level indices <- which(meta[[condition]] == level) - + data_level <- data[, indices, drop = FALSE] - + data_level_long <- tidyr::pivot_longer( as.data.frame(data_level), cols = everything(), names_to = "variable", values_to = "value" ) - + # Create the density plot for the current level level_plot <- ggplot2::ggplot( - data_level_long, + data_level_long, ggplot2::aes(x = !!rlang::sym("value")) - ) + + ) + ggplot2::geom_density(fill = "blue", alpha = 0.5) + - ggplot2::ggtitle(paste("Level:", level)) + + ggplot2::ggtitle(paste("Level:", level)) + custom_theme - + # Add the level plot to the list density_plots <- c( density_plots, list(level_plot) - ) + ) } - + return(density_plots) } @@ -495,8 +482,8 @@ make_density_plots <- function( #' Generate Violin Box Plot #' #' @description -#' This function generates a violin plot for a given data matrix. The violin -#' plot shows the distribution of the values in the data matrix across different +#' This function generates a violin plot for a given data matrix. The violin +#' plot shows the distribution of the values in the data matrix across different #' variables, with each variable's distribution displayed as a separate violin. #' #' @param data A numeric matrix containing the data. @@ -504,16 +491,14 @@ make_density_plots <- function( #' @param condition The name of the factor column of meta for the experiment #' #' @return A ggplot object representing the violin plot. -#' +#' #' @importFrom ggplot2 ggplot aes geom_violin theme labs #' @importFrom grid unit -#' +#' make_violin_box_plots <- function( data, meta, - condition - ) { - + condition) { custom_theme <- ggplot2::theme( panel.background = ggplot2::element_rect(fill = "white", color = "white"), plot.background = ggplot2::element_rect(fill = "white", color = "white"), @@ -521,44 +506,55 @@ make_violin_box_plots <- function( panel.grid.major.y = ggplot2::element_line(color = "grey"), panel.grid.minor = ggplot2::element_blank() ) - + plots <- list() - + # Create plots for each level of the condition levels <- unique(meta[[condition]]) - + for (level in levels) { - # Filter the data for the current level indices <- which(meta[[condition]] == level) - + data_level <- data[, indices, drop = FALSE] - + data_level_long <- tidyr::pivot_longer( as.data.frame(data_level), cols = everything(), names_to = "variable", values_to = "value" ) - + # Create the violin plot with boxplot overlay for the current level - level_plot <- ggplot2::ggplot(data_level_long, - ggplot2::aes(x = !!rlang::sym("variable"), - y = !!rlang::sym("value"))) + + level_plot <- ggplot2::ggplot( + data_level_long, + ggplot2::aes( + x = !!rlang::sym("variable"), + y = !!rlang::sym("value") + ) + ) + ggplot2::geom_violin(trim = FALSE, fill = "#77DD77", color = "black") + - ggplot2::geom_boxplot(width = 0.1, fill = "white", - color = "black", outlier.shape = NA) + - ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 60, hjust = 1, - size = 6), - plot.margin = grid::unit(c(0, 0, 0, 0), "cm")) + - ggplot2::labs(x = "Timepoint", y = "Value", - title = paste("Level:", level)) + + ggplot2::geom_boxplot( + width = 0.1, fill = "white", + color = "black", outlier.shape = NA + ) + + ggplot2::theme( + axis.text.x = ggplot2::element_text( + angle = 60, hjust = 1, + size = 6 + ), + plot.margin = grid::unit(c(0, 0, 0, 0), "cm") + ) + + ggplot2::labs( + x = "Timepoint", y = "Value", + title = paste("Level:", level) + ) + custom_theme - + # Add the level plot to the list plots <- c(plots, list(level_plot)) } - + return(plots) } @@ -566,65 +562,67 @@ make_violin_box_plots <- function( #' Mean Correlation with Time Plot #' #' @description -#' This function takes a data frame with time series data -#' (rows as features and columns as samples) -#' and a meta table with sample information including time points, computes -#' the correlation of each +#' This function takes a data frame with time series data +#' (rows as features and columns as samples) +#' and a meta table with sample information including time points, computes +#' the correlation of each #' feature with time, and plots the distribution of these correlations. #' #' @param data A data frame where rows are features and columns are samples. #' @param meta A data frame with sample metadata. Must contain a column "Time". -#' @param condition The column of the meta dataframe containign the levels that +#' @param condition The column of the meta dataframe containign the levels that #' separate the experiment. #' #' @return A ggplot2 object showing the distribution of mean correlations #' with time. -#' +#' #' @importFrom rlang .data -#' +#' plot_mean_correlation_with_time <- function( data, meta, - condition - ) { - + condition) { plot_list <- list() - + # Loop through each level of the condition for (cond in unique(meta[[condition]])) { # Subset the data and meta for the current condition condition_indices <- which(meta[[condition]] == cond) data_subset <- data[, condition_indices] time_subset <- meta$Time[condition_indices] - + # Compute correlation of each feature with time correlations <- apply(data_subset, 1, function(feature) { cor(feature, time_subset, use = "complete.obs") }) - + # Create a data frame for plotting, ensuring row names are set if (is.null(rownames(data))) { rownames(data) <- paste0("Feature", 1:nrow(data)) } - + cor_data <- data.frame( Feature = rownames(data), Correlation = correlations - ) - + ) + # Generate the plot p <- ggplot2::ggplot(cor_data, aes(x = .data$Correlation)) + - ggplot2::geom_histogram(binwidth = 0.05, fill = "#bcbd22", - color = "black") + + ggplot2::geom_histogram( + binwidth = 0.05, fill = "#bcbd22", + color = "black" + ) + ggplot2::theme_minimal() + - ggplot2::labs(title = paste("Level:", cond), - x = "Correlation with Time", - y = "Count of Features") - + ggplot2::labs( + title = paste("Level:", cond), + x = "Correlation with Time", + y = "Count of Features" + ) + # Add the plot to the list plot_list[[cond]] <- p } - + return(plot_list) } @@ -632,42 +630,40 @@ plot_mean_correlation_with_time <- function( #' First Lag Autocorrelation Coefficients Plot #' #' @description -#' This function takes a data frame with time series data +#' This function takes a data frame with time series data #' (rows as features and columns as samples), -#' a meta table with sample information including time points and conditions, +#' a meta table with sample information including time points and conditions, #' computes the first lag -#' autocorrelation for each feature for each condition level, and plots the +#' autocorrelation for each feature for each condition level, and plots the #' distribution of these #' autocorrelation coefficients. #' #' @param data A data frame where rows are features and columns are samples. -#' @param meta A data frame with sample metadata. Must contain a column "Time" +#' @param meta A data frame with sample metadata. Must contain a column "Time" #' and the condition column. -#' @param condition The name of the column in the meta table that contains the +#' @param condition The name of the column in the meta table that contains the #' condition information. #' -#' @return A list of ggplot2 objects, each showing the distribution of first +#' @return A list of ggplot2 objects, each showing the distribution of first #' lag autocorrelation coefficients for one condition. -#' +#' #' @importFrom stats acf #' @importFrom rlang .data #' plot_first_lag_autocorrelation <- function( data, - meta, - condition - ) { - + meta, + condition) { # Initialize a list to store the plots plot_list <- list() - + # Loop through each level of the condition for (cond in unique(meta[[condition]])) { # Subset the data and meta for the current condition condition_indices <- which(meta[[condition]] == cond) data_subset <- data[, condition_indices] # time_subset <- meta$Time[condition_indices] - + # Compute first lag autocorrelation of each feature autocorrelations <- apply(data_subset, 1, function(feature) { # Compute first lag difference @@ -675,39 +671,45 @@ plot_first_lag_autocorrelation <- function( # Compute autocorrelation stats::acf(lag_diff, plot = FALSE)$acf[2] }) - + # Calculate mean and standard deviation of autocorrelations mean_autocorrelation <- mean(autocorrelations, na.rm = TRUE) std_autocorrelation <- sd(autocorrelations, na.rm = TRUE) - + # Create a data frame for plotting cor_data <- data.frame( Feature = 1:nrow(data), Autocorrelation = autocorrelations - ) - + ) + # Generate the plot p <- ggplot2::ggplot(cor_data, aes(x = .data$Autocorrelation)) + - ggplot2::geom_histogram(binwidth = 0.05, fill = "#9467bd", - color = "black") + + ggplot2::geom_histogram( + binwidth = 0.05, fill = "#9467bd", + color = "black" + ) + ggplot2::theme_minimal() + ggplot2::theme( - plot.title = element_text(size = 13), # Title text size - axis.title.x = element_text(size = 10), # X-axis title text size - axis.title.y = element_text(size = 10), # Y-axis title text size - axis.text.x = element_text(size = 7), # X-axis text size - axis.text.y = element_text(size = 7) # Y-axis text size + plot.title = element_text(size = 13), # Title text size + axis.title.x = element_text(size = 10), # X-axis title text size + axis.title.y = element_text(size = 10), # Y-axis title text size + axis.text.x = element_text(size = 7), # X-axis text size + axis.text.y = element_text(size = 7) # Y-axis text size ) + - ggplot2::labs(title = paste("Level:", cond), - x = "Autocorrelation Coefficient", - y = "Count of Features", - subtitle = paste("Mean:", round(mean_autocorrelation, 3), - "SD:", round(std_autocorrelation, 3))) - + ggplot2::labs( + title = paste("Level:", cond), + x = "Autocorrelation Coefficient", + y = "Count of Features", + subtitle = paste( + "Mean:", round(mean_autocorrelation, 3), + "SD:", round(std_autocorrelation, 3) + ) + ) + # Add the plot to the list plot_list[[cond]] <- p } - + return(plot_list) } @@ -715,110 +717,110 @@ plot_first_lag_autocorrelation <- function( #' Lag-1 Differences Plot #' #' @description -#' This function takes a data frame with time series data +#' This function takes a data frame with time series data #' (rows as features and columns as samples), -#' a meta table with sample information including time points and conditions, +#' a meta table with sample information including time points and conditions, #' computes the lag-1 -#' differences for each feature for each condition level, and plots the +#' differences for each feature for each condition level, and plots the #' distribution of these #' differences. #' #' @param data A data frame where rows are features and columns are samples. -#' @param meta A data frame with sample metadata. Must contain a column "Time" +#' @param meta A data frame with sample metadata. Must contain a column "Time" #' and the condition column. -#' @param condition The name of the column in the meta table that contains the +#' @param condition The name of the column in the meta table that contains the #' condition information. #' -#' @return A list of ggplot2 objects, each showing the distribution of lag-1 +#' @return A list of ggplot2 objects, each showing the distribution of lag-1 #' differences for one condition. -#' +#' #' @importFrom stats sd #' @importFrom rlang .data #' plot_lag1_differences <- function( - data, - meta, - condition - ) { - + data, + meta, + condition) { plot_list <- list() - + # Loop through each level of the condition for (cond in unique(meta[[condition]])) { # Subset the data and meta for the current condition condition_indices <- which(meta[[condition]] == cond) data_subset <- data[, condition_indices] - + # Compute absolute lag-1 differences of each feature - lag1_differences <- t(apply(data_subset, 1, - function(feature) { - abs(diff(feature)) - })) - + lag1_differences <- t(apply( + data_subset, 1, + function(feature) { + abs(diff(feature)) + } + )) + # Normalize lag-1 differences by the mean of the feature values feature_means <- apply( data_subset, 1, mean, na.rm = TRUE - ) - + ) + normalized_lag1_differences <- lag1_differences / feature_means - + # Calculate mean and stdev of normalized lag-1 differences for each feature mean_lag1_diff <- apply( normalized_lag1_differences, 1, mean, na.rm = TRUE - ) - + ) + std_lag1_diff <- apply( normalized_lag1_differences, 1, stats::sd, na.rm = TRUE - ) - + ) + # Create a data frame for plotting diff_data <- data.frame( Feature = 1:nrow(data), Mean_Lag1_Difference = mean_lag1_diff, Std_Lag1_Difference = std_lag1_diff ) - + # Generate the plot p <- ggplot2::ggplot( diff_data, aes(x = .data$Mean_Lag1_Difference) - ) + + ) + ggplot2::geom_histogram( binwidth = 0.005, fill = "#ff7f0e", color = "black" - ) + + ) + ggplot2::theme_minimal() + ggplot2::theme( - plot.title = ggplot2::element_text(size = 13), - axis.title.x = ggplot2::element_text(size = 10), - axis.title.y = ggplot2::element_text(size = 10), - axis.text.x = ggplot2::element_text(size = 7), - axis.text.y = ggplot2::element_text(size = 7) + plot.title = ggplot2::element_text(size = 13), + axis.title.x = ggplot2::element_text(size = 10), + axis.title.y = ggplot2::element_text(size = 10), + axis.text.x = ggplot2::element_text(size = 7), + axis.text.y = ggplot2::element_text(size = 7) ) + ggplot2::labs( title = paste("Level:", cond), x = "Mean Normalized Absolute Lag-1 Difference", y = "Count of Features", subtitle = paste( - "Mean:", - round(mean(mean_lag1_diff, na.rm = TRUE), 3), + "Mean:", + round(mean(mean_lag1_diff, na.rm = TRUE), 3), "SD:", round(stats::sd(mean_lag1_diff, na.rm = TRUE), 3) - ) ) - + ) + plot_list[[cond]] <- p } - + return(plot_list) } @@ -827,63 +829,61 @@ plot_lag1_differences <- function( #' Coefficient of Variation (CV) Plot #' #' @description -#' This function takes a data frame with time series data +#' This function takes a data frame with time series data #' (rows as features and columns as samples), -#' a meta table with sample information including time points and conditions, +#' a meta table with sample information including time points and conditions, #' computes the coefficient -#' of variation (CV) for each feature for each condition level, and plots the +#' of variation (CV) for each feature for each condition level, and plots the #' distribution of these #' CVs. #' #' @param data A data frame where rows are features and columns are samples. #' @param meta A data frame with sample metadata. Must contain a column "Time" #' and the condition column. -#' @param condition The name of the column in the meta table that contains the +#' @param condition The name of the column in the meta table that contains the #' condition information. #' #' @return A list of ggplot2 objects, each showing the distribution of CVs for #' one condition. #' plot_cv <- function( - data, - meta, - condition - ) { - + data, + meta, + condition) { plot_list <- list() - + for (cond in unique(meta[[condition]])) { condition_indices <- which(meta[[condition]] == cond) data_subset <- data[, condition_indices] - + # Compute CV of each feature cvs <- apply(data_subset, 1, function(feature) { sd(feature) / mean(feature) }) - + # Calculate mean and standard deviation of CVs mean_cv <- mean(cvs, na.rm = TRUE) std_cv <- stats::sd(cvs, na.rm = TRUE) - + # Create a data frame for plotting cv_data <- data.frame( Feature = seq_len(nrow(data)), CV = cvs ) - + p <- ggplot2::ggplot(cv_data, aes(x = .data$CV)) + ggplot2::geom_histogram( - binwidth = 0.01, + binwidth = 0.01, fill = "#e377c2", color = "black" - ) + + ) + ggplot2::theme_minimal() + ggplot2::theme( - plot.title = element_text(size = 13), - axis.title.x = element_text(size = 10), - axis.title.y = element_text(size = 10), - axis.text.x = element_text(size = 7), - axis.text.y = element_text(size = 7) + plot.title = element_text(size = 13), + axis.title.x = element_text(size = 10), + axis.title.y = element_text(size = 10), + axis.text.x = element_text(size = 7), + axis.text.y = element_text(size = 7) ) + ggplot2::labs( title = paste("Level:", cond), @@ -891,15 +891,15 @@ plot_cv <- function( y = "Count of Features", subtitle = paste( "Mean CV:", - round(mean_cv, 3), + round(mean_cv, 3), "SD CV:", round(std_cv, 3) - ) ) - + ) + plot_list[[cond]] <- p } - + return(plot_list) } @@ -916,60 +916,60 @@ plot_cv <- function( #' factor levels for coloring the PCA plot. #' #' @return A ggplot object representing the PCA plot. -#' +#' #' @importFrom stats prcomp #' @importFrom ggplot2 ggplot geom_point xlim xlab ylab ggtitle theme_minimal #' theme #' @importFrom ggrepel geom_text_repel -#' +#' make_pca_plot <- function( - data, - meta, - condition -) { - + data, + meta, + condition) { # Perform PCA pc <- stats::prcomp(t(data)) pca_df <- data.frame(PC1 = pc$x[, 1], PC2 = pc$x[, 2]) - + # Add labels and levels from the metadata pca_df$Labels <- colnames(data) pca_df$Levels <- meta[[condition]] - + # Add time column for alpha transparency pca_df$Time <- meta$Time - + # Normalize the Time column to a 0-1 range for alpha values pca_df$Alpha <- scales::rescale(pca_df$Time, to = c(0.3, 1)) - + # Calculate the variance explained variance_explained <- pc$sdev^2 / sum(pc$sdev^2) percent_variance_explained <- round(variance_explained * 100, digits = 1) - + # Extend the x-axis range x_range <- range(pc$x[, 1]) extended_x_max <- x_range[2] + (x_range[2] - x_range[1]) * 0.2 - + # Create the PCA plot pca_plot <- ggplot2::ggplot(pca_df, aes( - x = !!rlang::sym("PC1"), - y = !!rlang::sym("PC2"), + x = !!rlang::sym("PC1"), + y = !!rlang::sym("PC2"), color = !!rlang::sym("Levels"), - alpha = !!rlang::sym("Alpha"))) + + alpha = !!rlang::sym("Alpha") + )) + ggplot2::geom_point() + - ggrepel::geom_text_repel(aes(label = !!rlang::sym("Labels")), - box.padding = 0.35, - point.padding = 0.5, - max.overlaps = Inf, - size = 2) + + ggrepel::geom_text_repel(aes(label = !!rlang::sym("Labels")), + box.padding = 0.35, + point.padding = 0.5, + max.overlaps = Inf, + size = 2 + ) + ggplot2::xlim(x_range[1], extended_x_max) + ggplot2::xlab(paste("PC1 -", percent_variance_explained[1], "% variance")) + ggplot2::ylab(paste("PC2 -", percent_variance_explained[2], "% variance")) + ggplot2::labs(color = condition) + - ggplot2::scale_alpha(range = c(0.3, 1), guide = "none") + # Hide alpha + ggplot2::scale_alpha(range = c(0.3, 1), guide = "none") + # Hide alpha ggplot2::theme_minimal() + ggplot2::theme(plot.title = element_text(hjust = 0.5)) - + return(pca_plot) } @@ -978,66 +978,64 @@ make_pca_plot <- function( #' Generate MDS Plot #' #' @description -#' This function generates a multidimensional scaling (MDS) plot for a given -#' data matrix. The MDS plot visualizes the similarities or dissimilarities +#' This function generates a multidimensional scaling (MDS) plot for a given +#' data matrix. The MDS plot visualizes the similarities or dissimilarities #' between samples in the data matrix. #' #' @param data A numeric matrix containing the data. #' @param meta A dataframe, containign the meta information of data. -#' @param condition The column of the meta dataframe containign the levels that +#' @param condition The column of the meta dataframe containign the levels that #' separate the experiment. #' #' @return A ggplot object representing the MDS plot. -#' +#' #' @importFrom limma plotMDS #' @importFrom ggplot2 ggplot geom_point ggtitle theme_minimal #' @importFrom ggrepel geom_text_repel -#' +#' make_mds_plot <- function( data, meta, - condition -) { - + condition) { # Perform MDS using limma's plotMDS function mds <- limma::plotMDS( x = data, plot = FALSE ) - + # Extract MDS coordinates mds_df <- data.frame( - Dim1 = mds$x, - Dim2 = mds$y, + Dim1 = mds$x, + Dim2 = mds$y, Labels = colnames(data) ) - + # Add condition levels and time information from metadata mds_df$Levels <- meta[[condition]] mds_df$Time <- meta$Time - + # Normalize the Time column to a 0-1 range for alpha values mds_df$Alpha <- scales::rescale(mds_df$Time, to = c(0.3, 1)) - + # Generate the MDS plot using ggplot2 and ggrepel mds_plot <- ggplot2::ggplot( - mds_df, + mds_df, ggplot2::aes( - x = .data$Dim1, - y = .data$Dim2, + x = .data$Dim1, + y = .data$Dim2, label = .data$Labels, color = .data$Levels, - alpha = .data$Alpha # Use alpha for transparency + alpha = .data$Alpha # Use alpha for transparency ) ) + ggplot2::geom_point() + ggrepel::geom_text_repel( - box.padding = 0.35, - point.padding = 0.5, + box.padding = 0.35, + point.padding = 0.5, max.overlaps = Inf, size = 2 ) + - ggplot2::scale_alpha(range = c(0.3, 1), guide = "none") + # Hide alpha + ggplot2::scale_alpha(range = c(0.3, 1), guide = "none") + # Hide alpha ggplot2::theme_minimal() + ggplot2::labs( x = "Dimension 1", @@ -1045,7 +1043,7 @@ make_mds_plot <- function( color = condition ) + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)) - + return(mds_plot) } @@ -1053,46 +1051,48 @@ make_mds_plot <- function( #' Generate Correlation Heatmaps #' #' @description -#' This function generates correlation heatmaps using Spearman correlation for -#' a given data matrix. It creates a combined heatmap for all levels and -#' individual heatmaps for each level specified in the condition column of the +#' This function generates correlation heatmaps using Spearman correlation for +#' a given data matrix. It creates a combined heatmap for all levels and +#' individual heatmaps for each level specified in the condition column of the #' metadata. #' #' @param data A numeric matrix containing the data. #' @param meta A dataframe containing the metadata. -#' @param condition The column name in the metadata dataframe that contains the +#' @param condition The column name in the metadata dataframe that contains the #' factor levels for generating individual heatmaps. #' -#' @return A list of `ComplexHeatmap` heatmap objects representing the -#' correlation +#' @return A list of `ComplexHeatmap` heatmap objects representing the +#' correlation #' heatmaps. #' #' @importFrom stats cor #' @importFrom ComplexHeatmap Heatmap #' @importFrom grDevices colorRampPalette -#' +#' make_correlation_heatmaps <- function( - data, - meta, - condition - ) { - + data, + meta, + condition) { heatmaps <- list() heatmaps_sizes <- c() - - if (length(unique(meta[[condition]])) > 1) { # Only when > 2 levels + + if (length(unique(meta[[condition]])) > 1) { # Only when > 2 levels # Create combined correlation heatmap - corr_all <- stats::cor(data, method = "spearman", - use = "pairwise.complete.obs") + corr_all <- stats::cor(data, + method = "spearman", + use = "pairwise.complete.obs" + ) # Remove perfect correlations for better visualization diag(corr_all) <- NA - + # Define the color function for the heatmap based on the range of corr_all - breaks <- seq(min(corr_all, na.rm = TRUE), - max(corr_all, na.rm = TRUE), length.out = 100) + breaks <- seq(min(corr_all, na.rm = TRUE), + max(corr_all, na.rm = TRUE), + length.out = 100 + ) col_fun <- colorRampPalette(c("blue", "white", "red")) - + heatmap_all <- ComplexHeatmap::Heatmap( corr_all, col = col_fun(100), @@ -1100,9 +1100,9 @@ make_correlation_heatmaps <- function( column_title = "All Levels", heatmap_legend_param = list( title = "Spearman Correlation", - title_gp = gpar(fontsize = 6), - labels_gp = gpar(fontsize = 6), - title_position = "leftcenter-rot" + title_gp = gpar(fontsize = 6), + labels_gp = gpar(fontsize = 6), + title_position = "leftcenter-rot" ), na_col = "grey", row_names_gp = gpar(fontsize = 6), @@ -1111,31 +1111,37 @@ make_correlation_heatmaps <- function( ) heatmaps <- c(heatmaps, list(heatmap_all)) } - + # Custom scaling logic for the HTML report - heatmap_all_size <- max(1.5 * length(meta[[condition]]) / 25, - 1) + heatmap_all_size <- max( + 1.5 * length(meta[[condition]]) / 25, + 1 + ) heatmaps_sizes <- c(heatmaps_sizes, heatmap_all_size) - + # Create correlation heatmaps for each level of the condition levels <- unique(meta[[condition]]) for (level in levels) { # Filter the data for the current level indices <- which(meta[[condition]] == level) data_level <- data[, indices, drop = FALSE] - + # Compute Spearman correlation - corr_level <- stats::cor(data_level, method = "spearman", - use = "pairwise.complete.obs") + corr_level <- stats::cor(data_level, + method = "spearman", + use = "pairwise.complete.obs" + ) # Remove perfect correlations for better visualization diag(corr_level) <- NA - + # Define the color function for the heatmap based on the range of corr_level - breaks_level <- seq(min(corr_level, na.rm = TRUE), - max(corr_level, na.rm = TRUE), length.out = 100) - + breaks_level <- seq(min(corr_level, na.rm = TRUE), + max(corr_level, na.rm = TRUE), + length.out = 100 + ) + col_fun_level <- colorRampPalette(c("blue", "white", "red")) - + # Create the correlation heatmap for the current level heatmap_level <- ComplexHeatmap::Heatmap( corr_level, @@ -1144,27 +1150,31 @@ make_correlation_heatmaps <- function( column_title = paste("Level:", level), heatmap_legend_param = list( title = "Spearman Correlation", - title_gp = gpar(fontsize = 6), - labels_gp = gpar(fontsize = 6), - title_position = "leftcenter-rot" + title_gp = gpar(fontsize = 6), + labels_gp = gpar(fontsize = 6), + title_position = "leftcenter-rot" ), na_col = "grey", row_names_gp = gpar(fontsize = 6), column_names_gp = gpar(fontsize = 6), column_names_rot = 60 ) - + heatmaps <- c(heatmaps, list(heatmap_level)) - + # Custom scaling logic for the HTML report nr_level_timepoints <- sum(meta[[condition]] == level) - heatmap_level_size <- max(1.5 * nr_level_timepoints / 17, - 1) + heatmap_level_size <- max( + 1.5 * nr_level_timepoints / 17, + 1 + ) heatmaps_sizes <- c(heatmaps_sizes, heatmap_level_size) } - - list(heatmaps = heatmaps, - heatmaps_sizes = heatmaps_sizes) + + list( + heatmaps = heatmaps, + heatmaps_sizes = heatmaps_sizes + ) } @@ -1182,13 +1192,12 @@ make_correlation_heatmaps <- function( #' autocorrelation plots, coefficient of variation (CV) plots, PCA plots, PCA #' variance explained plots, MDS plots, and correlation heatmaps. Each #' explanation provides insights on what the plot shows and how to interpret it. -#' +#' get_explore_plots_explanations <- function() { - plot_explanations_file <- system.file( "descriptions", "explore_plot_explanations.txt", package = "SplineOmics" - ) + ) plot_explanations <- readLines(plot_explanations_file) } diff --git a/R/extract_data.R b/R/extract_data.R index c9c86ff..da304b1 100755 --- a/R/extract_data.R +++ b/R/extract_data.R @@ -1,6 +1,6 @@ -#' extract_data.R contains the exported package function extract_data. This +#' extract_data.R contains the exported package function extract_data. This #' function automatically recognises the data field in a table and returns the -#' data matrix, that serves as input for the other functions of this package. +#' data matrix, that serves as input for the other functions of this package. #' This is for convenience only. @@ -9,20 +9,20 @@ #' Extract Numeric Matrix from Dataframe #' #' @description -#' This function takes a dataframe and identifies a rectangular or quadratic -#' area containing numeric data, starting from the first occurrence of a -#' 6x6 block of numeric values. It then extracts this area into a matrix, -#' ensuring that each row contains only numeric values. Rows with any NA values +#' This function takes a dataframe and identifies a rectangular or quadratic +#' area containing numeric data, starting from the first occurrence of a +#' 6x6 block of numeric values. It then extracts this area into a matrix, +#' ensuring that each row contains only numeric values. Rows with any NA values #' are removed from the resulting matrix. #' -#' @param data A dataframe loaded from a tabular file, potentially containing a +#' @param data A dataframe loaded from a tabular file, potentially containing a #' rectangular or quadratic area with numeric data amidst other values. #' @param feature_name_columns (Optional) A character vector, specifying the -#' columns of the dataframe data, that should be +#' columns of the dataframe data, that should be #' used to construct the feature names. If ommited, #' the feature names are just numbers (stored as #' characters) starting from 1 (1, 2, 3, etc.) -#' @param user_prompt Boolean specifying whether the user prompt about the +#' @param user_prompt Boolean specifying whether the user prompt about the #' correct format of the input data should be shown. #' #' @return A numeric matrix with row headers and appropriate column names. @@ -30,90 +30,88 @@ #' @importFrom stats complete.cases #' #' @export -#' +#' extract_data <- function( data, feature_name_columns = NA, - user_prompt = TRUE - ) { - + user_prompt = TRUE) { control_inputs_extract_data( data = data, feature_name_columns = feature_name_columns - ) - + ) + if (user_prompt) { ask_user(paste( "Is the data matrix on the left, the annotation info on the right,", "separated by an empty column? " - )) + )) } - + data <- as.data.frame(data) - + numeric_block_finder <- NumericBlockFinder$new(data) upper_left_cell <- numeric_block_finder$find_upper_left_cell() lower_right_cell <- numeric_block_finder$find_lower_right_cell() - + upper_left_row <- upper_left_cell$upper_left_row upper_left_col <- upper_left_cell$upper_left_col - + lower_right_row <- lower_right_cell$lower_right_row lower_right_col <- lower_right_cell$lower_right_col - + # Extract the numeric data block numeric_data <- data[ upper_left_row:lower_right_row, upper_left_col:lower_right_col - ] + ] numeric_data[] <- - lapply(numeric_data, function(col) suppressWarnings( - as.numeric(as.character(col)))) + lapply(numeric_data, function(col) { + suppressWarnings( + as.numeric(as.character(col)) + ) + }) # Check if every element of numeric_data is numeric - if (any(sapply(numeric_data, function(col) all(is.na(col))))) { - stop( - paste( + if (any(vapply(numeric_data, function(col) all(is.na(col)), logical(1)))) { + stop_call_false(paste( "All elements of the data field must be numeric. Please", "ensure there is an empty column between the numeric data and", "the annotation information, which, if present, must be on the", "right of the numeric data, not on the left." - ), - call. = FALSE - ) + )) } # Remove rows and columns that are entirely NA numeric_data <- numeric_data[ - rowSums(is.na(numeric_data)) != ncol(numeric_data), - ] + rowSums(is.na(numeric_data)) != ncol(numeric_data), + ] numeric_data <- numeric_data[ , colSums(is.na(numeric_data)) != nrow(numeric_data) - ] + ] # Remove rows with any NA values clean_data <- numeric_data[stats::complete.cases(numeric_data), ] - + # Extract headers for each column above the identified block - headers <- sapply(upper_left_col:lower_right_col, function(col_idx) { + headers <- vapply(upper_left_col:lower_right_col, function(col_idx) { header_values <- data[1:(upper_left_row - 1), col_idx] header_values <- header_values[!is.na(header_values)] paste(header_values, collapse = "_") - }) - + }, character(1)) + colnames(clean_data) <- headers - + clean_data <- add_feature_names( data = data, clean_data = clean_data, feature_name_columns = feature_name_columns - ) - + ) + clean_matrix <- as.matrix(clean_data) rownames(clean_matrix) <- rownames(clean_data) - + clean_matrix } @@ -124,7 +122,7 @@ extract_data <- function( #' NumericBlockFinder: A class for finding numeric blocks in data #' -#' This class provides methods to identify the upper-left and lower-right +#' This class provides methods to identify the upper-left and lower-right #' cells of a numeric block within a dataframe. #' #' @field data A dataframe containing the input data. @@ -135,34 +133,32 @@ NumericBlockFinder <- R6::R6Class("NumericBlockFinder", public = list( data = NULL, upper_left_cell = NULL, - - + + #' Initialize a NumericBlockFinder object #' #' @param data A dataframe containing the input data. #' @return A new instance of the NumericBlockFinder class. - #' + #' initialize = function(data) { - self$data <- as.data.frame(data) }, - - + + #' Find the upper-left cell of the first 6x6 block of numeric values #' - #' This method identifies the upper-left cell of the first 6x6 block of + #' This method identifies the upper-left cell of the first 6x6 block of #' numeric values in the dataframe. #' - #' @return A list containing the row and column indices of the upper-left + #' @return A list containing the row and column indices of the upper-left #' cell. - #' + #' find_upper_left_cell = function() { - upper_left_row <- NA upper_left_col <- NA num_rows <- nrow(self$data) num_cols <- ncol(self$data) - + for (i in 1:(num_rows - 5)) { for (j in 1:(num_cols - 5)) { block <- self$data[i:(i + 5), j:(j + 5)] @@ -175,18 +171,21 @@ NumericBlockFinder <- R6::R6Class("NumericBlockFinder", } if (!is.na(upper_left_row)) break } - + if (is.na(upper_left_row) || is.na(upper_left_col)) { stop("No at least 6x6 block of numeric values found.", - call. = FALSE) + call. = FALSE + ) } - - self$upper_left_cell <- list(upper_left_row = upper_left_row, - upper_left_col = upper_left_col) + + self$upper_left_cell <- list( + upper_left_row = upper_left_row, + upper_left_col = upper_left_col + ) return(self$upper_left_cell) }, - - + + #' Find the lower-right cell of a block of contiguous non-NA values #' #' This method identifies the lower-right cell of a block of contiguous @@ -194,19 +193,20 @@ NumericBlockFinder <- R6::R6Class("NumericBlockFinder", #' #' @return A list containing the row and column indices of the lower-right #' cell. - #' + #' find_lower_right_cell = function() { - if (is.null(self$upper_left_cell)) { - stop(paste("Upper-left cell has not been identified.", - "Call find_upper_left_cell first."), call. = FALSE) + stop(paste( + "Upper-left cell has not been identified.", + "Call find_upper_left_cell first." + ), call. = FALSE) } - + upper_left_row <- self$upper_left_cell$upper_left_row upper_left_col <- self$upper_left_cell$upper_left_col num_rows <- nrow(self$data) num_cols <- ncol(self$data) - + # Expand the block vertically lower_right_row <- upper_left_row for (i in (upper_left_row + 1):num_rows) { @@ -215,18 +215,20 @@ NumericBlockFinder <- R6::R6Class("NumericBlockFinder", } lower_right_row <- i } - + # Expand the block horizontally lower_right_col <- upper_left_col - for (j in (upper_left_col+1):num_cols) { + for (j in (upper_left_col + 1):num_cols) { if (is.na(self$data[upper_left_row, j])) { break } lower_right_col <- j } - - list(lower_right_row = lower_right_row, - lower_right_col = lower_right_col) + + list( + lower_right_row = lower_right_row, + lower_right_col = lower_right_col + ) } ) ) @@ -239,60 +241,63 @@ NumericBlockFinder <- R6::R6Class("NumericBlockFinder", #' #' @description #' This function checks the validity of input data and the feature name column. -#' It ensures that the input data is a dataframe, the feature name column is +#' It ensures that the input data is a dataframe, the feature name column is #' specified correctly, and contains valid data. #' #' @param data A dataframe containing the input data. -#' @param feature_name_columns A character vector specifying the names of the +#' @param feature_name_columns A character vector specifying the names of the #' feature name columns. The columns must be present -#' in the dataframe data. If `NA`, no column is +#' in the dataframe data. If `NA`, no column is #' checked. #' #' @details #' The function performs the following checks: #' - Ensures the input data is a dataframe. -#' - Checks if the feature name column is a single string and exists in the +#' - Checks if the feature name column is a single string and exists in the #' data. -#' - Ensures the specified feature name column does not contain only `NA` +#' - Ensures the specified feature name column does not contain only `NA` #' values. #' - Checks if the input dataframe is not empty. #' #' If any of these checks fail, the function stops with an error message. -#' +#' control_inputs_extract_data <- function( data, - feature_name_columns - ) { - + feature_name_columns) { if (!is.data.frame(data)) { stop("Input data must be a dataframe.", call. = FALSE) } - + if (!any(is.na(feature_name_columns))) { - if (!is.character(feature_name_columns)) { stop("feature_name_columns should be a character vector.", call. = FALSE) } - + missing_columns <- setdiff(feature_name_columns, colnames(data)) if (length(missing_columns) > 0) { - stop(paste( - "The following feature_name_columns are not present in the data:", - paste(missing_columns, collapse = ", ") + stop( + paste( + "The following feature_name_columns are not present in the data:", + paste(missing_columns, collapse = ", ") ), - call. = FALSE) + call. = FALSE + ) } - - + + if (!any(is.na(feature_name_columns))) { if (all(is.na(data[feature_name_columns]))) { - stop(paste("Columns '", paste(feature_name_columns, collapse = ", "), - "' contain only NA values.", sep = ""), - call. = FALSE) + stop( + paste("Columns '", paste(feature_name_columns, collapse = ", "), + "' contain only NA values.", + sep = "" + ), + call. = FALSE + ) } } } - + if (nrow(data) == 0) { stop("Input dataframe is empty.", call. = FALSE) } @@ -302,14 +307,14 @@ control_inputs_extract_data <- function( #' Prompt the user with a yes/no question #' #' @description -#' This function prompts the user with a yes/no question. If the user answers -#' "yes" (case insensitive), the code proceeds. If the user answers "no" or +#' This function prompts the user with a yes/no question. If the user answers +#' "yes" (case insensitive), the code proceeds. If the user answers "no" or #' anything else, the code stops. #' #' @param question A string of the question to ask the user. -#' +#' #' @return None. -#' +#' ask_user <- function(question) { message(question, " (yes/no):") response <- readline() @@ -324,70 +329,78 @@ ask_user <- function(question) { #' Add Feature Names to Data #' #' @description -#' This function assigns feature names to the rows of a dataframe based on a -#' specified column from another dataframe. If no column is specified, it +#' This function assigns feature names to the rows of a dataframe based on a +#' specified column from another dataframe. If no column is specified, it #' assigns sequential numbers as feature names. #' #' @param data A dataframe containing the original data with feature names. #' @param clean_data A dataframe to which the feature names will be added. -#' @param feature_name_columns A string specifying the name of the feature -#' columns in `data`. If `NA`, sequential numbers +#' @param feature_name_columns A string specifying the name of the feature +#' columns in `data`. If `NA`, sequential numbers #' will be used as feature names. #' #' @details #' The function performs the following operations: #' - Extracts feature names from the specified column in `data`, ignoring #' `NA` values. -#' - Ensures the feature names are unique and match the number of rows in +#' - Ensures the feature names are unique and match the number of rows in #' `clean_data`. #' - Assigns the feature names to the rows of `clean_data`. -#' - If `feature_name_column` is `NA`, assigns sequential numbers -#' (1, 2, 3, etc.) +#' - If `feature_name_column` is `NA`, assigns sequential numbers +#' (1, 2, 3, etc.) #' as feature names and issues a message. #' #' @return The `clean_data` dataframe with updated row names. -#' -add_feature_names <- function(data, - clean_data, +#' +add_feature_names <- function(data, + clean_data, feature_name_columns) { - if (!any(is.na(feature_name_columns))) { - - non_na_index <- which(apply(data[feature_name_columns], 1, - function(row) all(!is.na(row))))[1] + non_na_index <- which(apply( + data[feature_name_columns], 1, + function(row) all(!is.na(row)) + ))[1] data_filtered <- data[non_na_index:nrow(data), , drop = FALSE] clean_data_filtered <- clean_data[non_na_index:nrow(clean_data), , - drop = FALSE] - + drop = FALSE + ] + # Extract and combine the feature names from specified columns - feature_names <- apply(data_filtered[feature_name_columns], 1, - function(row) paste(row, collapse = "_")) - + feature_names <- apply( + data_filtered[feature_name_columns], 1, + function(row) paste(row, collapse = "_") + ) + # Check for NA values in combined feature names feature_names <- as.character(feature_names) feature_names <- feature_names[!is.na(feature_names)] # Ensure unique feature names if (length(feature_names) != length(unique(feature_names))) { - stop("Combined feature names must be unique, ignoring NA values.", - call. = FALSE) + stop("Combined feature names must be unique, ignoring NA values.", + call. = FALSE + ) } - + # Ensure the length matches the number of rows in clean_data if (length(feature_names) != nrow(clean_data)) { - stop(paste("Length of combined feature names does not match the number of", - "rows in clean_data."), - call. = FALSE) + stop( + paste( + "Length of combined feature names does not match the number of", + "rows in clean_data." + ), + call. = FALSE + ) } - + # Assign combined feature names as row names rownames(clean_data) <- feature_names - } else { - rownames(clean_data) <- as.character(seq_len(nrow(clean_data))) - message(paste("No feature_name column specified. Setting numbers 1, 2, 3,", - "etc. as the feature names")) + message(paste( + "No feature_name column specified. Setting numbers 1, 2, 3,", + "etc. as the feature names" + )) } return(clean_data) } diff --git a/R/open_tutorial_and_template.R b/R/open_tutorial_and_template.R index 90179b7..9801850 100755 --- a/R/open_tutorial_and_template.R +++ b/R/open_tutorial_and_template.R @@ -1,64 +1,38 @@ -# This function is exported, but not part of the functionality of the -# SplineOmics package. Rather, it provides a convenient way of opening the -# tutorial for the SplineOmics package in a R Markdown file, which -# provides an interactive experience. - - #' Interactive Tutorial for Getting Started #' #' @description #' This function opens the `tutorial.Rmd` file in RStudio for #' interactive use. Users can then run each code chunk step by step. -#' +#' +#' @return +#' If successful, opens the `tutorial.Rmd` file in RStudio for the user to +#' interact with. +#' If `rstudioapi` is not installed or available, or the tutorial file is +#' not found, +#' an error is thrown with a corresponding message. +#' #' @export -#' +#' open_tutorial <- function() { - # Check if rstudioapi is installed - if (!requireNamespace( - "rstudioapi", - quietly = TRUE - )) { - repeat { - # Prompt the user for action - cat("The 'rstudioapi' package is not installed.\n") - cat("1: Install 'rstudioapi'\n") - cat("2: Do not install and quit\n") - cat("3: Resolve manually and retry\n") - choice <- readline(prompt = "Please enter your choice (1, 2, or 3): ") - - # Check user input and take appropriate action - if (choice == "1") { - utils::install.packages("rstudioapi") - break - } else if (choice == "2") { - stop( - "User chose not to install 'rstudioapi'. Exiting function.", - call. = FALSE - ) - } else if (choice == "3") { - stop( - "Please install 'rstudioapi' manually and retry.", - call. = FALSE) - } else { - cat("Invalid choice. Please enter 1, 2, or 3.\n") - } - } - } - - file <- system.file( - "tutorial", - "tutorial.Rmd", - package = "SplineOmics" + if (!requireNamespace("rstudioapi", quietly = TRUE)) { + stop_call_false( + "The 'rstudioapi' package is not installed. ", + "Please install it manually with: install.packages('rstudioapi')." ) + } + + # Find the tutorial file + file <- system.file("tutorial", "tutorial.Rmd", package = "SplineOmics") + if (file != "") { if (rstudioapi::isAvailable()) { rstudioapi::navigateToFile(file) } else { - stop("RStudio API not available. Cannot open tutorial.") + stop_call_false("RStudio API not available. Cannot open tutorial.") } } else { - stop("tutorial.Rmd file not found under inst/tutorial") + stop_call_false("tutorial.Rmd file not found under inst/tutorial") } } @@ -67,59 +41,38 @@ open_tutorial <- function() { #' #' @description #' This function opens the `template.Rmd` file in RStudio for -#' interactive use. The template file provides a structure for users +#' interactive use. The template file provides a structure for users #' to quickly set up their personal analysis. -#' +#' +#' @return +#' If successful, opens the `template.Rmd` file in RStudio for the user to +#' interact with. +#' If `rstudioapi` is not installed or available, or the template file is +#' not found, +#' an error is thrown with a corresponding message. +#' #' @export -#' +#' open_template <- function() { - # Check if rstudioapi is installed - if (!requireNamespace( - "rstudioapi", - quietly = TRUE - )) { - repeat { - # Prompt the user for action - cat("The 'rstudioapi' package is not installed.\n") - cat("1: Install 'rstudioapi'\n") - cat("2: Do not install and quit\n") - cat("3: Resolve manually and retry\n") - choice <- readline(prompt = "Please enter your choice (1, 2, or 3): ") - - # Check user input and take appropriate action - if (choice == "1") { - utils::install.packages("rstudioapi") - break - } else if (choice == "2") { - stop( - "User chose not to install 'rstudioapi'. Exiting function.", - call. = FALSE - ) - } else if (choice == "3") { - stop( - "Please install 'rstudioapi' manually and retry.", - call. = FALSE) - } else { - cat("Invalid choice. Please enter 1, 2, or 3.\n") - } - } + if (!requireNamespace("rstudioapi", quietly = TRUE)) { + stop( + "The 'rstudioapi' package is not installed. ", + "Please install it manually with: install.packages('rstudioapi').", + call. = FALSE + ) } - - file <- system.file( - "template", - "template.Rmd", - package = "SplineOmics" - ) + + # Find the template file + file <- system.file("template", "template.Rmd", package = "SplineOmics") + if (file != "") { if (rstudioapi::isAvailable()) { rstudioapi::navigateToFile(file) } else { - stop("RStudio API not available. Cannot open template.") + stop("RStudio API not available. Cannot open template.", call. = FALSE) } } else { - stop("template.Rmd file not found under inst/template") + stop("template.Rmd file not found under inst/template", call. = FALSE) } } - - diff --git a/R/preprocess_rna_seq_data.R b/R/preprocess_rna_seq_data.R index 503689a..c2c6fb8 100755 --- a/R/preprocess_rna_seq_data.R +++ b/R/preprocess_rna_seq_data.R @@ -6,7 +6,7 @@ #' @description #' The `preprocess_rna_seq_data()` function performs essential preprocessing #' steps for raw RNA-seq counts. This includes creating a `DGEList` object, -#' normalizing the counts using the default TMM (Trimmed Mean of M-values) +#' normalizing the counts using the default TMM (Trimmed Mean of M-values) #' normalization via the `edgeR::calcNormFactors` function, and applying the #' `voom` transformation from the `limma` package to obtain log-transformed #' counts per million (logCPM) with associated precision weights. If you @@ -19,106 +19,65 @@ #' @param spline_params Parameters for spline functions (optional). Must contain #' the named elements spline_type, which must contain either the string "n" for #' natural cubic splines, or "b", for B-splines, the named element degree in the -#' case of B-splines, that must contain only an integer, and the named element +#' case of B-splines, that must contain only an integer, and the named element #' dof, specifying the degree of freedom, containing an integer and required #' both for natural and B-splines. -#' @param design A design formula for the limma analysis, such as +#' @param design A design formula for the limma analysis, such as #' '~ 1 + Phase*X + Reactor'. -#' @param normalize_func An optional normalization function. If provided, this +#' @param normalize_func An optional normalization function. If provided, this #' function will be used to normalize the `DGEList` object. If not provided, #' TMM normalization (via `edgeR::calcNormFactors`) will be used by default. #' Must take as -#' input the y of: y <- edgeR::DGEList(counts = raw_counts) and output the y +#' input the y of: y <- edgeR::DGEList(counts = raw_counts) and output the y #' with the normalized counts. #' @return A `voom` object, which includes the log2-counts per million (logCPM) #' matrix and observation-specific weights. -#' +#' #' @importFrom limma voom -#' +#' #' @export -#' +#' preprocess_rna_seq_data <- function( raw_counts, meta, spline_params, design, - normalize_func = NULL -) { + normalize_func = NULL) { message("Preprocessing RNA-seq data (normalization + voom)...") - - # Check if edgeR is installed; if not, prompt the user + + # Check if edgeR is installed; if not, inform the user if (!requireNamespace("edgeR", quietly = TRUE)) { - message("The 'edgeR' package is not installed.") - - # Prompt user for action - repeat { - user_input <- readline( - prompt = - "What would you like to do?\n - 1: Automatically install edgeR\n - 2: Manually install edgeR\n - 3: Cancel\n - Please enter 1, 2, or 3: " - ) - - if (user_input == "1") { - # Try to install edgeR automatically from Bioconductor - message("Attempting to install 'edgeR' automatically - from Bioconductor...") - if (!requireNamespace("BiocManager", quietly = TRUE)) { - utils::install.packages("BiocManager") - } - tryCatch( - { - BiocManager::install("edgeR", update = FALSE) - }, - error = function(e) { - stop( - "Automatic installation of 'edgeR' failed. - Please install it manually and try again.", - call. = FALSE - ) - } - ) - break # Exit the loop if installation is successful - } else if (user_input == "2") { - stop( - "Please install 'edgeR' manually using - BiocManager::install('edgeR') and then re-run the function.", - call. = FALSE - ) - } else if (user_input == "3") { - stop("Operation canceled by the user.", call. = FALSE) - } else { - message("Invalid input. Please enter 1, 2, or 3.") - } - } + stop( + "The 'edgeR' package is not installed. ", + "Please install it manually using BiocManager::install('edgeR') ", + "and re-run the function." + ) } - + design_matrix <- design2design_matrix( meta = meta, spline_params = spline_params, level_index = 1, design = design ) - + # Step 1: Create DGEList object from raw counts y <- edgeR::DGEList(counts = raw_counts) - + # Step 2: Apply the normalization function (either user-provided or default) if (!is.null(normalize_func) && is.function(normalize_func)) { - y <- normalize_func(y) # user provided normalisation function + y <- normalize_func(y) # user provided normalisation function } else { # Default: Normalize the counts using TMM normalization y <- edgeR::calcNormFactors(y) } - + # Step 3: Apply voom transformation to get logCPM values and weights voom_obj <- limma::voom( y, design_matrix ) - + return(voom_obj) -} \ No newline at end of file +} diff --git a/R/run_gsea.R b/R/run_gsea.R index 4203300..7c409e2 100755 --- a/R/run_gsea.R +++ b/R/run_gsea.R @@ -34,9 +34,7 @@ run_gsea <- function( clusterProfiler_params = NA, plot_titles = NA, universe = NULL, - report_dir = here::here() - ) { - + report_dir = here::here()) { report_dir <- normalizePath( report_dir, mustWork = FALSE @@ -45,21 +43,22 @@ run_gsea <- function( # Check report_info and report_dir args <- lapply( as.list( - match.call()[-1]), + match.call()[-1] + ), eval, parent.frame() - ) + ) input_control <- InputControl$new(args) input_control$auto_validate() - # Remove levels that levels_clustered_hits <- levels_clustered_hits[ - !sapply( + !vapply( levels_clustered_hits, - is.character - ) - ] + is.character, + logical(1) + ) + ] # Control the test not covered by the InputControl class control_inputs_create_gsea_report( @@ -68,9 +67,9 @@ run_gsea <- function( params = clusterProfiler_params, plot_titles = plot_titles, background = universe - ) + ) - ensure_clusterProfiler() # Deals with clusterProfiler installation. + ensure_clusterProfiler() # Deals with clusterProfiler installation. all_results <- map2( levels_clustered_hits, @@ -81,7 +80,7 @@ run_gsea <- function( databases, clusterProfiler_params, universe - ) + ) ) names(all_results) <- names(levels_clustered_hits) @@ -95,14 +94,14 @@ run_gsea <- function( # Extract the plots, plot sizes, and header info from the processed results plots <- purrr::flatten(map(processed_results, "plot")) plots_sizes <- unlist(map(processed_results, "plot_size")) - + insert_after_each <- function(lst, value) { - result <- vector("list", 2 * length(lst)) # Create a list twice the size - result[seq(1, length(result), by = 2)] <- lst # Insert original elements at odd positions - result[seq(2, length(result), by = 2)] <- value # Insert value at even positions + result <- vector("list", 2 * length(lst)) + result[seq(1, length(result), by = 2)] <- lst + result[seq(2, length(result), by = 2)] <- value return(result) } - + plots <- insert_after_each(plots, "section_break") plots_sizes <- insert_after_each(plots_sizes, 999) @@ -121,7 +120,7 @@ run_gsea <- function( report_type = "create_gsea_report", filename = "create_gsea_report", report_dir = report_dir - ) + ) print_info_message( message_prefix = "Gene set enrichment analysis", @@ -155,9 +154,7 @@ control_inputs_create_gsea_report <- function( databases, params, plot_titles, - background - ) { - + background) { check_clustered_hits(levels_clustered_hits) check_databases(databases) @@ -166,11 +163,12 @@ control_inputs_create_gsea_report <- function( if (!is.na(plot_titles)) { - if (!is.character(plot_titles) || - length(plot_titles) != length(levels_clustered_hits)) { - stop(paste("plot_titles must be a character vector with length == length", - "length levels_clustered_hits"), call. = FALSE) + length(plot_titles) != length(levels_clustered_hits)) { + stop(paste( + "plot_titles must be a character vector with length == length", + "length levels_clustered_hits" + ), call. = FALSE) } } @@ -194,64 +192,19 @@ control_inputs_create_gsea_report <- function( #' is loaded for use. #' ensure_clusterProfiler <- function() { - - # Check if clusterProfiler is installed; if not, prompt the user + # Check if clusterProfiler is installed; if not, inform the user if (!requireNamespace("clusterProfiler", quietly = TRUE)) { - message("The 'clusterProfiler' package is not installed.") - - # Prompt user for action - repeat { - user_input <- readline( - prompt = paste0( - "What would you like to do?\n", - "1: Automatically install clusterProfiler\n", - "2: Manually install clusterProfiler\n", - "3: Cancel\n", - "Please enter 1, 2, or 3: " - ) - ) - - if (user_input == "1") { - # Try to install clusterProfiler automatically from Bioconductor - message( - "Attempting to install 'clusterProfiler' automatically - from Bioconductor..." - ) - - if (!requireNamespace("BiocManager", quietly = TRUE)) { - utils::install.packages("BiocManager") - } - - tryCatch( - { - BiocManager::install("clusterProfiler", update = FALSE, ask = FALSE) - }, - error = function(e) { - stop( - "Automatic installation of 'clusterProfiler' failed. - Please install it manually and try again.", - call. = FALSE - ) - } - ) - break # Exit the loop if installation is successful - } else if (user_input == "2") { - stop( - "Please install 'clusterProfiler' manually - using BiocManager::install('clusterProfiler') and - then re-run the function.", - call. = FALSE - ) - } else if (user_input == "3") { - stop("Operation canceled by the user.", call. = FALSE) - } else { - message("Invalid input. Please enter 1, 2, or 3.") - } - } + stop( + "The 'clusterProfiler' package is not installed. ", + "Please install it manually using", + "BiocManager::install('clusterProfiler') ", + "and re-run the function." + ) } } + #' Manage GSEA Analysis for a Specific Level #' #' @description @@ -277,15 +230,13 @@ manage_gsea_level <- function( level_name, databases, clusterProfiler_params, - universe - ) { - + universe) { clustered_hits <- na.omit(clustered_hits) message(paste( "\n\n Running clusterProfiler for the level:", level_name - )) + )) result <- create_gsea_report_level( clustered_genes = clustered_hits, @@ -293,7 +244,7 @@ manage_gsea_level <- function( params = clusterProfiler_params, plot_title = level_name, universe = universe - ) + ) } @@ -318,9 +269,7 @@ manage_gsea_level <- function( #' process_result <- function( level_result, - level_name - ) { - + level_name) { result <- list() if (any(is.na(level_result))) { @@ -379,14 +328,12 @@ build_create_gsea_report <- function( plots_sizes, level_headers_info, report_info, - output_file_path - ) { - + output_file_path) { html_content <- paste( header_section, "", sep = "\n" - ) + ) toc <- create_toc() @@ -398,15 +345,13 @@ build_create_gsea_report <- function( level_headers_info <- Filter( Negate(is.null), level_headers_info - ) + ) pb <- create_progress_bar(plots) # Generate the sections and plots for (index in seq_along(plots)) { - # means jump to next level - if (any(class(plots[[index]]) == "character")) { - + if (any(is(plots[[index]], "character"))) { section_info <- level_headers_info[[current_header_index]] section_content <- generate_section_content( @@ -426,7 +371,7 @@ build_create_gsea_report <- function( pb$tick() next } - + # Add the section header and horizontal line just before the plot section_info <- level_headers_info[[current_header_index]] section_header <- sprintf( @@ -435,13 +380,13 @@ build_create_gsea_report <- function( index, section_info$header_name ) - + horizontal_line <- "" - + if (current_header_index > 1) { horizontal_line <- "
    " } - + # Update the HTML content with the section header and horizontal line html_content <- paste( html_content, @@ -449,19 +394,19 @@ build_create_gsea_report <- function( section_header, sep = "\n" ) - + toc_entry <- sprintf( "
  • %s
  • ", toc_style, index, section_info$header_name ) - + toc <- paste( toc, toc_entry, sep = "\n" - ) + ) result <- process_plots( plots_element = plots[[index]], @@ -505,38 +450,42 @@ build_create_gsea_report <- function( #' if the conditions are not met. #' check_clustered_hits <- function(levels_clustered_hits) { - if (!is.list(levels_clustered_hits)) { stop(paste("levels_clustered_hits must be a list"), call. = FALSE) } for (i in seq_along(levels_clustered_hits)) { - clustered_hits <- levels_clustered_hits[[i]] # Check if clustered_hits is a dataframe if (!is.data.frame(clustered_hits)) { - stop(paste("Element", i ,"of levels_clustered_hits is not a dataframe", - "but must be one."), call. = FALSE) + stop(paste( + "Element", i, "of levels_clustered_hits is not a dataframe", + "but must be one." + ), call. = FALSE) } # Check if the dataframe contains the columns 'gene' and 'cluster' required_columns <- c("feature", "cluster") if (!all(required_columns %in% colnames(clustered_hits))) { - stop(paste("The dataframe must contain the columns 'feature' and", - "'cluster'."), - call. = FALSE) + stop( + paste( + "The dataframe must contain the columns 'feature' and", + "'cluster'." + ), + call. = FALSE + ) } # Check if the 'feature' column contains only integers if (!is.integer(clustered_hits$feature) && - !all(clustered_hits$feature == as.integer(clustered_hits$feature))) { + !all(clustered_hits$feature == as.integer(clustered_hits$feature))) { stop("The 'feature' column must contain only integers.", call. = FALSE) } # Check if the 'cluster' column contains only integers if (!is.integer(clustered_hits$cluster) && - !all(clustered_hits$cluster == as.integer(clustered_hits$cluster))) { + !all(clustered_hits$cluster == as.integer(clustered_hits$cluster))) { stop("The 'cluster' column must contain only integers.", call. = FALSE) } } @@ -560,14 +509,16 @@ check_clustered_hits <- function(levels_clustered_hits) { #' check_genes <- function( genes, - max_index_overall = NA - ) { - + max_index_overall = NA) { if (!is.na(max_index_overall)) { if (length(genes) < max_index_overall) { - stop(paste("genes must at least have over", max_index_overall, - "elements"), - call. = FALSE) + stop( + paste( + "genes must at least have over", max_index_overall, + "elements" + ), + call. = FALSE + ) } } @@ -581,10 +532,16 @@ check_genes <- function( first_invalid_index <- which(!valid)[1] first_invalid_value <- genes[first_invalid_index] num_invalid <- sum(!valid) - 1 - stop(sprintf(paste("Invalid gene found at index %d: '%s'.", - "There are %d more invalid elements."), - first_invalid_index, first_invalid_value, num_invalid), - call. = FALSE) + stop( + sprintf( + paste( + "Invalid gene found at index %d: '%s'.", + "There are %d more invalid elements." + ), + first_invalid_index, first_invalid_value, num_invalid + ), + call. = FALSE + ) } } @@ -602,7 +559,6 @@ check_genes <- function( #' error message if the dataframe is not valid. #' check_databases <- function(databases) { - if (!is.data.frame(databases)) { stop("The input must be a dataframe.", call. = FALSE) } @@ -614,12 +570,12 @@ check_databases <- function(databases) { expected_colnames <- c("DB", "Geneset", "Gene") if (!all(colnames(databases) == expected_colnames)) { stop("The dataframe must have columns named DB, Geneset, and Gene.", - call. = FALSE) + call. = FALSE + ) } - if (!all(sapply(databases, is.character))) { - stop("All columns in the dataframe must be of type character.", - call. = FALSE) + if (!all(vapply(databases, is.character, logical(1)))) { + stop_call_false("All columns in the dataframe must be of type character.") } } @@ -640,11 +596,10 @@ check_databases <- function(databases) { #' #' @return This function does not return a value. It stops with an error message #' if the conditions are not met. -#' +#' #' @importFrom stats p.adjust #' check_params <- function(params) { - required_params <- list( pvalueCutoff = "numeric", pAdjustMethod = "character", @@ -675,9 +630,7 @@ check_params <- function(params) { # Check for required elements and their data types for (param in names(params)) { - if (param %in% names(required_params)) { - actual_value <- params[[param]] expected_type <- required_params[[param]] actual_type <- class(params[[param]]) @@ -687,18 +640,17 @@ check_params <- function(params) { } if (expected_type == "integer" && !is.integer(params[[param]])) { - # Check if the value can be coerced to integer if (is.numeric(params[[param]]) && - all(params[[param]] == as.integer(params[[param]]))) { - + all(params[[param]] == as.integer(params[[param]]))) { actual_type <- "integer" } } if (expected_type != actual_type) { - stop("The element '", param, "' must be of type ", - expected_type, ".", call. = FALSE) + expected_type, ".", + call. = FALSE + ) } } else { stop( @@ -706,18 +658,20 @@ check_params <- function(params) { param, "' in the list.", call. = FALSE - ) + ) } - if (param == 'pAdjustMethod') { + if (param == "pAdjustMethod") { if (!(actual_value %in% valid_adj_p_value_methods)) { - stop(paste("pAdjustMethod must be one of", - valid_adj_p_value_methods, collapse = ", "), - call. = FALSE) - + stop( + paste("pAdjustMethod must be one of", + valid_adj_p_value_methods, + collapse = ", " + ), + call. = FALSE + ) } } - } } @@ -751,9 +705,7 @@ create_gsea_report_level <- function( databases, params = NA, plot_title = "", - universe = NULL - ) { - + universe = NULL) { set_default_params(params) all_term2genes <- dbs_to_term2genes(databases) @@ -795,7 +747,7 @@ create_gsea_report_level <- function( gene_list <- as.list(cluster_genes) gene_list <- unlist(gene_list) - at_least_one_result = FALSE + at_least_one_result <- FALSE # Run clusterProfiler and process output for (database_name in names(all_term2genes)) { @@ -804,30 +756,30 @@ create_gsea_report_level <- function( message(paste( "\nDatabase:", database_name - )) + )) enrichment <- clusterProfiler::enricher( gene = gene_list, - pvalueCutoff = params$pvalueCutoff, + pvalueCutoff = params$pvalueCutoff, pAdjustMethod = params$pAdjustMethod, - universe = universe, - minGSSize = params$minGSSize, - maxGSSize = params$maxGSSize, - qvalueCutoff = params$qvalueCutoff, - gson = NULL, - TERM2GENE = term2gene, - TERM2NAME = NA - ) + universe = universe, + minGSSize = params$minGSSize, + maxGSSize = params$maxGSSize, + qvalueCutoff = params$qvalueCutoff, + gson = NULL, + TERM2GENE = term2gene, + TERM2NAME = NA + ) enrichment <- as.data.frame(enrichment) if (is.null(enrichment) || (nrow(enrichment) == 0 & - ncol(enrichment) == 0)) { + ncol(enrichment) == 0)) { next } - at_least_one_result = TRUE + at_least_one_result <- TRUE enrichment_results[[length(enrichment_results) + 1]] <- enrichment @@ -836,15 +788,15 @@ create_gsea_report_level <- function( "cluster: %s, database: %s", cluster, database_name - ) + ) raw_results[[name]] <- enrichment } if (is.null(universe)) { - use_background = TRUE + use_background <- TRUE } else { - use_background = FALSE + use_background <- FALSE } if (at_least_one_result) { @@ -862,7 +814,12 @@ create_gsea_report_level <- function( } # Make dotplot - any_result <- sapply(all_db_results, function(df) nrow(df) > 0) + any_result <- vapply( + all_db_results, + function(df) nrow(df) > 0, + logical(1) + ) + has_true <- any(any_result) if (has_true) { @@ -870,7 +827,7 @@ create_gsea_report_level <- function( all_db_results, names(all_term2genes), plot_title - ) + ) } else { message("No database led to an enrichment result!") return(NA) @@ -881,7 +838,7 @@ create_gsea_report_level <- function( dotplot_nrows = result[["dotplot_height"]], full_enrich_results = result[["full_enrich_results"]], raw_results = raw_results - ) + ) } @@ -905,11 +862,8 @@ generate_section_content <- function( toc, html_content, section_header_style, - toc_style -) { - + toc_style) { if (any(is.na(section_info$full_enrich_results))) { - no_results_message <- paste0( "

    ", "No database specified led to identification of any enrichment ", @@ -931,7 +885,7 @@ generate_section_content <- function( full_enrich_results_header <- paste0( "

    Enrichment Results

    " - ) + ) df <- section_info$full_enrich_results @@ -960,7 +914,7 @@ generate_section_content <- function( raw_enrich_results_header <- paste0( "

    Count smaller 2 Enrichment Results

    " - ) + ) base64_df <- sprintf( ' @@ -1004,7 +958,6 @@ generate_section_content <- function( #' input `params` or with added default values for any missing elements. #' set_default_params <- function(params) { - default_params <- list( pvalueCutoff = 0.05, pAdjustMethod = "BH", @@ -1046,12 +999,10 @@ set_default_params <- function(params) { #' contain gene names ('Gene') associated with each gene set. #' dbs_to_term2genes <- function(databases) { - db_split <- split(databases, databases$DB) # Transform into long format all_term2genes <- lapply(db_split, function(db_df) { - df_with_renamed_columns <- db_df[, c("Geneset", "Gene")] colnames(df_with_renamed_columns) <- c("term", "gene") return(df_with_renamed_columns) @@ -1084,9 +1035,7 @@ process_enrichment_results <- function( adjP_threshold, column_name, count_column_name, - background = FALSE - ) { - + background = FALSE) { column_indices <- list(2, 6, 3, 4, 9) # Process results for all databases. @@ -1100,11 +1049,21 @@ process_enrichment_results <- function( term_list <- as.list(df[[column_indices[[1]]]]) adjP_list <- as.list(df[[column_indices[[2]]]]) + odds_ratio <- as.list(df[[column_indices[[3]]]]) + odds_ratio <- vapply( + odds_ratio, + function(x) eval(parse(text = x)), + numeric(1) + ) - odds_ratio <- sapply(odds_ratio, function(x) eval(parse(text = x))) bg_ratio <- as.list(df[[column_indices[[4]]]]) - bg_ratio <- sapply(bg_ratio, function(x) eval(parse(text = x))) + bg_ratio <- vapply( + bg_ratio, + function(x) eval(parse(text = x)), + numeric(1) + ) + odds_ratio <- mapply("/", odds_ratio, bg_ratio) gene_count_list <- as.list(df[[column_indices[[5]]]]) @@ -1112,7 +1071,7 @@ process_enrichment_results <- function( named_list <- list() # Loop through the terms - for(j in seq_along(term_list)) { + for (j in seq_along(term_list)) { # Create a sublist for each term with its adjP value and gene count # Skip terms that are just supported by one gene. @@ -1128,7 +1087,6 @@ process_enrichment_results <- function( } for (name in names(named_list)) { - if (!name %in% all_db_results[[i]]$BioProcess) { # Create a list with the same structure as your DataFrame row_index <- nrow(all_db_results[[i]]) + 1 @@ -1136,7 +1094,6 @@ process_enrichment_results <- function( all_db_results[[i]][row_index, column_name] <- named_list[[name]][[1]] all_db_results[[i]][row_index, count_column_name] <- named_list[[name]][[2]] - } else { row_index <- which(all_db_results[[i]]$BioProcess == name) all_db_results[[i]][row_index, column_name] <- named_list[[name]][[1]] @@ -1264,9 +1221,7 @@ process_enrichment_results <- function( make_enrich_dotplot <- function( enrichments_list, databases, - title = "Title" -) { - + title = "Title") { results <- prepare_plot_data( enrichments_list, databases @@ -1280,7 +1235,7 @@ make_enrich_dotplot <- function( num_labels <- length(unique(top_plot_data$term)) plot_height <- num_labels * height_per_label - if (plot_height < 0.70) { # to always have a minimum size. + if (plot_height < 0.70) { # to always have a minimum size. plot_height <- 0.70 } @@ -1389,9 +1344,7 @@ make_enrich_dotplot <- function( #' prepare_plot_data <- function( enrichments_list, - databases - ) { - + databases) { plot_data <- enrichments_list |> purrr::set_names(databases) |> @@ -1413,7 +1366,7 @@ prepare_plot_data <- function( dplyr::arrange( dplyr::desc(.data$avg_odds_ratio), .data$db, .data$BioProcess - ) + ) # Initialize the cluster counts cluster_counts <- @@ -1463,7 +1416,7 @@ prepare_plot_data <- function( # threshold. This step might seem redundant given the current logic but # could be adjusted for more complex conditions if (any(temp_cluster_counts <= min_threshold | - temp_cluster_counts > min_threshold)) { + temp_cluster_counts > min_threshold)) { # Commit the update if the combination is still eligible cluster_counts <- temp_cluster_counts selected_combos[[length(selected_combos) + 1]] <- combo @@ -1474,18 +1427,18 @@ prepare_plot_data <- function( # Stop if all combos have been evaluated or the sum of cluster_counts # exceeds 5 times the number of clusters if (i == nrow(plot_data) || sum(cluster_counts) > 5 * - length(cluster_counts)) { + length(cluster_counts)) { break } - i <- i + length(cluster_counts) # Jump to next combo + i <- i + length(cluster_counts) # Jump to next combo } # Combine selected combos into a dataframe top_combos <- do.call( rbind, selected_combos - ) + ) # Filter the original data to keep only rows matching the top 5 combinations top_plot_data <- plot_data |> @@ -1494,8 +1447,8 @@ prepare_plot_data <- function( by = c( "db", "BioProcess" - ) ) + ) full_enrich_results <- stats::na.omit(plot_data) @@ -1505,15 +1458,15 @@ prepare_plot_data <- function( .data$BioProcess, col = "term", sep = ": " - ) + ) top_plot_data$term <- factor( top_plot_data$term, levels = rev(unique(top_plot_data$term)) - ) + ) list( top_plot_data = top_plot_data, full_enrich_results = full_enrich_results - ) -} \ No newline at end of file + ) +} diff --git a/R/run_limma_splines.R b/R/run_limma_splines.R index 77ccb40..2198b27 100755 --- a/R/run_limma_splines.R +++ b/R/run_limma_splines.R @@ -1,34 +1,34 @@ # Exported function: run_limma_splines() --------------------------------------- - + #' Run limma analysis with splines -#' +#' #' @description #' This function performs a limma spline analysis to identify significant -#' time-dependent changes in features (e.g., proteins) within an omics -#' time-series dataset. It evaluates features within each condition level -#' and between levels by comparing average differences and interactions +#' time-dependent changes in features (e.g., proteins) within an omics +#' time-series dataset. It evaluates features within each condition level +#' and between levels by comparing average differences and interactions #' between time and condition. #' -#' @param splineomics An S3 object of class `SplineOmics` that contains the +#' @param splineomics An S3 object of class `SplineOmics` that contains the #' following elements: #' \itemize{ #' \item \code{data}: The matrix of the omics dataset, with the feature #' names optionally as row headers. -#' \item \code{rna_seq_data}: An object containing the preprocessed -#' RNA-seq data, +#' \item \code{rna_seq_data}: An object containing the preprocessed +#' RNA-seq data, #' such as the output from `limma::voom` or a similar preprocessing pipeline. -#' \item \code{meta}: A dataframe containing metadata corresponding to the -#' \code{data}, must include a 'Time' column and the column specified by +#' \item \code{meta}: A dataframe containing metadata corresponding to the +#' \code{data}, must include a 'Time' column and the column specified by #' \code{condition}. -#' \item \code{design}: A character string representing the limma design +#' \item \code{design}: A character string representing the limma design #' formula. -#' \item \code{condition}: A character string specifying the column name +#' \item \code{condition}: A character string specifying the column name #' in \code{meta} used to define groups for analysis. -#' \item \code{spline_params}: A list of spline parameters used in the +#' \item \code{spline_params}: A list of spline parameters used in the #' analysis, including: #' \itemize{ -#' \item \code{spline_type}: The type of spline (e.g., "n" for natural +#' \item \code{spline_type}: The type of spline (e.g., "n" for natural #' splines or "b" for B-splines). #' \item \code{dof}: Degrees of freedom for the spline. #' \item \code{knots}: Positions of the internal knots (for B-splines). @@ -37,137 +37,138 @@ #' } #' } #' -#' @return The SplineOmics object, updated with a list with three elements: +#' @return The SplineOmics object, updated with a list with three elements: #' - `time_effect`: A list of top tables for each level with the time #' effect. #' - `avrg_diff_conditions`: A list of top tables for each comparison -#' between the levels. The comparison is the +#' between the levels. The comparison is the #' average difference of the values. -#' - `interaction_condition_time`: A list of top tables for each -#' comparison between levels. The +#' - `interaction_condition_time`: A list of top tables for each +#' comparison between levels. The #' comparison is the interaction between #' the condition and the time. -#' +#' #' @importFrom purrr partial map map_chr map2 #' @importFrom stats setNames #' @importFrom utils combn -#' +#' #' @export -#' +#' run_limma_splines <- function( - splineomics - ) { - + splineomics) { check_splineomics_elements( splineomics = splineomics, func_type = "run_limma_splines" ) - + args <- lapply( as.list(match.call()[-1]), eval, parent.frame() - ) - + ) + check_null_elements(args) input_control <- InputControl$new(args) input_control$auto_validate() - + data <- splineomics[["data"]] rna_seq_data <- splineomics[["rna_seq_data"]] meta <- splineomics[["meta"]] spline_params <- splineomics[["spline_params"]] padjust_method <- splineomics[["padjust_method"]] design <- splineomics[["design"]] + dream_params <- splineomics[["dream_params"]] mode <- splineomics[["mode"]] condition <- splineomics[["condition"]] - + feature_names <- rownames(data) - - rownames(data) <- NULL # To just have numbers describing the rows + + rownames(data) <- NULL # To just have numbers describing the rows meta[[condition]] <- factor(meta[[condition]]) levels <- levels(meta[[condition]]) - # Get hits for level (within level analysis) + # Get hits for level (within level analysis) process_level_with_params <- purrr::partial( - within_level, + within_level, spline_params = spline_params, - data = data, + data = data, rna_seq_data = rna_seq_data, - meta = meta, - design = design, - condition = condition, - feature_names = feature_names, - padjust_method = padjust_method, + meta = meta, + design = design, + dream_params = dream_params, + condition = condition, + feature_names = feature_names, + padjust_method = padjust_method, mode = mode - ) - + ) + results_list <- purrr::imap( levels, process_level_with_params - ) - - within_level_top_table <- + ) + + within_level_top_table <- stats::setNames( - purrr::map(results_list, "top_table"), + purrr::map(results_list, "top_table"), purrr::map_chr(results_list, "name") - ) + ) + + # Factor and Factor:Time comparisons between levels + between_level_condition_only <- list() + between_level_condition_time <- list() # Factor AND time - # Factor and Factor:Time comparisons between levels - between_level_condition_only <- list() - between_level_condition_time <- list() # Factor AND time - if (mode == "integrated") { level_combinations <- utils::combn(levels, 2, simplify = FALSE) for (lev_combo in level_combinations) { result <- between_level( - data = data, + data = data, rna_seq_data = rna_seq_data, - meta = meta, - design = design, + meta = meta, + design = design, + dream_params = dream_params, spline_params = spline_params, - condition = condition, - compared_levels = lev_combo, - padjust_method = padjust_method, + condition = condition, + compared_levels = lev_combo, + padjust_method = padjust_method, feature_names = feature_names - ) - + ) + between_level_condition_only[[ paste0( - "avrg_diff_" ,lev_combo[1], + "avrg_diff_", lev_combo[1], "_vs_", lev_combo[2] - ) - ]] <- result$condition_only - + ) + ]] <- result$condition_only + between_level_condition_time[[ paste0( - "time_interaction_" , + "time_interaction_", lev_combo[1], "_vs_", lev_combo[2] - ) - ]] <- result$condition_time + ) + ]] <- result$condition_time } } else { # mode == "isolated" message(paste( "mode == 'integrated' necessary for between level", - "comparisons. Returning emtpy lists the limma result categories 2 and 3 + "comparisons. Returning emtpy lists the limma result categories 2 and 3 (avrg diff conditions, and interaction condition time)." - )) + )) } - + message("\033[32mInfo\033[0m limma spline analysis completed successfully") - + limma_splines_result <- list( - time_effect = within_level_top_table, - avrg_diff_conditions = between_level_condition_only, - interaction_condition_time = between_level_condition_time - ) + time_effect = within_level_top_table, + avrg_diff_conditions = between_level_condition_only, + interaction_condition_time = between_level_condition_time + ) splineomics <- update_splineomics( splineomics = splineomics, limma_splines_result = limma_splines_result - ) + ) } @@ -178,173 +179,223 @@ run_limma_splines <- function( #' Between Level Analysis #' #' @description -#' Performs a between-level analysis using LIMMA to compare specified levels +#' Performs a between-level analysis using LIMMA to compare specified levels #' within a condition. #' #' @param data A matrix of data values. -#' @param rna_seq_data An object containing the preprocessed RNA-seq data, +#' @param rna_seq_data An object containing the preprocessed RNA-seq data, #' such as the output from `limma::voom` or a similar preprocessing pipeline. #' @param meta A dataframe containing metadata, including a 'Time' column. #' @param design A design formula or matrix for the LIMMA analysis. +#' @param dream_params A named list or NULL. When not NULL, it must at least +#' contain the named element 'random_effects', which must contain a string that +#' is a formula for the random effects of the mixed models by dream. +#' Additionally, it can contain the named elements dof, which must be a int +#' bigger than 1, which is the degree of freedom for the dream topTable, and +#' the named element KenwardRoger, which must be a bool, specifying whether +#' to use that method or not. #' @param spline_params A list of spline parameters for the analysis. #' @param condition A character string specifying the condition. #' @param compared_levels A vector of levels within the condition to compare. #' @param padjust_method A character string specifying the p-adjustment method. #' @param feature_names A non-empty character vector of feature names. #' -#' @return A list containing top tables for the factor only and factor-time +#' @return A list containing top tables for the factor only and factor-time #' contrast. #' #' @seealso -#' \code{\link[splines]{bs}}, \code{\link[splines]{ns}}, -#' \code{\link[limma]{lmFit}}, \code{\link[limma]{eBayes}}, +#' \code{\link[splines]{bs}}, \code{\link[splines]{ns}}, +#' \code{\link[limma]{lmFit}}, \code{\link[limma]{eBayes}}, #' \code{\link[limma]{topTable}}, \code{\link{modify_limma_top_table}} -#' -#' @importFrom splines bs -#' @importFrom splines ns -#' @importFrom stats as.formula -#' @importFrom stats model.matrix -#' @importFrom limma lmFit -#' @importFrom limma eBayes -#' @importFrom limma topTable -#' +#' +#' @importFrom splines bs ns +#' @importFrom stats as.formula model.matrix +#' @importFrom limma lmFit eBayes topTable +#' @importFrom variancePartition dream eBayes topTable +#' between_level <- function( - data, + data, rna_seq_data, - meta, - design, - spline_params, - condition, + meta, + design, + dream_params, + spline_params, + condition, compared_levels, - padjust_method, + padjust_method, feature_names ) { samples <- which(meta[[condition]] %in% compared_levels) data <- data[, samples] - # meta <- subset(meta, meta[[condition]] %in% compared_levels) meta <- meta[meta[[condition]] %in% compared_levels, ] - - design_matrix <- design2design_matrix( + + result <- design2design_matrix( meta = meta, spline_params = spline_params, level_index = 1, design = design - ) + ) + + design_matrix <- result$design_matrix if (!is.null(rna_seq_data)) { data <- rna_seq_data } - fit <- limma::lmFit( - data, - design_matrix - ) - fit <- limma::eBayes(fit) - - factor_only_contrast_coeff <- paste0( + condition_only_contrast_coeff <- paste0( condition, compared_levels[2] - ) - - condition_only <- limma::topTable( - fit, - coef = factor_only_contrast_coeff, - adjust.method = padjust_method, - number = Inf - ) - - condition_only_resuls <- list( - top_table = condition_only, - fit = fit - ) - - top_table_condition_only <- process_top_table( - condition_only_resuls, - feature_names - ) - + ) num_matching_columns <- sum( grepl( "^X\\d+$", colnames(design_matrix) - ) ) + ) - factor_time_contrast_coeffs <- paste0( + interaction_condition_time_contrast_coeffs <- paste0( condition, compared_levels[2], - ":X", + ":X", seq_len(num_matching_columns) - ) + ) - condition_time <- limma::topTable( - fit, - coef = factor_time_contrast_coeffs, - adjust.method = padjust_method, - number = Inf + if (!is.null(dream_params)) { + colnames(data) <- rownames(meta) # dream requires this format + meta <- result$meta # Only do it after, new meta has more columns + + # Apply the Kenward-Roger method if specified + if (isTRUE(dream_params[["KenwardRoger"]])) { + method <- "Kenward-Roger" + } else { + method <- NULL + } + + fit <- variancePartition::dream( + exprObj = data, + formula = stats::as.formula(design), + data = meta, + random.formula = stats::as.formula(dream_params[["random_effects"]]), + ddf = method + ) + + fit <- variancePartition::eBayes(fit) + + condition_only <- variancePartition::topTable( + fit, + coef = condition_only_contrast_coeff, + adjust.method = padjust_method, + number = Inf + ) + + condition_time <- variancePartition::topTable( + fit, + coef = interaction_condition_time_contrast_coeffs, + adjust.method = padjust_method, + number = Inf, + sort.by = "F" + ) + + } else { + fit <- limma::lmFit( + data, + design_matrix + ) + + fit <- limma::eBayes(fit) + + condition_only <- limma::topTable( + fit, + coef = condition_only_contrast_coeff, + adjust.method = padjust_method, + number = Inf ) + condition_time <- limma::topTable( + fit, + coef = interaction_condition_time_contrast_coeffs, + adjust.method = padjust_method, + number = Inf + ) + } + + condition_only_resuls <- list( + top_table = condition_only, + fit = fit + ) + + top_table_condition_only <- process_top_table( + condition_only_resuls, + feature_names + ) + condition_and_time_results <- list( top_table = condition_time, fit = fit - ) + ) top_table_condition_and_time <- process_top_table( - condition_and_time_results, + condition_and_time_results, feature_names - ) - + ) + list( condition_only = top_table_condition_only, condition_time = top_table_condition_and_time - ) + ) } #' Within level analysis #' #' @description -#' Processes a single level within a condition, performing limma analysis +#' Processes a single level within a condition, performing limma analysis #' and generating the top table of results. #' #' @param level The level within the condition to process. #' @param level_index The index of the level within the condition. -#' @param spline_params A list of spline parameters for the analysis. +#' @param spline_params A list of spline parameters for the analysis. #' @param data A matrix of data values. -#' @param rna_seq_data An object containing the preprocessed RNA-seq data, +#' @param rna_seq_data An object containing the preprocessed RNA-seq data, #' such as the output from `limma::voom` or a similar preprocessing pipeline. #' @param meta A dataframe containing the metadata for data. #' @param design A design formula or matrix for the limma analysis. +#' @param dream_params A named list or NULL. When not NULL, it must at least +#' contain the named element 'random_effects', which must contain a string that +#' is a formula for the random effects of the mixed models by dream. +#' Additionally, it can contain the named elements dof, which must be a int +#' bigger than 1, which is the degree of freedom for the dream topTable, and +#' the named element KenwardRoger, which must be a bool, specifying whether +#' to use that method or not. #' @param condition A character string specifying the condition. #' @param feature_names A non-empty character vector of feature names. #' @param padjust_method A character string specifying the p-adjustment method. -#' @param mode A character string specifying the mode +#' @param mode A character string specifying the mode #' ('isolated' or 'integrated'). #' -#' @return A list containing the name of the results and the top table of +#' @return A list containing the name of the results and the top table of #' results. #' #' @seealso #' \code{\link{within_level}}, \code{\link{process_top_table}} -#' +#' #' @importFrom stats relevel -#' +#' within_level <- function( - level, + level, level_index, spline_params, - data, + data, rna_seq_data, - meta, - design, - condition, - feature_names, - padjust_method, - mode - ) { - + meta, + design, + dream_params, + condition, + feature_names, + padjust_method, + mode) { if (mode == "isolated") { samples <- which(meta[[condition]] == level) data_copy <- data[, samples] @@ -353,38 +404,39 @@ within_level <- function( data_copy <- data meta_copy <- meta meta_copy[[condition]] <- stats::relevel( - meta_copy[[condition]], + meta_copy[[condition]], ref = level - ) + ) # spline_params must be uniform across all levels for integrated mode. - level_index <- 1L + level_index <- 1L } - + result <- process_within_level( - data = data_copy, + data = data_copy, rna_seq_data = rna_seq_data, - meta = meta_copy, - design = design, + meta = meta_copy, + design = design, + dream_params = dream_params, spline_params = spline_params, - level_index = level_index, + level_index = level_index, padjust_method = padjust_method - ) + ) top_table <- process_top_table( - result, + result, feature_names - ) - + ) + results_name <- paste( condition, level, sep = "_" - ) + ) list( name = results_name, top_table = top_table - ) + ) } @@ -394,11 +446,11 @@ within_level <- function( #' Process Top Table #' #' @description -#' Processes the top table from a LIMMA analysis, adding feature names and +#' Processes the top table from a LIMMA analysis, adding feature names and #' intercepts. #' -#' @param process_within_level_result List of lists containing the limma -#' topTable, and fit. All of this is from +#' @param process_within_level_result List of lists containing the limma +#' topTable, and fit. All of this is from #' one specific level. #' @param feature_names A non-empty character vector of feature names. #' @@ -406,21 +458,19 @@ within_level <- function( #' #' @seealso #' \link{modify_limma_top_table}, \link[limma]{lmFit} -#' +#' #' @importFrom stats coef -#' +#' process_top_table <- function( - process_within_level_result, - feature_names - ) { - + process_within_level_result, + feature_names) { top_table <- process_within_level_result$top_table fit <- process_within_level_result$fit top_table <- modify_limma_top_table( top_table, feature_names - ) + ) intercepts <- as.data.frame(stats::coef(fit)[, "(Intercept)", drop = FALSE]) intercepts_ordered <- intercepts[top_table$feature_nr, , drop = FALSE] @@ -433,76 +483,152 @@ process_top_table <- function( #' Process Within Level #' #' @description -#' Performs a within-level analysis using limma to generate top tables and fit -#' objects based on the specified spline parameters. Performs the limma spline +#' Performs a within-level analysis using limma to generate top tables and fit +#' objects based on the specified spline parameters. Performs the limma spline #' analysis for a selected level of a factor #' #' @param data A matrix of data values. -#' @param rna_seq_data An object containing the preprocessed RNA-seq data, +#' @param rna_seq_data An object containing the preprocessed RNA-seq data, #' such as the output from `limma::voom` or a similar preprocessing pipeline. #' @param meta A dataframe containing metadata, including a 'Time' column. #' @param design A design formula or matrix for the limma analysis. +#' @param dream_params A named list or NULL. When not NULL, it must at least +#' contain the named element 'random_effects', which must contain a string that +#' is a formula for the random effects of the mixed models by dream. +#' Additionally, it can contain the named elements dof, which must be a int +#' bigger than 1, which is the degree of freedom for the dream topTable, and +#' the named element KenwardRoger, which must be a bool, specifying whether +#' to use that method or not. #' @param spline_params A list of spline parameters for the analysis. #' @param level_index The index of the level within the factor. #' @param padjust_method A character string specifying the p-adjustment method. #' -#' @return A list containing the top table and the fit object from the limma +#' @return A list containing the top table and the fit object from the limma #' analysis. #' #' @seealso -#' \link[splines]{bs}, \link[splines]{ns}, \link[limma]{lmFit}, +#' \link[splines]{bs}, \link[splines]{ns}, \link[limma]{lmFit}, #' \link[limma]{eBayes}, \link[limma]{topTable} -#' +#' #' @importFrom splines bs ns #' @importFrom stats as.formula model.matrix #' @importFrom limma lmFit eBayes topTable -#' +#' @importFrom variancePartition dream eBayes topTable +#' process_within_level <- function( data, rna_seq_data, meta, design, + dream_params, spline_params, level_index, padjust_method ) { - - design_matrix <- design2design_matrix( + + result <- design2design_matrix( meta, spline_params, level_index, design - ) + ) + + design_matrix <- result$design_matrix if (!is.null(rna_seq_data)) { data <- rna_seq_data } - fit <- limma::lmFit( - data, - design_matrix + if (!is.null(dream_params)) { + colnames(data) <- rownames(meta) # dream wants it like this. + meta <- result$meta # Only do it after, new meta has more columns + + if (isTRUE(dream_params[["KenwardRoger"]])) { + method <- "Kenward-Roger" + } else { + method = NULL + } + + fit <- variancePartition::dream( + exprObj = data, + formula = stats::as.formula(design), + data = meta, + random.formula = stats::as.formula(dream_params[["random_effects"]]), + ddf = method ) - fit <- limma::eBayes(fit) + + fit <- variancePartition::eBayes(fit) + + num_matching_columns <- sum(grepl("^X\\d+$", colnames(design_matrix))) + coeffs <- paste0("X", seq_len(num_matching_columns)) + + if (!is.null(dream_params[["dof"]])) { + dof <- dream_params[["dof"]] + } else { + dof = Inf + } - num_matching_columns <- sum(grepl( - "^X\\d+$", - colnames(design_matrix) - )) - coeffs <- paste0("X", seq_len(num_matching_columns)) - - top_table <- limma::topTable( - fit, - adjust.method = padjust_method, - number = Inf, - coef = coeffs + top_table <- variancePartition::topTable( + fit, + adjust.method = padjust_method, + number = dof, + coef = coeffs, + sort.by = "F" + ) + } else { + fit <- limma::lmFit( + data, + design_matrix + ) + fit <- limma::eBayes(fit) + + # Extract the top table based on coefficients + num_matching_columns <- sum(grepl("^X\\d+$", colnames(design_matrix))) + coeffs <- paste0("X", seq_len(num_matching_columns)) + + top_table <- limma::topTable( + fit, + adjust.method = padjust_method, + number = Inf, + coef = coeffs ) + } attr(top_table, "adjust.method") <- padjust_method list( top_table = top_table, fit = fit - ) + ) +} + + +#' Remove intercept from a formula +#' +#' @description +#' This function modifies a given formula by replacing the first occurrence +#' of a standalone intercept (`1`) with `0`. It works even if the `1` is +#' preceded by a tilde (`~`), ensuring that the intercept is removed while +#' leaving other parts of the formula intact. +#' +#' @param formula A formula object. The formula can include an intercept (`1`) +#' and other terms. If a `1` is found, it is replaced with `0`. +#' +#' @return A modified formula with the intercept removed. The first standalone +#' occurrence of `1` will be replaced by `0`. +#' +remove_intercept <- function(formula) { + # Deparse the formula into a single string + formula_str <- paste(deparse(formula), collapse = " ") + + # Regular expression to match the first standalone 1 + # (with optional spaces around it) + pattern <- "(~\\s*|\\s+)(1)(\\s|$)" + + # Replace the first occurrence of "1" with "0" + formula_str <- sub(pattern, "\\10\\3", formula_str) + + new_formula <- as.formula(formula_str) } @@ -518,47 +644,51 @@ process_within_level <- function( #' @param feature_names A character vector of feature names. #' #' @return A tibble with feature indices and names included. -#' +#' #' @importFrom tibble as_tibble #' @importFrom dplyr relocate last_col mutate #' @importFrom rlang .data -#' +#' modify_limma_top_table <- function( - top_table, - feature_names - ) { - + top_table, + feature_names) { is_integer_string <- function(x) { - return(grepl("^[0-9]+$", x)) + return(grepl("^[0-9]+$", x)) } - - # Because the row headers of a potential rna_seq_data object were not + + # Because the row headers of a potential rna_seq_data object were not # converted to ints (written as strings) beforehand. This is run only when # the row headers are still "real" strings. - if (!all(sapply(rownames(top_table), is_integer_string))) { - rownames(top_table) <- sapply( - rownames(top_table), + if (!all(vapply( + rownames(top_table), + is_integer_string, + logical(1) + )) + ) { + rownames(top_table) <- vapply( + rownames(top_table), function(id) { # Find the index of the current row name in feature_names index <- which(feature_names == id) # Return the index as a string return(as.character(index)) - } + }, + character(1) ) } - + top_table <- tibble::as_tibble( - top_table, + top_table, rownames = "feature_nr" - ) - + ) + # feature_nr <- NULL # dummy declaration for the lintr and R CMD. # Convert feature_nr to integer - top_table <- top_table |> + top_table <- top_table |> dplyr::mutate(feature_nr = as.integer(.data$feature_nr)) |> dplyr::relocate(.data$feature_nr, .after = dplyr::last_col()) - + # Sort and add feature names based on the feature_nr sorted_feature_names <- feature_names[top_table$feature_nr] top_table <- top_table |> dplyr::mutate(feature_names = sorted_feature_names) diff --git a/R/screen_limma_hyperparams.R b/R/screen_limma_hyperparams.R index 7af2914..28a8a9b 100755 --- a/R/screen_limma_hyperparams.R +++ b/R/screen_limma_hyperparams.R @@ -3,82 +3,80 @@ #' Limma Hyperparameters Screening #' -#' This function screens through various combinations of hyperparameters for +#' This function screens through various combinations of hyperparameters for #' limma analysis, -#' including designs, modes, and degrees of freedom. It validates inputs, +#' including designs, modes, and degrees of freedom. It validates inputs, #' generates results for all -#' combinations, and plots the outcomes. Finally, it may also be involved in +#' combinations, and plots the outcomes. Finally, it may also be involved in #' generating an HTML report #' as part of a larger analysis workflow. #' -#' @param splineomics An S3 object of class `SplineOmics` that contains all the +#' @param splineomics An S3 object of class `SplineOmics` that contains all the #' necessary data and parameters for the analysis, including: #' \itemize{ #' \item \code{condition}: A string specifying the column name of the meta #' dataframe, that contains the levels that separate #' the experiment ('treatment' can be a condition, and -#' 'drug' and 'no drug' can be the levels of such a +#' 'drug' and 'no drug' can be the levels of such a #' condition). -#' \item \code{report_info}: -#' \item \code{meta_batch_column}: A character string specifying the meta +#' \item \code{report_info}: +#' \item \code{meta_batch_column}: A character string specifying the meta #' batch column. -#' \item \code{meta_batch2_column}: A character string specifying the second -#' meta batch column (the limma function -#' removeBatchEffect supports a maximum of +#' \item \code{meta_batch2_column}: A character string specifying the second +#' meta batch column (the limma function +#' removeBatchEffect supports a maximum of #' two batch columns.) #' } #' @param datas A list of matrices containing the datasets to be analyzed. #' @param datas_descr A description object for the data. -#' @param metas A list of data frames containing metadata for each dataset in +#' @param metas A list of data frames containing metadata for each dataset in #' `datas`. #' @param designs A character vector of design formulas for the limma analysis. #' @param modes A character vector that must have the same length as 'designs'. #' For each design formula, you must specify either 'isolated' or 'integrated'. -#' Isolated means limma determines the results for each level using only the +#' Isolated means limma determines the results for each level using only the #' data from that level. Integrated means limma determines the results for all #' levels using the full dataset (from all levels). #' @param spline_test_configs A configuration object for spline tests. #' @param report_dir A non-empty string specifying the report directory. -#' @param adj_pthresholds A numeric vector of p-value thresholds for +#' @param adj_pthresholds A numeric vector of p-value thresholds for #' significance determination. #' @param rna_seq_datas A list of RNA-seq data objects, such as the voom object #' derived from the limma::voom function. #' @param time_unit A character string specifying the time unit label for plots. -#' @param padjust_method A character string specifying the method for p-value +#' @param padjust_method A character string specifying the method for p-value #' adjustment. #' #' @return Returns a list of plots generated from the limma analysis results. -#' Each element in the list corresponds to a different combination of +#' Each element in the list corresponds to a different combination of #' hyperparameters. -#' +#' #' @importFrom here here #' #' @export #' screen_limma_hyperparams <- function( - splineomics, # SplineOmics object - datas, + splineomics, # SplineOmics object + datas, datas_descr, - metas, - designs, + metas, + designs, modes, spline_test_configs, report_dir = here::here(), adj_pthresholds = c(0.05), rna_seq_datas = NULL, - time_unit = "min", # For the plot labels - padjust_method = "BH" - ) { - - if (is.null(rna_seq_datas)) { # Set the default value. - rna_seq_datas <- vector("list", length(datas)) + time_unit = "min", # For the plot labels + padjust_method = "BH") { + if (is.null(rna_seq_datas)) { # Set the default value. + rna_seq_datas <- vector("list", length(datas)) } report_dir <- normalizePath( report_dir, mustWork = FALSE ) - + check_splineomics_elements( splineomics = splineomics, func_type = "screen_limma_hyperparams" @@ -88,7 +86,7 @@ screen_limma_hyperparams <- function( check_null_elements(args) input_control <- InputControl$new(args) input_control$auto_validate() - + report_info <- splineomics[["report_info"]] meta_batch_column <- splineomics[["meta_batch_column"]] meta_batch2_column <- splineomics[["meta_batch2_column"]] @@ -96,59 +94,59 @@ screen_limma_hyperparams <- function( feature_names <- rownames(datas[[1]]) - top_tables_combos <- + top_tables_combos <- get_limma_combos_results( - datas = datas, + datas = datas, rna_seq_datas = rna_seq_datas, - metas = metas, - designs = designs, - modes = modes, - condition = condition, + metas = metas, + designs = designs, + modes = modes, + condition = condition, spline_test_configs = spline_test_configs, - feature_names = feature_names, - adj_pthresholds = adj_pthresholds, + feature_names = feature_names, + adj_pthresholds = adj_pthresholds, padjust_method = padjust_method - ) + ) - combo_pair_plots <- + combo_pair_plots <- plot_limma_combos_results( - top_tables_combos = top_tables_combos, - datas = datas, + top_tables_combos = top_tables_combos, + datas = datas, metas = metas, condition = condition, spline_test_configs = spline_test_configs, meta_batch_column = meta_batch_column, meta_batch2_column = meta_batch2_column, time_unit = time_unit - ) + ) timestamp <- format(Sys.time(), "%d_%m_%Y-%H_%M_%S") - + report_info$meta_condition <- c(condition) report_info$meta_batch <- paste( - meta_batch_column, + meta_batch_column, meta_batch2_column, sep = ", " - ) - + ) + generate_reports( - combo_pair_plots = combo_pair_plots, + combo_pair_plots = combo_pair_plots, report_info = report_info, report_dir = report_dir, timestamp = timestamp - ) - + ) + # Generates a HTML which shows the overview of the hyperparameters, which # are explored in the HTML reports generated with the function above. generate_reports_meta( - datas_descr = datas_descr, - designs = designs, - modes = modes, + datas_descr = datas_descr, + designs = designs, + modes = modes, spline_test_configs = spline_test_configs, report_dir = report_dir, timestamp = timestamp - ) - + ) + print_info_message( message_prefix = "limma hyperparameter screening", report_dir = report_dir @@ -162,7 +160,7 @@ screen_limma_hyperparams <- function( #' Generate LIMMA Combination Results #' #' @description -#' Computes results for various combinations of data, design matrices, and +#' Computes results for various combinations of data, design matrices, and #' spline configurations using the LIMMA method. #' #' @param datas A list of matrices. @@ -175,57 +173,55 @@ screen_limma_hyperparams <- function( #' @param spline_test_configs A configuration object for spline tests. #' @param feature_names A character vector of feature names. #' @param adj_pthresholds A numeric vector with elements > 0 and < 1. -#' @param padjust_method A single character string specifying the p-adjustment +#' @param padjust_method A single character string specifying the p-adjustment #' method. #' -#' @return A list of results for each combination of data, design, and spline +#' @return A list of results for each combination of data, design, and spline #' configuration. -#' +#' #' @importFrom tidyr expand_grid #' @importFrom dplyr mutate #' @importFrom purrr pmap #' @importFrom purrr set_names #' @importFrom rlang sym -#' +#' get_limma_combos_results <- function( - datas, + datas, rna_seq_datas, - metas, - designs, - modes, - condition, + metas, + designs, + modes, + condition, spline_test_configs, - feature_names, - adj_pthresholds, - padjust_method - ) { - + feature_names, + adj_pthresholds, + padjust_method) { combos <- tidyr::expand_grid( data_index = seq_along(datas), design_index = seq_along(designs), spline_config_index = seq_along(spline_test_configs$spline_type), pthreshold = adj_pthresholds - ) |> + ) |> dplyr::mutate(id = paste0( - "Data_", !!rlang::sym("data_index"), - "_Design_", !!rlang::sym("design_index"), - "_SConfig_", !!rlang::sym("spline_config_index"), + "Data_", !!rlang::sym("data_index"), + "_Design_", !!rlang::sym("design_index"), + "_SConfig_", !!rlang::sym("spline_config_index"), "_PThresh_", !!rlang::sym("pthreshold") - )) - - purrr::pmap( - combos, - process_combo, - datas = datas, - rna_seq_datas = rna_seq_datas, - metas = metas, - designs = designs, - modes = modes, - condition = condition, - spline_test_configs = spline_test_configs, - feature_names = feature_names, - padjust_method = padjust_method - ) |> + )) + + purrr::pmap( + combos, + process_combo, + datas = datas, + rna_seq_datas = rna_seq_datas, + metas = metas, + designs = designs, + modes = modes, + condition = condition, + spline_test_configs = spline_test_configs, + feature_names = feature_names, + padjust_method = padjust_method + ) |> purrr::set_names(combos$id) } @@ -233,7 +229,7 @@ get_limma_combos_results <- function( #' Plot limma Combination Results #' #' @description -#' Generates plots for pairwise comparisons of hyperparameter combinations +#' Generates plots for pairwise comparisons of hyperparameter combinations #' using limma results. #' #' @param top_tables_combos A list of top tables for each combination. @@ -246,16 +242,16 @@ get_limma_combos_results <- function( #' column. #' @param time_unit A single character, such as s, m, h, or d, specifying the #' time_unit that should be used for the plots (s = seconds, m = minutes, -#' h = hours, d = days). This single character will be converted to a string +#' h = hours, d = days). This single character will be converted to a string #' that is a little bit more verbose, such as sec in square brackets for s. #' -#' @return A list of results including hit comparison plots and composite +#' @return A list of results including hit comparison plots and composite #' spline plots for each pair of combinations. -#' +#' #' @importFrom progress progress_bar #' @importFrom purrr set_names #' @importFrom purrr map -#' +#' plot_limma_combos_results <- function( top_tables_combos, datas, @@ -264,56 +260,53 @@ plot_limma_combos_results <- function( spline_test_configs, meta_batch_column, meta_batch2_column, - time_unit = time_unit - ) { - + time_unit = time_unit) { names_extracted <- regmatches( names(top_tables_combos), - regexpr("Data_\\d+_Design_\\d+", - names(top_tables_combos) - ) + regexpr( + "Data_\\d+_Design_\\d+", + names(top_tables_combos) ) - + ) + combos_separated <- lapply(unique(names_extracted), function(id) { top_tables_combos[names_extracted == id] }) - + names(combos_separated) <- unique(names_extracted) - + combos <- names(combos_separated) combo_pairs <- combn(combos, 2, simplify = FALSE) - print("Generating the plots for all pairwise hyperparams-combo comparisons") + message("Generating the plots for all pairwise hyperparams-combo comparisons") progress_ticks <- length(combo_pairs) pb <- progress::progress_bar$new( - total = progress_ticks, + total = progress_ticks, format = "[:bar] :percent" - ) - + ) + pb$tick(0) - + time_unit_label <- paste0("[", time_unit, "]") - + if (!is.null(meta_batch_column)) { - # Takes the shortcut approach without the specific design_matrix datas <- remove_batch_effect( - datas = datas, + datas = datas, metas = metas, condition = condition, meta_batch_column = meta_batch_column, meta_batch2_column = meta_batch2_column - ) + ) } - - + + combo_pair_results <- purrr::set_names( purrr::map(combo_pairs, function(pair) { - combo_pair <- combos_separated[pair] hitcomp <- gen_hitcomp_plots(combo_pair) - + composites <- purrr::map(combo_pair, function(combo) { composite <- gen_composite_spline_plots( combo, @@ -321,23 +314,24 @@ plot_limma_combos_results <- function( metas, spline_test_configs, time_unit_label - ) + ) }) pb$tick() list( hitcomp = hitcomp, composites = composites - ) - } - ), purrr::map( - combo_pairs, - function(pair) paste( + ) + }), purrr::map( + combo_pairs, + function(pair) { + paste( pair[1], "vs", pair[2], sep = "_" - ) - ) + ) + } + ) ) return(combo_pair_results) } @@ -354,25 +348,27 @@ plot_limma_combos_results <- function( #' @param timestamp A timestamp to include in the reports. #' #' @return No return value, called for side effects. -#' +#' #' @importFrom progress progress_bar #' @importFrom purrr imap -#' +#' generate_reports <- function( - combo_pair_plots, + combo_pair_plots, report_info, report_dir, - timestamp - ) { - - print("Building .html reports for all pairwise hyperparams-combo comparisons") + timestamp) { + message( + "Building .html reports for all pairwise hyperparams-combo comparisons" + ) progress_ticks <- length(combo_pair_plots) - pb <- progress::progress_bar$new(total = progress_ticks, - format = "[:bar] :percent") - - result <- purrr::imap(combo_pair_plots, ~{ + pb <- progress::progress_bar$new( + total = progress_ticks, + format = "[:bar] :percent" + ) + + result <- purrr::imap(combo_pair_plots, ~ { process_combo_pair(.x, .y, report_info, report_dir, timestamp) - pb$tick() + pb$tick() }) } @@ -380,7 +376,7 @@ generate_reports <- function( #' Generate Reports Metadata #' #' @description -#' Generates a metadata table for the LIMMA hyperparameter screen reports and +#' Generates a metadata table for the LIMMA hyperparameter screen reports and #' saves it as an HTML file with custom styling. #' #' @param datas_descr A description object for the data. @@ -391,51 +387,49 @@ generate_reports <- function( #' @param timestamp A timestamp to include in the report filename. #' #' @return No return value, called for side effects. -#' +#' #' @importFrom here here -#' +#' generate_reports_meta <- function( - datas_descr, - designs, - modes, + datas_descr, + designs, + modes, spline_test_configs, report_dir, - timestamp - ) { - + timestamp) { formatted_spline_configs <- flatten_spline_configs(spline_test_configs) - + # Combine the hyperparameters and their descriptions into two vectors hyperparameters <- c( - paste0("Data_", seq_along(datas_descr)), + paste0("Data_", seq_along(datas_descr)), paste0("Design_", seq_along(designs)), paste0("SConfig_", seq_along(formatted_spline_configs)) - ) + ) descriptions <- c( datas_descr, - paste(designs, "(mode:", modes, ")"), + paste(designs, "(mode:", modes, ")"), unlist(formatted_spline_configs) - ) - + ) + table_df <- data.frame( - hyperparameter = hyperparameters, - description = descriptions, + hyperparameter = hyperparameters, + description = descriptions, stringsAsFactors = FALSE - ) - + ) + filename <- sprintf("hyperparams_screen_meta_table_%s.html", timestamp) file_path <- here::here(report_dir, filename) - + custom_css <- " " - + # Start HTML table with the header html_table <- "" html_table <- paste0(html_table, "") - + # Add column headers for (header in colnames(table_df)) { html_table <- paste0(html_table, "") } html_table <- paste0(html_table, "") - + # Add table rows for (i in 1:nrow(table_df)) { html_table <- paste0(html_table, "") @@ -482,21 +476,21 @@ generate_reports_meta <- function( } html_table <- paste0(html_table, "") } - + # Close the table body and the table tag html_table <- paste0(html_table, "
    ", header, "
    ") - + html_table <- paste0(custom_css, html_table) - + writeLines( html_table, con = file_path - ) - - cat( + ) + + message( "Meta table for the limma hyperparameter screen reports saved to:", file_path, "\n" - ) + ) } @@ -507,12 +501,12 @@ generate_reports_meta <- function( #' Process Combination #' #' @description -#' Processes a single combination of data, design, spline configuration, and +#' Processes a single combination of data, design, spline configuration, and #' p-threshold to generate LIMMA spline results. #' #' @param data_index Index of the data in the datas list. #' @param design_index Index of the design in the designs list. -#' @param spline_config_index Index of the spline configuration in the +#' @param spline_config_index Index of the spline configuration in the #' spline_test_configs list. #' @param pthreshold The p-value threshold for significance. #' @param datas A list of data matrices @@ -524,21 +518,21 @@ generate_reports_meta <- function( #' @param condition A single character string specifying the condition. #' @param spline_test_configs A configuration object for spline tests. #' @param feature_names A character vector of feature names. -#' @param padjust_method A single character string specifying the p-adjustment +#' @param padjust_method A single character string specifying the p-adjustment #' method. #' @param ... Additional arguments. #' #' @return A list of top tables from the LIMMA spline analysis. #' #' @seealso -#' \code{\link{create_spline_params}}, +#' \code{\link{create_spline_params}}, #' \code{\link{run_limma_splines}} -#' +#' process_combo <- function( - data_index, - design_index, - spline_config_index, - pthreshold, + data_index, + design_index, + spline_config_index, + pthreshold, datas, rna_seq_datas, metas, @@ -548,53 +542,51 @@ process_combo <- function( spline_test_configs, feature_names, padjust_method, - ... - ) { - + ...) { data <- datas[[data_index]] rna_seq_data <- rna_seq_datas[[data_index]] meta <- metas[[data_index]] design <- designs[[design_index]] mode <- modes[[design_index]] - + spline_params <- create_spline_params( - spline_test_configs = spline_test_configs, - index = spline_config_index, - meta = meta, - condition = condition, + spline_test_configs = spline_test_configs, + index = spline_config_index, + meta = meta, + condition = condition, mode = mode - ) + ) # Because either DoF or knots are specified, and only optionally bknots # If they are not specified, their value is NA. spline_params <- Filter( is_not_na, spline_params - ) - + ) + rownames(data) <- feature_names - + splineomics <- create_splineomics( data = data, rna_seq_data = rna_seq_data, meta = meta, design = design, mode = mode, - spline_params = spline_params, + spline_params = spline_params, condition = condition, ) # suppressMessages will not affect warnings and error messages! result <- suppressMessages(run_limma_splines(splineomics)) - result[['limma_splines_result']][['time_effect']] + result[["limma_splines_result"]][["time_effect"]] } #' Remove Batch Effect #' #' @description -#' Removes batch effects from the data matrices using the specified batch +#' Removes batch effects from the data matrices using the specified batch #' column in the metadata. #' #' @param datas A list of matrices. @@ -603,42 +595,40 @@ process_combo <- function( #' @param meta_batch2_column A character string specifying the second meta batch #' column. #' @param condition A character vector of length 1, specifying the column name -#' of the meta dataframe, that contains the levels that +#' of the meta dataframe, that contains the levels that #' separate the experiment. #' #' @return A list of matrices with batch effects removed where applicable. #' #' @seealso #' \link[limma]{removeBatchEffect} -#' +#' #' @importFrom limma removeBatchEffect #' remove_batch_effect <- function( - datas, + datas, metas, meta_batch_column, meta_batch2_column, - condition - ) { - + condition) { results <- list() for (i in seq_along(datas)) { data <- datas[[i]] meta <- metas[[i]] - + # This is the shortcut approach. It would be better to remove the batch # effect using the design_matrix, but it is challenging to program this here - + args <- list( x = data, batch = meta[[meta_batch_column]], group = meta[[condition]] ) - + if (!is.null(meta_batch2_column)) { args$batch2 <- meta[[meta_batch2_column]] } - + batch_corrected_data <- do.call(removeBatchEffect, args) results[[i]] <- batch_corrected_data } @@ -651,24 +641,24 @@ remove_batch_effect <- function( #' @description #' Creates a new hit comparison object with specified condition names. #' -#' @param cond1name A character string for the first condition name +#' @param cond1name A character string for the first condition name #' (max length 25). -#' @param cond2name A character string for the second condition name +#' @param cond2name A character string for the second condition name #' (max length 25). #' -#' @return An object of class "hitcomp" containing empty data lists +#' @return An object of class "hitcomp" containing empty data lists #' and condition names. -#' +#' hc_new <- function( - cond1name = "Condition 1", - cond2name = "Condition 2" - ) { - - if (!is.character(cond1name) || nchar(cond1name) > 25) + cond1name = "Condition 1", + cond2name = "Condition 2") { + if (!is.character(cond1name) || nchar(cond1name) > 25) { stop("cond1name max len = 25") - if (!is.character(cond2name) || nchar(cond2name) > 25) + } + if (!is.character(cond2name) || nchar(cond2name) > 25) { stop("cond2name max len = 25") - + } + res <- list( data = list( list(), @@ -688,30 +678,29 @@ hc_new <- function( #' #' @param hc_obj An object of class "hitcomp". #' @param top_table A dataframe containing the top table data. -#' @param params_id A character string identifying the parameters +#' @param params_id A character string identifying the parameters #' (max length 70). -#' @param condition An integer (1 or 2) specifying the condition to which the +#' @param condition An integer (1 or 2) specifying the condition to which the #' data belongs. #' @param threshold A numeric value specifying the adjusted p-value threshold. #' #' @return The updated hit comparison object. -#' +#' hc_add <- function( - hc_obj, - top_table, - params_id, condition = 1, - threshold = 0.05 - ){ - + hc_obj, + top_table, + params_id, condition = 1, + threshold = 0.05) { # Validate input if (!is.data.frame(top_table)) stop("top_table must be a dataframe.") if (!is.character(params_id) || nchar(params_id) > 70) { - stop(paste("max len = 70. params_id '", params_id, "' is too long.", - sep = "")) + stop(paste("max len = 70. params_id '", params_id, "' is too long.", + sep = "" + )) } if (!(condition %in% c(1, 2))) stop("condition must be either 1 or 2.") if (!is.numeric(threshold)) stop("threshold must be numeric.") - + # Create the list to append new_entry <- list( DataFrame = top_table, @@ -720,12 +709,12 @@ hc_add <- function( adj_p_value_threshold = threshold ) ) - + # Append to the appropriate global list in the package environment hc_obj$data[[condition]] <- append( hc_obj$data[[condition]], list(new_entry) - ) + ) return(hc_obj) } @@ -733,54 +722,54 @@ hc_add <- function( #' Generate Venn Heatmap #' #' @description -#' Creates a Venn heatmap to visualize the overlap of hits between two +#' Creates a Venn heatmap to visualize the overlap of hits between two #' conditions stored in a hit comparison object. #' -#' @param hc_obj An object of class "hitcomp" containing hit data for two +#' @param hc_obj An object of class "hitcomp" containing hit data for two #' conditions. #' #' @return A list containing the Venn heatmap plot and the number of hits. #' #' @seealso #' \code{\link{store_hits}}, \link[pheatmap]{pheatmap} -#' +#' #' @importFrom tidyr expand_grid unnest_longer replace_na pivot_wider #' @importFrom tibble enframe column_to_rownames #' @importFrom dplyr mutate select left_join #' @importFrom pheatmap pheatmap #' @importFrom purrr flatten_chr -#' +#' hc_vennheatmap <- function(hc_obj) { - hits_1 <- store_hits(hc_obj$data[[1]]) hits_2 <- store_hits(hc_obj$data[[2]]) color_palette <- c("white", "blue", "yellow", "green") breaks <- c(-0.5, 0.5, 1.5, 2.5, 3.5) - + # Check if all elements in hits_1 and hits_2 are character(0) - no_hits_1 <- all(sapply(hits_1, function(x) length(x) == 0)) - no_hits_2 <- all(sapply(hits_2, function(x) length(x) == 0)) - + no_hits_1 <- all(vapply(hits_1, function(x) length(x) == 0, logical(1))) + no_hits_2 <- all(vapply(hits_2, function(x) length(x) == 0, logical(1))) + # If both have no hits, create a placeholder plot for no hits if (no_hits_1 && no_hits_2) { # Create a simple empty matrix for the plot venn_matrix <- matrix( 0, nrow = 1, - ncol = 1, + ncol = 1, dimnames = list("No Hits", "No Hits") - ) - + ) + plot_title <- sprintf( - "No hits found for %s and %s", - hc_obj$condition_names[[1]], + "No hits found for %s and %s", + hc_obj$condition_names[[1]], hc_obj$condition_names[[2]] - ) + ) # Continue with your plotting code vennheatmap_plot <- pheatmap::pheatmap( - venn_matrix, color = color_palette, + venn_matrix, + color = color_palette, breaks = breaks, cluster_cols = FALSE, cluster_rows = FALSE, @@ -791,7 +780,7 @@ hc_vennheatmap <- function(hc_obj) { silent = TRUE, fontsize = 6 ) - + return(list(vennheatmap = vennheatmap_plot, nrhits = 0)) } @@ -805,39 +794,44 @@ hc_vennheatmap <- function(hc_obj) { names(hits_2) ) ) - + df_1 <- - hits_1 |> - tibble::enframe("params", "features") |> + hits_1 |> + tibble::enframe("params", "features") |> tidyr::unnest_longer(!!rlang::sym("features")) |> dplyr::mutate(x1 = 1) - + df_2 <- - hits_2 |> - tibble::enframe("params", "features") |> + hits_2 |> + tibble::enframe("params", "features") |> tidyr::unnest_longer(!!rlang::sym("features")) |> dplyr::mutate(x2 = 2) - - venn_matrix <- - df |> - dplyr::left_join(df_1, by = c("features", "params")) |> - dplyr::left_join(df_2, by = c("features", "params")) |> - tidyr::replace_na(list(x1 = 0, x2 = 0)) |> - dplyr::mutate(x = !!rlang::sym("x1") + !!rlang::sym("x2")) |> + + venn_matrix <- + df |> + dplyr::left_join(df_1, by = c("features", "params")) |> + dplyr::left_join(df_2, by = c("features", "params")) |> + tidyr::replace_na(list(x1 = 0, x2 = 0)) |> + dplyr::mutate(x = !!rlang::sym("x1") + !!rlang::sym("x2")) |> dplyr::select(!c(!!rlang::sym("x1"), !!rlang::sym("x2"))) |> - tidyr::pivot_wider(names_from = !!rlang::sym("params"), - values_from = !!rlang::sym("x")) |> - tibble::column_to_rownames("features") |> + tidyr::pivot_wider( + names_from = !!rlang::sym("params"), + values_from = !!rlang::sym("x") + ) |> + tibble::column_to_rownames("features") |> as.matrix() venn_matrix <- venn_matrix[, order(colnames(venn_matrix))] - - plot_title <- sprintf("0 -> none, 1 -> %s, 2 -> %s, 3 -> both", - hc_obj$condition_names[[1]], - hc_obj$condition_names[[2]]) - + + plot_title <- sprintf( + "0 -> none, 1 -> %s, 2 -> %s, 3 -> both", + hc_obj$condition_names[[1]], + hc_obj$condition_names[[2]] + ) + vennheatmap_plot <- pheatmap::pheatmap( - venn_matrix, color = color_palette, + venn_matrix, + color = color_palette, breaks = breaks, cluster_cols = FALSE, cluster_rows = TRUE, @@ -847,64 +841,62 @@ hc_vennheatmap <- function(hc_obj) { main = plot_title, silent = TRUE, fontsize = 6 - ) - + ) + return( list( - vennheatmap = vennheatmap_plot, + vennheatmap = vennheatmap_plot, nrhits = nrow(venn_matrix) - ) ) + ) } #' Generate Barplot for Hit Comparison Object #' #' @description -#' Creates a barplot to visualize the number of significant features for each +#' Creates a barplot to visualize the number of significant features for each #' parameter set in the hit comparison object. #' -#' @param hc_obj An object of class "hitcomp" containing hit data for two +#' @param hc_obj An object of class "hitcomp" containing hit data for two #' conditions. #' #' @return A ggplot2 object representing the barplot. #' #' @seealso #' \code{\link{store_hits}}, \code{\link{ggplot2}} -#' +#' #' @importFrom ggplot2 geom_col geom_text facet_wrap scale_y_continuous aes #' @importFrom ggplot2 theme_minimal element_text element_blank expansion xlab #' @importFrom ggplot2 theme -#' @importFrom purrr map_int set_names +#' @importFrom purrr map_int set_names #' @importFrom tibble enframe #' @importFrom dplyr bind_rows vars -#' +#' hc_barplot <- function(hc_obj) { - - plot_data <- + plot_data <- list( - store_hits(hc_obj$data[[1]]) |> - purrr::map_int(length) |> + store_hits(hc_obj$data[[1]]) |> + purrr::map_int(length) |> tibble::enframe("params", "n_hits"), - store_hits(hc_obj$data[[2]]) |> - purrr::map_int(length) |> + store_hits(hc_obj$data[[2]]) |> + purrr::map_int(length) |> tibble::enframe("params", "n_hits") - ) |> - purrr::set_names(hc_obj$condition_names) |> + ) |> + purrr::set_names(hc_obj$condition_names) |> dplyr::bind_rows(.id = "condition") - + ggplot2::ggplot( plot_data, aes( - x = !!rlang::sym("params"), + x = !!rlang::sym("params"), y = !!rlang::sym("n_hits") - ) - ) + + ) + ) + geom_col() + geom_text( aes(label = !!rlang::sym("n_hits")), vjust = -0.5, - ) + xlab("Parameters") + scale_y_continuous( @@ -919,7 +911,7 @@ hc_barplot <- function(hc_obj) { vjust = 1, hjust = 1, size = 4 - ), + ), panel.grid.major.x = element_blank() ) + NULL @@ -929,133 +921,129 @@ hc_barplot <- function(hc_obj) { #' Generate Hit Comparison Plots #' #' @description -#' Generates Venn heatmap and barplot for a given combination pair of top +#' Generates Venn heatmap and barplot for a given combination pair of top #' tables. #' #' @param combo_pair A list containing two combinations of top tables. #' -#' @return A list containing the Venn heatmap plot, the number of hits divided +#' @return A list containing the Venn heatmap plot, the number of hits divided #' by 16, the barplot, and a length indicator for the barplot. #' #' @seealso -#' \code{\link{hc_new}}, \code{\link{hc_add}}, \code{\link{hc_vennheatmap}}, +#' \code{\link{hc_new}}, \code{\link{hc_add}}, \code{\link{hc_vennheatmap}}, #' \code{\link{hc_barplot}} -#' +#' gen_hitcomp_plots <- function(combo_pair) { - combo_pair_combined <- c( combo_pair[[1]], combo_pair[[2]] - ) - + ) + hitcomp <- hc_new( names(combo_pair)[1], names(combo_pair)[2] - ) - - combo_names <- sapply(names(combo_pair_combined), function(name) { + ) + + combo_names <- vapply(names(combo_pair_combined), function(name) { # Using sub to extract everything from 'DoF' onwards match <- sub(".*(SConfig.*)$", "\\1", name) return(match) - }) - + }, character(1)) + condition_nr <- 1L for (i in 1:length(combo_pair_combined)) { combo_top_tables <- combo_pair_combined[[i]] combo_name <- combo_names[i] # Extract the part where DoF and p-value threshold are written. pthreshold <- as.numeric(sub(".*_([^_]+)$", "\\1", combo_name)) - - if (i == length(combo_pair_combined)/2 + 1) { + + if (i == length(combo_pair_combined) / 2 + 1) { condition_nr <- 2L } - + for (top_table_name in names(combo_top_tables)) { top_table <- combo_top_tables[[top_table_name]] id <- paste( top_table_name, combo_name, sep = "_" - ) + ) hitcomp <- hc_add( hitcomp, top_table, id, condition_nr, pthreshold - ) + ) } } result <- hc_vennheatmap(hitcomp) barplot <- hc_barplot(hitcomp) - + list( - vennheatmap = result$vennheatmap, - vennheatmap_len = c(as.integer(result$nrhits/16)), + vennheatmap = result$vennheatmap, + vennheatmap_len = c(as.integer(result$nrhits / 16)), barplot = barplot, barplot_len = c(2L) ) } - + #' Generate Composite Spline Plots #' #' @description -#' Creates composite spline plots for significant and non-significant features +#' Creates composite spline plots for significant and non-significant features #' across multiple levels within a condition. -#' One half of one condition comparison HTML +#' One half of one condition comparison HTML #' (composite spline plots for one 'condition' inside one condition comparison) #' #' @param internal_combos A list containing combinations of top tables. #' @param datas A list of matrices. #' @param metas A list of metadata corresponding to the data matrices. #' @param spline_test_configs A configuration object for spline tests. -#' @param time_unit_label A character string specifying the time unit label +#' @param time_unit_label A character string specifying the time unit label #' for plots. #' #' @return A list containing the composite spline plots and their lengths. #' #' @seealso #' \code{\link{plot_composite_splines}} -#' +#' #' @importFrom utils tail -#' +#' gen_composite_spline_plots <- function( - internal_combos, - datas, + internal_combos, + datas, metas, spline_test_configs, - time_unit_label - ) { - + time_unit_label) { plots <- list() plots_len <- integer(0) - + # all the combos of DoF and adj. p-value threshold for one condition for (combo_name in names(internal_combos)) { top_tables_levels <- internal_combos[[combo_name]] - + data <- datas[[as.integer(strsplit(combo_name, "_")[[1]][2])]] meta <- metas[[as.integer(strsplit(combo_name, "_")[[1]][2])]] - - pthresh <- as.numeric(utils::tail(strsplit(combo_name, "_")[[1]], 1)) - - # for one given combo of DoF and adj. p-value threshold, within one + + pthresh <- as.numeric(utils::tail(strsplit(combo_name, "_")[[1]], 1)) + + # for one given combo of DoF and adj. p-value threshold, within one # condition, there are multiple levels (for example exp and stat) for (top_table_name in names(top_tables_levels)) { top_table <- top_tables_levels[[top_table_name]] - + parts <- strsplit(top_table_name, "_")[[1]] condition <- parts[1] level <- parts[2] meta_level <- meta[meta[[condition]] == level, ] data_level <- data[, which(meta[[condition]] == level)] - - # Show 6 significant and 6 non significant splines, each within a + + # Show 6 significant and 6 non significant splines, each within a # composite plot (the 6 individual plots combined with patchwork) - for (type in c('significant', 'not_significant')) { - + for (type in c("significant", "not_significant")) { if (type == "significant") { filtered_rows <- top_table[top_table$adj.P.Val < pthresh, ] selected_rows <- if (nrow(filtered_rows) > 6) { @@ -1073,49 +1061,49 @@ gen_composite_spline_plots <- function( } indices <- as.integer(selected_rows$feature_nr) } - - # One composite spline plot for each unique combo between DoF and + + # One composite spline plot for each unique combo between DoF and # adj. p-value threshold (for one level within one condition) # This fun just generates a single composite plot result <- plot_composite_splines( - data_level, + data_level, meta_level, spline_test_configs, - top_table, - combo_name, + top_table, + combo_name, indices, type, time_unit_label - ) - + ) + if (is.list(result)) { plot_name <- paste( combo_name, top_table_name, type, sep = "_" - ) + ) plots[[plot_name]] <- result$composite_plot plots_len <- c(plots_len, result$composite_plot_len) } } } } - + list( - composite_plots = plots, + composite_plots = plots, composite_plots_len = plots_len - ) + ) } #' Process Combination Pair #' #' @description -#' Processes a combination pair to generate plots and compile them into an +#' Processes a combination pair to generate plots and compile them into an #' HTML report. #' -#' @param combo_pair A list containing hit comparison and composite spline +#' @param combo_pair A list containing hit comparison and composite spline #' plots. #' @param combo_pair_name A character string for naming the combination pair. #' @param report_info An object containing report information. @@ -1126,60 +1114,58 @@ gen_composite_spline_plots <- function( #' #' @seealso #' \code{\link{generate_report_html}} -#' +#' process_combo_pair <- function( - combo_pair, - combo_pair_name, + combo_pair, + combo_pair_name, report_info, report_dir, - timestamp - ) { - + timestamp) { plots <- list() plots_len <- integer(0) - + hitcomp <- combo_pair$hitcomp - + plots[[1]] <- hitcomp$vennheatmap plots[[2]] <- hitcomp$vennheatmap plots[[3]] <- hitcomp$barplot - + plots_len <- c( - plots_len, - 2, - hitcomp$vennheatmap_len, + plots_len, + 2, + hitcomp$vennheatmap_len, hitcomp$barplot_len - ) - + ) + composites <- combo_pair$composites - + for (composite in composites) { for (plot in composite$composite_plots) { plots[[length(plots) + 1]] <- plot } - + for (len in composite$composite_plots_len) { plots_len <- c(plots_len, len) } } - + # Function is in splinetime_general_fun.R generate_report_html( - plots = plots, - plots_sizes = plots_len, + plots = plots, + plots_sizes = plots_len, report_info = report_info, report_type = "screen_limma_hyperparams", filename = combo_pair_name, timestamp = timestamp, report_dir = report_dir - ) + ) } #' Create Spline Parameters #' #' @description -#' Generates spline parameters based on the configuration, metadata, condition, +#' Generates spline parameters based on the configuration, metadata, condition, #' and mode. #' #' @param spline_test_configs A configuration object for spline tests. @@ -1192,24 +1178,22 @@ process_combo_pair <- function( #' #' @seealso #' \code{\link{process_config_column}} -#' +#' create_spline_params <- function( - spline_test_configs, - index, - meta, - condition, - mode - ) { - - num_levels <- length(unique(meta[[condition]])) - + spline_test_configs, + index, + meta, + condition, + mode) { + num_levels <- length(unique(meta[[condition]])) + result <- lapply( - spline_test_configs, - process_config_column, - index, - num_levels, + spline_test_configs, + process_config_column, + index, + num_levels, mode - ) + ) return(result) } @@ -1222,34 +1206,32 @@ create_spline_params <- function( #' @param spline_configs A list of spline configuration objects. #' #' @return A list of formatted strings representing each spline configuration. -#' +#' flatten_spline_configs <- function(spline_configs) { - formatted_layers <- list() - + names_of_spline_configs <- names(spline_configs) for (i in 1:length(spline_configs$spline_type)) { ith_elements <- lapply(spline_configs, function(x) x[[i]]) - + formatted_strings <- list() - + Map(function(name, element) { - formatted_strings <<- c( + formatted_strings <- c( formatted_strings, paste0( name, - " = ", + " = ", paste( element, - collapse = ", ") + collapse = ", " ) ) - + ) }, names_of_spline_configs, ith_elements) - + final_string <- paste(formatted_strings, collapse = ", ") - formatted_layers[[length(formatted_layers) + 1]] <- final_string - + formatted_layers[[length(formatted_layers) + 1]] <- final_string } formatted_layers } @@ -1265,11 +1247,10 @@ flatten_spline_configs <- function(spline_configs) { #' #' @param x An atomic vector or any other object. #' -#' @return TRUE if the vector contains at least one non-NA value or if the +#' @return TRUE if the vector contains at least one non-NA value or if the #' object is not atomic; FALSE otherwise. -#' +#' is_not_na <- function(x) { - if (is.atomic(x)) { return(!all(is.na(x))) } else { @@ -1281,32 +1262,30 @@ is_not_na <- function(x) { #' Process Configuration Column #' #' @description -#' Processes a configuration column based on the given mode and number of +#' Processes a configuration column based on the given mode and number of #' levels. #' -#' @param config_column A configuration column from the spline test +#' @param config_column A configuration column from the spline test #' configurations. #' @param index Index of the configuration to process. #' @param num_levels Number of unique levels in the metadata condition. -#' @param mode A character string specifying the mode +#' @param mode A character string specifying the mode #' ('integrated' or 'isolated'). #' #' @return A vector or list with the processed configuration values. -#' +#' process_config_column <- function( config_column, index, num_levels, - mode - ) { - + mode) { if (mode == "integrated") { if (is.list(config_column)) { config_column[[index]] } else { config_column[index] } - } else { # mode = 'isolated' + } else { # mode = 'isolated' if (is.list(config_column)) { rep(config_column[[index]], num_levels) } else { @@ -1319,21 +1298,20 @@ process_config_column <- function( #' Store Hits #' #' @description -#' Stores the feature indices for significant hits based on the adjusted p-value +#' Stores the feature indices for significant hits based on the adjusted p-value #' threshold for each condition. #' -#' @param condition A list containing dataframes and parameters for each +#' @param condition A list containing dataframes and parameters for each #' condition. #' -#' @return A list where each element is a vector of feature indices that meet +#' @return A list where each element is a vector of feature indices that meet #' the significance threshold. -#' +#' #' @importFrom dplyr pull -#' +#' store_hits <- function(condition) { - hits_cond <- list() - + for (item in condition) { df <- item$DataFrame adj_p_value_treshold <- item$Parameters$adj_p_value_threshold @@ -1344,7 +1322,7 @@ store_hits <- function(condition) { pull(!!sym("feature_nr")) |> as.character() } - + return(hits_cond) } @@ -1352,129 +1330,148 @@ store_hits <- function(condition) { #' Plot Composite Splines #' #' @description -#' Generates composite spline plots for significant and non-significant +#' Generates composite spline plots for significant and non-significant #' features based on the specified indices. #' #' @param data A matrix of data values. #' @param meta A dataframe containing metadata. #' @param spline_test_configs A configuration object for spline tests. #' @param top_table A dataframe containing the top table results. -#' @param top_table_name A character string specifying the name of the +#' @param top_table_name A character string specifying the name of the #' top table. #' @param indices A vector of indices specifying which features to plot. -#' @param type A character string specifying the type of features ('significant' +#' @param type A character string specifying the type of features ('significant' #' or 'not_significant'). #' @param time_unit_label A string shown in the plots as the unit for the time, #' such as min or hours. #' -#' @return A list containing the composite plot and its length if plots are +#' @return A list containing the composite plot and its length if plots are #' generated, FALSE otherwise. #' #' @seealso -#' \link[splines]{bs}, \link[splines]{ns}, \link[ggplot2]{ggplot2}, +#' \link[splines]{bs}, \link[splines]{ns}, \link[ggplot2]{ggplot2}, #' \link[patchwork]{wrap_plots} -#' +#' #' @importFrom splines ns -#' @importFrom ggplot2 ggplot geom_point geom_line theme_minimal +#' @importFrom ggplot2 ggplot geom_point geom_line theme_minimal #' @importFrom ggplot2 scale_x_continuous labs annotate theme #' @importFrom patchwork wrap_plots plot_annotation -#' +#' plot_composite_splines <- function( - data, - meta, + data, + meta, spline_test_configs, - top_table, - top_table_name, + top_table, + top_table_name, indices, type, - time_unit_label - ) { - + time_unit_label) { plot_list <- list() - config_index <- - as.integer(sub(".*SConfig_([0-9]+)_.*", "\\1", top_table_name)) + config_index <- + as.integer(sub(".*SConfig_([0-9]+)_.*", "\\1", top_table_name)) + + smooth_timepoints <- seq(meta$Time[1], + meta$Time[length(meta$Time)], + length.out = 100 + ) - smooth_timepoints <- seq(meta$Time[1], - meta$Time[length(meta$Time)], - length.out = 100) - args <- list(x = smooth_timepoints, intercept = FALSE) args$df <- spline_test_configs$dof[[config_index]] if (spline_test_configs$spline_type[config_index] == "b") { args$degree <- spline_test_configs$degree[[config_index]] X <- do.call(splines::bs, args) - } else { # natural cubic splines + } else { # natural cubic splines X <- do.call(splines::ns, args) } - + # Generate all the individual plots for (index in indices) { - DoF <- which(names(top_table) == "AveExpr") - 1 - spline_coeffs <- - as.numeric(top_table[top_table$feature_nr == - index, paste0("X", 1:DoF)]) - - intercept <- + spline_coeffs <- + as.numeric(top_table[top_table$feature_nr == + index, paste0("X", 1:DoF)]) + + intercept <- as.numeric(top_table$intercept[top_table$feature_nr == index]) - + fitted_values <- X %*% spline_coeffs + intercept - - plot_data <- data.frame(Time = meta$Time, - Intensity = as.vector(t(data[index, ]))) - + + plot_data <- data.frame( + Time = meta$Time, + Intensity = as.vector(t(data[index, ])) + ) + plot_spline <- data.frame(Time = smooth_timepoints, Fitted = fitted_values) - + # Calculate the extension for the x-axis x_max <- max(meta$Time) - x_extension <- x_max * 0.05 # Extend the x-axis by 5% of its maximum value - + x_extension <- x_max * 0.05 # Extend the x-axis by 5% of its maximum value + p <- ggplot2::ggplot() + - geom_point(data = plot_data, aes(x = !!rlang::sym("Time"), - y = !!rlang::sym("Intensity")), - color = 'blue') + - geom_line(data = plot_spline, aes(x = !!rlang::sym("Time"), - y = !!rlang::sym("Fitted")), - color = 'red') + + geom_point( + data = plot_data, aes( + x = !!rlang::sym("Time"), + y = !!rlang::sym("Intensity") + ), + color = "blue" + ) + + geom_line( + data = plot_spline, aes( + x = !!rlang::sym("Time"), + y = !!rlang::sym("Fitted") + ), + color = "red" + ) + theme_minimal() + scale_x_continuous(limits = c(min(meta$Time), x_max + x_extension)) labs(x = paste0("Time ", time_unit_label), y = "Intensity") - - title <- top_table$feature_names[index] + + title <- top_table$feature_names[index] if (is.na(title)) { title <- paste("Feature:", index) } - - p <- p + labs(title = title, - x = paste0("Time ", time_unit_label), y = "Intensity") + - theme(plot.title = element_text(size = 4), - axis.title.x = element_text(size = 8), - axis.title.y = element_text(size = 8)) + - annotate("text", x = x_max + (x_extension / 2), y = - max(fitted_values, na.rm = TRUE), - label = "", - hjust = 0.5, vjust = 1, size = 3.5, angle = 0, color = "black") + + p <- p + labs( + title = title, + x = paste0("Time ", time_unit_label), y = "Intensity" + ) + + theme( + plot.title = element_text(size = 4), + axis.title.x = element_text(size = 8), + axis.title.y = element_text(size = 8) + ) + + annotate("text", + x = x_max + (x_extension / 2), y = + max(fitted_values, na.rm = TRUE), + label = "", + hjust = 0.5, vjust = 1, size = 3.5, angle = 0, color = "black" + ) plot_list[[length(plot_list) + 1]] <- p } - + if (length(plot_list) > 0) { # Generate the combined plot num_plots <- length(plot_list) ncol <- 3 composite_plot_len <- as.integer(ceiling(num_plots / ncol)) - - composite_plot <- patchwork::wrap_plots(plot_list, ncol = 3) + - patchwork::plot_annotation(title = paste(top_table_name, type, - sep = " | "), - theme = theme(plot.title = element_text(hjust = 0.5, - size = 14))) - - return(list( - composite_plot = composite_plot, - composite_plot_len = composite_plot_len) + + composite_plot <- patchwork::wrap_plots(plot_list, ncol = 3) + + patchwork::plot_annotation( + title = paste(top_table_name, type, + sep = " | " + ), + theme = theme(plot.title = element_text( + hjust = 0.5, + size = 14 + )) ) + + return(list( + composite_plot = composite_plot, + composite_plot_len = composite_plot_len + )) } else { return(FALSE) } @@ -1484,76 +1481,76 @@ plot_composite_splines <- function( #' Build Hyperparameters Screening Report #' #' @description -#' Constructs an HTML report for hyperparameter screening by embedding plots +#' Constructs an HTML report for hyperparameter screening by embedding plots #' and their respective sizes into the provided header section. #' #' @param header_section A character string containing the HTML header section. #' @param plots A list of ggplot2 plot objects. -#' @param plots_sizes A list of integers specifying the number of rows for each +#' @param plots_sizes A list of integers specifying the number of rows for each #' plot. #' @param report_info A named list containg the report info fields. Here used #' for the email hotkey functionality. -#' @param output_file_path A character string specifying the path to save the +#' @param output_file_path A character string specifying the path to save the #' HTML report. #' #' @return No return value, called for side effects. #' #' @seealso #' \code{\link{plot2base64}} -#' +#' build_hyperparams_screen_report <- function( - header_section, - plots, - plots_sizes, + header_section, + plots, + plots_sizes, report_info, - output_file_path - ) { - + output_file_path) { html_content <- paste(header_section, "", sep = "\n") - + toc <- create_toc() - + styles <- define_html_styles() section_header_style <- styles$section_header_style toc_style <- styles$toc_style - + headers <- c( "Venn-Heatmap", "Venn-Heatmap long", "Nr. Hits Barplots", "Spline Curves" - ) - + ) + # section_texts <- get_hyperparams_screen_plots_explanations() section_texts <- read_section_texts( "screen_hyperparams_plot_explanations.txt" - ) - + ) + nr_of_sections <- length(headers) - + for (index in seq_along(plots)) { - if (index <= nr_of_sections) { - section_header <- sprintf( "

    %s

    ", section_header_style, index, headers[index] - ) - - section_text <- sprintf('

    %s

    ', - section_texts[index]) - + ) + + section_text <- sprintf( + '

    %s

    ', + section_texts[index] + ) + html_content <- paste( html_content, section_header, section_text, sep = "\n" - ) - - toc_entry <- sprintf("
  • %s
  • ", - toc_style, index, headers[index]) + ) + + toc_entry <- sprintf( + "
  • %s
  • ", + toc_style, index, headers[index] + ) toc <- paste(toc, toc_entry, sep = "\n") } @@ -1567,7 +1564,7 @@ build_hyperparams_screen_report <- function( html_content <- result$html_content toc <- result$toc } - + generate_and_write_html( toc = toc, html_content = html_content, diff --git a/R/splineomics_object.R b/R/splineomics_object.R index b7c1757..ddaa5a2 100755 --- a/R/splineomics_object.R +++ b/R/splineomics_object.R @@ -4,56 +4,56 @@ #' Create a SplineOmics object #' #' @description -#' Creates a SplineOmics object containing variables that are commonly used +#' Creates a SplineOmics object containing variables that are commonly used #' across multiple functions in the package. -#' +#' #' @param data The actual omics data. In the case the rna_seq_data argument is -#' used, still provide this argument. In that case, input the data matrix in +#' used, still provide this argument. In that case, input the data matrix in #' here (for example the $E part of the voom object). Assign your feature names #' as row headers (otherwise, just numbers will be your feature names). #' @param meta Metadata associated with the omics data. #' @param condition A condition variable. -#' @param rna_seq_data An object containing the preprocessed RNA-seq data, -#' such as the output from `limma::voom` or a similar preprocessing pipeline. +#' @param rna_seq_data An object containing the preprocessed RNA-seq data, +#' such as the output from `limma::voom` or a similar preprocessing pipeline. #' This argument is not controlled by any function of the `SplineOmics` package. #' Rather, in that regard it relies on the input control from the `limma::lmfit` #' function. -#' @param annotation A dataframe with the feature descriptions of data +#' @param annotation A dataframe with the feature descriptions of data #' (optional). -#' @param report_info A list containing report information such as omics data -#' type, data description, data collection date, analyst name, contact info, -#' and project name (optional). +#' @param report_info A list containing report information such as omics data +#' type, data description, data collection date, analyst name, contact info, +#' and project name (optional). #' @param meta_batch_column Column for meta batch information (optional). -#' @param meta_batch2_column Column for secondary meta batch information +#' @param meta_batch2_column Column for secondary meta batch information #' (optional). -#' @param feature_name_columns Character vector containing the column names of +#' @param feature_name_columns Character vector containing the column names of #' the annotation info that describe the features. -#' This argument is used to specify in the HTML +#' This argument is used to specify in the HTML #' report how exactly the feature names displayed #' above each individual spline plot have been -#' created. Use the same vector that was used to +#' created. Use the same vector that was used to #' create the row headers for the data matrix! #' @param design A design matrix or similar object (optional). -#' @param mode For the design formula, you must specify either 'isolated' or -#' 'integrated'. Isolated means limma determines the results for each level +#' @param mode For the design formula, you must specify either 'isolated' or +#' 'integrated'. Isolated means limma determines the results for each level #' using only the data from that level. Integrated means limma determines the #' results for all levels using the full dataset (from all levels). #' @param spline_params Parameters for spline functions (optional). Must contain #' the named elements spline_type, which must contain either the string "n" for #' natural cubic splines, or "b", for B-splines, the named element degree in the -#' case of B-splines, that must contain only an integer, and the named element +#' case of B-splines, that must contain only an integer, and the named element #' dof, specifying the degree of freedom, containing an integer and required #' both for natural and B-splines. -#' @param padjust_method Method for p-value adjustment, one of "none", "BH", -#' "BY", "holm", "bonferroni", "hochberg", or "hommel". +#' @param padjust_method Method for p-value adjustment, one of "none", "BH", +#' "BY", "holm", "bonferroni", "hochberg", or "hommel". #' Defaults to "BH" (Benjamini-Hochberg). #' #' @return A SplineOmics object. #' #' @export -#' +#' create_splineomics <- function( - data, + data, meta, condition, rna_seq_data = NULL, @@ -63,11 +63,12 @@ create_splineomics <- function( meta_batch2_column = NULL, feature_name_columns = NULL, design = NULL, + dream_params = NULL, mode = NULL, spline_params = NULL, padjust_method = "BH" ) { - + splineomics <- list( data = data, rna_seq_data = rna_seq_data, @@ -79,11 +80,12 @@ create_splineomics <- function( meta_batch2_column = meta_batch2_column, feature_name_columns = feature_name_columns, design = design, + dream_params = dream_params, mode = mode, spline_params = spline_params, padjust_method = padjust_method ) - + class(splineomics) <- "SplineOmics" return(splineomics) } @@ -100,7 +102,7 @@ create_splineomics <- function( #' @return The updated SplineOmics object. #' #' @export -#' +#' update_splineomics <- function( splineomics, ... @@ -109,7 +111,7 @@ update_splineomics <- function( if (!inherits(splineomics, "SplineOmics")) { stop("The passed object must be of class 'SplineOmics'") } - + allowed_fields <- c( "data", "rna_seq_data", @@ -121,11 +123,12 @@ update_splineomics <- function( "meta_batch2_column", "feature_name_columns", "design", + "dream_params", "mode", "spline_params", "limma_splines_result" - ) - + ) + args <- list(...) for (name in names(args)) { @@ -134,7 +137,7 @@ update_splineomics <- function( } splineomics[[name]] <- args[[name]] } - + return(splineomics) } @@ -143,59 +146,59 @@ update_splineomics <- function( #' #' @description #' This function provides a summary print of the SplineOmics object, showing -#' relevant information such as the number of features, samples, metadata, +#' relevant information such as the number of features, samples, metadata, #' RNA-seq data, annotation, and spline parameters. #' #' @param x A SplineOmics object created by the `create_splineomics` function. #' @param ... Additional arguments passed to or from other methods. #' #' @details -#' This function is automatically called when a SplineOmics object is printed. -#' It provides a concise overview of the object's contents and attributes, -#' including the dimensions of the data, available metadata, and other relevant +#' This function is automatically called when a SplineOmics object is printed. +#' It provides a concise overview of the object's contents and attributes, +#' including the dimensions of the data, available metadata, and other relevant #' information such as annotations and spline parameters. #' #' @return -#' The function does not return a value. It prints a summary of +#' The function does not return a value. It prints a summary of #' the SplineOmics object. -#' +#' #' @importFrom utils head #' #' @export -#' +#' print.SplineOmics <- function(x, ...) { cat("data:") cat("SplineOmics Object\n") cat("-------------------\n") - + # Print summary information cat("Number of features (rows):", nrow(x$data), "\n") cat("Number of samples (columns):", ncol(x$data), "\n") - + cat("Meta data columns:", ncol(x$meta), "\n") cat("First few meta columns:\n") print(utils::head(x$meta, 3)) - + cat("Condition:", x$condition, "\n") - + if (!is.null(x$rna_seq_data)) { cat("RNA-seq data is provided.\n") } else { cat("No RNA-seq data provided.\n") } - + if (!is.null(x$annotation)) { cat("Annotation provided with", nrow(x$annotation), "entries.\n") } else { cat("No annotation provided.\n") } - + if (!is.null(x$spline_params)) { cat("Spline parameters are set:\n") - print(x$spline_params) + print(x$spline_params) } else { cat("No spline parameters set.\n") } - + cat("P-value adjustment method:", x$padjust_method, "\n") } diff --git a/R/utils_general.R b/R/utils_general.R index 1caab3c..6302921 100755 --- a/R/utils_general.R +++ b/R/utils_general.R @@ -1,4 +1,4 @@ -#' utils scripts contains shared functions that are used by at least two package +#' utils scripts contains shared functions that are used by at least two package #' functions of the SplineOmics package. # Level 1 internal functions --------------------------------------------------- @@ -9,9 +9,9 @@ #' @description #' Creates a progress bar for tracking the progress of an iterable task. #' -#' @param iterable An iterable object (e.g., list or vector) whose length +#' @param iterable An iterable object (e.g., list or vector) whose length #' determines the total number of steps. -#' @param message A message to display with the progress bar +#' @param message A message to display with the progress bar #' (default is "Processing"). #' #' @return A progress bar object from the 'progress' package. @@ -20,12 +20,10 @@ #' #' @seealso #' \code{\link{progress_bar}} -#' +#' create_progress_bar <- function( iterable, - message = "Processing" -) { - + message = "Processing") { # Create and return the progress bar pb <- progress::progress_bar$new( format = paste(" ", message, " [:bar] :percent :elapsed"), @@ -33,7 +31,7 @@ create_progress_bar <- function( width = 60, clear = FALSE ) - + return(pb) } @@ -42,20 +40,20 @@ create_progress_bar <- function( #' Create Design Matrix for Splines #' #' @description -#' This function generates a design matrix using spline parameters and metadata. -#' It accommodates both B-splines and natural cubic splines based on the provided +#' This function generates a design matrix using spline parameters and metadata. +#' It accommodates both B-splines and natural cubic splines based on the provided #' spline type and parameters. #' #' @param meta A dataframe containing the metadata, including the time column. -#' @param spline_params A list containing the spline parameters. This list can -#' include `dof` (degrees of freedom), `knots`, `bknots` (boundary knots), +#' @param spline_params A list containing the spline parameters. This list can +#' include `dof` (degrees of freedom), `knots`, `bknots` (boundary knots), #' `spline_type`, and `degree`. -#' @param level_index An integer representing the current level index for which +#' @param level_index An integer representing the current level index for which #' the design matrix is being generated. -#' @param design A character string representing the design formula to be used +#' @param design A character string representing the design formula to be used #' for generating the model matrix. #' -#' @return A design matrix constructed using the specified spline parameters and +#' @return A design matrix constructed using the specified spline parameters and #' design formula. #' #' @importFrom splines bs ns @@ -67,18 +65,18 @@ design2design_matrix <- function( level_index, design ) { - + args <- list( x = meta$Time, intercept = FALSE - ) # Time column is mandatory - + ) # Time column is mandatory + if (!is.null(spline_params$dof)) { args$df <- spline_params$dof[level_index] } else { args$knots <- spline_params$knots[[level_index]] } - + if (!is.null(spline_params$bknots)) { args$Boundary.knots <- spline_params$bknots[[level_index]] } @@ -86,14 +84,19 @@ design2design_matrix <- function( if (spline_params$spline_type[level_index] == "b") { args$degree <- spline_params$degree[level_index] meta$X <- do.call(splines::bs, args) - } else { # natural cubic splines + } else { # natural cubic splines meta$X <- do.call(splines::ns, args) } - + design_matrix <- stats::model.matrix( stats::as.formula(design), data = meta - ) + ) + + result <- list( + design_matrix = design_matrix, + meta = meta + ) } @@ -110,9 +113,7 @@ design2design_matrix <- function( #' merge_top_table_with_annotation <- function( top_table, - annotation -) { - + annotation) { top_table$feature_nr <- as.numeric(as.character(top_table$feature_nr)) annotation_rows <- annotation[top_table$feature_nr, ] top_table <- cbind(top_table, annotation_rows) @@ -122,7 +123,7 @@ merge_top_table_with_annotation <- function( #' Bind Data with Annotation #' #' @description -#' This function converts a matrix to a dataframe, adds row names as the first +#' This function converts a matrix to a dataframe, adds row names as the first #' column, #' and binds it with annotation data. #' @@ -135,28 +136,27 @@ merge_top_table_with_annotation <- function( #' bind_data_with_annotation <- function( data, - annotation = NULL -) { - + annotation = NULL) { data_df <- as.data.frame(data) - + # Add row names as the first column named feature_names combined_df <- cbind( feature_name = rownames(data_df), data_df ) - + # If annotation is not NULL, check row count and bind with annotation if (!is.null(annotation)) { if (nrow(data_df) != nrow(annotation)) { stop("The number of rows in data and annotation must be the same.", - call. = FALSE) + call. = FALSE + ) } - + # Bind the annotation with the data combined_df <- cbind(combined_df, annotation) } - + return(combined_df) } @@ -164,53 +164,51 @@ bind_data_with_annotation <- function( #' Print Informational Message #' #' @description -#' This function prints a nicely formatted informational message with a green "Info" label. +#' This function prints a nicely formatted informational message with a green +#' "Info" label. #' -#' @param message_prefix A custom message prefix to be displayed before the success message. +#' @param message_prefix A custom message prefix to be displayed before the +#' success message. #' @param report_dir The directory where the HTML reports are located. #' #' @return NULL #' print_info_message <- function( message_prefix, - report_dir - ) { - + report_dir) { # Green color code for "Info" green_info <- "\033[32mInfo\033[0m" - + full_message <- paste( green_info, message_prefix, "completed successfully.\n", "Your HTML reports are located in the directory: ", report_dir, ".\n", "Please note that due to embedded files, the reports might be flagged as\n", "harmful by other software. Rest assured that they provide no harm.\n" ) - - cat(full_message) + + message(full_message) } #' Stop with custom message without call. #' #' @description -#' A helper function that triggers an error with the specified message and -#' suppresses the function call in the error output. This function behaves -#' similarly to the base `stop()` function but automatically concatenates +#' A helper function that triggers an error with the specified message and +#' suppresses the function call in the error output. This function behaves +#' similarly to the base `stop()` function but automatically concatenates #' multiple message strings if provided. #' -#' @param ... One or more character strings specifying the error message. -#' If multiple strings are provided, they will be concatenated +#' @param ... One or more character strings specifying the error message. +#' If multiple strings are provided, they will be concatenated #' with a space between them. #' -#' @return This function does not return a value; it stops execution and +#' @return This function does not return a value; it stops execution and #' throws an error. #' stop_call_false <- function(...) { # Concatenate all arguments into a single string message_text <- paste(..., sep = " ") - + # Call stop with the concatenated message and call. = FALSE stop(message_text, call. = FALSE) } - - diff --git a/R/utils_input_validation.R b/R/utils_input_validation.R index 091bd49..e663345 100755 --- a/R/utils_input_validation.R +++ b/R/utils_input_validation.R @@ -1,5 +1,3 @@ - - # InputControl class ----------------------------------------------------------- @@ -11,32 +9,30 @@ #' InputControl <- R6::R6Class("InputControl", inherit = Level2Functions, - public = list( args = NULL, - + #' Initialize an InputControl object #' #' @param args A list of arguments to be validated. #' @return A new instance of the InputControl class. - #' + #' initialize = function(args) { - if (!is.null(args$splineomics) && - inherits(args$splineomics, "SplineOmics")) { + inherits(args$splineomics, "SplineOmics")) { args <- c(args, args$splineomics) - args$splineomics <- NULL + args$splineomics <- NULL } - + self$args <- args }, - - + + #' Automatically Validate All Arguments #' - #' This method automatically validates all arguments by sequentially + #' This method automatically validates all arguments by sequentially #' calling - #' various validation methods defined within the class. Each validation + #' various validation methods defined within the class. Each validation #' method #' checks specific aspects of the input arguments and raises an error if the #' validation fails. @@ -60,7 +56,7 @@ InputControl <- R6::R6Class("InputControl", #' - \code{self$check_report()} #' - \code{self$check_feature_name_columns()} #' - #' @return NULL. The function is used for its side effects of validating + #' @return NULL. The function is used for its side effects of validating #' input #' arguments and raising errors if any validation fails. #' @@ -71,6 +67,7 @@ InputControl <- R6::R6Class("InputControl", self$check_datas_descr() self$check_top_tables() self$check_design_formula() + self$check_dream_params() self$check_mode() self$check_modes() self$check_designs_and_metas() @@ -88,22 +85,22 @@ InputControl <- R6::R6Class("InputControl", self$check_report() self$check_feature_name_columns() }, - + #' Check Data and Meta #' #' @description - #' This function checks the validity of the data and meta objects, + #' This function checks the validity of the data and meta objects, #' ensuring that - #' data is a matrix with numeric values and that meta is a dataframe + #' data is a matrix with numeric values and that meta is a dataframe #' containing - #' the specified condition column. Additionally, it verifies that the + #' the specified condition column. Additionally, it verifies that the #' number of - #' columns in the data matrix matches the number of rows in the meta + #' columns in the data matrix matches the number of rows in the meta #' dataframe. #' #' @param data A matrix containing numeric values. - #' @param meta A dataframe containing the metadata, including the 'Time' + #' @param meta A dataframe containing the metadata, including the 'Time' #' column #' and the specified condition column. #' @param condition A single character string specifying the column name in @@ -117,7 +114,6 @@ InputControl <- R6::R6Class("InputControl", #' error message if any check fails. #' check_data_and_meta = function() { - data <- self$args[["data"]] meta <- self$args[["meta"]] condition <- self$args[["condition"]] @@ -126,126 +122,130 @@ InputControl <- R6::R6Class("InputControl", data_meta_index <- self$args[["data_meta_index"]] required_args <- list(data, meta, condition) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + self$check_data( data, data_meta_index - ) - + ) + self$check_meta( meta = meta, condition = condition, meta_batch_column = meta_batch_column, meta_batch2_column = meta_batch2_column, data_meta_index = data_meta_index - ) - + ) + if (!(nrow(meta) == ncol(data))) { if (!is.null(data_meta_index)) { - stop(paste0("For index ", data_meta_index, - "data column number must be equal to ", - "meta row number"), - call. = FALSE) + stop( + paste0( + "For index ", data_meta_index, + "data column number must be equal to ", + "meta row number" + ), + call. = FALSE + ) } else { stop(paste0("data column number must be equal to meta row number"), - call. = FALSE) + call. = FALSE + ) } } }, - - + + #' Check Annotation Consistency #' #' @description - #' This method checks the consistency of the annotation with the data. + #' This method checks the consistency of the annotation with the data. #' It ensures - #' that the annotation is a dataframe and that it has the same number + #' that the annotation is a dataframe and that it has the same number #' of rows as the data. #' #' @details #' The method performs the following checks: - #' + #' #' * Ensures that both `annotation` and `data` are provided. #' * Confirms that `annotation` is a dataframe. #' * Verifies that `annotation` and `data` have the same number of rows. - #' + #' #' If any of these checks fail, an informative error message is returned. #' - #' @return NULL if any required arguments are missing. Otherwise, performs + #' @return NULL if any required arguments are missing. Otherwise, performs #' checks and potentially raises errors if checks fail. #' check_annotation = function() { - annotation <- self$args[["annotation"]] data <- self$args[["data"]] required_args <- list(annotation, data) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + if (!is.data.frame(annotation)) { stop( "annotation is not a dataframe but must be one!", call. = FALSE ) } - + if (nrow(annotation) != nrow(data)) { stop( "annotation and data don't have the same nr. of rows but must have!", call. = FALSE - ) + ) } }, - - + + #' Check Multiple Data and Meta Pairs #' #' @description - #' Iterates over multiple data and meta pairs to validate each pair using + #' Iterates over multiple data and meta pairs to validate each pair using #' the `check_data_and_meta` function. #' #' @param datas A list of matrices containing numeric values. #' @param metas A list of data frames containing metadata. - #' @param condition A character string specifying the column name in the + #' @param condition A character string specifying the column name in the #' meta dataframe to be checked. - #' @param meta_batch_column An optional parameter specifying the column name + #' @param meta_batch_column An optional parameter specifying the column name #' in the meta dataframe used to remove the batch effect. Default is NA. #' @param meta_batch2_column An optional parameter specifying the column - #' name - #' in the meta dataframe used to remove the second batch effect. Default + #' name + #' in the meta dataframe used to remove the second batch effect. Default #' is NA. #' #' @return NULL if any check fails, otherwise returns TRUE. #' check_datas_and_metas = function() { - datas <- self$args$datas metas <- self$args$metas condition <- self$args$condition meta_batch_column <- self$args$meta_batch_column meta_batch2_column <- self$args$meta_batch2_column - + required_args <- list(datas, metas, condition) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + if (length(datas) != length(metas)) { stop(paste0("datas and metas must have the same length."), - call. = FALSE) + call. = FALSE + ) } - + data_storage <- self$args$data meta_storage <- self$args$meta - + for (i in seq_along(datas)) { self$args$data <- datas[[i]] self$args$meta <- metas[[i]] @@ -253,22 +253,22 @@ InputControl <- R6::R6Class("InputControl", self$args$condition <- condition self$args$meta_batch_column <- meta_batch_column self$args$meta_batch2_column <- meta_batch2_column - + self$check_data_and_meta() } - + self$args$data <- data_storage self$args$meta <- meta_storage - + return(TRUE) }, - - + + #' Check Data Descriptions #' #' @description - #' Validates that the data descriptions are character vectors with each - #' element + #' Validates that the data descriptions are character vectors with each + #' element #' not exceeding 80 characters in length. #' #' @param datas_descr A character vector of data descriptions. @@ -277,22 +277,21 @@ InputControl <- R6::R6Class("InputControl", #' #' @seealso #' \code{\link{stop}} for error handling. - #' + #' check_datas_descr = function() { - datas_descr <- self$args$datas_descr - + required_args <- list(datas_descr) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + if (!is.character(datas_descr) || any(nchar(datas_descr) > 80)) { long_elements_indices <- which(nchar(datas_descr) > 80) long_elements <- datas_descr[long_elements_indices] error_message <- sprintf( - "'datas_descr' must be a character vector with no element over 80 + "'datas_descr' must be a character vector with no element over 80 characters. Offending element(s) at indices %s: '%s'. Please shorten the description.", paste(long_elements_indices, collapse = ", "), @@ -301,8 +300,8 @@ InputControl <- R6::R6Class("InputControl", stop(error_message) } }, - - + + #' Check Top Tables #' #' @description @@ -314,100 +313,107 @@ InputControl <- R6::R6Class("InputControl", #' @return No return value, called for side effects. #' check_top_tables = function() { - top_tables <- self$args$top_tables required_args <- list(top_tables) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + # Helper function to check data frames in a list check_list_of_dataframes <- function(df_list) { - - if (!is.list(df_list) || !all(sapply(df_list, is.data.frame))) { - - stop("Expected a list of dataframes", call. = FALSE) - + if (!is.list(df_list) || + !all(vapply(df_list, is.data.frame, logical(1)))) { + stop_call_false("Expected a list of dataframes") } else { - if (length(df_list) != 2) { - stop(paste("top_tables must be a list of two lists if you want", - "to cluster the hits of the limma results of", - "avrg_diff_conditions or interaction_condition_time.", - "The list must contain one of those two plus", - "the time_effect limma result, in any order"), - call. = FALSE) + stop_call_false(paste( + "top_tables must be a list of two lists if you want", + "to cluster the hits of the limma results of", + "avrg_diff_conditions or interaction_condition_time.", + "The list must contain one of those two plus", + "the time_effect limma result, in any order" + )) } - - underscore_count <- sapply(names(df_list), - function(name) sum(grepl("_", name))) + + underscore_count <- vapply( + names(df_list), + function(name) sum(grepl("_", name)), + integer(1) + ) if (sum(underscore_count == 1) != 1 || - sum(underscore_count == 4) != 1) { - stop(paste("top_tables must be a list of two lists if you want", - "to cluster the hits of the limma results of", - "avrg_diff_conditions or interaction_condition_time.", - "The list must contain one of those two plus", - "the time_effect limma result, in any order"), - call. = FALSE) + sum(underscore_count == 4) != 1) { + stop_call_false(paste( + "top_tables must be a list of two lists if you want", + "to cluster the hits of the limma results of", + "avrg_diff_conditions or interaction_condition_time.", + "The list must contain one of those two plus", + "the time_effect limma result, in any order" + )) } - + for (df in df_list) { self$check_dataframe(df) } } } - + # Check if top_tables is a list if (!is.list(top_tables)) { - stop("top_tables must be a list", call. = FALSE) + stop_call_false("top_tables must be a list") } - + for (i in seq_along(top_tables)) { - element <- top_tables[[i]] element_name <- names(top_tables)[i] - - # Means it is a list of lists (so the user wants to cluster the hits of - # avrg_diff_conditions or interaction_condition_time with the help of + + # Means it is a list of lists (so the user wants to cluster the hits of + # avrg_diff_conditions or interaction_condition_time with the help of # the spline coeffs in time_effect) if (!tibble::is_tibble(element) && is.list(element)) { - check_list_of_dataframes(element) - } else if (tibble::is_tibble(element)) { - matches <- gregexpr("_", element_name) - underscore_count <- sum(sapply(matches, - function(x) if (x[1] == -1) 0 else length(x))) - + underscore_count <- sum(vapply( + matches, + function(x) if (x[1] == -1) 0 else length(x), + integer(1) + )) + if (underscore_count != 1) { - stop(paste("Very likely you did not pass the time_effect result", - "of limma but rather one of avrg_diff_conditions or", - "interaction_condition_time, which cannot be passed alone", - "(to cluster the hits of one of those, put only one of them", - "at a time into a list with the time_effect result. Further", - "note: Please do not edit those list element names by hand."), - call. = FALSE) + stop( + paste( + "Very likely you did not pass the time_effect result", + "of limma but rather one of avrg_diff_conditions or", + "interaction_condition_time, which cannot be passed alone", + "(to cluster the hits of one of those, put only one of them", + "at a time into a list with the time_effect result. Further", + "note: Please do not edit those list element names by hand." + ), + call. = FALSE + ) } - + self$check_dataframe(element) - } else { - stop(paste("top_tables must contain either data frames or lists of", - "data frames"), - call. = FALSE) + stop( + paste( + "top_tables must contain either data frames or lists of", + "data frames" + ), + call. = FALSE + ) } } }, - + #' Check Design Formula #' #' @description #' Validates the design formula ensuring it is a valid character string, - #' contains allowed characters, includes the intercept term 'X', and + #' contains allowed characters, includes the intercept term 'X', and #' references #' columns present in the metadata. #' @@ -415,55 +421,57 @@ InputControl <- R6::R6Class("InputControl", #' @param meta A data frame containing metadata. #' @param meta_index An optional index for the data/meta pair. #' - #' @return TRUE if the design formula is valid, otherwise an error is + #' @return TRUE if the design formula is valid, otherwise an error is #' thrown. #' #' @seealso \code{\link[stats]{model.matrix}} #' check_design_formula = function() { - formula <- self$args[["design"]] meta <- self$args[["meta"]] meta_index <- self$args[["meta_index"]] - + # Not strictly required meta_batch_column <- self$args[["meta_batch_column"]] meta_batch2_column <- self$args[["meta_batch2_column"]] - + required_args <- list( formula, meta - ) - - if (any(sapply(required_args, is.null))) { + ) + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } # Check if the formula is a valid character string if (!is.character(formula) || length(formula) != 1) { stop("The design formula must be a valid character string.", - call. = FALSE) + call. = FALSE + ) } - + # Ensure the formula contains allowed characters only allowed_chars <- "^[~ 1A-Za-z0-9_+*:()-]*$" if (!grepl(allowed_chars, formula)) { stop("The design formula contains invalid characters.", - call. = FALSE) + call. = FALSE + ) } - + # Ensure that the formula begins with an intercept (~ 1) # Ignore whitespace, check the start of the string if (!grepl("^\\s*~\\s*1", formula)) { stop( paste( "The design formula must start with an intercept term '~ 1'.", - "This is because spline curves are plotted onto the data", + "This is because spline curves are plotted onto the data", "which is not possible without an intercept" - ), - call. = FALSE) + ), + call. = FALSE + ) } - + # Ensure the formula contains the intercept term 'X' if (!grepl("\\bX\\b", formula)) { stop_call_false( @@ -471,125 +479,210 @@ InputControl <- R6::R6Class("InputControl", "for the meta Time column" ) } - + # Extract terms from the formula (removing interactions and functions) formula_terms <- unlist(strsplit(gsub("[~+*:()]", " ", formula), " ")) formula_terms <- formula_terms[formula_terms != ""] - + # Remove '1' and 'X' from terms since they are not columns formula_terms <- setdiff(formula_terms, c("1", "X")) - + # Check if the terms are present in the dataframe missing_columns <- setdiff(formula_terms, names(meta)) if (length(missing_columns) > 0) { if (!is.null(meta_index)) { - stop_call_false(sprintf("%s (data/meta pair index: %s): %s", - "The following design columns are missing in meta", - meta_index, - paste(missing_columns, collapse = ", "))) - + stop_call_false(sprintf( + "%s (data/meta pair index: %s): %s", + "The following design columns are missing in meta", + meta_index, + paste(missing_columns, collapse = ", ") + )) } else { - stop_call_false(paste("The following design columns are missing in meta:", - paste(missing_columns, collapse = ", "))) + stop_call_false(paste( + "The following design columns are missing in meta:", + paste(missing_columns, collapse = ", ") + )) } } - + # Convert formula to string for regex checking formula_str <- as.character(formula) - + # Check if batch column is provided and validate its presence in the formula if (!is.null(meta_batch_column)) { if (!grepl(meta_batch_column, formula_str)) { stop_call_false( - paste("The batch effect column", meta_batch_column, - "is provided but not present in the design formula. ", - "Please ensure that if you specify a batch column, ", - "it is included in the design formula to", - "remove batch effects.") + paste( + "The batch effect column", meta_batch_column, + "is provided in the SplineOmics object as the field", + "meta_batch_column but not present in the design formula. ", + "Please ensure that if you specify a batch column, ", + "it is included in the design formula to", + "remove batch effects." + ) ) } } - + # Check if the second batch column is provided and validate its presence if (!is.null(meta_batch2_column)) { if (!grepl(meta_batch2_column, formula_str)) { stop_call_false( - paste("The second batch effect column", meta_batch2_column, - "is provided but not present in the design formula.", - "Please ensure that if you specify a second batch column,", - "it is included in the design formula", - "to remove batch effects.") + paste( + "The second batch effect column", meta_batch2_column, + "is provided but not present in the design formula.", + "Please ensure that if you specify a second batch column,", + "it is included in the design formula", + "to remove batch effects." + ) ) } } - + return(TRUE) }, + #' Validate the `dream_params` argument + #' + #' @description + #' This function checks the validity of the `dream_params` argument provided + #' in the class. If `dream_params` is present, it ensures that it contains + #' the required and optional elements in the correct format. + #' Specifically, `dream_params` must contain a named element + #' `random_effects`, + #' which is required and must be a string. It may also optionally contain + #' the + #' elements `dof`, which must be an integer greater than 1, and + #' `KenwardRoger`, + #' which must be a boolean. Unnamed elements or elements other than these + #' three are not allowed. + #' + #' @return + #' Returns `TRUE` if `dream_params` passes all checks. Otherwise, stops the + #' function and returns an error message using `stop_call_false`. + #' + check_dream_params = function() { + dream_params <- self$args[["dream_params"]] + + required_args <- list(dream_params) + + if (any(vapply(required_args, is.null, logical(1)))) { + return(NULL) + } + + # Check that dream_params is a named list + if (!is.list(dream_params) || is.null(names(dream_params))) { + stop_call_false("dream_params must be a named list.") + } + + # Define allowed elements and check for unexpected elements + allowed_elements <- c("random_effects", "dof", "KenwardRoger") + if (!all(names(dream_params) %in% allowed_elements)) { + stop_call_false( + "dream_params contains invalid elements. + Only 'random_effects', 'dof', and 'KenwardRoger' + are allowed." + ) + } + + # Check that random_effects is present and is a string + if (!"random_effects" %in% names(dream_params) + || !is.character(dream_params[["random_effects"]]) + || length(dream_params[["random_effects"]]) != 1) { + stop_call_false( + "'random_effects' must be a string and must be present in + dream_params." + ) + } + + # If 'dof' is provided, check that it is an integer greater than 1 + if ("dof" %in% names(dream_params)) { + if (!is.numeric(dream_params[["dof"]]) + || dream_params[["dof"]] <= 1 + || dream_params[["dof"]] != as.integer(dream_params[["dof"]])) { + stop_call_false("'dof' must be an integer greater than 1.") + } + } + + # If 'KenwardRoger' is provided, check that it is a boolean + if ("KenwardRoger" %in% names(dream_params)) { + if (!is.logical(dream_params[["KenwardRoger"]]) + || length(dream_params[["KenwardRoger"]]) != 1) { + stop_call_false("'KenwardRoger' must be a boolean.") + } + } + + # No unnamed elements should be present + if (any(names(dream_params) == "")) { + stop_call_false("Unnamed elements are not allowed in dream_params.") + } + + return(TRUE) + }, + + #' Validate and check all modes #' #' @description - #' This function iterates over the `modes` argument, sets each `mode` in - #' `self$args`, and calls `check_mode()` to validate each mode. After each + #' This function iterates over the `modes` argument, sets each `mode` in + #' `self$args`, and calls `check_mode()` to validate each mode. After each #' validation, the `mode` is removed from `self$args`. #' #' @return NULL if `modes` is missing; otherwise, checks all modes. #' check_modes = function() { - modes <- self$args[["modes"]] - + required_args <- list(modes) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + for (mode in modes) { self$args$mode <- mode self$check_mode() - + self$args$mode <- NULL } }, - - + + #' Check the mode argument for validity #' #' @description - #' This function checks if the `mode` argument is provided and validates - #' that it is either "isolated" or "integrated". If `mode` is missing or + #' This function checks if the `mode` argument is provided and validates + #' that it is either "isolated" or "integrated". If `mode` is missing or #' invalid, an error is thrown. #' #' @return NULL if `mode` is missing; otherwise, validates the mode. #' check_mode = function() { - mode <- self$args[["mode"]] - + required_args <- list(mode) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } if (mode != "isolated" && mode != "integrated") { stop_call_false( "mode must be either 'isolated' or 'integrated' and not '", mode, "'!" - ) + ) } }, - - + + #' Check Multiple Designs and Metas #' #' @description #' Iterates over multiple design formulas and corresponding metadata #' to validate each pair using the `check_design_formula` function. #' - #' @param designs A vector of character strings representing design + #' @param designs A vector of character strings representing design #' formulas. #' @param metas A list of data frames containing metadata. #' @param meta_indices A vector of optional indices for the data/meta pairs. @@ -597,27 +690,26 @@ InputControl <- R6::R6Class("InputControl", #' @return NULL if any check fails, otherwise returns TRUE. #' check_designs_and_metas = function() { - designs <- self$args$designs metas <- self$args$metas meta_indices <- self$args$meta_indices - + if (is.null(designs) || is.null(metas)) { return(NULL) } - + for (i in seq_along(designs)) { self$args$design <- designs[i] self$args$meta <- metas[[i]] - self$args$meta_index <- + self$args$meta_index <- ifelse(!is.null(meta_indices), meta_indices[i], NA) self$check_design_formula() } - + return(TRUE) }, - - + + #' Check Spline Parameters #' #' @description @@ -634,127 +726,130 @@ InputControl <- R6::R6Class("InputControl", #' called for side effects. #' check_spline_params = function() { - spline_params <- self$args$spline_params mode <- self$args[["mode"]] meta <- self$args$meta condition <- self$args$condition - + required_args <- list( spline_params, mode, meta, condition - ) - - if (any(sapply(required_args, is.null))) { + ) + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + self$check_spline_params_generally(spline_params) self$check_spline_params_mode_dependent( spline_params, mode, meta, condition - ) + ) }, - - + + #' Check Spline Test Configurations #' #' @describeIn InputControl - #' This method verifies the spline test configurations and associated + #' This method verifies the spline test configurations and associated #' metadata - #' within the object's arguments. It performs a series of checks on the - #' configurations, including column verification, spline type validation, - #' and ensuring that the degrees of freedom (dof) are within acceptable + #' within the object's arguments. It performs a series of checks on the + #' configurations, including column verification, spline type validation, + #' and ensuring that the degrees of freedom (dof) are within acceptable #' ranges. - #' + #' #' @param spline_test_configs A configuration object for spline tests. #' @param metas A list of metadata corresponding to the data matrices. - #' + #' #' @return Returns `NULL` if any required arguments are mising, otherwise, #' called for side effects. #' check_spline_test_configs = function() { - spline_test_configs <- self$args$spline_test_configs metas <- self$args$metas - + required_args <- list(spline_test_configs, metas) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } self$check_columns_spline_test_configs(spline_test_configs) - + self$check_spline_type_column(spline_test_configs) - + self$check_spline_type_params(spline_test_configs) - + self$check_max_and_min_dof( spline_test_configs, metas - ) + ) }, - - + + #' Check Limma Top Tables Structure #' - #' This function checks if the provided limma top tables data structure - #' is correctly formatted. It ensures that the data structure contains - #' exactly three named elements ('time_effect', 'avrg_diff_conditions', - #' and 'interaction_condition_time') and that each element contains + #' This function checks if the provided limma top tables data structure + #' is correctly formatted. It ensures that the data structure contains + #' exactly three named elements ('time_effect', 'avrg_diff_conditions', + #' and 'interaction_condition_time') and that each element contains #' dataframes with the correct columns and data types. #' #' @param self An object containing the data structure to check. #' - #' @return This function does not return a value. It stops execution + #' @return This function does not return a value. It stops execution #' if the data structure does not match the expected format. - #' + #' check_limma_top_tables = function() { - top_tables <- self$args$run_limma_splines_result - - required_names <- c("time_effect", - "avrg_diff_conditions", - "interaction_condition_time") - + + required_names <- c( + "time_effect", + "avrg_diff_conditions", + "interaction_condition_time" + ) + if (!all(names(top_tables) %in% required_names) || - length(top_tables) != 3) { - stop("The list must contain exactly three named elements: - 'time_effect', 'avrg_diff_conditions', + length(top_tables) != 3) { + stop("The list must contain exactly three named elements: + 'time_effect', 'avrg_diff_conditions', 'interaction_condition_time'", call. = FALSE) } - - expected_cols1_3 <- c("X1", "X2", "AveExpr", "F", "P.Value", "adj.P.Val", - "feature_nr", "feature_names", "intercept") - - expected_cols2 <- c("logFC", "AveExpr", "t", "P.Value", "adj.P.Val", - "B", "feature_nr", "feature_names", "intercept") - + + expected_cols1_3 <- c( + "X1", "X2", "AveExpr", "F", "P.Value", "adj.P.Val", + "feature_nr", "feature_names", "intercept" + ) + + expected_cols2 <- c( + "logFC", "AveExpr", "t", "P.Value", "adj.P.Val", + "B", "feature_nr", "feature_names", "intercept" + ) + for (df in top_tables$time_effect) { check_columns(df, expected_cols1_3) } - + for (df in top_tables$avrg_diff_conditions) { check_columns(df, expected_cols2) } - + for (df in top_tables$interaction_condition_time) { check_columns(df, expected_cols1_3) } }, - + #' Check Adjusted p-Thresholds #' #' @description #' This function checks the validity of the adjusted p-thresholds vector, #' ensuring that - #' all elements are numeric, greater than 0, and less than 1. If any of + #' all elements are numeric, greater than 0, and less than 1. If any of #' these #' conditions #' are not met, the function stops execution and returns an error message @@ -767,272 +862,271 @@ InputControl <- R6::R6Class("InputControl", #' error message if any check fails. #' check_adj_pthresholds = function() { - # Exploited argument slicing. adj_pthresholds <- self$args[["adj_pthresh"]] required_args <- list(adj_pthresholds) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + if (!is.numeric(adj_pthresholds)) { stop("'adj_pthresholds' must be a numeric vector.", - call. = FALSE) + call. = FALSE + ) } - + # Check for elements <= 0 if (any(adj_pthresholds <= 0)) { offending_elements <- which(adj_pthresholds <= 0) - stop(paste0("'adj_pthresholds' must have all elements > 0. ", - "Offending elements at indices: ", - paste(offending_elements, collapse = ", "), - ". Values: ", - paste(adj_pthresholds[offending_elements], collapse = ", "), - "."), - call. = FALSE) + stop( + paste0( + "'adj_pthresholds' must have all elements > 0. ", + "Offending elements at indices: ", + paste(offending_elements, collapse = ", "), + ". Values: ", + paste(adj_pthresholds[offending_elements], collapse = ", "), + "." + ), + call. = FALSE + ) } - + # Check for elements >= 1 if (any(adj_pthresholds >= 1)) { offending_elements <- which(adj_pthresholds >= 1) - stop(paste0("'adj_pthresholds' must have all elements < 1. ", - "Offending elements at indices: ", - paste(offending_elements, collapse = ", "), - ". Values: ", - paste(adj_pthresholds[offending_elements], collapse = ", "), - "."), - call. = FALSE) + stop( + paste0( + "'adj_pthresholds' must have all elements < 1. ", + "Offending elements at indices: ", + paste(offending_elements, collapse = ", "), + ". Values: ", + paste(adj_pthresholds[offending_elements], collapse = ", "), + "." + ), + call. = FALSE + ) } - + return(TRUE) }, - - + + #' Check adjusted p-value thresholds for limma category 2 and 3 #' #' @description - #' This function checks that both adjusted p-value thresholds for - #' average difference conditions and interaction condition time are + #' This function checks that both adjusted p-value thresholds for + #' average difference conditions and interaction condition time are #' non-null, floats, and in the range [0, 1]. #' - #' @return - #' `NULL` if either argument is `NULL` or invalid. + #' @return + #' `NULL` if either argument is `NULL` or invalid. #' Otherwise, no return value (assumed valid inputs). #' check_adj_pthresh_limma_category_2_3 = function() { - - adj_pthresh_avrg_diff_conditions <- + adj_pthresh_avrg_diff_conditions <- self$args[["adj_pthresh_avrg_diff_conditions"]] - - adj_pthresh_interaction_condition_time <- + + adj_pthresh_interaction_condition_time <- self$args[["adj_pthresh_interaction_condition_time"]] - + required_args <- list( adj_pthresh_avrg_diff_conditions, adj_pthresh_interaction_condition_time - ) - - if (any(sapply(required_args, is.null))) { + ) + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + # Check that both arguments are numeric and in the range [0, 1] - if (!all(sapply(required_args, function(arg) { + if (!all(vapply(required_args, function(arg) { is.numeric(arg) && arg >= 0 && arg <= 1 - }))) { + }, logical(1)))) { stop_call_false( - "Both adj_pthresh_avrg_diff_conditions and", - "adj_pthresh_interaction_condition_time must", + "Both adj_pthresh_avrg_diff_conditions and", + "adj_pthresh_interaction_condition_time must", "be floats between 0 and 1." - ) + ) } }, - - + + #' Check Clusters #' #' @description - #' This function verifies the cluster configurations within the object's + #' This function verifies the cluster configurations within the object's #' arguments. - #' It checks if the clusters argument is present and performs validation - #' on its - #' content. If no clusters are specified, it defaults to automatic cluster + #' It checks if the clusters argument is present and performs validation + #' on its + #' content. If no clusters are specified, it defaults to automatic cluster #' estimation. #' #' @details #' The function performs the following checks: - #' - If `clusters` is an integer or a vector of integers. Otherwise, it + #' - If `clusters` is an integer or a vector of integers. Otherwise, it #' gives an error. #' check_clusters = function() { - clusters <- self$args[["clusters"]] meta <- self$args[["meta"]] condition <- self$args[["condition"]] - + required_args <- list( clusters, meta, condition ) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + # Get the unique number of elements in the condition column unique_conditions <- unique(meta[[condition]]) num_unique_conditions <- length(unique_conditions) - + # Check if clusters is a single integer or a vector of integers if (is.numeric(clusters) && all(clusters == as.integer(clusters))) { - # Ensure clusters has as many elements as unique conditions if (length(clusters) != num_unique_conditions) { stop_call_false( - "The number of elements in 'clusters' must match the number", + "The number of elements in 'clusters' must match the number", "of unique elements in the '", condition, "' column of the meta dataframe ( There are", num_unique_conditions, "unique elements = levels)" ) } - + # If clusters is a single integer, ensure it is positive if (length(clusters) == 1 && clusters <= 0) { stop_call_false("clusters must be a positive integer.") } - + # If clusters is a vector of integers, ensure all are positive if (length(clusters) > 1 && any(clusters <= 0)) { stop_call_false("All elements in clusters must be positive integers.") } - } else { stop_call_false( "clusters must be a single integer or a vector of integers." - ) + ) } - }, - - + + #' Check Plot Info #' #' @description - #' This method checks the validity of the `plot_info` list. It ensures that - #' `y_axis_label` and `time_unit` meet the length constraints, - #' `treatment_labels` - #' is either `NA` or a character vector with elements meeting the length - #' constraint, - #' and `treatment_timepoints` is either `NA` or a numeric vector with the - #' same length + #' This method checks the validity of the `plot_info` list. It ensures that + #' `y_axis_label` and `time_unit` meet the length constraints, + #' `treatment_labels` + #' is either `NA` or a character vector with elements meeting the length + #' constraint, + #' and `treatment_timepoints` is either `NA` or a numeric vector with the + #' same length #' as `treatment_labels`. #' #' @details #' The method performs the following checks: - #' + #' #' * Ensures that `plot_info` is provided and not NULL. #' * Confirms that `y_axis_label` is a character vector with maximally 30 #' characters. - #' * Confirms that `time_unit` is a character vector with maximally 15 + #' * Confirms that `time_unit` is a character vector with maximally 15 #' characters. #' * Validates that `treatment_labels` is either `NA` or a character vector - #' with each + #' with each #' element being maximally 15 characters long. - #' * Validates that `treatment_timepoints` is either `NA` or a numeric - #' vector with the + #' * Validates that `treatment_timepoints` is either `NA` or a numeric + #' vector with the #' same length as `treatment_labels` if `treatment_labels` is not `NA`. #' #' If any of these checks fail, an informative error message is returned. #' - #' @return NULL if `plot_info` is not provided or invalid. Otherwise, + #' @return NULL if `plot_info` is not provided or invalid. Otherwise, #' performs checks #' and potentially raises errors if checks fail. #' check_plot_info = function() { - plot_info <- self$args$plot_info meta <- self$args$meta - condition_column <- self$args[["condition"]] - + condition_column <- self$args[["condition"]] + required_args <- list( plot_info, meta, condition_column ) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + # Check y_axis_label if (!is.character(plot_info$y_axis_label) || - nchar(plot_info$y_axis_label) > 40) { + nchar(plot_info$y_axis_label) > 40) { stop( "y_axis_label must be a string with maximally 40 characters", call. = FALSE ) } - + # Check time_unit if (!is.character(plot_info$time_unit) || - nchar(plot_info$time_unit) > 15) { + nchar(plot_info$time_unit) > 15) { stop( "time_unit must be a string with maximally 15 characters", call. = FALSE ) } - + # Ensure treatment_labels and treatment_timepoints are lists - if (!is.list(plot_info$treatment_labels) || - !is.list(plot_info$treatment_timepoints)) { + if (!is.list(plot_info$treatment_labels) || + !is.list(plot_info$treatment_timepoints)) { stop( "treatment_labels and treatment_timepoints must be lists", call. = FALSE ) } - + # Check if the lists are named or not label_names <- names(plot_info$treatment_labels) timepoint_names <- names(plot_info$treatment_timepoints) - + if (!is.null(label_names) || !is.null(timepoint_names)) { - # If one has names, both must have names if (is.null(label_names) || is.null(timepoint_names)) { stop( - "Both treatment_labels and treatment_timepoints must + "Both treatment_labels and treatment_timepoints must be either fully named or not named", call. = FALSE ) } - + # Check if the names are present in the condition column of meta if (!all(label_names %in% meta[[condition_column]]) || - !all(timepoint_names %in% meta[[condition_column]])) { + !all(timepoint_names %in% meta[[condition_column]])) { stop( "All names in treatment_labels and treatment_timepoints must be present in the condition column of the meta data", call. = FALSE ) } - + # Ensure that both lists have the same names if (!identical(label_names, timepoint_names)) { stop( - "treatment_labels and treatment_timepoints must have + "treatment_labels and treatment_timepoints must have identical names", call. = FALSE ) } - } else { - # If unnamed, ensure there's only one element - if (length(plot_info$treatment_labels) != 1 - || length(plot_info$treatment_timepoints) != 1) { + if (length(plot_info$treatment_labels) != 1 || + length(plot_info$treatment_timepoints) != 1) { stop( "If treatment_labels and treatment_timepoints are unnamed, they must contain only a single element", @@ -1053,7 +1147,7 @@ InputControl <- R6::R6Class("InputControl", } } } - + # Check elements of treatment_timepoints for (timepoint in plot_info$treatment_timepoints) { if (!any(!is.na(timepoint))) { @@ -1065,20 +1159,20 @@ InputControl <- R6::R6Class("InputControl", } } } - + # Ensure that the lengths match if both are non-NA - if (!any(is.na(plot_info$treatment_labels)) - && !any(is.na(plot_info$treatment_timepoints))) { - if (length(plot_info$treatment_labels) - != length(plot_info$treatment_timepoints)) { + if (!any(is.na(plot_info$treatment_labels)) && + !any(is.na(plot_info$treatment_timepoints))) { + if (length(plot_info$treatment_labels) + != length(plot_info$treatment_timepoints)) { stop( - "treatment_labels and treatment_timepoints must have the + "treatment_labels and treatment_timepoints must have the same number of elements", call. = FALSE ) } } - + # Ensure treatment_timepoints are within valid range max_time <- max(meta$Time, na.rm = TRUE) for (timepoint in plot_info$treatment_timepoints) { @@ -1087,67 +1181,68 @@ InputControl <- R6::R6Class("InputControl", paste( "All treatment_timepoints must be before the last timepoint:", max_time - ), + ), call. = FALSE ) } } }, - - + + #' Check plot options #' #' @description - #' This method checks if the `plot_options` list contains the required - #' elements - #' `meta_replicate_column` and `cluster_heatmap_columns`. It validates that - #' `cluster_heatmap_columns` is either TRUE or FALSE, and that + #' This method checks if the `plot_options` list contains the required + #' elements + #' `meta_replicate_column` and `cluster_heatmap_columns`. It validates that + #' `cluster_heatmap_columns` is either TRUE or FALSE, and that #' `meta_replicate_column` is a valid column name in the `meta` dataframe. #' If the checks fail, the script stops with an error message. #' check_plot_options = function() { - plot_options <- self$args[["plot_options"]] meta <- self$args[["meta"]] - + required_args <- list( plot_options, meta ) - + # Check if any required arguments are NULL - if (any(sapply(required_args, is.null))) { + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + # Ensure at least one of the required elements is present in plot_options if (!any(c("meta_replicate_column", "cluster_heatmap_columns") %in% names(plot_options))) { stop_call_false("At least one of 'meta_replicate_column' or 'cluster_heatmap_columns' must be present in plot_options") } - + # Check if meta_replicate_column is present, and if so, validate it if ("meta_replicate_column" %in% names(plot_options)) { - if (!is.character(plot_options[["meta_replicate_column"]]) || - length(plot_options[["meta_replicate_column"]]) != 1) { + if (!is.character(plot_options[["meta_replicate_column"]]) || + length(plot_options[["meta_replicate_column"]]) != 1) { stop_call_false("'meta_replicate_column' must be a single string") } - + if (!plot_options[["meta_replicate_column"]] %in% colnames(meta)) { - stop_call_false("The value of 'meta_replicate_column' does not exist in", - "the meta dataframe") + stop_call_false( + "The value of 'meta_replicate_column' does not exist in", + "the meta dataframe" + ) } } - + # Check if cluster_heatmap_columns is present, and if so, validate it if ("cluster_heatmap_columns" %in% names(plot_options)) { - if (!is.logical(plot_options[["cluster_heatmap_columns"]]) || - length(plot_options[["cluster_heatmap_columns"]]) != 1) { + if (!is.logical(plot_options[["cluster_heatmap_columns"]]) || + length(plot_options[["cluster_heatmap_columns"]]) != 1) { stop_call_false("'cluster_heatmap_columns' must be TRUE or FALSE") } } }, - - + + #' Check and Create Report Directory #' #' @description @@ -1156,7 +1251,7 @@ InputControl <- R6::R6Class("InputControl", #' If the directory does not exist, it attempts to create it. If there are #' any #' warnings or - #' errors during directory creation, the function stops execution and + #' errors during directory creation, the function stops execution and #' returns #' an error message. #' @@ -1169,97 +1264,105 @@ InputControl <- R6::R6Class("InputControl", #' valid. #' check_report_dir = function() { - report_dir <- self$args[["report_dir"]] - + if (is.null(report_dir)) { # some functions just have a different name. - report_dir <- self$args$output_dir + report_dir <- self$args$output_dir } - + required_args <- list(report_dir) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + # Attempt to create the directory if it does not exist if (!file.exists(report_dir)) { - tryCatch({ - dir.create(report_dir, recursive = TRUE) - }, warning = function(w) { - stop_call_false( - sprintf("Warning occurred while creating the directory: %s", - w$message) + tryCatch( + { + dir.create(report_dir, recursive = TRUE) + }, + warning = function(w) { + stop_call_false( + sprintf( + "Warning occurred while creating the directory: %s", + w$message + ) ) - }, error = function(e) { - stop_call_false( - sprintf("Error occurred while creating the directory: %s", - e$message) + }, + error = function(e) { + stop_call_false( + sprintf( + "Error occurred while creating the directory: %s", + e$message + ) ) - }) + } + ) } - + # Verify that the directory exists and is a directory if (!file.exists(report_dir) || !file.info(report_dir)$isdir) { stop_call_false( - sprintf("The specified path is not a valid directory: %s", - report_dir) + sprintf( + "The specified path is not a valid directory: %s", + report_dir ) + ) } - + return(TRUE) }, - - + + #' Check Genes Validity #' #' @description - #' This function checks the validity of the `data` and `genes` arguments - #' within the `self$args` list. It ensures that `genes` is a character - #' vector, - #' that neither `data` nor `genes` is `NULL`, and that the length of `genes` + #' This function checks the validity of the `data` and `genes` arguments + #' within the `self$args` list. It ensures that `genes` is a character + #' vector, + #' that neither `data` nor `genes` is `NULL`, and that the length of `genes` #' matches the number of rows in `data`. #' - #' @return Returns `TRUE` if all checks pass. Returns `NULL` if any required - #' arguments are `NULL`. Throws an error if `genes` is not a character - #' vector + #' @return Returns `TRUE` if all checks pass. Returns `NULL` if any required + #' arguments are `NULL`. Throws an error if `genes` is not a character + #' vector #' or if the length of `genes` does not match the number of rows in `data`. - #' + #' check_genes = function() { - data <- self$args$data genes <- self$args$genes required_args <- list(data, genes) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + if (!is.character(genes)) { stop(paste0("genes must be a character vector"), call. = FALSE) } - + if (length(genes) != nrow(data)) { stop(paste0("length(genes) must be equal to nrow(data)"), call. = FALSE) } }, - - + + #' Check p-Adjustment Method #' #' @description - #' This function checks if the provided p-adjustment method is valid. The + #' This function checks if the provided p-adjustment method is valid. The #' valid #' methods are: - #' "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", and + #' "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", and #' "none". #' If the method #' is not one of these, the function stops execution and returns an error #' message. #' - #' @param padjust_method A character string specifying the p-adjustment + #' @param padjust_method A character string specifying the p-adjustment #' method. #' Valid options #' are "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", and @@ -1270,30 +1373,33 @@ InputControl <- R6::R6Class("InputControl", #' returns an error message if the method is invalid. #' check_padjust_method = function() { - padjust_method <- self$args$padjust_method - + required_args <- list(padjust_method) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + supported_methods <- stats::p.adjust.methods if (!(is.character(padjust_method) && - padjust_method %in% supported_methods)) { - stop(sprintf(paste("padjust_method must be a character and one of the", - "supported methods (%s).", - paste(supported_methods, collapse = ", "))), - call. = FALSE) + padjust_method %in% supported_methods)) { + stop( + sprintf(paste( + "padjust_method must be a character and one of the", + "supported methods (%s).", + paste(supported_methods, collapse = ", ") + )), + call. = FALSE + ) } }, - - + + #' Check Report Information #' #' @description - #' Validates the report information to ensure it contains all mandatory + #' Validates the report information to ensure it contains all mandatory #' fields #' and adheres to the required formats. #' @@ -1303,15 +1409,14 @@ InputControl <- R6::R6Class("InputControl", #' thrown. #' check_report_info = function() { - report_info <- self$args[["report_info"]] - + required_args <- list(report_info) - - if (any(sapply(required_args, is.null))) { + + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } - + mandatory_fields <- c( "omics_data_type", "data_description", @@ -1319,93 +1424,101 @@ InputControl <- R6::R6Class("InputControl", "analyst_name", "contact_info", "project_name" - ) - + ) + all_fields <- c( mandatory_fields, "method_description", "results_summary", "conclusions" - ) - + ) + # Check if report_info is a named list if (!is.list(report_info) || is.null(names(report_info))) { - stop("report_info must be a named list.", - call. = FALSE) + stop_call_false("report_info must be a named list.") } - + # Check if all values in report_info are strings - non_string_fields <- sapply(report_info, function(x) !is.character(x)) + non_string_fields <- vapply( + report_info, + function(x) !is.character(x), + logical(1) + ) + if (any(non_string_fields)) { invalid_fields <- names(report_info)[non_string_fields] - stop(paste("The following fields in report_info must be strings:", - paste(invalid_fields, collapse = ", ")), - call. = FALSE) + stop_call_false(paste( + "The following fields in report_info must be strings:", + paste(invalid_fields, collapse = ", ") + )) } - + # Check if all mandatory fields are present missing_fields <- setdiff(mandatory_fields, names(report_info)) if (length(missing_fields) > 0) { - stop(paste("Missing mandatory fields in report_info:", - paste(missing_fields, collapse = ", ")), - call. = FALSE) + stop_call_false(paste( + "Missing mandatory fields in report_info:", + paste(missing_fields, collapse = ", ") + )) } - + # Check if there are any extra fields not in all_fields extra_fields <- setdiff(names(report_info), all_fields) if (length(extra_fields) > 0) { - stop(paste("The following fields in report_info are not recognized:", - paste(extra_fields, collapse = ", ")), - call. = FALSE) + stop_call_false(paste( + "The following fields in report_info are not recognized:", + paste(extra_fields, collapse = ", ") + )) } - + # Check omics_data_type format if (!grepl("^[a-zA-Z_]+$", report_info[["omics_data_type"]])) { - stop(paste("The 'omics_data_type' field must contain only alphabetic", - "letters and underscores."), - call. = FALSE) + stop_call_false(paste( + "The 'omics_data_type' field must contain only alphabetic", + "letters and underscores." + )) } - + excluded_fields <- c( "data_description", "method_description", "results summary", "conclusions" - ) - excluded_limit <- 700 - + ) + excluded_limit <- 700 + check_long_fields <- function(data, excluded_fields, excluded_limit) { - - long_fields <- sapply(data, function(x) { + long_fields <- vapply(data, function(x) { if (any(names(data) %in% excluded_fields)) { any(nchar(x) > excluded_limit) } else { any(nchar(x) > 70) } - }) + }, logical(1)) return(long_fields) } - + # Check if any field exceeds 70 characters long_fields <- check_long_fields( - report_info, - excluded_fields, + report_info, + excluded_fields, excluded_limit - ) - + ) + if (any(long_fields)) { too_long_fields <- names(report_info)[long_fields] stop(paste("The following fields have strings exceeding 70 characters:", - paste(too_long_fields, collapse = ", "), - sep = "\n"), call. = FALSE) + paste(too_long_fields, collapse = ", "), + sep = "\n" + ), call. = FALSE) } - + return(TRUE) }, - - + + #' Check Feature Name Columns #' #' @description @@ -1431,44 +1544,43 @@ InputControl <- R6::R6Class("InputControl", #' names in the `annotation` data frame. #' check_feature_name_columns = function() { - feature_name_columns <- self$args[["feature_name_columns"]] annotation <- self$args[["annotation"]] required_args <- list( feature_name_columns, annotation - ) + ) - if (any(sapply(required_args, is.null))) { + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } # Check if every element in feature_name_columns is a character # of length 1 - if ( - !all( - sapply( - feature_name_columns, - function(x) is.character(x) && length(x) == 1) - ) - ) { - stop( - paste("All elements of feature_name_columns must be characters", - "with length 1."), - call. = FALSE + if (!all(vapply( + feature_name_columns, + function(x) is.character(x) && length(x) == 1, + logical(1) + )) + ) { + stop_call_false( + paste( + "All elements of feature_name_columns must be characters", + "with length 1." ) + ) } # Check if all elements of feature_name_columns are column names # in annotation if (!all(feature_name_columns %in% colnames(annotation))) { - stop( + stop_call_false( paste( "All elements of feature_name_columns must be column names", - "in annotation."), - call. = FALSE + "in annotation." ) + ) } }, @@ -1488,12 +1600,11 @@ InputControl <- R6::R6Class("InputControl", #' an error. #' check_report = function() { - report <- self$args[["report"]] required_args <- list(report) - if (any(sapply(required_args, is.null))) { + if (any(vapply(required_args, is.null, logical(1)))) { return(NULL) } @@ -1517,956 +1628,1005 @@ InputControl <- R6::R6Class("InputControl", #' @seealso \code{\link{InputControl}} #' Level2Functions <- R6::R6Class("Level2Functions", - inherit = Level3Functions, - - public = list( - - #' Check Data Matrix - #' - #' @description - #' This function checks the validity of the data matrix, ensuring that it - #' is a - #' matrix, contains only numeric values, - #' has no missing values, and all elements are non-negative. Additionally, it - #' verifies that no rows or columns are - #' entirely zeros. - #' - #' @param data A dataframe containing numeric values. - #' @param data_meta_index An optional parameter specifying the index of the - #' data - #' for error messages. Default is NA. - #' - #' @return Returns TRUE if all checks pass. Stops execution and returns an - #' error - #' message if any check fails. - #' - check_data = function( - data, - data_meta_index = NULL - ) { - - if (!is.matrix(data) || !is.numeric(data)) { - stop( - self$create_error_message( - "data must be a numeric matrix.", - data_meta_index - ), - call. = FALSE - ) - } - - # Check for missing values - if (any(is.na(data))) { - stop(self$create_error_message( - "data must not contain missing values.", - data_meta_index - ), - call. = FALSE) - } - - # Check for non-negative values - if (any(data < 0)) { - stop( - self$create_error_message( - paste( - "All elements of data must be non-negative. The elements should", - "represent concentrations, abundances, or", - "intensities (which are inherently non-negative)." - ), - data_meta_index), - call. = FALSE) - } - - # Check for rows with all zeros - if (any(rowSums(data) == 0)) { - stop( - self$create_error_message( - "data must not contain rows with all zeros!", - data_meta_index), - call. = FALSE) - } - - # Check for columns with all zeros - if (any(colSums(data) == 0)) { - stop(self$create_error_message(paste( - "data must not contain columns with all zeros!"), - data_meta_index), - call. = FALSE) - } - - # Check if row headers (rownames) are present and non-null - row_headers <- rownames(data) - if (is.null(row_headers)) { - stop(self$create_error_message( - "The data matrix must have row headers!", - data_meta_index), - call. = FALSE) - } - - return(TRUE) - }, - - - #' Check Metadata - #' - #' @description - #' This function checks the validity of the metadata dataframe, ensuring it - #' contains the 'Time' column, - #' does not contain missing values, and that the specified condition column - #' is - #' valid and of the appropriate type. - #' Additionally, it checks for an optional batch effect column and prints - #' messages regarding its use. - #' - #' @param meta A dataframe containing the metadata, including the 'Time' - #' column. - #' @param condition A single character string specifying the column name - #' in the - #' meta dataframe to be checked. - #' @param meta_batch_column An optional parameter specifying the column - #' name in - #' the meta dataframe used to remove the batch effect. Default is NA. - #' @param meta_batch2_column An optional parameter specifying the column - #' name in - #' the meta dataframe used to remove the batch effect. Default is NA. - #' @param data_meta_index An optional parameter specifying the index of the - #' data/meta pair for error messages. Default is NA. - #' - #' @return Returns TRUE if all checks pass. Stops execution and returns an - #' error message if any check fails. - #' - check_meta = function( - meta, - condition, - meta_batch_column = NULL, - meta_batch2_column = NULL, - data_meta_index = NULL - ) { - - if (!is.data.frame(meta) || - !"Time" %in% names(meta) || - !is.numeric(meta[["Time"]])) { - stop(self$create_error_message( - paste("meta must be a dataframe with the numeric column Time"), - data_meta_index - ), - call. = FALSE) - } - - if (any(is.na(meta))) { - stop(self$create_error_message( - "meta must not contain missing values.", - data_meta_index - ), - call. = FALSE) - } - - # Check if condition is a single character - if (!is.character(condition) || length(condition) != 1) { - stop("'condition' must be a single character", - call. = FALSE) - } - - # Check if condition is a column in the meta dataframe - if (!condition %in% colnames(meta)) { - stop(self$create_error_message( - sprintf( - "The condition '%s' is not a %s", - condition, - paste("column in meta") - ), - data_meta_index), call. = FALSE) - } - - # Check if the factor column is of appropriate type - if (!is.factor(meta[[condition]]) && - !is.character(meta[[condition]])) { - stop(self$create_error_message( - sprintf("The factor column '%s' must be of type - factor or character.", condition), - data_meta_index), - call. = FALSE) - } - - # Check condition and time pattern consistency - self$check_condition_time_consistency(meta, condition) - - if (!is.character(meta_batch2_column)) { - meta_batch2_column <- NULL - } - - if (is.null(meta_batch_column) && !is.null(meta_batch2_column)) { - stop(paste("For removing the batch effect, batch2 can only be used when", - "batch is used!"), call. = FALSE) - } - - if (!is.null(meta_batch_column)) { - if (is.character(meta_batch_column)) { - - if (meta_batch_column == "Time" || meta_batch_column == condition) { - stop(paste("meta_batch_column must not be == 'Time' or", condition), - call. = FALSE) - } - - self$check_batch_column( - meta, - meta_batch_column, - data_meta_index - ) - } else { - stop( - "meta_batch_column must be a character", - call. = FALSE - ) - } - } - - if (!is.null(meta_batch2_column)) { - if (is.character(meta_batch2_column)) { - - if (meta_batch2_column == "Time" || meta_batch2_column == condition) { - stop(paste("meta_batch2_column must not be == 'Time' or", condition), - call. = FALSE) - } - - if (meta_batch_column == meta_batch2_column) { - stop(paste("meta_batch_column must not be equal to", - "meta_batch2_column"), - call. = FALSE) - } - - self$check_batch_column(meta, - meta_batch2_column, - data_meta_index) - } else { - stop( - "meta_batch2_column must be a character", - call. = FALSE - ) - } - } - - return(TRUE) - }, - - - #' Check Dataframe - #' - #' @description - #' Validates that the dataframe contains all required columns with the - #' correct data types. - #' - #' @param df A dataframe to check. - #' - #' @return TRUE if the dataframe is valid, otherwise an error is thrown. - #' - check_dataframe = function(df) { - - # Define the required columns and their expected types - required_columns <- list( - AveExpr = "numeric", - P.Value = "numeric", - adj.P.Val = "numeric", - feature_nr = "integer", - feature_names = "character", - intercept = "numeric" - ) - - # Check if all required columns are present - missing_columns <- setdiff(names(required_columns), names(df)) - if (length(missing_columns) > 0) { - stop(paste("Missing columns in top_table:", - paste(missing_columns, collapse = ", ")), - call. = FALSE) - } - - # Check if columns have the correct type - for (col in names(required_columns)) { - if (!inherits(df[[col]], required_columns[[col]])) { - stop(paste("top_table column", col, "must be of type", - required_columns[[col]]), - call. = FALSE) - } - } - - return(TRUE) - }, - - - #' Check Spline Parameters Generally - #' - #' @description - #' Validates the general structure and contents of spline parameters. - #' - #' @param spline_params A list of spline parameters. - #' - #' @return No return value, called for side effects. - #' - check_spline_params_generally = function(spline_params) { - - allowed_fields <- c("spline_type", "degree", "dof") - - if (!all(names(spline_params) %in% allowed_fields)) { - stop( - paste( - "spline_params contains invalid fields. Only 'spline_type',", - "'degree', and 'dof' are allowed." - ), call. = FALSE - ) - } - - # Check if spline_type exists and contains valid values - if ("spline_type" %in% names(spline_params)) { - if (!all(spline_params$spline_type %in% c("b", "n"))) { - stop( - paste( - "Elements of spline_type must be either 'b' for B-splines", - "or 'n' for natural cubic splines."), - call. = FALSE - ) - } - } else { - stop("spline_type is missing in spline_params.", call. = FALSE) - } - - # Check if degree exists and is an integer vector for B-splines, - # and NA for natural splines - if ("degree" %in% names(spline_params)) { - for (i in seq_along(spline_params$spline_type)) { - if (spline_params$spline_type[i] == "b" && - (!is.integer(spline_params$degree[i]) - || is.na(spline_params$degree[i]))) { - stop( - paste( - "Degree must be specified as an integer for", - "B-splines in spline_params." - ), - call. = FALSE) - } - if (spline_params$spline_type[i] == "n" - && !is.na(spline_params$degree[i])) { - stop( - paste( - "Degree must be NA for natural cubic", - "splines in spline_params." - ), - call. = FALSE) - } - } - } else if (all(spline_params$spline_type == 'b')) { - stop("degree is missing in spline_params.", call. = FALSE) - } - - # Check if dof exists and is an integer vector - if ("dof" %in% names(spline_params)) { - if (!all(spline_params$dof == as.integer(spline_params$dof))) { - stop("dof must be an integer vector in spline_params.", call. = FALSE) - } - # Check for B-splines that dof is greater than 2 - for (i in seq_along(spline_params$spline_type)) { - if (spline_params$spline_type[i] == "b" - && spline_params$dof[i] < 3) { - stop( - paste("B-splines require DoF > 2 for spline_type at index", i), - call. = FALSE - ) - } - } - } else { - stop("dof is missing in spline_params.", call. = FALSE) - } - }, - - - #' Check Spline Parameters Mode Dependent - #' - #' @description - #' Validates the spline parameters depending on the specified mode. - #' - #' @param spline_params A list of spline parameters. - #' @param mode A character string specifying the mode - #' ('integrated' or 'isolated'). - #' @param meta A dataframe containing metadata. - #' @param condition A character string specifying the condition. - #' - #' @return No return value, called for side effects. - #' - check_spline_params_mode_dependent = function( - spline_params, - mode, - meta, - condition - ) { - if (mode == "integrated") { - # Check that all parameters in spline_params have exactly - # one "logical" element - if (any(sapply(spline_params, function(x) { - # Atomic vectors (like numeric or character vectors) - # should count as 1 element - !is.atomic(x) && length(x) != 1 - }))) { - stop(paste( - "All parameters in spline_params must have exactly one element", - "when mode is 'integrated'.", - "Different spline parameters for the different levels is not", - "supported for this mode." - ), call. = FALSE) - } - - # # Additional check for 'knots' and 'bknots' if they exist - # if ("knots" %in% names(spline_params)) { - # # Check if 'knots' is atomic (i.e., treat vectors as a single unit) or NA - # if (!(is.atomic(spline_params$knots) || all(is.na(spline_params$knots)))) { - # stop( - # paste( - # "All elements in 'knots' in spline_params must be atomic", - # "or NA when mode is 'integrated'.", - # "Different spline parameters for different levels are not", - # "supported for this mode." - # ), - # call. = FALSE - # ) - # } - # } - # - # if ("bknots" %in% names(spline_params)) { - # # Check if 'bknots' is atomic (i.e., treat vectors as a single unit) or NA - # if (!(is.atomic(spline_params$bknots) || - # all(is.na(spline_params$bknots)))) { - # stop( - # paste( - # "All elements in 'bknots' in spline_params must be atomic or", - # "NA when mode is 'integrated'.", - # "Different spline parameters for different levels are not", - # "supported for this mode." - # ), - # call. = FALSE - # ) - # } - # } - - - } else if (mode == "isolated") { - num_levels <- length(unique(meta[[condition]])) - if (any(sapply(spline_params, length) != num_levels)) { - stop(paste( - "Each vector or list in spline_params must have as many", - "elements as there are unique elements in the ", condition, - "column of meta when mode is 'isolated'." - ), - call. = FALSE) - } - # if ("knots" %in% names(spline_params)) { - # if (length(spline_params$knots) != num_levels) { - # stop( - # paste("'knots' in spline_params must have the same number of", - # "elements as there are unique elements in the ", condition, - # "column of meta when mode is 'isolated'."), - # call. = FALSE) - # } - # } - # if ("bknots" %in% names(spline_params)) { - # if (length(spline_params$bknots) != num_levels) { - # stop( - # paste("'bknots' in spline_params must have the same number of", - # "elements as there are unique elements in the ", condition, - # "column of meta when mode is 'isolated'."), - # call. = FALSE) - # } - # } - } - }, - - - #' Check Columns in Spline Test Configurations - #' - #' @description - #' Validates that the spline test configurations contain the required columns - #' in the correct order. - #' - #' @param spline_test_configs A dataframe containing spline test - #' configurations. - #' - #' @return No return value, called for side effects. - #' - #' @keywords internal - #' - check_columns_spline_test_configs = function(spline_test_configs) { - - required_columns <- c( - "spline_type", - "degree", - "dof" - # "knots", - # "bknots" - ) - - # Check for exact match of column names and order - if (!identical(names(spline_test_configs), required_columns)) { - # Find the missing or extra columns - missing_columns <- setdiff(required_columns, names(spline_test_configs)) - extra_columns <- setdiff(names(spline_test_configs), required_columns) - error_message <- "Error: Incorrect columns in dataframe. " - - # Append specific issues to the error message - if (length(missing_columns) > 0) { - error_message <- paste0(error_message, "Missing columns: ", - paste(missing_columns, collapse = ", "), ". ") - } - if (length(extra_columns) > 0) { - error_message <- paste0(error_message, "Extra columns: ", - paste(extra_columns, collapse = ", "), ". ") - } - error_message <- paste0(error_message, - "Expected columns in order: ", - paste(required_columns, collapse = ", "), ".") - - stop(error_message) - } - }, - - - #' Check Spline Type Column - #' - #' @description - #' Validates that the 'spline_type' column in the spline test configurations - #' contains only 'n' or 'b'. - #' - #' @param spline_test_configs A dataframe containing spline test - #' configurations. - #' - #' @return No return value, called for side effects. - #' - #' @keywords internal - #' - check_spline_type_column = function(spline_test_configs) { - - if (!all(spline_test_configs$spline_type %in% c("n", "b"))) { - # Identify invalid entries - invalid_entries <- spline_test_configs$spline_type[ - !spline_test_configs$spline_type %in% c("n", "b") - ] - error_message <- sprintf( - "Error: 'spline_type' contains invalid entries. - Only 'n' or 'b' are allowed. Invalid entries found: %s", - paste(unique(invalid_entries), collapse=", ") - ) - - stop(error_message) - } - }, - - - #' Check Spline Type Parameters - #' - #' @description - #' Validates the parameters for each row in the spline test configurations - #' based on the spline type. - #' - #' @param spline_test_configs A dataframe containing spline test - #' configurations. - #' - #' @return TRUE if all checks pass, otherwise an error is thrown. - #' - #' @keywords internal - #' - check_spline_type_params = function(spline_test_configs) { - - for (i in seq_len(nrow(spline_test_configs))) { - row <- spline_test_configs[i,] - switch(as.character(row$spline_type), - "n" = { - if (!is.na(row$degree)) - stop("degree must be NA for spline_type n") - - # if (!((is.na(row$dof) && !is.na(row$knots)) || - # (!is.na(row$dof) && is.na(row$knots)))) { - # stop("Either dof or knots must be NA, but not both, for - # spline_type n") - # } - - if (!is.integer(row$dof)) { - stop("dof must be an integer when it is not NA for - spline_type n") - } - - # if (!is.na(row$knots) && !is.numeric(row$knots)) { - # stop("knots must be a numeric vector when it is not NA for - # spline_type n") - # } - # if (!is.na(row$bknots) && (!is.numeric(row$bknots) || - # length(row$bknots) != 2)) { - # stop("bknots must be a numeric vector of exactly two elements - # or NA for spline_type n") - # } - }, - "b" = { - if (!is.integer(row$degree)) stop("degree must be an integer for - spline_type b") - if (!is.na(row$dof) && (!is.integer(row$dof) || - row$dof < row$degree)) { - stop("dof must be an integer at least as big as degree for - spline_type b") - } - - # if (!is.na(row$knots) && !is.numeric(row$knots)) { - # stop("knots must be a numeric vector when it is not NA for - # spline_type b") - # } - # if (!is.na(row$bknots) && (!is.numeric(row$bknots) || - # length(row$bknots) != 2)) { - # stop("bknots must be a numeric vector of exactly two elements - # or NA for spline_type b") - # } - }, - stop("spline_type must be either 'n' or 'b'") - ) - } - return(TRUE) - }, - - - #' Check Maximum and Minimum Degrees of Freedom - #' - #' @description - #' Validates the degrees of freedom (DoF) for each row in the spline test - #' configurations based on the metadata. - #' - #' @param spline_test_configs A dataframe containing spline test - #' configurations. - #' @param metas A list of metadata corresponding to the data matrices. - #' - #' @return No return value, called for side effects. - #' - #' @keywords internal - #' - check_max_and_min_dof = function( - spline_test_configs, - metas - ) { - - for (i in seq_len(nrow(spline_test_configs))) { - row <- spline_test_configs[i, ] - spline_type <- row[["spline_type"]] - dof <- row[["dof"]] - degree <- row[["degree"]] - knots <- row[["knots"]] - - # Calculate k and DoF if dof is NA - if (is.na(dof)) { - k <- length(knots) - if (spline_type == "b") { - dof <- k + degree - } else if (spline_type == "n") { - dof <- k + 1 - } else { - stop("Unknown spline type '", spline_type, "' at row ", i) - } - } - - # Check if calculated or provided DoF is valid - if (dof < 2) { - stop("DoF must be at least 2, found DoF of ", dof, " at row ", i) - } - - for (j in seq_along(metas)) { - meta <- metas[[j]] - nr_timepoints <- length(unique(meta$Time)) - if (dof > nr_timepoints) { - stop("DoF (", dof, ") cannot exceed the number of unique time points - (", nr_timepoints, ") in meta", j, " at row ", i) - } - } - - } - - invisible(NULL) - }, - - - #' Check Dataframe Columns - #' - #' This function checks if the columns of a dataframe match the expected - #' column names and their respective data types. - #' - #' @param df A dataframe to check. - #' @param expected_cols A character vector of expected column names. - #' - #' @return This function does not return a value. It stops execution if the - #' dataframe columns or their classes do not match the expected structure. - #' - check_columns = function( - df, - expected_cols - ) { - - actual_cols <- names(df) - if (!all(expected_cols %in% actual_cols)) { - stop("Dataframe columns do not match expected structure", - call. = FALSE) - } - expected_classes <- c("numeric", "numeric", "numeric", "numeric", - "numeric", "numeric", "integer", "character", - "numeric") - actual_classes <- sapply(df, class) - if (!all(actual_classes == expected_classes)) { - stop("Dataframe column classes do not match expected classes", - call. = FALSE) - } - } - ) -) - - + inherit = Level3Functions, + public = list( -# Level3Functions class -------------------------------------------------------- + #' Check Data Matrix + #' + #' @description + #' This function checks the validity of the data matrix, ensuring that it + #' is a + #' matrix, contains only numeric values, + #' has no missing values, and all elements are non-negative. Additionally, it + #' verifies that no rows or columns are + #' entirely zeros. + #' + #' @param data A dataframe containing numeric values. + #' @param data_meta_index An optional parameter specifying the index of the + #' data + #' for error messages. Default is NA. + #' + #' @return Returns TRUE if all checks pass. Stops execution and returns an + #' error + #' message if any check fails. + #' + check_data = function( + data, + data_meta_index = NULL) { + if (!is.matrix(data) || !is.numeric(data)) { + stop( + self$create_error_message( + "data must be a numeric matrix.", + data_meta_index + ), + call. = FALSE + ) + } + # Check for missing values + if (any(is.na(data))) { + stop( + self$create_error_message( + "data must not contain missing values.", + data_meta_index + ), + call. = FALSE + ) + } -#' Level3Functions: A class for level 3 utility functions -#' -#' This class provides methods for creating error messages and checking + # Check for non-negative values + if (any(data < 0)) { + stop( + self$create_error_message( + paste( + "All elements of data must be non-negative. The elements should", + "represent concentrations, abundances, or", + "intensities (which are inherently non-negative)." + ), + data_meta_index + ), + call. = FALSE + ) + } + + # Check for rows with all zeros + if (any(rowSums(data) == 0)) { + stop( + self$create_error_message( + "data must not contain rows with all zeros!", + data_meta_index + ), + call. = FALSE + ) + } + + # Check for columns with all zeros + if (any(colSums(data) == 0)) { + stop( + self$create_error_message( + paste( + "data must not contain columns with all zeros!" + ), + data_meta_index + ), + call. = FALSE + ) + } + + # Check if row headers (rownames) are present and non-null + row_headers <- rownames(data) + if (is.null(row_headers)) { + stop( + self$create_error_message( + "The data matrix must have row headers!", + data_meta_index + ), + call. = FALSE + ) + } + + return(TRUE) + }, + + + #' Check Metadata + #' + #' @description + #' This function checks the validity of the metadata dataframe, ensuring it + #' contains the 'Time' column, + #' does not contain missing values, and that the specified condition column + #' is + #' valid and of the appropriate type. + #' Additionally, it checks for an optional batch effect column and prints + #' messages regarding its use. + #' + #' @param meta A dataframe containing the metadata, including the 'Time' + #' column. + #' @param condition A single character string specifying the column name + #' in the + #' meta dataframe to be checked. + #' @param meta_batch_column An optional parameter specifying the column + #' name in + #' the meta dataframe used to remove the batch effect. Default is NA. + #' @param meta_batch2_column An optional parameter specifying the column + #' name in + #' the meta dataframe used to remove the batch effect. Default is NA. + #' @param data_meta_index An optional parameter specifying the index of the + #' data/meta pair for error messages. Default is NA. + #' + #' @return Returns TRUE if all checks pass. Stops execution and returns an + #' error message if any check fails. + #' + check_meta = function( + meta, + condition, + meta_batch_column = NULL, + meta_batch2_column = NULL, + data_meta_index = NULL) { + if (!is.data.frame(meta) || + !"Time" %in% names(meta) || + !is.numeric(meta[["Time"]])) { + stop( + self$create_error_message( + paste("meta must be a dataframe with the numeric column Time"), + data_meta_index + ), + call. = FALSE + ) + } + + if (any(is.na(meta))) { + stop( + self$create_error_message( + "meta must not contain missing values.", + data_meta_index + ), + call. = FALSE + ) + } + + # Check if condition is a single character + if (!is.character(condition) || length(condition) != 1) { + stop("'condition' must be a single character", + call. = FALSE + ) + } + + # Check if condition is a column in the meta dataframe + if (!condition %in% colnames(meta)) { + stop(self$create_error_message( + sprintf( + "The condition '%s' is not a %s", + condition, + paste("column in meta") + ), + data_meta_index + ), call. = FALSE) + } + + # Check if the factor column is of appropriate type + if (!is.factor(meta[[condition]]) && + !is.character(meta[[condition]])) { + stop( + self$create_error_message( + sprintf("The factor column '%s' must be of type + factor or character.", condition), + data_meta_index + ), + call. = FALSE + ) + } + + # Check condition and time pattern consistency + self$check_condition_time_consistency(meta, condition) + + if (!is.character(meta_batch2_column)) { + meta_batch2_column <- NULL + } + + if (is.null(meta_batch_column) && !is.null(meta_batch2_column)) { + stop(paste( + "For removing the batch effect, batch2 can only be used when", + "batch is used!" + ), call. = FALSE) + } + + if (!is.null(meta_batch_column)) { + if (is.character(meta_batch_column)) { + if (meta_batch_column == "Time" || meta_batch_column == condition) { + stop(paste("meta_batch_column must not be == 'Time' or", condition), + call. = FALSE + ) + } + + self$check_batch_column( + meta, + meta_batch_column, + data_meta_index + ) + } else { + stop( + "meta_batch_column must be a character", + call. = FALSE + ) + } + } + + if (!is.null(meta_batch2_column)) { + if (is.character(meta_batch2_column)) { + if (meta_batch2_column == "Time" || meta_batch2_column == condition) { + stop(paste("meta_batch2_column must not be == 'Time' or", condition), + call. = FALSE + ) + } + + if (meta_batch_column == meta_batch2_column) { + stop( + paste( + "meta_batch_column must not be equal to", + "meta_batch2_column" + ), + call. = FALSE + ) + } + + self$check_batch_column( + meta, + meta_batch2_column, + data_meta_index + ) + } else { + stop( + "meta_batch2_column must be a character", + call. = FALSE + ) + } + } + + return(TRUE) + }, + + + #' Check Dataframe + #' + #' @description + #' Validates that the dataframe contains all required columns with the + #' correct data types. + #' + #' @param df A dataframe to check. + #' + #' @return TRUE if the dataframe is valid, otherwise an error is thrown. + #' + check_dataframe = function(df) { + # Define the required columns and their expected types + required_columns <- list( + AveExpr = "numeric", + P.Value = "numeric", + adj.P.Val = "numeric", + feature_nr = "integer", + feature_names = "character", + intercept = "numeric" + ) + + # Check if all required columns are present + missing_columns <- setdiff(names(required_columns), names(df)) + if (length(missing_columns) > 0) { + stop( + paste( + "Missing columns in top_table:", + paste(missing_columns, collapse = ", ") + ), + call. = FALSE + ) + } + + # Check if columns have the correct type + for (col in names(required_columns)) { + if (!inherits(df[[col]], required_columns[[col]])) { + stop( + paste( + "top_table column", col, "must be of type", + required_columns[[col]] + ), + call. = FALSE + ) + } + } + + return(TRUE) + }, + + + #' Check Spline Parameters Generally + #' + #' @description + #' Validates the general structure and contents of spline parameters. + #' + #' @param spline_params A list of spline parameters. + #' + #' @return No return value, called for side effects. + #' + check_spline_params_generally = function(spline_params) { + allowed_fields <- c("spline_type", "degree", "dof") + + if (!all(names(spline_params) %in% allowed_fields)) { + stop( + paste( + "spline_params contains invalid fields. Only 'spline_type',", + "'degree', and 'dof' are allowed." + ), + call. = FALSE + ) + } + + # Check if spline_type exists and contains valid values + if ("spline_type" %in% names(spline_params)) { + if (!all(spline_params$spline_type %in% c("b", "n"))) { + stop( + paste( + "Elements of spline_type must be either 'b' for B-splines", + "or 'n' for natural cubic splines." + ), + call. = FALSE + ) + } + } else { + stop("spline_type is missing in spline_params.", call. = FALSE) + } + + # Check if degree exists and is an integer vector for B-splines, + # and NA for natural splines + if ("degree" %in% names(spline_params)) { + for (i in seq_along(spline_params$spline_type)) { + if (spline_params$spline_type[i] == "b" && + (!is.integer(spline_params$degree[i]) || + is.na(spline_params$degree[i]))) { + stop( + paste( + "Degree must be specified as an integer for", + "B-splines in spline_params." + ), + call. = FALSE + ) + } + if (spline_params$spline_type[i] == "n" && + !is.na(spline_params$degree[i])) { + stop( + paste( + "Degree must be NA for natural cubic", + "splines in spline_params." + ), + call. = FALSE + ) + } + } + } else if (all(spline_params$spline_type == "b")) { + stop("degree is missing in spline_params.", call. = FALSE) + } + + # Check if dof exists and is an integer vector + if ("dof" %in% names(spline_params)) { + if (!all(spline_params$dof == as.integer(spline_params$dof))) { + stop("dof must be an integer vector in spline_params.", call. = FALSE) + } + # Check for B-splines that dof is greater than 2 + for (i in seq_along(spline_params$spline_type)) { + if (spline_params$spline_type[i] == "b" && + spline_params$dof[i] < 3) { + stop( + paste("B-splines require DoF > 2 for spline_type at index", i), + call. = FALSE + ) + } + } + } else { + stop("dof is missing in spline_params.", call. = FALSE) + } + }, + + + #' Check Spline Parameters Mode Dependent + #' + #' @description + #' Validates the spline parameters depending on the specified mode. + #' + #' @param spline_params A list of spline parameters. + #' @param mode A character string specifying the mode + #' ('integrated' or 'isolated'). + #' @param meta A dataframe containing metadata. + #' @param condition A character string specifying the condition. + #' + #' @return No return value, called for side effects. + #' + check_spline_params_mode_dependent = function( + spline_params, + mode, + meta, + condition) { + if (mode == "integrated") { + # Check that all parameters in spline_params have exactly + # one "logical" element + if (any(vapply(spline_params, function(x) { + # Atomic vectors (like numeric or character vectors) + # should count as 1 element + !is.atomic(x) && length(x) != 1 + }, logical(1)))) { + stop(paste( + "All parameters in spline_params must have exactly one element", + "when mode is 'integrated'.", + "Different spline parameters for the different levels is not", + "supported for this mode." + ), call. = FALSE) + } + + # # Additional check for 'knots' and 'bknots' if they exist + # if ("knots" %in% names(spline_params)) { + # # Check if 'knots' is atomic (i.e., treat vectors as a single unit) or NA + # if (!(is.atomic(spline_params$knots) || all(is.na(spline_params$knots)))) { + # stop( + # paste( + # "All elements in 'knots' in spline_params must be atomic", + # "or NA when mode is 'integrated'.", + # "Different spline parameters for different levels are not", + # "supported for this mode." + # ), + # call. = FALSE + # ) + # } + # } + # + # if ("bknots" %in% names(spline_params)) { + # # Check if 'bknots' is atomic (i.e., treat vectors as a single unit) or NA + # if (!(is.atomic(spline_params$bknots) || + # all(is.na(spline_params$bknots)))) { + # stop( + # paste( + # "All elements in 'bknots' in spline_params must be atomic or", + # "NA when mode is 'integrated'.", + # "Different spline parameters for different levels are not", + # "supported for this mode." + # ), + # call. = FALSE + # ) + # } + # } + } else if (mode == "isolated") { + num_levels <- length(unique(meta[[condition]])) + if (any(vapply(spline_params, length, integer(1)) != num_levels)) { + stop_call_false(paste( + "Each vector or list in spline_params must have as many", + "elements as there are unique elements in the ", condition, + "column of meta when mode is 'isolated'." + )) + } + # if ("knots" %in% names(spline_params)) { + # if (length(spline_params$knots) != num_levels) { + # stop( + # paste("'knots' in spline_params must have the same number of", + # "elements as there are unique elements in the ", condition, + # "column of meta when mode is 'isolated'."), + # call. = FALSE) + # } + # } + # if ("bknots" %in% names(spline_params)) { + # if (length(spline_params$bknots) != num_levels) { + # stop( + # paste("'bknots' in spline_params must have the same number of", + # "elements as there are unique elements in the ", condition, + # "column of meta when mode is 'isolated'."), + # call. = FALSE) + # } + # } + } + }, + + + #' Check Columns in Spline Test Configurations + #' + #' @description + #' Validates that the spline test configurations contain the required columns + #' in the correct order. + #' + #' @param spline_test_configs A dataframe containing spline test + #' configurations. + #' + #' @return No return value, called for side effects. + #' + #' @keywords internal + #' + check_columns_spline_test_configs = function(spline_test_configs) { + required_columns <- c( + "spline_type", + "degree", + "dof" + # "knots", + # "bknots" + ) + + # Check for exact match of column names and order + if (!identical(names(spline_test_configs), required_columns)) { + # Find the missing or extra columns + missing_columns <- setdiff(required_columns, names(spline_test_configs)) + extra_columns <- setdiff(names(spline_test_configs), required_columns) + error_message <- "Error: Incorrect columns in dataframe. " + + # Append specific issues to the error message + if (length(missing_columns) > 0) { + error_message <- paste0( + error_message, "Missing columns: ", + paste(missing_columns, collapse = ", "), ". " + ) + } + if (length(extra_columns) > 0) { + error_message <- paste0( + error_message, "Extra columns: ", + paste(extra_columns, collapse = ", "), ". " + ) + } + error_message <- paste0( + error_message, + "Expected columns in order: ", + paste(required_columns, collapse = ", "), "." + ) + + stop(error_message) + } + }, + + + #' Check Spline Type Column + #' + #' @description + #' Validates that the 'spline_type' column in the spline test configurations + #' contains only 'n' or 'b'. + #' + #' @param spline_test_configs A dataframe containing spline test + #' configurations. + #' + #' @return No return value, called for side effects. + #' + #' @keywords internal + #' + check_spline_type_column = function(spline_test_configs) { + if (!all(spline_test_configs$spline_type %in% c("n", "b"))) { + # Identify invalid entries + invalid_entries <- spline_test_configs$spline_type[ + !spline_test_configs$spline_type %in% c("n", "b") + ] + error_message <- sprintf( + "Error: 'spline_type' contains invalid entries. + Only 'n' or 'b' are allowed. Invalid entries found: %s", + paste(unique(invalid_entries), collapse = ", ") + ) + + stop(error_message) + } + }, + + + #' Check Spline Type Parameters + #' + #' @description + #' Validates the parameters for each row in the spline test configurations + #' based on the spline type. + #' + #' @param spline_test_configs A dataframe containing spline test + #' configurations. + #' + #' @return TRUE if all checks pass, otherwise an error is thrown. + #' + #' @keywords internal + #' + check_spline_type_params = function(spline_test_configs) { + for (i in seq_len(nrow(spline_test_configs))) { + row <- spline_test_configs[i, ] + switch(as.character(row$spline_type), + "n" = { + if (!is.na(row$degree)) { + stop("degree must be NA for spline_type n") + } + + # if (!((is.na(row$dof) && !is.na(row$knots)) || + # (!is.na(row$dof) && is.na(row$knots)))) { + # stop("Either dof or knots must be NA, but not both, for + # spline_type n") + # } + + if (!is.integer(row$dof)) { + stop("dof must be an integer when it is not NA for + spline_type n") + } + + # if (!is.na(row$knots) && !is.numeric(row$knots)) { + # stop("knots must be a numeric vector when it is not NA for + # spline_type n") + # } + # if (!is.na(row$bknots) && (!is.numeric(row$bknots) || + # length(row$bknots) != 2)) { + # stop("bknots must be a numeric vector of exactly two elements + # or NA for spline_type n") + # } + }, + "b" = { + if (!is.integer(row$degree)) stop("degree must be an integer for + spline_type b") + if (!is.na(row$dof) && (!is.integer(row$dof) || + row$dof < row$degree)) { + stop("dof must be an integer at least as big as degree for + spline_type b") + } + + # if (!is.na(row$knots) && !is.numeric(row$knots)) { + # stop("knots must be a numeric vector when it is not NA for + # spline_type b") + # } + # if (!is.na(row$bknots) && (!is.numeric(row$bknots) || + # length(row$bknots) != 2)) { + # stop("bknots must be a numeric vector of exactly two elements + # or NA for spline_type b") + # } + }, + stop("spline_type must be either 'n' or 'b'") + ) + } + return(TRUE) + }, + + + #' Check Maximum and Minimum Degrees of Freedom + #' + #' @description + #' Validates the degrees of freedom (DoF) for each row in the spline test + #' configurations based on the metadata. + #' + #' @param spline_test_configs A dataframe containing spline test + #' configurations. + #' @param metas A list of metadata corresponding to the data matrices. + #' + #' @return No return value, called for side effects. + #' + #' @keywords internal + #' + check_max_and_min_dof = function( + spline_test_configs, + metas) { + for (i in seq_len(nrow(spline_test_configs))) { + row <- spline_test_configs[i, ] + spline_type <- row[["spline_type"]] + dof <- row[["dof"]] + degree <- row[["degree"]] + knots <- row[["knots"]] + + # Calculate k and DoF if dof is NA + if (is.na(dof)) { + k <- length(knots) + if (spline_type == "b") { + dof <- k + degree + } else if (spline_type == "n") { + dof <- k + 1 + } else { + stop("Unknown spline type '", spline_type, "' at row ", i) + } + } + + # Check if calculated or provided DoF is valid + if (dof < 2) { + stop("DoF must be at least 2, found DoF of ", dof, " at row ", i) + } + + for (j in seq_along(metas)) { + meta <- metas[[j]] + nr_timepoints <- length(unique(meta$Time)) + if (dof > nr_timepoints) { + stop("DoF (", dof, ") cannot exceed the number of unique time points + (", nr_timepoints, ") in meta", j, " at row ", i) + } + } + } + + invisible(NULL) + }, + + + #' Check Dataframe Columns + #' + #' This function checks if the columns of a dataframe match the expected + #' column names and their respective data types. + #' + #' @param df A dataframe to check. + #' @param expected_cols A character vector of expected column names. + #' + #' @return This function does not return a value. It stops execution if the + #' dataframe columns or their classes do not match the expected structure. + #' + check_columns = function( + df, + expected_cols) { + actual_cols <- names(df) + if (!all(expected_cols %in% actual_cols)) { + stop_call_false("Dataframe columns do not match expected structure") + } + expected_classes <- c( + "numeric", + "numeric", + "numeric", + "numeric", + "numeric", + "numeric", + "integer", + "character", + "numeric" + ) + actual_classes <- vapply(df, class, character(1)) + if (!all(actual_classes == expected_classes)) { + stop_call_false("Dataframe column classes do not match expected classes") + } + } + ) +) + + + +# Level3Functions class -------------------------------------------------------- + + +#' Level3Functions: A class for level 3 utility functions +#' +#' This class provides methods for creating error messages and checking #' batch columns. #' #' @seealso \code{\link{Level2Functions}} #' Level3Functions <- R6::R6Class("Level3Functions", + inherit = Level4Functions, + public = list( + + #' Check the structure of a voom object + #' + #' @description + #' This function checks the structure of a `voom` object to ensure that it + #' contains + #' all the expected components and that these components have the correct + #' types + #' and dimensions. The function does not check the actual data within the + #' matrices. + #' + #' @param voom_obj A list representing a `voom` object, typically created + #' by the + #' `voom` function from the `limma` package. + #' + #' @details + #' The function verifies that the `voom` object contains the following + #' components: + #' - `E`: A matrix of log2-counts per million (logCPM) values. + #' - `weights`: A matrix of observation-specific weights that matches the + #' dimensions of `E`. + #' - `design`: A matrix representing the design matrix used in the linear + #' modeling, + #' with the same number of rows as there are columns in `E`. + #' + #' The function also checks for optional components such as: + #' - `genes`: A data frame of gene annotations. + #' - `targets`: A data frame of target information. + #' - `sample.weights`: A numeric vector of sample-specific weights. + #' + #' If any of these checks fail, the function stops and reports the issues. + #' If the structure is valid, a message confirming the validity is printed. + #' + #' @return Boolean TRUE or FALSE. However, the function is mostly called for + #' its side effects, which stop the script if the structure is not valid. + #' + check_voom_structure = function(voom_obj) { + # Initialize a list to collect any issues found + issues <- list() + + # Check if the input is a list + if (!is.list(voom_obj)) { + stop("The input is not a list. A voom object should be a list.") + } + + # Check for the presence of the expected components + expected_components <- c("E", "weights", "design") + for (comp in expected_components) { + if (!comp %in% names(voom_obj)) { + issues <- c(issues, paste("Missing component:", comp)) + } + } + + # Check that 'E' is a matrix + if ("E" %in% names(voom_obj) && !is.matrix(voom_obj$E)) { + issues <- c(issues, "'E' should be a matrix.") + } - inherit = Level4Functions, - - public = list( - - #' Check the structure of a voom object - #' - #' @description - #' This function checks the structure of a `voom` object to ensure that it - #' contains - #' all the expected components and that these components have the correct - #' types - #' and dimensions. The function does not check the actual data within the - #' matrices. - #' - #' @param voom_obj A list representing a `voom` object, typically created - #' by the - #' `voom` function from the `limma` package. - #' - #' @details - #' The function verifies that the `voom` object contains the following - #' components: - #' - `E`: A matrix of log2-counts per million (logCPM) values. - #' - `weights`: A matrix of observation-specific weights that matches the - #' dimensions of `E`. - #' - `design`: A matrix representing the design matrix used in the linear - #' modeling, - #' with the same number of rows as there are columns in `E`. - #' - #' The function also checks for optional components such as: - #' - `genes`: A data frame of gene annotations. - #' - `targets`: A data frame of target information. - #' - `sample.weights`: A numeric vector of sample-specific weights. - #' - #' If any of these checks fail, the function stops and reports the issues. - #' If the structure is valid, a message confirming the validity is printed. - #' - #' @return Boolean TRUE or FALSE. However, the function is mostly called for - #' its side effects, which stop the script if the structure is not valid. - #' - check_voom_structure = function(voom_obj) { - - # Initialize a list to collect any issues found - issues <- list() - - # Check if the input is a list - if (!is.list(voom_obj)) { - stop("The input is not a list. A voom object should be a list.") - } - - # Check for the presence of the expected components - expected_components <- c("E", "weights", "design") - for (comp in expected_components) { - if (!comp %in% names(voom_obj)) { - issues <- c(issues, paste("Missing component:", comp)) - } - } - - # Check that 'E' is a matrix - if ("E" %in% names(voom_obj) && !is.matrix(voom_obj$E)) { - issues <- c(issues, "'E' should be a matrix.") - } - - # Check that 'weights' is a matrix and matches the dimensions of 'E' - if ("weights" %in% names(voom_obj)) { - if (!is.matrix(voom_obj$weights)) { - issues <- c(issues, "'weights' should be a matrix.") - } else if (!all(dim(voom_obj$weights) == dim(voom_obj$E))) { - issues <- c( - issues, - "'weights' dimensions do not match 'E' dimensions." - ) - } - } - - # Check that 'design' is a matrix and has the correct number of rows - if ("design" %in% names(voom_obj)) { - if (!is.matrix(voom_obj$design)) { - issues <- c(issues, "'design' should be a matrix.") - } else if (nrow(voom_obj$design) != ncol(voom_obj$E)) { - issues <- c( - issues, - "'design' matrix should have the same number of rows as the + # Check that 'weights' is a matrix and matches the dimensions of 'E' + if ("weights" %in% names(voom_obj)) { + if (!is.matrix(voom_obj$weights)) { + issues <- c(issues, "'weights' should be a matrix.") + } else if (!all(dim(voom_obj$weights) == dim(voom_obj$E))) { + issues <- c( + issues, + "'weights' dimensions do not match 'E' dimensions." + ) + } + } + + # Check that 'design' is a matrix and has the correct number of rows + if ("design" %in% names(voom_obj)) { + if (!is.matrix(voom_obj$design)) { + issues <- c(issues, "'design' should be a matrix.") + } else if (nrow(voom_obj$design) != ncol(voom_obj$E)) { + issues <- c( + issues, + "'design' matrix should have the same number of rows as the number of columns in 'E'." - ) - } - } - - # Optionally, check for the presence of other common components - if ("genes" %in% names(voom_obj) && !is.data.frame(voom_obj$genes)) { - issues <- c(issues, "'genes' should be a data frame.") - } - - # Check for the presence of optional components like targets or - # sample weights - if ("targets" %in% names(voom_obj) && !is.data.frame(voom_obj$targets)) { - issues <- c(issues, "'targets' should be a data frame.") - } - - if ("sample.weights" %in% names(voom_obj) - && !is.numeric(voom_obj$sample.weights)) { - issues <- c(issues, "'sample.weights' should be numeric.") - } - - # Report results - if (length(issues) > 0) { - stop( - "The voom object failed the structure check:\n", - paste( - issues, - collapse = "\n" - ), - call. = FALSE - ) - } else { - return(TRUE) - } - }, - - - #' Check Batch Column - #' - #' @description - #' This method checks the batch column in the metadata and provides - #' appropriate messages. - #' - #' @param meta A dataframe containing metadata. - #' @param meta_batch_column A character string specifying the batch column - #' in the metadata. - #' @param data_meta_index An optional parameter specifying the index of the - #' data/meta pair. Default is NA. - #' - #' @return NULL. The method is used for its side effects of throwing errors - #' or printing messages. - #' - check_batch_column = function( - meta, - meta_batch_column, - data_meta_index - ) { - - if (!is.null(meta_batch_column) && !(meta_batch_column %in% names(meta))) { - stop(self$create_error_message(sprintf("Batch effect column '%s' %s", - meta_batch_column, - "not found in meta"), - data_meta_index), - call. = FALSE) - } else if (!is.null(meta_batch_column)) { - if (!is.null(data_meta_index)) { - message(sprintf("Index: %s. %s", - data_meta_index, - paste("Column", meta_batch_column, - "of meta will be used", - "to remove the batch effect for the plotting"))) - } else { - message(sprintf("Column '%s' of meta will be used to %s", - meta_batch_column, - paste("remove the batch effect for the plotting"))) - } - } else { - if (!is.null(data_meta_index)) { - message(sprintf( - "Index: %s. Batch effect will NOT be removed for plotting!", - data_meta_index)) - } else { - message("Batch effect will NOT be removed for plotting!") - } - } - }, - - - #' Check Condition Time Consistency - #' - #' @description - #' This function checks whether the values in the `condition` column - #' have unique values for each block of identical `Time` values in the - #' `meta` dataframe. - #' Additionally, it ensures that every new block of a given time has a - #' new value - #' in the `condition` column. - #' - #' @param meta A dataframe containing the metadata, including the `Time` - #' column. - #' @param condition A character string specifying the column name in `meta` - #' used to define groups for analysis. - #' - #' @return Logical TRUE if the condition values are consistent with the - #' time series pattern. - #' - check_condition_time_consistency = function( - meta, - condition - ) { - - # Get the unique times in the order they appear - unique_times <- unique(meta[["Time"]]) - - # Initialize a list to store previously seen conditions for each time - # segment - seen_conditions <- list() - - # Iterate through each block of unique times - for (time in unique_times) { - # Get the indices for the current time segment - current_indices <- which(meta[["Time"]] == time) - - # Get the condition values for the current time segment - current_conditions <- meta[current_indices, condition, drop = TRUE] - - # Ensure that all conditions in the current segment are the same - if (length(unique(current_conditions)) != 2) { - stop(paste("Every block of identical time values in meta must", - "have unique values in the column", condition), - call. = FALSE) - } - - # Check if the condition value has been seen before for this time segment - if (!is.null(seen_conditions[[as.character(time)]])) { - if (current_conditions[1] %in% seen_conditions[[as.character(time)]]) { - stop(sprintf("Condition '%s' for time '%s' has been seen before.", - current_conditions[1], time), call. = FALSE) - } - } - - # Update the seen conditions for the current time segment - if (is.null(seen_conditions[[as.character(time)]])) { - seen_conditions[[as.character(time)]] <- character(0) - } - seen_conditions[[as.character(time)]] <- c( - seen_conditions[[as.character(time)]], - current_conditions[1] - ) - } - - return(TRUE) - } - ) + ) + } + } + + # Optionally, check for the presence of other common components + if ("genes" %in% names(voom_obj) && !is.data.frame(voom_obj$genes)) { + issues <- c(issues, "'genes' should be a data frame.") + } + + # Check for the presence of optional components like targets or + # sample weights + if ("targets" %in% names(voom_obj) && !is.data.frame(voom_obj$targets)) { + issues <- c(issues, "'targets' should be a data frame.") + } + + if ("sample.weights" %in% names(voom_obj) && + !is.numeric(voom_obj$sample.weights)) { + issues <- c(issues, "'sample.weights' should be numeric.") + } + + # Report results + if (length(issues) > 0) { + stop( + "The voom object failed the structure check:\n", + paste( + issues, + collapse = "\n" + ), + call. = FALSE + ) + } else { + return(TRUE) + } + }, + + + #' Check Batch Column + #' + #' @description + #' This method checks the batch column in the metadata and provides + #' appropriate messages. + #' + #' @param meta A dataframe containing metadata. + #' @param meta_batch_column A character string specifying the batch column + #' in the metadata. + #' @param data_meta_index An optional parameter specifying the index of the + #' data/meta pair. Default is NA. + #' + #' @return NULL. The method is used for its side effects of throwing errors + #' or printing messages. + #' + check_batch_column = function( + meta, + meta_batch_column, + data_meta_index) { + if (!is.null(meta_batch_column) && !(meta_batch_column %in% names(meta))) { + stop( + self$create_error_message( + sprintf( + "Batch effect column '%s' %s", + meta_batch_column, + "not found in meta" + ), + data_meta_index + ), + call. = FALSE + ) + } else if (!is.null(meta_batch_column)) { + if (!is.null(data_meta_index)) { + message(sprintf( + "Index: %s. %s", + data_meta_index, + paste( + "Column", meta_batch_column, + "of meta will be used", + "to remove the batch effect for the plotting" + ) + )) + } else { + message(sprintf( + "Column '%s' of meta will be used to %s", + meta_batch_column, + paste("remove the batch effect for the plotting") + )) + } + } else { + if (!is.null(data_meta_index)) { + message(sprintf( + "Index: %s. Batch effect will NOT be removed for plotting!", + data_meta_index + )) + } else { + message("Batch effect will NOT be removed for plotting!") + } + } + }, + + + #' Check Condition Time Consistency + #' + #' @description + #' This function checks whether the values in the `condition` column + #' have unique values for each block of identical `Time` values in the + #' `meta` dataframe. + #' Additionally, it ensures that every new block of a given time has a + #' new value + #' in the `condition` column. + #' + #' @param meta A dataframe containing the metadata, including the `Time` + #' column. + #' @param condition A character string specifying the column name in `meta` + #' used to define groups for analysis. + #' + #' @return Logical TRUE if the condition values are consistent with the + #' time series pattern. + #' + check_condition_time_consistency = function( + meta, + condition) { + # Get the unique times in the order they appear + unique_times <- unique(meta[["Time"]]) + + # Initialize a list to store previously seen conditions for each time + # segment + seen_conditions <- list() + + # Iterate through each block of unique times + for (time in unique_times) { + # Get the indices for the current time segment + current_indices <- which(meta[["Time"]] == time) + + # Get the condition values for the current time segment + current_conditions <- meta[current_indices, condition, drop = TRUE] + + # Ensure that all conditions in the current segment are the same + if (length(unique(current_conditions)) != 2) { + stop( + paste( + "Every block of identical time values in meta must", + "have unique values in the column", condition + ), + call. = FALSE + ) + } + + # Check if the condition value has been seen before for this time segment + if (!is.null(seen_conditions[[as.character(time)]])) { + if (current_conditions[1] %in% seen_conditions[[as.character(time)]]) { + stop(sprintf( + "Condition '%s' for time '%s' has been seen before.", + current_conditions[1], time + ), call. = FALSE) + } + } + + # Update the seen conditions for the current time segment + if (is.null(seen_conditions[[as.character(time)]])) { + seen_conditions[[as.character(time)]] <- character(0) + } + seen_conditions[[as.character(time)]] <- c( + seen_conditions[[as.character(time)]], + current_conditions[1] + ) + } + + return(TRUE) + } + ) ) @@ -2481,38 +2641,36 @@ Level3Functions <- R6::R6Class("Level3Functions", #' @seealso \code{\link{Level3Functions}} #' Level4Functions <- R6::R6Class("Level4Functions", - public = list( - - #' Create Error Message - #' - #' @description - #' This method creates a formatted error message that includes the index of - #' the data/meta pair if provided. - #' If no index is provided, it returns the message as is. - #' - #' @param message A character string specifying the error message. - #' @param data_meta_index An optional parameter specifying the index of the - #' data/meta pair for the error message. Default is NA. - #' - #' @return Returns a formatted error message string. If an index is provided, - #' the message includes the index; otherwise, it returns the message as is. - #' - create_error_message = function( - message, - data_meta_index = NULL - ) { - - if (!is.null(data_meta_index)) { - return(sprintf( - "data/meta pair index %d: %s", - data_meta_index, - message - )) - } else { - return(message) - } - } - ) + public = list( + + #' Create Error Message + #' + #' @description + #' This method creates a formatted error message that includes the index of + #' the data/meta pair if provided. + #' If no index is provided, it returns the message as is. + #' + #' @param message A character string specifying the error message. + #' @param data_meta_index An optional parameter specifying the index of the + #' data/meta pair for the error message. Default is NA. + #' + #' @return Returns a formatted error message string. If an index is provided, + #' the message includes the index; otherwise, it returns the message as is. + #' + create_error_message = function( + message, + data_meta_index = NULL) { + if (!is.null(data_meta_index)) { + return(sprintf( + "data/meta pair index %d: %s", + data_meta_index, + message + )) + } else { + return(message) + } + } + ) ) @@ -2535,17 +2693,14 @@ Level4Functions <- R6::R6Class("Level4Functions", #' check_splineomics_elements <- function( splineomics, - func_type - ) { - - required_elements <- switch( - func_type, + func_type) { + required_elements <- switch(func_type, "explore_data" = c( "data", "meta", "condition", "report_info" - ), + ), "screen_limma_hyperparams" = c( "condition", "report_info", @@ -2573,36 +2728,34 @@ check_splineomics_elements <- function( "spline_params", "limma_splines_result" ), - stop( - "Invalid function type provided.", - call. = FALSE - ) - ) + stop_call_false("Invalid function type provided.") + ) missing_elements <- required_elements[ - !sapply( + !vapply( splineomics[required_elements], - function(x) !is.null(x) - ) - ] + function(x) !is.null(x), + logical(1) + ) + ] if (length(missing_elements) > 0) { - stop(paste( + stop_call_false(paste( "The following required elements for the function", func_type, "were not passed to the SplineOmics object:", paste( missing_elements, collapse = ", " - ), + ), "\nAll required elements for", func_type, "are:", paste( required_elements, - collapse = ", ") - ), - call. = FALSE) + collapse = ", " + ) + )) } } @@ -2620,13 +2773,14 @@ check_splineomics_elements <- function( #' any `NULL` elements are found in the input list. #' check_null_elements <- function(args) { - - null_elements <- names(args)[sapply(args, is.null)] + null_elements <- names(args)[vapply(args, is.null, logical(1))] if (length(null_elements) > 0) { stop( - paste("The following function arguments are NULL:", - paste(null_elements, collapse = ", ")), + paste( + "The following function arguments are NULL:", + paste(null_elements, collapse = ", ") + ), call. = FALSE ) } diff --git a/R/utils_report_generation.R b/R/utils_report_generation.R index 5236b9d..d9be578 100755 --- a/R/utils_report_generation.R +++ b/R/utils_report_generation.R @@ -1,4 +1,4 @@ -#' utils scripts contains shared functions that are used by at least two package +#' utils scripts contains shared functions that are used by at least two package #' functions of the SplineOmics package. The level separation is only valid #' internally in this script, and has no connection to the script level of the #' respective exported functions scripts. @@ -9,7 +9,7 @@ #' Generate Report HTML #' #' @description -#' Generates an HTML report with the provided plots, spline parameters, and +#' Generates an HTML report with the provided plots, spline parameters, and #' report information. #' #' @param plots A list of ggplot2 plot objects. @@ -32,18 +32,18 @@ #' for each level. #' @param adj_pthresh_avrg_diff_conditions Float, only for cluster_hits() #' @param adj_pthresh_interaction_condition_time Float, only for cluster_hits() -#' @param report_type A character string specifying the report type +#' @param report_type A character string specifying the report type #' ('screen_limma_hyperparams' or 'cluster_hits'). #' @param feature_name_columns Character vector with the column names of the -#' annotation information, such as the columns +#' annotation information, such as the columns #' containing the gene names. These column names #' are used to put the info in the HTML reports on #' how the descriptions above the individual spline -#' plots where created. This is because those +#' plots where created. This is because those #' descriptions can be made up of several column #' values, and the specific columns are then stated #' in the HTML report on top (e.g gene_uniprotID). -#' @param mode A character string specifying the mode +#' @param mode A character string specifying the mode #' ('isolated' or 'integrated'). #' @param filename A character string specifying the filename for the report. #' @param timestamp A timestamp to include in the report filename. @@ -52,18 +52,18 @@ #' @return No return value, called for side effects. #' #' @seealso -#' \code{\link{build_hyperparams_screen_report}}, +#' \code{\link{build_hyperparams_screen_report}}, #' \code{\link{build_cluster_hits_report}} -#' +#' #' @importFrom here here #' @importFrom tools file_path_sans_ext #' @importFrom grDevices dev.off -#' +#' generate_report_html <- function( - plots, - plots_sizes, + plots, + plots_sizes, report_info, - limma_result_2_and_3_plots = NULL, # only for build_cluster_hits_report + limma_result_2_and_3_plots = NULL, # only for build_cluster_hits_report data = NULL, meta = NA, topTables = NA, @@ -71,17 +71,17 @@ generate_report_html <- function( level_headers_info = NA, spline_params = NA, adj_pthresholds = NA, - adj_pthresh_avrg_diff_conditions = NA, # only for cluster_hits() - adj_pthresh_interaction_condition_time = NA, # only for cluster_hits() + adj_pthresh_avrg_diff_conditions = NA, # only for cluster_hits() + adj_pthresh_interaction_condition_time = NA, # only for cluster_hits() report_type = "explore_data", - feature_name_columns = NA, # only for cluster_hits() + feature_name_columns = NA, # only for cluster_hits() mode = NA, filename = "report", - timestamp = format(Sys.time(), - "%d_%m_%Y-%H_%M_%S"), - report_dir = here::here() - ) { - + timestamp = format( + Sys.time(), + "%d_%m_%Y-%H_%M_%S" + ), + report_dir = here::here()) { feature_names_formula <- "" if (report_type == "explore_data") { @@ -92,82 +92,87 @@ generate_report_html <- function( } } else if (report_type == "screen_limma_hyperparams") { title <- paste("hyperparams screen |", filename) - } else if (report_type == "create_limma_report") { title <- "limma report" - - } else if (report_type == "cluster_hits") { + } else if (report_type == "cluster_hits") { title <- "clustered hits" feature_names_formula <- paste( feature_name_columns, collapse = "_" - ) - - } else if (report_type == "create_gsea_report") { + ) + } else if (report_type == "create_gsea_report") { title <- "gsea" - } else { - stop(paste("report_type must be explore_hits, screen_limma_hyperparams,", - "create_limma_report, or cluster_hits"), - call. = FALSE) + stop( + paste( + "report_type must be explore_hits, screen_limma_hyperparams,", + "create_limma_report, or cluster_hits" + ), + call. = FALSE + ) } - + fields_to_format <- c( "data_description", "method_description", "results_summary", "conclusions" - ) - + ) + for (field in fields_to_format) { if (field %in% names(report_info)) { report_info[[field]] <- format_text(report_info[[field]]) } } - + splineomics_version <- utils::packageVersion("SplineOmics") header_text <- paste( - title, - paste("Omics-Datatype:", report_info$omics_data_type), - paste("Date-Time:", timestamp), - paste("SplineOmics Version:", splineomics_version), sep = " | " - ) + title, + paste("Omics-Datatype:", report_info$omics_data_type), + paste("Date-Time:", timestamp), + paste("SplineOmics Version:", splineomics_version), + sep = " | " + ) header_text <- paste(header_text, "


    ") - + header_section <- get_header_section( title = title, header_text = header_text, report_type = report_type, feature_names_formula = feature_names_formula - ) - + ) + report_info_fields <- c( "omics_data_type", - "data_description", + "data_description", "data_collection_date", "meta_condition", "meta_batch", "limma_design", "mode", - "analyst_name", + "analyst_name", "contact_info", "project_name", "method_description", - "results_summary", + "results_summary", "conclusions" - ) + ) download_fields <- c() - if (!is.null(data)) download_fields <- c( - download_fields, - "data_with_annotation" + if (!is.null(data)) { + download_fields <- c( + download_fields, + "data_with_annotation" ) - - if (!all(is.na(meta))) download_fields <- c( - download_fields, - "meta" + } + + if (!all(is.na(meta))) { + download_fields <- c( + download_fields, + "meta" ) - + } + if (!all(is.na(topTables))) { download_fields <- c( download_fields, @@ -178,32 +183,33 @@ generate_report_html <- function( } ) } - - + + if (!all(is.na(enrichr_format))) { download_fields <- c( download_fields, "Enrichr_clustered_genes", "Enrichr_background" - ) + ) } - + max_field_length <- max(nchar(gsub("_", " ", report_info_fields))) - + report_info_section <- paste( - '

    ', - 'Report Info \u2139

    ', sep = "" - ) - + '

    ', + "Report Info \u2139

    ", + sep = "" + ) + downloads_section <- paste( - '

    ', - 'Downloads \U0001F4E5

    ' - ) - - report_info[["mode"]] <- mode # Because mode is not part of report_info - + '

    ', + "Downloads \U0001F4E5

    " + ) + + report_info[["mode"]] <- mode # Because mode is not part of report_info + for (field in report_info_fields) { base64_df <- process_field( field, @@ -212,32 +218,33 @@ generate_report_html <- function( topTables, report_info, encode_df_to_base64, - report_type, + report_type, enrichr_format - ) - + ) + field_display <- sprintf( "%-*s", max_field_length, gsub("_", " ", field) - ) - + ) + report_info_section <- paste( report_info_section, - sprintf('', - field_display, base64_df), + field_display, base64_df + ), sep = "\n" - ) + ) } - + # Close the Report Info table report_info_section <- paste(report_info_section, "
    %s :%s
    ", sep = "\n") - + download_fields <- c(download_fields, "session_info") for (field in download_fields) { - base64_df <- process_field( field, data, @@ -247,72 +254,70 @@ generate_report_html <- function( encode_df_to_base64, report_type, enrichr_format - ) - + ) + field_display <- sprintf("%-*s", max_field_length, gsub("_", " ", field)) downloads_section <- paste( downloads_section, - sprintf('%s :%s', - field_display, base64_df), + field_display, base64_df + ), sep = "\n" - ) + ) } - + # Close the Downloads table downloads_section <- paste(downloads_section, "", sep = "\n") - + # Preserve initial header_section content header_section <- paste( header_section, report_info_section, - downloads_section, sep = "\n" - ) - - + downloads_section, + sep = "\n" + ) + + if (report_type == "create_gsea_report") { databases_text <- paste(report_info$databases, collapse = ", ") header_section <- paste( - header_section, - "

    Databases used: ", - databases_text, - "

    ", + header_section, + "

    Databases used: ", + databases_text, + "

    ", sep = "\n" - ) + ) } - + file_name <- sprintf( "%s_%s_%s.html", filename, report_info$omics_data_type, timestamp - ) - + ) + output_file_path <- here::here(report_dir, file_name) - + if (report_type == "explore_data") { - build_explore_data_report( - header_section = header_section, - plots = plots, + header_section = header_section, + plots = plots, plots_sizes = plots_sizes, report_info = report_info, output_file_path = output_file_path - ) - + ) } else if (report_type == "screen_limma_hyperparams") { - build_hyperparams_screen_report( - header_section = header_section, - plots = plots, - plots_sizes = plots_sizes, + header_section = header_section, + plots = plots, + plots_sizes = plots_sizes, report_info = report_info, output_file_path = output_file_path - ) - + ) } else if (report_type == "create_limma_report") { - build_create_limma_report( header_section = header_section, plots = plots, @@ -320,10 +325,8 @@ generate_report_html <- function( level_headers_info = level_headers_info, report_info = report_info, output_file_path = output_file_path - ) - + ) } else if (report_type == "create_gsea_report") { - build_create_gsea_report( header_section = header_section, plots = plots, @@ -331,24 +334,23 @@ generate_report_html <- function( level_headers_info = level_headers_info, report_info = report_info, output_file_path = output_file_path - ) - - } else { # report_type == "cluster_hits" + ) + } else { # report_type == "cluster_hits" build_cluster_hits_report( - header_section = header_section, - plots = plots, + header_section = header_section, + plots = plots, limma_result_2_and_3_plots = limma_result_2_and_3_plots, plots_sizes = plots_sizes, level_headers_info = level_headers_info, spline_params = spline_params, adj_pthresholds = adj_pthresholds, adj_pthresh_avrg_diff_conditions = adj_pthresh_avrg_diff_conditions, - adj_pthresh_interaction_condition_time = + adj_pthresh_interaction_condition_time = adj_pthresh_interaction_condition_time, mode = mode, report_info = report_info, output_file_path = output_file_path - ) + ) } } @@ -357,112 +359,110 @@ generate_report_html <- function( #' #' @description #' This function generates an HTML report by inserting a table of contents, -#' embedding necessary JavaScript files, and writing the final HTML content +#' embedding necessary JavaScript files, and writing the final HTML content #' to a specified output file. #' #' @param toc A string containing the table of contents in HTML format. -#' @param html_content A string containing the main HTML content with a +#' @param html_content A string containing the main HTML content with a #' placeholder for the table of contents. -#' @param report_info A list containing report information such as +#' @param report_info A list containing report information such as #' `contact_info` and `analyst_name`. -#' @param output_file_path A string specifying the path where the final +#' @param output_file_path A string specifying the path where the final #' HTML file will be written. -#' +#' generate_and_write_html <- function( toc, html_content, report_info, - output_file_path -) { - + output_file_path) { output_file_path <- normalizePath( output_file_path, mustWork = FALSE - ) - + ) + # Close the Table of Contents toc <- paste( toc, "
    ", sep = "\n" - ) - + ) + # Insert the Table of Contents at the placeholder html_content <- gsub( "", toc, html_content - ) - + ) + # Append a horizontal line after the TOC html_content <- gsub( "", "\n
    ", html_content - ) - + ) + # Path to the external JavaScript file within the package js_file_path <- normalizePath( system.file( "www/hotkeys.js", package = "SplineOmics" - ), + ), mustWork = FALSE - ) + ) if (js_file_path == "") { stop("JavaScript file not found.") } - + # Read the JavaScript file and replace placeholders with actual values js_content <- readLines( js_file_path, encoding = "UTF-8" - ) + ) js_content <- gsub( "\\{\\{email\\}\\}", report_info$contact_info, js_content - ) + ) js_content <- gsub( "\\{\\{name\\}\\}", report_info$analyst_name, js_content - ) - + ) + # Read the content of JSZip and FileSaver JavaScript files as text jszip_path <- normalizePath( system.file( "www/jszip.min.js", package = "SplineOmics" - ), + ), mustWork = FALSE - ) + ) filesaver_path <- normalizePath( system.file( "www/FileSaver.min.js", package = "SplineOmics" - ), + ), mustWork = FALSE - ) - + ) + if (!file.exists(jszip_path)) { stop("JSZip file not found at: ", jszip_path) } if (!file.exists(filesaver_path)) { stop("FileSaver.js file not found at: ", filesaver_path) } - + jszip_content <- readLines( jszip_path, encoding = "UTF-8", warn = FALSE - ) + ) filesaver_content <- readLines( filesaver_path, encoding = "UTF-8", warn = FALSE - ) - + ) + # Combine all JavaScript content combined_js_content <- c( "" ) - + # Properly escape special characters in JavaScript content combined_js_content <- paste( combined_js_content, collapse = "\n" - ) + ) combined_js_content <- gsub( "\\\\", "\\\\\\\\", combined_js_content - ) # Escape backslashes - combined_js_content <- gsub( # Escape double quotes + ) # Escape backslashes + combined_js_content <- gsub( # Escape double quotes "\"", "\\\"", combined_js_content - ) - + ) + # Embed the combined JavaScript content before the closing body tag script_tag <- paste( combined_js_content, collapse = "\n" - ) + ) html_content <- gsub( "", paste( script_tag, "", sep = "\n" - ), + ), html_content - ) - + ) + # Append the final closing tags for the HTML body and document html_content <- paste( html_content, "", sep = "\n" - ) - + ) + # Ensure the directory exists dir_path <- dirname(output_file_path) if (!dir.exists(dir_path)) { dir.create(dir_path, recursive = TRUE) } - + con <- file( output_file_path, "w", encoding = "UTF-8" - ) + ) writeLines( html_content, con, useBytes = TRUE - ) + ) close(con) } @@ -533,28 +533,27 @@ generate_and_write_html <- function( #' Read and split section texts from a file #' #' @description -#' This internal function reads the contents of a text file located in the -#' `inst/descriptions` directory of the package and splits it into individual +#' This internal function reads the contents of a text file located in the +#' `inst/descriptions` directory of the package and splits it into individual #' sections based on a specified delimiter. #' -#' @param filename A character string specifying the name of the file -#' containing the section texts. The file should be located in the +#' @param filename A character string specifying the name of the file +#' containing the section texts. The file should be located in the #' `inst/descriptions` directory of the package. #' -#' @return A character vector where each element is a section of the text +#' @return A character vector where each element is a section of the text #' split by the delimiter `|`. -#' +#' read_section_texts <- function(filename) { - file_path <- system.file( "descriptions", filename, package = "SplineOmics" - ) + ) content <- readLines( file_path, warn = FALSE - ) |> paste(collapse = " ") + ) |> paste(collapse = " ") # Split the content by the delimiter strsplit(content, "\\|")[[1]] } @@ -567,19 +566,18 @@ read_section_texts <- function(filename) { #' #' @description #' This function takes a character vector `text` and splits it into individual -#' characters. It then iterates over the characters and builds lines not +#' characters. It then iterates over the characters and builds lines not #' exceeding #' a specified character limit (default 70). Newlines are inserted between lines #' using the `
    ` tag, suitable for HTML display. -#' +#' #' @param text A character vector to be formatted. -#' +#' #' @return A character vector with formatted text containing line breaks. -#' +#' format_text <- function(text) { - letters <- strsplit(text, "")[[1]] - formatted_lines <- vector(mode = "character", length = 0) + formatted_lines <- vector(mode = "character", length = 0) current_line <- "" for (char in letters) { if (nchar(current_line) + nchar(char) <= 70) { @@ -589,7 +587,7 @@ format_text <- function(text) { current_line <- char } } - formatted_lines <- c(formatted_lines, current_line) + formatted_lines <- c(formatted_lines, current_line) formatted_text <- paste(formatted_lines, collapse = "
    ") } @@ -597,16 +595,16 @@ format_text <- function(text) { #' Get Header Section #' #' @description -#' Generates the HTML header section for a report, including the title, header -#' text, and logo. This section also includes the styling for the table and +#' Generates the HTML header section for a report, including the title, header +#' text, and logo. This section also includes the styling for the table and #' other HTML elements. #' #' @param title A string specifying the title of the HTML document. -#' @param header_text A string specifying the text to be displayed in the +#' @param header_text A string specifying the text to be displayed in the #' header of the report. #' @param report_type A character specifying the type of HTML report. -#' @param feature_names_formula String describing which columns of the -#' annotation info, such as gene and uniprotID, +#' @param feature_names_formula String describing which columns of the +#' annotation info, such as gene and uniprotID, #' where used to construct the description above #' the individual spline plots. This is placed in #' the beginning of the output HTML reports. @@ -614,72 +612,70 @@ format_text <- function(text) { #' @return A string containing the HTML header section. #' #' @details -#' The function checks the `DEVTOOLS_LOAD` environment variable to determine -#' the path to the logo image. The logo image is then converted to a base64 -#' data URI and included in the HTML. The header section includes styles for -#' tables, table cells, and header elements to ensure proper formatting and +#' The function checks the `DEVTOOLS_LOAD` environment variable to determine +#' the path to the logo image. The logo image is then converted to a base64 +#' data URI and included in the HTML. The header section includes styles for +#' tables, table cells, and header elements to ensure proper formatting and #' alignment. #' #' @importFrom base64enc dataURI -#' +#' get_header_section <- function( title, header_text, report_type, - feature_names_formula - ) { - + feature_names_formula) { if (feature_names_formula == "") { feature_names_formula <- "No feature name columns provided!" } - + if (Sys.getenv("DEVTOOLS_LOAD") == "true") { logo_path <- file.path( "inst", "logos", "SplineOmics_logo.png" - ) + ) } else { logo_path <- system.file( "logos", "SplineOmics_logo.png", package = "SplineOmics" - ) + ) } - + logo_base64 <- base64enc::dataURI(file = logo_path, mime = "image/png") header_section <- paste( "", title, "", - "", # Ensure UTF-8 encoding (JavaScript issues) + "", # Ensure UTF-8 encoding (JavaScript issues) "", @@ -689,115 +685,115 @@ get_header_section <- function( "", sep = "" ) - - note <- switch( - report_type, + + note <- switch(report_type, "explore_data" = paste( - '
    ', - '
    Note!
    ', '

    ', "This HTML report contains the exploratory", - "data analysis plots, (e.g. density plots)
    Right-click on", + "data analysis plots, (e.g. density plots)
    Right-click on", "any plot in this report to save it as a .svg (vector graphic) file!

    ", - '
    ' - ), + "" + ), "screen_limma_hyperparams" = '

    ', "create_limma_report" = paste( '
    ', '
    Note!
    ', '

    ', "This HTML report contains plots visualizing the results from", "the limma topTables.
    Right-click on", "any plot in this report to save it as a .svg (vector graphic) file!", - '

    To understand the three limma result categories shown in this ', - 'report, please
    To understand the three limma result categories shown in this ", + 'report, please
    download and review this PDF document

    The grey shaded areas of the plots in this report cover the non-significant features!

    ', - '
    ' + "" ), "cluster_hits" = paste( - '
    ', - '
    Note!
    ', '

    ', - '

    ', + "", + "

    ", + "", paste( '', - 'feature_name "formula": ', - '{annotation-column-x}_{annotation-column-y}_ ... :', - '
    ', - feature_names_formula, - '
    ' - ), - '' + 'feature_name "formula": ', + "{annotation-column-x}_{annotation-column-y}_ ... :", + "
    ", + feature_names_formula, + "" ), - "create_gsea_report" = '

    ') + "" + ), + "create_gsea_report" = '

    ' + ) hotkeys_box <- paste( '
    ', '
    Hotkeys
    ', '

    ', "Press:
    ", - "t --> Jump to Table of Contents and save current scroll", + "t --> Jump to Table of Contents and save current scroll", "position \U0001F4D1
    ", "s --> Save current scroll position \U0001F4CC
    ", "b --> Jump back to saved position \U0001F519
    ", "d --> Download all embedded files as zip \U0001F4E5
    ", "e --> Write an email to contact info \u2709
    ", - '

    ', - '
    ' + "

    ", + "" ) - - + + header_section <- paste( header_section, "

    ", note, "

    ", @@ -806,7 +802,7 @@ get_header_section <- function( "", sep = "" ) - + return(header_section) } @@ -814,97 +810,99 @@ get_header_section <- function( #' Encode DataFrame to Base64 for HTML Embedding #' #' @description -#' This function takes a dataframe as input and returns a base64 encoded -#' CSV object. The encoded object can be embedded into an HTML document -#' directly, with a button to download the file without pointing to a +#' This function takes a dataframe as input and returns a base64 encoded +#' CSV object. The encoded object can be embedded into an HTML document +#' directly, with a button to download the file without pointing to a #' local file. #' #' @param df A dataframe to be encoded. #' @param report_type (Optional) A string specifying for which report generation #' this function is called. Generates different Excel sheet #' names based on the report_type. -#' +#' #' @return A character string containing the base64 encoded CSV data. -#' +#' #' @importFrom openxlsx createWorkbook addWorksheet writeData saveWorkbook -#' +#' encode_df_to_base64 <- function( df, - report_type = NA - ) { - + report_type = NA) { temp_file <- tempfile(fileext = ".xlsx") wb <- openxlsx::createWorkbook() - + if (is.data.frame(df)) { # Convert single dataframe to Excel with one sheet sheet_name <- "Sheet1" openxlsx::addWorksheet( wb, sheet_name - ) + ) openxlsx::writeData( wb, sheet = sheet_name, df - ) - } else if (is.list(df) && all(sapply(df, is.data.frame))) { + ) + } else if (is.list(df) && all(vapply(df, is.data.frame, logical(1)))) { # Convert list of dataframes to Excel with multiple sheets - + if (!is.na(report_type)) { if (report_type == "create_gsea_report") { all_names <- names(df) - sheet_names <- sapply(all_names, extract_and_combine) + sheet_names <- vapply( + all_names, + extract_and_combine, + character(1) + ) } } else { sheet_names <- make.unique(names(df)) } - - + + for (i in seq_along(sheet_names)) { openxlsx::addWorksheet( wb, sheet_names[i] - ) + ) openxlsx::writeData( wb, sheet = sheet_names[i], df[[i]] - ) + ) } } else { stop("Input must be a dataframe or a list of dataframes.") } - + openxlsx::saveWorkbook( wb, temp_file, overwrite = TRUE - ) - + ) + # Read the file and encode to base64 file_content <- readBin( - temp_file, + temp_file, "raw", file.info(temp_file)$size - ) + ) base64_file <- base64enc::base64encode(file_content) - + # Determine MIME type - mime_type <- + mime_type <- "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" - + # Create the data URI scheme data_uri <- paste0( "data:", mime_type, ";base64,", base64_file - ) - + ) + # Remove the temporary file unlink(temp_file) - + return(data_uri) } @@ -912,7 +910,7 @@ encode_df_to_base64 <- function( #' Convert Plot to Base64 #' #' @description -#' Converts a ggplot2 plot to a Base64-encoded PNG image and returns an HTML +#' Converts a ggplot2 plot to a Base64-encoded PNG image and returns an HTML #' img tag for embedding in a report. #' #' @param plot A ggplot2 plot object. @@ -921,7 +919,7 @@ encode_df_to_base64 <- function( #' @param width A numeric value specifying the width of the plot in inches. #' @param base_height_per_row A numeric value specifying the base height per #' row in inches. -#' @param units A character string specifying the units for the width and +#' @param units A character string specifying the units for the width and #' height. #' @param html_img_width A character string specifying the width of the image #' in HTML. @@ -931,58 +929,56 @@ encode_df_to_base64 <- function( #' #' @seealso #' \link[base64enc]{dataURI} -#' +#' #' @importFrom ggplot2 ggsave #' @importFrom base64enc dataURI #' @importFrom svglite svglite -#' +#' plot2base64 <- function( - plot, - height, - width = 7, - base_height_per_row = 2.5, - units = "in", - html_img_width = "100%" - ) { - + plot, + height, + width = 7, + base_height_per_row = 2.5, + units = "in", + html_img_width = "100%") { additional_height_per_row <- 2.1 height <- base_height_per_row + (height - 1) * additional_height_per_row - - # Create a temporary file for the SVG. SVG does not specify the quality + + # Create a temporary file for the SVG. SVG does not specify the quality # already, but later, after exporting the figures from the HTML, you can # specify the quality. img_file <- tempfile(fileext = ".svg") svglite::svglite(file = img_file, width = width, height = height) - + # Draw the plot print(plot) # Turn off the device dev.off() - + # Read the SVG file content svg_content <- readLines(img_file, warn = FALSE) - + # Convert the SVG content to a single string svg_string <- paste(svg_content, collapse = "\n") - + # Encode the SVG content as base64 svg_base64 <- base64enc::dataURI( charToRaw(svg_string), mime = "image/svg+xml" - ) - + ) + # Delete the temporary SVG file unlink(img_file) - + # Return the HTML img tag with the base64 string and a fixed width return( sprintf( - 'Plot', + 'Plot', svg_base64, html_img_width - ) ) + ) } @@ -992,17 +988,16 @@ plot2base64 <- function( #' Creates the HTML content for the Table of Contents. #' #' @return A string containing the HTML for the Table of Contents. -#' +#' create_toc <- function() { - toc <- paste( - "
    ", - "
    ", - "

    Table of Contents

    ", - "
    " ) # Start a new row for each plot grid_content <- paste0( @@ -1112,18 +1103,18 @@ process_plots <- function( ) grid_content <- paste0( grid_content, - '
    ', base64_list[[i]]$plot, '
    ' + '
    ', base64_list[[i]]$plot, "
    " ) - - grid_content <- paste0(grid_content, '') - + + grid_content <- paste0(grid_content, "") + # Add a horizontal line after each plot grid_content <- paste0( grid_content, '
    ' ) } - + # Add the grid content to the HTML content html_content <- paste( html_content, @@ -1132,7 +1123,7 @@ process_plots <- function( ) } else if ( !is.na(element_name) && - element_name == "cluster_mean_splines" + element_name == "cluster_mean_splines" ) { # One plot for each cluster for (i in seq_along(plots_element)) { @@ -1149,7 +1140,7 @@ process_plots <- function( header_index ) } - + return( list( html_content = html_content, @@ -1163,26 +1154,26 @@ process_plots <- function( #' Process and Encode Data Field for Report #' #' @description -#' This function processes a given field, encodes the associated data as base64, -#' and generates a download link for the report. It handles different types of +#' This function processes a given field, encodes the associated data as base64, +#' and generates a download link for the report. It handles different types of #' fields including data, meta, top tables, and Enrichr formatted gene lists. #' #' @param field A string specifying the field to process. #' @param data A dataframe containing the main data. #' @param meta A dataframe containing meta information. -#' @param topTables A dataframe containing the results of differential +#' @param topTables A dataframe containing the results of differential #' expression analysis. #' @param report_info A list containing additional report information. #' @param encode_df_to_base64 A function to encode a dataframe to base64. #' @param report_type A string specifying the type of report. -#' @param enrichr_format A list with the formatted gene lists and background +#' @param enrichr_format A list with the formatted gene lists and background #' gene list. #' -#' @return A string containing the HTML link for downloading the processed +#' @return A string containing the HTML link for downloading the processed #' field. #' #' @importFrom base64enc base64encode -#' +#' process_field <- function( field, data, @@ -1191,47 +1182,40 @@ process_field <- function( report_info, encode_df_to_base64, report_type, - enrichr_format -) { - - if (field == "data_with_annotation") { + enrichr_format) { + if (field == "data_with_annotation") { base64_df <- sprintf( ' - ', + ', encode_df_to_base64(data) ) - } else if (field == "meta" && - !is.null(meta) && - is.data.frame(meta) && - !any(is.na(meta))) { + !is.null(meta) && + is.data.frame(meta) && + !any(is.na(meta))) { base64_df <- sprintf( ' - ', + ', encode_df_to_base64(meta) ) - - } else if (field == "limma_topTables_clustered_time_effect_hits" - && !any(is.na(topTables))) { + } else if (field == "limma_topTables_clustered_time_effect_hits" && + !any(is.na(topTables))) { base64_df <- sprintf( ' - ', + ', encode_df_to_base64(topTables) ) - - } else if (field == "limma_topTables" && !any(is.na(topTables))) { + } else if (field == "limma_topTables" && !any(is.na(topTables))) { base64_df <- sprintf( ' - ', + ', encode_df_to_base64(topTables) ) - - } else if (field == "Enrichr_clustered_genes" && - !any(is.na(enrichr_format)) && - !is.null(enrichr_format$gene_lists)) { - + } else if (field == "Enrichr_clustered_genes" && + !any(is.na(enrichr_format)) && + !is.null(enrichr_format$gene_lists)) { # Create ZIP file for Enrichr_clustered_genes zip_base64 <- create_enrichr_zip(enrichr_format) base64_df <- sprintf( @@ -1240,31 +1224,27 @@ process_field <- function( ', zip_base64 ) - - } else if (field == "Enrichr_background" && - !any(is.na(enrichr_format)) && - !is.null(enrichr_format$background)) { - + } else if (field == "Enrichr_background" && + !any(is.na(enrichr_format)) && + !is.null(enrichr_format$background)) { base64_df <- sprintf( - ' ', base64enc::base64encode(charToRaw(enrichr_format$background)) ) - } else if (field == "session_info") { # Capture session info and encode to base64 on-the-fly session_details <- sessionInfo() session_info <- paste(capture.output(session_details), collapse = "\n") base64_session_info <- base64enc::base64encode(charToRaw(session_info)) - + base64_df <- sprintf( - ' ', base64_session_info ) - } else { base64_df <- ifelse( is.null(report_info[[field]]), @@ -1280,7 +1260,6 @@ process_field <- function( extract_and_combine <- function(input) { - # Extract substring after 'cluster:' and before the next ',' cluster_match <- regmatches( input, @@ -1288,9 +1267,9 @@ extract_and_combine <- function(input) { "(?<=cluster: )[^,]+", input, perl = TRUE - ) ) - + ) + # Extract substring after 'database:' database_match <- regmatches( input, @@ -1298,17 +1277,17 @@ extract_and_combine <- function(input) { "(?<=database: )[^,]+", input, perl = TRUE - ) ) - + ) + # Combine the substrings with a whitespace in between combined <- paste(cluster_match, database_match, sep = " ") - + # Truncate the combined string to 30 characters if necessary if (nchar(combined) > 30) { combined <- substr(combined, 1, 30) } - + return(combined) } @@ -1316,57 +1295,54 @@ extract_and_combine <- function(input) { #' Create a ZIP File for Enrichr Gene Lists #' #' @description -#' This function creates a ZIP file containing directories for each level of -#' gene lists. Each directory contains text files for each cluster. The ZIP file +#' This function creates a ZIP file containing directories for each level of +#' gene lists. Each directory contains text files for each cluster. The ZIP file #' is then encoded to base64 for easy download. #' -#' @param enrichr_format A list with the formatted gene lists and background +#' @param enrichr_format A list with the formatted gene lists and background #' gene list, typically the output of `prepare_gene_lists_for_enrichr`. #' #' @return A base64-encoded string representing the ZIP file. #' #' @details -#' The function creates a temporary directory to store the files. For each level -#' in the `enrichr_format$gene_lists`, it creates a directory named after the -#' level. Within each level directory, it creates a text file for each cluster, -#' containing the genes in that cluster. The directories and files are added +#' The function creates a temporary directory to store the files. For each level +#' in the `enrichr_format$gene_lists`, it creates a directory named after the +#' level. Within each level directory, it creates a text file for each cluster, +#' containing the genes in that cluster. The directories and files are added #' to a ZIP file, which is then encoded to base64. #' #' @importFrom zip zip #' @importFrom base64enc base64encode -#' +#' create_enrichr_zip <- function(enrichr_format) { - temp_dir <- tempfile(pattern = "enrichr") dir.create(temp_dir) zip_file <- tempfile(fileext = ".zip") - + for (level in names(enrichr_format$gene_lists)) { - level_dir <- file.path(temp_dir, level) dir.create(level_dir, recursive = TRUE) - + for (cluster in names(enrichr_format$gene_lists[[level]])) { - cluster_file <- file.path(level_dir, paste0(cluster, ".txt")) writeLines(enrichr_format$gene_lists[[level]][[cluster]], cluster_file) } } - + # Create the ZIP file using relative paths original_wd <- getwd() setwd(temp_dir) files_to_zip <- list.files(temp_dir, recursive = TRUE) zip::zip(zipfile = zip_file, files = files_to_zip) setwd(original_wd) - + # Read the ZIP file and encode it to base64 zip_base64 <- base64enc::base64encode(zip_file) - + # Clean up temporary directory and files unlink(temp_dir, recursive = TRUE) unlink(zip_file) - + return(zip_base64) } @@ -1374,7 +1350,7 @@ create_enrichr_zip <- function(enrichr_format) { #' Add Plot to HTML Content #' #' @description -#' This function converts a plot to a base64 image and adds it to the +#' This function converts a plot to a base64 image and adds it to the #' HTML content. #' #' @param html_content The current HTML content as a character string. @@ -1388,17 +1364,16 @@ add_plot_to_html <- function( html_content, plot_element, plots_size, - section_index -) { + section_index) { img_tag <- plot2base64( plot_element, height = plots_size - ) + ) paste( html_content, '
    ', img_tag, - '
    ', + "", '
    ', sep = "\n" ) diff --git a/README.Rmd b/README.Rmd index b21cf39..9f2e4ac 100755 --- a/README.Rmd +++ b/README.Rmd @@ -52,7 +52,8 @@ If you have -omics data over time, the package will help you to run `limma` with ### What do I need precisely? -1. **Data**: A data matrix where each row is a feature (e.g., protein, metabolite, etc.) and each column is a sample taken at a specific time. The data must have no NA values and should have normally distributed features. +1. **Data**: A data matrix where each row is a feature (e.g., protein, metabolite, etc.) and each column is a sample taken at a specific time. The data must have no NA values, should have normally distributed features and no +dependence between the samples. 2. **Meta**: A table with metadata on the columns/samples of the data matrix (e.g., batch, time point, etc.) @@ -103,7 +104,11 @@ custom_lib_path <- path.expand("~/Rlibs") # Create the directory if it doesn't exist if (!dir.exists(custom_lib_path)) { - dir.create(custom_lib_path, showWarnings = FALSE, recursive = TRUE) + dir.create( + custom_lib_path, + showWarnings = FALSE, + recursive = TRUE + ) } # Set the library path to include the new directory @@ -293,6 +298,8 @@ For those interested in gaining a deeper understanding of the methodologies used - **limma**: To read about the `limma` R package, you can refer to this [publication](https://doi.org/10.1093/nar/gkv007). +- **PCA**: To learn more about PCA, download and read this [document](https://github.com/csbg/SplineOmics/raw/main/docs/Points_of_Significance_PCA.pdf). + - **Hierarchical clustering**: To get information about hierarchical clustering, you can refer to this [web article](https://towardsdatascience.com/understanding-the-concept-of-hierarchical-clustering-technique-c6e8243758ec). ## ❓ Getting Help diff --git a/README.md b/README.md index 6ad96af..33d2ce3 100755 --- a/README.md +++ b/README.md @@ -67,8 +67,8 @@ abundances, etc.). 1. **Data**: A data matrix where each row is a feature (e.g., protein, metabolite, etc.) and each column is a sample taken at a specific - time. The data must have no NA values and should have normally - distributed features. + time. The data must have no NA values, should have normally + distributed features and no dependence between the samples. 2. **Meta**: A table with metadata on the columns/samples of the data matrix (e.g., batch, time point, etc.) @@ -141,7 +141,11 @@ custom_lib_path <- path.expand("~/Rlibs") # Create the directory if it doesn't exist if (!dir.exists(custom_lib_path)) { - dir.create(custom_lib_path, showWarnings = FALSE, recursive = TRUE) + dir.create( + custom_lib_path, + showWarnings = FALSE, + recursive = TRUE + ) } # Set the library path to include the new directory @@ -402,6 +406,9 @@ recommended publications: - **limma**: To read about the `limma` R package, you can refer to this [publication](https://doi.org/10.1093/nar/gkv007). +- **PCA**: To learn more about PCA, download and read this + [document](https://github.com/csbg/SplineOmics/raw/main/docs/Points_of_Significance_PCA.pdf). + - **Hierarchical clustering**: To get information about hierarchical clustering, you can refer to this [web article](https://towardsdatascience.com/understanding-the-concept-of-hierarchical-clustering-technique-c6e8243758ec). diff --git a/SplineOmics.BiocCheck/00BiocCheck.log b/SplineOmics.BiocCheck/00BiocCheck.log index 12b0ba5..4c33804 100755 --- a/SplineOmics.BiocCheck/00BiocCheck.log +++ b/SplineOmics.BiocCheck/00BiocCheck.log @@ -1,7 +1,6 @@ * Checking for deprecated package usage... OK * Checking for remote package usage... OK -* Checking for 'LazyData: true' usage... -* NOTE: 'LazyData:' in the 'DESCRIPTION' should be set to false or removed +* Checking for 'LazyData: true' usage... OK * Checking version number... OK * Checking version number validity... OK * Checking R version dependency... OK @@ -9,29 +8,32 @@ * Checking individual file sizes... * WARNING: Package files exceed the 5MB size limit. Files over the limit: -/home/thomasrauter/Documents/PhD/projects/DGTX/R_packages/SplineOmics/inst/reports/cluster_hits_report.html +/home/thomas/Documents/PhD/projects/DGTX/R_packages/SplineOmics/inst/reports/cluster_hits_report.html * Checking biocViews... OK -* Checking that biocViews are present... -* ERROR: No biocViews terms found. +* Checking that biocViews are present... OK +* Checking package type based on biocViews... OK +* Checking for non-trivial biocViews... OK +* Checking that biocViews come from the same category... OK +* Checking biocViews validity... +* WARNING: Invalid BiocViews term(s): +'Spline' +* Checking for recommended biocViews... OK * Checking build system compatibility... OK * Checking for blank lines in DESCRIPTION... OK * Checking if DESCRIPTION is well formatted... OK -* Checking for proper Description: field... -* NOTE: The Description field in the DESCRIPTION is made up by less than 3 sentences. Please consider expanding this field, and structure it as a full paragraph +* Checking for proper Description: field... OK * Checking for whitespace in DESCRIPTION field names... OK * Checking that Package field matches directory/tarball name... OK * Checking for Version field... OK * Checking for valid maintainer... -* ERROR: Use only the Authors@R field not Author/Maintainer fields. -* NOTE: Consider adding the maintainer's ORCID iD in 'Authors@R' with 'comment=c(ORCID="...")' +* NOTE: Invalid ORCID iD for Thomas Rauter * Checking License: for restrictive use... OK -* Checking for recommeded fields in DESCRIPTION... -* NOTE: Provide 'BugReports' field(s) in DESCRIPTION +* Checking for recommeded fields in DESCRIPTION... OK * Checking for pinned package versions... OK -* Checking DESCRIPTION/NAMESPACE consistency... -* WARNING: Import grDevices, grid, splines, stats, tools, utils in DESCRIPTION as well as NAMESPACE. +* Checking DESCRIPTION/NAMESPACE consistency... OK * Checking .Rbuildignore... OK -* Checking for stray BiocCheck output folders... OK +* Checking for stray BiocCheck output folders... +* ERROR: Remove 'SplineOmics.BiocCheck' from the package directory * Checking for inst/doc folders... OK * Checking vignette directory... * WARNING: Evaluate more vignette chunks. @@ -44,212 +46,114 @@ vignettes/get-started.Rmd * Checking package installation calls in R code... * NOTE: Avoid using install, biocLite, install.packages, or update.packages Functions in files: -install.packages() in R/open_tutorial_and_template.R (line 32, column 16) -install.packages() in R/open_tutorial_and_template.R (line 92, column 16) -install.packages() in R/preprocess_rna_seq_data.R (line 70, column 18) -install() in R/preprocess_rna_seq_data.R (line 74, column 26) -install.packages() in R/run_gsea.R (line 222, column 18) -install() in R/run_gsea.R (line 227, column 26) +install.packages() in R/preprocess_rna_seq_data.R (line 68, column 18) +install() in R/preprocess_rna_seq_data.R (line 72, column 26) +install.packages() in R/run_gsea.R (line 219, column 18) +install() in R/run_gsea.R (line 224, column 26) * Checking for library/require of SplineOmics... OK * Checking coding practice... -* NOTE: Avoid sapply(); use vapply() -Found in files: -R/cluster_hits.R (line 931, column 20) -R/cluster_hits.R (line 3055, column 3) -R/create_limma_report.R (line 157, column 16) -R/download_enrichr_databases.R (line 157, column 21) -R/extract_data.R (line 76, column 11) -R/extract_data.R (line 100, column 14) -R/run_gsea.R (line 58, column 6) -R/run_gsea.R (line 620, column 12) -R/run_gsea.R (line 865, column 17) -R/run_gsea.R (line 1105, column 19) -R/run_gsea.R (line 1107, column 17) -R/run_limma_splines.R (line 536, column 12) -R/run_limma_splines.R (line 537, column 28) -R/screen_limma_hyperparams.R (line 762, column 20) -R/screen_limma_hyperparams.R (line 763, column 20) -R/screen_limma_hyperparams.R (line 956, column 18) -R/utils_input_validation.R (line 129, column 15) -R/utils_input_validation.R (line 187, column 15) -R/utils_input_validation.R (line 236, column 15) -R/utils_input_validation.R (line 286, column 15) -R/utils_input_validation.R (line 321, column 15) -R/utils_input_validation.R (line 328, column 39) -R/utils_input_validation.R (line 343, column 31) -R/utils_input_validation.R (line 381, column 35) -R/utils_input_validation.R (line 430, column 15) -R/utils_input_validation.R (line 510, column 15) -R/utils_input_validation.R (line 539, column 15) -R/utils_input_validation.R (line 615, column 15) -R/utils_input_validation.R (line 652, column 15) -R/utils_input_validation.R (line 741, column 15) -R/utils_input_validation.R (line 802, column 15) -R/utils_input_validation.R (line 807, column 16) -R/utils_input_validation.R (line 840, column 15) -R/utils_input_validation.R (line 911, column 15) -R/utils_input_validation.R (line 1018, column 15) -R/utils_input_validation.R (line 1069, column 15) -R/utils_input_validation.R (line 1111, column 15) -R/utils_input_validation.R (line 1144, column 15) -R/utils_input_validation.R (line 1171, column 28) -R/utils_input_validation.R (line 1214, column 24) -R/utils_input_validation.R (line 1276, column 15) -R/utils_input_validation.R (line 1284, column 11) -R/utils_input_validation.R (line 1329, column 15) -R/utils_input_validation.R (line 1736, column 16) -R/utils_input_validation.R (line 1784, column 18) -R/utils_input_validation.R (line 2044, column 23) -R/utils_input_validation.R (line 2416, column 6) -R/utils_input_validation.R (line 2457, column 32) -R/utils_report_generation.R (line 815, column 33) -R/utils_report_generation.R (line 821, column 24) * NOTE: Avoid 1:...; use seq_len() or seq_along() Found in files: -cluster_hits.R (line 1185, column 31) -cluster_hits.R (line 1531, column 44) -cluster_hits.R (line 1558, column 38) -cluster_hits.R (line 1771, column 15) -cluster_hits.R (line 1776, column 48) -cluster_hits.R (line 2089, column 15) -cluster_hits.R (line 2097, column 54) -cluster_hits.R (line 2098, column 54) -cluster_hits.R (line 2842, column 26) -cluster_hits.R (line 2850, column 12) -cluster_hits.R (line 2935, column 21) -explore_data.R (line 607, column 43) -explore_data.R (line 685, column 17) -explore_data.R (line 785, column 17) -extract_data.R (line 101, column 27) -extract_data.R (line 166, column 17) -extract_data.R (line 167, column 19) -run_gsea.R (line 949, column 13) -run_gsea.R (line 951, column 15) -screen_limma_hyperparams.R (line 478, column 13) -screen_limma_hyperparams.R (line 480, column 15) -screen_limma_hyperparams.R (line 963, column 13) -screen_limma_hyperparams.R (line 1231, column 13) -screen_limma_hyperparams.R (line 1417, column 49) +cluster_hits.R (line 1177, column 31) +cluster_hits.R (line 1525, column 45) +cluster_hits.R (line 1553, column 38) +cluster_hits.R (line 1731, column 15) +cluster_hits.R (line 1736, column 48) +cluster_hits.R (line 2021, column 15) +cluster_hits.R (line 2029, column 54) +cluster_hits.R (line 2030, column 54) +cluster_hits.R (line 2797, column 26) +cluster_hits.R (line 2805, column 13) +cluster_hits.R (line 2887, column 21) +explore_data.R (line 601, column 43) +explore_data.R (line 681, column 17) +explore_data.R (line 787, column 17) +extract_data.R (line 99, column 27) +extract_data.R (line 162, column 17) +extract_data.R (line 163, column 19) +run_gsea.R (line 947, column 13) +run_gsea.R (line 949, column 15) +screen_limma_hyperparams.R (line 472, column 13) +screen_limma_hyperparams.R (line 474, column 15) +screen_limma_hyperparams.R (line 954, column 13) +screen_limma_hyperparams.R (line 1214, column 13) +screen_limma_hyperparams.R (line 1393, column 28) * NOTE: Avoid 'cat' and 'print' outside of 'show' methods Found in files: -cat() in R/cluster_hits.R (line 364, column 11) -print() in R/cluster_hits.R (line 358, column 11) -print() in R/cluster_hits.R (line 716, column 3) -cat() in R/open_tutorial_and_template.R (line 24, column 7) -cat() in R/open_tutorial_and_template.R (line 25, column 7) -cat() in R/open_tutorial_and_template.R (line 26, column 7) -cat() in R/open_tutorial_and_template.R (line 27, column 7) -cat() in R/open_tutorial_and_template.R (line 44, column 9) -cat() in R/open_tutorial_and_template.R (line 84, column 7) -cat() in R/open_tutorial_and_template.R (line 85, column 7) -cat() in R/open_tutorial_and_template.R (line 86, column 7) -cat() in R/open_tutorial_and_template.R (line 87, column 7) -cat() in R/open_tutorial_and_template.R (line 104, column 9) -print() in R/run_gsea.R (line 860, column 7) -cat() in R/screen_limma_hyperparams.R (line 496, column 3) -print() in R/screen_limma_hyperparams.R (line 286, column 3) -print() in R/screen_limma_hyperparams.R (line 368, column 3) -cat() in R/utils_general.R (line 189, column 3) -print() in R/utils_report_generation.R (line 924, column 3) -* NOTE: Avoid using '=' for assignment and use '<-' instead -Found in files: -R/cluster_hits.R (line 1331, column 18) -R/cluster_hits.R (line 1553, column 19) -R/cluster_hits.R (line 3123, column 19) -R/explore_data.R (line 82, column 13) -R/run_gsea.R (line 798, column 25) -R/run_gsea.R (line 830, column 27) -R/run_gsea.R (line 845, column 22) -R/run_gsea.R (line 847, column 22) +print() in R/cluster_hits.R (line 354, column 11) +print() in R/cluster_hits.R (line 710, column 3) +print() in R/run_gsea.R (line 856, column 7) +print() in R/utils_report_generation.R (line 955, column 3) * NOTE: Avoid the use of 'paste' in condition signals Found in files: -R/cluster_hits.R (line 309, column 15) -R/cluster_hits.R (line 917, column 11) -R/cluster_hits.R (line 924, column 11) -R/cluster_hits.R (line 1977, column 17) -R/extract_data.R (line 78, column 7) -R/extract_data.R (line 201, column 14) -R/extract_data.R (line 378, column 12) -R/extract_data.R (line 389, column 13) -R/run_gsea.R (line 172, column 12) -R/run_gsea.R (line 285, column 11) -R/run_gsea.R (line 510, column 10) -R/run_gsea.R (line 519, column 12) -R/run_gsea.R (line 526, column 12) -R/run_gsea.R (line 568, column 12) -R/run_gsea.R (line 584, column 18) -R/run_gsea.R (line 804, column 15) -R/run_limma_splines.R (line 152, column 13) -R/screen_limma_hyperparams.R (line 709, column 10) -R/splineomics_object.R (line 133, column 12) -R/utils_input_validation.R (line 148, column 16) +R/cluster_hits.R (line 306, column 15) +R/cluster_hits.R (line 914, column 11) +R/cluster_hits.R (line 921, column 11) +R/cluster_hits.R (line 1897, column 17) +R/extract_data.R (line 199, column 14) +R/extract_data.R (line 388, column 9) +R/extract_data.R (line 400, column 13) +R/run_gsea.R (line 168, column 12) +R/run_gsea.R (line 280, column 11) +R/run_gsea.R (line 498, column 10) +R/run_gsea.R (line 506, column 12) +R/run_gsea.R (line 516, column 9) +R/run_gsea.R (line 560, column 9) +R/run_gsea.R (line 581, column 9) +R/run_gsea.R (line 800, column 15) +R/run_limma_splines.R (line 150, column 13) +R/screen_limma_hyperparams.R (line 697, column 10) +R/splineomics_object.R (line 129, column 12) +R/utils_input_validation.R (line 145, column 13) R/utils_input_validation.R (line 153, column 16) -R/utils_input_validation.R (line 241, column 14) -R/utils_input_validation.R (line 335, column 18) -R/utils_input_validation.R (line 347, column 18) -R/utils_input_validation.R (line 385, column 18) -R/utils_input_validation.R (line 397, column 16) -R/utils_input_validation.R (line 451, column 11) -R/utils_input_validation.R (line 944, column 15) -R/utils_input_validation.R (line 964, column 15) -R/utils_input_validation.R (line 977, column 13) -R/utils_input_validation.R (line 1074, column 14) -R/utils_input_validation.R (line 1078, column 14) -R/utils_input_validation.R (line 1197, column 14) -R/utils_input_validation.R (line 1290, column 11) -R/utils_input_validation.R (line 1300, column 11) -R/utils_input_validation.R (line 1404, column 12) -R/utils_input_validation.R (line 1424, column 39) -R/utils_input_validation.R (line 1483, column 10) -R/utils_input_validation.R (line 1509, column 12) -R/utils_input_validation.R (line 1532, column 13) -R/utils_input_validation.R (line 1540, column 17) -R/utils_input_validation.R (line 1561, column 15) -R/utils_input_validation.R (line 1566, column 15) -R/utils_input_validation.R (line 1619, column 15) -R/utils_input_validation.R (line 1644, column 10) -R/utils_input_validation.R (line 1655, column 12) -R/utils_input_validation.R (line 1673, column 14) -R/utils_input_validation.R (line 1682, column 14) -R/utils_input_validation.R (line 1703, column 14) -R/utils_input_validation.R (line 1741, column 15) -R/utils_input_validation.R (line 1785, column 17) -R/utils_input_validation.R (line 2217, column 26) -R/utils_input_validation.R (line 2223, column 26) -R/utils_input_validation.R (line 2277, column 15) -R/utils_report_generation.R (line 106, column 10) -* NOTE: Avoid redundant 'stop' and 'warn*' in signal conditions -Found in files: -R/utils_input_validation.R (line 1027, column 24) -R/utils_input_validation.R (line 1031, column 24) +R/utils_input_validation.R (line 240, column 14) +R/utils_input_validation.R (line 385, column 15) +R/utils_input_validation.R (line 400, column 13) +R/utils_input_validation.R (line 465, column 11) +R/utils_input_validation.R (line 1100, column 13) +R/utils_input_validation.R (line 1263, column 14) +R/utils_input_validation.R (line 1267, column 14) +R/utils_input_validation.R (line 1600, column 13) +R/utils_input_validation.R (line 1626, column 13) +R/utils_input_validation.R (line 1690, column 13) +R/utils_input_validation.R (line 1720, column 13) +R/utils_input_validation.R (line 1747, column 14) +R/utils_input_validation.R (line 1756, column 18) +R/utils_input_validation.R (line 1777, column 18) +R/utils_input_validation.R (line 1784, column 15) +R/utils_input_validation.R (line 1846, column 13) +R/utils_input_validation.R (line 1873, column 11) +R/utils_input_validation.R (line 1885, column 13) +R/utils_input_validation.R (line 1904, column 15) +R/utils_input_validation.R (line 1914, column 15) +R/utils_input_validation.R (line 1936, column 15) +R/utils_input_validation.R (line 1973, column 16) +R/utils_input_validation.R (line 2453, column 13) +R/utils_input_validation.R (line 2463, column 13) +R/utils_input_validation.R (line 2518, column 13) +R/utils_report_generation.R (line 107, column 7) * WARNING: Avoid class membership checks with class() / is() and == / !=; Use is(x, 'class') for S4 classes Found in files: -create_limma_report.R (line 453, column 37) -run_gsea.R (line 408, column 35) +create_limma_report.R (line 439, column 37) +run_gsea.R (line 398, column 35) * Checking parsed R code in R directory, examples, vignettes... -* WARNING: Remove browser() statements (found 1 times) -browser() in R/utils_report_generation.R (line 840, column 5) -* ERROR: Remove install() calls (found 6 times) -install.packages() in R/open_tutorial_and_template.R (line 32, column 16) -install.packages() in R/open_tutorial_and_template.R (line 92, column 16) -install.packages() in R/preprocess_rna_seq_data.R (line 70, column 18) -install() in R/preprocess_rna_seq_data.R (line 74, column 26) -install.packages() in R/run_gsea.R (line 222, column 18) -install() in R/run_gsea.R (line 227, column 26) -* NOTE: Avoid '<<-' if possible (found 1 times) -<<- in R/screen_limma_hyperparams.R (line 1237, column 25) +* ERROR: Remove install() calls (found 4 times) +install.packages() in R/preprocess_rna_seq_data.R (line 68, column 18) +install() in R/preprocess_rna_seq_data.R (line 72, column 26) +install.packages() in R/run_gsea.R (line 219, column 18) +install() in R/run_gsea.R (line 224, column 26) * NOTE: Avoid 'suppressWarnings'/'*Messages' if possible (found 3 times) -suppressWarnings() in R/extract_data.R (line 72, column 40) -suppressWarnings() in R/extract_data.R (line 169, column 24) -suppressMessages() in R/screen_limma_hyperparams.R (line 588, column 13) +suppressWarnings() in R/extract_data.R (line 71, column 7) +suppressWarnings() in R/extract_data.R (line 165, column 24) +suppressMessages() in R/screen_limma_hyperparams.R (line 580, column 13) * Checking function lengths... -* NOTE: The recommended function length is 50 lines or less. There are 68 functions greater than 50 lines. +* NOTE: The recommended function length is 50 lines or less. There are 72 functions greater than 50 lines. The longest 5 functions are: -build_cluster_hits_report() (R/cluster_hits.R): 394 lines -generate_report_html() (R/utils_report_generation.R): 269 lines -plot_splines() (R/cluster_hits.R): 263 lines -make_clustering_report() (R/cluster_hits.R): 256 lines -cluster_hits() (R/cluster_hits.R): 177 lines +build_cluster_hits_report() (R/cluster_hits.R): 390 lines +generate_report_html() (R/utils_report_generation.R): 294 lines +make_clustering_report() (R/cluster_hits.R): 257 lines +plot_splines() (R/cluster_hits.R): 232 lines +plot_spline_comparisons() (R/cluster_hits.R): 212 lines * Checking man page documentation... * WARNING: Empty or missing \value sections found in man pages. Found in files: @@ -280,56 +184,39 @@ run_gsea.Rd run_limma_splines.Rd screen_limma_hyperparams.Rd update_splineomics.Rd -* Checking package NEWS... -* NOTE: Consider adding a NEWS file, so your package news will be included in Bioconductor release announcements. +* Checking package NEWS... OK * Checking unit tests... OK * Checking skip_on_bioc() in tests... OK * Checking formatting of DESCRIPTION, NAMESPACE, man pages, R source, and vignette source... -* NOTE: Consider shorter lines; 216 lines (1%) are > 80 characters long. +* NOTE: Consider shorter lines; 203 lines (1%) are > 80 characters long. First few lines: -R/cluster_hits.R#L977 #' `".+_vs_.+"`. If a match is found, th ... -R/cluster_hits.R#L1032 #' The function iterates over each data ... -R/cluster_hits.R#L1035 #' threshold. The function then extracts ... -R/cluster_hits.R#L1166 #' If `meta_batch_column` is specified, ... -R/create_limma_report.R#L1 # The function create_limma_report() tak ... -R/explore_data.R#L8 #' of exploratory plots including densit ... -R/explore_data.R#L130 #' @param condition A string specifying ... -R/explore_data.R#L499 #' plot shows the distribution of the va ... -R/extract_data.R#L378 stop(paste("Length of combined fea ... -R/run_gsea.R#L101 result[seq(1, length(result), by = 2 ... -R/run_gsea.R#L102 result[seq(2, length(result), by = 2 ... -R/screen_limma_hyperparams.R#L1322 #' Stores the feature indices for signif ... -R/screen_limma_hyperparams.R#L1365 #' @param type A character string specif ... +R/cluster_hits.R#L3288 # If we have valid treatment_timepoi ... R/SplineOmics-package.R#L14 #' - create_splineomics: Creates the Spl ... R/SplineOmics-package.R#L19 #' - screen_limma_hyperparams: Allows th ... R/SplineOmics-package.R#L23 #' limma spl ... R/SplineOmics-package.R#L50 #' - **dendextend**: For extending `de ... R/SplineOmics-package.R#L52 #' - **ggplot2**: For creating elegant ... R/SplineOmics-package.R#L61 #' - **rlang**: For tools to work with ... -R/SplineOmics-package.R#L83 #' - [VSchaepertoens](https://github.com ... -R/utils_general.R#L1 #' utils scripts contains shared functio ... -R/utils_general.R#L45 #' This function generates a design matr ... -R/utils_general.R#L46 #' It accommodates both B-splines and na ... -R/utils_general.R#L58 #' @return A design matrix constructed u ... -R/utils_general.R#L106 #' @param top_table A dataframe containi ... -R/utils_general.R#L109 #' @return A dataframe with updated `top ... -R/utils_general.R#L167 #' This function prints a nicely formatt ... -R/utils_general.R#L169 #' @param message_prefix A custom messag ... -R/utils_input_validation.R#L217 #' @param meta_batch_column An optio ... -R/utils_input_validation.R#L1054 #' that neither `data` nor `genes` i ... -R/utils_input_validation.R#L1057 #' @return Returns `TRUE` if all che ... -R/utils_input_validation.R#L1751 # # Check if 'knots' is atomic ... -R/utils_input_validation.R#L1752 # if (!(is.atomic(spline_params ... -R/utils_input_validation.R#L1766 # # Check if 'bknots' is atomic ... -R/utils_input_validation.R#L1932 # stop("bknots must be ... -R/utils_input_validation.R#L1951 # stop("bknots must be ... -R/utils_report_generation.R#L1 #' utils scripts contains shared functio ... -R/utils_report_generation.R#L647 " margin-top: 0; margin-bottom: 0;" ... -R/utils_report_generation.R#L1131 #' This function processes a given field ... -R/utils_report_generation.R#L1193 '}}\preform ... -man/InputControl.Rd#L201 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L225 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L264 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L281 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L294 \item{\code{meta_batch_column}}{An optio ... -man/InputControl.Rd#L318 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L339 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L364 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L391 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L408 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L424 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L435 \item{\code{meta_indices}}{A vector of o ... -man/InputControl.Rd#L452 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L481 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L511 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L541 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L559 \if{html}{\out{}}\preform ... -man/InputControl.Rd#L587 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L604 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L628 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L658 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L683 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L713 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L738 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L760 \if{html}{\out{
    }}\preform ... -man/InputControl.Rd#L770 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L146
  • }}\preform ... +man/InputControl.Rd#L202 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L226 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L265 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L282 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L295 \item{\code{meta_batch_column}}{An optio ... +man/InputControl.Rd#L319 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L340 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L365 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L392 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L409 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L425 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L436 \item{\code{meta_indices}}{A vector of o ... +man/InputControl.Rd#L453 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L482 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L512 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L542 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L560 \if{html}{\out{}}\preform ... +man/InputControl.Rd#L588 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L605 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L629 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L646 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L676 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L701 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L731 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L756 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L778 \if{html}{\out{
    }}\preform ... +man/InputControl.Rd#L788 \if{html}{\out{
    }}\preform ... man/Level2Functions.Rd#L51 \code{\link[SplineOmics:Level4Functions] ... man/Level2Functions.Rd#L56 \item \href{#method-Level2Functions-chec ... man/Level2Functions.Rd#L57 \item \href{#method-Level2Functions-chec ... @@ -476,102 +365,98 @@ vignettes/Docker_permission_denied.Rmd#L66 Following these steps will help you r vignettes/Docker-instructions.Rmd#L66 To pull the Docker container, use the fo ... vignettes/Docker-instructions.Rmd#L72 If you face 'permission denied' issues, ... vignettes/Docker-instructions.Rmd#L76 To run the `Docker` container, you can u ... -vignettes/Docker-instructions.Rmd#L104 Once the container is running, open a we ... -vignettes/Docker-instructions.Rmd#L110 As long as the container is running, you ... -vignettes/Docker-instructions.Rmd#L126 The `input` and `output` directories on ... -vignettes/Docker-instructions.Rmd#L128 - Place your input files (e.g., data, ... -vignettes/Docker-instructions.Rmd#L130 - Any files generated by RStudio withi ... -vignettes/Docker-instructions.Rmd#L132 | **Local Directory** | **Docker Contain ... -vignettes/Docker-instructions.Rmd#L134 | | `/home/rstudio/` ... -vignettes/Docker-instructions.Rmd#L135 | `input/` | `/home/rstudio/i ... -vignettes/Docker-instructions.Rmd#L136 | `output/` | `/home/rstudio/o ... -vignettes/Docker-instructions.Rmd#L140 To see all the R packages and system ins ... -vignettes/Docker-instructions.Rmd#L146 Because the `/home/rstudio/output` dir i ... -vignettes/Docker-instructions.Rmd#L156 However, note that any packages installe ... -vignettes/Docker-instructions.Rmd#L160 If you want to permanently add R package ... -vignettes/Docker-instructions.Rmd#L191 When you have your final analysis script ... -vignettes/Docker-instructions.Rmd#L195 Ensure all analysis scripts and necessar ... -vignettes/Docker-instructions.Rmd#L220 Once your scripts are ready, commit the ... -vignettes/Docker-instructions.Rmd#L231 Push the new image to `Docker Hub` so ot ... -vignettes/Docker-instructions.Rmd#L245 To reproduce the results, you need to cr ... -vignettes/Docker-instructions.Rmd#L247 Use the following command to run the con ... -vignettes/Docker-instructions.Rmd#L257 Start a new container and mount an empty ... -vignettes/get-started.Rmd#L335 [here](https://csbg.github.io/SplineOmic ... -vignettes/get-started.Rmd#L550 [here](https://csbg.github.io/SplineOmic ... -vignettes/get-started.Rmd#L559 [here](https://csbg.github.io/SplineOmic ... -vignettes/get-started.Rmd#L608 document](https://csbg.github.io/SplineO ... -vignettes/get-started.Rmd#L644 [here](https://csbg.github.io/SplineOmic ... -vignettes/get-started.Rmd#L698 [here](https://csbg.github.io/SplineOmic ... -vignettes/get-started.Rmd#L786 [here](https://csbg.github.io/SplineOmic ... -* NOTE: Consider multiples of 4 spaces for line indents; 5906 lines (28%) are not. +vignettes/Docker-instructions.Rmd#L102 Once the container is running, open a we ... +vignettes/Docker-instructions.Rmd#L108 As long as the container is running, you ... +vignettes/Docker-instructions.Rmd#L124 The `input` and `output` directories on ... +vignettes/Docker-instructions.Rmd#L126 - Place your input files (e.g., data, ... +vignettes/Docker-instructions.Rmd#L128 - Any files generated by RStudio withi ... +vignettes/Docker-instructions.Rmd#L130 | **Local Directory** | **Docker Contain ... +vignettes/Docker-instructions.Rmd#L132 | | `/home/rstudio/` ... +vignettes/Docker-instructions.Rmd#L133 | `input/` | `/home/rstudio/i ... +vignettes/Docker-instructions.Rmd#L134 | `output/` | `/home/rstudio/o ... +vignettes/Docker-instructions.Rmd#L138 To see all the R packages and system ins ... +vignettes/Docker-instructions.Rmd#L144 Because the `/home/rstudio/output` dir i ... +vignettes/Docker-instructions.Rmd#L154 However, note that any packages installe ... +vignettes/Docker-instructions.Rmd#L158 If you want to permanently add R package ... +vignettes/Docker-instructions.Rmd#L189 When you have your final analysis script ... +vignettes/Docker-instructions.Rmd#L193 Ensure all analysis scripts and necessar ... +vignettes/Docker-instructions.Rmd#L218 Once your scripts are ready, commit the ... +vignettes/Docker-instructions.Rmd#L229 Push the new image to `Docker Hub` so ot ... +vignettes/Docker-instructions.Rmd#L243 To reproduce the results, you need to cr ... +vignettes/Docker-instructions.Rmd#L245 Use the following command to run the con ... +vignettes/Docker-instructions.Rmd#L255 Start a new container and mount an empty ... +vignettes/get-started.Rmd#L351 [here](https://csbg.github.io/SplineOmic ... +vignettes/get-started.Rmd#L570 [here](https://csbg.github.io/SplineOmic ... +vignettes/get-started.Rmd#L579 [here](https://csbg.github.io/SplineOmic ... +vignettes/get-started.Rmd#L629 document](https://csbg.github.io/SplineO ... +vignettes/get-started.Rmd#L665 [here](https://csbg.github.io/SplineOmic ... +vignettes/get-started.Rmd#L713 # additional_condition = NA # No trea ... +vignettes/get-started.Rmd#L760 [here](https://csbg.github.io/SplineOmic ... +vignettes/get-started.Rmd#L849 [here](https://csbg.github.io/SplineOmic ... +* NOTE: Consider multiples of 4 spaces for line indents; 5078 lines (23%) are not. First few lines: R/cluster_hits.R#L89 y_axis_label = "Value", ... R/cluster_hits.R#L90 time_unit = "min", ... R/cluster_hits.R#L91 treatment_labels = NA, ... R/cluster_hits.R#L92 treatment_timepoints = NA ... -R/cluster_hits.R#L93 ), ... R/cluster_hits.R#L95 cluster_heatmap_columns = FALSE, ... R/cluster_hits.R#L96 meta_replicate_column = NULL ... -R/cluster_hits.R#L102 report_dir <- normalizePath( ... -R/cluster_hits.R#L106 ... -R/cluster_hits.R#L107 check_splineomics_elements( ... -R/cluster_hits.R#L110 ) ... -R/cluster_hits.R#L112 args <- lapply(as.list(match.call()[-1 ... -R/cluster_hits.R#L113 check_null_elements(args) ... -R/cluster_hits.R#L114 input_control <- InputControl$new(args ... -R/cluster_hits.R#L115 input_control$auto_validate() ... -R/cluster_hits.R#L116 ... -R/cluster_hits.R#L117 top_tables <- splineomics[['limma_spli ... -R/cluster_hits.R#L118 data <- splineomics[["data"]] ... -R/cluster_hits.R#L119 meta <- splineomics[["meta"]] ... -R/cluster_hits.R#L120 annotation <- splineomics[["annotation ... -R/cluster_hits.R#L121 report_info <- splineomics[["report_in ... -R/cluster_hits.R#L122 design <- splineomics[["design"]] ... -R/cluster_hits.R#L123 mode <- splineomics[["mode"]] ... -R/cluster_hits.R#L124 condition <- splineomics[["condition"] ... -R/cluster_hits.R#L125 spline_params <- splineomics[["spline_ ... -R/cluster_hits.R#L126 meta_batch_column <- splineomics[["met ... -R/cluster_hits.R#L127 meta_batch2_column <- splineomics[["me ... -R/cluster_hits.R#L128 feature_name_columns <- splineomics[[" ... -R/cluster_hits.R#L130 # To set the default p-value threshold ... -R/cluster_hits.R#L131 if (is.numeric(adj_pthresholds) && ... -R/cluster_hits.R#L132 length(adj_pthresholds) == 1 && ad ... -R/cluster_hits.R#L135 } ... -R/cluster_hits.R#L136 ... -R/cluster_hits.R#L137 within_level_top_tables <- filter_top_ ... -R/cluster_hits.R#L144 huge_table_user_prompter(within_level_ ... -R/cluster_hits.R#L145 ... -R/cluster_hits.R#L146 all_levels_clustering <- perform_clust ... -R/cluster_hits.R#L155 report_info$limma_design <- c(design) ... -R/cluster_hits.R#L156 report_info$meta_condition <- c(condit ... -R/cluster_hits.R#L157 report_info$meta_batch <- paste( ... -R/cluster_hits.R#L162 ... -R/cluster_hits.R#L163 ... -R/cluster_hits.R#L164 if (adj_pthresh_avrg_diff_conditions > ... -R/cluster_hits.R#L165 adj_pthresh_interaction_condition_ ... -R/cluster_hits.R#L168 splineomics = splineomics, ... -R/cluster_hits.R#L169 all_levels_clustering = all_levels ... -R/cluster_hits.R#L170 data = data, ... -R/cluster_hits.R#L171 meta = meta, ... -R/cluster_hits.R#L172 condition = condition, ... -R/cluster_hits.R#L173 plot_info = plot_info, ... -R/cluster_hits.R#L174 adj_pthresh_avrg_diff_conditions = ... -R/cluster_hits.R#L175 adj_pthresh_interaction = adj_pthr ... -R/cluster_hits.R#L177 } else { ... -R/cluster_hits.R#L179 } ... -R/cluster_hits.R#L180 ... -R/cluster_hits.R#L182 if (!is.null(genes)) { ... -R/cluster_hits.R#L184 } ... -R/cluster_hits.R#L185 ... -R/cluster_hits.R#L186 if (report) { ... -R/cluster_hits.R#L188 all_levels_clustering = all_levels ... -R/cluster_hits.R#L189 condition = condition, ... -R/cluster_hits.R#L190 data = data, ... -R/cluster_hits.R#L191 meta = meta, ... -R/cluster_hits.R#L192 annotation = annotation, ... -R/cluster_hits.R#L193 genes = genes, ... -R/cluster_hits.R#L194 spline_params = spline_params, ... -R/cluster_hits.R#L195 adj_pthresholds = adj_pthresholds, ... +R/cluster_hits.R#L100 report_dir <- normalizePath( ... +R/cluster_hits.R#L103 ) ... +R/cluster_hits.R#L105 check_splineomics_elements( ... +R/cluster_hits.R#L108 ) ... +R/cluster_hits.R#L110 args <- lapply(as.list(match.call()[-1 ... +R/cluster_hits.R#L111 check_null_elements(args) ... +R/cluster_hits.R#L112 input_control <- InputControl$new(args ... +R/cluster_hits.R#L113 input_control$auto_validate() ... +R/cluster_hits.R#L115 top_tables <- splineomics[["limma_spli ... +R/cluster_hits.R#L116 data <- splineomics[["data"]] ... +R/cluster_hits.R#L117 meta <- splineomics[["meta"]] ... +R/cluster_hits.R#L118 annotation <- splineomics[["annotation ... +R/cluster_hits.R#L119 report_info <- splineomics[["report_in ... +R/cluster_hits.R#L120 design <- splineomics[["design"]] ... +R/cluster_hits.R#L121 mode <- splineomics[["mode"]] ... +R/cluster_hits.R#L122 condition <- splineomics[["condition"] ... +R/cluster_hits.R#L123 spline_params <- splineomics[["spline_ ... +R/cluster_hits.R#L124 meta_batch_column <- splineomics[["met ... +R/cluster_hits.R#L125 meta_batch2_column <- splineomics[["me ... +R/cluster_hits.R#L126 feature_name_columns <- splineomics[[" ... +R/cluster_hits.R#L128 # To set the default p-value threshold ... +R/cluster_hits.R#L129 if (is.numeric(adj_pthresholds) && ... +R/cluster_hits.R#L133 } ... +R/cluster_hits.R#L135 within_level_top_tables <- filter_top_ ... +R/cluster_hits.R#L140 ) ... +R/cluster_hits.R#L142 huge_table_user_prompter(within_level_ ... +R/cluster_hits.R#L144 all_levels_clustering <- perform_clust ... +R/cluster_hits.R#L151 ) ... +R/cluster_hits.R#L153 report_info$limma_design <- c(design) ... +R/cluster_hits.R#L154 report_info$meta_condition <- c(condit ... +R/cluster_hits.R#L155 report_info$meta_batch <- paste( ... +R/cluster_hits.R#L159 ) ... +R/cluster_hits.R#L162 if (adj_pthresh_avrg_diff_conditions > ... +R/cluster_hits.R#L165 splineomics = splineomics, ... +R/cluster_hits.R#L166 all_levels_clustering = all_levels ... +R/cluster_hits.R#L167 data = data, ... +R/cluster_hits.R#L168 meta = meta, ... +R/cluster_hits.R#L169 condition = condition, ... +R/cluster_hits.R#L170 plot_info = plot_info, ... +R/cluster_hits.R#L171 adj_pthresh_avrg_diff_conditions = ... +R/cluster_hits.R#L172 adj_pthresh_interaction = adj_pthr ... +R/cluster_hits.R#L174 } else { ... +R/cluster_hits.R#L176 } ... +R/cluster_hits.R#L179 if (!is.null(genes)) { ... +R/cluster_hits.R#L181 } ... +R/cluster_hits.R#L183 if (report) { ... +R/cluster_hits.R#L185 all_levels_clustering = all_levels ... +R/cluster_hits.R#L186 condition = condition, ... +R/cluster_hits.R#L187 data = data, ... +R/cluster_hits.R#L188 meta = meta, ... +R/cluster_hits.R#L189 annotation = annotation, ... +R/cluster_hits.R#L190 genes = genes, ... +R/cluster_hits.R#L191 spline_params = spline_params, ... +R/cluster_hits.R#L192 adj_pthresholds = adj_pthresholds, ... +R/cluster_hits.R#L193 adj_pthresh_avrg_diff_conditions = ... +R/cluster_hits.R#L194 adj_pthresh_interaction_condition_ ... R/cluster_hits.R#L196 report_dir = report_dir, ... R/cluster_hits.R#L197 mode = mode, ... R/cluster_hits.R#L198 report_info = report_info, ... @@ -582,7 +467,6 @@ R/cluster_hits.R#L202 plot_info = plot_info, ... R/cluster_hits.R#L203 plot_options = plot_options, ... R/cluster_hits.R#L204 feature_name_columns = feature_nam ... R/cluster_hits.R#L205 spline_comp_plots = spline_comp_pl ... -R/cluster_hits.R#L206 ) ... R/cluster_hits.R#L207 } else { ... R/cluster_hits.R#L209 } ... R/cluster_hits.R#L211 # Leave a message for the user instead ... @@ -590,1770 +474,1628 @@ R/cluster_hits.R#L212 all_levels_clustering <- lapply(all_le ... R/cluster_hits.R#L214 return("No result for this level, ... R/cluster_hits.R#L216 return(x) ... R/cluster_hits.R#L218 }) ... -R/cluster_hits.R#L219 ... R/cluster_hits.R#L220 clustered_hits_levels <- list() ... -R/cluster_hits.R#L221 ... R/cluster_hits.R#L222 for (i in seq_along(all_levels_cluster ... R/cluster_hits.R#L227 clustered_hits_levels[[element_nam ... -R/cluster_hits.R#L231 clustered_hits_levels[[element_nam ... -R/cluster_hits.R#L234 } ... -R/cluster_hits.R#L235 ... -R/cluster_hits.R#L236 if (!is.null(genes)) { ... -R/cluster_hits.R#L239 if (is.character(df)) { ... -R/cluster_hits.R#L241 } ... -R/cluster_hits.R#L242 df$gene <- genes[df$feature] ... -R/cluster_hits.R#L243 return(df) ... -R/cluster_hits.R#L245 } ... -R/cluster_hits.R#L246 ... -R/cluster_hits.R#L247 print_info_message( ... -R/cluster_hits.R#L250 ) ... -R/cluster_hits.R#L251 ... -R/cluster_hits.R#L252 list( ... -R/cluster_hits.R#L271 result <- check_between_level_pattern( ... -R/cluster_hits.R#L273 if (result$between_levels) { ... -R/cluster_hits.R#L275 within_level_top_tables_index <- 2 ... +R/cluster_hits.R#L230 clustered_hits_levels[[element_nam ... +R/cluster_hits.R#L233 } ... +R/cluster_hits.R#L235 if (!is.null(genes)) { ... +R/cluster_hits.R#L238 if (is.character(df)) { ... +R/cluster_hits.R#L240 } ... +R/cluster_hits.R#L241 df$gene <- genes[df$feature] ... +R/cluster_hits.R#L242 return(df) ... +R/cluster_hits.R#L244 } ... +R/cluster_hits.R#L246 print_info_message( ... +R/cluster_hits.R#L249 ) ... +R/cluster_hits.R#L251 list( ... +R/cluster_hits.R#L255 ) ... +R/cluster_hits.R#L268 result <- check_between_level_pattern( ... +R/cluster_hits.R#L270 if (result$between_levels) { # between ... +R/cluster_hits.R#L272 within_level_top_tables_index <- 2 ... +R/cluster_hits.R#L273 between_level_top_tables_index <- ... +R/cluster_hits.R#L275 within_level_top_tables_index <- 1 ... R/cluster_hits.R#L276 between_level_top_tables_index <- ... -R/cluster_hits.R#L278 within_level_top_tables_index <- 1 ... -R/cluster_hits.R#L279 between_level_top_tables_index <- ... -R/cluster_hits.R#L285 } else { ... -R/cluster_hits.R#L287 } ... -R/cluster_hits.R#L289 for (i in seq_along(within_level_top_t ... -R/cluster_hits.R#L295 hit_indices <- get_level_hit_indic ... -R/cluster_hits.R#L296 ... -R/cluster_hits.R#L297 ... -R/cluster_hits.R#L299 hit_indices <- within_level_top_ta ... -R/cluster_hits.R#L301 ] ... -R/cluster_hits.R#L305 within_level_top_table[within_leve ... -R/cluster_hits.R#L306 %in% hit_in ... -R/cluster_hits.R#L309 message(paste("Level", level, "has ... -R/cluster_hits.R#L311 within_level_top_tables[[i]] <- NA ... -R/cluster_hits.R#L313 within_level_top_tables[[i]] <- to ... -R/cluster_hits.R#L316 } ... -R/cluster_hits.R#L318 if (all(is.na(within_level_top_tables) ... -R/cluster_hits.R#L320 } ... -R/cluster_hits.R#L322 within_level_top_tables ... -R/cluster_hits.R#L338 ... -R/cluster_hits.R#L339 for (i in seq_along(tables)) { ... -R/cluster_hits.R#L342 next ... -R/cluster_hits.R#L346 # Prompt the user for input ... -R/cluster_hits.R#L347 while (TRUE) { ... -R/cluster_hits.R#L349 "The table", ... -R/cluster_hits.R#L350 names(tables)[i], ... -R/cluster_hits.R#L351 "has more than 500 rows. Do yo ... -R/cluster_hits.R#L352 )) ... -R/cluster_hits.R#L357 # Proceed ... -R/cluster_hits.R#L358 print("Proceeding...") ... -R/cluster_hits.R#L359 break ... -R/cluster_hits.R#L361 stop("Script stopped. User cho ... -R/cluster_hits.R#L363 # Invalid input, ask the user ... -R/cluster_hits.R#L364 cat(paste( ... -R/cluster_hits.R#L369 } ... -R/cluster_hits.R#L371 } ... -R/cluster_hits.R#L403 levels <- unique(meta[[condition]]) ... -R/cluster_hits.R#L405 all_levels_clustering <- mapply( ... -R/cluster_hits.R#L411 meta = meta, ... -R/cluster_hits.R#L412 condition = condition, ... -R/cluster_hits.R#L413 spline_params = spline_params, ... -R/cluster_hits.R#L414 mode = mode ... -R/cluster_hits.R#L415 ), ... -R/cluster_hits.R#L418 ... -R/cluster_hits.R#L419 return(all_levels_clustering) ... -R/cluster_hits.R#L504 # Optionally remove the batch-effect w ... -R/cluster_hits.R#L505 # For mode == "integrated", the batch- ... -R/cluster_hits.R#L506 # For mode == "isolated", the batch-ef ... -R/cluster_hits.R#L507 datas <- remove_batch_effect_cluster_h ... -R/cluster_hits.R#L519 # To extract the stored value for the ... -R/cluster_hits.R#L520 clusters <- c() ... -R/cluster_hits.R#L521 for (i in seq_along(all_levels_cluster ... -R/cluster_hits.R#L525 next ... -R/cluster_hits.R#L530 } ... -R/cluster_hits.R#L532 if (!dir.exists(report_dir)) { ... -R/cluster_hits.R#L534 } ... -R/cluster_hits.R#L536 time_unit_label <- paste0("[", plot_in ... -R/cluster_hits.R#L538 heatmaps <- plot_heatmap( ... -R/cluster_hits.R#L548 # log2_intensity_shape <- plot_log2_in ... -R/cluster_hits.R#L550 level_headers_info <- list() ... -R/cluster_hits.R#L551 plots <- list() ... -R/cluster_hits.R#L552 plots_sizes <- list() ... -R/cluster_hits.R#L553 q <- 0 ... -R/cluster_hits.R#L555 for (i in seq_along(all_levels_cluster ... -R/cluster_hits.R#L560 next ... -R/cluster_hits.R#L562 q <- q + 1 ... -R/cluster_hits.R#L571 ith_unique_value <- levels[i] ... -R/cluster_hits.R#L573 # Construct header name ... -R/cluster_hits.R#L574 header_name <- ith_unique_value ... -R/cluster_hits.R#L576 nr_hits <- nrow(level_clustering$c ... -R/cluster_hits.R#L578 header_info <- list( ... -R/cluster_hits.R#L584 level_headers_info[[i]] <- header_ ... -R/cluster_hits.R#L590 hc = level_clustering$hc, ... -R/cluster_hits.R#L591 clusters = level_clustering[["clus ... -R/cluster_hits.R#L592 k = clusters[q] ... -R/cluster_hits.R#L593 ) ... -R/cluster_hits.R#L596 curve_values = curve_values, ... -R/cluster_hits.R#L597 plot_info = plot_info ... -R/cluster_hits.R#L598 ) ... -R/cluster_hits.R#L601 curve_values = curve_values, ... -R/cluster_hits.R#L602 plot_info = plot_info ... -R/cluster_hits.R#L603 ) ... -R/cluster_hits.R#L611 data_level <- datas[[i]][, col_ind ... -R/cluster_hits.R#L613 data_level <- datas[[i]] ... -R/cluster_hits.R#L622 nr_of_hits <- sum( ... -R/cluster_hits.R#L626 main_title <- paste( ... -R/cluster_hits.R#L634 top_table_cluster <- top_table |> ... -R/cluster_hits.R#L637 X <- level_clustering$X ... -R/cluster_hits.R#L639 spline_plots <- plot_splines( ... -R/cluster_hits.R#L650 clusters_spline_plots[[length(clus ... -R/cluster_hits.R#L657 plots, ... -R/cluster_hits.R#L658 new_level = "level_header", # i ... -R/cluster_hits.R#L659 dendrogram = list(dendrogram), ... -R/cluster_hits.R#L660 p_curves = list(p_curves), ... -R/cluster_hits.R#L661 cluster_mean_splines = list(cluste ... -R/cluster_hits.R#L662 heatmap = heatmaps[[i]], ... -R/cluster_hits.R#L663 individual_spline_plots = clusters ... -R/cluster_hits.R#L664 ) ... -R/cluster_hits.R#L668 plots_sizes, ... -R/cluster_hits.R#L669 999, # dummy size fo ... -R/cluster_hits.R#L670 1.5, ... -R/cluster_hits.R#L671 1.5, ... -R/cluster_hits.R#L672 1, ... -R/cluster_hits.R#L673 1.5, ... -R/cluster_hits.R#L674 rep(1, length(clusters_spline_plot ... -R/cluster_hits.R#L675 ) ... -R/cluster_hits.R#L676 } ... -R/cluster_hits.R#L678 topTables <- list() ... -R/cluster_hits.R#L680 # Loop over each element in all_levels ... -R/cluster_hits.R#L681 for (i in seq_along(all_levels_cluster ... -R/cluster_hits.R#L696 element_name <- substr(element_nam ... -R/cluster_hits.R#L700 } ... -R/cluster_hits.R#L701 ... -R/cluster_hits.R#L702 if (!is.null(genes)) { ... -R/cluster_hits.R#L704 all_levels_clustering, ... -R/cluster_hits.R#L705 genes ... -R/cluster_hits.R#L707 } else { ... -R/cluster_hits.R#L709 } ... -R/cluster_hits.R#L710 ... -R/cluster_hits.R#L711 all_levels_clustering <- merge_annotat ... -R/cluster_hits.R#L714 ) ... -R/cluster_hits.R#L716 print("Generating report. This takes a ... -R/cluster_hits.R#L718 generate_report_html( ... -R/cluster_hits.R#L737 return(plots) ... -R/cluster_hits.R#L785 # Initialize the list that will store ... -R/cluster_hits.R#L786 comparison_plots <- list() ... -R/cluster_hits.R#L787 ... -R/cluster_hits.R#L788 # Check if all three elements are pres ... -R/cluster_hits.R#L789 if (length(splineomics[['limma_splines ... -R/cluster_hits.R#L793 splineomics[['limma_splines_result ... -R/cluster_hits.R#L795 splineomics[['limma_splines_result ... -R/cluster_hits.R#L805 condition_1 <- pair[1] ... -R/cluster_hits.R#L806 condition_2 <- pair[2] ... -R/cluster_hits.R#L807 ... -R/cluster_hits.R#L808 # Sort the current pair of conditi ... -R/cluster_hits.R#L809 sorted_conditions <- sort(c(condit ... -R/cluster_hits.R#L810 ... -R/cluster_hits.R#L811 # Initialize matched dataframes as ... -R/cluster_hits.R#L812 matched_avrg_diff <- NULL ... -R/cluster_hits.R#L813 matched_interaction_cond_time <- N ... -R/cluster_hits.R#L814 ... -R/cluster_hits.R#L815 # Search for the correct dataframe ... -R/cluster_hits.R#L816 for (df_name in names(avrg_diff_co ... -R/cluster_hits.R#L819 "avrg_diff_", ... -R/cluster_hits.R#L820 "", ... -R/cluster_hits.R#L821 df_name ... -R/cluster_hits.R#L822 ), ... -R/cluster_hits.R#L823 "_vs_" ... -R/cluster_hits.R#L824 )[[1]] ... -R/cluster_hits.R#L830 matched_avrg_diff <- avrg_diff ... -R/cluster_hits.R#L831 break ... -R/cluster_hits.R#L833 } ... -R/cluster_hits.R#L835 # Search for the correct dataframe ... -R/cluster_hits.R#L836 for (df_name in names(interaction_ ... -R/cluster_hits.R#L840 "time_interaction_", ... -R/cluster_hits.R#L841 "", ... -R/cluster_hits.R#L842 df_name ... -R/cluster_hits.R#L843 ), ... -R/cluster_hits.R#L844 "_vs_" ... -R/cluster_hits.R#L845 )[[1]] ... -R/cluster_hits.R#L852 matched_interaction_cond_time ... -R/cluster_hits.R#L853 break ... -R/cluster_hits.R#L855 } ... -R/cluster_hits.R#L857 # If both matched dataframes are f ... -R/cluster_hits.R#L858 if (!is.null(matched_avrg_diff) ... -R/cluster_hits.R#L859 && !is.null(matched_interactio ... -R/cluster_hits.R#L870 time_effect_1 = time_effect_1, ... -R/cluster_hits.R#L871 condition_1 = condition_1, ... -R/cluster_hits.R#L872 time_effect_2 = time_effect_2, ... -R/cluster_hits.R#L873 condition_2 = condition_2, ... -R/cluster_hits.R#L874 avrg_diff_conditions = matched ... -R/cluster_hits.R#L875 interaction_condition_time = m ... -R/cluster_hits.R#L876 data = data, ... -R/cluster_hits.R#L877 meta = meta, ... -R/cluster_hits.R#L878 condition = condition, ... -R/cluster_hits.R#L879 X_1 = X_1, ... -R/cluster_hits.R#L880 X_2 = X_2, ... -R/cluster_hits.R#L881 plot_info = plot_info, ... -R/cluster_hits.R#L882 adj_pthresh_avrg_diff_conditio ... -R/cluster_hits.R#L883 adj_pthresh_interaction = adj_ ... -R/cluster_hits.R#L890 } ... -R/cluster_hits.R#L892 } else { ... -R/cluster_hits.R#L894 } ... -R/cluster_hits.R#L895 ... -R/cluster_hits.R#L896 # Return the list containing all plot ... -R/cluster_hits.R#L897 return(comparison_plots) ... -R/cluster_hits.R#L917 message(paste0( ... -R/cluster_hits.R#L922 )) ... -R/cluster_hits.R#L923 ... -R/cluster_hits.R#L924 message(paste0( ... -R/cluster_hits.R#L928 )) ... -R/cluster_hits.R#L929 ... -R/cluster_hits.R#L930 # Apply cleaning process to each gene ... -R/cluster_hits.R#L931 cleaned_genes <- sapply(genes, functio ... -R/cluster_hits.R#L933 # Replace all non-alphanumeric cha ... -R/cluster_hits.R#L934 gene_name <- gsub("[^A-Za-z0-9]", ... -R/cluster_hits.R#L935 ... -R/cluster_hits.R#L936 # Extract the first block of alpha ... -R/cluster_hits.R#L937 # first whitespace ... -R/cluster_hits.R#L938 clean_gene_name <- sub("^([A-Za-z0 ... -R/cluster_hits.R#L939 ... -R/cluster_hits.R#L940 # Convert to uppercase ... -R/cluster_hits.R#L941 toupper(clean_gene_name) ... -R/cluster_hits.R#L943 NA ... -R/cluster_hits.R#L945 }) ... -R/cluster_hits.R#L946 ... -R/cluster_hits.R#L947 # Return cleaned genes, keeping the sa ... -R/cluster_hits.R#L948 return(cleaned_genes) ... -R/cluster_hits.R#L983 # Initialize variables ... -R/cluster_hits.R#L984 between_levels <- FALSE ... -R/cluster_hits.R#L985 index_with_pattern <- NA ... -R/cluster_hits.R#L987 # Define the regular expression patter ... -R/cluster_hits.R#L988 pattern <- ".+_vs_.+" ... -R/cluster_hits.R#L990 # Check if top_tables is a list ... -R/cluster_hits.R#L991 if (is.list(top_tables)) { ... -R/cluster_hits.R#L994 # Check if the element is a list ... -R/cluster_hits.R#L995 if (is.list(top_tables[[i]])) { ... -R/cluster_hits.R#L1000 between_levels <- TRUE ... -R/cluster_hits.R#L1001 index_with_pattern <- i ... -R/cluster_hits.R#L1002 break ... -R/cluster_hits.R#L1004 } ... -R/cluster_hits.R#L1006 } ... -R/cluster_hits.R#L1008 return(list( ... -R/cluster_hits.R#L1044 unique_hit_indices <- c() ... -R/cluster_hits.R#L1046 # Loop through the elements of the lis ... -R/cluster_hits.R#L1047 for (i in seq_along(between_level_top_ ... -R/cluster_hits.R#L1053 # Get the current data frame ... -R/cluster_hits.R#L1054 within_level_top_table <- between_ ... -R/cluster_hits.R#L1056 # Find the row indices that meet t ... -R/cluster_hits.R#L1057 hit_indices <- ... -R/cluster_hits.R#L1060 # Extract the feature indices from ... -R/cluster_hits.R#L1061 feature_indices <- within_level_to ... -R/cluster_hits.R#L1062 feature_indices <- within_level_to ... -R/cluster_hits.R#L1064 unique_hit_indices <- c( ... -R/cluster_hits.R#L1069 } ... -R/cluster_hits.R#L1071 # Get unique feature indices ... -R/cluster_hits.R#L1072 unique_hit_indices <- unique(unique_hi ... -R/cluster_hits.R#L1108 # means that it had < 2 hits. ... -R/cluster_hits.R#L1109 if (is.null(top_table) || all(is.na(to ... -R/cluster_hits.R#L1111 } ... -R/cluster_hits.R#L1112 ... -R/cluster_hits.R#L1113 curve_results <- get_curve_values( ... -R/cluster_hits.R#L1122 normalized_curves <- normalize_curves( ... -R/cluster_hits.R#L1124 clustering_result <- ... -R/cluster_hits.R#L1126 curve_values = normalized_curves, ... -R/cluster_hits.R#L1127 k = cluster_size, ... -R/cluster_hits.R#L1128 smooth_timepoints = curve_results$ ... -R/cluster_hits.R#L1129 top_table = top_table ... -R/cluster_hits.R#L1130 ) ... -R/cluster_hits.R#L1132 clustering_result$X <- curve_results$X ... -R/cluster_hits.R#L1133 return(clustering_result) ... -R/cluster_hits.R#L1183 datas <- list() ... -R/cluster_hits.R#L1184 n <- length(unique(meta[[condition]])) ... -R/cluster_hits.R#L1185 level_indices <- as.integer(1:n) ... -R/cluster_hits.R#L1186 unique_levels <- unique(meta[[conditio ... -R/cluster_hits.R#L1188 if (!is.null(meta_batch_column)) { ... -R/cluster_hits.R#L1192 # Take only the data from the leve ... -R/cluster_hits.R#L1193 if (mode == "isolated") { ... -R/cluster_hits.R#L1198 } else { ... -R/cluster_hits.R#L1202 } ... -R/cluster_hits.R#L1204 design_matrix <- design2design_mat ... -R/cluster_hits.R#L1211 # The batch columns are not allowe ... -R/cluster_hits.R#L1212 # removeBatchEffect. Instead the b ... -R/cluster_hits.R#L1213 batch_columns <- grep( ... -R/cluster_hits.R#L1215 "^", ... -R/cluster_hits.R#L1216 meta_batch_column ... -R/cluster_hits.R#L1217 ), ... -R/cluster_hits.R#L1220 ... -R/cluster_hits.R#L1221 design_matrix <- design_matrix[, - ... -R/cluster_hits.R#L1223 args <- list( ... -R/cluster_hits.R#L1227 ) ... -R/cluster_hits.R#L1228 ... -R/cluster_hits.R#L1229 if (mode == "isolated") { ... -R/cluster_hits.R#L1236 args$batch2 <- meta_copy[[meta ... -R/cluster_hits.R#L1238 } else { # mode == integrated ... -R/cluster_hits.R#L1242 args$batch2 <- meta_copy[[meta ... -R/cluster_hits.R#L1244 } ... -R/cluster_hits.R#L1246 data_copy <- do.call(limma::remove ... -R/cluster_hits.R#L1248 # For mode == "integrated", all el ... -R/cluster_hits.R#L1249 datas <- c(datas, list(data_copy)) ... -R/cluster_hits.R#L1252 } else { # no meta batch colu ... -R/cluster_hits.R#L1256 # Take only the data from the leve ... -R/cluster_hits.R#L1257 if (mode == "isolated") { ... -R/cluster_hits.R#L1261 } else { ... -R/cluster_hits.R#L1263 } ... -R/cluster_hits.R#L1265 datas <- c(datas, list(data_copy)) ... -R/cluster_hits.R#L1267 } ... -R/cluster_hits.R#L1268 return(datas) ... -R/cluster_hits.R#L1313 BASE_TEXT_SIZE_PT <- 5 ... -R/cluster_hits.R#L1315 ht_opt( ... -R/cluster_hits.R#L1329 ) ... -R/cluster_hits.R#L1330 ... -R/cluster_hits.R#L1331 ht_opt$message = FALSE ... -R/cluster_hits.R#L1333 levels <- unique(meta[[condition]]) ... -R/cluster_hits.R#L1334 heatmaps <- list() ... -R/cluster_hits.R#L1335 ... -R/cluster_hits.R#L1336 # Generate a heatmap for every level ... -R/cluster_hits.R#L1337 for (i in seq_along(all_levels_cluster ... -R/cluster_hits.R#L1342 heatmaps[[length(heatmaps) + 1]] < ... -R/cluster_hits.R#L1343 next ... -R/cluster_hits.R#L1355 data_level <- datas[[i]][, level_i ... -R/cluster_hits.R#L1357 data_level <- datas[[i]] ... -R/cluster_hits.R#L1368 ComplexHeatmap::Heatmap( ... -R/cluster_hits.R#L1371 "left-labels = cluster,", ... -R/cluster_hits.R#L1372 "top-labels = time" ... -R/cluster_hits.R#L1373 ), ... -R/cluster_hits.R#L1380 title = "z-score of log2 value ... -R/cluster_hits.R#L1381 title_position = "lefttop-rot" ... -R/cluster_hits.R#L1382 ), ... -R/cluster_hits.R#L1396 } ... -R/cluster_hits.R#L1397 heatmaps ... -R/cluster_hits.R#L1428 # Convert hc to dendrogram ... -R/cluster_hits.R#L1429 dend <- stats::as.dendrogram(hc) ... -R/cluster_hits.R#L1431 # Get clusters based on cutree result ... -R/cluster_hits.R#L1432 clusters <- stats::cutree(hc, k) ... -R/cluster_hits.R#L1434 # Get the order of clusters as they ap ... -R/cluster_hits.R#L1435 cluster_order <- clusters[hc[["order"] ... -R/cluster_hits.R#L1437 # Find the unique clusters in the orde ... -R/cluster_hits.R#L1438 unique_cluster_order <- unique(cluster ... -R/cluster_hits.R#L1440 # Generate distinct colors for the k c ... -R/cluster_hits.R#L1441 colors <- scales::hue_pal()(k) ... -R/cluster_hits.R#L1443 # Reorder the colors according to the ... -R/cluster_hits.R#L1444 ordered_colors <- colors[match( ... -R/cluster_hits.R#L1449 # Apply the reordered colors to the br ... -R/cluster_hits.R#L1450 dend_colored <- dendextend::color_bran ... -R/cluster_hits.R#L1454 ) ... -R/cluster_hits.R#L1456 # Remove labels for the plot ... -R/cluster_hits.R#L1457 dend_colored <- dendextend::set( ... -R/cluster_hits.R#L1461 "", ... -R/cluster_hits.R#L1462 length(dendextend::get_leaves_attr ... -R/cluster_hits.R#L1464 ) ... -R/cluster_hits.R#L1466 # Convert to ggplot-compatible dendrog ... -R/cluster_hits.R#L1467 ggdend <- dendextend::as.ggdend(dend_c ... -R/cluster_hits.R#L1469 # Create the plot ... -R/cluster_hits.R#L1470 p_dend <- ggplot2::ggplot(ggdend) + ... -R/cluster_hits.R#L1472 title = paste( ... -R/cluster_hits.R#L1475 ), ... -R/cluster_hits.R#L1476 x = "", ... -R/cluster_hits.R#L1477 y = "" ... -R/cluster_hits.R#L1481 axis.text.x = ggplot2::element_bla ... -R/cluster_hits.R#L1482 axis.ticks.x = ggplot2::element_bl ... -R/cluster_hits.R#L1483 axis.text.y = ggplot2::element_bla ... -R/cluster_hits.R#L1484 axis.ticks.y = ggplot2::element_bl ... -R/cluster_hits.R#L1485 plot.title = ggplot2::element_text ... -R/cluster_hits.R#L1488 return(p_dend) ... -R/cluster_hits.R#L1521 time <- as.numeric(colnames(curve_valu ... -R/cluster_hits.R#L1523 clusters <- unique(curve_values$cluste ... -R/cluster_hits.R#L1524 average_curves <- data.frame() ... -R/cluster_hits.R#L1526 # Loop through each unique cluster val ... -R/cluster_hits.R#L1527 for (current_cluster in clusters) { ... -R/cluster_hits.R#L1536 Time = time, Value = average_curve ... -R/cluster_hits.R#L1537 cluster = as.factor(current_cluste ... -R/cluster_hits.R#L1538 ) ... -R/cluster_hits.R#L1542 average_curves, ... -R/cluster_hits.R#L1543 curve_df ... -R/cluster_hits.R#L1544 ) ... -R/cluster_hits.R#L1545 } ... -R/cluster_hits.R#L1547 average_curves$cluster <- factor( ... -R/cluster_hits.R#L1550 unique(as.numeric(average_curves$c ... -R/cluster_hits.R#L1552 ... -R/cluster_hits.R#L1553 time_unit_label = paste0("[", plot_inf ... -R/cluster_hits.R#L1554 ... -R/cluster_hits.R#L1555 cluster_colors <- scales::hue_pal()(le ... -R/cluster_hits.R#L1556 ... -R/cluster_hits.R#L1557 if (length(cluster_colors) > length(un ... -R/cluster_hits.R#L1559 } ... -R/cluster_hits.R#L1560 names(cluster_colors) <- paste( ... -R/cluster_hits.R#L1564 ... -R/cluster_hits.R#L1565 color_values <- c(cluster_colors) ... -R/cluster_hits.R#L1566 distinct_colors <- c() ... -R/cluster_hits.R#L1567 ... -R/cluster_hits.R#L1568 # Create the base plot ... -R/cluster_hits.R#L1569 p_curves <- ggplot2::ggplot( ... -R/cluster_hits.R#L1572 x = !!rlang::sym("Time"), ... -R/cluster_hits.R#L1573 y = !!rlang::sym("Value"), ... -R/cluster_hits.R#L1574 color = paste("Cluster", factor(!! ... -R/cluster_hits.R#L1576 ) + ... -R/cluster_hits.R#L1583 ... -R/cluster_hits.R#L1584 # Conditionally add vertical dashed li ... -R/cluster_hits.R#L1585 if (!all(is.na(plot_info$treatment_lab ... -R/cluster_hits.R#L1588 Time = plot_info$treatment_timepoi ... -R/cluster_hits.R#L1589 Label = plot_info$treatment_labels ... -R/cluster_hits.R#L1593 ggplot2::geom_vline( ... -R/cluster_hits.R#L1598 ) + ... -R/cluster_hits.R#L1599 ggplot2::geom_text( ... -R/cluster_hits.R#L1602 # Slightly offset from the ver ... -R/cluster_hits.R#L1603 x = .data$Time - max(.data$Tim ... -R/cluster_hits.R#L1604 y = 1, # Place the labels at ... -R/cluster_hits.R#L1605 label = .data$Time, ... -R/cluster_hits.R#L1606 color = .data$Label ... -R/cluster_hits.R#L1613 ) ... -R/cluster_hits.R#L1619 cluster_colors, ... -R/cluster_hits.R#L1620 distinct_colors ... -R/cluster_hits.R#L1621 ) ... -R/cluster_hits.R#L1622 } ... -R/cluster_hits.R#L1623 ... -R/cluster_hits.R#L1624 # Finalize color scale and theme adjus ... -R/cluster_hits.R#L1625 p_curves <- p_curves + ... -R/cluster_hits.R#L1627 values = color_values, ... -R/cluster_hits.R#L1628 name = ggplot2::element_text("Clus ... -R/cluster_hits.R#L1629 guide = ggplot2::guide_legend( ... -R/cluster_hits.R#L1631 linetype = c(rep("solid", leng ... -R/cluster_hits.R#L1632 rep("dashed", len ... -R/cluster_hits.R#L1633 size = c(rep(1, length(cluster ... -R/cluster_hits.R#L1634 rep(0.5, length(disti ... -R/cluster_hits.R#L1636 ) ... -R/cluster_hits.R#L1639 legend.key.size = grid::unit(0.6, ... -R/cluster_hits.R#L1640 legend.key.height = grid::unit(0.3 ... -R/cluster_hits.R#L1641 legend.title = ggplot2::element_te ... -R/cluster_hits.R#L1644 return(p_curves) ... -R/cluster_hits.R#L1675 clusters <- sort(unique(curve_values$c ... -R/cluster_hits.R#L1677 plots <- list() ... -R/cluster_hits.R#L1678 for (current_cluster in clusters) { ... -R/cluster_hits.R#L1680 curve_values, ... -R/cluster_hits.R#L1681 curve_values$cluster == current_cl ... -R/cluster_hits.R#L1682 ) ... -R/cluster_hits.R#L1686 "Cluster", ... -R/cluster_hits.R#L1687 current_cluster, ... -R/cluster_hits.R#L1688 "| Hits:", ... -R/cluster_hits.R#L1689 nr_of_hits, ... -R/cluster_hits.R#L1690 sep = " " ... -R/cluster_hits.R#L1691 ) ... -R/cluster_hits.R#L1694 plot_single_and_mean_splines( ... -R/cluster_hits.R#L1699 } ... -R/cluster_hits.R#L1700 ... -R/cluster_hits.R#L1701 return(plots) ... -R/cluster_hits.R#L1757 ... -R/cluster_hits.R#L1758 # Sort so that HTML reports are easier ... -R/cluster_hits.R#L1759 top_table <- top_table |> dplyr::arran ... -R/cluster_hits.R#L1760 ... -R/cluster_hits.R#L1761 DoF <- which(names(top_table) == "AveE ... -R/cluster_hits.R#L1762 time_points <- meta$Time ... -R/cluster_hits.R#L1763 ... -R/cluster_hits.R#L1764 titles <- data.frame( ... -R/cluster_hits.R#L1767 ) ... -R/cluster_hits.R#L1768 ... -R/cluster_hits.R#L1769 plot_list <- list() ... -R/cluster_hits.R#L1770 ... -R/cluster_hits.R#L1771 for (hit in 1:nrow(top_table)) { ... -R/cluster_hits.R#L1779 meta$Time[1], ... -R/cluster_hits.R#L1780 meta$Time[length(meta$Time)], ... -R/cluster_hits.R#L1781 length.out = 1000 # To ensure sm ... -R/cluster_hits.R#L1787 Time = time_points, ... -R/cluster_hits.R#L1788 Y = y_values ... -R/cluster_hits.R#L1793 replicates <- meta[[replicate_colu ... -R/cluster_hits.R#L1794 plot_data$Replicate <- replicates ... -R/cluster_hits.R#L1795 ... -R/cluster_hits.R#L1796 # Create color palette for replica ... -R/cluster_hits.R#L1797 replicate_colors <- scales::hue_pa ... -R/cluster_hits.R#L1798 names(replicate_colors) <- unique( ... -R/cluster_hits.R#L1799 ... -R/cluster_hits.R#L1800 color_values <- c("Spline" = "red" ... -R/cluster_hits.R#L1802 color_values <- c("Data" = "blue", ... -R/cluster_hits.R#L1815 adj_p_value < adj_pthreshold / 50, ... -R/cluster_hits.R#L1816 "***", ... -R/cluster_hits.R#L1817 ifelse( ... -R/cluster_hits.R#L1821 adj_p_value < adj_pthreshold, ... -R/cluster_hits.R#L1822 "*", ... -R/cluster_hits.R#L1823 "" ... -R/cluster_hits.R#L1825 ) ... -R/cluster_hits.R#L1830 spline_label <- paste0( ... -R/cluster_hits.R#L1836 ) ... -R/cluster_hits.R#L1837 ... -R/cluster_hits.R#L1838 plot_spline <- data.frame( ... -R/cluster_hits.R#L1841 ) ... -R/cluster_hits.R#L1842 ... -R/cluster_hits.R#L1843 x_max <- as.numeric(max(time_point ... -R/cluster_hits.R#L1844 x_extension <- x_max * 0.05 ... -R/cluster_hits.R#L1845 ... -R/cluster_hits.R#L1846 all_time_points <- unique(c(time_p ... -R/cluster_hits.R#L1847 ... -R/cluster_hits.R#L1848 # Filter out close labels to avoid ... -R/cluster_hits.R#L1849 time_diffs <- diff(all_time_points ... -R/cluster_hits.R#L1850 min_spacing <- x_max * 0.05 # kee ... -R/cluster_hits.R#L1851 keep_labels <- c(TRUE, time_diffs ... -R/cluster_hits.R#L1852 filtered_time_points <- all_time_p ... -R/cluster_hits.R#L1853 ... -R/cluster_hits.R#L1854 dynamic_label <- function(labels) ... -R/cluster_hits.R#L1856 labels == "Spline", ... -R/cluster_hits.R#L1857 spline_label, ... -R/cluster_hits.R#L1858 labels ... -R/cluster_hits.R#L1860 } ... -R/cluster_hits.R#L1861 ... -R/cluster_hits.R#L1862 p <- ggplot2::ggplot() + ... -R/cluster_hits.R#L1864 data = plot_data, ... -R/cluster_hits.R#L1865 ggplot2::aes( ... -R/cluster_hits.R#L1870 .data$Replicate ... -R/cluster_hits.R#L1872 "Data" ... -R/cluster_hits.R#L1874 ), ... -R/cluster_hits.R#L1875 alpha = 0.5 # 50% transparent ... -R/cluster_hits.R#L1878 data = plot_spline, ... -R/cluster_hits.R#L1879 ggplot2::aes( ... -R/cluster_hits.R#L1883 ) ... -R/cluster_hits.R#L1887 limits = c(min(time_points), x ... -R/cluster_hits.R#L1888 breaks = filtered_time_points, ... -R/cluster_hits.R#L1889 labels = function(x) { ... -R/cluster_hits.R#L1891 } ... -R/cluster_hits.R#L1894 x = paste0("Time ", time_unit_ ... -R/cluster_hits.R#L1895 y = plot_info$y_axis_label ... -R/cluster_hits.R#L1898 values = color_values, ... -R/cluster_hits.R#L1899 labels = dynamic_label ... -R/cluster_hits.R#L1902 legend.position = "right", ... -R/cluster_hits.R#L1903 legend.justification = "center ... -R/cluster_hits.R#L1904 legend.box = "vertical", ... -R/cluster_hits.R#L1905 legend.background = ggplot2::e ... -R/cluster_hits.R#L1906 legend.title = ggplot2::elemen ... -R/cluster_hits.R#L1907 legend.text = ggplot2::element ... -R/cluster_hits.R#L1910 ), ... -R/cluster_hits.R#L1911 axis.text.x = ggplot2::element ... -R/cluster_hits.R#L1915 ), ... -R/cluster_hits.R#L1916 axis.title.y = ggplot2::elemen ... -R/cluster_hits.R#L1919 ), ... -R/cluster_hits.R#L1920 axis.text.y = ggplot2::element ... -R/cluster_hits.R#L1922 ) ... -R/cluster_hits.R#L1924 ... -R/cluster_hits.R#L1925 if (!all(is.na(treatment_labels))) ... -R/cluster_hits.R#L1928 Time = treatment_times, ... -R/cluster_hits.R#L1929 Label = treatment_labels ... -R/cluster_hits.R#L1933 data = treatment_df, ... -R/cluster_hits.R#L1934 ggplot2::aes( ... -R/cluster_hits.R#L1937 ), ... -R/cluster_hits.R#L1938 linetype = "dashed", ... -R/cluster_hits.R#L1939 size = 0.5 ... -R/cluster_hits.R#L1951 data = treatment_df, ... -R/cluster_hits.R#L1952 ggplot2::aes( ... -R/cluster_hits.R#L1957 ), ... -R/cluster_hits.R#L1958 angle = 90, # Rotate the labe ... -R/cluster_hits.R#L1959 vjust = 0, # Position on the ... -R/cluster_hits.R#L1960 hjust = 1, # Align the right ... -R/cluster_hits.R#L1961 size = 3, # Text size ... -R/cluster_hits.R#L1962 show.legend = FALSE # Stop te ... -R/cluster_hits.R#L1964 } ... -R/cluster_hits.R#L1965 ... -R/cluster_hits.R#L1966 # Add title and annotations ... -R/cluster_hits.R#L1967 matched_row <- dplyr::filter( ... -R/cluster_hits.R#L1970 ) ... -R/cluster_hits.R#L1971 ... -R/cluster_hits.R#L1972 title <- as.character(matched_row$ ... -R/cluster_hits.R#L1973 ... -R/cluster_hits.R#L1974 if (nchar(title) > 100) { ... -R/cluster_hits.R#L1978 "Truncating it to ... -R/cluster_hits.R#L1979 } ... -R/cluster_hits.R#L1980 ... -R/cluster_hits.R#L1981 if (is.na(title)) { ... -R/cluster_hits.R#L1983 } ... -R/cluster_hits.R#L1984 ... -R/cluster_hits.R#L1985 p <- p + ggplot2::labs(title = tit ... -R/cluster_hits.R#L1987 plot.title = ggplot2::element_ ... -R/cluster_hits.R#L1988 axis.title.x = ggplot2::elemen ... -R/cluster_hits.R#L1989 axis.title.y = ggplot2::elemen ... -R/cluster_hits.R#L1992 "text", ... -R/cluster_hits.R#L1993 x = x_max + (x_extension / 2), ... -R/cluster_hits.R#L1994 y = max(fitted_values, na.rm = ... -R/cluster_hits.R#L1995 label = "", ... -R/cluster_hits.R#L1996 hjust = 0.5, ... -R/cluster_hits.R#L1997 vjust = 1, ... -R/cluster_hits.R#L1998 size = 3.5, ... -R/cluster_hits.R#L1999 angle = 0, ... -R/cluster_hits.R#L2000 color = "black" ... -R/cluster_hits.R#L2002 p ... -R/cluster_hits.R#L2006 } ... -R/cluster_hits.R#L2007 ... -R/cluster_hits.R#L2008 return(plot_list) ... -R/cluster_hits.R#L2074 # Sort and prepare data ... -R/cluster_hits.R#L2075 time_effect_1 <- time_effect_1 |> dply ... -R/cluster_hits.R#L2076 time_effect_2 <- time_effect_2 |> dply ... -R/cluster_hits.R#L2078 # Get relevant parameters ... -R/cluster_hits.R#L2079 DoF <- which(names(time_effect_1) == " ... -R/cluster_hits.R#L2080 time_points <- meta$Time ... -R/cluster_hits.R#L2081 titles <- data.frame( ... -R/cluster_hits.R#L2084 ) ... -R/cluster_hits.R#L2086 plot_list <- list() ... -R/cluster_hits.R#L2087 feature_names_list <- list() ... -R/cluster_hits.R#L2089 for (hit in 1:nrow(time_effect_1)) { ... -R/cluster_hits.R#L2110 ... -R/cluster_hits.R#L2111 # Define the number of stars for a ... -R/cluster_hits.R#L2112 avrg_diff_stars <- ifelse( ... -R/cluster_hits.R#L2116 avrg_diff_pval < adj_pthresh_a ... -R/cluster_hits.R#L2117 "**", ... -R/cluster_hits.R#L2118 ifelse( ... -R/cluster_hits.R#L2122 ) ... -R/cluster_hits.R#L2124 ) ... -R/cluster_hits.R#L2125 ... -R/cluster_hits.R#L2126 # Define the number of stars for i ... -R/cluster_hits.R#L2127 interaction_stars <- ifelse( ... -R/cluster_hits.R#L2131 interaction_pval < adj_pthresh ... -R/cluster_hits.R#L2132 "**", ... -R/cluster_hits.R#L2133 ifelse( ... -R/cluster_hits.R#L2137 ) ... -R/cluster_hits.R#L2139 ) ... -R/cluster_hits.R#L2141 # Use the conditions to split the ... -R/cluster_hits.R#L2142 plot_data <- data.frame( ... -R/cluster_hits.R#L2146 ) ... -R/cluster_hits.R#L2148 # Create the plot ... -R/cluster_hits.R#L2149 p <- ggplot2::ggplot() + ... -R/cluster_hits.R#L2151 data = plot_data, ... -R/cluster_hits.R#L2152 ggplot2::aes( ... -R/cluster_hits.R#L2157 na.rm = TRUE, ... -R/cluster_hits.R#L2158 alpha = 0.5 # Make data dots ... -R/cluster_hits.R#L2161 data = data.frame( ... -R/cluster_hits.R#L2165 ggplot2::aes( ... -R/cluster_hits.R#L2172 data = plot_data, ... -R/cluster_hits.R#L2173 ggplot2::aes( ... -R/cluster_hits.R#L2178 na.rm = TRUE, ... -R/cluster_hits.R#L2179 alpha = 0.5 # Make data dots ... -R/cluster_hits.R#L2182 data = data.frame( ... -R/cluster_hits.R#L2186 ggplot2::aes( ... -R/cluster_hits.R#L2193 c("orange", "orange", "purple" ... -R/cluster_hits.R#L2194 c(paste("Data", condition_1), ... -R/cluster_hits.R#L2198 breaks = unique(meta$Time), # ... -R/cluster_hits.R#L2199 guide = ggplot2::guide_axis( ... -R/cluster_hits.R#L2202 ) ... -R/cluster_hits.R#L2205 title = paste( ... -R/cluster_hits.R#L2212 ), ... -R/cluster_hits.R#L2213 x = paste0("Time [", plot_info ... -R/cluster_hits.R#L2214 y = plot_info$y_axis_label ... -R/cluster_hits.R#L2218 legend.position = "right", ... -R/cluster_hits.R#L2219 legend.title = element_blank() ... -R/cluster_hits.R#L2220 plot.title = ggplot2::element_ ... -R/cluster_hits.R#L2223 plot_list[[length(plot_list) + 1]] ... -R/cluster_hits.R#L2224 feature_names_list[[length(feature ... -R/cluster_hits.R#L2227 } ... -R/cluster_hits.R#L2229 return(list( ... -R/cluster_hits.R#L2232 )) ... -R/cluster_hits.R#L2253 ... -R/cluster_hits.R#L2254 all_levels_clustering <- lapply( ... -R/cluster_hits.R#L2257 # Check if x is not logical and an ... -R/cluster_hits.R#L2258 if (!is.logical(x) && !is.null(ann ... -R/cluster_hits.R#L2260 x$top_table, ... -R/cluster_hits.R#L2261 annotation ... -R/cluster_hits.R#L2263 } ... -R/cluster_hits.R#L2264 return(x) ... -R/cluster_hits.R#L2266 ) ... -R/cluster_hits.R#L2267 ... -R/cluster_hits.R#L2268 return(all_levels_clustering) ... -R/cluster_hits.R#L2290 formatted_gene_lists <- list() ... -R/cluster_hits.R#L2291 ... -R/cluster_hits.R#L2292 for (i in seq_along(all_levels_cluster ... -R/cluster_hits.R#L2301 clustered_hits$feature, ... -R/cluster_hits.R#L2302 clustered_hits$cluster ... -R/cluster_hits.R#L2308 cluster_genes <- clusters[[cluster ... -R/cluster_hits.R#L2310 gene_list <- genes[cluster_genes] ... -R/cluster_hits.R#L2311 gene_list <- na.omit(gene_list) # ... -R/cluster_hits.R#L2312 ... -R/cluster_hits.R#L2313 if (length(gene_list) > 0) { ... -R/cluster_hits.R#L2315 paste(gene_list, collapse = "\ ... -R/cluster_hits.R#L2316 } ... -R/cluster_hits.R#L2320 } ... -R/cluster_hits.R#L2321 ... -R/cluster_hits.R#L2322 # Prepare the background genes list us ... -R/cluster_hits.R#L2323 background_gene_list <- paste( ... -R/cluster_hits.R#L2327 ... -R/cluster_hits.R#L2328 return(list( ... -R/cluster_hits.R#L2331 )) ... -R/cluster_hits.R#L2378 html_content <- paste(header_section, ... -R/cluster_hits.R#L2379 ... -R/cluster_hits.R#L2380 toc <- create_toc() ... -R/cluster_hits.R#L2381 ... -R/cluster_hits.R#L2382 styles <- define_html_styles() ... -R/cluster_hits.R#L2383 section_header_style <- styles$section ... -R/cluster_hits.R#L2384 toc_style <- styles$toc_style ... -R/cluster_hits.R#L2386 current_header_index <- 1 ... -R/cluster_hits.R#L2387 j <- 0 ... -R/cluster_hits.R#L2388 level_headers_info <- Filter(Negate(is ... -R/cluster_hits.R#L2390 ... -R/cluster_hits.R#L2391 pb <- create_progress_bar(plots) ... -R/cluster_hits.R#L2393 header_index <- 0 ... -R/cluster_hits.R#L2394 level_index <- 0 ... -R/cluster_hits.R#L2395 ... -R/cluster_hits.R#L2396 # Generate the sections and plots ... -R/cluster_hits.R#L2397 for (index in seq_along(plots)) { ... -R/cluster_hits.R#L2401 header_info <- level_headers_info[ ... -R/cluster_hits.R#L2402 nr_hits <- header_info$nr_hits ... -R/cluster_hits.R#L2403 adj_pvalue_threshold <- header_inf ... -R/cluster_hits.R#L2405 # means this is the section of a n ... -R/cluster_hits.R#L2406 # The very first level is also a n ... -R/cluster_hits.R#L2407 if (names(plots)[index] == "new_le ... -R/cluster_hits.R#L2412 "Time Effect of Condition:", ... -R/cluster_hits.R#L2413 header_info$header_name ... -R/cluster_hits.R#L2417 "

    " ... -R/cluster_hits.R#L2509 } else { # element_name == "indiv ... -R/cluster_hits.R#L2513 "", ... -R/cluster_hits.R#L2541 asterisks_definition, ... -R/cluster_hits.R#L2542 "

    ") ... -R/cluster_hits.R#L2545 } ... -R/cluster_hits.R#L2546 ... -R/cluster_hits.R#L2547 html_content <- paste( ... -R/cluster_hits.R#L2551 ) ... -R/cluster_hits.R#L2552 ... -R/cluster_hits.R#L2553 toc_entry <- paste0( ... -R/cluster_hits.R#L2560 ) ... -R/cluster_hits.R#L2561 ... -R/cluster_hits.R#L2562 toc <- paste(toc, toc_entry, sep = ... -R/cluster_hits.R#L2568 plots_element = plots[[index]], ... -R/cluster_hits.R#L2569 element_name = names(plots)[index] ... -R/cluster_hits.R#L2570 plots_size = plots_sizes[[index]], ... -R/cluster_hits.R#L2571 html_content = html_content, ... -R/cluster_hits.R#L2572 toc = toc, ... -R/cluster_hits.R#L2573 header_index = header_index ... -R/cluster_hits.R#L2574 ) ... -R/cluster_hits.R#L2580 } ... -R/cluster_hits.R#L2581 ... -R/cluster_hits.R#L2582 # Add sections for limma_result_2_and_ ... -R/cluster_hits.R#L2583 if (!is.null(limma_result_2_and_3_plot ... -R/cluster_hits.R#L2591 "

    %s< ... -R/cluster_hits.R#L2592 section_header_style, ... -R/cluster_hits.R#L2593 header_index, ... -R/cluster_hits.R#L2594 "Avrg diff conditions & interactio ... -R/cluster_hits.R#L2598 html_content, ... -R/cluster_hits.R#L2599 limma_main_header, ... -R/cluster_hits.R#L2600 sep = "\n" ... -R/cluster_hits.R#L2606 "
    Asterisks definition (Average Di ... -R/cluster_hits.R#L2609 paste( ... -R/cluster_hits.R#L2615 "
    ", ... -R/cluster_hits.R#L2616 paste( ... -R/cluster_hits.R#L2622 "
    ", ... -R/cluster_hits.R#L2623 paste( ... -R/cluster_hits.R#L2629 "
    ", ... -R/cluster_hits.R#L2630 sep = "\n" ... -R/cluster_hits.R#L2634 "
    Asterisks definition (Interactio ... -R/cluster_hits.R#L2637 paste( ... -R/cluster_hits.R#L2643 "
    ", ... -R/cluster_hits.R#L2644 paste( ... -R/cluster_hits.R#L2650 "
    ", ... -R/cluster_hits.R#L2651 paste( ... -R/cluster_hits.R#L2657 "
    ", ... -R/cluster_hits.R#L2658 sep = "\n" ... -R/cluster_hits.R#L2663 html_content, ... -R/cluster_hits.R#L2664 asterisks_definition_avrg_diff, ... -R/cluster_hits.R#L2665 asterisks_definition_interaction, ... -R/cluster_hits.R#L2666 sep = "\n" ... -R/cluster_hits.R#L2671 "
  • ... -R/cluster_hits.R#L2845 curve_values <- matrix( ... -R/cluster_hits.R#L2850 for(i in 1:nrow(splineCoeffs)) { ... -R/cluster_hits.R#L2852 splineCoeffs[i, ], ... -R/cluster_hits.R#L2853 ncol = ncol(splineCoeffs), ... -R/cluster_hits.R#L2854 byrow = TRUE ... -R/cluster_hits.R#L2855 ) ... -R/cluster_hits.R#L2858 } ... -R/cluster_hits.R#L2860 curve_values <- as.data.frame(curve_va ... -R/cluster_hits.R#L2861 rownames(curve_values) <- rownames(spl ... -R/cluster_hits.R#L2862 ... -R/cluster_hits.R#L2863 list( ... -R/cluster_hits.R#L2889 normalized_curves <- apply(curve_value ... -R/cluster_hits.R#L2891 }) ... -R/cluster_hits.R#L2893 normalized_curves <- t(normalized_curv ... -R/cluster_hits.R#L2894 curve_values[,] <- normalized_curves ... -R/cluster_hits.R#L2895 curve_values ... -R/cluster_hits.R#L2921 distance_matrix <- stats::dist(curve_v ... -R/cluster_hits.R#L2922 hc <- stats::hclust(distance_matrix, m ... -R/cluster_hits.R#L2924 cluster_assignments <- stats::cutree(h ... -R/cluster_hits.R#L2926 clustered_hits <- data.frame(cluster = ... -R/cluster_hits.R#L2928 clustered_hits$feature <- top_table$fe ... -R/cluster_hits.R#L2929 clustered_hits <- clustered_hits[, c(" ... -R/cluster_hits.R#L2931 colnames(curve_values) <- smooth_timep ... -R/cluster_hits.R#L2932 curve_values$cluster <- cluster_assign ... -R/cluster_hits.R#L2934 top_table$cluster <- NA ... -R/cluster_hits.R#L2935 top_table$cluster[1:nrow(clustered_hit ... -R/cluster_hits.R#L2938 group_clustering <- list( ... -R/cluster_hits.R#L2977 if (!is.null(spline_params$spline_type ... -R/cluster_hits.R#L2978 length(spline_params$spline_type) ... -R/cluster_hits.R#L2980 } else { ... -R/cluster_hits.R#L2982 } ... -R/cluster_hits.R#L2984 if (!is.null(spline_params$degree) && ... -R/cluster_hits.R#L2985 length(spline_params$degree) >= j) ... -R/cluster_hits.R#L2987 } else { ... -R/cluster_hits.R#L2989 } ... -R/cluster_hits.R#L2991 if (!is.null(spline_params$dof) && ... -R/cluster_hits.R#L2992 length(spline_params$dof) >= j) { ... -R/cluster_hits.R#L2994 } else { ... -R/cluster_hits.R#L2996 } ... -R/cluster_hits.R#L2998 if (!is.null(spline_params$knots) && ... -R/cluster_hits.R#L2999 length(spline_params$knots) >= j) ... -R/cluster_hits.R#L3001 } else { ... -R/cluster_hits.R#L3003 } ... -R/cluster_hits.R#L3005 if (!is.null(spline_params$bknots) && ... -R/cluster_hits.R#L3006 length(spline_params$bknots) >= j) ... -R/cluster_hits.R#L3008 } else { ... -R/cluster_hits.R#L3010 } ... -R/cluster_hits.R#L3012 if (spline_params$spline_type[j] == "b ... -R/cluster_hits.R#L3023 } else { # spline_type == "n" ... -R/cluster_hits.R#L3033 } ... -R/cluster_hits.R#L3034 return(spline_params_info) ... -R/cluster_hits.R#L3055 sapply(names, function(x) { ... -R/cluster_hits.R#L3057 return(paste0(substr(x, 1, max_len ... -R/cluster_hits.R#L3059 return(x) ... -R/cluster_hits.R#L3061 }) ... -R/cluster_hits.R#L3100 ... -R/cluster_hits.R#L3101 time_col <- rlang::sym("time") ... -R/cluster_hits.R#L3102 feature_col <- rlang::sym("feature") ... -R/cluster_hits.R#L3103 ... -R/cluster_hits.R#L3104 # Convert data to long format ... -R/cluster_hits.R#L3105 df_long <- as.data.frame(t(time_series ... -R/cluster_hits.R#L3108 cols = -!!time_col, ... -R/cluster_hits.R#L3109 names_to = "feature", ... -R/cluster_hits.R#L3110 values_to = "intensity" ... -R/cluster_hits.R#L3114 ... -R/cluster_hits.R#L3115 # Compute consensus (mean of each colu ... -R/cluster_hits.R#L3116 consensus <- colMeans(time_series_data ... -R/cluster_hits.R#L3117 ... -R/cluster_hits.R#L3118 consensus_df <- data.frame( ... -R/cluster_hits.R#L3121 ) ... -R/cluster_hits.R#L3122 ... -R/cluster_hits.R#L3123 time_unit_label = paste0("[", plot_inf ... -R/cluster_hits.R#L3124 ... -R/cluster_hits.R#L3125 color_values <- c( ... -R/cluster_hits.R#L3128 ) ... -R/cluster_hits.R#L3129 ... -R/cluster_hits.R#L3130 p <- ggplot2::ggplot() + ... -R/cluster_hits.R#L3132 data = df_long, ... -R/cluster_hits.R#L3133 ggplot2::aes( ... -R/cluster_hits.R#L3138 ), ... -R/cluster_hits.R#L3139 alpha = 0.3, linewidth = 0.5) + ... -R/cluster_hits.R#L3141 data = consensus_df, ... -R/cluster_hits.R#L3142 ggplot2::aes( ... -R/cluster_hits.R#L3146 ), ... -R/cluster_hits.R#L3147 linewidth = 1.5) ... -R/cluster_hits.R#L3148 ... -R/cluster_hits.R#L3149 # Conditionally add vertical dashed li ... -R/cluster_hits.R#L3150 if (!all(is.na(plot_info$treatment_lab ... -R/cluster_hits.R#L3154 Time = plot_info$treatment_timepoi ... -R/cluster_hits.R#L3155 Label = treatment_labels ... -R/cluster_hits.R#L3159 ggplot2::geom_vline( ... -R/cluster_hits.R#L3162 xintercept = .data$Time, ... -R/cluster_hits.R#L3163 color = .data$Label ... -R/cluster_hits.R#L3167 ) + ... -R/cluster_hits.R#L3168 ggplot2::geom_text( ... -R/cluster_hits.R#L3171 x = .data$Time - max(.data$Tim ... -R/cluster_hits.R#L3172 y = 1, ... -R/cluster_hits.R#L3173 label = .data$Time, ... -R/cluster_hits.R#L3174 color = .data$Label ... -R/cluster_hits.R#L3181 ) ... -R/cluster_hits.R#L3187 } ... -R/cluster_hits.R#L3188 ... -R/cluster_hits.R#L3189 p <- p + ... -R/cluster_hits.R#L3191 name = "", ... -R/cluster_hits.R#L3192 values = color_values, ... -R/cluster_hits.R#L3193 guide = ggplot2::guide_legend( ... -R/cluster_hits.R#L3195 size = c( ... -R/cluster_hits.R#L3199 0.5, ... -R/cluster_hits.R#L3200 length(na.omit(plot_info$t ... -R/cluster_hits.R#L3201 ) ... -R/cluster_hits.R#L3204 ) ... -R/cluster_hits.R#L3209 title = title, ... -R/cluster_hits.R#L3210 x = paste("Time", time_unit_label) ... -R/cluster_hits.R#L3211 y = paste("min-max norm.", plot_in ... -R/cluster_hits.R#L3214 plot.margin = grid::unit(c(1, 1, 1 ... -R/cluster_hits.R#L3215 legend.position = "right", ... -R/cluster_hits.R#L3216 legend.box = "vertical", ... -R/cluster_hits.R#L3217 legend.title = ggplot2::element_te ... -R/cluster_hits.R#L3218 legend.background = ggplot2::eleme ... -R/cluster_hits.R#L3219 axis.title.y = ggplot2::element_te ... -R/cluster_hits.R#L3220 plot.title = ggplot2::element_text ... -R/cluster_hits.R#L3221 legend.key.size = grid::unit(0.6, ... -R/cluster_hits.R#L3222 legend.key.height = grid::unit(0.3 ... -R/cluster_hits.R#L3224 ... -R/cluster_hits.R#L3225 return(p) ... -R/create_limma_report.R#L54 ... -R/create_limma_report.R#L55 report_dir <- normalizePath( ... -R/create_limma_report.R#L58 ) ... -R/create_limma_report.R#L59 ... -R/create_limma_report.R#L60 check_splineomics_elements( ... -R/create_limma_report.R#L63 ) ... -R/create_limma_report.R#L64 ... -R/create_limma_report.R#L65 # Control the function arguments ... -R/create_limma_report.R#L66 args <- lapply(as.list(match.call()[-1 ... -R/create_limma_report.R#L67 check_null_elements(args) ... -R/create_limma_report.R#L68 input_control <- InputControl$new(args ... -R/create_limma_report.R#L69 input_control$auto_validate() ... -R/create_limma_report.R#L70 ... -R/create_limma_report.R#L71 limma_splines_result <- splineomics[[" ... -R/create_limma_report.R#L72 meta <- splineomics[["meta"]] ... -R/create_limma_report.R#L73 condition <- splineomics[["condition"] ... -R/create_limma_report.R#L74 annotation <- splineomics[["annotation ... -R/create_limma_report.R#L75 report_info <- splineomics[["report_in ... -R/create_limma_report.R#L76 ... -R/create_limma_report.R#L77 # Get the top_tables of the three limm ... -R/create_limma_report.R#L78 time_effect <- limma_splines_result$ti ... -R/create_limma_report.R#L79 avrg_diff_conditions <- limma_splines_ ... -R/create_limma_report.R#L80 interaction_condition_time <- limma_sp ... -R/create_limma_report.R#L81 ... -R/create_limma_report.R#L82 plots <- list() ... -R/create_limma_report.R#L83 plots_sizes <- list() ... -R/create_limma_report.R#L84 section_headers_info <- list() ... -R/create_limma_report.R#L86 ... -R/create_limma_report.R#L87 result <- generate_time_effect_plots( ... -R/create_limma_report.R#L91 ... -R/create_limma_report.R#L92 plots <- c( ... -R/create_limma_report.R#L96 plots_sizes <- c( ... -R/create_limma_report.R#L100 section_headers_info <- c( ... -R/create_limma_report.R#L105 ... -R/create_limma_report.R#L106 # length == 0 when there was just one ... -R/create_limma_report.R#L107 if (length(avrg_diff_conditions) > 0) ... -R/create_limma_report.R#L110 avrg_diff_conditions, ... -R/create_limma_report.R#L111 adj_pthresh ... -R/create_limma_report.R#L112 ) ... -R/create_limma_report.R#L115 plots, ... -R/create_limma_report.R#L116 result$plots ... -R/create_limma_report.R#L117 ) ... -R/create_limma_report.R#L119 plots_sizes, ... -R/create_limma_report.R#L120 result$plots_sizes ... -R/create_limma_report.R#L121 ) ... -R/create_limma_report.R#L123 section_headers_info, ... -R/create_limma_report.R#L124 result$section_headers_info ... -R/create_limma_report.R#L125 ) ... -R/create_limma_report.R#L126 } ... -R/create_limma_report.R#L128 # length == 0 when there was just one ... -R/create_limma_report.R#L129 if (length(interaction_condition_time) ... -R/create_limma_report.R#L132 interaction_condition_time, ... -R/create_limma_report.R#L133 adj_pthresh ... -R/create_limma_report.R#L134 ) ... -R/create_limma_report.R#L137 plots, ... -R/create_limma_report.R#L138 result$plots ... -R/create_limma_report.R#L139 ) ... -R/create_limma_report.R#L141 plots_sizes, ... -R/create_limma_report.R#L142 result$plots_sizes ... -R/create_limma_report.R#L143 ) ... -R/create_limma_report.R#L145 section_headers_info, ... -R/create_limma_report.R#L146 result$section_headers_info ... -R/create_limma_report.R#L147 ) ... -R/create_limma_report.R#L148 } ... -R/create_limma_report.R#L149 ... -R/create_limma_report.R#L150 all_top_tables <- c( ... -R/create_limma_report.R#L155 ... -R/create_limma_report.R#L156 unique_values <- unique(meta[[conditio ... -R/create_limma_report.R#L157 new_names <- sapply( ... -R/create_limma_report.R#L162 names(all_top_tables) <- new_names ... -R/create_limma_report.R#L163 ... -R/create_limma_report.R#L164 if (!is.null(annotation)) { ... -R/create_limma_report.R#L167 all_top_tables[[index]] <- merge_t ... -R/create_limma_report.R#L170 ) ... -R/create_limma_report.R#L172 } ... -R/create_limma_report.R#L174 generate_report_html( ... -R/create_limma_report.R#L184 ... -R/create_limma_report.R#L185 print_info_message( ... -R/create_limma_report.R#L188 ) ... -R/create_limma_report.R#L190 return(plots) ... -R/create_limma_report.R#L216 ... -R/create_limma_report.R#L217 plots <- list("Time Effect") ... -R/create_limma_report.R#L218 plots_sizes <- c(999) ... -R/create_limma_report.R#L219 ... -R/create_limma_report.R#L220 header_info <- list(header_name = "Tim ... -R/create_limma_report.R#L221 section_headers_info <- list(header_in ... -R/create_limma_report.R#L222 ... -R/create_limma_report.R#L223 for (i in seq_along(time_effect)) { ... -R/create_limma_report.R#L230 top_table = top_table, ... -R/create_limma_report.R#L231 title = title ... -R/create_limma_report.R#L232 ) ... -R/create_limma_report.R#L235 plots, ... -R/create_limma_report.R#L236 list(p_value_hist) ... -R/create_limma_report.R#L237 ) ... -R/create_limma_report.R#L239 } ... -R/create_limma_report.R#L240 ... -R/create_limma_report.R#L241 list( ... -R/create_limma_report.R#L268 ... -R/create_limma_report.R#L269 plots <- list("Average Difference Cond ... -R/create_limma_report.R#L270 plots_sizes <- c(999) ... -R/create_limma_report.R#L271 ... -R/create_limma_report.R#L272 header_info <- list(header_name = "Ave ... -R/create_limma_report.R#L273 section_headers_info <- list(header_in ... -R/create_limma_report.R#L274 ... -R/create_limma_report.R#L275 for (i in seq_along(avrg_diff_conditio ... +R/cluster_hits.R#L281 } else { # no between level analysis ... +R/cluster_hits.R#L283 } ... +R/cluster_hits.R#L285 for (i in seq_along(within_level_top_t ... +R/cluster_hits.R#L290 hit_indices <- get_level_hit_indic ... +R/cluster_hits.R#L294 ) ... +R/cluster_hits.R#L296 hit_indices <- within_level_top_ta ... +R/cluster_hits.R#L298 ] ... +R/cluster_hits.R#L302 within_level_top_table[within_leve ... +R/cluster_hits.R#L303 %in% hit_indices, ] ... +R/cluster_hits.R#L306 message(paste( ... +R/cluster_hits.R#L309 )) ... +R/cluster_hits.R#L310 within_level_top_tables[[i]] <- NA ... +R/cluster_hits.R#L312 within_level_top_tables[[i]] <- to ... +R/cluster_hits.R#L314 } ... +R/cluster_hits.R#L316 if (all(is.na(within_level_top_tables) ... +R/cluster_hits.R#L318 } ... +R/cluster_hits.R#L320 within_level_top_tables ... +R/cluster_hits.R#L336 for (i in seq_along(tables)) { ... +R/cluster_hits.R#L338 next ... +R/cluster_hits.R#L342 # Prompt the user for input ... +R/cluster_hits.R#L343 while (TRUE) { ... +R/cluster_hits.R#L345 "The table", ... +R/cluster_hits.R#L346 names(tables)[i], ... +R/cluster_hits.R#L347 "has more than 500 rows. Do yo ... +R/cluster_hits.R#L353 # Proceed ... +R/cluster_hits.R#L354 print("Proceeding...") ... +R/cluster_hits.R#L355 break ... +R/cluster_hits.R#L357 stop_call_false("Script stoppe ... +R/cluster_hits.R#L359 # Invalid input, ask the user ... +R/cluster_hits.R#L360 message( ... +R/cluster_hits.R#L363 ) ... +R/cluster_hits.R#L365 } ... +R/cluster_hits.R#L367 } ... +R/cluster_hits.R#L397 levels <- unique(meta[[condition]]) ... +R/cluster_hits.R#L399 all_levels_clustering <- mapply( ... +R/cluster_hits.R#L405 meta = meta, ... +R/cluster_hits.R#L406 condition = condition, ... +R/cluster_hits.R#L407 spline_params = spline_params, ... +R/cluster_hits.R#L408 mode = mode ... +R/cluster_hits.R#L411 ) # Return a list ... +R/cluster_hits.R#L413 return(all_levels_clustering) ... +R/cluster_hits.R#L500 # Optionally remove the batch-effect w ... +R/cluster_hits.R#L501 # For mode == "integrated", the batch- ... +R/cluster_hits.R#L502 # For mode == "isolated", the batch-ef ... +R/cluster_hits.R#L503 datas <- remove_batch_effect_cluster_h ... +R/cluster_hits.R#L512 ) ... +R/cluster_hits.R#L515 # To extract the stored value for the ... +R/cluster_hits.R#L516 clusters <- c() ... +R/cluster_hits.R#L517 for (i in seq_along(all_levels_cluster ... +R/cluster_hits.R#L519 all(is.na(all_levels_clustering[[i ... +R/cluster_hits.R#L520 next ... +R/cluster_hits.R#L525 } ... +R/cluster_hits.R#L527 if (!dir.exists(report_dir)) { ... +R/cluster_hits.R#L529 } ... +R/cluster_hits.R#L531 time_unit_label <- paste0("[", plot_in ... +R/cluster_hits.R#L533 heatmaps <- plot_heatmap( ... +R/cluster_hits.R#L541 ) ... +R/cluster_hits.R#L543 # log2_intensity_shape <- plot_log2_in ... +R/cluster_hits.R#L545 level_headers_info <- list() ... +R/cluster_hits.R#L546 plots <- list() ... +R/cluster_hits.R#L547 plots_sizes <- list() ... +R/cluster_hits.R#L548 q <- 0 ... +R/cluster_hits.R#L550 for (i in seq_along(all_levels_cluster ... +R/cluster_hits.R#L553 all(is.na(all_levels_clustering[[i ... +R/cluster_hits.R#L554 next ... +R/cluster_hits.R#L556 q <- q + 1 ... +R/cluster_hits.R#L564 level <- levels[i] ... +R/cluster_hits.R#L566 # Construct header name ... +R/cluster_hits.R#L567 header_name <- level ... +R/cluster_hits.R#L569 nr_hits <- nrow(level_clustering$c ... +R/cluster_hits.R#L571 header_info <- list( ... +R/cluster_hits.R#L575 ) ... +R/cluster_hits.R#L577 level_headers_info[[i]] <- header_ ... +R/cluster_hits.R#L583 hc = level_clustering$hc, ... +R/cluster_hits.R#L584 clusters = level_clustering[["clus ... +R/cluster_hits.R#L585 k = clusters[q] ... +R/cluster_hits.R#L589 curve_values = curve_values, ... +R/cluster_hits.R#L590 plot_info = plot_info, ... +R/cluster_hits.R#L591 level = level ... +R/cluster_hits.R#L595 curve_values = curve_values, ... +R/cluster_hits.R#L596 plot_info = plot_info, ... +R/cluster_hits.R#L597 level = level ... +R/cluster_hits.R#L606 data_level <- datas[[i]][, col_ind ... +R/cluster_hits.R#L608 data_level <- datas[[i]] ... +R/cluster_hits.R#L616 nr_of_hits <- sum( ... +R/cluster_hits.R#L619 ) ... +R/cluster_hits.R#L620 main_title <- paste( ... +R/cluster_hits.R#L626 ) ... +R/cluster_hits.R#L628 top_table_cluster <- top_table |> ... +R/cluster_hits.R#L631 X <- level_clustering$X ... +R/cluster_hits.R#L633 spline_plots <- plot_splines( ... +R/cluster_hits.R#L643 ) ... +R/cluster_hits.R#L645 clusters_spline_plots[[length(clus ... +R/cluster_hits.R#L648 ) ... +R/cluster_hits.R#L652 plots, ... +R/cluster_hits.R#L653 new_level = "level_header", # is t ... +R/cluster_hits.R#L654 dendrogram = list(dendrogram), ... +R/cluster_hits.R#L655 p_curves = list(p_curves), ... +R/cluster_hits.R#L656 cluster_mean_splines = list(cluste ... +R/cluster_hits.R#L657 heatmap = heatmaps[[i]], ... +R/cluster_hits.R#L658 individual_spline_plots = clusters ... +R/cluster_hits.R#L663 plots_sizes, ... +R/cluster_hits.R#L664 999, # dummy size for "next_level" ... +R/cluster_hits.R#L665 1.5, ... +R/cluster_hits.R#L666 1.5, ... +R/cluster_hits.R#L667 1, ... +R/cluster_hits.R#L668 1.5, ... +R/cluster_hits.R#L669 rep(1, length(clusters_spline_plot ... +R/cluster_hits.R#L671 } ... +R/cluster_hits.R#L673 topTables <- list() ... +R/cluster_hits.R#L675 # Loop over each element in all_levels ... +R/cluster_hits.R#L676 for (i in seq_along(all_levels_cluster ... +R/cluster_hits.R#L690 element_name <- substr(element_nam ... +R/cluster_hits.R#L694 } ... +R/cluster_hits.R#L696 if (!is.null(genes)) { ... +R/cluster_hits.R#L698 all_levels_clustering, ... +R/cluster_hits.R#L699 genes ... +R/cluster_hits.R#L701 } else { ... +R/cluster_hits.R#L703 } ... +R/cluster_hits.R#L705 all_levels_clustering <- merge_annotat ... +R/cluster_hits.R#L708 ) ... +R/cluster_hits.R#L710 print("Generating report. This takes a ... +R/cluster_hits.R#L712 generate_report_html( ... +R/cluster_hits.R#L726 adj_pthresh_interaction_condition_ ... +R/cluster_hits.R#L732 ) ... +R/cluster_hits.R#L734 return(plots) ... +R/cluster_hits.R#L781 # Initialize the list that will store ... +R/cluster_hits.R#L782 comparison_plots <- list() ... +R/cluster_hits.R#L784 # Check if all three elements are pres ... +R/cluster_hits.R#L785 if (length(splineomics[["limma_splines ... +R/cluster_hits.R#L789 splineomics[["limma_splines_result ... +R/cluster_hits.R#L791 splineomics[["limma_splines_result ... +R/cluster_hits.R#L801 condition_1 <- pair[1] ... +R/cluster_hits.R#L802 condition_2 <- pair[2] ... +R/cluster_hits.R#L804 # Sort the current pair of conditi ... +R/cluster_hits.R#L805 sorted_conditions <- sort(c(condit ... +R/cluster_hits.R#L807 # Initialize matched dataframes as ... +R/cluster_hits.R#L808 matched_avrg_diff <- NULL ... +R/cluster_hits.R#L809 matched_interaction_cond_time <- N ... +R/cluster_hits.R#L811 # Search for the correct dataframe ... +R/cluster_hits.R#L812 for (df_name in names(avrg_diff_co ... +R/cluster_hits.R#L815 sub( ... +R/cluster_hits.R#L819 ), ... +R/cluster_hits.R#L820 "_vs_" ... +R/cluster_hits.R#L827 matched_avrg_diff <- avrg_diff ... +R/cluster_hits.R#L828 break ... +R/cluster_hits.R#L830 } ... +R/cluster_hits.R#L832 # Search for the correct dataframe ... +R/cluster_hits.R#L833 for (df_name in names(interaction_ ... +R/cluster_hits.R#L837 sub( ... +R/cluster_hits.R#L841 ), ... +R/cluster_hits.R#L842 "_vs_" ... +R/cluster_hits.R#L850 matched_interaction_cond_time ... +R/cluster_hits.R#L851 break ... +R/cluster_hits.R#L853 } ... +R/cluster_hits.R#L855 # If both matched dataframes are f ... +R/cluster_hits.R#L856 if (!is.null(matched_avrg_diff) && ... +R/cluster_hits.R#L868 time_effect_1 = time_effect_1, ... +R/cluster_hits.R#L869 condition_1 = condition_1, ... +R/cluster_hits.R#L870 time_effect_2 = time_effect_2, ... +R/cluster_hits.R#L871 condition_2 = condition_2, ... +R/cluster_hits.R#L872 avrg_diff_conditions = matched ... +R/cluster_hits.R#L873 interaction_condition_time = m ... +R/cluster_hits.R#L874 data = data, ... +R/cluster_hits.R#L875 meta = meta, ... +R/cluster_hits.R#L876 condition = condition, ... +R/cluster_hits.R#L877 X_1 = X_1, ... +R/cluster_hits.R#L878 X_2 = X_2, ... +R/cluster_hits.R#L879 plot_info = plot_info, ... +R/cluster_hits.R#L880 adj_pthresh_avrg_diff_conditio ... +R/cluster_hits.R#L881 adj_pthresh_interaction = adj_ ... +R/cluster_hits.R#L888 } ... +R/cluster_hits.R#L890 } else { ... +R/cluster_hits.R#L892 } ... +R/cluster_hits.R#L894 # Return the list containing all plot ... +R/cluster_hits.R#L895 return(comparison_plots) ... +R/cluster_hits.R#L914 message(paste0( ... +R/cluster_hits.R#L919 )) ... +R/cluster_hits.R#L921 message(paste0( ... +R/cluster_hits.R#L925 )) ... +R/cluster_hits.R#L927 # Apply cleaning process to each gene ... +R/cluster_hits.R#L928 cleaned_genes <- vapply(genes, functio ... +R/cluster_hits.R#L930 # Replace all non-alphanumeric cha ... +R/cluster_hits.R#L931 gene_name <- gsub("[^A-Za-z0-9]", ... +R/cluster_hits.R#L933 # Extract the first block of alpha ... +R/cluster_hits.R#L934 # first whitespace ... +R/cluster_hits.R#L935 clean_gene_name <- sub("^([A-Za-z0 ... +R/cluster_hits.R#L937 # Convert to uppercase ... +R/cluster_hits.R#L938 toupper(clean_gene_name) ... +R/cluster_hits.R#L940 NA ... +R/cluster_hits.R#L942 }, character(1)) ... +R/cluster_hits.R#L944 # Return cleaned genes, keeping the sa ... +R/cluster_hits.R#L945 return(cleaned_genes) ... +R/cluster_hits.R#L979 # Initialize variables ... +R/cluster_hits.R#L980 between_levels <- FALSE ... +R/cluster_hits.R#L981 index_with_pattern <- NA ... +R/cluster_hits.R#L983 # Define the regular expression patter ... +R/cluster_hits.R#L984 pattern <- ".+_vs_.+" ... +R/cluster_hits.R#L986 # Check if top_tables is a list ... +R/cluster_hits.R#L987 if (is.list(top_tables)) { ... +R/cluster_hits.R#L990 # Check if the element is a list ... +R/cluster_hits.R#L991 if (is.list(top_tables[[i]])) { ... +R/cluster_hits.R#L996 between_levels <- TRUE ... +R/cluster_hits.R#L997 index_with_pattern <- i ... +R/cluster_hits.R#L998 break ... +R/cluster_hits.R#L1000 } ... +R/cluster_hits.R#L1002 } ... +R/cluster_hits.R#L1004 return(list( ... +R/cluster_hits.R#L1007 )) ... +R/cluster_hits.R#L1038 unique_hit_indices <- c() ... +R/cluster_hits.R#L1040 # Loop through the elements of the lis ... +R/cluster_hits.R#L1041 for (i in seq_along(between_level_top_ ... +R/cluster_hits.R#L1047 # Get the current data frame ... +R/cluster_hits.R#L1048 within_level_top_table <- between_ ... +R/cluster_hits.R#L1050 # Find the row indices that meet t ... +R/cluster_hits.R#L1051 hit_indices <- ... +R/cluster_hits.R#L1054 # Extract the feature indices from ... +R/cluster_hits.R#L1055 feature_indices <- within_level_to ... +R/cluster_hits.R#L1056 feature_indices <- within_level_to ... +R/cluster_hits.R#L1059 ] ... +R/cluster_hits.R#L1060 unique_hit_indices <- c( ... +R/cluster_hits.R#L1063 ) ... +R/cluster_hits.R#L1065 } ... +R/cluster_hits.R#L1067 # Get unique feature indices ... +R/cluster_hits.R#L1068 unique_hit_indices <- unique(unique_hi ... +R/cluster_hits.R#L1102 # means that it had < 2 hits. ... +R/cluster_hits.R#L1103 if (is.null(top_table) || all(is.na(to ... +R/cluster_hits.R#L1105 } ... +R/cluster_hits.R#L1107 curve_results <- get_curve_values( ... +R/cluster_hits.R#L1114 ) ... +R/cluster_hits.R#L1116 normalized_curves <- normalize_curves( ... +R/cluster_hits.R#L1118 clustering_result <- ... +R/cluster_hits.R#L1120 curve_values = normalized_curves, ... +R/cluster_hits.R#L1121 k = cluster_size, ... +R/cluster_hits.R#L1122 smooth_timepoints = curve_results$ ... +R/cluster_hits.R#L1123 top_table = top_table ... +R/cluster_hits.R#L1126 clustering_result$X <- curve_results$X ... +R/cluster_hits.R#L1127 return(clustering_result) ... +R/cluster_hits.R#L1175 datas <- list() ... +R/cluster_hits.R#L1176 n <- length(unique(meta[[condition]])) ... +R/cluster_hits.R#L1177 level_indices <- as.integer(1:n) ... +R/cluster_hits.R#L1178 unique_levels <- unique(meta[[conditio ... +R/cluster_hits.R#L1180 if (!is.null(meta_batch_column)) { ... +R/cluster_hits.R#L1182 # Take only the data from the leve ... +R/cluster_hits.R#L1183 if (mode == "isolated") { ... +R/cluster_hits.R#L1188 } else { ... +R/cluster_hits.R#L1192 } ... +R/cluster_hits.R#L1194 design_matrix <- design2design_mat ... +R/cluster_hits.R#L1199 ) ... +R/cluster_hits.R#L1201 # The batch columns are not allowe ... +R/cluster_hits.R#L1202 # removeBatchEffect. Instead the b ... +R/cluster_hits.R#L1203 batch_columns <- grep( ... +R/cluster_hits.R#L1205 "^", ... +R/cluster_hits.R#L1206 meta_batch_column ... +R/cluster_hits.R#L1209 ) ... +R/cluster_hits.R#L1211 design_matrix <- design_matrix[, - ... +R/cluster_hits.R#L1213 args <- list( ... +R/cluster_hits.R#L1217 ) ... +R/cluster_hits.R#L1219 if (mode == "isolated") { ... +R/cluster_hits.R#L1224 length(unique(meta_copy[[meta_ ... +R/cluster_hits.R#L1225 args$batch2 <- meta_copy[[meta ... +R/cluster_hits.R#L1227 } else { # mode == integrated ... +R/cluster_hits.R#L1230 length(unique(meta_copy[[meta_ ... +R/cluster_hits.R#L1231 args$batch2 <- meta_copy[[meta ... +R/cluster_hits.R#L1233 } ... +R/cluster_hits.R#L1235 data_copy <- do.call( ... +R/cluster_hits.R#L1238 ) ... +R/cluster_hits.R#L1240 # For mode == "integrated", all el ... +R/cluster_hits.R#L1241 datas <- c( ... +R/cluster_hits.R#L1244 ) ... +R/cluster_hits.R#L1246 } else { # no meta batch column specif ... +R/cluster_hits.R#L1249 # Take only the data from the leve ... +R/cluster_hits.R#L1250 if (mode == "isolated") { ... +R/cluster_hits.R#L1254 } else { ... +R/cluster_hits.R#L1256 } ... +R/cluster_hits.R#L1258 datas <- c(datas, list(data_copy)) ... +R/cluster_hits.R#L1260 } ... +R/cluster_hits.R#L1261 return(datas) ... +R/cluster_hits.R#L1304 BASE_TEXT_SIZE_PT <- 5 ... +R/cluster_hits.R#L1306 ht_opt( ... +R/cluster_hits.R#L1320 ) ... +R/cluster_hits.R#L1322 ht_opt$message <- FALSE ... +R/cluster_hits.R#L1324 levels <- unique(meta[[condition]]) ... +R/cluster_hits.R#L1325 heatmaps <- list() ... +R/cluster_hits.R#L1327 # Generate a heatmap for every level ... +R/cluster_hits.R#L1328 for (i in seq_along(all_levels_cluster ... +R/cluster_hits.R#L1331 all(is.na(all_levels_clustering[[i ... +R/cluster_hits.R#L1332 heatmaps[[length(heatmaps) + 1]] < ... +R/cluster_hits.R#L1333 next ... +R/cluster_hits.R#L1345 data_level <- datas[[i]][, level_i ... +R/cluster_hits.R#L1347 data_level <- datas[[i]] ... +R/cluster_hits.R#L1358 cluster_heatmap_columns <- FALSE ... +R/cluster_hits.R#L1362 ComplexHeatmap::Heatmap( ... +R/cluster_hits.R#L1365 "left-labels = cluster,", ... +R/cluster_hits.R#L1366 "top-labels = time" ... +R/cluster_hits.R#L1374 title = "z-score of log2 value ... +R/cluster_hits.R#L1375 title_position = "lefttop-rot" ... +R/cluster_hits.R#L1388 ) ... +R/cluster_hits.R#L1391 } ... +R/cluster_hits.R#L1392 heatmaps ... +R/cluster_hits.R#L1421 # Convert hc to dendrogram ... +R/cluster_hits.R#L1422 dend <- stats::as.dendrogram(hc) ... +R/cluster_hits.R#L1424 # Get clusters based on cutree result ... +R/cluster_hits.R#L1425 clusters <- stats::cutree(hc, k) ... +R/cluster_hits.R#L1427 # Get the order of clusters as they ap ... +R/cluster_hits.R#L1428 cluster_order <- clusters[hc[["order"] ... +R/cluster_hits.R#L1430 # Find the unique clusters in the orde ... +R/cluster_hits.R#L1431 unique_cluster_order <- unique(cluster ... +R/cluster_hits.R#L1433 # Generate distinct colors for the k c ... +R/cluster_hits.R#L1434 colors <- scales::hue_pal()(k) ... +R/cluster_hits.R#L1436 # Reorder the colors according to the ... +R/cluster_hits.R#L1437 ordered_colors <- colors[match( ... +R/cluster_hits.R#L1440 )] ... +R/cluster_hits.R#L1442 # Apply the reordered colors to the br ... +R/cluster_hits.R#L1443 dend_colored <- dendextend::color_bran ... +R/cluster_hits.R#L1447 ) ... +R/cluster_hits.R#L1449 # Remove labels for the plot ... +R/cluster_hits.R#L1450 dend_colored <- dendextend::set( ... +R/cluster_hits.R#L1454 "", ... +R/cluster_hits.R#L1455 length(dendextend::get_leaves_attr ... +R/cluster_hits.R#L1457 ) ... +R/cluster_hits.R#L1459 # Convert to ggplot-compatible dendrog ... +R/cluster_hits.R#L1460 ggdend <- dendextend::as.ggdend(dend_c ... +R/cluster_hits.R#L1462 # Create the plot ... +R/cluster_hits.R#L1463 p_dend <- ggplot2::ggplot(ggdend) + ... +R/cluster_hits.R#L1465 title = paste( ... +R/cluster_hits.R#L1468 ), ... +R/cluster_hits.R#L1469 x = "", ... +R/cluster_hits.R#L1470 y = "" ... +R/cluster_hits.R#L1474 axis.text.x = ggplot2::element_bla ... +R/cluster_hits.R#L1475 axis.ticks.x = ggplot2::element_bl ... +R/cluster_hits.R#L1476 axis.text.y = ggplot2::element_bla ... +R/cluster_hits.R#L1477 axis.ticks.y = ggplot2::element_bl ... +R/cluster_hits.R#L1478 plot.title = ggplot2::element_text ... +R/cluster_hits.R#L1481 return(p_dend) ... +R/cluster_hits.R#L1515 time <- as.numeric(colnames(curve_valu ... +R/cluster_hits.R#L1517 clusters <- unique(curve_values$cluste ... +R/cluster_hits.R#L1518 average_curves <- data.frame() ... +R/cluster_hits.R#L1520 # Loop through each unique cluster val ... +R/cluster_hits.R#L1521 for (current_cluster in clusters) { ... +R/cluster_hits.R#L1530 Time = time, Value = average_curve ... +R/cluster_hits.R#L1531 cluster = as.factor(current_cluste ... +R/cluster_hits.R#L1536 average_curves, ... +R/cluster_hits.R#L1537 curve_df ... +R/cluster_hits.R#L1539 } ... +R/cluster_hits.R#L1541 average_curves$cluster <- factor( ... +R/cluster_hits.R#L1544 unique(as.numeric(average_curves$c ... +R/cluster_hits.R#L1546 ) ... +R/cluster_hits.R#L1548 time_unit_label <- paste0("[", plot_in ... +R/cluster_hits.R#L1550 cluster_colors <- scales::hue_pal()(le ... +R/cluster_hits.R#L1552 if (length(cluster_colors) > length(un ... +R/cluster_hits.R#L1554 } ... +R/cluster_hits.R#L1555 names(cluster_colors) <- paste( ... +R/cluster_hits.R#L1558 ) ... +R/cluster_hits.R#L1560 color_values <- c(cluster_colors) ... +R/cluster_hits.R#L1561 distinct_colors <- c() ... +R/cluster_hits.R#L1563 # Create the base plot ... +R/cluster_hits.R#L1564 p_curves <- ggplot2::ggplot( ... +R/cluster_hits.R#L1567 x = !!rlang::sym("Time"), ... +R/cluster_hits.R#L1568 y = !!rlang::sym("Value"), ... +R/cluster_hits.R#L1569 color = paste("Cluster", factor(!! ... +R/cluster_hits.R#L1571 ) + ... +R/cluster_hits.R#L1579 # Call the wrapper function to conditi ... +R/cluster_hits.R#L1580 # treatment colors ... +R/cluster_hits.R#L1581 result <- maybe_add_dashed_lines( ... +R/cluster_hits.R#L1585 ) ... +R/cluster_hits.R#L1587 p_curves <- result$p ... +R/cluster_hits.R#L1588 treatment_colors <- result$treatment_c ... +R/cluster_hits.R#L1590 # Combine cluster colors and treatment ... +R/cluster_hits.R#L1591 all_colors <- c(cluster_colors, treatm ... +R/cluster_hits.R#L1593 # Finalize color scale and theme adjus ... +R/cluster_hits.R#L1594 p_curves <- p_curves + ... +R/cluster_hits.R#L1596 values = all_colors, # Combine bot ... +R/cluster_hits.R#L1597 name = NULL # No legend title ... +R/cluster_hits.R#L1600 legend.key.size = grid::unit(0.6, ... +R/cluster_hits.R#L1601 legend.key.height = grid::unit(0.3 ... +R/cluster_hits.R#L1602 legend.title = ggplot2::element_te ... +R/cluster_hits.R#L1605 return(p_curves) ... +R/cluster_hits.R#L1635 clusters <- sort(unique(curve_values$c ... +R/cluster_hits.R#L1637 plots <- list() ... +R/cluster_hits.R#L1638 for (current_cluster in clusters) { ... +R/cluster_hits.R#L1640 curve_values, ... +R/cluster_hits.R#L1641 curve_values$cluster == current_cl ... +R/cluster_hits.R#L1646 "Cluster", ... +R/cluster_hits.R#L1647 current_cluster, ... +R/cluster_hits.R#L1648 "| Hits:", ... +R/cluster_hits.R#L1649 nr_of_hits, ... +R/cluster_hits.R#L1650 sep = " " ... +R/cluster_hits.R#L1654 plot_single_and_mean_splines( ... +R/cluster_hits.R#L1659 ) ... +R/cluster_hits.R#L1660 } ... +R/cluster_hits.R#L1662 return(plots) ... +R/cluster_hits.R#L1718 # Sort so that HTML reports are easier ... +R/cluster_hits.R#L1719 top_table <- top_table |> dplyr::arran ... +R/cluster_hits.R#L1721 DoF <- which(names(top_table) == "AveE ... +R/cluster_hits.R#L1722 time_points <- meta$Time ... +R/cluster_hits.R#L1724 titles <- data.frame( ... +R/cluster_hits.R#L1727 ) ... +R/cluster_hits.R#L1729 plot_list <- list() ... +R/cluster_hits.R#L1731 for (hit in 1:nrow(top_table)) { ... +R/cluster_hits.R#L1739 meta$Time[1], ... +R/cluster_hits.R#L1740 meta$Time[length(meta$Time)], ... +R/cluster_hits.R#L1741 length.out = 1000 # To ensure smoo ... +R/cluster_hits.R#L1747 Time = time_points, ... +R/cluster_hits.R#L1748 Y = y_values ... +R/cluster_hits.R#L1753 replicates <- meta[[replicate_colu ... +R/cluster_hits.R#L1754 plot_data$Replicate <- replicates ... +R/cluster_hits.R#L1756 # Create color palette for replica ... +R/cluster_hits.R#L1757 replicate_colors <- scales::hue_pa ... +R/cluster_hits.R#L1758 names(replicate_colors) <- unique( ... +R/cluster_hits.R#L1760 color_values <- c( ... +R/cluster_hits.R#L1763 ) ... +R/cluster_hits.R#L1765 color_values <- c( ... +R/cluster_hits.R#L1768 ) ... +R/cluster_hits.R#L1774 adj_p_value < adj_pthreshold / 50, ... +R/cluster_hits.R#L1775 "***", ... +R/cluster_hits.R#L1776 ifelse( ... +R/cluster_hits.R#L1780 adj_p_value < adj_pthreshold, ... +R/cluster_hits.R#L1781 "*", ... +R/cluster_hits.R#L1782 "" ... +R/cluster_hits.R#L1784 ) ... +R/cluster_hits.R#L1788 time_values = time_points, ... +R/cluster_hits.R#L1789 response_values = y_values ... +R/cluster_hits.R#L1794 plot_spline <- data.frame( ... +R/cluster_hits.R#L1797 ) ... +R/cluster_hits.R#L1799 x_max <- as.numeric(max(time_point ... +R/cluster_hits.R#L1800 x_extension <- x_max * 0.05 ... +R/cluster_hits.R#L1802 # Define color column outside aes( ... +R/cluster_hits.R#L1803 color_column_values <- if (!is.nul ... +R/cluster_hits.R#L1806 } else { ... +R/cluster_hits.R#L1808 } ... +R/cluster_hits.R#L1810 plot_data$color_column <- factor(c ... +R/cluster_hits.R#L1812 p <- ggplot2::ggplot() + ... +R/cluster_hits.R#L1814 data = plot_data, ... +R/cluster_hits.R#L1815 ggplot2::aes( ... +R/cluster_hits.R#L1819 ), ... +R/cluster_hits.R#L1820 alpha = 0.5 # 50% transparent ... +R/cluster_hits.R#L1823 data = plot_spline, ... +R/cluster_hits.R#L1824 ggplot2::aes( ... +R/cluster_hits.R#L1828 ) ... +R/cluster_hits.R#L1832 limits = c(min(time_points), x ... +R/cluster_hits.R#L1833 breaks = filter_timepoints(tim ... +R/cluster_hits.R#L1834 labels = function(x) { ... +R/cluster_hits.R#L1836 } ... +R/cluster_hits.R#L1839 x = paste0("Time ", time_unit_ ... +R/cluster_hits.R#L1840 y = plot_info$y_axis_label ... +R/cluster_hits.R#L1843 color = ggplot2::guide_legend( ... +R/cluster_hits.R#L1846 legend.position = "right", ... +R/cluster_hits.R#L1847 legend.justification = "center ... +R/cluster_hits.R#L1848 legend.box = "vertical", ... +R/cluster_hits.R#L1849 legend.background = ggplot2::e ... +R/cluster_hits.R#L1850 legend.title = ggplot2::elemen ... +R/cluster_hits.R#L1851 legend.text = ggplot2::element ... +R/cluster_hits.R#L1854 ), ... +R/cluster_hits.R#L1855 axis.text.x = ggplot2::element ... +R/cluster_hits.R#L1859 ), ... +R/cluster_hits.R#L1860 axis.title.y = ggplot2::elemen ... +R/cluster_hits.R#L1863 ), ... +R/cluster_hits.R#L1864 axis.text.y = ggplot2::element ... +R/cluster_hits.R#L1866 ) ... +R/cluster_hits.R#L1869 y_pos <- max( ... +R/cluster_hits.R#L1872 ) ... +R/cluster_hits.R#L1874 result <- maybe_add_dashed_lines( ... +R/cluster_hits.R#L1879 ) ... +R/cluster_hits.R#L1881 p <- result$p # Updated plot with ... +R/cluster_hits.R#L1882 treatment_colors <- result$treatme ... +R/cluster_hits.R#L1884 color_values <- c(color_values, tr ... +R/cluster_hits.R#L1886 # Add title and annotations ... +R/cluster_hits.R#L1887 matched_row <- dplyr::filter( ... +R/cluster_hits.R#L1890 ) ... +R/cluster_hits.R#L1892 title <- as.character(matched_row$ ... +R/cluster_hits.R#L1894 if (nchar(title) > 100) { ... +R/cluster_hits.R#L1898 "The feature ID", title_before ... +R/cluster_hits.R#L1899 "Truncating it to 100 chars:", ... +R/cluster_hits.R#L1901 } ... +R/cluster_hits.R#L1903 if (is.na(title)) { ... +R/cluster_hits.R#L1905 } ... +R/cluster_hits.R#L1907 p <- p + ... +R/cluster_hits.R#L1909 values = color_values, ... +R/cluster_hits.R#L1913 title = paste( ... +R/cluster_hits.R#L1917 ), ... +R/cluster_hits.R#L1918 x = paste("Time", time_unit_la ... +R/cluster_hits.R#L1919 y = paste(plot_info$y_axis_lab ... +R/cluster_hits.R#L1922 plot.title = ggplot2::element_ ... +R/cluster_hits.R#L1923 axis.title.x = ggplot2::elemen ... +R/cluster_hits.R#L1924 axis.title.y = ggplot2::elemen ... +R/cluster_hits.R#L1925 legend.key.size = grid::unit(0 ... +R/cluster_hits.R#L1926 legend.key.height = grid::unit ... +R/cluster_hits.R#L1927 legend.title = ggplot2::elemen ... +R/cluster_hits.R#L1928 legend.text = ggplot2::element ... +R/cluster_hits.R#L1929 axis.text.x = ggplot2::element ... +R/cluster_hits.R#L1932 p ... +R/cluster_hits.R#L1936 } ... +R/cluster_hits.R#L1938 return(plot_list) ... +R/cluster_hits.R#L2002 # Sort and prepare data (sorting based ... +R/cluster_hits.R#L2003 time_effect_1 <- time_effect_1 |> dply ... +R/cluster_hits.R#L2004 time_effect_2 <- time_effect_2 |> dply ... +R/cluster_hits.R#L2005 avrg_diff_conditions <- ... +R/cluster_hits.R#L2007 interaction_condition_time <- ... +R/cluster_hits.R#L2010 # Get relevant parameters ... +R/cluster_hits.R#L2011 DoF <- which(names(time_effect_1) == " ... +R/cluster_hits.R#L2012 time_points <- meta$Time ... +R/cluster_hits.R#L2013 titles <- data.frame( ... +R/cluster_hits.R#L2016 ) ... +R/cluster_hits.R#L2018 plot_list <- list() ... +R/cluster_hits.R#L2019 feature_names_list <- list() ... +R/cluster_hits.R#L2021 for (hit in 1:nrow(time_effect_1)) { ... +R/cluster_hits.R#L2041 interaction_pval < adj_pthresh_int ... +R/cluster_hits.R#L2042 # Define the number of stars for a ... +R/cluster_hits.R#L2043 avrg_diff_stars <- ifelse( ... +R/cluster_hits.R#L2047 avrg_diff_pval < adj_pthresh_a ... +R/cluster_hits.R#L2048 "**", ... +R/cluster_hits.R#L2049 ifelse( ... +R/cluster_hits.R#L2053 ) ... +R/cluster_hits.R#L2055 ) ... +R/cluster_hits.R#L2057 # Define the number of stars for i ... +R/cluster_hits.R#L2058 interaction_stars <- ifelse( ... +R/cluster_hits.R#L2062 interaction_pval < adj_pthresh ... +R/cluster_hits.R#L2063 "**", ... +R/cluster_hits.R#L2064 ifelse( ... +R/cluster_hits.R#L2068 ) ... +R/cluster_hits.R#L2070 ) ... +R/cluster_hits.R#L2072 # Use the conditions to split the ... +R/cluster_hits.R#L2073 plot_data <- data.frame( ... +R/cluster_hits.R#L2077 ) ... +R/cluster_hits.R#L2079 # Calculate average CV for Y1 and ... +R/cluster_hits.R#L2080 cv_1 <- calc_cv( ... +R/cluster_hits.R#L2083 ) ... +R/cluster_hits.R#L2085 cv_2 <- calc_cv( ... +R/cluster_hits.R#L2088 ) ... +R/cluster_hits.R#L2090 # Create the plot ... +R/cluster_hits.R#L2091 p <- ggplot2::ggplot() + ... +R/cluster_hits.R#L2093 data = plot_data, ... +R/cluster_hits.R#L2094 ggplot2::aes( ... +R/cluster_hits.R#L2098 ), ... +R/cluster_hits.R#L2099 na.rm = TRUE, ... +R/cluster_hits.R#L2100 alpha = 0.5 # Make data dots t ... +R/cluster_hits.R#L2103 data = data.frame( ... +R/cluster_hits.R#L2106 ), ... +R/cluster_hits.R#L2107 ggplot2::aes( ... +R/cluster_hits.R#L2111 ) ... +R/cluster_hits.R#L2114 data = plot_data, ... +R/cluster_hits.R#L2115 ggplot2::aes( ... +R/cluster_hits.R#L2119 ), ... +R/cluster_hits.R#L2120 na.rm = TRUE, ... +R/cluster_hits.R#L2121 alpha = 0.5 # Make data dots t ... +R/cluster_hits.R#L2124 data = data.frame( ... +R/cluster_hits.R#L2127 ), ... +R/cluster_hits.R#L2128 ggplot2::aes( ... +R/cluster_hits.R#L2132 ) ... +R/cluster_hits.R#L2135 c( ... +R/cluster_hits.R#L2140 ), ... +R/cluster_hits.R#L2141 c( ... +R/cluster_hits.R#L2143 "Data", ... +R/cluster_hits.R#L2144 condition_1 ... +R/cluster_hits.R#L2147 "Spline", ... +R/cluster_hits.R#L2148 condition_1 ... +R/cluster_hits.R#L2151 "Data", ... +R/cluster_hits.R#L2152 condition_2 ... +R/cluster_hits.R#L2155 "Spline", ... +R/cluster_hits.R#L2156 condition_2 ... +R/cluster_hits.R#L2158 ) ... +R/cluster_hits.R#L2161 breaks = filter_timepoints(tim ... +R/cluster_hits.R#L2164 title = paste( ... +R/cluster_hits.R#L2173 ), ... +R/cluster_hits.R#L2174 x = paste0("Time [", plot_info ... +R/cluster_hits.R#L2175 y = plot_info$y_axis_label ... +R/cluster_hits.R#L2179 legend.position = "right", ... +R/cluster_hits.R#L2180 legend.title = element_blank() ... +R/cluster_hits.R#L2181 plot.title = ggplot2::element_ ... +R/cluster_hits.R#L2182 legend.text = ggplot2::element ... +R/cluster_hits.R#L2183 axis.title.x = ggplot2::elemen ... +R/cluster_hits.R#L2184 axis.title.y = ggplot2::elemen ... +R/cluster_hits.R#L2185 axis.text.x = ggplot2::element ... +R/cluster_hits.R#L2188 plot_list[[length(plot_list) + 1]] ... +R/cluster_hits.R#L2189 feature_names_list[[length(feature ... +R/cluster_hits.R#L2192 } ... +R/cluster_hits.R#L2194 return(list( ... +R/cluster_hits.R#L2197 )) ... +R/cluster_hits.R#L2217 all_levels_clustering <- lapply( ... +R/cluster_hits.R#L2220 # Check if x is not logical and an ... +R/cluster_hits.R#L2221 if (!is.logical(x) && !is.null(ann ... +R/cluster_hits.R#L2223 x$top_table, ... +R/cluster_hits.R#L2224 annotation ... +R/cluster_hits.R#L2226 } ... +R/cluster_hits.R#L2227 return(x) ... +R/cluster_hits.R#L2229 ) ... +R/cluster_hits.R#L2231 return(all_levels_clustering) ... +R/cluster_hits.R#L2251 formatted_gene_lists <- list() ... +R/cluster_hits.R#L2253 for (i in seq_along(all_levels_cluster ... +R/cluster_hits.R#L2261 clustered_hits$feature, ... +R/cluster_hits.R#L2262 clustered_hits$cluster ... +R/cluster_hits.R#L2268 cluster_genes <- clusters[[cluster ... +R/cluster_hits.R#L2270 gene_list <- genes[cluster_genes] ... +R/cluster_hits.R#L2271 gene_list <- na.omit(gene_list) # ... +R/cluster_hits.R#L2273 if (length(gene_list) > 0) { ... +R/cluster_hits.R#L2275 paste(gene_list, collapse = "\ ... +R/cluster_hits.R#L2276 } ... +R/cluster_hits.R#L2280 } ... +R/cluster_hits.R#L2282 # Prepare the background genes list us ... +R/cluster_hits.R#L2283 background_gene_list <- paste( ... +R/cluster_hits.R#L2286 ) ... +R/cluster_hits.R#L2288 return(list( ... +R/cluster_hits.R#L2291 )) ... +R/cluster_hits.R#L2340 html_content <- paste(header_section, ... +R/cluster_hits.R#L2342 toc <- create_toc() ... +R/cluster_hits.R#L2344 styles <- define_html_styles() ... +R/cluster_hits.R#L2345 section_header_style <- styles$section ... +R/cluster_hits.R#L2346 toc_style <- styles$toc_style ... +R/cluster_hits.R#L2348 current_header_index <- 1 ... +R/cluster_hits.R#L2349 j <- 0 ... +R/cluster_hits.R#L2350 level_headers_info <- Filter(Negate(is ... +R/cluster_hits.R#L2353 pb <- create_progress_bar(plots) ... +R/cluster_hits.R#L2355 header_index <- 0 ... +R/cluster_hits.R#L2356 level_index <- 0 ... +R/cluster_hits.R#L2358 # Generate the sections and plots ... +R/cluster_hits.R#L2359 for (index in seq_along(plots)) { ... +R/cluster_hits.R#L2363 header_info <- level_headers_info[ ... +R/cluster_hits.R#L2364 nr_hits <- header_info$nr_hits ... +R/cluster_hits.R#L2365 adj_pvalue_threshold <- header_inf ... +R/cluster_hits.R#L2367 # means this is the section of a n ... +R/cluster_hits.R#L2368 # The very first level is also a n ... +R/cluster_hits.R#L2369 if (names(plots)[index] == "new_le ... +R/cluster_hits.R#L2373 "Time Effect of Condition:", ... +R/cluster_hits.R#L2374 header_info$header_name ... +R/cluster_hits.R#L2378 "

    " ... +R/cluster_hits.R#L2469 } else { # element_name == "indivi ... +R/cluster_hits.R#L2473 "", ... +R/cluster_hits.R#L2501 asterisks_definition, ... +R/cluster_hits.R#L2502 "

  • " ... +R/cluster_hits.R#L2506 } ... +R/cluster_hits.R#L2508 html_content <- paste( ... +R/cluster_hits.R#L2512 ) ... +R/cluster_hits.R#L2514 toc_entry <- paste0( ... +R/cluster_hits.R#L2521 ) ... +R/cluster_hits.R#L2523 toc <- paste(toc, toc_entry, sep = ... +R/cluster_hits.R#L2529 plots_element = plots[[index]], ... +R/cluster_hits.R#L2530 element_name = names(plots)[index] ... +R/cluster_hits.R#L2531 plots_size = plots_sizes[[index]], ... +R/cluster_hits.R#L2532 html_content = html_content, ... +R/cluster_hits.R#L2533 toc = toc, ... +R/cluster_hits.R#L2534 header_index = header_index ... +R/cluster_hits.R#L2541 } ... +R/cluster_hits.R#L2543 # Add sections for limma_result_2_and_ ... +R/cluster_hits.R#L2544 if (length(limma_result_2_and_3_plots) ... +R/cluster_hits.R#L2550 "

    %s< ... +R/cluster_hits.R#L2551 section_header_style, ... +R/cluster_hits.R#L2552 header_index, ... +R/cluster_hits.R#L2553 "Avrg diff conditions & interactio ... +R/cluster_hits.R#L2557 html_content, ... +R/cluster_hits.R#L2558 limma_main_header, ... +R/cluster_hits.R#L2559 sep = "\n" ... +R/cluster_hits.R#L2565 "
    Asterisks definition (Average Di ... +R/cluster_hits.R#L2568 paste( ... +R/cluster_hits.R#L2573 ), ... +R/cluster_hits.R#L2574 "
    ", ... +R/cluster_hits.R#L2575 paste( ... +R/cluster_hits.R#L2580 ), ... +R/cluster_hits.R#L2581 "
    ", ... +R/cluster_hits.R#L2582 paste( ... +R/cluster_hits.R#L2587 ), ... +R/cluster_hits.R#L2588 "
    ", ... +R/cluster_hits.R#L2589 sep = "\n" ... +R/cluster_hits.R#L2593 "
    Asterisks definition (Interactio ... +R/cluster_hits.R#L2596 paste( ... +R/cluster_hits.R#L2601 ), ... +R/cluster_hits.R#L2602 "
    ", ... +R/cluster_hits.R#L2603 paste( ... +R/cluster_hits.R#L2608 ), ... +R/cluster_hits.R#L2609 "
    ", ... +R/cluster_hits.R#L2610 paste( ... +R/cluster_hits.R#L2615 ), ... +R/cluster_hits.R#L2616 "
    ", ... +R/cluster_hits.R#L2617 sep = "\n" ... +R/cluster_hits.R#L2622 html_content, ... +R/cluster_hits.R#L2623 asterisks_definition_avrg_diff, ... +R/cluster_hits.R#L2624 asterisks_definition_interaction, ... +R/cluster_hits.R#L2625 sep = "\n" ... +R/cluster_hits.R#L2630 "
  • ... +R/cluster_hits.R#L2800 curve_values <- matrix( ... +R/cluster_hits.R#L2803 ) ... +R/cluster_hits.R#L2805 for (i in 1:nrow(splineCoeffs)) { ... +R/cluster_hits.R#L2807 splineCoeffs[i, ], ... +R/cluster_hits.R#L2808 ncol = ncol(splineCoeffs), ... +R/cluster_hits.R#L2809 byrow = TRUE ... +R/cluster_hits.R#L2813 } ... +R/cluster_hits.R#L2815 curve_values <- as.data.frame(curve_va ... +R/cluster_hits.R#L2816 rownames(curve_values) <- rownames(spl ... +R/cluster_hits.R#L2818 list( ... +R/cluster_hits.R#L2822 ) ... +R/cluster_hits.R#L2843 normalized_curves <- apply(curve_value ... +R/cluster_hits.R#L2845 }) ... +R/cluster_hits.R#L2847 normalized_curves <- t(normalized_curv ... +R/cluster_hits.R#L2848 curve_values[, ] <- normalized_curves ... +R/cluster_hits.R#L2849 curve_values ... +R/cluster_hits.R#L2873 distance_matrix <- stats::dist(curve_v ... +R/cluster_hits.R#L2874 hc <- stats::hclust(distance_matrix, m ... +R/cluster_hits.R#L2876 cluster_assignments <- stats::cutree(h ... +R/cluster_hits.R#L2878 clustered_hits <- data.frame(cluster = ... +R/cluster_hits.R#L2880 clustered_hits$feature <- top_table$fe ... +R/cluster_hits.R#L2881 clustered_hits <- clustered_hits[, c(" ... +R/cluster_hits.R#L2883 colnames(curve_values) <- smooth_timep ... +R/cluster_hits.R#L2884 curve_values$cluster <- cluster_assign ... +R/cluster_hits.R#L2886 top_table$cluster <- NA ... +R/cluster_hits.R#L2887 top_table$cluster[1:nrow(clustered_hit ... +R/cluster_hits.R#L2890 group_clustering <- list( ... +R/cluster_hits.R#L2896 ) ... +R/cluster_hits.R#L2927 if (!is.null(spline_params$spline_type ... +R/cluster_hits.R#L2930 } else { ... +R/cluster_hits.R#L2932 } ... +R/cluster_hits.R#L2934 if (!is.null(spline_params$degree) && ... +R/cluster_hits.R#L2937 } else { ... +R/cluster_hits.R#L2939 } ... +R/cluster_hits.R#L2941 if (!is.null(spline_params$dof) && ... +R/cluster_hits.R#L2944 } else { ... +R/cluster_hits.R#L2946 } ... +R/cluster_hits.R#L2948 if (!is.null(spline_params$knots) && ... +R/cluster_hits.R#L2951 } else { ... +R/cluster_hits.R#L2953 } ... +R/cluster_hits.R#L2955 if (!is.null(spline_params$bknots) && ... +R/cluster_hits.R#L2958 } else { ... +R/cluster_hits.R#L2960 } ... +R/cluster_hits.R#L2962 if (spline_params$spline_type[j] == "b ... +R/cluster_hits.R#L2964 " ... +R/cluster_hits.R#L2972 spline_params$degree[j], spline_pa ... +R/cluster_hits.R#L2973 spline_params$knots[j], spline_par ... +R/cluster_hits.R#L2975 } else { # spline_type == "n" ... +R/cluster_hits.R#L2977 " ... +R/cluster_hits.R#L2984 spline_params$dof[j], spline_param ... +R/cluster_hits.R#L2985 spline_params$bknots[j] ... +R/cluster_hits.R#L2987 } ... +R/cluster_hits.R#L2988 return(spline_params_info) ... +R/cluster_hits.R#L3008 vapply(names, function(x) { ... +R/cluster_hits.R#L3010 return(paste0(substr(x, 1, max_len ... +R/cluster_hits.R#L3012 return(x) ... +R/cluster_hits.R#L3014 }, character(1)) ... +R/cluster_hits.R#L3021 x_max <- as.numeric(max(time_points)) ... +R/cluster_hits.R#L3023 # Calculate the minimum spacing based ... +R/cluster_hits.R#L3024 min_spacing <- x_max * percentage_thre ... +R/cluster_hits.R#L3026 all_time_points <- unique(c(time_point ... +R/cluster_hits.R#L3028 # Calculate the differences between co ... +R/cluster_hits.R#L3029 time_diffs <- diff(all_time_points) ... +R/cluster_hits.R#L3031 # Keep labels that are more than the m ... +R/cluster_hits.R#L3032 keep_labels <- c(TRUE, time_diffs > mi ... +R/cluster_hits.R#L3033 filtered_time_points <- all_time_point ... +R/cluster_hits.R#L3035 return(filtered_time_points) ... +R/cluster_hits.R#L3059 time_data <- data.frame( ... +R/cluster_hits.R#L3062 ) ... +R/cluster_hits.R#L3064 unique_times <- unique(time_data$Time) ... +R/cluster_hits.R#L3066 cvs <- vapply( ... +R/cluster_hits.R#L3069 # Subset for the specific time poi ... +R/cluster_hits.R#L3070 values_at_time <- time_data$Respon ... +R/cluster_hits.R#L3071 # Calculate CV if the mean is not ... +R/cluster_hits.R#L3072 if (mean(values_at_time, na.rm = T ... +R/cluster_hits.R#L3075 values_at_time, ... +R/cluster_hits.R#L3076 na.rm = TRUE ... +R/cluster_hits.R#L3078 mean( ... +R/cluster_hits.R#L3081 )) * 100 ... +R/cluster_hits.R#L3082 } else { ... +R/cluster_hits.R#L3084 } ... +R/cluster_hits.R#L3087 ) ... +R/cluster_hits.R#L3088 # Return the average CV across time po ... +R/cluster_hits.R#L3089 return(mean( ... +R/cluster_hits.R#L3092 )) ... +R/cluster_hits.R#L3131 time_col <- rlang::sym("time") ... +R/cluster_hits.R#L3132 feature_col <- rlang::sym("feature") ... +R/cluster_hits.R#L3134 # Convert data to long format ... +R/cluster_hits.R#L3135 df_long <- as.data.frame(t(time_series ... +R/cluster_hits.R#L3138 cols = -!!time_col, ... +R/cluster_hits.R#L3139 names_to = "feature", ... +R/cluster_hits.R#L3140 values_to = "intensity" ... +R/cluster_hits.R#L3145 # Compute consensus (mean of each colu ... +R/cluster_hits.R#L3146 consensus <- colMeans(time_series_data ... +R/cluster_hits.R#L3148 consensus_df <- data.frame( ... +R/cluster_hits.R#L3151 ) ... +R/cluster_hits.R#L3153 time_unit_label <- paste0("[", plot_in ... +R/cluster_hits.R#L3155 color_values <- c( ... +R/cluster_hits.R#L3158 ) ... +R/cluster_hits.R#L3160 p <- ggplot2::ggplot() + ... +R/cluster_hits.R#L3162 data = df_long, ... +R/cluster_hits.R#L3163 ggplot2::aes( ... +R/cluster_hits.R#L3168 ), ... +R/cluster_hits.R#L3169 alpha = 0.3, linewidth = 0.5 ... +R/cluster_hits.R#L3172 data = consensus_df, ... +R/cluster_hits.R#L3173 ggplot2::aes( ... +R/cluster_hits.R#L3177 ), ... +R/cluster_hits.R#L3178 linewidth = 1.5 ... +R/cluster_hits.R#L3181 treatment_labels <- NA ... +R/cluster_hits.R#L3183 result <- maybe_add_dashed_lines( ... +R/cluster_hits.R#L3187 ) ... +R/cluster_hits.R#L3189 p <- result$p ... +R/cluster_hits.R#L3190 treatment_colors <- result$treatment_c ... +R/cluster_hits.R#L3192 # Combine the original colors with the ... +R/cluster_hits.R#L3193 color_values <- c(color_values, treatm ... +R/cluster_hits.R#L3195 # Add the final scale for colors and a ... +R/cluster_hits.R#L3196 p <- p + ... +R/cluster_hits.R#L3198 name = "", ... +R/cluster_hits.R#L3199 values = color_values, ... +R/cluster_hits.R#L3200 guide = ggplot2::guide_legend( ... +R/cluster_hits.R#L3202 size = c( ... +R/cluster_hits.R#L3206 ) ... +R/cluster_hits.R#L3208 ) ... +R/cluster_hits.R#L3213 title = title, ... +R/cluster_hits.R#L3214 x = paste("Time", time_unit_label) ... +R/cluster_hits.R#L3215 y = paste("min-max norm.", plot_in ... +R/cluster_hits.R#L3218 plot.margin = grid::unit(c(1, 1, 1 ... +R/cluster_hits.R#L3219 legend.position = "right", ... +R/cluster_hits.R#L3220 legend.box = "vertical", ... +R/cluster_hits.R#L3221 legend.title = ggplot2::element_te ... +R/cluster_hits.R#L3222 legend.background = ggplot2::eleme ... +R/cluster_hits.R#L3223 axis.title.y = ggplot2::element_te ... +R/cluster_hits.R#L3224 plot.title = ggplot2::element_text ... +R/cluster_hits.R#L3225 legend.key.size = grid::unit(0.6, ... +R/cluster_hits.R#L3226 legend.key.height = grid::unit(0.3 ... +R/cluster_hits.R#L3229 return(p) ... +R/cluster_hits.R#L3264 # Initialize an empty vector to store ... +R/cluster_hits.R#L3265 treatment_colors <- c() ... +R/cluster_hits.R#L3267 # Check if there are treatment labels ... +R/cluster_hits.R#L3268 if (!all(is.na(plot_info$treatment_lab ... +R/cluster_hits.R#L3275 # Take the single unnamed element ... +R/cluster_hits.R#L3276 treatment_timepoints <- plot_info$ ... +R/cluster_hits.R#L3277 treatment_labels <- plot_info$trea ... +R/cluster_hits.R#L3279 # Check if the key (level) is in t ... +R/cluster_hits.R#L3280 if (level %in% names(plot_info$tre ... +R/cluster_hits.R#L3285 } ... +R/cluster_hits.R#L3290 !is.null(treatment_labels) && ... +R/cluster_hits.R#L3291 all(!is.na(treatment_timepoints)) ... +R/cluster_hits.R#L3292 all(!is.na(treatment_labels))) { ... +R/cluster_hits.R#L3293 # Generate colors for the treatmen ... +R/cluster_hits.R#L3294 treatment_colors <- scales::hue_pa ... +R/cluster_hits.R#L3295 names(treatment_colors) <- treatme ... +R/cluster_hits.R#L3297 # Call the function to add dashed ... +R/cluster_hits.R#L3298 p <- add_dashed_lines( ... +R/cluster_hits.R#L3303 ) ... +R/cluster_hits.R#L3305 } ... +R/cluster_hits.R#L3307 # Return both the updated plot and the ... +R/cluster_hits.R#L3308 return(list( ... +R/cluster_hits.R#L3311 )) ... +R/cluster_hits.R#L3345 # Check if treatment labels and timepo ... +R/cluster_hits.R#L3346 if (!is.null(treatment_timepoints) && ... +R/cluster_hits.R#L3352 Time = treatment_timepoints, ... +R/cluster_hits.R#L3353 Label = treatment_labels ... +R/cluster_hits.R#L3362 ggplot2::geom_vline( ... +R/cluster_hits.R#L3365 xintercept = .data$Time, ... +R/cluster_hits.R#L3366 color = .data$Label ... +R/cluster_hits.R#L3370 ) + ... +R/cluster_hits.R#L3371 ggplot2::geom_text( ... +R/cluster_hits.R#L3374 x = Time - max(Time) * 0.005, ... +R/cluster_hits.R#L3375 y = y_pos, ... +R/cluster_hits.R#L3376 label = round(Time, 2), ... +R/cluster_hits.R#L3377 color = Label ... +R/cluster_hits.R#L3384 ) ... +R/cluster_hits.R#L3385 } ... +R/cluster_hits.R#L3387 return(p) # Return the updated plot ob ... +R/create_limma_report.R#L53 report_dir <- normalizePath( ... +R/create_limma_report.R#L56 ) ... +R/create_limma_report.R#L58 check_splineomics_elements( ... +R/create_limma_report.R#L61 ) ... +R/create_limma_report.R#L63 # Control the function arguments ... +R/create_limma_report.R#L64 args <- lapply(as.list(match.call()[-1 ... +R/create_limma_report.R#L65 check_null_elements(args) ... +R/create_limma_report.R#L66 input_control <- InputControl$new(args ... +R/create_limma_report.R#L67 input_control$auto_validate() ... +R/create_limma_report.R#L69 limma_splines_result <- splineomics[[" ... +R/create_limma_report.R#L70 meta <- splineomics[["meta"]] ... +R/create_limma_report.R#L71 condition <- splineomics[["condition"] ... +R/create_limma_report.R#L72 annotation <- splineomics[["annotation ... +R/create_limma_report.R#L73 report_info <- splineomics[["report_in ... +R/create_limma_report.R#L75 # Get the top_tables of the three limm ... +R/create_limma_report.R#L76 time_effect <- limma_splines_result$ti ... +R/create_limma_report.R#L77 avrg_diff_conditions <- limma_splines_ ... +R/create_limma_report.R#L78 interaction_condition_time <- limma_sp ... +R/create_limma_report.R#L80 plots <- list() ... +R/create_limma_report.R#L81 plots_sizes <- list() ... +R/create_limma_report.R#L82 section_headers_info <- list() ... +R/create_limma_report.R#L85 result <- generate_time_effect_plots( ... +R/create_limma_report.R#L88 ) ... +R/create_limma_report.R#L90 plots <- c( ... +R/create_limma_report.R#L93 ) ... +R/create_limma_report.R#L94 plots_sizes <- c( ... +R/create_limma_report.R#L97 ) ... +R/create_limma_report.R#L98 section_headers_info <- c( ... +R/create_limma_report.R#L101 ) ... +R/create_limma_report.R#L104 # length == 0 when there was just one ... +R/create_limma_report.R#L105 if (length(avrg_diff_conditions) > 0) ... +R/create_limma_report.R#L107 avrg_diff_conditions, ... +R/create_limma_report.R#L108 adj_pthresh ... +R/create_limma_report.R#L112 plots, ... +R/create_limma_report.R#L113 result$plots ... +R/create_limma_report.R#L116 plots_sizes, ... +R/create_limma_report.R#L117 result$plots_sizes ... +R/create_limma_report.R#L120 section_headers_info, ... +R/create_limma_report.R#L121 result$section_headers_info ... +R/create_limma_report.R#L123 } ... +R/create_limma_report.R#L125 # length == 0 when there was just one ... +R/create_limma_report.R#L126 if (length(interaction_condition_time) ... +R/create_limma_report.R#L128 interaction_condition_time, ... +R/create_limma_report.R#L129 adj_pthresh ... +R/create_limma_report.R#L133 plots, ... +R/create_limma_report.R#L134 result$plots ... +R/create_limma_report.R#L137 plots_sizes, ... +R/create_limma_report.R#L138 result$plots_sizes ... +R/create_limma_report.R#L141 section_headers_info, ... +R/create_limma_report.R#L142 result$section_headers_info ... +R/create_limma_report.R#L144 } ... +R/create_limma_report.R#L146 all_top_tables <- c( ... +R/create_limma_report.R#L150 ) ... +R/create_limma_report.R#L152 unique_values <- unique(meta[[conditio ... +R/create_limma_report.R#L153 new_names <- vapply( ... +R/create_limma_report.R#L158 ) ... +R/create_limma_report.R#L159 names(all_top_tables) <- new_names ... +R/create_limma_report.R#L161 if (!is.null(annotation)) { ... +R/create_limma_report.R#L164 all_top_tables[[index]] <- merge_t ... +R/create_limma_report.R#L167 ) ... +R/create_limma_report.R#L169 } ... +R/create_limma_report.R#L171 generate_report_html( ... +R/create_limma_report.R#L180 ) ... +R/create_limma_report.R#L182 print_info_message( ... +R/create_limma_report.R#L185 ) ... +R/create_limma_report.R#L187 return(plots) ... +R/create_limma_report.R#L212 plots <- list("Time Effect") ... +R/create_limma_report.R#L213 plots_sizes <- c(999) ... +R/create_limma_report.R#L215 header_info <- list(header_name = "Tim ... +R/create_limma_report.R#L216 section_headers_info <- list(header_in ... +R/create_limma_report.R#L218 for (i in seq_along(time_effect)) { ... +R/create_limma_report.R#L225 top_table = top_table, ... +R/create_limma_report.R#L226 title = title ... +R/create_limma_report.R#L230 plots, ... +R/create_limma_report.R#L231 list(p_value_hist) ... +R/create_limma_report.R#L234 } ... +R/create_limma_report.R#L236 list( ... +R/create_limma_report.R#L240 ) ... +R/create_limma_report.R#L262 plots <- list("Average Difference Cond ... +R/create_limma_report.R#L263 plots_sizes <- c(999) ... +R/create_limma_report.R#L265 header_info <- list(header_name = "Ave ... +R/create_limma_report.R#L266 section_headers_info <- list(header_in ... +R/create_limma_report.R#L268 for (i in seq_along(avrg_diff_conditio ... +R/create_limma_report.R#L276 top_table = top_table, ... +R/create_limma_report.R#L277 title = title ... R/create_limma_report.R#L283 top_table = top_table, ... -R/create_limma_report.R#L284 title = title ... -R/create_limma_report.R#L285 ) ... -R/create_limma_report.R#L290 top_table = top_table, ... -R/create_limma_report.R#L291 adj_pthresh = adj_pthresh, ... -R/create_limma_report.R#L292 compared_levels ... -R/create_limma_report.R#L293 ) ... -R/create_limma_report.R#L297 } ... -R/create_limma_report.R#L298 ... -R/create_limma_report.R#L299 list( ... -R/create_limma_report.R#L327 ... -R/create_limma_report.R#L328 plots <- list("Interaction of Conditio ... -R/create_limma_report.R#L329 plots_sizes <- c(999) ... -R/create_limma_report.R#L330 ... -R/create_limma_report.R#L331 header_info <- list(header_name = "Int ... -R/create_limma_report.R#L332 section_headers_info <- list(header_in ... -R/create_limma_report.R#L333 ... -R/create_limma_report.R#L334 for (i in seq_along(interaction_condit ... -R/create_limma_report.R#L343 top_table = top_table, ... -R/create_limma_report.R#L344 title = title ... -R/create_limma_report.R#L345 ) ... -R/create_limma_report.R#L349 } ... -R/create_limma_report.R#L350 ... -R/create_limma_report.R#L351 list( ... -R/create_limma_report.R#L376 ... -R/create_limma_report.R#L377 for (val in unique_values) { ... -R/create_limma_report.R#L380 } ... -R/create_limma_report.R#L381 return(name) ... -R/create_limma_report.R#L413 ... -R/create_limma_report.R#L414 # Read the text file and split it into ... -R/create_limma_report.R#L415 descriptions_path <- system.file( ... -R/create_limma_report.R#L420 text_blocks <- readLines(descriptions_ ... -R/create_limma_report.R#L421 text_blocks <- split( ... -R/create_limma_report.R#L425 ... -R/create_limma_report.R#L426 # Remove empty elements created by spl ... -R/create_limma_report.R#L427 text_blocks <- Filter(function(x) leng ... -R/create_limma_report.R#L428 ... -R/create_limma_report.R#L429 ... -R/create_limma_report.R#L430 html_content <- paste( ... -R/create_limma_report.R#L435 ... -R/create_limma_report.R#L436 toc <- create_toc() ... -R/create_limma_report.R#L437 ... -R/create_limma_report.R#L438 styles <- define_html_styles() ... -R/create_limma_report.R#L439 section_header_style <- styles$section ... -R/create_limma_report.R#L440 toc_style <- styles$toc_style ... -R/create_limma_report.R#L441 ... -R/create_limma_report.R#L442 current_header_index <- 1 ... -R/create_limma_report.R#L443 level_headers_info <- Filter(Negate(is ... -R/create_limma_report.R#L444 ... -R/create_limma_report.R#L445 pb <- create_progress_bar(plots) ... -R/create_limma_report.R#L446 # Generate the sections and plots ... -R/create_limma_report.R#L447 for (index in seq_along(plots)) { ... -R/create_limma_report.R#L450 header_info <- level_headers_info[ ... -R/create_limma_report.R#L452 # means jump to next section ... -R/create_limma_report.R#L453 if (any(class(plots[[index]]) == " ... -R/create_limma_report.R#L456 "

    %s

  • ', ... -R/explore_data.R#L307 section_id, ... -R/explore_data.R#L308 major_header_style, ... -R/explore_data.R#L309 major_headers[major_header_ind ... -R/explore_data.R#L310 ) ... -R/explore_data.R#L313 group_header <- paste( ... -R/explore_data.R#L323 html_content, ... -R/explore_data.R#L324 group_header, ... -R/explore_data.R#L325 sep = "\n" ... -R/explore_data.R#L326 ) ... -R/explore_data.R#L327 } ... -R/explore_data.R#L328 next ... -R/explore_data.R#L330 ... -R/explore_data.R#L333 ... -R/explore_data.R#L334 section_id <- paste0("section_", t ... -R/explore_data.R#L335 toc <- ... -R/explore_data.R#L337 toc, ... -R/explore_data.R#L338 sprintf( ... -R/explore_data.R#L340 '
  • %s
  • ... -R/explore_data.R#L345 sep = "\n" ... -R/explore_data.R#L346 ) ... -R/explore_data.R#L347 ... -R/explore_data.R#L348 section_header <- sprintf( ... -R/explore_data.R#L354 ... -R/explore_data.R#L355 plot_description <- sprintf( ... -R/explore_data.R#L359 ... -R/explore_data.R#L360 html_content <- paste( ... -R/explore_data.R#L366 ... -R/explore_data.R#L367 toc_index_memory <- toc_index ... -R/explore_data.R#L376 html_content, ... -R/explore_data.R#L377 img_tag, ... -R/explore_data.R#L378 "
    ", # Add horizontal line aft ... -R/explore_data.R#L379 sep = "\n" ... -R/explore_data.R#L380 ) ... -R/explore_data.R#L382 } ... -R/explore_data.R#L383 ... -R/explore_data.R#L384 generate_and_write_html( ... -R/explore_data.R#L389 ) ... -R/explore_data.R#L417 ... -R/explore_data.R#L418 custom_theme <- ggplot2::theme( ... -R/explore_data.R#L424 ) ... -R/explore_data.R#L425 ... -R/explore_data.R#L426 density_plots <- list() ... -R/explore_data.R#L428 # Melt the data to long format using t ... -R/explore_data.R#L429 data_long <- tidyr::pivot_longer( ... -R/explore_data.R#L434 ) ... -R/explore_data.R#L435 ... -R/explore_data.R#L436 ... -R/explore_data.R#L437 if (length(unique(meta[[condition]])) ... -R/explore_data.R#L440 data_long, ... -R/explore_data.R#L441 ggplot2::aes(x = !!rlang::sym("val ... -R/explore_data.R#L442 ) + ... -R/explore_data.R#L443 ggplot2::geom_density( ... -R/explore_data.R#L447 ggplot2::ggtitle("All Levels") + ... -R/explore_data.R#L448 custom_theme ... -R/explore_data.R#L451 density_plots, ... -R/explore_data.R#L452 list(overall_plot) ... -R/explore_data.R#L453 ) ... -R/explore_data.R#L454 } ... -R/explore_data.R#L455 ... -R/explore_data.R#L456 ... -R/explore_data.R#L457 # Create density plots for each level ... -R/explore_data.R#L458 levels <- unique(meta[[condition]]) ... -R/explore_data.R#L459 ... -R/explore_data.R#L460 for (level in levels) { ... -R/explore_data.R#L468 as.data.frame(data_level), ... -R/explore_data.R#L469 cols = everything(), ... -R/explore_data.R#L470 names_to = "variable", ... -R/explore_data.R#L471 values_to = "value" ... -R/explore_data.R#L476 data_level_long, ... -R/explore_data.R#L477 ggplot2::aes(x = !!rlang::sym("val ... -R/explore_data.R#L478 ) + ... -R/explore_data.R#L479 ggplot2::geom_density(fill = "blue ... -R/explore_data.R#L480 ggplot2::ggtitle(paste("Level:", l ... -R/explore_data.R#L481 custom_theme ... -R/explore_data.R#L485 density_plots, ... -R/explore_data.R#L486 list(level_plot) ... -R/explore_data.R#L487 ) ... -R/explore_data.R#L488 } ... -R/explore_data.R#L489 ... -R/explore_data.R#L490 return(density_plots) ... -R/explore_data.R#L516 ... -R/explore_data.R#L517 custom_theme <- ggplot2::theme( ... -R/explore_data.R#L523 ) ... -R/explore_data.R#L524 ... -R/explore_data.R#L525 plots <- list() ... -R/explore_data.R#L526 ... -R/explore_data.R#L527 # Create plots for each level of the c ... -R/explore_data.R#L528 levels <- unique(meta[[condition]]) ... -R/explore_data.R#L529 ... -R/explore_data.R#L530 for (level in levels) { ... -R/explore_data.R#L538 as.data.frame(data_level), ... -R/explore_data.R#L539 cols = everything(), ... -R/explore_data.R#L540 names_to = "variable", ... -R/explore_data.R#L541 values_to = "value" ... -R/explore_data.R#L546 ggplot ... -R/explore_data.R#L547 ... -R/explore_data.R#L548 ggplot2::geom_violin(trim = FALSE, ... -R/explore_data.R#L549 ggplot2::geom_boxplot(width = 0.1, ... -R/explore_data.R#L551 ggplot2::theme(axis.text.x = ggplo ... -R/explore_data.R#L552 ... -R/explore_data.R#L553 plot.margin = grid: ... -R/explore_data.R#L554 ggplot2::labs(x = "Timepoint", y = ... -R/explore_data.R#L556 custom_theme ... -R/explore_data.R#L560 } ... -R/explore_data.R#L561 ... -R/explore_data.R#L562 return(plots) ... -R/explore_data.R#L591 plot_list <- list() ... -R/explore_data.R#L592 ... -R/explore_data.R#L593 # Loop through each level of the condi ... -R/explore_data.R#L594 for (cond in unique(meta[[condition]]) ... -R/explore_data.R#L602 cor(feature, time_subset, use = "c ... -R/explore_data.R#L607 rownames(data) <- paste0("Feature" ... -R/explore_data.R#L611 Feature = rownames(data), ... -R/explore_data.R#L612 Correlation = correlations ... -R/explore_data.R#L613 ) ... -R/explore_data.R#L617 ggplot2::geom_histogram(binwidth = ... -R/explore_data.R#L618 color = "b ... -R/explore_data.R#L619 ggplot2::theme_minimal() + ... -R/explore_data.R#L620 ggplot2::labs(title = paste("Level ... -R/explore_data.R#L621 x = "Correlation with Time", ... -R/explore_data.R#L622 y = "Count of Features") ... -R/explore_data.R#L626 } ... -R/explore_data.R#L627 ... -R/explore_data.R#L628 return(plot_list) ... -R/explore_data.R#L660 ... -R/explore_data.R#L661 # Initialize a list to store the plots ... -R/explore_data.R#L662 plot_list <- list() ... -R/explore_data.R#L663 ... -R/explore_data.R#L664 # Loop through each level of the condi ... -R/explore_data.R#L665 for (cond in unique(meta[[condition]]) ... -R/explore_data.R#L673 # Compute first lag difference ... -R/explore_data.R#L674 lag_diff <- diff(feature) ... -R/explore_data.R#L675 # Compute autocorrelation ... -R/explore_data.R#L676 stats::acf(lag_diff, plot = FALSE) ... -R/explore_data.R#L685 Feature = 1:nrow(data), ... -R/explore_data.R#L686 Autocorrelation = autocorrelations ... -R/explore_data.R#L687 ) ... -R/explore_data.R#L691 ggplot2::geom_histogram(binwidth = ... -R/explore_data.R#L692 color = "b ... -R/explore_data.R#L693 ggplot2::theme_minimal() + ... -R/explore_data.R#L694 ggplot2::theme( ... -R/explore_data.R#L700 ) + ... -R/explore_data.R#L701 ggplot2::labs(title = paste("Level ... -R/explore_data.R#L702 x = "Autocorrelation Coeffici ... -R/explore_data.R#L703 y = "Count of Features", ... -R/explore_data.R#L704 subtitle = paste("Mean:", rou ... -R/explore_data.R#L709 } ... -R/explore_data.R#L710 ... -R/explore_data.R#L711 return(plot_list) ... -R/explore_data.R#L743 ... +R/explore_data.R#L51 meta_batch_column <- splineomics[["met ... +R/explore_data.R#L52 meta_batch2_column <- splineomics[["me ... +R/explore_data.R#L54 data_list <- list(data = data) ... +R/explore_data.R#L56 if (!is.null(meta_batch_column)) { ... +R/explore_data.R#L58 x = data, ... +R/explore_data.R#L59 batch = meta[[meta_batch_column]], ... +R/explore_data.R#L60 group = meta[[condition]] ... +R/explore_data.R#L64 args$batch2 <- meta[[meta_batch2_c ... +R/explore_data.R#L70 } ... +R/explore_data.R#L72 all_plots <- list() ... +R/explore_data.R#L73 report_info$meta_condition <- c(condit ... +R/explore_data.R#L74 report_info$meta_batch <- paste( ... +R/explore_data.R#L78 ) ... +R/explore_data.R#L79 timestamp <- format(Sys.time(), "%d_%m ... +R/explore_data.R#L81 for (data_name in names(data_list)) { ... +R/explore_data.R#L84 current_data, ... +R/explore_data.R#L85 meta, ... +R/explore_data.R#L86 condition ... +R/explore_data.R#L90 generate_report_html( ... +R/explore_data.R#L99 ) ... +R/explore_data.R#L103 } ... +R/explore_data.R#L105 print_info_message( ... +R/explore_data.R#L108 ) ... +R/explore_data.R#L110 return(all_plots) ... +R/explore_data.R#L140 meta[[condition]] <- as.factor(meta[[c ... +R/explore_data.R#L142 plot_functions_and_sizes <- list( ... +R/explore_data.R#L152 ) ... +R/explore_data.R#L154 apply_plot_function <- function(entry) ... +R/explore_data.R#L157 plots = plot_result, size = entry$ ... +R/explore_data.R#L158 flatten = if ("flatten" %in% names ... +R/explore_data.R#L160 } ... +R/explore_data.R#L162 plot_results <- lapply(plot_functions_ ... +R/explore_data.R#L164 all_plots <- list() ... +R/explore_data.R#L165 all_plots_sizes <- c() ... +R/explore_data.R#L167 # Flatten the results and sizes condit ... +R/explore_data.R#L168 for (result in plot_results) { ... +R/explore_data.R#L173 # Special handling for make_correl ... +R/explore_data.R#L174 all_plots <- c(all_plots, result$p ... +R/explore_data.R#L175 all_plots_sizes <- c(all_plots_siz ... +R/explore_data.R#L177 # Do not flatten the result, add i ... +R/explore_data.R#L178 all_plots <- c(all_plots, list(res ... +R/explore_data.R#L179 all_plots_sizes <- c(all_plots_siz ... +R/explore_data.R#L181 # Flatten the result ... +R/explore_data.R#L182 all_plots <- c(all_plots, result$p ... +R/explore_data.R#L183 all_plots_sizes <- c( ... +R/explore_data.R#L186 result$size, ... +R/explore_data.R#L187 length(result$plots) ... +R/explore_data.R#L189 ) ... +R/explore_data.R#L191 } ... +R/explore_data.R#L193 list( ... +R/explore_data.R#L196 ) ... +R/explore_data.R#L228 html_content <- paste(header_section, ... +R/explore_data.R#L230 toc <- create_toc() ... +R/explore_data.R#L232 styles <- define_html_styles() ... +R/explore_data.R#L233 section_header_style <- styles$section ... +R/explore_data.R#L234 toc_style <- styles$toc_style ... +R/explore_data.R#L236 just_plots <- plots |> purrr::discard( ... +R/explore_data.R#L237 pb <- create_progress_bar(just_plots) ... +R/explore_data.R#L239 plot_names <- c( ... +R/explore_data.R#L249 ) ... +R/explore_data.R#L251 plot_explanations <- get_explore_plots ... +R/explore_data.R#L253 major_headers <- c( ... +R/explore_data.R#L257 ) ... +R/explore_data.R#L259 major_header_style <- ... +R/explore_data.R#L262 toc_index <- 0 ... +R/explore_data.R#L263 toc_index_memory <- toc_index ... +R/explore_data.R#L264 major_header_index <- 0 ... +R/explore_data.R#L266 # Generate the sections and plots ... +R/explore_data.R#L267 for (index in seq_along(plots)) { ... +R/explore_data.R#L270 toc_index <- toc_index + 1 ... +R/explore_data.R#L272 if ( ... +R/explore_data.R#L274 toc_index == 3 || ... +R/explore_data.R#L275 toc_index == 6 ... +R/explore_data.R#L276 ) { ... +R/explore_data.R#L280 "section_major_", ... +R/explore_data.R#L281 major_header_index ... +R/explore_data.R#L284 toc, ... +R/explore_data.R#L285 sprintf( ... +R/explore_data.R#L290 ), ... +R/explore_data.R#L291 sep = "\n" ... +R/explore_data.R#L295 '
    %s
    ', ... +R/explore_data.R#L297 section_id, ... +R/explore_data.R#L298 major_header_style, ... +R/explore_data.R#L299 major_headers[major_header_ind ... +R/explore_data.R#L303 group_header <- paste( ... +R/explore_data.R#L309 ) ... +R/explore_data.R#L313 html_content, ... +R/explore_data.R#L314 group_header, ... +R/explore_data.R#L315 sep = "\n" ... +R/explore_data.R#L317 } ... +R/explore_data.R#L318 next ... +R/explore_data.R#L323 section_id <- paste0("section_", t ... +R/explore_data.R#L324 toc <- ... +R/explore_data.R#L326 toc, ... +R/explore_data.R#L327 sprintf( ... +R/explore_data.R#L329 '
  • %s
  • ... +R/explore_data.R#L334 ), ... +R/explore_data.R#L335 sep = "\n" ... +R/explore_data.R#L338 section_header <- sprintf( ... +R/explore_data.R#L343 ) ... +R/explore_data.R#L345 plot_description <- sprintf( ... +R/explore_data.R#L348 ) ... +R/explore_data.R#L350 html_content <- paste( ... +R/explore_data.R#L355 ) ... +R/explore_data.R#L357 toc_index_memory <- toc_index ... +R/explore_data.R#L366 html_content, ... +R/explore_data.R#L367 img_tag, ... +R/explore_data.R#L368 "
    ", # Add horizontal line afte ... +R/explore_data.R#L369 sep = "\n" ... +R/explore_data.R#L372 } ... +R/explore_data.R#L374 generate_and_write_html( ... +R/explore_data.R#L379 ) ... +R/explore_data.R#L406 custom_theme <- ggplot2::theme( ... +R/explore_data.R#L412 ) ... +R/explore_data.R#L414 density_plots <- list() ... +R/explore_data.R#L416 # Melt the data to long format using t ... +R/explore_data.R#L417 data_long <- tidyr::pivot_longer( ... +R/explore_data.R#L422 ) ... +R/explore_data.R#L425 if (length(unique(meta[[condition]])) ... +R/explore_data.R#L428 data_long, ... +R/explore_data.R#L429 ggplot2::aes(x = !!rlang::sym("val ... +R/explore_data.R#L431 ggplot2::geom_density( ... +R/explore_data.R#L434 ) + ... +R/explore_data.R#L435 ggplot2::ggtitle("All Levels") + ... +R/explore_data.R#L436 custom_theme ... +R/explore_data.R#L439 density_plots, ... +R/explore_data.R#L440 list(overall_plot) ... +R/explore_data.R#L442 } ... +R/explore_data.R#L445 # Create density plots for each level ... +R/explore_data.R#L446 levels <- unique(meta[[condition]]) ... +R/explore_data.R#L448 for (level in levels) { ... +R/explore_data.R#L455 as.data.frame(data_level), ... +R/explore_data.R#L456 cols = everything(), ... +R/explore_data.R#L457 names_to = "variable", ... +R/explore_data.R#L458 values_to = "value" ... +R/explore_data.R#L463 data_level_long, ... +R/explore_data.R#L464 ggplot2::aes(x = !!rlang::sym("val ... +R/explore_data.R#L466 ggplot2::geom_density(fill = "blue ... +R/explore_data.R#L467 ggplot2::ggtitle(paste("Level:", l ... +R/explore_data.R#L468 custom_theme ... +R/explore_data.R#L472 density_plots, ... +R/explore_data.R#L473 list(level_plot) ... +R/explore_data.R#L475 } ... +R/explore_data.R#L477 return(density_plots) ... +R/explore_data.R#L502 custom_theme <- ggplot2::theme( ... +R/explore_data.R#L508 ) ... +R/explore_data.R#L510 plots <- list() ... +R/explore_data.R#L512 # Create plots for each level of the c ... +R/explore_data.R#L513 levels <- unique(meta[[condition]]) ... +R/explore_data.R#L515 for (level in levels) { ... +R/explore_data.R#L522 as.data.frame(data_level), ... +R/explore_data.R#L523 cols = everything(), ... +R/explore_data.R#L524 names_to = "variable", ... +R/explore_data.R#L525 values_to = "value" ... +R/explore_data.R#L530 data_level_long, ... +R/explore_data.R#L531 ggplot2::aes( ... +R/explore_data.R#L534 ) ... +R/explore_data.R#L536 ggplot2::geom_violin(trim = FALSE, ... +R/explore_data.R#L537 ggplot2::geom_boxplot( ... +R/explore_data.R#L540 ) + ... +R/explore_data.R#L541 ggplot2::theme( ... +R/explore_data.R#L543 angle = 60, hjust = 1, ... +R/explore_data.R#L544 size = 6 ... +R/explore_data.R#L547 ) + ... +R/explore_data.R#L548 ggplot2::labs( ... +R/explore_data.R#L551 ) + ... +R/explore_data.R#L552 custom_theme ... +R/explore_data.R#L556 } ... +R/explore_data.R#L558 return(plots) ... +R/explore_data.R#L585 plot_list <- list() ... +R/explore_data.R#L587 # Loop through each level of the condi ... +R/explore_data.R#L588 for (cond in unique(meta[[condition]]) ... +R/explore_data.R#L596 cor(feature, time_subset, use = "c ... +R/explore_data.R#L601 rownames(data) <- paste0("Feature" ... +R/explore_data.R#L605 Feature = rownames(data), ... +R/explore_data.R#L606 Correlation = correlations ... +R/explore_data.R#L611 ggplot2::geom_histogram( ... +R/explore_data.R#L614 ) + ... +R/explore_data.R#L615 ggplot2::theme_minimal() + ... +R/explore_data.R#L616 ggplot2::labs( ... +R/explore_data.R#L620 ) ... +R/explore_data.R#L624 } ... +R/explore_data.R#L626 return(plot_list) ... +R/explore_data.R#L657 # Initialize a list to store the plots ... +R/explore_data.R#L658 plot_list <- list() ... +R/explore_data.R#L660 # Loop through each level of the condi ... +R/explore_data.R#L661 for (cond in unique(meta[[condition]]) ... +R/explore_data.R#L669 # Compute first lag difference ... +R/explore_data.R#L670 lag_diff <- diff(feature) ... +R/explore_data.R#L671 # Compute autocorrelation ... +R/explore_data.R#L672 stats::acf(lag_diff, plot = FALSE) ... +R/explore_data.R#L681 Feature = 1:nrow(data), ... +R/explore_data.R#L682 Autocorrelation = autocorrelations ... +R/explore_data.R#L687 ggplot2::geom_histogram( ... +R/explore_data.R#L690 ) + ... +R/explore_data.R#L691 ggplot2::theme_minimal() + ... +R/explore_data.R#L692 ggplot2::theme( ... +R/explore_data.R#L698 ) + ... +R/explore_data.R#L699 ggplot2::labs( ... +R/explore_data.R#L704 "Mean:", round(mean_autocorrel ... +R/explore_data.R#L705 "SD:", round(std_autocorrelati ... +R/explore_data.R#L707 ) ... +R/explore_data.R#L711 } ... +R/explore_data.R#L713 return(plot_list) ... R/explore_data.R#L744 plot_list <- list() ... -R/explore_data.R#L745 ... R/explore_data.R#L746 # Loop through each level of the condi ... R/explore_data.R#L747 for (cond in unique(meta[[condition]]) ... -R/explore_data.R#L755 abs(di ... -R/explore_data.R#L760 data_subset, ... -R/explore_data.R#L761 1, ... -R/explore_data.R#L762 mean, ... -R/explore_data.R#L763 na.rm = TRUE ... -R/explore_data.R#L764 ) ... -R/explore_data.R#L770 normalized_lag1_differences, ... -R/explore_data.R#L771 1, ... -R/explore_data.R#L772 mean, ... -R/explore_data.R#L773 na.rm = TRUE ... -R/explore_data.R#L774 ) ... -R/explore_data.R#L777 normalized_lag1_differences, ... -R/explore_data.R#L778 1, ... -R/explore_data.R#L779 stats::sd, ... -R/explore_data.R#L780 na.rm = TRUE ... -R/explore_data.R#L781 ) ... -R/explore_data.R#L785 Feature = 1:nrow(data), ... -R/explore_data.R#L786 Mean_Lag1_Difference = mean_lag1_d ... -R/explore_data.R#L787 Std_Lag1_Difference = std_lag1_dif ... -R/explore_data.R#L792 diff_data, ... -R/explore_data.R#L793 aes(x = .data$Mean_Lag1_Difference ... -R/explore_data.R#L794 ) + ... -R/explore_data.R#L795 ggplot2::geom_histogram( ... -R/explore_data.R#L800 ggplot2::theme_minimal() + ... -R/explore_data.R#L801 ggplot2::theme( ... -R/explore_data.R#L807 ) + ... -R/explore_data.R#L808 ggplot2::labs( ... -R/explore_data.R#L813 "Mean:", ... -R/explore_data.R#L814 round(mean(mean_lag1_diff, na. ... -R/explore_data.R#L815 "SD:", round(stats::sd(mean_la ... -R/explore_data.R#L816 ) ... -R/explore_data.R#L820 } ... -R/explore_data.R#L821 ... -R/explore_data.R#L822 return(plot_list) ... -R/explore_data.R#L852 ... +R/explore_data.R#L754 data_subset, 1, ... +R/explore_data.R#L755 function(feature) { ... +R/explore_data.R#L757 } ... +R/explore_data.R#L762 data_subset, ... +R/explore_data.R#L763 1, ... +R/explore_data.R#L764 mean, ... +R/explore_data.R#L765 na.rm = TRUE ... +R/explore_data.R#L772 normalized_lag1_differences, ... +R/explore_data.R#L773 1, ... +R/explore_data.R#L774 mean, ... +R/explore_data.R#L775 na.rm = TRUE ... +R/explore_data.R#L779 normalized_lag1_differences, ... +R/explore_data.R#L780 1, ... +R/explore_data.R#L781 stats::sd, ... +R/explore_data.R#L782 na.rm = TRUE ... +R/explore_data.R#L787 Feature = 1:nrow(data), ... +R/explore_data.R#L788 Mean_Lag1_Difference = mean_lag1_d ... +R/explore_data.R#L789 Std_Lag1_Difference = std_lag1_dif ... +R/explore_data.R#L794 diff_data, ... +R/explore_data.R#L795 aes(x = .data$Mean_Lag1_Difference ... +R/explore_data.R#L797 ggplot2::geom_histogram( ... +R/explore_data.R#L801 ) + ... +R/explore_data.R#L802 ggplot2::theme_minimal() + ... +R/explore_data.R#L803 ggplot2::theme( ... +R/explore_data.R#L809 ) + ... +R/explore_data.R#L810 ggplot2::labs( ... +R/explore_data.R#L815 "Mean:", ... +R/explore_data.R#L816 round(mean(mean_lag1_diff, na. ... +R/explore_data.R#L817 "SD:", round(stats::sd(mean_la ... +R/explore_data.R#L819 ) ... +R/explore_data.R#L822 } ... +R/explore_data.R#L824 return(plot_list) ... R/explore_data.R#L853 plot_list <- list() ... -R/explore_data.R#L854 ... R/explore_data.R#L855 for (cond in unique(meta[[condition]]) ... R/explore_data.R#L861 sd(feature) / mean(feature) ... R/explore_data.R#L870 Feature = seq_len(nrow(data)), ... R/explore_data.R#L871 CV = cvs ... R/explore_data.R#L875 ggplot2::geom_histogram( ... +R/explore_data.R#L879 ) + ... R/explore_data.R#L880 ggplot2::theme_minimal() + ... R/explore_data.R#L881 ggplot2::theme( ... R/explore_data.R#L887 ) + ... R/explore_data.R#L888 ggplot2::labs( ... R/explore_data.R#L893 "Mean CV:", ... -R/explore_data.R#L894 round(mean_cv, 3), ... +R/explore_data.R#L894 round(mean_cv, 3), ... R/explore_data.R#L895 "SD CV:", ... R/explore_data.R#L896 round(std_cv, 3) ... -R/explore_data.R#L897 ) ... +R/explore_data.R#L898 ) ... R/explore_data.R#L901 } ... -R/explore_data.R#L902 ... R/explore_data.R#L903 return(plot_list) ... -R/explore_data.R#L930 ... -R/explore_data.R#L931 # Perform PCA ... -R/explore_data.R#L932 pc <- stats::prcomp(t(data)) ... -R/explore_data.R#L933 pca_df <- data.frame(PC1 = pc$x[, 1], ... -R/explore_data.R#L934 ... -R/explore_data.R#L935 # Add labels and levels from the metad ... -R/explore_data.R#L936 pca_df$Labels <- colnames(data) ... -R/explore_data.R#L937 pca_df$Levels <- meta[[condition]] ... -R/explore_data.R#L938 ... -R/explore_data.R#L939 # Add time column for alpha transparen ... -R/explore_data.R#L940 pca_df$Time <- meta$Time ... -R/explore_data.R#L941 ... -R/explore_data.R#L942 # Normalize the Time column to a 0-1 r ... -R/explore_data.R#L943 pca_df$Alpha <- scales::rescale(pca_df ... -R/explore_data.R#L944 ... -R/explore_data.R#L945 # Calculate the variance explained ... -R/explore_data.R#L946 variance_explained <- pc$sdev^2 / sum( ... -R/explore_data.R#L947 percent_variance_explained <- round(va ... -R/explore_data.R#L948 ... -R/explore_data.R#L949 # Extend the x-axis range ... -R/explore_data.R#L950 x_range <- range(pc$x[, 1]) ... -R/explore_data.R#L951 extended_x_max <- x_range[2] + (x_rang ... -R/explore_data.R#L952 ... -R/explore_data.R#L953 # Create the PCA plot ... -R/explore_data.R#L954 pca_plot <- ggplot2::ggplot(pca_df, ae ... -R/explore_data.R#L961 box.padding ... -R/explore_data.R#L962 point.paddi ... -R/explore_data.R#L963 max.overlap ... -R/explore_data.R#L964 size = 2) + ... -R/explore_data.R#L972 ... +R/explore_data.R#L929 # Perform PCA ... +R/explore_data.R#L930 pc <- stats::prcomp(t(data)) ... +R/explore_data.R#L931 pca_df <- data.frame(PC1 = pc$x[, 1], ... +R/explore_data.R#L933 # Add labels and levels from the metad ... +R/explore_data.R#L934 pca_df$Labels <- colnames(data) ... +R/explore_data.R#L935 pca_df$Levels <- meta[[condition]] ... +R/explore_data.R#L937 # Add time column for alpha transparen ... +R/explore_data.R#L938 pca_df$Time <- meta$Time ... +R/explore_data.R#L940 # Normalize the Time column to a 0-1 r ... +R/explore_data.R#L941 pca_df$Alpha <- scales::rescale(pca_df ... +R/explore_data.R#L943 # Calculate the variance explained ... +R/explore_data.R#L944 variance_explained <- pc$sdev^2 / sum( ... +R/explore_data.R#L945 percent_variance_explained <- round(va ... +R/explore_data.R#L947 # Extend the x-axis range ... +R/explore_data.R#L948 x_range <- range(pc$x[, 1]) ... +R/explore_data.R#L949 extended_x_max <- x_range[2] + (x_rang ... +R/explore_data.R#L951 # Create the PCA plot ... +R/explore_data.R#L952 pca_plot <- ggplot2::ggplot(pca_df, ae ... +R/explore_data.R#L957 )) + ... +R/explore_data.R#L960 box.padding = 0.35, ... +R/explore_data.R#L961 point.padding = 0.5, ... +R/explore_data.R#L962 max.overlaps = Inf, ... +R/explore_data.R#L963 size = 2 ... R/explore_data.R#L973 return(pca_plot) ... -R/explore_data.R#L1001 ... -R/explore_data.R#L1002 # Perform MDS using limma's plotMDS fu ... -R/explore_data.R#L1003 mds <- limma::plotMDS( ... -R/explore_data.R#L1006 ) ... -R/explore_data.R#L1007 ... -R/explore_data.R#L1008 # Extract MDS coordinates ... -R/explore_data.R#L1009 mds_df <- data.frame( ... -R/explore_data.R#L1013 ) ... -R/explore_data.R#L1014 ... -R/explore_data.R#L1015 # Add condition levels and time inform ... -R/explore_data.R#L1016 mds_df$Levels <- meta[[condition]] ... -R/explore_data.R#L1017 mds_df$Time <- meta$Time ... -R/explore_data.R#L1018 ... -R/explore_data.R#L1019 # Normalize the Time column to a 0-1 r ... -R/explore_data.R#L1020 mds_df$Alpha <- scales::rescale(mds_df ... -R/explore_data.R#L1021 ... -R/explore_data.R#L1022 # Generate the MDS plot using ggplot2 ... -R/explore_data.R#L1023 mds_plot <- ggplot2::ggplot( ... -R/explore_data.R#L1026 x = .data$Dim1, ... -R/explore_data.R#L1027 y = .data$Dim2, ... -R/explore_data.R#L1028 label = .data$Labels, ... -R/explore_data.R#L1029 color = .data$Levels, ... -R/explore_data.R#L1030 alpha = .data$Alpha # Use alpha f ... -R/explore_data.R#L1032 ) + ... -R/explore_data.R#L1035 box.padding = 0.35, ... -R/explore_data.R#L1036 point.padding = 0.5, ... -R/explore_data.R#L1037 max.overlaps = Inf, ... -R/explore_data.R#L1038 size = 2 ... -R/explore_data.R#L1043 x = "Dimension 1", ... -R/explore_data.R#L1044 y = "Dimension 2", ... -R/explore_data.R#L1045 color = condition ... -R/explore_data.R#L1048 ... -R/explore_data.R#L1049 return(mds_plot) ... -R/explore_data.R#L1079 ... -R/explore_data.R#L1080 heatmaps <- list() ... -R/explore_data.R#L1081 heatmaps_sizes <- c() ... -R/explore_data.R#L1082 ... -R/explore_data.R#L1083 if (length(unique(meta[[condition]])) ... -R/explore_data.R#L1086 use = "pairwi ... -R/explore_data.R#L1092 max(corr_all, na.rm = ... +R/explore_data.R#L1000 # Perform MDS using limma's plotMDS fu ... +R/explore_data.R#L1001 mds <- limma::plotMDS( ... +R/explore_data.R#L1004 ) ... +R/explore_data.R#L1006 # Extract MDS coordinates ... +R/explore_data.R#L1007 mds_df <- data.frame( ... +R/explore_data.R#L1011 ) ... +R/explore_data.R#L1013 # Add condition levels and time inform ... +R/explore_data.R#L1014 mds_df$Levels <- meta[[condition]] ... +R/explore_data.R#L1015 mds_df$Time <- meta$Time ... +R/explore_data.R#L1017 # Normalize the Time column to a 0-1 r ... +R/explore_data.R#L1018 mds_df$Alpha <- scales::rescale(mds_df ... +R/explore_data.R#L1020 # Generate the MDS plot using ggplot2 ... +R/explore_data.R#L1021 mds_plot <- ggplot2::ggplot( ... +R/explore_data.R#L1024 x = .data$Dim1, ... +R/explore_data.R#L1025 y = .data$Dim2, ... +R/explore_data.R#L1026 label = .data$Labels, ... +R/explore_data.R#L1027 color = .data$Levels, ... +R/explore_data.R#L1028 alpha = .data$Alpha # Use alpha fo ... +R/explore_data.R#L1030 ) + ... +R/explore_data.R#L1033 box.padding = 0.35, ... +R/explore_data.R#L1034 point.padding = 0.5, ... +R/explore_data.R#L1035 max.overlaps = Inf, ... +R/explore_data.R#L1036 size = 2 ... +R/explore_data.R#L1041 x = "Dimension 1", ... +R/explore_data.R#L1042 y = "Dimension 2", ... +R/explore_data.R#L1043 color = condition ... +R/explore_data.R#L1047 return(mds_plot) ... +R/explore_data.R#L1076 heatmaps <- list() ... +R/explore_data.R#L1077 heatmaps_sizes <- c() ... +R/explore_data.R#L1079 if (length(unique(meta[[condition]])) ... +R/explore_data.R#L1082 method = "spearman", ... +R/explore_data.R#L1083 use = "pairwise.complete.obs" ... +R/explore_data.R#L1090 max(corr_all, na.rm = TRUE), ... +R/explore_data.R#L1091 length.out = 100 ... R/explore_data.R#L1097 corr_all, ... R/explore_data.R#L1098 col = col_fun(100), ... R/explore_data.R#L1099 name = "Correlation", ... @@ -2365,3400 +2107,2733 @@ R/explore_data.R#L1108 row_names_gp = gpar(fontsize = 6), ... R/explore_data.R#L1109 column_names_gp = gpar(fontsize = ... R/explore_data.R#L1110 column_names_rot = 60 ... R/explore_data.R#L1113 } ... -R/explore_data.R#L1114 ... R/explore_data.R#L1115 # Custom scaling logic for the HTML re ... -R/explore_data.R#L1116 heatmap_all_size <- max(1.5 * length(m ... -R/explore_data.R#L1117 1) ... -R/explore_data.R#L1118 heatmaps_sizes <- c(heatmaps_sizes, he ... -R/explore_data.R#L1119 ... -R/explore_data.R#L1120 # Create correlation heatmaps for each ... -R/explore_data.R#L1121 levels <- unique(meta[[condition]]) ... -R/explore_data.R#L1122 for (level in levels) { ... -R/explore_data.R#L1129 use = "pair ... -R/explore_data.R#L1141 corr_level, ... -R/explore_data.R#L1142 col = col_fun_level(100), ... -R/explore_data.R#L1143 name = "Correlation", ... -R/explore_data.R#L1144 column_title = paste("Level:", lev ... -R/explore_data.R#L1145 heatmap_legend_param = list( ... -R/explore_data.R#L1150 ), ... -R/explore_data.R#L1151 na_col = "grey", ... -R/explore_data.R#L1152 row_names_gp = gpar(fontsize = 6), ... -R/explore_data.R#L1153 column_names_gp = gpar(fontsize = ... -R/explore_data.R#L1154 column_names_rot = 60 ... -R/explore_data.R#L1162 1) ... -R/explore_data.R#L1164 } ... -R/explore_data.R#L1165 ... -R/explore_data.R#L1166 list(heatmaps = heatmaps, ... -R/explore_data.R#L1167 heatmaps_sizes = heatmaps_sizes) ... -R/explore_data.R#L1187 ... -R/explore_data.R#L1188 plot_explanations_file <- system.file( ... -R/explore_data.R#L1193 plot_explanations <- readLines(plot_ex ... -R/extract_data.R#L39 ... -R/extract_data.R#L40 control_inputs_extract_data( ... -R/extract_data.R#L44 ... -R/extract_data.R#L45 if (user_prompt) { ... -R/extract_data.R#L47 "Is the data matrix on the left, t ... -R/extract_data.R#L48 "separated by an empty column? " ... -R/extract_data.R#L49 )) ... -R/extract_data.R#L50 } ... -R/extract_data.R#L51 ... -R/extract_data.R#L52 data <- as.data.frame(data) ... -R/extract_data.R#L53 ... -R/extract_data.R#L54 numeric_block_finder <- NumericBlockFi ... -R/extract_data.R#L55 upper_left_cell <- numeric_block_finde ... -R/extract_data.R#L56 lower_right_cell <- numeric_block_find ... -R/extract_data.R#L57 ... -R/extract_data.R#L58 upper_left_row <- upper_left_cell$uppe ... -R/extract_data.R#L59 upper_left_col <- upper_left_cell$uppe ... -R/extract_data.R#L60 ... -R/extract_data.R#L61 lower_right_row <- lower_right_cell$lo ... -R/extract_data.R#L62 lower_right_col <- lower_right_cell$lo ... -R/extract_data.R#L64 ... -R/extract_data.R#L65 # Extract the numeric data block ... -R/extract_data.R#L66 numeric_data <- data[ ... -R/extract_data.R#L71 numeric_data[] <- ... -R/extract_data.R#L73 as.numeric(as.character(col)))) ... -R/extract_data.R#L75 # Check if every element of numeric_da ... -R/extract_data.R#L76 if (any(sapply(numeric_data, function( ... -R/extract_data.R#L78 paste( ... +R/explore_data.R#L1116 heatmap_all_size <- max( ... +R/explore_data.R#L1119 ) ... +R/explore_data.R#L1120 heatmaps_sizes <- c(heatmaps_sizes, he ... +R/explore_data.R#L1122 # Create correlation heatmaps for each ... +R/explore_data.R#L1123 levels <- unique(meta[[condition]]) ... +R/explore_data.R#L1124 for (level in levels) { ... +R/explore_data.R#L1131 method = "spearman", ... +R/explore_data.R#L1132 use = "pairwise.complete.obs" ... +R/explore_data.R#L1139 max(corr_level, na.rm = TRUE), ... +R/explore_data.R#L1140 length.out = 100 ... +R/explore_data.R#L1147 corr_level, ... +R/explore_data.R#L1148 col = col_fun_level(100), ... +R/explore_data.R#L1149 name = "Correlation", ... +R/explore_data.R#L1150 column_title = paste("Level:", lev ... +R/explore_data.R#L1151 heatmap_legend_param = list( ... +R/explore_data.R#L1156 ), ... +R/explore_data.R#L1157 na_col = "grey", ... +R/explore_data.R#L1158 row_names_gp = gpar(fontsize = 6), ... +R/explore_data.R#L1159 column_names_gp = gpar(fontsize = ... +R/explore_data.R#L1160 column_names_rot = 60 ... +R/explore_data.R#L1168 1.5 * nr_level_timepoints / 17, ... +R/explore_data.R#L1169 1 ... +R/explore_data.R#L1172 } ... +R/explore_data.R#L1174 list( ... +R/explore_data.R#L1177 ) ... +R/explore_data.R#L1197 plot_explanations_file <- system.file( ... +R/explore_data.R#L1201 ) ... +R/explore_data.R#L1202 plot_explanations <- readLines(plot_ex ... +R/extract_data.R#L38 control_inputs_extract_data( ... +R/extract_data.R#L41 ) ... +R/extract_data.R#L43 if (user_prompt) { ... +R/extract_data.R#L45 "Is the data matrix on the left, t ... +R/extract_data.R#L46 "separated by an empty column? " ... +R/extract_data.R#L48 } ... +R/extract_data.R#L50 data <- as.data.frame(data) ... +R/extract_data.R#L52 numeric_block_finder <- NumericBlockFi ... +R/extract_data.R#L53 upper_left_cell <- numeric_block_finde ... +R/extract_data.R#L54 lower_right_cell <- numeric_block_find ... +R/extract_data.R#L56 upper_left_row <- upper_left_cell$uppe ... +R/extract_data.R#L57 upper_left_col <- upper_left_cell$uppe ... +R/extract_data.R#L59 lower_right_row <- lower_right_cell$lo ... +R/extract_data.R#L60 lower_right_col <- lower_right_cell$lo ... +R/extract_data.R#L63 # Extract the numeric data block ... +R/extract_data.R#L64 numeric_data <- data[ ... +R/extract_data.R#L67 ] ... +R/extract_data.R#L69 numeric_data[] <- ... +R/extract_data.R#L71 suppressWarnings( ... +R/extract_data.R#L73 ) ... +R/extract_data.R#L76 # Check if every element of numeric_da ... +R/extract_data.R#L77 if (any(vapply(numeric_data, function( ... R/extract_data.R#L79 "All elements of the data field mu ... R/extract_data.R#L80 "ensure there is an empty column b ... R/extract_data.R#L81 "the annotation information, which ... R/extract_data.R#L82 "right of the numeric data, not on ... -R/extract_data.R#L83 ), ... -R/extract_data.R#L84 call. = FALSE ... -R/extract_data.R#L85 ) ... -R/extract_data.R#L86 } ... -R/extract_data.R#L88 # Remove rows and columns that are ent ... -R/extract_data.R#L89 numeric_data <- numeric_data[ ... -R/extract_data.R#L92 numeric_data <- numeric_data[ ... -R/extract_data.R#L96 # Remove rows with any NA values ... -R/extract_data.R#L97 clean_data <- numeric_data[stats::comp ... -R/extract_data.R#L98 ... -R/extract_data.R#L99 # Extract headers for each column abov ... -R/extract_data.R#L100 headers <- sapply(upper_left_col:lower ... -R/extract_data.R#L104 }) ... -R/extract_data.R#L105 ... -R/extract_data.R#L106 colnames(clean_data) <- headers ... -R/extract_data.R#L107 ... -R/extract_data.R#L108 clean_data <- add_feature_names( ... -R/extract_data.R#L113 ... -R/extract_data.R#L114 clean_matrix <- as.matrix(clean_data) ... -R/extract_data.R#L115 rownames(clean_matrix) <- rownames(cle ... -R/extract_data.R#L116 ... -R/extract_data.R#L117 clean_matrix ... -R/extract_data.R#L135 public = list( ... -R/extract_data.R#L146 ... -R/extract_data.R#L147 self$data <- as.data.frame(data) ... -R/extract_data.R#L160 ... -R/extract_data.R#L161 upper_left_row <- NA ... -R/extract_data.R#L162 upper_left_col <- NA ... -R/extract_data.R#L163 num_rows <- nrow(self$data) ... -R/extract_data.R#L164 num_cols <- ncol(self$data) ... -R/extract_data.R#L165 ... -R/extract_data.R#L166 for (i in 1:(num_rows - 5)) { ... -R/extract_data.R#L168 block <- self$data[i:(i + 5), ... -R/extract_data.R#L169 block_num <- suppressWarnings( ... -R/extract_data.R#L170 if (all(!is.na(block_num)) && ... -R/extract_data.R#L174 } ... -R/extract_data.R#L177 } ... -R/extract_data.R#L178 ... -R/extract_data.R#L179 if (is.na(upper_left_row) || is.na ... -R/extract_data.R#L181 call. = FALSE) ... -R/extract_data.R#L182 } ... -R/extract_data.R#L183 ... -R/extract_data.R#L184 self$upper_left_cell <- list(upper ... -R/extract_data.R#L185 upper ... -R/extract_data.R#L186 return(self$upper_left_cell) ... -R/extract_data.R#L199 ... -R/extract_data.R#L200 if (is.null(self$upper_left_cell)) ... -R/extract_data.R#L202 "Call find_upper_left ... +R/extract_data.R#L84 } ... +R/extract_data.R#L86 # Remove rows and columns that are ent ... +R/extract_data.R#L87 numeric_data <- numeric_data[ ... +R/extract_data.R#L89 ] ... +R/extract_data.R#L90 numeric_data <- numeric_data[ ... +R/extract_data.R#L92 ] ... +R/extract_data.R#L94 # Remove rows with any NA values ... +R/extract_data.R#L95 clean_data <- numeric_data[stats::comp ... +R/extract_data.R#L97 # Extract headers for each column abov ... +R/extract_data.R#L98 headers <- vapply(upper_left_col:lower ... +R/extract_data.R#L102 }, character(1)) ... +R/extract_data.R#L104 colnames(clean_data) <- headers ... +R/extract_data.R#L106 clean_data <- add_feature_names( ... +R/extract_data.R#L110 ) ... +R/extract_data.R#L112 clean_matrix <- as.matrix(clean_data) ... +R/extract_data.R#L113 rownames(clean_matrix) <- rownames(cle ... +R/extract_data.R#L115 clean_matrix ... +R/extract_data.R#L133 public = list( ... +R/extract_data.R#L144 self$data <- as.data.frame(data) ... +R/extract_data.R#L157 upper_left_row <- NA ... +R/extract_data.R#L158 upper_left_col <- NA ... +R/extract_data.R#L159 num_rows <- nrow(self$data) ... +R/extract_data.R#L160 num_cols <- ncol(self$data) ... +R/extract_data.R#L162 for (i in 1:(num_rows - 5)) { ... +R/extract_data.R#L164 block <- self$data[i:(i + 5), ... +R/extract_data.R#L165 block_num <- suppressWarnings( ... +R/extract_data.R#L166 if (all(!is.na(block_num)) && ... +R/extract_data.R#L170 } ... +R/extract_data.R#L173 } ... +R/extract_data.R#L175 if (is.na(upper_left_row) || is.na ... +R/extract_data.R#L177 call. = FALSE ... +R/extract_data.R#L179 } ... +R/extract_data.R#L181 self$upper_left_cell <- list( ... +R/extract_data.R#L184 ) ... +R/extract_data.R#L185 return(self$upper_left_cell) ... +R/extract_data.R#L198 if (is.null(self$upper_left_cell)) ... +R/extract_data.R#L200 "Upper-left cell has not been ... +R/extract_data.R#L201 "Call find_upper_left_cell fir ... R/extract_data.R#L203 } ... -R/extract_data.R#L204 ... R/extract_data.R#L205 upper_left_row <- self$upper_left_ ... R/extract_data.R#L206 upper_left_col <- self$upper_left_ ... R/extract_data.R#L207 num_rows <- nrow(self$data) ... R/extract_data.R#L208 num_cols <- ncol(self$data) ... -R/extract_data.R#L209 ... R/extract_data.R#L210 # Expand the block vertically ... R/extract_data.R#L211 lower_right_row <- upper_left_row ... R/extract_data.R#L212 for (i in (upper_left_row + 1):num ... R/extract_data.R#L214 break ... R/extract_data.R#L217 } ... -R/extract_data.R#L218 ... R/extract_data.R#L219 # Expand the block horizontally ... R/extract_data.R#L220 lower_right_col <- upper_left_col ... -R/extract_data.R#L221 for (j in (upper_left_col+1):num_c ... +R/extract_data.R#L221 for (j in (upper_left_col + 1):num ... R/extract_data.R#L223 break ... R/extract_data.R#L226 } ... -R/extract_data.R#L227 ... -R/extract_data.R#L228 list(lower_right_row = lower_right ... -R/extract_data.R#L229 lower_right_col = lower_right ... -R/extract_data.R#L231 ) ... -R/extract_data.R#L266 ... +R/extract_data.R#L228 list( ... +R/extract_data.R#L231 ) ... +R/extract_data.R#L233 ) ... R/extract_data.R#L267 if (!is.data.frame(data)) { ... R/extract_data.R#L269 } ... -R/extract_data.R#L270 ... R/extract_data.R#L271 if (!any(is.na(feature_name_columns))) ... -R/extract_data.R#L274 stop("feature_name_columns should ... -R/extract_data.R#L279 stop(paste( ... -R/extract_data.R#L288 if (all(is.na(data[feature_name_co ... -R/extract_data.R#L290 "' contain only NA va ... -R/extract_data.R#L291 call. = FALSE) ... -R/extract_data.R#L292 } ... -R/extract_data.R#L294 } ... -R/extract_data.R#L295 ... -R/extract_data.R#L296 if (nrow(data) == 0) { ... -R/extract_data.R#L298 } ... -R/extract_data.R#L314 message(question, " (yes/no):") ... -R/extract_data.R#L315 response <- readline() ... -R/extract_data.R#L316 if (tolower(response) == "yes") { ... -R/extract_data.R#L318 } else { ... -R/extract_data.R#L320 } ... -R/extract_data.R#L351 clean_data ... -R/extract_data.R#L352 feature_na ... -R/extract_data.R#L353 ... -R/extract_data.R#L354 if (!any(is.na(feature_name_columns))) ... -R/extract_data.R#L360 dr ... -R/extract_data.R#L364 function(row) ... -R/extract_data.R#L372 stop("Combined feature names must ... -R/extract_data.R#L373 call. = FALSE) ... -R/extract_data.R#L378 stop(paste("Length of combined fea ... -R/extract_data.R#L379 "rows in clean_data."), ... -R/extract_data.R#L380 call. = FALSE) ... -R/extract_data.R#L386 } else { ... -R/extract_data.R#L390 "etc. as the feature n ... -R/extract_data.R#L391 } ... -R/extract_data.R#L392 return(clean_data) ... -R/open_tutorial_and_template.R#L16 ... +R/extract_data.R#L273 stop("feature_name_columns should ... +R/extract_data.R#L278 stop( ... +R/extract_data.R#L280 "The following feature_name_co ... +R/extract_data.R#L281 paste(missing_columns, collaps ... +R/extract_data.R#L284 ) ... +R/extract_data.R#L289 if (all(is.na(data[feature_name_co ... +R/extract_data.R#L291 paste("Columns '", paste(featu ... +R/extract_data.R#L294 ), ... +R/extract_data.R#L295 call. = FALSE ... +R/extract_data.R#L297 } ... +R/extract_data.R#L299 } ... +R/extract_data.R#L301 if (nrow(data) == 0) { ... +R/extract_data.R#L303 } ... +R/extract_data.R#L319 message(question, " (yes/no):") ... +R/extract_data.R#L320 response <- readline() ... +R/extract_data.R#L321 if (tolower(response) == "yes") { ... +R/extract_data.R#L323 } else { ... +R/extract_data.R#L325 } ... +R/extract_data.R#L356 clean_data ... +R/extract_data.R#L357 feature_na ... +R/extract_data.R#L358 if (!any(is.na(feature_name_columns))) ... +R/extract_data.R#L360 data[feature_name_columns], 1, ... +R/extract_data.R#L361 function(row) all(!is.na(row)) ... +R/extract_data.R#L365 drop = FALSE ... +R/extract_data.R#L370 data_filtered[feature_name_columns ... +R/extract_data.R#L371 function(row) paste(row, collapse ... +R/extract_data.R#L380 stop("Combined feature names must ... +R/extract_data.R#L382 ) ... +R/extract_data.R#L387 stop( ... +R/extract_data.R#L389 "Length of combined feature na ... +R/extract_data.R#L390 "rows in clean_data." ... +R/extract_data.R#L393 ) ... +R/extract_data.R#L398 } else { ... +R/extract_data.R#L401 "No feature_name column specified. ... +R/extract_data.R#L402 "etc. as the feature names" ... +R/extract_data.R#L404 } ... +R/extract_data.R#L405 return(clean_data) ... R/open_tutorial_and_template.R#L17 # Check if rstudioapi is installed ... -R/open_tutorial_and_template.R#L18 if (!requireNamespace( ... -R/open_tutorial_and_template.R#L21 )) { ... -R/open_tutorial_and_template.R#L23 # Prompt the user for action ... -R/open_tutorial_and_template.R#L24 cat("The 'rstudioapi' package is n ... -R/open_tutorial_and_template.R#L25 cat("1: Install 'rstudioapi'\n") ... -R/open_tutorial_and_template.R#L26 cat("2: Do not install and quit\n" ... -R/open_tutorial_and_template.R#L27 cat("3: Resolve manually and retry ... -R/open_tutorial_and_template.R#L28 choice <- readline(prompt = "Pleas ... -R/open_tutorial_and_template.R#L29 ... -R/open_tutorial_and_template.R#L30 # Check user input and take approp ... -R/open_tutorial_and_template.R#L31 if (choice == "1") { ... -R/open_tutorial_and_template.R#L34 } else if (choice == "2") { ... -R/open_tutorial_and_template.R#L36 "User chose not to install 'rs ... -R/open_tutorial_and_template.R#L37 call. = FALSE ... -R/open_tutorial_and_template.R#L38 ) ... -R/open_tutorial_and_template.R#L39 } else if (choice == "3") { ... -R/open_tutorial_and_template.R#L41 "Please install 'rstudioapi' m ... -R/open_tutorial_and_template.R#L42 call. = FALSE) ... -R/open_tutorial_and_template.R#L43 } else { ... -R/open_tutorial_and_template.R#L45 } ... -R/open_tutorial_and_template.R#L47 } ... -R/open_tutorial_and_template.R#L48 ... -R/open_tutorial_and_template.R#L49 file <- system.file( ... -R/open_tutorial_and_template.R#L54 if (file != "") { ... -R/open_tutorial_and_template.R#L56 rstudioapi::navigateToFile(file) ... -R/open_tutorial_and_template.R#L58 stop("RStudio API not available. C ... -R/open_tutorial_and_template.R#L60 } else { ... -R/open_tutorial_and_template.R#L62 } ... -R/open_tutorial_and_template.R#L76 ... -R/open_tutorial_and_template.R#L77 # Check if rstudioapi is installed ... -R/open_tutorial_and_template.R#L78 if (!requireNamespace( ... -R/open_tutorial_and_template.R#L83 # Prompt the user for action ... -R/open_tutorial_and_template.R#L84 cat("The 'rstudioapi' package is n ... -R/open_tutorial_and_template.R#L85 cat("1: Install 'rstudioapi'\n") ... -R/open_tutorial_and_template.R#L86 cat("2: Do not install and quit\n" ... -R/open_tutorial_and_template.R#L87 cat("3: Resolve manually and retry ... -R/open_tutorial_and_template.R#L88 choice <- readline(prompt = "Pleas ... -R/open_tutorial_and_template.R#L89 ... -R/open_tutorial_and_template.R#L90 # Check user input and take approp ... -R/open_tutorial_and_template.R#L91 if (choice == "1") { ... -R/open_tutorial_and_template.R#L94 } else if (choice == "2") { ... -R/open_tutorial_and_template.R#L96 "User chose not to install 'rs ... -R/open_tutorial_and_template.R#L97 call. = FALSE ... -R/open_tutorial_and_template.R#L99 } else if (choice == "3") { ... -R/open_tutorial_and_template.R#L101 "Please install 'rstudioapi' m ... -R/open_tutorial_and_template.R#L102 call. = FALSE) ... -R/open_tutorial_and_template.R#L103 } else { ... -R/open_tutorial_and_template.R#L105 } ... -R/open_tutorial_and_template.R#L107 } ... -R/open_tutorial_and_template.R#L108 ... -R/open_tutorial_and_template.R#L109 file <- system.file( ... -R/open_tutorial_and_template.R#L113 ) ... -R/open_tutorial_and_template.R#L114 if (file != "") { ... -R/open_tutorial_and_template.R#L116 rstudioapi::navigateToFile(file) ... -R/open_tutorial_and_template.R#L118 stop("RStudio API not available. C ... -R/open_tutorial_and_template.R#L120 } else { ... -R/open_tutorial_and_template.R#L122 } ... -R/preprocess_rna_seq_data.R#L47 ... -R/preprocess_rna_seq_data.R#L48 message("Preprocessing RNA-seq data (n ... -R/preprocess_rna_seq_data.R#L49 ... -R/preprocess_rna_seq_data.R#L50 # Check if edgeR is installed; if not, ... -R/preprocess_rna_seq_data.R#L51 if (!requireNamespace("edgeR", quietly ... -R/preprocess_rna_seq_data.R#L56 user_input <- readline( ... -R/preprocess_rna_seq_data.R#L58 "What would you like to do?\n ... -R/preprocess_rna_seq_data.R#L63 ) ... -R/preprocess_rna_seq_data.R#L64 ... -R/preprocess_rna_seq_data.R#L65 if (user_input == "1") { ... -R/preprocess_rna_seq_data.R#L70 utils::install.packages("BiocM ... -R/preprocess_rna_seq_data.R#L73 { ... -R/preprocess_rna_seq_data.R#L75 }, ... -R/preprocess_rna_seq_data.R#L76 error = function(e) { ... -R/preprocess_rna_seq_data.R#L78 "Automatic installation of ... -R/preprocess_rna_seq_data.R#L80 call. = FALSE ... -R/preprocess_rna_seq_data.R#L82 } ... -R/preprocess_rna_seq_data.R#L85 } else if (user_input == "2") { ... -R/preprocess_rna_seq_data.R#L87 "Please install 'edgeR' manual ... -R/preprocess_rna_seq_data.R#L88 BiocManager::install('edgeR') a ... -R/preprocess_rna_seq_data.R#L89 call. = FALSE ... -R/preprocess_rna_seq_data.R#L91 } else if (user_input == "3") { ... -R/preprocess_rna_seq_data.R#L93 } else { ... -R/preprocess_rna_seq_data.R#L95 } ... -R/preprocess_rna_seq_data.R#L97 } ... -R/preprocess_rna_seq_data.R#L98 ... -R/preprocess_rna_seq_data.R#L99 design_matrix <- design2design_matrix( ... -R/preprocess_rna_seq_data.R#L104 ) ... -R/preprocess_rna_seq_data.R#L105 ... -R/preprocess_rna_seq_data.R#L106 # Step 1: Create DGEList object from r ... -R/preprocess_rna_seq_data.R#L107 y <- edgeR::DGEList(counts = raw_count ... -R/preprocess_rna_seq_data.R#L108 ... -R/preprocess_rna_seq_data.R#L109 # Step 2: Apply the normalization func ... -R/preprocess_rna_seq_data.R#L110 if (!is.null(normalize_func) && is.fun ... -R/preprocess_rna_seq_data.R#L112 } else { ... -R/preprocess_rna_seq_data.R#L115 } ... -R/preprocess_rna_seq_data.R#L116 ... -R/preprocess_rna_seq_data.R#L117 # Step 3: Apply voom transformation to ... -R/preprocess_rna_seq_data.R#L118 voom_obj <- limma::voom( ... -R/preprocess_rna_seq_data.R#L121 ) ... -R/preprocess_rna_seq_data.R#L122 ... -R/preprocess_rna_seq_data.R#L123 return(voom_obj) ... -R/run_gsea.R#L40 report_dir <- normalizePath( ... -R/run_gsea.R#L43 ) ... -R/run_gsea.R#L45 # Check report_info and report_dir ... -R/run_gsea.R#L46 args <- lapply( ... -R/run_gsea.R#L48 match.call()[-1]), ... -R/run_gsea.R#L53 input_control <- InputControl$new(args ... -R/run_gsea.R#L54 input_control$auto_validate() ... -R/run_gsea.R#L56 # Remove levels that ... -R/run_gsea.R#L57 levels_clustered_hits <- levels_cluste ... -R/run_gsea.R#L59 levels_clustered_hits, ... -R/run_gsea.R#L60 is.character ... -R/run_gsea.R#L61 ) ... -R/run_gsea.R#L64 # Control the test not covered by the ... -R/run_gsea.R#L65 control_inputs_create_gsea_report( ... -R/run_gsea.R#L73 ensure_clusterProfiler() # Deals with ... -R/run_gsea.R#L75 all_results <- map2( ... -R/run_gsea.R#L79 .x, ... -R/run_gsea.R#L80 .y, ... -R/run_gsea.R#L81 databases, ... -R/run_gsea.R#L82 clusterProfiler_params, ... -R/run_gsea.R#L83 universe ... -R/run_gsea.R#L84 ) ... -R/run_gsea.R#L85 ) ... -R/run_gsea.R#L87 names(all_results) <- names(levels_clu ... -R/run_gsea.R#L89 processed_results <- map2( ... -R/run_gsea.R#L93 ) ... -R/run_gsea.R#L95 # Extract the plots, plot sizes, and h ... -R/run_gsea.R#L96 plots <- purrr::flatten(map(processed_ ... -R/run_gsea.R#L97 plots_sizes <- unlist(map(processed_re ... -R/run_gsea.R#L98 ... -R/run_gsea.R#L99 insert_after_each <- function(lst, val ... -R/run_gsea.R#L104 } ... -R/run_gsea.R#L105 ... -R/run_gsea.R#L106 plots <- insert_after_each(plots, "sec ... -R/run_gsea.R#L107 plots_sizes <- insert_after_each(plots ... -R/run_gsea.R#L109 level_headers_info <- map(processed_re ... -R/run_gsea.R#L111 names(level_headers_info) <- names(all ... -R/run_gsea.R#L114 report_info$databases <- unique(databa ... -R/run_gsea.R#L116 generate_report_html( ... -R/run_gsea.R#L126 print_info_message( ... -R/run_gsea.R#L129 ) ... -R/run_gsea.R#L131 return(Filter(function(x) !is.characte ... -R/run_gsea.R#L161 check_clustered_hits(levels_clustered_ ... -R/run_gsea.R#L163 check_databases(databases) ... -R/run_gsea.R#L165 check_params(params) ... -R/run_gsea.R#L168 if (!is.na(plot_titles)) { ... -R/run_gsea.R#L172 stop(paste("plot_titles must be a ... -R/run_gsea.R#L173 "length levels_clustere ... -R/run_gsea.R#L175 } ... -R/run_gsea.R#L178 if (!is.null(background)) { ... -R/run_gsea.R#L180 stop("background must be a charact ... -R/run_gsea.R#L182 check_genes(background) ... -R/run_gsea.R#L184 } ... -R/run_gsea.R#L198 # Check if clusterProfiler is installe ... -R/run_gsea.R#L199 if (!requireNamespace("clusterProfiler ... -R/run_gsea.R#L204 user_input <- readline( ... -R/run_gsea.R#L206 "What would you like to do?\n" ... -R/run_gsea.R#L207 "1: Automatically install clus ... -R/run_gsea.R#L208 "2: Manually install clusterPr ... -R/run_gsea.R#L209 "3: Cancel\n", ... -R/run_gsea.R#L210 "Please enter 1, 2, or 3: " ... -R/run_gsea.R#L212 ) ... -R/run_gsea.R#L214 if (user_input == "1") { ... -R/run_gsea.R#L217 "Attempting to install 'cluste ... -R/run_gsea.R#L218 from Bioconductor..." ... -R/run_gsea.R#L219 ) ... -R/run_gsea.R#L222 utils::install.packages("BiocM ... -R/run_gsea.R#L226 { ... -R/run_gsea.R#L228 }, ... -R/run_gsea.R#L229 error = function(e) { ... -R/run_gsea.R#L231 "Automatic installation of ... -R/run_gsea.R#L232 Please install it manually ... -R/run_gsea.R#L233 call. = FALSE ... -R/run_gsea.R#L234 ) ... -R/run_gsea.R#L235 } ... -R/run_gsea.R#L238 } else if (user_input == "2") { ... -R/run_gsea.R#L240 "Please install 'clusterProfil ... -R/run_gsea.R#L241 using BiocManager::install('cl ... -R/run_gsea.R#L242 then re-run the function.", ... -R/run_gsea.R#L243 call. = FALSE ... -R/run_gsea.R#L244 ) ... -R/run_gsea.R#L245 } else if (user_input == "3") { ... -R/run_gsea.R#L247 } else { ... -R/run_gsea.R#L249 } ... -R/run_gsea.R#L251 } ... -R/run_gsea.R#L283 clustered_hits <- na.omit(clustered_hi ... -R/run_gsea.R#L285 message(paste( ... -R/run_gsea.R#L290 result <- create_gsea_report_level( ... -R/run_gsea.R#L324 result <- list() ... -R/run_gsea.R#L326 if (any(is.na(level_result))) { ... +R/open_tutorial_and_template.R#L18 if (!requireNamespace("rstudioapi", qu ... +R/open_tutorial_and_template.R#L20 "The 'rstudioapi' package is not i ... +R/open_tutorial_and_template.R#L21 "Please install it manually with: ... +R/open_tutorial_and_template.R#L23 } ... +R/open_tutorial_and_template.R#L25 # Find the tutorial file ... +R/open_tutorial_and_template.R#L26 file <- system.file("tutorial", "tutor ... +R/open_tutorial_and_template.R#L28 if (file != "") { ... +R/open_tutorial_and_template.R#L30 rstudioapi::navigateToFile(file) ... +R/open_tutorial_and_template.R#L32 stop_call_false("RStudio API not a ... +R/open_tutorial_and_template.R#L34 } else { ... +R/open_tutorial_and_template.R#L36 } ... +R/open_tutorial_and_template.R#L57 # Check if rstudioapi is installed ... +R/open_tutorial_and_template.R#L58 if (!requireNamespace("rstudioapi", qu ... +R/open_tutorial_and_template.R#L60 "The 'rstudioapi' package is not i ... +R/open_tutorial_and_template.R#L61 "Please install it manually with: ... +R/open_tutorial_and_template.R#L62 call. = FALSE ... +R/open_tutorial_and_template.R#L64 } ... +R/open_tutorial_and_template.R#L66 # Find the template file ... +R/open_tutorial_and_template.R#L67 file <- system.file("template", "templ ... +R/open_tutorial_and_template.R#L69 if (file != "") { ... +R/open_tutorial_and_template.R#L71 rstudioapi::navigateToFile(file) ... +R/open_tutorial_and_template.R#L73 stop("RStudio API not available. C ... +R/open_tutorial_and_template.R#L75 } else { ... +R/open_tutorial_and_template.R#L77 } ... +R/preprocess_rna_seq_data.R#L46 message("Preprocessing RNA-seq data (n ... +R/preprocess_rna_seq_data.R#L48 # Check if edgeR is installed; if not, ... +R/preprocess_rna_seq_data.R#L49 if (!requireNamespace("edgeR", quietly ... +R/preprocess_rna_seq_data.R#L54 user_input <- readline( ... +R/preprocess_rna_seq_data.R#L56 "What would you like to do?\n ... +R/preprocess_rna_seq_data.R#L61 ) ... +R/preprocess_rna_seq_data.R#L63 if (user_input == "1") { ... +R/preprocess_rna_seq_data.R#L68 utils::install.packages("BiocM ... +R/preprocess_rna_seq_data.R#L71 { ... +R/preprocess_rna_seq_data.R#L73 }, ... +R/preprocess_rna_seq_data.R#L74 error = function(e) { ... +R/preprocess_rna_seq_data.R#L76 "Automatic installation of ... +R/preprocess_rna_seq_data.R#L78 call. = FALSE ... +R/preprocess_rna_seq_data.R#L80 } ... +R/preprocess_rna_seq_data.R#L83 } else if (user_input == "2") { ... +R/preprocess_rna_seq_data.R#L85 "Please install 'edgeR' manual ... +R/preprocess_rna_seq_data.R#L86 BiocManager::install('edgeR') a ... +R/preprocess_rna_seq_data.R#L87 call. = FALSE ... +R/preprocess_rna_seq_data.R#L89 } else if (user_input == "3") { ... +R/preprocess_rna_seq_data.R#L91 } else { ... +R/preprocess_rna_seq_data.R#L93 } ... +R/preprocess_rna_seq_data.R#L95 } ... +R/preprocess_rna_seq_data.R#L97 design_matrix <- design2design_matrix( ... +R/preprocess_rna_seq_data.R#L102 ) ... +R/preprocess_rna_seq_data.R#L104 # Step 1: Create DGEList object from r ... +R/preprocess_rna_seq_data.R#L105 y <- edgeR::DGEList(counts = raw_count ... +R/preprocess_rna_seq_data.R#L107 # Step 2: Apply the normalization func ... +R/preprocess_rna_seq_data.R#L108 if (!is.null(normalize_func) && is.fun ... +R/preprocess_rna_seq_data.R#L110 } else { ... +R/preprocess_rna_seq_data.R#L113 } ... +R/preprocess_rna_seq_data.R#L115 # Step 3: Apply voom transformation to ... +R/preprocess_rna_seq_data.R#L116 voom_obj <- limma::voom( ... +R/preprocess_rna_seq_data.R#L119 ) ... +R/preprocess_rna_seq_data.R#L121 return(voom_obj) ... +R/run_gsea.R#L38 report_dir <- normalizePath( ... +R/run_gsea.R#L41 ) ... +R/run_gsea.R#L43 # Check report_info and report_dir ... +R/run_gsea.R#L44 args <- lapply( ... +R/run_gsea.R#L46 match.call()[-1] ... +R/run_gsea.R#L50 ) ... +R/run_gsea.R#L52 input_control <- InputControl$new(args ... +R/run_gsea.R#L53 input_control$auto_validate() ... +R/run_gsea.R#L55 levels_clustered_hits <- levels_cluste ... +R/run_gsea.R#L57 levels_clustered_hits, ... +R/run_gsea.R#L58 is.character, ... +R/run_gsea.R#L59 logical(1) ... +R/run_gsea.R#L61 ] ... +R/run_gsea.R#L63 # Control the test not covered by the ... +R/run_gsea.R#L64 control_inputs_create_gsea_report( ... +R/run_gsea.R#L70 ) ... +R/run_gsea.R#L72 ensure_clusterProfiler() # Deals with ... +R/run_gsea.R#L74 all_results <- map2( ... +R/run_gsea.R#L78 .x, ... +R/run_gsea.R#L79 .y, ... +R/run_gsea.R#L80 databases, ... +R/run_gsea.R#L81 clusterProfiler_params, ... +R/run_gsea.R#L82 universe ... +R/run_gsea.R#L84 ) ... +R/run_gsea.R#L86 names(all_results) <- names(levels_clu ... +R/run_gsea.R#L88 processed_results <- map2( ... +R/run_gsea.R#L92 ) ... +R/run_gsea.R#L94 # Extract the plots, plot sizes, and h ... +R/run_gsea.R#L95 plots <- purrr::flatten(map(processed_ ... +R/run_gsea.R#L96 plots_sizes <- unlist(map(processed_re ... +R/run_gsea.R#L98 insert_after_each <- function(lst, val ... +R/run_gsea.R#L103 } ... +R/run_gsea.R#L105 plots <- insert_after_each(plots, "sec ... +R/run_gsea.R#L106 plots_sizes <- insert_after_each(plots ... +R/run_gsea.R#L108 level_headers_info <- map(processed_re ... +R/run_gsea.R#L110 names(level_headers_info) <- names(all ... +R/run_gsea.R#L113 report_info$databases <- unique(databa ... +R/run_gsea.R#L115 generate_report_html( ... +R/run_gsea.R#L123 ) ... +R/run_gsea.R#L125 print_info_message( ... +R/run_gsea.R#L128 ) ... +R/run_gsea.R#L130 return(Filter(function(x) !is.characte ... +R/run_gsea.R#L158 check_clustered_hits(levels_clustered_ ... +R/run_gsea.R#L160 check_databases(databases) ... +R/run_gsea.R#L162 check_params(params) ... +R/run_gsea.R#L165 if (!is.na(plot_titles)) { ... +R/run_gsea.R#L167 length(plot_titles) != length(leve ... +R/run_gsea.R#L168 stop(paste( ... +R/run_gsea.R#L171 ), call. = FALSE) ... +R/run_gsea.R#L173 } ... +R/run_gsea.R#L176 if (!is.null(background)) { ... +R/run_gsea.R#L178 stop("background must be a charact ... +R/run_gsea.R#L180 check_genes(background) ... +R/run_gsea.R#L182 } ... +R/run_gsea.R#L195 # Check if clusterProfiler is installe ... +R/run_gsea.R#L196 if (!requireNamespace("clusterProfiler ... +R/run_gsea.R#L201 user_input <- readline( ... +R/run_gsea.R#L203 "What would you like to do?\n" ... +R/run_gsea.R#L204 "1: Automatically install clus ... +R/run_gsea.R#L205 "2: Manually install clusterPr ... +R/run_gsea.R#L206 "3: Cancel\n", ... +R/run_gsea.R#L207 "Please enter 1, 2, or 3: " ... +R/run_gsea.R#L209 ) ... +R/run_gsea.R#L211 if (user_input == "1") { ... +R/run_gsea.R#L214 "Attempting to install 'cluste ... +R/run_gsea.R#L215 from Bioconductor..." ... +R/run_gsea.R#L219 utils::install.packages("BiocM ... +R/run_gsea.R#L223 { ... +R/run_gsea.R#L225 }, ... +R/run_gsea.R#L226 error = function(e) { ... +R/run_gsea.R#L228 "Automatic installation of ... +R/run_gsea.R#L229 Please install it manually ... +R/run_gsea.R#L230 call. = FALSE ... +R/run_gsea.R#L232 } ... +R/run_gsea.R#L235 } else if (user_input == "2") { ... +R/run_gsea.R#L237 "Please install 'clusterProfil ... +R/run_gsea.R#L238 using BiocManager::install('cl ... +R/run_gsea.R#L239 then re-run the function.", ... +R/run_gsea.R#L240 call. = FALSE ... +R/run_gsea.R#L242 } else if (user_input == "3") { ... +R/run_gsea.R#L244 } else { ... +R/run_gsea.R#L246 } ... +R/run_gsea.R#L248 } ... +R/run_gsea.R#L278 clustered_hits <- na.omit(clustered_hi ... +R/run_gsea.R#L280 message(paste( ... +R/run_gsea.R#L283 )) ... +R/run_gsea.R#L285 result <- create_gsea_report_level( ... +R/run_gsea.R#L291 ) ... +R/run_gsea.R#L317 result <- list() ... +R/run_gsea.R#L319 if (any(is.na(level_result))) { ... +R/run_gsea.R#L323 header_name = level_name, ... +R/run_gsea.R#L324 full_enrich_results = NA ... +R/run_gsea.R#L326 } else { ... R/run_gsea.R#L330 header_name = level_name, ... -R/run_gsea.R#L331 full_enrich_results = NA ... -R/run_gsea.R#L333 } else { ... -R/run_gsea.R#L337 header_name = level_name, ... -R/run_gsea.R#L338 full_enrich_results = level_result ... -R/run_gsea.R#L339 raw_enrich_results = level_result$ ... -R/run_gsea.R#L341 } ... -R/run_gsea.R#L343 return(result) ... -R/run_gsea.R#L385 html_content <- paste( ... -R/run_gsea.R#L391 toc <- create_toc() ... -R/run_gsea.R#L393 styles <- define_html_styles() ... -R/run_gsea.R#L394 section_header_style <- styles$section ... -R/run_gsea.R#L395 toc_style <- styles$toc_style ... -R/run_gsea.R#L397 current_header_index <- 1 ... -R/run_gsea.R#L398 level_headers_info <- Filter( ... -R/run_gsea.R#L403 pb <- create_progress_bar(plots) ... -R/run_gsea.R#L404 # Generate the sections and plots ... -R/run_gsea.R#L405 for (index in seq_along(plots)) { ... -R/run_gsea.R#L410 section_info <- level_headers_info ... -R/run_gsea.R#L412 section_content <- generate_sectio ... -R/run_gsea.R#L419 ) ... -R/run_gsea.R#L421 html_content <- section_content$ht ... -R/run_gsea.R#L422 # toc <- section_content$toc ... -R/run_gsea.R#L424 current_header_index <- current_he ... -R/run_gsea.R#L426 pb$tick() ... -R/run_gsea.R#L427 next ... -R/run_gsea.R#L433 "

    %s< ... -R/run_gsea.R#L434 section_header_style, ... -R/run_gsea.R#L435 index, ... -R/run_gsea.R#L436 section_info$header_name ... -R/run_gsea.R#L442 horizontal_line <- "
    " ... -R/run_gsea.R#L447 html_content, ... -R/run_gsea.R#L448 horizontal_line, ... -R/run_gsea.R#L449 section_header, ... -R/run_gsea.R#L450 sep = "\n" ... -R/run_gsea.R#L454 "
  • %s< ... +R/run_gsea.R#L423 section_header_style, ... +R/run_gsea.R#L424 index, ... +R/run_gsea.R#L425 section_info$header_name ... +R/run_gsea.R#L431 horizontal_line <- "
    " ... +R/run_gsea.R#L436 html_content, ... +R/run_gsea.R#L437 horizontal_line, ... +R/run_gsea.R#L438 section_header, ... +R/run_gsea.R#L439 sep = "\n" ... +R/run_gsea.R#L443 "
  • 0) { ... -R/run_gsea.R#L665 paste( ... -R/run_gsea.R#L670 ) ... -R/run_gsea.R#L672 } ... -R/run_gsea.R#L674 valid_adj_p_value_methods <- stats::p. ... -R/run_gsea.R#L676 # Check for required elements and thei ... -R/run_gsea.R#L677 for (param in names(params)) { ... -R/run_gsea.R#L681 actual_value <- params[[param]] ... -R/run_gsea.R#L682 expected_type <- required_params[[ ... -R/run_gsea.R#L683 actual_type <- class(params[[param ... -R/run_gsea.R#L685 if (is.null(actual_value)) { ... -R/run_gsea.R#L687 } ... -R/run_gsea.R#L689 if (expected_type == "integer" && ... -R/run_gsea.R#L695 actual_type <- "integer" ... -R/run_gsea.R#L697 } ... -R/run_gsea.R#L698 if (expected_type != actual_type) ... -R/run_gsea.R#L701 expected_type, ".", call. = ... -R/run_gsea.R#L702 } ... -R/run_gsea.R#L704 stop( ... -R/run_gsea.R#L713 if (!(actual_value %in% valid_adj_ ... -R/run_gsea.R#L715 valid_adj_p_value_met ... -R/run_gsea.R#L716 call. = FALSE) ... -R/run_gsea.R#L718 } ... -R/run_gsea.R#L721 } ... -R/run_gsea.R#L757 set_default_params(params) ... -R/run_gsea.R#L759 all_term2genes <- dbs_to_term2genes(da ... -R/run_gsea.R#L762 ## Prepare objects ... -R/run_gsea.R#L763 unique_clusters <- sort(unique(cluster ... -R/run_gsea.R#L765 all_db_results <- vector("list", lengt ... -R/run_gsea.R#L767 for (i in seq_along(all_db_results)) { ... -R/run_gsea.R#L769 } ... -R/run_gsea.R#L771 raw_results <- list() ... -R/run_gsea.R#L773 for (cluster in unique_clusters) { ... -R/run_gsea.R#L777 column_name <- paste("Cluster", cl ... -R/run_gsea.R#L778 count_column_name <- paste0(column ... -R/run_gsea.R#L780 # Initialize the column as an empt ... -R/run_gsea.R#L781 if (nrow(all_db_results[[i]]) == 0 ... -R/run_gsea.R#L784 vector("logical", length = 0) ... -R/run_gsea.R#L785 } else { ... -R/run_gsea.R#L788 } ... -R/run_gsea.R#L802 term2gene <- all_term2genes[[datab ... -R/run_gsea.R#L804 message(paste( ... -R/run_gsea.R#L809 enrichment <- ... -R/run_gsea.R#L811 gene = gene_list, ... -R/run_gsea.R#L812 pvalueCutoff = params$pvalueC ... -R/run_gsea.R#L813 pAdjustMethod = params$pAdjust ... -R/run_gsea.R#L814 universe = universe, ... -R/run_gsea.R#L815 minGSSize = params$minGSSi ... -R/run_gsea.R#L816 maxGSSize = params$maxGSSi ... -R/run_gsea.R#L817 qvalueCutoff = params$qvalueC ... -R/run_gsea.R#L818 gson = NULL, ... -R/run_gsea.R#L819 TERM2GENE = term2gene, ... -R/run_gsea.R#L820 TERM2NAME = NA ... -R/run_gsea.R#L821 ) ... -R/run_gsea.R#L823 enrichment <- as.data.frame(enrich ... -R/run_gsea.R#L825 if (is.null(enrichment) || (nrow(e ... -R/run_gsea.R#L826 ncol(e ... -R/run_gsea.R#L828 } ... -R/run_gsea.R#L830 at_least_one_result = TRUE ... -R/run_gsea.R#L832 enrichment_results[[length(enrichm ... -R/run_gsea.R#L834 # Store all for returning in the e ... -R/run_gsea.R#L835 name <- sprintf( ... -R/run_gsea.R#L841 raw_results[[name]] <- enrichment ... -R/run_gsea.R#L845 use_background = TRUE ... -R/run_gsea.R#L847 use_background = FALSE ... -R/run_gsea.R#L851 all_db_results <- process_enrichme ... -R/run_gsea.R#L858 ) ... -R/run_gsea.R#L860 print(paste0("No enrichment result ... -R/run_gsea.R#L862 } ... -R/run_gsea.R#L864 # Make dotplot ... -R/run_gsea.R#L865 any_result <- sapply(all_db_results, f ... -R/run_gsea.R#L866 has_true <- any(any_result) ... -R/run_gsea.R#L868 if (has_true) { ... -R/run_gsea.R#L870 all_db_results, ... -R/run_gsea.R#L871 names(all_term2genes), ... -R/run_gsea.R#L872 plot_title ... -R/run_gsea.R#L873 ) ... -R/run_gsea.R#L874 } else { ... -R/run_gsea.R#L877 } ... -R/run_gsea.R#L879 list( ... -R/run_gsea.R#L911 if (any(is.na(section_info$full_enrich ... -R/run_gsea.R#L914 "

    Download count2small_results.x ... -R/run_gsea.R#L969 section_info$raw_enrich_results, ... -R/run_gsea.R#L970 "create_gsea_report" ... -R/run_gsea.R#L972 ) ... -R/run_gsea.R#L974 html_content <- paste( ... -R/run_gsea.R#L981 ) ... -R/run_gsea.R#L983 list( ... -R/run_gsea.R#L985 ) ... -R/run_gsea.R#L1008 default_params <- list( ... -R/run_gsea.R#L1014 ) ... -R/run_gsea.R#L1016 if (any(is.na(params))) { ... -R/run_gsea.R#L1018 } else { ... -R/run_gsea.R#L1022 params[[param]] <- default_params[ ... -R/run_gsea.R#L1024 } ... -R/run_gsea.R#L1026 return(params) ... -R/run_gsea.R#L1050 db_split <- split(databases, databases ... -R/run_gsea.R#L1052 # Transform into long format ... -R/run_gsea.R#L1053 all_term2genes <- lapply(db_split, fun ... -R/run_gsea.R#L1058 }) ... -R/run_gsea.R#L1060 names(all_term2genes) <- names(db_spli ... -R/run_gsea.R#L1062 return(all_term2genes) ... -R/run_gsea.R#L1090 column_indices <- list(2, 6, 3, 4, 9) ... -R/run_gsea.R#L1092 # Process results for all databases. ... -R/run_gsea.R#L1093 for (i in seq_along(enrichment_results ... -R/run_gsea.R#L1098 next ... -R/run_gsea.R#L1116 # Create a sublist for each term w ... -R/run_gsea.R#L1118 # Skip terms that are just support ... -R/run_gsea.R#L1119 if (gene_count_list[j] < 2) { ... -R/run_gsea.R#L1121 } ... -R/run_gsea.R#L1123 sublist <- list(adjP_list[j], odds ... -R/run_gsea.R#L1125 # Assign this sublist to named_lis ... -R/run_gsea.R#L1126 term <- as.character(term_list[j]) ... -R/run_gsea.R#L1127 named_list[[term]] <- sublist ... -R/run_gsea.R#L1132 if (!name %in% all_db_results[[i]] ... -R/run_gsea.R#L1138 named_list[[name]][[2]] ... -R/run_gsea.R#L1140 } else { ... -R/run_gsea.R#L1144 named_list[[name]][[2]] ... -R/run_gsea.R#L1145 } ... -R/run_gsea.R#L1147 } ... -R/run_gsea.R#L1148 return(all_db_results) ... -R/run_gsea.R#L1270 results <- prepare_plot_data( ... -R/run_gsea.R#L1273 ) ... -R/run_gsea.R#L1275 top_plot_data <- results$top_plot_data ... -R/run_gsea.R#L1276 full_enrich_results <- results$full_en ... -R/run_gsea.R#L1278 # Calculate plot height based on the n ... -R/run_gsea.R#L1279 height_per_label <- 0.1 ... -R/run_gsea.R#L1280 num_labels <- length(unique(top_plot_d ... -R/run_gsea.R#L1281 plot_height <- num_labels * height_per ... -R/run_gsea.R#L1283 if (plot_height < 0.70) { # to always ... -R/run_gsea.R#L1285 } ... -R/run_gsea.R#L1287 # Ensure term labels are truncated to ... -R/run_gsea.R#L1288 top_plot_data$term <- as.character(top ... -R/run_gsea.R#L1289 top_plot_data$term <- ifelse( ... -R/run_gsea.R#L1293 ) ... -R/run_gsea.R#L1295 p <- ggplot2::ggplot( ... -R/run_gsea.R#L1298 .data$cluster, ... -R/run_gsea.R#L1299 .data$term, ... -R/run_gsea.R#L1300 size = -log10(.data$adj.p_value) ... -R/run_gsea.R#L1302 ) + ... -R/run_gsea.R#L1304 aes(color = .data$odds_ratios), ... -R/run_gsea.R#L1305 na.rm = TRUE ... -R/run_gsea.R#L1308 .data$cluster, ... -R/run_gsea.R#L1309 .data$term ... -R/run_gsea.R#L1313 "odds\nratio", ... -R/run_gsea.R#L1314 low = "blue", ... -R/run_gsea.R#L1315 high = "red", ... -R/run_gsea.R#L1316 labels = function(x) round(x, 2), ... -R/run_gsea.R#L1317 guide = ggplot2::guide_colorbar( ... -R/run_gsea.R#L1321 ) ... -R/run_gsea.R#L1324 max_size = 3, ... -R/run_gsea.R#L1325 limits = c(0, 2), ... -R/run_gsea.R#L1326 breaks = c(0, 1, 2), ... -R/run_gsea.R#L1327 labels = c("0", "1", "2 or higher" ... -R/run_gsea.R#L1328 oob = scales::oob_squish ... -R/run_gsea.R#L1332 panel.grid.major.x = ggplot2::elem ... -R/run_gsea.R#L1333 panel.grid.minor.x = ggplot2::elem ... -R/run_gsea.R#L1334 panel.grid.major.y = ggplot2::elem ... -R/run_gsea.R#L1335 panel.grid.minor.y = ggplot2::elem ... -R/run_gsea.R#L1336 plot.title = ggplot2::element_text ... -R/run_gsea.R#L1337 axis.text.y = ggplot2::element_tex ... -R/run_gsea.R#L1338 axis.text.x = ggplot2::element_tex ... -R/run_gsea.R#L1339 legend.text = ggplot2::element_tex ... -R/run_gsea.R#L1340 legend.title = ggplot2::element_te ... -R/run_gsea.R#L1341 legend.key.height = unit(4, "mm"), ... -R/run_gsea.R#L1342 legend.key.width = unit(3, "mm"), ... -R/run_gsea.R#L1343 legend.spacing = ggplot2::unit(0, ... -R/run_gsea.R#L1344 legend.spacing.y = ggplot2::unit(0 ... -R/run_gsea.R#L1345 plot.margin = ggplot2::unit(c(2, 0 ... -R/run_gsea.R#L1346 legend.position = "right", ... -R/run_gsea.R#L1347 legend.box.margin = ggplot2::margi ... -R/run_gsea.R#L1353 list( ... -R/run_gsea.R#L1357 ) ... -R/run_gsea.R#L1395 plot_data <- ... -R/run_gsea.R#L1402 .data$p_odd, ... -R/run_gsea.R#L1403 c("Cluster_", cluster = "\\d+", "_ ... -R/run_gsea.R#L1404 too_few = "align_start" ... -R/run_gsea.R#L1409 plot_data <- plot_data |> ... -R/run_gsea.R#L1414 dplyr::desc(.data$avg_odds_ratio), ... -R/run_gsea.R#L1415 .data$db, .data$BioProcess ... -R/run_gsea.R#L1416 ) ... -R/run_gsea.R#L1418 # Initialize the cluster counts ... -R/run_gsea.R#L1419 cluster_counts <- ... -R/run_gsea.R#L1421 names(cluster_counts) <- as.character( ... -R/run_gsea.R#L1423 selected_combos <- list() ... -R/run_gsea.R#L1425 min_threshold <- 5 ... -R/run_gsea.R#L1427 # Iterate through combinations ... -R/run_gsea.R#L1428 i <- 1 ... -R/run_gsea.R#L1429 while (i <= nrow(plot_data)) { ... -R/run_gsea.R#L1440 dplyr::filter( ... -R/run_gsea.R#L1444 ) ... -R/run_gsea.R#L1448 table(relevant_rows$cluster[!is.na ... -R/run_gsea.R#L1457 # Temporarily update cluster count ... -R/run_gsea.R#L1458 temp_cluster_counts <- cluster_cou ... -R/run_gsea.R#L1459 temp_cluster_counts[combo_clusters ... -R/run_gsea.R#L1462 # Final check to ensure we don't e ... -R/run_gsea.R#L1463 # threshold. This step might seem ... -R/run_gsea.R#L1464 # could be adjusted for more compl ... -R/run_gsea.R#L1465 if (any(temp_cluster_counts <= min ... -R/run_gsea.R#L1466 temp_cluster_counts > min_ ... -R/run_gsea.R#L1470 } ... -R/run_gsea.R#L1478 break ... -R/run_gsea.R#L1482 } ... -R/run_gsea.R#L1484 # Combine selected combos into a dataf ... -R/run_gsea.R#L1485 top_combos <- do.call( ... -R/run_gsea.R#L1490 # Filter the original data to keep onl ... -R/run_gsea.R#L1491 top_plot_data <- plot_data |> ... -R/run_gsea.R#L1493 top_combos, ... -R/run_gsea.R#L1494 by = c( ... -R/run_gsea.R#L1498 ) ... -R/run_gsea.R#L1500 full_enrich_results <- stats::na.omit( ... -R/run_gsea.R#L1502 top_plot_data <- top_plot_data |> ... -R/run_gsea.R#L1504 .data$db, ... -R/run_gsea.R#L1505 .data$BioProcess, ... -R/run_gsea.R#L1506 col = "term", ... -R/run_gsea.R#L1507 sep = ": " ... -R/run_gsea.R#L1508 ) ... -R/run_gsea.R#L1510 top_plot_data$term <- factor( ... -R/run_gsea.R#L1515 list( ... -R/run_limma_splines.R#L3 ... -R/run_limma_splines.R#L61 check_splineomics_elements( ... -R/run_limma_splines.R#L64 ) ... -R/run_limma_splines.R#L65 ... -R/run_limma_splines.R#L66 args <- lapply( ... -R/run_limma_splines.R#L71 ... -R/run_limma_splines.R#L72 check_null_elements(args) ... -R/run_limma_splines.R#L73 input_control <- InputControl$new(args ... -R/run_limma_splines.R#L74 input_control$auto_validate() ... -R/run_limma_splines.R#L75 ... -R/run_limma_splines.R#L76 data <- splineomics[["data"]] ... -R/run_limma_splines.R#L77 rna_seq_data <- splineomics[["rna_seq_ ... -R/run_limma_splines.R#L78 meta <- splineomics[["meta"]] ... -R/run_limma_splines.R#L79 spline_params <- splineomics[["spline_ ... -R/run_limma_splines.R#L80 padjust_method <- splineomics[["padjus ... -R/run_limma_splines.R#L81 design <- splineomics[["design"]] ... -R/run_limma_splines.R#L82 mode <- splineomics[["mode"]] ... -R/run_limma_splines.R#L83 condition <- splineomics[["condition"] ... -R/run_limma_splines.R#L84 ... -R/run_limma_splines.R#L85 feature_names <- rownames(data) ... -R/run_limma_splines.R#L86 ... -R/run_limma_splines.R#L87 rownames(data) <- NULL # To just hav ... -R/run_limma_splines.R#L89 meta[[condition]] <- factor(meta[[cond ... -R/run_limma_splines.R#L90 levels <- levels(meta[[condition]]) ... -R/run_limma_splines.R#L92 # Get hits for level (within level ana ... -R/run_limma_splines.R#L93 process_level_with_params <- purrr::pa ... -R/run_limma_splines.R#L105 ... -R/run_limma_splines.R#L106 results_list <- purrr::imap( ... -R/run_limma_splines.R#L110 ... -R/run_limma_splines.R#L111 within_level_top_table <- ... -R/run_limma_splines.R#L113 purrr::map(results_list, "top_tabl ... -R/run_limma_splines.R#L114 purrr::map_chr(results_list, "name ... -R/run_limma_splines.R#L115 ) ... -R/run_limma_splines.R#L117 # Factor and Factor:Time comparisons b ... -R/run_limma_splines.R#L118 between_level_condition_only <- list() ... -R/run_limma_splines.R#L119 between_level_condition_time <- list() ... -R/run_limma_splines.R#L120 ... -R/run_limma_splines.R#L121 if (mode == "integrated") { ... -R/run_limma_splines.R#L124 result <- between_level( ... -R/run_limma_splines.R#L135 ... -R/run_limma_splines.R#L136 between_level_condition_only[[ ... -R/run_limma_splines.R#L138 "avrg_diff_" ,lev_combo[1], ... -R/run_limma_splines.R#L139 "_vs_", lev_combo[2] ... -R/run_limma_splines.R#L140 ) ... -R/run_limma_splines.R#L142 ... -R/run_limma_splines.R#L143 between_level_condition_time[[ ... -R/run_limma_splines.R#L145 "time_interaction_" , ... -R/run_limma_splines.R#L146 lev_combo[1], ... -R/run_limma_splines.R#L147 "_vs_", lev_combo[2] ... -R/run_limma_splines.R#L148 ) ... -R/run_limma_splines.R#L151 } else { # mode == "isolated" ... -R/run_limma_splines.R#L153 "mode == 'integrated' necessary fo ... -R/run_limma_splines.R#L154 "comparisons. Returning emtpy list ... -R/run_limma_splines.R#L155 (avrg diff conditions, and interac ... -R/run_limma_splines.R#L156 )) ... -R/run_limma_splines.R#L157 } ... -R/run_limma_splines.R#L158 ... -R/run_limma_splines.R#L159 message("\033[32mInfo\033[0m limma spl ... -R/run_limma_splines.R#L160 ... -R/run_limma_splines.R#L161 limma_splines_result <- list( ... -R/run_limma_splines.R#L162 time_effect = within_level_top_table, ... -R/run_limma_splines.R#L163 avrg_diff_conditions = between_level_ ... -R/run_limma_splines.R#L164 interaction_condition_time = between_ ... -R/run_limma_splines.R#L165 ) ... -R/run_limma_splines.R#L167 splineomics <- update_splineomics( ... -R/run_limma_splines.R#L170 ) ... -R/run_limma_splines.R#L222 ... -R/run_limma_splines.R#L223 samples <- which(meta[[condition]] %in ... -R/run_limma_splines.R#L224 data <- data[, samples] ... -R/run_limma_splines.R#L226 # meta <- subset(meta, meta[[condition ... -R/run_limma_splines.R#L227 meta <- meta[meta[[condition]] %in% co ... -R/run_limma_splines.R#L228 ... -R/run_limma_splines.R#L229 design_matrix <- design2design_matrix( ... -R/run_limma_splines.R#L236 if (!is.null(rna_seq_data)) { ... -R/run_limma_splines.R#L238 } ... -R/run_limma_splines.R#L239 ... -R/run_limma_splines.R#L240 fit <- limma::lmFit( ... -R/run_limma_splines.R#L244 fit <- limma::eBayes(fit) ... -R/run_limma_splines.R#L246 factor_only_contrast_coeff <- paste0( ... -R/run_limma_splines.R#L250 condition_only <- limma::topTable( ... -R/run_limma_splines.R#L256 ... -R/run_limma_splines.R#L257 condition_only_resuls <- list( ... -R/run_limma_splines.R#L261 top_table_condition_only <- process_to ... -R/run_limma_splines.R#L265 ... -R/run_limma_splines.R#L266 ... -R/run_limma_splines.R#L267 num_matching_columns <- sum( ... -R/run_limma_splines.R#L269 "^X\\d+$", ... -R/run_limma_splines.R#L270 colnames(design_matrix) ... -R/run_limma_splines.R#L271 ) ... -R/run_limma_splines.R#L273 ... -R/run_limma_splines.R#L274 factor_time_contrast_coeffs <- paste0( ... -R/run_limma_splines.R#L280 ... -R/run_limma_splines.R#L281 condition_time <- limma::topTable( ... -R/run_limma_splines.R#L287 ... -R/run_limma_splines.R#L288 condition_and_time_results <- list( ... -R/run_limma_splines.R#L292 top_table_condition_and_time <- proces ... -R/run_limma_splines.R#L296 ... -R/run_limma_splines.R#L297 list( ... -R/run_limma_splines.R#L345 ... -R/run_limma_splines.R#L346 if (mode == "isolated") { ... -R/run_limma_splines.R#L350 } else { # mode == "integrated" ... -R/run_limma_splines.R#L354 meta_copy[[condition]], ... -R/run_limma_splines.R#L355 ref = level ... -R/run_limma_splines.R#L356 ) ... -R/run_limma_splines.R#L359 } ... -R/run_limma_splines.R#L360 ... -R/run_limma_splines.R#L361 result <- process_within_level( ... -R/run_limma_splines.R#L371 top_table <- process_top_table( ... -R/run_limma_splines.R#L375 ... -R/run_limma_splines.R#L376 results_name <- paste( ... -R/run_limma_splines.R#L382 list( ... -R/run_limma_splines.R#L415 top_table <- process_within_level_resu ... -R/run_limma_splines.R#L416 fit <- process_within_level_result$fit ... -R/run_limma_splines.R#L418 top_table <- modify_limma_top_table( ... -R/run_limma_splines.R#L423 intercepts <- as.data.frame(stats::coe ... -R/run_limma_splines.R#L424 intercepts_ordered <- intercepts[top_t ... -R/run_limma_splines.R#L425 top_table$intercept <- intercepts_orde ... -R/run_limma_splines.R#L427 top_table ... -R/run_limma_splines.R#L468 design_matrix <- design2design_matrix( ... -R/run_limma_splines.R#L475 if (!is.null(rna_seq_data)) { ... -R/run_limma_splines.R#L477 } ... -R/run_limma_splines.R#L479 fit <- limma::lmFit( ... -R/run_limma_splines.R#L483 fit <- limma::eBayes(fit) ... -R/run_limma_splines.R#L485 num_matching_columns <- sum(grepl( ... -R/run_limma_splines.R#L489 coeffs <- paste0("X", seq_len(num_matc ... -R/run_limma_splines.R#L490 ... -R/run_limma_splines.R#L491 top_table <- limma::topTable( ... -R/run_limma_splines.R#L498 attr(top_table, "adjust.method") <- pa ... -R/run_limma_splines.R#L500 list( ... -R/run_limma_splines.R#L528 ... -R/run_limma_splines.R#L529 is_integer_string <- function(x) { ... -R/run_limma_splines.R#L531 } ... -R/run_limma_splines.R#L532 ... -R/run_limma_splines.R#L533 # Because the row headers of a potenti ... -R/run_limma_splines.R#L534 # converted to ints (written as string ... -R/run_limma_splines.R#L535 # the row headers are still "real" str ... -R/run_limma_splines.R#L536 if (!all(sapply(rownames(top_table), i ... -R/run_limma_splines.R#L538 rownames(top_table), ... -R/run_limma_splines.R#L539 function(id) { ... -R/run_limma_splines.R#L544 } ... -R/run_limma_splines.R#L546 } ... -R/run_limma_splines.R#L547 ... -R/run_limma_splines.R#L548 top_table <- tibble::as_tibble( ... -R/run_limma_splines.R#L552 ... -R/run_limma_splines.R#L553 # feature_nr <- NULL # dummy declarat ... -R/run_limma_splines.R#L555 # Convert feature_nr to integer ... -R/run_limma_splines.R#L556 top_table <- top_table |> ... -R/run_limma_splines.R#L559 ... -R/run_limma_splines.R#L560 # Sort and add feature names based on ... -R/run_limma_splines.R#L561 sorted_feature_names <- feature_names[ ... -R/run_limma_splines.R#L562 top_table <- top_table |> dplyr::mutat ... -R/run_limma_splines.R#L564 return(top_table) ... -R/screen_limma_hyperparams.R#L72 ... -R/screen_limma_hyperparams.R#L73 if (is.null(rna_seq_datas)) { # Set t ... -R/screen_limma_hyperparams.R#L75 } ... -R/screen_limma_hyperparams.R#L77 report_dir <- normalizePath( ... -R/screen_limma_hyperparams.R#L80 ) ... -R/screen_limma_hyperparams.R#L81 ... -R/screen_limma_hyperparams.R#L82 check_splineomics_elements( ... -R/screen_limma_hyperparams.R#L85 ) ... -R/screen_limma_hyperparams.R#L87 args <- lapply(as.list(match.call()[-1 ... -R/screen_limma_hyperparams.R#L88 check_null_elements(args) ... -R/screen_limma_hyperparams.R#L89 input_control <- InputControl$new(args ... -R/screen_limma_hyperparams.R#L90 input_control$auto_validate() ... -R/screen_limma_hyperparams.R#L91 ... -R/screen_limma_hyperparams.R#L92 report_info <- splineomics[["report_in ... -R/screen_limma_hyperparams.R#L93 meta_batch_column <- splineomics[["met ... -R/screen_limma_hyperparams.R#L94 meta_batch2_column <- splineomics[["me ... -R/screen_limma_hyperparams.R#L95 condition <- splineomics[["condition"] ... -R/screen_limma_hyperparams.R#L97 feature_names <- rownames(datas[[1]]) ... -R/screen_limma_hyperparams.R#L99 top_tables_combos <- ... -R/screen_limma_hyperparams.R#L101 datas = datas, ... -R/screen_limma_hyperparams.R#L102 rna_seq_datas = rna_seq_datas, ... -R/screen_limma_hyperparams.R#L103 metas = metas, ... -R/screen_limma_hyperparams.R#L104 designs = designs, ... -R/screen_limma_hyperparams.R#L105 modes = modes, ... -R/screen_limma_hyperparams.R#L106 condition = condition, ... -R/screen_limma_hyperparams.R#L107 spline_test_configs = spline_test_ ... -R/screen_limma_hyperparams.R#L108 feature_names = feature_names, ... -R/screen_limma_hyperparams.R#L109 adj_pthresholds = adj_pthresholds, ... -R/screen_limma_hyperparams.R#L110 padjust_method = padjust_method ... -R/screen_limma_hyperparams.R#L111 ) ... -R/screen_limma_hyperparams.R#L113 combo_pair_plots <- ... -R/screen_limma_hyperparams.R#L115 top_tables_combos = top_tables_com ... -R/screen_limma_hyperparams.R#L116 datas = datas, ... -R/screen_limma_hyperparams.R#L117 metas = metas, ... -R/screen_limma_hyperparams.R#L118 condition = condition, ... -R/screen_limma_hyperparams.R#L119 spline_test_configs = spline_test_ ... -R/screen_limma_hyperparams.R#L120 meta_batch_column = meta_batch_col ... -R/screen_limma_hyperparams.R#L121 meta_batch2_column = meta_batch2_c ... -R/screen_limma_hyperparams.R#L122 time_unit = time_unit ... -R/screen_limma_hyperparams.R#L123 ) ... -R/screen_limma_hyperparams.R#L125 timestamp <- format(Sys.time(), "%d_%m ... -R/screen_limma_hyperparams.R#L126 ... -R/screen_limma_hyperparams.R#L127 report_info$meta_condition <- c(condit ... -R/screen_limma_hyperparams.R#L128 report_info$meta_batch <- paste( ... -R/screen_limma_hyperparams.R#L133 ... -R/screen_limma_hyperparams.R#L134 generate_reports( ... -R/screen_limma_hyperparams.R#L140 ... -R/screen_limma_hyperparams.R#L141 # Generates a HTML which shows the ove ... -R/screen_limma_hyperparams.R#L142 # are explored in the HTML reports gen ... -R/screen_limma_hyperparams.R#L143 generate_reports_meta( ... -R/screen_limma_hyperparams.R#L151 ... -R/screen_limma_hyperparams.R#L152 print_info_message( ... -R/screen_limma_hyperparams.R#L155 ) ... -R/screen_limma_hyperparams.R#L203 combos <- tidyr::expand_grid( ... -R/screen_limma_hyperparams.R#L208 ) |> ... -R/screen_limma_hyperparams.R#L210 "Data_", !!rlang::sym("data_index" ... -R/screen_limma_hyperparams.R#L211 "_Design_", !!rlang::sym("design_i ... -R/screen_limma_hyperparams.R#L212 "_SConfig_", !!rlang::sym("spline_ ... -R/screen_limma_hyperparams.R#L213 "_PThresh_", !!rlang::sym("pthresh ... -R/screen_limma_hyperparams.R#L214 )) ... -R/screen_limma_hyperparams.R#L217 combos, ... -R/screen_limma_hyperparams.R#L218 process_combo, ... -R/screen_limma_hyperparams.R#L219 datas = datas, ... -R/screen_limma_hyperparams.R#L220 rna_seq_datas = rna_seq_datas, ... -R/screen_limma_hyperparams.R#L221 metas = metas, ... -R/screen_limma_hyperparams.R#L222 designs = designs, ... -R/screen_limma_hyperparams.R#L223 modes = modes, ... -R/screen_limma_hyperparams.R#L224 condition = condition, ... -R/screen_limma_hyperparams.R#L225 spline_test_configs = spline_test_ ... -R/screen_limma_hyperparams.R#L226 feature_names = feature_names, ... -R/screen_limma_hyperparams.R#L227 padjust_method = padjust_method ... -R/screen_limma_hyperparams.R#L228 ) |> ... -R/screen_limma_hyperparams.R#L270 names_extracted <- regmatches( ... -R/screen_limma_hyperparams.R#L276 ... -R/screen_limma_hyperparams.R#L277 combos_separated <- lapply(unique(name ... -R/screen_limma_hyperparams.R#L279 }) ... -R/screen_limma_hyperparams.R#L280 ... -R/screen_limma_hyperparams.R#L281 names(combos_separated) <- unique(name ... -R/screen_limma_hyperparams.R#L282 ... -R/screen_limma_hyperparams.R#L283 combos <- names(combos_separated) ... -R/screen_limma_hyperparams.R#L284 combo_pairs <- combn(combos, 2, simpli ... -R/screen_limma_hyperparams.R#L286 print("Generating the plots for all pa ... -R/screen_limma_hyperparams.R#L287 progress_ticks <- length(combo_pairs) ... -R/screen_limma_hyperparams.R#L288 pb <- progress::progress_bar$new( ... -R/screen_limma_hyperparams.R#L292 ... -R/screen_limma_hyperparams.R#L293 pb$tick(0) ... -R/screen_limma_hyperparams.R#L294 ... -R/screen_limma_hyperparams.R#L295 time_unit_label <- paste0("[", time_un ... -R/screen_limma_hyperparams.R#L296 ... -R/screen_limma_hyperparams.R#L297 if (!is.null(meta_batch_column)) { ... -R/screen_limma_hyperparams.R#L301 datas = datas, ... -R/screen_limma_hyperparams.R#L302 metas = metas, ... -R/screen_limma_hyperparams.R#L303 condition = condition, ... -R/screen_limma_hyperparams.R#L304 meta_batch_column = meta_batch_col ... -R/screen_limma_hyperparams.R#L305 meta_batch2_column = meta_batch2_c ... -R/screen_limma_hyperparams.R#L306 ) ... -R/screen_limma_hyperparams.R#L307 } ... -R/screen_limma_hyperparams.R#L308 ... -R/screen_limma_hyperparams.R#L309 ... -R/screen_limma_hyperparams.R#L310 combo_pair_results <- purrr::set_names ... -R/screen_limma_hyperparams.R#L313 combo_pair <- combos_separated[pai ... -R/screen_limma_hyperparams.R#L315 hitcomp <- gen_hitcomp_plots(combo ... -R/screen_limma_hyperparams.R#L316 ... -R/screen_limma_hyperparams.R#L317 composites <- purrr::map(combo_pai ... -R/screen_limma_hyperparams.R#L319 combo, ... -R/screen_limma_hyperparams.R#L320 datas, ... -R/screen_limma_hyperparams.R#L321 metas, ... -R/screen_limma_hyperparams.R#L322 spline_test_configs, ... -R/screen_limma_hyperparams.R#L323 time_unit_label ... -R/screen_limma_hyperparams.R#L324 ) ... -R/screen_limma_hyperparams.R#L325 }) ... -R/screen_limma_hyperparams.R#L326 pb$tick() ... -R/screen_limma_hyperparams.R#L327 list( ... -R/screen_limma_hyperparams.R#L335 pair[1], ... -R/screen_limma_hyperparams.R#L336 "vs", ... -R/screen_limma_hyperparams.R#L337 pair[2], ... -R/screen_limma_hyperparams.R#L338 sep = "_" ... -R/screen_limma_hyperparams.R#L339 ) ... -R/screen_limma_hyperparams.R#L340 ) ... -R/screen_limma_hyperparams.R#L341 ) ... -R/screen_limma_hyperparams.R#L342 return(combo_pair_results) ... -R/screen_limma_hyperparams.R#L367 ... -R/screen_limma_hyperparams.R#L368 print("Building .html reports for all ... -R/screen_limma_hyperparams.R#L369 progress_ticks <- length(combo_pair_pl ... -R/screen_limma_hyperparams.R#L370 pb <- progress::progress_bar$new(total ... -R/screen_limma_hyperparams.R#L371 forma ... -R/screen_limma_hyperparams.R#L372 ... -R/screen_limma_hyperparams.R#L373 result <- purrr::imap(combo_pair_plots ... -R/screen_limma_hyperparams.R#L376 }) ... -R/screen_limma_hyperparams.R#L405 ... -R/screen_limma_hyperparams.R#L406 formatted_spline_configs <- flatten_sp ... -R/screen_limma_hyperparams.R#L407 ... -R/screen_limma_hyperparams.R#L408 # Combine the hyperparameters and thei ... -R/screen_limma_hyperparams.R#L409 hyperparameters <- c( ... -R/screen_limma_hyperparams.R#L414 descriptions <- c( ... -R/screen_limma_hyperparams.R#L419 ... -R/screen_limma_hyperparams.R#L420 table_df <- data.frame( ... -R/screen_limma_hyperparams.R#L425 ... -R/screen_limma_hyperparams.R#L426 filename <- sprintf("hyperparams_scree ... -R/screen_limma_hyperparams.R#L427 file_path <- here::here(report_dir, fi ... -R/screen_limma_hyperparams.R#L428 ... -R/screen_limma_hyperparams.R#L429 custom_css <- " ... -R/screen_limma_hyperparams.R#L432 font-size: 32px; ... -R/screen_limma_hyperparams.R#L433 margin-left: auto; ... -R/screen_limma_hyperparams.R#L434 margin-right: auto; ... -R/screen_limma_hyperparams.R#L437 border: 1px solid #cccccc; ... -R/screen_limma_hyperparams.R#L438 padding: 12px; ... -R/screen_limma_hyperparams.R#L439 text-align: left; ... -R/screen_limma_hyperparams.R#L442 background-color: #f2f2f2; ... -R/screen_limma_hyperparams.R#L447 custom_css <- " ... -R/screen_limma_hyperparams.R#L449 table { ... -R/screen_limma_hyperparams.R#L452 } ... -R/screen_limma_hyperparams.R#L453 th, td { ... +R/run_gsea.R#L647 required_params <- list( ... +R/run_gsea.R#L653 ) ... +R/run_gsea.R#L655 # Check if params is a list ... +R/run_gsea.R#L656 if (!is.list(params)) { ... +R/run_gsea.R#L658 } ... +R/run_gsea.R#L660 # Check for extra elements ... +R/run_gsea.R#L661 extra_params <- setdiff(names(params), ... +R/run_gsea.R#L662 if (length(extra_params) > 0) { ... +R/run_gsea.R#L664 paste( ... +R/run_gsea.R#L669 ) ... +R/run_gsea.R#L671 } ... +R/run_gsea.R#L673 valid_adj_p_value_methods <- stats::p. ... +R/run_gsea.R#L675 # Check for required elements and thei ... +R/run_gsea.R#L676 for (param in names(params)) { ... +R/run_gsea.R#L678 actual_value <- params[[param]] ... +R/run_gsea.R#L679 expected_type <- required_params[[ ... +R/run_gsea.R#L680 actual_type <- class(params[[param ... +R/run_gsea.R#L682 if (is.null(actual_value)) { ... +R/run_gsea.R#L684 } ... +R/run_gsea.R#L686 if (expected_type == "integer" && ... +R/run_gsea.R#L689 all(params[[param]] == as.inte ... +R/run_gsea.R#L690 actual_type <- "integer" ... +R/run_gsea.R#L692 } ... +R/run_gsea.R#L693 if (expected_type != actual_type) ... +R/run_gsea.R#L695 expected_type, ".", ... +R/run_gsea.R#L696 call. = FALSE ... +R/run_gsea.R#L698 } ... +R/run_gsea.R#L700 stop( ... +R/run_gsea.R#L705 ) ... +R/run_gsea.R#L709 if (!(actual_value %in% valid_adj_ ... +R/run_gsea.R#L711 paste("pAdjustMethod must be o ... +R/run_gsea.R#L714 ), ... +R/run_gsea.R#L715 call. = FALSE ... +R/run_gsea.R#L717 } ... +R/run_gsea.R#L719 } ... +R/run_gsea.R#L753 set_default_params(params) ... +R/run_gsea.R#L755 all_term2genes <- dbs_to_term2genes(da ... +R/run_gsea.R#L758 ## Prepare objects ... +R/run_gsea.R#L759 unique_clusters <- sort(unique(cluster ... +R/run_gsea.R#L761 all_db_results <- vector("list", lengt ... +R/run_gsea.R#L763 for (i in seq_along(all_db_results)) { ... +R/run_gsea.R#L765 } ... +R/run_gsea.R#L767 raw_results <- list() ... +R/run_gsea.R#L769 for (cluster in unique_clusters) { ... +R/run_gsea.R#L773 column_name <- paste("Cluster", cl ... +R/run_gsea.R#L774 count_column_name <- paste0(column ... +R/run_gsea.R#L776 # Initialize the column as an empt ... +R/run_gsea.R#L777 if (nrow(all_db_results[[i]]) == 0 ... +R/run_gsea.R#L780 vector("logical", length = 0) ... +R/run_gsea.R#L781 } else { ... +R/run_gsea.R#L784 } ... +R/run_gsea.R#L798 term2gene <- all_term2genes[[datab ... +R/run_gsea.R#L800 message(paste( ... +R/run_gsea.R#L803 )) ... +R/run_gsea.R#L805 enrichment <- ... +R/run_gsea.R#L807 gene = gene_list, ... +R/run_gsea.R#L808 pvalueCutoff = params$pvalueCu ... +R/run_gsea.R#L809 pAdjustMethod = params$pAdjust ... +R/run_gsea.R#L810 universe = universe, ... +R/run_gsea.R#L811 minGSSize = params$minGSSize, ... +R/run_gsea.R#L812 maxGSSize = params$maxGSSize, ... +R/run_gsea.R#L813 qvalueCutoff = params$qvalueCu ... +R/run_gsea.R#L814 gson = NULL, ... +R/run_gsea.R#L815 TERM2GENE = term2gene, ... +R/run_gsea.R#L816 TERM2NAME = NA ... +R/run_gsea.R#L819 enrichment <- as.data.frame(enrich ... +R/run_gsea.R#L821 if (is.null(enrichment) || (nrow(e ... +R/run_gsea.R#L824 } ... +R/run_gsea.R#L826 at_least_one_result <- TRUE ... +R/run_gsea.R#L828 enrichment_results[[length(enrichm ... +R/run_gsea.R#L830 # Store all for returning in the e ... +R/run_gsea.R#L831 name <- sprintf( ... +R/run_gsea.R#L835 ) ... +R/run_gsea.R#L837 raw_results[[name]] <- enrichment ... +R/run_gsea.R#L841 use_background <- TRUE ... +R/run_gsea.R#L843 use_background <- FALSE ... +R/run_gsea.R#L847 all_db_results <- process_enrichme ... +R/run_gsea.R#L854 ) ... +R/run_gsea.R#L856 print(paste0("No enrichment result ... +R/run_gsea.R#L858 } ... +R/run_gsea.R#L860 # Make dotplot ... +R/run_gsea.R#L861 any_result <- vapply( ... +R/run_gsea.R#L865 ) ... +R/run_gsea.R#L867 has_true <- any(any_result) ... +R/run_gsea.R#L869 if (has_true) { ... +R/run_gsea.R#L871 all_db_results, ... +R/run_gsea.R#L872 names(all_term2genes), ... +R/run_gsea.R#L873 plot_title ... +R/run_gsea.R#L875 } else { ... +R/run_gsea.R#L878 } ... +R/run_gsea.R#L880 list( ... +R/run_gsea.R#L885 ) ... +R/run_gsea.R#L910 if (any(is.na(section_info$full_enrich ... +R/run_gsea.R#L912 "

    Download count2small_results.x ... +R/run_gsea.R#L967 section_info$raw_enrich_results, ... +R/run_gsea.R#L968 "create_gsea_report" ... +R/run_gsea.R#L970 ) ... +R/run_gsea.R#L972 html_content <- paste( ... +R/run_gsea.R#L979 ) ... +R/run_gsea.R#L981 list( ... +R/run_gsea.R#L983 ) ... +R/run_gsea.R#L1005 default_params <- list( ... +R/run_gsea.R#L1011 ) ... +R/run_gsea.R#L1013 if (any(is.na(params))) { ... +R/run_gsea.R#L1015 } else { ... +R/run_gsea.R#L1019 params[[param]] <- default_params[ ... +R/run_gsea.R#L1021 } ... +R/run_gsea.R#L1023 return(params) ... +R/run_gsea.R#L1046 db_split <- split(databases, databases ... +R/run_gsea.R#L1048 # Transform into long format ... +R/run_gsea.R#L1049 all_term2genes <- lapply(db_split, fun ... +R/run_gsea.R#L1053 }) ... +R/run_gsea.R#L1055 names(all_term2genes) <- names(db_spli ... +R/run_gsea.R#L1057 return(all_term2genes) ... +R/run_gsea.R#L1083 column_indices <- list(2, 6, 3, 4, 9) ... +R/run_gsea.R#L1085 # Process results for all databases. ... +R/run_gsea.R#L1086 for (i in seq_along(enrichment_results ... +R/run_gsea.R#L1091 next ... +R/run_gsea.R#L1099 odds_ratio, ... +R/run_gsea.R#L1100 function(x) eval(parse(text = x)), ... +R/run_gsea.R#L1101 numeric(1) ... +R/run_gsea.R#L1106 bg_ratio, ... +R/run_gsea.R#L1107 function(x) eval(parse(text = x)), ... +R/run_gsea.R#L1108 numeric(1) ... +R/run_gsea.R#L1119 # Create a sublist for each term w ... +R/run_gsea.R#L1121 # Skip terms that are just support ... +R/run_gsea.R#L1122 if (gene_count_list[j] < 2) { ... +R/run_gsea.R#L1124 } ... +R/run_gsea.R#L1126 sublist <- list(adjP_list[j], odds ... +R/run_gsea.R#L1128 # Assign this sublist to named_lis ... +R/run_gsea.R#L1129 term <- as.character(term_list[j]) ... +R/run_gsea.R#L1130 named_list[[term]] <- sublist ... +R/run_gsea.R#L1134 if (!name %in% all_db_results[[i]] ... +R/run_gsea.R#L1140 named_list[[name]][[2]] ... +R/run_gsea.R#L1141 } else { ... +R/run_gsea.R#L1145 named_list[[name]][[2]] ... +R/run_gsea.R#L1146 } ... +R/run_gsea.R#L1148 } ... +R/run_gsea.R#L1149 return(all_db_results) ... +R/run_gsea.R#L1269 results <- prepare_plot_data( ... +R/run_gsea.R#L1272 ) ... +R/run_gsea.R#L1274 top_plot_data <- results$top_plot_data ... +R/run_gsea.R#L1275 full_enrich_results <- results$full_en ... +R/run_gsea.R#L1277 # Calculate plot height based on the n ... +R/run_gsea.R#L1278 height_per_label <- 0.1 ... +R/run_gsea.R#L1279 num_labels <- length(unique(top_plot_d ... +R/run_gsea.R#L1280 plot_height <- num_labels * height_per ... +R/run_gsea.R#L1282 if (plot_height < 0.70) { # to always ... +R/run_gsea.R#L1284 } ... +R/run_gsea.R#L1286 # Ensure term labels are truncated to ... +R/run_gsea.R#L1287 top_plot_data$term <- as.character(top ... +R/run_gsea.R#L1288 top_plot_data$term <- ifelse( ... +R/run_gsea.R#L1292 ) ... +R/run_gsea.R#L1294 p <- ggplot2::ggplot( ... +R/run_gsea.R#L1297 .data$cluster, ... +R/run_gsea.R#L1298 .data$term, ... +R/run_gsea.R#L1299 size = -log10(.data$adj.p_value) ... +R/run_gsea.R#L1301 ) + ... +R/run_gsea.R#L1303 aes(color = .data$odds_ratios), ... +R/run_gsea.R#L1304 na.rm = TRUE ... +R/run_gsea.R#L1307 .data$cluster, ... +R/run_gsea.R#L1308 .data$term ... +R/run_gsea.R#L1312 "odds\nratio", ... +R/run_gsea.R#L1313 low = "blue", ... +R/run_gsea.R#L1314 high = "red", ... +R/run_gsea.R#L1315 labels = function(x) round(x, 2), ... +R/run_gsea.R#L1316 guide = ggplot2::guide_colorbar( ... +R/run_gsea.R#L1320 ) ... +R/run_gsea.R#L1323 max_size = 3, ... +R/run_gsea.R#L1324 limits = c(0, 2), ... +R/run_gsea.R#L1325 breaks = c(0, 1, 2), ... +R/run_gsea.R#L1326 labels = c("0", "1", "2 or higher" ... +R/run_gsea.R#L1327 oob = scales::oob_squish ... +R/run_gsea.R#L1331 panel.grid.major.x = ggplot2::elem ... +R/run_gsea.R#L1332 panel.grid.minor.x = ggplot2::elem ... +R/run_gsea.R#L1333 panel.grid.major.y = ggplot2::elem ... +R/run_gsea.R#L1334 panel.grid.minor.y = ggplot2::elem ... +R/run_gsea.R#L1335 plot.title = ggplot2::element_text ... +R/run_gsea.R#L1336 axis.text.y = ggplot2::element_tex ... +R/run_gsea.R#L1337 axis.text.x = ggplot2::element_tex ... +R/run_gsea.R#L1338 legend.text = ggplot2::element_tex ... +R/run_gsea.R#L1339 legend.title = ggplot2::element_te ... +R/run_gsea.R#L1340 legend.key.height = unit(4, "mm"), ... +R/run_gsea.R#L1341 legend.key.width = unit(3, "mm"), ... +R/run_gsea.R#L1342 legend.spacing = ggplot2::unit(0, ... +R/run_gsea.R#L1343 legend.spacing.y = ggplot2::unit(0 ... +R/run_gsea.R#L1344 plot.margin = ggplot2::unit(c(2, 0 ... +R/run_gsea.R#L1345 legend.position = "right", ... +R/run_gsea.R#L1346 legend.box.margin = ggplot2::margi ... +R/run_gsea.R#L1352 list( ... +R/run_gsea.R#L1356 ) ... +R/run_gsea.R#L1392 plot_data <- ... +R/run_gsea.R#L1399 .data$p_odd, ... +R/run_gsea.R#L1400 c("Cluster_", cluster = "\\d+", "_ ... +R/run_gsea.R#L1401 too_few = "align_start" ... +R/run_gsea.R#L1406 plot_data <- plot_data |> ... +R/run_gsea.R#L1411 dplyr::desc(.data$avg_odds_ratio), ... +R/run_gsea.R#L1412 .data$db, .data$BioProcess ... +R/run_gsea.R#L1415 # Initialize the cluster counts ... +R/run_gsea.R#L1416 cluster_counts <- ... +R/run_gsea.R#L1418 names(cluster_counts) <- as.character( ... +R/run_gsea.R#L1420 selected_combos <- list() ... +R/run_gsea.R#L1422 min_threshold <- 5 ... +R/run_gsea.R#L1424 # Iterate through combinations ... +R/run_gsea.R#L1425 i <- 1 ... +R/run_gsea.R#L1426 while (i <= nrow(plot_data)) { ... +R/run_gsea.R#L1437 dplyr::filter( ... +R/run_gsea.R#L1441 ) ... +R/run_gsea.R#L1445 table(relevant_rows$cluster[!is.na ... +R/run_gsea.R#L1454 # Temporarily update cluster count ... +R/run_gsea.R#L1455 temp_cluster_counts <- cluster_cou ... +R/run_gsea.R#L1456 temp_cluster_counts[combo_clusters ... +R/run_gsea.R#L1459 # Final check to ensure we don't e ... +R/run_gsea.R#L1460 # threshold. This step might seem ... +R/run_gsea.R#L1461 # could be adjusted for more compl ... +R/run_gsea.R#L1462 if (any(temp_cluster_counts <= min ... +R/run_gsea.R#L1467 } ... +R/run_gsea.R#L1474 length(cluster_counts)) { ... +R/run_gsea.R#L1475 break ... +R/run_gsea.R#L1479 } ... +R/run_gsea.R#L1481 # Combine selected combos into a dataf ... +R/run_gsea.R#L1482 top_combos <- do.call( ... +R/run_gsea.R#L1485 ) ... +R/run_gsea.R#L1487 # Filter the original data to keep onl ... +R/run_gsea.R#L1488 top_plot_data <- plot_data |> ... +R/run_gsea.R#L1490 top_combos, ... +R/run_gsea.R#L1491 by = c( ... +R/run_gsea.R#L1494 ) ... +R/run_gsea.R#L1497 full_enrich_results <- stats::na.omit( ... +R/run_gsea.R#L1499 top_plot_data <- top_plot_data |> ... +R/run_gsea.R#L1501 .data$db, ... +R/run_gsea.R#L1502 .data$BioProcess, ... +R/run_gsea.R#L1503 col = "term", ... +R/run_gsea.R#L1504 sep = ": " ... +R/run_gsea.R#L1507 top_plot_data$term <- factor( ... +R/run_gsea.R#L1510 ) ... +R/run_gsea.R#L1512 list( ... +R/run_gsea.R#L1515 ) ... +R/run_limma_splines.R#L59 check_splineomics_elements( ... +R/run_limma_splines.R#L62 ) ... +R/run_limma_splines.R#L64 args <- lapply( ... +R/run_limma_splines.R#L68 ) ... +R/run_limma_splines.R#L70 check_null_elements(args) ... +R/run_limma_splines.R#L71 input_control <- InputControl$new(args ... +R/run_limma_splines.R#L72 input_control$auto_validate() ... +R/run_limma_splines.R#L74 data <- splineomics[["data"]] ... +R/run_limma_splines.R#L75 rna_seq_data <- splineomics[["rna_seq_ ... +R/run_limma_splines.R#L76 meta <- splineomics[["meta"]] ... +R/run_limma_splines.R#L77 spline_params <- splineomics[["spline_ ... +R/run_limma_splines.R#L78 padjust_method <- splineomics[["padjus ... +R/run_limma_splines.R#L79 design <- splineomics[["design"]] ... +R/run_limma_splines.R#L80 mode <- splineomics[["mode"]] ... +R/run_limma_splines.R#L81 condition <- splineomics[["condition"] ... +R/run_limma_splines.R#L83 feature_names <- rownames(data) ... +R/run_limma_splines.R#L85 rownames(data) <- NULL # To just have ... +R/run_limma_splines.R#L87 meta[[condition]] <- factor(meta[[cond ... +R/run_limma_splines.R#L88 levels <- levels(meta[[condition]]) ... +R/run_limma_splines.R#L90 # Get hits for level (within level ana ... +R/run_limma_splines.R#L91 process_level_with_params <- purrr::pa ... +R/run_limma_splines.R#L102 ) ... +R/run_limma_splines.R#L104 results_list <- purrr::imap( ... +R/run_limma_splines.R#L107 ) ... +R/run_limma_splines.R#L109 within_level_top_table <- ... +R/run_limma_splines.R#L111 purrr::map(results_list, "top_tabl ... +R/run_limma_splines.R#L112 purrr::map_chr(results_list, "name ... +R/run_limma_splines.R#L115 # Factor and Factor:Time comparisons b ... +R/run_limma_splines.R#L116 between_level_condition_only <- list() ... +R/run_limma_splines.R#L117 between_level_condition_time <- list() ... +R/run_limma_splines.R#L119 if (mode == "integrated") { ... +R/run_limma_splines.R#L122 result <- between_level( ... +R/run_limma_splines.R#L132 ) ... +R/run_limma_splines.R#L134 between_level_condition_only[[ ... +R/run_limma_splines.R#L136 "avrg_diff_", lev_combo[1], ... +R/run_limma_splines.R#L137 "_vs_", lev_combo[2] ... +R/run_limma_splines.R#L139 ]] <- result$condition_only ... +R/run_limma_splines.R#L141 between_level_condition_time[[ ... +R/run_limma_splines.R#L143 "time_interaction_", ... +R/run_limma_splines.R#L144 lev_combo[1], ... +R/run_limma_splines.R#L145 "_vs_", lev_combo[2] ... +R/run_limma_splines.R#L147 ]] <- result$condition_time ... +R/run_limma_splines.R#L149 } else { # mode == "isolated" ... +R/run_limma_splines.R#L151 "mode == 'integrated' necessary fo ... +R/run_limma_splines.R#L152 "comparisons. Returning emtpy list ... +R/run_limma_splines.R#L153 (avrg diff conditions, and interac ... +R/run_limma_splines.R#L155 } ... +R/run_limma_splines.R#L157 message("\033[32mInfo\033[0m limma spl ... +R/run_limma_splines.R#L159 limma_splines_result <- list( ... +R/run_limma_splines.R#L163 ) ... +R/run_limma_splines.R#L165 splineomics <- update_splineomics( ... +R/run_limma_splines.R#L168 ) ... +R/run_limma_splines.R#L219 samples <- which(meta[[condition]] %in ... +R/run_limma_splines.R#L220 data <- data[, samples] ... +R/run_limma_splines.R#L222 # meta <- subset(meta, meta[[condition ... +R/run_limma_splines.R#L223 meta <- meta[meta[[condition]] %in% co ... +R/run_limma_splines.R#L225 design_matrix <- design2design_matrix( ... +R/run_limma_splines.R#L230 ) ... +R/run_limma_splines.R#L232 if (!is.null(rna_seq_data)) { ... +R/run_limma_splines.R#L234 } ... +R/run_limma_splines.R#L236 fit <- limma::lmFit( ... +R/run_limma_splines.R#L239 ) ... +R/run_limma_splines.R#L240 fit <- limma::eBayes(fit) ... +R/run_limma_splines.R#L242 factor_only_contrast_coeff <- paste0( ... +R/run_limma_splines.R#L245 ) ... +R/run_limma_splines.R#L247 condition_only <- limma::topTable( ... +R/run_limma_splines.R#L252 ) ... +R/run_limma_splines.R#L254 condition_only_resuls <- list( ... +R/run_limma_splines.R#L257 ) ... +R/run_limma_splines.R#L259 top_table_condition_only <- process_to ... +R/run_limma_splines.R#L262 ) ... +R/run_limma_splines.R#L265 num_matching_columns <- sum( ... +R/run_limma_splines.R#L267 "^X\\d+$", ... +R/run_limma_splines.R#L268 colnames(design_matrix) ... +R/run_limma_splines.R#L270 ) ... +R/run_limma_splines.R#L272 factor_time_contrast_coeffs <- paste0( ... +R/run_limma_splines.R#L277 ) ... +R/run_limma_splines.R#L279 condition_time <- limma::topTable( ... +R/run_limma_splines.R#L284 ) ... +R/run_limma_splines.R#L286 condition_and_time_results <- list( ... +R/run_limma_splines.R#L289 ) ... +R/run_limma_splines.R#L290 top_table_condition_and_time <- proces ... +R/run_limma_splines.R#L293 ) ... +R/run_limma_splines.R#L295 list( ... +R/run_limma_splines.R#L298 ) ... +R/run_limma_splines.R#L342 if (mode == "isolated") { ... +R/run_limma_splines.R#L346 } else { # mode == "integrated" ... +R/run_limma_splines.R#L350 meta_copy[[condition]], ... +R/run_limma_splines.R#L351 ref = level ... +R/run_limma_splines.R#L355 } ... +R/run_limma_splines.R#L357 result <- process_within_level( ... +R/run_limma_splines.R#L365 ) ... +R/run_limma_splines.R#L367 top_table <- process_top_table( ... +R/run_limma_splines.R#L370 ) ... +R/run_limma_splines.R#L372 results_name <- paste( ... +R/run_limma_splines.R#L376 ) ... +R/run_limma_splines.R#L378 list( ... +R/run_limma_splines.R#L381 ) ... +R/run_limma_splines.R#L409 top_table <- process_within_level_resu ... +R/run_limma_splines.R#L410 fit <- process_within_level_result$fit ... +R/run_limma_splines.R#L412 top_table <- modify_limma_top_table( ... +R/run_limma_splines.R#L415 ) ... +R/run_limma_splines.R#L417 intercepts <- as.data.frame(stats::coe ... +R/run_limma_splines.R#L418 intercepts_ordered <- intercepts[top_t ... +R/run_limma_splines.R#L419 top_table$intercept <- intercepts_orde ... +R/run_limma_splines.R#L421 top_table ... +R/run_limma_splines.R#L460 design_matrix <- design2design_matrix( ... +R/run_limma_splines.R#L465 ) ... +R/run_limma_splines.R#L467 if (!is.null(rna_seq_data)) { ... +R/run_limma_splines.R#L469 } ... +R/run_limma_splines.R#L471 fit <- limma::lmFit( ... +R/run_limma_splines.R#L474 ) ... +R/run_limma_splines.R#L475 fit <- limma::eBayes(fit) ... +R/run_limma_splines.R#L477 num_matching_columns <- sum(grepl( ... +R/run_limma_splines.R#L480 )) ... +R/run_limma_splines.R#L481 coeffs <- paste0("X", seq_len(num_matc ... +R/run_limma_splines.R#L483 top_table <- limma::topTable( ... +R/run_limma_splines.R#L488 ) ... +R/run_limma_splines.R#L490 attr(top_table, "adjust.method") <- pa ... +R/run_limma_splines.R#L492 list( ... +R/run_limma_splines.R#L495 ) ... +R/run_limma_splines.R#L519 is_integer_string <- function(x) { ... +R/run_limma_splines.R#L521 } ... +R/run_limma_splines.R#L523 # Because the row headers of a potenti ... +R/run_limma_splines.R#L524 # converted to ints (written as string ... +R/run_limma_splines.R#L525 # the row headers are still "real" str ... +R/run_limma_splines.R#L526 if (!all(vapply( ... +R/run_limma_splines.R#L530 )) ... +R/run_limma_splines.R#L531 ) { ... +R/run_limma_splines.R#L533 rownames(top_table), ... +R/run_limma_splines.R#L534 function(id) { ... +R/run_limma_splines.R#L539 }, ... +R/run_limma_splines.R#L540 character(1) ... +R/run_limma_splines.R#L542 } ... +R/run_limma_splines.R#L544 top_table <- tibble::as_tibble( ... +R/run_limma_splines.R#L547 ) ... +R/run_limma_splines.R#L549 # feature_nr <- NULL # dummy declarat ... +R/run_limma_splines.R#L551 # Convert feature_nr to integer ... +R/run_limma_splines.R#L552 top_table <- top_table |> ... +R/run_limma_splines.R#L556 # Sort and add feature names based on ... +R/run_limma_splines.R#L557 sorted_feature_names <- feature_names[ ... +R/run_limma_splines.R#L558 top_table <- top_table |> dplyr::mutat ... +R/run_limma_splines.R#L560 return(top_table) ... +R/screen_limma_hyperparams.R#L71 if (is.null(rna_seq_datas)) { # Set th ... +R/screen_limma_hyperparams.R#L73 } ... +R/screen_limma_hyperparams.R#L75 report_dir <- normalizePath( ... +R/screen_limma_hyperparams.R#L78 ) ... +R/screen_limma_hyperparams.R#L80 check_splineomics_elements( ... +R/screen_limma_hyperparams.R#L83 ) ... +R/screen_limma_hyperparams.R#L85 args <- lapply(as.list(match.call()[-1 ... +R/screen_limma_hyperparams.R#L86 check_null_elements(args) ... +R/screen_limma_hyperparams.R#L87 input_control <- InputControl$new(args ... +R/screen_limma_hyperparams.R#L88 input_control$auto_validate() ... +R/screen_limma_hyperparams.R#L90 report_info <- splineomics[["report_in ... +R/screen_limma_hyperparams.R#L91 meta_batch_column <- splineomics[["met ... +R/screen_limma_hyperparams.R#L92 meta_batch2_column <- splineomics[["me ... +R/screen_limma_hyperparams.R#L93 condition <- splineomics[["condition"] ... +R/screen_limma_hyperparams.R#L95 feature_names <- rownames(datas[[1]]) ... +R/screen_limma_hyperparams.R#L97 top_tables_combos <- ... +R/screen_limma_hyperparams.R#L99 datas = datas, ... +R/screen_limma_hyperparams.R#L100 rna_seq_datas = rna_seq_datas, ... +R/screen_limma_hyperparams.R#L101 metas = metas, ... +R/screen_limma_hyperparams.R#L102 designs = designs, ... +R/screen_limma_hyperparams.R#L103 modes = modes, ... +R/screen_limma_hyperparams.R#L104 condition = condition, ... +R/screen_limma_hyperparams.R#L105 spline_test_configs = spline_test_ ... +R/screen_limma_hyperparams.R#L106 feature_names = feature_names, ... +R/screen_limma_hyperparams.R#L107 adj_pthresholds = adj_pthresholds, ... +R/screen_limma_hyperparams.R#L108 padjust_method = padjust_method ... +R/screen_limma_hyperparams.R#L111 combo_pair_plots <- ... +R/screen_limma_hyperparams.R#L113 top_tables_combos = top_tables_com ... +R/screen_limma_hyperparams.R#L114 datas = datas, ... +R/screen_limma_hyperparams.R#L115 metas = metas, ... +R/screen_limma_hyperparams.R#L116 condition = condition, ... +R/screen_limma_hyperparams.R#L117 spline_test_configs = spline_test_ ... +R/screen_limma_hyperparams.R#L118 meta_batch_column = meta_batch_col ... +R/screen_limma_hyperparams.R#L119 meta_batch2_column = meta_batch2_c ... +R/screen_limma_hyperparams.R#L120 time_unit = time_unit ... +R/screen_limma_hyperparams.R#L123 timestamp <- format(Sys.time(), "%d_%m ... +R/screen_limma_hyperparams.R#L125 report_info$meta_condition <- c(condit ... +R/screen_limma_hyperparams.R#L126 report_info$meta_batch <- paste( ... +R/screen_limma_hyperparams.R#L130 ) ... +R/screen_limma_hyperparams.R#L132 generate_reports( ... +R/screen_limma_hyperparams.R#L137 ) ... +R/screen_limma_hyperparams.R#L139 # Generates a HTML which shows the ove ... +R/screen_limma_hyperparams.R#L140 # are explored in the HTML reports gen ... +R/screen_limma_hyperparams.R#L141 generate_reports_meta( ... +R/screen_limma_hyperparams.R#L148 ) ... +R/screen_limma_hyperparams.R#L150 print_info_message( ... +R/screen_limma_hyperparams.R#L153 ) ... +R/screen_limma_hyperparams.R#L199 combos <- tidyr::expand_grid( ... +R/screen_limma_hyperparams.R#L204 ) |> ... +R/screen_limma_hyperparams.R#L206 "Data_", !!rlang::sym("data_index" ... +R/screen_limma_hyperparams.R#L207 "_Design_", !!rlang::sym("design_i ... +R/screen_limma_hyperparams.R#L208 "_SConfig_", !!rlang::sym("spline_ ... +R/screen_limma_hyperparams.R#L209 "_PThresh_", !!rlang::sym("pthresh ... +R/screen_limma_hyperparams.R#L212 purrr::pmap( ... +R/screen_limma_hyperparams.R#L224 ) |> ... +R/screen_limma_hyperparams.R#L264 names_extracted <- regmatches( ... +R/screen_limma_hyperparams.R#L267 "Data_\\d+_Design_\\d+", ... +R/screen_limma_hyperparams.R#L268 names(top_tables_combos) ... +R/screen_limma_hyperparams.R#L270 ) ... +R/screen_limma_hyperparams.R#L272 combos_separated <- lapply(unique(name ... +R/screen_limma_hyperparams.R#L274 }) ... +R/screen_limma_hyperparams.R#L276 names(combos_separated) <- unique(name ... +R/screen_limma_hyperparams.R#L278 combos <- names(combos_separated) ... +R/screen_limma_hyperparams.R#L279 combo_pairs <- combn(combos, 2, simpli ... +R/screen_limma_hyperparams.R#L281 message("Generating the plots for all ... +R/screen_limma_hyperparams.R#L282 progress_ticks <- length(combo_pairs) ... +R/screen_limma_hyperparams.R#L283 pb <- progress::progress_bar$new( ... +R/screen_limma_hyperparams.R#L286 ) ... +R/screen_limma_hyperparams.R#L288 pb$tick(0) ... +R/screen_limma_hyperparams.R#L290 time_unit_label <- paste0("[", time_un ... +R/screen_limma_hyperparams.R#L292 if (!is.null(meta_batch_column)) { ... +R/screen_limma_hyperparams.R#L295 datas = datas, ... +R/screen_limma_hyperparams.R#L296 metas = metas, ... +R/screen_limma_hyperparams.R#L297 condition = condition, ... +R/screen_limma_hyperparams.R#L298 meta_batch_column = meta_batch_col ... +R/screen_limma_hyperparams.R#L299 meta_batch2_column = meta_batch2_c ... +R/screen_limma_hyperparams.R#L301 } ... +R/screen_limma_hyperparams.R#L304 combo_pair_results <- purrr::set_names ... +R/screen_limma_hyperparams.R#L306 combo_pair <- combos_separated[pai ... +R/screen_limma_hyperparams.R#L308 hitcomp <- gen_hitcomp_plots(combo ... +R/screen_limma_hyperparams.R#L310 composites <- purrr::map(combo_pai ... +R/screen_limma_hyperparams.R#L312 combo, ... +R/screen_limma_hyperparams.R#L313 datas, ... +R/screen_limma_hyperparams.R#L314 metas, ... +R/screen_limma_hyperparams.R#L315 spline_test_configs, ... +R/screen_limma_hyperparams.R#L316 time_unit_label ... +R/screen_limma_hyperparams.R#L318 }) ... +R/screen_limma_hyperparams.R#L319 pb$tick() ... +R/screen_limma_hyperparams.R#L320 list( ... +R/screen_limma_hyperparams.R#L323 ) ... +R/screen_limma_hyperparams.R#L325 combo_pairs, ... +R/screen_limma_hyperparams.R#L326 function(pair) { ... +R/screen_limma_hyperparams.R#L328 pair[1], ... +R/screen_limma_hyperparams.R#L329 "vs", ... +R/screen_limma_hyperparams.R#L330 pair[2], ... +R/screen_limma_hyperparams.R#L331 sep = "_" ... +R/screen_limma_hyperparams.R#L333 } ... +R/screen_limma_hyperparams.R#L335 ) ... +R/screen_limma_hyperparams.R#L336 return(combo_pair_results) ... +R/screen_limma_hyperparams.R#L360 message( ... +R/screen_limma_hyperparams.R#L362 ) ... +R/screen_limma_hyperparams.R#L363 progress_ticks <- length(combo_pair_pl ... +R/screen_limma_hyperparams.R#L364 pb <- progress::progress_bar$new( ... +R/screen_limma_hyperparams.R#L367 ) ... +R/screen_limma_hyperparams.R#L369 result <- purrr::imap(combo_pair_plots ... +R/screen_limma_hyperparams.R#L372 }) ... +R/screen_limma_hyperparams.R#L400 formatted_spline_configs <- flatten_sp ... +R/screen_limma_hyperparams.R#L402 # Combine the hyperparameters and thei ... +R/screen_limma_hyperparams.R#L403 hyperparameters <- c( ... +R/screen_limma_hyperparams.R#L407 ) ... +R/screen_limma_hyperparams.R#L408 descriptions <- c( ... +R/screen_limma_hyperparams.R#L412 ) ... +R/screen_limma_hyperparams.R#L414 table_df <- data.frame( ... +R/screen_limma_hyperparams.R#L418 ) ... +R/screen_limma_hyperparams.R#L420 filename <- sprintf("hyperparams_scree ... +R/screen_limma_hyperparams.R#L421 file_path <- here::here(report_dir, fi ... +R/screen_limma_hyperparams.R#L423 custom_css <- " ... +R/screen_limma_hyperparams.R#L426 font-size: 32px; ... +R/screen_limma_hyperparams.R#L427 margin-left: auto; ... +R/screen_limma_hyperparams.R#L428 margin-right: auto; ... +R/screen_limma_hyperparams.R#L431 border: 1px solid #cccccc; ... +R/screen_limma_hyperparams.R#L432 padding: 12px; ... +R/screen_limma_hyperparams.R#L433 text-align: left; ... +R/screen_limma_hyperparams.R#L436 background-color: #f2f2f2; ... +R/screen_limma_hyperparams.R#L441 custom_css <- " ... +R/screen_limma_hyperparams.R#L443 table { ... +R/screen_limma_hyperparams.R#L446 } ... +R/screen_limma_hyperparams.R#L447 th, td { ... +R/screen_limma_hyperparams.R#L451 } ... +R/screen_limma_hyperparams.R#L452 tr:nth-child(even) { ... +R/screen_limma_hyperparams.R#L454 } ... +R/screen_limma_hyperparams.R#L455 tr:hover { ... R/screen_limma_hyperparams.R#L457 } ... -R/screen_limma_hyperparams.R#L458 tr:nth-child(even) { ... -R/screen_limma_hyperparams.R#L460 } ... -R/screen_limma_hyperparams.R#L461 tr:hover { ... -R/screen_limma_hyperparams.R#L463 } ... -R/screen_limma_hyperparams.R#L466 ... -R/screen_limma_hyperparams.R#L467 # Start HTML table with the header ... -R/screen_limma_hyperparams.R#L468 html_table <- "

  • " ... -R/screen_limma_hyperparams.R#L469 html_table <- paste0(html_table, " none, 1 -> ... -R/screen_limma_hyperparams.R#L838 ... -R/screen_limma_hyperparams.R#L839 vennheatmap_plot <- pheatmap::pheatmap ... -R/screen_limma_hyperparams.R#L851 ... -R/screen_limma_hyperparams.R#L852 return( ... -R/screen_limma_hyperparams.R#L854 vennheatmap = vennheatmap_plot, ... -R/screen_limma_hyperparams.R#L855 nrhits = nrow(venn_matrix) ... -R/screen_limma_hyperparams.R#L856 ) ... -R/screen_limma_hyperparams.R#L883 ... -R/screen_limma_hyperparams.R#L884 plot_data <- ... -R/screen_limma_hyperparams.R#L886 store_hits(hc_obj$data[[1]]) |> ... -R/screen_limma_hyperparams.R#L889 store_hits(hc_obj$data[[2]]) |> ... -R/screen_limma_hyperparams.R#L895 ... -R/screen_limma_hyperparams.R#L896 ggplot2::ggplot( ... -R/screen_limma_hyperparams.R#L899 x = !!rlang::sym("params"), ... -R/screen_limma_hyperparams.R#L900 y = !!rlang::sym("n_hits") ... -R/screen_limma_hyperparams.R#L901 ) ... -R/screen_limma_hyperparams.R#L905 aes(label = !!rlang::sym("n_hits") ... -R/screen_limma_hyperparams.R#L906 vjust = -0.5, ... -R/screen_limma_hyperparams.R#L907 ... -R/screen_limma_hyperparams.R#L911 "Nr. of hits", ... -R/screen_limma_hyperparams.R#L912 expand = expansion(mult = c(0, .2) ... -R/screen_limma_hyperparams.R#L917 axis.text.x = element_text( ... -R/screen_limma_hyperparams.R#L923 panel.grid.major.x = element_blank ... -R/screen_limma_hyperparams.R#L945 ... -R/screen_limma_hyperparams.R#L946 combo_pair_combined <- c( ... -R/screen_limma_hyperparams.R#L950 ... -R/screen_limma_hyperparams.R#L951 hitcomp <- hc_new( ... -R/screen_limma_hyperparams.R#L955 ... -R/screen_limma_hyperparams.R#L956 combo_names <- sapply(names(combo_pair ... -R/screen_limma_hyperparams.R#L960 }) ... -R/screen_limma_hyperparams.R#L961 ... -R/screen_limma_hyperparams.R#L962 condition_nr <- 1L ... -R/screen_limma_hyperparams.R#L963 for (i in 1:length(combo_pair_combined ... -R/screen_limma_hyperparams.R#L970 condition_nr <- 2L ... -R/screen_limma_hyperparams.R#L974 top_table <- combo_top_tables[[top ... -R/screen_limma_hyperparams.R#L975 id <- paste( ... -R/screen_limma_hyperparams.R#L980 hitcomp <- hc_add( ... -R/screen_limma_hyperparams.R#L988 } ... -R/screen_limma_hyperparams.R#L990 result <- hc_vennheatmap(hitcomp) ... -R/screen_limma_hyperparams.R#L991 barplot <- hc_barplot(hitcomp) ... -R/screen_limma_hyperparams.R#L992 ... -R/screen_limma_hyperparams.R#L993 list( ... -R/screen_limma_hyperparams.R#L998 ) ... -R/screen_limma_hyperparams.R#L1001 ... -R/screen_limma_hyperparams.R#L1031 ... -R/screen_limma_hyperparams.R#L1032 plots <- list() ... -R/screen_limma_hyperparams.R#L1033 plots_len <- integer(0) ... -R/screen_limma_hyperparams.R#L1034 ... -R/screen_limma_hyperparams.R#L1035 # all the combos of DoF and adj. p-val ... -R/screen_limma_hyperparams.R#L1036 for (combo_name in names(internal_comb ... -R/screen_limma_hyperparams.R#L1047 top_table <- top_tables_levels[[to ... -R/screen_limma_hyperparams.R#L1048 ... -R/screen_limma_hyperparams.R#L1049 parts <- strsplit(top_table_name, ... -R/screen_limma_hyperparams.R#L1050 condition <- parts[1] ... -R/screen_limma_hyperparams.R#L1051 level <- parts[2] ... -R/screen_limma_hyperparams.R#L1052 meta_level <- meta[meta[[condition ... -R/screen_limma_hyperparams.R#L1053 data_level <- data[, which(meta[[c ... -R/screen_limma_hyperparams.R#L1054 ... -R/screen_limma_hyperparams.R#L1055 # Show 6 significant and 6 non sig ... -R/screen_limma_hyperparams.R#L1056 # composite plot (the 6 individual ... -R/screen_limma_hyperparams.R#L1057 for (type in c('significant', 'not ... -R/screen_limma_hyperparams.R#L1060 filtered_rows <- top_table[top ... -R/screen_limma_hyperparams.R#L1061 selected_rows <- if (nrow(filt ... -R/screen_limma_hyperparams.R#L1063 } else { ... -R/screen_limma_hyperparams.R#L1065 } ... -R/screen_limma_hyperparams.R#L1066 indices <- as.integer(selected ... -R/screen_limma_hyperparams.R#L1068 filtered_rows <- top_table[top ... -R/screen_limma_hyperparams.R#L1069 selected_rows <- if (nrow(filt ... -R/screen_limma_hyperparams.R#L1071 } else { ... -R/screen_limma_hyperparams.R#L1073 } ... -R/screen_limma_hyperparams.R#L1074 indices <- as.integer(selected ... -R/screen_limma_hyperparams.R#L1081 data_level, ... -R/screen_limma_hyperparams.R#L1082 meta_level, ... -R/screen_limma_hyperparams.R#L1083 spline_test_configs, ... -R/screen_limma_hyperparams.R#L1084 top_table, ... -R/screen_limma_hyperparams.R#L1085 combo_name, ... -R/screen_limma_hyperparams.R#L1086 indices, ... -R/screen_limma_hyperparams.R#L1087 type, ... -R/screen_limma_hyperparams.R#L1088 time_unit_label ... -R/screen_limma_hyperparams.R#L1089 ) ... -R/screen_limma_hyperparams.R#L1092 plot_name <- paste( ... -R/screen_limma_hyperparams.R#L1098 plots[[plot_name]] <- result$c ... -R/screen_limma_hyperparams.R#L1099 plots_len <- c(plots_len, resu ... -R/screen_limma_hyperparams.R#L1101 } ... -R/screen_limma_hyperparams.R#L1103 } ... -R/screen_limma_hyperparams.R#L1104 ... -R/screen_limma_hyperparams.R#L1105 list( ... -R/screen_limma_hyperparams.R#L1138 plots <- list() ... -R/screen_limma_hyperparams.R#L1139 plots_len <- integer(0) ... -R/screen_limma_hyperparams.R#L1140 ... -R/screen_limma_hyperparams.R#L1141 hitcomp <- combo_pair$hitcomp ... -R/screen_limma_hyperparams.R#L1142 ... -R/screen_limma_hyperparams.R#L1143 plots[[1]] <- hitcomp$vennheatmap ... -R/screen_limma_hyperparams.R#L1144 plots[[2]] <- hitcomp$vennheatmap ... -R/screen_limma_hyperparams.R#L1145 plots[[3]] <- hitcomp$barplot ... -R/screen_limma_hyperparams.R#L1146 ... -R/screen_limma_hyperparams.R#L1147 plots_len <- c( ... -R/screen_limma_hyperparams.R#L1153 ... -R/screen_limma_hyperparams.R#L1154 composites <- combo_pair$composites ... -R/screen_limma_hyperparams.R#L1155 ... -R/screen_limma_hyperparams.R#L1156 for (composite in composites) { ... -R/screen_limma_hyperparams.R#L1158 plots[[length(plots) + 1]] <- plot ... -R/screen_limma_hyperparams.R#L1162 plots_len <- c(plots_len, len) ... -R/screen_limma_hyperparams.R#L1164 } ... -R/screen_limma_hyperparams.R#L1165 ... -R/screen_limma_hyperparams.R#L1166 # Function is in splinetime_general_fu ... -R/screen_limma_hyperparams.R#L1167 generate_report_html( ... -R/screen_limma_hyperparams.R#L1203 ... -R/screen_limma_hyperparams.R#L1204 num_levels <- length(unique(meta[[cond ... -R/screen_limma_hyperparams.R#L1205 ... -R/screen_limma_hyperparams.R#L1206 result <- lapply( ... -R/screen_limma_hyperparams.R#L1213 return(result) ... -R/screen_limma_hyperparams.R#L1227 ... -R/screen_limma_hyperparams.R#L1228 formatted_layers <- list() ... -R/screen_limma_hyperparams.R#L1229 ... -R/screen_limma_hyperparams.R#L1230 names_of_spline_configs <- names(splin ... -R/screen_limma_hyperparams.R#L1231 for (i in 1:length(spline_configs$spli ... -R/screen_limma_hyperparams.R#L1237 formatted_strings <<- c( ... -R/screen_limma_hyperparams.R#L1240 name, ... -R/screen_limma_hyperparams.R#L1241 " = ", ... -R/screen_limma_hyperparams.R#L1242 paste( ... -R/screen_limma_hyperparams.R#L1245 ) ... -R/screen_limma_hyperparams.R#L1247 ... -R/screen_limma_hyperparams.R#L1253 } ... -R/screen_limma_hyperparams.R#L1254 formatted_layers ... -R/screen_limma_hyperparams.R#L1272 ... -R/screen_limma_hyperparams.R#L1273 if (is.atomic(x)) { ... -R/screen_limma_hyperparams.R#L1275 } else { ... -R/screen_limma_hyperparams.R#L1277 } ... -R/screen_limma_hyperparams.R#L1303 if (mode == "integrated") { ... -R/screen_limma_hyperparams.R#L1305 config_column[[index]] ... -R/screen_limma_hyperparams.R#L1307 config_column[index] ... -R/screen_limma_hyperparams.R#L1309 } else { # mode = 'isolated' ... -R/screen_limma_hyperparams.R#L1311 rep(config_column[[index]], num_le ... -R/screen_limma_hyperparams.R#L1313 rep(config_column[index], num_leve ... -R/screen_limma_hyperparams.R#L1315 } ... -R/screen_limma_hyperparams.R#L1334 ... -R/screen_limma_hyperparams.R#L1335 hits_cond <- list() ... -R/screen_limma_hyperparams.R#L1336 ... -R/screen_limma_hyperparams.R#L1337 for (item in condition) { ... -R/screen_limma_hyperparams.R#L1343 filter(df[["adj.P.Val"]] < adj_p_v ... -R/screen_limma_hyperparams.R#L1344 pull(!!sym("feature_nr")) |> ... -R/screen_limma_hyperparams.R#L1345 as.character() ... -R/screen_limma_hyperparams.R#L1346 } ... -R/screen_limma_hyperparams.R#L1347 ... -R/screen_limma_hyperparams.R#L1348 return(hits_cond) ... -R/screen_limma_hyperparams.R#L1392 ... -R/screen_limma_hyperparams.R#L1393 plot_list <- list() ... -R/screen_limma_hyperparams.R#L1394 config_index <- ... -R/screen_limma_hyperparams.R#L1397 smooth_timepoints <- seq(meta$Time[1], ... -R/screen_limma_hyperparams.R#L1398 meta$Time[len ... -R/screen_limma_hyperparams.R#L1399 length.out = ... -R/screen_limma_hyperparams.R#L1400 ... -R/screen_limma_hyperparams.R#L1401 args <- list(x = smooth_timepoints, in ... -R/screen_limma_hyperparams.R#L1402 args$df <- spline_test_configs$dof[[co ... -R/screen_limma_hyperparams.R#L1404 if (spline_test_configs$spline_type[co ... -R/screen_limma_hyperparams.R#L1407 } else { ... -R/screen_limma_hyperparams.R#L1409 } ... -R/screen_limma_hyperparams.R#L1410 ... -R/screen_limma_hyperparams.R#L1411 # Generate all the individual plots ... -R/screen_limma_hyperparams.R#L1412 for (index in indices) { ... -R/screen_limma_hyperparams.R#L1416 as.numeric(top_table[top_table$fea ... -R/screen_limma_hyperparams.R#L1417 index, past ... -R/screen_limma_hyperparams.R#L1420 as.numeric(top_table$intercept[top ... -R/screen_limma_hyperparams.R#L1434 geom_point(data = plot_data, aes(x ... -R/screen_limma_hyperparams.R#L1435 y ... -R/screen_limma_hyperparams.R#L1436 color = 'blue') + ... -R/screen_limma_hyperparams.R#L1437 geom_line(data = plot_spline, aes( ... -R/screen_limma_hyperparams.R#L1440 theme_minimal() + ... -R/screen_limma_hyperparams.R#L1441 scale_x_continuous(limits = c(min( ... -R/screen_limma_hyperparams.R#L1446 title <- paste("Feature:", index) ... -R/screen_limma_hyperparams.R#L1450 x = paste0("Time ", ti ... -R/screen_limma_hyperparams.R#L1451 theme(plot.title = element_text(si ... -R/screen_limma_hyperparams.R#L1454 annotate("text", x = x_max + (x_ex ... -R/screen_limma_hyperparams.R#L1455 max(fitted_values, na.r ... -R/screen_limma_hyperparams.R#L1456 label = "", ... -R/screen_limma_hyperparams.R#L1457 hjust = 0.5, vjust = 1, s ... -R/screen_limma_hyperparams.R#L1460 } ... -R/screen_limma_hyperparams.R#L1461 ... -R/screen_limma_hyperparams.R#L1462 if (length(plot_list) > 0) { ... -R/screen_limma_hyperparams.R#L1469 patchwork::plot_annotation(title = ... -R/screen_limma_hyperparams.R#L1470 ... -R/screen_limma_hyperparams.R#L1471 theme = theme(plot ... -R/screen_limma_hyperparams.R#L1472 ... -R/screen_limma_hyperparams.R#L1475 composite_plot = composite_plot, ... -R/screen_limma_hyperparams.R#L1476 composite_plot_len = composite_plo ... -R/screen_limma_hyperparams.R#L1477 ) ... -R/screen_limma_hyperparams.R#L1478 } else { ... -R/screen_limma_hyperparams.R#L1480 } ... -R/screen_limma_hyperparams.R#L1512 html_content <- paste(header_section, ... -R/screen_limma_hyperparams.R#L1513 ... -R/screen_limma_hyperparams.R#L1514 toc <- create_toc() ... -R/screen_limma_hyperparams.R#L1515 ... -R/screen_limma_hyperparams.R#L1516 styles <- define_html_styles() ... -R/screen_limma_hyperparams.R#L1517 section_header_style <- styles$section ... -R/screen_limma_hyperparams.R#L1518 toc_style <- styles$toc_style ... -R/screen_limma_hyperparams.R#L1519 ... -R/screen_limma_hyperparams.R#L1520 headers <- c( ... -R/screen_limma_hyperparams.R#L1526 ... -R/screen_limma_hyperparams.R#L1527 # section_texts <- get_hyperparams_scr ... -R/screen_limma_hyperparams.R#L1528 section_texts <- read_section_texts( ... -R/screen_limma_hyperparams.R#L1531 ... -R/screen_limma_hyperparams.R#L1532 nr_of_sections <- length(headers) ... -R/screen_limma_hyperparams.R#L1533 ... -R/screen_limma_hyperparams.R#L1534 for (index in seq_along(plots)) { ... -R/screen_limma_hyperparams.R#L1537 ... -R/screen_limma_hyperparams.R#L1538 section_header <- sprintf( ... -R/screen_limma_hyperparams.R#L1544 ... -R/screen_limma_hyperparams.R#L1545 section_text <- sprintf('

    ... +R/screen_limma_hyperparams.R#L1323 as.character() ... +R/screen_limma_hyperparams.R#L1324 } ... +R/screen_limma_hyperparams.R#L1326 return(hits_cond) ... +R/screen_limma_hyperparams.R#L1369 plot_list <- list() ... +R/screen_limma_hyperparams.R#L1370 config_index <- ... +R/screen_limma_hyperparams.R#L1373 smooth_timepoints <- seq(meta$Time[1], ... +R/screen_limma_hyperparams.R#L1376 ) ... +R/screen_limma_hyperparams.R#L1378 args <- list(x = smooth_timepoints, in ... +R/screen_limma_hyperparams.R#L1379 args$df <- spline_test_configs$dof[[co ... +R/screen_limma_hyperparams.R#L1381 if (spline_test_configs$spline_type[co ... +R/screen_limma_hyperparams.R#L1384 } else { # natural cubic splines ... +R/screen_limma_hyperparams.R#L1386 } ... +R/screen_limma_hyperparams.R#L1388 # Generate all the individual plots ... +R/screen_limma_hyperparams.R#L1389 for (index in indices) { ... +R/screen_limma_hyperparams.R#L1392 as.numeric(top_table[top_table$fea ... +R/screen_limma_hyperparams.R#L1396 as.numeric(top_table$intercept[top ... +R/screen_limma_hyperparams.R#L1401 Time = meta$Time, ... +R/screen_limma_hyperparams.R#L1402 Intensity = as.vector(t(data[index ... +R/screen_limma_hyperparams.R#L1412 geom_point( ... +R/screen_limma_hyperparams.R#L1414 x = !!rlang::sym("Time"), ... +R/screen_limma_hyperparams.R#L1415 y = !!rlang::sym("Intensity") ... +R/screen_limma_hyperparams.R#L1418 ) + ... +R/screen_limma_hyperparams.R#L1419 geom_line( ... +R/screen_limma_hyperparams.R#L1421 x = !!rlang::sym("Time"), ... +R/screen_limma_hyperparams.R#L1422 y = !!rlang::sym("Fitted") ... +R/screen_limma_hyperparams.R#L1425 ) + ... +R/screen_limma_hyperparams.R#L1426 theme_minimal() + ... +R/screen_limma_hyperparams.R#L1427 scale_x_continuous(limits = c(min( ... +R/screen_limma_hyperparams.R#L1432 title <- paste("Feature:", index) ... +R/screen_limma_hyperparams.R#L1436 title = title, ... +R/screen_limma_hyperparams.R#L1437 x = paste0("Time ", time_unit_labe ... +R/screen_limma_hyperparams.R#L1439 theme( ... +R/screen_limma_hyperparams.R#L1443 ) + ... +R/screen_limma_hyperparams.R#L1444 annotate("text", ... +R/screen_limma_hyperparams.R#L1446 max(fitted_values, na.rm = TRU ... +R/screen_limma_hyperparams.R#L1449 ) ... +R/screen_limma_hyperparams.R#L1452 } ... +R/screen_limma_hyperparams.R#L1454 if (length(plot_list) > 0) { ... +R/screen_limma_hyperparams.R#L1461 patchwork::plot_annotation( ... +R/screen_limma_hyperparams.R#L1463 sep = " | " ... +R/screen_limma_hyperparams.R#L1466 hjust = 0.5, ... +R/screen_limma_hyperparams.R#L1467 size = 14 ... +R/screen_limma_hyperparams.R#L1469 ) ... +R/screen_limma_hyperparams.R#L1472 composite_plot = composite_plot, ... +R/screen_limma_hyperparams.R#L1473 composite_plot_len = composite_plo ... +R/screen_limma_hyperparams.R#L1475 } else { ... +R/screen_limma_hyperparams.R#L1477 } ... +R/screen_limma_hyperparams.R#L1507 html_content <- paste(header_section, ... +R/screen_limma_hyperparams.R#L1509 toc <- create_toc() ... +R/screen_limma_hyperparams.R#L1511 styles <- define_html_styles() ... +R/screen_limma_hyperparams.R#L1512 section_header_style <- styles$section ... +R/screen_limma_hyperparams.R#L1513 toc_style <- styles$toc_style ... +R/screen_limma_hyperparams.R#L1515 headers <- c( ... +R/screen_limma_hyperparams.R#L1520 ) ... +R/screen_limma_hyperparams.R#L1522 # section_texts <- get_hyperparams_scr ... +R/screen_limma_hyperparams.R#L1523 section_texts <- read_section_texts( ... +R/screen_limma_hyperparams.R#L1525 ) ... +R/screen_limma_hyperparams.R#L1527 nr_of_sections <- length(headers) ... +R/screen_limma_hyperparams.R#L1529 for (index in seq_along(plots)) { ... +R/screen_limma_hyperparams.R#L1531 section_header <- sprintf( ... +R/screen_limma_hyperparams.R#L1536 ) ... +R/screen_limma_hyperparams.R#L1538 section_text <- sprintf( ... +R/screen_limma_hyperparams.R#L1541 ) ... +R/screen_limma_hyperparams.R#L1543 html_content <- paste( ... +R/screen_limma_hyperparams.R#L1548 ) ... +R/screen_limma_hyperparams.R#L1550 toc_entry <- sprintf( ... +R/screen_limma_hyperparams.R#L1553 ) ... +R/screen_limma_hyperparams.R#L1554 toc <- paste(toc, toc_entry, sep = ... +R/screen_limma_hyperparams.R#L1558 plots_element = plots[[index]], ... +R/screen_limma_hyperparams.R#L1559 plots_size = plots_sizes[[index]], ... +R/screen_limma_hyperparams.R#L1560 html_content = html_content, ... +R/screen_limma_hyperparams.R#L1561 toc = toc, ... +R/screen_limma_hyperparams.R#L1562 header_index = index ... +R/screen_limma_hyperparams.R#L1566 } ... +R/screen_limma_hyperparams.R#L1568 generate_and_write_html( ... +R/screen_limma_hyperparams.R#L1573 ) ... +R/splineomics_object.R#L69 splineomics <- list( ... +R/splineomics_object.R#L83 ) ... +R/splineomics_object.R#L85 class(splineomics) <- "SplineOmics" ... +R/splineomics_object.R#L86 return(splineomics) ... +R/splineomics_object.R#L105 if (!inherits(splineomics, "SplineOmic ... +R/splineomics_object.R#L107 } ... +R/splineomics_object.R#L109 allowed_fields <- c( ... +R/splineomics_object.R#L123 ) ... +R/splineomics_object.R#L125 args <- list(...) ... +R/splineomics_object.R#L127 for (name in names(args)) { ... +R/splineomics_object.R#L129 stop(paste("Field", name, "is not ... +R/splineomics_object.R#L132 } ... +R/splineomics_object.R#L134 return(splineomics) ... +R/splineomics_object.R#L163 cat("data:") ... +R/splineomics_object.R#L164 cat("SplineOmics Object\n") ... +R/splineomics_object.R#L165 cat("-------------------\n") ... +R/splineomics_object.R#L167 # Print summary information ... +R/splineomics_object.R#L168 cat("Number of features (rows):", nrow ... +R/splineomics_object.R#L169 cat("Number of samples (columns):", nc ... +R/splineomics_object.R#L171 cat("Meta data columns:", ncol(x$meta) ... +R/splineomics_object.R#L172 cat("First few meta columns:\n") ... +R/splineomics_object.R#L173 print(utils::head(x$meta, 3)) ... +R/splineomics_object.R#L175 cat("Condition:", x$condition, "\n") ... +R/splineomics_object.R#L177 if (!is.null(x$rna_seq_data)) { ... +R/splineomics_object.R#L179 } else { ... +R/splineomics_object.R#L181 } ... +R/splineomics_object.R#L183 if (!is.null(x$annotation)) { ... +R/splineomics_object.R#L185 } else { ... +R/splineomics_object.R#L187 } ... +R/splineomics_object.R#L189 if (!is.null(x$spline_params)) { ... +R/splineomics_object.R#L192 } else { ... +R/splineomics_object.R#L194 } ... +R/splineomics_object.R#L196 cat("P-value adjustment method:", x$pa ... +R/utils_general.R#L27 # Create and return the progress bar ... +R/utils_general.R#L28 pb <- progress::progress_bar$new( ... +R/utils_general.R#L33 ) ... +R/utils_general.R#L35 return(pb) ... +R/utils_general.R#L67 args <- list( ... +R/utils_general.R#L70 ) # Time column is mandatory ... +R/utils_general.R#L72 if (!is.null(spline_params$dof)) { ... +R/utils_general.R#L74 } else { ... +R/utils_general.R#L76 } ... +R/utils_general.R#L78 if (!is.null(spline_params$bknots)) { ... R/utils_general.R#L80 } ... -R/utils_general.R#L81 ... -R/utils_general.R#L82 if (!is.null(spline_params$bknots)) { ... -R/utils_general.R#L84 } ... -R/utils_general.R#L86 if (spline_params$spline_type[level_in ... -R/utils_general.R#L89 } else { ... -R/utils_general.R#L91 } ... -R/utils_general.R#L92 ... -R/utils_general.R#L93 design_matrix <- stats::model.matrix( ... -R/utils_general.R#L115 ... -R/utils_general.R#L116 top_table$feature_nr <- as.numeric(as. ... -R/utils_general.R#L117 annotation_rows <- annotation[top_tabl ... -R/utils_general.R#L118 top_table <- cbind(top_table, annotati ... -R/utils_general.R#L140 ... -R/utils_general.R#L141 data_df <- as.data.frame(data) ... -R/utils_general.R#L142 ... -R/utils_general.R#L143 # Add row names as the first column na ... -R/utils_general.R#L144 combined_df <- cbind( ... -R/utils_general.R#L147 ) ... -R/utils_general.R#L148 ... -R/utils_general.R#L149 # If annotation is not NULL, check row ... -R/utils_general.R#L150 if (!is.null(annotation)) { ... -R/utils_general.R#L152 stop("The number of rows in data a ... -R/utils_general.R#L153 call. = FALSE) ... -R/utils_general.R#L158 } ... -R/utils_general.R#L159 ... -R/utils_general.R#L160 return(combined_df) ... -R/utils_general.R#L178 ... -R/utils_general.R#L179 # Green color code for "Info" ... -R/utils_general.R#L180 green_info <- "\033[32mInfo\033[0m" ... -R/utils_general.R#L181 ... -R/utils_general.R#L182 full_message <- paste( ... -R/utils_general.R#L187 ) ... -R/utils_general.R#L188 ... -R/utils_general.R#L189 cat(full_message) ... -R/utils_general.R#L209 # Concatenate all arguments into a sin ... -R/utils_general.R#L210 message_text <- paste(..., sep = " ") ... -R/utils_general.R#L211 ... -R/utils_general.R#L212 # Call stop with the concatenated mess ... -R/utils_general.R#L213 stop(message_text, call. = FALSE) ... -R/utils_input_validation.R#L13 inherit = Level2Functions, ... -R/utils_input_validation.R#L14 ... -R/utils_input_validation.R#L15 public = list( ... -R/utils_input_validation.R#L24 ... -R/utils_input_validation.R#L25 if (!is.null(args$splineomics) && ... -R/utils_input_validation.R#L26 inherits(args$splineomics, "Sp ... -R/utils_input_validation.R#L29 } ... -R/utils_input_validation.R#L30 ... -R/utils_input_validation.R#L31 self$args <- args ... -R/utils_input_validation.R#L68 self$check_data_and_meta() ... -R/utils_input_validation.R#L69 self$check_annotation() ... -R/utils_input_validation.R#L70 self$check_datas_and_metas() ... -R/utils_input_validation.R#L71 self$check_datas_descr() ... -R/utils_input_validation.R#L72 self$check_top_tables() ... -R/utils_input_validation.R#L73 self$check_design_formula() ... -R/utils_input_validation.R#L74 self$check_mode() ... -R/utils_input_validation.R#L75 self$check_modes() ... -R/utils_input_validation.R#L76 self$check_designs_and_metas() ... -R/utils_input_validation.R#L77 self$check_spline_params() ... -R/utils_input_validation.R#L78 self$check_spline_test_configs() ... -R/utils_input_validation.R#L79 self$check_adj_pthresholds() ... -R/utils_input_validation.R#L80 self$check_adj_pthresh_limma_categ ... -R/utils_input_validation.R#L81 self$check_clusters() ... -R/utils_input_validation.R#L82 self$check_genes() ... -R/utils_input_validation.R#L83 self$check_plot_info() ... -R/utils_input_validation.R#L84 self$check_report_dir() ... -R/utils_input_validation.R#L85 self$check_padjust_method() ... -R/utils_input_validation.R#L86 self$check_report_info() ... -R/utils_input_validation.R#L87 self$check_report() ... -R/utils_input_validation.R#L88 self$check_feature_name_columns() ... -R/utils_input_validation.R#L119 ... -R/utils_input_validation.R#L120 data <- self$args[["data"]] ... -R/utils_input_validation.R#L121 meta <- self$args[["meta"]] ... -R/utils_input_validation.R#L122 condition <- self$args[["condition ... -R/utils_input_validation.R#L123 meta_batch_column <- self$args[["m ... -R/utils_input_validation.R#L124 meta_batch2_column <- self$args[[" ... -R/utils_input_validation.R#L125 data_meta_index <- self$args[["dat ... -R/utils_input_validation.R#L127 required_args <- list(data, meta, ... -R/utils_input_validation.R#L128 ... -R/utils_input_validation.R#L129 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L131 } ... -R/utils_input_validation.R#L132 ... -R/utils_input_validation.R#L133 self$check_data( ... -R/utils_input_validation.R#L137 ... -R/utils_input_validation.R#L138 self$check_meta( ... -R/utils_input_validation.R#L145 ... -R/utils_input_validation.R#L146 if (!(nrow(meta) == ncol(data))) { ... -R/utils_input_validation.R#L148 stop(paste0("For index ", data ... -R/utils_input_validation.R#L149 "data column numbe ... -R/utils_input_validation.R#L150 "meta row number") ... -R/utils_input_validation.R#L151 call. = FALSE) ... +R/utils_general.R#L82 if (spline_params$spline_type[level_in ... +R/utils_general.R#L85 } else { # natural cubic splines ... +R/utils_general.R#L87 } ... +R/utils_general.R#L89 design_matrix <- stats::model.matrix( ... +R/utils_general.R#L92 ) ... +R/utils_general.R#L110 top_table$feature_nr <- as.numeric(as. ... +R/utils_general.R#L111 annotation_rows <- annotation[top_tabl ... +R/utils_general.R#L112 top_table <- cbind(top_table, annotati ... +R/utils_general.R#L133 data_df <- as.data.frame(data) ... +R/utils_general.R#L135 # Add row names as the first column na ... +R/utils_general.R#L136 combined_df <- cbind( ... +R/utils_general.R#L139 ) ... +R/utils_general.R#L141 # If annotation is not NULL, check row ... +R/utils_general.R#L142 if (!is.null(annotation)) { ... +R/utils_general.R#L144 stop("The number of rows in data a ... +R/utils_general.R#L146 ) ... +R/utils_general.R#L151 } ... +R/utils_general.R#L153 return(combined_df) ... +R/utils_general.R#L172 # Green color code for "Info" ... +R/utils_general.R#L173 green_info <- "\033[32mInfo\033[0m" ... +R/utils_general.R#L175 full_message <- paste( ... +R/utils_general.R#L180 ) ... +R/utils_general.R#L182 message(full_message) ... +R/utils_general.R#L202 # Concatenate all arguments into a sin ... +R/utils_general.R#L203 message_text <- paste(..., sep = " ") ... +R/utils_general.R#L205 # Call stop with the concatenated mess ... +R/utils_general.R#L206 stop(message_text, call. = FALSE) ... +R/utils_input_validation.R#L11 inherit = Level2Functions, ... +R/utils_input_validation.R#L12 public = list( ... +R/utils_input_validation.R#L21 if (!is.null(args$splineomics) && ... +R/utils_input_validation.R#L25 } ... +R/utils_input_validation.R#L27 self$args <- args ... +R/utils_input_validation.R#L64 self$check_data_and_meta() ... +R/utils_input_validation.R#L65 self$check_annotation() ... +R/utils_input_validation.R#L66 self$check_datas_and_metas() ... +R/utils_input_validation.R#L67 self$check_datas_descr() ... +R/utils_input_validation.R#L68 self$check_top_tables() ... +R/utils_input_validation.R#L69 self$check_design_formula() ... +R/utils_input_validation.R#L70 self$check_mode() ... +R/utils_input_validation.R#L71 self$check_modes() ... +R/utils_input_validation.R#L72 self$check_designs_and_metas() ... +R/utils_input_validation.R#L73 self$check_spline_params() ... +R/utils_input_validation.R#L74 self$check_spline_test_configs() ... +R/utils_input_validation.R#L75 self$check_adj_pthresholds() ... +R/utils_input_validation.R#L76 self$check_adj_pthresh_limma_categ ... +R/utils_input_validation.R#L77 self$check_clusters() ... +R/utils_input_validation.R#L78 self$check_genes() ... +R/utils_input_validation.R#L79 self$check_plot_info() ... +R/utils_input_validation.R#L80 self$check_plot_options() ... +R/utils_input_validation.R#L81 self$check_report_dir() ... +R/utils_input_validation.R#L82 self$check_padjust_method() ... +R/utils_input_validation.R#L83 self$check_report_info() ... +R/utils_input_validation.R#L84 self$check_report() ... +R/utils_input_validation.R#L85 self$check_feature_name_columns() ... +R/utils_input_validation.R#L116 data <- self$args[["data"]] ... +R/utils_input_validation.R#L117 meta <- self$args[["meta"]] ... +R/utils_input_validation.R#L118 condition <- self$args[["condition ... +R/utils_input_validation.R#L119 meta_batch_column <- self$args[["m ... +R/utils_input_validation.R#L120 meta_batch2_column <- self$args[[" ... +R/utils_input_validation.R#L121 data_meta_index <- self$args[["dat ... +R/utils_input_validation.R#L123 required_args <- list(data, meta, ... +R/utils_input_validation.R#L125 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L127 } ... +R/utils_input_validation.R#L129 self$check_data( ... +R/utils_input_validation.R#L132 ) ... +R/utils_input_validation.R#L134 self$check_meta( ... +R/utils_input_validation.R#L140 ) ... +R/utils_input_validation.R#L142 if (!(nrow(meta) == ncol(data))) { ... +R/utils_input_validation.R#L144 stop( ... +R/utils_input_validation.R#L146 "For index ", data_meta_in ... +R/utils_input_validation.R#L147 "data column number must b ... +R/utils_input_validation.R#L148 "meta row number" ... +R/utils_input_validation.R#L151 ) ... R/utils_input_validation.R#L153 stop(paste0("data column numbe ... -R/utils_input_validation.R#L154 call. = FALSE) ... -R/utils_input_validation.R#L156 } ... -R/utils_input_validation.R#L181 ... +R/utils_input_validation.R#L155 ) ... +R/utils_input_validation.R#L157 } ... R/utils_input_validation.R#L182 annotation <- self$args[["annotati ... R/utils_input_validation.R#L183 data <- self$args[["data"]] ... R/utils_input_validation.R#L185 required_args <- list(annotation, ... -R/utils_input_validation.R#L186 ... -R/utils_input_validation.R#L187 if (any(sapply(required_args, is.n ... +R/utils_input_validation.R#L187 if (any(vapply(required_args, is.n ... R/utils_input_validation.R#L189 } ... -R/utils_input_validation.R#L190 ... R/utils_input_validation.R#L191 if (!is.data.frame(annotation)) { ... R/utils_input_validation.R#L193 "annotation is not a dataframe ... R/utils_input_validation.R#L194 call. = FALSE ... R/utils_input_validation.R#L196 } ... -R/utils_input_validation.R#L197 ... R/utils_input_validation.R#L198 if (nrow(annotation) != nrow(data) ... R/utils_input_validation.R#L200 "annotation and data don't hav ... R/utils_input_validation.R#L201 call. = FALSE ... -R/utils_input_validation.R#L202 ) ... R/utils_input_validation.R#L203 } ... -R/utils_input_validation.R#L227 ... -R/utils_input_validation.R#L228 datas <- self$args$datas ... -R/utils_input_validation.R#L229 metas <- self$args$metas ... -R/utils_input_validation.R#L230 condition <- self$args$condition ... -R/utils_input_validation.R#L231 meta_batch_column <- self$args$met ... -R/utils_input_validation.R#L232 meta_batch2_column <- self$args$me ... -R/utils_input_validation.R#L233 ... -R/utils_input_validation.R#L234 required_args <- list(datas, metas ... -R/utils_input_validation.R#L235 ... -R/utils_input_validation.R#L236 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L238 } ... -R/utils_input_validation.R#L239 ... -R/utils_input_validation.R#L240 if (length(datas) != length(metas) ... -R/utils_input_validation.R#L242 call. = FALSE) ... +R/utils_input_validation.R#L227 datas <- self$args$datas ... +R/utils_input_validation.R#L228 metas <- self$args$metas ... +R/utils_input_validation.R#L229 condition <- self$args$condition ... +R/utils_input_validation.R#L230 meta_batch_column <- self$args$met ... +R/utils_input_validation.R#L231 meta_batch2_column <- self$args$me ... +R/utils_input_validation.R#L233 required_args <- list(datas, metas ... +R/utils_input_validation.R#L235 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L237 } ... +R/utils_input_validation.R#L239 if (length(datas) != length(metas) ... +R/utils_input_validation.R#L241 call. = FALSE ... R/utils_input_validation.R#L243 } ... -R/utils_input_validation.R#L244 ... R/utils_input_validation.R#L245 data_storage <- self$args$data ... R/utils_input_validation.R#L246 meta_storage <- self$args$meta ... -R/utils_input_validation.R#L247 ... R/utils_input_validation.R#L248 for (i in seq_along(datas)) { ... R/utils_input_validation.R#L257 } ... -R/utils_input_validation.R#L258 ... R/utils_input_validation.R#L259 self$args$data <- data_storage ... R/utils_input_validation.R#L260 self$args$meta <- meta_storage ... -R/utils_input_validation.R#L261 ... R/utils_input_validation.R#L262 return(TRUE) ... -R/utils_input_validation.R#L281 ... -R/utils_input_validation.R#L282 datas_descr <- self$args$datas_des ... -R/utils_input_validation.R#L283 ... -R/utils_input_validation.R#L284 required_args <- list(datas_descr) ... -R/utils_input_validation.R#L285 ... -R/utils_input_validation.R#L286 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L288 } ... -R/utils_input_validation.R#L289 ... -R/utils_input_validation.R#L290 if (!is.character(datas_descr) || ... -R/utils_input_validation.R#L294 "'datas_descr' must be a chara ... -R/utils_input_validation.R#L295 characters. Offending element(s) a ... -R/utils_input_validation.R#L296 the description.", ... -R/utils_input_validation.R#L297 paste(long_elements_indices, c ... -R/utils_input_validation.R#L298 paste(long_elements, collapse ... -R/utils_input_validation.R#L301 } ... -R/utils_input_validation.R#L316 ... -R/utils_input_validation.R#L317 top_tables <- self$args$top_tables ... -R/utils_input_validation.R#L319 required_args <- list(top_tables) ... -R/utils_input_validation.R#L320 ... -R/utils_input_validation.R#L321 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L323 } ... -R/utils_input_validation.R#L324 ... -R/utils_input_validation.R#L325 # Helper function to check data fr ... -R/utils_input_validation.R#L326 check_list_of_dataframes <- functi ... -R/utils_input_validation.R#L329 ... -R/utils_input_validation.R#L330 stop("Expected a list of dataf ... -R/utils_input_validation.R#L331 ... -R/utils_input_validation.R#L333 ... -R/utils_input_validation.R#L334 if (length(df_list) != 2) { ... -R/utils_input_validation.R#L336 "to cluster the h ... -R/utils_input_validation.R#L337 "avrg_diff_condit ... -R/utils_input_validation.R#L338 "The list must co ... -R/utils_input_validation.R#L339 "the time_effect ... -R/utils_input_validation.R#L340 call. = FALSE) ... -R/utils_input_validation.R#L341 } ... -R/utils_input_validation.R#L342 ... -R/utils_input_validation.R#L343 underscore_count <- sapply(nam ... -R/utils_input_validation.R#L344 fun ... -R/utils_input_validation.R#L345 if (sum(underscore_count == 1) ... -R/utils_input_validation.R#L346 sum(underscore_count == 4) ... -R/utils_input_validation.R#L348 "to cluster the h ... -R/utils_input_validation.R#L349 "avrg_diff_condit ... -R/utils_input_validation.R#L350 "The list must co ... -R/utils_input_validation.R#L351 "the time_effect ... -R/utils_input_validation.R#L352 call. = FALSE) ... +R/utils_input_validation.R#L281 datas_descr <- self$args$datas_des ... +R/utils_input_validation.R#L283 required_args <- list(datas_descr) ... +R/utils_input_validation.R#L285 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L287 } ... +R/utils_input_validation.R#L289 if (!is.character(datas_descr) || ... +R/utils_input_validation.R#L293 "'datas_descr' must be a chara ... +R/utils_input_validation.R#L294 characters. Offending element(s) a ... +R/utils_input_validation.R#L295 the description.", ... +R/utils_input_validation.R#L296 paste(long_elements_indices, c ... +R/utils_input_validation.R#L297 paste(long_elements, collapse ... +R/utils_input_validation.R#L300 } ... +R/utils_input_validation.R#L315 top_tables <- self$args$top_tables ... +R/utils_input_validation.R#L317 required_args <- list(top_tables) ... +R/utils_input_validation.R#L319 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L321 } ... +R/utils_input_validation.R#L323 # Helper function to check data fr ... +R/utils_input_validation.R#L324 check_list_of_dataframes <- functi ... +R/utils_input_validation.R#L326 !all(vapply(df_list, is.data.f ... +R/utils_input_validation.R#L327 stop_call_false("Expected a li ... +R/utils_input_validation.R#L329 if (length(df_list) != 2) { ... +R/utils_input_validation.R#L331 "top_tables must be a list ... +R/utils_input_validation.R#L332 "to cluster the hits of th ... +R/utils_input_validation.R#L333 "avrg_diff_conditions or i ... +R/utils_input_validation.R#L334 "The list must contain one ... +R/utils_input_validation.R#L335 "the time_effect limma res ... +R/utils_input_validation.R#L337 } ... +R/utils_input_validation.R#L339 underscore_count <- vapply( ... +R/utils_input_validation.R#L343 ) ... +R/utils_input_validation.R#L344 if (sum(underscore_count == 1) ... +R/utils_input_validation.R#L347 "top_tables must be a list ... +R/utils_input_validation.R#L348 "to cluster the hits of th ... +R/utils_input_validation.R#L349 "avrg_diff_conditions or i ... +R/utils_input_validation.R#L350 "The list must contain one ... +R/utils_input_validation.R#L351 "the time_effect limma res ... R/utils_input_validation.R#L353 } ... -R/utils_input_validation.R#L354 ... R/utils_input_validation.R#L355 for (df in df_list) { ... R/utils_input_validation.R#L357 } ... R/utils_input_validation.R#L359 } ... -R/utils_input_validation.R#L360 ... R/utils_input_validation.R#L361 # Check if top_tables is a list ... R/utils_input_validation.R#L362 if (!is.list(top_tables)) { ... R/utils_input_validation.R#L364 } ... -R/utils_input_validation.R#L365 ... R/utils_input_validation.R#L366 for (i in seq_along(top_tables)) { ... -R/utils_input_validation.R#L375 ... -R/utils_input_validation.R#L376 check_list_of_dataframes(eleme ... -R/utils_input_validation.R#L377 ... -R/utils_input_validation.R#L380 matches <- gregexpr("_", eleme ... -R/utils_input_validation.R#L381 underscore_count <- sum(sapply ... -R/utils_input_validation.R#L382 function(x ... -R/utils_input_validation.R#L383 ... -R/utils_input_validation.R#L384 if (underscore_count != 1) { ... -R/utils_input_validation.R#L386 "of limma but rather on ... -R/utils_input_validation.R#L387 "interaction_condition_ ... -R/utils_input_validation.R#L388 "(to cluster the hits o ... -R/utils_input_validation.R#L389 "at a time into a list ... -R/utils_input_validation.R#L390 "note: Please do not ed ... -R/utils_input_validation.R#L391 call. = FALSE) ... -R/utils_input_validation.R#L392 } ... -R/utils_input_validation.R#L393 ... -R/utils_input_validation.R#L394 self$check_dataframe(element) ... -R/utils_input_validation.R#L395 ... -R/utils_input_validation.R#L397 stop(paste("top_tables must co ... -R/utils_input_validation.R#L398 "data frames"), ... -R/utils_input_validation.R#L399 call. = FALSE) ... -R/utils_input_validation.R#L401 } ... -R/utils_input_validation.R#L423 ... -R/utils_input_validation.R#L424 formula <- self$args[["design"]] ... -R/utils_input_validation.R#L425 meta <- self$args$meta ... -R/utils_input_validation.R#L426 meta_index <- self$args$meta_index ... -R/utils_input_validation.R#L427 ... -R/utils_input_validation.R#L428 required_args <- list(formula, met ... -R/utils_input_validation.R#L429 ... -R/utils_input_validation.R#L430 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L432 } ... -R/utils_input_validation.R#L434 # Check if the formula is a valid ... -R/utils_input_validation.R#L435 if (!is.character(formula) || leng ... -R/utils_input_validation.R#L437 call. = FALSE) ... -R/utils_input_validation.R#L438 } ... -R/utils_input_validation.R#L439 ... -R/utils_input_validation.R#L440 # Ensure the formula contains allo ... -R/utils_input_validation.R#L441 allowed_chars <- "^[~ 1A-Za-z0-9_+ ... -R/utils_input_validation.R#L442 if (!grepl(allowed_chars, formula) ... -R/utils_input_validation.R#L444 call. = FALSE) ... -R/utils_input_validation.R#L445 } ... -R/utils_input_validation.R#L446 ... -R/utils_input_validation.R#L447 # Ensure that the formula begins w ... -R/utils_input_validation.R#L448 # Ignore whitespace, check the sta ... -R/utils_input_validation.R#L449 if (!grepl("^\\s*~\\s*1", formula) ... -R/utils_input_validation.R#L451 paste( ... -R/utils_input_validation.R#L456 call. = FALSE) ... -R/utils_input_validation.R#L457 } ... -R/utils_input_validation.R#L458 ... -R/utils_input_validation.R#L459 # Ensure the formula contains the ... -R/utils_input_validation.R#L460 if (!grepl("\\bX\\b", formula)) { ... -R/utils_input_validation.R#L462 "The design formula must inclu ... -R/utils_input_validation.R#L463 "for the meta Time column" ... -R/utils_input_validation.R#L465 } ... -R/utils_input_validation.R#L466 ... -R/utils_input_validation.R#L467 # Extract terms from the formula ( ... -R/utils_input_validation.R#L468 formula_terms <- unlist(strsplit(g ... -R/utils_input_validation.R#L469 formula_terms <- formula_terms[for ... -R/utils_input_validation.R#L470 ... -R/utils_input_validation.R#L471 # Remove '1' and 'X' from terms si ... -R/utils_input_validation.R#L472 formula_terms <- setdiff(formula_t ... -R/utils_input_validation.R#L473 ... -R/utils_input_validation.R#L474 # Check if the terms are present i ... -R/utils_input_validation.R#L475 missing_columns <- setdiff(formula ... -R/utils_input_validation.R#L476 if (length(missing_columns) > 0) { ... -R/utils_input_validation.R#L478 stop(sprintf("%s (data/meta pa ... -R/utils_input_validation.R#L479 "The following de ... -R/utils_input_validation.R#L480 meta_index, ... -R/utils_input_validation.R#L481 paste(missing_col ... -R/utils_input_validation.R#L482 call. = FALSE) ... -R/utils_input_validation.R#L483 ... -R/utils_input_validation.R#L485 stop(paste("The following desi ... -R/utils_input_validation.R#L486 paste(missing_colum ... -R/utils_input_validation.R#L487 call. = FALSE) ... -R/utils_input_validation.R#L489 } ... -R/utils_input_validation.R#L490 ... -R/utils_input_validation.R#L491 return(TRUE) ... -R/utils_input_validation.R#L505 ... -R/utils_input_validation.R#L506 modes <- self$args[["modes"]] ... -R/utils_input_validation.R#L507 ... -R/utils_input_validation.R#L508 required_args <- list(modes) ... -R/utils_input_validation.R#L509 ... -R/utils_input_validation.R#L510 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L512 } ... -R/utils_input_validation.R#L513 ... -R/utils_input_validation.R#L514 for (mode in modes) { ... -R/utils_input_validation.R#L520 } ... -R/utils_input_validation.R#L534 ... -R/utils_input_validation.R#L535 mode <- self$args[["mode"]] ... -R/utils_input_validation.R#L536 ... -R/utils_input_validation.R#L537 required_args <- list(mode) ... -R/utils_input_validation.R#L538 ... -R/utils_input_validation.R#L539 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L541 } ... -R/utils_input_validation.R#L543 if (mode != "isolated" && mode != ... -R/utils_input_validation.R#L545 "mode must be either 'isolated ... -R/utils_input_validation.R#L546 ) ... -R/utils_input_validation.R#L547 } ... -R/utils_input_validation.R#L565 ... -R/utils_input_validation.R#L566 designs <- self$args$designs ... -R/utils_input_validation.R#L567 metas <- self$args$metas ... -R/utils_input_validation.R#L568 meta_indices <- self$args$meta_ind ... -R/utils_input_validation.R#L569 ... -R/utils_input_validation.R#L570 if (is.null(designs) || is.null(me ... -R/utils_input_validation.R#L572 } ... -R/utils_input_validation.R#L573 ... -R/utils_input_validation.R#L574 for (i in seq_along(designs)) { ... -R/utils_input_validation.R#L578 ifelse(!is.null(meta_indices), ... -R/utils_input_validation.R#L580 } ... -R/utils_input_validation.R#L581 ... -R/utils_input_validation.R#L582 return(TRUE) ... -R/utils_input_validation.R#L602 ... -R/utils_input_validation.R#L603 spline_params <- self$args$spline_ ... -R/utils_input_validation.R#L604 mode <- self$args[["mode"]] ... -R/utils_input_validation.R#L605 meta <- self$args$meta ... -R/utils_input_validation.R#L606 condition <- self$args$condition ... -R/utils_input_validation.R#L607 ... -R/utils_input_validation.R#L608 required_args <- list( ... -R/utils_input_validation.R#L614 ... -R/utils_input_validation.R#L615 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L617 } ... -R/utils_input_validation.R#L618 ... -R/utils_input_validation.R#L619 self$check_spline_params_generally ... -R/utils_input_validation.R#L620 self$check_spline_params_mode_depe ... -R/utils_input_validation.R#L646 ... -R/utils_input_validation.R#L647 spline_test_configs <- self$args$s ... -R/utils_input_validation.R#L648 metas <- self$args$metas ... -R/utils_input_validation.R#L649 ... -R/utils_input_validation.R#L650 required_args <- list(spline_test_ ... -R/utils_input_validation.R#L651 ... -R/utils_input_validation.R#L652 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L654 } ... -R/utils_input_validation.R#L656 self$check_columns_spline_test_con ... -R/utils_input_validation.R#L657 ... -R/utils_input_validation.R#L658 self$check_spline_type_column(spli ... -R/utils_input_validation.R#L659 ... -R/utils_input_validation.R#L660 self$check_spline_type_params(spli ... -R/utils_input_validation.R#L661 ... -R/utils_input_validation.R#L662 self$check_max_and_min_dof( ... -R/utils_input_validation.R#L683 ... -R/utils_input_validation.R#L684 top_tables <- self$args$run_limma_ ... -R/utils_input_validation.R#L685 ... -R/utils_input_validation.R#L686 required_names <- c("time_effect", ... -R/utils_input_validation.R#L687 "avrg_diff_con ... -R/utils_input_validation.R#L688 "interaction_c ... -R/utils_input_validation.R#L689 ... -R/utils_input_validation.R#L690 if (!all(names(top_tables) %in% re ... -R/utils_input_validation.R#L691 length(top_tables) != 3) { ... -R/utils_input_validation.R#L693 'time_effect', 'avrg_diff_condi ... -R/utils_input_validation.R#L694 'interaction_condition_time'", ... -R/utils_input_validation.R#L695 } ... -R/utils_input_validation.R#L696 ... -R/utils_input_validation.R#L697 expected_cols1_3 <- c("X1", "X2", ... -R/utils_input_validation.R#L699 ... -R/utils_input_validation.R#L700 expected_cols2 <- c("logFC", "AveE ... -R/utils_input_validation.R#L701 "B", "feature_ ... -R/utils_input_validation.R#L702 ... -R/utils_input_validation.R#L703 for (df in top_tables$time_effect) ... -R/utils_input_validation.R#L705 } ... -R/utils_input_validation.R#L706 ... -R/utils_input_validation.R#L707 for (df in top_tables$avrg_diff_co ... -R/utils_input_validation.R#L709 } ... -R/utils_input_validation.R#L710 ... -R/utils_input_validation.R#L711 for (df in top_tables$interaction_ ... -R/utils_input_validation.R#L713 } ... -R/utils_input_validation.R#L735 ... -R/utils_input_validation.R#L736 # Exploited argument slicing. ... -R/utils_input_validation.R#L737 adj_pthresholds <- self$args[["adj ... -R/utils_input_validation.R#L739 required_args <- list(adj_pthresho ... -R/utils_input_validation.R#L740 ... -R/utils_input_validation.R#L741 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L743 } ... -R/utils_input_validation.R#L744 ... -R/utils_input_validation.R#L745 if (!is.numeric(adj_pthresholds)) ... -R/utils_input_validation.R#L747 call. = FALSE) ... -R/utils_input_validation.R#L748 } ... -R/utils_input_validation.R#L749 ... -R/utils_input_validation.R#L750 # Check for elements <= 0 ... -R/utils_input_validation.R#L751 if (any(adj_pthresholds <= 0)) { ... -R/utils_input_validation.R#L759 call. = FALSE) ... -R/utils_input_validation.R#L760 } ... -R/utils_input_validation.R#L761 ... -R/utils_input_validation.R#L762 # Check for elements >= 1 ... -R/utils_input_validation.R#L763 if (any(adj_pthresholds >= 1)) { ... -R/utils_input_validation.R#L771 call. = FALSE) ... -R/utils_input_validation.R#L772 } ... -R/utils_input_validation.R#L773 ... -R/utils_input_validation.R#L774 return(TRUE) ... -R/utils_input_validation.R#L790 ... -R/utils_input_validation.R#L791 adj_pthresh_avrg_diff_conditions < ... -R/utils_input_validation.R#L793 ... -R/utils_input_validation.R#L794 adj_pthresh_interaction_condition_ ... -R/utils_input_validation.R#L796 ... -R/utils_input_validation.R#L797 required_args <- list( ... -R/utils_input_validation.R#L801 ... -R/utils_input_validation.R#L802 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L804 } ... -R/utils_input_validation.R#L805 ... -R/utils_input_validation.R#L806 # Check that both arguments are nu ... -R/utils_input_validation.R#L807 if (!all(sapply(required_args, fun ... -R/utils_input_validation.R#L809 }))) { ... -R/utils_input_validation.R#L811 "Both adj_pthresh_avrg_diff_co ... -R/utils_input_validation.R#L812 "adj_pthresh_interaction_condi ... -R/utils_input_validation.R#L813 "be floats between 0 and 1." ... -R/utils_input_validation.R#L814 ) ... -R/utils_input_validation.R#L815 } ... -R/utils_input_validation.R#L835 ... -R/utils_input_validation.R#L836 clusters <- self$args$clusters ... -R/utils_input_validation.R#L837 ... -R/utils_input_validation.R#L838 required_args <- list(clusters) ... -R/utils_input_validation.R#L839 ... -R/utils_input_validation.R#L840 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L842 } ... -R/utils_input_validation.R#L843 ... -R/utils_input_validation.R#L844 # Check if clusters is a single in ... -R/utils_input_validation.R#L845 if (is.numeric(clusters) && all(cl ... -R/utils_input_validation.R#L849 stop("clusters must be a posit ... -R/utils_input_validation.R#L854 stop( ... -R/utils_input_validation.R#L859 } else { ... -R/utils_input_validation.R#L861 "clusters must be a single int ... -R/utils_input_validation.R#L862 call. = FALSE ... -R/utils_input_validation.R#L863 ) ... -R/utils_input_validation.R#L864 } ... -R/utils_input_validation.R#L902 ... -R/utils_input_validation.R#L903 plot_info <- self$args$plot_info ... -R/utils_input_validation.R#L904 meta <- self$args$meta ... -R/utils_input_validation.R#L905 ... -R/utils_input_validation.R#L906 required_args <- list( ... -R/utils_input_validation.R#L910 ... -R/utils_input_validation.R#L911 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L913 } ... -R/utils_input_validation.R#L914 ... -R/utils_input_validation.R#L915 # Check y_axis_label ... -R/utils_input_validation.R#L916 if (!is.character(plot_info$y_axis ... -R/utils_input_validation.R#L917 nchar(plot_info$y_axis_label) ... -R/utils_input_validation.R#L919 "y_axis_label must be a string ... -R/utils_input_validation.R#L920 call. = FALSE ... -R/utils_input_validation.R#L921 ) ... -R/utils_input_validation.R#L922 } ... -R/utils_input_validation.R#L923 ... -R/utils_input_validation.R#L924 # Check time_unit ... -R/utils_input_validation.R#L925 if (!is.character(plot_info$time_u ... -R/utils_input_validation.R#L926 nchar(plot_info$time_unit) > 1 ... -R/utils_input_validation.R#L928 "time_unit must be a string wi ... -R/utils_input_validation.R#L929 call. = FALSE ... -R/utils_input_validation.R#L930 ) ... -R/utils_input_validation.R#L931 } ... -R/utils_input_validation.R#L932 ... -R/utils_input_validation.R#L933 if (!is.na(plot_info$treatment_lab ... -R/utils_input_validation.R#L936 if (!is.character(plot_info$tr ... -R/utils_input_validation.R#L938 "treatment_labels must be ... -R/utils_input_validation.R#L939 call. = FALSE ... -R/utils_input_validation.R#L941 } ... -R/utils_input_validation.R#L942 if (any(nchar(plot_info$treatm ... -R/utils_input_validation.R#L944 paste( ... -R/utils_input_validation.R#L947 call. = FALSE ... -R/utils_input_validation.R#L949 } ... -R/utils_input_validation.R#L954 if (!is.numeric(plot_info$trea ... -R/utils_input_validation.R#L956 "treatment_timepoints must ... -R/utils_input_validation.R#L957 call. = FALSE ... -R/utils_input_validation.R#L959 } ... -R/utils_input_validation.R#L960 if (!any(is.na(plot_info$treat ... -R/utils_input_validation.R#L961 length(plot_info$treatment ... -R/utils_input_validation.R#L962 length(plot_info$treatment ... -R/utils_input_validation.R#L964 paste( ... -R/utils_input_validation.R#L967 call. = FALSE ... -R/utils_input_validation.R#L969 } ... -R/utils_input_validation.R#L976 stop( ... -R/utils_input_validation.R#L978 "All treatment_timepoints ... -R/utils_input_validation.R#L979 max_time), ... -R/utils_input_validation.R#L981 ) ... -R/utils_input_validation.R#L983 } ... -R/utils_input_validation.R#L1008 ... -R/utils_input_validation.R#L1009 report_dir <- self$args[["report_d ... -R/utils_input_validation.R#L1010 ... -R/utils_input_validation.R#L1011 if (is.null(report_dir)) { ... -R/utils_input_validation.R#L1014 } ... -R/utils_input_validation.R#L1015 ... -R/utils_input_validation.R#L1016 required_args <- list(report_dir) ... -R/utils_input_validation.R#L1017 ... -R/utils_input_validation.R#L1018 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L1020 } ... -R/utils_input_validation.R#L1021 ... -R/utils_input_validation.R#L1022 # Attempt to create the directory ... -R/utils_input_validation.R#L1023 if (!file.exists(report_dir)) { ... -R/utils_input_validation.R#L1025 dir.create(report_dir, recursi ... -R/utils_input_validation.R#L1027 stop(sprintf("Warning occurred ... -R/utils_input_validation.R#L1028 w$message), ... -R/utils_input_validation.R#L1029 call. = FALSE) ... -R/utils_input_validation.R#L1031 stop(sprintf("Error occurred w ... -R/utils_input_validation.R#L1032 e$message), ... -R/utils_input_validation.R#L1033 call. = FALSE) ... -R/utils_input_validation.R#L1035 } ... -R/utils_input_validation.R#L1036 ... -R/utils_input_validation.R#L1037 # Verify that the directory exists ... -R/utils_input_validation.R#L1038 if (!file.exists(report_dir) || !f ... -R/utils_input_validation.R#L1040 report_dir), ... -R/utils_input_validation.R#L1041 call. = FALSE) ... -R/utils_input_validation.R#L1042 } ... -R/utils_input_validation.R#L1043 ... -R/utils_input_validation.R#L1044 return(TRUE) ... -R/utils_input_validation.R#L1064 data <- self$args$data ... -R/utils_input_validation.R#L1065 genes <- self$args$genes ... -R/utils_input_validation.R#L1067 required_args <- list(data, genes) ... -R/utils_input_validation.R#L1068 ... -R/utils_input_validation.R#L1069 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L1071 } ... -R/utils_input_validation.R#L1072 ... -R/utils_input_validation.R#L1073 if (!is.character(genes)) { ... -R/utils_input_validation.R#L1075 } ... -R/utils_input_validation.R#L1076 ... -R/utils_input_validation.R#L1077 if (length(genes) != nrow(data)) { ... -R/utils_input_validation.R#L1079 } ... -R/utils_input_validation.R#L1106 ... -R/utils_input_validation.R#L1107 padjust_method <- self$args$padjus ... -R/utils_input_validation.R#L1108 ... -R/utils_input_validation.R#L1109 required_args <- list(padjust_meth ... -R/utils_input_validation.R#L1110 ... -R/utils_input_validation.R#L1111 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L1113 } ... -R/utils_input_validation.R#L1114 ... -R/utils_input_validation.R#L1115 supported_methods <- stats::p.adju ... -R/utils_input_validation.R#L1116 if (!(is.character(padjust_method) ... -R/utils_input_validation.R#L1119 "supported me ... -R/utils_input_validation.R#L1120 paste(support ... -R/utils_input_validation.R#L1121 call. = FALSE) ... -R/utils_input_validation.R#L1122 } ... -R/utils_input_validation.R#L1139 ... -R/utils_input_validation.R#L1140 report_info <- self$args[["report_ ... -R/utils_input_validation.R#L1141 ... -R/utils_input_validation.R#L1142 required_args <- list(report_info) ... -R/utils_input_validation.R#L1143 ... -R/utils_input_validation.R#L1144 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L1146 } ... -R/utils_input_validation.R#L1147 ... -R/utils_input_validation.R#L1148 mandatory_fields <- c( ... -R/utils_input_validation.R#L1156 ... -R/utils_input_validation.R#L1157 all_fields <- c( ... -R/utils_input_validation.R#L1163 ... -R/utils_input_validation.R#L1164 # Check if report_info is a named ... -R/utils_input_validation.R#L1165 if (!is.list(report_info) || is.nu ... -R/utils_input_validation.R#L1167 call. = FALSE) ... -R/utils_input_validation.R#L1168 } ... -R/utils_input_validation.R#L1169 ... -R/utils_input_validation.R#L1170 # Check if all values in report_in ... -R/utils_input_validation.R#L1171 non_string_fields <- sapply(report ... -R/utils_input_validation.R#L1172 if (any(non_string_fields)) { ... -R/utils_input_validation.R#L1175 paste(invalid_fields, ... -R/utils_input_validation.R#L1176 call. = FALSE) ... -R/utils_input_validation.R#L1177 } ... -R/utils_input_validation.R#L1178 ... -R/utils_input_validation.R#L1179 # Check if all mandatory fields ar ... -R/utils_input_validation.R#L1180 missing_fields <- setdiff(mandator ... -R/utils_input_validation.R#L1181 if (length(missing_fields) > 0) { ... -R/utils_input_validation.R#L1183 paste(missing_fields, ... -R/utils_input_validation.R#L1184 call. = FALSE) ... -R/utils_input_validation.R#L1185 } ... -R/utils_input_validation.R#L1186 ... -R/utils_input_validation.R#L1187 # Check if there are any extra fie ... -R/utils_input_validation.R#L1188 extra_fields <- setdiff(names(repo ... -R/utils_input_validation.R#L1189 if (length(extra_fields) > 0) { ... -R/utils_input_validation.R#L1191 paste(extra_fields, c ... -R/utils_input_validation.R#L1192 call. = FALSE) ... -R/utils_input_validation.R#L1193 } ... -R/utils_input_validation.R#L1194 ... -R/utils_input_validation.R#L1195 # Check omics_data_type format ... -R/utils_input_validation.R#L1196 if (!grepl("^[a-zA-Z_]+$", report_ ... -R/utils_input_validation.R#L1198 "letters and undersco ... -R/utils_input_validation.R#L1199 call. = FALSE) ... -R/utils_input_validation.R#L1200 } ... -R/utils_input_validation.R#L1201 ... -R/utils_input_validation.R#L1202 excluded_fields <- c( ... -R/utils_input_validation.R#L1208 excluded_limit <- 700 ... -R/utils_input_validation.R#L1209 ... -R/utils_input_validation.R#L1210 check_long_fields <- function(data ... -R/utils_input_validation.R#L1215 if (any(names(data) %in% exclu ... -R/utils_input_validation.R#L1217 } else { ... -R/utils_input_validation.R#L1219 } ... +R/utils_input_validation.R#L374 check_list_of_dataframes(eleme ... +R/utils_input_validation.R#L376 matches <- gregexpr("_", eleme ... +R/utils_input_validation.R#L377 underscore_count <- sum(vapply ... +R/utils_input_validation.R#L381 )) ... +R/utils_input_validation.R#L383 if (underscore_count != 1) { ... +R/utils_input_validation.R#L385 paste( ... +R/utils_input_validation.R#L392 ), ... +R/utils_input_validation.R#L393 call. = FALSE ... +R/utils_input_validation.R#L395 } ... +R/utils_input_validation.R#L397 self$check_dataframe(element) ... +R/utils_input_validation.R#L399 stop( ... +R/utils_input_validation.R#L401 "top_tables must contain e ... +R/utils_input_validation.R#L402 "data frames" ... +R/utils_input_validation.R#L405 ) ... +R/utils_input_validation.R#L407 } ... +R/utils_input_validation.R#L429 formula <- self$args[["design"]] ... +R/utils_input_validation.R#L430 meta <- self$args[["meta"]] ... +R/utils_input_validation.R#L431 meta_index <- self$args[["meta_ind ... +R/utils_input_validation.R#L433 # Not strictly required ... +R/utils_input_validation.R#L434 meta_batch_column <- self$args[["m ... +R/utils_input_validation.R#L435 meta_batch2_column <- self$args[[" ... +R/utils_input_validation.R#L437 required_args <- list( ... +R/utils_input_validation.R#L440 ) ... +R/utils_input_validation.R#L442 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L444 } ... +R/utils_input_validation.R#L446 # Check if the formula is a valid ... +R/utils_input_validation.R#L447 if (!is.character(formula) || leng ... +R/utils_input_validation.R#L449 call. = FALSE ... +R/utils_input_validation.R#L451 } ... +R/utils_input_validation.R#L453 # Ensure the formula contains allo ... +R/utils_input_validation.R#L454 allowed_chars <- "^[~ 1A-Za-z0-9_+ ... +R/utils_input_validation.R#L455 if (!grepl(allowed_chars, formula) ... +R/utils_input_validation.R#L457 call. = FALSE ... +R/utils_input_validation.R#L459 } ... +R/utils_input_validation.R#L461 # Ensure that the formula begins w ... +R/utils_input_validation.R#L462 # Ignore whitespace, check the sta ... +R/utils_input_validation.R#L463 if (!grepl("^\\s*~\\s*1", formula) ... +R/utils_input_validation.R#L465 paste( ... +R/utils_input_validation.R#L469 ), ... +R/utils_input_validation.R#L470 call. = FALSE ... +R/utils_input_validation.R#L472 } ... +R/utils_input_validation.R#L474 # Ensure the formula contains the ... +R/utils_input_validation.R#L475 if (!grepl("\\bX\\b", formula)) { ... +R/utils_input_validation.R#L477 "The design formula must inclu ... +R/utils_input_validation.R#L478 "for the meta Time column" ... +R/utils_input_validation.R#L480 } ... +R/utils_input_validation.R#L482 # Extract terms from the formula ( ... +R/utils_input_validation.R#L483 formula_terms <- unlist(strsplit(g ... +R/utils_input_validation.R#L484 formula_terms <- formula_terms[for ... +R/utils_input_validation.R#L486 # Remove '1' and 'X' from terms si ... +R/utils_input_validation.R#L487 formula_terms <- setdiff(formula_t ... +R/utils_input_validation.R#L489 # Check if the terms are present i ... +R/utils_input_validation.R#L490 missing_columns <- setdiff(formula ... +R/utils_input_validation.R#L491 if (length(missing_columns) > 0) { ... +R/utils_input_validation.R#L493 stop_call_false(sprintf( ... +R/utils_input_validation.R#L498 )) ... +R/utils_input_validation.R#L500 stop_call_false(paste( ... +R/utils_input_validation.R#L503 )) ... +R/utils_input_validation.R#L505 } ... +R/utils_input_validation.R#L507 # Convert formula to string for re ... +R/utils_input_validation.R#L508 formula_str <- as.character(formul ... +R/utils_input_validation.R#L510 # Check if batch column is provide ... +R/utils_input_validation.R#L511 if (!is.null(meta_batch_column)) { ... +R/utils_input_validation.R#L513 stop_call_false( ... +R/utils_input_validation.R#L515 "The batch effect column", ... +R/utils_input_validation.R#L516 "is provided but not prese ... +R/utils_input_validation.R#L517 "Please ensure that if you ... +R/utils_input_validation.R#L518 "it is included in the des ... +R/utils_input_validation.R#L519 "remove batch effects." ... +R/utils_input_validation.R#L521 ) ... +R/utils_input_validation.R#L523 } ... +R/utils_input_validation.R#L525 # Check if the second batch column ... +R/utils_input_validation.R#L526 if (!is.null(meta_batch2_column)) ... +R/utils_input_validation.R#L528 stop_call_false( ... +R/utils_input_validation.R#L530 "The second batch effect c ... +R/utils_input_validation.R#L531 "is provided but not prese ... +R/utils_input_validation.R#L532 "Please ensure that if you ... +R/utils_input_validation.R#L533 "it is included in the des ... +R/utils_input_validation.R#L534 "to remove batch effects." ... +R/utils_input_validation.R#L536 ) ... +R/utils_input_validation.R#L538 } ... +R/utils_input_validation.R#L540 return(TRUE) ... +R/utils_input_validation.R#L554 modes <- self$args[["modes"]] ... +R/utils_input_validation.R#L556 required_args <- list(modes) ... +R/utils_input_validation.R#L558 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L560 } ... +R/utils_input_validation.R#L562 for (mode in modes) { ... +R/utils_input_validation.R#L568 } ... +R/utils_input_validation.R#L582 mode <- self$args[["mode"]] ... +R/utils_input_validation.R#L584 required_args <- list(mode) ... +R/utils_input_validation.R#L586 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L588 } ... +R/utils_input_validation.R#L590 if (mode != "isolated" && mode != ... +R/utils_input_validation.R#L592 "mode must be either 'isolated ... +R/utils_input_validation.R#L594 } ... +R/utils_input_validation.R#L612 designs <- self$args$designs ... +R/utils_input_validation.R#L613 metas <- self$args$metas ... +R/utils_input_validation.R#L614 meta_indices <- self$args$meta_ind ... +R/utils_input_validation.R#L616 if (is.null(designs) || is.null(me ... +R/utils_input_validation.R#L618 } ... +R/utils_input_validation.R#L620 for (i in seq_along(designs)) { ... +R/utils_input_validation.R#L624 ifelse(!is.null(meta_indices), ... +R/utils_input_validation.R#L626 } ... +R/utils_input_validation.R#L628 return(TRUE) ... +R/utils_input_validation.R#L648 spline_params <- self$args$spline_ ... +R/utils_input_validation.R#L649 mode <- self$args[["mode"]] ... +R/utils_input_validation.R#L650 meta <- self$args$meta ... +R/utils_input_validation.R#L651 condition <- self$args$condition ... +R/utils_input_validation.R#L653 required_args <- list( ... +R/utils_input_validation.R#L658 ) ... +R/utils_input_validation.R#L660 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L662 } ... +R/utils_input_validation.R#L664 self$check_spline_params_generally ... +R/utils_input_validation.R#L665 self$check_spline_params_mode_depe ... +R/utils_input_validation.R#L670 ) ... +R/utils_input_validation.R#L691 spline_test_configs <- self$args$s ... +R/utils_input_validation.R#L692 metas <- self$args$metas ... +R/utils_input_validation.R#L694 required_args <- list(spline_test_ ... +R/utils_input_validation.R#L696 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L698 } ... +R/utils_input_validation.R#L700 self$check_columns_spline_test_con ... +R/utils_input_validation.R#L702 self$check_spline_type_column(spli ... +R/utils_input_validation.R#L704 self$check_spline_type_params(spli ... +R/utils_input_validation.R#L706 self$check_max_and_min_dof( ... +R/utils_input_validation.R#L709 ) ... +R/utils_input_validation.R#L727 top_tables <- self$args$run_limma_ ... +R/utils_input_validation.R#L729 required_names <- c( ... +R/utils_input_validation.R#L733 ) ... +R/utils_input_validation.R#L735 if (!all(names(top_tables) %in% re ... +R/utils_input_validation.R#L738 'time_effect', 'avrg_diff_condi ... +R/utils_input_validation.R#L739 'interaction_condition_time'", ... +R/utils_input_validation.R#L740 } ... +R/utils_input_validation.R#L742 expected_cols1_3 <- c( ... +R/utils_input_validation.R#L745 ) ... +R/utils_input_validation.R#L747 expected_cols2 <- c( ... +R/utils_input_validation.R#L750 ) ... +R/utils_input_validation.R#L752 for (df in top_tables$time_effect) ... +R/utils_input_validation.R#L754 } ... +R/utils_input_validation.R#L756 for (df in top_tables$avrg_diff_co ... +R/utils_input_validation.R#L758 } ... +R/utils_input_validation.R#L760 for (df in top_tables$interaction_ ... +R/utils_input_validation.R#L762 } ... +R/utils_input_validation.R#L784 # Exploited argument slicing. ... +R/utils_input_validation.R#L785 adj_pthresholds <- self$args[["adj ... +R/utils_input_validation.R#L787 required_args <- list(adj_pthresho ... +R/utils_input_validation.R#L789 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L791 } ... +R/utils_input_validation.R#L793 if (!is.numeric(adj_pthresholds)) ... +R/utils_input_validation.R#L795 call. = FALSE ... +R/utils_input_validation.R#L797 } ... +R/utils_input_validation.R#L799 # Check for elements <= 0 ... +R/utils_input_validation.R#L800 if (any(adj_pthresholds <= 0)) { ... +R/utils_input_validation.R#L803 paste0( ... +R/utils_input_validation.R#L810 ), ... +R/utils_input_validation.R#L811 call. = FALSE ... +R/utils_input_validation.R#L813 } ... +R/utils_input_validation.R#L815 # Check for elements >= 1 ... +R/utils_input_validation.R#L816 if (any(adj_pthresholds >= 1)) { ... +R/utils_input_validation.R#L819 paste0( ... +R/utils_input_validation.R#L826 ), ... +R/utils_input_validation.R#L827 call. = FALSE ... +R/utils_input_validation.R#L829 } ... +R/utils_input_validation.R#L831 return(TRUE) ... +R/utils_input_validation.R#L847 adj_pthresh_avrg_diff_conditions < ... +R/utils_input_validation.R#L850 adj_pthresh_interaction_condition_ ... +R/utils_input_validation.R#L853 required_args <- list( ... +R/utils_input_validation.R#L856 ) ... +R/utils_input_validation.R#L858 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L860 } ... +R/utils_input_validation.R#L862 # Check that both arguments are nu ... +R/utils_input_validation.R#L863 if (!all(vapply(required_args, fun ... +R/utils_input_validation.R#L865 }, logical(1)))) { ... +R/utils_input_validation.R#L867 "Both adj_pthresh_avrg_diff_co ... +R/utils_input_validation.R#L868 "adj_pthresh_interaction_condi ... +R/utils_input_validation.R#L869 "be floats between 0 and 1." ... +R/utils_input_validation.R#L871 } ... +R/utils_input_validation.R#L891 clusters <- self$args[["clusters"] ... +R/utils_input_validation.R#L892 meta <- self$args[["meta"]] ... +R/utils_input_validation.R#L893 condition <- self$args[["condition ... +R/utils_input_validation.R#L895 required_args <- list( ... +R/utils_input_validation.R#L899 ) ... +R/utils_input_validation.R#L901 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L903 } ... +R/utils_input_validation.R#L905 # Get the unique number of element ... +R/utils_input_validation.R#L906 unique_conditions <- unique(meta[[ ... +R/utils_input_validation.R#L907 num_unique_conditions <- length(un ... +R/utils_input_validation.R#L909 # Check if clusters is a single in ... +R/utils_input_validation.R#L910 if (is.numeric(clusters) && all(cl ... +R/utils_input_validation.R#L913 stop_call_false( ... +R/utils_input_validation.R#L918 ) ... +R/utils_input_validation.R#L923 stop_call_false("clusters must ... +R/utils_input_validation.R#L928 stop_call_false("All elements ... +R/utils_input_validation.R#L930 } else { ... +R/utils_input_validation.R#L932 "clusters must be a single int ... +R/utils_input_validation.R#L934 } ... +R/utils_input_validation.R#L972 plot_info <- self$args$plot_info ... +R/utils_input_validation.R#L973 meta <- self$args$meta ... +R/utils_input_validation.R#L974 condition_column <- self$args[["co ... +R/utils_input_validation.R#L976 required_args <- list( ... +R/utils_input_validation.R#L980 ) ... +R/utils_input_validation.R#L982 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L984 } ... +R/utils_input_validation.R#L986 # Check y_axis_label ... +R/utils_input_validation.R#L987 if (!is.character(plot_info$y_axis ... +R/utils_input_validation.R#L990 "y_axis_label must be a string ... +R/utils_input_validation.R#L991 call. = FALSE ... +R/utils_input_validation.R#L993 } ... +R/utils_input_validation.R#L995 # Check time_unit ... +R/utils_input_validation.R#L996 if (!is.character(plot_info$time_u ... +R/utils_input_validation.R#L999 "time_unit must be a string wi ... +R/utils_input_validation.R#L1000 call. = FALSE ... +R/utils_input_validation.R#L1002 } ... +R/utils_input_validation.R#L1004 # Ensure treatment_labels and trea ... +R/utils_input_validation.R#L1005 if (!is.list(plot_info$treatment_l ... +R/utils_input_validation.R#L1008 "treatment_labels and treatmen ... +R/utils_input_validation.R#L1009 call. = FALSE ... +R/utils_input_validation.R#L1011 } ... +R/utils_input_validation.R#L1013 # Check if the lists are named or ... +R/utils_input_validation.R#L1014 label_names <- names(plot_info$tre ... +R/utils_input_validation.R#L1015 timepoint_names <- names(plot_info ... +R/utils_input_validation.R#L1017 if (!is.null(label_names) || !is.n ... +R/utils_input_validation.R#L1020 stop( ... +R/utils_input_validation.R#L1024 ) ... +R/utils_input_validation.R#L1029 !all(timepoint_names %in% meta ... +R/utils_input_validation.R#L1030 stop( ... +R/utils_input_validation.R#L1034 ) ... +R/utils_input_validation.R#L1039 stop( ... +R/utils_input_validation.R#L1043 ) ... +R/utils_input_validation.R#L1045 } else { ... +R/utils_input_validation.R#L1048 length(plot_info$treatment_tim ... +R/utils_input_validation.R#L1049 stop( ... +R/utils_input_validation.R#L1053 ) ... +R/utils_input_validation.R#L1055 } ... +R/utils_input_validation.R#L1057 # Check elements of treatment_labe ... +R/utils_input_validation.R#L1058 for (label in plot_info$treatment_ ... +R/utils_input_validation.R#L1060 if (!is.character(label)) { ... +R/utils_input_validation.R#L1062 "All elements of treatment ... +R/utils_input_validation.R#L1063 strings", ... +R/utils_input_validation.R#L1064 call. = FALSE ... +R/utils_input_validation.R#L1066 } ... +R/utils_input_validation.R#L1068 } ... +R/utils_input_validation.R#L1070 # Check elements of treatment_time ... +R/utils_input_validation.R#L1071 for (timepoint in plot_info$treatm ... +R/utils_input_validation.R#L1073 if (!is.numeric(timepoint)) { ... +R/utils_input_validation.R#L1075 "All elements of treatment ... +R/utils_input_validation.R#L1076 call. = FALSE ... +R/utils_input_validation.R#L1078 } ... +R/utils_input_validation.R#L1080 } ... +R/utils_input_validation.R#L1082 # Ensure that the lengths match if ... +R/utils_input_validation.R#L1083 if (!any(is.na(plot_info$treatment ... +R/utils_input_validation.R#L1087 stop( ... +R/utils_input_validation.R#L1091 ) ... +R/utils_input_validation.R#L1093 } ... +R/utils_input_validation.R#L1095 # Ensure treatment_timepoints are ... +R/utils_input_validation.R#L1096 max_time <- max(meta$Time, na.rm = ... +R/utils_input_validation.R#L1097 for (timepoint in plot_info$treatm ... +R/utils_input_validation.R#L1099 stop( ... +R/utils_input_validation.R#L1101 "All treatment_timepoints ... +R/utils_input_validation.R#L1102 max_time ... +R/utils_input_validation.R#L1105 ) ... +R/utils_input_validation.R#L1107 } ... +R/utils_input_validation.R#L1122 plot_options <- self$args[["plot_o ... +R/utils_input_validation.R#L1123 meta <- self$args[["meta"]] ... +R/utils_input_validation.R#L1125 required_args <- list( ... +R/utils_input_validation.R#L1128 ) ... +R/utils_input_validation.R#L1130 # Check if any required arguments ... +R/utils_input_validation.R#L1131 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L1133 } ... +R/utils_input_validation.R#L1135 # Ensure at least one of the requi ... +R/utils_input_validation.R#L1136 if (!any(c("meta_replicate_column" ... +R/utils_input_validation.R#L1138 } ... +R/utils_input_validation.R#L1140 # Check if meta_replicate_column i ... +R/utils_input_validation.R#L1141 if ("meta_replicate_column" %in% n ... +R/utils_input_validation.R#L1143 length(plot_options[["meta_rep ... +R/utils_input_validation.R#L1144 stop_call_false("'meta_replica ... +R/utils_input_validation.R#L1148 stop_call_false( ... +R/utils_input_validation.R#L1151 ) ... +R/utils_input_validation.R#L1153 } ... +R/utils_input_validation.R#L1155 # Check if cluster_heatmap_columns ... +R/utils_input_validation.R#L1156 if ("cluster_heatmap_columns" %in% ... +R/utils_input_validation.R#L1158 length(plot_options[["cluster_ ... +R/utils_input_validation.R#L1159 stop_call_false("'cluster_heat ... +R/utils_input_validation.R#L1161 } ... +R/utils_input_validation.R#L1186 report_dir <- self$args[["report_d ... +R/utils_input_validation.R#L1188 if (is.null(report_dir)) { ... +R/utils_input_validation.R#L1191 } ... +R/utils_input_validation.R#L1193 required_args <- list(report_dir) ... +R/utils_input_validation.R#L1195 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L1197 } ... +R/utils_input_validation.R#L1199 # Attempt to create the directory ... +R/utils_input_validation.R#L1200 if (!file.exists(report_dir)) { ... +R/utils_input_validation.R#L1202 { ... +R/utils_input_validation.R#L1204 }, ... +R/utils_input_validation.R#L1205 warning = function(w) { ... +R/utils_input_validation.R#L1207 sprintf( ... +R/utils_input_validation.R#L1210 ) ... +R/utils_input_validation.R#L1212 }, ... +R/utils_input_validation.R#L1213 error = function(e) { ... +R/utils_input_validation.R#L1215 sprintf( ... +R/utils_input_validation.R#L1218 ) ... +R/utils_input_validation.R#L1220 } ... R/utils_input_validation.R#L1222 } ... -R/utils_input_validation.R#L1223 ... -R/utils_input_validation.R#L1224 # Check if any field exceeds 70 ch ... -R/utils_input_validation.R#L1225 long_fields <- check_long_fields( ... -R/utils_input_validation.R#L1230 ... -R/utils_input_validation.R#L1231 if (any(long_fields)) { ... -R/utils_input_validation.R#L1234 paste(too_long_fields ... -R/utils_input_validation.R#L1235 sep = "\n"), call. = ... -R/utils_input_validation.R#L1236 } ... -R/utils_input_validation.R#L1237 ... -R/utils_input_validation.R#L1238 return(TRUE) ... -R/utils_input_validation.R#L1268 feature_name_columns <- self$args[ ... -R/utils_input_validation.R#L1269 annotation <- self$args[["annotati ... -R/utils_input_validation.R#L1271 required_args <- list( ... -R/utils_input_validation.R#L1276 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L1278 } ... -R/utils_input_validation.R#L1280 # Check if every element in featur ... -R/utils_input_validation.R#L1281 # of length 1 ... -R/utils_input_validation.R#L1282 if ( ... -R/utils_input_validation.R#L1284 sapply( ... -R/utils_input_validation.R#L1287 ) ... -R/utils_input_validation.R#L1290 paste("All elements of feature ... -R/utils_input_validation.R#L1292 call. = FALSE ... -R/utils_input_validation.R#L1293 ) ... -R/utils_input_validation.R#L1294 } ... -R/utils_input_validation.R#L1296 # Check if all elements of feature ... -R/utils_input_validation.R#L1297 # in annotation ... -R/utils_input_validation.R#L1298 if (!all(feature_name_columns %in% ... -R/utils_input_validation.R#L1300 paste( ... -R/utils_input_validation.R#L1303 call. = FALSE ... -R/utils_input_validation.R#L1304 ) ... -R/utils_input_validation.R#L1305 } ... -R/utils_input_validation.R#L1325 report <- self$args[["report"]] ... -R/utils_input_validation.R#L1327 required_args <- list(report) ... -R/utils_input_validation.R#L1329 if (any(sapply(required_args, is.n ... -R/utils_input_validation.R#L1331 } ... -R/utils_input_validation.R#L1333 if (!rlang::is_bool(report)) { ... -R/utils_input_validation.R#L1335 } ... -R/utils_input_validation.R#L1337 ) ... -R/utils_input_validation.R#L1353 inherit = Level3Functions, ... -R/utils_input_validation.R#L1355 public = list( ... -R/utils_input_validation.R#L1357 #' Check Data Matrix ... -R/utils_input_validation.R#L1358 #' ... -R/utils_input_validation.R#L1359 #' @description ... -R/utils_input_validation.R#L1360 #' This function checks the validity ... -R/utils_input_validation.R#L1361 #' is a ... -R/utils_input_validation.R#L1362 #' matrix, contains only numeric valu ... -R/utils_input_validation.R#L1363 #' has no missing values, and all ele ... -R/utils_input_validation.R#L1364 #' verifies that no rows or columns a ... -R/utils_input_validation.R#L1365 #' entirely zeros. ... -R/utils_input_validation.R#L1366 #' ... -R/utils_input_validation.R#L1367 #' @param data A dataframe containing ... -R/utils_input_validation.R#L1368 #' @param data_meta_index An optional ... -R/utils_input_validation.R#L1369 #' data ... -R/utils_input_validation.R#L1370 #' for error messages. Default is NA. ... -R/utils_input_validation.R#L1371 #' ... -R/utils_input_validation.R#L1372 #' @return Returns TRUE if all checks ... -R/utils_input_validation.R#L1373 #' error ... -R/utils_input_validation.R#L1374 #' message if any check fails. ... -R/utils_input_validation.R#L1375 #' ... -R/utils_input_validation.R#L1376 check_data = function( ... -R/utils_input_validation.R#L1381 if (!is.matrix(data) || !is.numeric ... -R/utils_input_validation.R#L1382 stop( ... -R/utils_input_validation.R#L1383 self$create_error_message( ... -R/utils_input_validation.R#L1384 "data must be a numeric matri ... -R/utils_input_validation.R#L1385 data_meta_index ... -R/utils_input_validation.R#L1386 ), ... -R/utils_input_validation.R#L1387 call. = FALSE ... -R/utils_input_validation.R#L1388 ) ... -R/utils_input_validation.R#L1389 } ... -R/utils_input_validation.R#L1391 # Check for missing values ... -R/utils_input_validation.R#L1392 if (any(is.na(data))) { ... -R/utils_input_validation.R#L1393 stop(self$create_error_message( ... -R/utils_input_validation.R#L1394 "data must not contain missing ... -R/utils_input_validation.R#L1395 data_meta_index ... -R/utils_input_validation.R#L1396 ), ... -R/utils_input_validation.R#L1398 } ... -R/utils_input_validation.R#L1400 # Check for non-negative values ... -R/utils_input_validation.R#L1401 if (any(data < 0)) { ... -R/utils_input_validation.R#L1402 stop( ... -R/utils_input_validation.R#L1403 self$create_error_message( ... -R/utils_input_validation.R#L1404 paste( ... -R/utils_input_validation.R#L1405 "All elements of data must ... -R/utils_input_validation.R#L1406 "represent concentrations, ... -R/utils_input_validation.R#L1407 "intensities (which are inh ... -R/utils_input_validation.R#L1408 ), ... -R/utils_input_validation.R#L1411 } ... -R/utils_input_validation.R#L1413 # Check for rows with all zeros ... -R/utils_input_validation.R#L1414 if (any(rowSums(data) == 0)) { ... -R/utils_input_validation.R#L1415 stop( ... -R/utils_input_validation.R#L1416 self$create_error_message( ... -R/utils_input_validation.R#L1417 "data must not contain rows w ... -R/utils_input_validation.R#L1418 data_meta_index), ... -R/utils_input_validation.R#L1420 } ... -R/utils_input_validation.R#L1422 # Check for columns with all zeros ... -R/utils_input_validation.R#L1423 if (any(colSums(data) == 0)) { ... -R/utils_input_validation.R#L1424 stop(self$create_error_message(pa ... -R/utils_input_validation.R#L1425 "data must not contain columns ... -R/utils_input_validation.R#L1426 da ... -R/utils_input_validation.R#L1428 } ... -R/utils_input_validation.R#L1430 # Check if row headers (rownames) a ... -R/utils_input_validation.R#L1431 row_headers <- rownames(data) ... -R/utils_input_validation.R#L1432 if (is.null(row_headers)) { ... -R/utils_input_validation.R#L1433 stop(self$create_error_message( ... -R/utils_input_validation.R#L1434 "The data matrix must have row ... -R/utils_input_validation.R#L1435 data_meta_index), ... -R/utils_input_validation.R#L1436 call. = FALSE) ... -R/utils_input_validation.R#L1437 } ... -R/utils_input_validation.R#L1439 return(TRUE) ... -R/utils_input_validation.R#L1440 }, ... -R/utils_input_validation.R#L1443 #' Check Metadata ... -R/utils_input_validation.R#L1444 #' ... -R/utils_input_validation.R#L1445 #' @description ... -R/utils_input_validation.R#L1446 #' This function checks the validity ... -R/utils_input_validation.R#L1447 #' contains the 'Time' column, ... -R/utils_input_validation.R#L1448 #' does not contain missing values, a ... -R/utils_input_validation.R#L1449 #' is ... -R/utils_input_validation.R#L1450 #' valid and of the appropriate type. ... -R/utils_input_validation.R#L1451 #' Additionally, it checks for an opt ... -R/utils_input_validation.R#L1452 #' messages regarding its use. ... -R/utils_input_validation.R#L1453 #' ... -R/utils_input_validation.R#L1454 #' @param meta A dataframe containing ... -R/utils_input_validation.R#L1455 #' column. ... -R/utils_input_validation.R#L1456 #' @param condition A single characte ... -R/utils_input_validation.R#L1457 #' in the ... -R/utils_input_validation.R#L1458 #' meta dataframe to be checked. ... -R/utils_input_validation.R#L1459 #' @param meta_batch_column An option ... -R/utils_input_validation.R#L1460 #' name in ... -R/utils_input_validation.R#L1461 #' the meta dataframe used to remove ... -R/utils_input_validation.R#L1462 #' @param meta_batch2_column An optio ... -R/utils_input_validation.R#L1463 #' name in ... -R/utils_input_validation.R#L1464 #' the meta dataframe used to remove ... -R/utils_input_validation.R#L1465 #' @param data_meta_index An optional ... -R/utils_input_validation.R#L1466 #' data/meta pair for error messages. ... -R/utils_input_validation.R#L1467 #' ... -R/utils_input_validation.R#L1468 #' @return Returns TRUE if all checks ... -R/utils_input_validation.R#L1469 #' error message if any check fails. ... -R/utils_input_validation.R#L1470 #' ... -R/utils_input_validation.R#L1471 check_meta = function( ... -R/utils_input_validation.R#L1479 if (!is.data.frame(meta) || ... -R/utils_input_validation.R#L1480 !"Time" %in% names(meta) || ... -R/utils_input_validation.R#L1481 !is.numeric(meta[["Time"]])) { ... -R/utils_input_validation.R#L1482 stop(self$create_error_message( ... -R/utils_input_validation.R#L1483 paste("meta must be a dataframe ... -R/utils_input_validation.R#L1484 data_meta_index ... -R/utils_input_validation.R#L1485 ), ... -R/utils_input_validation.R#L1486 call. = FALSE) ... -R/utils_input_validation.R#L1487 } ... -R/utils_input_validation.R#L1489 if (any(is.na(meta))) { ... -R/utils_input_validation.R#L1490 stop(self$create_error_message( ... -R/utils_input_validation.R#L1491 "meta must not contain missing ... -R/utils_input_validation.R#L1492 data_meta_index ... -R/utils_input_validation.R#L1493 ), ... -R/utils_input_validation.R#L1494 call. = FALSE) ... -R/utils_input_validation.R#L1495 } ... -R/utils_input_validation.R#L1497 # Check if condition is a single ch ... -R/utils_input_validation.R#L1498 if (!is.character(condition) || len ... -R/utils_input_validation.R#L1499 stop("'condition' must be a singl ... -R/utils_input_validation.R#L1501 } ... -R/utils_input_validation.R#L1503 # Check if condition is a column in ... -R/utils_input_validation.R#L1504 if (!condition %in% colnames(meta)) ... -R/utils_input_validation.R#L1505 stop(self$create_error_message( ... -R/utils_input_validation.R#L1506 sprintf( ... -R/utils_input_validation.R#L1507 "The condition '%s' is not a ... -R/utils_input_validation.R#L1508 condition, ... -R/utils_input_validation.R#L1509 paste("column in meta") ... -R/utils_input_validation.R#L1510 ), ... -R/utils_input_validation.R#L1511 data_meta_index), call. = FALSE ... -R/utils_input_validation.R#L1512 } ... -R/utils_input_validation.R#L1514 # Check if the factor column is of ... -R/utils_input_validation.R#L1515 if (!is.factor(meta[[condition]]) & ... -R/utils_input_validation.R#L1516 !is.character(meta[[condition]] ... -R/utils_input_validation.R#L1517 stop(self$create_error_message( ... -R/utils_input_validation.R#L1518 sprintf("The factor column '%s' m ... -R/utils_input_validation.R#L1519 factor or character.", ... -R/utils_input_validation.R#L1520 da ... -R/utils_input_validation.R#L1522 } ... -R/utils_input_validation.R#L1524 # Check condition and time pattern ... -R/utils_input_validation.R#L1525 self$check_condition_time_consisten ... -R/utils_input_validation.R#L1527 if (!is.character(meta_batch2_colum ... -R/utils_input_validation.R#L1528 meta_batch2_column <- NULL ... -R/utils_input_validation.R#L1529 } ... -R/utils_input_validation.R#L1531 if (is.null(meta_batch_column) && ! ... -R/utils_input_validation.R#L1532 stop(paste("For removing the batc ... -R/utils_input_validation.R#L1533 "batch is used!"), cal ... -R/utils_input_validation.R#L1534 } ... -R/utils_input_validation.R#L1536 if (!is.null(meta_batch_column)) { ... -R/utils_input_validation.R#L1537 if (is.character(meta_batch_colum ... -R/utils_input_validation.R#L1539 if (meta_batch_column == "Time" ... -R/utils_input_validation.R#L1540 stop(paste("meta_batch_column ... -R/utils_input_validation.R#L1542 } ... -R/utils_input_validation.R#L1544 self$check_batch_column( ... -R/utils_input_validation.R#L1545 meta, ... -R/utils_input_validation.R#L1546 meta_batch_column, ... -R/utils_input_validation.R#L1547 data_meta_index ... -R/utils_input_validation.R#L1548 ) ... -R/utils_input_validation.R#L1549 } else { ... -R/utils_input_validation.R#L1550 stop( ... -R/utils_input_validation.R#L1551 "meta_batch_column must be a ... -R/utils_input_validation.R#L1552 call. = FALSE ... -R/utils_input_validation.R#L1553 ) ... -R/utils_input_validation.R#L1554 } ... -R/utils_input_validation.R#L1555 } ... -R/utils_input_validation.R#L1557 if (!is.null(meta_batch2_column)) { ... -R/utils_input_validation.R#L1558 if (is.character(meta_batch2_colu ... -R/utils_input_validation.R#L1560 if (meta_batch2_column == "Time" ... -R/utils_input_validation.R#L1561 stop(paste("meta_batch2_column ... -R/utils_input_validation.R#L1562 call. = FALSE) ... -R/utils_input_validation.R#L1563 } ... -R/utils_input_validation.R#L1565 if (meta_batch_column == meta_bat ... -R/utils_input_validation.R#L1566 stop(paste("meta_batch_column m ... -R/utils_input_validation.R#L1568 call. = FALSE) ... -R/utils_input_validation.R#L1569 } ... -R/utils_input_validation.R#L1571 self$check_batch_column(meta, ... -R/utils_input_validation.R#L1572 meta_batc ... -R/utils_input_validation.R#L1573 data_meta ... -R/utils_input_validation.R#L1574 } else { ... -R/utils_input_validation.R#L1575 stop( ... -R/utils_input_validation.R#L1576 "meta_batch2_column must be a ... -R/utils_input_validation.R#L1577 call. = FALSE ... -R/utils_input_validation.R#L1578 ) ... -R/utils_input_validation.R#L1579 } ... -R/utils_input_validation.R#L1580 } ... -R/utils_input_validation.R#L1582 return(TRUE) ... -R/utils_input_validation.R#L1583 }, ... -R/utils_input_validation.R#L1586 #' Check Dataframe ... -R/utils_input_validation.R#L1587 #' ... -R/utils_input_validation.R#L1588 #' @description ... -R/utils_input_validation.R#L1589 #' Validates that the dataframe conta ... -R/utils_input_validation.R#L1590 #' correct data types. ... -R/utils_input_validation.R#L1591 #' ... -R/utils_input_validation.R#L1592 #' @param df A dataframe to check. ... -R/utils_input_validation.R#L1593 #' ... -R/utils_input_validation.R#L1594 #' @return TRUE if the dataframe is v ... -R/utils_input_validation.R#L1595 #' ... -R/utils_input_validation.R#L1596 check_dataframe = function(df) { ... -R/utils_input_validation.R#L1598 # Define the required columns and t ... -R/utils_input_validation.R#L1599 required_columns <- list( ... -R/utils_input_validation.R#L1600 AveExpr = "numeric", ... -R/utils_input_validation.R#L1601 P.Value = "numeric", ... -R/utils_input_validation.R#L1602 adj.P.Val = "numeric", ... -R/utils_input_validation.R#L1603 feature_nr = "integer", ... -R/utils_input_validation.R#L1604 feature_names = "character", ... -R/utils_input_validation.R#L1605 intercept = "numeric" ... -R/utils_input_validation.R#L1606 ) ... -R/utils_input_validation.R#L1608 # Check if all required columns are ... -R/utils_input_validation.R#L1609 missing_columns <- setdiff(names(re ... -R/utils_input_validation.R#L1610 if (length(missing_columns) > 0) { ... -R/utils_input_validation.R#L1611 stop(paste("Missing columns in to ... -R/utils_input_validation.R#L1612 paste(missing_columns, ... -R/utils_input_validation.R#L1614 } ... -R/utils_input_validation.R#L1616 # Check if columns have the correct ... -R/utils_input_validation.R#L1617 for (col in names(required_columns) ... -R/utils_input_validation.R#L1618 if (!inherits(df[[col]], required ... -R/utils_input_validation.R#L1619 stop(paste("top_table column", ... -R/utils_input_validation.R#L1621 call. = FALSE) ... -R/utils_input_validation.R#L1622 } ... -R/utils_input_validation.R#L1623 } ... -R/utils_input_validation.R#L1625 return(TRUE) ... -R/utils_input_validation.R#L1626 }, ... -R/utils_input_validation.R#L1629 #' Check Spline Parameters Generally ... -R/utils_input_validation.R#L1630 #' ... -R/utils_input_validation.R#L1631 #' @description ... -R/utils_input_validation.R#L1632 #' Validates the general structure an ... -R/utils_input_validation.R#L1633 #' ... -R/utils_input_validation.R#L1634 #' @param spline_params A list of spl ... -R/utils_input_validation.R#L1635 #' ... -R/utils_input_validation.R#L1636 #' @return No return value, called fo ... -R/utils_input_validation.R#L1637 #' ... -R/utils_input_validation.R#L1638 check_spline_params_generally = funct ... -R/utils_input_validation.R#L1640 allowed_fields <- c("spline_type", ... -R/utils_input_validation.R#L1642 if (!all(names(spline_params) %in% ... -R/utils_input_validation.R#L1643 stop( ... -R/utils_input_validation.R#L1644 paste( ... -R/utils_input_validation.R#L1645 "spline_params contains inval ... -R/utils_input_validation.R#L1646 "'degree', and 'dof' are allo ... -R/utils_input_validation.R#L1647 ), call. = FALSE ... -R/utils_input_validation.R#L1648 ) ... -R/utils_input_validation.R#L1649 } ... -R/utils_input_validation.R#L1651 # Check if spline_type exists and c ... -R/utils_input_validation.R#L1652 if ("spline_type" %in% names(spline ... -R/utils_input_validation.R#L1653 if (!all(spline_params$spline_typ ... -R/utils_input_validation.R#L1654 stop( ... -R/utils_input_validation.R#L1655 paste( ... -R/utils_input_validation.R#L1658 call. = FALSE ... -R/utils_input_validation.R#L1659 ) ... -R/utils_input_validation.R#L1660 } ... -R/utils_input_validation.R#L1661 } else { ... -R/utils_input_validation.R#L1662 stop("spline_type is missing in s ... -R/utils_input_validation.R#L1663 } ... -R/utils_input_validation.R#L1665 # Check if degree exists and is an ... -R/utils_input_validation.R#L1666 # and NA for natural splines ... -R/utils_input_validation.R#L1667 if ("degree" %in% names(spline_para ... -R/utils_input_validation.R#L1668 for (i in seq_along(spline_params ... -R/utils_input_validation.R#L1669 if (spline_params$spline_type[i ... -R/utils_input_validation.R#L1670 (!is.integer(spline_params$ ... -R/utils_input_validation.R#L1671 || is.na(spline_params$deg ... -R/utils_input_validation.R#L1672 stop( ... -R/utils_input_validation.R#L1673 paste( ... -R/utils_input_validation.R#L1674 "Degree must be specified ... -R/utils_input_validation.R#L1675 "B-splines in spline_para ... -R/utils_input_validation.R#L1676 ), ... -R/utils_input_validation.R#L1677 call. = FALSE) ... -R/utils_input_validation.R#L1678 } ... -R/utils_input_validation.R#L1679 if (spline_params$spline_type[i ... -R/utils_input_validation.R#L1680 && !is.na(spline_params$deg ... -R/utils_input_validation.R#L1681 stop( ... -R/utils_input_validation.R#L1682 paste( ... -R/utils_input_validation.R#L1683 "Degree must be NA for na ... -R/utils_input_validation.R#L1684 "splines in spline_params ... -R/utils_input_validation.R#L1685 ), ... -R/utils_input_validation.R#L1686 call. = FALSE) ... -R/utils_input_validation.R#L1687 } ... -R/utils_input_validation.R#L1688 } ... -R/utils_input_validation.R#L1689 } else if (all(spline_params$spline ... -R/utils_input_validation.R#L1690 stop("degree is missing in spline ... -R/utils_input_validation.R#L1691 } ... -R/utils_input_validation.R#L1693 # Check if dof exists and is an int ... -R/utils_input_validation.R#L1694 if ("dof" %in% names(spline_params) ... -R/utils_input_validation.R#L1695 if (!all(spline_params$dof == as. ... -R/utils_input_validation.R#L1696 stop("dof must be an integer ve ... -R/utils_input_validation.R#L1697 } ... -R/utils_input_validation.R#L1698 # Check for B-splines that dof is ... -R/utils_input_validation.R#L1699 for (i in seq_along(spline_params ... -R/utils_input_validation.R#L1700 if (spline_params$spline_type[i ... -R/utils_input_validation.R#L1701 && spline_params$dof[i] < 3 ... -R/utils_input_validation.R#L1702 stop( ... -R/utils_input_validation.R#L1703 paste("B-splines require Do ... -R/utils_input_validation.R#L1704 call. = FALSE ... -R/utils_input_validation.R#L1705 ) ... -R/utils_input_validation.R#L1706 } ... -R/utils_input_validation.R#L1707 } ... -R/utils_input_validation.R#L1708 } else { ... -R/utils_input_validation.R#L1709 stop("dof is missing in spline_pa ... -R/utils_input_validation.R#L1710 } ... -R/utils_input_validation.R#L1711 }, ... -R/utils_input_validation.R#L1714 #' Check Spline Parameters Mode Depen ... -R/utils_input_validation.R#L1715 #' ... -R/utils_input_validation.R#L1716 #' @description ... -R/utils_input_validation.R#L1717 #' Validates the spline parameters de ... -R/utils_input_validation.R#L1718 #' ... -R/utils_input_validation.R#L1719 #' @param spline_params A list of spl ... -R/utils_input_validation.R#L1720 #' @param mode A character string spe ... -R/utils_input_validation.R#L1721 #' ('integrated' or 'isola ... -R/utils_input_validation.R#L1722 #' @param meta A dataframe containing ... -R/utils_input_validation.R#L1723 #' @param condition A character strin ... -R/utils_input_validation.R#L1724 #' ... -R/utils_input_validation.R#L1725 #' @return No return value, called fo ... -R/utils_input_validation.R#L1726 #' ... -R/utils_input_validation.R#L1727 check_spline_params_mode_dependent = ... -R/utils_input_validation.R#L1733 if (mode == "integrated") { ... -R/utils_input_validation.R#L1734 # Check that all parameters in sp ... -R/utils_input_validation.R#L1735 # one "logical" element ... -R/utils_input_validation.R#L1736 if (any(sapply(spline_params, fun ... -R/utils_input_validation.R#L1737 # Atomic vectors (like numeric ... -R/utils_input_validation.R#L1738 # should count as 1 element ... -R/utils_input_validation.R#L1739 !is.atomic(x) && length(x) != 1 ... -R/utils_input_validation.R#L1740 }))) { ... -R/utils_input_validation.R#L1741 stop(paste( ... -R/utils_input_validation.R#L1742 "All parameters in spline_par ... -R/utils_input_validation.R#L1743 "when mode is 'integrated'.", ... -R/utils_input_validation.R#L1744 "Different spline parameters ... -R/utils_input_validation.R#L1745 "supported for this mode." ... -R/utils_input_validation.R#L1746 ), call. = FALSE) ... -R/utils_input_validation.R#L1747 } ... -R/utils_input_validation.R#L1749 # # Additional check for 'knots' ... -R/utils_input_validation.R#L1750 # if ("knots" %in% names(spline_p ... -R/utils_input_validation.R#L1751 # # Check if 'knots' is atomic ... -R/utils_input_validation.R#L1752 # if (!(is.atomic(spline_params ... -R/utils_input_validation.R#L1753 # stop( ... -R/utils_input_validation.R#L1754 # paste( ... -R/utils_input_validation.R#L1755 # "All elements in 'knots ... -R/utils_input_validation.R#L1756 # "or NA when mode is 'in ... -R/utils_input_validation.R#L1757 # "Different spline param ... -R/utils_input_validation.R#L1758 # "supported for this mod ... -R/utils_input_validation.R#L1759 # ), ... -R/utils_input_validation.R#L1760 # call. = FALSE ... -R/utils_input_validation.R#L1761 # ) ... -R/utils_input_validation.R#L1762 # } ... -R/utils_input_validation.R#L1763 # } ... -R/utils_input_validation.R#L1764 # ... -R/utils_input_validation.R#L1765 # if ("bknots" %in% names(spline_ ... -R/utils_input_validation.R#L1766 # # Check if 'bknots' is atomic ... -R/utils_input_validation.R#L1767 # if (!(is.atomic(spline_params ... -R/utils_input_validation.R#L1768 # all(is.na(spline_params ... -R/utils_input_validation.R#L1769 # stop( ... -R/utils_input_validation.R#L1770 # paste( ... -R/utils_input_validation.R#L1771 # "All elements in 'bknot ... -R/utils_input_validation.R#L1772 # "NA when mode is 'integ ... -R/utils_input_validation.R#L1773 # "Different spline param ... -R/utils_input_validation.R#L1774 # "supported for this mod ... -R/utils_input_validation.R#L1775 # ), ... -R/utils_input_validation.R#L1776 # call. = FALSE ... -R/utils_input_validation.R#L1777 # ) ... -R/utils_input_validation.R#L1778 # } ... -R/utils_input_validation.R#L1779 # } ... -R/utils_input_validation.R#L1782 } else if (mode == "isolated") { ... -R/utils_input_validation.R#L1783 num_levels <- length(unique(meta[ ... -R/utils_input_validation.R#L1784 if (any(sapply(spline_params, l ... -R/utils_input_validation.R#L1785 stop(paste( ... -R/utils_input_validation.R#L1786 "Each vector or list in spl ... -R/utils_input_validation.R#L1787 "elements as there are uniq ... -R/utils_input_validation.R#L1788 "column of meta when mode i ... -R/utils_input_validation.R#L1789 ), ... -R/utils_input_validation.R#L1791 } ... -R/utils_input_validation.R#L1792 # if ("knots" %in% names(spline_p ... -R/utils_input_validation.R#L1793 # if (length(spline_params$knot ... -R/utils_input_validation.R#L1794 # stop( ... -R/utils_input_validation.R#L1795 # paste("'knots' in spline_ ... -R/utils_input_validation.R#L1796 # "elements as there ... -R/utils_input_validation.R#L1797 # "column of meta whe ... -R/utils_input_validation.R#L1798 # call. = FALSE) ... -R/utils_input_validation.R#L1799 # } ... -R/utils_input_validation.R#L1800 # } ... -R/utils_input_validation.R#L1801 # if ("bknots" %in% names(spline_ ... -R/utils_input_validation.R#L1802 # if (length(spline_params$bkno ... -R/utils_input_validation.R#L1803 # stop( ... -R/utils_input_validation.R#L1804 # paste("'bknots' in spline ... -R/utils_input_validation.R#L1805 # "elements as there ... -R/utils_input_validation.R#L1806 # "column of meta whe ... -R/utils_input_validation.R#L1807 # call. = FALSE) ... -R/utils_input_validation.R#L1808 # } ... -R/utils_input_validation.R#L1809 # } ... -R/utils_input_validation.R#L1810 } ... -R/utils_input_validation.R#L1811 }, ... -R/utils_input_validation.R#L1814 #' Check Columns in Spline Test Confi ... -R/utils_input_validation.R#L1815 #' ... -R/utils_input_validation.R#L1816 #' @description ... -R/utils_input_validation.R#L1817 #' Validates that the spline test con ... -R/utils_input_validation.R#L1818 #' in the correct order. ... -R/utils_input_validation.R#L1819 #' ... -R/utils_input_validation.R#L1820 #' @param spline_test_configs A dataf ... -R/utils_input_validation.R#L1821 #' configurations. ... -R/utils_input_validation.R#L1822 #' ... -R/utils_input_validation.R#L1823 #' @return No return value, called fo ... -R/utils_input_validation.R#L1824 #' ... -R/utils_input_validation.R#L1825 #' @keywords internal ... -R/utils_input_validation.R#L1826 #' ... -R/utils_input_validation.R#L1827 check_columns_spline_test_configs = f ... -R/utils_input_validation.R#L1829 required_columns <- c( ... -R/utils_input_validation.R#L1830 "spline_type", ... -R/utils_input_validation.R#L1831 "degree", ... -R/utils_input_validation.R#L1832 "dof" ... -R/utils_input_validation.R#L1833 # "knots", ... -R/utils_input_validation.R#L1834 # "bknots" ... -R/utils_input_validation.R#L1835 ) ... -R/utils_input_validation.R#L1837 # Check for exact match of column n ... -R/utils_input_validation.R#L1838 if (!identical(names(spline_test_co ... -R/utils_input_validation.R#L1839 # Find the missing or extra colum ... -R/utils_input_validation.R#L1840 missing_columns <- setdiff(requir ... -R/utils_input_validation.R#L1841 extra_columns <- setdiff(names(sp ... -R/utils_input_validation.R#L1842 error_message <- "Error: Incorrec ... -R/utils_input_validation.R#L1844 # Append specific issues to the e ... -R/utils_input_validation.R#L1845 if (length(missing_columns) > 0) ... -R/utils_input_validation.R#L1846 error_message <- paste0(error_m ... -R/utils_input_validation.R#L1847 paste(m ... -R/utils_input_validation.R#L1848 } ... -R/utils_input_validation.R#L1849 if (length(extra_columns) > 0) { ... -R/utils_input_validation.R#L1850 error_message <- paste0(error_m ... -R/utils_input_validation.R#L1851 paste(e ... -R/utils_input_validation.R#L1852 } ... -R/utils_input_validation.R#L1853 error_message <- paste0(error_mes ... -R/utils_input_validation.R#L1854 "Expected ... -R/utils_input_validation.R#L1855 paste(req ... -R/utils_input_validation.R#L1857 stop(error_message) ... -R/utils_input_validation.R#L1858 } ... -R/utils_input_validation.R#L1859 }, ... -R/utils_input_validation.R#L1862 #' Check Spline Type Column ... -R/utils_input_validation.R#L1863 #' ... -R/utils_input_validation.R#L1864 #' @description ... -R/utils_input_validation.R#L1865 #' Validates that the 'spline_type' c ... -R/utils_input_validation.R#L1866 #' contains only 'n' or 'b'. ... -R/utils_input_validation.R#L1867 #' ... -R/utils_input_validation.R#L1868 #' @param spline_test_configs A dataf ... -R/utils_input_validation.R#L1869 #' configurations. ... -R/utils_input_validation.R#L1870 #' ... -R/utils_input_validation.R#L1871 #' @return No return value, called fo ... -R/utils_input_validation.R#L1872 #' ... -R/utils_input_validation.R#L1873 #' @keywords internal ... -R/utils_input_validation.R#L1874 #' ... -R/utils_input_validation.R#L1875 check_spline_type_column = function(s ... -R/utils_input_validation.R#L1877 if (!all(spline_test_configs$spline ... -R/utils_input_validation.R#L1878 # Identify invalid entries ... -R/utils_input_validation.R#L1879 invalid_entries <- spline_test_co ... -R/utils_input_validation.R#L1880 !spline_test_configs$spline_typ ... -R/utils_input_validation.R#L1881 ] ... -R/utils_input_validation.R#L1882 error_message <- sprintf( ... -R/utils_input_validation.R#L1883 "Error: 'spline_type' contains ... -R/utils_input_validation.R#L1885 paste(unique(invalid_entries), ... -R/utils_input_validation.R#L1886 ) ... -R/utils_input_validation.R#L1888 stop(error_message) ... -R/utils_input_validation.R#L1889 } ... -R/utils_input_validation.R#L1890 }, ... -R/utils_input_validation.R#L1893 #' Check Spline Type Parameters ... -R/utils_input_validation.R#L1894 #' ... -R/utils_input_validation.R#L1895 #' @description ... -R/utils_input_validation.R#L1896 #' Validates the parameters for each ... -R/utils_input_validation.R#L1897 #' based on the spline type. ... -R/utils_input_validation.R#L1898 #' ... -R/utils_input_validation.R#L1899 #' @param spline_test_configs A dataf ... -R/utils_input_validation.R#L1900 #' configurations. ... -R/utils_input_validation.R#L1901 #' ... -R/utils_input_validation.R#L1902 #' @return TRUE if all checks pass, o ... -R/utils_input_validation.R#L1903 #' ... -R/utils_input_validation.R#L1904 #' @keywords internal ... -R/utils_input_validation.R#L1905 #' ... -R/utils_input_validation.R#L1906 check_spline_type_params = function(s ... -R/utils_input_validation.R#L1908 for (i in seq_len(nrow(spline_test_ ... -R/utils_input_validation.R#L1909 row <- spline_test_configs[i,] ... -R/utils_input_validation.R#L1910 switch(as.character(row$spline_ty ... -R/utils_input_validation.R#L1911 "n" = { ... -R/utils_input_validation.R#L1913 stop("degree must be N ... -R/utils_input_validation.R#L1922 stop("dof must be an i ... -R/utils_input_validation.R#L1935 }, ... -R/utils_input_validation.R#L1936 "b" = { ... -R/utils_input_validation.R#L1938 ... -R/utils_input_validation.R#L1941 stop("dof must be an i ... -R/utils_input_validation.R#L1954 }, ... -R/utils_input_validation.R#L1955 stop("spline_type must be ... -R/utils_input_validation.R#L1956 ) ... -R/utils_input_validation.R#L1957 } ... -R/utils_input_validation.R#L1958 return(TRUE) ... -R/utils_input_validation.R#L1959 }, ... -R/utils_input_validation.R#L1962 #' Check Maximum and Minimum Degrees ... -R/utils_input_validation.R#L1963 #' ... -R/utils_input_validation.R#L1964 #' @description ... -R/utils_input_validation.R#L1965 #' Validates the degrees of freedom ( ... -R/utils_input_validation.R#L1966 #' configurations based on the metada ... -R/utils_input_validation.R#L1967 #' ... -R/utils_input_validation.R#L1968 #' @param spline_test_configs A dataf ... -R/utils_input_validation.R#L1969 #' configurations. ... -R/utils_input_validation.R#L1970 #' @param metas A list of metadata co ... -R/utils_input_validation.R#L1971 #' ... -R/utils_input_validation.R#L1972 #' @return No return value, called fo ... -R/utils_input_validation.R#L1973 #' ... -R/utils_input_validation.R#L1974 #' @keywords internal ... -R/utils_input_validation.R#L1975 #' ... -R/utils_input_validation.R#L1976 check_max_and_min_dof = function( ... -R/utils_input_validation.R#L1981 for (i in seq_len(nrow(spline_test_ ... -R/utils_input_validation.R#L1982 row <- spline_test_configs[i, ] ... -R/utils_input_validation.R#L1983 spline_type <- row[["spline_type" ... -R/utils_input_validation.R#L1984 dof <- row[["dof"]] ... -R/utils_input_validation.R#L1985 degree <- row[["degree"]] ... -R/utils_input_validation.R#L1986 knots <- row[["knots"]] ... -R/utils_input_validation.R#L1988 # Calculate k and DoF if dof is N ... -R/utils_input_validation.R#L1989 if (is.na(dof)) { ... -R/utils_input_validation.R#L1990 k <- length(knots) ... -R/utils_input_validation.R#L1991 if (spline_type == "b") { ... -R/utils_input_validation.R#L1992 dof <- k + degree ... -R/utils_input_validation.R#L1993 } else if (spline_type == "n") ... -R/utils_input_validation.R#L1994 dof <- k + 1 ... -R/utils_input_validation.R#L1995 } else { ... -R/utils_input_validation.R#L1996 stop("Unknown spline type '", ... -R/utils_input_validation.R#L1997 } ... -R/utils_input_validation.R#L1998 } ... -R/utils_input_validation.R#L2000 # Check if calculated or provided ... -R/utils_input_validation.R#L2001 if (dof < 2) { ... -R/utils_input_validation.R#L2002 stop("DoF must be at least 2, f ... -R/utils_input_validation.R#L2003 } ... -R/utils_input_validation.R#L2005 for (j in seq_along(metas)) { ... -R/utils_input_validation.R#L2006 meta <- metas[[j]] ... -R/utils_input_validation.R#L2007 nr_timepoints <- length(unique( ... -R/utils_input_validation.R#L2008 if (dof > nr_timepoints) { ... -R/utils_input_validation.R#L2009 stop("DoF (", dof, ") cannot ... -R/utils_input_validation.R#L2010 (", nr_timepoints, ") in meta ... -R/utils_input_validation.R#L2011 } ... -R/utils_input_validation.R#L2012 } ... -R/utils_input_validation.R#L2014 } ... -R/utils_input_validation.R#L2016 invisible(NULL) ... -R/utils_input_validation.R#L2017 }, ... -R/utils_input_validation.R#L2020 #' Check Dataframe Columns ... -R/utils_input_validation.R#L2021 #' ... -R/utils_input_validation.R#L2022 #' This function checks if the columns ... -R/utils_input_validation.R#L2023 #' column names and their respective d ... -R/utils_input_validation.R#L2024 #' ... -R/utils_input_validation.R#L2025 #' @param df A dataframe to check. ... -R/utils_input_validation.R#L2026 #' @param expected_cols A character ve ... -R/utils_input_validation.R#L2027 #' ... -R/utils_input_validation.R#L2028 #' @return This function does not retu ... -R/utils_input_validation.R#L2029 #' dataframe columns or their classes ... -R/utils_input_validation.R#L2030 #' ... -R/utils_input_validation.R#L2031 check_columns = function( ... -R/utils_input_validation.R#L2038 stop("Dataframe columns do not mat ... -R/utils_input_validation.R#L2039 call. = FALSE) ... -R/utils_input_validation.R#L2042 "numeric", "nu ... -R/utils_input_validation.R#L2043 "numeric") ... -R/utils_input_validation.R#L2046 stop("Dataframe column classes do ... -R/utils_input_validation.R#L2047 call. = FALSE) ... -R/utils_input_validation.R#L2049 } ... -R/utils_input_validation.R#L2050 ) ... -R/utils_input_validation.R#L2067 inherit = Level4Functions, ... -R/utils_input_validation.R#L2069 public = list( ... -R/utils_input_validation.R#L2071 #' Check the structure of a voom obje ... -R/utils_input_validation.R#L2072 #' ... -R/utils_input_validation.R#L2073 #' @description ... -R/utils_input_validation.R#L2074 #' This function checks the structure ... -R/utils_input_validation.R#L2075 #' contains ... -R/utils_input_validation.R#L2076 #' all the expected components and th ... -R/utils_input_validation.R#L2077 #' types ... -R/utils_input_validation.R#L2078 #' and dimensions. The function does ... -R/utils_input_validation.R#L2079 #' matrices. ... -R/utils_input_validation.R#L2080 #' ... -R/utils_input_validation.R#L2081 #' @param voom_obj A list representin ... -R/utils_input_validation.R#L2082 #' by the ... -R/utils_input_validation.R#L2083 #' `voom` function from the `limma` ... -R/utils_input_validation.R#L2084 #' ... -R/utils_input_validation.R#L2085 #' @details ... -R/utils_input_validation.R#L2086 #' The function verifies that the `vo ... -R/utils_input_validation.R#L2087 #' components: ... -R/utils_input_validation.R#L2088 #' - `E`: A matrix of log2-counts per ... -R/utils_input_validation.R#L2089 #' - `weights`: A matrix of observati ... -R/utils_input_validation.R#L2090 #' dimensions of `E`. ... -R/utils_input_validation.R#L2091 #' - `design`: A matrix representing ... -R/utils_input_validation.R#L2092 #' modeling, ... -R/utils_input_validation.R#L2093 #' with the same number of rows as ... -R/utils_input_validation.R#L2094 #' ... -R/utils_input_validation.R#L2095 #' The function also checks for optio ... -R/utils_input_validation.R#L2096 #' - `genes`: A data frame of gene an ... -R/utils_input_validation.R#L2097 #' - `targets`: A data frame of targe ... -R/utils_input_validation.R#L2098 #' - `sample.weights`: A numeric vect ... -R/utils_input_validation.R#L2099 #' ... -R/utils_input_validation.R#L2100 #' If any of these checks fail, the f ... -R/utils_input_validation.R#L2101 #' If the structure is valid, a messa ... -R/utils_input_validation.R#L2102 #' ... -R/utils_input_validation.R#L2103 #' @return Boolean TRUE or FALSE. How ... -R/utils_input_validation.R#L2104 #' its side effects, which stop the s ... -R/utils_input_validation.R#L2105 #' ... -R/utils_input_validation.R#L2106 check_voom_structure = function(voom_ ... -R/utils_input_validation.R#L2108 # Initialize a list to collect any ... -R/utils_input_validation.R#L2109 issues <- list() ... -R/utils_input_validation.R#L2111 # Check if the input is a list ... -R/utils_input_validation.R#L2112 if (!is.list(voom_obj)) { ... -R/utils_input_validation.R#L2113 stop("The input is not a list. A ... -R/utils_input_validation.R#L2114 } ... -R/utils_input_validation.R#L2116 # Check for the presence of the exp ... -R/utils_input_validation.R#L2117 expected_components <- c("E", "weig ... -R/utils_input_validation.R#L2118 for (comp in expected_components) { ... -R/utils_input_validation.R#L2119 if (!comp %in% names(voom_obj)) { ... -R/utils_input_validation.R#L2120 issues <- c(issues, paste("Miss ... -R/utils_input_validation.R#L2121 } ... -R/utils_input_validation.R#L2122 } ... -R/utils_input_validation.R#L2124 # Check that 'E' is a matrix ... -R/utils_input_validation.R#L2125 if ("E" %in% names(voom_obj) && !is ... -R/utils_input_validation.R#L2126 issues <- c(issues, "'E' should b ... -R/utils_input_validation.R#L2127 } ... -R/utils_input_validation.R#L2129 # Check that 'weights' is a matrix ... -R/utils_input_validation.R#L2130 if ("weights" %in% names(voom_obj)) ... -R/utils_input_validation.R#L2131 if (!is.matrix(voom_obj$weights)) ... -R/utils_input_validation.R#L2132 issues <- c(issues, "'weights' ... -R/utils_input_validation.R#L2133 } else if (!all(dim(voom_obj$weig ... -R/utils_input_validation.R#L2134 issues <- c( ... -R/utils_input_validation.R#L2135 issues, ... -R/utils_input_validation.R#L2136 "'weights' dimensions do not ... -R/utils_input_validation.R#L2137 ) ... -R/utils_input_validation.R#L2138 } ... -R/utils_input_validation.R#L2139 } ... -R/utils_input_validation.R#L2141 # Check that 'design' is a matrix a ... -R/utils_input_validation.R#L2142 if ("design" %in% names(voom_obj)) ... -R/utils_input_validation.R#L2143 if (!is.matrix(voom_obj$design)) ... -R/utils_input_validation.R#L2144 issues <- c(issues, "'design' s ... -R/utils_input_validation.R#L2145 } else if (nrow(voom_obj$design) ... -R/utils_input_validation.R#L2146 issues <- c( ... -R/utils_input_validation.R#L2147 issues, ... -R/utils_input_validation.R#L2148 "'design' matrix should have ... -R/utils_input_validation.R#L2149 number of columns in 'E'." ... -R/utils_input_validation.R#L2150 ) ... -R/utils_input_validation.R#L2151 } ... -R/utils_input_validation.R#L2152 } ... -R/utils_input_validation.R#L2154 # Optionally, check for the presenc ... -R/utils_input_validation.R#L2155 if ("genes" %in% names(voom_obj) && ... -R/utils_input_validation.R#L2156 issues <- c(issues, "'genes' shou ... -R/utils_input_validation.R#L2157 } ... -R/utils_input_validation.R#L2159 # Check for the presence of optiona ... -R/utils_input_validation.R#L2160 # sample weights ... -R/utils_input_validation.R#L2161 if ("targets" %in% names(voom_obj) ... -R/utils_input_validation.R#L2162 issues <- c(issues, "'targets' sh ... -R/utils_input_validation.R#L2163 } ... -R/utils_input_validation.R#L2165 if ("sample.weights" %in% names(voo ... -R/utils_input_validation.R#L2166 && !is.numeric(voom_obj$sample. ... -R/utils_input_validation.R#L2167 issues <- c(issues, "'sample.weig ... -R/utils_input_validation.R#L2168 } ... -R/utils_input_validation.R#L2170 # Report results ... -R/utils_input_validation.R#L2171 if (length(issues) > 0) { ... -R/utils_input_validation.R#L2172 stop( ... -R/utils_input_validation.R#L2173 "The voom object failed the str ... -R/utils_input_validation.R#L2174 paste( ... -R/utils_input_validation.R#L2175 issues, ... -R/utils_input_validation.R#L2176 collapse = "\n" ... -R/utils_input_validation.R#L2177 ), ... -R/utils_input_validation.R#L2178 call. = FALSE ... -R/utils_input_validation.R#L2179 ) ... -R/utils_input_validation.R#L2180 } else { ... -R/utils_input_validation.R#L2181 return(TRUE) ... -R/utils_input_validation.R#L2182 } ... -R/utils_input_validation.R#L2183 }, ... -R/utils_input_validation.R#L2186 #' Check Batch Column ... -R/utils_input_validation.R#L2187 #' ... -R/utils_input_validation.R#L2188 #' @description ... -R/utils_input_validation.R#L2189 #' This method checks the batch colum ... -R/utils_input_validation.R#L2190 #' appropriate messages. ... -R/utils_input_validation.R#L2191 #' ... -R/utils_input_validation.R#L2192 #' @param meta A dataframe containing ... -R/utils_input_validation.R#L2193 #' @param meta_batch_column A charact ... -R/utils_input_validation.R#L2194 #' in the metadata. ... -R/utils_input_validation.R#L2195 #' @param data_meta_index An optional ... -R/utils_input_validation.R#L2196 #' data/meta pair. Default is NA. ... -R/utils_input_validation.R#L2197 #' ... -R/utils_input_validation.R#L2198 #' @return NULL. The method is used f ... -R/utils_input_validation.R#L2199 #' or printing messages. ... -R/utils_input_validation.R#L2200 #' ... -R/utils_input_validation.R#L2201 check_batch_column = function( ... -R/utils_input_validation.R#L2207 if (!is.null(meta_batch_column) && ... -R/utils_input_validation.R#L2208 stop(self$create_error_message(sp ... -R/utils_input_validation.R#L2209 ... -R/utils_input_validation.R#L2210 ... -R/utils_input_validation.R#L2211 da ... -R/utils_input_validation.R#L2213 } else if (!is.null(meta_batch_colu ... -R/utils_input_validation.R#L2214 if (!is.null(data_meta_index)) { ... -R/utils_input_validation.R#L2215 message(sprintf("Index: %s. %s" ... -R/utils_input_validation.R#L2216 data_meta_index ... -R/utils_input_validation.R#L2217 paste("Column", ... -R/utils_input_validation.R#L2218 "of meta ... -R/utils_input_validation.R#L2219 "to remov ... -R/utils_input_validation.R#L2220 } else { ... -R/utils_input_validation.R#L2221 message(sprintf("Column '%s' of ... -R/utils_input_validation.R#L2222 meta_batch_colu ... -R/utils_input_validation.R#L2223 paste("remove t ... -R/utils_input_validation.R#L2224 } ... -R/utils_input_validation.R#L2225 } else { ... -R/utils_input_validation.R#L2226 if (!is.null(data_meta_index)) { ... -R/utils_input_validation.R#L2227 message(sprintf( ... -R/utils_input_validation.R#L2228 "Index: %s. Batch effect will ... -R/utils_input_validation.R#L2229 data_meta_index)) ... -R/utils_input_validation.R#L2230 } else { ... -R/utils_input_validation.R#L2231 message("Batch effect will NOT ... -R/utils_input_validation.R#L2232 } ... -R/utils_input_validation.R#L2233 } ... -R/utils_input_validation.R#L2234 }, ... -R/utils_input_validation.R#L2237 #' Check Condition Time Consistency ... -R/utils_input_validation.R#L2238 #' ... -R/utils_input_validation.R#L2239 #' @description ... -R/utils_input_validation.R#L2240 #' This function checks whether the v ... -R/utils_input_validation.R#L2241 #' have unique values for each block ... -R/utils_input_validation.R#L2242 #' `meta` dataframe. ... -R/utils_input_validation.R#L2243 #' Additionally, it ensures that ever ... -R/utils_input_validation.R#L2244 #' new value ... -R/utils_input_validation.R#L2245 #' in the `condition` column. ... -R/utils_input_validation.R#L2246 #' ... -R/utils_input_validation.R#L2247 #' @param meta A dataframe containing ... -R/utils_input_validation.R#L2248 #' column. ... -R/utils_input_validation.R#L2249 #' @param condition A character strin ... -R/utils_input_validation.R#L2250 #' used to define gr ... -R/utils_input_validation.R#L2251 #' ... -R/utils_input_validation.R#L2252 #' @return Logical TRUE if the condit ... -R/utils_input_validation.R#L2253 #' time series pattern. ... -R/utils_input_validation.R#L2254 #' ... -R/utils_input_validation.R#L2255 check_condition_time_consistency = fu ... -R/utils_input_validation.R#L2260 # Get the unique times in the order ... -R/utils_input_validation.R#L2261 unique_times <- unique(meta[["Time" ... -R/utils_input_validation.R#L2263 # Initialize a list to store previo ... -R/utils_input_validation.R#L2264 # segment ... -R/utils_input_validation.R#L2265 seen_conditions <- list() ... -R/utils_input_validation.R#L2267 # Iterate through each block of uni ... -R/utils_input_validation.R#L2268 for (time in unique_times) { ... -R/utils_input_validation.R#L2269 # Get the indices for the current ... -R/utils_input_validation.R#L2270 current_indices <- which(meta[["T ... -R/utils_input_validation.R#L2272 # Get the condition values for th ... -R/utils_input_validation.R#L2273 current_conditions <- meta[curren ... -R/utils_input_validation.R#L2275 # Ensure that all conditions in t ... -R/utils_input_validation.R#L2276 if (length(unique(current_conditi ... -R/utils_input_validation.R#L2277 stop(paste("Every block of iden ... -R/utils_input_validation.R#L2279 call. = FALSE) ... -R/utils_input_validation.R#L2280 } ... -R/utils_input_validation.R#L2282 # Check if the condition value ha ... -R/utils_input_validation.R#L2283 if (!is.null(seen_conditions[[as. ... -R/utils_input_validation.R#L2284 if (current_conditions[1] %in% ... -R/utils_input_validation.R#L2285 stop(sprintf("Condition '%s' ... -R/utils_input_validation.R#L2287 } ... -R/utils_input_validation.R#L2288 } ... -R/utils_input_validation.R#L2290 # Update the seen conditions for ... -R/utils_input_validation.R#L2291 if (is.null(seen_conditions[[as.c ... -R/utils_input_validation.R#L2292 seen_conditions[[as.character(t ... -R/utils_input_validation.R#L2293 } ... -R/utils_input_validation.R#L2294 seen_conditions[[as.character(tim ... -R/utils_input_validation.R#L2295 seen_conditions[[as.character(t ... -R/utils_input_validation.R#L2296 current_conditions[1] ... -R/utils_input_validation.R#L2297 ) ... -R/utils_input_validation.R#L2298 } ... -R/utils_input_validation.R#L2300 return(TRUE) ... -R/utils_input_validation.R#L2301 } ... -R/utils_input_validation.R#L2302 ) ... -R/utils_input_validation.R#L2317 public = list( ... -R/utils_input_validation.R#L2319 #' Create Error Message ... -R/utils_input_validation.R#L2320 #' ... -R/utils_input_validation.R#L2321 #' @description ... -R/utils_input_validation.R#L2322 #' This method creates a formatted er ... -R/utils_input_validation.R#L2323 #' the data/meta pair if provided. ... -R/utils_input_validation.R#L2324 #' If no index is provided, it return ... -R/utils_input_validation.R#L2325 #' ... -R/utils_input_validation.R#L2326 #' @param message A character string ... -R/utils_input_validation.R#L2327 #' @param data_meta_index An optional ... -R/utils_input_validation.R#L2328 #' data/meta pair for the error messa ... -R/utils_input_validation.R#L2329 #' ... -R/utils_input_validation.R#L2330 #' @return Returns a formatted error ... -R/utils_input_validation.R#L2331 #' the message includes the index; ot ... -R/utils_input_validation.R#L2332 #' ... -R/utils_input_validation.R#L2333 create_error_message = function( ... -R/utils_input_validation.R#L2338 if (!is.null(data_meta_index)) { ... -R/utils_input_validation.R#L2339 return(sprintf( ... -R/utils_input_validation.R#L2340 "data/meta pair index %d: %s", ... -R/utils_input_validation.R#L2341 data_meta_index, ... -R/utils_input_validation.R#L2342 message ... -R/utils_input_validation.R#L2343 )) ... -R/utils_input_validation.R#L2344 } else { ... -R/utils_input_validation.R#L2345 return(message) ... -R/utils_input_validation.R#L2346 } ... -R/utils_input_validation.R#L2347 } ... -R/utils_input_validation.R#L2348 ) ... -R/utils_input_validation.R#L2374 required_elements <- switch( ... -R/utils_input_validation.R#L2377 "data", ... -R/utils_input_validation.R#L2378 "meta", ... -R/utils_input_validation.R#L2379 "condition", ... -R/utils_input_validation.R#L2380 "report_info" ... -R/utils_input_validation.R#L2381 ), ... -R/utils_input_validation.R#L2383 "condition", ... -R/utils_input_validation.R#L2384 "report_info", ... -R/utils_input_validation.R#L2385 "padjust_method" ... -R/utils_input_validation.R#L2388 "data", ... -R/utils_input_validation.R#L2389 "meta", ... -R/utils_input_validation.R#L2390 "design", ... -R/utils_input_validation.R#L2391 "mode", ... -R/utils_input_validation.R#L2392 "condition", ... -R/utils_input_validation.R#L2393 "spline_params", ... -R/utils_input_validation.R#L2394 "padjust_method" ... -R/utils_input_validation.R#L2397 "limma_splines_result", ... -R/utils_input_validation.R#L2398 "report_info" ... -R/utils_input_validation.R#L2401 "data", ... -R/utils_input_validation.R#L2402 "meta", ... -R/utils_input_validation.R#L2403 "design", ... -R/utils_input_validation.R#L2404 "mode", ... -R/utils_input_validation.R#L2405 "condition", ... -R/utils_input_validation.R#L2406 "spline_params", ... -R/utils_input_validation.R#L2407 "limma_splines_result" ... -R/utils_input_validation.R#L2410 "Invalid function type provided.", ... -R/utils_input_validation.R#L2411 call. = FALSE ... -R/utils_input_validation.R#L2412 ) ... -R/utils_input_validation.R#L2415 missing_elements <- required_elements[ ... -R/utils_input_validation.R#L2417 splineomics[required_elements], ... -R/utils_input_validation.R#L2418 function(x) !is.null(x) ... -R/utils_input_validation.R#L2419 ) ... -R/utils_input_validation.R#L2422 if (length(missing_elements) > 0) { ... -R/utils_input_validation.R#L2424 "The following required elements f ... -R/utils_input_validation.R#L2425 func_type, ... -R/utils_input_validation.R#L2426 "were not passed to the SplineOmic ... -R/utils_input_validation.R#L2427 paste( ... -R/utils_input_validation.R#L2431 "\nAll required elements for", ... -R/utils_input_validation.R#L2432 func_type, ... -R/utils_input_validation.R#L2433 "are:", ... -R/utils_input_validation.R#L2434 paste( ... -R/utils_input_validation.R#L2437 ), ... -R/utils_input_validation.R#L2438 call. = FALSE) ... -R/utils_input_validation.R#L2439 } ... -R/utils_input_validation.R#L2457 null_elements <- names(args)[sapply(ar ... -R/utils_input_validation.R#L2459 if (length(null_elements) > 0) { ... -R/utils_input_validation.R#L2461 paste("The following function argu ... -R/utils_input_validation.R#L2463 call. = FALSE ... -R/utils_input_validation.R#L2465 } ... -R/utils_report_generation.R#L77 "%d_%m_%Y-%H_%M_%S ... -R/utils_report_generation.R#L81 feature_names_formula <- "" ... -R/utils_report_generation.R#L82 ... -R/utils_report_generation.R#L83 if (report_type == "explore_data") { ... -R/utils_report_generation.R#L85 title <- "explore data" ... -R/utils_report_generation.R#L87 title <- "explore batch-corrected ... -R/utils_report_generation.R#L89 } else if (report_type == "screen_limm ... -R/utils_report_generation.R#L92 } else if (report_type == "create_limm ... -R/utils_report_generation.R#L95 } else if (report_type == "cluster_hit ... -R/utils_report_generation.R#L98 feature_name_columns, ... -R/utils_report_generation.R#L99 collapse = "_" ... -R/utils_report_generation.R#L100 ) ... -R/utils_report_generation.R#L102 } else if (report_type == "create_gsea ... +R/utils_input_validation.R#L1224 # Verify that the directory exists ... +R/utils_input_validation.R#L1225 if (!file.exists(report_dir) || !f ... +R/utils_input_validation.R#L1227 sprintf( ... +R/utils_input_validation.R#L1230 ) ... +R/utils_input_validation.R#L1232 } ... +R/utils_input_validation.R#L1234 return(TRUE) ... +R/utils_input_validation.R#L1253 data <- self$args$data ... +R/utils_input_validation.R#L1254 genes <- self$args$genes ... +R/utils_input_validation.R#L1256 required_args <- list(data, genes) ... +R/utils_input_validation.R#L1258 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L1260 } ... +R/utils_input_validation.R#L1262 if (!is.character(genes)) { ... +R/utils_input_validation.R#L1264 } ... +R/utils_input_validation.R#L1266 if (length(genes) != nrow(data)) { ... +R/utils_input_validation.R#L1268 } ... +R/utils_input_validation.R#L1295 padjust_method <- self$args$padjus ... +R/utils_input_validation.R#L1297 required_args <- list(padjust_meth ... +R/utils_input_validation.R#L1299 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L1301 } ... +R/utils_input_validation.R#L1303 supported_methods <- stats::p.adju ... +R/utils_input_validation.R#L1304 if (!(is.character(padjust_method) ... +R/utils_input_validation.R#L1307 sprintf(paste( ... +R/utils_input_validation.R#L1311 )), ... +R/utils_input_validation.R#L1312 call. = FALSE ... +R/utils_input_validation.R#L1314 } ... +R/utils_input_validation.R#L1331 report_info <- self$args[["report_ ... +R/utils_input_validation.R#L1333 required_args <- list(report_info) ... +R/utils_input_validation.R#L1335 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L1337 } ... +R/utils_input_validation.R#L1339 mandatory_fields <- c( ... +R/utils_input_validation.R#L1346 ) ... +R/utils_input_validation.R#L1348 all_fields <- c( ... +R/utils_input_validation.R#L1353 ) ... +R/utils_input_validation.R#L1355 # Check if report_info is a named ... +R/utils_input_validation.R#L1356 if (!is.list(report_info) || is.nu ... +R/utils_input_validation.R#L1358 } ... +R/utils_input_validation.R#L1360 # Check if all values in report_in ... +R/utils_input_validation.R#L1361 non_string_fields <- vapply( ... +R/utils_input_validation.R#L1365 ) ... +R/utils_input_validation.R#L1367 if (any(non_string_fields)) { ... +R/utils_input_validation.R#L1370 "The following fields in repor ... +R/utils_input_validation.R#L1371 paste(invalid_fields, collapse ... +R/utils_input_validation.R#L1373 } ... +R/utils_input_validation.R#L1375 # Check if all mandatory fields ar ... +R/utils_input_validation.R#L1376 missing_fields <- setdiff(mandator ... +R/utils_input_validation.R#L1377 if (length(missing_fields) > 0) { ... +R/utils_input_validation.R#L1379 "Missing mandatory fields in r ... +R/utils_input_validation.R#L1380 paste(missing_fields, collapse ... +R/utils_input_validation.R#L1382 } ... +R/utils_input_validation.R#L1384 # Check if there are any extra fie ... +R/utils_input_validation.R#L1385 extra_fields <- setdiff(names(repo ... +R/utils_input_validation.R#L1386 if (length(extra_fields) > 0) { ... +R/utils_input_validation.R#L1388 "The following fields in repor ... +R/utils_input_validation.R#L1389 paste(extra_fields, collapse = ... +R/utils_input_validation.R#L1391 } ... +R/utils_input_validation.R#L1393 # Check omics_data_type format ... +R/utils_input_validation.R#L1394 if (!grepl("^[a-zA-Z_]+$", report_ ... +R/utils_input_validation.R#L1396 "The 'omics_data_type' field m ... +R/utils_input_validation.R#L1397 "letters and underscores." ... +R/utils_input_validation.R#L1399 } ... +R/utils_input_validation.R#L1401 excluded_fields <- c( ... +R/utils_input_validation.R#L1406 ) ... +R/utils_input_validation.R#L1407 excluded_limit <- 700 ... +R/utils_input_validation.R#L1409 check_long_fields <- function(data ... +R/utils_input_validation.R#L1413 if (any(names(data) %in% exclu ... +R/utils_input_validation.R#L1415 } else { ... +R/utils_input_validation.R#L1417 } ... +R/utils_input_validation.R#L1420 } ... +R/utils_input_validation.R#L1422 # Check if any field exceeds 70 ch ... +R/utils_input_validation.R#L1423 long_fields <- check_long_fields( ... +R/utils_input_validation.R#L1427 ) ... +R/utils_input_validation.R#L1429 if (any(long_fields)) { ... +R/utils_input_validation.R#L1432 paste(too_long_fields, collaps ... +R/utils_input_validation.R#L1433 sep = "\n" ... +R/utils_input_validation.R#L1435 } ... +R/utils_input_validation.R#L1437 return(TRUE) ... +R/utils_input_validation.R#L1466 feature_name_columns <- self$args[ ... +R/utils_input_validation.R#L1467 annotation <- self$args[["annotati ... +R/utils_input_validation.R#L1469 required_args <- list( ... +R/utils_input_validation.R#L1472 ) ... +R/utils_input_validation.R#L1474 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L1476 } ... +R/utils_input_validation.R#L1478 # Check if every element in featur ... +R/utils_input_validation.R#L1479 # of length 1 ... +R/utils_input_validation.R#L1480 if (!all(vapply( ... +R/utils_input_validation.R#L1484 )) ... +R/utils_input_validation.R#L1485 ) { ... +R/utils_input_validation.R#L1487 paste( ... +R/utils_input_validation.R#L1490 ) ... +R/utils_input_validation.R#L1492 } ... +R/utils_input_validation.R#L1494 # Check if all elements of feature ... +R/utils_input_validation.R#L1495 # in annotation ... +R/utils_input_validation.R#L1496 if (!all(feature_name_columns %in% ... +R/utils_input_validation.R#L1498 paste( ... +R/utils_input_validation.R#L1501 ) ... +R/utils_input_validation.R#L1503 } ... +R/utils_input_validation.R#L1522 report <- self$args[["report"]] ... +R/utils_input_validation.R#L1524 required_args <- list(report) ... +R/utils_input_validation.R#L1526 if (any(vapply(required_args, is.n ... +R/utils_input_validation.R#L1528 } ... +R/utils_input_validation.R#L1530 if (!rlang::is_bool(report)) { ... +R/utils_input_validation.R#L1532 } ... +R/utils_input_validation.R#L1534 ) ... +R/utils_input_validation.R#L1550 inherit = Level3Functions, ... +R/utils_input_validation.R#L1551 public = list( ... +R/utils_input_validation.R#L1575 if (!is.matrix(data) || !is.numeri ... +R/utils_input_validation.R#L1577 self$create_error_message( ... +R/utils_input_validation.R#L1580 ), ... +R/utils_input_validation.R#L1581 call. = FALSE ... +R/utils_input_validation.R#L1583 } ... +R/utils_input_validation.R#L1585 # Check for missing values ... +R/utils_input_validation.R#L1586 if (any(is.na(data))) { ... +R/utils_input_validation.R#L1588 self$create_error_message( ... +R/utils_input_validation.R#L1591 ), ... +R/utils_input_validation.R#L1592 call. = FALSE ... +R/utils_input_validation.R#L1594 } ... +R/utils_input_validation.R#L1596 # Check for non-negative values ... +R/utils_input_validation.R#L1597 if (any(data < 0)) { ... +R/utils_input_validation.R#L1599 self$create_error_message( ... +R/utils_input_validation.R#L1601 "All elements of data must ... +R/utils_input_validation.R#L1602 "represent concentrations, ... +R/utils_input_validation.R#L1603 "intensities (which are in ... +R/utils_input_validation.R#L1606 ), ... +R/utils_input_validation.R#L1607 call. = FALSE ... +R/utils_input_validation.R#L1609 } ... +R/utils_input_validation.R#L1611 # Check for rows with all zeros ... +R/utils_input_validation.R#L1612 if (any(rowSums(data) == 0)) { ... +R/utils_input_validation.R#L1614 self$create_error_message( ... +R/utils_input_validation.R#L1617 ), ... +R/utils_input_validation.R#L1618 call. = FALSE ... +R/utils_input_validation.R#L1620 } ... +R/utils_input_validation.R#L1622 # Check for columns with all zeros ... +R/utils_input_validation.R#L1623 if (any(colSums(data) == 0)) { ... +R/utils_input_validation.R#L1625 self$create_error_message( ... +R/utils_input_validation.R#L1627 "data must not contain col ... +R/utils_input_validation.R#L1630 ), ... +R/utils_input_validation.R#L1631 call. = FALSE ... +R/utils_input_validation.R#L1633 } ... +R/utils_input_validation.R#L1635 # Check if row headers (rownames) ... +R/utils_input_validation.R#L1636 row_headers <- rownames(data) ... +R/utils_input_validation.R#L1637 if (is.null(row_headers)) { ... +R/utils_input_validation.R#L1639 self$create_error_message( ... +R/utils_input_validation.R#L1642 ), ... +R/utils_input_validation.R#L1643 call. = FALSE ... +R/utils_input_validation.R#L1645 } ... +R/utils_input_validation.R#L1647 return(TRUE) ... +R/utils_input_validation.R#L1685 if (!is.data.frame(meta) || ... +R/utils_input_validation.R#L1689 self$create_error_message( ... +R/utils_input_validation.R#L1692 ), ... +R/utils_input_validation.R#L1693 call. = FALSE ... +R/utils_input_validation.R#L1695 } ... +R/utils_input_validation.R#L1697 if (any(is.na(meta))) { ... +R/utils_input_validation.R#L1699 self$create_error_message( ... +R/utils_input_validation.R#L1702 ), ... +R/utils_input_validation.R#L1703 call. = FALSE ... +R/utils_input_validation.R#L1705 } ... +R/utils_input_validation.R#L1707 # Check if condition is a single c ... +R/utils_input_validation.R#L1708 if (!is.character(condition) || le ... +R/utils_input_validation.R#L1710 call. = FALSE ... +R/utils_input_validation.R#L1712 } ... +R/utils_input_validation.R#L1714 # Check if condition is a column i ... +R/utils_input_validation.R#L1715 if (!condition %in% colnames(meta) ... +R/utils_input_validation.R#L1717 sprintf( ... +R/utils_input_validation.R#L1721 ), ... +R/utils_input_validation.R#L1722 data_meta_index ... +R/utils_input_validation.R#L1724 } ... +R/utils_input_validation.R#L1726 # Check if the factor column is of ... +R/utils_input_validation.R#L1727 if (!is.factor(meta[[condition]]) ... +R/utils_input_validation.R#L1730 self$create_error_message( ... +R/utils_input_validation.R#L1732 factor or character.", ... +R/utils_input_validation.R#L1734 ), ... +R/utils_input_validation.R#L1735 call. = FALSE ... +R/utils_input_validation.R#L1737 } ... +R/utils_input_validation.R#L1739 # Check condition and time pattern ... +R/utils_input_validation.R#L1740 self$check_condition_time_consiste ... +R/utils_input_validation.R#L1742 if (!is.character(meta_batch2_colu ... +R/utils_input_validation.R#L1744 } ... +R/utils_input_validation.R#L1746 if (is.null(meta_batch_column) && ... +R/utils_input_validation.R#L1748 "For removing the batch effect ... +R/utils_input_validation.R#L1749 "batch is used!" ... +R/utils_input_validation.R#L1751 } ... +R/utils_input_validation.R#L1753 if (!is.null(meta_batch_column)) { ... +R/utils_input_validation.R#L1755 if (meta_batch_column == "Time ... +R/utils_input_validation.R#L1757 call. = FALSE ... +R/utils_input_validation.R#L1759 } ... +R/utils_input_validation.R#L1761 self$check_batch_column( ... +R/utils_input_validation.R#L1765 ) ... +R/utils_input_validation.R#L1767 stop( ... +R/utils_input_validation.R#L1770 ) ... +R/utils_input_validation.R#L1772 } ... +R/utils_input_validation.R#L1774 if (!is.null(meta_batch2_column)) ... +R/utils_input_validation.R#L1776 if (meta_batch2_column == "Tim ... +R/utils_input_validation.R#L1778 call. = FALSE ... +R/utils_input_validation.R#L1780 } ... +R/utils_input_validation.R#L1782 if (meta_batch_column == meta_ ... +R/utils_input_validation.R#L1784 paste( ... +R/utils_input_validation.R#L1787 ), ... +R/utils_input_validation.R#L1788 call. = FALSE ... +R/utils_input_validation.R#L1790 } ... +R/utils_input_validation.R#L1792 self$check_batch_column( ... +R/utils_input_validation.R#L1796 ) ... +R/utils_input_validation.R#L1798 stop( ... +R/utils_input_validation.R#L1801 ) ... +R/utils_input_validation.R#L1803 } ... +R/utils_input_validation.R#L1805 return(TRUE) ... +R/utils_input_validation.R#L1820 # Define the required columns and ... +R/utils_input_validation.R#L1821 required_columns <- list( ... +R/utils_input_validation.R#L1828 ) ... +R/utils_input_validation.R#L1830 # Check if all required columns ar ... +R/utils_input_validation.R#L1831 missing_columns <- setdiff(names(r ... +R/utils_input_validation.R#L1832 if (length(missing_columns) > 0) { ... +R/utils_input_validation.R#L1834 paste( ... +R/utils_input_validation.R#L1837 ), ... +R/utils_input_validation.R#L1838 call. = FALSE ... +R/utils_input_validation.R#L1840 } ... +R/utils_input_validation.R#L1842 # Check if columns have the correc ... +R/utils_input_validation.R#L1843 for (col in names(required_columns ... +R/utils_input_validation.R#L1845 stop( ... +R/utils_input_validation.R#L1847 "top_table column", col, " ... +R/utils_input_validation.R#L1848 required_columns[[col]] ... +R/utils_input_validation.R#L1851 ) ... +R/utils_input_validation.R#L1853 } ... +R/utils_input_validation.R#L1855 return(TRUE) ... +R/utils_input_validation.R#L1869 allowed_fields <- c("spline_type", ... +R/utils_input_validation.R#L1871 if (!all(names(spline_params) %in% ... +R/utils_input_validation.R#L1873 paste( ... +R/utils_input_validation.R#L1876 ), ... +R/utils_input_validation.R#L1877 call. = FALSE ... +R/utils_input_validation.R#L1879 } ... +R/utils_input_validation.R#L1881 # Check if spline_type exists and ... +R/utils_input_validation.R#L1882 if ("spline_type" %in% names(splin ... +R/utils_input_validation.R#L1884 stop( ... +R/utils_input_validation.R#L1886 "Elements of spline_type m ... +R/utils_input_validation.R#L1887 "or 'n' for natural cubic ... +R/utils_input_validation.R#L1890 ) ... +R/utils_input_validation.R#L1892 } else { ... +R/utils_input_validation.R#L1894 } ... +R/utils_input_validation.R#L1896 # Check if degree exists and is an ... +R/utils_input_validation.R#L1897 # and NA for natural splines ... +R/utils_input_validation.R#L1898 if ("degree" %in% names(spline_par ... +R/utils_input_validation.R#L1900 if (spline_params$spline_type[ ... +R/utils_input_validation.R#L1902 is.na(spline_params$degree ... +R/utils_input_validation.R#L1904 paste( ... +R/utils_input_validation.R#L1907 ), ... +R/utils_input_validation.R#L1908 call. = FALSE ... +R/utils_input_validation.R#L1910 } ... +R/utils_input_validation.R#L1911 if (spline_params$spline_type[ ... +R/utils_input_validation.R#L1914 paste( ... +R/utils_input_validation.R#L1917 ), ... +R/utils_input_validation.R#L1918 call. = FALSE ... +R/utils_input_validation.R#L1920 } ... +R/utils_input_validation.R#L1922 } else if (all(spline_params$splin ... +R/utils_input_validation.R#L1924 } ... +R/utils_input_validation.R#L1926 # Check if dof exists and is an in ... +R/utils_input_validation.R#L1927 if ("dof" %in% names(spline_params ... +R/utils_input_validation.R#L1929 stop("dof must be an integer v ... +R/utils_input_validation.R#L1933 if (spline_params$spline_type[ ... +R/utils_input_validation.R#L1936 paste("B-splines require D ... +R/utils_input_validation.R#L1937 call. = FALSE ... +R/utils_input_validation.R#L1939 } ... +R/utils_input_validation.R#L1941 } else { ... +R/utils_input_validation.R#L1943 } ... +R/utils_input_validation.R#L1965 if (mode == "integrated") { ... +R/utils_input_validation.R#L1969 # Atomic vectors (like numeric ... +R/utils_input_validation.R#L1970 # should count as 1 element ... +R/utils_input_validation.R#L1971 !is.atomic(x) && length(x) != ... +R/utils_input_validation.R#L1973 stop(paste( ... +R/utils_input_validation.R#L1978 ), call. = FALSE) ... +R/utils_input_validation.R#L2012 } else if (mode == "isolated") { ... +R/utils_input_validation.R#L2015 stop_call_false(paste( ... +R/utils_input_validation.R#L2019 )) ... +R/utils_input_validation.R#L2039 } ... +R/utils_input_validation.R#L2057 required_columns <- c( ... +R/utils_input_validation.R#L2063 ) ... +R/utils_input_validation.R#L2065 # Check for exact match of column ... +R/utils_input_validation.R#L2066 if (!identical(names(spline_test_c ... +R/utils_input_validation.R#L2074 error_message <- paste0( ... +R/utils_input_validation.R#L2077 ) ... +R/utils_input_validation.R#L2080 error_message <- paste0( ... +R/utils_input_validation.R#L2083 ) ... +R/utils_input_validation.R#L2086 error_message, ... +R/utils_input_validation.R#L2087 "Expected columns in order: ", ... +R/utils_input_validation.R#L2088 paste(required_columns, collap ... +R/utils_input_validation.R#L2092 } ... +R/utils_input_validation.R#L2110 if (!all(spline_test_configs$splin ... +R/utils_input_validation.R#L2113 !spline_test_configs$spline_ty ... +R/utils_input_validation.R#L2116 "Error: 'spline_type' contains ... +R/utils_input_validation.R#L2118 paste(unique(invalid_entries), ... +R/utils_input_validation.R#L2122 } ... +R/utils_input_validation.R#L2140 for (i in seq_len(nrow(spline_test ... +R/utils_input_validation.R#L2143 "n" = { ... +R/utils_input_validation.R#L2145 stop("degree must be NA fo ... +R/utils_input_validation.R#L2155 stop("dof must be an integ ... +R/utils_input_validation.R#L2168 }, ... +R/utils_input_validation.R#L2169 "b" = { ... +R/utils_input_validation.R#L2171 ... +R/utils_input_validation.R#L2173 row$dof < row$degree)) { ... +R/utils_input_validation.R#L2174 stop("dof must be an integ ... +R/utils_input_validation.R#L2187 }, ... +R/utils_input_validation.R#L2188 stop("spline_type must be eith ... +R/utils_input_validation.R#L2190 } ... +R/utils_input_validation.R#L2191 return(TRUE) ... +R/utils_input_validation.R#L2212 for (i in seq_len(nrow(spline_test ... +R/utils_input_validation.R#L2221 k <- length(knots) ... +R/utils_input_validation.R#L2222 if (spline_type == "b") { ... +R/utils_input_validation.R#L2224 } else if (spline_type == "n") ... +R/utils_input_validation.R#L2226 } else { ... +R/utils_input_validation.R#L2228 } ... +R/utils_input_validation.R#L2233 stop("DoF must be at least 2, ... +R/utils_input_validation.R#L2237 meta <- metas[[j]] ... +R/utils_input_validation.R#L2238 nr_timepoints <- length(unique ... +R/utils_input_validation.R#L2239 if (dof > nr_timepoints) { ... +R/utils_input_validation.R#L2241 (", nr_timepoints, ") in meta ... +R/utils_input_validation.R#L2242 } ... +R/utils_input_validation.R#L2244 } ... +R/utils_input_validation.R#L2246 invisible(NULL) ... +R/utils_input_validation.R#L2264 actual_cols <- names(df) ... +R/utils_input_validation.R#L2265 if (!all(expected_cols %in% actual ... +R/utils_input_validation.R#L2267 } ... +R/utils_input_validation.R#L2268 expected_classes <- c( ... +R/utils_input_validation.R#L2278 ) ... +R/utils_input_validation.R#L2279 actual_classes <- vapply(df, class ... +R/utils_input_validation.R#L2280 if (!all(actual_classes == expecte ... +R/utils_input_validation.R#L2282 } ... +R/utils_input_validation.R#L2284 ) ... +R/utils_input_validation.R#L2300 inherit = Level4Functions, ... +R/utils_input_validation.R#L2301 public = list( ... +R/utils_input_validation.R#L2339 # Initialize a list to collect any ... +R/utils_input_validation.R#L2340 issues <- list() ... +R/utils_input_validation.R#L2342 # Check if the input is a list ... +R/utils_input_validation.R#L2343 if (!is.list(voom_obj)) { ... +R/utils_input_validation.R#L2345 } ... +R/utils_input_validation.R#L2347 # Check for the presence of the ex ... +R/utils_input_validation.R#L2348 expected_components <- c("E", "wei ... +R/utils_input_validation.R#L2349 for (comp in expected_components) ... +R/utils_input_validation.R#L2351 issues <- c(issues, paste("Mis ... +R/utils_input_validation.R#L2353 } ... +R/utils_input_validation.R#L2355 # Check that 'E' is a matrix ... +R/utils_input_validation.R#L2356 if ("E" %in% names(voom_obj) && !i ... +R/utils_input_validation.R#L2358 } ... +R/utils_input_validation.R#L2360 # Check that 'weights' is a matrix ... +R/utils_input_validation.R#L2361 if ("weights" %in% names(voom_obj) ... +R/utils_input_validation.R#L2363 issues <- c(issues, "'weights' ... +R/utils_input_validation.R#L2365 issues <- c( ... +R/utils_input_validation.R#L2368 ) ... +R/utils_input_validation.R#L2370 } ... +R/utils_input_validation.R#L2372 # Check that 'design' is a matrix ... +R/utils_input_validation.R#L2373 if ("design" %in% names(voom_obj)) ... +R/utils_input_validation.R#L2375 issues <- c(issues, "'design' ... +R/utils_input_validation.R#L2377 issues <- c( ... +R/utils_input_validation.R#L2380 number of columns in 'E'." ... +R/utils_input_validation.R#L2381 ) ... +R/utils_input_validation.R#L2383 } ... +R/utils_input_validation.R#L2385 # Optionally, check for the presen ... +R/utils_input_validation.R#L2386 if ("genes" %in% names(voom_obj) & ... +R/utils_input_validation.R#L2388 } ... +R/utils_input_validation.R#L2390 # Check for the presence of option ... +R/utils_input_validation.R#L2391 # sample weights ... +R/utils_input_validation.R#L2392 if ("targets" %in% names(voom_obj) ... +R/utils_input_validation.R#L2394 } ... +R/utils_input_validation.R#L2396 if ("sample.weights" %in% names(vo ... +R/utils_input_validation.R#L2399 } ... +R/utils_input_validation.R#L2401 # Report results ... +R/utils_input_validation.R#L2402 if (length(issues) > 0) { ... +R/utils_input_validation.R#L2404 "The voom object failed the st ... +R/utils_input_validation.R#L2405 paste( ... +R/utils_input_validation.R#L2408 ), ... +R/utils_input_validation.R#L2409 call. = FALSE ... +R/utils_input_validation.R#L2411 } else { ... +R/utils_input_validation.R#L2413 } ... +R/utils_input_validation.R#L2436 if (!is.null(meta_batch_column) && ... +R/utils_input_validation.R#L2438 self$create_error_message( ... +R/utils_input_validation.R#L2440 "Batch effect column '%s' ... +R/utils_input_validation.R#L2441 meta_batch_column, ... +R/utils_input_validation.R#L2442 "not found in meta" ... +R/utils_input_validation.R#L2445 ), ... +R/utils_input_validation.R#L2446 call. = FALSE ... +R/utils_input_validation.R#L2448 } else if (!is.null(meta_batch_col ... +R/utils_input_validation.R#L2450 message(sprintf( ... +R/utils_input_validation.R#L2454 "Column", meta_batch_colum ... +R/utils_input_validation.R#L2455 "of meta will be used", ... +R/utils_input_validation.R#L2456 "to remove the batch effec ... +R/utils_input_validation.R#L2458 )) ... +R/utils_input_validation.R#L2460 message(sprintf( ... +R/utils_input_validation.R#L2464 )) ... +R/utils_input_validation.R#L2466 } else { ... +R/utils_input_validation.R#L2468 message(sprintf( ... +R/utils_input_validation.R#L2471 )) ... +R/utils_input_validation.R#L2473 message("Batch effect will NOT ... +R/utils_input_validation.R#L2475 } ... +R/utils_input_validation.R#L2500 # Get the unique times in the orde ... +R/utils_input_validation.R#L2501 unique_times <- unique(meta[["Time ... +R/utils_input_validation.R#L2503 # Initialize a list to store previ ... +R/utils_input_validation.R#L2504 # segment ... +R/utils_input_validation.R#L2505 seen_conditions <- list() ... +R/utils_input_validation.R#L2507 # Iterate through each block of un ... +R/utils_input_validation.R#L2508 for (time in unique_times) { ... +R/utils_input_validation.R#L2517 stop( ... +R/utils_input_validation.R#L2519 "Every block of identical ... +R/utils_input_validation.R#L2520 "have unique values in the ... +R/utils_input_validation.R#L2523 ) ... +R/utils_input_validation.R#L2528 if (current_conditions[1] %in% ... +R/utils_input_validation.R#L2530 "Condition '%s' for time ' ... +R/utils_input_validation.R#L2531 current_conditions[1], tim ... +R/utils_input_validation.R#L2533 } ... +R/utils_input_validation.R#L2538 seen_conditions[[as.character( ... +R/utils_input_validation.R#L2541 seen_conditions[[as.character( ... +R/utils_input_validation.R#L2542 current_conditions[1] ... +R/utils_input_validation.R#L2544 } ... +R/utils_input_validation.R#L2546 return(TRUE) ... +R/utils_input_validation.R#L2548 ) ... +R/utils_input_validation.R#L2563 public = list( ... +R/utils_input_validation.R#L2582 if (!is.null(data_meta_index)) { ... +R/utils_input_validation.R#L2584 "data/meta pair index %d: %s", ... +R/utils_input_validation.R#L2585 data_meta_index, ... +R/utils_input_validation.R#L2586 message ... +R/utils_input_validation.R#L2588 } else { ... +R/utils_input_validation.R#L2590 } ... +R/utils_input_validation.R#L2592 ) ... +R/utils_input_validation.R#L2616 required_elements <- switch(func_type, ... +R/utils_input_validation.R#L2618 "data", ... +R/utils_input_validation.R#L2619 "meta", ... +R/utils_input_validation.R#L2620 "condition", ... +R/utils_input_validation.R#L2621 "report_info" ... +R/utils_input_validation.R#L2624 "condition", ... +R/utils_input_validation.R#L2625 "report_info", ... +R/utils_input_validation.R#L2626 "padjust_method" ... +R/utils_input_validation.R#L2629 "data", ... +R/utils_input_validation.R#L2630 "meta", ... +R/utils_input_validation.R#L2631 "design", ... +R/utils_input_validation.R#L2632 "mode", ... +R/utils_input_validation.R#L2633 "condition", ... +R/utils_input_validation.R#L2634 "spline_params", ... +R/utils_input_validation.R#L2635 "padjust_method" ... +R/utils_input_validation.R#L2638 "limma_splines_result", ... +R/utils_input_validation.R#L2639 "report_info" ... +R/utils_input_validation.R#L2642 "data", ... +R/utils_input_validation.R#L2643 "meta", ... +R/utils_input_validation.R#L2644 "design", ... +R/utils_input_validation.R#L2645 "mode", ... +R/utils_input_validation.R#L2646 "condition", ... +R/utils_input_validation.R#L2647 "spline_params", ... +R/utils_input_validation.R#L2648 "limma_splines_result" ... +R/utils_input_validation.R#L2651 ) ... +R/utils_input_validation.R#L2653 missing_elements <- required_elements[ ... +R/utils_input_validation.R#L2655 splineomics[required_elements], ... +R/utils_input_validation.R#L2656 function(x) !is.null(x), ... +R/utils_input_validation.R#L2657 logical(1) ... +R/utils_input_validation.R#L2659 ] ... +R/utils_input_validation.R#L2661 if (length(missing_elements) > 0) { ... +R/utils_input_validation.R#L2663 "The following required elements f ... +R/utils_input_validation.R#L2664 func_type, ... +R/utils_input_validation.R#L2665 "were not passed to the SplineOmic ... +R/utils_input_validation.R#L2666 paste( ... +R/utils_input_validation.R#L2669 ), ... +R/utils_input_validation.R#L2670 "\nAll required elements for", ... +R/utils_input_validation.R#L2671 func_type, ... +R/utils_input_validation.R#L2672 "are:", ... +R/utils_input_validation.R#L2673 paste( ... +R/utils_input_validation.R#L2676 ) ... +R/utils_input_validation.R#L2678 } ... +R/utils_input_validation.R#L2695 null_elements <- names(args)[vapply(ar ... +R/utils_input_validation.R#L2697 if (length(null_elements) > 0) { ... +R/utils_input_validation.R#L2699 paste( ... +R/utils_input_validation.R#L2702 ), ... +R/utils_input_validation.R#L2703 call. = FALSE ... +R/utils_input_validation.R#L2705 } ... +R/utils_report_generation.R#L81 Sys.time(), ... +R/utils_report_generation.R#L82 "%d_%m_%Y-%H_%M_%S" ... +R/utils_report_generation.R#L85 feature_names_formula <- "" ... +R/utils_report_generation.R#L87 if (report_type == "explore_data") { ... +R/utils_report_generation.R#L89 title <- "explore data" ... +R/utils_report_generation.R#L91 title <- "explore batch-corrected ... +R/utils_report_generation.R#L93 } else if (report_type == "screen_limm ... +R/utils_report_generation.R#L95 } else if (report_type == "create_limm ... +R/utils_report_generation.R#L97 } else if (report_type == "cluster_hit ... +R/utils_report_generation.R#L100 feature_name_columns, ... +R/utils_report_generation.R#L101 collapse = "_" ... +R/utils_report_generation.R#L103 } else if (report_type == "create_gsea ... R/utils_report_generation.R#L105 } else { ... -R/utils_report_generation.R#L107 "create_limma_report, or ... -R/utils_report_generation.R#L108 call. = FALSE) ... -R/utils_report_generation.R#L109 } ... -R/utils_report_generation.R#L110 ... -R/utils_report_generation.R#L111 fields_to_format <- c( ... -R/utils_report_generation.R#L117 ... -R/utils_report_generation.R#L118 for (field in fields_to_format) { ... -R/utils_report_generation.R#L120 report_info[[field]] <- format_tex ... -R/utils_report_generation.R#L122 } ... -R/utils_report_generation.R#L124 header_text <- paste( ... -R/utils_report_generation.R#L129 header_text <- paste(header_text, "

    ', ... +R/utils_report_generation.R#L238 ), ... +R/utils_report_generation.R#L239 sep = "\n" ... +R/utils_report_generation.R#L241 } ... +R/utils_report_generation.R#L243 # Close the Report Info table ... +R/utils_report_generation.R#L244 report_info_section <- paste(report_in ... +R/utils_report_generation.R#L246 download_fields <- c(download_fields, ... +R/utils_report_generation.R#L247 for (field in download_fields) { ... +R/utils_report_generation.R#L249 field, ... +R/utils_report_generation.R#L250 data, ... +R/utils_report_generation.R#L251 meta, ... +R/utils_report_generation.R#L252 topTables, ... +R/utils_report_generation.R#L253 report_info, ... +R/utils_report_generation.R#L254 encode_df_to_base64, ... +R/utils_report_generation.R#L255 report_type, ... +R/utils_report_generation.R#L256 enrichr_format ... +R/utils_report_generation.R#L261 downloads_section, ... +R/utils_report_generation.R#L262 sprintf( ... +R/utils_report_generation.R#L264 color:blue; padding-right: 5p ... +R/utils_report_generation.R#L265 :', ... +R/utils_report_generation.R#L267 ), ... +R/utils_report_generation.R#L268 sep = "\n" ... +R/utils_report_generation.R#L270 } ... +R/utils_report_generation.R#L272 # Close the Downloads table ... +R/utils_report_generation.R#L273 downloads_section <- paste(downloads_s ... +R/utils_report_generation.R#L275 # Preserve initial header_section cont ... +R/utils_report_generation.R#L276 header_section <- paste( ... +R/utils_report_generation.R#L281 ) ... +R/utils_report_generation.R#L284 if (report_type == "create_gsea_report ... +R/utils_report_generation.R#L287 header_section, ... +R/utils_report_generation.R#L288 "

    Datab ... +R/utils_report_generation.R#L289 databases_text, ... +R/utils_report_generation.R#L290 "

    ", ... +R/utils_report_generation.R#L291 sep = "\n" ... +R/utils_report_generation.R#L293 } ... +R/utils_report_generation.R#L295 file_name <- sprintf( ... +R/utils_report_generation.R#L300 ) ... +R/utils_report_generation.R#L302 output_file_path <- here::here(report_ ... +R/utils_report_generation.R#L304 if (report_type == "explore_data") { ... R/utils_report_generation.R#L306 header_section = header_section, ... R/utils_report_generation.R#L307 plots = plots, ... R/utils_report_generation.R#L308 plots_sizes = plots_sizes, ... -R/utils_report_generation.R#L309 level_headers_info = level_headers ... -R/utils_report_generation.R#L310 report_info = report_info, ... -R/utils_report_generation.R#L311 output_file_path = output_file_pat ... -R/utils_report_generation.R#L312 ) ... -R/utils_report_generation.R#L314 } else { # report_type == "c ... -R/utils_report_generation.R#L316 header_section = header_section, ... -R/utils_report_generation.R#L317 plots = plots, ... -R/utils_report_generation.R#L318 limma_result_2_and_3_plots = limma ... -R/utils_report_generation.R#L319 plots_sizes = plots_sizes, ... -R/utils_report_generation.R#L320 level_headers_info = level_headers ... -R/utils_report_generation.R#L321 spline_params = spline_params, ... -R/utils_report_generation.R#L322 adj_pthresholds = adj_pthresholds, ... -R/utils_report_generation.R#L323 mode = mode, ... -R/utils_report_generation.R#L324 report_info = report_info, ... -R/utils_report_generation.R#L325 output_file_path = output_file_pat ... -R/utils_report_generation.R#L326 ) ... -R/utils_report_generation.R#L327 } ... -R/utils_report_generation.R#L352 ... -R/utils_report_generation.R#L353 output_file_path <- normalizePath( ... -R/utils_report_generation.R#L357 ... -R/utils_report_generation.R#L358 # Close the Table of Contents ... -R/utils_report_generation.R#L359 toc <- paste( ... -R/utils_report_generation.R#L364 ... -R/utils_report_generation.R#L365 # Insert the Table of Contents at the ... -R/utils_report_generation.R#L366 html_content <- gsub( ... -R/utils_report_generation.R#L371 ... -R/utils_report_generation.R#L372 # Append a horizontal line after the T ... -R/utils_report_generation.R#L373 html_content <- gsub( ... -R/utils_report_generation.R#L378 ... -R/utils_report_generation.R#L379 # Path to the external JavaScript file ... -R/utils_report_generation.R#L380 js_file_path <- normalizePath( ... -R/utils_report_generation.R#L382 "www/hotkeys.js", ... -R/utils_report_generation.R#L383 package = "SplineOmics" ... -R/utils_report_generation.R#L384 ), ... -R/utils_report_generation.R#L387 if (js_file_path == "") { ... -R/utils_report_generation.R#L389 } ... -R/utils_report_generation.R#L390 ... -R/utils_report_generation.R#L391 # Read the JavaScript file and replace ... -R/utils_report_generation.R#L392 js_content <- readLines( ... -R/utils_report_generation.R#L396 js_content <- gsub( ... -R/utils_report_generation.R#L401 js_content <- gsub( ... -R/utils_report_generation.R#L406 ... -R/utils_report_generation.R#L407 # Read the content of JSZip and FileSa ... -R/utils_report_generation.R#L408 jszip_path <- normalizePath( ... -R/utils_report_generation.R#L410 "www/jszip.min.js", ... -R/utils_report_generation.R#L411 package = "SplineOmics" ... -R/utils_report_generation.R#L412 ), ... -R/utils_report_generation.R#L415 filesaver_path <- normalizePath( ... -R/utils_report_generation.R#L417 "www/FileSaver.min.js", ... -R/utils_report_generation.R#L418 package = "SplineOmics" ... -R/utils_report_generation.R#L419 ), ... -R/utils_report_generation.R#L422 ... -R/utils_report_generation.R#L423 if (!file.exists(jszip_path)) { ... -R/utils_report_generation.R#L425 } ... -R/utils_report_generation.R#L426 if (!file.exists(filesaver_path)) { ... -R/utils_report_generation.R#L428 } ... -R/utils_report_generation.R#L429 ... -R/utils_report_generation.R#L430 jszip_content <- readLines( ... -R/utils_report_generation.R#L435 filesaver_content <- readLines( ... -R/utils_report_generation.R#L440 ... -R/utils_report_generation.R#L441 # Combine all JavaScript content ... -R/utils_report_generation.R#L442 combined_js_content <- c( ... -R/utils_report_generation.R#L448 ) ... -R/utils_report_generation.R#L449 ... -R/utils_report_generation.R#L450 # Properly escape special characters i ... -R/utils_report_generation.R#L451 combined_js_content <- paste( ... -R/utils_report_generation.R#L455 combined_js_content <- gsub( ... -R/utils_report_generation.R#L460 combined_js_content <- gsub( # Esca ... -R/utils_report_generation.R#L465 ... -R/utils_report_generation.R#L466 # Embed the combined JavaScript conten ... -R/utils_report_generation.R#L467 script_tag <- paste( ... -R/utils_report_generation.R#L471 html_content <- gsub( ... -R/utils_report_generation.R#L474 script_tag, ... -R/utils_report_generation.R#L475 "", ... -R/utils_report_generation.R#L476 sep = "\n" ... -R/utils_report_generation.R#L477 ), ... -R/utils_report_generation.R#L480 ... -R/utils_report_generation.R#L481 # Append the final closing tags for th ... -R/utils_report_generation.R#L482 html_content <- paste( ... -R/utils_report_generation.R#L487 ... -R/utils_report_generation.R#L488 # Ensure the directory exists ... -R/utils_report_generation.R#L489 dir_path <- dirname(output_file_path) ... -R/utils_report_generation.R#L490 if (!dir.exists(dir_path)) { ... -R/utils_report_generation.R#L492 } ... -R/utils_report_generation.R#L493 ... -R/utils_report_generation.R#L494 con <- file( ... -R/utils_report_generation.R#L499 writeLines( ... -R/utils_report_generation.R#L504 close(con) ... -R/utils_report_generation.R#L523 ... -R/utils_report_generation.R#L524 file_path <- system.file( ... -R/utils_report_generation.R#L529 content <- readLines( ... -R/utils_report_generation.R#L533 # Split the content by the delimiter ... -R/utils_report_generation.R#L534 strsplit(content, "\\|")[[1]] ... -R/utils_report_generation.R#L556 letters <- strsplit(text, "")[[1]] ... -R/utils_report_generation.R#L557 formatted_lines <- vector(mode = "char ... -R/utils_report_generation.R#L558 current_line <- "" ... -R/utils_report_generation.R#L559 for (char in letters) { ... -R/utils_report_generation.R#L561 current_line <- paste(current_line ... -R/utils_report_generation.R#L563 formatted_lines <- c(formatted_lin ... -R/utils_report_generation.R#L564 current_line <- char ... -R/utils_report_generation.R#L566 } ... -R/utils_report_generation.R#L567 formatted_lines <- c(formatted_lines, ... -R/utils_report_generation.R#L568 formatted_text <- paste(formatted_line ... -R/utils_report_generation.R#L607 if (feature_names_formula == "") { ... -R/utils_report_generation.R#L609 } ... -R/utils_report_generation.R#L610 ... -R/utils_report_generation.R#L611 if (Sys.getenv("DEVTOOLS_LOAD") == "tr ... -R/utils_report_generation.R#L613 "inst", ... -R/utils_report_generation.R#L614 "logos", ... -R/utils_report_generation.R#L615 "SplineOmics_logo.png" ... -R/utils_report_generation.R#L616 ) ... -R/utils_report_generation.R#L617 } else { ... -R/utils_report_generation.R#L619 "logos", ... -R/utils_report_generation.R#L620 "SplineOmics_logo.png", ... -R/utils_report_generation.R#L621 package = "SplineOmics" ... -R/utils_report_generation.R#L622 ) ... -R/utils_report_generation.R#L623 } ... -R/utils_report_generation.R#L624 ... -R/utils_report_generation.R#L625 logo_base64 <- base64enc::dataURI(file ... -R/utils_report_generation.R#L627 header_section <- paste( ... -R/utils_report_generation.R#L666 ) ... -R/utils_report_generation.R#L667 ... -R/utils_report_generation.R#L668 note <- switch( ... -R/utils_report_generation.R#L671 '
    ', ... -R/utils_report_generation.R#L675 '
    N ... -R/utils_report_generation.R#L680 '

    ', ... -R/utils_report_generation.R#L681 "This HTML report contains the exp ... -R/utils_report_generation.R#L682 "data analysis plots, (e.g. densit ... -R/utils_report_generation.R#L683 "any plot in this report to save i ... -R/utils_report_generation.R#L684 '

    ' ... -R/utils_report_generation.R#L685 ), ... -R/utils_report_generation.R#L688 '
    ', ... -R/utils_report_generation.R#L691 '' ... -R/utils_report_generation.R#L711 '
    Note!
    ', ... -R/utils_report_generation.R#L719 '

    ', ... -R/utils_report_generation.R#L720 "Clustering of features that show" ... -R/utils_report_generation.R#L721 "significant changes over time (= ... -R/utils_report_generation.R#L722 "Clustering was done based on the ... -R/utils_report_generation.R#L723 "of the spline.
    For this, the ... -R/utils_report_generation.R#L724 "topTable are used to generate 100 ... -R/utils_report_generation.R#L725 "These datapoints are used for hi ... -R/utils_report_generation.R#L726 "Right-click on any plot in this ... -R/utils_report_generation.R#L727 ".svg (vector graphic) file!
    ... -R/utils_report_generation.R#L728 "the experiment is not shown, it m ... -R/utils_report_generation.R#L729 "

    ", ... -R/utils_report_generation.R#L730 paste( ... -R/utils_report_generation.R#L737 ), ... -R/utils_report_generation.R#L738 '
    ' ... -R/utils_report_generation.R#L739 ), ... -R/utils_report_generation.R#L742 hotkeys_box <- paste( ... -R/utils_report_generation.R#L762 ) ... -R/utils_report_generation.R#L763 ... -R/utils_report_generation.R#L764 ... -R/utils_report_generation.R#L765 header_section <- paste( ... +R/utils_report_generation.R#L309 report_info = report_info, ... +R/utils_report_generation.R#L310 output_file_path = output_file_pat ... +R/utils_report_generation.R#L312 } else if (report_type == "screen_limm ... +R/utils_report_generation.R#L314 header_section = header_section, ... +R/utils_report_generation.R#L315 plots = plots, ... +R/utils_report_generation.R#L316 plots_sizes = plots_sizes, ... +R/utils_report_generation.R#L317 report_info = report_info, ... +R/utils_report_generation.R#L318 output_file_path = output_file_pat ... +R/utils_report_generation.R#L320 } else if (report_type == "create_limm ... +R/utils_report_generation.R#L322 header_section = header_section, ... +R/utils_report_generation.R#L323 plots = plots, ... +R/utils_report_generation.R#L324 plots_sizes = plots_sizes, ... +R/utils_report_generation.R#L325 level_headers_info = level_headers ... +R/utils_report_generation.R#L326 report_info = report_info, ... +R/utils_report_generation.R#L327 output_file_path = output_file_pat ... +R/utils_report_generation.R#L329 } else if (report_type == "create_gsea ... +R/utils_report_generation.R#L331 header_section = header_section, ... +R/utils_report_generation.R#L332 plots = plots, ... +R/utils_report_generation.R#L333 plots_sizes = plots_sizes, ... +R/utils_report_generation.R#L334 level_headers_info = level_headers ... +R/utils_report_generation.R#L335 report_info = report_info, ... +R/utils_report_generation.R#L336 output_file_path = output_file_pat ... +R/utils_report_generation.R#L338 } else { # report_type == "cluster_hit ... +R/utils_report_generation.R#L340 header_section = header_section, ... +R/utils_report_generation.R#L341 plots = plots, ... +R/utils_report_generation.R#L342 limma_result_2_and_3_plots = limma ... +R/utils_report_generation.R#L343 plots_sizes = plots_sizes, ... +R/utils_report_generation.R#L344 level_headers_info = level_headers ... +R/utils_report_generation.R#L345 spline_params = spline_params, ... +R/utils_report_generation.R#L346 adj_pthresholds = adj_pthresholds, ... +R/utils_report_generation.R#L347 adj_pthresh_avrg_diff_conditions = ... +R/utils_report_generation.R#L348 adj_pthresh_interaction_condition_ ... +R/utils_report_generation.R#L350 mode = mode, ... +R/utils_report_generation.R#L351 report_info = report_info, ... +R/utils_report_generation.R#L352 output_file_path = output_file_pat ... +R/utils_report_generation.R#L354 } ... +R/utils_report_generation.R#L378 output_file_path <- normalizePath( ... +R/utils_report_generation.R#L381 ) ... +R/utils_report_generation.R#L383 # Close the Table of Contents ... +R/utils_report_generation.R#L384 toc <- paste( ... +R/utils_report_generation.R#L388 ) ... +R/utils_report_generation.R#L390 # Insert the Table of Contents at the ... +R/utils_report_generation.R#L391 html_content <- gsub( ... +R/utils_report_generation.R#L395 ) ... +R/utils_report_generation.R#L397 # Append a horizontal line after the T ... +R/utils_report_generation.R#L398 html_content <- gsub( ... +R/utils_report_generation.R#L402 ) ... +R/utils_report_generation.R#L404 # Path to the external JavaScript file ... +R/utils_report_generation.R#L405 js_file_path <- normalizePath( ... +R/utils_report_generation.R#L407 "www/hotkeys.js", ... +R/utils_report_generation.R#L408 package = "SplineOmics" ... +R/utils_report_generation.R#L411 ) ... +R/utils_report_generation.R#L412 if (js_file_path == "") { ... +R/utils_report_generation.R#L414 } ... +R/utils_report_generation.R#L416 # Read the JavaScript file and replace ... +R/utils_report_generation.R#L417 js_content <- readLines( ... +R/utils_report_generation.R#L420 ) ... +R/utils_report_generation.R#L421 js_content <- gsub( ... +R/utils_report_generation.R#L425 ) ... +R/utils_report_generation.R#L426 js_content <- gsub( ... +R/utils_report_generation.R#L430 ) ... +R/utils_report_generation.R#L432 # Read the content of JSZip and FileSa ... +R/utils_report_generation.R#L433 jszip_path <- normalizePath( ... +R/utils_report_generation.R#L435 "www/jszip.min.js", ... +R/utils_report_generation.R#L436 package = "SplineOmics" ... +R/utils_report_generation.R#L439 ) ... +R/utils_report_generation.R#L440 filesaver_path <- normalizePath( ... +R/utils_report_generation.R#L442 "www/FileSaver.min.js", ... +R/utils_report_generation.R#L443 package = "SplineOmics" ... +R/utils_report_generation.R#L446 ) ... +R/utils_report_generation.R#L448 if (!file.exists(jszip_path)) { ... +R/utils_report_generation.R#L450 } ... +R/utils_report_generation.R#L451 if (!file.exists(filesaver_path)) { ... +R/utils_report_generation.R#L453 } ... +R/utils_report_generation.R#L455 jszip_content <- readLines( ... +R/utils_report_generation.R#L459 ) ... +R/utils_report_generation.R#L460 filesaver_content <- readLines( ... +R/utils_report_generation.R#L464 ) ... +R/utils_report_generation.R#L466 # Combine all JavaScript content ... +R/utils_report_generation.R#L467 combined_js_content <- c( ... +R/utils_report_generation.R#L473 ) ... +R/utils_report_generation.R#L475 # Properly escape special characters i ... +R/utils_report_generation.R#L476 combined_js_content <- paste( ... +R/utils_report_generation.R#L479 ) ... +R/utils_report_generation.R#L480 combined_js_content <- gsub( ... +R/utils_report_generation.R#L484 ) # Escape backslashes ... +R/utils_report_generation.R#L485 combined_js_content <- gsub( # Escape ... +R/utils_report_generation.R#L489 ) ... +R/utils_report_generation.R#L491 # Embed the combined JavaScript conten ... +R/utils_report_generation.R#L492 script_tag <- paste( ... +R/utils_report_generation.R#L495 ) ... +R/utils_report_generation.R#L496 html_content <- gsub( ... +R/utils_report_generation.R#L499 script_tag, ... +R/utils_report_generation.R#L500 "", ... +R/utils_report_generation.R#L501 sep = "\n" ... +R/utils_report_generation.R#L504 ) ... +R/utils_report_generation.R#L506 # Append the final closing tags for th ... +R/utils_report_generation.R#L507 html_content <- paste( ... +R/utils_report_generation.R#L511 ) ... +R/utils_report_generation.R#L513 # Ensure the directory exists ... +R/utils_report_generation.R#L514 dir_path <- dirname(output_file_path) ... +R/utils_report_generation.R#L515 if (!dir.exists(dir_path)) { ... +R/utils_report_generation.R#L517 } ... +R/utils_report_generation.R#L519 con <- file( ... +R/utils_report_generation.R#L523 ) ... +R/utils_report_generation.R#L524 writeLines( ... +R/utils_report_generation.R#L528 ) ... +R/utils_report_generation.R#L529 close(con) ... +R/utils_report_generation.R#L548 file_path <- system.file( ... +R/utils_report_generation.R#L552 ) ... +R/utils_report_generation.R#L553 content <- readLines( ... +R/utils_report_generation.R#L556 ) |> paste(collapse = " ") ... +R/utils_report_generation.R#L557 # Split the content by the delimiter ... +R/utils_report_generation.R#L558 strsplit(content, "\\|")[[1]] ... +R/utils_report_generation.R#L579 letters <- strsplit(text, "")[[1]] ... +R/utils_report_generation.R#L580 formatted_lines <- vector(mode = "char ... +R/utils_report_generation.R#L581 current_line <- "" ... +R/utils_report_generation.R#L582 for (char in letters) { ... +R/utils_report_generation.R#L584 current_line <- paste(current_line ... +R/utils_report_generation.R#L586 formatted_lines <- c(formatted_lin ... +R/utils_report_generation.R#L587 current_line <- char ... +R/utils_report_generation.R#L589 } ... +R/utils_report_generation.R#L590 formatted_lines <- c(formatted_lines, ... +R/utils_report_generation.R#L591 formatted_text <- paste(formatted_line ... +R/utils_report_generation.R#L628 if (feature_names_formula == "") { ... +R/utils_report_generation.R#L630 } ... +R/utils_report_generation.R#L632 if (Sys.getenv("DEVTOOLS_LOAD") == "tr ... +R/utils_report_generation.R#L634 "inst", ... +R/utils_report_generation.R#L635 "logos", ... +R/utils_report_generation.R#L636 "SplineOmics_logo.png" ... +R/utils_report_generation.R#L638 } else { ... +R/utils_report_generation.R#L640 "logos", ... +R/utils_report_generation.R#L641 "SplineOmics_logo.png", ... +R/utils_report_generation.R#L642 package = "SplineOmics" ... +R/utils_report_generation.R#L644 } ... +R/utils_report_generation.R#L646 logo_base64 <- base64enc::dataURI(file ... +R/utils_report_generation.R#L648 header_section <- paste( ... +R/utils_report_generation.R#L687 ) ... +R/utils_report_generation.R#L689 note <- switch(report_type, ... +R/utils_report_generation.R#L691 '
    ', ... +R/utils_report_generation.R#L695 '
    N ... +R/utils_report_generation.R#L700 '

    ', ... +R/utils_report_generation.R#L701 "This HTML report contains the exp ... +R/utils_report_generation.R#L702 "data analysis plots, (e.g. densit ... +R/utils_report_generation.R#L703 "any plot in this report to save i ... +R/utils_report_generation.R#L704 "

    " ... +R/utils_report_generation.R#L708 '
    ', ... +R/utils_report_generation.R#L711 '" ... +R/utils_report_generation.R#L731 '
    Note!
    ', ... +R/utils_report_generation.R#L739 '

    ', ... +R/utils_report_generation.R#L740 '

      ... +R/utils_report_generation.R#L742 significant changes over time (= h ... +R/utils_report_generation.R#L743 '
    • ... +R/utils_report_generation.R#L744 min-max normalized shape of the sp ... +R/utils_report_generation.R#L745 '
    • ... +R/utils_report_generation.R#L746 the limma topTable are used to gen ... +R/utils_report_generation.R#L747 0 and 1.
    • ', ... +R/utils_report_generation.R#L748 '
    • ... +R/utils_report_generation.R#L749 hierarchical clustering.
    • ', ... +R/utils_report_generation.R#L750 '
    • ... +R/utils_report_generation.R#L751 report to save it as a .svg (vecto ... +R/utils_report_generation.R#L752 '
    • ... +R/utils_report_generation.R#L753 not shown, it means it has < 2 hit ... +R/utils_report_generation.R#L754 '
    • ... +R/utils_report_generation.R#L755 individual spline plots is the ave ... +R/utils_report_generation.R#L756 all timepoints. For example, a val ... +R/utils_report_generation.R#L757 on average, have a standard deviat ... +R/utils_report_generation.R#L758 "
    ", ... +R/utils_report_generation.R#L759 "

    ", ... +R/utils_report_generation.R#L760 "
    ", ... +R/utils_report_generation.R#L761 paste( ... +R/utils_report_generation.R#L768 ), ... +R/utils_report_generation.R#L769 "
    " ... R/utils_report_generation.R#L772 ) ... -R/utils_report_generation.R#L773 ... -R/utils_report_generation.R#L774 return(header_section) ... -R/utils_report_generation.R#L799 ... -R/utils_report_generation.R#L800 temp_file <- tempfile(fileext = ".xlsx ... -R/utils_report_generation.R#L801 wb <- openxlsx::createWorkbook() ... -R/utils_report_generation.R#L802 ... -R/utils_report_generation.R#L803 if (is.data.frame(df)) { ... -R/utils_report_generation.R#L807 wb, ... -R/utils_report_generation.R#L808 sheet_name ... -R/utils_report_generation.R#L809 ) ... -R/utils_report_generation.R#L811 wb, ... -R/utils_report_generation.R#L812 sheet = sheet_name, ... -R/utils_report_generation.R#L813 df ... -R/utils_report_generation.R#L814 ) ... -R/utils_report_generation.R#L815 } else if (is.list(df) && all(sapply(d ... -R/utils_report_generation.R#L819 if (report_type == "create_gsea_re ... -R/utils_report_generation.R#L822 } ... -R/utils_report_generation.R#L824 sheet_names <- make.unique(names(d ... -R/utils_report_generation.R#L829 openxlsx::addWorksheet( ... -R/utils_report_generation.R#L833 openxlsx::writeData( ... -R/utils_report_generation.R#L839 } else { ... -R/utils_report_generation.R#L842 } ... -R/utils_report_generation.R#L843 ... -R/utils_report_generation.R#L844 openxlsx::saveWorkbook( ... -R/utils_report_generation.R#L849 ... -R/utils_report_generation.R#L850 # Read the file and encode to base64 ... -R/utils_report_generation.R#L851 file_content <- readBin( ... -R/utils_report_generation.R#L856 base64_file <- base64enc::base64encode ... -R/utils_report_generation.R#L857 ... -R/utils_report_generation.R#L858 # Determine MIME type ... -R/utils_report_generation.R#L859 mime_type <- ... -R/utils_report_generation.R#L861 ... -R/utils_report_generation.R#L862 # Create the data URI scheme ... -R/utils_report_generation.R#L863 data_uri <- paste0( ... -R/utils_report_generation.R#L869 ... -R/utils_report_generation.R#L870 # Remove the temporary file ... -R/utils_report_generation.R#L871 unlink(temp_file) ... -R/utils_report_generation.R#L872 ... -R/utils_report_generation.R#L873 return(data_uri) ... -R/utils_report_generation.R#L912 ... -R/utils_report_generation.R#L913 additional_height_per_row <- 2.1 ... -R/utils_report_generation.R#L914 height <- base_height_per_row + (heigh ... -R/utils_report_generation.R#L915 ... -R/utils_report_generation.R#L916 # Create a temporary file for the SVG. ... -R/utils_report_generation.R#L917 # already, but later, after exporting ... -R/utils_report_generation.R#L918 # specify the quality. ... -R/utils_report_generation.R#L919 img_file <- tempfile(fileext = ".svg") ... -R/utils_report_generation.R#L921 svglite::svglite(file = img_file, widt ... -R/utils_report_generation.R#L922 ... -R/utils_report_generation.R#L923 # Draw the plot ... -R/utils_report_generation.R#L924 print(plot) ... -R/utils_report_generation.R#L926 # Turn off the device ... -R/utils_report_generation.R#L927 dev.off() ... -R/utils_report_generation.R#L928 ... -R/utils_report_generation.R#L929 # Read the SVG file content ... -R/utils_report_generation.R#L930 svg_content <- readLines(img_file, war ... -R/utils_report_generation.R#L931 ... -R/utils_report_generation.R#L932 # Convert the SVG content to a single ... -R/utils_report_generation.R#L933 svg_string <- paste(svg_content, colla ... -R/utils_report_generation.R#L934 ... -R/utils_report_generation.R#L935 # Encode the SVG content as base64 ... -R/utils_report_generation.R#L936 svg_base64 <- base64enc::dataURI( ... -R/utils_report_generation.R#L940 ... -R/utils_report_generation.R#L941 # Delete the temporary SVG file ... -R/utils_report_generation.R#L942 unlink(img_file) ... -R/utils_report_generation.R#L943 ... -R/utils_report_generation.R#L944 # Return the HTML img tag with the bas ... -R/utils_report_generation.R#L945 return( ... -R/utils_report_generation.R#L947 'Plot", ... -R/utils_report_generation.R#L966 "
    ", ... -R/utils_report_generation.R#L968 "

    Table of ... -R/utils_report_generation.R#L969 "

    @@ -637,7 +641,7 @@

    Output and Report Options

    just want the figures in the R environment)
    # Those fields are mandatory, because we believe that when such a report is
    -# opened after half a year, those infos can be very helpful. 
    +# opened after half a year, those infos can be very helpful.
     report_info <- list(
       omics_data_type = "PTX",
       data_description = "Proteomics data of CHO cells",
    @@ -645,12 +649,12 @@ 

    Output and Report Options

    analyst_name = "Thomas Rauter", contact_info = "thomas.rauter@plus.ac.at", project_name = "DGTX" - ) +) report_dir <- here::here( "results", "explore_data" - )
    +)

    SplineOmics Object

    @@ -713,12 +717,12 @@

    Optional Arguments create_splineomics()

    meta = meta, annotation = annotation, report_info = report_info, - condition = "Phase", # Column of meta that contains the levels. - meta_batch_column = "Reactor" # For batch effect removal + condition = "Phase", # Column of meta that contains the levels. + meta_batch_column = "Reactor" # For batch effect removal ) # Special print.SplineOmics function leads to selective printing -print(splineomics) +print(splineomics) #> data:SplineOmics Object #> ------------------- #> Number of features (rows): 4162 @@ -739,9 +743,9 @@

    Optional Arguments create_splineomics()

    Now that we have the SplineOmics object defined, we can perform our exploratory data analysis.

    plots <- SplineOmics::explore_data(
    -  splineomics = splineomics,   # SplineOmics object
    +  splineomics = splineomics, # SplineOmics object
       report_dir = report_dir
    -  )
    +)

    Here you can see the HTML report of the explore_data() function with the NOT batch-corrected data, and here @@ -864,77 +868,77 @@

    Example

    This allows you to systematically explore different combinations and select the optimal hyperparameters for your analysis.

    Below is an example for our proteomics data:

    -
    data1 <- data 
    +
    data1 <- data
     meta1 <- meta
     
     # Remove the "outliers"
     data2 <- data[, !(colnames(data) %in% c(
    -  "E12_TP05_Exponential", 
    +  "E12_TP05_Exponential",
       "E10_TP10_Stationary"
    -  )
    -  )]
    +)
    +)]
     
     # Adjust meta so that it matches data2
     meta2 <- meta[!meta$Sample.ID %in% c(
    -  "E12_TP05_Exponential", 
    +  "E12_TP05_Exponential",
       "E10_TP10_Stationary"
    -  ), ]
    +), ]
     
    -# As mentioned above, all the values of one hyperparameter are stored 
    +# As mentioned above, all the values of one hyperparameter are stored
     # and provided as a list.
    -datas <- list(data1, data2) 
    +datas <- list(data1, data2)
     
     # This will be used to describe the versions of the data.
     datas_descr <- c(
       "full_data",
       "outliers_removed"
    -  ) 
    +)
     
    -metas <- list(meta1, meta2) 
    +metas <- list(meta1, meta2)
     
     # Test two different limma designs
     designs <- c(
       "~ 1 + Phase*X + Reactor",
       "~ 1 + X + Reactor"
    -  ) 
    +)
     
     # 'Integrated means' limma will use the full dataset to generate the results for
    -# each condition. 'Isolated' means limma will use only the respective part of 
    -# the dataset for each condition. Designs that contain the condition column 
    +# each condition. 'Isolated' means limma will use only the respective part of
    +# the dataset for each condition. Designs that contain the condition column
     # (here Phase) must have mode 'integrated', because the full data is needed to
     # include the different conditions into the design formula.
     modes <- c(
       "integrated",
       "isolated"
    -  )
    +)
     
     # Specify the meta "level" column
    -condition <- "Phase" 
    +condition <- "Phase"
     
     report_dir <- here::here(
       "results",
       "hyperparams_screen_reports"
    -  ) 
    +)
     
     # To remove the batch effect
    -meta_batch_column = "Reactor" 
    +meta_batch_column <- "Reactor"
     
     # Test out two different p-value thresholds (inner hyperparameter)
     adj_pthresholds <- c(
       0.05,
       0.1
    -  )
    +)
     
     # Create a dataframe with combinations of spline parameters to test
     # (every row a combo to test)
     spline_test_configs <- data.frame(
    -   # 'n' stands for natural cubic splines, b for B-splines.
    -  spline_type = c("n", "n", "b", "b"),  
    +  # 'n' stands for natural cubic splines, b for B-splines.
    +  spline_type = c("n", "n", "b", "b"),
       # Degree is not applicable (NA) for natural splines.
    -  degree = c(NA, NA, 2L, 4L),           
    +  degree = c(NA, NA, 2L, 4L),
       # Degrees of freedom (DoF) to test.
       # Higher dof means spline can fit more complex patterns.
    -  dof = c(2L, 3L, 3L, 4L)         
    +  dof = c(2L, 3L, 3L, 4L)
     )
     
     print(spline_test_configs)
    @@ -956,7 +960,7 @@ 

    Example

    spline_test_configs = spline_test_configs, report_dir = report_dir, adj_pthresholds = adj_pthresholds, - )
    +)

    As mentioned, this function generates a report for each comparison of the outer hyperparameters, which are too many to show here. You can view an example report here

    @@ -992,20 +996,20 @@

    Run limma spline analysis

    To generate the limma result categories 2 and 3 ()

    splineomics <- SplineOmics::update_splineomics(
       splineomics = splineomics,
    -  design = "~ 1 + Phase*X + Reactor",  # best design formula
    -  mode = "integrated",  # means limma uses the full data for each condition.
    -  data = data2,   # data without "outliers" was better
    -  meta = meta2,  
    +  design = "~ 1 + Phase*X + Reactor", # best design formula
    +  mode = "integrated", # means limma uses the full data for each condition.
    +  data = data2, # data without "outliers" was better
    +  meta = meta2,
       spline_params = list(
    -    spline_type = c("n"),   # natural cubic splines (take these if unsure)
    -    dof = c(2L)  # If you are unsure about which dof, start with 2 and increase
    -    )
    +    spline_type = c("n"), # natural cubic splines (take these if unsure)
    +    dof = c(2L) # If you are unsure about which dof, start with 2 and increase
    +  )
     )

    Run the run_limma_splines() function with the updated SplineOmics object:

    splineomics <- SplineOmics::run_limma_splines(
       splineomics = splineomics
    -  )
    +)
     #> Column 'Reactor' of meta will be used to remove the batch effect for the plotting
     #> Info limma spline analysis completed successfully

    The output of the function run_limma_splines() is a named list, where @@ -1031,12 +1035,12 @@

    Build limma report

    report_dir <- here::here(
       "results",
       "create_limma_reports"
    -  )
    +)
     
     plots <- SplineOmics::create_limma_report(
       splineomics = splineomics,
       report_dir = report_dir
    -  )
    +)

    You can view the generated analysis report of the create_limma_report function here.

    This report contains p-value histograms for all three limma result @@ -1056,26 +1060,26 @@

    Cluster the hits (significant features)

    features (e.g. proteins) that have an adj. p-value below the threshold. Hierarchical clustering is used to place every hit in one of as many clusters as we have specified for that specific level.

    -
    adj_pthresholds <- c(  # 0.05 for both levels
    -  0.05,  # exponential
    -  0.05   # stationary
    -  )
    +
    adj_pthresholds <- c( # 0.05 for both levels
    +  0.05, # exponential
    +  0.05 # stationary
    +)
     
     clusters <- c(
    -  6L,  # 6 clusters for the exponential phase level
    -  3L   # 3 clusters for the stationary phase level
    -  )
    +  6L, # 6 clusters for the exponential phase level
    +  3L # 3 clusters for the stationary phase level
    +)
     
     report_dir <- here::here(
       "results",
       "clustering_reports"
    -  )
    +)
     
    -plot_info = list(  # For the spline plots
    +plot_info <- list( # For the spline plots
       y_axis_label = "log2 intensity",
    -  time_unit = "min",  # our measurements were in minutes
    -  treatment_labels = list("feeding"),  # add this for all conditions
    -  treatment_timepoints = list(0)  # Feeding was at 0 minutes.
    +  time_unit = "min", # our measurements were in minutes
    +  treatment_labels = list("feeding"), # add this for all conditions
    +  treatment_timepoints = list(0) # Feeding was at 0 minutes.
     )
     
     # Like this you can add individual treatment labels to your plots:
    @@ -1083,14 +1087,14 @@ 

    Cluster the hits (significant features)

    # exponential = "treatment 1", # One treatment in exp # stationary = c("treatment 2", "treatment 3") # Two treatments in stat # additional_condition = NA # No treatment in the hypothetical third condition -# ) -# +# ) +# # treatment_timepoints = list( # exponential = 0, # stationary = C(100, 140), # Two treatments also need two timepoints # additional_condition = NA -# ) -# +# ) +# # or set a treatment for ALL conditions (still always make a list): # # treatment_labels = list("treatment") @@ -1109,10 +1113,10 @@

    Cluster the hits (significant features)

    gene_column_name <- "Gene_symbol" genes <- annotation[[gene_column_name]] -plot_options = list( +plot_options <- list( # When meta_replicate_column is not there, all datapoints are blue. - meta_replicate_column = "Reactor", # Colors the data points based on Reactor - cluster_heatmap_columns = FALSE # Per default FALSE, just for demonstration + meta_replicate_column = "Reactor", # Colors the data points based on Reactor + cluster_heatmap_columns = FALSE # Per default FALSE, just for demonstration ) clustering_results <- SplineOmics::cluster_hits( @@ -1125,7 +1129,7 @@

    Cluster the hits (significant features)

    report_dir = report_dir, adj_pthresh_avrg_diff_conditions = 0, adj_pthresh_interaction_condition_time = 0.25 - )
    +)

    You can view the generated analysis report of the cluster_hits function here.

    As discussed before, there are three limma result categories. The @@ -1153,11 +1157,12 @@

    Perform gene set enrichment analysis (GSEA)

    "GO_Biological_Process_2018", "GO_Molecular_Function_2018", "Human_Gene_Atlas" - ) +) SplineOmics::download_enrichr_databases( gene_set_lib = gene_set_lib, - filename = "databases.tsv") + filename = "databases.tsv" +)

    Per default the file is placed in the current working directory, which is the root dir of the R project.

    To run GSEA, the downloaded database file has to be loaded as a @@ -1182,12 +1187,12 @@

    Perform gene set enrichment analysis (GSEA)

    minGSSize = 10, maxGSSize = 500, qvalueCutoff = 0.2 - ) +) report_dir <- here::here( "results", "gsea_reports" - ) +)

    The function below runs the clusterProfiler for all clusters and all levels, and generates the HTML report:

    result <- SplineOmics::run_gsea(
    @@ -1199,7 +1204,7 @@ 

    Perform gene set enrichment analysis (GSEA)

    clusterProfiler_params = clusterProfiler_params, report_info = report_info, report_dir = report_dir - )
    +)

    You can view the generated analysis report of the cluster_hits function here.

    This report first shows all enrichment results, where more than 2 @@ -1239,6 +1244,61 @@

    Conclusion

    satisfied with the documentation, open an issue on GitHub or check out the other options under the Feedback section of the README on GitHub. Thank you!

    +
    #> R version 4.3.3 (2024-02-29)
    +#> Platform: x86_64-pc-linux-gnu (64-bit)
    +#> Running under: Ubuntu 22.04.5 LTS
    +#> 
    +#> Matrix products: default
    +#> BLAS:   /usr/local/R-4.3.3/lib/R/lib/libRblas.so 
    +#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0
    +#> 
    +#> locale:
    +#>  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
    +#>  [3] LC_TIME=de_AT.UTF-8        LC_COLLATE=en_US.UTF-8    
    +#>  [5] LC_MONETARY=de_AT.UTF-8    LC_MESSAGES=en_US.UTF-8   
    +#>  [7] LC_PAPER=de_AT.UTF-8       LC_NAME=C                 
    +#>  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
    +#> [11] LC_MEASUREMENT=de_AT.UTF-8 LC_IDENTIFICATION=C       
    +#> 
    +#> time zone: Europe/Vienna
    +#> tzcode source: system (glibc)
    +#> 
    +#> attached base packages:
    +#> [1] stats     graphics  grDevices datasets  utils     methods   base     
    +#> 
    +#> other attached packages:
    +#> [1] dplyr_1.1.4       here_1.0.1        readxl_1.4.3      SplineOmics_0.1.0
    +#> 
    +#> loaded via a namespace (and not attached):
    +#>  [1] tidyselect_1.2.1      viridisLite_0.4.2     farver_2.1.2         
    +#>  [4] viridis_0.6.5         fastmap_1.2.0         digest_0.6.37        
    +#>  [7] lifecycle_1.0.4       cluster_2.1.6         statmod_1.5.0        
    +#> [10] magrittr_2.0.3        compiler_4.3.3        rlang_1.1.4          
    +#> [13] sass_0.4.9            progress_1.2.3        tools_4.3.3          
    +#> [16] utf8_1.2.4            yaml_2.3.10           knitr_1.48           
    +#> [19] prettyunits_1.2.0     RColorBrewer_1.1-3    withr_3.0.1          
    +#> [22] purrr_1.0.2           BiocGenerics_0.48.1   grid_4.3.3           
    +#> [25] stats4_4.3.3          fansi_1.0.6           colorspace_2.1-1     
    +#> [28] ggplot2_3.5.1         scales_1.3.0          iterators_1.0.14     
    +#> [31] cli_3.6.3             rmarkdown_2.28        crayon_1.5.3         
    +#> [34] generics_0.1.3        rstudioapi_0.16.0     rjson_0.2.23         
    +#> [37] cachem_1.1.0          splines_4.3.3         parallel_4.3.3       
    +#> [40] BiocManager_1.30.25   cellranger_1.1.0      matrixStats_1.4.1    
    +#> [43] base64enc_0.1-3       vctrs_0.6.5           jsonlite_1.8.9       
    +#> [46] IRanges_2.36.0        GetoptLong_1.0.5      hms_1.1.3            
    +#> [49] patchwork_1.3.0       S4Vectors_0.40.2      ggrepel_0.9.6        
    +#> [52] clue_0.3-65           systemfonts_1.1.0     dendextend_1.18.0    
    +#> [55] foreach_1.5.2         limma_3.58.1          jquerylib_0.1.4      
    +#> [58] tidyr_1.3.1           glue_1.8.0            codetools_0.2-19     
    +#> [61] stringi_1.8.4         shape_1.4.6.1         gtable_0.3.5         
    +#> [64] ComplexHeatmap_2.18.0 munsell_0.5.1         tibble_3.2.1         
    +#> [67] pillar_1.9.0          htmltools_0.5.8.1     circlize_0.4.16      
    +#> [70] R6_2.5.1              doParallel_1.0.17     rprojroot_2.0.4      
    +#> [73] evaluate_1.0.0        png_0.1-8             openxlsx_4.2.7.1     
    +#> [76] pheatmap_1.0.12       renv_1.0.10           bslib_0.8.0          
    +#> [79] Rcpp_1.0.13           zip_2.3.1             svglite_2.1.3        
    +#> [82] gridExtra_2.3         xfun_0.48             pkgconfig_2.0.3      
    +#> [85] GlobalOptions_0.1.2
    diff --git a/docs/Points_of_Significance_PCA.pdf b/docs/Points_of_Significance_PCA.pdf new file mode 100644 index 0000000..3a64922 Binary files /dev/null and b/docs/Points_of_Significance_PCA.pdf differ diff --git a/inst/reports/cluster_hits_report.html b/inst/reports/cluster_hits_report.html deleted file mode 100755 index e12c9fe..0000000 --- a/inst/reports/cluster_hits_report.html +++ /dev/null @@ -1,332 +0,0 @@ -clustered hits | time_effect

    clustered hits | time_effect | Omics-Datatype: PTX | Date-Time: 18_09_2024-11_31_09


    Datab ... -R/utils_report_generation.R#L257 databases_text, ... -R/utils_report_generation.R#L258 "

    ", ... -R/utils_report_generation.R#L259 sep = "\n" ... -R/utils_report_generation.R#L260 ) ... -R/utils_report_generation.R#L261 } ... -R/utils_report_generation.R#L262 ... -R/utils_report_generation.R#L263 file_name <- sprintf( ... -R/utils_report_generation.R#L269 ... -R/utils_report_generation.R#L270 output_file_path <- here::here(report_ ... -R/utils_report_generation.R#L271 ... -R/utils_report_generation.R#L272 if (report_type == "explore_data") { ... -R/utils_report_generation.R#L275 header_section = header_section, ... -R/utils_report_generation.R#L276 plots = plots, ... -R/utils_report_generation.R#L277 plots_sizes = plots_sizes, ... -R/utils_report_generation.R#L278 report_info = report_info, ... -R/utils_report_generation.R#L279 output_file_path = output_file_pat ... -R/utils_report_generation.R#L280 ) ... -R/utils_report_generation.R#L282 } else if (report_type == "screen_limm ... -R/utils_report_generation.R#L285 header_section = header_section, ... -R/utils_report_generation.R#L286 plots = plots, ... -R/utils_report_generation.R#L287 plots_sizes = plots_sizes, ... -R/utils_report_generation.R#L288 report_info = report_info, ... -R/utils_report_generation.R#L289 output_file_path = output_file_pat ... -R/utils_report_generation.R#L290 ) ... -R/utils_report_generation.R#L292 } else if (report_type == "create_limm ... -R/utils_report_generation.R#L295 header_section = header_section, ... -R/utils_report_generation.R#L296 plots = plots, ... -R/utils_report_generation.R#L297 plots_sizes = plots_sizes, ... -R/utils_report_generation.R#L298 level_headers_info = level_headers ... -R/utils_report_generation.R#L299 report_info = report_info, ... -R/utils_report_generation.R#L300 output_file_path = output_file_pat ... -R/utils_report_generation.R#L301 ) ... -R/utils_report_generation.R#L303 } else if (report_type == "create_gsea ... +R/utils_report_generation.R#L172 "meta" ... +R/utils_report_generation.R#L174 } ... +R/utils_report_generation.R#L176 if (!all(is.na(topTables))) { ... +R/utils_report_generation.R#L178 download_fields, ... +R/utils_report_generation.R#L179 if (report_type == "cluster_hits") ... +R/utils_report_generation.R#L181 } else { ... +R/utils_report_generation.R#L183 } ... +R/utils_report_generation.R#L185 } ... +R/utils_report_generation.R#L188 if (!all(is.na(enrichr_format))) { ... +R/utils_report_generation.R#L190 download_fields, ... +R/utils_report_generation.R#L191 "Enrichr_clustered_genes", ... +R/utils_report_generation.R#L192 "Enrichr_background" ... +R/utils_report_generation.R#L194 } ... +R/utils_report_generation.R#L196 max_field_length <- max(nchar(gsub("_" ... +R/utils_report_generation.R#L198 report_info_section <- paste( ... +R/utils_report_generation.R#L204 ) ... +R/utils_report_generation.R#L206 downloads_section <- paste( ... +R/utils_report_generation.R#L209 ) ... +R/utils_report_generation.R#L211 report_info[["mode"]] <- mode # Becaus ... +R/utils_report_generation.R#L213 for (field in report_info_fields) { ... +R/utils_report_generation.R#L215 field, ... +R/utils_report_generation.R#L216 data, ... +R/utils_report_generation.R#L217 meta, ... +R/utils_report_generation.R#L218 topTables, ... +R/utils_report_generation.R#L219 report_info, ... +R/utils_report_generation.R#L220 encode_df_to_base64, ... +R/utils_report_generation.R#L221 report_type, ... +R/utils_report_generation.R#L222 enrichr_format ... +R/utils_report_generation.R#L226 "%-*s", ... +R/utils_report_generation.R#L227 max_field_length, ... +R/utils_report_generation.R#L228 gsub("_", " ", field) ... +R/utils_report_generation.R#L232 report_info_section, ... +R/utils_report_generation.R#L233 sprintf( ... +R/utils_report_generation.R#L235 color:blue; padding-right: 5p ... +R/utils_report_generation.R#L236 :
    %s
    %s

    Note!

    Clustering of features that show significant changes over time (= hits).
    Clustering was done based on the min-max normalized shape of the spline.
    For this, the spline parameters in the limma topTable are used to generate 1000 curve datapoints between 0 and 1. These datapoints are used for hierarchical clustering.
    Right-click on any plot in this report to save it as a .svg (vector graphic) file!
    If one level of the experiment is not shown, it means it has < 2 hits!

    feature_name "formula": {annotation-column-x}_{annotation-column-y}_ ... :
    Gene_name



    Hotkeys

    Press:
    t --> Jump to Table of Contents and save current scroll position 📑
    s --> Save current scroll position 📌
    b --> Jump back to saved position 🔙
    d --> Download all embedded files as zip 📥
    e --> Write an email to contact info ✉

    - -

    Report Info ℹ

    - - - - - - - - - - - - -
    omics data type - :PTX
    data description - :Proteomics data
    data collection date - :February 2024
    meta condition - :Phase
    meta batch - :Reactor,
    limma design - :~ 1 + Phase*X + Reactor
    analyst name - :Thomas Rauter
    contact info - :thomas.rauter@plus.ac.at
    project name - :DGTX
    method description - :NA
    results summary - :NA
    conclusions - :NA
    -

    Downloads 📥

    - - - - - -
    data with annotation - : -
    meta - : -
    limma topTables - : -
    Enrichr clustered genes - : -
    Enrichr background - : -
    -
    -
    -

    Exponential

    - -

    - Spline-type: Natural cubic spline
    - DoF: 2
    - Knots: NA
    - Boundary-knots: NA -

    -

    adj.p-value threshold: 0.050

    Number of hits: 61


    -

    Overall Clustering

    -
    -Plot -
    -
    -
    -Plot -
    -
    -

    Min-max normalized individual and mean splines

    -
    -Plot -
    -
    -
    -Plot -
    -
    -
    -Plot -
    -
    -
    -Plot -
    -
    -
    -Plot -
    -
    -
    -Plot -
    -
    -

    Z-Score of log2 Value Heatmap

    Rows = features (labels on the right, cluster labels on the left), columns = timepoints; Blue = down, red = up, --> compared to the rest - of the row;
    -
    -Plot -
    -
    -

    Individual Significant Features (Hits) Splines

    - Asterisks definition:
    Adj. p-value < 0.05 --> *
    Adj. p-value < 0.01 --> **
    Adj. p-value < 0.001 --> ***
    -

    Cluster 1 | Hits: 21

    1-acylglycerol-3-phosphate O-acyltransferase 2
    Plot

    AHNAK nucleoprotein 2
    Plot

    CLOCK interacting pacemaker
    Plot

    CTTNBP2 N-terminal like
    Plot

    NPC1 like intracellular cholesterol transporter 1
    Plot

    WD repeat containing, antisense to TP73
    Plot

    acid sensing ion channel subunit 2
    Plot

    cell division cycle associated 3
    Plot

    cofilin 1
    Plot

    cytidine/uridine monophosphate kinase 1
    Plot

    family with sequence similarity 181 member A
    Plot

    leucine rich repeat containing 14B
    Plot

    lysine acetyltransferase 2A
    Plot

    ribonucleic acid export 1
    Plot

    schwannomin-interacting protein 1
    Plot

    serotransferrin
    Plot

    solute carrier family 35 member D3
    Plot

    sterile alpha motif domain containing 12
    Plot

    testis associated actin remodelling kinase 2
    Plot

    ubiquitin conjugating enzyme E2 U
    Plot

    zinc finger MIZ-type containing 2
    Plot

    -

    Cluster 2 | Hits: 8

    ADP ribosylation factor like GTPase 1
    Plot

    Coenzyme A synthase
    Plot

    IQ motif containing G
    Plot

    RB binding protein 9, serine hydrolase
    Plot

    aquaporin 3 (Gill blood group)
    Plot

    heat shock protein HSP 90-alpha-like
    Plot

    snRNA-activating protein complex subunit 5-like
    Plot

    ubiquinol-cytochrome-c reductase complex assembly factor 3
    Plot

    -

    Cluster 3 | Hits: 8

    BPI fold containing family B member 3
    Plot

    N-terminal EF-hand calcium binding protein 2
    Plot

    NADH dehydrogenase [ubiquinone] 1 alpha subcomplex assembly factor 4-like
    Plot

    THAP domain containing 6
    Plot

    TNF receptor superfamily member 21
    Plot

    armadillo repeat containing 3
    Plot

    karyopherin subunit alpha 7
    Plot

    ribosomal protein S24
    Plot

    -

    Cluster 4 | Hits: 16

    ATP synthase membrane subunit f
    Plot

    ATPase plasma membrane Ca2+ transporting 3
    Plot

    CCHC-type zinc finger nucleic acid binding protein
    Plot

    ER membrane protein complex subunit 3
    Plot

    adhesion G protein-coupled receptor F5
    Plot

    chloride channel CLIC like 1
    Plot

    coiled-coil domain containing 60
    Plot

    crystallin beta A4
    Plot

    geranylgeranyl diphosphate synthase 1
    Plot

    membrane bound O-acyltransferase domain containing 4
    Plot

    pleckstrin homology and coiled-coil domain containing D1
    Plot

    small integral membrane protein 41
    Plot

    solute carrier family 26 member 9
    Plot

    striatin
    Plot

    tRNA aspartic acid methyltransferase 1
    Plot

    ubiquitin specific peptidase 19
    Plot

    -

    Cluster 5 | Hits: 4

    ATPase H+ transporting V1 subunit C2
    Plot

    core 1 synthase, glycoprotein-N-acetylgalactosamine 3-beta-galactosyltransferase 1
    Plot

    phosphatidylinositol-4-phosphate 3-kinase catalytic subunit type 2 alpha
    Plot

    zinc finger and BTB domain containing 38
    Plot

    -

    Cluster 6 | Hits: 4

    RNA binding protein, mRNA processing factor 2
    Plot

    betaine--homocysteine S-methyltransferase
    Plot

    mitochondrial nucleoid associated protein 1
    Plot

    triggering receptor expressed on myeloid cells 1
    Plot

    -

    Stationary

    - -

    - Spline-type: Natural cubic spline
    - DoF: 2
    - Knots: NA
    - Boundary-knots: NA -

    -

    adj.p-value threshold: 0.050

    Number of hits: 5


    -

    Overall Clustering

    -
    -Plot -
    -
    -
    -Plot -
    -
    -

    Min-max normalized individual and mean splines

    -
    -Plot -
    -
    -
    -Plot -
    -
    -
    -Plot -
    -
    -

    Z-Score of log2 Value Heatmap

    Rows = features (labels on the right, cluster labels on the left), columns = timepoints; Blue = down, red = up, --> compared to the rest - of the row;
    -
    -Plot -
    -
    -

    Individual Significant Features (Hits) Splines

    - Asterisks definition:
    Adj. p-value < 0.05 --> *
    Adj. p-value < 0.01 --> **
    Adj. p-value < 0.001 --> ***
    -

    Cluster 1 | Hits: 3

    S100 calcium binding protein G
    Plot

    ribosomal protein S24
    Plot

    trinucleotide repeat containing 18
    Plot

    -

    Cluster 2 | Hits: 1

    hemojuvelin BMP co-receptor
    Plot

    -

    Cluster 3 | Hits: 1

    SEC61 translocon subunit alpha 2
    Plot

    - diff --git a/man/InputControl.Rd b/man/InputControl.Rd index c41fd7a..03818cf 100755 --- a/man/InputControl.Rd +++ b/man/InputControl.Rd @@ -23,7 +23,7 @@ If any of these checks fail, an informative error message is returned. The function performs the following checks: -- If `clusters` is an integer or a vector of integers. Otherwise, it +- If `clusters` is an integer or a vector of integers. Otherwise, it gives an error. Check Plot Info @@ -35,13 +35,13 @@ The method performs the following checks: * Ensures that `plot_info` is provided and not NULL. * Confirms that `y_axis_label` is a character vector with maximally 30 characters. -* Confirms that `time_unit` is a character vector with maximally 15 +* Confirms that `time_unit` is a character vector with maximally 15 characters. * Validates that `treatment_labels` is either `NA` or a character vector - with each + with each element being maximally 15 characters long. -* Validates that `treatment_timepoints` is either `NA` or a numeric -vector with the +* Validates that `treatment_timepoints` is either `NA` or a numeric +vector with the same length as `treatment_labels` if `treatment_labels` is not `NA`. If any of these checks fail, an informative error message is returned. @@ -67,11 +67,11 @@ an error. } \section{Functions}{ \itemize{ -\item \code{InputControl}: This method verifies the spline test configurations and associated +\item \code{InputControl}: This method verifies the spline test configurations and associated metadata -within the object's arguments. It performs a series of checks on the -configurations, including column verification, spline type validation, -and ensuring that the degrees of freedom (dof) are within acceptable +within the object's arguments. It performs a series of checks on the +configurations, including column verification, spline type validation, +and ensuring that the degrees of freedom (dof) are within acceptable ranges. }} @@ -82,7 +82,7 @@ Check Top Tables \code{\link[stats]{model.matrix}} -Validate and check all modes +Validate the `dream_params` argument } \section{Super classes}{ \code{\link[SplineOmics:Level4Functions]{SplineOmics::Level4Functions}} -> \code{\link[SplineOmics:Level3Functions]{SplineOmics::Level3Functions}} -> \code{\link[SplineOmics:Level2Functions]{SplineOmics::Level2Functions}} -> \code{InputControl} @@ -107,6 +107,7 @@ Initialize an InputControl object} \item \href{#method-InputControl-check_datas_descr}{\code{InputControl$check_datas_descr()}} \item \href{#method-InputControl-check_top_tables}{\code{InputControl$check_top_tables()}} \item \href{#method-InputControl-check_design_formula}{\code{InputControl$check_design_formula()}} +\item \href{#method-InputControl-check_dream_params}{\code{InputControl$check_dream_params()}} \item \href{#method-InputControl-check_modes}{\code{InputControl$check_modes()}} \item \href{#method-InputControl-check_mode}{\code{InputControl$check_mode()}} \item \href{#method-InputControl-check_designs_and_metas}{\code{InputControl$check_designs_and_metas()}} @@ -167,9 +168,9 @@ A new instance of the InputControl class. Automatically Validate All Arguments -This method automatically validates all arguments by sequentially +This method automatically validates all arguments by sequentially calling -various validation methods defined within the class. Each validation +various validation methods defined within the class. Each validation method checks specific aspects of the input arguments and raises an error if the validation fails. @@ -203,7 +204,7 @@ The following validation methods are called in sequence: } \subsection{Returns}{ -NULL. The function is used for its side effects of validating +NULL. The function is used for its side effects of validating input arguments and raising errors if any validation fails. @@ -214,13 +215,13 @@ Check Data and Meta \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_data_and_meta}{}}} \subsection{Method \code{check_data_and_meta()}}{ -This function checks the validity of the data and meta objects, +This function checks the validity of the data and meta objects, ensuring that -data is a matrix with numeric values and that meta is a dataframe +data is a matrix with numeric values and that meta is a dataframe containing -the specified condition column. Additionally, it verifies that the +the specified condition column. Additionally, it verifies that the number of -columns in the data matrix matches the number of rows in the meta +columns in the data matrix matches the number of rows in the meta dataframe. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_data_and_meta()}\if{html}{\out{
    }} @@ -231,7 +232,7 @@ dataframe. \describe{ \item{\code{data}}{A matrix containing numeric values.} -\item{\code{meta}}{A dataframe containing the metadata, including the 'Time' +\item{\code{meta}}{A dataframe containing the metadata, including the 'Time' column and the specified condition column.} @@ -257,16 +258,16 @@ Check Annotation Consistency \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_annotation}{}}} \subsection{Method \code{check_annotation()}}{ -This method checks the consistency of the annotation with the data. +This method checks the consistency of the annotation with the data. It ensures -that the annotation is a dataframe and that it has the same number +that the annotation is a dataframe and that it has the same number of rows as the data. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_annotation()}\if{html}{\out{
    }} } \subsection{Returns}{ -NULL if any required arguments are missing. Otherwise, performs +NULL if any required arguments are missing. Otherwise, performs checks and potentially raises errors if checks fail. Check Multiple Data and Meta Pairs @@ -276,7 +277,7 @@ Check Multiple Data and Meta Pairs \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_datas_and_metas}{}}} \subsection{Method \code{check_datas_and_metas()}}{ -Iterates over multiple data and meta pairs to validate each pair using +Iterates over multiple data and meta pairs to validate each pair using the `check_data_and_meta` function. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_datas_and_metas()}\if{html}{\out{
    }} @@ -289,15 +290,15 @@ the `check_data_and_meta` function. \item{\code{metas}}{A list of data frames containing metadata.} -\item{\code{condition}}{A character string specifying the column name in the +\item{\code{condition}}{A character string specifying the column name in the meta dataframe to be checked.} -\item{\code{meta_batch_column}}{An optional parameter specifying the column name +\item{\code{meta_batch_column}}{An optional parameter specifying the column name in the meta dataframe used to remove the batch effect. Default is NA.} \item{\code{meta_batch2_column}}{An optional parameter specifying the column - name -in the meta dataframe used to remove the second batch effect. Default + name +in the meta dataframe used to remove the second batch effect. Default is NA.} } \if{html}{\out{}} @@ -312,8 +313,8 @@ Check Data Descriptions \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_datas_descr}{}}} \subsection{Method \code{check_datas_descr()}}{ -Validates that the data descriptions are character vectors with each -element +Validates that the data descriptions are character vectors with each +element not exceeding 80 characters in length. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_datas_descr()}\if{html}{\out{
    }} @@ -358,7 +359,7 @@ Check Design Formula \if{latex}{\out{\hypertarget{method-InputControl-check_design_formula}{}}} \subsection{Method \code{check_design_formula()}}{ Validates the design formula ensuring it is a valid character string, -contains allowed characters, includes the intercept term 'X', and +contains allowed characters, includes the intercept term 'X', and references columns present in the metadata. \subsection{Usage}{ @@ -377,16 +378,42 @@ columns present in the metadata. \if{html}{\out{}} } \subsection{Returns}{ -TRUE if the design formula is valid, otherwise an error is +TRUE if the design formula is valid, otherwise an error is thrown. } } \if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-InputControl-check_dream_params}{}}} +\subsection{Method \code{check_dream_params()}}{ +This function checks the validity of the `dream_params` argument provided +in the class. If `dream_params` is present, it ensures that it contains +the required and optional elements in the correct format. +Specifically, `dream_params` must contain a named element +`random_effects`, +which is required and must be a string. It may also optionally contain +the +elements `dof`, which must be an integer greater than 1, and +`KenwardRoger`, +which must be a boolean. Unnamed elements or elements other than these +three are not allowed. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{InputControl$check_dream_params()}\if{html}{\out{
    }} +} + +\subsection{Returns}{ +Returns `TRUE` if `dream_params` passes all checks. Otherwise, stops the +function and returns an error message using `stop_call_false`. + +Validate and check all modes +} +} +\if{html}{\out{
    }} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_modes}{}}} \subsection{Method \code{check_modes()}}{ -This function iterates over the `modes` argument, sets each `mode` in -`self$args`, and calls `check_mode()` to validate each mode. After each +This function iterates over the `modes` argument, sets each `mode` in +`self$args`, and calls `check_mode()` to validate each mode. After each validation, the `mode` is removed from `self$args`. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_modes()}\if{html}{\out{
    }} @@ -402,8 +429,8 @@ Check the mode argument for validity \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_mode}{}}} \subsection{Method \code{check_mode()}}{ -This function checks if the `mode` argument is provided and validates -that it is either "isolated" or "integrated". If `mode` is missing or +This function checks if the `mode` argument is provided and validates +that it is either "isolated" or "integrated". If `mode` is missing or invalid, an error is thrown. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_mode()}\if{html}{\out{
    }} @@ -428,7 +455,7 @@ to validate each pair using the `check_design_formula` function. \subsection{Arguments}{ \if{html}{\out{
    }} \describe{ -\item{\code{designs}}{A vector of character strings representing design +\item{\code{designs}}{A vector of character strings representing design formulas.} \item{\code{metas}}{A list of data frames containing metadata.} @@ -497,10 +524,10 @@ Returns `NULL` if any required arguments are mising, otherwise, Check Limma Top Tables Structure -This function checks if the provided limma top tables data structure -is correctly formatted. It ensures that the data structure contains -exactly three named elements ('time_effect', 'avrg_diff_conditions', -and 'interaction_condition_time') and that each element contains +This function checks if the provided limma top tables data structure +is correctly formatted. It ensures that the data structure contains +exactly three named elements ('time_effect', 'avrg_diff_conditions', +and 'interaction_condition_time') and that each element contains dataframes with the correct columns and data types. } } @@ -520,7 +547,7 @@ dataframes with the correct columns and data types. \if{html}{\out{
    }} } \subsection{Returns}{ -This function does not return a value. It stops execution +This function does not return a value. It stops execution if the data structure does not match the expected format. Check Adjusted p-Thresholds @@ -532,7 +559,7 @@ Check Adjusted p-Thresholds \subsection{Method \code{check_adj_pthresholds()}}{ This function checks the validity of the adjusted p-thresholds vector, ensuring that -all elements are numeric, greater than 0, and less than 1. If any of +all elements are numeric, greater than 0, and less than 1. If any of these conditions are not met, the function stops execution and returns an error message @@ -560,15 +587,15 @@ Check adjusted p-value thresholds for limma category 2 and 3 \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_adj_pthresh_limma_category_2_3}{}}} \subsection{Method \code{check_adj_pthresh_limma_category_2_3()}}{ -This function checks that both adjusted p-value thresholds for -average difference conditions and interaction condition time are +This function checks that both adjusted p-value thresholds for +average difference conditions and interaction condition time are non-null, floats, and in the range [0, 1]. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_adj_pthresh_limma_category_2_3()}\if{html}{\out{
    }} } \subsection{Returns}{ -`NULL` if either argument is `NULL` or invalid. +`NULL` if either argument is `NULL` or invalid. Otherwise, no return value (assumed valid inputs). Check Clusters @@ -578,11 +605,11 @@ Check Clusters \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_clusters}{}}} \subsection{Method \code{check_clusters()}}{ -This function verifies the cluster configurations within the object's +This function verifies the cluster configurations within the object's arguments. -It checks if the clusters argument is present and performs validation -on its -content. If no clusters are specified, it defaults to automatic cluster +It checks if the clusters argument is present and performs validation +on its +content. If no clusters are specified, it defaults to automatic cluster estimation. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_clusters()}\if{html}{\out{
    }} @@ -593,20 +620,20 @@ estimation. \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_plot_info}{}}} \subsection{Method \code{check_plot_info()}}{ -This method checks the validity of the `plot_info` list. It ensures that -`y_axis_label` and `time_unit` meet the length constraints, -`treatment_labels` -is either `NA` or a character vector with elements meeting the length -constraint, -and `treatment_timepoints` is either `NA` or a numeric vector with the -same length +This method checks the validity of the `plot_info` list. It ensures that +`y_axis_label` and `time_unit` meet the length constraints, +`treatment_labels` +is either `NA` or a character vector with elements meeting the length +constraint, +and `treatment_timepoints` is either `NA` or a numeric vector with the +same length as `treatment_labels`. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_plot_info()}\if{html}{\out{
    }} } \subsection{Returns}{ -NULL if `plot_info` is not provided or invalid. Otherwise, +NULL if `plot_info` is not provided or invalid. Otherwise, performs checks and potentially raises errors if checks fail. @@ -617,10 +644,10 @@ Check plot options \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_plot_options}{}}} \subsection{Method \code{check_plot_options()}}{ -This method checks if the `plot_options` list contains the required -elements -`meta_replicate_column` and `cluster_heatmap_columns`. It validates that -`cluster_heatmap_columns` is either TRUE or FALSE, and that +This method checks if the `plot_options` list contains the required +elements +`meta_replicate_column` and `cluster_heatmap_columns`. It validates that +`cluster_heatmap_columns` is either TRUE or FALSE, and that `meta_replicate_column` is a valid column name in the `meta` dataframe. If the checks fail, the script stops with an error message. @@ -639,7 +666,7 @@ valid directory. If the directory does not exist, it attempts to create it. If there are any warnings or -errors during directory creation, the function stops execution and +errors during directory creation, the function stops execution and returns an error message. \subsection{Usage}{ @@ -667,19 +694,19 @@ Check Genes Validity \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_genes}{}}} \subsection{Method \code{check_genes()}}{ -This function checks the validity of the `data` and `genes` arguments -within the `self$args` list. It ensures that `genes` is a character -vector, -that neither `data` nor `genes` is `NULL`, and that the length of `genes` +This function checks the validity of the `data` and `genes` arguments +within the `self$args` list. It ensures that `genes` is a character +vector, +that neither `data` nor `genes` is `NULL`, and that the length of `genes` matches the number of rows in `data`. \subsection{Usage}{ \if{html}{\out{
    }}\preformatted{InputControl$check_genes()}\if{html}{\out{
    }} } \subsection{Returns}{ -Returns `TRUE` if all checks pass. Returns `NULL` if any required -arguments are `NULL`. Throws an error if `genes` is not a character -vector +Returns `TRUE` if all checks pass. Returns `NULL` if any required +arguments are `NULL`. Throws an error if `genes` is not a character +vector or if the length of `genes` does not match the number of rows in `data`. Check p-Adjustment Method @@ -689,10 +716,10 @@ Check p-Adjustment Method \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_padjust_method}{}}} \subsection{Method \code{check_padjust_method()}}{ -This function checks if the provided p-adjustment method is valid. The +This function checks if the provided p-adjustment method is valid. The valid methods are: -"holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", and +"holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", and "none". If the method is not one of these, the function stops execution and returns an error @@ -704,7 +731,7 @@ is not one of these, the function stops execution and returns an error \subsection{Arguments}{ \if{html}{\out{
    }} \describe{ -\item{\code{padjust_method}}{A character string specifying the p-adjustment +\item{\code{padjust_method}}{A character string specifying the p-adjustment method. Valid options are "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", and @@ -724,7 +751,7 @@ Check Report Information \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-InputControl-check_report_info}{}}} \subsection{Method \code{check_report_info()}}{ -Validates the report information to ensure it contains all mandatory +Validates the report information to ensure it contains all mandatory fields and adheres to the required formats. \subsection{Usage}{ diff --git a/man/NumericBlockFinder.Rd b/man/NumericBlockFinder.Rd index 6e93606..1810bb5 100755 --- a/man/NumericBlockFinder.Rd +++ b/man/NumericBlockFinder.Rd @@ -4,7 +4,7 @@ \alias{NumericBlockFinder} \title{NumericBlockFinder: A class for finding numeric blocks in data} \description{ -This class provides methods to identify the upper-left and lower-right +This class provides methods to identify the upper-left and lower-right cells of a numeric block within a dataframe. } \section{Public fields}{ @@ -48,7 +48,7 @@ A new instance of the NumericBlockFinder class. Find the upper-left cell of the first 6x6 block of numeric values -This method identifies the upper-left cell of the first 6x6 block of +This method identifies the upper-left cell of the first 6x6 block of numeric values in the dataframe. } } @@ -61,9 +61,9 @@ numeric values in the dataframe. } \subsection{Returns}{ -A list containing the row and column indices of the upper-left +A list containing the row and column indices of the upper-left cell. - + Find the lower-right cell of a block of contiguous non-NA values This method identifies the lower-right cell of a block of contiguous diff --git a/man/SplineOmics-package.Rd b/man/SplineOmics-package.Rd index 1285479..f4da33b 100755 --- a/man/SplineOmics-package.Rd +++ b/man/SplineOmics-package.Rd @@ -6,12 +6,12 @@ \alias{SplineOmics-package} \title{Package Name: SplineOmics} \description{ -The R package SplineOmics finds the significant features (hits) of +The R package SplineOmics finds the significant features (hits) of time-series -omics data by using splines and limma for hypothesis testing. -It then clusters the hits based on the spline shape while showing all +It then clusters the hits based on the spline shape while showing all results in summary HTML reports. -For detailed documentation, vignettes, and examples, please visit the +For detailed documentation, vignettes, and examples, please visit the [SplineOmics GitHub page](https://github.com/csbg/SplineOmics.git). } \section{Key Functions and Classes}{ @@ -23,25 +23,25 @@ For detailed documentation, vignettes, and examples, please visit the an HTML report containg various plots, such as density plots and correlation heatmaps. - screen_limma_hyperparams: Allows the specify lists of different hyperparameters - to test, such as a degree of freedom of 2, 3, 4, - and adj.p-val thresholds, such as 0.1 and 0.05, + to test, such as a degree of freedom of 2, 3, 4, + and adj.p-val thresholds, such as 0.1 and 0.05, and tests all specified different values for all limma spline hyperparameters in a semi-combinatorial way. -- update_splineomics: Allows to change values of the SplineOmics object, for +- update_splineomics: Allows to change values of the SplineOmics object, for example after observing that outliers should be removed from the data (update the data parameter). -- run_limma_splines: Central function of the script, is called by the +- run_limma_splines: Central function of the script, is called by the screen_limma_hyperparams function and can be called to - get the limma spline analysis results (p-values for all + get the limma spline analysis results (p-values for all features (e.g. proteins)) with the hyperparameters, that were selected finally. -- create_limma_report: Creates an HTML report showing the run_limma_splines +- create_limma_report: Creates an HTML report showing the run_limma_splines results - cluster_hits: Clusters the splines of the hits (significant features) based on their shape and shows all results as plots in an HTML report. -- download_enrichr_databases: Allows to download the Enrichr databases for +- download_enrichr_databases: Allows to download the Enrichr databases for runnin clusterProfiler in the run_gsea function with them. - run_gsea: Runs clusterProfiler with the clustered hits by using the Enrichr @@ -85,15 +85,15 @@ These dependencies are only necessary for some functions: \section{Authors}{ -- [Thomas-Rauter](https://github.com/Thomas-Rauter) - Wrote the package and - developed the approach with VSchaepertoens under guidance from nfortelny +- [Thomas-Rauter](https://github.com/Thomas-Rauter) - Wrote the package and + developed the approach with VSchaepertoens under guidance from nfortelny and skafdasschaf. -- [nfortelny](https://github.com/nfortelny) - Principal Investigator, +- [nfortelny](https://github.com/nfortelny) - Principal Investigator, provided guidance and support. -- [skafdasschaf](https://github.com/skafdasschaf) - Helped review code and +- [skafdasschaf](https://github.com/skafdasschaf) - Helped review code and provided improvement suggestions. -- [VSchaepertoens](https://github.com/VSchaepertoens) - Developed an internal - plotting function and contributed to exploratory data analysis and the +- [VSchaepertoens](https://github.com/VSchaepertoens) - Developed an internal + plotting function and contributed to exploratory data analysis and the overall approach. } @@ -122,11 +122,12 @@ None Useful links: \itemize{ \item \url{https://csbg.github.io/SplineOmics} + \item Report bugs at \url{https://github.com/csbg/SplineOmics/issues} } } \author{ -\strong{Maintainer}: Thomas Rauter \email{thomas.rauter@plus.ac.at} +\strong{Maintainer}: Thomas Rauter \email{thomas.rauter@plus.ac.at} (\href{https://orcid.org/0009-0004-5578-3628}{ORCID}) } \keyword{GSEA,} diff --git a/man/add_dashed_lines.Rd b/man/add_dashed_lines.Rd index 3282150..6aa06c6 100755 --- a/man/add_dashed_lines.Rd +++ b/man/add_dashed_lines.Rd @@ -7,24 +7,24 @@ add_dashed_lines(p, treatment_timepoints, treatment_labels, y_pos) } \arguments{ -\item{p}{A ggplot object. The plot to which dashed lines and labels +\item{p}{A ggplot object. The plot to which dashed lines and labels will be added.} -\item{treatment_timepoints}{A numeric vector of timepoints where +\item{treatment_timepoints}{A numeric vector of timepoints where dashed lines should be drawn.} -\item{treatment_labels}{A character vector of labels corresponding -to each treatment timepoint. These labels are used for coloring +\item{treatment_labels}{A character vector of labels corresponding +to each treatment timepoint. These labels are used for coloring the lines, but the x-axis coordinates are displayed as the labels.} -\item{y_pos}{A numeric value specifying the y-axis position where +\item{y_pos}{A numeric value specifying the y-axis position where the text labels should be placed.} } \value{ A ggplot object with added dashed lines and labels. } \description{ -This internal function adds dashed vertical lines at specified -treatment timepoints to a plot, along with text labels that +This internal function adds dashed vertical lines at specified +treatment timepoints to a plot, along with text labels that display the corresponding x-axis values. } diff --git a/man/add_feature_names.Rd b/man/add_feature_names.Rd index 1f342c4..0c2379d 100755 --- a/man/add_feature_names.Rd +++ b/man/add_feature_names.Rd @@ -11,26 +11,26 @@ add_feature_names(data, clean_data, feature_name_columns) \item{clean_data}{A dataframe to which the feature names will be added.} -\item{feature_name_columns}{A string specifying the name of the feature -columns in `data`. If `NA`, sequential numbers +\item{feature_name_columns}{A string specifying the name of the feature +columns in `data`. If `NA`, sequential numbers will be used as feature names.} } \value{ The `clean_data` dataframe with updated row names. } \description{ -This function assigns feature names to the rows of a dataframe based on a -specified column from another dataframe. If no column is specified, it +This function assigns feature names to the rows of a dataframe based on a +specified column from another dataframe. If no column is specified, it assigns sequential numbers as feature names. } \details{ The function performs the following operations: - Extracts feature names from the specified column in `data`, ignoring `NA` values. -- Ensures the feature names are unique and match the number of rows in +- Ensures the feature names are unique and match the number of rows in `clean_data`. - Assigns the feature names to the rows of `clean_data`. -- If `feature_name_column` is `NA`, assigns sequential numbers -(1, 2, 3, etc.) +- If `feature_name_column` is `NA`, assigns sequential numbers +(1, 2, 3, etc.) as feature names and issues a message. } diff --git a/man/add_plot_to_html.Rd b/man/add_plot_to_html.Rd index 1e0718e..bcd04db 100755 --- a/man/add_plot_to_html.Rd +++ b/man/add_plot_to_html.Rd @@ -19,6 +19,6 @@ add_plot_to_html(html_content, plot_element, plots_size, section_index) The updated HTML content as a character string. } \description{ -This function converts a plot to a base64 image and adds it to the +This function converts a plot to a base64 image and adds it to the HTML content. } diff --git a/man/ask_user.Rd b/man/ask_user.Rd index 2045bfe..ea715a0 100755 --- a/man/ask_user.Rd +++ b/man/ask_user.Rd @@ -13,7 +13,7 @@ ask_user(question) None. } \description{ -This function prompts the user with a yes/no question. If the user answers -"yes" (case insensitive), the code proceeds. If the user answers "no" or +This function prompts the user with a yes/no question. If the user answers +"yes" (case insensitive), the code proceeds. If the user answers "no" or anything else, the code stops. } diff --git a/man/between_level.Rd b/man/between_level.Rd index 4088ddf..b51ea9f 100755 --- a/man/between_level.Rd +++ b/man/between_level.Rd @@ -9,6 +9,7 @@ between_level( rna_seq_data, meta, design, + dream_params, spline_params, condition, compared_levels, @@ -19,13 +20,21 @@ between_level( \arguments{ \item{data}{A matrix of data values.} -\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, +\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, such as the output from `limma::voom` or a similar preprocessing pipeline.} \item{meta}{A dataframe containing metadata, including a 'Time' column.} \item{design}{A design formula or matrix for the LIMMA analysis.} +\item{dream_params}{A named list or NULL. When not NULL, it must at least +contain the named element 'random_effects', which must contain a string that +is a formula for the random effects of the mixed models by dream. +Additionally, it can contain the named elements dof, which must be a int +bigger than 1, which is the degree of freedom for the dream topTable, and +the named element KenwardRoger, which must be a bool, specifying whether +to use that method or not.} + \item{spline_params}{A list of spline parameters for the analysis.} \item{condition}{A character string specifying the condition.} @@ -37,15 +46,15 @@ such as the output from `limma::voom` or a similar preprocessing pipeline.} \item{feature_names}{A non-empty character vector of feature names.} } \value{ -A list containing top tables for the factor only and factor-time +A list containing top tables for the factor only and factor-time contrast. } \description{ -Performs a between-level analysis using LIMMA to compare specified levels +Performs a between-level analysis using LIMMA to compare specified levels within a condition. } \seealso{ -\code{\link[splines]{bs}}, \code{\link[splines]{ns}}, -\code{\link[limma]{lmFit}}, \code{\link[limma]{eBayes}}, +\code{\link[splines]{bs}}, \code{\link[splines]{ns}}, +\code{\link[limma]{lmFit}}, \code{\link[limma]{eBayes}}, \code{\link[limma]{topTable}}, \code{\link{modify_limma_top_table}} } diff --git a/man/bind_data_with_annotation.Rd b/man/bind_data_with_annotation.Rd index 32a1b49..fb01b95 100755 --- a/man/bind_data_with_annotation.Rd +++ b/man/bind_data_with_annotation.Rd @@ -17,7 +17,7 @@ A dataframe with `data` and `annotation` combined, and the row names as the first column named `feature_names`. } \description{ -This function converts a matrix to a dataframe, adds row names as the first +This function converts a matrix to a dataframe, adds row names as the first column, and binds it with annotation data. } diff --git a/man/build_create_limma_report.Rd b/man/build_create_limma_report.Rd index 5d25627..26bb320 100755 --- a/man/build_create_limma_report.Rd +++ b/man/build_create_limma_report.Rd @@ -25,14 +25,14 @@ build_create_limma_report( \item{report_info}{A named list containg the report info fields. Here used for the email hotkey functionality.} -\item{output_file_path}{A character string specifying the path to save the +\item{output_file_path}{A character string specifying the path to save the HTML report.} } \value{ No return value, called for side effects. } \description{ -Generates an HTML report for clustered hits, including plots and +Generates an HTML report for clustered hits, including plots and spline parameter details, with a table of contents. } \seealso{ diff --git a/man/build_explore_data_report.Rd b/man/build_explore_data_report.Rd index 75aa68d..c70c111 100755 --- a/man/build_explore_data_report.Rd +++ b/man/build_explore_data_report.Rd @@ -13,26 +13,26 @@ build_explore_data_report( ) } \arguments{ -\item{header_section}{A string containing the HTML content for the header +\item{header_section}{A string containing the HTML content for the header section of the report.} -\item{plots}{A list of ggplot objects representing the plots to be included +\item{plots}{A list of ggplot objects representing the plots to be included in the report.} -\item{plots_sizes}{A list of sizes corresponding to each plot, defining the +\item{plots_sizes}{A list of sizes corresponding to each plot, defining the dimensions to be used when rendering the plots.} \item{report_info}{A named list containg the report info fields. Here used for the email hotkey functionality.} -\item{output_file_path}{A string specifying the file path where the HTML +\item{output_file_path}{A string specifying the file path where the HTML report will be saved.} } \value{ None. This function writes the HTML content to the specified file. } \description{ -This function generates an HTML report containing a header section, table of -contents, and a series of plots. Each plot is included in the report with +This function generates an HTML report containing a header section, table of +contents, and a series of plots. Each plot is included in the report with specified sizes. } diff --git a/man/build_hyperparams_screen_report.Rd b/man/build_hyperparams_screen_report.Rd index 7385089..a3ce31b 100755 --- a/man/build_hyperparams_screen_report.Rd +++ b/man/build_hyperparams_screen_report.Rd @@ -17,20 +17,20 @@ build_hyperparams_screen_report( \item{plots}{A list of ggplot2 plot objects.} -\item{plots_sizes}{A list of integers specifying the number of rows for each +\item{plots_sizes}{A list of integers specifying the number of rows for each plot.} \item{report_info}{A named list containg the report info fields. Here used for the email hotkey functionality.} -\item{output_file_path}{A character string specifying the path to save the +\item{output_file_path}{A character string specifying the path to save the HTML report.} } \value{ No return value, called for side effects. } \description{ -Constructs an HTML report for hyperparameter screening by embedding plots +Constructs an HTML report for hyperparameter screening by embedding plots and their respective sizes into the provided header section. } \seealso{ diff --git a/man/calc_cv.Rd b/man/calc_cv.Rd new file mode 100644 index 0000000..118d34f --- /dev/null +++ b/man/calc_cv.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cluster_hits.R +\name{calc_cv} +\alias{calc_cv} +\title{Calculate average CV across unique time points} +\usage{ +calc_cv(time_values, response_values) +} +\arguments{ +\item{time_values}{A numeric vector containing the time points. Time points +may repeat across replicates.} + +\item{response_values}{A numeric vector of response values corresponding to +the time points.} +} +\value{ +The average coefficient of variation (CV) across all time points. +Returns NA if all CVs are NA. +} +\description{ +This function calculates the coefficient of variation (CV) for each unique +time point based on the provided time values and response values. It then +returns the average CV across all time points. The CV is only calculated if +there are more than one valid (non-NA) values for a given time point and +the mean of the values is non-zero. +} diff --git a/man/check_between_level_pattern.Rd b/man/check_between_level_pattern.Rd index 5b54d5f..df8978f 100755 --- a/man/check_between_level_pattern.Rd +++ b/man/check_between_level_pattern.Rd @@ -7,28 +7,28 @@ check_between_level_pattern(top_tables) } \arguments{ -\item{top_tables}{A list where each element is itself a list containing +\item{top_tables}{A list where each element is itself a list containing named elements.} } \value{ A list with two elements: \describe{ - \item{between_levels}{A logical value indicating whether any element names + \item{between_levels}{A logical value indicating whether any element names match the between-level pattern.} - \item{index_with_pattern}{The index of the first element in `top_tables` - where all names match the between-level pattern, or NA if no match is + \item{index_with_pattern}{The index of the first element in `top_tables` + where all names match the between-level pattern, or NA if no match is found.} } } \description{ -This function checks if any of the elements within a list of top tables +This function checks if any of the elements within a list of top tables contain element names that match the specified between-level pattern. } \details{ -The function iterates over each element in `top_tables`. For each element -that -is a list, it checks if all names within that inner list match the pattern -`".+_vs_.+"`. If a match is found, the function sets `between_levels` to TRUE -and records the index of the matching element. The search stops at the first +The function iterates over each element in `top_tables`. For each element +that +is a list, it checks if all names within that inner list match the pattern +`".+_vs_.+"`. If a match is found, the function sets `between_levels` to TRUE +and records the index of the matching element. The search stops at the first match. } diff --git a/man/clean_gene_symbols.Rd b/man/clean_gene_symbols.Rd index 432545b..38cc309 100755 --- a/man/clean_gene_symbols.Rd +++ b/man/clean_gene_symbols.Rd @@ -10,13 +10,13 @@ clean_gene_symbols(genes) \item{genes}{A character vector containing gene names to be cleaned.} } \value{ -A character vector of cleaned gene symbols (names) with the same -length as the input. The cleaned names will be in uppercase, and any +A character vector of cleaned gene symbols (names) with the same +length as the input. The cleaned names will be in uppercase, and any invalid or empty gene names will be replaced with NA. } \description{ -This function preprocesses a vector of gene names by cleaning and -formatting them. It removes any non-alphanumeric characters after the -first block of alphanumeric characters and converts the remaining +This function preprocesses a vector of gene names by cleaning and +formatting them. It removes any non-alphanumeric characters after the +first block of alphanumeric characters and converts the remaining characters to uppercase. } diff --git a/man/cluster_hits.Rd b/man/cluster_hits.Rd index a13aa4a..b3f08c9 100755 --- a/man/cluster_hits.Rd +++ b/man/cluster_hits.Rd @@ -24,54 +24,54 @@ cluster_hits( ) } \arguments{ -\item{splineomics}{An S3 object of class `SplineOmics` that contains all the +\item{splineomics}{An S3 object of class `SplineOmics` that contains all the necessary data and parameters for the analysis, including: \itemize{ - \item \code{data}: The original expression dataset used for differential + \item \code{data}: The original expression dataset used for differential expression analysis. - \item \code{meta}: A dataframe containing metadata corresponding to the - \code{data}, must include a 'Time' column and any columns specified by + \item \code{meta}: A dataframe containing metadata corresponding to the + \code{data}, must include a 'Time' column and any columns specified by \code{conditions}. - \item \code{design}: A character of length 1 representing the limma + \item \code{design}: A character of length 1 representing the limma design formula. - \item \code{condition}: Character of length 1 specifying the column name + \item \code{condition}: Character of length 1 specifying the column name in \code{meta} used to define groups for analysis. \item \code{spline_params}: A list of spline parameters for the analysis. - \item \code{meta_batch_column}: A character string specifying the column + \item \code{meta_batch_column}: A character string specifying the column name in the metadata used for batch effect removal. - \item \code{meta_batch2_column}: A character string specifying the second + \item \code{meta_batch2_column}: A character string specifying the second column name in the metadata used for batch effect removal. \item \code{limma_splines_result}: A list of data frames, each representing - a top table from differential expression analysis, containing at least + a top table from differential expression analysis, containing at least 'adj.P.Val' and expression data columns. }} \item{clusters}{Character or integer vector specifying the number of clusters} -\item{adj_pthresholds}{Numeric vector of p-value thresholds for filtering +\item{adj_pthresholds}{Numeric vector of p-value thresholds for filtering hits in each top table.} \item{adj_pthresh_avrg_diff_conditions}{p-value threshold for the results from the average difference of the condition limma result. Per default 0 ( turned off).} -\item{adj_pthresh_interaction_condition_time}{p-value threshold for the -results from the interaction of condition and time limma result. Per default +\item{adj_pthresh_interaction_condition_time}{p-value threshold for the +results from the interaction of condition and time limma result. Per default 0 (turned off).} \item{genes}{A character vector containing the gene names of the features to be analyzed.} -\item{plot_info}{List containing the elements y_axis_label (string), +\item{plot_info}{List containing the elements y_axis_label (string), time_unit (string), treatment_labels (character vector), -treatment_timepoints (integer vector). All can also be NA. -This list is used to add this info to the spline plots. +treatment_timepoints (integer vector). All can also be NA. +This list is used to add this info to the spline plots. time_unit is used to label the x-axis, and treatment_labels and -timepoints are used to create vertical dashed lines, -indicating the positions of the treatments (such as +indicating the positions of the treatments (such as feeding, temperature shift, etc.).} -\item{plot_options}{List with specific fields (cluster_heatmap_columns = +\item{plot_options}{List with specific fields (cluster_heatmap_columns = Bool) that allow for customization of plotting behavior.} \item{report_dir}{Character string specifying the directory path where the diff --git a/man/control_inputs_extract_data.Rd b/man/control_inputs_extract_data.Rd index 04012ea..dfc40c9 100755 --- a/man/control_inputs_extract_data.Rd +++ b/man/control_inputs_extract_data.Rd @@ -9,22 +9,22 @@ control_inputs_extract_data(data, feature_name_columns) \arguments{ \item{data}{A dataframe containing the input data.} -\item{feature_name_columns}{A character vector specifying the names of the +\item{feature_name_columns}{A character vector specifying the names of the feature name columns. The columns must be present -in the dataframe data. If `NA`, no column is +in the dataframe data. If `NA`, no column is checked.} } \description{ This function checks the validity of input data and the feature name column. -It ensures that the input data is a dataframe, the feature name column is +It ensures that the input data is a dataframe, the feature name column is specified correctly, and contains valid data. } \details{ The function performs the following checks: - Ensures the input data is a dataframe. -- Checks if the feature name column is a single string and exists in the +- Checks if the feature name column is a single string and exists in the data. -- Ensures the specified feature name column does not contain only `NA` +- Ensures the specified feature name column does not contain only `NA` values. - Checks if the input dataframe is not empty. diff --git a/man/create_enrichr_zip.Rd b/man/create_enrichr_zip.Rd index 51640fe..a1842d8 100755 --- a/man/create_enrichr_zip.Rd +++ b/man/create_enrichr_zip.Rd @@ -7,21 +7,21 @@ create_enrichr_zip(enrichr_format) } \arguments{ -\item{enrichr_format}{A list with the formatted gene lists and background +\item{enrichr_format}{A list with the formatted gene lists and background gene list, typically the output of `prepare_gene_lists_for_enrichr`.} } \value{ A base64-encoded string representing the ZIP file. } \description{ -This function creates a ZIP file containing directories for each level of -gene lists. Each directory contains text files for each cluster. The ZIP file +This function creates a ZIP file containing directories for each level of +gene lists. Each directory contains text files for each cluster. The ZIP file is then encoded to base64 for easy download. } \details{ -The function creates a temporary directory to store the files. For each level -in the `enrichr_format$gene_lists`, it creates a directory named after the -level. Within each level directory, it creates a text file for each cluster, -containing the genes in that cluster. The directories and files are added +The function creates a temporary directory to store the files. For each level +in the `enrichr_format$gene_lists`, it creates a directory named after the +level. Within each level directory, it creates a text file for each cluster, +containing the genes in that cluster. The directories and files are added to a ZIP file, which is then encoded to base64. } diff --git a/man/create_limma_report.Rd b/man/create_limma_report.Rd index 53852cd..218930d 100755 --- a/man/create_limma_report.Rd +++ b/man/create_limma_report.Rd @@ -7,7 +7,7 @@ create_limma_report(splineomics, adj_pthresh = 0.05, report_dir = here::here()) } \arguments{ -\item{splineomics}{An S3 object of class `SplineOmics` that contains all the +\item{splineomics}{An S3 object of class `SplineOmics` that contains all the necessary data and parameters for the analysis, including: \itemize{ \item \code{limma_splines_result}: A list containing top tables from @@ -15,30 +15,30 @@ necessary data and parameters for the analysis, including: \item \code{meta}: A data frame with sample metadata. Must contain a column "Time". \item \code{condition}: A character string specifying the column name in - the metadata (\code{meta}) that defines groups + the metadata (\code{meta}) that defines groups for analysis. This column contains levels such as - "exponential" and "stationary" for phases, or + "exponential" and "stationary" for phases, or "drug" and "no_drug" for treatments. - \item \code{annotation}: A data frame containing feature information, - such as gene and protein names, associated with + \item \code{annotation}: A data frame containing feature information, + such as gene and protein names, associated with the expression data. - \item \code{report_info}: A list containing metadata about the analysis + \item \code{report_info}: A list containing metadata about the analysis for reporting purposes. }} -\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold +\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold for significance. Default is 0.05. Must be > 0 and < 1.} -\item{report_dir}{A string specifying the directory where the report should +\item{report_dir}{A string specifying the directory where the report should be saved. Default is the current working directory.} } \value{ A list of plots included in the generated HTML report. } \description{ -Generates an HTML report based on the results of a limma analysis with -splines. -The report includes various plots and sections summarizing the analysis -results for time effects, average differences between conditions, +Generates an HTML report based on the results of a limma analysis with +splines. +The report includes various plots and sections summarizing the analysis +results for time effects, average differences between conditions, and interaction effects between condition and time. } diff --git a/man/create_progress_bar.Rd b/man/create_progress_bar.Rd index 5cf84f1..afe0852 100755 --- a/man/create_progress_bar.Rd +++ b/man/create_progress_bar.Rd @@ -2,17 +2,17 @@ % Please edit documentation in R/utils_general.R \name{create_progress_bar} \alias{create_progress_bar} -\title{utils scripts contains shared functions that are used by at least two package +\title{utils scripts contains shared functions that are used by at least two package functions of the SplineOmics package. Create Progress Bar} \usage{ create_progress_bar(iterable, message = "Processing") } \arguments{ -\item{iterable}{An iterable object (e.g., list or vector) whose length +\item{iterable}{An iterable object (e.g., list or vector) whose length determines the total number of steps.} -\item{message}{A message to display with the progress bar +\item{message}{A message to display with the progress bar (default is "Processing").} } \value{ diff --git a/man/create_spline_params.Rd b/man/create_spline_params.Rd index 1fffeba..a3d7cc9 100755 --- a/man/create_spline_params.Rd +++ b/man/create_spline_params.Rd @@ -21,7 +21,7 @@ create_spline_params(spline_test_configs, index, meta, condition, mode) A list of processed spline parameters. } \description{ -Generates spline parameters based on the configuration, metadata, condition, +Generates spline parameters based on the configuration, metadata, condition, and mode. } \seealso{ diff --git a/man/create_splineomics.Rd b/man/create_splineomics.Rd index 49d3d97..4a59ab4 100755 --- a/man/create_splineomics.Rd +++ b/man/create_splineomics.Rd @@ -15,6 +15,7 @@ create_splineomics( meta_batch2_column = NULL, feature_name_columns = NULL, design = NULL, + dream_params = NULL, mode = NULL, spline_params = NULL, padjust_method = "BH" @@ -22,7 +23,7 @@ create_splineomics( } \arguments{ \item{data}{The actual omics data. In the case the rna_seq_data argument is -used, still provide this argument. In that case, input the data matrix in +used, still provide this argument. In that case, input the data matrix in here (for example the $E part of the voom object). Assign your feature names as row headers (otherwise, just numbers will be your feature names).} @@ -30,54 +31,54 @@ as row headers (otherwise, just numbers will be your feature names).} \item{condition}{A condition variable.} -\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, -such as the output from `limma::voom` or a similar preprocessing pipeline. +\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, +such as the output from `limma::voom` or a similar preprocessing pipeline. This argument is not controlled by any function of the `SplineOmics` package. Rather, in that regard it relies on the input control from the `limma::lmfit` function.} -\item{annotation}{A dataframe with the feature descriptions of data +\item{annotation}{A dataframe with the feature descriptions of data (optional).} -\item{report_info}{A list containing report information such as omics data -type, data description, data collection date, analyst name, contact info, +\item{report_info}{A list containing report information such as omics data +type, data description, data collection date, analyst name, contact info, and project name (optional).} \item{meta_batch_column}{Column for meta batch information (optional).} -\item{meta_batch2_column}{Column for secondary meta batch information +\item{meta_batch2_column}{Column for secondary meta batch information (optional).} -\item{feature_name_columns}{Character vector containing the column names of +\item{feature_name_columns}{Character vector containing the column names of the annotation info that describe the features. -This argument is used to specify in the HTML +This argument is used to specify in the HTML report how exactly the feature names displayed above each individual spline plot have been -created. Use the same vector that was used to +created. Use the same vector that was used to create the row headers for the data matrix!} \item{design}{A design matrix or similar object (optional).} -\item{mode}{For the design formula, you must specify either 'isolated' or -'integrated'. Isolated means limma determines the results for each level +\item{mode}{For the design formula, you must specify either 'isolated' or +'integrated'. Isolated means limma determines the results for each level using only the data from that level. Integrated means limma determines the results for all levels using the full dataset (from all levels).} \item{spline_params}{Parameters for spline functions (optional). Must contain the named elements spline_type, which must contain either the string "n" for natural cubic splines, or "b", for B-splines, the named element degree in the -case of B-splines, that must contain only an integer, and the named element +case of B-splines, that must contain only an integer, and the named element dof, specifying the degree of freedom, containing an integer and required both for natural and B-splines.} -\item{padjust_method}{Method for p-value adjustment, one of "none", "BH", -"BY", "holm", "bonferroni", "hochberg", or "hommel". +\item{padjust_method}{Method for p-value adjustment, one of "none", "BH", +"BY", "holm", "bonferroni", "hochberg", or "hommel". Defaults to "BH" (Benjamini-Hochberg).} } \value{ A SplineOmics object. } \description{ -Creates a SplineOmics object containing variables that are commonly used +Creates a SplineOmics object containing variables that are commonly used across multiple functions in the package. } diff --git a/man/create_volcano_plot.Rd b/man/create_volcano_plot.Rd index 5aa265e..83a1281 100755 --- a/man/create_volcano_plot.Rd +++ b/man/create_volcano_plot.Rd @@ -7,18 +7,18 @@ create_volcano_plot(top_table, adj_pthresh, compared_levels) } \arguments{ -\item{top_table}{A data frame from limma containing 'logFC' and 'adj.P.Val' +\item{top_table}{A data frame from limma containing 'logFC' and 'adj.P.Val' columns.} \item{adj_pthresh}{A numeric value for the adjusted p-value threshold.} -\item{compared_levels}{A character vector of length 2 specifying the +\item{compared_levels}{A character vector of length 2 specifying the compared levels.} } \value{ A ggplot object representing the volcano plot. } \description{ -This function creates a volcano plot from a limma top table, plotting +This function creates a volcano plot from a limma top table, plotting log fold changes against the negative log10 of adjusted p-values. } diff --git a/man/define_html_styles.Rd b/man/define_html_styles.Rd index c8ce85d..31f58ee 100755 --- a/man/define_html_styles.Rd +++ b/man/define_html_styles.Rd @@ -10,6 +10,6 @@ define_html_styles() A list containing the styles for section headers and TOC entries. } \description{ -Defines the CSS styles for section headers and Table of Contents (TOC) +Defines the CSS styles for section headers and Table of Contents (TOC) entries used in the GSEA report generation. } diff --git a/man/design2design_matrix.Rd b/man/design2design_matrix.Rd index 8bcd4e1..8d6b4d2 100755 --- a/man/design2design_matrix.Rd +++ b/man/design2design_matrix.Rd @@ -9,22 +9,22 @@ design2design_matrix(meta, spline_params, level_index, design) \arguments{ \item{meta}{A dataframe containing the metadata, including the time column.} -\item{spline_params}{A list containing the spline parameters. This list can -include `dof` (degrees of freedom), `knots`, `bknots` (boundary knots), +\item{spline_params}{A list containing the spline parameters. This list can +include `dof` (degrees of freedom), `knots`, `bknots` (boundary knots), `spline_type`, and `degree`.} -\item{level_index}{An integer representing the current level index for which +\item{level_index}{An integer representing the current level index for which the design matrix is being generated.} -\item{design}{A character string representing the design formula to be used +\item{design}{A character string representing the design formula to be used for generating the model matrix.} } \value{ -A design matrix constructed using the specified spline parameters and +A design matrix constructed using the specified spline parameters and design formula. } \description{ -This function generates a design matrix using spline parameters and metadata. -It accommodates both B-splines and natural cubic splines based on the provided +This function generates a design matrix using spline parameters and metadata. +It accommodates both B-splines and natural cubic splines based on the provided spline type and parameters. } diff --git a/man/download_enrichr_databases.Rd b/man/download_enrichr_databases.Rd index 0a7570b..b55cb00 100755 --- a/man/download_enrichr_databases.Rd +++ b/man/download_enrichr_databases.Rd @@ -11,7 +11,7 @@ download_enrichr_databases( ) } \arguments{ -\item{gene_set_lib}{A character vector of database names to download from +\item{gene_set_lib}{A character vector of database names to download from Enrichr.} \item{output_dir}{A character string specifying the output directory @@ -23,12 +23,12 @@ present in some terms, .tsv is recommendet). When ommited, the file is named all_databases_{timestamp}.tsv.} } \value{ -This function does not return a value but saves a .tsv file in the - specified directory containing the gene sets from the specified +This function does not return a value but saves a .tsv file in the + specified directory containing the gene sets from the specified Enrichr databases. } \description{ This function downloads gene sets from specified Enrichr databases and saves - them to a specified output directory as a .tsv file. The file is named with + them to a specified output directory as a .tsv file. The file is named with a timestamp to ensure uniqueness. } diff --git a/man/encode_df_to_base64.Rd b/man/encode_df_to_base64.Rd index 62c0a4e..b899b07 100755 --- a/man/encode_df_to_base64.Rd +++ b/man/encode_df_to_base64.Rd @@ -17,8 +17,8 @@ names based on the report_type.} A character string containing the base64 encoded CSV data. } \description{ -This function takes a dataframe as input and returns a base64 encoded -CSV object. The encoded object can be embedded into an HTML document -directly, with a button to download the file without pointing to a +This function takes a dataframe as input and returns a base64 encoded +CSV object. The encoded object can be embedded into an HTML document +directly, with a button to download the file without pointing to a local file. } diff --git a/man/enrichr_get_genesets.Rd b/man/enrichr_get_genesets.Rd index 5652620..b7efb64 100755 --- a/man/enrichr_get_genesets.Rd +++ b/man/enrichr_get_genesets.Rd @@ -7,12 +7,12 @@ enrichr_get_genesets(databases) } \arguments{ -\item{databases}{A character vector of database names to download from +\item{databases}{A character vector of database names to download from Enrichr.} } \value{ A named list of gene sets from the specified Enrichr databases. Each - database is represented as a list, with gene set names as list + database is represented as a list, with gene set names as list names and vectors of human gene symbols as list elements. } \description{ diff --git a/man/explore_data.Rd b/man/explore_data.Rd index fb2b208..c030262 100755 --- a/man/explore_data.Rd +++ b/man/explore_data.Rd @@ -7,7 +7,7 @@ explore_data(splineomics, report_dir = here::here(), report = TRUE) } \arguments{ -\item{splineomics}{A SplineOmics object, containing the data, meta, +\item{splineomics}{A SplineOmics object, containing the data, meta, condition, report_info, meta_batch_column, and meta_batch2_column;} @@ -22,7 +22,7 @@ argument can be set to FALSE.} A list of ggplot objects representing various exploratory plots. } \description{ -This function takes a data matrix, checks its validity, and generates a list -of exploratory plots including density plots, boxplots, PCA plots, MDS plots, +This function takes a data matrix, checks its validity, and generates a list +of exploratory plots including density plots, boxplots, PCA plots, MDS plots, variance explained plots, and violin plots. } diff --git a/man/extract_data.Rd b/man/extract_data.Rd index 2dd39d9..086959d 100755 --- a/man/extract_data.Rd +++ b/man/extract_data.Rd @@ -2,34 +2,34 @@ % Please edit documentation in R/extract_data.R \name{extract_data} \alias{extract_data} -\title{extract_data.R contains the exported package function extract_data. This +\title{extract_data.R contains the exported package function extract_data. This function automatically recognises the data field in a table and returns the -data matrix, that serves as input for the other functions of this package. +data matrix, that serves as input for the other functions of this package. This is for convenience only. Extract Numeric Matrix from Dataframe} \usage{ extract_data(data, feature_name_columns = NA, user_prompt = TRUE) } \arguments{ -\item{data}{A dataframe loaded from a tabular file, potentially containing a +\item{data}{A dataframe loaded from a tabular file, potentially containing a rectangular or quadratic area with numeric data amidst other values.} \item{feature_name_columns}{(Optional) A character vector, specifying the -columns of the dataframe data, that should be +columns of the dataframe data, that should be used to construct the feature names. If ommited, the feature names are just numbers (stored as characters) starting from 1 (1, 2, 3, etc.)} -\item{user_prompt}{Boolean specifying whether the user prompt about the +\item{user_prompt}{Boolean specifying whether the user prompt about the correct format of the input data should be shown.} } \value{ A numeric matrix with row headers and appropriate column names. } \description{ -This function takes a dataframe and identifies a rectangular or quadratic -area containing numeric data, starting from the first occurrence of a -6x6 block of numeric values. It then extracts this area into a matrix, -ensuring that each row contains only numeric values. Rows with any NA values +This function takes a dataframe and identifies a rectangular or quadratic +area containing numeric data, starting from the first occurrence of a +6x6 block of numeric values. It then extracts this area into a matrix, +ensuring that each row contains only numeric values. Rows with any NA values are removed from the resulting matrix. } diff --git a/man/format_text.Rd b/man/format_text.Rd index cdd1052..42bb841 100755 --- a/man/format_text.Rd +++ b/man/format_text.Rd @@ -14,7 +14,7 @@ A character vector with formatted text containing line breaks. } \description{ This function takes a character vector `text` and splits it into individual -characters. It then iterates over the characters and builds lines not +characters. It then iterates over the characters and builds lines not exceeding a specified character limit (default 70). Newlines are inserted between lines using the `
    ` tag, suitable for HTML display. diff --git a/man/gen_composite_spline_plots.Rd b/man/gen_composite_spline_plots.Rd index a2ba506..d4a908c 100755 --- a/man/gen_composite_spline_plots.Rd +++ b/man/gen_composite_spline_plots.Rd @@ -21,16 +21,16 @@ gen_composite_spline_plots( \item{spline_test_configs}{A configuration object for spline tests.} -\item{time_unit_label}{A character string specifying the time unit label +\item{time_unit_label}{A character string specifying the time unit label for plots.} } \value{ A list containing the composite spline plots and their lengths. } \description{ -Creates composite spline plots for significant and non-significant features +Creates composite spline plots for significant and non-significant features across multiple levels within a condition. -One half of one condition comparison HTML +One half of one condition comparison HTML (composite spline plots for one 'condition' inside one condition comparison) } \seealso{ diff --git a/man/gen_hitcomp_plots.Rd b/man/gen_hitcomp_plots.Rd index 0519164..f33ea33 100755 --- a/man/gen_hitcomp_plots.Rd +++ b/man/gen_hitcomp_plots.Rd @@ -10,14 +10,14 @@ gen_hitcomp_plots(combo_pair) \item{combo_pair}{A list containing two combinations of top tables.} } \value{ -A list containing the Venn heatmap plot, the number of hits divided +A list containing the Venn heatmap plot, the number of hits divided by 16, the barplot, and a length indicator for the barplot. } \description{ -Generates Venn heatmap and barplot for a given combination pair of top +Generates Venn heatmap and barplot for a given combination pair of top tables. } \seealso{ -\code{\link{hc_new}}, \code{\link{hc_add}}, \code{\link{hc_vennheatmap}}, +\code{\link{hc_new}}, \code{\link{hc_add}}, \code{\link{hc_vennheatmap}}, \code{\link{hc_barplot}} } diff --git a/man/generate_and_write_html.Rd b/man/generate_and_write_html.Rd index 031f3d9..c81ddd8 100755 --- a/man/generate_and_write_html.Rd +++ b/man/generate_and_write_html.Rd @@ -9,17 +9,17 @@ generate_and_write_html(toc, html_content, report_info, output_file_path) \arguments{ \item{toc}{A string containing the table of contents in HTML format.} -\item{html_content}{A string containing the main HTML content with a +\item{html_content}{A string containing the main HTML content with a placeholder for the table of contents.} -\item{report_info}{A list containing report information such as +\item{report_info}{A list containing report information such as `contact_info` and `analyst_name`.} -\item{output_file_path}{A string specifying the path where the final +\item{output_file_path}{A string specifying the path where the final HTML file will be written.} } \description{ This function generates an HTML report by inserting a table of contents, -embedding necessary JavaScript files, and writing the final HTML content +embedding necessary JavaScript files, and writing the final HTML content to a specified output file. } diff --git a/man/generate_avrg_diff_plots.Rd b/man/generate_avrg_diff_plots.Rd index 303305f..9c03685 100755 --- a/man/generate_avrg_diff_plots.Rd +++ b/man/generate_avrg_diff_plots.Rd @@ -7,18 +7,18 @@ generate_avrg_diff_plots(avrg_diff_conditions, adj_pthresh) } \arguments{ -\item{avrg_diff_conditions}{A list of top tables from the LIMMA analysis +\item{avrg_diff_conditions}{A list of top tables from the LIMMA analysis representing the average difference between conditions.} -\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold +\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold for significance.} } \value{ -A list containing the plots and their sizes, as well as the +A list containing the plots and their sizes, as well as the section header information. } \description{ -Creates p-value histograms and volcano plots for each condition in the -average difference conditions. This function is used internally in the +Creates p-value histograms and volcano plots for each condition in the +average difference conditions. This function is used internally in the `create_limma_report` function. } diff --git a/man/generate_explore_plots.Rd b/man/generate_explore_plots.Rd index e91e706..7ac9aee 100755 --- a/man/generate_explore_plots.Rd +++ b/man/generate_explore_plots.Rd @@ -11,19 +11,19 @@ generate_explore_plots(data, meta, condition) \item{meta}{A data frame containing metadata associated with the data.} -\item{condition}{A string specifying the column in the metadata that contains +\item{condition}{A string specifying the column in the metadata that contains the condition or grouping variable.} } \value{ A list containing two elements: \describe{ \item{plots}{A list of ggplot objects representing the generated plots.} - \item{plots_sizes}{A vector of numeric values indicating the sizes of the + \item{plots_sizes}{A vector of numeric values indicating the sizes of the corresponding plots.} } } \description{ -This function generates various exploratory plots including density plots, -box plots, violin plots, PCA plots, and correlation heatmaps based on the +This function generates various exploratory plots including density plots, +box plots, violin plots, PCA plots, and correlation heatmaps based on the provided data and metadata. } diff --git a/man/generate_interaction_plots.Rd b/man/generate_interaction_plots.Rd index bca0ec1..79f8428 100755 --- a/man/generate_interaction_plots.Rd +++ b/man/generate_interaction_plots.Rd @@ -7,19 +7,19 @@ generate_interaction_plots(interaction_condition_time, adj_pthresh) } \arguments{ -\item{interaction_condition_time}{A list of top tables from the LIMMA -analysis +\item{interaction_condition_time}{A list of top tables from the LIMMA +analysis representing the interaction effects between condition and time.} -\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold +\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold for significance.} } \value{ -A list containing the plots and their sizes, as well as the +A list containing the plots and their sizes, as well as the section header information. } \description{ -Creates p-value histograms for each interaction condition in the -interaction of condition and time. This function is used internally in the +Creates p-value histograms for each interaction condition in the +interaction of condition and time. This function is used internally in the `create_limma_report` function. } diff --git a/man/generate_report_html.Rd b/man/generate_report_html.Rd index db88811..5af3612 100755 --- a/man/generate_report_html.Rd +++ b/man/generate_report_html.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/utils_report_generation.R \name{generate_report_html} \alias{generate_report_html} -\title{utils scripts contains shared functions that are used by at least two package +\title{utils scripts contains shared functions that are used by at least two package functions of the SplineOmics package. The level separation is only valid internally in this script, and has no connection to the script level of the respective exported functions scripts. @@ -64,20 +64,20 @@ for each level.} \item{adj_pthresh_interaction_condition_time}{Float, only for cluster_hits()} -\item{report_type}{A character string specifying the report type +\item{report_type}{A character string specifying the report type ('screen_limma_hyperparams' or 'cluster_hits').} \item{feature_name_columns}{Character vector with the column names of the -annotation information, such as the columns +annotation information, such as the columns containing the gene names. These column names are used to put the info in the HTML reports on how the descriptions above the individual spline -plots where created. This is because those +plots where created. This is because those descriptions can be made up of several column values, and the specific columns are then stated in the HTML report on top (e.g gene_uniprotID).} -\item{mode}{A character string specifying the mode +\item{mode}{A character string specifying the mode ('isolated' or 'integrated').} \item{filename}{A character string specifying the filename for the report.} @@ -90,10 +90,10 @@ in the HTML report on top (e.g gene_uniprotID).} No return value, called for side effects. } \description{ -Generates an HTML report with the provided plots, spline parameters, and +Generates an HTML report with the provided plots, spline parameters, and report information. } \seealso{ -\code{\link{build_hyperparams_screen_report}}, +\code{\link{build_hyperparams_screen_report}}, \code{\link{build_cluster_hits_report}} } diff --git a/man/generate_reports_meta.Rd b/man/generate_reports_meta.Rd index ccc994d..3e26eda 100755 --- a/man/generate_reports_meta.Rd +++ b/man/generate_reports_meta.Rd @@ -30,6 +30,6 @@ generate_reports_meta( No return value, called for side effects. } \description{ -Generates a metadata table for the LIMMA hyperparameter screen reports and +Generates a metadata table for the LIMMA hyperparameter screen reports and saves it as an HTML file with custom styling. } diff --git a/man/generate_spline_comparisons.Rd b/man/generate_spline_comparisons.Rd index 5e2047a..25cf114 100755 --- a/man/generate_spline_comparisons.Rd +++ b/man/generate_spline_comparisons.Rd @@ -17,12 +17,12 @@ generate_spline_comparisons( } \arguments{ \item{splineomics}{A list containing the splineomics results, including - time effects, -average difference between conditions, and interaction between condition + time effects, +average difference between conditions, and interaction between condition and time.} -\item{all_levels_clustering}{A list containing the X matrices for each -condition, used +\item{all_levels_clustering}{A list containing the X matrices for each +condition, used for spline fitting.} \item{data}{The data matrix containing the measurements.} @@ -33,15 +33,15 @@ the condition.} \item{condition}{Column name of meta that contains the levels of the experiment.} -\item{plot_info}{A list containing plotting information such as time unit +\item{plot_info}{A list containing plotting information such as time unit and axis labels.} \item{adj_pthresh_avrg_diff_conditions}{The adjusted p-value threshold for - the average + the average difference between conditions.} -\item{adj_pthresh_interaction}{The adjusted p-value threshold for the -interaction +\item{adj_pthresh_interaction}{The adjusted p-value threshold for the +interaction between condition and time.} } \value{ @@ -49,10 +49,10 @@ A list of lists containing the comparison plots and feature names for each condition pair. } \description{ -This function generates spline comparison plots for all pairwise -combinations of conditions in the metadata. For each condition pair, it -compares the time effects of two conditions, plots the data points, and -overlays the fitted spline curves. The function only generates plots if -the adjusted p-values for the average difference between conditions and the +This function generates spline comparison plots for all pairwise +combinations of conditions in the metadata. For each condition pair, it +compares the time effects of two conditions, plots the data points, and +overlays the fitted spline curves. The function only generates plots if +the adjusted p-values for the average difference between conditions and the interaction between condition and time are below the specified thresholds. } diff --git a/man/generate_time_effect_plots.Rd b/man/generate_time_effect_plots.Rd index 0ce1cd1..901537c 100755 --- a/man/generate_time_effect_plots.Rd +++ b/man/generate_time_effect_plots.Rd @@ -7,17 +7,17 @@ generate_time_effect_plots(time_effect, adj_pthresh) } \arguments{ -\item{time_effect}{A list of top tables from the LIMMA analysis representing +\item{time_effect}{A list of top tables from the LIMMA analysis representing the time effects.} -\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold +\item{adj_pthresh}{A numeric value specifying the adjusted p-value threshold for significance.} } \value{ -A list containing the plots and their sizes, as well as the +A list containing the plots and their sizes, as well as the section header information. } \description{ -Creates p-value histograms for each time effect in the LIMMA analysis. This +Creates p-value histograms for each time effect in the LIMMA analysis. This function is used internally in the `create_limma_report` function. } diff --git a/man/get_header_section.Rd b/man/get_header_section.Rd index 8d2b4dd..ac15979 100755 --- a/man/get_header_section.Rd +++ b/man/get_header_section.Rd @@ -9,13 +9,13 @@ get_header_section(title, header_text, report_type, feature_names_formula) \arguments{ \item{title}{A string specifying the title of the HTML document.} -\item{header_text}{A string specifying the text to be displayed in the +\item{header_text}{A string specifying the text to be displayed in the header of the report.} \item{report_type}{A character specifying the type of HTML report.} -\item{feature_names_formula}{String describing which columns of the -annotation info, such as gene and uniprotID, +\item{feature_names_formula}{String describing which columns of the +annotation info, such as gene and uniprotID, where used to construct the description above the individual spline plots. This is placed in the beginning of the output HTML reports.} @@ -24,14 +24,14 @@ the beginning of the output HTML reports.} A string containing the HTML header section. } \description{ -Generates the HTML header section for a report, including the title, header -text, and logo. This section also includes the styling for the table and +Generates the HTML header section for a report, including the title, header +text, and logo. This section also includes the styling for the table and other HTML elements. } \details{ -The function checks the `DEVTOOLS_LOAD` environment variable to determine -the path to the logo image. The logo image is then converted to a base64 -data URI and included in the HTML. The header section includes styles for -tables, table cells, and header elements to ensure proper formatting and +The function checks the `DEVTOOLS_LOAD` environment variable to determine +the path to the logo image. The logo image is then converted to a base64 +data URI and included in the HTML. The header section includes styles for +tables, table cells, and header elements to ensure proper formatting and alignment. } diff --git a/man/get_level_hit_indices.Rd b/man/get_level_hit_indices.Rd index 0bdda0f..113b53a 100755 --- a/man/get_level_hit_indices.Rd +++ b/man/get_level_hit_indices.Rd @@ -7,27 +7,27 @@ get_level_hit_indices(between_level_top_tables, level, adj_pthresholds) } \arguments{ -\item{between_level_top_tables}{A list of data frames containing the +\item{between_level_top_tables}{A list of data frames containing the between-level top tables.} -\item{level}{A string specifying the level to search for within the names +\item{level}{A string specifying the level to search for within the names of the data frames.} -\item{adj_pthresholds}{A numeric vector of adjusted p-value thresholds for +\item{adj_pthresholds}{A numeric vector of adjusted p-value thresholds for each data frame in `between_level_top_tables`.} } \value{ -A vector of unique feature indices that meet the adjusted p-value +A vector of unique feature indices that meet the adjusted p-value threshold criteria for the specified level. } \description{ -This function retrieves unique feature indices from a list of between-level +This function retrieves unique feature indices from a list of between-level top tables for a specified level, based on adjusted p-value thresholds. } \details{ -The function iterates over each data frame in `between_level_top_tables`. For -each data frame whose name contains the specified level (case insensitive), -it identifies the rows where the adjusted p-value is below the corresponding -threshold. The function then extracts the feature indices from these rows and +The function iterates over each data frame in `between_level_top_tables`. For +each data frame whose name contains the specified level (case insensitive), +it identifies the rows where the adjusted p-value is below the corresponding +threshold. The function then extracts the feature indices from these rows and compiles a unique list of these indices. } diff --git a/man/get_limma_combos_results.Rd b/man/get_limma_combos_results.Rd index f31e22d..e0e6093 100755 --- a/man/get_limma_combos_results.Rd +++ b/man/get_limma_combos_results.Rd @@ -37,14 +37,14 @@ derived from the limma::voom function.} \item{adj_pthresholds}{A numeric vector with elements > 0 and < 1.} -\item{padjust_method}{A single character string specifying the p-adjustment +\item{padjust_method}{A single character string specifying the p-adjustment method.} } \value{ -A list of results for each combination of data, design, and spline +A list of results for each combination of data, design, and spline configuration. } \description{ -Computes results for various combinations of data, design matrices, and +Computes results for various combinations of data, design matrices, and spline configurations using the LIMMA method. } diff --git a/man/hc_add.Rd b/man/hc_add.Rd index 9adf108..2515984 100755 --- a/man/hc_add.Rd +++ b/man/hc_add.Rd @@ -11,10 +11,10 @@ hc_add(hc_obj, top_table, params_id, condition = 1, threshold = 0.05) \item{top_table}{A dataframe containing the top table data.} -\item{params_id}{A character string identifying the parameters +\item{params_id}{A character string identifying the parameters (max length 70).} -\item{condition}{An integer (1 or 2) specifying the condition to which the +\item{condition}{An integer (1 or 2) specifying the condition to which the data belongs.} \item{threshold}{A numeric value specifying the adjusted p-value threshold.} diff --git a/man/hc_barplot.Rd b/man/hc_barplot.Rd index e2c9420..861836e 100755 --- a/man/hc_barplot.Rd +++ b/man/hc_barplot.Rd @@ -7,14 +7,14 @@ hc_barplot(hc_obj) } \arguments{ -\item{hc_obj}{An object of class "hitcomp" containing hit data for two +\item{hc_obj}{An object of class "hitcomp" containing hit data for two conditions.} } \value{ A ggplot2 object representing the barplot. } \description{ -Creates a barplot to visualize the number of significant features for each +Creates a barplot to visualize the number of significant features for each parameter set in the hit comparison object. } \seealso{ diff --git a/man/hc_new.Rd b/man/hc_new.Rd index b52e588..ff90c17 100755 --- a/man/hc_new.Rd +++ b/man/hc_new.Rd @@ -7,14 +7,14 @@ hc_new(cond1name = "Condition 1", cond2name = "Condition 2") } \arguments{ -\item{cond1name}{A character string for the first condition name +\item{cond1name}{A character string for the first condition name (max length 25).} -\item{cond2name}{A character string for the second condition name +\item{cond2name}{A character string for the second condition name (max length 25).} } \value{ -An object of class "hitcomp" containing empty data lists +An object of class "hitcomp" containing empty data lists and condition names. } \description{ diff --git a/man/hc_vennheatmap.Rd b/man/hc_vennheatmap.Rd index d854295..e804382 100755 --- a/man/hc_vennheatmap.Rd +++ b/man/hc_vennheatmap.Rd @@ -7,14 +7,14 @@ hc_vennheatmap(hc_obj) } \arguments{ -\item{hc_obj}{An object of class "hitcomp" containing hit data for two +\item{hc_obj}{An object of class "hitcomp" containing hit data for two conditions.} } \value{ A list containing the Venn heatmap plot and the number of hits. } \description{ -Creates a Venn heatmap to visualize the overlap of hits between two +Creates a Venn heatmap to visualize the overlap of hits between two conditions stored in a hit comparison object. } \seealso{ diff --git a/man/huge_table_user_prompter.Rd b/man/huge_table_user_prompter.Rd index 95871f6..8e4b003 100755 --- a/man/huge_table_user_prompter.Rd +++ b/man/huge_table_user_prompter.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/cluster_hits.R \name{huge_table_user_prompter} \alias{huge_table_user_prompter} -\title{Check if any table in a list has more than 300 rows and prompt user for +\title{Check if any table in a list has more than 300 rows and prompt user for input.} \usage{ huge_table_user_prompter(tables) @@ -11,7 +11,7 @@ huge_table_user_prompter(tables) \item{tables}{A list of data frames.} } \value{ -NULL. This function is used for its side effects (prompting the +NULL. This function is used for its side effects (prompting the user and potentially stopping the script). } \description{ diff --git a/man/is_not_na.Rd b/man/is_not_na.Rd index 44f722d..231ff9c 100755 --- a/man/is_not_na.Rd +++ b/man/is_not_na.Rd @@ -10,7 +10,7 @@ is_not_na(x) \item{x}{An atomic vector or any other object.} } \value{ -TRUE if the vector contains at least one non-NA value or if the +TRUE if the vector contains at least one non-NA value or if the object is not atomic; FALSE otherwise. } \description{ diff --git a/man/make_clustering_report.Rd b/man/make_clustering_report.Rd index 7457e9d..a1c1715 100755 --- a/man/make_clustering_report.Rd +++ b/man/make_clustering_report.Rd @@ -44,7 +44,7 @@ such as gene and uniprotID, for example.} \item{spline_params}{A list of spline parameters for the analysis.} -\item{adj_pthresholds}{Numeric vector, containing a float < 1 > 0 as each +\item{adj_pthresholds}{Numeric vector, containing a float < 1 > 0 as each value. There is one float for every level, and this is the adj. p-value threshold.} @@ -63,27 +63,27 @@ the adj. p-value threshold.} \item{meta_batch_column}{A character string specifying the meta batch column.} -\item{meta_batch2_column}{A character string specifying the second meta +\item{meta_batch2_column}{A character string specifying the second meta batch column.} -\item{plot_info}{List containing the elements y_axis_label (string), +\item{plot_info}{List containing the elements y_axis_label (string), time_unit (string), treatment_labels (character vector), -treatment_timepoints (integer vector). All can also be NA. -This list is used to add this info to the spline plots. +treatment_timepoints (integer vector). All can also be NA. +This list is used to add this info to the spline plots. time_unit is used to label the x-axis, and treatment_labels and -timepoints are used to create vertical dashed lines, -indicating the positions of the treatments (such as +indicating the positions of the treatments (such as feeding, temperature shift, etc.).} -\item{plot_options}{List with specific fields (cluster_heatmap_columns = +\item{plot_options}{List with specific fields (cluster_heatmap_columns = Bool) that allow for customization of plotting behavior.} -\item{feature_name_columns}{Character vector containing the column names of +\item{feature_name_columns}{Character vector containing the column names of the annotation info that describe the features. -This argument is used to specify in the HTML +This argument is used to specify in the HTML report how exactly the feature names displayed above each individual spline plot have been -created. Use the same vector that was used to +created. Use the same vector that was used to create the row headers for the data matrix!} \item{spline_comp_plots}{List containing the list of lists with all diff --git a/man/make_correlation_heatmaps.Rd b/man/make_correlation_heatmaps.Rd index 1a3cd58..88b561e 100755 --- a/man/make_correlation_heatmaps.Rd +++ b/man/make_correlation_heatmaps.Rd @@ -11,17 +11,17 @@ make_correlation_heatmaps(data, meta, condition) \item{meta}{A dataframe containing the metadata.} -\item{condition}{The column name in the metadata dataframe that contains the +\item{condition}{The column name in the metadata dataframe that contains the factor levels for generating individual heatmaps.} } \value{ -A list of `ComplexHeatmap` heatmap objects representing the -correlation +A list of `ComplexHeatmap` heatmap objects representing the +correlation heatmaps. } \description{ -This function generates correlation heatmaps using Spearman correlation for -a given data matrix. It creates a combined heatmap for all levels and -individual heatmaps for each level specified in the condition column of the +This function generates correlation heatmaps using Spearman correlation for +a given data matrix. It creates a combined heatmap for all levels and +individual heatmaps for each level specified in the condition column of the metadata. } diff --git a/man/make_mds_plot.Rd b/man/make_mds_plot.Rd index b45fc8f..8443dd5 100755 --- a/man/make_mds_plot.Rd +++ b/man/make_mds_plot.Rd @@ -11,14 +11,14 @@ make_mds_plot(data, meta, condition) \item{meta}{A dataframe, containign the meta information of data.} -\item{condition}{The column of the meta dataframe containign the levels that +\item{condition}{The column of the meta dataframe containign the levels that separate the experiment.} } \value{ A ggplot object representing the MDS plot. } \description{ -This function generates a multidimensional scaling (MDS) plot for a given -data matrix. The MDS plot visualizes the similarities or dissimilarities +This function generates a multidimensional scaling (MDS) plot for a given +data matrix. The MDS plot visualizes the similarities or dissimilarities between samples in the data matrix. } diff --git a/man/make_violin_box_plots.Rd b/man/make_violin_box_plots.Rd index 0bca0c3..5f0ab99 100755 --- a/man/make_violin_box_plots.Rd +++ b/man/make_violin_box_plots.Rd @@ -17,7 +17,7 @@ make_violin_box_plots(data, meta, condition) A ggplot object representing the violin plot. } \description{ -This function generates a violin plot for a given data matrix. The violin -plot shows the distribution of the values in the data matrix across different +This function generates a violin plot for a given data matrix. The violin +plot shows the distribution of the values in the data matrix across different variables, with each variable's distribution displayed as a separate violin. } diff --git a/man/maybe_add_dashed_lines.Rd b/man/maybe_add_dashed_lines.Rd index 70f7a27..6018d03 100755 --- a/man/maybe_add_dashed_lines.Rd +++ b/man/maybe_add_dashed_lines.Rd @@ -7,18 +7,18 @@ maybe_add_dashed_lines(p, plot_info, level, y_pos = 1) } \arguments{ -\item{p}{A ggplot object. The plot to which dashed lines and labels +\item{p}{A ggplot object. The plot to which dashed lines and labels will be added.} -\item{plot_info}{A list containing the treatment timepoints and -treatment labels. Treatment timepoints and labels can either be -unnamed elements or named lists where each element corresponds +\item{plot_info}{A list containing the treatment timepoints and +treatment labels. Treatment timepoints and labels can either be +unnamed elements or named lists where each element corresponds to a different `level`.} -\item{level}{A character string. Used to extract the treatment +\item{level}{A character string. Used to extract the treatment timepoints and labels when they are stored in named lists.} -\item{y_pos}{A numeric value specifying the y-axis position where +\item{y_pos}{A numeric value specifying the y-axis position where the text labels should be placed. Defaults to 1.} } \value{ @@ -27,9 +27,9 @@ A list containing: - `treatment_colors`: A named vector of colors used for the treatment labels. } \description{ -This internal function checks whether there are valid treatment -timepoints and labels in the `plot_info` list. If found, it adds +This internal function checks whether there are valid treatment +timepoints and labels in the `plot_info` list. If found, it adds dashed vertical lines and their corresponding x-axis values to the plot. -The treatment timepoints and labels can either be named lists (for +The treatment timepoints and labels can either be named lists (for multiple levels) or unnamed single elements. } diff --git a/man/merge_annotation_all_levels_clustering.Rd b/man/merge_annotation_all_levels_clustering.Rd index 2d0e7d2..efe95f6 100755 --- a/man/merge_annotation_all_levels_clustering.Rd +++ b/man/merge_annotation_all_levels_clustering.Rd @@ -16,7 +16,7 @@ dataframe with a `feature_nr` column. Some elements may be logical values.} \item{annotation}{A dataframe containing the annotation information.} } \value{ -A list with updated `top_table` dataframes containing merged +A list with updated `top_table` dataframes containing merged annotation information. } \description{ diff --git a/man/open_template.Rd b/man/open_template.Rd index 7a485b3..1dfa8c7 100755 --- a/man/open_template.Rd +++ b/man/open_template.Rd @@ -6,8 +6,15 @@ \usage{ open_template() } +\value{ +If successful, opens the `template.Rmd` file in RStudio for the user to +interact with. +If `rstudioapi` is not installed or available, or the template file is +not found, +an error is thrown with a corresponding message. +} \description{ This function opens the `template.Rmd` file in RStudio for -interactive use. The template file provides a structure for users +interactive use. The template file provides a structure for users to quickly set up their personal analysis. } diff --git a/man/open_tutorial.Rd b/man/open_tutorial.Rd index 22deaea..9da5333 100755 --- a/man/open_tutorial.Rd +++ b/man/open_tutorial.Rd @@ -6,6 +6,13 @@ \usage{ open_tutorial() } +\value{ +If successful, opens the `tutorial.Rmd` file in RStudio for the user to +interact with. +If `rstudioapi` is not installed or available, or the tutorial file is +not found, +an error is thrown with a corresponding message. +} \description{ This function opens the `tutorial.Rmd` file in RStudio for interactive use. Users can then run each code chunk step by step. diff --git a/man/plot2base64.Rd b/man/plot2base64.Rd index b5bdc97..80aa7b3 100755 --- a/man/plot2base64.Rd +++ b/man/plot2base64.Rd @@ -24,7 +24,7 @@ representation in the HTML.} \item{base_height_per_row}{A numeric value specifying the base height per row in inches.} -\item{units}{A character string specifying the units for the width and +\item{units}{A character string specifying the units for the width and height.} \item{html_img_width}{A character string specifying the width of the image @@ -35,7 +35,7 @@ A character string containing an HTML img tag with the Base64-encoded plot. } \description{ -Converts a ggplot2 plot to a Base64-encoded PNG image and returns an HTML +Converts a ggplot2 plot to a Base64-encoded PNG image and returns an HTML img tag for embedding in a report. } \seealso{ diff --git a/man/plot_all_mean_splines.Rd b/man/plot_all_mean_splines.Rd index 385962c..2ab74ad 100755 --- a/man/plot_all_mean_splines.Rd +++ b/man/plot_all_mean_splines.Rd @@ -10,13 +10,13 @@ plot_all_mean_splines(curve_values, plot_info, level) \item{curve_values}{A dataframe containing curve values and cluster assignments.} -\item{plot_info}{List containing the elements y_axis_label (string), +\item{plot_info}{List containing the elements y_axis_label (string), time_unit (string), treatment_labels (character vector), -treatment_timepoints (integer vector). All can also be NA. -This list is used to add this info to the spline plots. +treatment_timepoints (integer vector). All can also be NA. +This list is used to add this info to the spline plots. time_unit is used to label the x-axis, and treatment_labels and -timepoints are used to create vertical dashed lines, -indicating the positions of the treatments (such as +indicating the positions of the treatments (such as feeding, temperature shift, etc.).} \item{level}{One of the unique values of the meta condition column. This is diff --git a/man/plot_cluster_mean_splines.Rd b/man/plot_cluster_mean_splines.Rd index 36aa021..1bc178b 100755 --- a/man/plot_cluster_mean_splines.Rd +++ b/man/plot_cluster_mean_splines.Rd @@ -10,13 +10,13 @@ plot_cluster_mean_splines(curve_values, plot_info, level) \item{curve_values}{A dataframe containing curve values and cluster assignments.} -\item{plot_info}{List containing the elements y_axis_label (string), +\item{plot_info}{List containing the elements y_axis_label (string), time_unit (string), treatment_labels (character vector), -treatment_timepoints (integer vector). All can also be NA. -This list is used to add this info to the spline plots. +treatment_timepoints (integer vector). All can also be NA. +This list is used to add this info to the spline plots. time_unit is used to label the x-axis, and treatment_labels and -timepoints are used to create vertical dashed lines, -indicating the positions of the treatments (such as +indicating the positions of the treatments (such as feeding, temperature shift, etc.).} } \value{ diff --git a/man/plot_composite_splines.Rd b/man/plot_composite_splines.Rd index c7bdb17..30a658b 100755 --- a/man/plot_composite_splines.Rd +++ b/man/plot_composite_splines.Rd @@ -24,26 +24,26 @@ plot_composite_splines( \item{top_table}{A dataframe containing the top table results.} -\item{top_table_name}{A character string specifying the name of the +\item{top_table_name}{A character string specifying the name of the top table.} \item{indices}{A vector of indices specifying which features to plot.} -\item{type}{A character string specifying the type of features ('significant' +\item{type}{A character string specifying the type of features ('significant' or 'not_significant').} \item{time_unit_label}{A string shown in the plots as the unit for the time, such as min or hours.} } \value{ -A list containing the composite plot and its length if plots are +A list containing the composite plot and its length if plots are generated, FALSE otherwise. } \description{ -Generates composite spline plots for significant and non-significant +Generates composite spline plots for significant and non-significant features based on the specified indices. } \seealso{ -\link[splines]{bs}, \link[splines]{ns}, \link[ggplot2]{ggplot2}, +\link[splines]{bs}, \link[splines]{ns}, \link[ggplot2]{ggplot2}, \link[patchwork]{wrap_plots} } diff --git a/man/plot_cv.Rd b/man/plot_cv.Rd index 1395c29..f3f4b72 100755 --- a/man/plot_cv.Rd +++ b/man/plot_cv.Rd @@ -12,7 +12,7 @@ plot_cv(data, meta, condition) \item{meta}{A data frame with sample metadata. Must contain a column "Time" and the condition column.} -\item{condition}{The name of the column in the meta table that contains the +\item{condition}{The name of the column in the meta table that contains the condition information.} } \value{ @@ -20,11 +20,11 @@ A list of ggplot2 objects, each showing the distribution of CVs for one condition. } \description{ -This function takes a data frame with time series data +This function takes a data frame with time series data (rows as features and columns as samples), -a meta table with sample information including time points and conditions, +a meta table with sample information including time points and conditions, computes the coefficient -of variation (CV) for each feature for each condition level, and plots the +of variation (CV) for each feature for each condition level, and plots the distribution of these CVs. } diff --git a/man/plot_first_lag_autocorrelation.Rd b/man/plot_first_lag_autocorrelation.Rd index a36a750..ccecd1d 100755 --- a/man/plot_first_lag_autocorrelation.Rd +++ b/man/plot_first_lag_autocorrelation.Rd @@ -9,22 +9,22 @@ plot_first_lag_autocorrelation(data, meta, condition) \arguments{ \item{data}{A data frame where rows are features and columns are samples.} -\item{meta}{A data frame with sample metadata. Must contain a column "Time" +\item{meta}{A data frame with sample metadata. Must contain a column "Time" and the condition column.} -\item{condition}{The name of the column in the meta table that contains the +\item{condition}{The name of the column in the meta table that contains the condition information.} } \value{ -A list of ggplot2 objects, each showing the distribution of first +A list of ggplot2 objects, each showing the distribution of first lag autocorrelation coefficients for one condition. } \description{ -This function takes a data frame with time series data +This function takes a data frame with time series data (rows as features and columns as samples), -a meta table with sample information including time points and conditions, +a meta table with sample information including time points and conditions, computes the first lag -autocorrelation for each feature for each condition level, and plots the +autocorrelation for each feature for each condition level, and plots the distribution of these autocorrelation coefficients. } diff --git a/man/plot_heatmap.Rd b/man/plot_heatmap.Rd index 655b314..17d13d9 100755 --- a/man/plot_heatmap.Rd +++ b/man/plot_heatmap.Rd @@ -21,7 +21,7 @@ plot_heatmap( \item{mode}{A character vector with length 1, specifying the type of limma design formula (integrated for formulas with interaction effects -between the levels, isolated for formulas where each level is +between the levels, isolated for formulas where each level is analysed in isolation (no interaction effects))} \item{condition}{A character string specifying the condition.} @@ -31,7 +31,7 @@ level within the condition.} \item{time_unit_label}{A character string specifying the time unit label.} -\item{cluster_heatmap_columns}{Boolean specifying wether to cluster the +\item{cluster_heatmap_columns}{Boolean specifying wether to cluster the columns of the heatmap or not.} } \value{ diff --git a/man/plot_lag1_differences.Rd b/man/plot_lag1_differences.Rd index 7ede505..6d7b5c3 100755 --- a/man/plot_lag1_differences.Rd +++ b/man/plot_lag1_differences.Rd @@ -9,22 +9,22 @@ plot_lag1_differences(data, meta, condition) \arguments{ \item{data}{A data frame where rows are features and columns are samples.} -\item{meta}{A data frame with sample metadata. Must contain a column "Time" +\item{meta}{A data frame with sample metadata. Must contain a column "Time" and the condition column.} -\item{condition}{The name of the column in the meta table that contains the +\item{condition}{The name of the column in the meta table that contains the condition information.} } \value{ -A list of ggplot2 objects, each showing the distribution of lag-1 +A list of ggplot2 objects, each showing the distribution of lag-1 differences for one condition. } \description{ -This function takes a data frame with time series data +This function takes a data frame with time series data (rows as features and columns as samples), -a meta table with sample information including time points and conditions, +a meta table with sample information including time points and conditions, computes the lag-1 -differences for each feature for each condition level, and plots the +differences for each feature for each condition level, and plots the distribution of these differences. } diff --git a/man/plot_limma_combos_results.Rd b/man/plot_limma_combos_results.Rd index 1daa28d..5cc2f7c 100755 --- a/man/plot_limma_combos_results.Rd +++ b/man/plot_limma_combos_results.Rd @@ -33,14 +33,14 @@ column.} \item{time_unit}{A single character, such as s, m, h, or d, specifying the time_unit that should be used for the plots (s = seconds, m = minutes, -h = hours, d = days). This single character will be converted to a string +h = hours, d = days). This single character will be converted to a string that is a little bit more verbose, such as sec in square brackets for s.} } \value{ -A list of results including hit comparison plots and composite +A list of results including hit comparison plots and composite spline plots for each pair of combinations. } \description{ -Generates plots for pairwise comparisons of hyperparameter combinations +Generates plots for pairwise comparisons of hyperparameter combinations using limma results. } diff --git a/man/plot_mean_correlation_with_time.Rd b/man/plot_mean_correlation_with_time.Rd index 650c59e..fc82533 100755 --- a/man/plot_mean_correlation_with_time.Rd +++ b/man/plot_mean_correlation_with_time.Rd @@ -11,19 +11,19 @@ plot_mean_correlation_with_time(data, meta, condition) \item{meta}{A data frame with sample metadata. Must contain a column "Time".} -\item{condition}{The column of the meta dataframe containign the levels that +\item{condition}{The column of the meta dataframe containign the levels that separate the experiment.} } \value{ A ggplot2 object showing the distribution of mean correlations with time. - + @importFrom rlang .data } \description{ -This function takes a data frame with time series data -(rows as features and columns as samples) -and a meta table with sample information including time points, computes -the correlation of each +This function takes a data frame with time series data +(rows as features and columns as samples) +and a meta table with sample information including time points, computes +the correlation of each feature with time, and plots the distribution of these correlations. } diff --git a/man/plot_single_and_mean_splines.Rd b/man/plot_single_and_mean_splines.Rd index 5947be7..78baee6 100755 --- a/man/plot_single_and_mean_splines.Rd +++ b/man/plot_single_and_mean_splines.Rd @@ -11,13 +11,13 @@ plot_single_and_mean_splines(time_series_data, title, plot_info, level) \item{title}{A character string specifying the title of the plot.} -\item{plot_info}{List containing the elements y_axis_label (string), +\item{plot_info}{List containing the elements y_axis_label (string), time_unit (string), treatment_labels (character vector), -treatment_timepoints (integer vector). All can also be NA. -This list is used to add this info to the spline plots. +treatment_timepoints (integer vector). All can also be NA. +This list is used to add this info to the spline plots. time_unit is used to label the x-axis, and treatment_labels and -timepoints are used to create vertical dashed lines, -indicating the positions of the treatments (such as +indicating the positions of the treatments (such as feeding, temperature shift, etc.).} } \value{ diff --git a/man/plot_spline_comparisons.Rd b/man/plot_spline_comparisons.Rd index 5210c11..9a1af1d 100755 --- a/man/plot_spline_comparisons.Rd +++ b/man/plot_spline_comparisons.Rd @@ -33,11 +33,11 @@ condition.} \item{condition_2}{The name of the second condition.} \item{avrg_diff_conditions}{A data frame with the adjusted p-values for the - average difference + average difference between conditions.} \item{interaction_condition_time}{A data frame with the adjusted p-values - for the interaction between + for the interaction between condition and time.} \item{data}{The data matrix containing the measurements.} @@ -51,15 +51,15 @@ experiment.} \item{X_2}{A matrix of spline basis values for the second condition.} -\item{plot_info}{A list containing plotting information such as time unit +\item{plot_info}{A list containing plotting information such as time unit and axis labels.} -\item{adj_pthresh_avrg_diff_conditions}{The adjusted p-value threshold for -the average difference +\item{adj_pthresh_avrg_diff_conditions}{The adjusted p-value threshold for +the average difference between conditions.} -\item{adj_pthresh_interaction}{The adjusted p-value threshold for the -interaction between +\item{adj_pthresh_interaction}{The adjusted p-value threshold for the +interaction between condition and time.} } \value{ @@ -70,10 +70,10 @@ A list containing: } } \description{ -This function generates comparison plots for spline fits of two conditions -over time. It compares the time effects of two conditions, plots the data -points, and overlays the fitted spline curves. The function checks if the -adjusted p-values for the average difference between conditions and the -interaction between condition and time are below the specified thresholds +This function generates comparison plots for spline fits of two conditions +over time. It compares the time effects of two conditions, plots the data +points, and overlays the fitted spline curves. The function checks if the +adjusted p-values for the average difference between conditions and the +interaction between condition and time are below the specified thresholds before generating plots. } diff --git a/man/plot_splines.Rd b/man/plot_splines.Rd index 1209b2f..10bd364 100755 --- a/man/plot_splines.Rd +++ b/man/plot_splines.Rd @@ -33,19 +33,19 @@ points.} \item{time_unit_label}{A string shown in the plots as the unit for the time, such as min or hours.} -\item{plot_info}{List containing the elements y_axis_label (string), +\item{plot_info}{List containing the elements y_axis_label (string), time_unit (string), treatment_labels (character vector), -treatment_timepoints (integer vector). All can also be NA. -This list is used to add this info to the spline plots. +treatment_timepoints (integer vector). All can also be NA. +This list is used to add this info to the spline plots. time_unit is used to label the x-axis, and treatment_labels and -timepoints are used to create vertical dashed lines, -indicating the positions of the treatments (such as +indicating the positions of the treatments (such as feeding, temperature shift, etc.).} \item{adj_pthreshold}{Double > 0 and < 1 specifying the adj. p-val threshold.} \item{replicate_column}{String specifying the column of the meta dataframe -that contains the labels of the replicate measurents. When that is not +that contains the labels of the replicate measurents. When that is not given, this argument is NULL.} } \value{ diff --git a/man/prepare_gene_lists_for_enrichr.Rd b/man/prepare_gene_lists_for_enrichr.Rd index 9dd031f..06bd683 100755 --- a/man/prepare_gene_lists_for_enrichr.Rd +++ b/man/prepare_gene_lists_for_enrichr.Rd @@ -16,7 +16,7 @@ prepare_gene_lists_for_enrichr(all_levels_clustering, genes) A character vector with the formatted gene lists for each cluster. } \description{ -This function processes the clustered hits in each element of -`all_levels_clustering`, formats the gene names for easy copy-pasting into +This function processes the clustered hits in each element of +`all_levels_clustering`, formats the gene names for easy copy-pasting into Enrichr, and returns the formatted gene lists as a string. } diff --git a/man/preprocess_rna_seq_data.Rd b/man/preprocess_rna_seq_data.Rd index 3f7ace9..0c34f9f 100755 --- a/man/preprocess_rna_seq_data.Rd +++ b/man/preprocess_rna_seq_data.Rd @@ -21,18 +21,18 @@ columns).} \item{spline_params}{Parameters for spline functions (optional). Must contain the named elements spline_type, which must contain either the string "n" for natural cubic splines, or "b", for B-splines, the named element degree in the -case of B-splines, that must contain only an integer, and the named element +case of B-splines, that must contain only an integer, and the named element dof, specifying the degree of freedom, containing an integer and required both for natural and B-splines.} -\item{design}{A design formula for the limma analysis, such as +\item{design}{A design formula for the limma analysis, such as '~ 1 + Phase*X + Reactor'.} -\item{normalize_func}{An optional normalization function. If provided, this +\item{normalize_func}{An optional normalization function. If provided, this function will be used to normalize the `DGEList` object. If not provided, TMM normalization (via `edgeR::calcNormFactors`) will be used by default. Must take as -input the y of: y <- edgeR::DGEList(counts = raw_counts) and output the y +input the y of: y <- edgeR::DGEList(counts = raw_counts) and output the y with the normalized counts.} } \value{ @@ -42,7 +42,7 @@ A `voom` object, which includes the log2-counts per million (logCPM) \description{ The `preprocess_rna_seq_data()` function performs essential preprocessing steps for raw RNA-seq counts. This includes creating a `DGEList` object, -normalizing the counts using the default TMM (Trimmed Mean of M-values) +normalizing the counts using the default TMM (Trimmed Mean of M-values) normalization via the `edgeR::calcNormFactors` function, and applying the `voom` transformation from the `limma` package to obtain log-transformed counts per million (logCPM) with associated precision weights. If you diff --git a/man/print.SplineOmics.Rd b/man/print.SplineOmics.Rd index 358202f..a46dad2 100755 --- a/man/print.SplineOmics.Rd +++ b/man/print.SplineOmics.Rd @@ -12,17 +12,17 @@ \item{...}{Additional arguments passed to or from other methods.} } \value{ -The function does not return a value. It prints a summary of +The function does not return a value. It prints a summary of the SplineOmics object. } \description{ This function provides a summary print of the SplineOmics object, showing -relevant information such as the number of features, samples, metadata, +relevant information such as the number of features, samples, metadata, RNA-seq data, annotation, and spline parameters. } \details{ -This function is automatically called when a SplineOmics object is printed. -It provides a concise overview of the object's contents and attributes, -including the dimensions of the data, available metadata, and other relevant +This function is automatically called when a SplineOmics object is printed. +It provides a concise overview of the object's contents and attributes, +including the dimensions of the data, available metadata, and other relevant information such as annotations and spline parameters. } diff --git a/man/print_info_message.Rd b/man/print_info_message.Rd index cc7dcb1..2761605 100755 --- a/man/print_info_message.Rd +++ b/man/print_info_message.Rd @@ -7,10 +7,12 @@ print_info_message(message_prefix, report_dir) } \arguments{ -\item{message_prefix}{A custom message prefix to be displayed before the success message.} +\item{message_prefix}{A custom message prefix to be displayed before the +success message.} \item{report_dir}{The directory where the HTML reports are located.} } \description{ -This function prints a nicely formatted informational message with a green "Info" label. +This function prints a nicely formatted informational message with a green + "Info" label. } diff --git a/man/process_combo.Rd b/man/process_combo.Rd index 3139f97..7793e98 100755 --- a/man/process_combo.Rd +++ b/man/process_combo.Rd @@ -26,7 +26,7 @@ process_combo( \item{design_index}{Index of the design in the designs list.} -\item{spline_config_index}{Index of the spline configuration in the +\item{spline_config_index}{Index of the spline configuration in the spline_test_configs list.} \item{pthreshold}{The p-value threshold for significance.} @@ -48,7 +48,7 @@ derived from the limma::voom function.} \item{feature_names}{A character vector of feature names.} -\item{padjust_method}{A single character string specifying the p-adjustment +\item{padjust_method}{A single character string specifying the p-adjustment method.} \item{...}{Additional arguments.} @@ -57,10 +57,10 @@ method.} A list of top tables from the LIMMA spline analysis. } \description{ -Processes a single combination of data, design, spline configuration, and +Processes a single combination of data, design, spline configuration, and p-threshold to generate LIMMA spline results. } \seealso{ -\code{\link{create_spline_params}}, +\code{\link{create_spline_params}}, \code{\link{run_limma_splines}} } diff --git a/man/process_combo_pair.Rd b/man/process_combo_pair.Rd index 9178650..e3638e4 100755 --- a/man/process_combo_pair.Rd +++ b/man/process_combo_pair.Rd @@ -13,7 +13,7 @@ process_combo_pair( ) } \arguments{ -\item{combo_pair}{A list containing hit comparison and composite spline +\item{combo_pair}{A list containing hit comparison and composite spline plots.} \item{combo_pair_name}{A character string for naming the combination pair.} @@ -28,7 +28,7 @@ plots.} No return value, called for side effects. } \description{ -Processes a combination pair to generate plots and compile them into an +Processes a combination pair to generate plots and compile them into an HTML report. } \seealso{ diff --git a/man/process_config_column.Rd b/man/process_config_column.Rd index 23fcb1d..1c51be2 100755 --- a/man/process_config_column.Rd +++ b/man/process_config_column.Rd @@ -7,20 +7,20 @@ process_config_column(config_column, index, num_levels, mode) } \arguments{ -\item{config_column}{A configuration column from the spline test +\item{config_column}{A configuration column from the spline test configurations.} \item{index}{Index of the configuration to process.} \item{num_levels}{Number of unique levels in the metadata condition.} -\item{mode}{A character string specifying the mode +\item{mode}{A character string specifying the mode ('integrated' or 'isolated').} } \value{ A vector or list with the processed configuration values. } \description{ -Processes a configuration column based on the given mode and number of +Processes a configuration column based on the given mode and number of levels. } diff --git a/man/process_field.Rd b/man/process_field.Rd index beed82f..23c8f8f 100755 --- a/man/process_field.Rd +++ b/man/process_field.Rd @@ -22,7 +22,7 @@ process_field( \item{meta}{A dataframe containing meta information.} -\item{topTables}{A dataframe containing the results of differential +\item{topTables}{A dataframe containing the results of differential expression analysis.} \item{report_info}{A list containing additional report information.} @@ -31,15 +31,15 @@ expression analysis.} \item{report_type}{A string specifying the type of report.} -\item{enrichr_format}{A list with the formatted gene lists and background +\item{enrichr_format}{A list with the formatted gene lists and background gene list.} } \value{ -A string containing the HTML link for downloading the processed +A string containing the HTML link for downloading the processed field. } \description{ -This function processes a given field, encodes the associated data as base64, -and generates a download link for the report. It handles different types of +This function processes a given field, encodes the associated data as base64, +and generates a download link for the report. It handles different types of fields including data, meta, top tables, and Enrichr formatted gene lists. } diff --git a/man/process_plots.Rd b/man/process_plots.Rd index fa5c3ed..1f53445 100755 --- a/man/process_plots.Rd +++ b/man/process_plots.Rd @@ -22,7 +22,7 @@ process_plots( \item{toc}{The current state of the table of contents (TOC).} -\item{header_index}{An index to uniquely identify each section +\item{header_index}{An index to uniquely identify each section for anchoring.} \item{element_name}{A character string specifying the name of the element.} diff --git a/man/process_top_table.Rd b/man/process_top_table.Rd index 749eec0..0096835 100755 --- a/man/process_top_table.Rd +++ b/man/process_top_table.Rd @@ -7,8 +7,8 @@ process_top_table(process_within_level_result, feature_names) } \arguments{ -\item{process_within_level_result}{List of lists containing the limma -topTable, and fit. All of this is from +\item{process_within_level_result}{List of lists containing the limma +topTable, and fit. All of this is from one specific level.} \item{feature_names}{A non-empty character vector of feature names.} @@ -17,7 +17,7 @@ one specific level.} A dataframe containing the processed top table with added intercepts. } \description{ -Processes the top table from a LIMMA analysis, adding feature names and +Processes the top table from a LIMMA analysis, adding feature names and intercepts. } \seealso{ diff --git a/man/process_within_level.Rd b/man/process_within_level.Rd index 0d862c5..8f584c6 100755 --- a/man/process_within_level.Rd +++ b/man/process_within_level.Rd @@ -9,6 +9,7 @@ process_within_level( rna_seq_data, meta, design, + dream_params, spline_params, level_index, padjust_method @@ -17,13 +18,21 @@ process_within_level( \arguments{ \item{data}{A matrix of data values.} -\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, +\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, such as the output from `limma::voom` or a similar preprocessing pipeline.} \item{meta}{A dataframe containing metadata, including a 'Time' column.} \item{design}{A design formula or matrix for the limma analysis.} +\item{dream_params}{A named list or NULL. When not NULL, it must at least +contain the named element 'random_effects', which must contain a string that +is a formula for the random effects of the mixed models by dream. +Additionally, it can contain the named elements dof, which must be a int +bigger than 1, which is the degree of freedom for the dream topTable, and +the named element KenwardRoger, which must be a bool, specifying whether +to use that method or not.} + \item{spline_params}{A list of spline parameters for the analysis.} \item{level_index}{The index of the level within the factor.} @@ -31,15 +40,15 @@ such as the output from `limma::voom` or a similar preprocessing pipeline.} \item{padjust_method}{A character string specifying the p-adjustment method.} } \value{ -A list containing the top table and the fit object from the limma +A list containing the top table and the fit object from the limma analysis. } \description{ -Performs a within-level analysis using limma to generate top tables and fit -objects based on the specified spline parameters. Performs the limma spline +Performs a within-level analysis using limma to generate top tables and fit +objects based on the specified spline parameters. Performs the limma spline analysis for a selected level of a factor } \seealso{ -\link[splines]{bs}, \link[splines]{ns}, \link[limma]{lmFit}, +\link[splines]{bs}, \link[splines]{ns}, \link[limma]{lmFit}, \link[limma]{eBayes}, \link[limma]{topTable} } diff --git a/man/read_section_texts.Rd b/man/read_section_texts.Rd index 0a16f1e..2494667 100755 --- a/man/read_section_texts.Rd +++ b/man/read_section_texts.Rd @@ -7,16 +7,16 @@ read_section_texts(filename) } \arguments{ -\item{filename}{A character string specifying the name of the file -containing the section texts. The file should be located in the +\item{filename}{A character string specifying the name of the file +containing the section texts. The file should be located in the `inst/descriptions` directory of the package.} } \value{ -A character vector where each element is a section of the text +A character vector where each element is a section of the text split by the delimiter `|`. } \description{ -This internal function reads the contents of a text file located in the -`inst/descriptions` directory of the package and splits it into individual +This internal function reads the contents of a text file located in the +`inst/descriptions` directory of the package and splits it into individual sections based on a specified delimiter. } diff --git a/man/remove_batch_effect.Rd b/man/remove_batch_effect.Rd index e66406c..374d135 100755 --- a/man/remove_batch_effect.Rd +++ b/man/remove_batch_effect.Rd @@ -23,14 +23,14 @@ remove_batch_effect( column.} \item{condition}{A character vector of length 1, specifying the column name -of the meta dataframe, that contains the levels that +of the meta dataframe, that contains the levels that separate the experiment.} } \value{ A list of matrices with batch effects removed where applicable. } \description{ -Removes batch effects from the data matrices using the specified batch +Removes batch effects from the data matrices using the specified batch column in the metadata. } \seealso{ diff --git a/man/remove_batch_effect_cluster_hits.Rd b/man/remove_batch_effect_cluster_hits.Rd index 520071c..b70d3f0 100755 --- a/man/remove_batch_effect_cluster_hits.Rd +++ b/man/remove_batch_effect_cluster_hits.Rd @@ -20,18 +20,18 @@ remove_batch_effect_cluster_hits( \item{meta}{A dataframe containing meta information.} -\item{condition}{A string specifying the column in `meta` that divides the +\item{condition}{A string specifying the column in `meta` that divides the experiment into levels.} -\item{meta_batch_column}{A string specifying the column in `meta` that +\item{meta_batch_column}{A string specifying the column in `meta` that indicates batch information.} -\item{meta_batch2_column}{A string specifying the second batch column in +\item{meta_batch2_column}{A string specifying the second batch column in `meta`, if applicable.} \item{design}{A design matrix for the experiment.} -\item{mode}{A string indicating the mode of operation: "isolated" or +\item{mode}{A string indicating the mode of operation: "isolated" or "integrated".} \item{spline_params}{A list of spline parameters for the design matrix.} @@ -40,18 +40,18 @@ indicates batch information.} A list of dataframes with batch effects removed for each level. } \description{ -This function removes batch effects from the data for each level specified -by the condition. It supports both isolated and integrated modes, with +This function removes batch effects from the data for each level specified +by the condition. It supports both isolated and integrated modes, with optional handling for a second batch column. } \details{ The function operates in two modes: \describe{ - \item{isolated}{Processes each level independently, using only data from + \item{isolated}{Processes each level independently, using only data from that level.} \item{integrated}{Processes the entire dataset together.} } -If `meta_batch_column` is specified, the function removes batch effects using -`removeBatchEffect`. If a second batch column (`meta_batch2_column`) is +If `meta_batch_column` is specified, the function removes batch effects using +`removeBatchEffect`. If a second batch column (`meta_batch2_column`) is specified, it is also included in the batch effect removal. } diff --git a/man/remove_intercept.Rd b/man/remove_intercept.Rd new file mode 100644 index 0000000..b891bf7 --- /dev/null +++ b/man/remove_intercept.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/run_limma_splines.R +\name{remove_intercept} +\alias{remove_intercept} +\title{Remove intercept from a formula} +\usage{ +remove_intercept(formula) +} +\arguments{ +\item{formula}{A formula object. The formula can include an intercept (`1`) +and other terms. If a `1` is found, it is replaced with `0`.} +} +\value{ +A modified formula with the intercept removed. The first standalone + occurrence of `1` will be replaced by `0`. +} +\description{ +This function modifies a given formula by replacing the first occurrence +of a standalone intercept (`1`) with `0`. It works even if the `1` is +preceded by a tilde (`~`), ensuring that the intercept is removed while +leaving other parts of the formula intact. +} diff --git a/man/remove_prefix.Rd b/man/remove_prefix.Rd index fd66c86..a3d4e9c 100755 --- a/man/remove_prefix.Rd +++ b/man/remove_prefix.Rd @@ -15,6 +15,6 @@ remove_prefix(string, prefix) A string with the prefix removed. } \description{ -Removes a specified prefix from the beginning of a string. This function +Removes a specified prefix from the beginning of a string. This function is useful for cleaning or standardizing strings by removing known prefixes. } diff --git a/man/run_limma_splines.Rd b/man/run_limma_splines.Rd index bf8f1d4..d6bbe15 100755 --- a/man/run_limma_splines.Rd +++ b/man/run_limma_splines.Rd @@ -7,25 +7,25 @@ run_limma_splines(splineomics) } \arguments{ -\item{splineomics}{An S3 object of class `SplineOmics` that contains the +\item{splineomics}{An S3 object of class `SplineOmics` that contains the following elements: \itemize{ \item \code{data}: The matrix of the omics dataset, with the feature names optionally as row headers. - \item \code{rna_seq_data}: An object containing the preprocessed - RNA-seq data, + \item \code{rna_seq_data}: An object containing the preprocessed + RNA-seq data, such as the output from `limma::voom` or a similar preprocessing pipeline. - \item \code{meta}: A dataframe containing metadata corresponding to the - \code{data}, must include a 'Time' column and the column specified by + \item \code{meta}: A dataframe containing metadata corresponding to the + \code{data}, must include a 'Time' column and the column specified by \code{condition}. - \item \code{design}: A character string representing the limma design + \item \code{design}: A character string representing the limma design formula. - \item \code{condition}: A character string specifying the column name + \item \code{condition}: A character string specifying the column name in \code{meta} used to define groups for analysis. - \item \code{spline_params}: A list of spline parameters used in the + \item \code{spline_params}: A list of spline parameters used in the analysis, including: \itemize{ - \item \code{spline_type}: The type of spline (e.g., "n" for natural + \item \code{spline_type}: The type of spline (e.g., "n" for natural splines or "b" for B-splines). \item \code{dof}: Degrees of freedom for the spline. \item \code{knots}: Positions of the internal knots (for B-splines). @@ -35,21 +35,21 @@ following elements: }} } \value{ -The SplineOmics object, updated with a list with three elements: +The SplineOmics object, updated with a list with three elements: - `time_effect`: A list of top tables for each level with the time effect. - `avrg_diff_conditions`: A list of top tables for each comparison - between the levels. The comparison is the + between the levels. The comparison is the average difference of the values. - - `interaction_condition_time`: A list of top tables for each - comparison between levels. The + - `interaction_condition_time`: A list of top tables for each + comparison between levels. The comparison is the interaction between the condition and the time. } \description{ This function performs a limma spline analysis to identify significant -time-dependent changes in features (e.g., proteins) within an omics -time-series dataset. It evaluates features within each condition level -and between levels by comparing average differences and interactions +time-dependent changes in features (e.g., proteins) within an omics +time-series dataset. It evaluates features within each condition level +and between levels by comparing average differences and interactions between time and condition. } diff --git a/man/screen_limma_hyperparams.Rd b/man/screen_limma_hyperparams.Rd index 3530eb2..8045a9d 100755 --- a/man/screen_limma_hyperparams.Rd +++ b/man/screen_limma_hyperparams.Rd @@ -20,20 +20,20 @@ screen_limma_hyperparams( ) } \arguments{ -\item{splineomics}{An S3 object of class `SplineOmics` that contains all the +\item{splineomics}{An S3 object of class `SplineOmics` that contains all the necessary data and parameters for the analysis, including: \itemize{ \item \code{condition}: A string specifying the column name of the meta dataframe, that contains the levels that separate the experiment ('treatment' can be a condition, and - 'drug' and 'no drug' can be the levels of such a + 'drug' and 'no drug' can be the levels of such a condition). - \item \code{report_info}: - \item \code{meta_batch_column}: A character string specifying the meta + \item \code{report_info}: + \item \code{meta_batch_column}: A character string specifying the meta batch column. - \item \code{meta_batch2_column}: A character string specifying the second - meta batch column (the limma function - removeBatchEffect supports a maximum of + \item \code{meta_batch2_column}: A character string specifying the second + meta batch column (the limma function + removeBatchEffect supports a maximum of two batch columns.) }} @@ -41,14 +41,14 @@ necessary data and parameters for the analysis, including: \item{datas_descr}{A description object for the data.} -\item{metas}{A list of data frames containing metadata for each dataset in +\item{metas}{A list of data frames containing metadata for each dataset in `datas`.} \item{designs}{A character vector of design formulas for the limma analysis.} \item{modes}{A character vector that must have the same length as 'designs'. For each design formula, you must specify either 'isolated' or 'integrated'. -Isolated means limma determines the results for each level using only the +Isolated means limma determines the results for each level using only the data from that level. Integrated means limma determines the results for all levels using the full dataset (from all levels).} @@ -56,7 +56,7 @@ levels using the full dataset (from all levels).} \item{report_dir}{A non-empty string specifying the report directory.} -\item{adj_pthresholds}{A numeric vector of p-value thresholds for +\item{adj_pthresholds}{A numeric vector of p-value thresholds for significance determination.} \item{rna_seq_datas}{A list of RNA-seq data objects, such as the voom object @@ -64,20 +64,20 @@ derived from the limma::voom function.} \item{time_unit}{A character string specifying the time unit label for plots.} -\item{padjust_method}{A character string specifying the method for p-value +\item{padjust_method}{A character string specifying the method for p-value adjustment.} } \value{ Returns a list of plots generated from the limma analysis results. - Each element in the list corresponds to a different combination of + Each element in the list corresponds to a different combination of hyperparameters. } \description{ -This function screens through various combinations of hyperparameters for +This function screens through various combinations of hyperparameters for limma analysis, -including designs, modes, and degrees of freedom. It validates inputs, +including designs, modes, and degrees of freedom. It validates inputs, generates results for all -combinations, and plots the outcomes. Finally, it may also be involved in +combinations, and plots the outcomes. Finally, it may also be involved in generating an HTML report as part of a larger analysis workflow. } diff --git a/man/shorten_names.Rd b/man/shorten_names.Rd index c7ea6c4..002e47f 100755 --- a/man/shorten_names.Rd +++ b/man/shorten_names.Rd @@ -9,14 +9,14 @@ shorten_names(name, unique_values) \arguments{ \item{name}{A string representing the name to be shortened.} -\item{unique_values}{A vector of unique values whose abbreviations will +\item{unique_values}{A vector of unique values whose abbreviations will replace their occurrences in the name.} } \value{ A string with the unique values replaced by their abbreviations. } \description{ -Replaces occurrences of unique values within a name with their first three -characters. This function is useful for abbreviating long condition names +Replaces occurrences of unique values within a name with their first three +characters. This function is useful for abbreviating long condition names in a dataset. } diff --git a/man/stop_call_false.Rd b/man/stop_call_false.Rd index 47a821c..b1c37a5 100755 --- a/man/stop_call_false.Rd +++ b/man/stop_call_false.Rd @@ -7,17 +7,17 @@ stop_call_false(...) } \arguments{ -\item{...}{One or more character strings specifying the error message. -If multiple strings are provided, they will be concatenated +\item{...}{One or more character strings specifying the error message. +If multiple strings are provided, they will be concatenated with a space between them.} } \value{ -This function does not return a value; it stops execution and +This function does not return a value; it stops execution and throws an error. } \description{ -A helper function that triggers an error with the specified message and -suppresses the function call in the error output. This function behaves -similarly to the base `stop()` function but automatically concatenates +A helper function that triggers an error with the specified message and +suppresses the function call in the error output. This function behaves +similarly to the base `stop()` function but automatically concatenates multiple message strings if provided. } diff --git a/man/store_hits.Rd b/man/store_hits.Rd index 4a31d8a..4d464a7 100755 --- a/man/store_hits.Rd +++ b/man/store_hits.Rd @@ -7,14 +7,14 @@ store_hits(condition) } \arguments{ -\item{condition}{A list containing dataframes and parameters for each +\item{condition}{A list containing dataframes and parameters for each condition.} } \value{ -A list where each element is a vector of feature indices that meet +A list where each element is a vector of feature indices that meet the significance threshold. } \description{ -Stores the feature indices for significant hits based on the adjusted p-value +Stores the feature indices for significant hits based on the adjusted p-value threshold for each condition. } diff --git a/man/within_level.Rd b/man/within_level.Rd index 267ebdb..1e31556 100755 --- a/man/within_level.Rd +++ b/man/within_level.Rd @@ -12,6 +12,7 @@ within_level( rna_seq_data, meta, design, + dream_params, condition, feature_names, padjust_method, @@ -27,28 +28,36 @@ within_level( \item{data}{A matrix of data values.} -\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, +\item{rna_seq_data}{An object containing the preprocessed RNA-seq data, such as the output from `limma::voom` or a similar preprocessing pipeline.} \item{meta}{A dataframe containing the metadata for data.} \item{design}{A design formula or matrix for the limma analysis.} +\item{dream_params}{A named list or NULL. When not NULL, it must at least +contain the named element 'random_effects', which must contain a string that +is a formula for the random effects of the mixed models by dream. +Additionally, it can contain the named elements dof, which must be a int +bigger than 1, which is the degree of freedom for the dream topTable, and +the named element KenwardRoger, which must be a bool, specifying whether +to use that method or not.} + \item{condition}{A character string specifying the condition.} \item{feature_names}{A non-empty character vector of feature names.} \item{padjust_method}{A character string specifying the p-adjustment method.} -\item{mode}{A character string specifying the mode +\item{mode}{A character string specifying the mode ('isolated' or 'integrated').} } \value{ -A list containing the name of the results and the top table of +A list containing the name of the results and the top table of results. } \description{ -Processes a single level within a condition, performing limma analysis +Processes a single level within a condition, performing limma analysis and generating the top table of results. } \seealso{ diff --git a/renv.lock b/renv.lock index a18b006..0f54c38 100755 --- a/renv.lock +++ b/renv.lock @@ -201,6 +201,29 @@ ], "Hash": "f6e782014c01a819603ca4a3a508c301" }, + "Deriv": { + "Package": "Deriv", + "Version": "4.1.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "cd52c065c9e687c60c56b51f10f7bcd3" + }, + "EnvStats": { + "Package": "EnvStats", + "Version": "3.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "R", + "ggplot2", + "nortest" + ], + "Hash": "08f0337e9a3b03a9027a423a1ae76ed3" + }, "GO.db": { "Package": "GO.db", "Version": "3.18.0", @@ -324,6 +347,17 @@ ], "Hash": "8d6e9f4dce69aec9c588c27ae79be08e" }, + "KernSmooth": { + "Package": "KernSmooth", + "Version": "2.23-22", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "2fecebc3047322fa5930f74fae5de70f" + }, "MASS": { "Package": "MASS", "Version": "7.3-60.0.1", @@ -445,6 +479,27 @@ ], "Hash": "4ac8e423216b8b70cb9653d1b3f71eb9" }, + "Rdpack": { + "Package": "Rdpack", + "Version": "2.6.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "rbibutils", + "tools", + "utils" + ], + "Hash": "24a964d2cf75ad25d7b843856c8d4c93" + }, + "RhpcBLASctl": { + "Package": "RhpcBLASctl", + "Version": "0.23-42", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c966ea2957ff75e77afa5c908dfc89e1" + }, "S4Vectors": { "Package": "S4Vectors", "Version": "0.40.2", @@ -476,6 +531,18 @@ ], "Hash": "65c0b6bca03f88758f86ef0aa18c4873" }, + "aod": { + "Package": "aod", + "Version": "1.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "stats" + ], + "Hash": "6cbe18ab157a28fe4d6f2bc55e12d234" + }, "ape": { "Package": "ape", "Version": "5.8", @@ -514,13 +581,23 @@ }, "askpass": { "Package": "askpass", - "Version": "1.2.0", + "Version": "1.2.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "sys" ], - "Hash": "cad6cf7f1d5f6e906700b9d3e718c796" + "Hash": "c39f4155b3ceb1a9a2799d700fbd4b6a" + }, + "backports": { + "Package": "backports", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "e1e1b9d75c37401117b636b7ae50827a" }, "base64enc": { "Package": "base64enc", @@ -558,10 +635,10 @@ }, "bitops": { "Package": "bitops", - "Version": "1.0-8", + "Version": "1.0-9", "Source": "Repository", "Repository": "CRAN", - "Hash": "da69e6b6f8feebec0827205aad3fdbd8" + "Hash": "d972ef991d58c19e6efa71b21f5e144b" }, "blob": { "Package": "blob", @@ -575,6 +652,18 @@ ], "Hash": "40415719b5a479b87949f3aa0aee737c" }, + "boot": { + "Package": "boot", + "Version": "1.3-29", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "graphics", + "stats" + ], + "Hash": "a0cb8a465a115fd8460cab1a5b18a5f3" + }, "brio": { "Package": "brio", "Version": "1.1.5", @@ -585,6 +674,26 @@ ], "Hash": "c1ee497a6d999947c2c224ae46799b1a" }, + "broom": { + "Package": "broom", + "Version": "1.0.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "backports", + "dplyr", + "generics", + "glue", + "lifecycle", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyr" + ], + "Hash": "8fcc818f3b9887aebaf206f141437cc9" + }, "bslib": { "Package": "bslib", "Version": "0.8.0", @@ -607,6 +716,17 @@ ], "Hash": "b299c6741ca9746fb227debcb0f9fb6c" }, + "caTools": { + "Package": "caTools", + "Version": "1.18.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bitops" + ], + "Hash": "ab79c733080d83b4ad8a2cc33c1ef393" + }, "cachem": { "Package": "cachem", "Version": "1.1.0", @@ -777,6 +897,17 @@ ], "Hash": "bb097fccb22d156624fd07cd2894ddb6" }, + "corpcor": { + "Package": "corpcor", + "Version": "1.6.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "17ebe3b6d75d09c5bab3891880b34237" + }, "cowplot": { "Package": "cowplot", "Version": "1.1.3", @@ -839,7 +970,7 @@ }, "dendextend": { "Package": "dendextend", - "Version": "1.17.1", + "Version": "1.18.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -851,7 +982,7 @@ "utils", "viridis" ], - "Hash": "043fafb791081fc553f29021bd0a9a01" + "Hash": "769fa78232320ee628c21c2eb07b6981" }, "desc": { "Package": "desc", @@ -892,6 +1023,30 @@ ], "Hash": "33698c4b3127fc9f506654607fb73676" }, + "doBy": { + "Package": "doBy", + "Version": "4.6.24", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Deriv", + "MASS", + "Matrix", + "R", + "boot", + "broom", + "cowplot", + "dplyr", + "ggplot2", + "methods", + "microbenchmark", + "modelr", + "rlang", + "tibble", + "tidyr" + ], + "Hash": "8ddf795104defe53c5392a588888ec68" + }, "doParallel": { "Package": "doParallel", "Version": "1.0.17", @@ -1019,6 +1174,13 @@ ], "Hash": "6b567375113ceb7d9f800de4dd42218e" }, + "fANCOVA": { + "Package": "fANCOVA", + "Version": "0.6-1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "2557114e4acc64d572add2881d725bde" + }, "fansi": { "Package": "fansi", "Version": "1.0.6", @@ -1329,14 +1491,29 @@ }, "glue": { "Package": "glue", - "Version": "1.7.0", + "Version": "1.8.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", "methods" ], - "Hash": "e0b3a53876554bd45879e596cdb10a52" + "Hash": "5899f1eaa825580172bb56c08266f37c" + }, + "gplots": { + "Package": "gplots", + "Version": "3.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "KernSmooth", + "R", + "caTools", + "gtools", + "methods", + "stats" + ], + "Hash": "d24febf39c58dcb5a6cc6a12bd66d40a" }, "graphlayouts": { "Package": "graphlayouts", @@ -1407,6 +1584,18 @@ ], "Hash": "e18861963cbc65a27736e02b3cd3c4a0" }, + "gtools": { + "Package": "gtools", + "Version": "3.9.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods", + "stats", + "utils" + ], + "Hash": "588d091c35389f1f4a9d533c8d709b35" + }, "here": { "Package": "here", "Version": "1.0.1", @@ -1650,6 +1839,48 @@ ], "Hash": "74c3b64358e0be7edc3ecd130816dd3f" }, + "lme4": { + "Package": "lme4", + "Version": "1.1-35.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "Matrix", + "R", + "Rcpp", + "RcppEigen", + "boot", + "graphics", + "grid", + "lattice", + "methods", + "minqa", + "nlme", + "nloptr", + "parallel", + "splines", + "stats", + "utils" + ], + "Hash": "16a08fc75007da0d08e0c0388c7c33e6" + }, + "lmerTest": { + "Package": "lmerTest", + "Version": "3.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "R", + "ggplot2", + "lme4", + "methods", + "numDeriv", + "stats" + ], + "Hash": "f04948de84602afc23bfa9f5427e954d" + }, "locfit": { "Package": "locfit", "Version": "1.5-9.10", @@ -1721,6 +1952,18 @@ ], "Hash": "110ee9d83b496279960e162ac97764ce" }, + "microbenchmark": { + "Package": "microbenchmark", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "graphics", + "stats" + ], + "Hash": "f9d226d88d4087d817d4e616626ce8e5" + }, "mime": { "Package": "mime", "Version": "0.12", @@ -1731,6 +1974,34 @@ ], "Hash": "18e9c28c1d3ca1560ce30658b22ce104" }, + "minqa": { + "Package": "minqa", + "Version": "1.2.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Rcpp" + ], + "Hash": "785ef8e22389d4a7634c6c944f2dc07d" + }, + "modelr": { + "Package": "modelr", + "Version": "0.1.11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "broom", + "magrittr", + "purrr", + "rlang", + "tibble", + "tidyr", + "tidyselect", + "vctrs" + ], + "Hash": "4f50122dc256b1b6996a4703fecea821" + }, "munsell": { "Package": "munsell", "Version": "0.5.1", @@ -1742,6 +2013,17 @@ ], "Hash": "4fd8900853b746af55b81fda99da7695" }, + "mvtnorm": { + "Package": "mvtnorm", + "Version": "1.3-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "77c61d51ce0f36e3c1a76e6b295aab31" + }, "nlme": { "Package": "nlme", "Version": "3.1-164", @@ -1756,6 +2038,33 @@ ], "Hash": "a623a2239e642806158bc4dc3f51565d" }, + "nloptr": { + "Package": "nloptr", + "Version": "2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "27550641889a3abf3aec4d91186311ec" + }, + "nortest": { + "Package": "nortest", + "Version": "1.0-4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "stats" + ], + "Hash": "e587e7a30c737ad415590976481332e4" + }, + "numDeriv": { + "Package": "numDeriv", + "Version": "2016.8-1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "df58958f293b166e4ab885ebcad90e02" + }, "openssl": { "Package": "openssl", "Version": "2.2.2", @@ -1802,6 +2111,24 @@ ], "Hash": "e23fb9ecb1258207bcb763d78d513439" }, + "pbkrtest": { + "Package": "pbkrtest", + "Version": "0.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "MASS", + "Matrix", + "R", + "broom", + "doBy", + "dplyr", + "lme4", + "methods", + "numDeriv" + ], + "Hash": "938e6bbc4ac57534f8b43224506a8966" + }, "pheatmap": { "Package": "pheatmap", "Version": "1.0.12", @@ -2055,6 +2382,18 @@ ], "Hash": "5e3c5dc0b071b21fa128676560dbe94d" }, + "rbibutils": { + "Package": "rbibutils", + "Version": "2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "tools", + "utils" + ], + "Hash": "dfc034a172fd88fc66b1a703894c4185" + }, "readr": { "Package": "readr", "Version": "2.1.5", @@ -2093,6 +2432,27 @@ ], "Hash": "8cf9c239b96df1bbb133b74aef77ad0a" }, + "remaCor": { + "Package": "remaCor", + "Version": "0.0.18", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "EnvStats", + "R", + "Rcpp", + "RcppArmadillo", + "Rdpack", + "compiler", + "ggplot2", + "grid", + "methods", + "mvtnorm", + "reshape2", + "stats" + ], + "Hash": "08a3cc7b81538ee6ee8564e842f6a0ca" + }, "rematch": { "Package": "rematch", "Version": "2.0.0", @@ -2112,13 +2472,13 @@ }, "renv": { "Package": "renv", - "Version": "1.0.9", + "Version": "1.0.10", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "utils" ], - "Hash": "ef233f0e9064fc88c898b340c9add5c2" + "Hash": "d0387d5687ec933dd7587efd4cfa2d85" }, "reshape2": { "Package": "reshape2", @@ -2340,10 +2700,10 @@ }, "sys": { "Package": "sys", - "Version": "3.4.2", + "Version": "3.4.3", "Source": "Repository", "Repository": "CRAN", - "Hash": "3a1be13d68d47a8cd0bfd74739ca1555" + "Hash": "de342ebfebdbf40477d0758d05426646" }, "systemfonts": { "Package": "systemfonts", @@ -2574,6 +2934,42 @@ ], "Hash": "62b65c52671e6665f803ff02954446e9" }, + "variancePartition": { + "Package": "variancePartition", + "Version": "1.32.5", + "Source": "Bioconductor", + "Repository": "Bioconductor 3.18", + "Requirements": [ + "Biobase", + "BiocParallel", + "MASS", + "Matrix", + "R", + "Rdpack", + "RhpcBLASctl", + "aod", + "corpcor", + "fANCOVA", + "ggplot2", + "gplots", + "grDevices", + "graphics", + "iterators", + "limma", + "lme4", + "lmerTest", + "matrixStats", + "methods", + "pbkrtest", + "remaCor", + "reshape2", + "rlang", + "scales", + "stats", + "utils" + ], + "Hash": "8d17907a59342ac6f97954d1f14248e8" + }, "vctrs": { "Package": "vctrs", "Version": "0.6.5", @@ -2675,7 +3071,7 @@ }, "xfun": { "Package": "xfun", - "Version": "0.47", + "Version": "0.48", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -2684,7 +3080,7 @@ "stats", "tools" ], - "Hash": "36ab21660e2d095fef0d83f689e0477c" + "Hash": "89e455b87c84e227eb7f60a1b4e5fe1f" }, "xml2": { "Package": "xml2", diff --git a/renv/activate.R b/renv/activate.R index c360bf2..c19fc3e 100755 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,7 +2,7 @@ local({ # the requested version of renv - version <- "1.0.9" + version <- "1.0.10" attr(version, "sha") <- NULL # the project directory diff --git a/vignettes/Docker-instructions.Rmd b/vignettes/Docker-instructions.Rmd index 9b1459c..fc8aea8 100755 --- a/vignettes/Docker-instructions.Rmd +++ b/vignettes/Docker-instructions.Rmd @@ -65,7 +65,7 @@ document.addEventListener("DOMContentLoaded", function() { To pull the Docker container, use the following command. Make sure to check for the newest version or the specific version you need by visiting the [Docker Hub repository](https://hub.docker.com/r/thomasrauter/splineomics). -```{r eval=FALSE} +``` bash docker pull thomasrauter/splineomics:0.1.0 ``` @@ -75,10 +75,9 @@ If you face 'permission denied' issues, check out [this vignette](https://raw.gi To run the `Docker` container, you can use one of the following commands, depending on your operating system. Before running the command, ensure that you are in a directory containing two subfolders: `input` and `output`. These will be used to transfer files between your local machine and the Docker container. -For Linux and macOS: +For Linux and macOS (`Bash`): -```{r eval=FALSE} -# Bash +```bash docker run -it -d \ -v $(pwd)/input:/home/rstudio/input \ -v $(pwd)/output:/home/rstudio/output \ @@ -88,10 +87,9 @@ docker run -it -d \ thomasrauter/splineomics:0.1.0 ``` -For Windows: +For Windows (`PowerShell`): -```{r eval=FALSE} -# PowerShell +```powershell docker run -it -d ` -v "${PWD}\input:/home/rstudio/input" ` -v "${PWD}\output:/home/rstudio/output" ` @@ -111,13 +109,13 @@ As long as the container is running, you can work on that localhost page with RS Stop the container: -```{r eval=FALSE} +```bash docker stop splineomics ``` Start the container again: -```{r eval=FALSE} +```bash docker start splineomics ``` @@ -139,7 +137,7 @@ The `input` and `output` directories on your local machine are mounted to corres To see all the R packages and system installations that make up the `Docker` container, you can run the following command in the terminal of RStudio on your localhost browser page. -```{r eval=FALSE} +```bash cp -r /log home/rstudio/output ``` @@ -161,7 +159,7 @@ If you want to permanently add R packages, R scripts, or other files to the Spli For example: -```{r eval=FALSE} +```bash # Use the SplineOmics image as the base image FROM thomasrauter/splineomics:0.1.0 @@ -194,7 +192,7 @@ When you have your final analysis script inside the Docker container of the `Spl Ensure all analysis scripts and necessary files are saved in a dedicated directory inside the container (e.g., `/home/rstudio/analysis/`). Your analysis script should take the input files from a directory like /home/rstudio/input/ (which is already inside the container and does not need to be mounted again when reproducing the analysis) and output all results to /home/rstudio/output/. The /home/rstudio/output/ directory is mounted to a local directory on the user’s machine, making the results accessible outside the container. Example directory structure: -```{r eval=FALSE} +```bash /home/rstudio/ └── analysis/ ├── final_analysis.R # Main analysis script @@ -207,7 +205,7 @@ Create a bash script (run_analysis.sh) that runs your analysis automatically. Example run_analysis.sh: -```{r eval=FALSE} +```bash #!/bin/bash Rscript /home/rstudio/analysis/final_analysis.R tail -f /dev/null # Keep the container running after analysis @@ -219,7 +217,7 @@ Save this script in `/home/rstudio/`. Once your scripts are ready, commit the running container as a new image and set the new entry point to run the bash script automatically: -```{r eval=FALSE} +```bash docker commit \ --change='CMD ["/bin/bash", "/home/rstudio/run_analysis.sh"]' \ \ @@ -230,13 +228,13 @@ docker commit \ Push the new image to `Docker Hub` so others can easily pull and reproduce the analysis: -```{r eval=FALSE} +```bash docker push thomasrauter/splineomics-analysis:v1 ``` Others can pull (download) the container with this command: -```{r eval=FALSE} +```bash docker pull thomasrauter/splineomics-analysis:v1 ``` @@ -246,7 +244,7 @@ To reproduce the results, you need to create a local directory where the results Use the following command to run the container and ensure that the results are saved to the local output directory (see commands in section Running the `Docker` Container above how to mount the `output` dir in the current working dir). -```{r eval=FALSE} +```bash docker run -it \ -v /path/to/local/output:/home/rstudio/output \ thomasrauter/splineomics-analysis:v1 @@ -256,7 +254,7 @@ docker run -it \ Start a new container and mount an empty local directory to the /home/rstudio/ directory inside the container. This allows you to directly access all the analysis files on your local machine. -```{r eval=FALSE} +```bash docker run -it \ -v /path/to/local/dir:/home/rstudio \ thomasrauter/splineomics-analysis:v1 diff --git a/vignettes/design_limma_design_formula.Rmd b/vignettes/design_limma_design_formula.Rmd index 2f31b9b..cdc88c6 100755 --- a/vignettes/design_limma_design_formula.Rmd +++ b/vignettes/design_limma_design_formula.Rmd @@ -137,3 +137,9 @@ contrast <- makeContrasts( - `~ 1 + factor1 + factor2`: Additive model with an intercept. - `~ 0 + factor1 * factor2`: Model with main effects and their interaction, no intercept. - `~ 1 + factor1 * factor2`: Model with intercept, main effects, and their interaction. + +# Session Info + +```{r sessionInfo, echo=FALSE} +sessionInfo() +``` diff --git a/vignettes/get-started.Rmd b/vignettes/get-started.Rmd index de48246..e3240d3 100755 --- a/vignettes/get-started.Rmd +++ b/vignettes/get-started.Rmd @@ -63,9 +63,9 @@ viewed [here](https://csbg.github.io/SplineOmics/reference) ```{r setup, eval = TRUE} library(SplineOmics) -library(readxl) # for loading Excel files -library(here) # For managing filepaths -library(dplyr) # For data manipulation +library(readxl) # for loading Excel files +library(here) # For managing filepaths +library(dplyr) # For data manipulation ``` # Load the files @@ -96,12 +96,11 @@ the annotation info, which can be copied in a separate dataframe, as shown below. ```{r load the files} - data <- readRDS(system.file( "extdata", "proteomics_data.rds", package = "SplineOmics" - )) +)) meta <- read_excel( @@ -109,11 +108,11 @@ meta <- read_excel( "extdata", "proteomics_meta.xlsx", package = "SplineOmics" - ) ) +) # Extract the annotation part from the dataframe. -first_na_col <- which(is.na(data[1,]))[1] +first_na_col <- which(is.na(data[1, ]))[1] annotation <- data |> dplyr::select((first_na_col + 1):ncol(data)) |> dplyr::slice(-c(1:3)) @@ -123,7 +122,7 @@ print(meta) print(annotation) ``` -Two comments about the characteristics the input data should have: +Three comments about the characteristics the input data should have: - The data must not contain any NA values or other special values, and must consist only of numbers. For example, the original proteomics @@ -140,6 +139,9 @@ Two comments about the characteristics the input data should have: from normality. Proper transformation helps ensure that the assumptions underlying the statistical tests are met, leading to more accurate and trustworthy results. + +- The samples in the data should be independent of each other. Linear models, such as those used in limma, assume that the observations (samples) are independent. If there is a dependency between samples (e.g., repeated measurements of the same subject), this assumption is violated, which can + lead to incorrect statistical inferences. ## Bring the Inputs into the Standardized Format @@ -185,10 +187,10 @@ data <- SplineOmics::extract_data( # The dataframe with the numbers on the left and info on the right. data = data, # Use this annotation column for the feature names. - feature_name_columns = c("Gene_name"), + feature_name_columns = c("Gene_name"), # When TRUE, you must confirm that data is in the required format. - user_prompt = FALSE - ) + user_prompt = FALSE +) ``` # Perform EDA (exploratory data analysis) @@ -257,7 +259,7 @@ optional arguments: ```{r Load EDA arguments, eval = TRUE} # Those fields are mandatory, because we believe that when such a report is -# opened after half a year, those infos can be very helpful. +# opened after half a year, those infos can be very helpful. report_info <- list( omics_data_type = "PTX", data_description = "Proteomics data of CHO cells", @@ -265,12 +267,12 @@ report_info <- list( analyst_name = "Thomas Rauter", contact_info = "thomas.rauter@plus.ac.at", project_name = "DGTX" - ) +) report_dir <- here::here( "results", "explore_data" - ) +) ``` ## SplineOmics Object @@ -328,12 +330,12 @@ splineomics <- SplineOmics::create_splineomics( meta = meta, annotation = annotation, report_info = report_info, - condition = "Phase", # Column of meta that contains the levels. - meta_batch_column = "Reactor" # For batch effect removal + condition = "Phase", # Column of meta that contains the levels. + meta_batch_column = "Reactor" # For batch effect removal ) # Special print.SplineOmics function leads to selective printing -print(splineomics) +print(splineomics) ``` Now that we have the SplineOmics object defined, we can perform our @@ -341,10 +343,9 @@ exploratory data analysis. ```{r Run EDA function, eval = FALSE} plots <- SplineOmics::explore_data( - splineomics = splineomics, # SplineOmics object + splineomics = splineomics, # SplineOmics object report_dir = report_dir - ) - +) ``` [Here](https://csbg.github.io/SplineOmics_html_reports/explore_data_PTX.html) @@ -473,77 +474,77 @@ select the optimal hyperparameters for your analysis. Below is an example for our proteomics data: ```{r Load hyperparameter-screening args, eval = TRUE} -data1 <- data +data1 <- data meta1 <- meta # Remove the "outliers" data2 <- data[, !(colnames(data) %in% c( - "E12_TP05_Exponential", + "E12_TP05_Exponential", "E10_TP10_Stationary" - ) - )] +) +)] # Adjust meta so that it matches data2 meta2 <- meta[!meta$Sample.ID %in% c( - "E12_TP05_Exponential", + "E12_TP05_Exponential", "E10_TP10_Stationary" - ), ] +), ] -# As mentioned above, all the values of one hyperparameter are stored +# As mentioned above, all the values of one hyperparameter are stored # and provided as a list. -datas <- list(data1, data2) +datas <- list(data1, data2) # This will be used to describe the versions of the data. datas_descr <- c( "full_data", "outliers_removed" - ) +) -metas <- list(meta1, meta2) +metas <- list(meta1, meta2) # Test two different limma designs designs <- c( "~ 1 + Phase*X + Reactor", "~ 1 + X + Reactor" - ) +) # 'Integrated means' limma will use the full dataset to generate the results for -# each condition. 'Isolated' means limma will use only the respective part of -# the dataset for each condition. Designs that contain the condition column +# each condition. 'Isolated' means limma will use only the respective part of +# the dataset for each condition. Designs that contain the condition column # (here Phase) must have mode 'integrated', because the full data is needed to # include the different conditions into the design formula. modes <- c( "integrated", "isolated" - ) +) # Specify the meta "level" column -condition <- "Phase" +condition <- "Phase" report_dir <- here::here( "results", "hyperparams_screen_reports" - ) +) # To remove the batch effect -meta_batch_column = "Reactor" +meta_batch_column <- "Reactor" # Test out two different p-value thresholds (inner hyperparameter) adj_pthresholds <- c( 0.05, 0.1 - ) +) # Create a dataframe with combinations of spline parameters to test # (every row a combo to test) spline_test_configs <- data.frame( - # 'n' stands for natural cubic splines, b for B-splines. - spline_type = c("n", "n", "b", "b"), + # 'n' stands for natural cubic splines, b for B-splines. + spline_type = c("n", "n", "b", "b"), # Degree is not applicable (NA) for natural splines. - degree = c(NA, NA, 2L, 4L), + degree = c(NA, NA, 2L, 4L), # Degrees of freedom (DoF) to test. # Higher dof means spline can fit more complex patterns. - dof = c(2L, 3L, 3L, 4L) + dof = c(2L, 3L, 3L, 4L) ) print(spline_test_configs) @@ -563,8 +564,7 @@ SplineOmics::screen_limma_hyperparams( spline_test_configs = spline_test_configs, report_dir = report_dir, adj_pthresholds = adj_pthresholds, - ) - +) ``` As mentioned, this function generates a report for each comparison of @@ -607,14 +607,14 @@ To generate the limma result categories 2 and 3 () ```{r Update the SplineOmics object, eval = TRUE} splineomics <- SplineOmics::update_splineomics( splineomics = splineomics, - design = "~ 1 + Phase*X + Reactor", # best design formula - mode = "integrated", # means limma uses the full data for each condition. - data = data2, # data without "outliers" was better - meta = meta2, + design = "~ 1 + Phase*X + Reactor", # best design formula + mode = "integrated", # means limma uses the full data for each condition. + data = data2, # data without "outliers" was better + meta = meta2, spline_params = list( - spline_type = c("n"), # natural cubic splines (take these if unsure) - dof = c(2L) # If you are unsure about which dof, start with 2 and increase - ) + spline_type = c("n"), # natural cubic splines (take these if unsure) + dof = c(2L) # If you are unsure about which dof, start with 2 and increase + ) ) ``` @@ -624,7 +624,7 @@ object: ```{r limma spline analysis, eval = TRUE} splineomics <- SplineOmics::run_limma_splines( splineomics = splineomics - ) +) ``` The output of the function run_limma_splines() is a named list, where @@ -655,12 +655,12 @@ generate p-value histograms an volcano plots. report_dir <- here::here( "results", "create_limma_reports" - ) +) plots <- SplineOmics::create_limma_report( splineomics = splineomics, report_dir = report_dir - ) +) ``` You can view the generated analysis report of the create_limma_report @@ -687,26 +687,26 @@ Hierarchical clustering is used to place every hit in one of as many clusters as we have specified for that specific level. ```{r cluster the hits, eval = FALSE} -adj_pthresholds <- c( # 0.05 for both levels - 0.05, # exponential - 0.05 # stationary - ) +adj_pthresholds <- c( # 0.05 for both levels + 0.05, # exponential + 0.05 # stationary +) clusters <- c( - 6L, # 6 clusters for the exponential phase level - 3L # 3 clusters for the stationary phase level - ) + 6L, # 6 clusters for the exponential phase level + 3L # 3 clusters for the stationary phase level +) report_dir <- here::here( "results", "clustering_reports" - ) +) -plot_info = list( # For the spline plots +plot_info <- list( # For the spline plots y_axis_label = "log2 intensity", - time_unit = "min", # our measurements were in minutes - treatment_labels = list("feeding"), # add this for all conditions - treatment_timepoints = list(0) # Feeding was at 0 minutes. + time_unit = "min", # our measurements were in minutes + treatment_labels = list("feeding"), # add this for all conditions + treatment_timepoints = list(0) # Feeding was at 0 minutes. ) # Like this you can add individual treatment labels to your plots: @@ -714,14 +714,14 @@ plot_info = list( # For the spline plots # exponential = "treatment 1", # One treatment in exp # stationary = c("treatment 2", "treatment 3") # Two treatments in stat # additional_condition = NA # No treatment in the hypothetical third condition -# ) -# +# ) +# # treatment_timepoints = list( # exponential = 0, # stationary = C(100, 140), # Two treatments also need two timepoints # additional_condition = NA -# ) -# +# ) +# # or set a treatment for ALL conditions (still always make a list): # # treatment_labels = list("treatment") @@ -740,10 +740,10 @@ plot_info = list( # For the spline plots gene_column_name <- "Gene_symbol" genes <- annotation[[gene_column_name]] -plot_options = list( +plot_options <- list( # When meta_replicate_column is not there, all datapoints are blue. - meta_replicate_column = "Reactor", # Colors the data points based on Reactor - cluster_heatmap_columns = FALSE # Per default FALSE, just for demonstration + meta_replicate_column = "Reactor", # Colors the data points based on Reactor + cluster_heatmap_columns = FALSE # Per default FALSE, just for demonstration ) clustering_results <- SplineOmics::cluster_hits( @@ -756,7 +756,7 @@ clustering_results <- SplineOmics::cluster_hits( report_dir = report_dir, adj_pthresh_avrg_diff_conditions = 0, adj_pthresh_interaction_condition_time = 0.25 - ) +) ``` You can view the generated analysis report of the cluster_hits function @@ -789,11 +789,12 @@ gene_set_lib <- c( "GO_Biological_Process_2018", "GO_Molecular_Function_2018", "Human_Gene_Atlas" - ) +) SplineOmics::download_enrichr_databases( gene_set_lib = gene_set_lib, - filename = "databases.tsv") + filename = "databases.tsv" +) ``` Per default the file is placed in the current working directory, which @@ -823,12 +824,12 @@ clusterProfiler_params <- list( minGSSize = 10, maxGSSize = 500, qvalueCutoff = 0.2 - ) +) report_dir <- here::here( "results", "gsea_reports" - ) +) ``` The function below runs the clusterProfiler for all clusters and all @@ -844,7 +845,7 @@ result <- SplineOmics::run_gsea( clusterProfiler_params = clusterProfiler_params, report_info = report_info, report_dir = report_dir - ) +) ``` You can view the generated analysis report of the cluster_hits function @@ -890,3 +891,9 @@ We hope that the SplineOmics package makes your scientific data analysis easier. If you face any problems (bugs in the code) or are not satisfied with the documentation, open an issue on GitHub or check out the other options under the Feedback section of the README on GitHub. Thank you! + +# Session Info + +```{r sessionInfo, echo=FALSE} +sessionInfo() +```