From cc9149bca7d6187c1bc3d1525a9e482b36a213fd Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Tue, 14 Jul 2026 17:36:58 +0200 Subject: [PATCH 01/42] cleaned up DIMS/preprocessing/average_peaks_functions.R --- DIMS/preprocessing/average_peaks_functions.R | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/DIMS/preprocessing/average_peaks_functions.R b/DIMS/preprocessing/average_peaks_functions.R index beed29b..b7ad6f6 100644 --- a/DIMS/preprocessing/average_peaks_functions.R +++ b/DIMS/preprocessing/average_peaks_functions.R @@ -1,13 +1,15 @@ +# function for averaging peak intensities for different technical replicates + +#' Average the intensity of peaks that occur in different technical replicates of a biological sample +#' +#' @param peaklist_allrepl_sorted: Dataframe with peaks sorted on median m/z (float) +#' @param sample_name: String with sample name (string) +#' +#' @return averaged_peaks: matrix of averaged peaks (float) average_peaks_per_sample <- function(peaklist_allrepl_sorted, sample_name) { - #' Average the intensity of peaks that occur in different technical replicates of a biological sample - #' - #' @param peaklist_allrepl_sorted: Dataframe with peaks sorted on median m/z (float) - #' - #' @return averaged_peaks: matrix of averaged peaks (float) - # initialize averaged_peaks <- peaklist_allrepl_sorted[0, ] - # set ppm as fixed value, not the same ppm as in peak grouping + # set ppm as fixed value, not the same ppm as in peak group annotation ppm_peak <- 2 while (nrow(peaklist_allrepl_sorted) > 1) { From da7d9e7ef24fca53c45a4575254267aca3855040 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Tue, 14 Jul 2026 17:37:28 +0200 Subject: [PATCH 02/42] cleaned up DIMS/preprocessing/collect_filled_functions.R --- DIMS/preprocessing/collect_filled_functions.R | 111 +++++++++--------- 1 file changed, 56 insertions(+), 55 deletions(-) diff --git a/DIMS/preprocessing/collect_filled_functions.R b/DIMS/preprocessing/collect_filled_functions.R index abcebbe..dbabf9b 100644 --- a/DIMS/preprocessing/collect_filled_functions.R +++ b/DIMS/preprocessing/collect_filled_functions.R @@ -1,13 +1,13 @@ -# CollectFilled functions +# functions for collecting peak groups after fill missing +#' Collapse identification info for peak groups with the same mass +#' +#' @param column_label: Name of column in peakgroup_list (string) +#' @param peakgroup_list: Peak group list (matrix) +#' @param index_dup: Index of duplicate peak group (integer) +#' +#' @return collapsed_items: Semicolon-separated list of info (string) collapse_information <- function(column_label, peakgroup_list, index_dup) { - #' Collapse identification info for peak groups with the same mass - #' - #' @param column_label: Name of column in peakgroup_list (string) - #' @param peakgroup_list: Peak group list (matrix) - #' @param index_dup: Index of duplicate peak group (integer) - #' - #' @return collapsed_items: Semicolon-separated list of info (string) # get the item(s) that need to be collapsed list_items <- as.vector(peakgroup_list[index_dup, column_label]) # remove NA @@ -18,18 +18,18 @@ collapse_information <- function(column_label, peakgroup_list, index_dup) { return(collapsed_items) } +#' Merge identification info for peak groups with the same mass +#' +#' @param peakgroup_list: Peak group list (matrix) +#' +#' @return peakgroup_list_dedup: de-duplicated peak group list (matrix) merge_duplicate_rows <- function(peakgroup_list) { - #' Merge identification info for peak groups with the same mass - #' - #' @param peakgroup_list: Peak group list (matrix) - #' - #' @return peakgroup_list_dedup: de-duplicated peak group list (matrix) - - options(digits = 16) - collect <- NULL - remove <- NULL + # initialize + dedup_peakgroups <- NULL + remove_peakgroup_indices <- NULL # check for peak groups with identical mass + peakgroup_list[, "mzmed.pgrp"] <- as.character(peakgroup_list[, "mzmed.pgrp"]) index_dup <- which(duplicated(peakgroup_list[, "mzmed.pgrp"])) while (length(index_dup) > 0) { @@ -43,35 +43,38 @@ merge_duplicate_rows <- function(peakgroup_list) { single_peakgroup[, "HMDB_code"] <- collapse_information("HMDB_code", peakgroup_list, peaklist_index) single_peakgroup[, "all_hmdb_ids"] <- collapse_information("all_hmdb_ids", peakgroup_list, peaklist_index) single_peakgroup[, "sec_hmdb_ids"] <- collapse_information("sec_hmdb_ids", peakgroup_list, peaklist_index) - if (single_peakgroup[, "sec_hmdb_ids"] == ";") single_peakgroup[, "sec_hmdb_ids"] < NA + if (single_peakgroup[, "sec_hmdb_ids"] == ";") { + single_peakgroup[, "sec_hmdb_ids"] <- NA + } # keep track of deduplicated entries - collect <- rbind(collect, single_peakgroup) - remove <- c(remove, peaklist_index) + dedup_peakgroups <- rbind(dedup_peakgroups, single_peakgroup) + remove_peakgroup_indices <- c(remove_peakgroup_indices, peaklist_index) # remove current entry from index index_dup <- index_dup[-which(peakgroup_list[index_dup, "mzmed.pgrp"] == peakgroup_list[index_dup[1], "mzmed.pgrp"])] } # remove duplicate entries - if (!is.null(remove)) { - peakgroup_list <- peakgroup_list[-remove, ] + if (!is.null(remove_peakgroup_indices)) { + peakgroup_list <- peakgroup_list[-remove_peakgroup_indices, ] } # append deduplicated entries - peakgroup_list_dedup <- rbind(peakgroup_list, collect) + peakgroup_list_dedup <- rbind(peakgroup_list, dedup_peakgroups) + peakgroup_list[, "mzmed.pgrp"] <- as.numeric(peakgroup_list[, "mzmed.pgrp"]) return(peakgroup_list_dedup) } +#' Calculate Z-scores for peak groups based on average and standard deviation of controls +#' +#' @param peakgroup_list: Peak group list (matrix) +#' +#' @return peakgroup_list_zscores: peak group list with Z-scores (matrix) calculate_zscores_peakgrouplist <- function(peakgroup_list) { - #' Calculate Z-scores for peak groups based on average and standard deviation of controls - #' - #' @param peakgroup_list: Peak group list (matrix) - #' - #' @return peakgroup_list_dedup: de-duplicated peak group list (matrix) - + # define case and control labels (fixed) case_label <- "P" control_label <- "C" - # get index for new column names + # get index for new columns startcol <- ncol(peakgroup_list) + 3 # calculate mean and standard deviation for Control group ctrl_cols <- grep(control_label, colnames(peakgroup_list), fixed = TRUE) @@ -84,49 +87,48 @@ calculate_zscores_peakgrouplist <- function(peakgroup_list) { peakgroup_list$sd.ctrls <- apply(ctrl_ints, 1, function(x) sd(as.numeric(x), na.rm = TRUE)) # set new column names and calculate Z-scores - colnames_zscores <- NULL + peakgroup_list_zscores <-peakgroup_list + colnames_zscores <- paste0(colnames(peakgroup_list[int_cols], "_Zscore") for (col_index in int_cols) { - col_name <- colnames(peakgroup_list)[col_index] - colnames_zscores <- c(colnames_zscores, paste0(col_name, "_Zscore")) zscores_1col <- (as.numeric(as.vector(unlist(peakgroup_list[, col_index]))) - peakgroup_list$avg.ctrls) / peakgroup_list$sd.ctrls - peakgroup_list <- cbind(peakgroup_list, zscores_1col) + peakgroup_list_zscores <- cbind(peakgroup_list_zscores, zscores_1col) } # apply new column names to columns at end plus avg and sd columns - colnames(peakgroup_list)[startcol:ncol(peakgroup_list)] <- colnames_zscores + colnames(peakgroup_list_zscores)[startcol:ncol(peakgroup_list)] <- colnames_zscores - return(peakgroup_list) + return(peakgroup_list_zscores) } +#' Calculate ppm deviation between observed mass and expected theoretical mass +#' +#' @param peakgroup_list: Peak group list (matrix) +#' +#' @return peakgroup_list_ppm: peak group list with ppm column (matrix) calculate_ppm_deviation <- function(peakgroup_list) { - #' Calculate ppm deviation between observed mass and expected theoretical mass - #' - #' @param peakgroup_list: Peak group list (matrix) - #' - #' @return peakgroup_list_ppm: peak group list with ppm column (matrix) - # make sure values in columns mzmed.pgrp and theormz_HMDB are numeric peakgroup_list$mzmed.pgrp <- as.numeric(peakgroup_list$mzmed.pgrp) peakgroup_list$theormz_HMDB <- as.numeric(peakgroup_list$theormz_HMDB) # calculate ppm deviation - for (row_index in seq_len(nrow(peakgroup_list))) { - observed_mz <- peakgroup_list$mzmed.pgrp[row_index] - theor_mz <- peakgroup_list$theormz_HMDB[row_index] - peakgroup_list$ppmdev[row_index] <- 10^6 * (observed_mz - theor_mz) / theor_mz + peakgroup_list_ppm <- peakgroup_list + for (row_index in seq_len(nrow(peakgroup_list_ppm))) { + observed_mz <- peakgroup_list_ppm$mzmed.pgrp[row_index] + theor_mz <- peakgroup_list_ppm$theormz_HMDB[row_index] + peakgroup_list_ppm$ppmdev[row_index] <- 10^6 * (observed_mz - theor_mz) / theor_mz } - return(peakgroup_list) + return(peakgroup_list_ppm) } +#' Put columns in peak group list in correct order +#' +#' @param peakgroup_list: Peak group list (matrix) +#' +#' @return peakgroup_ordered: peak group list with columns in correct order (matrix) order_columns_peakgrouplist <- function(peakgroup_list) { - #' Put columns in peak group list in correct order - #' - #' @param peakgroup_list: Peak group list (matrix) - #' - #' @return peakgroup_ordered: peak group list with columns in correct order (matrix) - + # retain original column names original_colnames <- colnames(peakgroup_list) mass_columns <- c(grep("mzm", original_colnames), grep("nrsamples", original_colnames)) if (any(grepl("avg.int", original_colnames))) { @@ -140,7 +142,6 @@ order_columns_peakgrouplist <- function(peakgroup_list) { zscore_columns <- grep("_Zscore", original_colnames) # create peak group list with columns in correct order peakgroup_ordered <- peakgroup_list[ , c(mass_columns, descriptive_columns, intensity_columns, control_columns, zscore_columns)] - + return(peakgroup_ordered) } - From 19fb510b5e889aaaab2507481d4923541493ed15 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Tue, 14 Jul 2026 17:37:49 +0200 Subject: [PATCH 03/42] cleaned up DIMS/preprocessing/collect_sum_adducts_functions.R --- .../collect_sum_adducts_functions.R | 41 ++++++++++--------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/DIMS/preprocessing/collect_sum_adducts_functions.R b/DIMS/preprocessing/collect_sum_adducts_functions.R index a65e3f7..45e3031 100644 --- a/DIMS/preprocessing/collect_sum_adducts_functions.R +++ b/DIMS/preprocessing/collect_sum_adducts_functions.R @@ -1,37 +1,38 @@ +# functions for combining sum adducts + +#' Combine all AdductSum parts in 1 dataframe +#' +#' @param scanmode: string with the scan mode, either "positive" or "negative" +#' +#' @returns: adductsums_all: dataframe with all adducts for one scan mode combine_sum_adduct_parts <- function(scanmode) { - #' Combine all AdductSum parts in 1 dataframe - #' - #' @param scanmode: string with the scanmodus, either positive or negative - #' - #' @returns: outlist_tot: dataframe with all adducts for one scanmodus adductsum_part_files <- list.files("./", pattern = scanmode) - outlist_tot <- NULL + adductsums_all <- NULL for (i in seq_along(adductsum_part_files)) { load(adductsum_part_files[i]) - outlist_tot <- rbind(outlist_tot, adductsum) + adductsums_all <- rbind(adductsums_all, adductsum) } - return(outlist_tot) + return(adductsums_all) } +#' Combine the scan modes; add intensities if both scan modes are present +#' +#' @param outlist_pos_adducts_hmdb: intensities for adducts in the positive scan mode (data frame) +#' @param outlist_neg_adducts_hmdb: intensities for adducts in the negative scan mode (data frame) +#' +#' @returns: outlist: dataframe with intensities for all metabolites present in either or both scanmodes combine_scanmodes_intensities <- function(outlist_pos_adducts_hmdb, outlist_neg_adducts_hmdb) { - #' Combine the scanmodes and when present in both scanmodes add intensities - #' - #' @param outlist_pos_adducts_hmdb: dataframe with adducts for the positive scanmodus - #' @param outlist_neg_adducts_hmdb: dataframe with adducts for the positive scanmodus - #' - #' @returns: outlist: dataframe with intensities for all metabolites present in either or both scanmodes - - # Only continue with patients (columns) that are in both pos and neg, so patients that are in both + # Only continue with samples (columns) that are in both pos and neg samples_both_modes <- intersect(colnames(outlist_neg_adducts_hmdb), colnames(outlist_pos_adducts_hmdb)) outlist_neg_adducts_hmdb <- outlist_neg_adducts_hmdb[, samples_both_modes] outlist_pos_adducts_hmdb <- outlist_pos_adducts_hmdb[, samples_both_modes] - # Find indexes of neg hmdb code that are also found in pos and vice versa + # Find indices of metabolites in neg that are also found in pos and vice versa index_neg <- which(rownames(outlist_neg_adducts_hmdb) %in% rownames(outlist_pos_adducts_hmdb)) index_pos <- which(rownames(outlist_pos_adducts_hmdb) %in% rownames(outlist_neg_adducts_hmdb)) - # Get intensities of metabs present in both modes from pos modus + # Get intensities of metabs present in both modes from pos mode outlist_combi_pos_ints <- outlist_pos_adducts_hmdb[rownames(outlist_pos_adducts_hmdb)[index_pos], ] %>% select(-c(HMDB_name, HMDB_name_all, HMDB_ID_all, sec_HMDB_ID)) # Get intensities of metabs present in both modes from neg modus @@ -40,12 +41,12 @@ combine_scanmodes_intensities <- function(outlist_pos_adducts_hmdb, outlist_neg_ # HMDB info for metabs present in both modes outlist_combi_info <- outlist_pos_adducts_hmdb[rownames(outlist_pos_adducts_hmdb)[index_pos], ] %>% select(HMDB_name, HMDB_name_all, HMDB_ID_all, sec_HMDB_ID) - # Combine positive and negative numbers and paste back HMDB column + # Sum positive and negative intensities and put back HMDB columns outlist_combi_ints <- apply(outlist_combi_pos_ints, 2, as.numeric) + apply(outlist_combi_neg_ints, 2, as.numeric) rownames(outlist_combi_ints) <- rownames(outlist_combi_pos_ints) outlist_combi <- cbind(outlist_combi_ints, outlist_combi_info) - # Get outlist with metabs in either pos or neg + # Get remaining metabolites which are not present in both scan modes outlist_pos <- outlist_pos_adducts_hmdb[-index_pos, ] outlist_neg <- outlist_neg_adducts_hmdb[-index_neg, ] From 276883f8b3d63d3ddb04a60b6b7b8c324d3df947 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 16 Jul 2026 17:19:49 +0200 Subject: [PATCH 04/42] cleaned up DIMS/preprocessing/evaluate_tics_functions.R --- DIMS/preprocessing/evaluate_tics_functions.R | 46 ++++++++++---------- 1 file changed, 22 insertions(+), 24 deletions(-) diff --git a/DIMS/preprocessing/evaluate_tics_functions.R b/DIMS/preprocessing/evaluate_tics_functions.R index 8cb782e..08b01d8 100644 --- a/DIMS/preprocessing/evaluate_tics_functions.R +++ b/DIMS/preprocessing/evaluate_tics_functions.R @@ -1,12 +1,13 @@ # EvaluateTics functions + +#' Find technical replicates with a total intensity below a threshold +#' +#' @param repl_pattern: List of samples with corresponding technical replicates (strings) +#' @param thresh2remove: Threshold value for acceptance or rejection of total intensity (integer) +#' +#' @return remove_tech_reps: Array of rejected technical replicates (strings) find_bad_replicates <- function(repl_pattern, thresh2remove) { - #' Find technical replicates with a total intensity below a threshold - #' - #' @param repl_pattern: List of samples with corresponding technical replicates (strings) - #' @param thresh2remove: Threshold value for acceptance or rejection of total intensity (integer) - #' - #' @return remove_tech_reps: Array of rejected technical replicates (strings) - + # initialize remove_pos <- NULL remove_neg <- NULL cat("Pklist sum threshold to remove technical replicate:", thresh2remove, "\n") @@ -49,21 +50,20 @@ find_bad_replicates <- function(repl_pattern, thresh2remove) { col.names = FALSE, sep = "\t" ) - + # combine removed technical replicates from pos and neg remove_tech_reps <- list(pos = remove_pos, neg = remove_neg) return(remove_tech_reps) } +#' Remove technical replicates with insufficient quality from a biological sample +#' +#' @param bad_samples: Array of technical replicates of insufficient quality (strings) +#' @param repl_pattern: List of samples with corresponding technical replicates (strings) +#' @param nr_replicates: Number of technical replicates per biological sample (integer) +#' +#' @return repl_pattern_filtered: list of technical replicates of sufficient quality (strings) remove_from_repl_pattern <- function(bad_samples, repl_pattern, nr_replicates) { - #' Remove technical replicates with insufficient quality from a biological sample - #' - #' @param bad_samples: Array of technical replicates of insufficient quality (strings) - #' @param repl_pattern: List of samples with corresponding technical replicates (strings) - #' @param nr_replicates: Number of technical replicates per biological sample (integer) - #' - #' @return repl_pattern_filtered: list of technical replicates of sufficient quality (strings) - # collect list of samples to remove from replication pattern remove_from_group <- NULL for (sample_nr in 1:length(repl_pattern)){ @@ -89,14 +89,13 @@ remove_from_repl_pattern <- function(bad_samples, repl_pattern, nr_replicates) { return(repl_pattern_filtered) } +#' Create an overview of technical replicates with sufficient quality from a biological sample +#' +#' @param repl_pattern_filtered: List of samples with corresponding technical replicates (strings) +#' @param scanmode: Scan mode "positive" or "negative" (string) +#' +#' @return allsamples_techreps_scanmode: Matrix of technical replicates of sufficient quality (strings) get_overview_tech_reps <- function(repl_pattern_filtered, scanmode) { - #' Create an overview of technical replicates with sufficient quality from a biological sample - #' - #' @param repl_pattern_filtered: List of samples with corresponding technical replicates (strings) - #' @param scanmode: Scan mode "positive" or "negative" (string) - #' - #' @return allsamples_techreps_scanmode: Matrix of technical replicates of sufficient quality (strings) - allsamples_techreps_scanmode <- matrix("", ncol = 3, nrow = length(repl_pattern_filtered)) for (sample_nr in 1:length(repl_pattern_filtered)) { allsamples_techreps_scanmode[sample_nr, 1] <- names(repl_pattern_filtered)[sample_nr] @@ -105,4 +104,3 @@ get_overview_tech_reps <- function(repl_pattern_filtered, scanmode) { allsamples_techreps_scanmode[, 3] <- scanmode return(allsamples_techreps_scanmode) } - From 8f6747e7ac392b02655e9f63c696f845bbe766a6 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 16 Jul 2026 17:20:14 +0200 Subject: [PATCH 05/42] cleaned up DIMS/preprocessing/fill_missing_functions.R --- DIMS/preprocessing/fill_missing_functions.R | 23 +++++++++++---------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/DIMS/preprocessing/fill_missing_functions.R b/DIMS/preprocessing/fill_missing_functions.R index b55bc02..12f0ff1 100644 --- a/DIMS/preprocessing/fill_missing_functions.R +++ b/DIMS/preprocessing/fill_missing_functions.R @@ -1,13 +1,14 @@ -fill_missing_intensities <- function(peakgroup_list, repl_pattern, thresh, disable_randomness = FALSE) { - #' Replace intensities that are zero with random value - #' - #' @param peakgroup_list: Peak groups (matrix) - #' @param repl_pattern: Replication pattern (list of strings) - #' @param thresh: Value for threshold between noise and signal (integer) - #' @param thresh: Variable which indicates whether randomness should be disabled (boolean) - #' - #' @return final_outlist: peak groups with filled-in intensities (matrix) +# function for fill missing (zero) intensities with random noise +#' Replace intensities that are zero with random value +#' +#' @param peakgroup_list: Peak groups with zero intensities (matrix) +#' @param repl_pattern: Replication pattern (list of strings) +#' @param thresh: Value for threshold between noise and signal (integer) +#' @param disable_randomness: Variable which indicates whether randomness should be disabled (boolean) +#' +#' @return final_outlist: peak groups with filled-in intensities (matrix) +fill_missing_intensities <- function(peakgroup_list, repl_pattern, thresh, disable_randomness = FALSE) { # for unit test, turn off randomness if (disable_randomness) { set.seed(123) @@ -30,8 +31,8 @@ fill_missing_intensities <- function(peakgroup_list, repl_pattern, thresh, disab # Add column with average intensity; find intensity columns first int_cols <- which(colnames(peakgroup_list) %in% names(repl_pattern)) - peakgroup_list <- cbind(peakgroup_list, "avg.int" = apply(peakgroup_list[, int_cols], 1, mean)) + final_outlist <- cbind(peakgroup_list, "avg.int" = apply(peakgroup_list[, int_cols], 1, mean)) - return(peakgroup_list) + return(final_outlist) } } From f49be53fc6a8bd6f6fdad7286d482ee1f06fc117 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 16 Jul 2026 17:20:41 +0200 Subject: [PATCH 06/42] cleaned up DIMS/preprocessing/peak_finding_functions.R --- DIMS/preprocessing/peak_finding_functions.R | 81 +++++++++------------ 1 file changed, 35 insertions(+), 46 deletions(-) diff --git a/DIMS/preprocessing/peak_finding_functions.R b/DIMS/preprocessing/peak_finding_functions.R index 30d1699..84469b2 100644 --- a/DIMS/preprocessing/peak_finding_functions.R +++ b/DIMS/preprocessing/peak_finding_functions.R @@ -1,15 +1,15 @@ # functions for peak finding +# NB: add package R.utils to docker image, remove seqToIntervals function from this file +# replace seqToIntervals to R.utils::seqToIntervals in function search_regions_of_interest +#' Divide the full m/z range into regions of interest with indices +#' +#' @param ints_fullrange: Matrix with m/z values and intensities (float) +#' +#' @return regions_of_interest: matrix of m/z regions of interest (integer) search_regions_of_interest <- function(ints_fullrange) { - #' Divide the full m/z range into regions of interest with indices - #' - #' @param ints_fullrange: Matrix with m/z values and intensities (float) - #' - #' @return regions_of_interest: matrix of m/z regions of interest (integer) - # find indices where intensity is not equal to zero nonzero_positions <- as.vector(which(ints_fullrange$int != 0)) - # find regions of interest (look for consecutive numbers) regions_of_interest_consec <- seqToIntervals(nonzero_positions) # add length of regions of interest @@ -75,24 +75,23 @@ search_regions_of_interest <- function(ints_fullrange) { # sort on first index if (nrow(regions_of_interest_final) > 1){ - regions_of_interest_sorted <- regions_of_interest_final %>% as.data.frame %>% dplyr::arrange(from) + regions_of_interest <- regions_of_interest_final %>% as.data.frame %>% dplyr::arrange(from) } else { - regions_of_interest_sorted <- regions_of_interest_final + regions_of_interest <- regions_of_interest_final } - return(regions_of_interest_sorted) + return(regions_of_interest) } +#' Fit Gaussian peak for each region of interest and integrate area under the curve +#' +#' @param ints_fullrange: Named list of intensities (float) +#' @param regions_of_interest: Named list of intensities (float) +#' @param resol: Value for resolution (integer) +#' @param peak_thresh: Value for noise level threshold (integer) # NOT USED YET +#' +#' @return allpeaks_values: matrix of integrated peaks integrate_peaks <- function(ints_fullrange, regions_of_interest, resol, peak_thresh) { - #' Fit Gaussian peak for each region of interest and integrate area under the curve - #' - #' @param ints_fullrange: Named list of intensities (float) - #' @param regions_of_interest: Named list of intensities (float) - #' @param resol: Value for resolution (integer) - #' @param peak_thresh: Value for noise level threshold (integer) # NOT USED YET - #' - #' @return allpeaks_values: matrix of integrated peaks - # initialize dataframe to store results for all peaks allpeaks_values <- matrix(0, nrow = nrow(regions_of_interest), ncol = 5) colnames(allpeaks_values) <- c("mzmed.pkt", "fq", "mzmin.pkt", "mzmax.pkt", "height.pkt") @@ -191,14 +190,13 @@ seqToIntervals <- function(idx) { return(res) } +#' Calculate fwhm (full width at half maximum intensity) for a peak +#' +#' @param query_mass: Value for mass (float) +#' @param resol: Value for resolution (integer) +#' +#' @return fwhm: Value for full width at half maximum (float) get_fwhm <- function(query_mass, resol) { - #' Calculate fwhm (full width at half maximum intensity) for a peak - #' - #' @param query_mass: Value for mass (float) - #' @param resol: Value for resolution (integer) - #' - #' @return fwhm: Value for full width at half maximum (float) - # set aberrant values of query_mass to default value of 200 if (is.na(query_mass)) { query_mass <- 200 @@ -214,25 +212,16 @@ get_fwhm <- function(query_mass, resol) { return(fwhm) } - -# from https://rdrr.io/cran/rvmethod/src/R/gaussfit.R -#' Gaussian Function from package rvmethod +#' Gaussian function based on stats::dnorm +#' Calculate area under the Gaussian curve +#' +#' @param mz_range: Vector of values at which to evaluate the Gaussian (vector) +#' @param mu: center of the Gaussian peak (float) +#' @param sigma: Spread of the Gaussian peak (float) #' -#' This function returns the unnormalized (height of 1.0) Gaussian curve with a -#' given center and spread. -#' -#' @param x the vector of values at which to evaluate the Gaussian -#' @param mu the center of the Gaussian -#' @param sigma the spread of the Gaussian (must be greater than 0) -#' @return vector of values of the Gaussian -#' @examples x = seq(-4, 4, length.out = 100) -#' y = gaussfunc(x, 0, 1) -#' plot(x, y) -#' -#' @import stats -#' -#' @export -gaussfunc <- function(x, mu, sigma) { - return(exp(-((x - mu) ^ 2) / (2 * (sigma ^ 2)))) -} +#' @return calc_area: integrated area under the Gaussian curve (float) +gaussfunc <- function(mz_range, mu, sigma) { + calc_area <- stats::dnorm(mz_range, mu, sigma) / stats::dnorm(mu, mu, sigma) + return(calc_area) +} From 79245577d6edfaea37d062ae88cb457c5d52423c Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 16 Jul 2026 17:21:05 +0200 Subject: [PATCH 07/42] cleaned up DIMS/preprocessing/peak_grouping_functions.R --- DIMS/preprocessing/peak_grouping_functions.R | 45 +++++++++----------- 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/DIMS/preprocessing/peak_grouping_functions.R b/DIMS/preprocessing/peak_grouping_functions.R index 93ff96f..9251f6c 100644 --- a/DIMS/preprocessing/peak_grouping_functions.R +++ b/DIMS/preprocessing/peak_grouping_functions.R @@ -1,13 +1,13 @@ -# functions for PeakGrouping -find_peak_groups <- function(outlist_sorted, mz_tolerance, sample_names) { - #' find peaks in all samples with query m/z values and form peak groups - #' - #' @param outlist_sorted: matrix of peaks (mzmed, intensity) in all samples - #' @param mz_tolerance: Value for mass tolerance around query m/z (float) - #' @param sample_names: vector of sample names (vector of strings) - #' - #' @return ints_sorted: matrix of peak groups +# functions for generating peak groups and annotating them +#' find peaks in all samples with query m/z values and form peak groups +#' +#' @param outlist_sorted: matrix of peaks (mzmed, intensity) in all samples +#' @param mz_tolerance: Value for mass tolerance around query m/z (float) +#' @param sample_names: vector of sample names (vector of strings) +#' +#' @return ints_sorted: matrix of peak groups +find_peak_groups <- function(outlist_sorted, mz_tolerance, sample_names) { # set up object for intensities for all samples ints_allsamps <- matrix(0, nrow = nrow(outlist_sorted), ncol = 3 + (length(sample_names))) colnames(ints_allsamps) <- c("mzmed.pgrp", "mzmin.pgrp", "mzmax.pgrp", sample_names) @@ -63,16 +63,15 @@ find_peak_groups <- function(outlist_sorted, mz_tolerance, sample_names) { return(ints_sorted) } +#' annotate peak groups; assign metabolites (adducts, isotopes) with suitable mass from HMDB +#' +#' @param ints_sorted: matrix of peak groups +#' @param hmdb_add_iso: subset of HMDB (matrix) +#' @param column_label: column name with appropriate m/z values for scan mode (string) +#' @param mz_tolerance: Value for mass tolerance around query m/z (float) +#' +#' @return peakgrouplist_identified: matrix of peak groups with annotation annotate_peak_groups <- function(ints_sorted, hmdb_add_iso, column_label, mz_tolerance) { - #' annotate peak groups; assign metabolites (adducts, isotopes) with suitable mass from HMDB - #' - #' @param ints_sorted: matrix of peak groups - #' @param hmdb_add_iso: subset of HMDB (matrix) - #' @param column_label: column name with appropriate m/z values for scan mode (string) - #' @param mz_tolerance: Value for mass tolerance around query m/z (float) - #' - #' @return peakgrouplist_identified: matrix of peak groups with annotation - # Initialize matrix for annotation assigned_hmdb <- matrix("", nrow = nrow(ints_sorted), ncol = 7) colnames(assigned_hmdb) <- c("assi_HMDB", "all_hmdb_names", "iso_HMDB", "HMDB_code", @@ -80,7 +79,7 @@ annotate_peak_groups <- function(ints_sorted, hmdb_add_iso, column_label, mz_tol # make sure isotope entries in the hmdb part have no HMDB IDs in the HMDB_ID_all column hmdb_add_iso[grep("iso", rownames(hmdb_add_iso)), "HMDB_ID_all"] <- "" - + # for each peak group, find all entries in HMDB part with mass within ppm range for (row_number in 1:nrow(ints_sorted)) { # initialize to make sure there's no information from the previous peak group @@ -99,14 +98,12 @@ annotate_peak_groups <- function(ints_sorted, hmdb_add_iso, column_label, mz_tol reference_mass <- ints_sorted[row_number, "mzmed.pgrp"] # select indices for all HMDB entries with mass between +/- ppm tolerance select_from_hmdb <- which(hmdb_add_iso[, column_label] > (reference_mass - mz_tolerance) & - hmdb_add_iso[, column_label] < (reference_mass + mz_tolerance)) + hmdb_add_iso[, column_label] < (reference_mass + mz_tolerance)) if (length(select_from_hmdb) > 0) { # get dataframe of all entries which are selected select_hmdb_df <- hmdb_add_iso[select_from_hmdb, ] # separate into main metabolites, metabolites with adducts and isotopes # main metabolites have no "_" in their name - # if there are rownames with "_", choose only those without "_" - # check if any rownames contain a hmdb code without "_" if (any(!grepl("_", rownames(select_hmdb_df)))) { grep_noiso_noadduct <- which(!grepl("_", rownames(select_hmdb_df))) } else { @@ -161,8 +158,8 @@ annotate_peak_groups <- function(ints_sorted, hmdb_add_iso, column_label, mz_tol peakgrouplist_identified[, "theormz_HMDB"] <- as.numeric(peakgrouplist_identified[, "theormz_HMDB"]) peakgrouplist_identified[, "mzmed.pgrp"] <- as.numeric(peakgrouplist_identified[, "mzmed.pgrp"]) peakgrouplist_identified[, "ppmdev"] <- 1000000 * (peakgrouplist_identified[, "mzmed.pgrp"] - - peakgrouplist_identified[, "theormz_HMDB"]) / - peakgrouplist_identified[, "theormz_HMDB"] + peakgrouplist_identified[, "theormz_HMDB"]) / + peakgrouplist_identified[, "theormz_HMDB"] return(peakgrouplist_identified) } From c9b7f56d2a78e916381f110985b8149f5b137ee5 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 16 Jul 2026 17:21:27 +0200 Subject: [PATCH 08/42] cleaned up DIMS/preprocessing/sum_intensities_adducts.R --- DIMS/preprocessing/sum_intensities_adducts.R | 21 ++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/DIMS/preprocessing/sum_intensities_adducts.R b/DIMS/preprocessing/sum_intensities_adducts.R index 30c9cdc..4217b36 100644 --- a/DIMS/preprocessing/sum_intensities_adducts.R +++ b/DIMS/preprocessing/sum_intensities_adducts.R @@ -1,12 +1,14 @@ +# functions for summing intensities from different adducts of the same metabolite + +#' Sum intensities for different adducts of the same metabolite +#' +#' @param peakgroup_list: Peak group list (matrix) +#' @param hmdb_part: Matrix of metabolites , part of the HMDB (matrix) +#' @param adducts: Vector of adducts (vector of integers) +#' @param z_score: Value indicating whether Z-scores have been calculated (integer) +#' +#' @return adductsum: peak group list with summed intensities (matrix) sum_intensities_adducts <- function(peakgroup_list, hmdb_part, adducts, z_score) { - #' Sum intensities for different adducts of the same metabolite - #' - #' @param peakgroup_list: Peak group list (matrix) - #' @param hmdb_part: Matrix of metabolites , part of the HMDB (matrix) - #' @param adducts: Vector of adducts (vector of integers) - #' @param z_score: Value indicating whether Z-scores have been calculated (integer) - #' - #' @return adductsum: peak group list with summed intensities (matrix) hmdb_part_info <- cbind(HMDB_id = rownames(hmdb_part), CompoundName = hmdb_part[, "CompoundName"]) # create overview of row indices for each metabolite_adduct combination in peaklist @@ -15,7 +17,7 @@ sum_intensities_adducts <- function(peakgroup_list, hmdb_part, adducts, z_score) # avoid rows with only "" in HMDB_code column hmdb_in_peaklist[which(hmdb_in_peaklist == "")] <- ";" hmdb_in_peaklist_rownr <- c() - + # create dataframe with for each HMDB id a row number hmdb_in_peaklist_rownr <- data.frame( row_id = rep(seq_along(hmdb_in_peaklist), lengths(hmdb_in_peaklist)), @@ -78,4 +80,3 @@ sum_intensities_adducts <- function(peakgroup_list, hmdb_part, adducts, z_score) return(adductsum) } - From ef734aec7c83bdc3cfedb06417e47eb5149af447 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Mon, 20 Jul 2026 10:43:17 +0200 Subject: [PATCH 09/42] missing parenthesis in DIMS/preprocessing/collect_filled_functions.R --- DIMS/preprocessing/collect_filled_functions.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DIMS/preprocessing/collect_filled_functions.R b/DIMS/preprocessing/collect_filled_functions.R index dbabf9b..02ab519 100644 --- a/DIMS/preprocessing/collect_filled_functions.R +++ b/DIMS/preprocessing/collect_filled_functions.R @@ -88,7 +88,7 @@ calculate_zscores_peakgrouplist <- function(peakgroup_list) { # set new column names and calculate Z-scores peakgroup_list_zscores <-peakgroup_list - colnames_zscores <- paste0(colnames(peakgroup_list[int_cols], "_Zscore") + colnames_zscores <- paste0(colnames(peakgroup_list)[int_cols], "_Zscore") for (col_index in int_cols) { zscores_1col <- (as.numeric(as.vector(unlist(peakgroup_list[, col_index]))) - peakgroup_list$avg.ctrls) / peakgroup_list$sd.ctrls From 9e65f57647bbc87d3568d0f151229d5a9476a8e1 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Mon, 20 Jul 2026 10:50:44 +0200 Subject: [PATCH 10/42] remove obsolete Utils folder and R scripts inside --- DIMS/Utils/RawFiles.nf | 12 - DIMS/Utils/add_lab_id_and_onderzoeksnummer.R | 16 - DIMS/Utils/atomic_info.R | 92 ----- DIMS/Utils/calculate_zscores.R | 63 --- DIMS/Utils/check_overlap.R | 24 -- DIMS/Utils/check_same_samplename.R | 10 - DIMS/Utils/create_violin_plots.R | 122 ------ DIMS/Utils/do_peakfinding.R | 55 --- DIMS/Utils/estimate_area.R | 23 -- DIMS/Utils/fit_gaussian.R | 319 ---------------- DIMS/Utils/fit_gaussians.R | 196 ---------- DIMS/Utils/fit_init.R | 47 --- DIMS/Utils/fit_optim.R | 47 --- DIMS/Utils/fit_peaks.R | 381 ------------------- DIMS/Utils/get_element_info.R | 24 -- DIMS/Utils/get_fit_quality.R | 34 -- DIMS/Utils/get_fwhm.R | 21 - DIMS/Utils/get_patient_data_to_helix.R | 39 -- DIMS/Utils/get_stdev.R | 22 -- DIMS/Utils/identify_noisepeaks.R | 103 ----- DIMS/Utils/is_diagnostic_patient.R | 11 - DIMS/Utils/merge_duplicate_rows.R | 58 --- DIMS/Utils/optimize_gaussfit.R | 23 -- DIMS/Utils/output_helix.R | 39 -- DIMS/Utils/prepare_alarmvalues.R | 59 --- DIMS/Utils/prepare_data.R | 51 --- DIMS/Utils/prepare_data_perpage.R | 58 --- DIMS/Utils/prepare_toplist.R | 35 -- DIMS/Utils/replace_zeros.R | 64 ---- DIMS/Utils/search_mzrange.R | 180 --------- DIMS/Utils/sum_curves.R | 35 -- DIMS/Utils/sum_intensities_adducts.R | 76 ---- DIMS/Utils/within_ppm.R | 64 ---- 33 files changed, 2403 deletions(-) delete mode 100644 DIMS/Utils/RawFiles.nf delete mode 100644 DIMS/Utils/add_lab_id_and_onderzoeksnummer.R delete mode 100644 DIMS/Utils/atomic_info.R delete mode 100644 DIMS/Utils/calculate_zscores.R delete mode 100644 DIMS/Utils/check_overlap.R delete mode 100644 DIMS/Utils/check_same_samplename.R delete mode 100644 DIMS/Utils/create_violin_plots.R delete mode 100644 DIMS/Utils/do_peakfinding.R delete mode 100644 DIMS/Utils/estimate_area.R delete mode 100644 DIMS/Utils/fit_gaussian.R delete mode 100644 DIMS/Utils/fit_gaussians.R delete mode 100644 DIMS/Utils/fit_init.R delete mode 100644 DIMS/Utils/fit_optim.R delete mode 100644 DIMS/Utils/fit_peaks.R delete mode 100644 DIMS/Utils/get_element_info.R delete mode 100644 DIMS/Utils/get_fit_quality.R delete mode 100644 DIMS/Utils/get_fwhm.R delete mode 100644 DIMS/Utils/get_patient_data_to_helix.R delete mode 100644 DIMS/Utils/get_stdev.R delete mode 100644 DIMS/Utils/identify_noisepeaks.R delete mode 100644 DIMS/Utils/is_diagnostic_patient.R delete mode 100644 DIMS/Utils/merge_duplicate_rows.R delete mode 100644 DIMS/Utils/optimize_gaussfit.R delete mode 100644 DIMS/Utils/output_helix.R delete mode 100644 DIMS/Utils/prepare_alarmvalues.R delete mode 100644 DIMS/Utils/prepare_data.R delete mode 100644 DIMS/Utils/prepare_data_perpage.R delete mode 100644 DIMS/Utils/prepare_toplist.R delete mode 100644 DIMS/Utils/replace_zeros.R delete mode 100644 DIMS/Utils/search_mzrange.R delete mode 100644 DIMS/Utils/sum_curves.R delete mode 100644 DIMS/Utils/sum_intensities_adducts.R delete mode 100644 DIMS/Utils/within_ppm.R diff --git a/DIMS/Utils/RawFiles.nf b/DIMS/Utils/RawFiles.nf deleted file mode 100644 index 8cc0efe..0000000 --- a/DIMS/Utils/RawFiles.nf +++ /dev/null @@ -1,12 +0,0 @@ -def extractRawfilesFromDir(dir) { - // Original code from: https://github.com/SciLifeLab/Sarek - MIT License - Copyright (c) 2016 SciLifeLab - dir = dir.tokenize().collect{"$it/*.raw"} - Channel - .fromPath(dir, type:'file') - .ifEmpty { error "No raw files found in ${dir}." } - .map { rawfiles_path -> - def file_id = rawfiles_path.getSimpleName() - [file_id, rawfiles_path] - } -} - diff --git a/DIMS/Utils/add_lab_id_and_onderzoeksnummer.R b/DIMS/Utils/add_lab_id_and_onderzoeksnummer.R deleted file mode 100644 index f2ff13e..0000000 --- a/DIMS/Utils/add_lab_id_and_onderzoeksnummer.R +++ /dev/null @@ -1,16 +0,0 @@ -add_lab_id_and_onderzoeksnummer <- function(df_metabs_helix) { - #' Adding labnummer and Onderzoeksnummer to a dataframe - #' - #' @param df_metabs_helix: dataframe with patient data to be uploaded to Helix - #' - #' @return: dataframe with added labnummer and Onderzoeksnummer columns - - # Split patient number into labnummer and Onderzoeksnummer - for (row in 1:nrow(df_metabs_helix)) { - df_metabs_helix[row, "labnummer"] <- gsub("^P|\\.[0-9]*", "", df_metabs_helix[row, "Patient"]) - labnummer_split <- strsplit(as.character(df_metabs_helix[row, "labnummer"]), "M")[[1]] - df_metabs_helix[row, "Onderzoeksnummer"] <- paste0("MB", labnummer_split[1], "/", labnummer_split[2]) - } - - return(df_metabs_helix) -} diff --git a/DIMS/Utils/atomic_info.R b/DIMS/Utils/atomic_info.R deleted file mode 100644 index 94d0e83..0000000 --- a/DIMS/Utils/atomic_info.R +++ /dev/null @@ -1,92 +0,0 @@ -## adapted from globalAssignments.HPC.R -# relative abundancies from theoretical mass and composition -# not a function, but a large amount of objects that will become available in memory -# refactor: include in get_element_info -# check if all these elements are necessary. Only use snake_make for Hmass -> hydrogen_mass. -# move source library to higher level -options(digits = 16) - -suppressPackageStartupMessages(library(lattice)) - -# The following list was copied from Rdisop elements.R and corrected for C, H, O, Cl, S according to NIST -Ba <- list(name = "Ba", mass = 130, isotope = list(mass = c(-0.093718, 0, -0.094958, 0, -0.095514, -0.094335, -0.095447, -0.094188, -0.094768), abundance = c(0.00106, 0, 0.00101, 0, 0.02417, 0.06592, 0.07854, 0.1123, 0.717))) -Br <- list(name = "Br", mass = 79, isotope = list(mass = c(-0.0816639, 0, -0.083711), abundance = c(0.5069, 0, 0.4931))) -C <- list(name = "C", mass = 12, isotope = list(mass = c(0, 0.003354838, 0.003241989), abundance = c(0.9893, 0.0107, 0))) -Ca <- list(name = "Ca", mass = 40, isotope = list(mass = c(-0.0374094, 0, -0.0413824, -0.0412338, -0.0445194, 0, -0.046311, 0, -0.047467), abundance = c(0.96941, 0, 0.00647, 0.00135, 0.02086, 0, 4e-05, 0, 0.00187))) -Cl <- list(name = "Cl", mass = 35, isotope = list(mass = c(-0.03114732, 0, -0.03409741), abundance = c(0.7576, 0, 0.2424))) -Cr <- list(name = "Cr", mass = 50, isotope = list(mass = c(-0.0539536, 0, -0.0594902, -0.0593487, -0.0611175), abundance = c(0.04345, 0, 0.83789, 0.09501, 0.02365))) -Cu <- list(name = "Cu", mass = 63, isotope = list(mass = c(-0.0704011, 0, -0.0722071), abundance = c(0.6917, 0, 0.3083))) -F <- list(name = "F", mass = 19, isotope = list(mass = c(-0.00159678), abundance = c(1))) -Fe <- list(name = "Fe", mass = 54, isotope = list(mass = c(-0.0603873, 0, -0.0650607, -0.0646042, -0.0667227), abundance = c(0.058, 0, 0.9172, 0.022, 0.0028))) -H <- list(name = "H", mass = 1, isotope = list(mass = c(0.00782503207, 0.014101778, 0.01604928), abundance = c(0.999885, 0.000115, 0))) -Hg <- list(name = "Hg", mass = 196, isotope = list(mass = c(-0.034193, 0, -0.033257, -0.031746, -0.0317, -0.029723, -0.029383, 0, -0.026533), abundance = c(0.0015, 0, 0.0997, 0.1687, 0.231, 0.1318, 0.2986, 0, 0.0687))) -I <- list(name = "I", mass = 127, isotope = list(mass = c(-0.095527), abundance = c(1))) -K <- list(name = "K", mass = 39, isotope = list(mass = c(-0.0362926, -0.0360008, -0.0381746), abundance = c(0.932581, 0.000117, 0.067302))) -Li <- list(name = "Li", mass = 6, isotope = list(mass = c(0.0151214, 0.016003), abundance = c(0.075, 0.925))) -Mg <- list(name = "Mg", mass = 24, isotope = list(mass = c(-0.0149577, -0.0141626, -0.0174063), abundance = c(0.7899, 0.1, 0.1101))) -Mn <- list(name = "Mn", mass = 55, isotope = list(mass = c(-0.0619529), abundance = c(1))) -N <- list(name = "N", mass = 14, isotope = list(mass = c(0.003074002, 0.00010897), abundance = c(0.99634, 0.00366))) -Na <- list(name = "Na", mass = 23, isotope = list(mass = c(-0.0102323), abundance = c(1))) -Ni <- list(name = "Ni", mass = 58, isotope = list(mass = c(-0.0646538, 0, -0.0692116, -0.0689421, -0.0716539, 0, -0.0720321), abundance = c(0.68077, 0, 0.26223, 0.0114, 0.03634, 0, 0.00926))) -O <- list(name = "O", mass = 16, isotope = list(mass = c(-0.00508538044, -0.0008683, -0.0008397), abundance = c(0.99757, 0.000381, 0.00205))) -P <- list(name = "P", mass = 31, isotope = list(mass = c(-0.026238), abundance = c(1))) -S <- list(name = "S", mass = 32, isotope = list(mass = c(-0.027929, -0.02854124, -0.0321331, 0, -0.03291924), abundance = c(0.9499, 0.0075, 0.0425, 0, 1e-04))) -Se <- list(name = "Se", mass = 74, isotope = list(mass = c(-0.0775254, 0, -0.080788, -0.0800875, -0.0826924, 0, -0.0834804, 0, -0.0833022), abundance = c(0.0089, 0, 0.0936, 0.0763, 0.2378, 0, 0.4961, 0, 0.0873))) -Si <- list(name = "Si", mass = 28, isotope = list(mass = c(-0.0230729, -0.0235051, -0.0262293), abundance = c(0.9223, 0.0467, 0.031))) -Sn <- list(name = "Sn", mass = 112, isotope = list(mass = c(-0.095174, 0, -0.097216, -0.096652, -0.098253, -0.097044, -0.098391, -0.09669, -0.0978009, 0, -0.0965596, 0, -0.0947257), abundance = c(0.0097, 0, 0.0065, 0.0034, 0.1453, 0.0768, 0.2423, 0.0859, 0.3259, 0, 0.0463, 0, 0.0579))) -Zn <- list(name = "Zn", mass = 64, isotope = list(mass = c(-0.0708552, 0, -0.0739653, -0.0728709, -0.0751541, 0, -0.074675), abundance = c(0.486, 0, 0.279, 0.041, 0.188, 0, 0.006))) - -# The following list is for our own use -NH4 <- list(name = "NH4", mass = 18, isotope = list(mass = c(0.03437, 0.03141, -0.95935)), abundance = c(0.995, 0.004, 0.001)) # SISweb: 18.03437 100 19.03141 0.4 19.04065 0.1 -Ac <- list(name = "Ac", mass = 60, isotope = list(mass = c(0.02114, 0.02450, 0.02538)), abundance = c(0.975, 0.021, 0.004)) # SISweb: 60.02114 100 61.02450 2.2 62.02538 0.4 -NaCl <- list(name = "NaCl", mass = 58, isotope = list(mass = c(-0.04137, 0, -0.04433)), abundance = c(0.755, 0, 0.245)) # SISweb: 57.95862 100 59.95567 32.4 -NaCl2 <- list(name = "NaCl2", mass = 116, isotope = list(mass = c(-0.08274, 0, -0.08866)), abundance = c(0.755, 0, 0.245)) # SISweb: 57.95862 100 59.95567 32.4 -NaCl3 <- list(name = "NaCl3", mass = 174, isotope = list(mass = c(-0.12411, 0, -0.13299)), abundance = c(0.755, 0, 0.245)) # SISweb: 57.95862 100 59.95567 32.4 -NaCl4 <- list(name = "NaCl4", mass = 232, isotope = list(mass = c(-0.16548, 0, -0.17732)), abundance = c(0.755, 0, 0.245)) # SISweb: 57.95862 100 59.95567 32.4 -NaCl5 <- list(name = "NaCl5", mass = 290, isotope = list(mass = c(-0.20685, 0, -0.22165)), abundance = c(0.755, 0, 0.245)) # SISweb: 57.95862 100 59.95567 32.4 -For <- list(name = "For", mass = 45, isotope = list(mass = c(-0.00233, 0.00103)), abundance = c(0.989, 0.011)) # SISweb: 46.00549 100 47.00885 1.1 (47.0097 0.1) 48.00973 0.4 -Na2 <- list(name = "2Na-H", mass = 46, isotope = list(mass = c(-1.0282896)), abundance = c(1)) # SISweb for Na2: 45.97954 100 # minus 1 H ! -Met <- list(name = "CH3OH", mass = 32, isotope = list(mass = c(1.034045, 1.037405)), abundance = c(0.989, 0.011)) # SISweb: 32.02622 100 33.02958 1.1 33.0325 0.1 34.03046 0.2 -CH3OH <- list(name = "CH3OH", mass = 32, isotope = list(mass = c(1.034045, 1.037405)), abundance = c(0.989, 0.011)) # SISweb: 32.02622 100 33.02958 1.1 33.0325 0.1 34.03046 0.2 -Na3 <- list(name = "3Na-2H", mass = 69, isotope = list(mass = c(-2.0463469)), abundance = c(1)) # SISweb for Na2: 45.97954 100 # minus 1 H ! -KCl <- list(name = "KCl", mass = 74, isotope = list(mass = c(-0.06744, 0.92961, -0.06744, 0.92772)), abundance = c(0.7047, 0.2283, 0.0507, 0.0162)) # SISweb: 73.93256 100 75.92961 32.4 75.93067 7.2 77.92772 2.3 -H2PO4 <- list(name = "H2PO4", mass = 97, isotope = list(mass = c(-0.03091)), abundance = c(1)) -HSO4 <- list(name = "HSO4", mass = 97, isotope = list(mass = c(-0.04042, 0, -0.04462)), abundance = c(0.96, 0, 0.04)) -Met2 <- list(name = "Met2", mass = 64, isotope = list(mass = c(1.060265, 1.013405)), abundance = c(0.978, 0.022)) -Met3 <- list(name = "Met3", mass = 96, isotope = list(mass = c(1.086485, 1.089845)), abundance = c(0.969, 0.031)) -Met4 <- list(name = "Met4", mass = 128, isotope = list(mass = c(1.112705, 1.116065)), abundance = c(0.959, 0.041)) -Met5 <- list(name = "Met5", mass = 160, isotope = list(mass = c(1.20935, 1.142285)), abundance = c(0.949, 0.051)) -NaminH <- list(name = "Na-H", mass = 21, isotope = list(mass = c(-0.02571416)), abundance = c(1)) -KminH <- list(name = "K-H", mass = 37, isotope = list(mass = c(-0.05194, 0.94617)), abundance = c(0.9328, 0.0672)) -H2O <- list(name = "H2O", mass = -19, isotope = list(mass = c(-0.01894358)), abundance = c(1)) -NaK <- list(name = "NaK-H", mass = 61, isotope = list(mass = c(-0.054345, 0.943765)), abundance = c(0.9328, 0.0672)) -min2H <- list(name = "min2H", mass = -2, isotope = list(mass = c(-0.0151014)), abundance = c(1)) -plus2H <- list(name = "plus2H", mass = 2, isotope = list(mass = c(0.0151014)), abundance = c(1)) -plus2Na <- list(name = "plus2Na", mass = 46, isotope = list(mass = c(-0.02046), abundance = c(1))) -plusNaH <- list(name = "plusNaH", mass = 24, isotope = list(mass = c(-0.00295588), abundance = c(1))) -plusKH <- list(name = "plusKH", mass = 40, isotope = list(mass = c(-0.029008, 0.969101)), abundance = c(0.9328, 0.0672)) -plusHNH <- list(name = "plusHNH", mass = 19, isotope = list(mass = c(0.04164642)), abundance = c(1)) -min3H <- list(name = "min3H", mass = -3, isotope = list(mass = c(-0.02182926)), abundance = c(1)) -plus3H <- list(name = "plus3H", mass = 3, isotope = list(mass = c(0.02182926)), abundance = c(1)) -plus3Na <- list(name = "plus3Na", mass = 68, isotope = list(mass = c(0.96931)), abundance = c(1)) -plus2NaH <- list(name = "plus2NaH", mass = 47, isotope = list(mass = c(0.2985712)), abundance = c(1)) -plusNa2H <- list(name = "plusNa2H", mass = 25, isotope = list(mass = c(0.00432284)), abundance = c(1)) - -# add first isotope of Cl because of high abundance -Cl37 <- list(name = "Cl37", mass = 37, isotope = list(mass = c(-0.03409741)), abundance = c(1)) - -all_elements <- list(Ba, Br, C, Ca, Cl, Cr, Cu, F, Fe, H, Hg, I, K, Li, Mg, Mn, N, Na, Ni, O, P, S, Se, Si, Sn, Zn) -all_adducts <- list(Ba, Br, Ca, Cl, Cl37, Cr, Cu, Fe, Hg, I, K, Li, Mg, Mn, Na, Ni, Se, Si, Sn, Zn, - NH4, Ac, NaCl, For, Na2, CH3OH, NaCl2, NaCl3, NaCl4, NaCl5, Na3, KCl, H2PO4, HSO4, - Met2, Met3, Met4, Met5, NaminH, KminH, H2O, NaK, min2H, plus2H, plus2Na, plusNaH, - plusKH, min3H, plus3H, plusHNH, plus3Na, plus2NaH, plusNa2H) - -atoms_inuse <- c("P", "O", "N", "C", "H", "S", "Cl", "D", "13C", "34S", "18O", "37Cl") -atomic_weights <- c(30.97376163, 15.99491463, 14.0030740052, 12.0000, 1.0078250321, 31.9720707, 34.968852721, 2.0141017778, 13.0033548378, 33.96786690, 17.9991610, 36.96590259) -electron <- 0.00054858 - -hydrogen_mass <- Hmass <- H$mass + H$isotope$mass[1] -Dmass <- H$mass + 1 + H$isotope$mass[2] -Tmass <- H$mass + 2 + H$isotope$mass[3] -C13mass <- C$mass + 1 + C$isotope$mass[2] -N15mass <- N$mass + 1 + N$isotope$mass[2] diff --git a/DIMS/Utils/calculate_zscores.R b/DIMS/Utils/calculate_zscores.R deleted file mode 100644 index 12365e4..0000000 --- a/DIMS/Utils/calculate_zscores.R +++ /dev/null @@ -1,63 +0,0 @@ -## adapted from statistics_z.R -# refactor: change column names from avg.ctrls to avg_ctrls, sd.ctrls to sd_ctrls -# check logic of parameter adducts -calculate_zscores <- function(peakgroup_list, adducts) { - #' Calculate Z-scores for peak groups based on average and standard deviation of controls - #' - #' @param peakgroup_list: Peak group list (matrix) - #' @param sort_col: Column to sort on (string) - #' @param adducts: Parameter indicating whether there are adducts in the list (boolean) - #' - #' @return peakgroup_list_dedup: de-duplicated peak group list (matrix) - - case_label <- "P" - control_label <- "C" - # get index for new column names - startcol <- ncol(peakgroup_list) + 3 - - # calculate mean and standard deviation for Control group - ctrl_cols <- grep(control_label, colnames(peakgroup_list), fixed = TRUE) - case_cols <- grep(case_label, colnames(peakgroup_list), fixed = TRUE) - int_cols <- c(ctrl_cols, case_cols) - # set al zeros to NA - peakgroup_list[, int_cols][peakgroup_list[, int_cols] == 0] <- NA - ctrl_ints <- peakgroup_list[, ctrl_cols, drop = FALSE] - peakgroup_list$avg.ctrls <- apply(ctrl_ints, 1, function(x) mean(as.numeric(x), na.rm = TRUE)) - peakgroup_list$sd.ctrls <- apply(ctrl_ints, 1, function(x) sd(as.numeric(x), na.rm = TRUE)) - - # set new column names and calculate Z-scores - colnames_zscores <- NULL - for (col_index in int_cols) { - col_name <- colnames(peakgroup_list)[col_index] - colnames_zscores <- c(colnames_zscores, paste0(col_name, "_Zscore")) - zscores_1col <- (as.numeric(as.vector(unlist(peakgroup_list[, col_index]))) - - peakgroup_list$avg.ctrls) / peakgroup_list$sd.ctrls - peakgroup_list <- cbind(peakgroup_list, zscores_1col) - } - - # apply new column names to columns at end plus avg and sd columns - colnames(peakgroup_list)[startcol:ncol(peakgroup_list)] <- colnames_zscores - - # add ppm deviation column - zscore_cols <- grep("Zscore", colnames(peakgroup_list), fixed = TRUE) - if (!adducts) { - if ((dim(peakgroup_list[, zscore_cols])[2] + 6) != (startcol - 1)) { - ppmdev <- array(1:nrow(peakgroup_list), dim = c(nrow(peakgroup_list))) - # calculate ppm deviation - for (i in 1:nrow(peakgroup_list)) { - if (!is.na(peakgroup_list$theormz_HMDB[i]) && - !is.null(peakgroup_list$theormz_HMDB[i]) && - (peakgroup_list$theormz_HMDB[i] != "")) { - ppmdev[i] <- 10^6 * (as.numeric(as.vector(peakgroup_list$mzmed.pgrp[i])) - - as.numeric(as.vector(peakgroup_list$theormz_HMDB[i]))) / - as.numeric(as.vector(peakgroup_list$theormz_HMDB[i])) - } else { - ppmdev[i] <- NA - } - } - peakgroup_list <- cbind(peakgroup_list[, 1:4], ppmdev = ppmdev, peakgroup_list[, 5:ncol(peakgroup_list)]) - } - } - - return(peakgroup_list) -} diff --git a/DIMS/Utils/check_overlap.R b/DIMS/Utils/check_overlap.R deleted file mode 100644 index 66492e8..0000000 --- a/DIMS/Utils/check_overlap.R +++ /dev/null @@ -1,24 +0,0 @@ -## adapted from checkOverlap.R -check_overlap <- function(range1, range2) { - #' Modify range1 and range2 in case of overlap - #' - #' @param range1: Vector of m/z values for first peak (float) - #' @param range2: Vector of m/z values for second peak (float) - #' - #' @return new_ranges: list of two ranges (list) - - # Check for overlap - if (length(intersect(range1, range2)) == 2) { - if (length(range1) >= length(range2)) { - range1 <- range1[-length(range1)] - } else { - range2 <- range2[-1] - } - } else if (length(intersect(range1, range2)) == 3) { - range1 <- range1[-length(range1)] - range2 <- range2[-1] - } - new_ranges <- list("range1" = range1, "range2" = range2) - return(new_ranges) -} - diff --git a/DIMS/Utils/check_same_samplename.R b/DIMS/Utils/check_same_samplename.R deleted file mode 100644 index 6e80841..0000000 --- a/DIMS/Utils/check_same_samplename.R +++ /dev/null @@ -1,10 +0,0 @@ -check_same_samplename <- function(int_col_name, zscore_col_name) { - #' A check to see if intensity and Z-score columns match - #' - #' @param int_col_name: name of an intensity column (string) - #' @param zscore_col_name: name of a Z-score column (string) - #' - #' @return: match or mismatch of the columns (boolean) - - paste0(int_col_name, "_Zscore") == zscore_col_name -} diff --git a/DIMS/Utils/create_violin_plots.R b/DIMS/Utils/create_violin_plots.R deleted file mode 100644 index be4f1f6..0000000 --- a/DIMS/Utils/create_violin_plots.R +++ /dev/null @@ -1,122 +0,0 @@ -# remove parameter default value -# add explanation variable to parameters -create_violin_plots <- function(pdf_dir, pt_name, metab_perpage, top_metab_pt = NULL) { - #' Create violin plots for each patient - #' - #' @param pdf_dir: location where to save the pdf file (string) - #' @param pt_name: patient code (string) - #' @param metab_perpage: list of dataframe with a dataframe for each page in the violinplot pdf (list) - #' @param top_metab_pt: dataframe with increased and decrease metabolites for this patient (dataframe) - - # set parameters for plots - plot_height <- 9.6 - plot_width <- 6 - fontsize <- 1 - circlesize <- 0.8 - colors_4plot <- c("#22E4AC", "#00B0F0", "#504FFF", "#A704FD", "#F36265", "#DA0641") - # green blue blue/purple purple orange red - - # patient plots, create the PDF device - pt_name_sub <- pt_name - suffix <- "" - if (grepl("Diagnostics", pdf_dir) & is_diagnostic_patient(pt_name)) { - prefix <- "MB" - suffix <- "_DIMS_PL_DIAG" - # substitute P and M in P2020M00001 into right format for Helix - pt_name_sub <- gsub("[PM]", "", pt_name) - pt_name_sub <- gsub("\\..*", "", pt_name_sub) - } else if (grepl("Diagnostics", pdf_dir)) { - prefix <- "Dx_" - } else if (grepl("IEM", pdf_dir)) { - prefix <- "IEM_" - } else { - prefix <- "R_" - } - - pdf(paste0(pdf_dir, "/", prefix, pt_name_sub, suffix, ".pdf"), - onefile = TRUE, - width = plot_width, - height = plot_height) - - # page headers: - page_headers <- names(metab_perpage) - - # put table into PDF file, if not empty - if (!is.null(dim(top_metab_pt))) { - plot.new() - # get the names and numbers in the table aligned - table_theme <- ttheme_default(core = list(fg_params = list(hjust = 0, x = 0.05, fontsize = 6)), - colhead = list(fg_params = list(fontsize = 8, fontface = "bold"))) - grid.table(top_metab_pt, theme = table_theme, rows = NULL) - # g <- tableGrob(top_metab_pt) - # grid.draw(g) - text(x = 0.45, y = 1.02, paste0("Top deviating metabolites for patient: ", pt_name), font = 1, cex = 1) - } - - # violin plots - for (page_index in 1:length(metab_perpage)) { - # extract list of metabolites to plot on a page - metab_list_2plot <- metab_perpage[[page_index]] - # extract original data for patient of interest (pt_name) before cut-offs - pt_list_2plot_orig <- metab_list_2plot[which(metab_list_2plot$variable == pt_name), ] - # cut off Z-scores higher than 20 or lower than -5 (for nicer plots) - metab_list_2plot$value[metab_list_2plot$value > 20] <- 20 - metab_list_2plot$value[metab_list_2plot$value < -5] <- -5 - # extract data for patient of interest (pt_name) - pt_list_2plot <- metab_list_2plot[which(metab_list_2plot$variable == pt_name), ] - # restore original Z-score before cut-off, for showing Z-scores in PDF - pt_list_2plot$value_orig <- pt_list_2plot_orig$value - # remove patient of interest (pt_name) from list; violins will be made up of controls and other patients - metab_list_2plot <- metab_list_2plot[-which(metab_list_2plot$variable == pt_name), ] - # subtitle per page - sub_perpage <- gsub("_", " ", page_headers[page_index]) - # for IEM plots, put subtitle on two lines - sub_perpage <- gsub("probability", "\nprobability", sub_perpage) - # add size parameter for showing Z-score of patient per metabolite - z_size <- rep(3, nrow(pt_list_2plot)) - # set size to 0 if row is empty - z_size[is.na(pt_list_2plot$value)] <- 0 - - # draw violin plot. shape=22 gives square for patient of interest - ggplot_object <- ggplot(metab_list_2plot, aes(x = value, y = HMDB_name)) + - theme(axis.text.y = element_text(size = rel(fontsize)), plot.caption = element_text(size = rel(fontsize))) + - xlim(-5, 20) + - geom_violin(scale = "width") + - geom_point(data = pt_list_2plot, aes(color = value), size = 3.5 * circlesize, shape = 22, fill = "white") + - scale_fill_gradientn( - colors = colors_4plot, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", - aesthetics = "colour" - ) + - # add Z-score value for patient of interest at x=16 - geom_text( - data = pt_list_2plot, aes(16, label = paste0("Z=", round(value_orig, 2))), hjust = "left", vjust = +0.2, - size = z_size - ) + - # add labels. Use font Courier to get all the plots in the same location. - labs(x = "Z-scores", y = "Metabolites", subtitle = sub_perpage, color = "z-score") + - theme(axis.text.y = element_text(family = "Courier", size = 6)) + - # do not show legend - theme(legend.position = "none") + - # add title - ggtitle(label = paste0("Results for patient ", pt_name)) + - # add vertical lines - geom_vline(xintercept = 2, col = "grey", lwd = 0.5, lty = 2) + - geom_vline(xintercept = -2, col = "grey", lwd = 0.5, lty = 2) - - suppressWarnings(print(ggplot_object)) - - } - - # add explanation of violin plots, version number etc. - plot(NA, xlim = c(0, 5), ylim = c(0, 5), bty = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "") - if (length(explanation) > 0) { - text(0.2, 5, explanation[1], pos = 4, cex = 0.8) - for (line_index in 2:length(explanation)) { - text_y_position <- 5 - (line_index * 0.2) - text(-0.2, text_y_position, explanation[line_index], pos = 4, cex = 0.5) - } - } - - # close the PDF file - dev.off() -} diff --git a/DIMS/Utils/do_peakfinding.R b/DIMS/Utils/do_peakfinding.R deleted file mode 100644 index fff6afe..0000000 --- a/DIMS/Utils/do_peakfinding.R +++ /dev/null @@ -1,55 +0,0 @@ -## adapted from findpeaks.Gauss.HPC.R -# NB: this function will be taken up into PeakFinding.R -# variables with fixed values will be removed from function parameters -# int_factor, scale, outdir, plot, thresh, width, height -do_peakfinding <- function(sample_avgtechrepl, int_factor, scale, resol, outdir, scanmode, plot, thresh, width, height) { - #' start peak finding - #' - #' @param sample_avgtechrepl: Dataframe with binned intensities averaged over technical replicates for a sample - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param outdir: Path for output directory (string) - #' @param scanmode: Scan mode, positive or negative (string) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param thresh: Value for noise level threshold (integer) - #' @param width: Value for width of plot (integer) - #' @param height: Value for height of plot (integer) - #' - #' @return save output to file - - sample_name <- colnames(sample_avgtechrepl)[1] - - # turn dataframe with intensities into a named list - ints_fullrange <- as.vector(sample_avgtechrepl) - names(ints_fullrange) <- rownames(sample_avgtechrepl) - - # initialise list to store results for all peaks - allpeaks_values <- list("mean" = NULL, "area" = NULL, "nr" = NULL, - "min" = NULL, "max" = NULL, "qual" = NULL, "spikes" = 0) - - # look for m/z range for all peaks - allpeaks_values <- search_mzrange(ints_fullrange, allpeaks_values, int_factor, scale, resol, - outdir, sample_name, scanmode, - plot, width, height, thresh) - - # turn the list into a dataframe - outlist_persample <- NULL - outlist_persample <- cbind("samplenr" = allpeaks_values$nr, - "mzmed.pkt" = allpeaks_values$mean, - "fq" = allpeaks_values$qual, - "mzmin.pkt" = allpeaks_values$min, - "mzmax.pkt" = allpeaks_values$max, - "height.pkt" = allpeaks_values$area) - - # remove peaks with height = 0 - outlist_persample <- outlist_persample[outlist_persample[, "height.pkt"] != 0, ] - - # save output to file - save(outlist_persample, file = paste0(sample_name, "_", scanmode, ".RData")) - - # generate text output to log file on number of spikes for this sample - # spikes are peaks that are too narrow, e.g. 1 data point - cat(paste("There were", allpeaks_values$spikes, "spikes")) -} - diff --git a/DIMS/Utils/estimate_area.R b/DIMS/Utils/estimate_area.R deleted file mode 100644 index 9f9042e..0000000 --- a/DIMS/Utils/estimate_area.R +++ /dev/null @@ -1,23 +0,0 @@ -estimate_area <- function(mass_max, resol, scale, sigma, int_factor) { - #' Estimate area of Gaussian curve - #' - #' @param mass_max: Value for m/z at maximum intensity of a peak (float) - #' @param resol: Value for resolution (integer) - #' @param scale: Value for peak width (float) - #' @param sigma: Value for standard deviation (float) - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' - #' @return area_curve: Value for area under the Gaussian curve (float) - - # generate a mass_vector with equally spaced m/z values - fwhm <- get_fwhm(mass_max, resol) - mz_min <- mass_max - 2 * fwhm - mz_max <- mass_max + 2 * fwhm - mz_range <- mz_max - mz_min - mass_vector2 <- seq(mz_min, mz_max, length = 1000) - - # estimate area under the curve - area_curve <- sum(scale * dnorm(mass_vector2, mass_max, sigma)) / 100 - - return(area_curve) -} diff --git a/DIMS/Utils/fit_gaussian.R b/DIMS/Utils/fit_gaussian.R deleted file mode 100644 index 6be9660..0000000 --- a/DIMS/Utils/fit_gaussian.R +++ /dev/null @@ -1,319 +0,0 @@ -## adapted from fitGaussian.R -# variables with fixed values will be removed from function parameters -# scale, outdir, plot, width, height -# max_index doesn't need to be passed to this function, can be determined here. -# remove plot sections (commented out) -# several functions need to be loaded before this function can run -fit_gaussian <- function(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - outdir, force, use_bounds, plot, scanmode, - int_factor, width, height) { - #' Fit 1, 2, 3 or 4 Gaussian peaks in small region of m/z - #' - #' @param mass_vector2: Vector of equally spaced m/z values (float) - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Value used to calculate area under Gaussian curve (integer) - #' @param max_index: Index in int_vector with the highest intensity (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param outdir: Path for output directory (string) - #' @param force: Number of local maxima in int_vector (integer) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param scanmode: Scan mode, positive or negative (string) - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' @param width: Value for width of plot (integer) - #' @param height: Value for height of plot (integer) - #' - #' @return roi_value_list: list of fit values for region of interest (list) - - # Initialise - peak_mean <- NULL - peak_area <- NULL - peak_qual <- NULL - peak_min <- NULL - peak_max <- NULL - fit_quality1 <- 0.15 - fit_quality <- 0.2 - - # One local maximum: - if (force == 1) { - # determine fit values for 1 Gaussian peak (mean, scale, sigma, qual) - fit_values <- fit_1peak(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - plot, fit_quality1, use_bounds) - # set initial value for scale factor - scale <- 2 - # test if the mean is outside the m/z range - if (fit_values$mean[1] < mass_vector[1] || fit_values$mean[1] > mass_vector[length(mass_vector)]) { - # run this function again with fixed boundaries - return(fit_gaussian(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - outdir, force = 1, use_bounds = TRUE, plot, scanmode, int_factor, width, height)) - } else { - # test if the fit is bad - if (fit_values$qual > fit_quality1) { - # Try to fit two curves; find two local maxima - new_index <- which(diff(sign(diff(int_vector))) == -2) + 1 - # test if there are two indices in new_index - if (length(new_index) != 2) { - new_index <- round(length(mass_vector) / 3) - new_index <- c(new_index, 2 * new_index) - } - # run this function again with two local maxima - return(fit_gaussian(mass_vector2, mass_vector, int_vector, new_index, - scale, resol, outdir, force = 2, use_bounds = FALSE, - plot, scanmode, int_factor, width, height)) - # good fit - } else { - peak_mean <- c(peak_mean, fit_values$mean) - peak_area <- c(peak_area, estimate_area(fit_values$mean, resol, fit_values$scale, - fit_values$sigma, int_factor)) - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - } - } - - #### Two local maxima; need at least 6 data points for this #### - } else if (force == 2 && (length(mass_vector) > 6)) { - # determine fit values for 2 Gaussian peaks (mean, scale, sigma, qual) - fit_values <- fit_2peaks(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - use_bounds, plot, fit_quality, int_factor) - # test if one of the means is outside the m/z range - if (fit_values$mean[1] < mass_vector[1] || fit_values$mean[1] > mass_vector[length(mass_vector)] || - fit_values$mean[2] < mass_vector[1] || fit_values$mean[2] > mass_vector[length(mass_vector)]) { - # check if fit quality is bad - if (fit_values$qual > fit_quality) { - # run this function again with fixed boundaries - return(fit_gaussian(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - outdir, force = 2, use_bounds = TRUE, - plot, scanmode, int_factor, width, height)) - } else { - # check which mean is outside range and remove it from the list of means - # NB: peak_mean and other variables have not been given values from 2-peak fit yet! - for (i in 1:length(fit_values$mean)){ - if (fit_values$mean[i] < mass_vector[1] || fit_values$mean[i] > mass_vector[length(mass_vector)]) { - peak_mean <- c(peak_mean, -i) - peak_area <- c(peak_area, -i) - } else { - peak_mean <- c(peak_mean, fit_values$mean[i]) - peak_area <- c(peak_area, fit_values$area[i]) - } - } - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - } - # if all means are within range - } else { - # check for bad fit - if (fit_values$qual > fit_quality) { - # Try to fit three curves; find three local maxima - new_index <- which(diff(sign(diff(int_vector))) == -2) + 1 - # test if there are three indices in new_index - if (length(new_index) != 3) { - new_index <- round(length(mass_vector) / 4) - new_index <- c(new_index, 2 * new_index, 3 * new_index) - } - # run this function again with three local maxima - return(fit_gaussian(mass_vector2, mass_vector, int_vector, new_index, - scale, resol, outdir, force = 3, use_bounds = FALSE, - plot, scanmode, int_factor, width, height)) - # good fit, all means are within m/z range - } else { - # check if means are within 3 ppm and sum if so - tmp <- fit_values$qual - nr_means_new <- -1 - nr_means <- length(fit_values$mean) - while (nr_means != nr_means_new) { - nr_means <- length(fit_values$mean) - fit_values <- within_ppm(fit_values$mean, fit_values$scale, fit_values$sigma, fit_values$area, - mass_vector2, mass_vector, ppm = 4, resol, plot) - nr_means_new <- length(fit_values$mean) - } - # restore original quality score - fit_values$qual <- tmp - - for (i in 1:length(fit_values$mean)){ - peak_mean <- c(peak_mean, fit_values$mean[i]) - peak_area <- c(peak_area, fit_values$area[i]) - } - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - } - } - - # Three local maxima; need at least 6 data points for this - } else if (force == 3 && (length(mass_vector) > 6)) { - # determine fit values for 3 Gaussian peaks (mean, scale, sigma, qual) - fit_values <- fit_3peaks(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - use_bounds, plot, fit_quality, int_factor) - # test if one of the means is outside the m/z range - if (fit_values$mean[1] < mass_vector[1] || fit_values$mean[1] > mass_vector[length(mass_vector)] || - fit_values$mean[2] < mass_vector[1] || fit_values$mean[2] > mass_vector[length(mass_vector)] || - fit_values$mean[3] < mass_vector[1] || fit_values$mean[3] > mass_vector[length(mass_vector)]) { - # check if fit quality is bad - if (fit_values$qual > fit_quality) { - # run this function again with fixed boundaries - return(fit_gaussian(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - outdir, force, use_bounds = TRUE, - plot, scanmode, int_factor, width, height)) - } else { - # check which mean is outside range and remove it from the list of means - # NB: peak_mean and other variables have not been given values from 2-peak fit yet! - for (i in 1:length(fit_values$mean)) { - if (fit_values$mean[i] < mass_vector[1] || fit_values$mean[i] > mass_vector[length(mass_vector)]) { - peak_mean <- c(peak_mean, -i) - peak_area <- c(peak_area, -i) - } else { - peak_mean <- c(peak_mean, fit_values$mean[i]) - peak_area <- c(peak_area, fit_values$area[i]) - } - } - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - } - # if all means are within range - } else { - # check for bad fit - if (fit_values$qual > fit_quality) { - # Try to fit four curves; find four local maxima - new_index <- which(diff(sign(diff(int_vector))) == -2) + 1 - # test if there are four indices in new_index - if (length(new_index) != 4) { - new_index <- round(length(mass_vector) / 5) - new_index <- c(new_index, 2 * new_index, 3 * new_index, 4 * new_index) - } - # run this function again with four local maxima - return(fit_gaussian(mass_vector2, mass_vector, int_vector, new_index, scale, resol, - outdir, force = 4, use_bounds = FALSE, plot, scanmode, - int_factor, width, height)) - # good fit, all means are within m/z range - } else { - # check if means are within 4 ppm and sum if so - tmp <- fit_values$qual - nr_means_new <- -1 - nr_means <- length(fit_values$mean) - while (nr_means != nr_means_new) { - nr_means <- length(fit_values$mean) - fit_values <- within_ppm(fit_values$mean, fit_values$scale, fit_values$sigma, fit_values$area, - mass_vector2, mass_vector, ppm = 4, resol, plot) - nr_means_new <- length(fit_values$mean) - } - # restore original quality score - fit_values$qual <- tmp - - for (i in 1:length(fit_values$mean)){ - peak_mean <- c(peak_mean, fit_values$mean[i]) - peak_area <- c(peak_area, fit_values$area[i]) - } - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - - } - } - - #### Four local maxima; need at least 6 data points for this #### - } else if (force == 4 && (length(mass_vector) > 6)) { - # determine fit values for 4 Gaussian peaks (mean, scale, sigma, qual) - fit_values <- fit_4peaks(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - use_bounds, plot, fit_quality, int_factor) - # test if one of the means is outside the m/z range - if (fit_values$mean[1] < mass_vector[1] || fit_values$mean[1] > mass_vector[length(mass_vector)] || - fit_values$mean[2] < mass_vector[1] || fit_values$mean[2] > mass_vector[length(mass_vector)] || - fit_values$mean[3] < mass_vector[1] || fit_values$mean[3] > mass_vector[length(mass_vector)] || - fit_values$mean[4] < mass_vector[1] || fit_values$mean[4] > mass_vector[length(mass_vector)]) { - # check if quality of fit is bad - if (fit_values$qual > fit_quality) { - # run this function again with fixed boundaries - return(fit_gaussian(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - outdir, force, use_bounds = TRUE, - plot, scanmode, int_factor, width, height)) - - } else { - # check which mean is outside range and remove it from the list of means - # NB: peak_mean and other variables have not been given values from 2-peak fit yet! - for (i in 1:length(fit_values$mean)) { - if (fit_values$mean[i] < mass_vector[1] | fit_values$mean[i] > mass_vector[length(mass_vector)]) { - peak_mean <- c(peak_mean, -i) - peak_area <- c(peak_area, -i) - } else { - peak_mean <- c(peak_mean, fit_values$mean[i]) - peak_area <- c(peak_area, fit_values$area[i]) - } - } - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - } - # if all means are within range - } else { - # check for bad fit - if (fit_values$qual > fit_quality) { - # Try to fit 1 curve, force = 5 - return(fit_gaussian(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - outdir, force = 5, use_bounds = FALSE, - plot, scanmode, int_factor, width, height)) - # good fit, all means are within m/z range - } else { - # check if means are within 4 ppm and sum if so - tmp <- fit_values$qual - nr_means_new <- -1 - nr_means <- length(fit_values$mean) - while (nr_means != nr_means_new) { - nr_means <- length(fit_values$mean) - fit_values <- within_ppm(fit_values$mean, fit_values$scale, fit_values$sigma, fit_values$area, - mass_vector2, mass_vector, ppm = 4, resol, plot) - nr_means_new <- length(fit_values$mean) - } - # restore original quality score - fit_values$qual <- tmp - - for (i in 1:length(fit_values$mean)){ - peak_mean <- c(peak_mean, fit_values$mean[i]) - peak_area <- c(peak_area, fit_values$area[i]) - } - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - - } - } - - # More than four local maxima; fit 1 peak. - } else { - scale <- 2 - fit_quality1 <- 0.40 - use_bounds <- TRUE - max_index <- which(int_vector == max(int_vector)) - fit_values <- fit_1peak(mass_vector2, mass_vector, int_vector, max_index, scale, resol, - plot, fit_quality1, use_bounds) - # check for bad fit - if (fit_values$qual > fit_quality1) { - # remove - if (plot) dev.off() - # get fit values from fit_optim - fit_values <- fit_optim(mass_vector, int_vector, resol, plot, scanmode, int_factor, width, height) - peak_mean <- c(peak_mean, fit_values$mean) - peak_area <- c(peak_area, fit_values$area) - peak_min <- fit_values$min - peak_max <- fit_values$max - peak_qual <- 0 - } else { - peak_mean <- c(peak_mean, fit_values$mean) - peak_area <- c(peak_area, estimate_area(fit_values$mean, resol, fit_values$scale, fit_values$sigma, int_factor)) - peak_qual <- fit_values$qual - peak_min <- mass_vector[1] - peak_max <- mass_vector[length(mass_vector)] - } - } - - # put all values for this region of interest into a list - roi_value_list <- list("mean" = peak_mean, - "area" = peak_area, - "qual" = peak_qual, - "min" = peak_min, - "max" = peak_max) - return(roi_value_list) -} diff --git a/DIMS/Utils/fit_gaussians.R b/DIMS/Utils/fit_gaussians.R deleted file mode 100644 index 05bff86..0000000 --- a/DIMS/Utils/fit_gaussians.R +++ /dev/null @@ -1,196 +0,0 @@ -# Gaussian fit functions -## adapted from fitG.R, fit2G.R, fit3G.R and fit4G.R (combined) -fit_1gaussian <- function(mass_vector, int_vector, sigma, query_mass, scale, use_bounds) { - #' Fit a Gaussian curve for a peak with given parameters - #' - #' @param mass_vector: Vector of masses (float) - #' @param int_vector: Vector of intensities (float) - #' @param sigma: Value for width of the peak (float) - #' @param query_mass: Value for mass at center of peak (float) - #' @param scale: Value for scaling intensities (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' - #' @return opt_fit: list of parameters and values describing the optimal fit - - # define optimization function for optim based on normal distribution - opt_f <- function(params) { - d <- params[2] * dnorm(mass_vector, mean = params[1], sd = sigma) - sum((d - int_vector) ^ 2) - } - if (use_bounds) { - # determine lower and upper boundaries - lower <- c(mass_vector[1], 0, mass_vector[1], 0) - upper <- c(mass_vector[length(mass_vector)], Inf, mass_vector[length(mass_vector)], Inf) - # get optimal value for fitted Gaussian curve - opt_fit <- optim(c(as.numeric(query_mass), as.numeric(scale)), - opt_f, control = list(maxit = 10000), method = "L-BFGS-B", - lower = lower, upper = upper) - } else { - opt_fit <- optim(c(as.numeric(query_mass), as.numeric(scale)), - opt_f, control = list(maxit = 10000)) - } - return(opt_fit) -} - - -fit_2gaussians <- function(mass_vector, int_vector, sigma1, sigma2, - query_mass1, scale1, - query_mass2, scale2, use_bounds) { - #' Fit two Gaussian curves for a peak with given parameters - #' - #' @param mass_vector: Vector of masses (float) - #' @param int_vector: Vector of intensities (float) - #' @param sigma1: Value for width of the first peak (float) - #' @param sigma2: Value for width of the second peak (float) - #' @param query_mass1: Value for mass at center of first peak (float) - #' @param scale1: Value for scaling intensities for first peak (float) - #' @param query_mass2: Value for mass at center of second peak (float) - #' @param scale2: Value for scaling intensities for second peak (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' - #' @return opt_fit: list of parameters and values describing the optimal fit - - # define optimization function for optim based on normal distribution - opt_f <- function(params) { - d <- params[2] * dnorm(mass_vector, mean = params[1], sd = sigma1) + - params[4] * dnorm(mass_vector, mean = params[3], sd = sigma2) - sum((d - int_vector) ^ 2) - } - - if (use_bounds) { - # determine lower and upper boundaries - lower <- c(mass_vector[1], 0, mass_vector[1], 0) - upper <- c(mass_vector[length(mass_vector)], Inf, mass_vector[length(mass_vector)], Inf) - # get optimal value for 2 fitted Gaussian curves - if (is.null(query_mass2) && is.null(scale2) && is.null(sigma2)) { - sigma2 <- sigma1 - opt_fit <- optim(c(as.numeric(query_mass1), as.numeric(scale1), - as.numeric(query_mass1), as.numeric(scale1)), - opt_f, control = list(maxit = 10000), - method = "L-BFGS-B", lower = lower, upper = upper) - } else { - opt_fit <- optim(c(as.numeric(query_mass1), as.numeric(scale1), - as.numeric(query_mass2), as.numeric(scale2)), - opt_f, control = list(maxit = 10000), - method = "L-BFGS-B", lower = lower, upper = upper) - } - } else { - if (is.null(query_mass2) && is.null(scale2) && is.null(sigma2)) { - sigma2 <- sigma1 - opt_fit <- optim(c(as.numeric(query_mass1), as.numeric(scale1), - as.numeric(query_mass1), as.numeric(scale1)), - opt_f, control = list(maxit = 10000)) - } else { - opt_fit <- optim(c(as.numeric(query_mass1), as.numeric(scale1), - as.numeric(query_mass2), as.numeric(scale2)), - opt_f, control = list(maxit = 10000)) - } - } - return(opt_fit) -} - - -fit_3gaussians <- function(mass_vector, int_vector, sigma1, sigma2, sigma3, - query_mass1, scale1, - query_mass2, scale2, - query_mass3, scale3, use_bounds) { - #' Fit three Gaussian curves for a peak with given parameters - #' - #' @param mass_vector: Vector of masses (float) - #' @param int_vector: Vector of intensities (float) - #' @param sigma1: Value for width of the first peak (float) - #' @param sigma2: Value for width of the second peak (float) - #' @param sigma3: Value for width of the third peak (float) - #' @param query_mass1: Value for mass at center of first peak (float) - #' @param scale1: Value for scaling intensities for first peak (float) - #' @param query_mass2: Value for mass at center of second peak (float) - #' @param scale2: Value for scaling intensities for second peak (float) - #' @param query_mass3: Value for mass at center of third peak (float) - #' @param scale3: Value for scaling intensities for third peak (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' - #' @return opt_fit: list of parameters and values describing the optimal fit - - # define optimization function for optim based on normal distribution - opt_f <- function(params) { - d <- params[2] * dnorm(mass_vector, mean = params[1], sd = sigma1) + - params[4] * dnorm(mass_vector, mean = params[3], sd = sigma2) + - params[6] * dnorm(mass_vector, mean = params[5], sd = sigma3) - sum((d - int_vector) ^ 2) - } - - if (use_bounds) { - # determine lower and upper boundaries - lower <- c(mass_vector[1], 0, mass_vector[1], 0, mass_vector[1], 0) - upper <- c(mass_vector[length(mass_vector)], Inf, mass_vector[length(mass_vector)], Inf, - mass_vector[length(mass_vector)], Inf) - # get optimal value for 3 fitted Gaussian curves - opt_fit <- optim(c(query_mass1, scale1, - query_mass2, scale2, - query_mass3, scale3), - opt_f, control = list(maxit = 10000), - method = "L-BFGS-B", lower = lower, upper = upper) - } else { - opt_fit <- optim(c(query_mass1, scale1, - query_mass2, scale2, - query_mass3, scale3), - opt_f, control = list(maxit = 10000)) - } - return(opt_fit) -} - -fit_4gaussians <- function(mass_vector, int_vector, sigma1, sigma2, sigma3, sigma4, - query_mass1, scale1, - query_mass2, scale2, - query_mass3, scale3, - query_mass4, scale4, use_bounds) { - #' Fit four Gaussian curves for a peak with given parameters - #' - #' @param mass_vector: Vector of masses (float) - #' @param int_vector: Vector of intensities (float) - #' @param sigma1: Value for width of the first peak (float) - #' @param sigma2: Value for width of the second peak (float) - #' @param sigma3: Value for width of the third peak (float) - #' @param sigma4: Value for width of the fourth peak (float) - #' @param query_mass1: Value for mass at center of first peak (float) - #' @param scale1: Value for scaling intensities for first peak (float) - #' @param query_mass2: Value for mass at center of second peak (float) - #' @param scale2: Value for scaling intensities for second peak (float) - #' @param query_mass3: Value for mass at center of third peak (float) - #' @param scale3: Value for scaling intensities for third peak (float) - #' @param query_mass4: Value for mass at center of fourth peak (float) - #' @param scale4: Value for scaling intensities for fourth peak (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' - #' @return opt_fit: list of parameters and values describing the optimal fit - - # define optimization function for optim based on normal distribution - opt_f <- function(params) { - d <- params[2] * dnorm(mass_vector, mean = params[1], sd = sigma1) + - params[4] * dnorm(mass_vector, mean = params[3], sd = sigma2) + - params[6] * dnorm(mass_vector, mean = params[5], sd = sigma3) + - params[8] * dnorm(mass_vector, mean = params[7], sd = sigma4) - sum((d - int_vector) ^ 2) - } - - if (use_bounds) { - # determine lower and upper boundaries - lower <- c(mass_vector[1], 0, mass_vector[1], 0, mass_vector[1], 0, mass_vector[1], 0) - upper <- c(mass_vector[length(mass_vector)], Inf, mass_vector[length(mass_vector)], Inf, - mass_vector[length(mass_vector)], Inf, mass_vector[length(mass_vector)], Inf) - # get optimal value for 3 fitted Gaussian curves - opt_fit <- optim(c(query_mass1, scale1, - query_mass2, scale2, - query_mass3, scale3, - query_mass4, scale4), - opt_f, control = list(maxit = 10000), - method = "L-BFGS-B", lower = lower, upper = upper) - } else { - opt_fit <- optim(c(query_mass1, scale1, - query_mass2, scale2, - query_mass3, scale3, - query_mass4, scale4), - opt_f, control = list(maxit = 10000)) - } - return(opt_fit) -} diff --git a/DIMS/Utils/fit_init.R b/DIMS/Utils/fit_init.R deleted file mode 100644 index ecae337..0000000 --- a/DIMS/Utils/fit_init.R +++ /dev/null @@ -1,47 +0,0 @@ -## adapted from fitGaussianInit.R -# variables with fixed values will be removed from function parameters -# scale, outdir, plot, width, height -# mz_index, start_index, end_index, sample_name not used. -# fit_gaussian should be defined before this function is called. -fit_init <- function(mass_vector, int_vector, int_factor, scale, resol, - outdir, sample_name, scanmode, plot, width, height, - mz_index, start_index, end_index) { - #' Determine initial fit of Gaussian curve to small region of m/z - #' - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Vector of intensities for a region of interest (float) - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param outdir: Path for output directory (string) - #' @param sample_name: Sample name (string) - #' @param scanmode: Scan mode, positive or negative (string) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param width: Value for width of plot (integer) - #' @param height: Value for height of plot (integer) - #' @param mz_index: Index of m/z value with non-zero intensity (integer) - #' @param start_index: Index of start of m/z range in mass_vector (integer) - #' @param end_index: Index of end of m/z range in mass_vector (integer) - #' - #' @return roi_value_list: list of fit values for region of interest (list) - - # define mass_diff as difference between last and first value of mass_vector - mass_diff <- mass_vector[length(mass_vector)] - mass_vector[1] - # generate a second mass_vector with equally spaced m/z values - mass_vector2 <- seq(mass_vector[1], mass_vector[length(mass_vector)], - length = mass_diff * int_factor) - - # Find the index in int_vector with the highest intensity - max_index <- which(int_vector == max(int_vector)) - roi_values <- fit_gaussian(mass_vector2, mass_vector, int_vector, max_index, - scale, resol, outdir, force = length(max_index), - use_bounds = FALSE, plot, scanmode, int_factor, width, height) - # put all values for this region of interest into a list - roi_value_list <- list("mean" = roi_values$mean, - "area" = roi_values$area, - "qual" = roi_values$qual, - "min" = roi_values$min, - "max" = roi_values$max) - return(roi_value_list) -} - diff --git a/DIMS/Utils/fit_optim.R b/DIMS/Utils/fit_optim.R deleted file mode 100644 index 404cc7a..0000000 --- a/DIMS/Utils/fit_optim.R +++ /dev/null @@ -1,47 +0,0 @@ -## adapted from generateGaussian.R -# variables with fixed values will be removed from function parameters -# plot, width, height -# fit_gaussian should be defined before this function is called. -fit_optim <- function(mass_vector, int_vector, resol, - plot, scanmode, int_factor, width, height) { - #' Determine optimized fit of Gaussian curve to small region of m/z - #' - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Vector of intensities for a region of interest (float) - #' @param resol: Value for resolution (integer) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param scanmode: Scan mode, positive or negative (string) - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' @param width: Value for width of plot (integer) - #' @param height: Value for height of plot (integer) - #' - #' @return roi_value_list: list of fit values for region of interest (list) - - factor <- 1.5 - # Find the index in int_vector with the highest intensity - max_index <- which(int_vector == max(int_vector))[1] - mass_max <- mass_vector[max_index] - int_max <- int_vector[max_index] - # get peak width - fwhm <- get_fwhm(mass_max, resol) - # simplify the peak shape: represent it by a triangle - mass_max_simple <- c(mass_max - factor * fwhm, mass_max, mass_max + factor * fwhm) - int_max_simple <- c(0, int_max, 0) - - # define mass_diff as difference between last and first value of mass_max_simple - mass_diff <- mass_max_simple[length(mass_max_simple)] - mass_max_simple[1] - # generate a second mass_vector with equally spaced m/z values - mass_vector2 <- seq(mass_max_simple[1], mass_max_simple[length(mass_max_simple)], - length = mass_diff * int_factor) - sigma <- get_stdev(mass_vector2, int_max_simple) - scale <- optimize_gaussfit(mass_vector2, int_max_simple, sigma, mass_max) - - # get an estimate of the area under the peak - area <- estimate_area(mass_max, resol, scale, sigma, int_factor) - # put all values for this region of interest into a list - roi_value_list <- list("mean" = mass_max, - "area" = area, - "min" = mass_vector2[1], - "max" = mass_vector2[length(mass_vector2)]) - return(roi_value_list) -} diff --git a/DIMS/Utils/fit_peaks.R b/DIMS/Utils/fit_peaks.R deleted file mode 100644 index 02d5408..0000000 --- a/DIMS/Utils/fit_peaks.R +++ /dev/null @@ -1,381 +0,0 @@ -## adapted from fit1Peak.R, fit2peaks.R, fit3peaks.R and fit4peaks.R (combined) -# variables with fixed values will be removed from function parameters -# plot, int_factor -fit_1peak <- function(mass_vector2, mass_vector, int_vector, max_index, scale, resol, plot, fit_quality, use_bounds) { - #' Fit 1 Gaussian peak in small region of m/z - #' - #' @param mass_vector2: Vector of equally spaced m/z values (float) - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Value used to calculate area under Gaussian curve (integer) - #' @param max_index: Index in int_vector with the highest intensity (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param fit_quality: Value indicating quality of fit of Gaussian curve (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' - #' @return roi_value_list: list of fit values for region of interest (list) - - if (length(int_vector) < 3) { - message("Range too small, no fit possible!") - } else { - if ((length(int_vector) == 4)) { - # fit 1 peak - mu <- weighted.mean(mass_vector, int_vector) - sigma <- get_stdev(mass_vector, int_vector) - fitted_peak <- fit_1gaussian(mass_vector, int_vector, sigma, mu, scale, use_bounds) - } else { - # set range vector - if ((length(mass_vector) - length(max_index)) < 2) { - range1 <- c((length(mass_vector) - 4) : length(mass_vector)) - } else if (length(max_index) < 2) { - range1 <- c(1:5) - } else { - range1 <- c(max_index[1] - 2, max_index[1] - 1, max_index[1], max_index[1] + 1, max_index[1] + 2) - } - if (range1[1] == 0) range1 <- range1[-1] - # remove NA - if (length(which(is.na(int_vector[range1]))) != 0) { - range1 <- range1[-which(is.na(int_vector[range1]))] - } - # fit 1 peak - mu <- weighted.mean(mass_vector[range1], int_vector[range1]) - sigma <- get_stdev(mass_vector[range1], int_vector[range1]) - fitted_peak <- fit_1gaussian(mass_vector, int_vector, sigma, mu, scale, use_bounds) - } - - p1 <- fitted_peak$par - - # get new value for fit quality and scale - fq_new <- get_fit_quality(mass_vector, int_vector, p1[1], p1[1], resol, p1[2], sigma)$fq_new - scale_new <- 1.2 * scale - - # bad fit - if (fq_new > fit_quality) { - # optimize scaling factor - fq <- 0 - scale <- 0 - if (sum(int_vector) > sum(p1[2] * dnorm(mass_vector, p1[1], sigma))) { - while ((round(fq, digits = 3) != round(fq_new, digits = 3)) && (scale_new < 10000)) { - fq <- fq_new - scale <- scale_new - # fit 1 peak - fitted_peak <- fit_1gaussian(mass_vector, int_vector, sigma, mu, scale, use_bounds) - p1 <- fitted_peak$par - # get new value for fit quality and scale - fq_new <- get_fit_quality(mass_vector, int_vector, p1[1], p1[1], resol, p1[2], sigma)$fq_new - scale_new <- 1.2 * scale - } - } else { - while ((round(fq, digits = 3) != round(fq_new, digits = 3)) && (scale_new < 10000)) { - fq <- fq_new - scale <- scale_new - # fit 1 peak - fitted_peak <- fit_1gaussian(mass_vector, int_vector, sigma, mu, scale, use_bounds) - p1 <- fitted_peak$par - # get new value for fit quality and scale - fq_new <- get_fit_quality(mass_vector, int_vector, p1[1], p1[1], resol, p1[2], sigma)$fq_new - scale_new <- 0.8 * scale - } - } - # use optimized scale factor to fit 1 peak - if (fq < fq_new) { - fitted_peak <- fit_1gaussian(mass_vector, int_vector, sigma, mu, scale, use_bounds) - p1 <- fitted_peak$par - fq_new <- fq - } - } - } - - roi_value_list <- list("mean" = p1[1], "scale" = p1[2], "sigma" = sigma, "qual" = fq_new) - return(roi_value_list) -} - -fit_2peaks <- function(mass_vector2, mass_vector, int_vector, max_index, scale, resol, use_bounds = FALSE, - plot = FALSE, fit_quality, int_factor) { - #' Fit 2 Gaussian peaks in small region of m/z - #' - #' @param mass_vector2: Vector of equally spaced m/z values (float) - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Value used to calculate area under Gaussian curve (integer) - #' @param max_index: Index in int_vector with the highest intensity (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param fit_quality: Value indicating quality of fit of Gaussian curve (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' - #' @return roi_value_list: list of fit values for region of interest (list) - - peak_mean <- NULL - peak_area <- NULL - peak_scale <- NULL - peak_sigma <- NULL - - # set range vectors for 2 peaks - range1 <- c(max_index[1] - 2, max_index[1] - 1, max_index[1], max_index[1] + 1, max_index[1] + 2) - if (range1[1] == 0) range1 <- range1[-1] - range2 <- c(max_index[2] - 2, max_index[2] - 1, max_index[2], max_index[2] + 1, max_index[2] + 2) - if (length(mass_vector) < range2[length(range2)]) range2 <- range2[-length(range2)] - range1 <- check_overlap(range1, range2)[[1]] - range2 <- check_overlap(range1, range2)[[2]] - # check for negative or 0 - remove <- which(range1 < 1) - if (length(remove) > 0) range1 <- range1[-remove] - remove <- which(range2 < 1) - if (length(remove) > 0) range2 <- range2[-remove] - # remove NA - if (length(which(is.na(int_vector[range1]))) != 0) range1 <- range1[-which(is.na(int_vector[range1]))] - if (length(which(is.na(int_vector[range2]))) != 0) range2 <- range2[-which(is.na(int_vector[range2]))] - - # fit 2 peaks, first separately, then together - mu1 <- weighted.mean(mass_vector[range1], int_vector[range1]) - sigma1 <- get_stdev(mass_vector[range1], int_vector[range1]) - fitted_peak <- fit_1gaussian(mass_vector[range1], int_vector[range1], sigma1, mu1, scale, use_bounds) - p1 <- fitted_peak$par - # second peak - mu2 <- weighted.mean(mass_vector[range2], int_vector[range2]) - sigma2 <- get_stdev(mass_vector[range2], int_vector[range2]) - fitted_peak <- fit_1gaussian(mass_vector[range2], int_vector[range2], sigma2, mu2, scale, use_bounds) - p2 <- fitted_peak$par - # combined - fitted_2peaks <- fit_2gaussians(mass_vector, int_vector, sigma1, sigma2, p1[1], p1[2], p2[1], p2[2], use_bounds) - pc <- fitted_2peaks$par - - # get fit quality - if (is.null(sigma2)) sigma2 <- sigma1 - sum_fit <- (pc[2] * dnorm(mass_vector, pc[1], sigma1)) + - (pc[4] * dnorm(mass_vector, pc[3], sigma2)) - fq <- get_fit_quality(mass_vector, int_vector, sort(c(pc[1], pc[3]))[1], sort(c(pc[1], pc[3]))[2], - resol, sum_fit = sum_fit)$fq_new - - # get parameter values - area1 <- estimate_area(pc[1], resol, pc[2], sigma1, int_factor) - area2 <- estimate_area(pc[3], resol, pc[4], sigma2, int_factor) - peak_area <- c(peak_area, area1) - peak_area <- c(peak_area, area2) - peak_mean <- c(peak_mean, pc[1]) - peak_mean <- c(peak_mean, pc[3]) - peak_scale <- c(peak_scale, pc[2]) - peak_scale <- c(peak_scale, pc[4]) - peak_sigma <- c(peak_sigma, sigma1) - peak_sigma <- c(peak_sigma, sigma2) - - roi_value_list <- list("mean" = peak_mean, "scale" = peak_scale, "sigma" = peak_sigma, "area" = peak_area, "qual" = fq) - return(roi_value_list) -} - -fit_3peaks <- function(mass_vector2, mass_vector, int_vector, max_index, scale, resol, use_bounds = FALSE, - plot = FALSE, fit_quality, int_factor) { - #' Fit 3 Gaussian peaks in small region of m/z - #' - #' @param mass_vector2: Vector of equally spaced m/z values (float) - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Value used to calculate area under Gaussian curve (integer) - #' @param max_index: Index in int_vector with the highest intensity (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param fit_quality: Value indicating quality of fit of Gaussian curve (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' - #' @return roi_value_list: list of fit values for region of interest (list) - - peak_mean <- NULL - peak_area <- NULL - peak_scale <- NULL - peak_sigma <- NULL - - # set range vectors for 3 peaks - range1 <- c(max_index[1] - 2, max_index[1] - 1, max_index[1], max_index[1] + 1, max_index[1] + 2) - range2 <- c(max_index[2] - 2, max_index[2] - 1, max_index[2], max_index[2] + 1, max_index[2] + 2) - range3 <- c(max_index[3] - 2, max_index[3] - 1, max_index[3], max_index[3] + 1, max_index[3] + 2) - remove <- which(range1 < 1) - if (length(remove) > 0) { - range1 <- range1[-remove] - } - remove <- which(range2 < 1) - if (length(remove) > 0) { - range2 <- range2[-remove] - } - if (length(mass_vector) < range3[length(range3)]) range3 <- range3[-length(range3)] - range1 <- check_overlap(range1, range2)[[1]] - range2 <- check_overlap(range1, range2)[[2]] - range2 <- check_overlap(range2, range3)[[1]] - range3 <- check_overlap(range2, range3)[[2]] - # check for negative or 0 - remove <- which(range1 < 1) - if (length(remove) > 0) range1 <- range1[-remove] - remove <- which(range2 < 1) - if (length(remove) > 0) range2 <- range2[-remove] - remove <- which(range3 < 1) - if (length(remove) > 0) range3 <- range3[-remove] - # remove NA - if (length(which(is.na(int_vector[range1]))) != 0) range1 <- range1[-which(is.na(int_vector[range1]))] - if (length(which(is.na(int_vector[range2]))) != 0) range2 <- range2[-which(is.na(int_vector[range2]))] - if (length(which(is.na(int_vector[range3]))) != 0) range3 <- range3[-which(is.na(int_vector[range3]))] - - # fit 3 peaks, first separately, then together - mu1 <- weighted.mean(mass_vector[range1], int_vector[range1]) - sigma1 <- get_stdev(mass_vector[range1], int_vector[range1]) - fitted_peak <- fit_1gaussian(mass_vector[range1], int_vector[range1], sigma1, mu1, scale, use_bounds) - p1 <- fitted_peak$par - # second peak - mu2 <- weighted.mean(mass_vector[range2], int_vector[range2]) - sigma2 <- get_stdev(mass_vector[range2], int_vector[range2]) - fitted_peak <- fit_1gaussian(mass_vector[range2], int_vector[range2], sigma2, mu2, scale, use_bounds) - p2 <- fitted_peak$par - # third peak - mu3 <- weighted.mean(mass_vector[range3], int_vector[range3]) - sigma3 <- get_stdev(mass_vector[range3], int_vector[range3]) - fitted_peak <- fit_1gaussian(mass_vector[range3], int_vector[range3], sigma3, mu3, scale, use_bounds) - p3 <- fitted_peak$par - # combined - fitted_3peaks <- fit_3gaussians(mass_vector, int_vector, sigma1, sigma2, sigma3, - p1[1], p1[2], p2[1], p2[2], p3[1], p3[2], use_bounds) - pc <- fitted_3peaks$par - - # get fit quality - sum_fit = (pc[2] * dnorm(mass_vector, pc[1], sigma1)) + - (pc[4] * dnorm(mass_vector, pc[3], sigma2)) + - (pc[6] * dnorm(mass_vector, pc[5], sigma3)) - fq <- get_fit_quality(mass_vector, int_vector, sort(c(pc[1], pc[3], pc[5]))[1], sort(c(pc[1], pc[3], pc[5]))[3], - resol, sum_fit = sum_fit)$fq_new - - # get parameter values - area1 <- estimate_area(pc[1], resol, pc[2], sigma1, int_factor) - area2 <- estimate_area(pc[3], resol, pc[4], sigma2, int_factor) - area3 <- estimate_area(pc[5], resol, pc[6], sigma3, int_factor) - peak_area <- c(peak_area, area1) - peak_area <- c(peak_area, area2) - peak_area <- c(peak_area, area3) - peak_mean <- c(peak_mean, pc[1]) - peak_mean <- c(peak_mean, pc[3]) - peak_mean <- c(peak_mean, pc[5]) - peak_scale <- c(peak_scale, pc[2]) - peak_scale <- c(peak_scale, pc[4]) - peak_scale <- c(peak_scale, pc[6]) - peak_sigma <- c(peak_sigma, sigma1) - peak_sigma <- c(peak_sigma, sigma2) - peak_sigma <- c(peak_sigma, sigma3) - - roi_value_list <- list("mean" = peak_mean, "scale" = peak_scale, "sigma" = peak_sigma, "area" = peak_area, "qual" = fq) - return(roi_value_list) -} - -fit_4peaks <- function(mass_vector2, mass_vector, int_vector, max_index, scale, resol, use_bounds = FALSE, - plot = FALSE, fit_quality, int_factor) { - #' Fit 4 Gaussian peaks in small region of m/z - #' - #' @param mass_vector2: Vector of equally spaced m/z values (float) - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Value used to calculate area under Gaussian curve (integer) - #' @param max_index: Index in int_vector with the highest intensity (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param fit_quality: Value indicating quality of fit of Gaussian curve (float) - #' @param use_bounds: Boolean to indicate whether boundaries are to be used - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' - #' @return roi_value_list: list of fit values for region of interest (list) - - peak_mean <- NULL - peak_area <- NULL - peak_scale <- NULL - peak_sigma <- NULL - - # set range vectors for 4 peaks - range1 <- c(max_index[1] - 2, max_index[1] - 1, max_index[1], max_index[1] + 1, max_index[1] + 2) - range2 <- c(max_index[2] - 2, max_index[2] - 1, max_index[2], max_index[2] + 1, max_index[2] + 2) - range3 <- c(max_index[3] - 2, max_index[3] - 1, max_index[3], max_index[3] + 1, max_index[3] + 2) - range4 <- c(max_index[4] - 2, max_index[4] - 1, max_index[4], max_index[4] + 1, max_index[4] + 2) - if (range1[1] == 0) range1 <- range1[-1] - if (length(mass_vector) < range4[length(range4)]) range4 <- range4[-length(range4)] - range1 <- check_overlap(range1, range2)[[1]] - range2 <- check_overlap(range1, range2)[[2]] - range2 <- check_overlap(range2, range3)[[1]] - range3 <- check_overlap(range2, range3)[[2]] - range3 <- check_overlap(range3, range4)[[1]] - range4 <- check_overlap(range3, range4)[[2]] - remove <- which(range4 > length(mass_vector)) - if (length(remove) > 0) { - range4 <- range4[-remove] - } - # check for negative or 0 - remove <- which(range1 < 1) - if (length(remove) > 0) range1 <- range1[-remove] - remove <- which(range2 < 1) - if (length(remove) > 0) range2 <- range2[-remove] - remove <- which(range3 < 1) - if (length(remove) > 0) range3 <- range3[-remove] - remove <- which(range4 < 1) - if (length(remove) > 0) range4 <- range4[-remove] - # remove NA - if (length(which(is.na(int_vector[range1]))) != 0) range1 <- range1[-which(is.na(int_vector[range1]))] - if (length(which(is.na(int_vector[range2]))) != 0) range2 <- range2[-which(is.na(int_vector[range2]))] - if (length(which(is.na(int_vector[range3]))) != 0) range3 <- range3[-which(is.na(int_vector[range3]))] - if (length(which(is.na(int_vector[range4]))) != 0) range4 <- range4[-which(is.na(int_vector[range4]))] - - # fit 4 peaks, first separately, then together - mu1 <- weighted.mean(mass_vector[range1], int_vector[range1]) - sigma1 <- get_stdev(mass_vector[range1], int_vector[range1]) - fitted_peak <- fit_1gaussian(mass_vector[range1], int_vector[range1], sigma1, mu1, scale, use_bounds) - p1 <- fitted_peak$par - # second peak - mu2 <- weighted.mean(mass_vector[range2], int_vector[range2]) - sigma2 <- get_stdev(mass_vector[range2], int_vector[range2]) - fitted_peak <- fit_1gaussian(mass_vector[range2], int_vector[range2], sigma2, mu2, scale, use_bounds) - p2 <- fitted_peak$par - # third peak - mu3 <- weighted.mean(mass_vector[range3], int_vector[range3]) - sigma3 <- get_stdev(mass_vector[range3], int_vector[range3]) - fitted_peak <- fit_1gaussian(mass_vector[range3], int_vector[range3], sigma3, mu3, scale, use_bounds) - p3 <- fitted_peak$par - # fourth peak - mu4 <- weighted.mean(mass_vector[range4], int_vector[range4]) - sigma4 <- get_stdev(mass_vector[range4], int_vector[range4]) - fitted_peak <- fit_1gaussian(mass_vector[range4], int_vector[range4], sigma4, mu4, scale, use_bounds) - p4 <- fitted_peak$par - # combined - fitted_4peaks <- fit_4gaussians(mass_vector, int_vector, sigma1, sigma2, sigma3, sigma3, - p1[1], p1[2], p2[1], p2[2], p3[1], p3[2], p4[1], p4[2], use_bounds) - pc <- fitted_4peaks$par - - # get fit quality - sum_fit <- (pc[2] * dnorm(mass_vector, pc[1], sigma1)) + - (pc[4] * dnorm(mass_vector, pc[3], sigma2)) + - (pc[6] * dnorm(mass_vector, pc[5], sigma3)) + - (pc[8] * dnorm(mass_vector, pc[7], sigma3)) - fq <- get_fit_quality(mass_vector, int_vector, - sort(c(pc[1], pc[3], pc[5], pc[7]))[1], sort(c(pc[1], pc[3], pc[5], pc[7]))[4], - resol, sum_fit = sum_fit)$fq_new - - # get parameter values - area1 <- estimate_area(pc[1], resol, pc[2], sigma1, int_factor) - area2 <- estimate_area(pc[3], resol, pc[4], sigma2, int_factor) - area3 <- estimate_area(pc[5], resol, pc[6], sigma3, int_factor) - area4 <- estimate_area(pc[7], resol, pc[8], sigma4, int_factor) - peak_area <- c(peak_area, area1) - peak_area <- c(peak_area, area2) - peak_area <- c(peak_area, area3) - peak_area <- c(peak_area, area4) - peak_mean <- c(peak_mean, pc[1]) - peak_mean <- c(peak_mean, pc[3]) - peak_mean <- c(peak_mean, pc[5]) - peak_mean <- c(peak_mean, pc[7]) - peak_scale <- c(peak_scale, pc[2]) - peak_scale <- c(peak_scale, pc[4]) - peak_scale <- c(peak_scale, pc[6]) - peak_scale <- c(peak_scale, pc[8]) - peak_sigma <- c(peak_sigma, sigma1) - peak_sigma <- c(peak_sigma, sigma2) - peak_sigma <- c(peak_sigma, sigma3) - peak_sigma <- c(peak_sigma, sigma4) - - roi_value_list <- list("mean" = peak_mean, "scale" = peak_scale, "sigma" = peak_sigma, "area" = peak_area, "qual" = fq) - return(roi_value_list) -} - diff --git a/DIMS/Utils/get_element_info.R b/DIMS/Utils/get_element_info.R deleted file mode 100644 index a619f6a..0000000 --- a/DIMS/Utils/get_element_info.R +++ /dev/null @@ -1,24 +0,0 @@ -## adapted from elementInfo.R, which is adapted from Rdisop function .getElement -# refactor: check where library is initialised: library(Rdisop) -get_element_info <- function(name, elements = NULL) { - #' Get info on m/z and isotopes for all chemical elements - #' - #' @param name: Name of adduct, e.g. Na (string) - #' @param elements: List of all adducts to take into account (list of strings) - #' - #' @return element_info: peak group list with filled-in intensities (matrix) - - # get information on all elements - if (!is.list(elements) || length(elements) == 0 ) { - elements <- initializePSE() - } - # extract information for a particular adduct - if (name == "CH3OH+H") { - # regular_expr should be exact match for name, except for methanol - regular_expr <- "^CH3OH\\+H$" - } else { - regular_expr <- paste0("^", name, "$") - } - element_info <- elements[[grep(regular_expr, sapply(elements, function(x) { x$name }))]] - return(element_info) -} \ No newline at end of file diff --git a/DIMS/Utils/get_fit_quality.R b/DIMS/Utils/get_fit_quality.R deleted file mode 100644 index 23b1947..0000000 --- a/DIMS/Utils/get_fit_quality.R +++ /dev/null @@ -1,34 +0,0 @@ -## adapted from getFitQuality.R -# parameter not used: mu_last -get_fit_quality <- function(mass_vector, int_vector, mu_first, mu_last, resol, scale = NULL, sigma = NULL, sum_fit = NULL) { - #' Fit 1 Gaussian peak in small region of m/z - #' - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Value used to calculate area under Gaussian curve (integer) - #' @param mu_first: Value for first peak (float) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param sum_fit: Value indicating quality of fit of Gaussian curve (float) - #' - #' @return list_params: list of parameters indicating quality of fit (list) - if (is.null(sum_fit)) { - mass_vector_int <- mass_vector - int_vector_int <- int_vector - # get new fit quality - fq_new <- mean(abs((scale * dnorm(mass_vector_int, mu_first, sigma)) - int_vector_int) / - rep((max(scale * dnorm(mass_vector_int, mu_first, sigma)) / 2), length(mass_vector_int))) - } else { - sum_fit_int <- sum_fit - int_vector_int <- int_vector - mass_vector_int <- mass_vector - # get new fit quality - fq_new <- mean(abs(sum_fit_int - int_vector_int) / rep(max(sum_fit_int) /2, length(sum_fit_int))) - } - - # Prevent division by 0 - if (is.nan(fq_new)) fq_new <- 1 - - list_params <- list("fq_new" = fq_new, "x_int" = mass_vector_int, "y_int" = int_vector_int) - return(list_params) -} - diff --git a/DIMS/Utils/get_fwhm.R b/DIMS/Utils/get_fwhm.R deleted file mode 100644 index 7543921..0000000 --- a/DIMS/Utils/get_fwhm.R +++ /dev/null @@ -1,21 +0,0 @@ -## adapted from getFwhm.R -get_fwhm <- function(query_mass, resol) { - #' Calculate fwhm (full width at half maximum intensity) for a peak - #' - #' @param query_mass: Value for mass (float) - #' @param resol: Value for resolution (integer) - #' - #' @return fwhm: Value for full width at half maximum (float) - - # set aberrant values of query_mass to zero - if (is.nan(query_mass)) query_mass <- 0 - if (is.na(query_mass)) query_mass <- 0 - if (is.null(query_mass)) query_mass <- 0 - if (query_mass < 0) query_mass <- 0 - # calculate resolution at given m/z value - resol_mz <- resol * (1 / sqrt(2) ^ (log2(query_mass / 200))) - # calculate full width at half maximum - fwhm <- query_mass / resol_mz - return(fwhm) -} - diff --git a/DIMS/Utils/get_patient_data_to_helix.R b/DIMS/Utils/get_patient_data_to_helix.R deleted file mode 100644 index 1eeaf7a..0000000 --- a/DIMS/Utils/get_patient_data_to_helix.R +++ /dev/null @@ -1,39 +0,0 @@ -get_patient_data_to_helix <- function(metab_interest_sorted, metab_list_all) { - #' Get patient data to be uploaded to Helix - #' - #' @param metab_interest_sorted: list of dataframes with metabolite Z-scores for each sample/patient (list) - #' @param metab_list_all: list of tables with metabolites for Helix and violin plots (list) - #' - #' @return: dataframe with patient data with only metabolites for Helix and violin plots - #' with Helix name, high/low Z-score cutoffs - - # Combine Z-scores of metab groups together - df_all_metabs_zscores <- bind_rows(metab_interest_sorted) - # Change columnnames - colnames(df_all_metabs_zscores) <- c("HMDB_name", "Patient", "Z_score") - # Change Patient column to character instead of factor - df_all_metabs_zscores$Patient <- as.character(df_all_metabs_zscores$Patient) - - # Delete whitespaces HMDB_name - df_all_metabs_zscores$HMDB_name <- str_trim(df_all_metabs_zscores$HMDB_name, "right") - - # Split HMDB_name column on "nitine;" for match dims_helix_table - df_all_metabs_zscores$HMDB_name_split <- str_split_fixed(df_all_metabs_zscores$HMDB_name, "nitine;", 2)[, 1] - - # Combine stofgroepen - dims_helix_table <- bind_rows(metab_list_all) - # Filter table for metabolites for Helix - dims_helix_table <- dims_helix_table %>% filter(Helix == "ja") - # Split HMDB_name column on "nitine;" for match df_all_metabs_zscores - dims_helix_table$HMDB_name_split <- str_split_fixed(dims_helix_table$HMDB_name, "nitine;", 2)[, 1] - dims_helix_table <- dims_helix_table %>% select(HMDB_name_split, Helix_naam, high_zscore, low_zscore) - - # Filter DIMS results for metabolites for Helix - df_metabs_helix <- df_all_metabs_zscores %>% filter(HMDB_name_split %in% dims_helix_table$HMDB_name_split) - # Combine dims_helix_table and df_metabs_helix, adding Helix codes etc. - df_metabs_helix <- df_metabs_helix %>% left_join(dims_helix_table, by = join_by(HMDB_name_split)) - - df_metabs_helix <- df_metabs_helix %>% select(HMDB_name, Patient, Z_score, Helix_naam, high_zscore, low_zscore) - - return(df_metabs_helix) -} diff --git a/DIMS/Utils/get_stdev.R b/DIMS/Utils/get_stdev.R deleted file mode 100644 index a385187..0000000 --- a/DIMS/Utils/get_stdev.R +++ /dev/null @@ -1,22 +0,0 @@ -## adapted from getSD.R -get_stdev <- function(mass_vector, int_vector, resol = 140000) { - #' Calculate standard deviation to determine width of a peak - #' - #' @param mass_vector: Vector of 3 mass values (float) - #' @param int_vector: Vector of 3 intensities (float) - #' @param resol: Value for resolution (integer) - #' - #' @return stdev: Value for standard deviation - # find maximum intensity in vector - max_index <- which(int_vector == max(int_vector)) - # find corresponding mass at maximum intensity - max_mass <- mass_vector[max_index] - # calculate resolution at given m/z value - resol_mz <- resol * (1 / sqrt(2) ^ (log2(max_mass / 200))) - # calculate full width at half maximum - fwhm <- max_mass / resol_mz - # calculate standard deviation - stdev <- (fwhm / 2) * 0.85 - return(stdev) -} - diff --git a/DIMS/Utils/identify_noisepeaks.R b/DIMS/Utils/identify_noisepeaks.R deleted file mode 100644 index cf79279..0000000 --- a/DIMS/Utils/identify_noisepeaks.R +++ /dev/null @@ -1,103 +0,0 @@ -## adapted from ident.hires.noise.HPC -# refactor: remove variables slope, incpt, ppm_iso_fixed -# combine with function get_element_info -# modified identify function to also look for adducts and their isotopes -identify_noisepeaks <- function(peakgroup_list, all_adducts, scanmode = "Negative", look4 = c("Cl", "Ac"), - noise_mz = NULL, resol = 140000, slope = 0, incpt = 0, ppm_fixed, ppm_iso_fixed) { - #' Replace intensities that are zero with random value - #' - #' @param peakgroup_list: Peak group list (matrix) - #' @param all_adducts: List of adducts to take into account (list of strings) - #' @param scanmode: Scan mode, positive or negative (string) - #' @param look4: List of adducts to look for (list of strings) - #' @param noise_mz: All known noise peaks (matrix) - #' @param resol: Value for resolution (integer) - #' @param slope: Value for slope for mass correction (float) - #' @param incpt: Value for intercept for mass correction (float) - #' @param ppm_fixed: Value for distance between two values of mass (integer) - #' @param ppm_iso_fixed: Value for distance between two values of mass for isotope peaks (integer) - #' - #' @return final_outlist: peak group list with filled-in intensities (matrix) - - options(stringsAsFactors = FALSE) - metlin <- assi <- iso <- rep("", nrow(peakgroup_list)) - theormz <- nisos <- expint <- conf <- rep(0, nrow(peakgroup_list)) - - # add adducts to identification list - if (scanmode == "Positive") { - adduct_scanmode <- "+" - } else { - adduct_scanmode <- "-" - } - # make a copy of noise_mz - noise_mz_orig <- noise_mz - - # loop over type of adduct - for (adduct_index in 1:length(look4)) { - noise_mz_adduct <- noise_mz_orig - noise_mz_adduct[, "CompoundName"] <- as.character(noise_mz_orig[, "CompoundName"]) - - if (look4[adduct_index] == "H2O") { - add2label <- paste0("[M-", look4[adduct_index], "]", adduct_scanmode) - } else { - add2label <- paste0("[M+", look4[adduct_index], "]", adduct_scanmode) - } - - noise_mz_adduct[, "CompoundName"] <- paste0(noise_mz_adduct[, "CompoundName"], add2label) - adduct_info <- get_element_info(look4[adduct_index], all_adducts) - if (scanmode == "Positive") { - adduct_mass <- adduct_info$mass[1] + adduct_info$isotope$mass[1] - hydrogen_mass - } else { - adduct_mass <- adduct_info$mass[1] + adduct_info$isotope$mass[1] + hydrogen_mass - } - - # loop over compounds in database - for (compound_index in 1:nrow(noise_mz_adduct)) { - # construct information for compound + adduct: - if (scanmode == "Positive") { - noise_mz_adduct[compound_index, "Mpos"] <- as.numeric(noise_mz_adduct[compound_index, "Mpos"]) + adduct_mass - noise_mz_adduct[compound_index, "MNeg"] <- 0 - } else { - noise_mz_adduct[compound_index, "Mpos"] <- 0 - noise_mz_adduct[compound_index, "MNeg"] <- as.numeric(noise_mz_adduct[compound_index, "MNeg"]) + adduct_mass - } - } - noise_mz <- rbind(noise_mz, noise_mz_adduct) - } - - if (scanmode == "Positive") { - theor_mcol <- as.numeric(noise_mz[, "Mpos"]) - } else { - theor_mcol <- as.numeric(noise_mz[, "MNeg"]) - } - - # get mz information from peakgroup_list - mcol <- peakgroup_list[, "mzmed.pgrp"] - # if column with average intensities is missing, calculate it: - if (!("avg.int" %in% colnames(peakgroup_list))) { - mzmaxcol <- which(colnames(peakgroup_list) == "mzmax.pgrp") - endcol <- ncol(peakgroup_list) - peakgroup_list[, "avg.int"] <- apply(peakgroup_list[, (mzmaxcol + 1):(endcol)], 1, mean) - } - - # do indentification using own database: - for (row_index in 1:nrow(noise_mz)) { - theor_mz <- theor_mcol[row_index] - - # set tolerance for mz accuracy of main peak - mtol <- theor_mz * ppm_fixed / 1000000 - # find main peak - selp <- which(mcol > (theor_mz - mtol) & mcol < (theor_mz + mtol)) - # if there is more than one candidate peak for main, select best one based on mz_diff - if (length(selp) > 1) { - selp <- selp[abs(mcol[selp] - theor_mz) == min(abs(mcol[selp] - theor_mz))] - } - if (length(selp) == 1) { - assi[selp] <- paste(assi[selp], as.character(noise_mz[row_index, "CompoundName"]), sep = ";") - theormz[selp] <- theor_mz - } - } - - final_outlist <- cbind(peakgroup_list, assi, theormz, conf, nisos, iso, expint, metlin) - return(final_outlist) -} diff --git a/DIMS/Utils/is_diagnostic_patient.R b/DIMS/Utils/is_diagnostic_patient.R deleted file mode 100644 index 5820838..0000000 --- a/DIMS/Utils/is_diagnostic_patient.R +++ /dev/null @@ -1,11 +0,0 @@ -is_diagnostic_patient <- function(patient_column) { - #' Check for Diagnostics patients with correct patient number (e.g. starting with "P2024M") - #' - #' @param patient_column: a column from dataframe with IDs (character vector) - #' - #' @return: a logical vector with TRUE or FALSE for each element (vector) - - diagnostic_patients <- grepl("^P[0-9]{4}M", patient_column) - - return(diagnostic_patients) -} diff --git a/DIMS/Utils/merge_duplicate_rows.R b/DIMS/Utils/merge_duplicate_rows.R deleted file mode 100644 index 25afd31..0000000 --- a/DIMS/Utils/merge_duplicate_rows.R +++ /dev/null @@ -1,58 +0,0 @@ -## adapted from mergeDuplicatedRows.R -merge_duplicate_rows <- function(peakgroup_list) { - #' Merge identification info for peak groups with the same mass - #' - #' @param peakgroup_list: Peak group list (matrix) - #' - #' @return peakgroup_list_dedup: de-duplicated peak group list (matrix) - - collapse <- function(column_label, peakgroup_list, index_dup) { - #' Collapse identification info for peak groups with the same mass - #' - #' @param column_label: Name of column in peakgroup_list (string) - #' @param peakgroup_list: Peak group list (matrix) - #' @param index_dup: Index of duplicate peak group (integer) - #' - #' @return collapsed_items: Semicolon-separated list of info (string) - # get the item(s) that need to be collapsed - list_items <- as.vector(peakgroup_list[index_dup, column_label]) - # remove NA - if (length(which(is.na(list_items))) > 0) list_items <- list_items[-which(is.na(list_items))] - collapsed_items <- paste(list_items, collapse = ";") - return(collapsed_items) - } - - options(digits = 16) - collect <- NULL - remove <- NULL - - # check for peak groups with identical mass - index_dup <- which(duplicated(peakgroup_list[, "mzmed.pgrp"])) - - while (length(index_dup) > 0) { - # get the index for the peak group which is double - peaklist_index <- which(peakgroup_list[, "mzmed.pgrp"] == peakgroup_list[index_dup[1], "mzmed.pgrp"]) - single_peakgroup <- peakgroup_list[peaklist_index[1], , drop = FALSE] - - # use function collapse to concatenate info - single_peakgroup[, "assi_HMDB"] <- collapse("assi_HMDB", peakgroup_list, peaklist_index) - single_peakgroup[, "iso_HMDB"] <- collapse("iso_HMDB", peakgroup_list, peaklist_index) - single_peakgroup[, "HMDB_code"] <- collapse("HMDB_code", peakgroup_list, peaklist_index) - single_peakgroup[, "all_hmdb_ids"] <- collapse("all_hmdb_ids", peakgroup_list, peaklist_index) - single_peakgroup[, "sec_hmdb_ids"] <- collapse("sec_hmdb_ids", peakgroup_list, peaklist_index) - if (single_peakgroup[, "sec_hmdb_ids"] == ";") single_peakgroup[, "sec_hmdb_ids"] < NA - - # keep track of deduplicated entries - collect <- rbind(collect, single_peakgroup) - remove <- c(remove, peaklist_index) - - # remove current entry from index - index_dup <- index_dup[-which(peakgroup_list[index_dup, "mzmed.pgrp"] == peakgroup_list[index_dup[1], "mzmed.pgrp"])] - } - - # remove duplicate entries - if (!is.null(remove)) peakgroup_list <- peakgroup_list[-remove, ] - # append deduplicated entries - peakgroup_list_dedup <- rbind(peakgroup_list, collect) - return(peakgroup_list_dedup) -} diff --git a/DIMS/Utils/optimize_gaussfit.R b/DIMS/Utils/optimize_gaussfit.R deleted file mode 100644 index 2d7f95d..0000000 --- a/DIMS/Utils/optimize_gaussfit.R +++ /dev/null @@ -1,23 +0,0 @@ -## adapted from optimizeGauss.R -optimize_gaussfit <- function(mass_vector, int_vector, sigma, mass_max) { - #' Optimize fit of Gaussian curve to small region of m/z - #' - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param int_vector: Vector of intensities for a region of interest (float) - #' @param sigma: Value for standard deviation (float) - #' @param mass_max: Value for mass at center of peak (float) - #' - #' @return opt_fit: list of fit values for region of interest (list) - - # define optimization function for optim based on normal distribution - opt_f <- function(p, mass_vector, int_vector, sigma, mass_max) { - curve <- p * dnorm(mass_vector, mass_max, sigma) - return((max(curve) - max(int_vector))^2) - } - - # get optimal value for fitted Gaussian curve - opt_fit <- optimize(opt_f, c(0, 100000), tol = 0.0001, mass_vector, int_vector, sigma, mass_max) - - return(opt_fit$minimum) -} - diff --git a/DIMS/Utils/output_helix.R b/DIMS/Utils/output_helix.R deleted file mode 100644 index 09fa1a9..0000000 --- a/DIMS/Utils/output_helix.R +++ /dev/null @@ -1,39 +0,0 @@ -output_for_helix <- function(protocol_name, df_metabs_helix) { - #' Get the output dataframe for Helix - #' - #' @param protocol_name: protocol name (string) - #' @param df_metabs_helix: dataframe with metabolite Z-scores for patients (dataframe) - #' - #' @return: dataframe with patient metabolite Z-scores in correct format for Helix - - # Remove positive controls - df_metabs_helix <- df_metabs_helix %>% filter(is_diagnostic_patient(Patient)) - - # Add 'Vial' column, each patient has unique ID - df_metabs_helix <- df_metabs_helix %>% - group_by(Patient) %>% - mutate(Vial = cur_group_id()) %>% - ungroup() - - # Split patient number into labnummer and Onderzoeksnummer - df_metabs_helix <- add_lab_id_and_onderzoeksnummer(df_metabs_helix) - - # Add column with protocol name - df_metabs_helix$Protocol <- protocol_name - - # Change name Z_score and Helix_naam columns to Amount and Name - change_columns <- c(Amount = "Z_score", Name = "Helix_naam") - df_metabs_helix <- df_metabs_helix %>% rename(all_of(change_columns)) - - # Select only necessary columns and set them in correct order - df_metabs_helix <- df_metabs_helix %>% - select(c(Vial, labnummer, Onderzoeksnummer, Protocol, Name, Amount)) - - # Remove duplicate patient-metabolite combinations ("leucine + isoleucine + allo-isoleucin_Z-score" is added 3 times) - df_metabs_helix <- df_metabs_helix %>% - group_by(Onderzoeksnummer, Name) %>% - distinct() %>% - ungroup() - - return(df_metabs_helix) -} diff --git a/DIMS/Utils/prepare_alarmvalues.R b/DIMS/Utils/prepare_alarmvalues.R deleted file mode 100644 index 94ffbfd..0000000 --- a/DIMS/Utils/prepare_alarmvalues.R +++ /dev/null @@ -1,59 +0,0 @@ -prepare_alarmvalues <- function(pt_name, dims_helix_table) { - #' Create a dataframe with all metabolites that exceed the min and max Z-score cutoffs - #' - #' @param pt_name: patient code (string) - #' @param dims_helix_table: dataframe with metabolite Z-scores for each patient and Helix info (dataframe) - #' - #' @return: dataframe with metabolites that exceed the min and max Z-score cutoffs for the selected patient - - # extract data for patient of interest (pt_name) - pt_metabs_helix <- dims_helix_table %>% filter(Patient == pt_name) - pt_metabs_helix$Z_score <- round(pt_metabs_helix$Z_score, 2) - - # Make empty dataframes for metabolites above or below alarmvalues - pt_list_high <- data.frame(HMDB_name = character(), Z_score = numeric()) - pt_list_low <- data.frame(HMDB_name = character(), Z_score = numeric()) - - # Loop over individual metabolites - for (metab in unique(pt_metabs_helix$HMDB_name)){ - # Get data for individual metabolite - pt_metab <- pt_metabs_helix %>% filter(HMDB_name == metab) - # print(pt_metab) - - # Check if zscore is positive of negative - if (pt_metab$Z_score > 0) { - # Get specific alarmvalue for metabolite - high_zscore_cutoff_metab <- pt_metabs_helix %>% filter(HMDB_name == metab) %>% pull(high_zscore) - - # If zscore is above the alarmvalue, add to pt_list_high table - if (pt_metab$Z_score > high_zscore_cutoff_metab) { - pt_metab_high <- pt_metab %>% select(HMDB_name, Z_score) - pt_list_high <- rbind(pt_list_high, pt_metab_high) - } - } else { - # Get specific alarmvalue for metabolite - low_zscore_cutoff_metab <- pt_metabs_helix %>% filter(HMDB_name == metab) %>% pull(low_zscore) - - # If zscore is below the alarmvalue, add to pt_list_low table - if (pt_metab$Z_score < low_zscore_cutoff_metab) { - pt_metab_low <- pt_metab %>% select(HMDB_name, Z_score) - pt_list_low <- rbind(pt_list_low, pt_metab_low) - } - } - } - - # sort tables on zscore - pt_list_high <- pt_list_high %>% arrange(desc(Z_score)) - pt_list_low <- pt_list_low %>% arrange(Z_score) - # add lines for increased, decreased - extra_line1 <- c("Increased", "") - extra_line2 <- c("Decreased", "") - # combine the two lists - top_metab_pt <- rbind(extra_line1, pt_list_high, extra_line2, pt_list_low) - # remove row names - rownames(top_metab_pt) <- NULL - # change column names for display - colnames(top_metab_pt) <- c("Metabolite", "Z-score") - - return(top_metab_pt) -} diff --git a/DIMS/Utils/prepare_data.R b/DIMS/Utils/prepare_data.R deleted file mode 100644 index ea3efe5..0000000 --- a/DIMS/Utils/prepare_data.R +++ /dev/null @@ -1,51 +0,0 @@ -# unused variables will be removed: metab_list_alarm -prepare_data <- function(metab_list_all, zscore_patients_local) { - #' Combine patient Z-scores with metabolite info - #' - #' @param metab_list_all: list of dataframes with metabolite information for different stofgroepen (list) - #' @param zscore_patients_local: dataframe with metabolite Z-scores for all patient - #' - #' @return: list of dataframes for each stofgroep with data for each metabolite and patient/control per row - - # remove "_Zscore" from column (patient) names - colnames(zscore_patients_local) <- gsub("_Zscore", "", colnames(zscore_patients_local)) - # put data into pages, max 20 violin plots per page in PDF - metab_interest_sorted <- list() - metab_category <- c() - for (metab_class_index in 1:length(metab_list_all)) { - metab_class <- names(metab_list_all)[metab_class_index] - metab_list <- metab_list_all[[metab_class_index]] - if (ncol(metab_list) > 2) { - # third column are the alarm values, so reduce the data frame to 2 columns and save list - metab_list_alarm <- metab_list - metab_list <- metab_list[, c(1, 2)] - } - # make sure that all HMDB_names have 45 characters - for (metab_index in 1:length(metab_list$HMDB_name)) { - if (is.character(metab_list$HMDB_name[metab_index])) { - hmdb_name_separated <- strsplit(metab_list$HMDB_name[metab_index], "")[[1]] - } else { - hmdb_name_separated <- "strspliterror" - } - if (length(hmdb_name_separated) <= 45) { - hmdb_name_separated <- c(hmdb_name_separated, rep(" ", 45 - length(hmdb_name_separated))) - } else { - hmdb_name_separated <- c(hmdb_name_separated[1:42], "...") - } - metab_list$HMDB_name[metab_index] <- paste0(hmdb_name_separated, collapse = "") - } - # find metabolites and ratios in data frame zscore_patients_local - metab_interest <- inner_join(metab_list, zscore_patients_local[-2], by = "HMDB_code") - # remove column "HMDB_code" - metab_interest <- metab_interest[, -which(colnames(metab_interest) == "HMDB_code")] - # put the data frame in long format - metab_interest_melt <- reshape2::melt(metab_interest, id.vars = "HMDB_name") - # sort on metabolite names (HMDB_name) - sort_order <- order(metab_interest_melt$HMDB_name) - metab_interest_sorted[[metab_class_index]] <- metab_interest_melt[sort_order, ] - metab_category <- c(metab_category, metab_class) - } - names(metab_interest_sorted) <- metab_category - - return(metab_interest_sorted) -} diff --git a/DIMS/Utils/prepare_data_perpage.R b/DIMS/Utils/prepare_data_perpage.R deleted file mode 100644 index 61d2e15..0000000 --- a/DIMS/Utils/prepare_data_perpage.R +++ /dev/null @@ -1,58 +0,0 @@ -# remove default variable values -prepare_data_perpage <- function(metab_interest_sorted, metab_interest_contr, nr_plots_perpage, nr_pat = 20, nr_contr = 30) { - #' Combine patient and control data for each page of the violinplot pdf - #' - #' @param metab_interest_sorted: list of dataframes with data for each metabolite and patient (list) - #' @param metab_interest_contr: list of dataframes with data for each metabolite and control (list) - #' @param nr_plots_perpage: number of plots per page in the violinplot pdf (integer) - #' @param nr_pat: number of patients (integer) - #' @param nr_contr: number of controls (integer) - #' - #' @return: list of dataframes with metabolite Z-scores for each patient and control, - #' the length of list is the number of pages for the violinplot pdf (list) - - total_nr_pages <- 0 - metab_perpage <- list() - metab_category <- c() - for (metab_class_index in 1:length(metab_interest_sorted)) { - # split list into pages, each page containing max nr_plots_perpage (20) compounds - metab_interest_perclass <- metab_interest_sorted[[metab_class_index]] - metab_class <- names(metab_interest_sorted)[metab_class_index] - # add controls - metab_interest_contr_perclass <- metab_interest_contr[[metab_class_index]] - # number of pages for this class - nr_pages <- ceiling(length(unique(metab_interest_perclass$HMDB_name)) / nr_plots_perpage) - for (page_nr in 1:nr_pages) { - total_nr_pages <- total_nr_pages + 1 - select_rows_start <- (nr_pat * nr_plots_perpage * (page_nr - 1)) + 1 - select_rows_end <- nr_pat * nr_plots_perpage * page_nr - metab_onepage_pat <- metab_interest_perclass[select_rows_start:select_rows_end, ] - # same for controls - select_rows_start_contr <- (nr_contr * nr_plots_perpage * (page_nr - 1)) + 1 - select_rows_end_contr <- nr_contr * nr_plots_perpage * page_nr - metab_onepage_pcontr <- metab_interest_contr_perclass[select_rows_start_contr:select_rows_end_contr, ] - # add controls - metab_onepage <- rbind(metab_onepage_pat, metab_onepage_pcontr) - # if a page has fewer than nr_plots_perpage plots, fill page with empty plots - na_rows <- which(is.na(metab_onepage$HMDB_name)) - if (length(na_rows) > 0) { - # repeat the patient and control variables - metab_onepage$variable[na_rows] <- metab_onepage$variable[1:(nr_pat + nr_contr)] - # for HMDB name, substitute a number of spaces - for (row_nr in na_rows) { - metab_onepage$HMDB_name[row_nr] <- paste0(rep("_", ceiling(row_nr / (nr_pat + nr_contr))), collapse = "") - } - metab_onepage$HMDB_name <- gsub("_", " ", metab_onepage$HMDB_name) - # leave the values at NA - } - # put data for one page into object with data for all pages - metab_perpage[[total_nr_pages]] <- metab_onepage - # create list of page headers - metab_category <- c(metab_category, paste(metab_class, page_nr, sep = "_")) - } - } - # add page headers to list - names(metab_perpage) <- metab_category - - return(metab_perpage) -} diff --git a/DIMS/Utils/prepare_toplist.R b/DIMS/Utils/prepare_toplist.R deleted file mode 100644 index cc616c4..0000000 --- a/DIMS/Utils/prepare_toplist.R +++ /dev/null @@ -1,35 +0,0 @@ -prepare_toplist <- function(pt_name, zscore_patients_copy) { - #' Create a dataframe with the top 20 highest and top 10 lowest metabolites per patient - #' - #' @param pt_name: patient code (string) - #' @param zscore_patients_copy: dataframe with metabolite Z-scores per patient (dataframe) - #' - #' @return: dataframe with 30 metabolites and Z-scores (dataframe) - - # set parameters for table - top_highest <- 20 - top_lowest <- 10 - - # extract data for patient of interest (pt_name) - pt_list <- zscore_patients_copy[, c(1, 2, which(colnames(zscore_patients_copy) == pt_name))] - # sort metabolites on Z-scores for this patient - pt_list_sort <- sort(pt_list[, 3], index.return = TRUE) - # determine top highest and lowest Z-scores for this patient - pt_list_sort <- sort(pt_list[, 3], index.return = TRUE) - pt_list_low <- pt_list[pt_list_sort$ix[1:top_lowest], ] - pt_list_high <- pt_list[pt_list_sort$ix[length(pt_list_sort$ix):(length(pt_list_sort$ix) - top_highest + 1)], ] - # round off Z-scores - pt_list_low[, 3] <- round(as.numeric(pt_list_low[, 3]), 2) - pt_list_high[, 3] <- round(as.numeric(pt_list_high[, 3]), 2) - # add lines for increased, decreased - extra_line1 <- c("Increased", "", "") - extra_line2 <- c("Decreased", "", "") - top_metab_pt <- rbind(extra_line1, pt_list_high, extra_line2, pt_list_low) - # remove row names - rownames(top_metab_pt) <- NULL - - # change column names for display - colnames(top_metab_pt) <- c("HMDB_ID", "Metabolite", "Z-score") - - return(top_metab_pt) -} diff --git a/DIMS/Utils/replace_zeros.R b/DIMS/Utils/replace_zeros.R deleted file mode 100644 index 0ef06a3..0000000 --- a/DIMS/Utils/replace_zeros.R +++ /dev/null @@ -1,64 +0,0 @@ -## adapted from replaceZeros.R -# this function does two things: replace zeros with random value and identify noise peaks -# refactor: split into two functions -# remove parameters outdir and thresh -# make hard-coded path to file with noise peaks into variable -# remove variables outdir, thresh -replace_zeros <- function(peakgroup_list, repl_pattern, scanmode, resol, outdir, thresh, ppm) { - #' Replace intensities that are zero with random value - #' - #' @param peakgroup_list: Peak group list (matrix) - #' @param repl_pattern: Replication pattern (list of strings) - #' @param scanmode: Scan mode, positive or negative (string) - #' @param resol: Value for resolution (integer) - #' @param outdir: Path for output directory (string) - #' @param thresh: Value for threshold (integer) - #' @param ppm: Value for distance between two values of mass (integer) - #' - #' @return final_outlist: peak group list with filled-in intensities (matrix) - - # replace zeros - if (!is.null(peakgroup_list)) { - for (sample_index in 1:length(names(repl_pattern))) { - sample_peaks <- peakgroup_list[, names(repl_pattern)[sample_index]] - zero_intensity <- which(sample_peaks <= 0) - if (!length(zero_intensity)) { - next - } - for (zero_index in 1:length(zero_intensity)) { - area <- fit_optim(peakgroup_list[zero_intensity[zero_index], "mzmed.pgrp"], thresh, - resol, FALSE, scanmode, int_factor = 1 * 10^5, 1, 1)$area - peakgroup_list[zero_intensity[zero_index], names(repl_pattern)[sample_index]] <- rnorm(n = 1, mean = area, - sd = 0.25 * area) - } - } - - # Add column with average intensity - peakgroup_list <- cbind(peakgroup_list, "avg.int" = apply(peakgroup_list[, 7:(ncol(peakgroup_list) - 4)], 1, mean)) - - if (scanmode == "negative") { - label <- "MNeg" - label2 <- "Negative" - # look for adducts in negative mode - look4_adducts <- c("Cl", "Cl37", "For", "NaCl", "KCl", "H2PO4", "HSO4", "Na-H", "K-H", "H2O", "I") - } else { - label <- "Mpos" - label2 <- "Positive" - # look for adducts in positive mode - look4_adducts <- c("Na", "K", "NaCl", "NH4", "2Na-H", "CH3OH", "KCl", "NaK-H") - } - - # Identify noise peaks - noise_mz <- read.table(file = "/hpc/dbg_mz/tools/db/TheoreticalMZ_NegPos_incNaCl.txt", - sep = "\t", header = TRUE, quote = "") - noise_mz <- noise_mz[(noise_mz[, label] != 0), 1:4] - outlist_withnoise <- identify_noisepeaks(peakgroup_list, all_adducts, scanmode = label2, - noise_mz, look4 = look4_adducts, resol = resol, - slope = 0, incpt = 0, ppm_fixed = ppm, ppm_iso_fixed = ppm) - noise_info <- outlist_withnoise[, c("assi", "theormz")] - colnames(noise_info) <- c("assi_noise", "theormz_noise") - - final_outlist <- cbind(peakgroup_list, noise_info) - return(final_outlist) - } -} diff --git a/DIMS/Utils/search_mzrange.R b/DIMS/Utils/search_mzrange.R deleted file mode 100644 index dcdc42a..0000000 --- a/DIMS/Utils/search_mzrange.R +++ /dev/null @@ -1,180 +0,0 @@ -## adapted from searchMZRange.R -# variables with fixed values will be removed from function parameters -# int_factor, scale, outdir, plot, thresh, width, height -# allpeaks_values should be generated here, not passed on from do_peakfinding -search_mzrange <- function(ints_fullrange, allpeaks_values, int_factor, scale, resol, - outdir, sample_name, scanmode, plot, width, height, thresh) { - #' Divide the full m/z range into regions of interest with min, max and mean m/z - #' - #' @param ints_fullrange: Named list of intensities (float) - #' @param allpeaks_values: Empty list to store results for all peaks - #' @param int_factor: Value used to calculate area under Gaussian curve (integer) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param resol: Value for resolution (integer) - #' @param outdir: Path for output directory (string) - #' @param sample_name: Sample name (string) - #' @param scanmode: Scan mode, positive or negative (string) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' @param width: Value for width of plot (integer) - #' @param height: Value for height of plot (integer) - #' @param thresh: Value for noise level threshold (integer) - #' - #' @return allpeaks_values: list of m/z regions of interest - - # find indices where intensity is not equal to zero - nonzero_indices <- as.vector(which(ints_fullrange != 0)) - - # bad infusion. These should have been taken out in AverageTechReplicates - if (length(nonzero_indices) == 0) return(allpeaks_values) - - # initialize - end_index <- NULL - start_index <- nonzero_indices[1] - # maximum length of region of interest - max_roi_length <- 15 - - # find regions of interest - for (mz_index in 1:length(nonzero_indices)) { - # check whether mz_index is smaller than length(nonzero_indices). - # only false if mz_index == length(nonzero_indixes). - # second check is true at the end of a peak. - if (mz_index < length(nonzero_indices) && (nonzero_indices[mz_index + 1] - nonzero_indices[mz_index]) > 1) { - end_index <- nonzero_indices[mz_index] - # get m/z values and intensities for this region of interest - mass_vector <- as.numeric(names(ints_fullrange)[c(start_index:end_index)]) - int_vector <- as.vector(ints_fullrange[c(start_index:end_index)]) - # check whether the vector of intensities is not empty. - if (length(int_vector) != 0) { - # check if intensity is above threshold or the maximum intensity is NaN - if (max(int_vector) < thresh || is.nan(max(int_vector))) { - # go to next region of interest - start_index <- nonzero_indices[mz_index + 1] - next - } - # check if there are more intensities than maximum for region of interest - if (length(int_vector) > max_roi_length) { - # trim lowest intensities to zero - int_vector[which(int_vector < min(int_vector) * 1.1)] <- 0 - # split the range into multiple sub ranges - sub_range <- int_vector - names(sub_range) <- mass_vector - allpeaks_values <- search_mzrange(sub_range, allpeaks_values, int_factor, - scale, resol, outdir, sample_name, scanmode, - plot, width, height, thresh) - # A proper peak needs to have at least 3 intensities above threshold - } else if (length(int_vector) > 3) { - # check if the sum of intensities is above zero. Why is this necessary? - if (sum(int_vector) == 0) next - # get initial fit values - roi_values <- fit_init(mass_vector, int_vector, int_factor, scale, resol, - outdir, sample_name, scanmode, plot, width, height, - mz_index, start_index, end_index) - print(roi_values) - if (roi_values$qual[1] == 1) { - # get optimized fit values - roi_values <- fit_optim(mass_vector, int_vector, resol, plot, - scanmode, int_factor, width, height) - # add region of interest to list of all peaks - allpeaks_values$mean <- c(allpeaks_values$mean, roi_values$mean) - allpeaks_values$area <- c(allpeaks_values$area, roi_values$area) - allpeaks_values$nr <- c(allpeaks_values$nr, sample_name) - allpeaks_values$min <- c(allpeaks_values$min, roi_values$min) - allpeaks_values$max <- c(allpeaks_values$max, roi_values$max) - allpeaks_values$qual <- c(allpeaks_values$qual, 0) - allpeaks_values$spikes <- allpeaks_values$spikes + 1 - - } else { - for (j in 1:length(roi_values$mean)){ - allpeaks_values$mean <- c(allpeaks_values$mean, roi_values$mean[j]) - allpeaks_values$area <- c(allpeaks_values$area, roi_values$area[j]) - allpeaks_values$nr <- c(allpeaks_values$nr, sample_name) - allpeaks_values$min <- c(allpeaks_values$min, roi_values$min[1]) - allpeaks_values$max <- c(allpeaks_values$max, roi_values$max[1]) - allpeaks_values$qual <- c(allpeaks_values$qual, roi_values$qual[1]) - } - } - - } else { - - roi_values <- fit_optim(mass_vector, int_vector, resol, - plot, scanmode, int_factor, width, height) - allpeaks_values$mean <- c(allpeaks_values$mean, roi_values$mean) - allpeaks_values$area <- c(allpeaks_values$area, roi_values$area) - allpeaks_values$nr <- c(allpeaks_values$nr, sample_name) - allpeaks_values$min <- c(allpeaks_values$min, roi_values$min) - allpeaks_values$max <- c(allpeaks_values$max, roi_values$max) - allpeaks_values$qual <- c(allpeaks_values$qual, 0) - allpeaks_values$spikes <- allpeaks_values$spikes + 1 - } - } - start_index <- nonzero_indices[mz_index + 1] - } - } - - # last little range - end_index <- nonzero_indices[length(nonzero_indices)] - mass_vector <- as.numeric(names(ints_fullrange)[c(start_index:end_index)]) - int_vector <- as.vector(ints_fullrange[c(start_index:end_index)]) - - if (length(int_vector) != 0) { - # check if intensity above threshold - if (max(int_vector) < thresh || is.nan(max(int_vector))) { - # do nothing - } else { - # check if there are more intensities than maximum for region of interest - if (length(int_vector) > max_roi_length) { - # trim lowest intensities to zero - int_vector[which(int_vector < min(int_vector) * 1.1)] <- 0 - # split the range into multiple sub ranges - sub_range <- int_vector - names(sub_range) <- mass_vector - - allpeaks_values <- search_mzrange(sub_range, allpeaks_values, int_factor, scale, resol, - outdir, sample_name, scanmode, - plot, width, height, thresh) - - } else if (length(int_vector) > 3) { - # Check only zeros - if (sum(int_vector) == 0) next - - roi_values <- fit_init(mass_vector, int_vector, int_factor, scale, resol, - outdir, sample_name, scanmode, plot, width, height, - mz_index, start_index, end_index) - if (roi_values$qual[1] == 1) { - roi_values <- fit_optim(mass_vector, int_vector, resol, - plot, scanmode, int_factor, width, height) - - allpeaks_values$mean <- c(allpeaks_values$mean, roi_values$mean) - allpeaks_values$area <- c(allpeaks_values$area, roi_values$area) - allpeaks_values$nr <- c(allpeaks_values$nr, sample_name) - allpeaks_values$min <- c(allpeaks_values$min, roi_values$min) - allpeaks_values$max <- c(allpeaks_values$max, roi_values$max) - allpeaks_values$qual <- c(allpeaks_values$qual, 0) - allpeaks_values$spikes <- allpeaks_values$spikes + 1 - - } else { - for (j in 1:length(roi_values$mean)){ - allpeaks_values$mean <- c(allpeaks_values$mean, roi_values$mean[j]) - allpeaks_values$area <- c(allpeaks_values$area, roi_values$area[j]) - allpeaks_values$nr <- c(allpeaks_values$nr, sample_name) - allpeaks_values$min <- c(allpeaks_values$min, roi_values$min[1]) - allpeaks_values$max <- c(allpeaks_values$max, roi_values$max[1]) - allpeaks_values$qual <- c(allpeaks_values$qual, roi_values$qual[1]) - } - } - } else { - roi_values <- fit_optim(mass_vector, int_vector, resol, - plot, scanmode, int_factor, width, height) - allpeaks_values$mean <- c(allpeaks_values$mean, roi_values$mean) - allpeaks_values$area <- c(allpeaks_values$area, roi_values$area) - allpeaks_values$nr <- c(allpeaks_values$nr, sample_name) - allpeaks_values$min <- c(allpeaks_values$min, roi_values$min) - allpeaks_values$max <- c(allpeaks_values$max, roi_values$max) - allpeaks_values$qual <- c(allpeaks_values$qual, 0) - allpeaks_values$spikes <- allpeaks_values$spikes + 1 - } - } - } - return(allpeaks_values) -} - diff --git a/DIMS/Utils/sum_curves.R b/DIMS/Utils/sum_curves.R deleted file mode 100644 index 542026b..0000000 --- a/DIMS/Utils/sum_curves.R +++ /dev/null @@ -1,35 +0,0 @@ -## adapted from sumCurves.R -# variables with fixed values will be removed from function parameters -# plot -# parameter half_max not used -sum_curves <- function(mean1, mean2, scale1, scale2, sigma1, sigma2, mass_vector2, mass_vector, resol, plot) { - #' Sum two curves - #' - #' @param mean1: Value for mean m/z of first peak (float) - #' @param mean2: Value for mean m/z of second peak (float) - #' @param scale1: Initial value used to estimate scaling parameter for first peak (integer) - #' @param scale2: Initial value used to estimate scaling parameter for second peak (integer) - #' @param sigma1: Value for standard deviation for first peak (float) - #' @param sigma2: Value for standard deviation for second peak (float) - #' @param mass_vector2: Vector of equally spaced m/z values (float) - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param resol: Value for resolution (integer) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' - #' @return list_params: list of parameters indicating quality of fit (list) - - sum_fit <- (scale1 * dnorm(mass_vector2, mean1, sigma1)) + (scale2 * dnorm(mass_vector2, mean2, sigma2)) - - mean1_plus2 <- weighted.mean(c(mean1, mean2), c(max(scale1 * dnorm(mass_vector2, mean1, sigma1)), - max(scale2 * dnorm(mass_vector2, mean2, sigma2)))) - - # get new values for parameters - fwhm <- get_fwhm(mean1_plus2, resol) - area <- max(sum_fit) - scale <- scale1 + scale2 - sigma <- (fwhm / 2) * 0.85 - - list_params <- list("mean" = mean1_plus2, "area" = area, "scale" = scale, "sigma" = sigma) - return(list_params) -} - diff --git a/DIMS/Utils/sum_intensities_adducts.R b/DIMS/Utils/sum_intensities_adducts.R deleted file mode 100644 index 7b4734c..0000000 --- a/DIMS/Utils/sum_intensities_adducts.R +++ /dev/null @@ -1,76 +0,0 @@ -sum_intensities_adducts <- function(peakgroup_list, hmdb_part, adducts, z_score) { - #' Sum intensities for different adducts of the same metabolite - #' - #' @param peakgroup_list: Peak group list (matrix) - #' @param hmdb_part: Matrix of metabolites , part of the HMDB (matrix) - #' @param adducts: Vector of adducts (vector of integers) - #' @param z_score: Value indicating whether Z-scores have been calculated (integer) - #' - #' @return adductsum: peak group list with summed intensities (matrix) - hmdb_codes <- rownames(hmdb_part) - hmdb_names <- hmdb_part[, 1] - - # create overview of row indices for each metabolite_adduct combination in peaklist - hmdb_in_peaklist <- peakgroup_list$HMDB_code - # avoid rows with only "" in HMDB_code column - hmdb_in_peaklist[which(hmdb_in_peaklist == "")] <- ";" - hmdb_in_peaklist_rownr <- c() - for (row_nr in 1:length(hmdb_in_peaklist)) { - hmdb_split <- strsplit(hmdb_in_peaklist[row_nr], ";")[[1]] - hmdb_rownr <- cbind(hmdb_split, row_nr) - hmdb_in_peaklist_rownr <- rbind(hmdb_in_peaklist_rownr, hmdb_rownr) - } - hmdb_in_peaklist_rownr <- as.data.frame(hmdb_in_peaklist_rownr) - # remove NA, if any - if (sum(is.na(hmdb_in_peaklist_rownr$hmdb_split)) > 0 ) { - hmdb_in_peaklist_rownr <- hmdb_in_peaklist_rownr[-which(is.na(hmdb_in_peaklist_rownr$hmdb_split)), ] - } - - # find intensity columns in peakgroup_list - if (z_score == 1) { - int_cols_C <- grep("C", colnames(peakgroup_list)[1:which(colnames(peakgroup_list) == "avg.ctrls")]) - int_cols_P <- grep("P", colnames(peakgroup_list)[1:which(colnames(peakgroup_list) == "avg.ctrls")]) - int_cols <- c(int_cols_C, int_cols_P) - } else { - int_cols_start <- which(colnames(peakgroup_list) == "nrsamples") + 1 - int_cols_end <- which(colnames(peakgroup_list) == "assi_HMDB") - 1 - int_cols <- c(int_cols_start:int_cols_end) - } - - # initialize - names <- NULL - adductsum <- NULL - names_long <- NULL - - # find adducts of each metabolite and sum the intensities - if (length(hmdb_codes) == 0) { - return(adductsum) - } - - for (hmdb_index in 1:length(hmdb_codes)) { - compound <- hmdb_codes[hmdb_index] - compound_plus <- c(compound, paste(compound, adducts, sep = "_")) - - # find indices of rows in peakgroup_list that contain compound plus adducts - metab_row <- which(hmdb_in_peaklist_rownr$hmdb_split %in% compound_plus) - metab_indices <- as.numeric(hmdb_in_peaklist_rownr$row_nr[metab_row]) - - # find intensities and sum them - ints <- peakgroup_list[metab_indices, int_cols] - total <- apply(ints, 2, sum) - - # add to adductsum - if (sum(total) != 0) { - names <- c(names, compound) - adductsum <- rbind(adductsum, total) - names_long <- c(names_long, hmdb_names[hmdb_index]) - } - } - - if (!is.null(adductsum)) { - rownames(adductsum) <- names - adductsum <- cbind(adductsum, "HMDB_name" = names_long) - } - - return(adductsum) -} diff --git a/DIMS/Utils/within_ppm.R b/DIMS/Utils/within_ppm.R deleted file mode 100644 index abdb0d4..0000000 --- a/DIMS/Utils/within_ppm.R +++ /dev/null @@ -1,64 +0,0 @@ -## adapted from isWithinXppm.R -# variables with fixed values will be removed from function parameters -# plot -within_ppm <- function(mean, scale, sigma, area, mass_vector2, mass_vector, ppm = 4, resol, plot) { - #' Test whether two mass ranges are within ppm distance of each other - #' - #' @param mean: Value for mean m/z (float) - #' @param scale: Initial value used to estimate scaling parameter (integer) - #' @param sigma: Value for standard deviation (float) - #' @param area: Value for area under the curve (float) - #' @param mass_vector2: Vector of equally spaced m/z values (float) - #' @param mass_vector: Vector of m/z values for a region of interest (float) - #' @param ppm: Value for distance between two values of mass (integer) - #' @param resol: Value for resolution (integer) - #' @param plot: Parameter indicating whether plots should be made (boolean) - #' - #' @return list_params: list of parameters indicating quality of fit (list) - - # sort - index <- order(mean) - mean <- mean[index] - scale <- scale[index] - sigma <- sigma[index] - area <- area[index] - - summed <- NULL - remove <- NULL - - if (length(mean) > 1) { - for (i in 2:length(mean)) { - if ((abs(mean[i - 1] - mean[i]) / mean[i - 1]) * 10^6 < ppm) { - - # avoid double occurance in sum - if ((i - 1) %in% summed) next - - result_values <- sum_curves(mean[i - 1], mean[i], scale[i - 1], scale[i], sigma[i - 1], sigma[i], - mass_vector2, mass_vector, resol, plot) - summed <- c(summed, i - 1, i) - if (is.nan(result_values$mean)) result_values$mean <- 0 - mean[i - 1] <- result_values$mean - mean[i] <- result_values$mean - area[i - 1] <- result_values$area - area[i] <- result_values$area - scale[i - 1] <- result_values$scale - scale[i] <- result_values$scale - sigma[i - 1] <- result_values$sigma - sigma[i] <- result_values$sigma - - remove <- c(remove, i) - } - } - } - - if (length(remove) != 0) { - mean <- mean[-c(remove)] - area <- area[-c(remove)] - scale <- scale[-c(remove)] - sigma <- sigma[-c(remove)] - } - - list_params <- list("mean" = mean, "area" = area, "scale" = scale, "sigma" = sigma, "qual" = NULL) - return(list_params) -} - From 20391c2b0738cf1f069c3b9aa3ab5340a0317d23 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Mon, 27 Jul 2026 11:51:42 +0200 Subject: [PATCH 11/42] cleaned up DIMS/export/generate_excel_functions.R --- DIMS/export/generate_excel_functions.R | 179 +++++++++++++------------ 1 file changed, 94 insertions(+), 85 deletions(-) diff --git a/DIMS/export/generate_excel_functions.R b/DIMS/export/generate_excel_functions.R index 9cf5936..beb54dc 100644 --- a/DIMS/export/generate_excel_functions.R +++ b/DIMS/export/generate_excel_functions.R @@ -1,132 +1,141 @@ # Functions for GenerateExcel -get_intensities_cols <- function(outlist, label) { - #' Get the indices of the control columns and a dataframe of intensities of the controls - #' - #' @param outlist: dataframe with intensities for all samples - #' @param label: string used by grep to get the correct columns - #' - #' @returns: list with 2 items: - #' col_idx: vector with indices of the control columns - #' df_intensities: dataframe with the intensities of the controls - col_idx <- grep(label, colnames(outlist), fixed = TRUE) - df_intensities <- as.data.frame(outlist[, col_idx]) - colnames(df_intensities) <- colnames(outlist)[col_idx] + +#' Get the indices of the control columns and a dataframe of intensities of the controls +#' +#' @param peakgroup_list: Dataframe with intensities for all samples (matrix) +#' @param label: Label used by grep to get the correct column (string) +#' +#' @returns: List with 2 items: +#' col_idx: vector with indices of the control columns +#' df_intensities: dataframe with the intensities of the controls +get_intensities_cols <- function(peakgroup_list, label) { + # get the column indices + col_idx <- grep(label, colnames(peakgroup_list), fixed = TRUE) + # get intensity columns + df_intensities <- as.data.frame(peakgroup_list[, col_idx]) + colnames(df_intensities) <- colnames(peakgroup_list)[col_idx] + return(list(col_idx = col_idx, df_intensities = df_intensities)) } -calculate_zscores <- function(outlist, zscore_type, control_cols, stat_filter, intensity_col_ids, startcol) { - #' Calculate the Z-scores with different methods for excluding controls - #' - #' @param outlist: dataframe with intensities for all samples - #' @param zscore_type: string with method for excluding controls - #' @param control_cols: vector with indices of the control columns - #' @param stat_filter: integer used for excluding controls, either percentage or outlier threshold - #' @param intensity_col_ids: vector with indices of the samples for which to calculate Z-scores - #' @param startcol: integer of the column from where to add the Z-score columns - #' - #' @returns: outlist: same dataframe as the input with added Z-score columns +#' Calculate the Z-scores with different methods for excluding outliers in controls +#' +#' @param peakgroup_list: dataframe with intensities for all samples (matrix) +#' @param zscore_type: string with method for excluding controls +#' @param control_cols: vector with indices of the control columns +#' @param stat_filter: integer used for excluding controls, either percentage or outlier threshold +#' @param intensity_col_ids: vector with indices of the samples for which to calculate Z-scores +#' +#' @returns: peakgroup_list: same dataframe as the input with added Z-score columns (matrix) +calculate_zscores <- function(peakgroup_list, zscore_type, control_cols, stat_filter, intensity_col_ids) { # Calculate mean and sd - outlist$avg_ctrls <- 0 - outlist$sd_ctrls <- 0 - outlist$nr_ctrls <- length(control_cols) + peakgroup_list$avg_ctrls <- 0 + peakgroup_list$sd_ctrls <- 0 + peakgroup_list$nr_ctrls <- length(control_cols) if (zscore_type == "_Zscore") { # Calculate mean and sd with all controls - outlist$avg_ctrls <- apply(control_cols, 1, function(x) mean(as.numeric(x), na.rm = TRUE)) - outlist$sd_ctrls <- apply(control_cols, 1, function(x) sd(as.numeric(x), na.rm = TRUE)) + peakgroup_list$avg_ctrls <- apply(control_cols, 1, function(x) mean(as.numeric(x), na.rm = TRUE)) + peakgroup_list$sd_ctrls <- apply(control_cols, 1, function(x) sd(as.numeric(x), na.rm = TRUE)) } else { if (length(control_cols) > 3) { - for (metabolite_index in seq_len(nrow(outlist))) { + for (metabolite_index in seq_len(nrow(peakgroup_list))) { if (zscore_type == "_RobustZscore") { # Calculate mean and sd, remove outlier controls by using robust scaler - outlist$avg_ctrls[metabolite_index] <- mean(robust_scaler( - outlist[metabolite_index, control_cols], + peakgroup_list$avg_ctrls[metabolite_index] <- mean(robust_scaler( + peakgroup_list[metabolite_index, control_cols], control_cols, stat_filter )) - outlist$sd_ctrls[metabolite_index] <- sd(robust_scaler( - outlist[metabolite_index, control_cols], + peakgroup_list$sd_ctrls[metabolite_index] <- sd(robust_scaler( + peakgroup_list[metabolite_index, control_cols], control_cols, stat_filter )) } else { # Calculate mean, sd and number of remaining controls, remove outlier controls by using grubbs test intensities_without_outliers <- remove_outliers_grubbs( - as.numeric(outlist[metabolite_index, control_cols]), + as.numeric(peakgroup_list[metabolite_index, control_cols]), stat_filter ) - outlist$avg_ctrls[metabolite_index] <- mean(intensities_without_outliers) - outlist$sd_ctrls[metabolite_index] <- sd(intensities_without_outliers) - outlist$nr_ctrls[metabolite_index] <- length(intensities_without_outliers) + peakgroup_list$avg_ctrls[metabolite_index] <- mean(intensities_without_outliers) + peakgroup_list$sd_ctrls[metabolite_index] <- sd(intensities_without_outliers) + peakgroup_list$nr_ctrls[metabolite_index] <- length(intensities_without_outliers) } } } } # Calculate Z-scores - outlist_zscores <- apply(outlist[, intensity_col_ids, drop = FALSE], 2, function(col) { - (as.numeric(col) - outlist$avg_ctrls) / outlist$sd_ctrls + outlist_zscores <- apply(peakgroup_list[, intensity_col_ids, drop = FALSE], 2, function(col) { + (as.numeric(col) - peakgroup_list$avg_ctrls) / peakgroup_list$sd_ctrls }) - outlist <- cbind(outlist, outlist_zscores) - colnames(outlist)[startcol:ncol(outlist)] <- paste0(colnames(outlist)[intensity_col_ids], zscore_type) + colnames(peakgroup_list) <- paste0(colnames(peakgroup_list)[intensity_col_ids], zscore_type) + peakgroup_list <- cbind(peakgroup_list, outlist_zscores) - return(outlist) + return(peakgroup_list) } +#' Robust scaler: remove outlier values in controls +#' +#' @param control_intensities: Intensities for control samples (vector of float) +#' @param control_col_ids: Column names for control samples (vector of string) +#' @param perc: Percentage of outliers which will be removed from controls (float) +#' +#' @returns trimmed_control_intensities: Intensities trimmed for outliers (vector of float) robust_scaler <- function(control_intensities, control_col_ids, perc = 5) { - #' Calculate robust scaler: Z-score based on controls without outliers - #' - #' @param control_intensities: Matrix with intensities for control samples - #' @param control_col_ids: Vector with column names for control samples - #' @param perc: Percentage of outliers which will be removed from controls (float) - #' - #' @return trimmed_control_intensities: Intensities trimmed for outliers + # determine how many values will be removed, based on percentage nr_to_remove <- ceiling(length(control_col_ids) * perc / 100) + # sort intensities sorted_control_intensities <- sort(as.numeric(control_intensities)) + # remove highest and lowest intensities start_index <- nr_to_remove + 1 end_index <- length(sorted_control_intensities) - nr_to_remove trimmed_control_intensities <- sorted_control_intensities[start_index:end_index] + return(trimmed_control_intensities) } +#' Remove outlier values using Grubb's test +#' +#' @param control_intensities: Intensities for control samples (vector of float) +#' @param outlier_threshold: Threshold for outliers to be removed from controls (float) +#' +#' @returns trimmed_control_intensities: Intensities trimmed for outliers (vector of float) remove_outliers_grubbs <- function(control_intensities, outlier_threshold = 2) { - #' Remove outliers per metabolite according to Grubb's test - #' - #' @param control_intensities: Vector with intensities for control samples - #' @param outlier_threshold: Threshold for outliers which will be removed from controls (float) - #' - #' @return trimmed_control_intensities: Intensities trimmed for outliers + # calculate Z-scores for all intensities mean_permetabolite <- mean(as.numeric(control_intensities)) stdev_permetabolite <- sd(as.numeric(control_intensities)) zscores_permetabolite <- (control_intensities - mean_permetabolite) / stdev_permetabolite - # remove intensities with a zscore_permetabolite greater than outlier_threshold + # remove intensities with a Z-score greater than outlier_threshold if (sum(zscores_permetabolite > outlier_threshold) > 0) { trimmed_control_intensities <- control_intensities[-which(zscores_permetabolite > outlier_threshold)] } else { trimmed_control_intensities <- control_intensities } + return(trimmed_control_intensities) } +#' Save a dataframe to RData and txt +#' +#' @param df: Dataframe (matrix) +#' @param file_name: File name (string) save_to_rdata_and_txt <- function(df, file_name) { - #' Save a dataframe to RData and txt - #' - #' @param df: dataframe - #' @param file_name: string with the file name save(df, file = paste0(file_name, ".RData")) write.table(df, file = paste0(file_name, ".txt"), sep = "\t", row.names = FALSE) } +#' Set the row height and column width of the Excel +#' +#' @param wb: An openxlsx workbook (S4 object) +#' @param sheetname: Name of the workbook sheet (string) +#' @param num_rows_df: Number of rows in dataframe (integer) +#' @param num_col_df: Number of columns in dataframe (integer) +#' @param plot_width: Width of the plots to be added (integer) +#' @param plots_present: Parameter that indicates whether plots are added to the workbook (boolean) +#' +#' @returns wb: Workbook object with changed row heights and column widths set_row_height_col_width_wb <- function(wb, sheetname, num_rows_df, num_cols_df, plot_width, plots_present) { - #' Change the row height and column width of the Excel - #' - #' @param wb: an openxlsx workbook (S4 object) - #' @param sheetname: name of the workbook sheet (string) - #' @param num_rows_df: number of rows in dataframe (int) - #' @param num_col_df: number of columns in dataframe (int) - #' @param plot_width: width of the plots to be added (int) - #' @param plots_present: boolean if plots are added to the workbook (boolean) - #' - #' @returns wb: a workbook object with changed row heights and column widths if (plots_present) { openxlsx::setColWidths(wb, sheetname, cols = 1, widths = plot_width / 20) openxlsx::setRowHeights(wb, sheetname, rows = c(seq(2, num_rows_df + 1)), heights = 560 / 4) @@ -144,9 +153,10 @@ set_row_height_col_width_wb <- function(wb, sheetname, num_rows_df, num_cols_df, #' pivot to long format, arrange Samples nummerically, change Sample names, get group size and #' set Intensities to numeric. #' -#' @param intensities_df: a dataframe with HMDB_key column and intensities for all samples +#' @param intensities_df: Dataframe with HMDB_key column and intensities (matrix) +#' @param row_index: Index of row (integer) #' -#' @returns intensities_df_long: a dataframe with on each row a sample and their intensity +#' @returns intensities_df_long: Dataframe with on each row a sample and its intensity (matrix) intensities_df_to_long_format <- function(intensities_df, row_index) { intensities_df_long <- intensities_df %>% slice(row_index) %>% @@ -170,8 +180,8 @@ intensities_df_to_long_format <- function(intensities_df, row_index) { #' Create a plot of intensities of samples for Excel #' Use boxplot if group size is above 2, otherwise use a dash/line #' -#' @param intensities_df_long: a dataframe with on each row a sample and their intensity -#' @param hmdb_id: HMDB ID of the selected metabolite +#' @param intensities_df_long: Dataframe with on each row a sample and its intensity (matrix) +#' @param hmdb_id: HMDB ID of the selected metabolite (string) #' #' @returns boxplot_object: ggplot2 object containing the plot of intensities create_boxplot <- function(intensities_df_long, hmdb_id) { @@ -198,18 +208,17 @@ create_boxplot <- function(intensities_df_long, hmdb_id) { return(boxplot_object) } -#' Make and save a boxplot of intensities to an Excel workbook -#' -#' For the Helix Excel the positive controls and SST mix samples are removed. +#' Make and save a boxplot of intensities in png format and insert into an Excel workbook +#' For the Helix Excel, the positive controls and SST mix samples are removed. #' -#' @param excel_workbook: an openxlsx Workbook object -#' @param sheetname: a string containing the sheetname where the plots are to be placed -#' @param intensities_df: a dataframe containing intensities for controls and patients of a specific HMDB ID -#' @param file_path: a string containing the filepath for the png -#' @param hmdb_id: a string containing the HMDB ID that the intensities_df contains data for -#' @param plot_width: an integer containing the plot width for the png -#' @param col_width: an integer containing the width of the column that has the plots -#' @param start_row_index: an integer containing the index of the row where the plot has to be placed +#' @param excel_workbook: An openxlsx Workbook object (workbook object) +#' @param sheetname: Name of the sheet where the plots are to be placed (string) +#' @param intensities_df: Dataframe containing intensities for controls and patients of a specific HMDB ID (matrix) +#' @param file_path: Filepath for the png (string) +#' @param hmdb_id: HMDB ID corresponding to intensities_df (string) +#' @param plot_width: Plot width for the png (integer) +#' @param col_width: Width of the column that has the plots (integer) +#' @param start_row_index: Index of the row where the plot has to be placed (integer) save_plot_to_excel_workbook <- function(excel_workbook, sheetname, intensities_df, From 49506124b4c238a1cf6c990aee14cdf625e12353 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Mon, 27 Jul 2026 11:52:03 +0200 Subject: [PATCH 12/42] cleaned up DIMS/export/generate_qc_output_functions.R --- DIMS/export/generate_qc_output_functions.R | 163 +++++++++++---------- 1 file changed, 82 insertions(+), 81 deletions(-) diff --git a/DIMS/export/generate_qc_output_functions.R b/DIMS/export/generate_qc_output_functions.R index 9f672ad..4ff1be5 100644 --- a/DIMS/export/generate_qc_output_functions.R +++ b/DIMS/export/generate_qc_output_functions.R @@ -1,32 +1,33 @@ -check_number_of_controls <- function(outlist, min_num_controls, file_name) { - #' Check te number of controls for all metabolites and report findings in a txt file - #' - #' @param outlist: Dataframe with intensities and Z-scores for all samples and controls - #' @param min_num_controls: Integer that is the minimum number of controls - #' @param file_name: String containing the file name - - outlist_under_ctrls <- outlist %>% +# functions for checking the quality of the dataset (internal standards, positive controls and SST sample) + +#' Check the number of control samples for each metabolite and report findings in a txt file +#' +#' @param peakgroup_list: Dataframe with intensities and Z-scores for all samples (matrix) +#' @param min_num_controls: Minimum number of controls (integer) +#' @param file_name: Output file name (string) +check_number_of_controls <- function(peakgroup_list, min_num_controls, file_name) { + peakgroups_below_nr_control <- peakgroup_list %>% filter(nr_ctrls < min_num_controls) %>% select(HMDB_name, HMDB_code) - if (nrow(outlist_under_ctrls) == 0) { + if (nrow(peakgroups_below_nr_control) == 0) { writeLines(paste0("All metabolites have", min_num_controls, "or more controls."), file_name) } else { writeLines(paste0("These metabolites have less than", min_num_controls, "controls. \n"), file_name) - write.table(outlist_under_ctrls, file_name, append = TRUE, row.names = FALSE, col.names = TRUE, sep = "\t") + write.table(peakgroups_below_nr_control, file_name, append = TRUE, row.names = FALSE, col.names = TRUE, sep = "\t") } } +#' Get the internal standards data +#' +#' @param internal_stand_df: dataframe with all data for all the internal standards (matrix) +#' @param scanmode: positive, negative or summed (string) +#' @param is_subset_filter: filter/threshold for outlier control removal (float) +#' @param dims_matrix: matrix used, e.g. Plasma, Research, etc. (string) +#' @param rundate: date of pipeline run (Date object) +#' @param project: project name (string) +#' +#' @returns internal_stand: dataframe with the intensities of the internal standards for all samples (matrix) get_internal_standards <- function(internal_stand_df, scanmode, is_subset_filter, dims_matrix, rundate, project) { - #' Get the internal standards data - #' - #' @param internal_stand_df: dataframe with all data for all the internal standards - #' @param scanmode: positive, negative or summed (string) - #' @param is_subset_filter: filter/threshold for outlier control removal (float) - #' @param dims_matrix: matrix used, e.g. Plasma, Research, etc. (string) - #' @param rundate: date of pipeline run (Date object) - #' @param project: project name (string) - #' - #' @returns internal_stand: dataframe with the intensity of the internal standards for all samples if (scanmode == "summed") { internal_stand <- internal_stand_df[c(names(is_subset_filter), "HMDB_code")] internal_stand$HMDB_name <- internal_stand_df$name @@ -49,6 +50,16 @@ get_internal_standards <- function(internal_stand_df, scanmode, is_subset_filter return(internal_stand) } +#' Generate and save internal standard plot +#' +#' @param plot_data: Dataframe with the data to be plotted (matrix) +#' @param plot_type: Type of plot (string) +#' @param plot_title: Title for the plot (string) +#' @param outdir: Directory where the plot needs to be saved (string) +#' @param file_name: Name of the file (string) +#' @param plot_width: Width of the plot (int) +#' @param plot_height: Height of the plot (int) +#' @param hline_data: Dataframe with values for the minimal intensity line (matrix) save_internal_standard_plot <- function( plot_data, plot_type, @@ -58,17 +69,6 @@ save_internal_standard_plot <- function( plot_width, plot_height, hline_data = NULL) { - #' Generate and save internal standard plot - #' - #' @param plot_data: dataframe with the data to be plotted - #' @param plot_type: type of plot (string) - #' @param plot_title: title for the plot (string) - #' @param outdir: directory where the plot needs to be saved (string) - #' @param file_name: name of the file (string) - #' @param plot_width: width of the plot (int) - #' @param plot_height: height of the plot (int) - #' @param hline_data: values for the minimal intensity line (dataframe) - #' # Check if plot_data contains data if (nrow(plot_data) == 0) { @@ -121,16 +121,16 @@ save_internal_standard_plot <- function( ) } -get_pos_ctrl_data <- function(outlist, sample_name, hmdb_codes, hmdb_names) { - #' Get the positive control data - #' - #' @param outlist: dataframe with intensities for all samples - #' @param sample_name: positive control sample name(s) (string) - #' @param hmdb_codes: HMDB codes of the positive control metabolites (vector) - #' @param hmdb_names: HMDB names of the positive control metabolites (vector) - #' - #' @returns: pos_ctrl_data: dataframe with intensities and Z-scores of the positive control metabolites - pos_ctrl_data <- outlist[hmdb_codes, c("HMDB_code", "name", sample_name)] +#' Get the positive control data +#' +#' @param peakgroup_list: Dataframe with intensities for all samples (matrix) +#' @param sample_name: positive control sample name(s) (string) +#' @param hmdb_codes: HMDB codes of the positive control metabolites (vector) +#' @param hmdb_names: HMDB names of the positive control metabolites (vector) +#' +#' @returns: pos_ctrl_data: Dataframe with intensities and Z-scores of the positive control metabolites (matrix) +get_pos_ctrl_data <- function(peakgroup_list, sample_name, hmdb_codes, hmdb_names) { + pos_ctrl_data <- peakgroup_list[hmdb_codes, c("HMDB_code", "name", sample_name)] pos_ctrl_data <- reshape2::melt(pos_ctrl_data, id.vars = c("HMDB_code", "name")) colnames(pos_ctrl_data) <- c("HMDB_code", "HMDB_name", "Sample", "Zscore") pos_ctrl_data$HMDB_name <- hmdb_names @@ -140,26 +140,27 @@ get_pos_ctrl_data <- function(outlist, sample_name, hmdb_codes, hmdb_names) { return(pos_ctrl_data) } +#' Round numbers to a set number of digits for numeric values +#' +#' @param df: Dataframe containing numeric values (matrix) +#' @param digits: Number of digits to round off to (integer) +#' +#' @return df: Dataframe with rounded numbers (matrix) round_df <- function(df, digits) { - #' Round numbers to a set number of digits for numeric values - #' - #' @param df: Dataframe containing numeric values - #' @param digits: Number of digits to round off to (integer) - #' - #' @return df: Dataframe with rounded numbers numeric_columns <- sapply(df, mode) == "numeric" df[numeric_columns] <- round(df[numeric_columns], digits) + return(df) } +#' Get internal standard intensities +#' +#' @param is_data: Dataframe with intensities of internal standards (matrix) +#' @param int_cols: Indices of internal standard columns (vector of integers) +#' @param is_codes: Internal standard codes (vector of strings) +#' +#' @returns: is_intensities: Dataframe with intensities of internal standards (matrix) get_is_intensities <- function(is_data, int_cols = NULL, is_codes = NULL) { - #' Get internal standard intensities - #' - #' @param is_data: dataframe with intensities of internal standards - #' @param int_cols: default = NULL, if present indices of internal standard columns - #' @param is_codes: default = NULL, if present internal standard codes - #' - #' @returns: is_intensities: dataframe with intensities of internal standards if (is.null(is_codes)) { is_intensities <- is_data[, int_cols] } else { @@ -168,15 +169,16 @@ get_is_intensities <- function(is_data, int_cols = NULL, is_codes = NULL) { } is_intensities <- calc_coefficient_of_variation(is_intensities) is_intensities <- cbind(IS_name = is_data$HMDB_name, is_intensities) + return(is_intensities) } +#' Calculate coefficent of variation (cv) based on standard deviation (sd) and mean +#' +#' @param intensity_list: Intensities (matrix) +#' +#' @return intensity_list_with_cv: Intensities and cv, mean, sd (matrix) calc_coefficient_of_variation <- function(intensity_list) { - #' Calculate coefficent of variation (cv) based on standard deviation (sd) and mean - #' - #' @param intensity_list: Matrix with intensities - #' - #' @return intensity_list_with_cv: Matrix with intensities and cv, mean, sd intensity_list <- as.data.frame( apply(intensity_list, 2, function(x) round(as.numeric(x), 0)), row.names = rownames(intensity_list) @@ -190,24 +192,23 @@ calc_coefficient_of_variation <- function(intensity_list) { sd = sd_allsamples, intensity_list ) + return(intensity_list_with_cv) } +#' Check if all m/z values are present +#' +#' @param mzmed_pgrp_ident: All m/z values for a specific scanmode (vector of float) +#' @param scanmode: Scan mode, positive or negative (string) +#' +#' @return results_mz_missing: Either the missing mz values or a message that no values are missing (string) check_missing_mz <- function(mzmed_pgrp_ident, scanmode) { - #' Check if all m/z values are present - #' - #' @param mzmed_pgrp_ident: Vector of all m/z values for a specific scanmode - #' @param scanmode: String with the scanmode, positive or negative - #' - #' @return results_mz_missing: String with either the missing mz values or - #' message that no values are missing. - # retrieve all unique m/z values in whole numbers and check if all are available mzmed_pgrp_ident <- unique(round(mzmed_pgrp_ident, digits = 0)) # m/z range for a standard run = 70-600 mz_range <- seq(70, 599, by = 1) mz_missing <- setdiff(mz_range, mzmed_pgrp_ident) - # check if m/z are missing and make an .txt file with information + # check if m/z are missing and make a txt file with information mz_missing_group <- cumsum(c(1, diff(mz_missing) != 1)) if (length(mz_missing_group) > 1) { results_mz_missing <- c(paste0("Missing m/z values ", scanmode, " mode")) @@ -218,28 +219,28 @@ check_missing_mz <- function(mzmed_pgrp_ident, scanmode) { return(results_mz_missing) } +#' Create a list of all internal standards with intensity below a threshold value +#' +#' @param is_selection_subset: Intensities for each internal standard in each sample (matrix) +#' @param thresholds: Threshold values for a given scan mode and matrix (vector of integers) +#' @param is_names: Names of internal standards for a given scan mode (vector of strings) +#' @param scanmode: Scan mode to include in output (string) +#' +#' @return is_below_threshold: All samples for which internal standard intensity is below threshold (matrix) find_is_below_threshold <- function(is_selection_subset, thresholds, is_names, scanmode) { - #' Create a list of all internal standards with intensity below a threshold value - #' - #' @param is_selection_subset: Matrix with intensities for each internal standard in each sample - #' @param thresholds: Threshold values for a given scan mode and matrix - #' @param is_names: Array of names of internal standards for a given scan mode - #' @param scanmode: string indicating scan mode to include in output - #' - #' @return is_below_threshold: Matrix listing all samples for which internal standard intensity is below threshold - - # initialize; get the headers of the matrix - is_below_threshold <- is_selection_subset[0, ] # for every line, check if intensity is below the appropriate threshold + below_threshold_index <- c() for (line_index in seq_len(nrow(is_selection_subset))) { is_selected <- is_selection_subset$HMDB_name[line_index] thresh_selected <- thresholds[which(is_names == is_selected)] if (is_selection_subset$Intensity[line_index] < thresh_selected) { - is_below_threshold <- rbind(is_below_threshold, is_selection_subset[line_index, ]) + below_threshold_index <- c(below_threshold_index, line_index) } } + is_below_threshold <- is_selection_subset[below_threshold_index, ] # add information on scan mode - is_below_threshold <- cbind(is_below_threshold, scanmode = rep(scanmode, nrow(is_below_threshold))) + is_below_threshold <- cbind(is_below_threshold, scanmode = scanmode) + return(is_below_threshold) } From c0ab1bd2f7b1f05c7639374e5c852fc923d11fb5 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 30 Jul 2026 15:10:00 +0200 Subject: [PATCH 13/42] bugs fixed in peakgroup_list in DIMS/export/generate_excel_functions.R --- DIMS/export/generate_excel_functions.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/DIMS/export/generate_excel_functions.R b/DIMS/export/generate_excel_functions.R index beb54dc..2e6481d 100644 --- a/DIMS/export/generate_excel_functions.R +++ b/DIMS/export/generate_excel_functions.R @@ -36,8 +36,8 @@ calculate_zscores <- function(peakgroup_list, zscore_type, control_cols, stat_fi if (zscore_type == "_Zscore") { # Calculate mean and sd with all controls - peakgroup_list$avg_ctrls <- apply(control_cols, 1, function(x) mean(as.numeric(x), na.rm = TRUE)) - peakgroup_list$sd_ctrls <- apply(control_cols, 1, function(x) sd(as.numeric(x), na.rm = TRUE)) + peakgroup_list$avg_ctrls <- apply(peakgroup_list[, control_cols], 1, function(x) mean(as.numeric(x), na.rm = TRUE)) + peakgroup_list$sd_ctrls <- apply(peakgroup_list[, control_cols], 1, function(x) sd(as.numeric(x), na.rm = TRUE)) } else { if (length(control_cols) > 3) { for (metabolite_index in seq_len(nrow(peakgroup_list))) { @@ -69,7 +69,7 @@ calculate_zscores <- function(peakgroup_list, zscore_type, control_cols, stat_fi outlist_zscores <- apply(peakgroup_list[, intensity_col_ids, drop = FALSE], 2, function(col) { (as.numeric(col) - peakgroup_list$avg_ctrls) / peakgroup_list$sd_ctrls }) - colnames(peakgroup_list) <- paste0(colnames(peakgroup_list)[intensity_col_ids], zscore_type) + colnames(outlist_zscores) <- paste0(colnames(peakgroup_list)[intensity_col_ids], zscore_type) peakgroup_list <- cbind(peakgroup_list, outlist_zscores) return(peakgroup_list) From 1e8c0a9011b94f6f368258562926e66a0574592e Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 30 Jul 2026 15:11:33 +0200 Subject: [PATCH 14/42] cleaned up DIMS/export/generate_violin_plots_functions.R --- DIMS/export/generate_violin_plots_functions.R | 287 ++++++++++-------- 1 file changed, 152 insertions(+), 135 deletions(-) diff --git a/DIMS/export/generate_violin_plots_functions.R b/DIMS/export/generate_violin_plots_functions.R index c314ce7..32c0b33 100644 --- a/DIMS/export/generate_violin_plots_functions.R +++ b/DIMS/export/generate_violin_plots_functions.R @@ -1,12 +1,15 @@ +# functions for creating violin plot PDF output + #' Preparing the intensities and Z-score dataframe. #' Certain columns are removed, the HMDB_code and HMDB_name column are moved forward, #' the avg_ctrls and sd_ctrls columns are renamed and the column type of all columns containing numbers #' is changed to numeric. #' -#' @param intensities_zscore_df: dataframe with intensities, Z-scores and metabolite information for all samples +#' @param intensities_zscore_df: Dataframe with intensities, Z-scores and metabolite information for all +#' samples (matrix) #' -#' @returns intensities_zscore_df: a dataframe containing intensities, Z-scores, HMDB IDs, HMDB names and -#' the mean and average of all controls +#' @return intensities_zscore_df: Dataframe containing intensities, Z-scores, HMDB IDs, HMDB names and +#' renamed columns for mean and average of all controls prepare_intensities_zscore_df <- function(intensities_zscore_df) { intensities_zscore_df <- intensities_zscore_df %>% select(-c( @@ -16,41 +19,44 @@ prepare_intensities_zscore_df <- function(intensities_zscore_df) { relocate(c(HMDB_code, HMDB_name)) %>% rename(mean_controls = avg_ctrls, sd_controls = sd_ctrls) %>% mutate(across(!c(HMDB_name, HMDB_code), as.numeric)) + return(intensities_zscore_df) } -#' Get all column names containing a specific prefix. +#' Get all column names containing a specific prefix #' -#' @param dataframe: dataframe containing multiple columns with Z-scores -#' @param prefix: a string of a prefix to be searched in the column names, e.g. "P" or "C". +#' @param dataframe: Dataframe containing multiple columns with Z-scores (matrix) +#' @param prefix: Prefix to be searched in the column names, e.g. "P" or "C" (string) #' -#' @returns sample_colnames: a vector of column names all containing the prefix. +#' @return sample_colnames: Column names all containing the prefix (vector of strings) get_colnames_by_prefix <- function(dataframe, prefix) { sample_colnames <- grep(paste0("^", prefix), colnames(dataframe), value = TRUE) + return(sample_colnames) } #' Remove the suffix from a vector of names #' -#' @param vector_names: vector containing names with or without a suffix -#' @param suffix: string containing the suffix to be removed +#' @param vector_names: Names with or without a suffix (vector of strings) +#' @param suffix: Suffix to be removed (string) #' -#' @returns names_no_suffix: a vector of unique names without the suffix +#' @return names_no_suffix: Unique names without the suffix (vector of strings) remove_suffix_from_items <- function(vector_names, suffix) { names_no_suffix <- unique(gsub("_Zscore", "", vector_names)) + return(names_no_suffix) } #' Add Zscores for multiple ratios to the dataframe #' -#' @param outlist: dataframe containing intensities and Z-scores for all controls and patients -#' @param metabolites_ratios_df: dataframe containing numerators and denominators for all ratios -#' @param all_sample_ids: vector of sample IDS, controls and patients +#' @param peakgroup_list: Dataframe containing intensities and Z-scores for all controls and patients (matrix) +#' @param metabolites_ratios_df: Dataframe containing numerators and denominators for all ratios (matrix) +#' @param all_sample_ids: Sample names for controls and patients (vector of strings) #' -#' @returns intensities_zscore_ratios_df: dataframe containing intensities and Z-scores for all controls and patients -#' for all metabolites and ratios -add_zscores_ratios_to_df <- function(outlist, metabolites_ratios_df, all_sample_ids) { - intensities_zscores_df <- prepare_intensities_zscore_df(outlist) +#' @return intensities_zscore_ratios_df: Dataframe containing intensities and Z-scores for all controls and patients +#' for all metabolites and ratios (matrix) +add_zscores_ratios_to_df <- function(peakgroup_list, metabolites_ratios_df, all_sample_ids) { + intensities_zscores_df <- prepare_intensities_zscore_df(peakgroup_list) # calculate Z-scores for the ratios zscore_ratios_df <- calculate_zscore_ratios(metabolites_ratios_df, intensities_zscores_df, all_sample_ids) @@ -61,11 +67,11 @@ add_zscores_ratios_to_df <- function(outlist, metabolites_ratios_df, all_sample_ #' Calculate Z-scores for ratios #' -#' @param metabolites_ratios_df: dataframe containing numerators and denominators for all ratios -#' @param intensities_zscores_df: dataframe containing intensities and Z-scores for all controls and patients -#' @param intensity_col_names: vector of sample IDS, controls and patients +#' @param metabolites_ratios_df: Dataframe containing numerators and denominators for all ratios (matrix) +#' @param intensities_zscores_df: Dataframe containing intensities and Z-scores for all samples (matrix) +#' @param intensity_col_names: Sample names (vector of strings) #' -#' @returns zscore_ratios_df: dataframe containing Z-scores for all ratios for all samples +#' @return zscore_ratios_df: Dataframe containing Z-scores for all ratios for all samples (matrix) calculate_zscore_ratios <- function(metabolites_ratios_df, intensities_zscores_df, intensity_col_names) { # remove Z-score columns from intensity_col_names if (any(grepl("_Zscore", intensity_col_names))) { @@ -102,7 +108,7 @@ calculate_zscore_ratios <- function(metabolites_ratios_df, intensities_zscores_d intensity_col_names ) # calculate the intensity ratio for each sample - zscore_ratios_df[row_index, intensity_cols_index] <- log2(numerator_intensities / denominator_intensities) + zscore_ratios_df[row_index, intensity_cols_index] <- numerator_intensities / denominator_intensities } control_intensities_cols_index <- grep("^C[^_]*$", colnames(intensities_zscores_df), perl = TRUE) @@ -123,15 +129,15 @@ calculate_zscore_ratios <- function(metabolites_ratios_df, intensities_zscores_d #' Make and save violin plots for each patient in a PDF #' -#' @param zscore_patients_df: dataframe with Z-scores for all patient samples -#' @param zscore_controls_df: dataframe with Z-scores for all control samples -#' @param path_metabolite_groups: string containing the path for the metabolite groups directories -#' @param nr_plots_perpage: integer containing the number of metabolites on a plot per page -#' @param number_of_samples: list containing the number of patient and control samples -#' @param run_name: string containing the run name -#' @param protocol_name: string containing the protocol name -#' @param explanation_violin_plot: vector of strings containing the explanation of the violin plots -#' @param number_of_metabolites: list containing the number of metabolites for the top and lowest table +#' @param zscore_patients_df: Dataframe with Z-scores for all patient samples (matrix) +#' @param zscore_controls_df: Dataframe with Z-scores for all control samples (matrix) +#' @param path_metabolite_groups: Path for the metabolite groups directories (string) +#' @param nr_plots_perpage: Number of metabolites on a plot per page (integer) +#' @param number_of_samples: Number of patient and control samples (list of integers) +#' @param run_name: Run name (string) +#' @param protocol_name: Protocol name (string) +#' @param explanation_violin_plot: Explanation of the violin plots (vector of strings) +#' @param number_of_metabolites: Number of metabolites for the top and lowest table (list of integers) make_and_save_violin_plot_pdfs <- function( zscore_patients_df, zscore_controls_df, @@ -170,6 +176,8 @@ make_and_save_violin_plot_pdfs <- function( if (any(is_diagnostic_patients(dims_helix_table$Sample))) { # transform dataframe for Helix output output_helix <- transform_metab_df_to_helix_df(protocol_name, dims_helix_table) + # round the Z-scores to 1 decimal + output_helix$Amount <- round(output_helix$Amount, 1) # save the DIMS Helix dataframe path_helixfile <- paste0("./output_Helix_", run_name, ".csv") write.csv(output_helix, path_helixfile, quote = FALSE, row.names = FALSE) @@ -196,11 +204,11 @@ make_and_save_violin_plot_pdfs <- function( } } -#' Get a list with dataframes for all off the metabolite group in a directory +#' Get a list with dataframes for all of the metabolite group in a directory #' -#' @param dir_with_subdirs: directory containing txt files with metabolites per group (string) +#' @param dir_with_subdirs: Directory containing txt files with metabolites per group (string) #' -#' @returns list_of_dataframes: list with dataframes with info on metabolites (list of dataframes) +#' @return list_of_dataframes: Dataframes with info on metabolites (list of dataframes) get_list_dataframes_from_dir <- function(dir_with_subdirs) { # get a list of all metabolite files txt_files_paths <- list.files(dir_with_subdirs, pattern = "*.txt", recursive = FALSE, full.names = TRUE) @@ -213,11 +221,11 @@ get_list_dataframes_from_dir <- function(dir_with_subdirs) { #' Merge patient Z-scores with metabolite info #' -#' @param list_df_metabolite_groups: list of dataframes with metabolite information for different metabolite classes (list) -#' @param zscore_df: dataframe with metabolite Z-scores for all patient +#' @param list_df_metabolite_groups: Dataframes with metabolite information for different metabolite classes (list) +#' @param zscore_df: Dataframe with metabolite Z-scores for all patient (matrix) #' -#' @return list_dfs_metabs_info_zscores: list of dataframes for each metabolite class -#' containing info and zscores for all samples +#' @return list_dfs_metabs_info_zscores: Dataframes for each metabolite class +#' containing info and zscores for all samples (list) merge_metabolite_info_zscores <- function(list_df_metabolite_groups, zscore_df) { # remove HMDB_name column and "_Zscore" from column (patient) names zscore_df <- zscore_df %>% @@ -252,16 +260,16 @@ merge_metabolite_info_zscores <- function(list_df_metabolite_groups, zscore_df) return(list_dfs_metabs_info_zscores) } -#' Combine patient and control data for each page of the violinplot pdf +#' Combine patient and control data for each page of the violin plot pdf #' -#' @param metab_interest_patients: list of dataframes with data for each metabolite and patient (list) -#' @param metab_interest_controls: list of dataframes with data for each metabolite and control (list) -#' @param number_of_plots_per_page: number of plots per page in the violinplot pdf (integer) -#' @param number_of_patients: number of patients (integer) -#' @param number_of_controls: number of controls (integer) +#' @param metab_interest_patients: Dataframes with data for each metabolite and patient (list) +#' @param metab_interest_controls: Dataframes with data for each metabolite and control (list) +#' @param number_of_plots_per_page: Number of plots per page in the violinplot pdf (integer) +#' @param number_of_patients: Number of patients (integer) +#' @param number_of_controls: Number of controls (integer) #' -#' @return list_metabolite_df_per_page: list of dataframes with metabolite Z-scores for each patient and control, -#' the length of list is the number of pages for the violinplot pdf (list) +#' @return list_metabolite_df_per_page: Dataframes with metabolite Z-scores for each patient and control, +#' the length of list is the number of pages for the violin plot pdf (list) get_data_per_metabolite_class <- function( metab_interest_patients, metab_interest_controls, @@ -306,7 +314,7 @@ get_data_per_metabolite_class <- function( #' @param list_metabolite_classes: list of tables with metabolites for Helix and violin plots (list) #' #' @return df_zscores_to_helix: dataframe with patient data with only metabolites for Helix and violin plots -#' with Helix name, high/low Z-score cutoffs +#' with Helix name, high/low Z-score cutoffs prepare_helix_patient_data <- function(list_dfs_metab_classes_zscores, list_metabolite_classes) { # Combine Z-scores of metab groups together metabolite_zscore_dataframe <- bind_rows(list_dfs_metab_classes_zscores) @@ -340,13 +348,13 @@ prepare_helix_patient_data <- function(list_dfs_metab_classes_zscores, list_meta #' Getting the intensities for calculating ratio Z-scores #' Retrieving a vector of intensities for a particular fraction side of the ratios for all samples. #' -#' @param ratios_metabs_df: dataframe with HMDB codes for the ratios (dataframe) -#' @param row_index: index of the row in the ratios_metabs_df (integer) -#' @param intensities_zscore_df: dataframe with intensities for each sample (dataframe) -#' @param fraction_side: either numerator or denominator, which side of the fraction (string) -#' @param intensity_cols: names of the columns that contain the intensities (string) +#' @param ratios_metabs_df: Dataframe with HMDB codes for the ratios (matrix) +#' @param row_index: Index of the row in the ratios_metabs_df (integer) +#' @param intensities_zscore_df: Dataframe with intensities for each sample (matrix) +#' @param fraction_side: Either numerator or denominator, which side of the fraction (string) +#' @param intensity_cols: Names of the columns that contain the intensities (vector of strings) #' -#' @returns fraction_side_intensity: a vector of intensities (vector of integers) +#' @return fraction_side_intensity: Intensities (vector of floats) get_intensities_fraction_side <- function(ratios_metabs_df, row_index, intensities_zscore_df, fraction_side, intensity_cols) { # get the HMDB ID(s) for the given fraction side fraction_side_hmdb_ids <- ratios_metabs_df[row_index, fraction_side] @@ -370,31 +378,33 @@ get_intensities_fraction_side <- function(ratios_metabs_df, row_index, intensiti } # vector of intensities for all samples fraction_side_intensity <- as.numeric(fraction_side_intensity) + return(fraction_side_intensity) } #' Get the sample IDs for columns that have Z-score and intensities #' -#' @param colnames_zscore_cols: vector of sample IDs from the dataframe containing Z-scores (vector of strings) -#' @param colnames_intensity_cols: vector of sample IDs form the dataframe containing intensities (vector of strings) +#' @param colnames_zscore_cols: Column names from the dataframe containing Z-scores (vector of strings) +#' @param colnames_intensity_cols: Sample names from the dataframe containing intensities (vector of strings) #' -#' @returns colnames_intersect: vector of sample IDs that are in both input vectors, ending on "_Zscore" (vector of strings) +#' @return colnames_intersect: Sample names that are in both input vectors, ending on "_Zscore" (vector of strings) get_sample_ids_with_zscores <- function(colnames_zscore_cols, colnames_intensity_cols) { colnames_intersect <- intersect( paste0(colnames_intensity_cols, "_Zscore"), grep("_Zscore", colnames_zscore_cols, value = TRUE) ) + return(colnames_intersect) } #' Pad or truncate HMDB names to a fixed width #' Add spaces or remove HMDB name characters till the length of the name equals the 'width' #' -#' @param metabolite_info_df: A dataframe containing a column `HMDB_name` (character). -#' @param width: Integer target width for the display names. Default is 45. -#' @param pad_character: Single character used for padding. Default is a space `" "`. +#' @param metabolite_info_df: A dataframe containing columns `HMDB_code` and `HMDB_name` (matrix) +#' @param width: Target width for the display names. Default is 45 (integer) +#' @param pad_character: Single character used for padding. Default is a space `" "` (string) #' -#' @return metabolite_info_df: A dataframe where the HMDB names are transformed +#' @return metabolite_info_df: Dataframe where the HMDB names are transformed (matrix) pad_truncate_hmdb_names <- function(metabolite_info_df, width, pad_character) { # Change the HMDB_name column so all names have 45 characters # remove characters if name is longer and add "..." @@ -409,15 +419,15 @@ pad_truncate_hmdb_names <- function(metabolite_info_df, width, pad_character) { return(metabolite_info_df) } -#' Get a list of dataframes for each chunk +#' Get a list of dataframes for each chunk of list of metabolites #' For each chunk, get a dataframe containing the metabolites in that chunk and add it to the list #' -#' @param metabolites_in_chunks: list of vectors, each containing metabolites -#' @param metabolite_class_patients_df: dataframe of Z-scores for all patient -#' @param metabolite_class_controls_df: dataframe of Z-scores for all control -#' @param number_of_plots_per_page: integer containing the number of metabolites per plot per page +#' @param metabolites_in_chunks: List of metabolites (list of vectors of strings) +#' @param metabolite_class_patients_df: Dataframe of Z-scores for all patients (matrix) +#' @param metabolite_class_controls_df: Dataframe of Z-scores for all controls (matrix) +#' @param number_of_plots_per_page: Number of metabolites per plot per page (integer) #' -#' @returns page_plot_data_list: a list of dataframes containing Z-scores +#' @return patients_controls_df_chunk: List of dataframes containing Z-scores (list of matrices) get_list_page_plot_data <- function( metabolites_in_chunks, metabolite_class_patients_df, @@ -443,10 +453,10 @@ get_list_page_plot_data <- function( #' Create the order of metabolites and add empty strings if the number of metabolites is lower than #' the number of plots per page. #' -#' @param number_of_plots_per_page: integer containing the number of metabolites per plot per page -#' @param metabolite_names_chunk: list of vectors, each containing metabolites +#' @param number_of_plots_per_page: Number of metabolites per plot per page (integer) +#' @param metabolite_names_chunk: List of metabolites (list of vectors of strings) #' -#' @returns metabolite_order: a vector containing all metabolites and possibly empty strings +#' @return metabolite_order: All metabolites and possibly empty strings (vector of strings) make_metabolite_order <- function(number_of_plots_per_page, metabolite_names_chunk) { # Add empty dummy's to extend the number of metabs to the nr_plots_perpage number_of_plots_missing <- number_of_plots_per_page - length(metabolite_names_chunk) @@ -456,14 +466,16 @@ make_metabolite_order <- function(number_of_plots_per_page, metabolite_names_chu } else { metabolite_order <- metabolite_names_chunk } + return(metabolite_order) } -#' Check for Diagnostics patients with correct patient number (e.g. starting with "P2024M") +#' Check sample name for Diagnostics patients for vector of sample names +#' (e.g. starting with "PYYYYM") #' -#' @param patient_column: a column from dataframe with IDs (character vector) +#' @param patient_column: Column names from dataframe (vector of strings) #' -#' @return: a logical vector with TRUE or FALSE for each element (vector) +#' @return diagnostic_patients: Vector with TRUE or FALSE for each element (vector of booleans) is_diagnostic_patients <- function(patient_column) { diagnostic_patients <- grepl("^P[0-9]{4}M", patient_column) @@ -472,10 +484,10 @@ is_diagnostic_patients <- function(patient_column) { #' Get the output dataframe for Helix #' -#' @param protocol_name: protocol name (string) -#' @param df_metabs_helix: dataframe with metabolite Z-scores for patients (dataframe) +#' @param protocol_name: Protocol name (string) +#' @param df_metabs_helix: Dataframe with metabolite Z-scores for patients (matrix) #' -#' @return: dataframe with patient metabolite Z-scores in correct format for Helix +#' @return df_metabs_helix: Same dataframe in correct format for Helix (matrix) transform_metab_df_to_helix_df <- function(protocol_name, df_metabs_helix) { # Remove positive controls df_metabs_helix <- df_metabs_helix %>% filter(is_diagnostic_patients(Sample)) @@ -500,7 +512,7 @@ transform_metab_df_to_helix_df <- function(protocol_name, df_metabs_helix) { df_metabs_helix <- df_metabs_helix %>% select(c(Vial, labnummer, Onderzoeksnummer, Protocol, Name, Amount)) - # Remove duplicate patient-metabolite combinations ("leucine + isoleucine + allo-isoleucin_Z-score" is added 3 times) + # Remove duplicate patient-metabolite combinations df_metabs_helix <- df_metabs_helix %>% group_by(Onderzoeksnummer, Name) %>% distinct() %>% @@ -511,9 +523,9 @@ transform_metab_df_to_helix_df <- function(protocol_name, df_metabs_helix) { #' Adding labnummer and Onderzoeksnummer to a dataframe #' -#' @param df_metabs_helix: dataframe with patient data to be uploaded to Helix +#' @param df_metabs_helix: Dataframe with patient data to be uploaded to Helix (matrix) #' -#' @return: dataframe with added labnummer and Onderzoeksnummer columns +#' @return df_metabs_helix: Same dataframe with labnummer and Onderzoeksnummer columns (matrix) add_lab_id_and_onderzoeksnr <- function(df_metabs_helix) { # Split patient number into labnummer and Onderzoeksnummer for (row in seq_len(nrow(df_metabs_helix))) { @@ -521,15 +533,17 @@ add_lab_id_and_onderzoeksnr <- function(df_metabs_helix) { labnummer_split <- strsplit(as.character(df_metabs_helix[row, "labnummer"]), "M")[[1]] df_metabs_helix[row, "Onderzoeksnummer"] <- paste0("MB", labnummer_split[1], "/", labnummer_split[2]) } + return(df_metabs_helix) } #' Create a dataframe with all metabolites that exceed the min and max Z-score cutoffs #' -#' @param patient_name: patient code (string) -#' @param dims_helix_table: dataframe with metabolite Z-scores for each patient and Helix info (dataframe) +#' @param patient_name: Patient name (string) +#' @param dims_helix_table: Dataframe with metabolite Z-scores for each patient and Helix info (matrix) #' -#' @return: dataframe with metabolites that exceed the min and max Z-score cutoffs for the selected patient +#' @return top_metab_patient: Dataframe with metabolites that exceed the min and max Z-score cutoffs +#' for the selected patient (matrix) get_top_metabolites_df <- function(patient_name, dims_helix_table) { # extract data for patient of interest (patient_name) patient_metabs_helix <- dims_helix_table %>% @@ -565,12 +579,12 @@ get_top_metabolites_df <- function(patient_name, dims_helix_table) { #' Create a dataframe with the top 20 highest and top 10 lowest metabolites per patient #' -#' @param pt_name: patient code (string) -#' @param zscore_patients: dataframe with metabolite Z-scores per patient (dataframe) -#' @param top_highest: the number of metabolites with the highest Z-score to display in the table (numeric) -#' @param top_lowest: the number of metabolites with the lowest Z-score to display in the table (numeric) +#' @param patient_id: Patient name (string) +#' @param zscore_patients: Dataframe with metabolite Z-scores per patient (dataframe) +#' @param num_of_highest_metabolites: Number of metabolites with highest Z-scores to display in the table (numeric) +#' @param num_of_lowest_metabolites: Number of metabolites with lowest Z-scores to display in the table (numeric) #' -#' @return: dataframe with 30 metabolites and Z-scores (dataframe) +#' @return top_metab_patient: dataframe with 30 metabolites and Z-scores (dataframe) prepare_toplist <- function(patient_id, zscore_patients, num_of_highest_metabolites, num_of_lowest_metabolites) { patient_df <- zscore_patients %>% select(HMDB_code, HMDB_name, !!sym(patient_id)) %>% @@ -587,24 +601,24 @@ prepare_toplist <- function(patient_id, zscore_patients, num_of_highest_metaboli # add lines for increased, decreased extra_line1 <- c("Increased", "", "") extra_line2 <- c("Decreased", "", "") - top_metab_pt <- rbind(extra_line1, patient_df_high, extra_line2, patient_df_low) + top_metab_patient <- rbind(extra_line1, patient_df_high, extra_line2, patient_df_low) # remove row names - rownames(top_metab_pt) <- NULL + rownames(top_metab_patient) <- NULL # change column names for display - colnames(top_metab_pt) <- c("HMDB_ID", "Metabolite", "Z-score") + colnames(top_metab_patient) <- c("HMDB_ID", "Metabolite", "Z-score") - return(top_metab_pt) + return(top_metab_patient) } #' Create a pdf with table with metabolites and violin plots #' -#' @param pdf_dir: location where to save the pdf file (string) -#' @param patient_id: patient id (string) -#' @param metab_perpage: list of dataframes, each dataframe contains data for a page in de pdf (list) -#' @param top_metab_pt: dataframe with increased and decreased metabolites for this patient (dataframe) -#' @param explanation: text that explains the violin plots and the pipeline version (string) -create_pdf_violin_plots <- function(pdf_dir, patient_id, metab_perpage, top_metab_pt, explanation) { +#' @param pdf_dir: Location for saving the pdf file (string) +#' @param patient_id: Patient name (string) +#' @param metab_perpage: List of dataframes, each dataframe contains data for a page in de pdf (list) +#' @param top_metab_patient: Dataframe with increased and decreased metabolites for this patient (matrix) +#' @param explanation_violin_plot: Text that explains the violin plots and the pipeline version (vector of strings) +create_pdf_violin_plots <- function(pdf_dir, patient_id, metab_perpage, top_metab_patient, explanation_violin_plot) { # set parameters for plots plot_height <- 9.6 plot_width <- 6 @@ -618,13 +632,13 @@ create_pdf_violin_plots <- function(pdf_dir, patient_id, metab_perpage, top_meta # patient plots, create the PDF device patient_id_sub <- patient_id suffix <- "" - if (grepl("Diagnostics", pdf_dir) && is_diagnostic_patients(patient_id)) { + if (grepl("Diagnost", pdf_dir) && is_diagnostic_patients(patient_id)) { prefix <- "MB" suffix <- "_DIMS_PL_DIAG" # substitute P and M in P2020M00001 into right format for Helix patient_id_sub <- gsub("[PM]", "", patient_id) patient_id_sub <- gsub("\\..*", "", patient_id_sub) - } else if (grepl("Diagnostics", pdf_dir)) { + } else if (grepl("Diagnost", pdf_dir)) { prefix <- "Dx_" } else if (grepl("IEM", pdf_dir)) { prefix <- "IEM_" @@ -642,9 +656,9 @@ create_pdf_violin_plots <- function(pdf_dir, patient_id, metab_perpage, top_meta page_headers <- names(metab_perpage) # put table into PDF file, if not empty - if (!is.null(dim(top_metab_pt))) { + if (!is.null(dim(top_metab_patient))) { max_rows_per_page <- 35 - total_rows <- nrow(top_metab_pt) + total_rows <- nrow(top_metab_patient) number_of_pages <- ceiling(total_rows / max_rows_per_page) # get the names and numbers in the table aligned @@ -656,7 +670,7 @@ create_pdf_violin_plots <- function(pdf_dir, patient_id, metab_perpage, top_meta for (page in seq(number_of_pages)) { start_row <- (page - 1) * max_rows_per_page + 1 end_row <- min(page * max_rows_per_page, total_rows) - page_data <- top_metab_pt[start_row:end_row, ] + page_data <- top_metab_patient[start_row:end_row, ] table_grob <- tableGrob(page_data, theme = table_theme, rows = NULL) @@ -696,13 +710,13 @@ create_pdf_violin_plots <- function(pdf_dir, patient_id, metab_perpage, top_meta suppressWarnings(print(ggplot_object)) } - # add explanation of violin plots, version number etc. + # add explanation_violin_plot of violin plots, version number etc. plot(NA, xlim = c(0, 5), ylim = c(0, 5), bty = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "") - if (length(explanation) > 0) { - text(0.2, 5, explanation[1], pos = 4, cex = 0.8) - for (line_index in 2:length(explanation)) { + if (length(explanation_violin_plot) > 0) { + text(0.2, 5, explanation_violin_plot[1], pos = 4, cex = 0.8) + for (line_index in 2:length(explanation_violin_plot)) { text_y_position <- 5 - (line_index * 0.2) - text(-0.2, text_y_position, explanation[line_index], pos = 4, cex = 0.5) + text(-0.2, text_y_position, explanation_violin_plot[line_index], pos = 4, cex = 0.5) } } @@ -712,12 +726,12 @@ create_pdf_violin_plots <- function(pdf_dir, patient_id, metab_perpage, top_meta #' Create violin plots #' -#' @param metab_zscores_df: dataframe with Z-scores for all samples (dataframe) -#' @param patient_zscore_df: dataframe with Z-scores for the specified patient (dataframe) -#' @param sub_perpage: subtitle of the page (string) -#' @param patient_id: the patient id of the selected patient (string) +#' @param metab_zscores_df: Dataframe with Z-scores for all samples (matrix) +#' @param patient_zscore_df: Dataframe with Z-scores for the specified patient (matrix) +#' @param sub_perpage: Subtitle of the page (string) +#' @param patient_id: Patient id of the selected patient (string) #' -#' @returns ggpplot_object: a violin plot of metabolites that highlights the selected patient (ggplot object) +#' @return ggplot_object: Violin plot of metabolites that highlights the selected patient (ggplot object) create_violin_plot <- function(metab_zscores_df, patient_zscore_df, sub_perpage, patient_id) { fontsize <- 1 circlesize <- 0.8 @@ -776,11 +790,11 @@ create_violin_plot <- function(metab_zscores_df, patient_zscore_df, sub_perpage, #' Run the dIEM algorithm (DOI: 10.3390/ijms21030979) #' -#' @param expected_biomarkers_df: dataframe with information for HMDB codes about IEMs (dataframe) -#' @param zscore_patients: dataframe containing Z-scores for patient (dataframe) -#' @param sample_cols: vector containing column names with intensities and Z-scores for patients (vector) +#' @param expected_biomarkers_df: Dataframe with information for HMDB codes about IEMs (matrix) +#' @param zscore_patients_df: Dataframe containing Z-scores for all patients (matrix) +#' @param sample_cols: Column names with intensities and Z-scores for patients (vector of strings) #' -#' @returns probability_score: a dataframe with probability scores for IEMs for each patient (dataframe) +#' @return probability_score: a dataframe with probability scores for IEMs for each patient (matrix) run_diem_algorithm <- function(expected_biomarkers_df, zscore_patients_df, sample_cols) { # Rank the metabolites for each patient individually ranking_patients <- zscore_patients_df %>% @@ -852,9 +866,9 @@ run_diem_algorithm <- function(expected_biomarkers_df, zscore_patients_df, sampl #' Ranking Z-scores for a patient, separate for positive and negative Z-scores #' -#' @param zscore_col: vector with Z-scores for a single patient (vector of integers) +#' @param zscore_col: Z-scores for a single patient (vector of floats) #' -#' @returns ranking: a vector of the ranking of the Z-scores (vector of integers) +#' @return ranking: Ranking of the Z-scores (vector of integers) rank_patient_zscores <- function(zscore_col) { # Create ranking column with default NA values ranking <- rep(NA_real_, length(zscore_col)) @@ -870,10 +884,10 @@ rank_patient_zscores <- function(zscore_col) { return(ranking) } -#' Save the probability score dataframe as an Excel file +#' Save the probability score dataframe to an Excel file #' -#' @param probability_score: a dataframe containing probability scores for each patient (dataframe) -#' @param run_name: name of the run, for the file name (string) +#' @param probability_score: Dataframe containing probability scores for each patient (matrix) +#' @param run_name: Name of the run, to be included in the file name (string) save_prob_scores_to_excel <- function(probability_score, run_name) { # Create conditional formatting for output Excel sheet. Colors according to values. wb <- createWorkbook() @@ -889,16 +903,18 @@ save_prob_scores_to_excel <- function(probability_score, run_name) { #' Make and save dIEM plots #' -#' @param diem_probability_score: dataframe with dIEM probability scores -#' @param patient_col_names: vector containing all patient column names -#' @param expected_biomarkers_df: dataframe with information for HMDB codes about IEMs -#' @param zscore_patients_df: dataframe containing Z-scores for all patients -#' @param zscore_controls_df: dataframe containing Z-scores for all controls -#' @param nr_plots_perpage: integer containing the number of metabolites per page -#' @param number_of_samples: list containing the number of patients and controls -#' @param number_of_metabolites: list containing the number of metabolites for the top and lowest table +#' @param diem_probability_score: Dataframe with dIEM probability scores (matrix) +#' @param patient_col_names: All patient column names (vector of strings) +#' @param expected_biomarkers_df: Dataframe with information for HMDB codes about IEMs (matrix) +#' @param zscore_patients_df: Dataframe containing Z-scores for all patients (matrix) +#' @param zscore_controls_df: Dataframe containing Z-scores for all controls (matrix) +#' @param nr_plots_perpage: Number of metabolites per page (integer) +#' @param number_of_samples: Number of patients and controls (list of integers) +#' @param number_of_metabolites: Number of metabolites for the top and lowest table (list of integers) +#' @param iem_variables: Top number of IEMs and threshold for dIEM (list of integers) +#' @param explanation_violin_plot: Text that explains the violin plots and the pipeline version (vector of strings) #' -#' @returns patient_no_iem: vector of patient IDs that have no IEMs +#' @return patient_no_iem: Patient IDs for which no IEM data is available (vector of strings) make_and_save_diem_plots <- function( diem_probability_score, patient_col_names, @@ -910,6 +926,7 @@ make_and_save_diem_plots <- function( number_of_metabolites, iem_variables, explanation_violin_plot) { + # create output folder diem_plot_dir <- paste("./dIEM_plots", sep = "/") dir.create(diem_plot_dir) @@ -968,11 +985,11 @@ make_and_save_diem_plots <- function( #' Get the IEM probabilities for a patient for all diseases #' -#' @param patient_top_iems_probs: dataframe containing the probability scores for diseases for a patient -#' @param expected_biomarkers_df: dataframe with information for HMDB codes about IEMs -#' @param patient_id: string containing the patien ID +#' @param patient_top_iems_probs: Dataframe containing the probability scores for diseases for a patient (matrix) +#' @param expected_biomarkers_df: Dataframe with information for HMDB codes about IEMs (matrix) +#' @param patient_id: Patient ID (string) #' -#' @returns list_metabolites_iems: list of dataframes containing the HMDB codes and names for all diseases +#' @return list_metabolites_iems: Dataframes containing the HMDB codes and names for all diseases (list of matrices) get_probabilities_top_iems <- function(patient_top_iems_probs, expected_biomarkers_df, patient_id) { # Get the metabolites for each IEM and their probability list_metabolites_iems <- list() @@ -998,8 +1015,8 @@ get_probabilities_top_iems <- function(patient_top_iems_probs, expected_biomarke #' Save a list of patient IDs to a text file #' -#' @param threshold_iem: integer containing the IEM threshold -#' @param patient_no_iem: vector containing patient IDs +#' @param threshold_iem: IEM threshold (integer) +#' @param patient_no_iem: Patient IDs (vector of strings) save_patient_no_iem <- function(threshold_iem, patient_no_iem) { patient_no_iem <- c( paste0( From c8124205e77c4521ceb3ac9a6bbb17a9aace2de7 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 11:34:28 +0200 Subject: [PATCH 15/42] changed docker image to v1.4 for all DIMS nf files --- DIMS/AssignToBins.nf | 2 +- DIMS/AveragePeaks.nf | 2 +- DIMS/CollectAveraged.nf | 2 +- DIMS/CollectFilled.nf | 2 +- DIMS/EvaluateTics.nf | 2 +- DIMS/FillMissing.nf | 2 +- DIMS/GenerateBreaks.nf | 2 +- DIMS/GenerateExcel.nf | 2 +- DIMS/GenerateQCOutput.nf | 2 +- DIMS/GenerateViolinPlots.nf | 2 +- DIMS/HMDBparts.nf | 2 +- DIMS/HMDBparts_main.nf | 2 +- DIMS/MakeInit.nf | 2 +- DIMS/PeakFinding.nf | 2 +- DIMS/PeakGrouping.nf | 2 +- DIMS/SumAdducts.nf | 2 +- 16 files changed, 16 insertions(+), 16 deletions(-) diff --git a/DIMS/AssignToBins.nf b/DIMS/AssignToBins.nf index d3bc79a..6e28a61 100644 --- a/DIMS/AssignToBins.nf +++ b/DIMS/AssignToBins.nf @@ -1,7 +1,7 @@ process AssignToBins { tag "DIMS AssignToBins ${file_id}" label 'AssignToBins' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/AveragePeaks.nf b/DIMS/AveragePeaks.nf index f50bd87..d1d6912 100644 --- a/DIMS/AveragePeaks.nf +++ b/DIMS/AveragePeaks.nf @@ -1,7 +1,7 @@ process AveragePeaks { tag "DIMS AveragePeaks" label 'AveragePeaks' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/CollectAveraged.nf b/DIMS/CollectAveraged.nf index fc65bf2..b3d34fb 100644 --- a/DIMS/CollectAveraged.nf +++ b/DIMS/CollectAveraged.nf @@ -1,7 +1,7 @@ process CollectAveraged { tag "DIMS CollectAveraged" label 'CollectAveraged' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/CollectFilled.nf b/DIMS/CollectFilled.nf index b002528..1a20bf7 100644 --- a/DIMS/CollectFilled.nf +++ b/DIMS/CollectFilled.nf @@ -1,7 +1,7 @@ process CollectFilled { tag "DIMS CollectFilled" label 'CollectFilled' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/EvaluateTics.nf b/DIMS/EvaluateTics.nf index 2cd8bb5..a8b1538 100644 --- a/DIMS/EvaluateTics.nf +++ b/DIMS/EvaluateTics.nf @@ -1,7 +1,7 @@ process EvaluateTics { tag "DIMS EvaluateTics" label 'EvaluateTics' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/FillMissing.nf b/DIMS/FillMissing.nf index 5022702..2478442 100644 --- a/DIMS/FillMissing.nf +++ b/DIMS/FillMissing.nf @@ -1,7 +1,7 @@ process FillMissing { tag "DIMS FillMissing ${peakgrouplist_file}" label 'FillMissing' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/GenerateBreaks.nf b/DIMS/GenerateBreaks.nf index c486010..a277a67 100644 --- a/DIMS/GenerateBreaks.nf +++ b/DIMS/GenerateBreaks.nf @@ -1,7 +1,7 @@ process GenerateBreaks { tag "DIMS GenerateBreaks" label 'GenerateBreaks' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/GenerateExcel.nf b/DIMS/GenerateExcel.nf index 552a8ee..a4badbe 100644 --- a/DIMS/GenerateExcel.nf +++ b/DIMS/GenerateExcel.nf @@ -1,7 +1,7 @@ process GenerateExcel { tag "DIMS GenerateExcel" label 'GenerateExcel' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/GenerateQCOutput.nf b/DIMS/GenerateQCOutput.nf index b39d058..0c9244f 100644 --- a/DIMS/GenerateQCOutput.nf +++ b/DIMS/GenerateQCOutput.nf @@ -1,7 +1,7 @@ process GenerateQCOutput { tag "DIMS GenerateQCOutput" label 'GenerateQCOutput' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/GenerateViolinPlots.nf b/DIMS/GenerateViolinPlots.nf index ec65a2e..4dbe55f 100755 --- a/DIMS/GenerateViolinPlots.nf +++ b/DIMS/GenerateViolinPlots.nf @@ -1,7 +1,7 @@ process GenerateViolinPlots { tag "DIMS GenerateViolinPlots" label 'GenerateViolinPlots' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/HMDBparts.nf b/DIMS/HMDBparts.nf index 760b28d..f254e8f 100644 --- a/DIMS/HMDBparts.nf +++ b/DIMS/HMDBparts.nf @@ -1,7 +1,7 @@ process HMDBparts { tag "DIMS HMDBparts" label 'HMDBparts' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/HMDBparts_main.nf b/DIMS/HMDBparts_main.nf index b38bac0..0b49dfa 100644 --- a/DIMS/HMDBparts_main.nf +++ b/DIMS/HMDBparts_main.nf @@ -1,7 +1,7 @@ process HMDBparts_main { tag "DIMS HMDBparts_main" label 'HMDBparts_main' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/MakeInit.nf b/DIMS/MakeInit.nf index 7aae0e4..5193263 100644 --- a/DIMS/MakeInit.nf +++ b/DIMS/MakeInit.nf @@ -1,7 +1,7 @@ process MakeInit { tag "DIMS MakeInit" label 'MakeInit' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/PeakFinding.nf b/DIMS/PeakFinding.nf index 1d02e50..a356523 100644 --- a/DIMS/PeakFinding.nf +++ b/DIMS/PeakFinding.nf @@ -1,7 +1,7 @@ process PeakFinding { tag "DIMS PeakFinding ${rdata_file}" label 'PeakFinding' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/PeakGrouping.nf b/DIMS/PeakGrouping.nf index 6cc4ddb..a69bf00 100644 --- a/DIMS/PeakGrouping.nf +++ b/DIMS/PeakGrouping.nf @@ -1,7 +1,7 @@ process PeakGrouping { tag "DIMS PeakGrouping ${hmdbpart_file}" label 'PeakGrouping' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: diff --git a/DIMS/SumAdducts.nf b/DIMS/SumAdducts.nf index 4b3f965..f089307 100644 --- a/DIMS/SumAdducts.nf +++ b/DIMS/SumAdducts.nf @@ -1,7 +1,7 @@ process SumAdducts { tag "DIMS SumAdducts ${hmdbpart_main_file}" label 'SumAdducts' - container = 'docker://umcugenbioinf/dims:1.3' + container = 'ghcr.io/umcugenetics/dims:v1.4.0' shell = ['/bin/bash', '-euo', 'pipefail'] input: From b01d332f3db298c78ac6215ec383c0cde7072d8b Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 13:23:13 +0200 Subject: [PATCH 16/42] cleaned up DIMS AssignToBins.R --- DIMS/AssignToBins.R | 35 +++++++++++++---------------------- 1 file changed, 13 insertions(+), 22 deletions(-) diff --git a/DIMS/AssignToBins.R b/DIMS/AssignToBins.R index 8b31af7..86f47d1 100644 --- a/DIMS/AssignToBins.R +++ b/DIMS/AssignToBins.R @@ -9,24 +9,21 @@ breaks_filepath <- cmd_args[2] trim_parameters_filepath <- cmd_args[3] resol <- as.numeric(cmd_args[4]) -# load breaks_file: contains breaks_fwhm, breaks_fwhm_avg, +options(digits = 16) + +# Initialize +pos_bins <- rep(0, length(breaks_fwhm) - 1) +neg_bins <- pos_bins +dims_thresh <- 100 + +# load breaks_file: contains breaks_fwhm & breaks_fwhm_avg load(breaks_filepath) # load trim parameters file: contains trim_left_neg, trim_left_pos, trim_right_neg & trim_right_pos load(trim_parameters_filepath) -# get sample name +# get name of the technical replicate techrep_name <- sub("\\..*$", "", basename(mzml_filepath)) -options(digits = 16) - -# Initialize -pos_results <- NULL -neg_results <- NULL -bins <- rep(0, length(breaks_fwhm) - 1) -pos_bins <- bins -neg_bins <- bins -dims_thresh <- 100 - # read in the data for 1 sample raw_data <- suppressMessages(xcms::xcmsRaw(mzml_filepath)) @@ -47,6 +44,7 @@ tic_intensity_pos <- tic_intensity_persample[tic_intensity_persample[ , "retenti tic_intensity_persample[ , "retention_time"] < max(pos_times_trimmed), ] tic_intensity_neg <- tic_intensity_persample[tic_intensity_persample[ , "retention_time"] > min(neg_times_trimmed) & tic_intensity_persample[ , "retention_time"] < max(neg_times_trimmed), ] + # calculate weighted mean of intensities for pos and neg separately mean_pos <- weighted.mean(tic_intensity_pos[ , "tic_intensity"], tic_intensity_pos[ , "tic_intensity"]) mean_neg <- weighted.mean(tic_intensity_neg[ , "tic_intensity"], tic_intensity_neg[ , "tic_intensity"]) @@ -54,18 +52,12 @@ mean_neg <- weighted.mean(tic_intensity_neg[ , "tic_intensity"], tic_intensity_n dims_thresh_pos <- 0.8 * mean_pos dims_thresh_neg <- 0.8 * mean_neg -# Generate an index with which to select values for each mode -#pos_index <- which(raw_data_matrix[, "time"] %in% pos_times) -#neg_index <- which(raw_data_matrix[, "time"] %in% neg_times) # select only data from scans which pass the dims_thresh_pos and *_neg filter pos_times_pass <- tic_intensity_pos[which(tic_intensity_pos[ , "tic_intensity"] > dims_thresh_pos), "retention_time"] neg_times_pass <- tic_intensity_neg[which(tic_intensity_neg[ , "tic_intensity"] > dims_thresh_neg), "retention_time"] -# Generate an index with which to select values for each mode -pos_index <- which(raw_data_matrix[, "time"] %in% pos_times_pass) -neg_index <- which(raw_data_matrix[, "time"] %in% neg_times_pass) # Separate each mode into its own matrix -pos_raw_data_matrix <- raw_data_matrix[pos_index, ] -neg_raw_data_matrix <- raw_data_matrix[neg_index, ] +pos_raw_data_matrix <- raw_data_matrix[which(raw_data_matrix[, "time"] %in% pos_times_pass), ] +neg_raw_data_matrix <- raw_data_matrix[which(raw_data_matrix[, "time"] %in% neg_times_pass), ] # Get index for binning intensity values bin_indices_pos <- cut( @@ -83,8 +75,7 @@ bin_indices_neg <- cut( labels = FALSE ) -# Get the list of intensity values for each bin, and add the -# intensity values which are in the same bin +# Get the list of intensity values for each bin and sum the intensities if (nrow(pos_raw_data_matrix) > 0) { # set NA in intensities to zero pos_raw_data_matrix[is.na(pos_raw_data_matrix[, "intensity"]), "intensity"] <- 0 From 5ed938aa4e345d3ad73eff452f04f72ae0fbf5a9 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 13:26:48 +0200 Subject: [PATCH 17/42] cleaned up DIMS AveragePeaks.R --- DIMS/AveragePeaks.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/DIMS/AveragePeaks.R b/DIMS/AveragePeaks.R index 7114e3c..b2a3704 100644 --- a/DIMS/AveragePeaks.R +++ b/DIMS/AveragePeaks.R @@ -1,3 +1,4 @@ +# load required packages library(dplyr) # define parameters @@ -12,9 +13,9 @@ tech_reps <- strsplit(techreps, ";")[[1]] # load in function scripts source(paste0(preprocessing_scripts_dir, "average_peaks_functions.R")) -# Initialize per sample +# Initialize +options(digits = 16) peaklist_allrepl <- NULL -nr_repl_persample <- 0 averaged_peaks <- matrix(0, nrow = 0, ncol = 6) colnames(averaged_peaks) <- c("samplenr", "mzmed.pkt", "fq", "mzmin.pkt", "mzmax.pkt", "height.pkt") @@ -25,13 +26,15 @@ for (file_nr in 1:length(tech_reps)) { # combine data for all technical replicates peaklist_allrepl <- rbind(peaklist_allrepl, tech_repl) } -# sort on mass +# make sure mass and intensity columns are numeric peaklist_allrepl_df <- as.data.frame(peaklist_allrepl) peaklist_allrepl_df$mzmed.pkt <- as.numeric(peaklist_allrepl_df$mzmed.pkt) peaklist_allrepl_df$height.pkt <- as.numeric(peaklist_allrepl_df$height.pkt) +# sort on mass peaklist_allrepl_sorted <- peaklist_allrepl_df %>% arrange(mzmed.pkt) # average over technical replicates averaged_peaks <- average_peaks_per_sample(peaklist_allrepl_sorted, sample_name) + save(averaged_peaks, file = paste0("AvgPeaks_", sample_name, "_", scanmode, ".RData")) From e23af2c4b611f05aa62908b3b8865dc5e982a1a6 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 13:28:31 +0200 Subject: [PATCH 18/42] cleaned up DIMS CollectAveraged.R, removed unused argument --- DIMS/CollectAveraged.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/DIMS/CollectAveraged.R b/DIMS/CollectAveraged.R index e6466d9..8463b6f 100755 --- a/DIMS/CollectAveraged.R +++ b/DIMS/CollectAveraged.R @@ -1,7 +1,5 @@ -# define parameters -cmd_args <- commandArgs(trailingOnly = TRUE) - -scripts_dir <- cmd_args[1] +# Initialize +options(digits = 16) # for each scan mode, collect all averaged peak lists per biological sample scanmodes <- c("positive", "negative") From 2a606e8dd8561b71b61ab3c296b77f5bf3e82510 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 13:29:26 +0200 Subject: [PATCH 19/42] cleaned up DIMS CollectFilled.R, removed unused argument --- DIMS/CollectFilled.R | 28 +++++++++++++++------------- DIMS/CollectFilled.nf | 2 +- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/DIMS/CollectFilled.R b/DIMS/CollectFilled.R index 4cd25fb..6f98249 100644 --- a/DIMS/CollectFilled.R +++ b/DIMS/CollectFilled.R @@ -2,44 +2,46 @@ cmd_args <- commandArgs(trailingOnly = TRUE) preprocessing_scripts_dir <- cmd_args[1] -ppm <- as.numeric(cmd_args[2]) -z_score <- as.numeric(cmd_args[3]) +z_score <- as.numeric(cmd_args[2]) source(paste0(preprocessing_scripts_dir, "collect_filled_functions.R")) +# Initialize +options(digits = 16) + # for each scan mode, collect all filled peak group lists scanmodes <- c("positive", "negative") for (scanmode in scanmodes) { # get list of files filled_files <- list.files("./", full.names = TRUE, pattern = paste0(scanmode, "_identified_filled")) # load files and combine into one object - outlist_total <- NULL + peakgroup_list_total <- NULL for (file_nr in seq_along(filled_files)) { peakgrouplist_filled <- get(load(filled_files[file_nr])) - outlist_total <- rbind(outlist_total, peakgrouplist_filled) + peakgroup_list_total <- rbind(peakgroup_list_total, peakgrouplist_filled) } # remove duplicates; peak groups with exactly the same m/z - outlist_total <- merge_duplicate_rows(outlist_total) + peakgroup_list_total <- merge_duplicate_rows(peakgroup_list_total) # sort on mass - outlist_total <- outlist_total[order(outlist_total[, "mzmed.pgrp"]), ] + peakgroup_list_total <- peakgroup_list_total[order(peakgroup_list_total[, "mzmed.pgrp"]), ] # load replication pattern pattern_file <- paste0(scanmode, "_repl_pattern.RData") repl_pattern <- get(load(pattern_file)) # calculate Z-scores if (z_score == 1) { - outlist_stats <- calculate_zscores_peakgrouplist(outlist_total) + peakgroup_list_stats <- calculate_zscores_peakgrouplist(peakgroup_list_total) } else { - outlist_stats <- outlist_total + peakgroup_list_stats <- peakgroup_list_total } # calculate ppm deviation - outlist_withppm <- calculate_ppm_deviation(outlist_stats) + peakgroup_list_withppm <- calculate_ppm_deviation(peakgroup_list_stats) # put columns in correct order - outlist_ident <- order_columns_peakgrouplist(outlist_withppm) + peakgroup_list_ident <- order_columns_peakgrouplist(peakgroup_list_withppm) # generate output in Excel-readable format: remove_columns <- c("mzmin.pgrp", "mzmax.pgrp") - outlist_ident <- outlist_ident[, -which(colnames(outlist_ident) %in% remove_columns)] - write.table(outlist_ident, file = paste0("outlist_identified_", scanmode, ".txt"), sep = "\t", row.names = FALSE) + peakgroup_list_ident <- peakgroup_list_ident[, -which(colnames(peakgroup_list_ident) %in% remove_columns)] + write.table(peakgroup_list_ident, file = paste0("peakgroup_list_identified_", scanmode, ".txt"), sep = "\t", row.names = FALSE) # export output in RData format - save(outlist_ident, file = paste0("outlist_identified_", scanmode, ".RData")) + save(peakgroup_list_ident, file = paste0("peakgroup_list_identified_", scanmode, ".RData")) } diff --git a/DIMS/CollectFilled.nf b/DIMS/CollectFilled.nf index 1a20bf7..b1ba31a 100644 --- a/DIMS/CollectFilled.nf +++ b/DIMS/CollectFilled.nf @@ -14,6 +14,6 @@ process CollectFilled { script: """ - Rscript ${baseDir}/CustomModules/DIMS/CollectFilled.R $params.preprocessing_scripts_dir $params.ppm $params.zscore + Rscript ${baseDir}/CustomModules/DIMS/CollectFilled.R $params.preprocessing_scripts_dir $params.zscore """ } From 22c65e28a5421f713e45088b61bfb167044fae0a Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 13:33:47 +0200 Subject: [PATCH 20/42] cleaned up DIMS CollectSumAdducts.R --- DIMS/CollectSumAdducts.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/DIMS/CollectSumAdducts.R b/DIMS/CollectSumAdducts.R index 28b5bf0..81c1a93 100755 --- a/DIMS/CollectSumAdducts.R +++ b/DIMS/CollectSumAdducts.R @@ -1,5 +1,4 @@ -## Combining all AdductSums part files for each scanmode and -# combine intensities if present in both scanmodes +# load required packages suppressMessages(library("dplyr")) # define parameters From 6aa5f4ef06128250589d23af63eee42831ab64a1 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 14:25:43 +0200 Subject: [PATCH 21/42] cleaned up DIMS EvaluateTics.R --- DIMS/EvaluateTics.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/DIMS/EvaluateTics.R b/DIMS/EvaluateTics.R index 521430e..f113e5f 100644 --- a/DIMS/EvaluateTics.R +++ b/DIMS/EvaluateTics.R @@ -1,4 +1,4 @@ -# load packages +# load required packages library("ggplot2") library("gridExtra") @@ -18,6 +18,9 @@ preprocessing_scripts_dir <- cmd_args[7] # load functions source(paste0(preprocessing_scripts_dir, "evaluate_tics_functions.R")) +# Initialize +options(digits = 16) + # load init_file: contains repl_pattern load(init_file) @@ -44,7 +47,7 @@ print(remove_tech_reps) remove_neg <- remove_tech_reps$neg repl_pattern_filtered <- remove_from_repl_pattern(remove_neg, repl_pattern, nr_replicates) save(repl_pattern_filtered, file = "negative_repl_pattern.RData") -# get an overview of suitable technical replicates for both negative mode +# get an overview of suitable technical replicates for negative scan mode allsamples_techreps_neg <- get_overview_tech_reps(repl_pattern_filtered, "negative") # positive scan mode @@ -63,9 +66,7 @@ write.table(allsamples_techreps_both_scanmodes, sep = "," ) - -## generate TIC plots -# get all txt files +# generate TIC plots using all tic files tic_files <- list.files("./", full.names = TRUE, pattern = "*TIC.txt") all_samps <- sub("_TIC\\..*$", "", basename(tic_files)) @@ -141,4 +142,3 @@ tic_plot_pdf <- marrangeGrob( ggsave(filename = paste0(run_name, "_TICplots.pdf"), tic_plot_pdf, width = 21, height = 29.7, units = "cm") - From 483a79127d83bc5aa19b75e62fc22e198bf05666 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 14:27:54 +0200 Subject: [PATCH 22/42] cleaned up DIMS FillMissing.R --- DIMS/FillMissing.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/DIMS/FillMissing.R b/DIMS/FillMissing.R index a523bab..75ff8a7 100755 --- a/DIMS/FillMissing.R +++ b/DIMS/FillMissing.R @@ -8,6 +8,9 @@ thresh <- as.numeric(cmd_args[3]) # load in function scripts source(paste0(preprocessing_scripts_dir, "fill_missing_functions.R")) +# Initialize +options(digits = 16) + # determine scan mode if (grepl("_pos", peakgrouplist_file)) { scanmode <- "positive" @@ -30,3 +33,4 @@ outputfile_name <- gsub(".RData", "_filled.RData", peakgrouplist_file) # save output save(peakgrouplist_filled, file = outputfile_name) + From 0aadafa44f413782f80f07bce4c8ddc45aa7c9bb Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 15:47:52 +0200 Subject: [PATCH 23/42] cleaned up DIMS GenerateBreaks.R and removed redundant parameter --- DIMS/GenerateBreaks.R | 35 +++++++++++++++++------------------ DIMS/GenerateBreaks.nf | 2 +- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/DIMS/GenerateBreaks.R b/DIMS/GenerateBreaks.R index 007d5ab..8461d4c 100644 --- a/DIMS/GenerateBreaks.R +++ b/DIMS/GenerateBreaks.R @@ -5,18 +5,13 @@ suppressPackageStartupMessages(library("xcms")) cmd_args <- commandArgs(trailingOnly = TRUE) filepath <- cmd_args[1] -outdir <- cmd_args[2] -trim <- as.numeric(cmd_args[3]) -resol <- as.numeric(cmd_args[4]) - -# initialize -trim_left_pos <- NULL -trim_right_pos <- NULL -trim_left_neg <- NULL -trim_right_neg <- NULL +trim <- as.numeric(cmd_args[2]) +resol <- as.numeric(cmd_args[3]) + +# Initialize +options(digits = 16) breaks_fwhm <- NULL breaks_fwhm_avg <- NULL -bins <- NULL # read in mzML file raw_data <- suppressMessages(xcms::xcmsRaw(filepath)) @@ -26,8 +21,8 @@ pos_times <- raw_data@scantime[raw_data@polarity == "positive"] neg_times <- raw_data@scantime[raw_data@polarity == "negative"] # trim (remove) scans at the start and end for positive -trim_left_pos <- round(pos_times[length(pos_times) * (trim * 1.5)]) # 15% aan het begin -trim_right_pos <- round(pos_times[length(pos_times) * (1 - (trim * 0.5))]) # 5% aan het eind +trim_left_pos <- round(pos_times[length(pos_times) * (trim * 1.5)]) # 15% at the start +trim_right_pos <- round(pos_times[length(pos_times) * (1 - (trim * 0.5))]) # 5% at the end # trim (remove) scans at the start and end for negative trim_left_neg <- round(neg_times[length(neg_times) * trim]) @@ -37,16 +32,20 @@ trim_right_neg <- round(neg_times[length(neg_times) * (1 - trim)]) low_mz <- raw_data@mzrange[1] high_mz <- raw_data@mzrange[2] -# determine number of segments (bins) +# determine number of segments nr_segments <- 2 * (high_mz - low_mz) segment <- seq(from = low_mz, to = high_mz, length.out = nr_segments + 1) -# determine start and end of each bin. -for (i in 1:nr_segments) { - start_segment <- segment[i] - end_segment <- segment[i+1] +# create bins for each segment +for (segment_index in 1:nr_segments) { + # determine start and end of each bin. + start_segment <- segment[segment_index] + end_segment <- segment[segment_index + 1] + # determine resolution for this mz range resol_mz <- resol * (1 / sqrt(2) ^ (log2(start_segment / 200))) + # determine full width at half maximum of peaks in this segment fwhm_segment <- start_segment / resol_mz + # determine boundaries of bins breaks_fwhm <- c(breaks_fwhm, seq(from = (start_segment + fwhm_segment), to = end_segment, by = 0.2 * fwhm_segment)) # average the m/z instead of start value range <- seq(from = (start_segment + fwhm_segment), to = end_segment, by = 0.2 * fwhm_segment) @@ -54,7 +53,7 @@ for (i in 1:nr_segments) { breaks_fwhm_avg <- c(breaks_fwhm_avg, range + 0.5 * delta_mz) } -# generate output file +# generate output files save(breaks_fwhm, breaks_fwhm_avg, file = "breaks.fwhm.RData") save(trim_left_pos, trim_right_pos, trim_left_neg, trim_right_neg, file = "trim_params.RData") save(high_mz, file = "highest_mz.RData") diff --git a/DIMS/GenerateBreaks.nf b/DIMS/GenerateBreaks.nf index a277a67..e9e3452 100644 --- a/DIMS/GenerateBreaks.nf +++ b/DIMS/GenerateBreaks.nf @@ -15,6 +15,6 @@ process GenerateBreaks { script: """ - Rscript ${baseDir}/CustomModules/DIMS/GenerateBreaks.R $mzML_file ./ $params.trim $params.resolution + Rscript ${baseDir}/CustomModules/DIMS/GenerateBreaks.R $mzML_file $params.trim $params.resolution """ } From 61f1aafb493824a45b2231ffbbaf864c2e9a9bd3 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 16:14:12 +0200 Subject: [PATCH 24/42] cleaned up DIMS GenerateQCOutput.R, removed outdir parameter --- DIMS/GenerateQCOutput.R | 87 +++++++++++++++++++---------------------- 1 file changed, 40 insertions(+), 47 deletions(-) diff --git a/DIMS/GenerateQCOutput.R b/DIMS/GenerateQCOutput.R index cb3d865..237854f 100644 --- a/DIMS/GenerateQCOutput.R +++ b/DIMS/GenerateQCOutput.R @@ -3,9 +3,6 @@ library("reshape2") library("openxlsx") suppressMessages(library("dplyr")) -# set the number of digits for floats -options(digits = 16) - # define parameters cmd_args <- commandArgs(trailingOnly = TRUE) @@ -15,11 +12,17 @@ dims_matrix <- cmd_args[3] sst_components_file <- cmd_args[4] export_scripts_dir <- cmd_args[5] -outdir <- "./" - # load in function scripts source(paste0(export_scripts_dir, "generate_qc_output_functions.R")) +# Initialize +options(digits = 16) +control_label <- "C" +# get current date +rundate <- Sys.Date() +# create a directory for plots +dir.create("plots", showWarnings = FALSE) + # load init files load(init_file) # load outlist from GenerateExcel @@ -28,22 +31,14 @@ load("outlist.RData") load("AdductSums_positive.RData") load("AdductSums_negative.RData") -# get current date -rundate <- Sys.Date() - -# create a directory for plots in project directory -dir.create(paste0(outdir, "/plots"), showWarnings = FALSE) - -control_label <- "C" - -#### CHECK NUMBER OF CONTROLS #### +# Check number of controls if (any(grepl("nr_ctrls", colnames(outlist)))) { file_name <- "Check_number_of_controls.txt" min_num_controls <- 25 check_number_of_controls(outlist, min_num_controls, file_name) } -#### INTERNAL STANDARDS #### +# INTERNAL STANDARDS is_list <- outlist[grep("Internal standard", outlist[, "relevance"], fixed = TRUE), ] is_codes <- rownames(is_list) @@ -53,7 +48,7 @@ if (length(sample_names_nodata) == 0) { sample_names_nodata <- "none" } write.table(sample_names_nodata, - file = paste(outdir, "sample_names_nodata.txt", sep = "/"), + file = "sample_names_nodata.txt", row.names = FALSE, col.names = FALSE, quote = FALSE ) if (!is.null(sample_names_nodata)) { @@ -75,7 +70,7 @@ is_pos <- get_internal_standards(is_list, "pos", outlist_tot_pos, dims_matrix, r is_neg <- get_internal_standards(is_list, "neg", outlist_tot_neg, dims_matrix, rundate, project) # Save results -save(is_pos, is_neg, is_summed, file = paste0(outdir, "/", project, "_IS_results.RData")) +save(is_pos, is_neg, is_summed, file = paste0(project, "_IS_results.RData")) # number of samples, for plotting length and width sample_count <- length(repl_pattern) @@ -92,15 +87,15 @@ plot_width <- 9 + 0.35 * sample_count plot_height <- plot_width / 2.5 save_internal_standard_plot( - is_neg, "barplot", "Interne Standaard (Neg)", outdir, + is_neg, "barplot", "Interne Standaard (Neg)", "./", "IS_bar_all_neg", plot_width, plot_height ) save_internal_standard_plot( - is_pos, "barplot", "Interne Standaard (Pos)", outdir, + is_pos, "barplot", "Interne Standaard (Pos)", "./", "IS_bar_all_pos", plot_width, plot_height ) save_internal_standard_plot( - is_summed, "barplot", "Interne Standaard (Summed)", outdir, + is_summed, "barplot", "Interne Standaard (Summed)", "./", "IS_bar_all_sum", plot_width, plot_height ) @@ -110,15 +105,15 @@ plot_height <- plot_width / 2.5 save_internal_standard_plot( is_neg, "lineplot", "Interne Standaard (Neg)", - outdir, "IS_line_all_neg", plot_width, plot_height + "IS_line_all_neg", plot_width, plot_height ) save_internal_standard_plot( is_pos, "lineplot", "Interne Standaard (Pos)", - outdir, "IS_line_all_pos", plot_width, plot_height + "IS_line_all_pos", plot_width, plot_height ) save_internal_standard_plot( is_summed, "lineplot", "Interne Standaard (Sum)", - outdir, "IS_line_all_sum", plot_width, plot_height + "IS_line_all_sum", plot_width, plot_height ) ## bar plots with a selection of IS @@ -223,50 +218,50 @@ if (nrow(is_below_threshold) > 0) { # bar plot either with or without minimal intensity lines if (add_min_intens_lines) { save_internal_standard_plot( - is_neg_selection_subset, "barplot", "Interne Standaard (Neg)", outdir, + is_neg_selection_subset, "barplot", "Interne Standaard (Neg)", "IS_bar_select_neg", plot_width, plot_height, hline_data_neg ) save_internal_standard_plot( - is_pos_selection_subset, "barplot", "Interne Standaard (Pos)", outdir, + is_pos_selection_subset, "barplot", "Interne Standaard (Pos)", "IS_bar_select_pos", plot_width, plot_height, hline_data_pos ) save_internal_standard_plot( - is_sum_selection_subset, "barplot", "Interne Standaard (Sum)", outdir, + is_sum_selection_subset, "barplot", "Interne Standaard (Sum)", "IS_bar_select_sum", plot_width, plot_height, hline_data_sum ) } else { save_internal_standard_plot( - is_neg_selection_subset, "barplot", "Interne Standaard (Neg)", outdir, + is_neg_selection_subset, "barplot", "Interne Standaard (Neg)", "IS_bar_select_neg", plot_width, plot_height ) save_internal_standard_plot( - is_pos_selection_subset, "barplot", "Interne Standaard (Pos)", outdir, + is_pos_selection_subset, "barplot", "Interne Standaard (Pos)", "IS_bar_select_pos", plot_width, plot_height ) save_internal_standard_plot( - is_sum_selection_subset, "barplot", "Interne Standaard (Sum)", outdir, + is_sum_selection_subset, "barplot", "Interne Standaard (Sum)", "IS_bar_select_sum", plot_width, plot_height ) } -## line plots with a selection of IS +# line plots with a selection of IS plot_width <- 8 + 0.2 * sample_count plot_height <- plot_width / 2.0 save_internal_standard_plot( - is_neg_selection_subset, "lineplot", "Interne Standaard (Neg)", outdir, + is_neg_selection_subset, "lineplot", "Interne Standaard (Neg)", "IS_line_select_neg", plot_width, plot_height ) save_internal_standard_plot( - is_pos_selection_subset, "lineplot", "Interne Standaard (Pos)", outdir, + is_pos_selection_subset, "lineplot", "Interne Standaard (Pos)", "IS_line_select_pos", plot_width, plot_height ) save_internal_standard_plot( - is_sum_selection_subset, "lineplot", "Interne Standaard (Sum)", outdir, + is_sum_selection_subset, "lineplot", "Interne Standaard (Sum)", "IS_line_select_sum", plot_width, plot_height ) -### POSITIVE CONTROLS CHECK +# POSITIVE CONTROLS # these positive controls need to be in the samplesheet, in order to make the positive_control.RData file # Positive control samples all have the format P1002.x, P1003.x and P1005.x (where x is a number) @@ -293,7 +288,7 @@ if (length(pos_contr_warning) == 0) { pos_contr_warning <- "No positive controls found" } write.table(pos_contr_warning, - file = paste(outdir, "positive_controls_warning.txt", sep = "/"), + file = "positive_controls_warning.txt", row.names = FALSE, col.names = FALSE, quote = FALSE ) @@ -332,17 +327,15 @@ if (length(positive_control_list) > 0) { positive_control$Project <- project # Save results - save(positive_control, file = paste0(outdir, "/", project, "_positive_control.RData")) + save(positive_control, file = paste0(project, "_positive_control.RData")) # round the Z-scores to 2 digits positive_control$Zscore <- round_df(positive_control$Zscore, 2) write.xlsx(positive_control, - file = paste0(outdir, "/", project, "_positive_control.xlsx"), + file = paste0(project, "_positive_control.xlsx"), sheetName = "Sheet1", col.names = TRUE, row.names = TRUE, append = FALSE ) } -### SST components output #### - # Internal standards lists, calculate coefficients of variation if ("plots" %in% colnames(is_list)) { intensity_col_ids <- 2:(which(colnames(is_list) == "HMDB_name") - 1) @@ -354,7 +347,7 @@ is_list_intensities <- get_is_intensities(is_list, int_cols = intensity_col_ids) is_neg_intensities <- get_is_intensities(outlist_tot_neg, is_codes = is_codes) is_pos_intensities <- get_is_intensities(outlist_tot_pos, is_codes = is_codes) -# SST components +# SST COMPONENTS sst_components <- read.csv(sst_components_file, header = TRUE, sep = "\t") sst_metabolites_df <- outlist %>% filter(HMDB_code %in% sst_components$HMDB_ID) sst_sample_column_index <- grep("P1001", colnames(sst_metabolites_df)) @@ -401,7 +394,7 @@ setColWidths(wb, 3, cols = 1, widths = 24) addWorksheet(wb, "SST components") openxlsx::writeData(wb, sheet = 4, sst_intensities_df) setColWidths(wb, 4, cols = 1:3, widths = 24) -xlsx_name <- paste0(outdir, "/", project, "_IS_SST.xlsx") +xlsx_name <- paste0(project, "_IS_SST.xlsx") openxlsx::saveWorkbook(wb, xlsx_name, overwrite = TRUE) rm(wb) @@ -410,17 +403,17 @@ if (sum(grepl("P1001", colnames(sst_intensities_df))) > 0) { zscore_column <- grep("_Zscore", colnames(sst_intensities_df))[1] sst_intensities_df_qc <- sst_intensities_df[sst_intensities_df[, zscore_column] < 2, ] sst_intensities_df_qc <- select(sst_intensities_df_qc, -c("CV_controls")) - write.table(sst_intensities_df_qc, file = paste(outdir, "sst_qc.txt", sep = "/"), row.names = FALSE, sep = "\t") + write.table(sst_intensities_df_qc, file = "sst_qc.txt", row.names = FALSE, sep = "\t") } else { - write.table("no SST sample present", file = paste(outdir, "sst_qc.txt", sep = "/"), row.names = FALSE, col.names = FALSE) + write.table("no SST sample present", file = "sst_qc.txt", row.names = FALSE, col.names = FALSE) } -### MISSING M/Z CHECK +# MISSING M/Z CHECK # check the outlist_identified_(negative/positive).RData files for missing m/z values and save to file # Load the outlist_identified files + remove the loaded files -load(paste0(outdir, "/outlist_identified_negative.RData")) +load("./outlist_identified_negative.RData") mzmed_pgrp_ident_neg <- outlist_ident$mzmed.pgrp -load(paste0(outdir, "/outlist_identified_positive.RData")) +load("./outlist_identified_positive.RData") mzmed_pgrp_ident_pos <- outlist_ident$mzmed.pgrp rm(outlist_ident) @@ -430,6 +423,6 @@ mz_missing_pos <- check_missing_mz(mzmed_pgrp_ident_pos, "Positive") # Write both scanmodes to missing_mz_warning file lapply(c(mz_missing_neg, mz_missing_pos), write, - file = paste0(outdir, "/missing_mz_warning.txt"), + file = "./missing_mz_warning.txt", append = TRUE, ncolumns = 1000 ) From 29c9bfb7cf366027ff3635c3dc213bfed436ec2c Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 16:19:22 +0200 Subject: [PATCH 25/42] cleaned up DIMS GenerateViolinPlots.R --- DIMS/GenerateViolinPlots.R | 46 +++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/DIMS/GenerateViolinPlots.R b/DIMS/GenerateViolinPlots.R index 9d1f3e7..d57910b 100644 --- a/DIMS/GenerateViolinPlots.R +++ b/DIMS/GenerateViolinPlots.R @@ -1,12 +1,11 @@ -# load packages +# load required packages suppressPackageStartupMessages(library("dplyr")) +suppressPackageStartupMessages(library("gridExtra")) library(reshape2) library(openxlsx) library(ggplot2) -suppressPackageStartupMessages(library("gridExtra")) library(stringr) -options(digits = 16) # define parameters cmd_args <- commandArgs(trailingOnly = TRUE) @@ -18,11 +17,31 @@ file_ratios_metabolites <- cmd_args[4] file_expected_biomarkers_iem <- cmd_args[5] file_explanation <- cmd_args[6] +# Initialize +options(digits = 16) +iem_variables <- list( + top_number_iem_diseases = 5, + threshold_iem = 5 +) +# number of diseases that score highest in dIEM algorithm to plot +top_number_iem_diseases <- 5 +# probability score cut-off for plotting the top diseases +threshold_iem <- 5 +nr_plots_perpage <- 20 +zscore_cutoff <- 5 +protocol_name <- "DIMS_PL_DIAG" +number_of_metabolites <- list( + highest = 20, + lowest = 10 +) + # load functions source(paste0(export_scripts_dir, "generate_violin_plots_functions.R")) + # load dataframe with intensities and Z-scores for all samples intensities_zscore_df <- get(load("outlist.RData")) rm(outlist) + # read input files metabolites_ratios_df <- read.csv(file_ratios_metabolites, sep = ";", stringsAsFactors = FALSE) expected_biomarkers_df <- read.csv(file_expected_biomarkers_iem, sep = ";", stringsAsFactors = FALSE) @@ -33,21 +52,6 @@ expected_biomarkers_df <- expected_biomarkers_df %>% ) explanation_violin_plot <- readLines(file_explanation) -# Set global variables -iem_variables <- list( - top_number_iem_diseases = 5, - threshold_iem = 5 -) -top_number_iem_diseases <- 5 # number of diseases that score highest in algorithm to plot -threshold_iem <- 5 # probability score cut-off for plotting the top diseases -nr_plots_perpage <- 20 # number of violin plots per page in PDF -zscore_cutoff <- 5 -protocol_name <- "DIMS_PL_DIAG" -number_of_metabolites <- list( - highest = 20, - lowest = 10 -) - control_ids <- get_colnames_by_prefix(intensities_zscore_df, "C") patient_ids <- get_colnames_by_prefix(intensities_zscore_df, "P") all_sample_ids <- c(control_ids, patient_ids) @@ -69,7 +73,7 @@ zscore_controls_df <- intensities_zscore_ratios_df %>% select(HMDB_code, HMDB_name, any_of(paste0(control_ids, "_Zscore"))) %>% rename_with(~ str_remove(.x, "_Zscore"), .cols = contains("_Zscore")) -#### Make violin plots ##### +# Make violin plots make_and_save_violin_plot_pdfs( zscore_patients_df, zscore_controls_df, @@ -82,12 +86,12 @@ make_and_save_violin_plot_pdfs( number_of_metabolites ) -#### Run the IEM algorithm ######### +# Run the IEM algorithm diem_probability_score <- run_diem_algorithm(expected_biomarkers_df, zscore_patients_df, patient_ids) save_prob_scores_to_excel(diem_probability_score, run_name) -#### Generate dIEM plots ######### +# Generate dIEM plots patient_no_iem <- make_and_save_diem_plots( diem_probability_score, patient_ids, From 8ad52da45d0e1cd261b6c72db93f93ff9d0b9df3 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 16:36:21 +0200 Subject: [PATCH 26/42] removed outdir parameter from DIMS/export/generate_qc_output_functions.R --- DIMS/export/generate_qc_output_functions.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/DIMS/export/generate_qc_output_functions.R b/DIMS/export/generate_qc_output_functions.R index 4ff1be5..c1b154c 100644 --- a/DIMS/export/generate_qc_output_functions.R +++ b/DIMS/export/generate_qc_output_functions.R @@ -55,7 +55,6 @@ get_internal_standards <- function(internal_stand_df, scanmode, is_subset_filter #' @param plot_data: Dataframe with the data to be plotted (matrix) #' @param plot_type: Type of plot (string) #' @param plot_title: Title for the plot (string) -#' @param outdir: Directory where the plot needs to be saved (string) #' @param file_name: Name of the file (string) #' @param plot_width: Width of the plot (int) #' @param plot_height: Height of the plot (int) @@ -64,7 +63,6 @@ save_internal_standard_plot <- function( plot_data, plot_type, plot_title, - outdir, file_name, plot_width, plot_height, @@ -116,7 +114,7 @@ save_internal_standard_plot <- function( ) } - ggplot2::ggsave(paste0(outdir, "/plots/", file_name, ".png"), + ggplot2::ggsave(paste0("./plots/", file_name, ".png"), plot = plot, height = plot_height, width = plot_width, units = "in" ) } From 135664d535f134437cd17ff0722cbb1a5be9eb5f Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 16:40:28 +0200 Subject: [PATCH 27/42] cleaned DIMS HMDBparts_main.R and HMDBparts.R --- DIMS/HMDBparts.R | 3 ++- DIMS/HMDBparts_main.R | 5 +++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/DIMS/HMDBparts.R b/DIMS/HMDBparts.R index 8c2234f..346e0a5 100755 --- a/DIMS/HMDBparts.R +++ b/DIMS/HMDBparts.R @@ -5,8 +5,9 @@ db_file <- cmd_args[1] breaks_file <- cmd_args[2] standard_run <- cmd_args[3] -# load file with binning breaks +# load breaks_file: contains breaks_fwhm & breaks_fwhm_avg load(breaks_file) +# determine minimum and maximum m/z values min_mz <- round(breaks_fwhm[1]) max_mz <- round(breaks_fwhm[length(breaks_fwhm)]) diff --git a/DIMS/HMDBparts_main.R b/DIMS/HMDBparts_main.R index 1a377eb..43b1f13 100644 --- a/DIMS/HMDBparts_main.R +++ b/DIMS/HMDBparts_main.R @@ -4,7 +4,12 @@ cmd_args <- commandArgs(trailingOnly = TRUE) db_file <- cmd_args[1] breaks_file <- cmd_args[2] +# Initialize +options(digits = 16) + +# load HMDB database file load(db_file) +# load breaks_file: contains breaks_fwhm & breaks_fwhm_avg load(breaks_file) # get minimum and maximum m/z in dataset From 89ca8fcbc4f6df23e33000c670a3c60a50fbc82d Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 16:45:01 +0200 Subject: [PATCH 28/42] cleaned up DIMS PeakFinding.R --- DIMS/PeakFinding.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/DIMS/PeakFinding.R b/DIMS/PeakFinding.R index 74f5d31..f3500b4 100644 --- a/DIMS/PeakFinding.R +++ b/DIMS/PeakFinding.R @@ -1,3 +1,4 @@ +# loead required packages library(dplyr) # define parameters @@ -6,12 +7,15 @@ cmd_args <- commandArgs(trailingOnly = TRUE) replicate_rdatafile <- cmd_args[1] resol <- as.numeric(cmd_args[2]) preprocessing_scripts_dir <- cmd_args[3] -# use fixed theshold between noise and signal for peak -peak_thresh <- 2000 # source functions script source(paste0(preprocessing_scripts_dir, "peak_finding_functions.R")) +# Initialize +options(digits = 16) +# theshold between noise and signal for peak +peak_thresh <- 2000 + # Load output of AssignToBins (peak_list) for a technical replicate load(replicate_rdatafile) techrepl_name <- colnames(peak_list$pos)[1] @@ -19,9 +23,6 @@ techrepl_name <- colnames(peak_list$pos)[1] # load list of technical replicates per sample that passed threshold filter techreps_passed <- read.table("replicates_per_sample.txt", sep=",") -# Initialize -options(digits = 16) - # do peak finding scanmodes <- c("positive", "negative") for (scanmode in scanmodes) { From 2a93a955691c8825b49b4f08aff33d77207b19c9 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 16:49:27 +0200 Subject: [PATCH 29/42] cleaned DIMS PeakGrouping.R --- DIMS/PeakGrouping.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/DIMS/PeakGrouping.R b/DIMS/PeakGrouping.R index e0a5c82..ee44ee3 100644 --- a/DIMS/PeakGrouping.R +++ b/DIMS/PeakGrouping.R @@ -1,9 +1,9 @@ -# define parameters -cmd_args <- commandArgs(trailingOnly = TRUE) - # load required packages library("dplyr") +# define parameters +cmd_args <- commandArgs(trailingOnly = TRUE) + hmdb_part_file <- cmd_args[1] preprocessing_scripts_dir <- cmd_args[2] ppm <- as.numeric(cmd_args[3]) @@ -11,6 +11,7 @@ ppm <- as.numeric(cmd_args[3]) # load in function scripts source(paste0(preprocessing_scripts_dir, "peak_grouping_functions.R")) +# Initialize options(digits = 16) # load part of the HMDB @@ -42,8 +43,6 @@ outlist_df$height.pkt <- as.numeric(outlist_df$height.pkt) rm(outlist_total) sample_names <- unique(outlist_df$samplenr) -## peak grouping -peakgrouplist <- NULL # limit the peaklist to the m/z range in the HMDB part, with ppm tolerance minmz_hmdbpart <- min(hmdb_add_iso[, column_label]) maxmz_hmdbpart <- max(hmdb_add_iso[, column_label]) @@ -54,10 +53,10 @@ outlist_mzrange <- outlist_df[outlist_df$mzmed.pkt > (minmz_hmdbpart - mz_tolera outlist_sorted <- outlist_mzrange %>% dplyr::arrange(desc(height.pkt)) # find peak groups -ints_sorted <- find_peak_groups(outlist_sorted, mz_tolerance, sample_names) +peakgrouplist <- find_peak_groups(outlist_sorted, mz_tolerance, sample_names) # do annotation -peakgrouplist_identified <- annotate_peak_groups(ints_sorted, hmdb_add_iso, column_label, mz_tolerance) +peakgrouplist_identified <- annotate_peak_groups(peakgrouplist, hmdb_add_iso, column_label, mz_tolerance) # write output to file save(peakgrouplist_identified, file = paste0(batch_number, "_", scanmode, "_identified.RData")) From 194fa48dbeac2eef6461706f03a3075b72f3926c Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Thu, 27 Aug 2026 16:51:16 +0200 Subject: [PATCH 30/42] cleaned DIMS SumAdducts.R --- DIMS/SumAdducts.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DIMS/SumAdducts.R b/DIMS/SumAdducts.R index 489ae17..d8ee40b 100644 --- a/DIMS/SumAdducts.R +++ b/DIMS/SumAdducts.R @@ -1,4 +1,6 @@ +# load required libraries library("dplyr") + # define parameters cmd_args <- commandArgs(trailingOnly = TRUE) From cdbd29885e729dd14d532b66f4122a769b737141 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Fri, 28 Aug 2026 10:34:24 +0200 Subject: [PATCH 31/42] minor bug fixes in DIMS DIMS/AssignToBins.R --- DIMS/AssignToBins.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/DIMS/AssignToBins.R b/DIMS/AssignToBins.R index 86f47d1..a076c53 100644 --- a/DIMS/AssignToBins.R +++ b/DIMS/AssignToBins.R @@ -9,15 +9,16 @@ breaks_filepath <- cmd_args[2] trim_parameters_filepath <- cmd_args[3] resol <- as.numeric(cmd_args[4]) -options(digits = 16) - # Initialize -pos_bins <- rep(0, length(breaks_fwhm) - 1) -neg_bins <- pos_bins +options(digits = 16) dims_thresh <- 100 +pos_results <- NULL +neg_results <- NULL # load breaks_file: contains breaks_fwhm & breaks_fwhm_avg load(breaks_filepath) +pos_bins <- rep(0, length(breaks_fwhm) - 1) +neg_bins <- pos_bins # load trim parameters file: contains trim_left_neg, trim_left_pos, trim_right_neg & trim_right_pos load(trim_parameters_filepath) From bf81af2c9be5e6302b052daadacb98cb03f54ca6 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Fri, 28 Aug 2026 11:29:11 +0200 Subject: [PATCH 32/42] changed outlist to peakgroup_list in DIMS/CollectFilled.nf --- DIMS/CollectFilled.nf | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DIMS/CollectFilled.nf b/DIMS/CollectFilled.nf index b1ba31a..8e2dafe 100644 --- a/DIMS/CollectFilled.nf +++ b/DIMS/CollectFilled.nf @@ -9,8 +9,8 @@ process CollectFilled { each path(replication_pattern) output: - path('outlist*.txt') - path('outlist*.RData'), emit: filled_pgrlist + path('peakgroup_list*.txt') + path('peakgroup_list*.RData'), emit: filled_pgrlist script: """ From daeaf890b26518156426497d260d33211ede4147 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Fri, 28 Aug 2026 11:59:43 +0200 Subject: [PATCH 33/42] changed outlist to peakgroup_list in DIMS/SumAdducts.R --- DIMS/SumAdducts.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DIMS/SumAdducts.R b/DIMS/SumAdducts.R index d8ee40b..c0dbfd6 100644 --- a/DIMS/SumAdducts.R +++ b/DIMS/SumAdducts.R @@ -22,7 +22,7 @@ if (grepl("positive_hmdb", hmdbpart_main_file)) { } # load input files -collect_file <- paste0("outlist_identified_", scanmode, ".RData") +collect_file <- paste0("peakgroup_list_identified_", scanmode, ".RData") peakgroup_list <- get(load(collect_file)) hmdb_main_part <- get(load(hmdbpart_main_file)) From 4d8e9d5aa51eb4761a4535fc299df3b66f2369b9 Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Fri, 28 Aug 2026 14:35:55 +0200 Subject: [PATCH 34/42] bug fixes in DIMS DIMS/GenerateQCOutput.R --- DIMS/GenerateQCOutput.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/DIMS/GenerateQCOutput.R b/DIMS/GenerateQCOutput.R index 237854f..5d52d6e 100644 --- a/DIMS/GenerateQCOutput.R +++ b/DIMS/GenerateQCOutput.R @@ -87,15 +87,15 @@ plot_width <- 9 + 0.35 * sample_count plot_height <- plot_width / 2.5 save_internal_standard_plot( - is_neg, "barplot", "Interne Standaard (Neg)", "./", + is_neg, "barplot", "Interne Standaard (Neg)", "IS_bar_all_neg", plot_width, plot_height ) save_internal_standard_plot( - is_pos, "barplot", "Interne Standaard (Pos)", "./", + is_pos, "barplot", "Interne Standaard (Pos)", "IS_bar_all_pos", plot_width, plot_height ) save_internal_standard_plot( - is_summed, "barplot", "Interne Standaard (Summed)", "./", + is_summed, "barplot", "Interne Standaard (Summed)", "IS_bar_all_sum", plot_width, plot_height ) @@ -197,7 +197,7 @@ if (dims_matrix == "Plasma") { } else if (dims_matrix == "DBS") { is_below_threshold_neg <- find_is_below_threshold(is_neg_selection_subset, threshold_is_dbs_neg, is_neg_selection, "neg") is_below_threshold_pos <- find_is_below_threshold(is_pos_selection_subset, threshold_is_dbs_pos, is_pos_selection, "pos") - is_below_threshold_sum <- find_is_below_threshold(is_sum_selection_subset, threshold_is_dbs_sum, is_neg_selection, "sum") + is_below_threshold_sum <- find_is_below_threshold(is_sum_selection_subset, threshold_is_dbs_sum, is_sum_selection, "sum") is_below_threshold <- rbind(is_below_threshold_pos, is_below_threshold_neg, is_below_threshold_sum) } else { # generate empty table @@ -409,13 +409,13 @@ if (sum(grepl("P1001", colnames(sst_intensities_df))) > 0) { } # MISSING M/Z CHECK -# check the outlist_identified_(negative/positive).RData files for missing m/z values and save to file -# Load the outlist_identified files + remove the loaded files -load("./outlist_identified_negative.RData") -mzmed_pgrp_ident_neg <- outlist_ident$mzmed.pgrp -load("./outlist_identified_positive.RData") -mzmed_pgrp_ident_pos <- outlist_ident$mzmed.pgrp -rm(outlist_ident) +# check the peakgroup_list_identified_(negative/positive).RData files for missing m/z values and save to file +# Load the peakgroup_list_identified files + remove the loaded files +load("./peakgroup_list_identified_negative.RData") +mzmed_pgrp_ident_neg <- peakgroup_list_ident$mzmed.pgrp +load("./peakgroup_list_identified_positive.RData") +mzmed_pgrp_ident_pos <- peakgroup_list_ident$mzmed.pgrp +rm(peakgroup_list_ident) # Check for missing mz values, if present returned with vector of missing mz values mz_missing_neg <- check_missing_mz(mzmed_pgrp_ident_neg, "Negative") From 6726629dc71ad86f3fc3447e2ce9f104df8c230c Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Fri, 28 Aug 2026 14:36:42 +0200 Subject: [PATCH 35/42] bug fix in DIMS/export/generate_qc_output_functions.R --- DIMS/export/generate_qc_output_functions.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/DIMS/export/generate_qc_output_functions.R b/DIMS/export/generate_qc_output_functions.R index c1b154c..759e9a0 100644 --- a/DIMS/export/generate_qc_output_functions.R +++ b/DIMS/export/generate_qc_output_functions.R @@ -237,7 +237,11 @@ find_is_below_threshold <- function(is_selection_subset, thresholds, is_names, s } is_below_threshold <- is_selection_subset[below_threshold_index, ] # add information on scan mode - is_below_threshold <- cbind(is_below_threshold, scanmode = scanmode) + if (nrow(is_below_threshold) > 0) { + is_below_threshold <- cbind(is_below_threshold, scanmode = scanmode) + } else { + is_below_threshold$scanmode_char <- character(0) + } return(is_below_threshold) } From 746c704d1df4352d76a3350693c66b89980a027f Mon Sep 17 00:00:00 2001 From: Mia Pras-Raves Date: Fri, 28 Aug 2026 14:37:38 +0200 Subject: [PATCH 36/42] cleaned up DIMS DIMS/GenerateExcel.R and removed outdir parameter --- DIMS/GenerateExcel.R | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/DIMS/GenerateExcel.R b/DIMS/GenerateExcel.R index f33c27d..910f1e8 100644 --- a/DIMS/GenerateExcel.R +++ b/DIMS/GenerateExcel.R @@ -18,17 +18,12 @@ path_metabolite_groups <- cmd_args[5] # load in function scripts source(paste0(export_scripts_dir, "generate_excel_functions.R")) -# set the number of digits for floats +# Initialize options(digits = 16) - -# Initialise plot <- TRUE export <- TRUE control_label <- "C" case_label <- "P" - -# setting outdir to export files to the working directory -outdir <- "./" # percentage of outliers to remove from calculation of robust scaler perc <- 5 # Z-score for removing outliers with grubbs test @@ -65,7 +60,7 @@ openxlsx::addWorksheet(wb_intensities_zscores, sheetname) # Add Z-scores and create plots if (z_score == 1) { - dir.create(paste0(outdir, "/plots"), showWarnings = FALSE) + dir.create("./plots", showWarnings = FALSE) wb_helix_zscores <- openxlsx::createWorkbook("SinglePatient") openxlsx::addWorksheet(wb_helix_zscores, sheetname) row_helix <- 2 # start on row 2 because of header @@ -90,16 +85,15 @@ if (z_score == 1) { outlist[, intensity_col_ids][outlist[, intensity_col_ids] == 0] <- NA # calculate robust Z-scores - outlist_robust_zscore <- calculate_zscores(outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids, startcol) + outlist_robust_zscore <- calculate_zscores(outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids) # calculate Z-scores after removal of outliers in Control samples with grubbs test outlist_nooutliers <- calculate_zscores( - outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, - intensity_col_ids, startcol + outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids ) # calculate Z-scores - outlist <- calculate_zscores(outlist, "_Zscore", control_intensities, NULL, intensity_col_ids, startcol) + outlist <- calculate_zscores(outlist, "_Zscore", control_col_idx, NULL, intensity_col_ids) # output metabolites filtered on relevance save_to_rdata_and_txt(outlist, "AdductSums_filtered_Zscores") @@ -213,7 +207,7 @@ if (z_score == 1) { plots_present = TRUE ) openxlsx::writeData(wb_helix_intensities, sheet = 1, outlist_helix, startCol = 1) - openxlsx::saveWorkbook(wb_helix_intensities, paste0(outdir, "/Helix_", project, ".xlsx"), overwrite = TRUE) + openxlsx::saveWorkbook(wb_helix_intensities, paste0("Helix_", project, ".xlsx"), overwrite = TRUE) rm(wb_helix_intensities) # reorder outlist for Excel file @@ -237,6 +231,6 @@ if (z_score == 1) { # write Excel file openxlsx::writeData(wb_intensities_zscores, sheet = 1, outlist, startCol = 1) -openxlsx::saveWorkbook(wb_intensities_zscores, paste0(outdir, "/", project, ".xlsx"), overwrite = TRUE) +openxlsx::saveWorkbook(wb_intensities_zscores, paste0(project, ".xlsx"), overwrite = TRUE) rm(wb_intensities_zscores) unlink("plots", recursive = TRUE) From 76a03892f5dd94ff74fd4ed9c048d5b0229711b2 Mon Sep 17 00:00:00 2001 From: mraves2 Date: Fri, 28 Aug 2026 16:45:42 +0200 Subject: [PATCH 37/42] bug fixes for unit tests for DIMS CollectFilled --- DIMS/preprocessing/collect_filled_functions.R | 2 +- DIMS/tests/testthat/test_collect_filled.R | 11 +++++------ 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/DIMS/preprocessing/collect_filled_functions.R b/DIMS/preprocessing/collect_filled_functions.R index 02ab519..57ad982 100644 --- a/DIMS/preprocessing/collect_filled_functions.R +++ b/DIMS/preprocessing/collect_filled_functions.R @@ -96,7 +96,7 @@ calculate_zscores_peakgrouplist <- function(peakgroup_list) { } # apply new column names to columns at end plus avg and sd columns - colnames(peakgroup_list_zscores)[startcol:ncol(peakgroup_list)] <- colnames_zscores + colnames(peakgroup_list_zscores)[startcol:ncol(peakgroup_list_zscores)] <- colnames_zscores return(peakgroup_list_zscores) } diff --git a/DIMS/tests/testthat/test_collect_filled.R b/DIMS/tests/testthat/test_collect_filled.R index 0b71196..72953f0 100644 --- a/DIMS/tests/testthat/test_collect_filled.R +++ b/DIMS/tests/testthat/test_collect_filled.R @@ -20,10 +20,9 @@ testthat::test_that("Duplicate rows in a peak group list are correctly merged", test_peakgroup_list_dup <- test_peakgroup_list[c(1, 2, 2, 3), ] # after merging duplicate rows, the test peak group list should have 3 rows - expect_equal(nrow(merge_duplicate_rows(test_peakgroup_list_dup)), 3, TRUE, tolerance = 0.001) + expect_equal(nrow(merge_duplicate_rows(test_peakgroup_list_dup)), 3, tolerance = 0.001) expect_equal(merge_duplicate_rows(test_peakgroup_list_dup)[3, "all_hmdb_ids"], - paste(test_peakgroup_list_dup[2, "all_hmdb_ids"], test_peakgroup_list_dup[3, "all_hmdb_ids"], sep = ";"), - TRUE) + paste(test_peakgroup_list_dup[2, "all_hmdb_ids"], test_peakgroup_list_dup[3, "all_hmdb_ids"], sep = ";")) }) testthat::test_that("Z-scores are correctly calculated in CollectFilled", { @@ -35,11 +34,11 @@ testthat::test_that("Z-scores are correctly calculated in CollectFilled", { test_peakgroup_list_noz <- test_peakgroup_list_noz[ , -grep("_Zscore", colnames(test_peakgroup_list_noz))] # after calculate_zscores_peakgrouplist, there should be 4 columns with _Zscore in the name - expect_equal(length(grep("_Zscore", colnames(calculate_zscores_peakgrouplist(test_peakgroup_list_noz)))), 4, TRUE, tolerance = 0.001) + expect_equal(length(grep("_Zscore", colnames(calculate_zscores_peakgrouplist(test_peakgroup_list_noz)))), 4, tolerance = 0.001) # after calculate_zscores_peakgrouplist, the 4 columns with _Zscore in the name should be filled non-zero - expect_equal(calculate_zscores_peakgrouplist(test_peakgroup_list_noz)$C101.1_Zscore[1], -0.7071, TRUE, tolerance = 0.00001) - expect_equal(calculate_zscores_peakgrouplist(test_peakgroup_list_noz)$P2.1_Zscore[4], 12.0208, TRUE, tolerance = 0.00001) + expect_equal(calculate_zscores_peakgrouplist(test_peakgroup_list_noz)$C101.1_Zscore[1], -0.7071, tolerance = 0.00001) + expect_equal(calculate_zscores_peakgrouplist(test_peakgroup_list_noz)$P2.1_Zscore[4], 12.0208, tolerance = 0.00001) }) From 18f328d7558d060ba0fe6044028aa5257abf35ee Mon Sep 17 00:00:00 2001 From: mraves2 Date: Tue, 1 Sep 2026 08:57:16 +0200 Subject: [PATCH 38/42] updated docker image for DIMS github actions --- .github/workflows/dims_lint.yml | 2 +- .github/workflows/dims_test.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/dims_lint.yml b/.github/workflows/dims_lint.yml index 7a068e0..7797c99 100644 --- a/.github/workflows/dims_lint.yml +++ b/.github/workflows/dims_lint.yml @@ -13,7 +13,7 @@ jobs: runs-on: ubuntu-latest container: - image: docker://umcugenbioinf/dims:1.3 + image: ghcr.io/umcugenetics/dims:v1.4.0 defaults: run: diff --git a/.github/workflows/dims_test.yml b/.github/workflows/dims_test.yml index e8c4078..791a750 100644 --- a/.github/workflows/dims_test.yml +++ b/.github/workflows/dims_test.yml @@ -12,7 +12,7 @@ jobs: runs-on: ubuntu-latest container: - image: docker://umcugenbioinf/dims:1.3 + image: ghcr.io/umcugenetics/dims:v1.4.0 defaults: run: From ad7f1feb6fc8d19e0ebdd38f96123e78a381c0d6 Mon Sep 17 00:00:00 2001 From: mraves2 Date: Tue, 1 Sep 2026 09:46:09 +0200 Subject: [PATCH 39/42] fixed unit test in DIMS/tests/testthat/test_generate_excel.R --- DIMS/tests/testthat/test_generate_excel.R | 28 +++++++++++------------ 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/DIMS/tests/testthat/test_generate_excel.R b/DIMS/tests/testthat/test_generate_excel.R index e4a7ff3..8e56e8b 100644 --- a/DIMS/tests/testthat/test_generate_excel.R +++ b/DIMS/tests/testthat/test_generate_excel.R @@ -34,40 +34,40 @@ testthat::test_that("get_intensities_cols: Get indices of columns and dataframe testthat::test_that("calculate_zscores: Calculating Z-scores using different methods for excluding controls", { test_outlist <- read.delim(test_path("fixtures", "test_outlist.txt")) + test_outlist <- as.data.frame(test_outlist) control_intensities <- read.delim(test_path("fixtures", "test_control_intensities.txt")) control_col_idx <- c(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13) intensity_col_ids <- c(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15) - startcol <- ncol(test_outlist) + 4 perc <- 5 outlier_threshold <- 2 - expect_type(calculate_zscores(test_outlist, "_Zscore", control_intensities, NULL, intensity_col_ids, startcol), "list") - expect_identical(colnames(calculate_zscores(test_outlist, "_Zscore", control_intensities, NULL, intensity_col_ids, startcol)), + expect_type(calculate_zscores(test_outlist, "_Zscore", control_col_idx, NULL, intensity_col_ids), "list") + expect_identical(colnames(calculate_zscores(test_outlist, "_Zscore", control_col_idx, NULL, intensity_col_ids)), c("plots", "C101.1", "C102.1", "C103.1", "C104.1", "C105.1", "C106.1", "C107.1", "C108.1", "C109.1", "C110.1", "C111.1", "C112.1", "P2.1", "P3.1", "HMDB_name", "HMDB_name_all", "HMDB_ID_all", "sec_HMDB_ID", "HMDB_key", "sec_HMDB_ID_rlvnc", "name", "relevance", "descr", "origin", "fluids", "tissue", "disease", "pathway", "HMDB_code", "avg_ctrls", "sd_ctrls", "nr_ctrls", "C101.1_Zscore", "C102.1_Zscore", "C103.1_Zscore", "C104.1_Zscore", "C105.1_Zscore", "C106.1_Zscore", "C107.1_Zscore", "C108.1_Zscore", "C109.1_Zscore", "C110.1_Zscore", "C111.1_Zscore", "C112.1_Zscore", "P2.1_Zscore", "P3.1_Zscore")) - expect_equal(round(calculate_zscores(test_outlist, "_Zscore", control_intensities, NULL, intensity_col_ids, startcol)$avg_ctrls, 3), + expect_equal(round(calculate_zscores(test_outlist, "_Zscore", control_col_idx, NULL, intensity_col_ids)$avg_ctrls, 3), c(16129.167, 1150.0, 1231.250, 4015.833), tolerance = 0.001) - expect_equal(calculate_zscores(test_outlist, "_Zscore", control_intensities, NULL, intensity_col_ids, startcol)$P2.1_Zscore, + expect_equal(calculate_zscores(test_outlist, "_Zscore", control_col_idx, NULL, intensity_col_ids)$P2.1_Zscore, c(-0.2544103, 32.4586955, 13.6066674, 0.4037668), tolerance = 0.001) - expect_type(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids, startcol), "list") - expect_identical(colnames(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids, startcol))[34:47], + expect_type(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids), "list") + expect_identical(colnames(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids))[34:47], c("C101.1_RobustZscore", "C102.1_RobustZscore", "C103.1_RobustZscore", "C104.1_RobustZscore", "C105.1_RobustZscore", "C106.1_RobustZscore", "C107.1_RobustZscore", "C108.1_RobustZscore", "C109.1_RobustZscore", "C110.1_RobustZscore", "C111.1_RobustZscore", "C112.1_RobustZscore", "P2.1_RobustZscore", "P3.1_RobustZscore")) - expect_equal(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids, startcol)$avg_ctrls, + expect_equal(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids)$avg_ctrls, c(1255.0, 1110.0, 1227.5, 2811.5), tolerance = 0.001) - expect_equal(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids, startcol)$P2.1_RobustZscore, + expect_equal(calculate_zscores(test_outlist, "_RobustZscore", control_col_idx, perc, intensity_col_ids)$P2.1_RobustZscore, c(9.1511750, 46.9804468, 16.8039663, 0.8565111), tolerance = 0.001) - expect_type(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids, startcol), "list") - expect_identical(colnames(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids, startcol))[34:47], + expect_type(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids), "list") + expect_identical(colnames(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids))[34:47], c("C101.1_OutlierRemovedZscore", "C102.1_OutlierRemovedZscore", "C103.1_OutlierRemovedZscore", "C104.1_OutlierRemovedZscore", "C105.1_OutlierRemovedZscore", "C106.1_OutlierRemovedZscore", "C107.1_OutlierRemovedZscore", @@ -75,11 +75,11 @@ testthat::test_that("calculate_zscores: Calculating Z-scores using different met "C111.1_OutlierRemovedZscore", "C112.1_OutlierRemovedZscore", "P2.1_OutlierRemovedZscore", "P3.1_OutlierRemovedZscore") ) - expect_equal(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids, startcol)$avg_ctrls, + expect_equal(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids)$avg_ctrls, c(1231.818, 1077.273, 1231.250, 2649.091), tolerance = 0.001) - expect_equal(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids, startcol)$nr_ctrls, + expect_equal(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids)$nr_ctrls, c(11, 11, 12, 11)) - expect_equal(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids, startcol)$P2.1_OutlierRemovedZscore, + expect_equal(calculate_zscores(test_outlist, "_OutlierRemovedZscore", control_col_idx, outlier_threshold, intensity_col_ids)$P2.1_OutlierRemovedZscore, c(8.9955723, 44.9136860, 13.6066674, 0.9345077), tolerance = 0.001) }) From 03fd185e644e0badcdf37fef6504cc72a7748bd0 Mon Sep 17 00:00:00 2001 From: mraves2 Date: Tue, 1 Sep 2026 10:18:25 +0200 Subject: [PATCH 40/42] fixed unit tests for DIMS/tests/testthat/test_generate_violin_plots.R removal of log transformation --- DIMS/tests/testthat/test_generate_violin_plots.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/DIMS/tests/testthat/test_generate_violin_plots.R b/DIMS/tests/testthat/test_generate_violin_plots.R index d5fe3a8..45b1835 100644 --- a/DIMS/tests/testthat/test_generate_violin_plots.R +++ b/DIMS/tests/testthat/test_generate_violin_plots.R @@ -676,7 +676,7 @@ testthat::test_that("add_zscores_ratios_to_df: Add Zscores for multiple ratios t test_metabolites_ratios_df, test_all_sample_ids )$C101.1, - c(1000, 1200, 1300, 1400, 1500, 1600, -0.2630344, -0.1069152, 11.8533096) + c(1000, 1200, 1300, 1400, 1500, 1600, 0.83333, 0.9285714, 3700.00000), tolerance = 0.0001 ) expect_equal( add_zscores_ratios_to_df( @@ -684,7 +684,7 @@ testthat::test_that("add_zscores_ratios_to_df: Add Zscores for multiple ratios t test_metabolites_ratios_df, test_all_sample_ids )$C101.1_Zscore, - c(0.45, 1.67, -1.86, 0.58, 2.47, -0.56, -0.5899371, 0.4858991, -0.4552026), + c(0.45, 1.67, -1.86, 0.58, 2.47, -0.56, -0.4574, 0.5552, -0.4486), tolerance = 0.0001 ) }) @@ -711,11 +711,11 @@ testthat::test_that("calculate_zscore_ratios: Calculate Zscores for ratios", { ) expect_equal( calculate_zscore_ratios(test_metabolites_ratios_df, test_outlist_df, test_all_sample_ids)$C101.1, - c(-0.2630344, -0.1069152, 11.8533096) + c(0.83333, 0.9285714, 3700.00000), tolerance = 0.0001 ) expect_equal( calculate_zscore_ratios(test_metabolites_ratios_df, test_outlist_df, test_all_sample_ids)$C101.1_Zscore, - c(-0.5899371, 0.4858991, -0.4552026), + c(-0.4574, 0.5552, -0.4486), tolerance = 0.0001 ) }) From e5d39d5a740ee9a12c14aebdda66817258a0a5fc Mon Sep 17 00:00:00 2001 From: mraves2 Date: Tue, 1 Sep 2026 10:20:02 +0200 Subject: [PATCH 41/42] fixed unit tests for DIMS/tests/testthat/test_generate_qc_output.R --- DIMS/tests/testthat/test_generate_qc_output.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/DIMS/tests/testthat/test_generate_qc_output.R b/DIMS/tests/testthat/test_generate_qc_output.R index 07be017..d4c23dd 100644 --- a/DIMS/tests/testthat/test_generate_qc_output.R +++ b/DIMS/tests/testthat/test_generate_qc_output.R @@ -60,7 +60,7 @@ testthat::test_that("Save internal standard plots", { expect_silent( save_internal_standard_plot( - test_plot_data, "barplot", "Test barplot", temp_dir, + test_plot_data, "barplot", "Test barplot", file_name_barplot, 6, 4, test_hline_data ) ) @@ -71,7 +71,7 @@ testthat::test_that("Save internal standard plots", { out_file_lineplot <- file.path(temp_dir, "plots", paste0(file_name_lineplot, ".png")) expect_silent( save_internal_standard_plot( - test_plot_data, "lineplot", "Test lineplot", temp_dir, + test_plot_data, "lineplot", "Test lineplot", file_name_lineplot, 6, 4 ) ) @@ -80,7 +80,7 @@ testthat::test_that("Save internal standard plots", { test_plot_data <- test_plot_data[-c(1, 2, 3, 4, 5, 6), ] expect_identical(save_internal_standard_plot( - test_plot_data, "barplot", "Test barplot", temp_dir, + test_plot_data, "barplot", "Test barplot", file_name_barplot, 6, 4, test_hline_data ), NULL) @@ -88,7 +88,7 @@ testthat::test_that("Save internal standard plots", { expect_silent( save_internal_standard_plot( - test_plot_data, "barplot", "Test barplot", temp_dir, + test_plot_data, "barplot", "Test barplot", file_name_barplot_select, 6, 4, test_hline_data ) ) From 23fa9ff6b056120051f1a3ff8c8bea1b0d855742 Mon Sep 17 00:00:00 2001 From: mraves2 Date: Tue, 1 Sep 2026 13:43:36 +0200 Subject: [PATCH 42/42] updated snapshots for DIMS unit tests --- .../generate_qc_output/test_barplot.png | Bin 47312 -> 46789 bytes .../testthat/_snaps/generate_violin_plots.md | 24 +++++++++--------- .../violin-plot-p2025m1.svg | 4 +-- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/DIMS/tests/testthat/_snaps/generate_qc_output/test_barplot.png b/DIMS/tests/testthat/_snaps/generate_qc_output/test_barplot.png index 9024fa35a7ad79500b08fab35a11ab095f827da5..b656b83ae7739f0a4248912494b3dd5c8432bcfc 100644 GIT binary patch literal 46789 zcmdqK2UJztmMyx?7{Nf0CH+H5L6UI$ypRh5+r9(5d%pj2?(f25F|>FY(_vt z5Cj21giX#l^ZUYcZr%U>t6T54_Ft>}{;F1`#|C?^HP@J9^xj7wv+kT#l;6C8aRZ4& z+I;ea>^Tx?9TkbRI-P1I{>8xSjtc%*Yp5VEOIjlS=W$U&5dLMo^$AT|66wGm;(u2- z#YsDmNV`ZUWsj*iJ?j7Id{kv(acQJVfcM?g>rB4`Hry6Bi+JUu9bac(6u$5|GW5B7 z1>egW8y?{bb9Z4Y%DG-)!LiQJ`1riGVy~x9IagkLnpjp``FSYNb||k){Fi{>rcLjh zr544yK6kl&F}99qDLm3OR?Xlqw*vP%;QBPGcQ5Nm+zs6Ex+pPRVl4d(=GF_u^8QrzX*HaV}r6UnX4K zcTV)n221OC?25Z2zz{606kFZ>`put5-Qg?#AJ6aT_qMG0)z$XAuIL~~&!vSat!y(< zYl%d!>3e@ZdfQe%v0HhzT`dKUY40y5tEGs!O{W)%U;g~?_U+r-s(QaZk$JvWz1YUq zmS4Y^cZiOTPRv>$@!|jN*Arqq8XsJ)Pt`rYHr8{YPoGcX&wZ25(sur@uR5JR`5?X~ zkXba-b!za_r%&efsg#b6>Dk#F^ZEl45^ldrr+dZs~f&r=;^hT1?{J1m2mp~{!T+fLv5|fjW@sA+qW|_H$Oe@ zt5@V=-}gO5IaV%ir}KpiZJm{o>M2_Gou9*#RFhLRGJel=#pHIpmk(qe`0>&hi%}ZL zw$vUdZC0CDjkk?2-@+)wdF03|AsO!KiN5-&{vWo(zuqJ!CW<=_QnB~eCD-G}q9t7? zhgzkN9BIgj5m|miM-TcX%3iLFh?_6{S>&3VEqUqk<>ILpS4&IF%Tj{E=HGR2V;3$w zx#=DsA0NOfng2e}FhPkPF zn)7T!hSZ(aw6r4ZB=+pNh_$-xvxAP#VR3$DTWfoYc5blo@#DusoXX$aSQmNN%5rgC z&9jq1KMNe0Hu)I3a`sWLUw*8_OHRS8OSC(8?xdj^9w}v`-?8JNX=rGuh(mvaT8h>_ z4vx@{x z(<@@cy|J)Z#8<|jiS*gbbonF|r)%3ydXJ?A$BL$~`~FOa1DFnfdHXR^#KNWbdBUmB za`i7X1)YWsHttdRL9g$2(5gkEqA4Lh-l3=FLu2wIJPkI1=i*GlK7Z-i?%0frrH%WT zD$B}xYM*}#<h3aFd42Eaf(RlU`3ibo%W^{=(t68!ICZ zPYn+{O%Jz)3mQw!^}lRr(8xQ6DC_zX)&BeU>FCDLz5DlLcb;>8Us-7}KRr?ou*qb`Hot89{+q!BvR1$OLAJV7Q$wmyq<33Lv5W1 zpr@nbPUsYJF7fd2DBnmc?%IE6`+l?fREtrM_V#vPmXMpaeyKWnHP7B1Zgmqpd^p#n zqPe*lkN!|-vHxWi>(nY<-+$i0hULLr<*u9b-9|pNdM*{2Y~biY>ebPCl$Ms}wpT>N z0q={W5_=TIjdN)2+O>lX8SPgO_hp+@8#d)wlQsb~>A4dpPK0o)W@)8_Pc*Yhxp7)t`H@M9a%|ypxRCfIO1$*rNBp|Jvo%6E z)GtXRJUra0cqV@I(}R5qQcLr;)YO4b{Us$NLJ#QX+x48IyxA#uS;A%fQ|Dg*C1ekS zYC%)36>d|l#R4CVxc}^JLcT3#-^+Z&`l$1z#w=5gYrn9eLJDlVzS!FfAGVUgE(|&B zkK*$6!JDw>&SRYu15Nd(S4m5k?2!-Py!h??ds)i%=1hDp&wefUp`t0&jSGvt!e+H+ z6=kgl8if@~`Q9VpAl59)-cFrDfU=0$C5EppE-pqOs}{Fn6+f1iYTMKPz^jXWL^Xke zghG%%b3Xob_@PUmXq?s4>OB`G>T`5i{?vX0m4V`!PA1AAY8l`9TC8-iQh7pLT=?f5 z&OycWVZr>J(Co=i+NVI&9`S%wY zlUih|*lH7-ytLxk@(0_`L>KG7vVKy{YJT+3V$<$sP!*1?er5P!gLAITtu1_7S?R;g zcp;pQX9n4YPpWUFKGU zNTh>NxyD=6Y>jRe+{?>$R`j~EY5}q?Y8vGyAcMAtC4fQ5iXW))!D$h^Po!)+Pge{% zzn}^Zyh4D4>}#vml^3`a6`QE2XPea>*nq4WI{xV4Lz6a!OL%{w@=d2kT?Y3hsiibN zK6azyClEn%iDzqL1&g$YPM)}B^O1@w;XJlU6zA`He_q~E8o#9G55Dvv1yN%5ne#gI z^kM1g0?t!!Z*DACXA&~`MWO5)`uO2Pwt4-R4jWoER4*i2UaPdiTgp^dCwl8@0^0_E z79cC+Ouk^3@oBJ*c^(#~ZeZ}3GN7>J5y&DQ-#pNe5liWc5DM_~%bM(6et6P#0~HE3 z#^CX>qRnqk5X2#kcq~CMMkoSF4u7o(3-2N?@|| zB==ieSb_`G_<}F(78D!y|ccLXK6dUY_~8IZ4OC zM}-3vN}P^kvMd&AaBy(cQbi>=TYcT~-O!LVgnV~%Co>(k+uQ4cbQ7lMVhYT4oC#=WeiTtV zKkAz$ZvE?Zy}oCWeu+nUFI9M#qP5=#`QB=$^vi|P( zp1he!gtt;PxPnvjgeadWDrt(OL`aNiNJyQLkUGnQn0G&T|vs z7MH0(i#mb30q@CiZY7$Unrcy&LX05=BC>5_QHm`h44XJu{-7R>>*8{%XTopiy?W)x zaPX~O5tn^$Z4X#PSy>svdcHR~?KEqudU<(ygusQj*mPT1#5x8BbR*sb`(!(QiCAqb zB_(yd=@Al_cCO{j%*=<$$KQGyb1azX=)Plvq4up^vu0*`+6^_cWMMK=bx+0_uGTcQ zv&UG+e$*bwmdR#Wqh&O&vD97aUxhZLS_PpK;um zE{NkyZ%dIY{$PH%aw9v|mwGucC<&j)D6Z6OQo%VE51$Hgah+_*F>B-avwe03)+B2I zG<8@M=~=xiaupdK9qk2F`y4J<^++@*GSU@<0yHMP*@6*3$YWvFhT(JuDzc&K9QX>i zqi?F0kXbFK5jP_PgA*|K!-o%16>}_qHfB6eq}k2E@iA#~YVhaz!S8@JjXWY2jVdk0 zc0CWW6Dqd*ZHSEL{Ie=Ft7Ey1Gv{4!iBi9Q_bwL6HO6DM2XJZ~HR}sEQ@~n^1jCOf zGPhosS#9H8yKWtiW6*;K0nDPiheU7#04fNhxSdbjkITtv37<)rnKHjaWFT=K9v(r# zZ=<#^GcykzI@IxVa-d1u)&9@p9}`Hj0Yy+7)GKtVPWm>nAx?)>+SD{x%I2xk^2TMX zvl3{dX5928>R@E^YO|J){!AeS?Ck92KQERBa5r^iQ*N!S6 zz<%!FEu1=^T&MU@;Fxnqb*y}7U}-TjkmZGn7cXA$Y3F<*ZU7tqyvQrJnM|8plwP_? zx2`WN8?{5DNBJIxMMW(De|{g@jJJ@|{`vWl{L4eS z!NI~JBFx(I0G)2yPq~QAjM@xBpOsZa5?lTIw$n!_i zb|73Fn}e&|H?s2<>edtzONJ~Y* zfddE1MTLTbg7`jbI}Wv^Gz;fVWJ<)v#knuebnO#SICaWp>ZfCfyqrIyQO(B=-A~CG zk-2U&HsZ_`-27j7blyng7zzk#Q0w}Hl6}hG7$JAPj^7aq^6VKbH>-k5!+;6z+N#i7of;d zOGNyc&?J6i)E&Wa*4p>L+WC${sf8Kib?W-y>^>(2DP$S)ZG`yq_X=s6FFR9mTQV=F zI|z6#&g*+F)SbTJ=jVsL&uv9NfMkUawJ2!zUcWuqakW)rRu9|K^sSlm#q*;Il<|12 zlfW2siU8ec|lEtLCH`YN=r+@@>*V9y@);MIa8s3{rYuC4qUl*wzf^h z?getO2YUojWB2mu=GhnlZtOo3k!96djCDa30FjK5_FM!{!zZfB%F3##g*Ly!zB>L+ z?M_)X-tC^4hhbsH3kCdgc(rkxZ@dw38Snn}>lb#17&kXJHYC{G+)&979u4IFG@X27 zrjbI1XjDnbl3tR3uT~YYf#L`ws*HED)pO!rV8wO zY5+Y#ruP=q+}^r}s3$@+VSD%P6|!vBXz{;$*9?0ugHKRUP~4$Ev2ewYZNTV9?0bU` zRS7H8v29y^?z3gqrJUY0*eWlyvU|TNNoUUogDvS4I*nXK)q3hO(W|Vie0+>+jG%ug zcAZ;IJw2D8Uqmq1_Dwjr)ijru?mu)W6WB6T$l>bMAL$ovgsZ4fDdYViP4wF3Kjo)A zbG)di2(sEsr;*>NMEv~x6a^$LNw;ZhAk2NMUOobaBov)8iS!4E1c)wEfeOb{ez&*V zB2EC(wLHpyy}5xxe365emNNPmng0@CuwyB{+JsOk*x2+9PsM%fq2trC1L(&e53O)B z@201xp+J0nU=$1nnhA1%3>5l`VF51~xb#$ix{#gNPkaNUEh8x}rX$t{hK7dKA>F>f zp1N*sg)>Y}*;)hQLxm^=ET)Vr)Ya9^huX5k$`U4#u9V%&hl0rgRh!*^J)@V`aE@|l{K(1EYK5#^;eo1sp z3{dVudV0EXwDaY!kB{L#vUA>fdwa(q#S=oopyScrO zc+5{De^IlD1xH7>WSM>gDh0=`YMiq^^HAbc3CfPM?w;6cC!`Nx4Avvozd%5c7lFo* z#Cqz}T5YQ&)eU#(l`8|_+k=q<>i7i&EaC~hX&}j3A??e`zV}+O>iUfvDZS~x!QUh2?UZV&(J!cB7b1tOIEzFyiZ^cW-1iL)8 zbooE9X zjMMM+(5DQm@*!85rxl4f4gUfO{y{0i9R%OJd!7z@6X4D;$jix-CsA4;ZV=@F1zkhq zp;|JZ`%+-?riy&t9V$LvFVTSW+JMSmY9h3O9m%J^Aw@5Zo{Zi>V@6fY*S-mY&AHDt z;~7v*^*k5sgOK4b2r!(QUyono*LfuXcGEG9y>0n3KijHRiXC6{KA7wL-N{z87>0+3 z0oKQnadEp2PJ-wJPH>xRKD>YbAav%$L{7>ZBq?0bZR(R$%|V_3BjO6n+qvIm9@w}h zg#FhQ^dv~!_qOhl+XN*K{id}y-c(=Yl93N!zJKbR>q#Xg{d~LUiU~{-PU)KyVvbxj zL=&ofl(-*srl1AJWwuD-_w<)$>xo4-p{`+B!R9u6&ApW#-O7|xnsm@$OU7#yY`Bx^ z%$l-H$KG#Oa&mQ5kjHIL&Gx0mK+q3X&&WH(>#oU}xM@YgTb5XomyJErF~lAy$Fw|Z z-4nCW3x48iw1xiF;y$HoT5z@fBYGNYgb-C_ZDeE=CE+|uAky(}$SaeeyN9h>c*BOa zp{%k>x1}qRaRbeHW2ifbH{(MuLvnK+@eYY10Vv5Xi(BoA@zl$TL7CR1%CMo7Lq1{h zL54ebPnXYk2lqt82Ysk&(F7U2G0@4gIo=p8Y#th3wkRnn ziH6D^Q`gpFcN7th&4jd!Hw}V{2-OltKK43g1rk~F5$nvk#+L&X9^fNxfJNM)VUjr? ztHV;UygJnAQqz!cU%$Sxlf=CT>tbqZYEXns~^B8`!j(i(=0$so^&>J4L7q1+LqG`wp--J;bQIqj@tZi+B z8jWu>c3l433vlVumDb{g;kI{o?%dHz$pQWaz8I=ciwT$BvymN;=_MM5AT#evOY!aC zfB?hKfiwIWg}EE2@jYnb&@XB3SD~s-)0Z~Ah{b|h^y3IW|Im2PH)I&!J9qB;pg%#g zZCec?R7Qzcyc3bm!2%*H%|kdyO-&_AH%K|E^_c^g_!k!!YYKv}(>`3{Iv2?Tu0_?> z+snwzeC1saWT_gTtX}gw(XNBYAYazA-;K&l!n;P=bDti*aOKJs2-=(55lximZsp_) zXN)v7E8gO@I3L=FeNig>%|r+txMGwTn%#T$ylYGjjz5%TwY(Ac9~0Pc)PB?28!9H~ zfggajNDxm2yv&2k7bHlXY_pKSz$(ZwM7y@od>4ocGHbz5aS-E3Uqt7;{sF_P;xDWrj zmetnQc40vE)cKu_xy$K12m&LicVen!NtfFb$}*anBH+PZUZkElw7F14h>Z5rv9+#m z0`!jw?Z$iTGLYU59DaD%O0QaKY-~*5bwD_8vaZK&pec9g>ysN{VPSS1_*MR*@drA? zC(*-OKxf!%}ow~1#q*Jefi?imy!z> z#yS-mLa~A}hepgEedV-z1dl7iEp%a++Z)^b1hwQu|Br7utN_)zI*SV>Z$bWa^6kpr zx~^uG&ri6BpO?74j^wqS%Qy3EgUU{|@0njqOS{ktT(^a}A=fG<{BloE&*+ZR2>6WN zZE-I)4d~Hr;Ffv46Fi4BAqLr6Em;@hDI#8&(VxZ;q75Qu29obhntC*!(B!}m0NHO> zl3nPe00D;Y<@#G5O|H; z*|Ya7B)jeMA)MG$xJRDdV%L2Q6E~DaCV3#m$>HQ}j#p((3o`-(Ml9 zw1VWdA(a<9@4S)5oeFYKQDm;if{SS^_)>IqwAzGzdHL5tqbH9Kt$wruIPPpVYM%5= zN03bju&@s`8!H0?=V1*fR62_r*mZPtJ_fL8zr1|Lw7w&77;FWbX&ZTZZVsKf94NHq z(Kr5-2JjO0_lPl~SD5U>U3p=zH=2i~4-Z~E9nCj7HKkwZl#%5=KYdkj0Z^t3ZSi|u zCu^Vq>}Q?LoZ$!wIPynuKd_-Q8Mz8>3g)^Z28yXzn&Y8 zrHKujHxnvUbvr&VL<9v6+}dO`$=6pwR@OUNLamYWX*9?%V{i{06@BUY z=Xuq#Y6ySMHHo<3b5MQ8 z6AU1g2=*EL5%uA1k#ZW|h3?SRv2l7~6Hvq(Yr{?EpIj)cVYv?c!=alibTybrbAm ziRyRajNz)_8#)u=camx=E30KZxVmZe)0^Y#2C}k*DsCtXj=LOdem8%|u+6pd9WJv)7uQvuK&YbbTa|beRH;D5yvjzhJ zyv|NyR3!>BswdppLs``9UrHhY?g8*=EyYRT~r!ctX}Ff9eS==CyoDxz7TZqW90Qox>|Eth$`YkTtfj zNfkD1rT>j^JluSf z?Dd%d;BU{v6_%3!9;gd~5Z%t5n&WZ6fzSnswt%waZ_=McVH91Iv@MjwP__5b0Fu6To!sgL7Lww7&!Z zlM7z_xXF}-J2FJu$V8PW{?|4H!hG2Ou5O~WHIaBxfI#~age)3sM;GD$kh<`8bx-ul z6tyN`7>Fwf!xHE`$mn6^ykoT1cXHW3`L1oCtXR6s562V~Px5VK5I@4JHCfZHi(I*# z+|k*IS4TVdB9v0H1ZY{Fbecyd;lReKDDlI@{R~6J0FyWd{@d@mo+()QpKeU%fKLR3 zxi|&-IfvBxK5VrEs`v1zt`l|Ym9S8~=y3sFS zAv_imC?w;@oSZvF`NMq0ZiS4FetfNPlqXDPiDD@1QDx5j~dTC+h zBTzsi<)Bh-t9kwUH5?Es&(Bc+ zarY}l2Xm0`0%}8H2@E{Uu!%raD5Cie1KfNH+#^#{VT+fFP)lJ1D}=MGrKJVM*X9F< z_w-!r(x9wDjbl%Z5zs05Hb7e)Y??WW__~OopqDNaX6&*yHlrZl&)Tv75drW^;?~P2 z;e;gG4(+Ty4~Bj|o?nASIimpcb}lg2}yxc?!e ztB9SFfIg@te8H3bKX5bT+vtuEHY6tW2Ipe~rCgdNWN)ma*2^%wNwZsoxYVc)8osA8 z)tUuTo`WVYvf;D+RDZ(_+G< z$nMtl&s9}JFRP?BZrYUfP3ft`ryxDNi$-R@4eWX@J#qV^oeZm=9!HsbKn>RL^;x)L z!dz49qKIAhS3?<#vYQ*}y=mYCsd=Y^Sf~UgAs+kS!Rmk_+KL1JAl=K)DG2>)X`yw= zKQM3!mOUiX{UJ%<4FutU3}kJc9&QUR)H^V+01+5IVizYTA(O9159DNN4WR1E`7vYw z0=_h^YAJSaf~<~bgx-#-njp0B4d7(3wWI_f4eR&#@h&ALrJzMr_dcnQ^2fM-~= zzg>HG+u#3;g2LFyh%@Z3%tr{-TR8U6Y6Dt2{gtF07x5uAqtA2T=W_3f3+q3^DhNs` z1>y9Q|ZGP1wNO0q~jp~d&PEAQ0ug&0Ifh(U($KYo;xlM{2<5$Zw- zQFnll0j&k1pOdq5$Px*z0!TtXp+{K~Qfvry$P-nhl>Kj$#udFN@+%(8!fyu~@#Lrb zd%$3`M@wd*K?07ZBk!%<%ow~>w_?IT)uo(FN?#qq{&?++Q`Dr_B~Zl%;KCP&H|+A| z%cA;X2nyib%EPVCCXuESsqh^dx5ee6NVzDzB&tD%I9`;$X=*}R`*UgkHxE7pB*(7v zdVqFlQ?-oOaqzFgq9V%AM~@!8eM?>!ur7TgDwU(7qiK_Yz$GIiQ3nYxU1Z7QEng}s zDypg+e;F8vrl|FGvmaqFda`|Fbo7CA1}KuKsAvES^;s9R)hj9#S}MPM`QA6Ng_+ub zUM%WMW#yU1&M6l70PR=MCk>fwQ8+b6dFgQPxE&Wj79UO8&Ku|5mdg|61<qTfsFeKX{Oq2X_B zt0L7a)S#E3UE!ltM(o&#FTY~yM?Ub${QD0diU8+aiu8zXL^zuL0u0_XuoOidyyznr zdtV!UZ2-Mq2*F#)CfQmy-t1a<3|$Qca=%ebXl|A!e44tm$27m0Wur8XTEfZX;ZeM* zbXCL6+}zxRgoG>$0R~nHr(X>tBnM@v1k27Ov>&eBxJE(Ig2QH@E|L<`2E2%TtAAzx zW=0_mRJ^P+npFGr_4U>3JzISq04m?V--geKGalVH57_{6;c~3Av9U!d?ziZhm<2@= zbC5`Xl=&<-{O%w_WmOe1XfxrmfW9ya2oMlbATqJk{O~)tm{5B_5Ik(!kwXb#26w-a zju%w-+8cx0etz>EK}vMI8tGhJf%!`49_a5op? zKG6o#Q4uQb#xvO3*Z^{f!Ti&cwt~^0WAENe;KJnFLnTXkme1?^Fydj({vM`Fm_v7Y zTLYhePiX>*^rnGum;PiQUL5z93LY7DSu*)L%~RlCRo~&s$& zLiOa4KmsQ+BZ-s{`_w>)lhXwKXB1?P(zvo`FhNKJ1*>pQ_10B9i$lj590v0E{K&0r zKB5J1RYPwl!UFSA?A~s+CK;R?@vn~p?shT^010Q5qJhQhO@$nEb;j|uTl>e&?6TEl zO{%Soj1jQOJ$lsq?Bw=jEh)v*r%z*GCVVa4$>iwhp>HJGTk~5VAjm*`BfN zlc}WY65Xcr9d>gpCG%~r;Ca{FtaIbdSs*(!%?Mfn5U^&=8g!sx=ufj))6otoVGfA! zGUKbfJdnSt>xXY`IF{!T=Igt$RWNb&>2k8O^TF58xso^f%e|}5ZcH5aX#-35rjd&sfn5z9_{Uiu?ohEYkbtTxjrfP4 zXD-C}R{+!)2nh+OOFhGe~>j9s5I9E6A2+tTp*Nt_!aS_4I0s9t;S zbhWo1r+E?k^g~!MdQjgXfB?zE4s~H>l(P251;9?ix2ZQVGP0Gtqrk=lz7ZO-i$Qr( zC?YoTA-hdFR6%I2+aqEkN#E@`UU1E4wZv)EQy9Rxhb|i#(eBuB#9HFsusJ99 zj^Y{~Dr6&PaY(5A{8dEu%F?m`Cn+D_cAQ5>5Qe=B`#v?(%GsK*n|QZkByN@H?7Kw1(z;#^=N3@ydUh!IYU6c)YLJyx zk~DA9Krs>bn0G=83Zlblt&bl+ZeZ`2ILc==a|BV(e|31DVqM^dx0gcXiu9D8kY2CW z-$;A!jlr+h;}$QHHdWsHo?-9kNI%KBabfwY%zeUZch0Tq@wwkqETrS2KkKh+vBo)G zy{bvDCHp=b8=Jeu@EPkqIS~;j9~ZzP7?rR`T3VV&8`Y1Gtuog}9(sH|z3>q71i}!L zK8hK9aV|;`2EjnAq}M%(`xr1Cc;Ui@-_k)xxhND0(I1*mctlGEx^{AMB2@1VtI?V~ zR4jPvzUSbj9bI$5*(kBv1pJV&ZUM_b<%?@lgzahfpY(E1>$)=gd!ohXJ&ls56eVUP z!0_w_+Fb6)^0u(MHe|_&q6Cp8|O%!9q525U4>Ec&Ee?D!R zag*?BX`~;GU^`_f#0Xi_rTZ&8gg7V}QsAuz4=PiQz&?pP)cuh_;j{R7=^O!^;QcBq zfGG3fz!_f~HKQ^KdFmC@X@0rV*5fq0-Y@B{-Ot05+>r20c|~4+exp&S`yCWVD5&&& zT6;q(QKg9f+R|^xi3ja_RZQcRk7?dss;IA5*K_0I=TB?6nMdj}T&|IO=ps|7%yjQ! zuX!!y*KPF4L~9vXU9U4WYq0MMeX$FNmRO%3)CF{xGJxrD7~Cd3#NiqwI`iryOD zzyp*3K#*Gq%>EZMsQH^|(_ijlNO?#lr~HJ*PYot!#q#1eiRtl&+#nbr_wL!VXZ!Z; zNIB?46PvU0K$5H`)y_AZ+-%pY@7^)kLA&7%XMf;^22K3>>D94`XQ||PV1nImG-XiR zbCynQ>vd%nsnxNx+wm(q5;n@I3ZbF%=Q{CkKUVy22qpiU8O#5C{+qB@5tlDU2dgb+@c%(UTCP0fE*zI!@UXgmz9{q&VK3a z7U#GU4K>^Z@9*EEo{KfV1_x8?%vgjONVMDaduZ=PMn6RL;oX0G0hlF8NAIMKZ}>#`PJaHZj`cbYSKzV}%d7l`LGAh- zs97#l>9^%#ui7sRd7cNe!(8>X_7!JWjD+YN;~d(CPB7$rqJa6y?NPdjuYIjYB^UJ? zR!Nj~4cWg^6jl#bA`rm6s(*j!Qvm-_2h=o0#eh}oR#hND*|_rK1Nv`%2*V%5_5XYO z+yBm^4i=?dr&#q=-Mf633SMr1V6BvQ`>Qq2mfiMd7I(MD-S%=iYo732%xRr@w!B5u zt@AHVN5wQgz47~7>D9ZjPT|gl6Ith#`%l-}CanokV4=<9G`J!1rh)tM(OuWx_b<#{ zRGKRDrdfH(*h(X~W>L>9Z{rOhlYF*Z6zxOf(S)0a4* z>j0!pjAH`eL3^C@)TSe>)%cWW&o06Cjj8r=h{^8wMjx8aFHv(4=Gd<6B#}hPNHj+~ z=DR!>jb&us5qAZ3oSv5UCXHc61GuN>@C`O^8V`)aCh%Yj12Z#_Uk&6mol;Pcp>lS1 zhAtn2_9j&uK2bXH5Q$_%oSNbF3Eki`R2MLZpOO=}Q;@?u9e}TvXOi9f47}l}#^7KW z{ISv$#cI;L#T+an6O*{!TGG)$B7f6}ma;fD=N3<-KqJd)j6SiKOqHR*EBVocn;ZoX zTyi;96P^+u8mZ}DHv)(S7e8IR8c%|`)40k3bZ%{^+TbRute8t%M}Sg-o8F_b92HY0ApMsjCGK$ix+46zPaL`WvJX|$A3({Ua@MeHw`f& zHInJTtC`uMzev$<hxqZ2%4u}tNZ}$__J059|0Bai=aamGvBe_7B*xN3oS$~ zMo@|{fE~aVeVRi&V-v~i0MUWnRRelH7RT@Yys&WIbFpe^=4H$R@BI^>K`0R&X9ms` zZT;T)Xmny?qOFQQ$RQoS*xaV-0!fe`12}lqo@noZEc(~3K7*%5b3n0(tF?T8jN3Lc zjA5Ro6^&Q%6Z+1SkbxcV4Kwi0?Wbd3D}M-+rtj$L%4I(33~+Vk%o)x8b)SyuIu{JW zA>9@uOT=K7kgzbHUf~gMYfQ8Z6-;f^pMHy-5^+jUh6*rLE5q=(z5T?={ZX|^hlKCU z!`UOI_dNhi0@tLu!$4!5#|q|@O>*})YAx(|Q1&cl{ky@3+{gcNZUjI4qL>(Xdg2{Ty( zVsZ1Mx5r8l2bRZe@5$d!Q1rAnaZN67AEpTw6~6h z5W($taCw`4(4YT+5MG?nU$TdW%Shpmnn!lN~&rbBkICq9azQ9QVp%@5O zQGpd!;Cu`k_g~IxY0dr|^2ps2lA(d&F5)_0P9l9;Q@ug1udmOzD!K^PTN*O=dRW`w zb?75H@bKcHr?*#krdpm&81@tA2iWqV$z_*DudQQEeDPuv`}_70A0Hn~gyM>{Dt1O+ zYUezBj=%>`?w%EhIL!fP>vvF2Y9^8X_(;oBMc=ZJTH&j6#g|~8)MBm#%0Y(<5d}jXyu!N_K*AtzdYJz*i&|+9w8f2o82{IOFJOX|tP&SqNq2tz?aC z4E5j+0Sjs9^p)ox%}RR(s?bAKMm-Z;%MervfMG!7LH1dd^OnfQ(X7($M zSzO)%hVO5?SBWCuA)2xB_xH$O?ieG!gLI3V{APJ0sx508>ILs^&9TrHUlXQd zQdb&>*4(95#CQ+h=K}-jaleXq3d5@T(D8>SzexK6Cben`0cX-jq$iY zY~H;=WjN|YK=Q^sm@=6P5qOs;^+?wv+q-w~J}B#eVkr$95q?(NGLP~_e8}&EA-gxm z+G)tJ6&D*T7WtIm3nrNwFazAXckWw5!^3K2_(){VfP-xXFX6jaB>K~kyhb)9YMTUG@|2kkd(1zi{lB>5WPP_e}R=7$Xed9 zgS+g~q3xB+Gn%*d+6CM>(lRQ0M8=q+|BU4 zrRd}xqV+@Gumz2_P?Usv#6~_*@+WvY0zR#YwYRs=ZMIQB(Ba9j6Al}d2Rli$jJ#7i z(&mj%i0gbo&Ay3M;uW60(y@&wuftt4gH2a)6S+(I3ventD%U7;2jsw6KRtC=c*YHU z^vv&<+U_}9_J}^EJbsGzic9l~Pk`?SLyx{qq@%`n)C35hd|zroYH=~9c}7~77N@i? zYp?`IJSaveJg>u1L@62>PxJFO#*^XJieQ%lR@p7=-r1#HTzz+8iv z6ypdYYB`ZsM3($jR8?uoC#VG?7`^R&WE!QE1O1#2L5+=?-bw_sm*Q4zUKk13+{de5 zU2TV{w~-4E1xXbLhjgNo-DFmeQE=p9W-=!~zmmmHNf$e;EZ(S=WG(y@(x+ZrMv~O=pPqOP_GM*c(Qm0U2mKNRKo<=;yL|}ZLp;X6Z%zgB?Eq33d@;?aqAK4F3Eu-W*Vf_cbVD|6 zj!`rjAWj`Sd9n?6v&9*rGBklR~9;ltp&NFCnMzZP(@zMDbF$$au zbL9xsy}Q1?uu8ZQ1G3hQgj!76rTui9pF`hwi`IiOP4zG>p^1?Y&2FL3ONSA1T;jEZ z#LsyhpnY;sZaIr$9+mi)qaA;w7_U!6zZuv4zfO$%ugS!}&j)lE7vPy5%ScV-RT&km z`LsoUk+~Kl{+AAg4;=7nwt4?Ebq$`@`qHP0v10nIl!}-ehCtnP6%O=AE&s-+M-J82 z)&2F`I`_iD>QR-(&CuF{E=f1H!se`cORDQcul@9XVx?Z+zW{9V!*WIDyJZZxluLT@ zoVd8OD@l3Jd93QAw)wGMpnkQysLWFTBNO}gS-k)3{qL7<+H7qw;v~_;_mw@x;~Wx{ zhr>}G%Z;L+24<-qgms0@qJA>I>E8Mnn52o%n$u;nKYW0WirpLQLejEPs5NutNyzSh-C)_JnyM`(A1v6{<>|5=n}0?k zb<67gnJ)Zq4CbJi0eBF0iAO|6s=v?}sexAwMeL3&3jS8u>LVnaZ9En|=M-#!jW-`| z{@S?{sm=lAC#yLV)rlDHM4to-5HxsNT3Wc~KmRgDuk!4A?Bm-{XJ==TEKqAjz3-hO z!w*lOMevqU3~s>3c2eB~4mr?ti|A*F&7w!AIoOc>0T}YHKr* zUrjceD@jh&s&(BdZSSGLCaeZqa&R!fe=dBy_fPObZ%8c|i~zopp_c5(Qzm)oT=XNj zVM2bs3(=vxc@uLkN^wuwy+JgaG2p*%-#%FF+R*>5%RJ&OfQk8*Ik0#6q_xx5PvTjJA|X4CCIU3FXzS!2yP*KUa~y?p&r#U)Hg?(U6bekdmpN zbx_-B-lExY9w7XX@D|hAwyz>7nlCxL1<+kqYx4E=g(WJY7}8(fI|hPueTl=tHE-6? zV`#^?RTuq;jqICn08Ms25Wnp1k(nw_5A_l*(p-Rh@t5I*z=A<7>s?E&yJE*X zy+c>=3|Xm(oAjfQR3M7$di3= zHJmfHEQv!`ViDZ(O2T6V%2Li9`DH?b#VV_Ur$8vV_Qs7z|gio z{InjbcF)O<+$%q}kxy_0sq0+*AlmilJkBUO%|Y1Wz=!H;YnyE<_#9iDjd|&y@or?t z$m5`EW3Bi!(*5AuKqTgC%NrvfG)SJ+xdQ_TRP2xN3xK;PUDUBVQu8_^V6?=kOd{F) z=zQUs8cmR1=mGl#a~mEk7{bAivtD7igPmp=9hO-Z81eyX2^@en)nS}wg!yL71rYAK zitE@Go8Z}KT?N4JJeb#Y09`}?98{0NA1}L*;2Iyf;JhU%?|Uxo#VlA~MhPct@ioAC zmckTwxrGZ=Ee8tdn7|?;vVOZBhqaul)P#fm7tTeh-8hi~nz+BMD(Gi!JNyvv`ByZhiT*ko7iID~ z-(S~(@5tk&`QO)KDmcConRId>QtxNRMR~*#k#h$k9@T{8_N`i^B<&g9vIG&)`uz_) zfn)JlR8mqB8d%bk4Hu20?7tr)wrFkeILP=$c0bIhd7stQEwcIn*Mba{g_HwGJ>Bwq zcm!4#X_@~VAQi_*9d2>D2%}4+5t0jzOB%t+A%OSkLoN7p8nT&JbuHC17*)+x2|~cl z!^bz!90;&BAhb7NrVShS-DzK6X1rE(+Re(828B^Y6X+PVmPjV2G#&)stagh zA)CODVKR|3S02K1UU;rTZw2WS;gloY9|H}#MT5iKYF@D+J3cS3-87*jG4dXy=3a}2 zw)WgRwnb|&AZS{X7~vrF%YPCwoc>wJxE$swOCoJ~-GRQO>=$SjGE`8xN*6aAD4zZe z9CnL_AfPx&2l2}X)CkoQNe$tuSScla;jK5cATjq({}pcBxdhzEyqCE7Y9yrp5;rpb zOWYXgu%5K*@bU`^1!El$zicuGh${$o z-IRYN%H)p37=p~=EYZ)HaKKSkFwXICbFanFS*NME-tx(*mvpnPSO1q46hgo{R;R}} zg2|gEu#}0B5rQ@@g0Fy6WlI>B@(_p`I?)sLo}jW01T`_`4ee}U43k_iY~W~%@!@yW z(2F}EM@FI9zWe?O`u|eM&XutEkB>IU`sWgf*|HO6?Z~#4a1TR|!GRgW_})_%S1c{{ zURhtDYRhS|#QxdL-a(=GBadVAv3o;$kZ}JJpuUVr^Y)P65XY&?P{Cu&$IWe)Ckcn| z)2F+=;g?FP4gD8-Hg(Q&C+!o<)(vvf(5Y$OLL@I4O2x$GEgE=0!?kpmRdS5#rIdrM z5H(P$?wIP|-y6iQ`=5v=@W5_hhqPwcS`HeI(op;TJI=`(eat;&3>gVzdte7VCT-^W zb6VnSIs!C!zuRQPq6mlnGVaFA?+?ps-#2XBc>esM2Xha~F6C$gEOl>v;<)1E@7WatMYO zS^+@-xd^2ahdS|X1k%m}`xn_CjI%+h*>}*>vt6MqVvu>%HfByod<_DhpuCOJ>qU3d z`9kR*H?y^Ud5PKN1D~XPmYbv0{S$k)-Qg9HDTQtu>RF4j*>+n;KNwQf#K4&87@G!HX2T|yu$Y)u@Z&3vD@d=EcWYhrvuw&45O1APR8_6RD`9i(&v^MoEV=U5 z7EG4Wk`q%?TO8|`s|w1jXv3-H#c`D7WU%-jwFoGI18KzMAiFmd&Fsb&9J)(jJ5D}6 z$$$DioS{U)%qx!Ec?GR%k_Xb`UrM*yP&y_s4|$)}(~I7s`d5nR2!KEcHQ0^n0*+_( zpCev-l3!`Nx~{z{)dfh^J;zGT%*+NMYty_1j``Nr@3c(G?}_ggnyLAJmV<;)IQsJu zgn-9-cGbrrU=tM>`VQ3v=u9{m)XZ7sAKN~}AS)x|;QbSJg;M{y3NR!de(s-t1M&~f z6Yf98vd#AcAq1C~i)H-Tuxqw5UR-Vs?mE8QhyNF?!oLaX-`pC6IY-;8f0$CWCdFez zhQ{ZrH71nX1$+d3{PpQ8qVq~F=|>x=HGD@=19V=GY(cw=(A~o&8?b-*$A~kO&>JEM zx(;%ww$wg^+!W!z&tTiN&Ym)m|Lj@Eu+nbybiDS+fO!AoD}A<{-n-4?z)>FgW{Wq; z#JL^+XG#}4spVQ(8h*56i!cBG2!Kj?8g6`CzaC$bU|2xc^9VFe43@e9`G*%H!{ABf z?LH)r*VWZQ>0LNj%52+cnjneBC;C~s)}T))J_|iH2jy_imL8B1`nCjCg%1zVM%Q`y zyg;vDzjd)Vae@~%(Y$^4Pt4DENlOo8eIu&A@fYSB_m=NLm$&^*_bO_Mbnu|o`Od?w z(;p9O4KxC)f(D`|WI=O|__oJ9_P8Hlzet>nfg{3R;>YzDdezZn)k?k|dgGoHy2nru zb-!X@fJCCv)D`<^f+jQCo>oQZ6C*&0Zh;~cQnfXZyp}o-mw?4qDICaqzYDw_PwZo7 zDiDEj>=G-_#|WPBh^L>Bohh(Dh7fCOGFwKR1^dS4CJUp zC99eVCa6kXZo3Mo_FTQ@T*&jTUGa- zv(MgZt-bat{xijiun&Ojkg(I-8%+-QPeQ7?V+PYMe?tYKG&EmRQkdgb+1Ryr?lcCE zv;>d56B#)QSh?bm-<`yY-WEn0XeNP9 zs~5_TQFsD4M*2YpnUD5Yu(`46z1657tBpFqMh-*XY_mU;TmrE)vsJ_wg%TE&HcBsI z7Z40Me4{b6TUKx?)<$&&y7AJ}qY+m;qh_Pt5Ch-#vFlyJ0!P>;H6|Y4z?-uih@T1her$~)(IBqS4z_8o+j#~a zLmf#?v8vs3Pp+v(jSZc5a!Tvr?jmoj*XvrfSSv>!(8(8<+xhHlF&=bswT0Lz0}X@> zyMaio#gIPAR!UB};>udT7h8!fyNJWvX|4gTcR!LmTSDK0J75a~FQhONc8 zDuo!*gLTPSFC@i27m}m7b9KRjEW4_plQxM)bLYkmCil-cCgn~-S5e}vTelXOJq$@G z@P7ZU^JLP&H@lH>0Y+pp+^!vaU1I6^%K8Slx>%Uuk{xArvu9;K)&(k?d?bI#S&ATUT7Y-(j%6w|IBU+1e=hRT>~F= z)(t#nD{ByG9HYw?I3L|7VAqe*%zqr_>(VyHSvL|EI4yPjE^kkqE-wQcHW{C# z+x$5!xczk2or3uUnp{s+#vR#IV^s=ThDnDwIRz;PATAjcQ}{2D;q{&9MMo+Q?@VYv z4r*v%wR($aJ5^}fV!!l-xNW9N8z=q=H>ngRhvEnwEH?Z7-ar zeI*{Dlr6Pqqw)H|&<#vCn)f0jl2L4<_+ZjO&ncQ#{gIdSg3S{gNY&$)eLkbWo(mF~ zYk{-Zh?{7E!VJk0KtObJ;1kNuF!^QDQ7}#c{oOt^g0B-qyewG9aZq%m32x9Tqkt&b zQBL9886b9lzdE>V5P`-WnveE70RZ+O!6brk>rz@?C`eGc~|>kb;%&`?M*@UF@a}ZCMvZD zPjpu`9Vy&4-+03V3j~vyroV4~v(g6XgQO_uFbXGPiLbf{Djk(+D0E0&&e6*vAdpcC z;3d~OKB(7}aX=u30jB}v^J|b?Mof%w;>jx!Vb~}vh7BD1pje@p=Zpb8$w|ObaTGRZ zv!4$25OJO;5 zTn>j{SndbN*LY!IMj?mOr?W_gXpf6mAgDtofyn6$SR3FI#CO(kWldTQLHigsq(Wgs zyD{^D(pEhGnc>#kTzm|N1j2o;%~DkT`>|?4qk3ayL5mB@&kU(31XcUX=T?%e4LXB{9r3_3)R$b%J}M(S^8oBvQT+w0)|5Nfd>rQ zF;g4L5WOlm+p9($*n__-`Gx;M^#ejUW{t~PNT?04EHKP`=5SlC9P5-+1}HaSW7<-N z@EtyKpTo19!k)@gmP&|nLbz!V9*)y?k^cgq#6_=PJCyF)R8~<@`0LtG#N5CapncCX zz&`h0F?R@U=mnWefk@b}W2-ah_lZ!vsm2^4Y6(~o#SHIT&mz{RxQB=ViFO*6fa&;H z_J?MDUpaEsz1pyDzRX>L6ezMlw{Ooyaiv z3NoERA{TUS5Y%poUqK}kE1NH=wJch+D6=oU0}~^_wic#?_ds~mn7djtwFd;NIXM!r zj8HORCQXE}0aZ3#aCehg3$pfrs%jE=;o-SxwQ;~~CiAB0^8s3;I^BL{q1Wj#hIQqO z{@I~*UuyfRf7!N`PQn#9Eu$0w6EdR%g(N-0MG`1RquC2aImqJ0sum%j3ht606=Fvaj{M;cf|X=TN&rYDvE+7|YNLIfXXKNs zTM~7X<+kgcEhfHsEe+r*K4JMwA=3vAQ@UvMldH^7r-$=SAuu3-yjP?P&btg$65bNL z4+a5U=p-VHp*WFPx5$kU(h=w0bs5-oU*w4Y= z@&*5_i$q7JFdvSC_H};8+{ITshy#R{*E5#mDdGE^+#IA~(0!s+AHLr^4KPx*Z3o1cCAmPWRsHo3!0E{-1cyc7>&4`?jQzed z_IIbPA^mBf=7$Oh^j^P0oijtG?wxixbkEB^~&_T4q z2pR#zT%8yw);H)r8e0KN)&*^R_P&$A6vv-TGX3ZXqUf0iPu&Q)K_}RN$m1t)W#+V) zJqHf-L$GTB0*_$mU^o+TL=@{zNWvOp8$iLFqZ*(5+0VI)L ze{IJ)N2-8D9b!UsNXLn0=QYt>J{57gk1f3*-Hd(t^&AG1XbEssV-xtiFj+H*@ku~I zY9bnNQejK?_}2~TIXTUrVPYps@YwEmf$`QJeK9_d!QeUAJrxa%>?rfYB)CcdM%}U|x9s z9tHW>L4cVy-O%1hB!fprF|UG^=GgwAV(&C$xY-f=tnkTkysJr0g0_s0g*L)osMky% z2y%NQA40pAA&3Fg4QPMev112HaTr^5q_)OD5-8nMv^8iExw$Tjsokxh=bo3DhzbGU zS{MEc=8rn%!SW18#Kg?xbK{asf)co$lt;voly&@-X)@|~D&@dR8wIF5ieB4R=s%^g z@sw~7;zyQ0JGZ$Cho!#;Czv#Ok(XN_;i)}~To|D#Ie09BGwG=6+I`4kfjK8J>4QyY zZu{3%`}Y0&opBPx9Duft7jYMYJYNk3eMHXY2*d6Nvc?ahl#-`>sw}B z*88JM`?ofns}LJl`8s-yoIz2HUhJ)O_(Jx7P|NfyHnt|{C_3+iU?r~atosjifsGBr znd?t|%e(Eb{fLFf2YPEc4Kx6gNm3!QK}5?t!-d=24F+oHeCQm35{}Y!Bh4{MmNiC& z<|Mp*s&gDvTo)14omzHiOSIg+j;TJ;1pR<^7hTqE4HEykoG@5PO~rEk1K;~-OXg+8 zVK4T^TH`26)V3rg5d0fld&INjd-_;yMje|tiWnZfy~ggg0VM%Zx4AuJ zy-*@h#97#2!_Ox+bIZKpwU&Lk_(XE6Tk;nyG>EQFKqA=*%MgO9?$nM^L7BCj<+*bO z*)+%`!(l*+D2fR=pvohWd^LC<{D?~CCEGL*1V>~%MsI8VR(N$SmW$Zbp7vLpUJ1$C z^mjGggaixdBX1LVvpn~;3z?ka7WD+BU}VV*m&$0OlEc%<>6y!clY%0Oo%>y#`^%Fv z_V3#_hY4B?&MreJ#i~&bBZqv1DwJ!pm-bB(p^#8tVn0+U_TCMpx3b^*7IK0(bzasU zLgT{lri{)j1b_f&)_NwA=NoI>j(U7E&RKK@CPLf>WkWcz!;H?4Xo3v*tWU%QTJvW1 z#doH-t7Z(Pzy&lBwuro4x@imDbFSR-3oqH34!{pE2yL?fscp)M3a;%V;IpoO=6sI>>pdDho5Busf zAkeXRT$P$C;k+k%l2m*REwSD^Xekj~h56u(JT7d~pnn9)uSi|aW$IMP)` zWz8%OW^Xa8*zP%Vgb5l_B1>EN;EwNVLlFFqeX9HSpJVLpD0XE)48DkYAjw2MG9IPC zK3&uSdatNBKU3>jFy}DT2(KF%0piGaa2!VgjzNqc_6KO?{RigQC>Qb)(1n{2k+H(P z&GQKeXR{{TV212DfI4kfYq^L*-o}z1}81f}hMu4$Mf!q$qJA^jm-}>Qo z&K?w9P=+I#bf|EQe&UFT@cxlBNa$ZhA_zd-OX@8iVu)7Y2n!I>DVgDuGa&d#jTB@b zh&ew1{%Yb+B7sEue-Mi7ZSyrT&aV;$1lTeb0~V-KNDSH_e!V7vz`7TqJ-eLv{HG%mjiPbnPTxVGjUNjGt`p=EWq3A|KWy7oq)JQWjfMQC3DE zUmjhy(nUnG0Ti-Dm8w}TWFwn^QPyy8a^@}}7-$f~Yuxvi?9)&; z5Y`tvTqP12+#qCQ>&ljsPs~`0IV`-k!scldWLoXc=zS0yHjngE z6tqxF6KxB5Z`0L=q(#&QIOGE*v^{x{JtXEh_i~)yLWgMNicI z$?s@0SK{m?3TTafjF)pX&{t5dvjRS1qohoJEnAPodl!cgDNH~FbGN+(2>6S#ymPs_ zzO^2ey~wiglHq5YGOlWkkX!*7cGUalXiR|oc4hitzPVF^sN~r5UXAx619}+24^I&EOkq)0Yth!6^hsMiY3MlXE9J z8vLwjIf~vUwah`HxGxnc#>59g;bdC{Q=i|eUVrc>z}hC!f);t z`^J_ygUJEwel+q5(FL8u%-M(NRA9HyLf?<*gV$iBe(Qik0^)*|*_u>Td;lICob5Be z)O2tc7dh(Q;%!uHvP$=(1#(~)Ya7jB5P{0ZEPSP zi8k{J|Jn&OUUX+rL^B2qi~pXO18xR)<$3EFh@Xgr|@}iI%Lz`Oc5?eN}kCwH5$8kKb1QSb3m- z)67!MXw5KYr~XJMK)g%jM7j;I=rZAk>~pbB5q9_z)4wS-A{%z>0m>a6H8fh4Hu~n? z2TA9l4*x|8KW)jLbztg>CGp$b4o2*i+@rC3Y8pMwR9!-FUD^<5vKbe!pK=M4_UAmi z^!Mm*vS65|BB^ptHUVzyEm0fjO(| zePeBX!1MR9{+4y(O>-R^f^35VENdU&V*{3h^po0$Xw zV{At~@};WKDGAUNL~fzo;g`!RDqIPcB%Ib3@BSRB#Xw9P9@TnR&%7qY7h^c>UpqQVB2N1ET03iT9 zm4#?+xZ`gouySSgbQ~kv^tTvt`sgGFMiD86?M2Os-cc8)F!Qs;*zb}+cd~@A_R*Hs z4q5VG&qEr`b1rWFG(LcG&=+rJt-%KaT!P4sXTgPv*F$>HV1;J>>Y|rsk0me)mXQUC zuY^nyv{^DTNWBB6qtS%G*mb4BY?G6~lQgDHto~4cKUdad#zT+Rj2ZHTfIt$F*NW7L z_@JV_)Z|FWTs$mJ&RR%Q8BB>ljN$7<#De6vw512ZA^|F@eFD}{j1sdRV120i`B(r1 zF86t+uxDDUzP<{lrEO2I*CLisS^&tj9$lXRi84ZHlgyOqI)0fvT{4p%R=RxAX@2F_ zRX5UJr=dNH^QAv~yL3r7;*3k%LX z-+w-{GQ-inF_*yvGxpRT6RGymLq4CnL!%m47yrWBq|eK%D*47%-=u|I#J_t z2yBxed$ru^xCqwXQ}}N9_}FG718mCZo`4M3)X3YvegG;8dxyP)yW>HnCK1KdZuj(MMIbE&(bL_OkkADd-<&f$r0x(kav4I1zeFmQn z_Zq*H3a8fcBo7e?=nAGs-o4x0ZGqCu9S>iIbd_j5!kOu4$BSGz6}K1}Hc%8xl<20l z5@?&G6iU9in{lTxD=raN-8kP`FGvVcE3I)oA{XdPXaHvE5DvHv|gqZp}%W*ObD$Enb7oB72B53L~8E zjo61$4IR)pN7gCNH}z6jhCsL$IW9Px^0G27^bdg7gKF025Q-6(M+)_NPAOni&=T+& zN(o3Q29W-BqADLmtMRo36U2`<){b89nDwUb61PqF#GXUAsd*}Ghhh|E?wKhUxKHxw z8F_GBSnBSy^&5v>u}tF2DmC|@+4M_b&%oT!x`6`QbsWe1WSmD(*PTG2#G1g@ZYXQ9@Kzgu{=7%lc>;CxN8Qh*qc@rxP4ygv=8EnG?X%O?g%02(Lg)K|ng z%%{zNQNBI(*`3ks2Dz}fxT3ATq#Vo894oSJ@_gtPl*gU)NHqXIi34A45Go?Tlf@OT zqMgHe5aBct%O4#x^FC2Vm10e$!xixn! zoAL13JY)-xAEW!*uVWUk%zByP(8!CoCsb6DJITqZp`p>G`BS}XBfp*1hO0MnpDC@l zo?Zv9B^qt=c?d}nxwAR)m3x|vmaOu*qDigU0}f+#7?+w`uPv#vAm<705NN(9x8%fI z9~jwbdld;3TL{-Jf7}r^nrW?Gp?PG=}M!;t|MkERiaec=kw>Qaui>^x4`2ir=rZ=KyDGiXhUDxve=3@w&N4Q0_z0 z>o;A5w$rq5VeY%O0jF!T=C26-QP>IaANJ`pBqO3pW z$f9l3*ti2N@xUAI>o28pZl@)8E{kA}wRBhZ(!lAJ7~2FDgt|IW3J{SR^gFSR?Z$j8 zbUdS~i2e3gT2IK}0oa*8b>+5e29tIdlS2&-?AVbD9FR%J_dAU9o*sgMHbAO(c(0zq z2f@0i6esmedw4ph%40U!D2SOyaN_XQ^^u4NWsckkomK8UG9y{-IDDq?5%ZO3!4FoB z%g7fja{gVAGaVYXpiymLE3F2V=z?d`f$ke5q{DHMDA|vHdh_I?I|Zl@dYlx>K!k>h zW?d`{IBSdJ0JfZC#K0c$avf<<6Yw%JFo3fkGg;oI9`Vj6N*t0@>GMvv@<$`&mb@M1 zDmw2m=@!3_X8R^O&1Ll^wKdh-kh+DOt+ztq#>c{WZ*8lyT^ceLTWLKMdXTx<`h2(( zyZ{Q5j2)0y3wL^Ocpe12n)kv9VR?H}YN{Z1gN4m%lnF3qD6uU@xz42HZq3i!0Q+j9 zFgs?uor*2Pu7dLRx4Iwr+ii>w7PIUa&9R;GN#+u_R$vDqa9y%3o*GC}#xCu`E1eP1 z8O+wRifPgmyW1>tXl=DSo)QvveY5N4@8LyEsRBN_w`C)9CI-eiE?Aj^sJb0ZrDY>|-|-E=mlw5&&Pp?`A@w&b=WA!J3XzgHc!L7{(+vRcuz zN8SY-b}JoKNDbHc(jf2Tw?5+TT>}(Rrov^g%(N#}V=CnEX=AH)Wb2x0cc`f#Iy=t* z;E2_^ZjnmFOGNaobfO}9qCnQm&CyQ*cY5=Kq|#zy%&=fEax&`PJqf5E1-z#6fhLy% zAktDb_S#^ETaw6C1puf=0Ykx|J1Q~~(1_)s#v=YNiRdn#O5vp~RvD29a<)^u320eg_fO)=`y+T|An7!G zNG8z#lem)h8;%Elass+l=lfrweKWObv;ucUVqp@pFh&+s1l1-`|3?u25ug`wt>ml8tR}8Si$RV8yv}RI zEwNpX322UdEL3-0?~+$22L&jGp(y|pl#8Ao34CdZrGW}hX)^N1Ge7xkV5s;7Hy4-5 zmADw2kOal*Zb%59m1lrEX*N3!4~`g)*55Hv_%kRY>ve}wF8eO;;5$F^hGT@cZn>;? zi_sFp#~XTSxhDXK_#n&rnYmIxAhkal#ou{?!KF#V+XXuWOubaaK=rN~E_}-Zl55=D z3c~_EmQBSC8B*%-b>A!zp2~+W;8shIK z%yLU5X`cjX1!PvHS{wVf43casM@|}Tn7CBYBp_J3jZzcfTXKqqC7=O57Se8H zBQfaky*Wy(sAOG{YohgJ0TccNhM<#7c82YRbbKZs#4w2msfW0kbPGs`0;)q?fi3)M zIJ4io_W=My#6CO)Fba73cfPO6B44>B;6pB<;KwMA`|weMO&78OV#=Hlw0FMi1X__Y zxy2XKfTDx8Gi%Y2U2+v7Nj!ZO$vS1~6+9=2`_qpZ>DP?o-r=QRD_epCL-3A)mejA?kDsXExU1Hu!!wsy~!O7&A% zc>D@+9&PK6?DU{K0978q) zjukEQJa9>=^BKzwScelG2^@{|soIfDt(xzIu^&)D93)Np=xYXu0A&Y$NRt4@-28f3 zgGzGEX1OKBBFeIklV4bs0^3kraecm13i_#_DuNOZ2?T;0-VfuQ+tI)Vzl&4gzBI>d zpN2j4aRJimynFwC>#A+&d##p;3JcQ(>CMN26fKT)7h)jp8l?KmcX+cHLFjBB+DDOg zR`5f~fT-a-1Nejl59*S?J&zn!my+;Mv=u4P?a~%Vd67Rp5=#V1*$%5Q2t@NqPb99x z$O1h6<+dDo`OW#8k0o+JdnpaA7c8}%z~d149&Ugb0vu>nDF{4Buky_|eTH2yAZOBv z3goGz?~f_)M@6c9O_fDz1%UA!17{fYqTEb~Q9ePsX^Rdt{5#&9X!)?PMb{;)#7EoAq_08Vu;rtI1#uG~uYiqRtnbIIBOwZB7W|a*%TpstU7$ zQ{yA8Bx-!Ts7zeyNN1Rh8?r)_lF<?znY=N*Yz!$T4M_8itFN% zQ1unBz@_r8^`Kj^z(E|K3P9p$P*D&|o64gXpP#h`$Yz0UKS;suYwYRuQE+_aVJ8t;dgHBv zysZk5aRWKF+)Gi;MKiFnS8F7$WPO4z5RDKiz)=$JqiGb#o~en+BluLJ8!NEt*B^1g zxp#iV1w*J}{movo=mCNg2n)Voq+X3uSHZYk^pL9`cmn{iz6lb@Y3u;5{-g9ir;ysE zG-{jvJ%XnZEL<({_tim48&z_7ikvB)IRh$nLUn?d6cJzdtvnFFOGzi2rKqHDg_oiu z1WQJJ(SndElP=@qxd8qifT==56k0xEjsR*Q^K&O!0(%4riqf1%8oA0RiNC_OHfe3O zl1PVW7e5Ttz%?i7HRW@^URg8LMecFZlW7PnYhBnQL+M15ETQpFLHB576fTg)dRG>4dc}VkVhLL*-sP+ zRFZ*8lVkHISrwJiryYyM#q_SaChAE8Whtmc8X?LP@+TqG|c9X<3A6oH?+O7;mnfO?RT zg$A!~6?|~6ZmRa$4SEx19vD)Nu~a0O-SF~4`K+fJJW2$_u+Pb`u1Ct#`r!kFHt|qJ zfD}WQO8DLgMi%r>z`%ZeG>pA!B}?_yl?5pb-jra?TG~X3ic8Kqq?jb3tyUUqU;;34wij8zW9f(>0yHNl zV781M0B0l)twr@D;{@vsfr5WYVxWN~mP-1dM|rC!hO#|IR%U6l+S#zw`A=2WdI-UJ zjsGzZai9u1k;&(QWq>*Tio*kBNE*ZE(WOha+c-Y|{ok<^e)xCb_N0mVYZY@g^VUV7 zF+|_+@uW~PneBhqBl_F&L;wv9ZyQ>W@7}!&a}^wopjZlQ5%KE% z4Ebn}W%)SUqyOXd!9firy8Evf>ok3}Sy)FjFcJvWyuG|&0;UHS4va<}t**$JM=+LC zkg0cRa=|wCs0N+3CXOy|51i?T;%H;(L=_rs-l|{Zw(R?>LdhHNWk$W1*qLIjDhTZ$ z^g>3Ac}LD~djY_*7+Q{>%h01Xv=3O;OkeV`sF%WJl}?&+Op{>0OZE7o&F|MQ_YlI? zmNIEB6P~}@kxrO}@l*fcH}wVNRLwdZ_!{Qm>vd#74TFZaSLdHDhb#lNe7y1)Fe10) zYQiyVwT|#}Fn1e*m=A{;RA+g98zOzIvuF(y6$xoYZHh!SluS%Iq#>F8(cn|hG2oB% za)2BCvabeyMZ!gz3)Ao3w=bwCKs&gD{1;AEW8es(kBUo5u8qGJY2FD&x}Y=}6MzRr zg9mns7_la-_Tky!xo8YvXjdK7LMsv_<+#hF6PO)GN?Kpmgh&!iv!9TIu7kWbUxsI^WfTg2uyL(0dy6#V+MM zK#JtS=OCz>M0w2C6ltD3V}|BA2R^w$4ya_XpBlvK zlwXEx4DS8+w1InS>P-;=b{g;HotOhQd2vFdR>Zw~Q~6A4QXk~^VnI=bIm}wSc7q8_ z(IxBm4c4zNeDHxmKxSfQd9W0^z^!!P5z!UL*l3I+V|V3nqS}u*qvK|E0WS^c%IHU0 zO2P(K&qQg9eM8_D6SyIFeaV!>LIuN)9yiq^>;MH zfP*7C>V8jT&<-E|*-Z~kV&fQNwXsKRC&sbRVI9mIg8p*^%?+-nqS)haf%riefo}yiHAEsW%%wc%5)owUoMu1c7+(w~ zaB2;?3=;yVzcM1T`Af4V)a%Q9sY1JgXe^8)ZGW4wsXm#zIUT8%c~yMa=Uiew4se`Y z{3w7bvMDMM?UHNljB%+}K&1AW*RyIn&SZFdjh5CE&V+dXl#7to4+x?KJU+{+5^)L< zW(A*;Lf%&B)SEC6%^pw6KyyRGoJV9tgczKEhsxPBbu`3WhTgEt^uzMq>y#8&QDD$b zshIIY>7W6x_ZQq<@)sbPbhnbx#?Wt^a>N6M`Mnt^zIrI;n$Z zYXeggE+w5qm6bHdCsS@Hl;p{Ic(neygL*LJu%~&dn2p(#{u?qgLTgP|fVvOn!mUp> z!K`p)>r>ezBwX9o*c|hlrW2HU*_HgK6GMx(61#gm;wTT zl)Luq&J{UK6}6qQW_LRJV4$*VKF!9?q@yU~#;oDxnGGtzgZt_#CZ&TU<<^|hvmsa% zf3@P;`i=8vxiMq0A}uf^4j%>0hv1KLY{fmfs6Z>L-7UU#nV|_l_tF>db`%L>;Sh8E zj7U_Om2w_2lL!3@7Z6DPmxcbSXZAEldpPxkem#s*7d9J9>t9%QWfv~74m4Ey2EdKz zpn?gvSlv0Mf{bufAT|9sor+0@*a!tm;{z;Nt=n4jWz;spKiL$`@3{D*4;1w~Og z&I{+yk=pH*_urG&fp?b#&EQ9e?$FDw4D5>oqDjoZby-vdtScXV9eHOjN`Zs0P>c$)4O0{2dXa znme{0gv-@bK8JU+gZnRM_Foo(01un)E3p_2!O%%vRSFMA zdnC8Rd${SvYfaZF28gkkNj2E{F4rN4KhMZpo{avdBAE6t@*egw>bnoWm7Y8c>uyyk z^VSQp@hTJfIL~pzdCmvj7u7W#>)7rDzshuWhP^m?eqNbm;x3|nW*8p5!^B8_gR!cX z(b=HlGFfd=p=H;`Zs8)VH^|gGNzD$Z=pz~N4J4V7_3r6qh$n(NQg0@sPT4*xOWZ*K zGoJ$b9o+vrKl-mN4{`SViq(6=kZ%t%qOrTfEQCMb$Xiz)Ei_|E1ZI#KG>VE{nm_lH z!{ELfJ&mK}<^oZ9^=Jbs2N1BvROuTvkOrHhM>p7|ZbqJ7yhdo5-S{UA@~5Tm)zGjb zK{;(|Hu2zJ&LSTA0chEIXG=6{kcc8xg`SPCDQpWzixKapozpII^6w^FPM%DY$i}{o zb3_*zu{mr)pVu^=+UaaBftzQbD+(G+XL!fTAh809fRh)^5PzgPBM`T;;MaMxmMh)-F@D5xfxUoL4Vh!m>bh#W0s6a13lPA;z=5u` zx?wYzp`T+zmS}|(n)LleA4G%qjnY{m{#MBJ?wpfzqt;4_=ixanNhM?QTNIB7{pdi) zsEeq47bHS}Y6+GKV~{{4|CL3fEk=NM$G)@TnyIpdVWq?i>pZlLtzL}Kx zgo`ASu3K+_EdVCO4>YafkXzG3Ah&q*$N^gl03U&#ZBG}?Ug&>89F!*UuEP5w$GyV2 zc1c|Wt+*aDArOC_=Xp+lva;s|xM*V1K#ZCK-7w;&8ZGMt*iE>1(`Wt0pDm%VAlJZ2 zTd0vd)QOf@(yW8Ly8gZZ@6iA$vZs4~U0}hNT(Y$=9SR|0+9jGP2XKa1a{*Rc$8!gC z4;JPKX@x-tRNfo-EcL=Q5jj#L_dYLSQ-{s*K<%7QBHnwz}r!w$(>H% zr;atzt%ycU4ubRmZ}#69EqE5S6Gn%SF3nr9k!Q4Uuwi%DGwD2EDxV9#J_)+yJOj~! z6o*4MCdpm+_Qft|} z3X!l>W}msZ`NbQ=P2$$z>wNyq2ssS6b{(I6QO;d(!mSro*QvAC zm(P?gAL2@4E{g%%#f*IdWdqqDXow93gsMZq!&Sizx7Rm|UztIxX`mJv?@a2fhgJan zY5dOd*q1u^MRUz@=K|?guarBUslmRH4z#ZUWk)|UiorJ6E&Ce$e^8I)@WCWJP zo(yL!!mDj*Q}J z0;`7N4{8iVbP+U05D|-Y*?uDDN3gq2WWp<~Jf5vsCygbal$Z!9f)$i%^Ubs|ng_x0 zr2R8!6fO7jGPnwYNH(FEH=UdiG_ zq{j}gr65^o0NchOdx*mh5xaBzd=nv|7A~6o7a0<*S(w@mY-|5?jO@7?Tv|yh(xg7o zvVOD!8&7Ni4q#<(Sr zZ!JJuQO2~>CMDlL=#o59plY}Sl_$pBT)r!SuMvDW!`Nj)2daG#mZ@zp`*_`t)(~54 z4`O%?c>=n0)l7?yE&Tq5`%;e1v1`Cdg@zf@F9tz79eMu+o`;4&h&Fx zap!a{U#a<=w>qK2GA7b`hti4qolZZ;TS({)6?dSe0dkl&?J5NNb3VJC5 zmT~S|#TSN|5)b0z_d-GWKqGALK+cqq3G)`w#@|ei*Nu60CI^R#VuQti_GnQ*q@<0Q zCp9#$UnZfF=IPb?i?F&0?@veOEZi5Zs-k%I>{;zoL!E8l-|Y3z+)+27Wxx2m%xCpR z#_2UvXJBf(V({>cE@f*gtJ^m)Og_VQg@NA>ACMkebQ9yNZ|qIi8h!D;qN1XwL3wTw z^G}~ge*1P6MT~vdKILF(d42D~1q%jheQz56=~a4qdV3Yq($cg~JxWNpzSl1(Xyh+m zwSu1?Q@Q(kdj-5+$YgF76BCn=5STMHAt6CVbkX{}qinLOG5jey_fONSF)r$$6x)z@ z^{ZFg<>h<(`aIm-Yin!IySh$0m!(|`AjQPo+}zCU&JB#xay@@uW9=%P!}llf3RYY{ z6kjPj(X^wZBRXh;(=m*zhklnwW;>?WLL!QJ$&l*W+S;OdR$pJAr*Pi9c>pvtB>wQ{ z8B;=wqP~3jg3P14yIVO^WA!{AZ|_S_-xbcBlpp{7Q9Nhu={MgjEvM(NPiO%E literal 47312 zcmdSB2UJ#TmM!{wJSqwbCXx!GC@K;pN=8r+5D-xikYE7GAUWev6a$EefMgZPNy!-z z5fsTuK$4Pk&f(1sr@HIial7xmZ@j+Uy{l>z1AqR#_ZQZhbFR6*#}^f(w{N50Mk0~6 z%bY)ZiA35$Mk4+Bp6n0&M(6J1%lN;|H{_(xl2(cTyv~dA!Ed&jpI5Uak=PFt|Jz^} zA!b7&9VE$|J#*PEc&OFU$>a9Q>bQ}fh3K{?kG>o~L)9O-qs4Ili8sgMUYb(I>YHf9 z<;YPA%PPh-yve?vvqR)q6FXmg%}Ny+>pO|dvA#ziojzN9{A@*U!2I%^(Tdp-=78_F zj%KlpG)^Wh=J#eNEd~lnirQCNw`Y9O=OLb*xGwHasM)ywBk69B6zAW+7q=#p+OYoX z=pBW}{{BEc6YZw;A72ap8UFV#FT3mPS^x3w0F?(Z0=O<7xTm!K6Dd~mKj};9i{y_U zJSg7Z8C@FgC3-?^zPr0y)(aDbEA>3PEG0?bJ2ozE@S2ozTue--+xjpp?(|6KjEIOR z=M)aS(q}YHB?gzcuLM_%)==9 z*ZS9=U7CJI?PV1A=H$QpM%ZcV+P{&AVM^z0YipB=vmU6E$shgVxi8`8DRy>+82(}!fXGa-E(tVVujEiEmnB&bjK z*WT_b_1=B-LSKEHf5HL3moKknS#&SWPtveoJ8e61O+i7y)O2Keuu)D8f{;l8~@Gc`AvtDnVETNsHrxR z(okJJFxMwRBO`moOHD3Bp;x_tRW4XPfKlG94XV1LHAK z(YDCl5w-n2m0{YKFW;(d@eX^7aS2EtZOaonb}YJLV}e#*bD+Y07X>L#`XlWb@$ugm zGSn_zN;dEO)Eq{~t(jxfnr7r*sPn$c_g9$s+EeSWut&IO#m2@qrQDt!YMLzLC@_9M z{&+Xb<{kS_8#TlS2GSb|aj zUtjKp2Ow_h*+fMRe1_o=RD!=)%2IAT3(o@6k9UKhMUgW zFXF(%%-l86T_(@Nyms@~C+{gOg}r$3;?bi=9v&3)U$mD8R54Q(U%$pgM|09rIOMHh zDR0@apO(+~Rc=#txO9mZqnSP5&$s8E*3{H=X-Ij{j!!pgYiC(Rxv)pkh3yb8`f#Kmio8jiCG#o0bs{1G&PE1TpO-*H4 z_6828S@qXsW}Y7O+C@t{w=kGQECp89LF~#aSFY61#l^;EyDTr{J1-tp3^h(KdwE-}p>6Z&iT>TU=67^7(UJhMa`NC%3J;Pnin2Z?-+fYe z=EqHqbmKd=wn@u1^>M0q4k72CQQHvw=?!$Pq)%D=PAv z^w&lyIygAo_u3VkRJeuFi4#$THSBDiaBr8lG=t3f^PCBOzP|Pj4(ha55IW4w-#fX) zB_)k!w7Y2ZmVDLWbeijQPs*DKbo$*?u!~oF9_EqhLHyr>yu@SxHQ+Amw&t!|a_J!?dLQg@K3L z_jT>_+AlCM>blzUi7B{u_j;0uFJT;`l6W*RVUZFL>Q2dMS{o^UUudSU`uA@yF}{R> z>4k#T~c2@r= z6pZ0DYPf2-!CGHGTCH!UTAES7hWX5yGs=+{P9-3-q(nx3X;APxsdi)a{2nouGCww- zBq?cWvAK@>4MX~VN89tATTbe%=VrD8g~!~eZjApbo~T#VvM*k6#wyLVpS%!s1MR0^gGQ~m7h>?(XCh&;%$@^QMly6Kz!8}>`& zFCZVcq%Qg>iW;oa;&mt7FK%VZ&CMMtSalh+4dXTPbF#(|?5Ipy17>&c;ja0MBSQ0r zheu8}#VE7P4=9Q)U(PAVV(*UQ*84t3yw{z_8J6@yHu3Vq;H}#G?>-e3b;lt_Hm4cc?D%_HDeo!0>Xr8P_D-MCp)RVY z^VqSE?|XgymHh7c-Y~P;$ntxe$Q42a>uYw`U}gNM6FqT4HvdGyhB#g9o-LFNPP47H zVJ-{(03aAfM+b-O`WrLBw(}l3Mn7B+VZc)4;wcFt+WoY0Xh^{Fs%d7 z-s{5;5;LC$$d~UEuy}X8kSE9HYQ7;4{oqe_w`j{7A@1%aQDH8ECe1waU*5ib8zF}Y z%)U&v^S}WS)1R5q(a~*rjyX9w{1fHJm=7NO7&!x!kmSV6&0TBZ7+(D&|tx75?ddiL*97$69i!UgL`D_jmbym+eq^8z5EG&F2G*K(x$-e6K8JlP8u#8yp zuM}D00X-5E)1!)zcmy*PLj-x**i5De>aFv$T~}9@7iZAaXWI2SVU*N-~J9j=f)i=CWA?q9+ z<8R-D|5X+!{3_-zFB@79zHoSVKdq$LZoE2xVSigfS(_3O1p~%l{WQFF9>G% z`}%ID=P5l&Z(1K)zYiI*oWDI-%r*b@>(_7JN+dPzqu3nok>K^lR$@A2_h3Cum5`$Q z+D*jIT$82j?CoU<)3ELS=8MlC6?v-=wGYeq)v236do{JSlnla|&Wkgtsi}hd+OsTK zxVX5uxw%iCjF*wF*GEE?3a^gb`a(}FDlAMpq#R+xVsXZ#HdZ031sN6yFHQaSs%&_F z#p7up7673OaUcZgGZ!ykX4bYYO;BCmRzBu4cALr%o<4mwKhWR5(b#=vVuGGWzY0iJ zG5EBSmKMP8xcy{LfXHtxE`aRCC@Q`K8cDMS_LGrLX$bjgEtjucVbjjPmVZP*z#ciY z;oaK`^J-h=;N3yM1LyJ`mKUrw97`)I{F3;7u}7@E|3`zJ9uiZ-Evoqoh~6i-C@3kt zHf-FCM7ag=>+$2qA%fN~3LFsLy1H(i+pOm)WIOVsu5IYjELL};sb$Z1x_RaI430w| zwlLVezO&5w_ISl(`R@*#j-{`7yS(1fcseAmM=NvnKf|duZrSlNX{A?eRmqTfSAxpE z0|%UEhSXAG;>X9wWw*zi2?z+_OB1u`dgPQ=(d4bSbsDkB%z0Jsapx3cK>bK`q(v2?> zH^rZe+E3h?_rpV~XPGG}RkyFq@Xz}NaNlld{6Y5*+@gZnlXwI=FlZ%MJCJ7781MBw z@LAKIY9`5tbxq$-`UyJD81H@-!oz)K{&C-<#C^$t8<4U~Gfryf zJ0ZZO&-i$IE46EJGmKA~g;e8&i9H`SPVL^G?wOEwJ;zQ?I?9pm=e}7oZ$v8J|CY?&|H; zXk!%>b!pAEo?tU-O!RfN)cNwy&o-CT8|Er1D5##_P3byUgx$XHg0~wLh)<5~=(9(U z`dTtZL7N7QQ%qa40r)=LEMX9``3`b3Ql-P0ySlQ7$9rJ#6mq~j8J_`TVe=00wXxEx z2oCV|y`rYp)KPlCsOaH#7_`EA)&{f8>IOgk)By^%C) z&)3vm443u-F_=cyOQ+1;Dlikw^9j46D=x#db)YGwcYd;W(Ab!VzA;{H^7C%RQvMwX zokK62xGN^N{<*f!8V&=b8l*LY8U~ctErLO`q#8_uPaQpS1ivevx=fd+6^6^(dnY5~ z>Qt>F(yQn~UwD*4h~d~V$C)Afj=#1b+UZq>5-c81yO)M0NN4Y)&)0^nFt;Z|D*(lJu(Q+Wp$7xvryCrtGZ5k6;HZsg2bMQz&tC@Y z2kMDf%E-;`f&o6+> z5FSAKmjLTeva$K9pKuAPjuc`^&qi+U-kL-83uDH_#Ke(1_6bSxTUlB0s=`eP2?^v( z1P(T{p~1n$)s^s{7&G35 z*HAS)pFWMt(+scX$*xpO(M!-SXp^`P?uXY^-z~6=NP$>uICcI)msv?mOU~=p9dFzj zWaZ`4^4;;xiPy4{3-!QE+B5Hj%iq+C zLVw4$Ix@v+-Xdk6XhYBNa7aLa0C0H^-6azsNGLp9IW&K5lJh$`-*KNZ-eA5zDohju z-{8f}&Td)}EHLxA>RF9d@4KBVWA0*zL3Va_R}16-M^aK!5@gOj*zNSkdcsQ}le(@D zS6>mp%_1h|+WG0hv}T@G5O`F)S_&ra_Ke*fA7mS2z}0Urj|1qa%*-!>91YaR5#);Z z6xLt+!t@~4{Bpgjb{<5UB6mtk3X0T~t236iw(S{a?YG06@d_qy)CyddU6#g6Hjz_b z4bU90%AT8>1IPJRSy^dOhOj|!`RxkZOcms<6zB;(iQlZvX?ePlO;}2%1}g#NHzG2! z&9YLYVK!;*A9=t{uK&7>yu7@gUJoLMva&KDnDzWb_pe_!`1vy&N3x=@_BF9TvGC5G zJsT$K40TLjH&&OE7Ep0&dA2<&A_7QHP)KO8CPEIVfPsObu&}VRvlDp3^YP=X(fq~u zth3Eq>+9;?y?Y0(taq%l=ypXg7K8#O6|ni{jT=W5f`1^|d?|Ky$P?w|wJv#f0OG=G zr#qvpoZRx#Qnt;opw7p;*jeYKrCVP9;@w2v_?y34z##a^lP5Pzo*g-Q^e78U7{(f- ziE$3WPmpO4PNY5Qq3rcgD4VWLnYhm(+D#p_JF=9HuZ0Qm$&O17Yd?|xgVfe==pC|N zYd6Pz0{3$Nw-<-khwI;vu``c}kbXo0z9c7K>L+yUV;^g4Yl|ODOs`(XrK-v*LJ)vW zc8-olX)_gb?~;wL%gV|kwM0xE!$0hy+Oy{@=LyxT#1*~%tEvb&8h(C$A)(Iy;JNz0 zE4N2iLq-f=yMWK5r>+Lx*Gj?;bFi|SLP+$G3cpljhaHShggFcx&(lh(qs0h)zesoD z-Zv`q&4dh3I_O5VkKc3&dV(7jaLdH!$Gd|T%pLNyVn0%BhWs8^5l%x*t(9ZL#=^qF z%F4>kJ^8En>7^_5d-qPyw3rDkJ;Dahv+93A^-Ixp!AB}QrnLhCCb-i}zumibf#N(U zB(fuRq>%H%6u`*Sr%y$Mg`J$8g=~gs_wV1oYgY}#-i{6(q`~IJ{E2U@NEC#uhrfV0 zH}qLt%)}t#@DqYCrSO<|j?M6X z$BWWe9?racK)mP<)Jr<{P;9<`+3Unyg7qY{$m;59YAx%zon>WZstM{x+%kbeAlj+i z-WOi|qr-MuD*V)`Q+EKfP>q-vKC*T-CTc>x`5ZEdtTGhFV_R~J(Y!Vi5Y8M5E0 zn_sXd`Foa0q`NsGvL}il@s0m3X`HX|!~p-y^oH!VZ=cYu(&u0>^YilpU9WefK~81K9lC9=_J?I z3^Q%z{c-W}Lt(2+QB)GyuVbp0jhm8>96v6jj*T?!LC3u?JKB!-1pHufE7Sp#KX&qD zuER92(`~N$zBZx^v0`H4goB_GuD`*&?0AshTWaPQtdXp&=b+RL$s;aXZ+ z^q!H)$rF$l2OE>btOs6FK`Xd{JPGV?V{4nyD~^FUaD{r?3CWLJi85B8uS#5Nx=B!z z6#48_YAr z2)rBHXs<->d`}QEIE@7KUP7@xe*8EKOG#}lHy4*h%{v)Xg!F{8vaJkeM_OZIVz8|A zThfPdK_uOGgb3SDK$*$5?0uGzVT(uz@By8&E%r)W^RTDX%?lSi zs6JiZ>^xO14M@*xlx{uP06{y@B-f%F(e&F_9~O{A4Rv*TDk>^!YCiLhk5~d497RY* zsJVRo`W2-kluR0bqQV6%?#}3fYDA$tzkdoHLJulKXUR^14Js;DO3hk!e%fSESXLH? zo7g=2*4pY^`kV<*lNcQhvAF;VerN~<44y~dsvH!q&>5yRLjfe{x5Ojt9E5y+!KYT| z|79u;({3_vtQnlXB!ApFCI}i*h0y4${Emd^=+k&iz&9yqztEKoc<2pil&eo>Vc8;- z*bMy`uaV=B58x{P)QQ?-BZAJ&k{$D32&%kxK^_;I{LWn|GJ9>cbbPTeHyGWp&_>H52z$4gV{m~sPzM)zzm?OgSBKWS-2;QJKUUU9w|O(xaZ(pkemaNIMG? z5@?#Nr2z(87o%KmsLc&(Rm`|LC%wq={OkAc1fC;)I|%HXeCu(peqtpwJEDe= z4Q;i@O2hrm+~2G=A}xsW1!z7v=MFM5DhUV=L+u6aR;>*`vn*|gesm5Gw~l4m9JRN% zCu&cS#)gOcPY4VDOcgdmRmrj!i=__RqxwL)X{&lvt&Fm2qIQ94cefph^wH(=L+aDF zb@iV_ZK0s8>Z1#M7E5tJi-?utO5d>)W?MeobcYU$87=YL*E>3zRBs5e=HkUFfCFU0 z6KQIw1%oi)u8Ur-OE>Z0Ya#hdeLb(R@Dem{??mAftgMSGi=#%f1-fN^ajHq%n3k58 zSCK13W`A0uEPyym?_fC^G#r^_sFWxY-0~<;sX{LCgE=MM$&I z1O|dFZv3SZH;fv1suLtN$1lJQ#uB0x*n0U?0j zEHrfqRi&J_Z$CX#V*Pk|<>AAJ&Fw8nz28lxeSLkWF;~#I+Fo(#%3iqe9n}*1zAC2L z3vQbOD(10fh8P)0r1uQIZ#E%hLQ}{e|FW-U;_ilxATW)6iTkh83Fe;MbNS(23%E&s zE@L_uXGgVr+b5W}qQ%#X^e?zi3@p=a4&bHw0`OVNr{ZNC*c%BLxM z@*#V(3U$uQ$k_LW*naV#OL1PbF*4mz553x;aLQPjM5>~QreL!S{YD5th%QiNc1eIG zpHxpR4P`kX@Se-cZY@1_0}f;^g0nTMp8GnwT8(Nx299+T7z4@17HwO}jO$-8c98jnEs3zM_6wwJ?@ zObJn7qKu;*&xz&K5W4wo;~+|p1(gBZQH6{j3@!r`Sk;Y@NaFYLyykdbeV#=1G}*vx zR<}8*md?)3!~IpAzHc_J2WWS9jt!ZM)`&d${_pm&$k_goY))g-&oCqLsF`LvQP5DI z>kId4NYdtT;{+h z-%S$%JFT~oleZMO7ChHlo38KrVN5bi=dL!`&sR$c5G9qFbZ~sD% zhl~kjz-2=1x%&R21WTk+YnElnhaxy`s4vo~cQE_Dsn)-iqUUMAKKx`aEAaHtP|D*I zlJ0BR`63KRcXPs`qM{zC$}4Y1wjVUQ*_l4;&!O!{jl>yW;C=D1={I)&;NV>BNq~>d z8hmz(QHaB8rsl|`=gATERCXv{!Ji@;p}5s3<8zd#xS*8#Vr54Y6beWREUh)7fF6pU(gdY5v#@CBo6%np7ZXEp`8% zJySm|E2l?VTiV;(i;5)U>I1heV+RF=b{MGLZ=VTD+!#ChAyy#{Kmc$_;t_^bPpA*z z#9AYH(is9=#^fzzblvl0d(9Zv<6cc^%Emvy(`tE&oY8%Ps zl!!--m0ZlxBdv8ZWQZYN@rC@4nNevJ}C(z)7neK;zHsC9XyQtjGxW6{pH z4$Rk}6Pcjg=3;`1QMP43ck&`8p+*8*F3{;JiS%0SA{}2~q0ZG0H_q*jcq{SvTh+o^ z?*2v?&T?LzNC(mv?D}=QEF@UaT2}oPpGlxXR9sR(|JKm$&~jcq*rJPiHwqF4S&*Sr zX8M`4ZAaPJP;O2X@G^4n(+}b^ImsjBI1`^rMNi+{brUwV@_XOj-=WxC1jPqPmNh|8 zc<JJTz5UPyMy!$0(rR;EnGBPf{r&s*VYXMHuhgPyYAzWR*4L-y^I>xe zTlGEnEkWftl0G&4{uau>(0x=445qqa3ZJH&7qJAoDfLV)iLEZB^dHrxUeN*di`+^B z(~|Ks?+v88kTTii|jyg0z@<62L%SKTS zhB@iM7l=$pj&uX`MlWANUX6Hw>aKcU;gseq$k1SJud|HISLFT#x~#82-0WJpR~;SU zz)IFFd)JL*0YLbK>!{T3HslyG8D|{lC%~X=wTrIme%yH_Mh09tNU# z79w~>UHyb_)aLtdFi{YU;a4b_FNeT4SuRL^y!Hw=Rw?Sm@gRDWSCy2MYChpH+u>&e zX^nZpMN0v~itQW7V{i%YVdgTqZ?MFSlNJ?1h~L^5FCO#+?6QNkrBZa!m|(CHQMDqg zOOp+@eat-c)vekN>}a9opD4NfVSBZv6VZZIH(w(IDY(;X0wW>W=K#_4)6y8 zM8F6ouftRyp&#b&koWlmr69e|Py9$6zYw$(WzSJEik?hx!PZ1^d`Ev4AK3nmH7fo3 zSSVzT8H+o22*Fd1BkyHU5UbmHNR*I~(|k~W=;-J`U?FE}a~u^h2#?`x&bE%5>Z^op z2^WZ;5*esEu4_4QjoPkxKp%MX2DdY*!2aS=FF|EQkNpY|8!BZ^c1Q(>?M3ibBEunSNbO&43DGED9h5GjM`{L5Pzk_ z#@g^*NRu~Lqd`(9Uvs6lp+3=l(`7iVk^ZMH<_ZYRQz-Z*tE9B=+78)6M5qmrQ24=e zjT%mtmH)AEBg}qtA2(9gxyXc9pHxf!jJTAqv?>;96pk6dPCI<)(16fqEC&=yO_oa~ zB_yCwKp0i;jcaRb!;6oD(%p7;Z@?y5(0);1IP*e;lAS>NR!gwQjaV#;}1eHc? zxnJ?ahY!^G!ze+%SlK)_HfBDT1vAK#a4zHhd3%TY3j$arjlQjs7Ed~;FSLRoBVSp< zf=}PMp{}lOXgGi@XK7&p+tf%_Zzu@<>|moAkSU;1wLZ`EG(@~qR7@cFc6D_P4GqDI zA;^6OFcK!2@87?>xw)Yf4d!ZZXNRB9o;&BcU!Vp`c7r!ck4_K(An*%Ybd`cDK`|QW z?A%F5CjjXM0&rGlYDfDX!4T7dx|kX#cf1&W$(tC4-FzBlZ5EbZ2;nHwSC*GUgi^<5 zfZ`b+CagLV5#QM z=X;6F(57(!wOGF8`cvm2Ji_MwjuT&5BFgeX6QZWBekO{-ZdHb9sPSKPI0;cOR#KNt z{Mp(k0i_+feO2A43=9n5GPrEcoRyWe#!yibBCp9?g~(GC44J8PC$yRomz!Tawr<6!U2H&=6>><^qXUge+U?=e zl%}pVZ9Et7)%NySsBv+}QQJm1E)}Z*kB|yiDjX-- zSm3W+-@*L5XFo-}^xj)iarG7o>VLX;{$ejmQu?V2cqXr{-9NqXGuxPhVy<1iMYVU<`x%|P#Hy@(#t`)GanM7nwnZ98^SzbcHiqW_X%Hg z&W-dm!iBQux{)sG%F_;c^6szKzSRQX3g;J*03e>(4AgxsE0YVaCgctwTXsIa8DJX3 z;?`6HpIix0dV=M{I#p1x3ga#c!yZyM;j0XT@`+dqiLV^OVOv20@iwpbXs}8?&d8WW z?LEFf>>E_RkMl8o4B?2X1X4gWb#ih_RZm!x37$N9bT!>Lfa+~@bRW{x#09YUx)EP9EHg_UAQ_smdK>eojLQ@8gg#N2tnpP z>P9Q-WH+pN@sxUr4@`U95!uNN6OO@SZIBou#XLXOlGwtxqvdqk-LoywW$J7Pq zrPbr=C%jem@@@`Cy@d@JOhh#mZaDZH$;rumGN6HYQ|IR88O`dPc!|o(yUoONBO|f3 zn-3sqJHp;@lIO0ag{`fs1KHifFaw_u`SYXqF;|Tz@W#8(8p!MFgHNM8a)|Br+68;F z7o(U9q_T;s2FRLPN!lQu-Gz&bi?hQmjTZY(GyNkV$-irPhDzU6c;J7uKc>I0l&57D z>->NU5141(DFJc1TX_j15b;3p_I!Xu;zOmbPzTz>t%0y!`t8n~?ZWJI~6=0Zgv1dxb?>^2hjWYlffKtJ-IZ^0X4_BdF}YRi117^Eb2ZJd9%75~rAyQtTE>IZYUx^k6dmEd zdyk^sRW-#dqb8i>HfWi`bN&0+AHffNeXj$*Y{h2tlJ^Sf zdi&|TO_v{%NYVlR&f_{~-rx()8q{sn61-RKCmvpntS~d$?phwm3q&ZVs0fc(sU)Qc zGXZay*dUV!`N>1ai`Z04vx2Ge3R=4!pgi)7K0D(1DsQo3Io+7@T^}qdC;E^Lt8$VR z7P|U{kn6y%FvIyMf+2ieZSMQ{t;%9!f=XFbMnuQz{-3&Y=Ql3JBiPx2pQWzBI8GWtt{gksWs zsyAvs7=2_zCO7b)jjq~%l)uf)%zU`|)fY~U;{|R3?FnoT;3HIKd|UCY>W>7K7P#9% zkF;~`l-eGr>L}`B`T}3PxG~>{x}1}P#-FI|&PQduel6~@am(xC&c^87zeeRxKZg0n z!i2k=b~_o_`-0sjMe>&k3(8ti;Z-`^59bw+Uo?Fc**9d?Nu6)YmnpuiC=C7~z^7v9?>@d!{C3QR@l44(I*TLQ5KSD|B}!Y(H( z`%bRMQ|dQ#5A+=5Trb+p^cjz;kzvXv_NOls!AxqSyXNm8eW8BFlVHeGVD}q%T`kw{ z&Tz}TzrR1n)%P7J^69l4K71HtIH>>dAv=Ku4%6#wr(DdBD*F3&ghhOIw; zzGT=$-}7tYsaVc6O-)FHm+o&Ex;?X@N9@q;*VXzj8UBDf1NL##X1^%|=C%G$b!Jsn zRZ#FAfrjbWSfeZT<(Ba|&kK*q%IXf%zd1r{^3IfjVTC3#kR(eH`VVW=g>3_y}5yUXsFicS`aBh`i%`}g{atv zrj^6@Hi1C&Gm#|7u0s|m=e=IX#OSy-bFa_ELT-(Y)(^eu>+jEB`4_3|$P5^J>4+>+5hCKsf!_}f!XNK_)v7N-kJXoW+_-U0ZJ_Ca&^iS{+7!BNs)GclaZy+&i`%jzez;rXg21brc`q}>R*;%wT>Ox5T zZW9w9580JJB{}(m#vfG!_=lL1d4 zKr6^tF1GC}k0V*h4%vj@q zfsC{34+`N-WN|13M%sz-@oK{~u+XwHR#0jZ(>TGj&Wjsg&B?}^u%AlD?Q z#MSl#_-5Stx{K*7S`~p9h71TlQjheS0JG%Zzir{|+e7m+;G|obHd8Vf+dOvG*VjkQ z!Ho(H6>C68d=f?uyzELGfSWqm)~%;Zc<4Q06Wc98!6=$L!wy6w@d(xk{_Hj0S}3w+ zd{hFf^6}ZdZy&nhpeCY%cY(wAj~XEKzF^vg*?*4zeVLQg34Eg!VErl1OaZ;%*w5Kg8w+PKW-(3$XL{>w2!y?FxmU z#+q?T4tw|xu8o<4e28Eg>@7)+a&Z_p^>kykt5;v;%FD<+PVGQ#H)o5o8$?4U-uG$F zAt>ho5V29Z0DPgL+pp#H6GxZpll#fue+T4hY*g)6>Y$l>e0pPk{yiUri}4y>}7PY{az!$J7ERD1UQ(q<*JdP znglctEfZzIG^|e)6aWK_c+xe=^myolQi-JMHL3C{Oc!p1A9Ef}jBRK1jp?`IXOp+J=51J9Zj4dx6{yUJPw!i)n+)E# zRDnL`#O#4s!dM5p8vJn<+1&Nf@J;8wY?EeOHXSd=+Ew1yjy~et@*sZK8-+yQE6cO~ z-Tl)W4(4FqMa}IM)6p*#jUM6U_wAyO`lS4|i_fes0u2W(7)?e1DNnoXB932JiW8f= zFGj|+)WcsOGfTlBd>Z*TAz>Ki;1Jut#O%g&$gZPPs^62tK`>v=`}{3Z~p$#Wwz&t0Z}!XI{9KvE3oOXv;m@KhMiC?|N)5I4nDw!$%^`sm63z4E^}fA9|jd z3oZewPq1PMdby%SRg%pAn#I@SURy{9SqbDfCWH;LsJ%Mq`hcotwmJ%W&qJzolqEGZ zTJj5!tk4hOb`kcUpm7puN{o2?tOz{ocnM>B%56muwSgT~x46`_wbz=y)l-jopGUuB zwj`$@3^cG~JfIqZ#AAKd8HIVYV5Zp!l%y3e!$Z%; z$_k&476N0K#}?A-uWtcmUn5O$8^Dsrp56C$aU_R>`e}&8GIk?Lobj8l4o}4U_hWtOOoL zt>(qVa{uxEIvS-_HLb7oO2Vku5U*y*<-_9h6)oY>v9X5uXY^o(piIXV@Dr`fMU-N> zNEZ;$*ws^`leE{)2{1olp|83SWSVV&B!v=}Glc$=)KAYIx*dGy3*uE$R!<<+CuK#E z`tIpBEUx5E*48L>=SY&FY!(JP3c_^p4TK&q(FJ|7>*%6ROG|T}H6&i(uChOCp+57j ztl{()5Gz43Yt*nFQZ+X>BhxhpDZ}S=%8e7f6rim$%cz=$B8HP)hvt+Qz({;SA8Xbw z51a7!?>XzwGw+HLmf;E@Ol#N&S`G%iw-MJQ$k0k4);$mTj&xV_rG}A*O@D}On+$J- z@Z|T3N! z==ZZcNsXaV>vax*Mba6EmB0hnv}w~O1SjgJo`51~Ak7W-!;NCtycJhI?laB2j=o$bHzfNAA!QLJw}ys>3U?lU{wVr> zIaIwcO((xqYxMIQ{}_X%PCC4LFRRLhSDbI8O8|+{AjIEhN1PJSUjb|2JNoJA>3*AL zX-4OlhA_BTi_K$l1M*o5wL-)cz>FrzkwYBJ$^2j9j&saAOp_ zus{hDo_*!QWj8^fI>nzaR=(^r8*&kc{4Ob3bi7`!0BWNVqX!>9zpXv*spXjW3FYmz z6n~;{W76ufMQT-_@q_hh0`o>`|EF0SNgrdrW|c+3=+jvyt`J_Ihti2whD4WMvpL4WK=!05#snHige8y-}d^`n{aeIDVdV0FE zD{9$Tdt`6kzWr5KK`;!`RKoskQs`z&f!WpP!nxn$bFe!uLw9bhua7VdP(12`P3k(W z>N<@naHoP!DD6R8z49E5Jqkg5Y;NWdkQs#SI0G&q@B=MDV`p~b#InOirO4wUZt+^$ zLf5kzHZ{a0H>zLba~Y_JvzG{?(+ZX)MX{ghCK?O*bLW|BT+UU)_TC02>Zj8!ULq_tof`{BV$R|IxiCB1uhYi_KwDe+$W?*nvXpKB?o z(2dFZY`WGz=JDCLvp#dbXo#^Y70AbVTz6|PA=Saw`%|pfP+z|yOzifEPJ>13fFO_LmA9IGGa3u zJpq}7hDG1CuGf11o6W^P7R=W&n+;PJPEzmVx^+H1uEXctA@3PVbi?d^d^Y__r|q_F z$(kG7s3cGu8dY?y3)Xmu@s>Zy_VD+|*oZM4ZsTB5K zl?Iz1qS3m;N4N#sabjX+I^*El&8`i=h_`mL&%ej9*^N~TS)gbTk&llL!AI`{g9O}(>_Z|?Cr#K+U({cn*wg37g{ttPzcl|uGyTR*(k7Pmk z4Az#*x&-(i`T_eUcHC+~z$GV2a?NfanX5|I9mB3D=&@~6vW1!XiZrIfHv2xs?Xt!4(*fF zLfs310K171u~0%%XUq7>1)Kz|iX@2-=gs|k3jFsIHddTAMX;X=cMv;7{GMA!5#G`A zeeuebdi=8=yQZK)%{!oX^y{LYL)fx#fYvq00@?)!NhF6a^k5QQ!T$jO@buob=Lfs_ z{{{f>wh^@8PY&>XMeq9kvZymRL)jC2j(y9! z$~2wAdn4p4_d!GJL>8Y5tsH9EM5^-q<|5q4;WGXdCmT#ztgS*fs!yI3kn zt=$QFPk<{=;*1Jzy$gsFhrI1pmuFEEN4Hx8T%_o2MKei4f1&59MY#e#(3|pZw80D} zzoUr42W#Vr%ENV>`~{-*toR0i`d}_cEw&2|8JfXSMCj2zxa;xf8y_H*f!@ufx0sSM z#Um#J9EynCyZqf5l}* zvNr%KlS}~bF;WXP*bT{_5^(NHS1K^HFj_LI^{vqNMVxh4{h?Yv6-{geJ_ZTT=FX!O z2f^(X*+8`6Uk*n|3JSRS;Rko6aP4vv3ePJEX3lZao5GTL8TUJ8H}uHeYL^V7n~o@K zcwL%|xH_Xf{KLuMVCHPzVX=()T^m2H^7jXysdj00j)^Krx0ZppB|ZWW=^tv}6QIwt z@Z+Y}bWh{p%xp2*FaJptn2lFF7Yzp4uP3)aCBZ|#{CW9LPzN-uD5Q0THqEST>Es`s zt;~A8uh)ZdasJKywRLskgkiy13lkF)tSjBI_ug;vnXs--yDq$ZyRuCRX~I$Lu?B2k zrAh$vqq-*o&okpZm;)}Wfe-#2RCza_2)YMp2s7qCp-RUpr2KzEl|>IOgSXtyl(~C^vlsbqR6!u)Ce6PvmnTts;d6kx}pIWfb>`DwU_JB6LUZ!IzE0s z4whJyMCU(_1WKj)1SP={U17JlfGSbohhX@E>J!?-;G5%~s)3V2rh$043?3dH#Id7p zR9+>7$XvwpbdOlJyC^l4cOn4(#yyH`N6WE$Fa$gbaJo7UY0^ zu|+xzU=LkbkX{|2y5ih7=o0ra+c;(GnqB7u?fGx2I25qHn*y-~1lJXW6>T`#h@EvS z(;&AXkX~mO43vQevk6P|!3^}~{Vy@)6eXdO;QB9xAA@s^X{uc5_w6H059r<kiYf*QUJ$DaP53nC|XJ)ZiC#w758)qhv{sA$st_Y{w53t{3*p6>-n zk3_t0vnXT3Qll5JxWz*+g4lreIvm;b1>4?(o_8QNF40izbif7CsVYg>Z2&(tP-2In z?jg^BJzL-`j6AwEOW-ZJ9SNr#YUTNH`r`tcIw9&qxBwyX;I6ouY2L}( zcx|_Y9ZqKaHEy>!zJ6ZG4kqG!6&$tz8!Giv#AOl05+*l@h>Z;mGkWXK%!X%{I^^AA znv(#iJgMBMjF=>+&?!rwD(o=K1H?e^j4PI##q_zuCF0v@iPpZD>)s{2R@Q7i=3~eoswx zqx#~-*gpRp%@h1?I3=#rPB^srQcTou#jd8?VJ5)cdLJR7v1fMNQ*@BOrOmV8*e*yx z&vQ&nOiZKr`L1bdPEI@m^&XnrIZv)Nc5-L^5V8pD%e``RjV@D4fkL7;j7}nRVIXc2 z_^?0aU>)k>kGBdh)D0(J4^WJ|K< zMmH+-tc2gl+#tp2kgabtd1ePmJnZYVMn52lJ)}|`c7wkxaCSupL~M2U6_@_!aamdO zbze3TW2N@8wy+Py26+AVKP?6hYv|6u5Oyr!f}Yj-@NCU;WL^Fr^U97&oab_^Uf;w- zKBKmV#wC(t({TUXZaM&O!-SgM$B!L*o*2sBoOHiOb01kQIR(|%TQ!Qm#XFSgfxfOi zThlr0;39_h2DdtKz@q&}XwH{B7Zw(*goe=uCCiI>QZQM1j9izvxMBPD?NBa1ViL4cZ@1B)HVnD+4Tg?{txtZD=eYU=^y#@{w4Eey9e)D~m=rD!5jgfV2< zv99^mWzR9XNe^Tv|vNG21Y$~IgmR3GaH{Ibr`}edGTP&Rh;A{xk_J9Kh%#TBR1zo)+kfxx% zuBCqCwp@Fh7~*~Y-6RE}D&x9!4r&4pfI?YJ@WDo8|23K)8uDhG_*e1Ovj20QPtZ2_ z7LPwUd#H(h!@?EjUE?>!s_dliqBC7tov3(4MWDY27DMFpCxi5hy=SZPAZ2;L_(pIt zoQE4Qyo+pp^uSk}t-ynar96&-IuG}+QRhrw_?ZdnoQT{4>I~N?_StH1+=uGD;S^+$ zc^JPaLP+Z zn?!=Yb9kShTBrRpS4K;*%mX(ZV(=>QiK=Z>HC-=({{O(q6!h*_gW-5otWAXZHm-dh z&uCBm5?gX#CHk^GLWyc0R3!W!Jd)7hpylcxf8>RL37qSbiSn9Q<=PiKf6=5f1^kR; zj#Abw_Z6JDwp7iytc0c<{`_%IDEG`hUp@Q?Ws+2-g{Mxb5F8X+DOsIsXTlO2uS#c}+=LEbwDADKajCBomuwD8^Q((Sf?a7}jEoXn}!*dahH~BzDI5(idB%`&#{v&X-4S@`KPmsb6#BsGtape};{#>V| zU8fXRrxe)_u8s173iZ9}R4mDMfO{Od`vY1RsO?@)o0C0gycx$)5~q=4Q5SH*5ddn( zcM*4+oBFE98OVoII*2}PuppFWLQdV3a=#5qF)_NjTmTJiu3$N1bq2lcR_m`-CAaYq ztvnr0>1)iNNz=v)<96`;4GQaEr@GF$yV@alVb@*}#!ew}%Z5E352*r!f(SkKvarM3 zQw1pVK-kZpir_dP>Xa#Fv=-b%c{j^)E)cansM0X{VN!}J(G0eu(q%eMyBxjs?I}?6 zEGqrQEEtQ)CzLQ)GH74pxI8mom2Ld zGADpPAvF*k!6^6GVsvo;L(BD#zN%XD-&m8DW--}=`7TkG3vy=%Sa9DDfv ze$R71_kCU0ece8=^Ys~f-{j`whE>EIp)!dz8tv%Y-Kvpp=v+#Ei9WEg>)PbYmxfy^ z@~zZ&O7hS#nY?TXG~<;>B6fivQ9Q<-$?L=ttP znktA&zNy@+fY-Rc%a445`lVNnvZKHRb{H9<^U<=O^srDUs$}aURV;2FXZ>^1)5dS) z|EQN2b@IkjM=OJn>ap)b5m6V(+Wyy1m$Jp<7TP#CIJ9s4rEYA}>0SAdiRj&W%qVTA@~UhN(xB`2)Nlu|OSKkEu0jCdAo5N+1 z3yem6Jv7GeW=lVY3F!X*_DWG@39u2s!BNR0#zIMj7NE!Q+<|sP*VRyiWEQV!qf&em za2T)7l+V#<2Lz?uknXk&$5mY1M^e*$JhRZ}`)Q$@%6A@rI-i@;=UQ7|KZ<2+LvTj4 zYyyO;;v!abs1FH06L&o>Zt43q>g*qZt{mJHWQ~l|7-yNOX|#{~8MmAxrkD?nO^rfoekw8`d>~FSL0?oRZgp_OYxI}8udwQ zmzG693;fN z1FSHy+eb5mhx`)C3C7yj#}c@N8_-M#44}x37u(jO!L@oDwp%V^v;znHfqT1F%v1Ut zD8E43)V*v?tsi%+$JgXH3$EM!p$JJfdxLiFC9rAXeg=OLEK<)OUvat;&4y{a?jge< zQ0v?PO{eUxho??S@7$G%ExLgnK!V_cUGE+rKES>YIUM@SyT(AbM%RnD61Ei;k~*^^ z-Gpva7Fjd0a};{xH8qccG3vQo96@!ABhdj3a`HIhaG8j5V<{RSsP>|1KIO_@NvhxF zKUFR0DI?Yv=FHJry@N>3cURivw^#TKrkBTHFDGXx#9RipcVYlm9ybL*#93#h!&V|8 zVWpoed|k`^qtWdt><7V5;pd(=VcM#KP1sZ;0gv9J`VVes&KT0|m6-7=!&af*nK~G~ z*`I4#H~ZxUSizOm^kZk$W`nQf>ud92^>>V74cwlI{%hA~;4JVf;nCYParEI<0PXAW z%+4Q}=(pN3Hs-0j8>s`P0z64gT@{~1$mn}6t;G;y0|9qsjE{7UEn2k5@FH$z`KE;K zTwrRt(_>iThn)zd6YujT-m`Kg@BRMV@ct$SY$lO!>KCu@{rBFXoT>M2g{WHvna9w9QElalGoAL1 zj-8K$JauoP!ksW)-+1NZ(j`GQ+0)pC{Qz3J`yR~2_H7trft)RAArM}Ss5dJlJn zCqowi;0MACEJKJe1XMj-{cV7f@oDe@hxE8G5__q8yMh2QEXs0&#f}GuSKro}`Let`je#6AXM343pu4{c| ztVT@jVW2p~pvd7)4)Jxu{snIYo*kSlL^zw4nK{Z~1K_TutFddrX=TLF9q0Cas94?6 zS(0?fLTW)2-h|3YUV#KO%Zq?v{}GSVpP$z6eJeMYfjAF14Jb{C8y*iiCEuQSydOmP zc>5-*01y&XwuLBWF>GS)axE|BSQEBKxtrbO-|DlmDv2WICtS5szit6+g6@xA0VjV}szAwkBb48cIRf4{ zRufa=ELHRq1NlKyM)Jdl=ueAB4w%fqu!Pt9bE%wr)-T*!?M;9i<>LeD}S|HxI% zMLd~gyy=jNfnwkP;v6|~uo{K^z)#?DsvbGY%7QXQPUqWt$S2^ib5m*#&l|Ub5+TJK zJO@dD4>BF47L3U-Tk~$#Q%8#Qd}r!)#Ev7@QBp7gET zNIAg4GkN*9U z&pp7xl7wQBG{qDG_c!_s8NfldS?Ethq%y*j>#w?jsx^l8A zCF{DDu}Yz*;;$^4*Wq+DIslWW7}`Ws-bj?|n1lJ)o^bh$hYu4;y!JK|Bp-P>8yB<} zJ2&|yq_B-2lTl&{jW^Gr`-hwR91oZGf~9HlOWb{V{iUqGk0*bBxPUkLC4m-@A|{Ms z2SSPVwWGt3(5=*=%!;E*&po?y!tJ9WfQh(0pSTI%s$^l0eY)8Ye{*?q-W>Ax1E?QiK-k^z@Un^=*gF+O<><6 z&ADQ)2W`gk0oETYiKpk=vVZ&%<=hChCLy)rm=KUKYwq~$fHV4ysn}K5oU$k3g!T;) zIiYG+xEct4lyJN<$9$RH2=oGqj_(jS$=dxEB%tDc$fIo(XT4;f)#RGHK|NI&0`MZ* zc4$P}yUW46#B??5;-pK42@iwU)Qf*d-|8~Ev}rmb2!D?uAO!D0asmitRF&Zo)5aXP;pnm!lQIYwjA zN6L@mWXSz~M#l1+t7tqDTkLG83M+tmqtN5l7=F1ncQx#}q-Ov`Xi3Zdrd(;%G}br- zN6Lmw>R;y2H=mMUC40zHme1^w6Y$bKdqx4YbMecqIMSxf52y_mN$syAHm}fC0D*$- zv?S&R;7)WU!An7Vh?U!35=3%aiGyz8g#r%+xPD+82=jAjF+U11glpW<$)6s3{wz0Y z5Mr=YxpATQU^-2Z>N9>Uw=af_-J!V~0qlre5iz_fbaU^! zUjg#5Y*x{CU6SAQ02zh_^n=NxaVs@d5YPULZivCfix-jVzK0$hLJdE+JA&zKAl$Z%ZpAm0qi7y0M52WZB}3(Tg;?%kP~H8tp~i41=-9TnyOk&eD; zJ&{3<>am2)=saMuNJ^QLCzozo5W?5|n`H1TM*sm5C5Ba(|4!r)f#pv?7Yq?GGBfig zu8fFQXrPN&Z!CfbfsZN+td|5ubVjEmvRjm=<4c-kIH!&HGn81`oj|_TH`aya zA6@^xBRFBbJRjjkh+GqvCZyGlHeN(iL6<>Nt+ze8_;P`cRdWHEMa+i1#CSx7mo@k~ zqM7{?=};AZD)#0#=inKX6HDli% z+Tc200~{tqCQCpaRoH`_L69S; z>^=}L5~KLsT(u9nW7sX*FCu<@6U~DdI11ew{D%N)-K>?jT8b!319uy@k04zAXh7KFI8x;S;>?gsp=^2P=br9`+3B z`_qYJ4sHbD)%mvd{5H|J8TGksq>md?2;F@tQ--O>$F8DRBN`s)Z{HF)sNC~y(y}+u zox0|&^k#==X4=<3>meUzWVjCdo@5xmd%N>8fht}@G5EIYm_`3-C;`>>cQ8!0uw6R! z)1)LRTyJ0(BsJKQ?E4_`1#OEy0kUK-zH3`t%0V{QjtdJP7CnS$j8)IYLWH z6Gi^QoXVxb{VTb#U@r^sdA$W?AF?0O_`abxL@tCp(P;exAL67qLIA$xSoHMng}{TJ z4<2S~(?Z%Tt!h1FO)TH3WhR-qa~bckaJb?MuQ~C}_V>)T9Z^pBe1?=`R6*4Wm_}qod<} zeZ2-dipNrI7IvoY^tIL^15$JpwXk^Tgr!9N(4!{K+=*tS@kV3mvFhWd+o!aKv1Tv&G00PnKVt#SXmM5-~>$KoSF|g~G&L z)OZ9vMg>I#3TXO3x&DpI{I12%Dfb`&;MmD}<}KGs(^eDtK#~BU3}SyoFzccA?{~af zC6fsYHu_kO{F0^qFt$%kNf{lf@Qt-65EKc{p32Xa+MxM4I>D!NS40>yTP`lX6cfNll!-9v#5?LGVL?Bx{aukDN}X4bu|zRwwFwv@(p45 z9(a#qtOBPn2$W9bN;stiE4)9g(E@xzVyuxTfM{eb#lK6lQII@B(qZI@RaR?yWE;w) zZ-TJ@#ZP9o%J@cj3}dPXv-dMXCHcD zWRvzB)b1qwVOI`Aww>|d0fE90so}pMgt3jh8_By)=ycRtD5S!i3oeMHcu9A`JYB5* z!hz~vi-aGOXrqUBemtuk&r8C+d0v#_76aE$i-hd04vjCF}*#y(?uk?p^0j0F6mH z(Cw4mgKdmW0vnX2e%~)TdmR92Y{seftJX95A8I{4cv;-lpCR{$58a3;NjZD>3vqAJ z>LQ1~#HtJS-&<0~2K7Tnx<&umype5f<^3|@=nf6g();>wLUUQ=>(}3L{^Y=Bi#nXo zwLQkz^zcUW8Z2RmR-W{gXSd(Dpf*-l0T}^--q9&t2ol6U@ z30W|7cO;X*L?t712vRQW2h=B{FCCHuVLwFYp<}zzjhCyI9qI!_JH|PI)tGY;)!^`o zZWRnNp?3U|PQ+)BJ3`zK`Xl3x#59}^wvLXtm^$<@!4d`6Y>avtbv-&>vYx{;_Ahjy z2lJ;_zyL?x(Xd-z|FZVh>Y3tL2Z^AOMr-TA2;=p;mY|K4|JV`)mHSaZKp$%R zV!FNB$S~5%t?R4`2DVKcS=QbNaJ@q1h$a-_L%UWVU;2vLUqPrM_I-#l1^0ZiR8^M* z4f$N11h}jJ3yRK*7n8M!qB9wJyx~RQCQhet%8;XO$I5vDu{j)+6M7edn|RX~;YcL2 zAN0n(aYnK|MkY&y(sX}F=fD{uGB8SQ)Y6e<1E4TFQnrS^^=CaO3_3gHP6iKzcMCGI z&+z`_E;0frf z+V0TwP7+wdPl?`X6P}J9=V+RP@UIT-}s4gHK$MI+>cO1_b4|SqNlsZ!w-K0=# z+?WtXQ&0@P8iIMW1vOHceN;U&JpyH7!X3!S$+jS=Cr}O4(}OHBaA;r(g*&)pkMzwC zEqEBdgWpuwrH$qaF^H5}Js5@ZjePv}=Wm-ntz-UK%r*TtX&-ahf@k6n*Dco@g{bL{$rKA@&?Y;+;mrO=` zYz;x@qXw6fcg?WF4*IaroI|Tntsd9_2-BG$leK(WaMhySZUr0CV8($HYVtuIFh_va;A??KxLE zI686+wuHJBZ*^X5(stgE^UliRR+pr_=f@n&hTG*swTZZp3~&SY{~BWv0RCX5LMUi< zv}OnCii1qU{pH9a0Rd%YWuzo`fu?~g`83u6tnXc8hM9UIg0|R+( zybBg(eh&TaEEA%}6(TnF?Y2giPE-Bpjk%N)>}AbGtVwbJ3l@aqm^;R(h6up3u`f2_ zy{S%%i&DkPYxAq<{lgZn?(XZN%68sGOUltY$7u`cKNrDLZ_`%y_Q7kTj&B90m9had z9}(N*A*X^Uf{(V49Ytoyvk;X({MCiv997ZqkYpAV5ob19^1vPD=$(QyXl2|ond#IW zK#qMrd`l&=8_E{VpN(h}oi+t$5cA6$cCy}=Xpg@zlGtJTT|tce3yYl*K(62>Q7~QR zGbC_-4B|!EC)>&`uB+2^MhHC&*;$h|>yJZQeqspvp zoHk7UH#uNv5by*4+rUoDouG}NYsASOdC$s%u06rmY+y&uP;ekfb%BOEls(Rwtzoz# zW@Kd!@Iuklh z=T8{7!~cPmML#tvgK&f7&{}P*BJdj9qbgSFckf4c(Ec9{cQ1Z)37x}qVe;+V>wk0$ zx&6>#bpB{7dbeehTnWyW^g72ChB0Mi1|fgU{;&52 zeAzjA>Cz=HHK8KbHB#hPMOyT8F`BuSMX-L~b&iI~tNQ1^=SSz@Kfj==P-$G?wM!_+ zATaH9yv=B_IIcKtKItX0vlI7@tv6pH={-;E19(UifkoOh(HNif{w>#u-M+0(S;B4E z={PN9MRBUTX6dx`6}6a-F87xR(@t1s=eep(YVMA$=o_vQJz13ikN(V4m0oJ*qbtbm zycP`0K=}xr;}6%sYAkk6{tN6M*zs+piAI%$sm%-_qrLOEe|{WX(yC3Hrd`|AM3XU= zt$)p3Q1doH4{IvKTsj<9DAE-V@ku4=!q?uxENjI#2n|1-0hVrW?7=A%{efxmN8oOixp-QSiYJ_)EgO!GksRlDuk3>ZBhRradVN2cmk+_WZ@9A zX)c@lL!dvtpC@n-%}hY^lYS{}>zh9gnw{ViFaYSK5yQ8T z{DPqM0I#rhF-rt$q#byw5~CQHs3o7k5&+FVHLqV^)`|Vx)L3181o#uT#->e$Xj(#_ zxkM-=8N^jmgPnMTnwy)8PyQb500UX&9c1_?`$r_t&QP}G`Jf4iV9f0MNC`ZttC!d) z>tTIH<0C*#^dP~UuwM^7=NOsQ*%>`J*|KnIe}8X+IK8`Dh@XF^uoNZ`_UjQ&fcqIT z%PS?V=kFLrejQG)Lwtu*__V1wbB0WT@fi+>>kB8T+>V1v5Vv@HfquxXx4 zOk!eH+ZKB}Yky$K+#9#*0RR`P_^}ouU?j9~VPv`MjV4$mn(|?5RLu?FVZzLy+(<*53qvuLf`NAc3it$Xwn7D*wxe+flgS235! z2aj&pu=hlP;~_Y6REq7%QVZ@GTxoq82t=DhafUDPML=+*s4v!WJ-j~}xT;Kyu0J<% zQW{M{F^$K%`@Ur-Z=d0$BHW1l7OZA)+Y2?`0n??^NW-|_A;M>QvYH6=e?C>2UJo+` z_Bc%FymQBSe6+E#F*Y`q`xyjZ+LPTRM&~X1e<5Zi=&mMNb6CxqVUvA3E<&xXcF-GT4{ahn2!h&Tyml8Nggpo?0l^M_}>6zbG0N0n$Fa z9p4DL_!2ECC&wGKRg#WcO%I+4MLpq#BwtypOMyy%NNB+sjkrU_oABTT1qF$&7o*(3 z!pTKAIyk%sn&|22x$Me1Z$|PZ*5M_wY;S%$IFQ6q$z&sYRs#1+#1AR_$nlqdbFTiE z&#^xq%>VcU=-Q-zoL6?;x?zMPgb^sH+L7JZv3~^fO7in*c~>jiNJWqKGlV6j2pw|Q zVH$G;_3W}M=PdCcTZu*9Qa7yMZvaaScYf&`L7)sSA`+17Y){8B6h|cFp~H)yEXhVG zFK~xLB1l)=xfso5htV+6gz}C+ws|PkrNEtk>N%sa4;VRIpm5j@S3$G-1`!YVIkDj| zGy4ESlQbXAgKkpaha9Q<+W=5oc zq1vE>Rlh%l6Dp9uhj;GW2_e6SM(WV=kH8KgSwdqF^iZE`$)qgsv2%nwKV(1p?axHE zi}4T!hx-{4AU&ol6gR?t<>lpea16S>j64t7D+~q$LlU^3L97df`27;;*}_jSEGW~| z$pi8A7P~V#08Rw-v!WDQ6qy-76d%i~sF*I6t?97|DYGW36+P2;ID2+HVPtT8)#D7a z*&ut5SUkW7rT_TX(MD;Kot(nisi+vDrZ+mUb}LC102Ez|+-kgU7EWP{Wyr(}&LEqt zrl#J$Eh!Db?EcqE_=Y|_@@=N?o<3DaHRY~jR6gP(Ar|!Mb}90lE1N@*gy?QHwAzlx zWtwlRMw9WL*M>n5+$WLw#^VCcg^~LuvK{Az=_~8>B;Uw?MJ=oe-j6$>!M?T`{^^JJ zSy)&&9xsKW`NC}Mpz1}wT99?1V>RmWU4TfKKQz3!W|Ji*H>fN+6>u>yP_t^V(dVVq zl_JZt@sGRLUG+R4=L&B(oaqm=DbF zxw*lpkY*qeI{KN)_#80111FDXWwp*Cetz+avljdDX;(5P_+{G9_AXkyxU*stcXi2V z#7Z_cw%#H+)gHyG$9gh}qC@2B<`vipS=`T1ljAv~14h`7IIq;R9wEt)qo2brM1wsh zCI-mI=h~sc!NLB1KW^wf^ow!$73+~smA1P8aWLo3pPS5G0LaHP3lZfzWaF4I3>OeI z%RPAbFiZ}zuiickk)(WT$Ea-|Fdr963O1#qRk;JLnc``6Fxwy<>Wb^2gn%3uC38+r z4vGmus-CCk82YqyBfLmDA;$8cIvi5cs_VO>;9cb3hp)qD!#Q-0;?Y^LI*>0Byr{-} zOTu>2iUh>~%XBGP(zG@pUEdNJbVxkep{h|xXS0f)pr;5t^; z7vzHp6+f*+&abUiSrz}_L1vZB$*V+)aKn~f#3%S*IZVLhq!n3p-2Ot|_#--sQL0dE z9)GywNUx>$@rTpq3-Iyr(K{r)W3%$}>&e?=V6UWbJ}gaWNt(F#0!ie^dp*g#0t44i}R%U3nA9M*afJ1OlAI9vlgd+Py4BcT=yox|~ut z!zt$&o*C$W1GXiU> zO6OsG-qaEH{T{oi=`Wg_Eriei;wyI}vp%aI;4@xd7W`dF{D1G>|5vxougfRKHDUI( z9MZ@_fI3H-4@6s-K~+HS=o=Zwp$fl^G05AX!vQJL3)P#Gg9Cge#Xd@`qF=mnGI%jPHW1qJ;pX~noL)@8dHjC#I*(NIx z0ZEFo-ys;7J$m@?l6f8&4p15jes__@6dSR?p>gL^m9~h&5MoIC-9@mgreahbdM1#G zHdwJXyUi#5_%>Mug?^|4m#BHI3obH+g0!ov3qT}H(R;+7kB*IP($d0_6E3aleYHe7 zTgs0#DYdv{2AJo&qL}qkqvoG5l@8Yl6EBY)KQPTg3s}MC`n_A_x7ymJphbeCRaprG zvDjy7RS1Wd05YLUNDslrx4&NneH`eftVhHj&f5%Z;KFR|vm`wn?yPD??emG%c|)Fg zYkT51cf;|HaI3T`>c0BkzAsj+5QoOzuTT1Ln%BOT-7_kse;-tYCC@6=J;vdZBq$+o znD_6M&2D6E2vrl1SM6arM{QH15ngu$2zEE@-{9_sB#}1!Li8mY7pn-ex7Vem02_UL zxyVw4a}s`%JJeLYdlgJ63~8fpR)(8yH!+FYykdLu8w{`psN0JUB{{$EfCI-zYx82i zMkCW>lVCl&L@ilmE8>KPqm=z4`mzN~cB5DPm376Tq2nUK;?jX;$}Gy&=&}htNh(6; zArd(>b)o#=H>qoAFf~OW<}+Dx1kCj(4e*dJf|&rKDtDdt&?3(WnuL%Gv0-n%f7g^b zf69e8EsE8vg%;V`S)a!7;Kj2lrrg>)r^r!OR#soEwy5ZxaV5+;mGj&CFXqYkfWf4@ zk}2PiP$lK1=kmotByRc1xXPa!j$_oG6Zx!{UCnx{HFdx61k_o$y1H6Eli?6amJYA3 zDrKv4bi=8j+v0-2a~jDZzEG9lDR&BGsRrX_NXy3B1pHs^ zYxQg95vMZAOwXSms7si&3*Fb9ot=g9d>|xdrJ$&kdpb~$czSqfutRz%b|8Ya6L({Y zNrjhqkCd3BhwhNCuWwJ-h(_G&+S(!L6un`u&n4_wpFu|ozlbRbf7d-Z9!J?f5+%4x z%Vtt<%|bvZhPGdWeeDNVLjWi%8LYVYG+E_9|1TIxKy@?sT6TqxsaXmA2kD$o3WTVD zG!DU{3`3Kk%PsVM)7Y2`sGUEJWnFbm3iWit_GI|Z_2YSaKpdKtosIf*C#H=8__z(n z9qcGF0jXlxB1Lk=`IP@6eJkBbEG_U#Tx z5J=c1wM>QA7kPOz==SILv6APIqNbmk{vNJr;#e??@)XYaSVsH*CumJ5L_H^%#7g6Y z81G*PzVCUg0#&CN;t`BlBVr{Tkt00?3m-jtgn=;W(4^%3X+Di_k&1$X zktv`hCGQk4C!aJ#f+Lpl31$oV{sdA+^|OfesS73%D^U!QG_yP*?|t%qx~uZlu-NgA zDf_f);7=U_w4kjoLGP0V7Gc|60Q-90Ukza+y9K!sG;j&q!RIz&Ym1_7fcqKbAU#C3 znsNk(BL6KO%88xwQDw0VaPx_eW!>ngIDXVtiI#G8 z@Ww#ZOWLg+;rj8%Qft1dk@S_#1V@|iJaKBa^tuCs%JW?^O-aI3(&}<0!+XVA3k^B| zO6nAqz^?`hh zt}i+wV%*~~Z|T754xL5WuX!aLEG(McB~IChUkVH)MdUX)dl#n9b^YAlZc7hVr|V+K z>b5X?z#}*>NqNsBEW}fV*1i!mp!sv7fKhzt(z(9^G$D;43AOZ0VKCTpTA@okkxsI! zrwUz-IoZRUqo}ibI?xi!LvY5>XWmtx2XYPf0 z2029^l>$mdkc4wU2^e=B<2gp=`T9VXg`ea@Vf*v}H=!sFF zuOxc_zc({`NtL$Ff0E9mZC>$`YTybX7wF73@z1ceh0QG9_4fUHV))b}^x)AWXBcFi z?U+t!ZeZ<>D@GCnkf4&W&geka05pt-6A%x$1#UGvj6c9Wig+*b``*UM6d(Wj>B*_+ z@&hU@k(=j(Z$cgtpc%1O8%fqQ@_~mqv5zKW-iHt$$x!W7Qnf{{kv9Sgned(b-2cbR zjsMk@_it;}Eyh`tM3ER>K1a;9|@F1C{(x7~7Op2~t(PY(V%S>?i(zLEU<6J1w|-h|t1m5p;$Tt9E)`&z5?2c)8f{aw64hU-N8t#jw< zEKmaxq61y#;Wis6louz%Csn3@&z7;+#UtA>xzXNUqT->wkN162#t zUg9lI8-3Jhw2E-GfXS*5xijI$4z{{v_ByhQC@L!pYp-jdDn8$0>mzl{6aHT~c35=71DKc%3cAR~IvC2#IC(h406qAMvzaYmw> zs44->;?8o8DHLn@eA^Ioki(EEJ3G7Z?c%k$uC^2kp90YWfIUOKi5|c%)S6M+2@<=| ztJB(2%1yBdJ0j_AIqS?bsH^e5g;Kk|C!pmI?j9bXeMl1qPIs6*tD=8AR2pZB++k~W zitN}-t>qXD@VCTRg2Ob*^~KQ`L09T?s`3@_#S`}HxRaL)Io0?mcu!M!YY6+n>2hZx z6n4cW5yF(GouU|=f^!7Op9VY0CMK%U66D9NyncO&*#h8gZRCgRe(z1N1sEI@80g0h zD@l+l;bv~T*+0T&?^UbIe5x%|hVe-T6{jfQAsA!d*`1!4v0qfuz}%eB$Dr^W+RA`H zX+mj&Qx>e%h83&K3=Mzm#?6pod?_wzSgs^r+Ui0);$JMjM!4S{lzIOyPHf!Bl zu0->LH|X{m%AW6Ri@p@7i_2U~q9a}Fg*Z!R0k9u1=sa?BbLl)3pjR?nfe+mfOWB1w z(fe0kz1;c6YLdmR`@Ap+e^hV=7|>x^Hsr@ZnQ|`vTcrR)Bi__> z&oRz>RJDUrz4lQ#hc9RfAN&s_yylnkl?xj)S428D?Nc0PhV33 z&rz%IlS$vnr**`z6cW1m9J?Tqmu`Doq=c4}z`Sr_T17=F)u)*!DI-I0?va=Fsd&{sI|C}neJ+AE}=6~*FOfw(=)l>oT z+d$U`r`_Xz1~0Yr-9e64oVQa`K?5@01&QiLAIf?fji@clSYTcFHgo^@C0oS{Ev0wS zG96vP*VWx!n{(vUbFm#S_k~Ev1F63!BX=Y-IxJRlfplOqzg2AcqKhChc!f6mqMELz zs-nhZ--o<1_WK-&3s_rhCJ-7lzy4MQQ_1)N_K#>Y5<9YkFgEfVC?}MD2Hpcl%`;>} zjg5}Jywi=;h)$m=?D+0(oLnd(%3fAPq2}9K{v#eyyOy1zuCz{m8s*x=yv7hg?h z3I_%UWAEqYvFZ%aihYyu zvjT-4UjKDj&wsy@<1dv-0m#qk0@qG?sdZE9qQ9e-_5vevfa=tgJArWkw=7ikZ;&LK zr2p@Nh~*?n;CFF_v=gyC`cIgUh>!}MSL$rhR*_(G1nnqYR?g9O9?jwRz!-KGQpeJ% zCQsZCPwzN6&%4{RX$(!?N`s#v^|Ed&jUFT&1}Ia+rOglJPxl=O_uXCRaqZ^ja*paN zAsTfnf~9+77NO(<`tdFZxm>9Bj=M|5AUJeb zS(Woyu$!-`3UP*4icR|w8dQ5$&5@0V)0~_St@_Oyqx}8XU19Haj4vVb30fV>AvbIV z`DpZzuUN`Jj7P$ZrT0x3-143C@fw9Jq-+FD=t#=mxzY~Voz4q zN>pnQaJHoO=rLc>_CXi(gSF zvj@HKH#W-eo*VM#D+mX?7n(LDCEu4hw&qr9p3lx*_qJPY0HQ{<@a}ip3>I3Ro{v9kx7To7RG>v?5YRq z)BgDD%?AD@|C7{;Yw%(8(H1U5X}q&YdFe9NuQ};*zakDl5bGe#18i};zSu8&bF!izC+-q`;3UX=>IGwj5IQClwo z*`vHMM+jn~x3HgyQ)Vj&ZHcr@EJBG`*B0Tugh#-E;OG9g#LG5v{nyw@i zsL$2U3tr1Jo7Rjr}OcHjnn(vUm;&2zSHtO~z|t&>x1UF7v?dju$nWk}wBzwhO>rkvmd z)2aj_b@G^PgCp_5D*0lX*Y(B5=`;o%tmmZFtMkNLXEPLkz~ETmE#PeQ=3*Kr&LO~(unH!a z9`>ztrOjLPaYcOEIE9orsBa4e9_WjKC~|dka{~W@>0Yi@lG9QGkUW#KCz@X_)+SJ6 z8cg%OQ1&7lByNl_HB<9`y1udJ5+3~cM7J-K2vyOnl?N{|=Abk4ZDZqJ#`b-3cm!WS ztjrQ7x9BsIOh7~5*tgD3DW6%~Kd!2nTou>mv+U?3lNa_Q-kUZm27Jz-MtplkedPuv zW!Kx;rIeySX#@L(1*?>;yti&Gd6z^nAh|0E!SWkk&c|=`fwbSBI}Pr1MI5}H$JUgWixIIuL!FYj$6``t8oXm z+!YI+W#7R-90OIOs;WwWU6kTLW!I9KU;xE$CnwJo#x(gWe6fm({IV zm@{s;4V`Q97w5+|F}j*!1NNU-cWCkh0w(V@Kn{W#6BRJP>KMl39z;QS+KqqfW_*K! zSglAje1p|*#|c}?Rcr`jF&-cY#28yafky+QA+g)>ay$QYal-Fzx5%&O=~b3O9`3O$ z%z83wiu;N9@MHgahNk_rEdIB*UE2V4kVG>s7_v!FX=#X%b5_lvRFf*Fvg+yLPk+?B z+>|t<7@daal@2|b2bzK}=TBDs{wH4}&j9SC(zxNa-#=y@*;!XI(Ub{!sihWaS(G>9 zfLd+p(~QZ3RzLJVrdkG{CsVE8t*gDc)8;;g|HY|0TFJ|P3wb9cM6e{$(SZ&~u-n=T zf2w?4MUg$oS{`$ZRwD#hpov-7?@#gk#&7pynE5{2H#{Y8-KEc)zO9PuQTC`5^INgl zbdTovd`;WUdnOh(yiw(5{`9<{ET8)9>{5ZB0uI?0iy3_1!9g+Yz$ zx(g4?Q+~$3_fSiK*=)r(9RqCMGsN<7LO|0^qllf|GF4r%LhQ_HyX!{Jz}f(ozQmkt zp71ji>Ysjn@du}&uNU^Dh8?3Y#6{*%>Qv%+Ufw*pY~-TBt(Qr9G}w>e#mULZaQy-V z$Jk~NGgy0_F6ZBzvNXyjX^eTjWM60bW3;2UJ9jj=Sr!NI=DimO-OyMO=ccFg`8 z9_Xn3@PUhQ^|zm5@l4Ff!q=Ax+Q-Ag!_94QG#DIqR78Z5ni>OkydN6o$X!#QSoQ^O z=L=?=B@(DH9sGLmb`1LMZ2OL%VWyJjCdwMf>E^6CqJ zf~?3K9v!|jvsAoC6%zUp>wP$(bY|o^pY#p>_Ybmgb5l$}Uw4iDgEVTL(<5|18EONE zId)k7)&45V_*n`X-Xv=u@y`8tA4jhCM8%~l6QDxar zgvWV*cT>)$sR{5uCdw5^NZqo{?$p9dUrAnGUQW(sU@gCljEtVHF6P!|=j42#yV^gf z$631Q;>+uIIBHk_>pDWT`OXx3O^hDJ=oXk^MamP&E(R424-dzDm~}tmUythiia?D} zOl8LF+czi3?3$=G9RskwK_fc{7Z+E{zb%|4`*>1nyWH};MqD8DbaA=5-CjYU%o;@F zTl)t;o6m9iZ4GEIo9q_)IDEUGtYY*Q~v`B?k7F~ diff --git a/DIMS/tests/testthat/_snaps/generate_violin_plots.md b/DIMS/tests/testthat/_snaps/generate_violin_plots.md index 598ec3f..83d6efc 100644 --- a/DIMS/tests/testthat/_snaps/generate_violin_plots.md +++ b/DIMS/tests/testthat/_snaps/generate_violin_plots.md @@ -3,19 +3,19 @@ Code content_pdf_violinplots Output - [1] "Top deviating metabolites for patient: P2025M1\n Metabolite Z.score\n Increased\n metab1 2.45\n Decreased\n metab11 −1.51\n" - [2] " Results for patient P2025M1\n test acyl carnitines\n metab1 Z=0.31\nMetabolites\n metab3 Z=2.34\n −5 0 5 10 15 20\n Z−scores\n" - [3] " Results for patient P2025M1\n test crea gua\n metab4 Z=0.84\nMetabolites\n metab11 Z=−0.46\n −5 0 5 10 15 20\n Z−scores\n" - [4] " Unit test Generate Violin Plots\nUnit test Generate Violin Plots\n" + [1] "Top deviating metabolites for patient: P2025M1\n\n\n\n\n Metabolite Z.score\n Increased\n\n metab1 2.45\n\n Decreased\n\n metab11 −1.51\n" + [2] " Results for patient P2025M1\n test acyl carnitines\n\n\n\n\n metab1 Z=0.31\nMetabolites\n\n\n\n\n metab3 Z=2.34\n\n\n\n\n −5 0 5 10 15 20\n Z−scores\n" + [3] " Results for patient P2025M1\n test crea gua\n\n\n\n\n metab4 Z=0.84\nMetabolites\n\n\n\n\n metab11 Z=−0.46\n\n\n\n\n −5 0 5 10 15 20\n Z−scores\n" + [4] " Unit test Generate Violin Plots\nUnit test Generate Violin Plots\n" # save_prob_scores_to_excel: Saving the probability score dataframe as an Excel file - Disease P2025M1 P2025M2 P2025M3 P2025M4 - 1 Disease A 10.900 -10.90000000000000 49.90000000000000 -49.9 - 2 Disease B 0.953 0.00000000000000 2.29000000000000 0.0 - 3 Disease C 12.100 0.00000000000000 0.00000000000000 12.1 - 4 Disease D 0.000 -12.50000000000000 0.00000000000000 18.2 - 5 Disease E 44.300 0.00000000000000 0.00000000000000 28.1 - 6 Disease F 0.000 -77.40000000000001 -77.40000000000001 0.0 - 7 Disease G -38.700 38.70000000000000 38.70000000000000 -38.7 + Disease P2025M1 P2025M2 P2025M3 P2025M4 + 1 Disease A 10.900 -10.9 49.90 -49.9 + 2 Disease B 0.953 0.0 2.29 0.0 + 3 Disease C 12.100 0.0 0.00 12.1 + 4 Disease D 0.000 -12.5 0.00 18.2 + 5 Disease E 44.300 0.0 0.00 28.1 + 6 Disease F 0.000 -77.4 -77.40 0.0 + 7 Disease G -38.700 38.7 38.70 -38.7 diff --git a/DIMS/tests/testthat/_snaps/generate_violin_plots/violin-plot-p2025m1.svg b/DIMS/tests/testthat/_snaps/generate_violin_plots/violin-plot-p2025m1.svg index 89edec1..4fdc0ee 100644 --- a/DIMS/tests/testthat/_snaps/generate_violin_plots/violin-plot-p2025m1.svg +++ b/DIMS/tests/testthat/_snaps/generate_violin_plots/violin-plot-p2025m1.svg @@ -40,8 +40,8 @@ - - + + Z=2.34