From fdf83d218c827ff6bbd72e4e221a959721fe3e15 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 10:54:50 -0400 Subject: [PATCH 01/12] Merge FTIRtools into PlotFTIR --- DESCRIPTION | 8 +- NAMESPACE | 11 +- NEWS.md | 2 + R/maths.R | 425 ++- R/peak-fit.R | 2384 +++++++++++++++++ README.Rmd | 8 +- README.md | 21 +- man/PlotFTIR-package.Rd | 2 +- man/baseline_ftir.Rd | 72 + man/find_ftir_peaks.Rd | 98 + man/fit_peak_df.Rd | 44 + man/fit_peaks.Rd | 155 ++ man/get_fit_method.Rd | 25 + man/get_fit_spectra.Rd | 54 + man/normalize_spectra.Rd | 6 +- man/optimization.Rd | 218 ++ man/plot_components.Rd | 103 + man/plot_fit_ftir_peaks.Rd | 115 + man/plot_fit_residuals.Rd | 92 + man/remove_continuum_ftir.Rd | 71 + ...alculate_baseline.Rd => shift_baseline.Rd} | 36 +- man/smooth_ftir.Rd | 59 + tests/testthat/test-maths.R | 460 +++- tests/testthat/test-peak-fit.R | 1030 +++++++ ...voluting-spectra-plot_fit_components-1.png | Bin 0 -> 37999 bytes .../deconvoluting-spectra-plot_residual-1.png | Bin 0 -> 32721 bytes ...nvoluting-spectra-repeat_isopropanol-1.png | Bin 0 -> 50504 bytes vignettes/deconvoluting-spectra-setup-1.png | Bin 0 -> 28754 bytes .../deconvoluting-spectra-toluene_one-1.png | Bin 0 -> 39093 bytes .../deconvoluting-spectra-toluene_two-1.png | Bin 0 -> 37924 bytes .../deconvoluting-spectra-zoom_plot_fit-1.png | Bin 0 -> 49708 bytes vignettes/deconvoluting-spectra.Rmd | 208 ++ vignettes/deconvoluting-spectra.Rmd.orig | 178 ++ vignettes/plotting_ftir_spectra.Rmd | 16 +- 34 files changed, 5734 insertions(+), 167 deletions(-) create mode 100644 R/peak-fit.R create mode 100644 man/baseline_ftir.Rd create mode 100644 man/find_ftir_peaks.Rd create mode 100644 man/fit_peak_df.Rd create mode 100644 man/fit_peaks.Rd create mode 100644 man/get_fit_method.Rd create mode 100644 man/get_fit_spectra.Rd create mode 100644 man/optimization.Rd create mode 100644 man/plot_components.Rd create mode 100644 man/plot_fit_ftir_peaks.Rd create mode 100644 man/plot_fit_residuals.Rd create mode 100644 man/remove_continuum_ftir.Rd rename man/{recalculate_baseline.Rd => shift_baseline.Rd} (79%) create mode 100644 man/smooth_ftir.Rd create mode 100644 tests/testthat/test-peak-fit.R create mode 100644 vignettes/deconvoluting-spectra-plot_fit_components-1.png create mode 100644 vignettes/deconvoluting-spectra-plot_residual-1.png create mode 100644 vignettes/deconvoluting-spectra-repeat_isopropanol-1.png create mode 100644 vignettes/deconvoluting-spectra-setup-1.png create mode 100644 vignettes/deconvoluting-spectra-toluene_one-1.png create mode 100644 vignettes/deconvoluting-spectra-toluene_two-1.png create mode 100644 vignettes/deconvoluting-spectra-zoom_plot_fit-1.png create mode 100644 vignettes/deconvoluting-spectra.Rmd create mode 100644 vignettes/deconvoluting-spectra.Rmd.orig diff --git a/DESCRIPTION b/DESCRIPTION index 0f6418d..0048f14 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,8 +10,8 @@ Authors@R: c( person("His Majesty the King in Right of Canada, as represented by the Minister of Natural Resources", role = 'cph') ) -Description: The goal of 'PlotFTIR' is to easily and quickly kick-start the production of journal-quality Fourier Transform Infra-Red (FTIR) spectral plots in R using 'ggplot2'. The produced plots can be published directly or further modified by 'ggplot2' functions. - L'objectif de 'PlotFTIR' est de démarrer facilement et rapidement la production des tracés spectraux de spectroscopie infrarouge à transformée de Fourier (IRTF) de qualité journal dans R à l'aide de 'ggplot2'. Les tracés produits peuvent être publiés directement ou modifiés davantage par les fonctions 'ggplot2'. +Description: The goal of 'PlotFTIR' is to easily and quickly kick-start the analysis and production of journal-quality Fourier Transform Infra-Red (FTIR) spectral plots in R using 'ggplot2'. The produced plots can be published directly or further modified by 'ggplot2' functions. + L'objectif de 'PlotFTIR' est de démarrer facilement et rapidement l'analyse et la production des tracés spectraux de spectroscopie infrarouge à transformée de Fourier (IRTF) de qualité journal dans R à l'aide de 'ggplot2'. Les tracés produits peuvent être publiés directement ou modifiés davantage par les fonctions 'ggplot2'. License: GPL (>= 3) Encoding: UTF-8 LazyData: true @@ -33,7 +33,9 @@ Suggests: ir, ChemoSpec, R.utils, - readJDX + readJDX, + baseline, + signal Config/testthat/edition: 3 VignetteBuilder: knitr BugReports: https://github.com/NRCan/PlotFTIR/issues diff --git a/NAMESPACE b/NAMESPACE index 711a57e..49a6860 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,23 +6,32 @@ export(add_band) export(add_scalar_value) export(add_wavenumber_marker) export(average_spectra) +export(baseline_ftir) export(check_ftir_data) export(chemospec_to_plotftir) export(compress_low_energy) +export(find_ftir_peaks) +export(fit_peak_df) +export(fit_peaks) export(get_plot_sample_ids) export(highlight_sample) export(ir_to_plotftir) export(move_plot_legend) export(normalize_spectra) +export(plot_components) +export(plot_fit_ftir_peaks) +export(plot_fit_residuals) export(plot_ftir) export(plot_ftir_stacked) export(plotftir_to_chemospec) export(plotftir_to_ir) export(read_ftir) export(read_ftir_directory) -export(recalculate_baseline) +export(remove_continuum_ftir) export(rename_plot_sample_ids) export(save_plot) +export(shift_baseline) +export(smooth_ftir) export(subtract_scalar_value) export(transmittance_to_absorbance) export(zoom_in_on_range) diff --git a/NEWS.md b/NEWS.md index 8d9ece7..0b89330 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # PlotFTIR (development version) +* Merged in deconvolution and advanced smoothing and baseline functions. (#19) + # PlotFTIR 1.2.0 * Patch update to expose `check_ftir_data` for downstream packages. (related to #19) diff --git a/R/maths.R b/R/maths.R index 89e6219..47a7bc6 100644 --- a/R/maths.R +++ b/R/maths.R @@ -303,7 +303,7 @@ subtract_scalar_value <- function(ftir, value, sample_ids = NA) { } -#' Recalculate Baseline +#' Shift Baseline #' #' @md #' @description It may be desired to shift the baseline signal (0 for absorbance @@ -311,20 +311,20 @@ subtract_scalar_value <- function(ftir, value, sample_ids = NA) { #' for all samples or a subset, using the same shift for all adjusted samples #' or calculated individually. #' -#' Recalculate or shift to baseline/max transmittance can be done following +#' Shift to baseline/max transmittance can be done following #' one of a few methods: #' * To shift baseline based on the value at a given wavenumber: -#' `recalculate_baseline(ftir, wavenumber_range = [numeric], method = +#' `shift_baseline(ftir, wavenumber_range = [numeric], method = #' 'point')` #' * To shift baseline based on the average value across a provided wavenumber range: -#' `recalculate_baseline(ftir, wavenumber_range = c([numeric], [numeric]), +#' `shift_baseline(ftir, wavenumber_range = c([numeric], [numeric]), #' method = 'average')` #' * To shift baseline based on the value at the single lowest point of absorbance #' (or highest point of transmittance) across the whole spectra -#' `recalculate_baseline(ftir, method = 'minimum')` +#' `shift_baseline(ftir, method = 'minimum')` #' * To shift baseline based on the value at the single lowest point of absorbance #' (or highest point of transmittance) in a given range -#' `recalculate_baseline(ftir, wavenumber_range = c([numeric], [numeric]), +#' `shift_baseline(ftir, wavenumber_range = c([numeric], [numeric]), #' method = 'minimum')` #' #' To perform the exact same baseline adjustment on all samples, specify @@ -338,21 +338,21 @@ subtract_scalar_value <- function(ftir, value, sample_ids = NA) { #' sous-ensemble, en utilisant le même décalage pour tous les échantillons #' ajustés ou calculés individuellement. #' -#' Le recalcul ou le décalage de la ligne de base/transmittance maximale peut +#' Le décalage de la ligne de base/transmittance maximale peut #' être effectué en suivant l'une des méthodes suivantes : #' * Pour décaler la ligne de base en fonction de la valeur à un nombre d'ondes donné : -#' `recalculate_baseline(ftir, wavenumber_range = [numeric], method = +#' `shift_baseline(ftir, wavenumber_range = [numeric], method = #' 'point')` #' * Pour décaler la ligne de base en fonction de la valeur moyenne sur un nombre -#' d'ondes donné : #' `recalculate_baseline(ftir) = [numerique], method = 'point') -#' `recalculate_baseline(ftir, wavenumber_range = c([numeric], [numeric]), +#' d'ondes donné : #' `shift_baseline(ftir) = [numerique], method = 'point') +#' `shift_baseline(ftir, wavenumber_range = c([numeric], [numeric]), #' method = 'average')` #' * Pour décaler la ligne de base en fonction de la valeur du point d'absorbance #' le plus bas (ou du point de transmittance le plus élevé) sur l'ensemble des spectres. -#' `recalculate_baseline(ftir, method = 'minimum')` +#' `shift_baseline(ftir, method = 'minimum')` #' * Décaler la ligne de base en fonction de la valeur du point d'absorbance le #' plus bas (ou du point de transmittance le plus élevé) dans une gamme donnée. -#' `recalculate_baseline(ftir, wavenumber_range = c([numeric], [numeric]), +#' `shift_baseline(ftir, wavenumber_range = c([numeric], [numeric]), #' method = 'minimum')` #' #' Pour effectuer exactement le même ajustement de la ligne de base sur tous @@ -360,16 +360,16 @@ subtract_scalar_value <- function(ftir, value, sample_ids = NA) { #' détermination unique pour chaque échantillon, spécifiez `individualy = #' TRUE`. #' @param ftir A data.frame of FTIR spectral data including spectra to be -#' baseline adjusted. +#' baseline shifted #' #' Un data.frame de données spectrales IRTF comprenant les spectres à ajuster #' à la ligne de base. #' -#' @param sample_ids A vector of sample IDs to be adjusted. All sample IDs must +#' @param sample_ids A vector of sample IDs to be shifted. All sample IDs must #' be present in the `ftir` data.frame. If adjusting all spectra, provide NA #' or NULL. Unlisted `sample_id` from `ftir` will be left alone. #' -#' Un vecteur d'ID d'échantillons à ajuster Tous les ID d'échantillons doivent +#' Un vecteur d'ID d'échantillons à ajuster. Tous les ID d'échantillons doivent #' être présents dans la base de données `ftir` data.frame. Si l'ajustement #' concerne tous les spectres, fournir NA ou NULL. Les `sample_id` non listés #' de `ftir` seront laissés seuls. @@ -408,8 +408,8 @@ subtract_scalar_value <- function(ftir, value, sample_ids = NA) { #' #' @examples #' # Adjust the biodiesel spectra to minimum for each sample -#' recalculate_baseline(biodiesel, method = "minimum", individually = TRUE) -recalculate_baseline <- function( +#' shift_baseline(biodiesel, method = "minimum", individually = TRUE) +shift_baseline <- function( ftir, sample_ids = NA, wavenumber_range = NA, @@ -427,26 +427,26 @@ recalculate_baseline <- function( if (any(!(sample_ids %in% unique(ftir$sample_id)))) { mismatch <- sample_ids[!(sample_ids %in% unique(ftir$sample_id))] cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. All provided {.arg sample_ids} must be in {.arg ftir} data.", + "Error in {.fn PlotFTIR::shift_baseline}. All provided {.arg sample_ids} must be in {.arg ftir} data.", x = "The following {.arg sample_id{?s}} are not present: {.val {mismatch}}." )) } if (length(wavenumber_range) < 1 || length(wavenumber_range) > 2) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg wavenumber_range} must be of length 1 or 2." + "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be of length 1 or 2." )) } if (!(all(is.na(wavenumber_range)) || all(is.numeric(wavenumber_range)))) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg wavenumber_range} must be {.code numeric} or {.code NA}.", + "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be {.code numeric} or {.code NA}.", x = "You provided a {.obj_type_friendly wavenumber_range}." )) } if (!is.logical(individually)) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg individually} must be a boolean value.", + "Error in {.fn PlotFTIR::shift_baseline}. {.arg individually} must be a boolean value.", x = "You provided a {.obj_type_friendly individually}." )) } @@ -454,14 +454,14 @@ recalculate_baseline <- function( permitted_methods <- c("point", "average", "minimum", "maximum") if (length(method) != 1 || !(method %in% permitted_methods)) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg method} must be a string.", + "Error in {.fn PlotFTIR::shift_baseline}. {.arg method} must be a string.", i = "{.arg method} must be one of {.val {permitted_methods}}." )) } if (method == "point" && length(wavenumber_range) == 2) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg wavenumber_range} must be one numeric value if {.code method = 'point'}.", + "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be one numeric value if {.code method = 'point'}.", i = "The value at the provided wavenumber will be used to baseline adjust data." )) } @@ -471,7 +471,7 @@ recalculate_baseline <- function( all(length(wavenumber_range) == 1, !is.na(wavenumber_range)) ) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg wavenumber_range} must be {.code NA} or two numeric values if {.code method = '{method}'}.", + "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be {.code NA} or two numeric values if {.code method = '{method}'}.", i = "The minimum (for absorbance spectra) or maximum (for transmittance spectra) value between the provided wavenumbers will be used to baseline adjust data.", i = "To adjust by a single point, call the function with {.code method = 'point'}" )) @@ -480,7 +480,7 @@ recalculate_baseline <- function( if (method == "point") { if (length(wavenumber_range) != 1 || is.na(wavenumber_range)) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg wavenumber_range} must be a single numeric value.", + "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be a single numeric value.", i = "The value at the provided wavenumber will be used to baseline adjust data." )) } @@ -494,7 +494,7 @@ recalculate_baseline <- function( max(ftir[ftir$sample_id == sample_ids[i], ]$wavenumber) ) { cli::cli_warn(c( - "Warning in {.fn PlotFTIR::recalculate_baseline}. Provided wavenumber is not within spectral range.", + "Warning in {.fn PlotFTIR::shift_baseline}. Provided wavenumber is not within spectral range.", i = "Using {round(ftir[ftir$sample_id == sample_ids[i],]$wavenumber[which(abs(wavenumber_range - ftir[ftir$sample_id == sample_ids[i],]$wavenumber) == min(abs(wavenumber_range - ftir[ftir$sample_id == sample_ids[i],]$wavenumber)))], 0)} cm-1 instead of provided {round(wavenumber_range, 0)} cm-1." )) } else if ( @@ -505,7 +505,7 @@ recalculate_baseline <- function( 10 ) { cli::cli_warn(c( - "Warning in {.fn PlotFTIR::recalculate_baseline}. No wavenumber values in spectra within 10 cm-1 of supplied point.", + "Warning in {.fn PlotFTIR::shift_baseline}. No wavenumber values in spectra within 10 cm-1 of supplied point.", i = "Using {round(ftir[ftir$sample_id == sample_ids[i],]$wavenumber[which(abs(wavenumber_range - ftir[ftir$sample_id == sample_ids[i],]$wavenumber) == min(abs(wavenumber_range - ftir[ftir$sample_id == sample_ids[i],]$wavenumber)))], 0)} cm-1 instead of provided {round(wavenumber_range, 0)} cm-1." )) } @@ -593,7 +593,7 @@ recalculate_baseline <- function( ) } else if (length(wavenumber_range) != 2) { cli::cli_abort(c( - "Error in {.fn PlotFTIR::recalculate_baseline}. {.arg wavenumber_range} must be two numeric values.", + "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be two numeric values.", i = "The average value between the provided wavenumbers will be used to baseline adjust data." )) } @@ -754,7 +754,7 @@ recalculate_baseline <- function( #' normalisant dans une région de nombre d'ondes. Cette fonction ne fonctionne #' pas sur les données de transmittance, elle renverra une erreur. #' -#' @inherit recalculate_baseline params return +#' @inherit shift_baseline params return #' @export #' @examples #' # Normalize all samples in `biodiesel` @@ -948,3 +948,370 @@ transmittance_to_absorbance <- function(ftir) { return(ftir) } + + +#' Smooth FTIR with Savitzky-Golay filter +#' +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance`. The `absorbance` column may be +#' replaced by a `transmittance` column for transmittance plots. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance`. La colonne `absorbance` peut +#' être remplacée par une colonne `transmittance` pour les tracés de +#' transmittance. +#' @param polynomial Savitzky-Golay polynomial term. +#' +#' Terme polynomial de Savitzky-Golay. +#' @param points Savitzky-Golay points term. +#' +#' Terme de points de Savitzky-Golay +#' @param derivative Which derivative to return (default = 0 to smooth spectrum, +#' but can alos determine smoothed derivatives) +#' +#' Dérivée à retourner (par défaut = 0 pour lisser le spectre, mais on peut +#' aussi déterminer des dérivées lissées) +#' +#' @return a data.frame with an FTIR spectrum, smoothed (or the derivative) +#' +#' un data.frame avec un FTIR lissé, lissé (ou la dérivée lissée) +#' @export +#' +#' @seealso [signal::sgolayfilt()] +#' +#' @references +#' * Savitzky, A.; Golay, M.J.E. (1964). "Smoothing and Differentiation of Data by Simplified Least Squares Procedures". Analytical Chemistry 36. pp. 1627–1639. doi:10.1021/ac60214a047 +#' @examples +#' # Load the isopropanol sample spectrum +#' ftir_data <- sample_spectra[ +#' sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Apply smoothing +#' ftir_smoothed <- smooth_ftir(ftir_data) + +#' # --- Optional: Visualize the results --- +#' \dontrun{ +#' plot_ftir(ftir_smoothed, plot_title = "Smoothed FTIR") +#' } +smooth_ftir <- function(ftir, polynomial = 2, points = 13, derivative = 0) { + if (!is.null(attr(ftir, "treatment"))) { + if (grepl("smoothed", attr(ftir, "treatment"))) { + cli::cli_warn(c( + "Warning in {.fn PlotFTIR::smooth_ftir}: Spectra have been previously smoothed.", + i = "Repeat smoothing of spectra may eliminate small or shoulder peaks." + )) + } else { + attr(ftir, "treatment") <- paste(attr(ftir, "treatment"), "smoothed") + } + } else { + attr(ftir, "treatment") <- "smoothed" + } + + ftir <- check_ftir_data(ftir) + + for (i in seq_along(unique(ftir$sample_id))) { + s <- unique(ftir$sample_id)[i] + if ("absorbance" %in% colnames(ftir)) { + intensity <- ftir[ftir$sample_id == s, ]$absorbance + } else { + intensity <- ftir[ftir$sample_id == s, ]$transmittance + } + + smoothed_spectra <- signal::sgolayfilt( + intensity, + p = polynomial, + n = points, + m = derivative + ) + + if ("absorbance" %in% colnames(ftir)) { + ftir[ftir$sample_id == s, ]$absorbance <- smoothed_spectra + } else { + ftir[ftir$sample_id == s, ]$transmittance <- smoothed_spectra + } + } + + return(ftir) +} + + +#' Baseline FTIR +#' +#' @description Correct the baseline of an FTIR spectrum using one of the +#' techniques available in the [baseline::baseline()] package. +#' +#' Corrigez la ligne de base d'un spectre IRTF en utilisant l'une des techniques +#' disponibles dans le package [baseline::baseline()]. +#' +#' @param ftir A data.frame in long format with columns `sample_id`, +#' `wavenumber`, and `absorbance`. The `absorbance` column may be replaced by +#' a `transmittance` column for transmittance plots. +#' +#' Un data.frame au format long avec les colonnes `sample_id`, `wavenumber`, +#' et `absorbance`. La colonne `absorbance` peut être remplacée par une +#' colonne `transmittance` pour les tracés de transmission. +#' @param method A method from [baseline::baseline()]. For FTIR data, best +#' results are achieved by selecting either `modpolyfit`, `peakDetection` or +#' `rfbaseline`. +#' +#' Une méthode de [baseline::baseline()]. Pour les données IRTF, les meilleurs +#' résultats sont obtenus en sélectionnant soit `modpolyfit`, soit +#' `peakDetection`, soit `rfbaseline`. +#' @param ... Additional parameters required by specific methods in +#' [baseline::baseline()]. +#' +#' Paramètres supplémentaires requis par certaines méthodes de +#' [baseline::baseline()]. +#' +#' @return A FTIR spectral data.frame with baseline corrected intensity column. +#' +#' Un data.frame contenant le spectre IRTF corrigé de la ligne de base +#' +#' @export +#' +#' @seealso [baseline::baseline()] +#' +#' @references +#' * Kristian Hovde Liland, Trygve Almøy, Bjørn-Helge Mevik (2010) Optimal Choice of Baseline Correction for Multivariate Calibration of Spectra, Applied Spectroscopy 64, pp. 1007-1016. doi:10.1366/000370210792434350 +#' * Chad A. Lieber and Anita Mahadevan-Jansen (2003) Automated Method for Subtraction of Fluorescence from Biological Raman Spectra, Applied Spectroscopy 57, pp. 1363-1367. doi:10.1366/000370203322554518 +#' * Kevin R. Coombes et al. (2003) Quality control and peak finding for proteomics data collected from nipple aspirate fluid by surface-enhanced laser desorption and ionization. Clinical Chemistry 49, pp. 1615-1623. doi:10.1373/49.10.1615 +#' * Andreas F. Ruckstuhl, Matthew P. Jacobson, Robert W. Field, James A. Dodd (2001) Baseline subtraction using robust local regression estimation. Journal of Quantitative Spectroscopy and Radiative Transfer 68, pp.. 179-193. doi:10.1016/S0022-4073(00)00021-2 +#' * Xianchun Shen et al. (2018) Applied Optics 57 pp. 5794-5799 doi:10.1364/AO.57.0057947 +#' @examples +#' # Load the isopropanol sample spectrum +#' ftir_data <- sample_spectra[ +#' sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Apply baseline correction using the default 'modpolyfit' method +#' ftir_baselined_modpoly <- baseline_ftir(ftir_data) +#' +#' # Apply baseline correction using the 'lowpass' method +#' ftir_baselined_lowpass <- baseline_ftir(ftir_data, method = "lowpass") +#' +#' # --- Optional: Visualize the results --- +#' \dontrun{ +#' plot_ftir(ftir_baselined_modpoly, plot_title = "ModPoly Baselined FTIR") +#' +#' plot_ftir(ftir_baselined_lowpass, plot_title = "Lowpass Baselined FTIR") +#' } +baseline_ftir <- function(ftir, method = "modpolyfit", ...) { + if ( + !(method %in% + c( + "als", + "fillPeaks", + "irls", + "lowpass", + "medianWindow", + "modpolyfit", + "peakDetection", + "rfbaseline", + "rollingBall", + "shirley", + "TAP" + )) + ) { + cli::cli_abort( + "Error in {.pkg PlotFTIR::baseline_ftir}: {.arg method} should be one of which the {.pkg baseline} is capable of performing." + ) + } + + if (method %in% c("TAP", "shirley", "rollingBall")) { + cli::cli_warn( + "Method {.code {method}} was not designed for use with FTIR data." + ) + } + + ftir <- check_ftir_data(ftir) + + if (!is.null(attr(ftir, "treatment"))) { + if (grepl("baselined", attr(ftir, "treatment"))) { + cli::cli_warn(c( + "Warning in {.fn PlotFTIR::baseline_ftir}: Spectra have been previously baselined.", + i = "Repeat baseline adjustment of spectra may produce unexpected results." + )) + } else { + attr(ftir, "treatment") <- paste(attr(ftir, "treatment"), "baselined") + } + } else { + attr(ftir, "treatment") <- "baselined" + } + + for (i in seq_along(unique(ftir$sample_id))) { + s <- unique(ftir$sample_id)[i] + + if ("absorbance" %in% colnames(ftir)) { + intensity <- ftir[ftir$sample_id == s, ]$absorbance + } else { + cli::cli_alert_danger( + "Note from {.fn PlotFTIR::baseline_ftir}: Baselining with transmittance spectra may not behave as expected." + ) + intensity <- ftir[ftir$sample_id == s, ]$transmittance + } + + baselined_spectra <- baseline::baseline( + matrix(intensity, ncol = length(intensity)), + method = method, + ... = ... + ) + corrected <- as.vector(baseline::getCorrected(baselined_spectra)) + + if ("absorbance" %in% colnames(ftir)) { + ftir[ftir$sample_id == s, ]$absorbance <- corrected + } else { + ftir[ftir$sample_id == s, ]$transmittance <- corrected + } + } + return(ftir) +} + + +# Function(s) for dealing with reflectance in absorbance spectra - continuum removal +# * Clark, R.N. and Roush, T.L. (1984) J. Geophysical Res. 89 pp 6329-6340 + +# Cubic Spline continuum is recommended, "although straight-line segments would produce nearly the same result in this case" +# ToDo: test cubic vs hermite. +# Should be done as division in reflectance spectra, or as subtraction for absorbtive spectra + +#' Remove Continuum from FTIR Spectra +#' +#' @description This function removes the continuum from FTIR spectra using +#' either spline or linear interpolation. The continuum is defined as the +#' convex hull of the spectrum, and is either subtracted or divided from the +#' original spectrum. This is a common preprocessing step in reflectance +#' spectroscopy to highlight absorption features. +#' +#' Cette fonction supprime le continuum des spectres IRTF en utilisant une +#' interpolation spline ou linéaire. Le continuum est défini comme l'enveloppe +#' convexe du spectre, et est soit soustrait, soit divisé du spectre original. +#' Il s'agit d'une étape de prétraitement courante en spectroscopie de +#' réflectance pour mettre en évidence les caractéristiques d'absorption. +#' +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance` or `transmittance`. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance` ou `transmittance`. +#' @param type The type of interpolation to use for the continuum. Options are +#' `spline` (default) or `linear`. +#' +#' Le type d'interpolation à utiliser pour le continuum. Les options sont +#' `spline` (par défaut) ou `linear`. +#' @param application How to apply the continuum to the spectra. Options are +#' `subtraction` (default) or `division`. +#' +#' Comment appliquer le continuum aux spectres. Les options sont `subtraction` +#' (par défaut) ou `division`. +#' @param ... Additional arguments (currently unused). +#' +#' Arguments supplémentaires (actuellement inutilisés). +#' +#' @return A data.frame with the continuum removed from the spectra. The +#' `absorbance` or `transmittance` column will be modified. +#' +#' Un data.frame avec le continuum supprimé des spectres. La colonne +#' `absorbance` ou `transmittance` sera modifiée. +#' +#' @export +#' +#' @references Clark, R.N. and Roush, T.L. (1984) J. Geophysical Res. 89 pp +#' 6329-6340 +#' +#' @examples +#' # Load the isopropanol sample spectrum +#' ftir_data <- sample_spectra[ +#' sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Remove the continuum using spline interpolation and subtraction +#' ftir_no_continuum <- remove_continuum_ftir(ftir_data) +#' +#' # Remove the continuum using linear interpolation and division +#' ftir_no_continuum_linear_div <- remove_continuum_ftir( +#' ftir_data, +#' type = "linear", +#' application = "division" +#' ) +remove_continuum_ftir <- function( + ftir, + type = "spline", + application = "subtraction", + ... +) { + # error checking + ftir <- PlotFTIR::check_ftir_data(ftir) + + if (!(application %in% c("subtraction", "division"))) { + cli::cli_abort( + "Error in {.fn PlotFTIR::remove_continuum_ftir}: {.arg application} must be either {.val subtraction} or {.val division}." + ) + } + + if (!(type %in% c("spline", "linear"))) { + cli::cli_abort( + "Error in {.fn PlotFTIR::remove_continuum_ftir}: {.arg type} must be either {.val spline} or {.val linear}." + ) + } + + if (!is.null(attr(ftir, "treatment"))) { + if (grepl("continuum removed", attr(ftir, "treatment"))) { + cli::cli_warn(c( + "Warning in {.fn PlotFTIR::remove_continuum_ftir}: Spectra have previously had continuum removed.", + i = "Repeat continuum removal of spectra may produce unexpected results." + )) + } else { + attr(ftir, "treatment") <- paste( + attr(ftir, "treatment"), + "continuum removed" + ) + } + } else { + attr(ftir, "treatment") <- "continuum removed" + } + + # needs to be ordered for rubberbanding + ftir <- ftir[order(ftir$wavenumber), ] + x <- ftir$wavenumber + if ("absorbance" %in% colnames(ftir)) { + y <- ftir$absorbance + # invert absorbance for convex hull + y_for_hull <- 1 / y + } else { + y <- ftir$transmittance + y_for_hull <- y + } + + # find convex shape of curve (rubberband) + # add bumpers, build hull, and sort + hull <- sort(grDevices::chull( + c(x[1] - 1, x, x[length(x)] + 1), + c(0, y_for_hull, 0) + )) + #take off the bumpers, subtract by 1 to 'shift everything' back to actual x indexes + hull <- hull[2:(length(hull) - 1)] - 1 + + # Build functions for interpolating + if (type == "spline") { + continuum <- stats::splinefun(x = x[hull], y = y_for_hull[hull])(x) + } else { + # Type is linear + continuum <- stats::approx(x = x[hull], y = y[hull], xout = x)$y + } + + # Apply the continuum to the spectra by subtraction or division + if (application == "subtraction") { + y_corrected <- y - continuum + } else { + y_corrected <- y / continuum + } + + if ("absorbance" %in% colnames(ftir)) { + ftir$absorbance <- 1 / y_corrected + } else { + ftir$transmittance <- y_corrected + } + + return(ftir) +} diff --git a/R/peak-fit.R b/R/peak-fit.R new file mode 100644 index 0000000..b497376 --- /dev/null +++ b/R/peak-fit.R @@ -0,0 +1,2384 @@ +#' Find FTIR Peaks +#' @description This function finds peaks in FTIR spectra by identifying minima +#' of the double derivative, then re-scanning for maxima of peaks missed by +#' the derivative method. This double-check ensures that both sharp peaks +#' (like C-H stretch) and wide gentle peaks (like O-H stretch) are found. The +#' spectra is smoothed by a Savitzky-Golay filter prior to analysis and as +#' such there are a number of optional tuning parameters that can be provided +#' (the defaults work well for typical spectra). +#' +#' Cette fonction permet de trouver des pics dans les spectres IRTF en +#' identifiant les minima de la double dérivée, puis en recherchant à nouveau +#' les maxima des pics manqués par la méthode de la dérivée. Cette double +#' vérification permet de s'assurer que les pics aigus (comme l'étirement C-H) +#' et les pics larges et doux (comme l'étirement O-H) sont trouvés. Le spectre +#' est lissé par un filtre de Savitzky-Golay avant l'analyse et, à ce titre, +#' un certain nombre de paramètres de réglage facultatifs peuvent être fournis +#' (les valeurs par défaut fonctionnent bien pour les spectres typiques). +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance`. The `absorbance` column may be +#' replaced by a `transmittance` column for transmittance plots. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance`. La colonne `absorbance` peut +#' être remplacée par une colonne `transmittance` pour les tracés de +#' transmittance. +#' @param ... Additional optional parameters to pass to peak finding algorithm. +#' * `sg_p_norm` The polynomial degree used in smoothing the spectra for finding peaks by signal maxima. Default `3`. +#' * `sg_p_deriv` The polynomial degree used in smoothing the derivative for finding peaks by minima. Default `3`. +#' * `sg_n_norm` The number of points used in smoothing the spectra for finding peaks by signal maxima. Default `13`. +#' * `sg_n_deriv` The number of points used in smoothing the derivative for finding peaks by minima. Default `13`. +#' * `window_norm` The width of the window (in wavenumbers) to ensure that a peak is a true maxima and not just noise. Default `10`. Works best on data with consistent resolution, and will round up to the next data point. +#' * `window_deriv` The width of the window (in wavenumbers) to ensure that a derivative minima is a true minima and not just noise. Default `5`. Works best on data with consistent resolution, and will round up to the next data point. +#' * `window_align` The width of the window (in wavenumbers) whereby derivative and normal peaks are compared. Normal peaks are added to the derivative peak list if they are outside of the window distance of any other peak +#' * `zero_norm` Spectra have baseline noise removed before searching for peaks by setting signal value below the zero threshold to 0. Default `1e-2`. +#' * `zero_deriv`Derivative have baseline noise removed before searching for peaks by setting values below the zero threshold to 0. Default `1e-4`. +#' +#' +#' Paramètres optionnels supplémentaires à transmettre à l'algorithme de +#' recherche de pics. #' * `sg_p_norm` Le degré polynomial utilisé pour lisser +#' les spectres afin de trouver les pics par les maxima du signal. Valeur par +#' défaut `3`. +#' * `sg_p_deriv` Le degré polynomial utilisé dans le lissage de la dérivée pour trouver les pics par les minima. Par défaut `3`. +#' * `sg_n_norm` Le nombre de points utilisés pour lisser les spectres afin de trouver les pics par maxima du signal. Valeur par défaut `13`. +#' * `sg_n_deriv` Le nombre de points utilisés dans le lissage de la dérivée pour trouver les pics par minima. Par défaut `13`. +#' * `window_norm` La largeur de la fenêtre (en wavenumbers) pour s'assurer qu'un pic est un vrai maxima et pas seulement du bruit. Valeur par défaut `10`. Fonctionne mieux sur des données avec une résolution cohérente, et arrondit au point de données suivant. +#' * `window_deriv` La largeur de la fenêtre (en wavenumbers) pour s'assurer qu'un minima de dérivée est un vrai minima et pas seulement du bruit. Valeur par défaut `5`. Fonctionne mieux sur des données avec une résolution cohérente, et arrondira au point de données suivant. +#' * `window_align` La largeur de la fenêtre (en wavenumbers) par laquelle les pics dérivés et normaux sont comparés. Les pics normaux sont ajoutés à la liste des pics dérivés s'ils se trouvent à l'extérieur de la distance de la fenêtre de tout autre pic. +#' * `zero_norm` Les spectres sont débarrassés du bruit de base avant de rechercher les pics en fixant à 0 la valeur du signal en dessous du seuil zéro. Valeur par défaut `1e-2`. +#' * `zero_deriv`La dérivée est débarrassée du bruit de base avant la recherche des pics en fixant à 0 les valeurs inférieures au seuil zéro. Valeur par défaut `1e-4`. +#' @return A vector of wavenumbers corresponding to peaks found in the provided +#' FTIR spectra. +#' +#' Un vecteur de nombres d'ondes correspondant aux pics trouvés dans les +#' spectres IRTF fournis. +#' @export +#' @seealso [signal::sgolayfilt()], [smooth_ftir()] +#' @md +#' @references Savitzky, A.; Golay, M.J.E. (1964). "Smoothing and +#' Differentiation of Data by Simplified Least Squares Procedures". Analytical +#' Chemistry 36. pp. 1627–1639. doi:10.1021/ac60214a047 +#' @examples +#' # Load the isopropanol sample spectrum from the PlotFTIR package +#' ftir_data <- PlotFTIR::sample_spectra[ +#' PlotFTIR::sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Find peaks using default settings +#' peaks_default <- find_ftir_peaks(ftir_data) +#' print("Peaks found with default settings:") +#' print(peaks_default) +#' +#' # Find peaks with adjusted smoothing and window parameters +#' # Example: Less smoothing on derivative, wider window for normal peaks +#' peaks_adjusted <- find_ftir_peaks( +#' ftir_data, +#' sg_n_deriv = 11, # Fewer points for derivative smoothing +#' window_norm = 15 # Wider window (wavenumbers) for normal peak check +#' ) +#' print("Peaks found with adjusted settings:") +#' print(peaks_adjusted) +find_ftir_peaks <- function(ftir, ...) { + ftir <- PlotFTIR::check_ftir_data(ftir) + + if (length(unique(ftir$sample_id)) != 1) { + cli::cli_abort( + "Error in {.fn PlotFTIR::find_ftir_peaks}. {.arg ftir} must only contain one sample spectra." + ) + } + + if (!("absorbance" %in% colnames(ftir))) { + # because this just returns a wavenumber list, we can do this transformation + # without angering the user + ftir <- PlotFTIR::transmittance_to_absorbance(ftir) + } + + args <- list(...) + # assign from dots + sg_p_norm <- `if`("sg_p_norm" %in% names(args), args$sg_p_norm, 3) + sg_p_deriv <- `if`("sg_p_deriv" %in% names(args), args$sg_p_deriv, 3) + sg_n_norm <- `if`("sg_n_norm" %in% names(args), args$sg_n_norm, 13) + sg_n_deriv <- `if`("sg_n_deriv" %in% names(args), args$sg_n_deriv, 15) + window_norm <- `if`("window_norm" %in% names(args), args$window_norm, 10) + window_deriv <- `if`("window_deriv" %in% names(args), args$window_deriv, 5) + window_align <- `if`("window_align" %in% names(args), args$window_align, 10) + zero_norm <- `if`("zero_norm" %in% names(args), args$zero_norm, 1e-2) + zero_deriv <- `if`("zero_deriv" %in% names(args), args$zero_deriv, 1e-4) + + if (!is.numeric(zero_norm)) { + cli::cli_abort( + "Error in {.fn PlotFTIR::find_ftir_peaks}. {.arg zero_norm} must be numeric." + ) + } + if (!is.numeric(zero_deriv)) { + cli::cli_abort( + "Error in {.fn PlotFTIR::find_ftir_peaks}. {.arg zero_deriv} must be numeric." + ) + } + + sg <- signal::sgolayfilt(ftir$absorbance, p = sg_p_norm, n = sg_n_norm, m = 0) + sg_deriv <- signal::sgolayfilt( + ftir$absorbance, + p = sg_p_deriv, + n = sg_n_deriv, + m = 2 + ) + + if (zero_norm > max(abs(sg), na.rm = TRUE)) { + cli::cli_abort(c( + "Error in {.fn PlotFTIR::find_ftir_peaks}. {.arg zero_norm} is larger than the highest point in the spectra.", + i = "Set {.arg zero_norm} to remove noise, typically around 1e-4." + )) + } + if (zero_deriv > max(abs(sg_deriv), na.rm = TRUE)) { + cli::cli_abort(c( + "Error in {.fn PlotFTIR::find_ftir_peaks}. {.arg zero_deriv} is larger than the highest point in the derivative spectra.", + i = "Set {.arg zero_deriv} to remove noise, typically around 1e-4." + )) + } + + # need resolution to convert windows in wavenumbers to data index units by + # ceiling window/resolution. E.g. window of 10 wavenumber, 4 wavenumber + # resolution -> peaks must be 10/4 = 3 data index apart (i.e. a peak can't be + # at 2000 cm-1 and 2008 cm-1, next option is 2012 cm-1) + resolution <- abs(mean(diff(ftir$wavenumber))) + + deriv_peaks <- ftir$wavenumber[minima( + zero_threshold(sg_deriv, zero_deriv), + ceiling(window_deriv / resolution) + )] + norm_peaks <- ftir$wavenumber[maxima( + zero_threshold(sg, zero_norm), + ceiling(window_norm / resolution) + )] + + all_peaks <- deriv_peaks + for (i in seq_along(norm_peaks)) { + if (sum(abs(all_peaks - norm_peaks[i]) < window_align) == 0) { + all_peaks <- c(all_peaks, norm_peaks[i]) + } + } + + all_peaks <- sort(all_peaks) + + # Gotta check that front and back edges aren't incorrectly IDd as peaks. This + # happened sometimes when the spectra is flat at the edges (because of the + # shape of the derivative) + if (min(all_peaks, na.rm = TRUE) == min(ftir$wavenumber, na.rm = TRUE)) { + last <- ftir[rank(ftir$wavenumber) == 1, "absorbance"] + secondlast <- ftir[rank(ftir$wavenumber) == 1, "absorbance"] + if (last <= secondlast) { + all_peaks <- all_peaks[all_peaks != min(ftir$wavenumber, na.rm = TRUE)] + } + } + + if (max(all_peaks, na.rm = TRUE) == max(ftir$wavenumber, na.rm = TRUE)) { + first <- ftir[ + rank(ftir$wavenumber) == length(ftir$wavenumber), + "absorbance" + ] + second <- ftir[ + rank(ftir$wavenumber) == (length(ftir$wavenumber) - 1), + "absorbance" + ] + if (first <= second) { + all_peaks <- all_peaks[all_peaks != max(ftir$wavenumber, na.rm = TRUE)] + } + } + + return(all_peaks) +} + + +maxima <- function(x, window = 1) { + # in this form, window is COUNTS of values away, not wavenumbers + lenx <- length(x) + x <- c(rep(-Inf, window), x, rep(-Inf, window)) + m <- c() + for (i in seq_along(x)) { + # don't evaluate in filler region + if (i <= window) { + next + } + if (i > (lenx + window)) { + next + } + if ( + max(x[seq(i - window, length.out = window)], na.rm = TRUE) < x[i] && + max(x[seq(i + 1, length.out = window)], na.rm = TRUE) < x[i] + ) { + # x is a maxima + m <- c(m, i - window) + } + } + return(m) +} + + +minima <- function(x, window = 1) { + return(maxima(x = x * -1, window)) +} + + +zero_threshold <- function(x, threshold = 1e-4) { + x[abs(x) < threshold] <- 0 + return(x) +} + + +#' Fit Peaks +#' @description Once peaks are found by [find_ftir_peaks()], they can be fitted +#' by adjusting intensity (area) standard deviation (width), and shape +#' parameters (gam, eta, and/or alpha). This can be done by +#' Expectation-Maximization methods, implemented here by the `EMpeaksR` +#' package's technique. Note that the spectra provided is shifted to baseline +#' to reduce the work of the peak fitter in producing background noise. +#' +#' Une fois les pics trouvés par [find_ftir_peaks()], ils peuvent être ajustés +#' en ajustant l'intensité (surface), l'écart-type (largeur) et les paramètres +#' de forme (gam, eta, et/ou alpha). Ceci peut être fait par des méthodes +#' d'espérance-maximisation, implémentées ici par la technique du paquet +#' `EMpeaksR`. Notez que le spectre fourni est décalé par rapport à la ligne +#' de base afin de réduire le travail de l'ajusteur de pics en produisant un +#' bruit de fond. +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance`. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance`. +#' @param peaklist The locations of peaks from `[find_ftir_peaks()]`. If none +#' provided, will search for peaks using the default parameters of that +#' function. Note that you could provide a common list of peaks for fitting +#' multiple different spectra to compare results between samples. +#' +#' Les emplacements des pics de `[find_ftir_peaks()]`. Si aucune valeur n'est +#' fournie, les pics seront recherchés en utilisant les paramètres par défaut +#' de cette fonction. Notez que vous pouvez fournir une liste commune de pics +#' pour l'ajustement de plusieurs spectres différents afin de comparer les +#' résultats entre les échantillons. +#' @param method The peak style / fitting method. Theoretically FTIR peaks are +#' Lorentzian shaped, but with Gaussian broadening the pseudo-Voigt shape +#' matches best. Some success is seen using Doniach-Šunjić-Gauss peak shapes +#' since these can adopt undetected shoulder peaks in an asymmetric measure +#' for each peak. Options are: +#' * `voigt` (default): Fit Voigt shaped peaks [EMpeaksR::spect_em_pvmm()] +#' * `gauss` Fit Gauss shaped peaks [EMpeaksR::spect_em_gmm()] +#' * `lorentz` Fit Lorentz shaped peaks [EMpeaksR::spect_em_lmm()] +#' * `dsg` Fit Doniach-Šunjić-Gauss shaped peaks [EMpeaksR::spect_em_dsgmm()] +#' +#' Le style des pics / la méthode d'ajustement. En théorie, les pics IRTF ont +#' une forme de Lorentz, mais avec un élargissement Gaussien, c'est la forme +#' pseudo-Voigt qui convient le mieux. Les formes de pics de +#' Doniach-Šunjić-Gauss donnent de bons résultats, car elles permettent +#' d'adopter des pics d'épaulement non détectés dans le cadre d'une mesure +#' asymétrique pour chaque pic. Les options sont les suivantes : +#' * `voigt` (par défaut) : Ajuster les pics en forme de Voigt [EMpeaksR::spect_em_pvmm()] +#' * `gauss` Ajuster les pics en forme de Gauss [EMpeaksR::spect_em_gmm()] +#' * `lorentz` Ajuster les pics en forme de Lorentz [EMpeaksR::spect_em_lmm()] +#' * `dsg` Ajuster les pics en forme de Doniach-Šunjić-Gauss [EMpeaksR::spect_em_dsgmm()] +#' @param fixed_peaks Boolean, whether to fix the peak locations to the provided +#' values or allow the optimizer to move peaks as needed. +#' +#' Booléen, pour savoir s'il faut fixer l'emplacement des pics aux valeurs +#' fournies ou permettre à l'optimiseur de déplacer les pics selon les +#' besoins. +#' @param ... Control parameters for fitting functions (`conv_cri` and/or +#' `maxit`) or additional parameters to pass to [find_ftir_peaks()] if needed. +#' Paramètres de contrôle pour les fonctions d'ajustement (`conv_cri` et/ou +#' `maxit`) ou paramètres supplémentaires à passer à [find_ftir_peaks()] si +#' nécessaire. +#' @return An `EMpeaksR` style fitted model. See the documentation for each peak +#' shape. +#' +#' Un modèle ajusté de type `EMpeaksR`. Voir la documentation pour chaque forme de pic. +#' @export +#' @md +#' @seealso [spect_em_gmm()], [spect_em_lmm()], [spect_em_pvmm()], +#' [spect_em_dsgmm()] +#' @references Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. +#' (2019) "Spectrum adapted expectation-maximization algorithm for +#' high-throughput peak shift analysis". Science and technology of advanced +#' materials, 20(1), pp 733-745. doi:10.1080/14686996.2019.1620123 Matsumura, +#' T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2021) "Spectrum adapted +#' expectation-conditional maximization algorithm for extending high–throughput +#' peak separation method in XPS analysis". Science and Technology of Advanced +#' Materials: Methods, 1(1), pp 45-55. doi:10.1080/27660400.2021.1899449 +#' @examples +#' #' # Load the isopropanol sample spectrum from the PlotFTIR package +#' ftir_data <- PlotFTIR::sample_spectra[ +#' PlotFTIR::sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Choose a subset of the data (reducing run time) +#' ftir_data <- ftir_data[ +#' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +#' ] +#' +#' # Example 1: Fit peaks using the default 'voigt' method +#' # Peaks will be found automatically using find_ftir_peaks defaults +#' fitted_voigt_default <- fit_peaks(ftir_data) +#' print("Fitted Voigt Peaks (Default):") +#' # Show key results like final parameters and convergence status +#' print(fit_peak_df(fitted_voigt_default)) +#' print(paste("Convergence:", fitted_voigt_default$convergence)) +#' +#' \dontrun{ +#' # Example 2: Fit peaks using the 'gauss' method +#' fitted_gauss <- fit_peaks(ftir_data, method = "gauss") +#' print("Fitted Gaussian Peaks:") +#' print(fit_peak_df(fitted_gauss)) +#' +#' # Example 3: Provide a pre-defined list of peaks +#' # First, find some peaks (maybe with custom settings) +#' initial_peaks <- find_ftir_peaks(ftir_data, window_norm = 20) +#' print("Initial peaks found:") +#' print(initial_peaks) +#' # Now fit using this specific list +#' fitted_voigt_custom_peaks <- fit_peaks(ftir_data, peaklist = initial_peaks) +#' print("Fitted Voigt Peaks (Custom Initial List):") +#' print(fit_peak_df(fitted_voigt_custom_peaks)) +#' +#' # Example 4: Fit peaks but keep their locations fixed +#' # Use a smaller subset of peaks for demonstration +#' fixed_peak_locations <- c(1130, 1375, 1460) +#' fitted_voigt_fixed <- fit_peaks( +#' ftir_data, +#' peaklist = fixed_peak_locations, +#' fixed_peaks = TRUE +#' ) +#' print("Fitted Voigt Peaks (Fixed Locations):") +#' print(fit_peak_df(fitted_voigt_fixed)) +#' +#' # Example 5: Pass control parameters (e.g., lower convergence criterion) +#' # Note: This might take longer or behave differently +#' fitted_voigt_tight_conv <- fit_peaks( +#' ftir_data, +#' conv_cri = 1e-4 # Tighter convergence +#' ) +#' print("Fitted Voigt Peaks (Tighter Convergence):") +#' print(paste("Iterations:", fitted_voigt_tight_conv$it)) +#' print(paste("Convergence:", fitted_voigt_tight_conv$convergence)) +#' } +fit_peaks <- function( + ftir, + peaklist = NA, + method = "voigt", + fixed_peaks = FALSE, + ... +) { + PlotFTIR::check_ftir_data(ftir) + + if (!("absorbance" %in% colnames(ftir))) { + cli::cli_abort( + "Error in {.fn PlotFTIR::fit_peaks}. {.arg ftir} must be supplied in absorbance units." + ) + } + + if (length(unique(ftir$sample_id)) != 1) { + cli::cli_abort( + "Error in {.fn PlotFTIR::fit_peaks}. {.arg ftir} must only contain one sample spectra." + ) + } + + if ( + !(tolower(method) %in% + c( + "v", + "pv", + "voigt", + "pseudo-voigt", + "gauss", + "gaussian", + "normal", + "g", + "dsg", + "doniach-\u0161unji\u0107-gauss", + "doniach-sunjic-gauss", + "l", + "lorentz" + )) + ) { + cli::cli_abort( + "Error in {.fn PlotFTIR::fit_peaks}. {.arg method} must be one of {.code voigt}, {.code lorentz}, {.code gauss} or {.code dsg}." + ) + } + + args <- list(...) + + if (all(is.na(peaklist))) { + peaklist <- find_ftir_peaks( + ftir, + ... = args[ + !(names(args) %in% + c("sigma", "mix_ratio", "eta", "gam", "alpha", "maxit", "conv_cri")) + ] + ) + } + n <- length(peaklist) + + # sort out optional args + # `if` documented by Hadley http://adv-r.had.co.nz/Functions.html + conv_cri <- `if`("conv_cri" %in% names(args), args$conv_cri, 1e-2) + maxit <- `if`("maxit" %in% names(args), args$maxit, 1e3) + sigma <- `if`("sigma" %in% names(args), args$sigma, rep(10, n)) + gam <- `if`("gam" %in% names(args), args$gam, rep(10, n)) + mix_ratio <- `if`("mix_ratio" %in% names(args), args$mix_ratio, rep(1 / n, n)) + eta <- `if`("eta" %in% names(args), args$eta, rep(0.5, n)) + alpha <- `if`("alpha" %in% names(args), args$alpha, rep(1e-4, n)) + + # simple baseline the ftir to minimize the work of peaks bringing up the noise. + ftir$absorbance <- ftir$absorbance - min(abs(ftir$absorbance), na.rm = TRUE) + + if (tolower(method) %in% c("g", "gauss", "gaussian", "normal")) { + method <- "gauss" + utils::capture.output( + res <- spect_em_gmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = peaklist, + sigma = sigma, + mix_ratio = mix_ratio, + maxit = maxit, + conv_cri = conv_cri, + fixed_mu = fixed_peaks + ), + file = nullfile() + ) + } else if (tolower(method) %in% c("v", "pv", "voigt", "pseudo-voigt")) { + method <- "voigt" + utils::capture.output( + res <- spect_em_pvmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = peaklist, + sigma = sigma, + eta = eta, + mix_ratio = mix_ratio, + maxit = maxit, + conv_cri = conv_cri, + fixed_mu = fixed_peaks + ), + file = nullfile() + ) + } else if (tolower(method) %in% c("l", "lorentz")) { + method <- "lorentz" + utils::capture.output( + res <- spect_em_lmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = peaklist, + gam = gam, + mix_ratio = mix_ratio, + maxit = maxit, + conv_cri = conv_cri, + fixed_mu = fixed_peaks + ), + file = nullfile() + ) + } else { + method <- "doniach-\u0161unji\u0107-gauss" + + utils::capture.output( + res <- spect_em_dsgmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = peaklist, + sigma = sigma, + alpha = alpha, + eta = eta, + mix_ratio = mix_ratio, + maxit = maxit, + conv_cri = conv_cri, + fixed_mu = fixed_peaks + ), + file = nullfile() + ) + } + res$method <- method + res$sample_id <- unique(ftir$sample_id) + res$fixed_peaks <- fixed_peaks + + return(res) +} + + +#' Fitted Peaks Data.Frame +#' @description Reformat the [fit_peaks()] object to a data.frame of peak +#' specifications. +#' +#' Reformater l'objet [fit_peaks()] en un data.frame de spécifications de pics. +#' @param fitted_peaks An object from [fit_peaks()]. +#' +#' Un objet de [fit_peaks()]. +#' @returns A data.frame of peak properties. +#' +#' Un data.frame des propriétés des pics. +#' @export +#' @examples +#' # Load the isopropanol sample spectrum from the PlotFTIR package +#' ftir_data <- PlotFTIR::sample_spectra[ +#' PlotFTIR::sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Choose a subset of the data (reducing run time) +#' ftir_data <- ftir_data[ +#' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +#' ] +#' +#' # First, fit the peaks (using the default 'voigt' method) +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' +#' # Now, convert the fitted model object to a data frame +#' peak_df_voigt <- fit_peak_df(fitted_voigt) +#' +#' print("Peak Data Frame from Voigt Fit:") +#' print(peak_df_voigt) +fit_peak_df <- function(fitted_peaks) { + peak_table <- data.frame( + "sample_id" = fitted_peaks$sample_id, + "peak" = seq_along(fitted_peaks$mu), + "wavenumber" = fitted_peaks$mu + ) + + if ("sigma" %in% names(fitted_peaks)) { + peak_table$sigma <- fitted_peaks$sigma + } + if ("gam" %in% names(fitted_peaks)) { + peak_table$gam <- fitted_peaks$gam + } + if ("eta" %in% names(fitted_peaks)) { + peak_table$eta <- fitted_peaks$eta + } + if ("alpha" %in% names(fitted_peaks)) { + peak_table$alpha <- fitted_peaks$alpha + } + peak_table$mix_ratio <- fitted_peaks$mix_ratio + peak_table$peak_shape <- fitted_peaks$method + + peak_table <- peak_table[order(peak_table$wavenumber), ] + + return(peak_table) +} + + +#' Get Fit Method +#' +#' @description Determine the types of peaks used to create the [fit_peaks()] +#' object. +#' +#' Déterminez les types de pics utilisés pour créer l'objet [fit_peaks()]. +#' +#' @param fitted_peaks An object from [fit_peaks()]. +#' +#' Un objet de [fit_peaks()]. +#' +#' @return A character value for the peak type fitted to the spectra. +#' +#' Une valeur de caractère pour le type de pic ajusté aux spectres. +#' @keywords internal +get_fit_method <- function(fitted_peaks) { + if (!("method" %in% names(fitted_peaks))) { + cli::cli_warn( + "Warning in {.fn PlotFTIR::get_fit_method}. {.arg fitted_peaks} should be generated with {.fn PlotFTIR::fit_peaks}." + ) + if ("alpha" %in% names(fitted_peaks)) { + method <- "doniach-\u0161unji\u0107-gauss" + } else if ("gam" %in% names(fitted_peaks)) { + method <- "lorentz" + } else if ("eta" %in% names(fitted_peaks)) { + method <- "voigt" + } else { + method <- "gauss" + } + } else { + method <- fitted_peaks$method + } + return(method) +} + + +#' Get Fit Spectra +#' +#' @description Given a fitted peak object and the FTIR source of the fit, +#' produce a resultant `absorbance` column. Typically used to plot fitted +#' peaks or calculate residuals. +#' +#' Étant donné un objet pic IRTF ajusté et la source IRTF de l'ajustement, +#' produire une colonne `absorbance` résultante. Généralement utilisé pour +#' tracer les pics ajustés ou calculer les résidus. +#' +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance`. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance`. +#' @param fitted_peaks An object from [fit_peaks()]. Should match the provided +#' sample in `ftir`. +#' +#' Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans +#' `ftir`. +#' @param peak A peak index if getting single peak spectra, else returns the sum +#' of all fitted peaks. +#' +#' Un index des pics si l'on obtient des spectres à un seul pic, sinon la +#' somme de tous les pics ajustés est renvoyée. +#' +#' @return The calculated absorbance intensities as numeric vector of the same +#' length as the FTIR spectra. +#' +#' Les intensités d'absorption calculées sous forme de tableau numérique de +#' même longueur que les spectres IRTF. +#' @keywords internal +#' @references Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. +#' (2019) "Spectrum adapted expectation-maximization algorithm for +#' high-throughput peak shift analysis". Science and technology of advanced +#' materials, 20(1), pp 733-745. doi:10.1080/14686996.2019.1620123 Matsumura, +#' T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2021) "Spectrum adapted +#' expectation-conditional maximization algorithm for extending high–throughput +#' peak separation method in XPS analysis". Science and Technology of Advanced +#' Materials: Methods, 1(1), pp 45-55. doi:10.1080/27660400.2021.1899449 +get_fit_spectra <- function(ftir, fitted_peaks, peak = NULL) { + PlotFTIR::check_ftir_data(ftir) + method <- get_fit_method(fitted_peaks) + if (!is.null(peak)) { + if (!is.numeric(peak)) { + cli::cli_abort( + "Error in PlotFTIR:::get_fit_spectra: requested peak must be an integer value. You provided {.obj_type_friendly {peak}}." + ) + } else if (peak %% 1 != 0) { + cli::cli_abort( + "Error in PlotFTIR:::get_fit_spectra: requested peak must be an integer value. You provided something with decimals." + ) + } + if (peak > length(fitted_peaks$mu) || peak < 1) { + cli::cli_abort( + "Error in PlotFTIR:::get_fit_spectra: requested peak {.val {peak}} is out of range, only {{length(fitted_peaks$mu}} peaks are fitted." + ) + } + } + + if (method == "gauss") { + y <- Reduce( + "+", + lapply( + seq_along(fitted_peaks$mu), + FUN = function(x) { + fitted_peaks$mix_ratio[x] * + truncated_g( + ftir$wavenumber, + mu = fitted_peaks$mu[x], + sigma = fitted_peaks$sigma[x] + ) + } + ) + ) + } else if (method == "voigt") { + y <- Reduce( + "+", + lapply( + seq_along(fitted_peaks$mu), + FUN = function(x) { + fitted_peaks$mix_ratio[x] * + truncated_pv( + ftir$wavenumber, + mu = fitted_peaks$mu[x], + sigma = fitted_peaks$sigma[x], + eta = fitted_peaks$eta[x] + ) + } + ) + ) + } else if (method == "lorentz") { + y <- Reduce( + "+", + lapply( + seq_along(fitted_peaks$mu), + FUN = function(x) { + fitted_peaks$mix_ratio[x] * + truncated_l( + ftir$wavenumber, + mu = fitted_peaks$mu[x], + gam = fitted_peaks$gam[x] + ) + } + ) + ) + } else { + y <- Reduce( + "+", + lapply( + seq_along(fitted_peaks$mu), + FUN = function(x) { + fitted_peaks$mix_ratio[x] * + truncated_dsg( + ftir$wavenumber, + mu = fitted_peaks$mu[x], + sigma = fitted_peaks$sigma[x], + alpha = fitted_peaks$alpha[x], + eta = fitted_peaks$eta[x] + ) + } + ) + ) + } + + scale_factor <- (1 / max(y, na.rm = TRUE)) * + max(ftir$absorbance, na.rm = TRUE) + + if (is.null(peak)) { + return(y * scale_factor) + } + + # we need to only produce a single peak. We did all of the fitting math to + # determine the scale factor, but now recalculate the peak of interest. + if (method == "gauss") { + y <- fitted_peaks$mix_ratio[peak] * + truncated_g( + ftir$wavenumber, + mu = fitted_peaks$mu[peak], + sigma = fitted_peaks$sigma[peak] + ) + } else if (method == "voigt") { + y <- fitted_peaks$mix_ratio[peak] * + truncated_pv( + ftir$wavenumber, + mu = fitted_peaks$mu[peak], + sigma = fitted_peaks$sigma[peak], + eta = fitted_peaks$eta[peak] + ) + } else if (method == "lorentz") { + y <- fitted_peaks$mix_ratio[peak] * + truncated_l( + ftir$wavenumber, + mu = fitted_peaks$mu[peak], + gam = fitted_peaks$gam[peak] + ) + } else { + y <- fitted_peaks$mix_ratio[peak] * + truncated_dsg( + ftir$wavenumber, + mu = fitted_peaks$mu[peak], + sigma = fitted_peaks$sigma[peak], + alpha = fitted_peaks$alpha[peak], + eta = fitted_peaks$eta[peak] + ) + } + return(y * scale_factor) +} + + +# peak_fit_plots + +#' Plot Components +#' @description Produces a plot of components of the peak fitting results. +#' +#' Produit un graphique des composantes des résultats de l'ajustement des +#' pics. +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance`. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance`. +#' @param fitted_peaks An object from [fit_peaks()]. Should match the provided +#' sample in `ftir`. +#' +#' Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans +#' `ftir`. +#' @param plot_fit Boolean, whether to plot the peak fit (default FALSE) +#' +#' Booléen, pour savoir s'il faut tracer l'ajustement du pic (par défaut +#' FALSE) +#' @param lang An optional argument for language. If set to one of `fr`, +#' `french`, `francais`, or `français` the axis and default plot and legend +#' titles will change to french. If non-default legend or plot titles are +#' provided they are used as-is. You can also provide `en`, `english` or +#' `anglais`, or (the default) `NA` will use the default language from user +#' options. To set a permanent default, set `options("PlotFTIR.lang" = "en")` +#' or `options("PlotFTIR.lang" = "fr")` for English or French, respectively. +#' +#' Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`, +#' ou `Français`, l'axe et les titres par défaut de le tracé et du légende +#' seront en français. Si des titres du légende ou de tracé autres que ceux +#' par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi +#' fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le +#' langue par défaut des options de l'utilisateur. Pour définir une valeur +#' par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou +#' `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français, +#' respectivement. +#' @param ... optional argument `fitted_sample_name` for naming the fitted peaks +#' on the plot, or extra parameters to pass to [PlotFTIR::plot_ftir()]. +#' +#' Argument optionnel `fitted_sample_name` pour nommer les pics ajustés sur le +#' graphique, ou des paramètres supplémentaires à passer à +#' [PlotFTIR::plot_ftir()]. +#' @returns A [PlotFTIR] graphic with residuals plotted against wavenumber +#' +#' Un graphique [PlotFTIR] avec les résidus tracés en fonction du nombre d'ondes +#' @export +#' @examples +#' # Load the isopropanol sample spectrum from the PlotFTIR package +#' ftir_data <- PlotFTIR::sample_spectra[ +#' PlotFTIR::sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' #' # Choose a subset of the data (reducing run time) +#' ftir_data <- ftir_data[ +#' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +#' ] +#' +#' # First, fit the peaks using the default 'voigt' method +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' +#' # --- Example 1: Plot components only (default) --- +#' \dontrun{ +#' plot_components(ftir_data, fitted_voigt) +#' } +#' +#' # --- Example 2: Plot components AND the overall fitted sum --- +#' \dontrun{ +#' plot_components(ftir_data, fitted_voigt, plot_fit = TRUE) +#' } +#' +#' # --- Example 3: Plot components and fit with custom titles and name --- +#' \dontrun{ +#' plot_components( +#' ftir_data, +#' fitted_voigt, +#' plot_fit = TRUE, +#' plot_title = c("Isopropanol Peak Fit", "Voigt Components"), +#' legend_title = "Spectrum Type", +#' fitted_sample_name = "Total Fit (Voigt)" +#' ) +#' } +#' +#' # --- Example 4: Plot components in French --- +#' \dontrun{ +#' plot_components(ftir_data, fitted_voigt, plot_fit = TRUE, lang = "fr") +#' } +plot_components <- function( + ftir, + fitted_peaks, + plot_fit = FALSE, + lang = NA, + ... +) { + PlotFTIR::check_ftir_data(ftir) + if (!("absorbance" %in% colnames(ftir))) { + cli::cli_abort( + "Error in {.fn FTIRtools::plot_components}. {.arg ftir} must be supplied in absorbance units." + ) + } + if (length(unique(ftir$sample_id)) != 1) { + cli::cli_abort( + "Error in {.fn FTIRtools::plot_components}. {.arg ftir} must only contain one sample spectra." + ) + } + + lang <- process_language(lang) + + # simple baseline the ftir to minimize the work of peaks bringing up the noise. + ftir$absorbance <- ftir$absorbance - min(abs(ftir$absorbance), na.rm = TRUE) + + argnames <- names(list(...)) + if ( + any( + !(argnames %in% + c("plot_title", "legend_title", "lang", "fitted_sample_name")) + ) + ) { + unused <- argnames[ + !(argnames %in% + c("plot_title", "legend_title", "lang", "fitted_sample_name")) + ] + lun <- length(unused) + cli::cli_abort( + "Error in {.fn FTIRtools::plot_components}. Supplied {lun} unused argument{?s}: {argnames}." + ) + } + + args <- list(...) + + legend_title <- `if`( + "legend_title" %in% argnames, + args$legend_title, + ifelse(lang == "en", "Sample ID", "ID de l'\u00e9chantillon") + ) + + method <- get_fit_method(fitted_peaks) + + if (!("sample_id" %in% names(fitted_peaks))) { + cli::cli_warn( + "Warning in {.fn FTIRtools::plot_components}. {.arg fitted_peaks} should be generated with {.fn FTIRtools::fit_peaks}." + ) + fitted_peaks$sample_id <- "" + } else if (fitted_peaks$sample_id != unique(ftir$sample_id)) { + cli::cli_warn(c( + "Warning in {.fn FTIRtools::plot_components}. {.arg fitted_peaks} does not contain fit peaks that match the ftir sample provided.", + i = 'The peaks were fit for sample "{fitted_peaks$sample_id}" and you provided "{unique(ftir$sample_id)[1]}".' + )) + } + + if ("plot_title" %in% argnames) { + plot_title <- args$plot_title + } else { + if (lang == "en") { + plot_title <- c( + "Fitted FTIR Plot", + paste0( + "Showing as-analyzed spectra and components of ", + tools::toTitleCase(method), + " fitted peaks" + ) + ) + } else { + plot_title <- c( + "Trac\u00e9 IRTF ajust\u00e9", + paste0( + "Montrer les spectres et es composants analys\u00e9s de pics ajust\u00e9 par la m\u00e9thode ", + tools::toTitleCase(method) + ) + ) + } + } + + n_peaks <- length(fitted_peaks$mu) + fit_spectra <- data.frame( + wavenumber = numeric(), + absorbance = numeric(), + sample_id = character() + ) + for (i in seq(n_peaks)) { + s <- paste("Component", i) + y <- get_fit_spectra(ftir, fitted_peaks, i) + fit_spectra <- rbind( + fit_spectra, + data.frame(wavenumber = ftir$wavenumber, absorbance = y, sample_id = s) + ) + } + + plotdata <- ftir + + if (plot_fit) { + fitted_sample_name <- `if`( + "fitted_sample_name" %in% argnames, + args$fitted_sample_name, + ifelse( + lang == "en", + trimws(paste("fitted", fitted_peaks$sample_id)), + trimws(paste(fitted_peaks$sample_id, "ajust\u00e9")) + ) + ) + fitted_sample <- data.frame( + wavenumber = ftir$wavenumber, + absorbance = get_fit_spectra(ftir, fitted_peaks = fitted_peaks), + sample_id = fitted_sample_name + ) + plotdata <- rbind(plotdata, fitted_sample) + } + + plotdata <- rbind(plotdata, fit_spectra) + + # Now need to reorder factor levels to make plot logical + # First original sample, next fitted, afterwards remaining components. + if (plot_fit) { + sampleids <- unique(plotdata$sample_id) + plotdata$sample_id <- factor( + plotdata$sample_id, + c( + ftir$sample_id[1], + fitted_sample_name, + sampleids[!(sampleids %in% c(ftir$sample_id[1], fitted_sample_name))] + ) + ) + } else { + sampleids <- unique(plotdata$sample_id) + plotdata$sample_id <- factor( + plotdata$sample_id, + c(ftir$sample_id[1], sampleids[!(sampleids %in% c(ftir$sample_id[1]))]) + ) + } + + # This will warn about too many samples if not suppressed + p <- suppressWarnings(PlotFTIR::plot_ftir( + plotdata, + plot_title = plot_title, + legend_title = legend_title, + lang = lang + )) + + if (!requireNamespace("ggthemes", quietly = TRUE)) { + suppressWarnings( + p <- p + + ggplot2::scale_color_viridis_d() + ) + } else { + suppressWarnings( + p <- p + + ggthemes::scale_color_calc() + ) + } + + if (plot_fit) { + utils::capture.output( + p <- PlotFTIR::highlight_sample( + p, + c(ftir$sample_id[1], fitted_sample_name) + ), + file = nullfile() + ) + } else { + utils::capture.output( + p <- PlotFTIR::highlight_sample( + p, + ftir$sample_id[1] + ), + file = nullfile() + ) + } + + return(p) +} + + +#' Plot Residuals +#' @description Produce a plot of the error between predicted and actual FTIR +#' spectra. +#' +#' Produisez un graphique de l'erreur entre les spectres IRTF prédits et réels. +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance`. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance`. +#' @param fitted_peaks An object from [fit_peaks()]. Should match the provided +#' sample in `ftir`. +#' +#' Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans +#' `ftir`. +#' @param lang An optional argument for language. If set to one of `fr`, +#' `french`, `francais`, or `français` the axis and default plot and legend +#' titles will change to french. If non-default legend or plot titles are +#' provided they are used as-is. You can also provide `en`, `english` or +#' `anglais`, or (the default) `NA` will use the default language from user +#' options. To set a permanent default, set `options("PlotFTIR.lang" = "en")` +#' or `options("PlotFTIR.lang" = "fr")` for English or French, respectively. +#' +#' Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`, +#' ou `Français`, l'axe et les titres par défaut de le tracé et du légende +#' seront en français. Si des titres du légende ou de tracé autres que ceux +#' par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi +#' fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le +#' langue par défaut des options de l'utilisateur. Pour définir une valeur +#' par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou +#' `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français, +#' respectivement. +#' @param ... optional argument `fitted_sample_name` for naming the fitted peaks +#' on the plot, or extra parameters to pass to [PlotFTIR::plot_ftir()]. +#' +#' Argument optionnel `fitted_sample_name` pour nommer les pics ajustés sur le +#' graphique, ou des paramètres supplémentaires à passer à +#' [PlotFTIR::plot_ftir()]. +#' @returns A [PlotFTIR::plot_ftir()] graphic with residuals plotted against +#' wavenumber. +#' +#' Un graphique [PlotFTIR::plot_ftir()] avec les résidus tracés en fonction du +#' nombre d'ondes. +#' @export +#' @examples +#' # Load the isopropanol sample spectrum from the PlotFTIR package +#' ftir_data <- PlotFTIR::sample_spectra[ +#' PlotFTIR::sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Choose a subset of the data (reducing run time) +#' ftir_data <- ftir_data[ +#' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +#' ] +#' +#' # First, fit the peaks using the default 'voigt' method +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' +#' # --- Example 1: Plot residuals with default settings --- +#' \dontrun{ +#' plot_fit_residuals(ftir_data, fitted_voigt) +#' } +#' +#' # --- Example 2: Plot residuals with custom titles in French --- +#' \dontrun{ +#' plot_fit_residuals( +#' ftir_data, +#' fitted_voigt, +#' lang = "fr", +#' plot_title = c( +#' "R\u00e9sidus de l'ajustement", +#' "Diff\u00e9rence entre le spectre et l'ajustement Voigt" +#' ) +#' ) +#' } +#' +plot_fit_residuals <- function(ftir, fitted_peaks, lang = NA, ...) { + PlotFTIR::check_ftir_data(ftir) + + if (!("absorbance" %in% colnames(ftir))) { + cli::cli_abort( + "Error in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg ftir} must be supplied in absorbance units." + ) + } + if (length(unique(ftir$sample_id)) != 1) { + cli::cli_abort( + "Error in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg ftir} must only contain one sample spectra." + ) + } + + if (!("sample_id" %in% names(fitted_peaks))) { + cli::cli_warn( + "Warning in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg fitted_peaks} should be generated with {.fn FTIRtools::fit_peaks}." + ) + fitted_peaks$sample_id <- "" + } else if (fitted_peaks$sample_id != unique(ftir$sample_id)) { + cli::cli_warn(c( + "Warning in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg fitted_peaks} does not contain fit peaks that match the ftir sample provided.", + i = 'The peaks were fit for sample "{fitted_peaks$sample_id}" and you provided "{unique(ftir$sample_id)[1]}".' + )) + } + + lang <- process_language(lang) + + # simple baseline the ftir to minimize the work of peaks bringing up the noise. + ftir$absorbance <- ftir$absorbance - min(abs(ftir$absorbance), na.rm = TRUE) + + method <- get_fit_method(fitted_peaks = fitted_peaks) + + fitted_y <- get_fit_spectra(ftir, fitted_peaks) + + residual <- fitted_y - ftir$absorbance + + plotdata <- data.frame( + "wavenumber" = ftir$wavenumber, + "absorbance" = residual, + "sample_id" = ifelse(lang == "en", "Residual", "R\u00e9sidu") + ) + + argnames <- names(list(...)) + if (any(!(argnames %in% c("plot_title", "legend_title", "lang")))) { + unused <- argnames[ + !(argnames %in% + c("plot_title", "legend_title", "lang")) + ] + lun <- length(unused) + cli::cli_abort( + "Error in {.fn FTIRtools::plot_components}. Supplied {lun} unused argument{?s}: {argnames}." + ) + } + + args <- list(...) + + legend_title <- `if`( + "legend_title" %in% argnames, + args$legend_title, + "" + ) + + method <- get_fit_method(fitted_peaks) + + if ("plot_title" %in% argnames) { + plot_title <- args$plot_title + } else { + if (lang == "en") { + plot_title <- c( + "Residual Plot", + paste0( + "Residual of ", + tools::toTitleCase(method), + " fitted peaks and ", + unique(ftir$sample_id) + ) + ) + } else { + plot_title <- c( + "Trac\u00e9 des r\u00e9sidus", + paste0( + "R\u00e9sidu de ", + tools::toTitleCase(method), + " pics ajust\u00e9s et ", + unique(ftir$sample_id) + ) + ) + } + } + + return(suppressWarnings(PlotFTIR::plot_ftir( + plotdata, + plot_title = plot_title, + legend_title = legend_title, + lang = lang + ))) +} + + +#' Plot Fitted Peaks +#' +#' @description Plot the spectra and sum of fitted peaks from [fit_peaks()] +#' using [PlotFTIR::plot_ftir()]. +#' +#' Tracez les spectres et la somme des pics ajustés à partir de [fit_peaks()] +#' en utilisant [PlotFTIR::plot_ftir()]. +#' +#' @param ftir A data.frame in long format with a single FTIR spectra in columns +#' `sample_id`, `wavenumber`, and `absorbance`. +#' +#' Un data.frame au format long avec un seul spectre IRTF dans les colonnes +#' `sample_id`, `wavenumber`, et `absorbance`. +#' @param fitted_peaks An object from [fit_peaks()]. Should match the provided +#' sample in `ftir`. +#' +#' Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans +#' `ftir`. +#' @param plot_components Boolean, whether to include the component peaks (see +#' [plot_components()]). +#' +#' Booléen, pour savoir s'il faut inclure les pics des composants (voir +#' [plot_components()]). +#' @param lang An optional argument for language. If set to one of `fr`, +#' `french`, `francais`, or `français` the axis and default plot and legend +#' titles will change to french. If non-default legend or plot titles are +#' provided they are used as-is. You can also provide `en`, `english` or +#' `anglais`, or (the default) `NA` will use the default language from user +#' options. To set a permanent default, set `options("PlotFTIR.lang" = "en")` +#' or `options("PlotFTIR.lang" = "fr")` for English or French, respectively. +#' +#' Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`, +#' ou `Français`, l'axe et les titres par défaut de le tracé et du légende +#' seront en français. Si des titres du légende ou de tracé autres que ceux +#' par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi +#' fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le +#' langue par défaut des options de l'utilisateur. Pour définir une valeur +#' par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou +#' `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français, +#' respectivement. +#' @param ... Optional argument `fitted_sample_name` for naming the fitted peaks +#' on the plot, or extra parameters to pass to [PlotFTIR::plot_ftir()]. +#' +#' Argument optionnel `fitted_sample_name` pour nommer les pics ajustés sur le +#' graphique, ou des paramètres supplémentaires à passer à +#' [PlotFTIR::plot_ftir()]. +#' +#' @return A [PlotFTIR::plot_ftir()] graphic. +#' +#' Un graphique [PlotFTIR::plot_ftir()]. +#' @export +#' @seealso [PlotFTIR::plot_ftir()] +#' @examples +#' # Load the isopropanol sample spectrum from the PlotFTIR package +#' ftir_data <- PlotFTIR::sample_spectra[ +#' PlotFTIR::sample_spectra$sample_id == "isopropanol", +#' ] +#' +#' # Choose a subset of the data (reducing run time) +#' ftir_data <- ftir_data[ +#' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +#' ] +#' +#' # First, fit the peaks using the default 'voigt' method +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' +#' # --- Example 1: Plot original spectrum and the overall fitted sum --- +#' \dontrun{ +#' plot_fit_ftir_peaks(ftir_data, fitted_voigt) +#' } +#' +#' # --- Example 2: Plot original, overall fit, AND individual components --- +#' # This internally calls plot_components() with plot_fit = TRUE +#' \dontrun{ +#' plot_fit_ftir_peaks(ftir_data, fitted_voigt, plot_components = TRUE) +#' } +#' +#' # --- Example 3: Plot original and fit with custom titles and name --- +#' \dontrun{ +#' plot_fit_ftir_peaks( +#' ftir_data, +#' fitted_voigt, +#' plot_title = c("Isopropanol Fit Comparison", "Original vs. Voigt Sum"), +#' legend_title = "Spectrum Source", +#' fitted_sample_name = "Total Voigt Fit" +#' ) +#' } +#' +#' # --- Example 4: Plot original and fit in French --- +#' \dontrun{ +#' plot_fit_ftir_peaks(ftir_data, fitted_voigt, lang = "fr") +#' } +#' +plot_fit_ftir_peaks <- function( + ftir, + fitted_peaks, + plot_components = FALSE, + lang = NA, + ... +) { + if (plot_components) { + return(plot_components( + ftir = ftir, + fitted_peaks = fitted_peaks, + plot_fit = TRUE, + lang = lang, + ... = ... + )) + } + PlotFTIR::check_ftir_data(ftir) + + if (!("absorbance" %in% colnames(ftir))) { + cli::cli_abort( + "Error in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg ftir} must be supplied in absorbance units." + ) + } + if (length(unique(ftir$sample_id)) != 1) { + cli::cli_abort( + "Error in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg ftir} must only contain one sample spectra." + ) + } + + lang <- process_language(lang) + + # simple baseline the ftir to minimize the work of peaks bringing up the noise. + ftir$absorbance <- ftir$absorbance - min(abs(ftir$absorbance), na.rm = TRUE) + + argnames <- names(list(...)) + if ( + any( + !(argnames %in% + c("plot_title", "legend_title", "lang", "fitted_sample_name")) + ) + ) { + unused <- argnames[ + !(argnames %in% + c("plot_title", "legend_title", "lang", "fitted_sample_name")) + ] + lun <- length(unused) + cli::cli_abort( + "Error in {.fn FTIRtools::plot_fit_ftir_peaks}. Supplied {lun} unused argument{?s}: {argnames}." + ) + } + + args <- list(...) + + legend_title <- `if`( + "legend_title" %in% argnames, + args$legend_title, + ifelse(lang == "en", "Sample ID", "ID de l'\u00e9chantillon") + ) + + method <- get_fit_method(fitted_peaks) + + if (!("sample_id" %in% names(fitted_peaks))) { + cli::cli_warn( + "Warning in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg fitted_peaks} should be generated with {.fn FTIRtools::fit_peaks}." + ) + fitted_peaks$sample_id <- "" + } else if (fitted_peaks$sample_id != unique(ftir$sample_id)) { + cli::cli_warn(c( + "Warning in {.fn FTIRtools::plot_fit_ftir_peaks}. {.arg fitted_peaks} does not contain fit peaks that match the ftir sample provided.", + i = 'The peaks were fit for sample "{fitted_peaks$sample_id}" and you provided "{unique(ftir$sample_id)[1]}".' + )) + } + + fitted_sample_name <- ifelse( + "fitted_sample_name" %in% argnames, + args$fitted_sample_name, + ifelse( + lang == "en", + trimws(paste("fitted", fitted_peaks$sample_id)), + trimws(paste(fitted_peaks$sample_id, "ajust\u00e9")) + ) + ) + if ("plot_title" %in% argnames) { + plot_title <- args$plot_title + } else { + if (lang == "en") { + plot_title <- c( + "Fitted FTIR Plot", + paste0( + "Showing as-analyzed spectra and sum of ", + tools::toTitleCase(method), + " fitted peaks" + ) + ) + } else { + plot_title <- c( + "Trac\u00e9 IRTF ajust\u00e9", + paste0( + "Montrer les spectres et de la somme des pics ajust\u00e9s par la m\u00e9thode ", + tools::toTitleCase(method) + ) + ) + } + } + + fitted_y <- get_fit_spectra(ftir = ftir, fitted_peaks = fitted_peaks) + + plotdata <- data.frame( + "wavenumber" = rep(ftir$wavenumber, 2), + "absorbance" = c(ftir$absorbance, fitted_y), + "sample_id" = c(ftir$sample_id, rep(fitted_sample_name, length(fitted_y))) + ) + + PlotFTIR::plot_ftir( + plotdata, + plot_title = plot_title, + legend_title = legend_title, + lang = lang + ) +} + + +process_language <- function(lang) { + # if language is provided, check against permitted, else use default from options. + l <- NA + if (!is.na(lang)) { + tryCatch( + l <- match.arg( + lang, + choices = c( + "en", + "english", + "anglais", + "fr", + "french", + "francais", + "fran\u00e7ais" + ), + several.ok = FALSE + ), + error = function(x) { + cli::cli_warn(c( + "Warning: language must be one of 'en', 'english', anglais', 'fr', 'french', 'francais' or 'fran\u00e7ais', not '{lang}'.", + i = "Using default language '{getOption('FTIRtools.lang', default = 'en')}'." + )) + } + ) + } + if (is.na(l)) { + # either lang was NA or failed the match.arg. Default to getOptions result + l <- getOption("FTIRtools.lang", default = "en") + } + + l <- substr(l, 0, 2) + + return(l) +} + + +# EMpeaksR algorithms modified with the following changes: +# - removal of verbose printing (now optional as message for easier silencing) +# - optionally optimize with fixed wavenumber (mu) values. +# - upper bounds on sigma were lifted to 1000 instead of 100 +# (to allow for broader peaks (etc. supports -OH band > 3000)) +# - additional comments in-code and formatting by {{ Posit::air }} to aid readability +# - additionally verbose documentation +# - Error checking of provided parameter values. + +# EMpeaksR is originally released under an MIT license and the license statement is +# listed in compliance with the requirements of this code. Nothing in this license +# statement affects any other portion of this package not contained in this file. + +# YEAR: 2023 +# COPYRIGHT HOLDER: Tarojiro Matsumura + +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +# LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +# OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +#' Peak Optimization +#' +#' @description Perform peak optimization (component location/wavenumber, +#' component width, proportional area, and/or shape parameters) for all +#' provided component peaks against an absorbance intensity. Uses expectation +#' maximization algorithms from Matsumura *et. al.*. The specific function +#' called results in different peak types and has different input parameters +#' to optimize: +#' * [spect_em_gmm()] optimizes Gauss shaped component peaks with the parameters: +#' * `sigma` - standard deviation (sigma) of the component peak +#' * [spect_em_lmm()] optimizes Lorentz shaped component peaks with the parameters: +#' * `gam` - width (gamma) of the peak(s). Can be thought of as standard deviation. +#' * [spect_em_pvmm()] optimizes pseudo-Voigt shaped component peaks (a blending of Gauss and Lorentz) with the following parameters: +#' * `sigma` - standard deviation (sigma) of the component peak +#' * `eta` - mixing of Gauss and Lorentz distribution for the component (proportion of Lorentz from 0-1) +#' * [spect_em_dsgmm()] optimizes Doniach-Šunjić-Gauss shaped component peaks (pseudo-Voigt but can be skew/asymmetrical) with the following parameters: +#' * `sigma` - standard deviation (sigma) of the component peak +#' * `alpha` - proportion asymmetric (0-1) of the component peak +#' * `eta` - mixing of Gauss and Lorentz distribution for the component (proportion of Lorentz from 0-1) +#' +#' Optimisation des pics (emplacement des composants/nombre d'ondes, largeur +#' des composants, surface proportionnelle et/ou paramètres de forme) pour +#' tous les pics de composants fournis par rapport à une intensité +#' d'absorption. Utilise les algorithmes de maximisation de l'espérance de +#' Matsumura *et. al.*. La fonction spécifique appelée produit différents +#' types de pics et a différents paramètres d'entrée à optimiser : +#' * [spect_em_gmm()] optimise les pics des composants en forme de Gauss avec les paramètres : +#' * `sigma` - écart-type (sigma) du pic de la composante +#' * [spect_em_lmm()] optimise les pics des composants en forme de Lorentz avec les paramètres : +#' * `gam` - largeur (gamma) du (des) pic(s). On peut l'assimiler à un écart-type. +#' * [spect_em_pvmm()] optimise les pics des composantes en forme de pseudo-Voigt (un mélange de Gauss et de Lorentz) avec les paramètres suivants : +#' * `sigma` - écart-type (sigma) du pic de la composante +#' * `eta` - mélange des distributions de Gauss et de Lorentz pour le composant (proportion de Lorentz de 0 à 1) +#' * [spect_em_dsgmm()] optimise les pics des composantes en forme de Doniach-Šunjić-Gauss (pseudo-Voigt mais peut être asymétrique/asymétrique) avec les paramètres suivants : +#' * `sigma` - écart-type (sigma) du pic de la composante. +#' * `alpha` - proportion asymétrique (0-1) du pic de la composante +#' * `eta` - mélange des distributions de Gauss et de Lorentz pour le composant (proportion de Lorentz de 0 à 1) +#' @param x A numeric vector of x values (wavenumbers) of the spectra against +#' which the components are being optimized. +#' +#' Un tableau numérique des valeurs x (nombres d'ondes) des spectres par +#' rapport auxquels les composants sont optimisés. +#' @param y A numeric vector of absorbance values (of same length as `x`) of the +#' spectra against which the components are being optimized. +#' +#' A numeric vector of absorbance values (of same length as `x`) of the +#' spectra against which the components are being optimized. +#' @param mu A numeric vector of component peak centers. +#' +#' Un tableau numérique des centres de pics des composants. +#' @param sigma A numeric vector of component peak standard deviation (sigma) +#' values. Must be the same length as `mu`. +#' +#' Un tableau numérique des valeurs d'écart-type (sigma) des pics des +#' composants. Doit être de la même longueur que `mu`. +#' @param alpha A numeric vector of component proportion asymmetric (alpha) +#' values. Must all be between 0 and 1. Must be the same length as `mu`. +#' +#' A numeric vector of component proportion asymmetric (alpha) values. Must +#' all be between 0 and 1. Must be the same length as `mu`. +#' @param eta A numeric vector of component mixing of Gauss and Lorentz +#' characteristics. Must all be between 0 and 1. Must be the same length as +#' `mu`. +#' +#' Un tableau numérique du mélange des composantes des caractéristiques de +#' Gauss et de Lorentz. Doit être compris entre 0 et 1. Doit être de la même +#' longueur que `mu`. +#' @param gam A numeric vector of component peak widths (gamma) values. Must be +#' the same length as `mu`. +#' +#' Un tableau numérique des valeurs de largeur des pics des composants +#' (gamma). Doit être de la même longueur que `mu`. +#' @param mix_ratio A numeric vector of mix ratios (e.g. proportionate area +#' under the curve) for each component peak. Must be the same length as `mu`. +#' +#' Un tableau numérique des rapports de mélange (par exemple, l'aire +#' proportionnelle sous la courbe) pour chaque pic de composant. Doit être de +#' la même longueur que `mu`. +#' @param conv_cri The value (in absolute units) to which convergence is +#' measured. If sequential optimization cycles differ by less than this +#' convergence amount, then the resulting parameters are returned. Smaller +#' values of `conv_cri` result in tighter convergence at higher computational +#' cost. +#' +#' La valeur (en unités absolues) à laquelle la convergence est est mesurée. +#' Si les cycles d'optimisation séquentiels diffèrent de moins de cette valeur +#' de convergence, les paramètres résultants sont renvoyés. Des valeurs plus +#' petites de `conv_cri` résultent en une convergence plus serrée à un coût de +#' calcul plus élevé. +#' @param maxit The maximum number of optimization cycles permitted. If +#' `conv_cri` has not been met by the completion of `maxit` cycles an error is +#' returned. +#' +#' Le nombre maximum de cycles d'optimisation autorisés. Si `conv_cri` n'a pas +#' été atteint à la fin des cycles `maxit`, une erreur est renvoyée. +#' @param fixed_mu Whether to allow peak centers to be moved in optimization +#' (TRUE) or fixed to the provided values (FALSE). +#' +#' Permet de déplacer les centres de pic lors de l'optimisation (VRAI) ou de +#' les fixer aux valeurs fournies (FAUX). +#' @param verbose Whether to output a status message at the conclusion of each +#' optimization cycle. +#' +#' Indique si un message d'état doit être émis à la fin de chaque cycle +#' d'optimisation. +#' @return A named list object, with values corresponding to the optimal peak +#' location, width, area, and shape parameters (function dependent), as well +#' as the optimization record of each optimized parameter, count of +#' optimization iterations, convergence status, and the type of optimization. +#' +#' Un objet liste nommé, avec des valeurs correspondant aux paramètres +#' optimaux d'emplacement, de largeur, de surface et de forme du pic +#' (dépendant de la fonction), ainsi que l'enregistrement d'optimisation de +#' chaque paramètre optimisé, le nombre d'itérations d'optimisation, l'état de +#' convergence et le type d'optimisation. +#' +#' @seealso [fit_peaks()] +#' +#' @references +#' * Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2019) "Spectrum adapted expectation-maximization algorithm for high-throughput peak shift analysis". Science and technology of advanced materials, 20(1), pp 733-745. doi:10.1080/14686996.2019.1620123 +#' * Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2021) "Spectrum adapted expectation-conditional maximization algorithm for extending high–throughput peak separation method in XPS analysis". Science and Technology of Advanced Materials: Methods, 1(1), pp 45-55. doi:10.1080/27660400.2021.1899449 +#' +#' @name optimization +#' @md +NULL + +#' @rdname optimization +spect_em_dsgmm <- function( + x, + y, + mu, + sigma = rep(10, length(mu)), + alpha = rep(0.5, length(mu)), + eta = rep(0.5, length(mu)), + mix_ratio = rep(1 / length(mu), length(mu)), + conv_cri = 1e-2, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) { + # Function Prep + f_k <- function(i) { + mix_ratio[i] * truncated_dsg(x, mu[i], sigma[i], alpha[i], eta[i]) + } + + LL <- function(x, y, mu, sigma, alpha, eta, mix_ratio) { + pL <- sapply(1:K, f_k) + sum(y * log(apply(pL, 1, sum))) + } + + Q_fun <- function(x, w_k, mu, sigma, alpha, eta, mix_ratio) { + w_k %*% (log(mix_ratio) + log(truncated_dsg(x, mu, sigma, alpha, eta))) + } + + # Error checking + if (length(x) != length(y)) { + cli::cli_abort( + "Error in {.fn spect_em_dsgmm}. Provided {.param x} and {.param y} vectors must be of the same length." + ) + } + if ( + any( + length(mix_ratio) != length(mu), + length(eta) != length(mu), + length(alpha) != length(mu), + length(sigma) != length(mu) + ) + ) { + cli::cli_abort( + "Error in {.fn spect_em_dsgmm}. All of {.param mu}, {.param sigma}, {.param alpha}, {.param eta} and {.param mix_ratio} must be of the same length." + ) + } + if (!maxit > 1) { + cli::cli_abort( + "Error in {.fn spect_em_dsgmm}. Provided {.param maxit} must be greater than 1 to perform optimization." + ) + } + + # Initial Values + start_cal <- Sys.time() + status <- "Not converged" + N <- length(x) + LL_1 <- numeric(0) + mix_ratio_1 <- numeric(0) + sigma_1 <- numeric(0) + mu_1 <- numeric(0) + alpha_1 <- numeric(0) + eta_1 <- numeric(0) + n_k <- numeric(0) + K <- length(mu) + LL_1[1] <- LL(x, y, mu, sigma, alpha, eta, mix_ratio) + mu_1 <- rbind(mu_1, mu) + sigma_1 <- rbind(sigma_1, sigma) + alpha_1 <- rbind(alpha_1, alpha) + eta_1 <- rbind(eta_1, eta) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + # Iterative optimization + for (i in 1:maxit) { + tmp <- sapply(1:K, f_k) + den <- apply(tmp, 1, sum) + w_k <- matrix(NA, nrow = K, ncol = N) + for (j in 1:K) { + w_k[j, ] <- y * + mix_ratio[j] * + truncated_dsg(x, mu[j], sigma[j], alpha[j], eta[j]) / + den + } + n_k <- apply(w_k, 1, sum) + n_k[which(is.na(n_k))] <- 0 + mu_cal <- c() + sigma_cal <- c() + alpha_cal <- c() + eta_cal <- c() + mix_ratio <- n_k / sum(y) + + # Update Mu + if (!fixed_mu) { + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(min(x), max(x)), + tol = 1e-06, + x = x, + sigma = sigma[k], + alpha = alpha[k], + eta = eta[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + mu_cal <- c(mu_cal, opt$maximum) + } + mu <- mu_cal + } + + # Update Sigma + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(0.1, 1000), + tol = 1e-06, + x = x, + mu = mu[k], + alpha = alpha[k], + eta = eta[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + sigma_cal <- c(sigma_cal, opt$maximum) + } + sigma <- sigma_cal + + # Update Alpha + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(1e-06, 0.999999), + tol = 1e-06, + x = x, + mu = mu[k], + sigma = sigma[k], + eta = eta[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + alpha_cal <- c(alpha_cal, opt$maximum) + } + alpha <- alpha_cal + + # Update Eta + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(1e-06, 0.999999), + tol = 1e-06, + x = x, + mu = mu[k], + sigma = sigma[k], + alpha = alpha[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + eta_cal <- c(eta_cal, opt$maximum) + } + eta <- eta_cal + + # Record Updates + LL_1[i + 1] <- LL(x, y, mu, sigma, alpha, eta, mix_ratio) + mu_1 <- rbind(mu_1, mu) + sigma_1 <- rbind(sigma_1, sigma) + alpha_1 <- rbind(alpha_1, alpha) + eta_1 <- rbind(eta_1, eta) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + #Check for convergance + if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { + status <- "converged" + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + if (verbose) { + cli::cli_alert_success( + "Converged in {i} iterations ({round(cal_time)} seconds)." + ) + } + break + } else if (verbose) { + cli::cli_alert_info("LL: {LL_1[i+1]}") + } + } + + if (is.na(cal_time)) { + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + } + + # mu: component peak centres + # sigma: component peak widths (specifically, standard deviation of the component centred at mu) + # alpha: estimated asymmetry of the component + # eta: mixing of Gauss and Lorentz distribution for the component (proportion Lorentz 0-1) + # mix_ratio: component peak heights (should sum to 1) + # it: number of iterations to convergence or maxit if not converged + # LL: log likelihood values at each iteration + # MU: mu values at each iteration + # SIGMA: sigma values at each iteration + # ALPHA: alpha values at each iteration + # ETA: eta values at each iteration + # MIX_RATIO: mix_ratio values at each iteration + # W_K: decomposed curve of each component [i,] at each x value [,j] + # convergence: message of convergence in calculation + # cal_time: time to converge + list( + mu = mu, + sigma = sigma, + alpha = alpha, + eta = eta, + mix_ratio = mix_ratio, + it = i, + LL = LL_1, + MU = mu_1, + SIGMA = sigma_1, + ALPHA = alpha_1, + ETA = eta_1, + MIX_RATIO = mix_ratio_1, + convergence = status, + W_K = w_k, + cal_time = cal_time + ) +} + + +#' @rdname optimization +spect_em_gmm <- function( + x, + y, + mu, + sigma = rep(10, length(mu)), + mix_ratio = rep(1 / length(mu), length(mu)), + conv_cri = 1e-2, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) { + # Function Setup + f_k <- function(i) { + mix_ratio[i] * stats::dnorm(x, mu[i], sigma[i]) + } + LL <- function(x, y, mu, sigma, mix_ratio) { + pL <- sapply(1:K, f_k) + sum(y * log(apply(pL, 1, sum))) + } + + # Error checking + if (length(x) != length(y)) { + cli::cli_abort( + "Error in {.fn spect_em_gmm}. Provided {.param x} and {.param y} vectors must be of the same length." + ) + } + if (any(length(mix_ratio) != length(mu), length(sigma) != length(mu))) { + cli::cli_abort( + "Error in {.fn spect_em_gmm}. All of {.param mu}, {.param sigma}, and {.param mix_ratio} must be of the same length." + ) + } + if (!maxit > 1) { + cli::cli_abort( + "Error in {.fn spect_em_gmm}. Provided {.param maxit} must be greater than 1 to perform optimization." + ) + } + + # Initial Values + start_cal <- Sys.time() + status <- "Not converged" + N <- length(x) + LL_1 <- numeric(0) + mix_ratio_1 <- numeric(0) + sigma_1 <- numeric(0) + mu_1 <- numeric(0) + n_k <- numeric(0) + K <- length(mu) + LL_1[1] <- LL(x, y, mu, sigma, mix_ratio) + mu_1 <- rbind(mu_1, mu) + sigma_1 <- rbind(sigma_1, sigma) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + # Iterative optimization + for (i in 1:maxit) { + tmp <- sapply(1:K, f_k) + den <- apply(tmp, 1, sum) + w_k <- matrix(NA, nrow = K, ncol = N) + for (j in 1:K) { + w_k[j, ] <- y * mix_ratio[j] * stats::dnorm(x, mu[j], sigma[j]) / den + } + n_k <- apply(w_k, 1, sum) + + # Update mu and sigma + for (j in 1:K) { + if (!fixed_mu) { + mu[j] <- sum((w_k[j, ] * x)) / n_k[j] + } + sigma[j] <- sqrt(sum(w_k[j, ] * (x - mu[j])^2) / n_k[j]) + } + mix_ratio <- n_k / sum(y) + + # record values + LL_1[i + 1] <- LL(x, y, mu, sigma, mix_ratio) + mu_1 <- rbind(mu_1, mu) + sigma_1 <- rbind(sigma_1, sigma) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + #Check for convergance + if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { + status <- "converged" + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + if (verbose) { + cli::cli_alert_success( + "Converged in {i} iterations ({round(cal_time)} seconds)." + ) + } + break + } else if (verbose) { + cli::cli_alert_info("LL: {LL_1[i+1]}") + } + } + + if (is.na(cal_time)) { + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + } + + # mu: component peak centres + # sigma: component peak widths (specifically, standard deviation of the normal distribution centred at mu) + # mix_ratio: component peak heights (should sum to 1) + # it: number of iterations to convergence or maxit if not converged + # LL: log likelihood values at each iteration + # MU: mu values at each iteration + # SIGMA: sigma values at each iteration + # MIX_RATIO: mix_ratio values at each iteration + # W_K: decomposed curve of each component [i,] at each x value [,j] + # convergence: message of convergence in calculation + # cal_time: time to converge + list( + mu = mu, + sigma = sigma, + mix_ratio = mix_ratio, + it = i, + LL = LL_1, + MU = mu_1, + SIGMA = sigma_1, + MIX_RATIO = mix_ratio_1, + convergence = status, + W_K = w_k, + cal_time = cal_time + ) +} + +#' @rdname optimization +spect_em_lmm <- function( + x, + y, + mu, + gam = rep(10, length(mu)), + mix_ratio = rep(1 / length(mu), length(mu)), + conv_cri = 1e-2, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) { + # Function Setup + f_k <- function(i) { + mix_ratio[i] * dCauchy(x, mu[i], gam[i]) + } + LL <- function(x, y, mu, gam, mix_ratio) { + pL <- sapply(1:K, f_k) + sum(y * log(apply(pL, 1, sum))) + } + Q_fun <- function(x, w_k, mu, gam, mix_ratio) { + w_k %*% (log(mix_ratio) + log(dCauchy(x, mu, gam))) + } + + # Error checking + if (length(x) != length(y)) { + cli::cli_abort( + "Error in {.fn spect_em_lmm}. Provided {.param x} and {.param y} vectors must be of the same length." + ) + } + if (any(length(mix_ratio) != length(mu), length(gam) != length(mu))) { + cli::cli_abort( + "Error in {.fn spect_em_lmm}. All of {.param mu}, {.param gam}, and {.param mix_ratio} must be of the same length." + ) + } + if (!maxit > 1) { + cli::cli_abort( + "Error in {.fn spect_em_lmm}. Provided {.param maxit} must be greater than 1 to perform optimization." + ) + } + + # Initial Values + start_cal <- Sys.time() + status <- "Not converged" + N <- length(x) + LL_1 <- numeric(0) + mix_ratio_1 <- numeric(0) + gam_1 <- numeric(0) + mu_1 <- numeric(0) + n_k <- numeric(0) + K <- length(mu) + + LL_1[1] <- LL(x, y, mu, gam, mix_ratio) + mu_1 <- rbind(mu_1, mu) + gam_1 <- rbind(gam_1, gam) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + # Iterative optimization + for (i in 1:maxit) { + tmp <- sapply(1:K, f_k) + den <- apply(tmp, 1, sum) + w_k <- matrix(NA, nrow = K, ncol = N) + for (j in 1:K) { + w_k[j, ] <- y * + mix_ratio[j] * + dCauchy(x, mu[j], gam[j]) / + den + } + n_k <- apply(w_k, 1, sum) + n_k[which(is.na(n_k))] <- 0 + mu_cal <- c() + gam_cal <- c() + mix_ratio <- n_k / sum(y) + + # Update Mu + if (!fixed_mu) { + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(min(x), max(x)), + tol = 1e-10, + x = x, + gam = gam[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + mu_cal <- c(mu_cal, opt$maximum) + } + mu <- mu_cal + } + + # Update GAM + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(0.001, 1000), + tol = 1e-10, + x = x, + mu = mu[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + gam_cal <- c(gam_cal, opt$maximum) + } + gam <- gam_cal + + # Record Values + LL_1[i + 1] <- LL(x, y, mu, gam, mix_ratio) + mu_1 <- rbind(mu_1, mu) + gam_1 <- rbind(gam_1, gam) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + #Check for convergance + if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { + status <- "converged" + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + if (verbose) { + cli::cli_alert_success( + "Converged in {i} iterations ({round(cal_time)} seconds)." + ) + } + break + } else if (verbose) { + cli::cli_alert_info("LL: {LL_1[i+1]}") + } + } + + if (is.na(cal_time)) { + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + } + + # mu: component peak centres + # gam: component peak widths (specifically, scale parameter of the lorenzian centred at mu) + # mix_ratio: component peak heights (should sum to 1) + # it: number of iterations to convergence or maxit if not converged + # LL: log likelihood values at each iteration + # MU: mu values at each iteration + # GAM: gam values at each iteration + # MIX_RATIO: mix_ratio values at each iteration + # W_K: decomposed curve of each component [i,] at each x value [,j] + # convergence: message of convergence in calculation + # cal_time: time to converge + list( + mu = mu, + gam = gam, + mix_ratio = mix_ratio, + it = i, + LL = LL_1, + MU = mu_1, + GAM = gam_1, + MIX_RATIO = mix_ratio_1, + convergence = status, + W_K = w_k, + cal_time = cal_time + ) +} + +#' @rdname optimization +spect_em_pvmm <- function( + x, + y, + mu, + sigma = rep(10, length(mu)), + eta = rep(0.5, length(mu)), + mix_ratio = rep(1 / length(mu), length(mu)), + conv_cri = 1e-2, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) { + # Function Setup + f_k <- function(i) { + mix_ratio[i] * truncated_pv(x, mu[i], sigma[i], eta[i]) + } + LL <- function(x, y, mu, sigma, eta, mix_ratio) { + pL <- sapply(1:K, f_k) + sum(y * log(apply(pL, 1, sum))) + } + Q_fun <- function(x, w_k, mu, sigma, eta, mix_ratio) { + w_k %*% (log(mix_ratio) + log(truncated_pv(x, mu, sigma, eta))) + } + + # Error checking + if (length(x) != length(y)) { + cli::cli_abort( + "Error in {.fn spect_em_pvmm}. Provided {.param x} and {.param y} vectors must be of the same length." + ) + } + if ( + any( + length(mix_ratio) != length(mu), + length(eta) != length(mu), + length(sigma) != length(mu) + ) + ) { + cli::cli_abort( + "Error in {.fn spect_em_pvmm}. All of {.param mu}, {.param sigma}, {.param eta}, and {.param mix_ratio} must be of the same length." + ) + } + if (!maxit > 1) { + cli::cli_abort( + "Error in {.fn spect_em_pvmm}. Provided {.param maxit} must be greater than 1 to perform optimization." + ) + } + + # Initial Values + start_cal <- Sys.time() + status <- "Not converged" + N <- length(x) + LL_1 <- numeric(0) + mix_ratio_1 <- numeric(0) + sigma_1 <- numeric(0) + mu_1 <- numeric(0) + eta_1 <- numeric(0) + n_k <- numeric(0) + K <- length(mu) + LL_1[1] <- LL(x, y, mu, sigma, eta, mix_ratio) + mu_1 <- rbind(mu_1, mu) + sigma_1 <- rbind(sigma_1, sigma) + eta_1 <- rbind(eta_1, eta) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + #Iterative optimization + for (i in 1:maxit) { + tmp <- sapply(1:K, f_k) + den <- apply(tmp, 1, sum) + w_k <- matrix(NA, nrow = K, ncol = N) + for (j in 1:K) { + w_k[j, ] <- y * + mix_ratio[j] * + truncated_pv(x, mu[j], sigma[j], eta[j]) / + den + } + n_k <- apply(w_k, 1, sum) + n_k[which(is.na(n_k))] <- 0 + mu_cal <- c() + sigma_cal <- c() + eta_cal <- c() + mix_ratio <- n_k / sum(y) + + # Update mu + if (!fixed_mu) { + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(min(x), max(x)), + tol = 1e-10, + x = x, + sigma = sigma[k], + eta = eta[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + mu_cal <- c(mu_cal, opt$maximum) + } + mu <- mu_cal + } + + # Update Sigma + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(0.001, 1000), + tol = 1e-10, + x = x, + mu = mu[k], + eta = eta[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + sigma_cal <- c(sigma_cal, opt$maximum) + } + sigma <- sigma_cal + + # Update Eta + for (k in 1:K) { + opt <- stats::optimize( + Q_fun, + interval = c(0, 1), + tol = 1e-10, + x = x, + mu = mu[k], + sigma = sigma[k], + w_k = w_k[k, ], + mix_ratio = mix_ratio[k], + maximum = TRUE + ) + eta_cal <- c(eta_cal, opt$maximum) + } + eta <- eta_cal + + # Record values + LL_1[i + 1] <- LL(x, y, mu, sigma, eta, mix_ratio) + mu_1 <- rbind(mu_1, mu) + sigma_1 <- rbind(sigma_1, sigma) + eta_1 <- rbind(eta_1, eta) + mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) + + #Check for convergance + if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { + status <- "converged" + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + if (verbose) { + cli::cli_alert_success( + "Converged in {i} iterations ({round(cal_time)} seconds)." + ) + } + break + } else if (verbose) { + cli::cli_alert_info("LL: {LL_1[i+1]}") + } + } + + if (is.na(cal_time)) { + cal_time <- difftime(Sys.time(), start_cal, units = "sec") + } + # mu: component peak centres + # sigma: component peak widths (specifically, standard deviation of the component centred at mu) + # eta: mixing of Gauss and Lorentz distribution for the component (proportion Lorentz 0-1) + # mix_ratio: component peak heights (should sum to 1) + # it: number of iterations to convergence or maxit if not converged + # LL: log likelihood values at each iteration + # MU: mu values at each iteration + # SIGMA: gam values at each iteration + # ETA: eta values at each iteration + # MIX_RATIO: mix_ratio values at each iteration + # W_K: decomposed curve of each component [i,] at each x value [,j] + # convergence: message of convergence in calculation + # cal_time: time to converge + list( + mu = mu, + sigma = sigma, + eta = eta, + mix_ratio = mix_ratio, + it = i, + LL = LL_1, + MU = mu_1, + SIGMA = sigma_1, + ETA = eta_1, + MIX_RATIO = mix_ratio_1, + convergence = status, + W_K = w_k, + cal_time = cal_time + ) +} + + +# These are from the EMpeaksR and are unexported helper functions + +truncated_pv <- function(x, mu, sigma, eta) { + (eta * + stats::dcauchy(x, mu, sqrt(2 * log(2)) * sigma) + + (1 - eta) * stats::dnorm(x, mu, sigma)) / + sum( + eta * + stats::dcauchy(x, mu, sqrt(2 * log(2)) * sigma) + + (1 - eta) * stats::dnorm(x, mu, sigma) + ) +} + +truncated_dsg <- function(x, mu, sigma, alpha, eta) { + ((eta * + (((gamma(1 - alpha)) / + ((x - mu)^2 + (sqrt(2 * log(2)) * sigma)^2)^((1 - alpha) / 2)) * + cos( + (pi * alpha / 2) + + (1 - alpha) * + atan( + (x - mu) / + (sqrt(2 * log(2)) * sigma) + ) + ))) + + (1 - eta) * stats::dnorm(x, mu, sigma)) / + sum( + ((eta * + (((gamma(1 - alpha)) / + ((x - mu)^2 + (sqrt(2 * log(2)) * sigma)^2)^((1 - alpha) / 2)) * + cos( + (pi * alpha / 2) + + (1 - alpha) * + atan( + (x - mu) / + (sqrt(2 * log(2)) * sigma) + ) + ))) + + (1 - eta) * stats::dnorm(x, mu, sigma)) + ) +} + +dCauchy <- function(x, mu, gam) { + return((stats::dcauchy(x, mu, gam)) / sum(stats::dcauchy(x, mu, gam))) +} + +truncated_l <- function(x, mu, gam) { + return(dCauchy(x = x, mu = mu[1], gam = gam[1])) +} + +truncated_g <- function(x, mu, sigma) { + return(stats::dnorm(x = x, mean = mu[1], sd = sigma[1])) +} diff --git a/README.Rmd b/README.Rmd index 7fed458..d8abbe7 100644 --- a/README.Rmd +++ b/README.Rmd @@ -157,7 +157,9 @@ head(biodiesel_transm) ``` Functions are provided for adjusting the baseline of spectra, adding or subtracting scalar values from entire spectra, normalizing spectra, and averaging spectra, see: -* `recalculate_baseline()` +* `shift_baseline()` +* `baseline_ftir()` +* `remove_continuum_ftir()` * `add_scalar_value()` and `subtract_scalar_value()` * `normalize_spectra()` * `average_spectra()` @@ -320,7 +322,9 @@ head(biodiesel_transm) ``` Des fonctions sont fournies pour ajuster la ligne de base des spectres, ajouter ou soustraire des valeurs scalaires de spectres entiers, normalisation des spectres, et calculer la moyenne des spectres, voir : -* `recalculate_baseline()` +* `shift_baseline()` +* `baseline_ftir()` +* `remove_continuum_ftir()` * `add_scalar_value()` et `subtract_scalar_value()` * `normalize_spectra()` * `average_spectra()` diff --git a/README.md b/README.md index 4911f11..880539f 100644 --- a/README.md +++ b/README.md @@ -209,9 +209,10 @@ head(biodiesel_transm) Functions are provided for adjusting the baseline of spectra, adding or subtracting scalar values from entire spectra, normalizing spectra, and -averaging spectra, see: \* `recalculate_baseline()` \* -`add_scalar_value()` and `subtract_scalar_value()` \* -`normalize_spectra()` \* `average_spectra()` +averaging spectra, see: \* `shift_baseline()` \* `baseline_ftir()` \* +`remove_continuum_ftir()` \* `add_scalar_value()` and +`subtract_scalar_value()` \* `normalize_spectra()` \* +`average_spectra()` ## Reading Files @@ -243,14 +244,14 @@ citation("PlotFTIR") #> To cite package 'PlotFTIR' in publications use: #> #> Bulsink P (????). _PlotFTIR: Plot FTIR Spectra_. R package version -#> 1.1.0.9000, . +#> 1.2.0.9000, . #> #> A BibTeX entry for LaTeX users is #> #> @Manual{, #> title = {PlotFTIR: Plot FTIR Spectra}, #> author = {Philip Bulsink}, -#> note = {R package version 1.1.0.9000}, +#> note = {R package version 1.2.0.9000}, #> url = {https://github.com/NRCan/PlotFTIR}, #> } ``` @@ -473,9 +474,9 @@ head(biodiesel_transm) Des fonctions sont fournies pour ajuster la ligne de base des spectres, ajouter ou soustraire des valeurs scalaires de spectres entiers, normalisation des spectres, et calculer la moyenne des spectres, voir : -\* `recalculate_baseline()` \* `add_scalar_value()` et -`subtract_scalar_value()` \* `normalize_spectra()` \* -`average_spectra()` +\* `shift_baseline()` \* `baseline_ftir()` \* `remove_continuum_ftir()` +\* `add_scalar_value()` et `subtract_scalar_value()` \* +`normalize_spectra()` \* `average_spectra()` ## Lecture des fichiers @@ -509,14 +510,14 @@ citation("PlotFTIR") #> To cite package 'PlotFTIR' in publications use: #> #> Bulsink P (????). _PlotFTIR: Plot FTIR Spectra_. R package version -#> 1.1.0.9000, . +#> 1.2.0.9000, . #> #> A BibTeX entry for LaTeX users is #> #> @Manual{, #> title = {PlotFTIR: Plot FTIR Spectra}, #> author = {Philip Bulsink}, -#> note = {R package version 1.1.0.9000}, +#> note = {R package version 1.2.0.9000}, #> url = {https://github.com/NRCan/PlotFTIR}, #> } ``` diff --git a/man/PlotFTIR-package.Rd b/man/PlotFTIR-package.Rd index d064d2e..f99887d 100644 --- a/man/PlotFTIR-package.Rd +++ b/man/PlotFTIR-package.Rd @@ -6,7 +6,7 @@ \alias{PlotFTIR-package} \title{PlotFTIR: Plot FTIR Spectra} \description{ -The goal of 'PlotFTIR' is to easily and quickly kick-start the production of journal-quality Fourier Transform Infra-Red (FTIR) spectral plots in R using 'ggplot2'. The produced plots can be published directly or further modified by 'ggplot2' functions. L'objectif de 'PlotFTIR' est de démarrer facilement et rapidement la production des tracés spectraux de spectroscopie infrarouge à transformée de Fourier (IRTF) de qualité journal dans R à l'aide de 'ggplot2'. Les tracés produits peuvent être publiés directement ou modifiés davantage par les fonctions 'ggplot2'. +The goal of 'PlotFTIR' is to easily and quickly kick-start the analysis and production of journal-quality Fourier Transform Infra-Red (FTIR) spectral plots in R using 'ggplot2'. The produced plots can be published directly or further modified by 'ggplot2' functions. L'objectif de 'PlotFTIR' est de démarrer facilement et rapidement l'analyse et la production des tracés spectraux de spectroscopie infrarouge à transformée de Fourier (IRTF) de qualité journal dans R à l'aide de 'ggplot2'. Les tracés produits peuvent être publiés directement ou modifiés davantage par les fonctions 'ggplot2'. } \seealso{ Useful links: diff --git a/man/baseline_ftir.Rd b/man/baseline_ftir.Rd new file mode 100644 index 0000000..b4af120 --- /dev/null +++ b/man/baseline_ftir.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/maths.R +\name{baseline_ftir} +\alias{baseline_ftir} +\title{Baseline FTIR} +\usage{ +baseline_ftir(ftir, method = "modpolyfit", ...) +} +\arguments{ +\item{ftir}{A data.frame in long format with columns `sample_id`, + `wavenumber`, and `absorbance`. The `absorbance` column may be replaced by + a `transmittance` column for transmittance plots. + + Un data.frame au format long avec les colonnes `sample_id`, `wavenumber`, + et `absorbance`. La colonne `absorbance` peut être remplacée par une + colonne `transmittance` pour les tracés de transmission.} + +\item{method}{A method from [baseline::baseline()]. For FTIR data, best + results are achieved by selecting either `modpolyfit`, `peakDetection` or + `rfbaseline`. + + Une méthode de [baseline::baseline()]. Pour les données IRTF, les meilleurs + résultats sont obtenus en sélectionnant soit `modpolyfit`, soit + `peakDetection`, soit `rfbaseline`.} + +\item{...}{Additional parameters required by specific methods in + [baseline::baseline()]. + + Paramètres supplémentaires requis par certaines méthodes de + [baseline::baseline()].} +} +\value{ +A FTIR spectral data.frame with baseline corrected intensity column. + +Un data.frame contenant le spectre IRTF corrigé de la ligne de base +} +\description{ +Correct the baseline of an FTIR spectrum using one of the +techniques available in the [baseline::baseline()] package. + +Corrigez la ligne de base d'un spectre IRTF en utilisant l'une des techniques +disponibles dans le package [baseline::baseline()]. +} +\examples{ +# Load the isopropanol sample spectrum +ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", +] + +# Apply baseline correction using the default 'modpolyfit' method +ftir_baselined_modpoly <- baseline_ftir(ftir_data) + +# Apply baseline correction using the 'lowpass' method +ftir_baselined_lowpass <- baseline_ftir(ftir_data, method = "lowpass") + +# --- Optional: Visualize the results --- +\dontrun{ + plot_ftir(ftir_baselined_modpoly, plot_title = "ModPoly Baselined FTIR") + + plot_ftir(ftir_baselined_lowpass, plot_title = "Lowpass Baselined FTIR") +} +} +\references{ +* Kristian Hovde Liland, Trygve Almøy, Bjørn-Helge Mevik (2010) Optimal Choice of Baseline Correction for Multivariate Calibration of Spectra, Applied Spectroscopy 64, pp. 1007-1016. doi:10.1366/000370210792434350 +* Chad A. Lieber and Anita Mahadevan-Jansen (2003) Automated Method for Subtraction of Fluorescence from Biological Raman Spectra, Applied Spectroscopy 57, pp. 1363-1367. doi:10.1366/000370203322554518 +* Kevin R. Coombes et al. (2003) Quality control and peak finding for proteomics data collected from nipple aspirate fluid by surface-enhanced laser desorption and ionization. Clinical Chemistry 49, pp. 1615-1623. doi:10.1373/49.10.1615 +* Andreas F. Ruckstuhl, Matthew P. Jacobson, Robert W. Field, James A. Dodd (2001) Baseline subtraction using robust local regression estimation. Journal of Quantitative Spectroscopy and Radiative Transfer 68, pp.. 179-193. doi:10.1016/S0022-4073(00)00021-2 +* Xianchun Shen et al. (2018) Applied Optics 57 pp. 5794-5799 doi:10.1364/AO.57.0057947 +} +\seealso{ +[baseline::baseline()] +} diff --git a/man/find_ftir_peaks.Rd b/man/find_ftir_peaks.Rd new file mode 100644 index 0000000..871f6cc --- /dev/null +++ b/man/find_ftir_peaks.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{find_ftir_peaks} +\alias{find_ftir_peaks} +\title{Find FTIR Peaks} +\usage{ +find_ftir_peaks(ftir, ...) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns +\code{sample_id}, \code{wavenumber}, and \code{absorbance}. The \code{absorbance} column may be +replaced by a \code{transmittance} column for transmittance plots. + +Un data.frame au format long avec un seul spectre IRTF dans les colonnes +\code{sample_id}, \code{wavenumber}, et \code{absorbance}. La colonne \code{absorbance} peut +être remplacée par une colonne \code{transmittance} pour les tracés de +transmittance.} + +\item{...}{Additional optional parameters to pass to peak finding algorithm. +\itemize{ +\item \code{sg_p_norm} The polynomial degree used in smoothing the spectra for finding peaks by signal maxima. Default \code{3}. +\item \code{sg_p_deriv} The polynomial degree used in smoothing the derivative for finding peaks by minima. Default \code{3}. +\item \code{sg_n_norm} The number of points used in smoothing the spectra for finding peaks by signal maxima. Default \code{13}. +\item \code{sg_n_deriv} The number of points used in smoothing the derivative for finding peaks by minima. Default \code{13}. +\item \code{window_norm} The width of the window (in wavenumbers) to ensure that a peak is a true maxima and not just noise. Default \code{10}. Works best on data with consistent resolution, and will round up to the next data point. +\item \code{window_deriv} The width of the window (in wavenumbers) to ensure that a derivative minima is a true minima and not just noise. Default \code{5}. Works best on data with consistent resolution, and will round up to the next data point. +\item \code{window_align} The width of the window (in wavenumbers) whereby derivative and normal peaks are compared. Normal peaks are added to the derivative peak list if they are outside of the window distance of any other peak +\item \code{zero_norm} Spectra have baseline noise removed before searching for peaks by setting signal value below the zero threshold to 0. Default \code{1e-2}. +\item \code{zero_deriv}Derivative have baseline noise removed before searching for peaks by setting values below the zero threshold to 0. Default \code{1e-4}. + +Paramètres optionnels supplémentaires à transmettre à l'algorithme de +recherche de pics. #' * \code{sg_p_norm} Le degré polynomial utilisé pour lisser +les spectres afin de trouver les pics par les maxima du signal. Valeur par +défaut \code{3}. +\item \code{sg_p_deriv} Le degré polynomial utilisé dans le lissage de la dérivée pour trouver les pics par les minima. Par défaut \code{3}. +\item \code{sg_n_norm} Le nombre de points utilisés pour lisser les spectres afin de trouver les pics par maxima du signal. Valeur par défaut \code{13}. +\item \code{sg_n_deriv} Le nombre de points utilisés dans le lissage de la dérivée pour trouver les pics par minima. Par défaut \code{13}. +\item \code{window_norm} La largeur de la fenêtre (en wavenumbers) pour s'assurer qu'un pic est un vrai maxima et pas seulement du bruit. Valeur par défaut \code{10}. Fonctionne mieux sur des données avec une résolution cohérente, et arrondit au point de données suivant. +\item \code{window_deriv} La largeur de la fenêtre (en wavenumbers) pour s'assurer qu'un minima de dérivée est un vrai minima et pas seulement du bruit. Valeur par défaut \code{5}. Fonctionne mieux sur des données avec une résolution cohérente, et arrondira au point de données suivant. +\item \code{window_align} La largeur de la fenêtre (en wavenumbers) par laquelle les pics dérivés et normaux sont comparés. Les pics normaux sont ajoutés à la liste des pics dérivés s'ils se trouvent à l'extérieur de la distance de la fenêtre de tout autre pic. +\item \code{zero_norm} Les spectres sont débarrassés du bruit de base avant de rechercher les pics en fixant à 0 la valeur du signal en dessous du seuil zéro. Valeur par défaut \code{1e-2}. +\item \code{zero_deriv}La dérivée est débarrassée du bruit de base avant la recherche des pics en fixant à 0 les valeurs inférieures au seuil zéro. Valeur par défaut \code{1e-4}. +}} +} +\value{ +A vector of wavenumbers corresponding to peaks found in the provided +FTIR spectra. + +Un vecteur de nombres d'ondes correspondant aux pics trouvés dans les +spectres IRTF fournis. +} +\description{ +This function finds peaks in FTIR spectra by identifying minima +of the double derivative, then re-scanning for maxima of peaks missed by +the derivative method. This double-check ensures that both sharp peaks +(like C-H stretch) and wide gentle peaks (like O-H stretch) are found. The +spectra is smoothed by a Savitzky-Golay filter prior to analysis and as +such there are a number of optional tuning parameters that can be provided +(the defaults work well for typical spectra). + +Cette fonction permet de trouver des pics dans les spectres IRTF en +identifiant les minima de la double dérivée, puis en recherchant à nouveau +les maxima des pics manqués par la méthode de la dérivée. Cette double +vérification permet de s'assurer que les pics aigus (comme l'étirement C-H) +et les pics larges et doux (comme l'étirement O-H) sont trouvés. Le spectre +est lissé par un filtre de Savitzky-Golay avant l'analyse et, à ce titre, +un certain nombre de paramètres de réglage facultatifs peuvent être fournis +(les valeurs par défaut fonctionnent bien pour les spectres typiques). +} +\examples{ +# Load the isopropanol sample spectrum from the PlotFTIR package +ftir_data <- PlotFTIR::sample_spectra[ + PlotFTIR::sample_spectra$sample_id == "isopropanol", +] + +# Find peaks using default settings +peaks_default <- find_ftir_peaks(ftir_data) +print("Peaks found with default settings:") +print(peaks_default) + +# Find peaks with adjusted smoothing and window parameters +# Example: Less smoothing on derivative, wider window for normal peaks +peaks_adjusted <- find_ftir_peaks( + ftir_data, + sg_n_deriv = 11, # Fewer points for derivative smoothing + window_norm = 15 # Wider window (wavenumbers) for normal peak check +) +print("Peaks found with adjusted settings:") +print(peaks_adjusted) +} +\references{ +Savitzky, A.; Golay, M.J.E. (1964). "Smoothing and +Differentiation of Data by Simplified Least Squares Procedures". Analytical +Chemistry 36. pp. 1627–1639. doi:10.1021/ac60214a047 +} +\seealso{ +\code{\link[signal:sgolayfilt]{signal::sgolayfilt()}}, \code{\link[=smooth_ftir]{smooth_ftir()}} +} diff --git a/man/fit_peak_df.Rd b/man/fit_peak_df.Rd new file mode 100644 index 0000000..b79a9f2 --- /dev/null +++ b/man/fit_peak_df.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{fit_peak_df} +\alias{fit_peak_df} +\title{Fitted Peaks Data.Frame} +\usage{ +fit_peak_df(fitted_peaks) +} +\arguments{ +\item{fitted_peaks}{An object from [fit_peaks()]. + + Un objet de [fit_peaks()].} +} +\value{ +A data.frame of peak properties. + + Un data.frame des propriétés des pics. +} +\description{ +Reformat the [fit_peaks()] object to a data.frame of peak +specifications. + +Reformater l'objet [fit_peaks()] en un data.frame de spécifications de pics. +} +\examples{ +# Load the isopropanol sample spectrum from the PlotFTIR package +ftir_data <- PlotFTIR::sample_spectra[ + PlotFTIR::sample_spectra$sample_id == "isopropanol", +] + +# Choose a subset of the data (reducing run time) +ftir_data <- ftir_data[ + ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +] + +# First, fit the peaks (using the default 'voigt' method) +fitted_voigt <- fit_peaks(ftir_data, method = "voigt") + +# Now, convert the fitted model object to a data frame +peak_df_voigt <- fit_peak_df(fitted_voigt) + +print("Peak Data Frame from Voigt Fit:") +print(peak_df_voigt) +} diff --git a/man/fit_peaks.Rd b/man/fit_peaks.Rd new file mode 100644 index 0000000..95e4cef --- /dev/null +++ b/man/fit_peaks.Rd @@ -0,0 +1,155 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{fit_peaks} +\alias{fit_peaks} +\title{Fit Peaks} +\usage{ +fit_peaks(ftir, peaklist = NA, method = "voigt", fixed_peaks = FALSE, ...) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns +\code{sample_id}, \code{wavenumber}, and \code{absorbance}. + +Un data.frame au format long avec un seul spectre IRTF dans les colonnes +\code{sample_id}, \code{wavenumber}, et \code{absorbance}.} + +\item{peaklist}{The locations of peaks from \verb{[find_ftir_peaks()]}. If none +provided, will search for peaks using the default parameters of that +function. Note that you could provide a common list of peaks for fitting +multiple different spectra to compare results between samples. + +Les emplacements des pics de \verb{[find_ftir_peaks()]}. Si aucune valeur n'est +fournie, les pics seront recherchés en utilisant les paramètres par défaut +de cette fonction. Notez que vous pouvez fournir une liste commune de pics +pour l'ajustement de plusieurs spectres différents afin de comparer les +résultats entre les échantillons.} + +\item{method}{The peak style / fitting method. Theoretically FTIR peaks are +Lorentzian shaped, but with Gaussian broadening the pseudo-Voigt shape +matches best. Some success is seen using Doniach-Šunjić-Gauss peak shapes +since these can adopt undetected shoulder peaks in an asymmetric measure +for each peak. Options are: +\itemize{ +\item \code{voigt} (default): Fit Voigt shaped peaks \code{\link[EMpeaksR:PVMM]{EMpeaksR::spect_em_pvmm()}} +\item \code{gauss} Fit Gauss shaped peaks \code{\link[EMpeaksR:GMM]{EMpeaksR::spect_em_gmm()}} +\item \code{lorentz} Fit Lorentz shaped peaks \code{\link[EMpeaksR:LMM]{EMpeaksR::spect_em_lmm()}} +\item \code{dsg} Fit Doniach-Šunjić-Gauss shaped peaks \code{\link[EMpeaksR:DSGMM]{EMpeaksR::spect_em_dsgmm()}} + +Le style des pics / la méthode d'ajustement. En théorie, les pics IRTF ont +une forme de Lorentz, mais avec un élargissement Gaussien, c'est la forme +pseudo-Voigt qui convient le mieux. Les formes de pics de +Doniach-Šunjić-Gauss donnent de bons résultats, car elles permettent +d'adopter des pics d'épaulement non détectés dans le cadre d'une mesure +asymétrique pour chaque pic. Les options sont les suivantes : +\item \code{voigt} (par défaut) : Ajuster les pics en forme de Voigt \code{\link[EMpeaksR:PVMM]{EMpeaksR::spect_em_pvmm()}} +\item \code{gauss} Ajuster les pics en forme de Gauss \code{\link[EMpeaksR:GMM]{EMpeaksR::spect_em_gmm()}} +\item \code{lorentz} Ajuster les pics en forme de Lorentz \code{\link[EMpeaksR:LMM]{EMpeaksR::spect_em_lmm()}} +\item \code{dsg} Ajuster les pics en forme de Doniach-Šunjić-Gauss \code{\link[EMpeaksR:DSGMM]{EMpeaksR::spect_em_dsgmm()}} +}} + +\item{fixed_peaks}{Boolean, whether to fix the peak locations to the provided +values or allow the optimizer to move peaks as needed. + +Booléen, pour savoir s'il faut fixer l'emplacement des pics aux valeurs +fournies ou permettre à l'optimiseur de déplacer les pics selon les +besoins.} + +\item{...}{Control parameters for fitting functions (\code{conv_cri} and/or +\code{maxit}) or additional parameters to pass to \code{\link[=find_ftir_peaks]{find_ftir_peaks()}} if needed. +Paramètres de contrôle pour les fonctions d'ajustement (\code{conv_cri} et/ou +\code{maxit}) ou paramètres supplémentaires à passer à \code{\link[=find_ftir_peaks]{find_ftir_peaks()}} si +nécessaire.} +} +\value{ +An \code{EMpeaksR} style fitted model. See the documentation for each peak +shape. + +Un modèle ajusté de type \code{EMpeaksR}. Voir la documentation pour chaque forme de pic. +} +\description{ +Once peaks are found by \code{\link[=find_ftir_peaks]{find_ftir_peaks()}}, they can be fitted +by adjusting intensity (area) standard deviation (width), and shape +parameters (gam, eta, and/or alpha). This can be done by +Expectation-Maximization methods, implemented here by the \code{EMpeaksR} +package's technique. Note that the spectra provided is shifted to baseline +to reduce the work of the peak fitter in producing background noise. + +Une fois les pics trouvés par \code{\link[=find_ftir_peaks]{find_ftir_peaks()}}, ils peuvent être ajustés +en ajustant l'intensité (surface), l'écart-type (largeur) et les paramètres +de forme (gam, eta, et/ou alpha). Ceci peut être fait par des méthodes +d'espérance-maximisation, implémentées ici par la technique du paquet +\code{EMpeaksR}. Notez que le spectre fourni est décalé par rapport à la ligne +de base afin de réduire le travail de l'ajusteur de pics en produisant un +bruit de fond. +} +\examples{ +#' # Load the isopropanol sample spectrum from the PlotFTIR package +ftir_data <- PlotFTIR::sample_spectra[ + PlotFTIR::sample_spectra$sample_id == "isopropanol", +] + +# Choose a subset of the data (reducing run time) +ftir_data <- ftir_data[ + ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +] + +# Example 1: Fit peaks using the default 'voigt' method +# Peaks will be found automatically using find_ftir_peaks defaults +fitted_voigt_default <- fit_peaks(ftir_data) +print("Fitted Voigt Peaks (Default):") +# Show key results like final parameters and convergence status +print(fit_peak_df(fitted_voigt_default)) +print(paste("Convergence:", fitted_voigt_default$convergence)) + +\dontrun{ +# Example 2: Fit peaks using the 'gauss' method +fitted_gauss <- fit_peaks(ftir_data, method = "gauss") +print("Fitted Gaussian Peaks:") +print(fit_peak_df(fitted_gauss)) + +# Example 3: Provide a pre-defined list of peaks +# First, find some peaks (maybe with custom settings) +initial_peaks <- find_ftir_peaks(ftir_data, window_norm = 20) +print("Initial peaks found:") +print(initial_peaks) +# Now fit using this specific list +fitted_voigt_custom_peaks <- fit_peaks(ftir_data, peaklist = initial_peaks) +print("Fitted Voigt Peaks (Custom Initial List):") +print(fit_peak_df(fitted_voigt_custom_peaks)) + +# Example 4: Fit peaks but keep their locations fixed +# Use a smaller subset of peaks for demonstration +fixed_peak_locations <- c(1130, 1375, 1460) +fitted_voigt_fixed <- fit_peaks( + ftir_data, + peaklist = fixed_peak_locations, + fixed_peaks = TRUE + ) +print("Fitted Voigt Peaks (Fixed Locations):") +print(fit_peak_df(fitted_voigt_fixed)) + +# Example 5: Pass control parameters (e.g., lower convergence criterion) +# Note: This might take longer or behave differently +fitted_voigt_tight_conv <- fit_peaks( + ftir_data, + conv_cri = 1e-4 # Tighter convergence +) +print("Fitted Voigt Peaks (Tighter Convergence):") +print(paste("Iterations:", fitted_voigt_tight_conv$it)) +print(paste("Convergence:", fitted_voigt_tight_conv$convergence)) +} +} +\references{ +Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. +(2019) "Spectrum adapted expectation-maximization algorithm for +high-throughput peak shift analysis". Science and technology of advanced +materials, 20(1), pp 733-745. doi:10.1080/14686996.2019.1620123 Matsumura, +T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2021) "Spectrum adapted +expectation-conditional maximization algorithm for extending high–throughput +peak separation method in XPS analysis". Science and Technology of Advanced +Materials: Methods, 1(1), pp 45-55. doi:10.1080/27660400.2021.1899449 +} +\seealso{ +\code{\link[=spect_em_gmm]{spect_em_gmm()}}, \code{\link[=spect_em_lmm]{spect_em_lmm()}}, \code{\link[=spect_em_pvmm]{spect_em_pvmm()}}, +\code{\link[=spect_em_dsgmm]{spect_em_dsgmm()}} +} diff --git a/man/get_fit_method.Rd b/man/get_fit_method.Rd new file mode 100644 index 0000000..549dfcc --- /dev/null +++ b/man/get_fit_method.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{get_fit_method} +\alias{get_fit_method} +\title{Get Fit Method} +\usage{ +get_fit_method(fitted_peaks) +} +\arguments{ +\item{fitted_peaks}{An object from [fit_peaks()]. + + Un objet de [fit_peaks()].} +} +\value{ +A character value for the peak type fitted to the spectra. + + Une valeur de caractère pour le type de pic ajusté aux spectres. +} +\description{ +Determine the types of peaks used to create the [fit_peaks()] + object. + + Déterminez les types de pics utilisés pour créer l'objet [fit_peaks()]. +} +\keyword{internal} diff --git a/man/get_fit_spectra.Rd b/man/get_fit_spectra.Rd new file mode 100644 index 0000000..2ee9542 --- /dev/null +++ b/man/get_fit_spectra.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{get_fit_spectra} +\alias{get_fit_spectra} +\title{Get Fit Spectra} +\usage{ +get_fit_spectra(ftir, fitted_peaks, peak = NULL) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns + `sample_id`, `wavenumber`, and `absorbance`. + + Un data.frame au format long avec un seul spectre IRTF dans les colonnes + `sample_id`, `wavenumber`, et `absorbance`.} + +\item{fitted_peaks}{An object from [fit_peaks()]. Should match the provided + sample in `ftir`. + + Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans + `ftir`.} + +\item{peak}{A peak index if getting single peak spectra, else returns the sum + of all fitted peaks. + + Un index des pics si l'on obtient des spectres à un seul pic, sinon la + somme de tous les pics ajustés est renvoyée.} +} +\value{ +The calculated absorbance intensities as numeric vector of the same + length as the FTIR spectra. + + Les intensités d'absorption calculées sous forme de tableau numérique de + même longueur que les spectres IRTF. +} +\description{ +Given a fitted peak object and the FTIR source of the fit, + produce a resultant `absorbance` column. Typically used to plot fitted + peaks or calculate residuals. + + Étant donné un objet pic IRTF ajusté et la source IRTF de l'ajustement, + produire une colonne `absorbance` résultante. Généralement utilisé pour + tracer les pics ajustés ou calculer les résidus. +} +\references{ +Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. +(2019) "Spectrum adapted expectation-maximization algorithm for +high-throughput peak shift analysis". Science and technology of advanced +materials, 20(1), pp 733-745. doi:10.1080/14686996.2019.1620123 Matsumura, +T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2021) "Spectrum adapted +expectation-conditional maximization algorithm for extending high–throughput +peak separation method in XPS analysis". Science and Technology of Advanced +Materials: Methods, 1(1), pp 45-55. doi:10.1080/27660400.2021.1899449 +} +\keyword{internal} diff --git a/man/normalize_spectra.Rd b/man/normalize_spectra.Rd index 6b55c2d..f67429f 100644 --- a/man/normalize_spectra.Rd +++ b/man/normalize_spectra.Rd @@ -8,16 +8,16 @@ normalize_spectra(ftir, sample_ids = NA, wavenumber_range = NA) } \arguments{ \item{ftir}{A data.frame of FTIR spectral data including spectra to be -baseline adjusted. +baseline shifted Un data.frame de données spectrales IRTF comprenant les spectres à ajuster à la ligne de base.} -\item{sample_ids}{A vector of sample IDs to be adjusted. All sample IDs must +\item{sample_ids}{A vector of sample IDs to be shifted. All sample IDs must be present in the \code{ftir} data.frame. If adjusting all spectra, provide NA or NULL. Unlisted \code{sample_id} from \code{ftir} will be left alone. -Un vecteur d'ID d'échantillons à ajuster Tous les ID d'échantillons doivent +Un vecteur d'ID d'échantillons à ajuster. Tous les ID d'échantillons doivent être présents dans la base de données \code{ftir} data.frame. Si l'ajustement concerne tous les spectres, fournir NA ou NULL. Les \code{sample_id} non listés de \code{ftir} seront laissés seuls.} diff --git a/man/optimization.Rd b/man/optimization.Rd new file mode 100644 index 0000000..f68662a --- /dev/null +++ b/man/optimization.Rd @@ -0,0 +1,218 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{optimization} +\alias{optimization} +\alias{spect_em_dsgmm} +\alias{spect_em_gmm} +\alias{spect_em_lmm} +\alias{spect_em_pvmm} +\title{Peak Optimization} +\usage{ +spect_em_dsgmm( + x, + y, + mu, + sigma = rep(10, length(mu)), + alpha = rep(0.5, length(mu)), + eta = rep(0.5, length(mu)), + mix_ratio = rep(1/length(mu), length(mu)), + conv_cri = 0.01, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) + +spect_em_gmm( + x, + y, + mu, + sigma = rep(10, length(mu)), + mix_ratio = rep(1/length(mu), length(mu)), + conv_cri = 0.01, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) + +spect_em_lmm( + x, + y, + mu, + gam = rep(10, length(mu)), + mix_ratio = rep(1/length(mu), length(mu)), + conv_cri = 0.01, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) + +spect_em_pvmm( + x, + y, + mu, + sigma = rep(10, length(mu)), + eta = rep(0.5, length(mu)), + mix_ratio = rep(1/length(mu), length(mu)), + conv_cri = 0.01, + maxit = 1000, + fixed_mu = FALSE, + verbose = FALSE +) +} +\arguments{ +\item{x}{A numeric vector of x values (wavenumbers) of the spectra against +which the components are being optimized. + +Un tableau numérique des valeurs x (nombres d'ondes) des spectres par +rapport auxquels les composants sont optimisés.} + +\item{y}{A numeric vector of absorbance values (of same length as \code{x}) of the +spectra against which the components are being optimized. + +A numeric vector of absorbance values (of same length as \code{x}) of the +spectra against which the components are being optimized.} + +\item{mu}{A numeric vector of component peak centers. + +Un tableau numérique des centres de pics des composants.} + +\item{sigma}{A numeric vector of component peak standard deviation (sigma) +values. Must be the same length as \code{mu}. + +Un tableau numérique des valeurs d'écart-type (sigma) des pics des +composants. Doit être de la même longueur que \code{mu}.} + +\item{alpha}{A numeric vector of component proportion asymmetric (alpha) +values. Must all be between 0 and 1. Must be the same length as \code{mu}. + +A numeric vector of component proportion asymmetric (alpha) values. Must +all be between 0 and 1. Must be the same length as \code{mu}.} + +\item{eta}{A numeric vector of component mixing of Gauss and Lorentz +characteristics. Must all be between 0 and 1. Must be the same length as +\code{mu}. + +Un tableau numérique du mélange des composantes des caractéristiques de +Gauss et de Lorentz. Doit être compris entre 0 et 1. Doit être de la même +longueur que \code{mu}.} + +\item{mix_ratio}{A numeric vector of mix ratios (e.g. proportionate area +under the curve) for each component peak. Must be the same length as \code{mu}. + +Un tableau numérique des rapports de mélange (par exemple, l'aire +proportionnelle sous la courbe) pour chaque pic de composant. Doit être de +la même longueur que \code{mu}.} + +\item{conv_cri}{The value (in absolute units) to which convergence is +measured. If sequential optimization cycles differ by less than this +convergence amount, then the resulting parameters are returned. Smaller +values of \code{conv_cri} result in tighter convergence at higher computational +cost. + +La valeur (en unités absolues) à laquelle la convergence est est mesurée. +Si les cycles d'optimisation séquentiels diffèrent de moins de cette valeur +de convergence, les paramètres résultants sont renvoyés. Des valeurs plus +petites de \code{conv_cri} résultent en une convergence plus serrée à un coût de +calcul plus élevé.} + +\item{maxit}{The maximum number of optimization cycles permitted. If +\code{conv_cri} has not been met by the completion of \code{maxit} cycles an error is +returned. + +Le nombre maximum de cycles d'optimisation autorisés. Si \code{conv_cri} n'a pas +été atteint à la fin des cycles \code{maxit}, une erreur est renvoyée.} + +\item{fixed_mu}{Whether to allow peak centers to be moved in optimization +(TRUE) or fixed to the provided values (FALSE). + +Permet de déplacer les centres de pic lors de l'optimisation (VRAI) ou de +les fixer aux valeurs fournies (FAUX).} + +\item{verbose}{Whether to output a status message at the conclusion of each +optimization cycle. + +Indique si un message d'état doit être émis à la fin de chaque cycle +d'optimisation.} + +\item{gam}{A numeric vector of component peak widths (gamma) values. Must be +the same length as \code{mu}. + +Un tableau numérique des valeurs de largeur des pics des composants +(gamma). Doit être de la même longueur que \code{mu}.} +} +\value{ +A named list object, with values corresponding to the optimal peak +location, width, area, and shape parameters (function dependent), as well +as the optimization record of each optimized parameter, count of +optimization iterations, convergence status, and the type of optimization. + +Un objet liste nommé, avec des valeurs correspondant aux paramètres +optimaux d'emplacement, de largeur, de surface et de forme du pic +(dépendant de la fonction), ainsi que l'enregistrement d'optimisation de +chaque paramètre optimisé, le nombre d'itérations d'optimisation, l'état de +convergence et le type d'optimisation. +} +\description{ +Perform peak optimization (component location/wavenumber, +component width, proportional area, and/or shape parameters) for all +provided component peaks against an absorbance intensity. Uses expectation +maximization algorithms from Matsumura \emph{et. al.}. The specific function +called results in different peak types and has different input parameters +to optimize: +\itemize{ +\item \code{\link[=spect_em_gmm]{spect_em_gmm()}} optimizes Gauss shaped component peaks with the parameters: +\itemize{ +\item \code{sigma} - standard deviation (sigma) of the component peak +} +\item \code{\link[=spect_em_lmm]{spect_em_lmm()}} optimizes Lorentz shaped component peaks with the parameters: +\itemize{ +\item \code{gam} - width (gamma) of the peak(s). Can be thought of as standard deviation. +} +\item \code{\link[=spect_em_pvmm]{spect_em_pvmm()}} optimizes pseudo-Voigt shaped component peaks (a blending of Gauss and Lorentz) with the following parameters: +\itemize{ +\item \code{sigma} - standard deviation (sigma) of the component peak +\item \code{eta} - mixing of Gauss and Lorentz distribution for the component (proportion of Lorentz from 0-1) +} +\item \code{\link[=spect_em_dsgmm]{spect_em_dsgmm()}} optimizes Doniach-Šunjić-Gauss shaped component peaks (pseudo-Voigt but can be skew/asymmetrical) with the following parameters: +\itemize{ +\item \code{sigma} - standard deviation (sigma) of the component peak +\item \code{alpha} - proportion asymmetric (0-1) of the component peak +\item \code{eta} - mixing of Gauss and Lorentz distribution for the component (proportion of Lorentz from 0-1) +} + +Optimisation des pics (emplacement des composants/nombre d'ondes, largeur +des composants, surface proportionnelle et/ou paramètres de forme) pour +tous les pics de composants fournis par rapport à une intensité +d'absorption. Utilise les algorithmes de maximisation de l'espérance de +Matsumura \emph{et. al.}. La fonction spécifique appelée produit différents +types de pics et a différents paramètres d'entrée à optimiser : +\item \code{\link[=spect_em_gmm]{spect_em_gmm()}} optimise les pics des composants en forme de Gauss avec les paramètres : +\itemize{ +\item \code{sigma} - écart-type (sigma) du pic de la composante +} +\item \code{\link[=spect_em_lmm]{spect_em_lmm()}} optimise les pics des composants en forme de Lorentz avec les paramètres : +\itemize{ +\item \code{gam} - largeur (gamma) du (des) pic(s). On peut l'assimiler à un écart-type. +} +\item \code{\link[=spect_em_pvmm]{spect_em_pvmm()}} optimise les pics des composantes en forme de pseudo-Voigt (un mélange de Gauss et de Lorentz) avec les paramètres suivants : +\itemize{ +\item \code{sigma} - écart-type (sigma) du pic de la composante +\item \code{eta} - mélange des distributions de Gauss et de Lorentz pour le composant (proportion de Lorentz de 0 à 1) +} +\item \code{\link[=spect_em_dsgmm]{spect_em_dsgmm()}} optimise les pics des composantes en forme de Doniach-Šunjić-Gauss (pseudo-Voigt mais peut être asymétrique/asymétrique) avec les paramètres suivants : +\itemize{ +\item \code{sigma} - écart-type (sigma) du pic de la composante. +\item \code{alpha} - proportion asymétrique (0-1) du pic de la composante +\item \code{eta} - mélange des distributions de Gauss et de Lorentz pour le composant (proportion de Lorentz de 0 à 1) +} +} +} +\references{ +\itemize{ +\item Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2019) "Spectrum adapted expectation-maximization algorithm for high-throughput peak shift analysis". Science and technology of advanced materials, 20(1), pp 733-745. doi:10.1080/14686996.2019.1620123 +\item Matsumura, T., Nagamura, N., Akaho, S., Nagata, K., & Ando, Y. (2021) "Spectrum adapted expectation-conditional maximization algorithm for extending high–throughput peak separation method in XPS analysis". Science and Technology of Advanced Materials: Methods, 1(1), pp 45-55. doi:10.1080/27660400.2021.1899449 +} +} +\seealso{ +\code{\link[=fit_peaks]{fit_peaks()}} +} diff --git a/man/plot_components.Rd b/man/plot_components.Rd new file mode 100644 index 0000000..9d763a9 --- /dev/null +++ b/man/plot_components.Rd @@ -0,0 +1,103 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{plot_components} +\alias{plot_components} +\title{Plot Components} +\usage{ +plot_components(ftir, fitted_peaks, plot_fit = FALSE, lang = NA, ...) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns + `sample_id`, `wavenumber`, and `absorbance`. + + Un data.frame au format long avec un seul spectre IRTF dans les colonnes + `sample_id`, `wavenumber`, et `absorbance`.} + +\item{fitted_peaks}{An object from [fit_peaks()]. Should match the provided + sample in `ftir`. + + Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans + `ftir`.} + +\item{plot_fit}{Boolean, whether to plot the peak fit (default FALSE) + + Booléen, pour savoir s'il faut tracer l'ajustement du pic (par défaut + FALSE)} + +\item{lang}{An optional argument for language. If set to one of `fr`, + `french`, `francais`, or `français` the axis and default plot and legend + titles will change to french. If non-default legend or plot titles are + provided they are used as-is. You can also provide `en`, `english` or + `anglais`, or (the default) `NA` will use the default language from user + options. To set a permanent default, set `options("PlotFTIR.lang" = "en")` + or `options("PlotFTIR.lang" = "fr")` for English or French, respectively. + + Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`, + ou `Français`, l'axe et les titres par défaut de le tracé et du légende + seront en français. Si des titres du légende ou de tracé autres que ceux + par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi + fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le + langue par défaut des options de l'utilisateur. Pour définir une valeur + par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou + `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français, + respectivement.} + +\item{...}{optional argument `fitted_sample_name` for naming the fitted peaks + on the plot, or extra parameters to pass to [PlotFTIR::plot_ftir()]. + + Argument optionnel `fitted_sample_name` pour nommer les pics ajustés sur le + graphique, ou des paramètres supplémentaires à passer à + [PlotFTIR::plot_ftir()].} +} +\value{ +A [PlotFTIR] graphic with residuals plotted against wavenumber + +Un graphique [PlotFTIR] avec les résidus tracés en fonction du nombre d'ondes +} +\description{ +Produces a plot of components of the peak fitting results. + + Produit un graphique des composantes des résultats de l'ajustement des + pics. +} +\examples{ +# Load the isopropanol sample spectrum from the PlotFTIR package +ftir_data <- PlotFTIR::sample_spectra[ + PlotFTIR::sample_spectra$sample_id == "isopropanol", +] + +#' # Choose a subset of the data (reducing run time) +ftir_data <- ftir_data[ + ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +] + +# First, fit the peaks using the default 'voigt' method +fitted_voigt <- fit_peaks(ftir_data, method = "voigt") + +# --- Example 1: Plot components only (default) --- +\dontrun{ + plot_components(ftir_data, fitted_voigt) +} + +# --- Example 2: Plot components AND the overall fitted sum --- +\dontrun{ + plot_components(ftir_data, fitted_voigt, plot_fit = TRUE) +} + +# --- Example 3: Plot components and fit with custom titles and name --- +\dontrun{ + plot_components( + ftir_data, + fitted_voigt, + plot_fit = TRUE, + plot_title = c("Isopropanol Peak Fit", "Voigt Components"), + legend_title = "Spectrum Type", + fitted_sample_name = "Total Fit (Voigt)" + ) +} + +# --- Example 4: Plot components in French --- +\dontrun{ + plot_components(ftir_data, fitted_voigt, plot_fit = TRUE, lang = "fr") +} +} diff --git a/man/plot_fit_ftir_peaks.Rd b/man/plot_fit_ftir_peaks.Rd new file mode 100644 index 0000000..3e355ba --- /dev/null +++ b/man/plot_fit_ftir_peaks.Rd @@ -0,0 +1,115 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{plot_fit_ftir_peaks} +\alias{plot_fit_ftir_peaks} +\title{Plot Fitted Peaks} +\usage{ +plot_fit_ftir_peaks( + ftir, + fitted_peaks, + plot_components = FALSE, + lang = NA, + ... +) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns + `sample_id`, `wavenumber`, and `absorbance`. + + Un data.frame au format long avec un seul spectre IRTF dans les colonnes + `sample_id`, `wavenumber`, et `absorbance`.} + +\item{fitted_peaks}{An object from [fit_peaks()]. Should match the provided + sample in `ftir`. + + Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans + `ftir`.} + +\item{plot_components}{Boolean, whether to include the component peaks (see + [plot_components()]). + + Booléen, pour savoir s'il faut inclure les pics des composants (voir + [plot_components()]).} + +\item{lang}{An optional argument for language. If set to one of `fr`, + `french`, `francais`, or `français` the axis and default plot and legend + titles will change to french. If non-default legend or plot titles are + provided they are used as-is. You can also provide `en`, `english` or + `anglais`, or (the default) `NA` will use the default language from user + options. To set a permanent default, set `options("PlotFTIR.lang" = "en")` + or `options("PlotFTIR.lang" = "fr")` for English or French, respectively. + + Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`, + ou `Français`, l'axe et les titres par défaut de le tracé et du légende + seront en français. Si des titres du légende ou de tracé autres que ceux + par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi + fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le + langue par défaut des options de l'utilisateur. Pour définir une valeur + par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou + `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français, + respectivement.} + +\item{...}{Optional argument `fitted_sample_name` for naming the fitted peaks + on the plot, or extra parameters to pass to [PlotFTIR::plot_ftir()]. + + Argument optionnel `fitted_sample_name` pour nommer les pics ajustés sur le + graphique, ou des paramètres supplémentaires à passer à + [PlotFTIR::plot_ftir()].} +} +\value{ +A [PlotFTIR::plot_ftir()] graphic. + + Un graphique [PlotFTIR::plot_ftir()]. +} +\description{ +Plot the spectra and sum of fitted peaks from [fit_peaks()] + using [PlotFTIR::plot_ftir()]. + + Tracez les spectres et la somme des pics ajustés à partir de [fit_peaks()] + en utilisant [PlotFTIR::plot_ftir()]. +} +\examples{ +# Load the isopropanol sample spectrum from the PlotFTIR package +ftir_data <- PlotFTIR::sample_spectra[ + PlotFTIR::sample_spectra$sample_id == "isopropanol", +] + +# Choose a subset of the data (reducing run time) +ftir_data <- ftir_data[ + ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +] + +# First, fit the peaks using the default 'voigt' method +fitted_voigt <- fit_peaks(ftir_data, method = "voigt") + +# --- Example 1: Plot original spectrum and the overall fitted sum --- +\dontrun{ + plot_fit_ftir_peaks(ftir_data, fitted_voigt) +} + +# --- Example 2: Plot original, overall fit, AND individual components --- +# This internally calls plot_components() with plot_fit = TRUE +\dontrun{ + plot_fit_ftir_peaks(ftir_data, fitted_voigt, plot_components = TRUE) +} + +# --- Example 3: Plot original and fit with custom titles and name --- +\dontrun{ + plot_fit_ftir_peaks( + ftir_data, + fitted_voigt, + plot_title = c("Isopropanol Fit Comparison", "Original vs. Voigt Sum"), + legend_title = "Spectrum Source", + fitted_sample_name = "Total Voigt Fit" + ) +} + +# --- Example 4: Plot original and fit in French --- +\dontrun{ + plot_fit_ftir_peaks(ftir_data, fitted_voigt, lang = "fr") +} + +} +\seealso{ +[PlotFTIR::plot_ftir()] +} diff --git a/man/plot_fit_residuals.Rd b/man/plot_fit_residuals.Rd new file mode 100644 index 0000000..8bc0b50 --- /dev/null +++ b/man/plot_fit_residuals.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/peak-fit.R +\name{plot_fit_residuals} +\alias{plot_fit_residuals} +\title{Plot Residuals} +\usage{ +plot_fit_residuals(ftir, fitted_peaks, lang = NA, ...) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns + `sample_id`, `wavenumber`, and `absorbance`. + + Un data.frame au format long avec un seul spectre IRTF dans les colonnes + `sample_id`, `wavenumber`, et `absorbance`.} + +\item{fitted_peaks}{An object from [fit_peaks()]. Should match the provided + sample in `ftir`. + + Un objet de [fit_peaks()]. Doit correspondre à l'échantillon fourni dans + `ftir`.} + +\item{lang}{An optional argument for language. If set to one of `fr`, + `french`, `francais`, or `français` the axis and default plot and legend + titles will change to french. If non-default legend or plot titles are + provided they are used as-is. You can also provide `en`, `english` or + `anglais`, or (the default) `NA` will use the default language from user + options. To set a permanent default, set `options("PlotFTIR.lang" = "en")` + or `options("PlotFTIR.lang" = "fr")` for English or French, respectively. + + Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`, + ou `Français`, l'axe et les titres par défaut de le tracé et du légende + seront en français. Si des titres du légende ou de tracé autres que ceux + par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi + fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le + langue par défaut des options de l'utilisateur. Pour définir une valeur + par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou + `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français, + respectivement.} + +\item{...}{optional argument `fitted_sample_name` for naming the fitted peaks + on the plot, or extra parameters to pass to [PlotFTIR::plot_ftir()]. + + Argument optionnel `fitted_sample_name` pour nommer les pics ajustés sur le + graphique, ou des paramètres supplémentaires à passer à + [PlotFTIR::plot_ftir()].} +} +\value{ +A [PlotFTIR::plot_ftir()] graphic with residuals plotted against + wavenumber. + + Un graphique [PlotFTIR::plot_ftir()] avec les résidus tracés en fonction du + nombre d'ondes. +} +\description{ +Produce a plot of the error between predicted and actual FTIR +spectra. + +Produisez un graphique de l'erreur entre les spectres IRTF prédits et réels. +} +\examples{ +# Load the isopropanol sample spectrum from the PlotFTIR package +ftir_data <- PlotFTIR::sample_spectra[ + PlotFTIR::sample_spectra$sample_id == "isopropanol", +] + +# Choose a subset of the data (reducing run time) +ftir_data <- ftir_data[ + ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, +] + +# First, fit the peaks using the default 'voigt' method +fitted_voigt <- fit_peaks(ftir_data, method = "voigt") + +# --- Example 1: Plot residuals with default settings --- +\dontrun{ + plot_fit_residuals(ftir_data, fitted_voigt) +} + +# --- Example 2: Plot residuals with custom titles in French --- +\dontrun{ + plot_fit_residuals( + ftir_data, + fitted_voigt, + lang = "fr", + plot_title = c( + "R\u00e9sidus de l'ajustement", + "Diff\u00e9rence entre le spectre et l'ajustement Voigt" + ) + ) +} + +} diff --git a/man/remove_continuum_ftir.Rd b/man/remove_continuum_ftir.Rd new file mode 100644 index 0000000..5fa3c0a --- /dev/null +++ b/man/remove_continuum_ftir.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/maths.R +\name{remove_continuum_ftir} +\alias{remove_continuum_ftir} +\title{Remove Continuum from FTIR Spectra} +\usage{ +remove_continuum_ftir(ftir, type = "spline", application = "subtraction", ...) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns + `sample_id`, `wavenumber`, and `absorbance` or `transmittance`. + + Un data.frame au format long avec un seul spectre IRTF dans les colonnes + `sample_id`, `wavenumber`, et `absorbance` ou `transmittance`.} + +\item{type}{The type of interpolation to use for the continuum. Options are + `spline` (default) or `linear`. + + Le type d'interpolation à utiliser pour le continuum. Les options sont + `spline` (par défaut) ou `linear`.} + +\item{application}{How to apply the continuum to the spectra. Options are + `subtraction` (default) or `division`. + + Comment appliquer le continuum aux spectres. Les options sont `subtraction` + (par défaut) ou `division`.} + +\item{...}{Additional arguments (currently unused). + + Arguments supplémentaires (actuellement inutilisés).} +} +\value{ +A data.frame with the continuum removed from the spectra. The + `absorbance` or `transmittance` column will be modified. + + Un data.frame avec le continuum supprimé des spectres. La colonne + `absorbance` ou `transmittance` sera modifiée. +} +\description{ +This function removes the continuum from FTIR spectra using + either spline or linear interpolation. The continuum is defined as the + convex hull of the spectrum, and is either subtracted or divided from the + original spectrum. This is a common preprocessing step in reflectance + spectroscopy to highlight absorption features. + + Cette fonction supprime le continuum des spectres IRTF en utilisant une + interpolation spline ou linéaire. Le continuum est défini comme l'enveloppe + convexe du spectre, et est soit soustrait, soit divisé du spectre original. + Il s'agit d'une étape de prétraitement courante en spectroscopie de + réflectance pour mettre en évidence les caractéristiques d'absorption. +} +\examples{ +# Load the isopropanol sample spectrum +ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", +] + +# Remove the continuum using spline interpolation and subtraction +ftir_no_continuum <- remove_continuum_ftir(ftir_data) + +# Remove the continuum using linear interpolation and division +ftir_no_continuum_linear_div <- remove_continuum_ftir( + ftir_data, + type = "linear", + application = "division" +) +} +\references{ +Clark, R.N. and Roush, T.L. (1984) J. Geophysical Res. 89 pp + 6329-6340 +} diff --git a/man/recalculate_baseline.Rd b/man/shift_baseline.Rd similarity index 79% rename from man/recalculate_baseline.Rd rename to man/shift_baseline.Rd index 9019c70..4e25cec 100644 --- a/man/recalculate_baseline.Rd +++ b/man/shift_baseline.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/maths.R -\name{recalculate_baseline} -\alias{recalculate_baseline} -\title{Recalculate Baseline} +\name{shift_baseline} +\alias{shift_baseline} +\title{Shift Baseline} \usage{ -recalculate_baseline( +shift_baseline( ftir, sample_ids = NA, wavenumber_range = NA, @@ -14,16 +14,16 @@ recalculate_baseline( } \arguments{ \item{ftir}{A data.frame of FTIR spectral data including spectra to be -baseline adjusted. +baseline shifted Un data.frame de données spectrales IRTF comprenant les spectres à ajuster à la ligne de base.} -\item{sample_ids}{A vector of sample IDs to be adjusted. All sample IDs must +\item{sample_ids}{A vector of sample IDs to be shifted. All sample IDs must be present in the \code{ftir} data.frame. If adjusting all spectra, provide NA or NULL. Unlisted \code{sample_id} from \code{ftir} will be left alone. -Un vecteur d'ID d'échantillons à ajuster Tous les ID d'échantillons doivent +Un vecteur d'ID d'échantillons à ajuster. Tous les ID d'échantillons doivent être présents dans la base de données \code{ftir} data.frame. Si l'ajustement concerne tous les spectres, fournir NA ou NULL. Les \code{sample_id} non listés de \code{ftir} seront laissés seuls.} @@ -69,19 +69,19 @@ or 100 for transmittance) to aid in plotting the spectra. This can be done for all samples or a subset, using the same shift for all adjusted samples or calculated individually. -Recalculate or shift to baseline/max transmittance can be done following +Shift to baseline/max transmittance can be done following one of a few methods: \itemize{ \item To shift baseline based on the value at a given wavenumber: -\verb{recalculate_baseline(ftir, wavenumber_range = [numeric], method = 'point')} +\verb{shift_baseline(ftir, wavenumber_range = [numeric], method = 'point')} \item To shift baseline based on the average value across a provided wavenumber range: -\verb{recalculate_baseline(ftir, wavenumber_range = c([numeric], [numeric]), method = 'average')} +\verb{shift_baseline(ftir, wavenumber_range = c([numeric], [numeric]), method = 'average')} \item To shift baseline based on the value at the single lowest point of absorbance (or highest point of transmittance) across the whole spectra -\code{recalculate_baseline(ftir, method = 'minimum')} +\code{shift_baseline(ftir, method = 'minimum')} \item To shift baseline based on the value at the single lowest point of absorbance (or highest point of transmittance) in a given range -\verb{recalculate_baseline(ftir, wavenumber_range = c([numeric], [numeric]), method = 'minimum')} +\verb{shift_baseline(ftir, wavenumber_range = c([numeric], [numeric]), method = 'minimum')} } To perform the exact same baseline adjustment on all samples, specify @@ -94,20 +94,20 @@ spectres. Cela peut être fait pour tous les échantillons ou un sous-ensemble, en utilisant le même décalage pour tous les échantillons ajustés ou calculés individuellement. -Le recalcul ou le décalage de la ligne de base/transmittance maximale peut +Le décalage de la ligne de base/transmittance maximale peut être effectué en suivant l'une des méthodes suivantes : \itemize{ \item Pour décaler la ligne de base en fonction de la valeur à un nombre d'ondes donné : -\verb{recalculate_baseline(ftir, wavenumber_range = [numeric], method = 'point')} +\verb{shift_baseline(ftir, wavenumber_range = [numeric], method = 'point')} \item Pour décaler la ligne de base en fonction de la valeur moyenne sur un nombre -d'ondes donné : #' \verb{recalculate_baseline(ftir) = [numerique], method = 'point') }recalculate_baseline(ftir, wavenumber_range = c(\link{numeric}, \link{numeric}), +d'ondes donné : #' \verb{shift_baseline(ftir) = [numerique], method = 'point') }shift_baseline(ftir, wavenumber_range = c(\link{numeric}, \link{numeric}), method = 'average')` \item Pour décaler la ligne de base en fonction de la valeur du point d'absorbance le plus bas (ou du point de transmittance le plus élevé) sur l'ensemble des spectres. -\code{recalculate_baseline(ftir, method = 'minimum')} +\code{shift_baseline(ftir, method = 'minimum')} \item Décaler la ligne de base en fonction de la valeur du point d'absorbance le plus bas (ou du point de transmittance le plus élevé) dans une gamme donnée. -\verb{recalculate_baseline(ftir, wavenumber_range = c([numeric], [numeric]), method = 'minimum')} +\verb{shift_baseline(ftir, wavenumber_range = c([numeric], [numeric]), method = 'minimum')} Pour effectuer exactement le même ajustement de la ligne de base sur tous les échantillons, spécifiez \code{individually = FALSE}. Pour ajuster avec une @@ -116,5 +116,5 @@ détermination unique pour chaque échantillon, spécifiez \code{individualy = T } \examples{ # Adjust the biodiesel spectra to minimum for each sample -recalculate_baseline(biodiesel, method = "minimum", individually = TRUE) +shift_baseline(biodiesel, method = "minimum", individually = TRUE) } diff --git a/man/smooth_ftir.Rd b/man/smooth_ftir.Rd new file mode 100644 index 0000000..f89f33d --- /dev/null +++ b/man/smooth_ftir.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/maths.R +\name{smooth_ftir} +\alias{smooth_ftir} +\title{Smooth FTIR with Savitzky-Golay filter} +\usage{ +smooth_ftir(ftir, polynomial = 2, points = 13, derivative = 0) +} +\arguments{ +\item{ftir}{A data.frame in long format with a single FTIR spectra in columns + `sample_id`, `wavenumber`, and `absorbance`. The `absorbance` column may be + replaced by a `transmittance` column for transmittance plots. + + Un data.frame au format long avec un seul spectre IRTF dans les colonnes + `sample_id`, `wavenumber`, et `absorbance`. La colonne `absorbance` peut + être remplacée par une colonne `transmittance` pour les tracés de + transmittance.} + +\item{polynomial}{Savitzky-Golay polynomial term. + + Terme polynomial de Savitzky-Golay.} + +\item{points}{Savitzky-Golay points term. + + Terme de points de Savitzky-Golay} + +\item{derivative}{Which derivative to return (default = 0 to smooth spectrum, + but can alos determine smoothed derivatives) + + Dérivée à retourner (par défaut = 0 pour lisser le spectre, mais on peut + aussi déterminer des dérivées lissées)} +} +\value{ +a data.frame with an FTIR spectrum, smoothed (or the derivative) + + un data.frame avec un FTIR lissé, lissé (ou la dérivée lissée) +} +\description{ +Smooth FTIR with Savitzky-Golay filter +} +\examples{ +# Load the isopropanol sample spectrum +ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", +] + +# Apply smoothing +ftir_smoothed <- smooth_ftir(ftir_data) +# --- Optional: Visualize the results --- +\dontrun{ + plot_ftir(ftir_smoothed, plot_title = "Smoothed FTIR") +} +} +\references{ +* Savitzky, A.; Golay, M.J.E. (1964). "Smoothing and Differentiation of Data by Simplified Least Squares Procedures". Analytical Chemistry 36. pp. 1627–1639. doi:10.1021/ac60214a047 +} +\seealso{ +[signal::sgolayfilt()] +} diff --git a/tests/testthat/test-maths.R b/tests/testthat/test-maths.R index ddfe934..13c9a36 100644 --- a/tests/testthat/test-maths.R +++ b/tests/testthat/test-maths.R @@ -238,43 +238,43 @@ test_that("add_subtract_scalar_value works", { test_that("Baseline error checking works", { expect_error( - recalculate_baseline("not_a_dataframe"), + shift_baseline("not_a_dataframe"), regexp = "must be a data frame. You provided a string", fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, method = "failure"), + shift_baseline(biodiesel, method = "failure"), regexp = "must be a string", fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, individually = "failure"), + shift_baseline(biodiesel, individually = "failure"), regexp = "must be a boolean value", fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, sample_ids = "A"), + shift_baseline(biodiesel, sample_ids = "A"), regexp = "All provided `sample_ids` must be in `ftir` data.", fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, wavenumber_range = c(1, 2, 3)), + shift_baseline(biodiesel, wavenumber_range = c(1, 2, 3)), regexp = "must be of length 1 or 2", fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, wavenumber_range = c("one", "two")), + shift_baseline(biodiesel, wavenumber_range = c("one", "two")), regexp = "`wavenumber_range` must be `numeric` or `NA`.", fixed = TRUE ) expect_error( - recalculate_baseline( + shift_baseline( biodiesel, method = "point", wavenumber_range = c(1, 2) @@ -283,24 +283,24 @@ test_that("Baseline error checking works", { fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, method = "point", wavenumber_range = NA), + shift_baseline(biodiesel, method = "point", wavenumber_range = NA), regexp = "must be a single numeric value", fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, method = "minimum", wavenumber_range = 1), + shift_baseline(biodiesel, method = "minimum", wavenumber_range = 1), regexp = "or two numeric values if `method = 'minimum'`", fixed = TRUE ) expect_error( - recalculate_baseline(biodiesel, method = "maximum", wavenumber_range = 1), + shift_baseline(biodiesel, method = "maximum", wavenumber_range = 1), regexp = "or two numeric values if `method = 'maximum'`", fixed = TRUE ) expect_error( - recalculate_baseline( + shift_baseline( biodiesel, method = "average", wavenumber_range = 1500 @@ -318,12 +318,12 @@ test_that("Baseline - average works", { ) expect_warning( - recalculate_baseline(ftir_data, method = "average", individually = TRUE), + shift_baseline(ftir_data, method = "average", individually = TRUE), regexp = "Adjusting spectra baseline by the average of all values is not analytically useful", fixed = TRUE ) suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", individually = TRUE @@ -341,7 +341,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", individually = FALSE @@ -358,7 +358,7 @@ test_that("Baseline - average works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", wavenumber_range = c(1000, 1025), @@ -379,7 +379,7 @@ test_that("Baseline - average works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", wavenumber_range = c(1000, 1025), @@ -401,7 +401,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "average", @@ -420,7 +420,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "average", @@ -439,7 +439,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "average", @@ -462,7 +462,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "average", @@ -488,12 +488,12 @@ test_that("Baseline - average works", { ftir_data$absorbance <- NULL expect_warning( - recalculate_baseline(ftir_data, method = "average", individually = TRUE), + shift_baseline(ftir_data, method = "average", individually = TRUE), regexp = "Adjusting spectra baseline by the average of all values is not analytically useful", fixed = TRUE ) suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", individually = TRUE @@ -511,7 +511,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", individually = FALSE @@ -528,7 +528,7 @@ test_that("Baseline - average works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", wavenumber_range = c(1000, 1025), @@ -549,7 +549,7 @@ test_that("Baseline - average works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "average", wavenumber_range = c(1000, 1025), @@ -571,7 +571,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "average", @@ -590,7 +590,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "average", @@ -609,7 +609,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "average", @@ -632,7 +632,7 @@ test_that("Baseline - average works", { expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") suppressWarnings( - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "average", @@ -662,7 +662,7 @@ test_that("Baseline - point works", { absorbance = c(0.1, 0.2, 0.3, 0.2, 0.3, 0.4, 0.3, 0.4, 0.5) ) - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "point", wavenumber_range = 1000, @@ -680,7 +680,7 @@ test_that("Baseline - point works", { expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") suppressWarnings(expect_warning( - recalculate_baseline( + shift_baseline( ftir_data, method = "point", wavenumber_range = 500, @@ -691,7 +691,7 @@ test_that("Baseline - point works", { )) suppressWarnings(expect_warning( - recalculate_baseline( + shift_baseline( ftir_data, method = "point", wavenumber_range = 1012.5, @@ -701,7 +701,7 @@ test_that("Baseline - point works", { fixed = TRUE )) - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "point", wavenumber_range = 1000, @@ -718,7 +718,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "point", @@ -736,7 +736,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "point", @@ -754,7 +754,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "point", @@ -776,7 +776,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "point", @@ -801,7 +801,7 @@ test_that("Baseline - point works", { ftir_data$transmittance <- c(90, 80, 70, 80, 70, 60, 70, 60, 50) ftir_data$absorbance <- NULL - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "point", wavenumber_range = 1000, @@ -818,7 +818,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "point", wavenumber_range = 1000, @@ -835,7 +835,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "point", @@ -853,7 +853,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "point", @@ -871,7 +871,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "point", @@ -893,7 +893,7 @@ test_that("Baseline - point works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "point", @@ -923,7 +923,7 @@ test_that("Baseline - minimum/maximum works", { absorbance = c(0.1, 0.2, 0.3, 0.2, 0.3, 0.4, 0.3, 0.4, 0.5) ) - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "minimum", individually = TRUE @@ -938,12 +938,12 @@ test_that("Baseline - minimum/maximum works", { c(0, 0.1, 0.2) ) expect_equal( - recalculate_baseline(ftir_data, method = "minimum", individually = TRUE), - recalculate_baseline(ftir_data, method = "maximum", individually = TRUE) + shift_baseline(ftir_data, method = "minimum", individually = TRUE), + shift_baseline(ftir_data, method = "maximum", individually = TRUE) ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "minimum", individually = FALSE @@ -958,12 +958,12 @@ test_that("Baseline - minimum/maximum works", { c(0.1, 0.2, 0.3) ) expect_equal( - recalculate_baseline(ftir_data, method = "minimum", individually = FALSE), - recalculate_baseline(ftir_data, method = "maximum", individually = FALSE) + shift_baseline(ftir_data, method = "minimum", individually = FALSE), + shift_baseline(ftir_data, method = "maximum", individually = FALSE) ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "minimum", @@ -979,13 +979,13 @@ test_that("Baseline - minimum/maximum works", { c(0.2, 0.3, 0.4) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "minimum", individually = TRUE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "maximum", @@ -994,7 +994,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "minimum", @@ -1010,13 +1010,13 @@ test_that("Baseline - minimum/maximum works", { c(0.2, 0.3, 0.4) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "minimum", individually = FALSE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "maximum", @@ -1025,7 +1025,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", @@ -1045,13 +1045,13 @@ test_that("Baseline - minimum/maximum works", { c(0.3, 0.4, 0.5) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", individually = TRUE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1060,7 +1060,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", @@ -1080,13 +1080,13 @@ test_that("Baseline - minimum/maximum works", { c(0.3, 0.4, 0.5) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", individually = FALSE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1095,7 +1095,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), wavenumber_range = c(1030, 1050), @@ -1116,14 +1116,14 @@ test_that("Baseline - minimum/maximum works", { c(0.3, 0.4, 0.5) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", wavenumber_range = c(1030, 1050), individually = TRUE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1133,7 +1133,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "absorbance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), wavenumber_range = c(1030, 1050), @@ -1154,14 +1154,14 @@ test_that("Baseline - minimum/maximum works", { c(0.3, 0.4, 0.5) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", wavenumber_range = c(1030, 1050), individually = FALSE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1174,7 +1174,7 @@ test_that("Baseline - minimum/maximum works", { ftir_data$transmittance <- c(90, 80, 70, 80, 70, 60, 70, 60, 50) ftir_data$absorbance <- NULL - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "minimum", individually = TRUE @@ -1189,12 +1189,12 @@ test_that("Baseline - minimum/maximum works", { c(100, 90, 80) ) expect_equal( - recalculate_baseline(ftir_data, method = "minimum", individually = TRUE), - recalculate_baseline(ftir_data, method = "maximum", individually = TRUE) + shift_baseline(ftir_data, method = "minimum", individually = TRUE), + shift_baseline(ftir_data, method = "maximum", individually = TRUE) ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, method = "minimum", individually = FALSE @@ -1209,12 +1209,12 @@ test_that("Baseline - minimum/maximum works", { c(90, 80, 70) ) expect_equal( - recalculate_baseline(ftir_data, method = "minimum", individually = FALSE), - recalculate_baseline(ftir_data, method = "maximum", individually = FALSE) + shift_baseline(ftir_data, method = "minimum", individually = FALSE), + shift_baseline(ftir_data, method = "maximum", individually = FALSE) ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "minimum", @@ -1230,13 +1230,13 @@ test_that("Baseline - minimum/maximum works", { c(80, 70, 60) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "minimum", individually = TRUE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "maximum", @@ -1245,7 +1245,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = "A", method = "minimum", @@ -1261,13 +1261,13 @@ test_that("Baseline - minimum/maximum works", { c(80, 70, 60) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "minimum", individually = FALSE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = "A", method = "maximum", @@ -1276,7 +1276,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", @@ -1296,13 +1296,13 @@ test_that("Baseline - minimum/maximum works", { c(70, 60, 50) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", individually = TRUE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1311,7 +1311,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", @@ -1331,13 +1331,13 @@ test_that("Baseline - minimum/maximum works", { c(70, 60, 50) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", individually = FALSE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1346,7 +1346,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), wavenumber_range = c(1030, 1050), @@ -1367,14 +1367,14 @@ test_that("Baseline - minimum/maximum works", { c(70, 60, 50) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", wavenumber_range = c(1030, 1050), individually = TRUE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1384,7 +1384,7 @@ test_that("Baseline - minimum/maximum works", { ) expect_equal(attr(recalculated_ftir, "intensity"), "transmittance") - recalculated_ftir <- recalculate_baseline( + recalculated_ftir <- shift_baseline( ftir_data, sample_ids = c("A", "B"), wavenumber_range = c(1030, 1050), @@ -1405,14 +1405,14 @@ test_that("Baseline - minimum/maximum works", { c(70, 60, 50) ) expect_equal( - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "minimum", wavenumber_range = c(1030, 1050), individually = FALSE ), - recalculate_baseline( + shift_baseline( ftir_data, sample_ids = c("A", "B"), method = "maximum", @@ -1605,7 +1605,7 @@ test_that("Normalization carries thorugh other functions", { ) expect_equal( attr( - recalculate_baseline( + shift_baseline( biodiesel_normal, method = "point", wavenumber_range = 3900 @@ -1620,3 +1620,279 @@ test_that("Normalization carries thorugh other functions", { "normalized transmittance" ) }) + + +test_that("baseline_ftir returns a data.frame with same number of rows", { + test_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + expect_equal(nrow(baseline_ftir(test_data)), nrow(test_data)) + expect_equal( + unique(baseline_ftir(test_data)$sample_id), + unique(test_data$sample_id) + ) + expect_equal(baseline_ftir(test_data)$wavenumber, test_data$wavenumber) +}) + +test_that("baseline_ftir corrects attributes", { + test_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + baselined <- baseline_ftir(test_data) + + expect_equal("baselined", attr(baselined, "treatment")) + + #make sure the attr is appended and not overwriting + smooth_baselined <- baseline_ftir(smooth_ftir(test_data)) + expect_true(grepl("baselined", attr(smooth_baselined, "treatment"))) + expect_true(grepl("smoothed", attr(smooth_baselined, "treatment"))) +}) + +test_that("baseline_ftir error check is ok", { + test_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + expect_error( + baseline_ftir(test_data, method = "fake"), + "should be one of which the" + ) + expect_warning( + baseline_ftir(test_data, method = "TAP"), + "was not designed for use with FTIR data" + ) + expect_warning( + baseline_ftir(baseline_ftir(test_data)), + "Repeat baseline adjustment of spectra may produce unexpected results" + ) + + test_data <- absorbance_to_transmittance(test_data) + + expect_message( + transbaseline <- baseline_ftir(test_data), + "Baselining with transmittance spectra may not behave as expected" + ) + expect_equal(transbaseline$wavenumber, test_data$wavenumber) +}) + +test_that("remove_continuum_ftir works with default parameters (spline, subtraction)", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + result <- remove_continuum_ftir(ftir_data) + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "absorbance", "sample_id")) + expect_true(all(is.numeric(result$absorbance))) + expect_true(all(is.numeric(result$wavenumber))) + expect_true(all(is.character(result$sample_id))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir works with linear interpolation", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + result <- remove_continuum_ftir(ftir_data, type = "linear") + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "absorbance", "sample_id")) + expect_true(all(is.numeric(result$absorbance))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir works with division", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + result <- remove_continuum_ftir(ftir_data, application = "division") + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "absorbance", "sample_id")) + expect_true(all(is.numeric(result$absorbance))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir works with linear interpolation and division", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + result <- remove_continuum_ftir( + ftir_data, + type = "linear", + application = "division" + ) + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "absorbance", "sample_id")) + expect_true(all(is.numeric(result$absorbance))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir throws error for invalid application", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + expect_error( + remove_continuum_ftir(ftir_data, application = "invalid"), + '`application` must be either "subtraction" or "division"' + ) +}) + +test_that("remove_continuum_ftir throws error for invalid type", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + expect_error( + remove_continuum_ftir(ftir_data, type = "invalid"), + '`type` must be either "spline" or "linear"' + ) +}) + +test_that("remove_continuum_ftir warns when continuum has already been removed", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + result <- remove_continuum_ftir(ftir_data) + expect_warning( + remove_continuum_ftir(result), + regexp = "Spectra have previously had continuum removed" + ) +}) + +test_that("remove_continuum_ftir works after other treatments.", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + result <- remove_continuum_ftir(baseline_ftir(ftir_data)) + expect_s3_class(result, "data.frame") + expect_true(grepl("continuum removed", attr(result, "treatment"))) + expect_true(grepl("baselined", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir works with transmittance data", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir_data_transmittance <- absorbance_to_transmittance(ftir_data) + result <- remove_continuum_ftir(ftir_data_transmittance) + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "transmittance", "sample_id")) + expect_true(all(is.numeric(result$transmittance))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir works with transmittance data and division", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir_data_transmittance <- absorbance_to_transmittance(ftir_data) + result <- remove_continuum_ftir( + ftir_data_transmittance, + application = "division" + ) + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "transmittance", "sample_id")) + expect_true(all(is.numeric(result$transmittance))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir works with transmittance data and linear", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir_data_transmittance <- absorbance_to_transmittance(ftir_data) + result <- remove_continuum_ftir(ftir_data_transmittance, type = "linear") + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "transmittance", "sample_id")) + expect_true(all(is.numeric(result$transmittance))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + +test_that("remove_continuum_ftir works with transmittance data, linear and division", { + ftir_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir_data_transmittance <- absorbance_to_transmittance(ftir_data) + result <- remove_continuum_ftir( + ftir_data_transmittance, + type = "linear", + application = "division" + ) + expect_s3_class(result, "data.frame") + expect_equal(colnames(result), c("wavenumber", "transmittance", "sample_id")) + expect_true(all(is.numeric(result$transmittance))) + expect_true("treatment" %in% names(attributes(result))) + expect_true(grepl("continuum removed", attr(result, "treatment"))) +}) + + +test_that("smooth_ftir returns a data.frame with same number of rows", { + test_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + expect_equal( + nrow(smooth_ftir(test_data, polynomial = 2, points = 13, derivative = 0)), + nrow(test_data) + ) + expect_equal( + unique( + smooth_ftir( + test_data, + polynomial = 2, + points = 13, + derivative = 0 + )$sample_id + ), + unique(test_data$sample_id) + ) + expect_equal( + smooth_ftir( + test_data, + polynomial = 2, + points = 13, + derivative = 0 + )$wavenumber, + test_data$wavenumber + ) + test_data <- absorbance_to_transmittance(test_data) + expect_equal( + smooth_ftir( + test_data, + polynomial = 2, + points = 13, + derivative = 0 + )$wavenumber, + test_data$wavenumber + ) +}) + +test_that("smooth_ftir checks repeat calls", { + test_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + smooth_propanol <- smooth_ftir(test_data) + + expect_warning( + smooth_ftir(smooth_propanol), + "Spectra have been previously smoothed." + ) +}) + +test_that("smooth_ftir corrects attributes", { + test_data <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + smoothed <- smooth_ftir(test_data) + + expect_equal("smoothed", attr(smoothed, "treatment")) + + #make sure the attr is appended and not overwriting + smooth_baselined <- smooth_ftir(baseline_ftir(test_data)) + expect_true(grepl("baselined", attr(smooth_baselined, "treatment"))) + expect_true(grepl("smoothed", attr(smooth_baselined, "treatment"))) +}) diff --git a/tests/testthat/test-peak-fit.R b/tests/testthat/test-peak-fit.R new file mode 100644 index 0000000..ad3b6dc --- /dev/null +++ b/tests/testthat/test-peak-fit.R @@ -0,0 +1,1030 @@ +test_that("find_ftir_peaks handles input errors ok", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = seq(4000, 400, length.out = 100), + absorbance = rnorm(100) + ) + expect_error(find_ftir_peaks(ftir), NA) # No error expected + expect_error( + find_ftir_peaks(ftir, zero_norm = "non-numeric"), + "`zero_norm` must be numeric" + ) # incorrect argument + expect_error( + find_ftir_peaks(ftir, zero_deriv = "non-numeric"), + "`zero_deriv` must be numeric" + ) # incorrect argumenet + + # Multiple sample spectra passed in + ftir <- data.frame( + sample_id = c(rep("sample1", 50), rep("sample2", 50)), + wavenumber = seq(4000, 400, length.out = 100), + absorbance = rnorm(100) + ) + expect_error(find_ftir_peaks(ftir), "must only contain one sample spectra") + + # Transmission spectra passed in + ftir <- data.frame( + sample_id = "sample1", + wavenumber = seq(4000, 400, length.out = 100), + transmittance = runif(100, min = 10, max = 100) + ) + expect_error(find_ftir_peaks(ftir), NA) # should be no error +}) + + +test_that("find_ftir_peaks returns sorted peaks", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = seq(4000, 400, length.out = 100), + absorbance = rnorm(100) + ) + peaks <- find_ftir_peaks(ftir) + expect_equal(peaks, sort(peaks)) +}) + +test_that("find_ftir_peaks returns correct peaks", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 0, 0), 10) + ) + peaks <- find_ftir_peaks( + ftir, + sg_p_deriv = 3, + sg_n_deriv = 7, + sg_p_norm = 3, + sg_n_norm = 7, + window_norm = 50, + window_deriv = 50 + ) + expect_equal(length(peaks), 10) + expect_equal( + peaks, + c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) + ) +}) + +test_that("Fixed Peak Locations don't move", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + peaklist <- c( + 1040, + 1100, + 1130, + 1160, + 1190, + 1220, + 1260, + 1300, + 1340, + 1380, + 1410, + 1460, + 1560, + 1750, + 1900, + 1970 + ) + + gmm_loose <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = F, + method = "g" + ) + + lmm_loose <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = F, + method = "l" + ) + pvmm_loose <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = F, + method = "pv" + ) + dsgmm_loose <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = F, + method = "dsg" + ) + + expect_false(all(gmm_loose$mu == peaklist)) + expect_false(all(lmm_loose$mu == peaklist)) + expect_false(all(pvmm_loose$mu == peaklist)) + expect_false(all(dsgmm_loose$mu == peaklist)) + + gmm_fixed <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = TRUE, + method = "g" + ) + + lmm_fixed <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = TRUE, + method = "l" + ) + pvmm_fixed <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = TRUE, + method = "pv" + ) + dsgmm_fixed <- fit_peaks( + ftir, + peaklist = peaklist, + fixed_peaks = TRUE, + method = "dsg" + ) + + expect_equal(gmm_fixed$mu, peaklist) + expect_equal(lmm_fixed$mu, peaklist) + expect_equal(pvmm_fixed$mu, peaklist) + expect_equal(dsgmm_fixed$mu, peaklist) +}) + +test_that("zero_normalization and zero_deriv check ok", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 0, 0), 10) + ) + peaks <- find_ftir_peaks( + ftir, + sg_p_deriv = 3, + sg_n_deriv = 7, + sg_p_norm = 3, + sg_n_norm = 7, + window_norm = 50, + window_deriv = 50 + ) + + expect_error( + peaks <- find_ftir_peaks( + ftir, + sg_p_deriv = 3, + sg_n_deriv = 7, + sg_p_norm = 3, + sg_n_norm = 7, + window_norm = 50, + window_deriv = 50, + zero_norm = 100 + ), + "is larger than the highest point in the spectra." + ) + + expect_error( + peaks <- find_ftir_peaks( + ftir, + sg_p_deriv = 3, + sg_n_deriv = 7, + sg_p_norm = 3, + sg_n_norm = 7, + window_norm = 50, + window_deriv = 50, + zero_deriv = 100 + ), + "is larger than the highest point in the derivative spectra." + ) +}) + +test_that("maxima function detects local maximas", { + x <- c(1, 2, 3, 4, 5, 4, 3, 2, 1) + expect_equal(maxima(x), 5) + x <- c(1, 2, 3, 4, 5, 3, 4, 5, 6, 5, 4, 3, 2, 1) + expect_equal(maxima(x, window = 2), c(5, 9)) +}) + +test_that("minima function detects local minimas", { + x <- c(1, 2, 3, 4, 5, 4, 3, 2, 1) + expect_equal(minima(x), c(1, 9)) + x <- c(3, 2, 3, 4, 5, 3, 4, 5, 6, 5, 4, 3, 2, 1) + expect_equal(minima(x), c(2, 6, 14)) + x <- c(1, 2, 3, 4, 5, 4, 5, 4, 5, 4, 5, 6, 5, 3, 5, 4, 3, 2, 1) + expect_equal(minima(x), c(1, 6, 8, 10, 14, 19)) + expect_equal(minima(x, window = 2), c(1, 14, 19)) +}) + +test_that("zero_threshold sets to zero values below threshold", { + x <- c(1, 0.01, 0.001, 0.0001) + expect_equal(zero_threshold(x, threshold = 1e-3), c(1, 0.01, 0.001, 0)) + x <- c(-1, -0.01, -0.001, -0.0001) + expect_equal(zero_threshold(x, threshold = 1e-2), c(-1, -0.01, 0, 0)) + x <- c(1, -0.01, 0.001, -0.001) + expect_equal(zero_threshold(x, threshold = 1e-2), c(1, -0.01, 0, 0)) +}) + +test_that("fit_peaks (voigt) returns correct results", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 1, 0), 10) + ) + fitted_peaks <- fit_peaks(ftir, method = "voigt") + expect_equal(fitted_peaks$method, "voigt") + expect_equal(length(fitted_peaks$mu), 10) + expect_equal( + round(fitted_peaks$mu), + c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) + ) + + fitted_peaks$method <- NULL + expect_warning( + fittype <- get_fit_method(fitted_peaks), + "should be generated with" + ) + expect_equal(fittype, "voigt") +}) + +test_that("fit_peaks (gaussian) returns correct results", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 1, 0), 10) + ) + fitted_peaks <- fit_peaks(ftir, method = "gaussian") + expect_equal(fitted_peaks$method, "gauss") + expect_equal(length(fitted_peaks$mu), 10) + expect_equal( + round(fitted_peaks$mu), + c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) + ) + + fitted_peaks$method <- NULL + expect_warning( + fittype <- get_fit_method(fitted_peaks), + "should be generated with" + ) + expect_equal(fittype, "gauss") +}) + +test_that("fit_peaks (lorentz) returns correct results", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 1, 1, 2, 3, 10, 3, 2, 1, 1), 10) + ) + fitted_peaks <- fit_peaks(ftir, method = "lorentz") + expect_equal(fitted_peaks$method, "lorentz") + expect_equal(length(fitted_peaks$mu), 10) + expect_equal( + round(fitted_peaks$mu), + c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3819) + ) + + fitted_peaks$method <- NULL + expect_warning( + fittype <- get_fit_method(fitted_peaks), + "should be generated with" + ) + expect_equal(fittype, "lorentz") +}) + +test_that("fit_peaks (dsg) returns correct results", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 1, 0), 10) + ) + fitted_peaks <- fit_peaks(ftir, method = "dsg") + expect_equal(fitted_peaks$method, "doniach-šunjić-gauss") + expect_equal(length(fitted_peaks$mu), 10) + expect_equal( + round(fitted_peaks$mu), + c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) + ) + + fitted_peaks$method <- NULL + expect_warning( + fittype <- get_fit_method(fitted_peaks), + "should be generated with" + ) + expect_equal(fittype, "doniach-šunjić-gauss") +}) + +test_that("fit_peaks error checks are ok", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + expect_error( + fit_peaks(absorbance_to_transmittance(ftir)), + "must be supplied in absorbance units" + ) + + expect_error( + fit_peaks(sample_spectra), + "must only contain one sample spectra" + ) + + expect_error( + fit_peaks(ftir, method = "bad_method"), + "must be one of `voigt`, `lorentz`, `gauss` or `dsg`" + ) +}) + +test_that("Peak data.frame is created ok", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + peaksdf <- fit_peak_df(fitpeaks) + + expect_equal( + colnames(peaksdf), + c( + "sample_id", + "peak", + "wavenumber", + "sigma", + "eta", + "mix_ratio", + "peak_shape" + ) + ) + + expect_equal( + colnames(fit_peak_df(fit_peaks(ftir, method = "gauss"))), + c("sample_id", "peak", "wavenumber", "sigma", "mix_ratio", "peak_shape") + ) + expect_equal( + colnames(fit_peak_df(fit_peaks(ftir, method = "lorentz"))), + c("sample_id", "peak", "wavenumber", "gam", "mix_ratio", "peak_shape") + ) + expect_equal( + colnames(fit_peak_df(fit_peaks(ftir, method = "dsg"))), + c( + "sample_id", + "peak", + "wavenumber", + "sigma", + "eta", + "alpha", + "mix_ratio", + "peak_shape" + ) + ) +}) + +test_that("get_fit_spectra works ok", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitg <- fit_peaks(ftir, method = "gauss") + fitv <- fit_peaks(ftir, method = "voigt") + fitl <- fit_peaks(ftir, method = "lorentz") + fitd <- fit_peaks(ftir, method = "dsg") + + expect_equal(length(get_fit_spectra(ftir, fitg)), length(ftir$wavenumber)) + expect_equal(length(get_fit_spectra(ftir, fitv)), length(ftir$wavenumber)) + expect_equal(length(get_fit_spectra(ftir, fitl)), length(ftir$wavenumber)) + expect_equal(length(get_fit_spectra(ftir, fitd)), length(ftir$wavenumber)) + + expect_equal(length(get_fit_spectra(ftir, fitg, 3)), length(ftir$wavenumber)) + expect_equal(length(get_fit_spectra(ftir, fitv, 3)), length(ftir$wavenumber)) + expect_equal(length(get_fit_spectra(ftir, fitl, 3)), length(ftir$wavenumber)) + expect_equal(length(get_fit_spectra(ftir, fitd, 3)), length(ftir$wavenumber)) +}) + +test_that("get_fit_spectra checks are ok", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + expect_error( + get_fit_spectra(ftir, fitpeaks, peak = "all"), + "requested peak must be an integer value" + ) + expect_error( + get_fit_spectra(ftir, fitpeaks, peak = 1.5), + "requested peak must be an integer value" + ) + expect_error( + get_fit_spectra(ftir, fitpeaks, peak = 100), + "requested peak 100 is out of range" + ) + expect_error( + get_fit_spectra(ftir, fitpeaks, peak = -1), + "requested peak -1 is out of range" + ) +}) + + +test_that("plot_fit_ftir_peaks work", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + if (!require("ggplot2", quietly = TRUE)) { + expect_error( + plot_fit_ftir_peaks(ftir, fitpeaks), + "requires ggplot2 package installation", + fixed = TRUE + ) + + testthat::skip("ggplot2 not available for testing peak fit plot production") + } + + p <- plot_fit_ftir_peaks(ftir, fitpeaks) + expect_true(ggplot2::is.ggplot(p)) + expect_equal(p$labels$title, "Fitted FTIR Plot") + expect_equal( + p$labels$subtitle, + "Showing as-analyzed spectra and sum of Voigt fitted peaks" + ) + + p2 <- plot_fit_ftir_peaks( + ftir, + fitpeaks, + plot_title = c("Test Plot", "Test Subtitle") + ) + expect_equal(p2$labels$title, "Test Plot") + expect_equal(p2$labels$subtitle, "Test Subtitle") +}) + +test_that("plot_fit_residuals work", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + if (!require("ggplot2", quietly = TRUE)) { + expect_error( + plot_fit_residuals(ftir, fitpeaks), + "requires ggplot2 package installation", + fixed = TRUE + ) + + testthat::skip("ggplot2 not available for testing residual plot production") + } + + p <- plot_fit_residuals(ftir, fitpeaks) + expect_true(ggplot2::is.ggplot(p)) + expect_equal(p$labels$title, "Residual Plot") + expect_equal( + p$labels$subtitle, + "Residual of Voigt fitted peaks and isopropanol" + ) + + p2 <- plot_fit_residuals( + ftir, + fitpeaks, + plot_title = c("Test Plot", "Test Subtitle") + ) + expect_equal(p2$labels$title, "Test Plot") + expect_equal(p2$labels$subtitle, "Test Subtitle") +}) + +test_that("plot_components work", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + if (!require("ggplot2", quietly = TRUE)) { + expect_error( + plot_components(ftir, fitpeaks), + "requires ggplot2 package installation", + fixed = TRUE + ) + + testthat::skip( + "ggplot2 not available for testing component plot production" + ) + } + + p <- plot_components(ftir, fitpeaks) + + expect_true(ggplot2::is.ggplot(p)) + expect_equal(p$labels$title, "Fitted FTIR Plot") + expect_equal( + p$labels$subtitle, + "Showing as-analyzed spectra and components of Voigt fitted peaks" + ) + + p2 <- plot_components(ftir, fitpeaks, plot_fit = TRUE) + p3 <- plot_fit_ftir_peaks(ftir, fitpeaks, plot_components = TRUE) + expect_equal(p2, p3) + p4 <- plot_components( + ftir, + fitpeaks, + plot_title = c("Test Plot", "Test Subtitle") + ) + expect_equal(p4$labels$title, "Test Plot") + expect_equal(p4$labels$subtitle, "Test Subtitle") +}) + +test_that("plot_fit_ftir_peaks error checks are ok", { + if (!require("ggplot2", quietly = TRUE)) { + testthat::skip("ggplot2 not available for testing fit peak plot production") + } + + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + ftir_trans <- absorbance_to_transmittance(ftir) + + expect_error( + plot_fit_ftir_peaks(ftir_trans, fitpeaks), + "must be supplied in absorbance units" + ) + expect_error( + plot_fit_ftir_peaks(sample_spectra, fitpeaks), + "must only contain one sample spectra" + ) + expect_warning( + plot_fit_ftir_peaks( + sample_spectra[ + sample_spectra$sample_id == "toluene", + ], + fitpeaks + ), + "does not contain fit peaks that match the ftir sample provided" + ) + expect_error( + plot_fit_ftir_peaks(ftir, fitpeaks, extra_arg = "ok"), + "Supplied 1 unused argument: extra_arg" + ) + fitpeaks$sample_id <- NULL + expect_warning( + plot_fit_ftir_peaks(ftir, fitpeaks), + "should be generated with" + ) +}) + +test_that("plot_fit_residuals error checks are ok", { + if (!require("ggplot2", quietly = TRUE)) { + testthat::skip( + "ggplot2 not available for testing fit residual plot production" + ) + } + + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + ftir_trans <- absorbance_to_transmittance(ftir) + + expect_error( + plot_fit_residuals(ftir_trans, fitpeaks), + "must be supplied in absorbance units" + ) + expect_error( + plot_fit_residuals(sample_spectra, fitpeaks), + "must only contain one sample spectra" + ) + expect_warning( + plot_fit_residuals( + sample_spectra[ + sample_spectra$sample_id == "toluene", + ], + fitpeaks + ), + "does not contain fit peaks that match the ftir sample provided" + ) + fitpeaks$sample_id <- NULL + expect_warning(plot_fit_residuals(ftir, fitpeaks), "should be generated with") + expect_error( + plot_fit_residuals(ftir, fitpeaks, extra_arg = "ok"), + "Supplied 1 unused argument: extra_arg" + ) +}) + +test_that("plot_components error checks are ok", { + if (!require("ggplot2", quietly = TRUE)) { + testthat::skip( + "ggplot2 not available for testing fit component plot production" + ) + } + + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + ftir_trans <- absorbance_to_transmittance(ftir) + + expect_error( + plot_components(ftir_trans, fitpeaks), + "must be supplied in absorbance units" + ) + expect_error( + plot_components(sample_spectra, fitpeaks), + "must only contain one sample spectra" + ) + expect_warning( + plot_components( + sample_spectra[ + sample_spectra$sample_id == "toluene", + ], + fitpeaks + ), + "does not contain fit peaks that match the ftir sample provided" + ) + fitpeaks$sample_id <- NULL + expect_warning(plot_components(ftir, fitpeaks), "should be generated with") + expect_error( + plot_components(ftir, fitpeaks, extra_arg = "ok"), + "Supplied 1 unused argument: extra_arg" + ) +}) + +test_that("Languages are handled properly", { + if (!require("ggplot2", quietly = TRUE)) { + testthat::skip( + "ggplot2 not available for testing fit component plot production" + ) + } + + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + fitpeaks <- fit_peaks(ftir) + + p <- plot_fit_ftir_peaks(ftir, fitpeaks) + expect_equal(p$labels$title, "Fitted FTIR Plot") + expect_equal( + p$labels$subtitle, + "Showing as-analyzed spectra and sum of Voigt fitted peaks" + ) + expect_equal(p$plot_env$legend_title, "Sample ID") + + p <- plot_fit_residuals(ftir, fitpeaks) + expect_equal(p$labels$title, "Residual Plot") + expect_equal( + p$labels$subtitle, + "Residual of Voigt fitted peaks and isopropanol" + ) + + p <- plot_components(ftir, fitpeaks) + expect_equal(p$labels$title, "Fitted FTIR Plot") + expect_equal( + p$labels$subtitle, + "Showing as-analyzed spectra and components of Voigt fitted peaks" + ) + expect_equal(p$plot_env$legend_title, "Sample ID") + + p <- plot_fit_ftir_peaks(ftir, fitpeaks, plot_components = TRUE) + expect_equal(p$labels$title, "Fitted FTIR Plot") + expect_equal( + p$labels$subtitle, + "Showing as-analyzed spectra and components of Voigt fitted peaks" + ) + expect_equal(p$plot_env$legend_title, "Sample ID") + + p <- plot_fit_ftir_peaks(ftir, fitpeaks, lang = "fr") + expect_equal(p$labels$title, "Trac\u00e9 IRTF ajust\u00e9") + expect_equal( + p$labels$subtitle, + "Montrer les spectres et de la somme des pics ajust\u00e9s par la m\u00e9thode Voigt" + ) + expect_equal(p$plot_env$legend_title, "ID de l'\u00e9chantillon") + + p <- plot_fit_residuals(ftir, fitpeaks, lang = "fr") + expect_equal(p$labels$title, "Trac\u00e9 des r\u00e9sidus") + expect_equal( + p$labels$subtitle, + "R\u00e9sidu de Voigt pics ajust\u00e9s et isopropanol" + ) + + p <- plot_components(ftir, fitpeaks, lang = "fr") + expect_equal(p$labels$title, "Trac\u00e9 IRTF ajust\u00e9") + expect_equal( + p$labels$subtitle, + "Montrer les spectres et es composants analys\u00e9s de pics ajust\u00e9 par la m\u00e9thode Voigt" + ) + expect_equal(p$plot_env$legend_title, "ID de l'\u00e9chantillon") + + p <- plot_fit_ftir_peaks(ftir, fitpeaks, plot_components = TRUE, lang = "fr") + expect_equal(p$labels$title, "Trac\u00e9 IRTF ajust\u00e9") + expect_equal( + p$labels$subtitle, + "Montrer les spectres et es composants analys\u00e9s de pics ajust\u00e9 par la m\u00e9thode Voigt" + ) + expect_equal(p$plot_env$legend_title, "ID de l'\u00e9chantillon") + + expect_warning( + plot_components(ftir, fitpeaks, lang = "test"), + "language must be one of 'en', 'english', anglais', 'fr', 'french', 'francais' or" + ) +}) + + +#component-optimization is extnsively tested in peak-fit code as well. + +test_that("component-optimization dsgmm error checking is ok", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 0, 0), 10) + ) + + expect_error( + spect_em_dsgmm( + x = c(4001, ftir$wavenumber), + y = ftir$absorbance, + mu = runif(10) + ), + "Provided x and y vectors must be of the same length" + ) + expect_error( + spect_em_dsgmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + eta = runif(11) + ), + "All of mu, sigma, alpha, eta and mix_ratio must be of the same length" + ) + expect_error( + spect_em_dsgmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + maxit = 1 + ), + "must be greater than 1 to perform optimization" + ) +}) + +test_that("component-optimization gmm error checking is ok", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 0, 0), 10) + ) + + expect_error( + spect_em_gmm( + x = c(4001, ftir$wavenumber), + y = ftir$absorbance, + mu = runif(10) + ), + "Provided x and y vectors must be of the same length" + ) + expect_error( + spect_em_gmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + sigma = runif(11) + ), + "All of mu, sigma, and mix_ratio must be of the same length" + ) + expect_error( + spect_em_gmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + maxit = 1 + ), + "must be greater than 1 to perform optimization" + ) +}) + +test_that("component-optimization lmm error checking is ok", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 0, 0), 10) + ) + + expect_error( + spect_em_lmm( + x = c(4001, ftir$wavenumber), + y = ftir$absorbance, + mu = runif(10), + gam = rep(10, 10) + ), + "Provided x and y vectors must be of the same length" + ) + expect_error( + spect_em_lmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + gam = runif(11) + ), + "All of mu, gam, and mix_ratio must be of the same length" + ) + expect_error( + spect_em_lmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + maxit = 1 + ), + "must be greater than 1 to perform optimization" + ) +}) + +test_that("component-optimization pvmm error checking is ok", { + ftir <- data.frame( + sample_id = "sample1", + wavenumber = round(seq(4000, 400, length.out = 100)), + absorbance = rep(c(0, 0, 1, 2, 3, 5, 3, 2, 0, 0), 10) + ) + + expect_error( + spect_em_pvmm( + x = c(4001, ftir$wavenumber), + y = ftir$absorbance, + mu = runif(10) + ), + "Provided x and y vectors must be of the same length" + ) + expect_error( + spect_em_pvmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + eta = runif(11) + ), + "All of mu, sigma, eta, and mix_ratio must be of the same length" + ) + expect_error( + spect_em_pvmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = runif(10), + maxit = 1 + ), + "must be greater than 1 to perform optimization" + ) +}) + +test_that("component-optimization verbose calls are ok", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + mu_list <- c( + 1041, + 1104, + 1129, + 1159, + 1188, + 1222, + 1263, + 1304, + 1340, + 1375, + 1410, + 1462, + 1559, + 1752, + 1896, + 1972 + ) + + expect_message( + spect_em_gmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list, + verbose = TRUE + ), + "Converged in " + ) + expect_message( + spect_em_lmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list, + verbose = TRUE + ), + "Converged in " + ) + expect_message( + spect_em_pvmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list, + verbose = TRUE + ), + "Converged in " + ) + expect_message( + spect_em_dsgmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list, + verbose = TRUE + ), + "Converged in " + ) +}) + +test_that("component-optimization fixed-mu is ok", { + ftir <- sample_spectra[ + sample_spectra$sample_id == "isopropanol", + ] + ftir <- ftir[ftir$wavenumber > 1000 & ftir$wavenumber < 2000, ] + mu_list_rounded <- c( + 1040, + 1100, + 1130, + 1160, + 1190, + 1220, + 1260, + 1300, + 1340, + 1380, + 1410, + 1460, + 1560, + 1750, + 1900, + 1970 + ) + + gmm_loose <- spect_em_gmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded + ) + lmm_loose <- spect_em_lmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded + ) + pvmm_loose <- spect_em_pvmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded + ) + dsgmm_loose <- spect_em_dsgmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded + ) + + expect_false(all(gmm_loose$mu == mu_list_rounded)) + expect_false(all(lmm_loose$mu == mu_list_rounded)) + expect_false(all(pvmm_loose$mu == mu_list_rounded)) + expect_false(all(dsgmm_loose$mu == mu_list_rounded)) + + gmm_fixed <- spect_em_gmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded, + fixed_mu = TRUE + ) + lmm_fixed <- spect_em_lmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded, + fixed_mu = TRUE + ) + pvmm_fixed <- spect_em_pvmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded, + fixed_mu = TRUE + ) + dsgmm_fixed <- spect_em_dsgmm( + x = ftir$wavenumber, + y = ftir$absorbance, + mu = mu_list_rounded, + fixed_mu = TRUE + ) + + expect_equal(gmm_fixed$mu, mu_list_rounded) + expect_equal(lmm_fixed$mu, mu_list_rounded) + expect_equal(pvmm_fixed$mu, mu_list_rounded) + expect_equal(dsgmm_fixed$mu, mu_list_rounded) +}) diff --git a/vignettes/deconvoluting-spectra-plot_fit_components-1.png b/vignettes/deconvoluting-spectra-plot_fit_components-1.png new file mode 100644 index 0000000000000000000000000000000000000000..ae30dd34b648d6eebb95b43ac91de287693e1650 GIT binary patch literal 37999 zcmeFZ2UHY6xGp%LK%)pWIY=5*P@;m8^8iK=QF0JaKu|z(4l>G+F_J+s{Zi(q5i6#z?*8SCyuckgTY`Yu3Sdk zg2BiD80=^^a0I&2Ej@o81|!P8dHuFB^j{cE5(YDeNlL;bp>qUG`5DaI9A+K?GcSa0 zKvyMU=7gJskGZ5dbVNu(w<63XBO)Xtpf7zl2p^jpH^Oe%*xayz&S^Ko>dc`|_gWG< zBea7)5zrs=2@* z=nJGVa=XjA4ltM?H{mal>jyb!7>pBk1)*@;HEyVL4?pQCTK7#0}@Z zz@2v??ZWi3w47sCMtWmVo$YtrCzPjDJwyOfLc);<`j?U%eiR0KK+Oe%UG@ivVDc;o z2xvb!6=ARlQji$tD~h6q!QLw%A^J}IKltbjJvRO&r}{*LP=&+B^z%f4rGX+rF|RQ) z%^$0!Sx*_oSOsL;ZH7v#)4D2mcc{pYPucARX5qWH>v+NqD>k0)Ho;&h2WfcOx}1Q6 zgin|m37p?`DfP(HlR6LH11`N5Fj%0yDBKfwzQLe5ky|$yP|qxDF|JG4c`2fXES(d9 z`647}Kv~zC3z5qcmRj8CmoFJTjx+!IG|g>>D4vl$0=xW*8%#3Glzm>E4F{j4wQ{5N z5)W^^4qj}nqgv2MJ|442GP(~HRjUvAtmgcDP?c5Ev3s< zc7Bs#SZw96gE?cvp|#WZyS(kb!#x+6&4luc-jdIXz+fb|5tBw~7RN`cMAmW(Pr z=73}_#i1KIdQTnaNtf&Jxs>3b{jq6X$>Dp<3pZ@9(!vQ{DIz=c)xGgukv^V!96Z+Z z!@3Wa0uv2bM%u>jVyl$be@T^(0YQserEgB7KgVb%VsMHMBQd5z1Ukk6L{ytcr{%?O z-3gqU>@?{l8ewl^!nMU5CDH*Q*>w#sY1>ADPW!8$oP<6K4cT&7XmsSYvRi}_`||QJ zCI#qG{D#j4rAQ}^R36W5Htl+W7&+K2^H>|F8@d{ z;lET)3>s~DyW&;?7q4b`DItquj+Mp=o1^~pnJt`P!yxr+u|y=-fV32~_=C2(Ctl|0 zj8jIBJ)dG_UlRurp;z56fQ7hqzVx+Iyoy;|^CtrBs`6CiT+78{aQ86pEw9KUwL|nj z6~g%|avg@7WJY44?on_7wCX@p`zWzQ{}}C92V2t)M$u8(b!?Nd(&7ZSKDe2vWKt0f z5Xrw9VNAk3JC^~JD}DGDlnzJsw}at1%YTt=4W9HGkqpSQsr=kuAh)hGG@SIhLmfAgFY;jsoyocyC(Ttewgysj0dRX3Fl`4qU@nOdiP%nn?A!wJuvY$fu9}INn*9ULBtKtNDTo zo6^uFJtP}epQ?D0(B%oJ%T<2UN2C*&YlA*Dx4&x6E0Z@RRiP;%l4Y(he|}H~u{bcZ5vyIizAD60_Ef1~H?!jTvuTL4(jnRU@n6kp}JA z=KJF8hD*n_!rXUU#&)zh8U%2o0fQeHZKci6JV_IBl`D{o`Ptl;v-T4ecBy`@E=GAh zvtwK6OJ~?I5DSDEAQyJ~64|EHtm%}+hiocc%cp-CF9v15Bx^)u`-J@LWozi=qFtke zOLOuuVA+Z`VnGCwTign)z%|x$qwE$Mzx2f>%=bNI9GV*U^LN%v&Nr{kb*_6~?hjDa zxht<<`7O2Bi<7OxudgH;75H3$qrsDTz_R%h0M{H>Dr1{)THS@QlihPzC>XI=H6-J3 zmp10ZMaee>N-1+}2v>P6KJ>dIQ2`_zp0%^*uAvq!6_D5b0heD!gE@&5aYr1|?3y)e zev)C378*GDxA`dHM^Fn>dCO0kH_ZmhsIdSw_9rKrt=NTTQ0qLETeYmz_`8UaBzK=b z&nl{?2@jwERbL>I6r7jGH1myfN!=(~zvB6k%jBRx{RAb_8V{7+QIy>SYAof-Y?;(9 zcfdvw$GKQ;bn>aQAdA2U8f-P|#_F1OqN94M_u|0z4xhSoWgn)-Y8l_$vt8|hVbI6# zew|(@*Xuv=>&I#q{=49SG2KF`t!mbgrs#rX>BU|3U|Y$l`38G2gQhII`KfO*uLUw| zmu72ziD|Kx8hp?lu9v{Cch|ozR9=}w_>*r*X6{xfM%v=?TTL;dO`8fii3ziG{Q3CJ z!jo2FSg(1*+JU*pH+qe;7n}J=krhdav21YvhYZ!mzp(DtX|ZAPycV9e%+be9+kR@~ zT7hf%LAQ`|^eUYnipQ`kFH&V6YP3Eu@RulS%{oAQc;<2bSA5`9kvPm+Wh| zum8T5w^9E_Y++k76KHzln6crd&Hg!S!&nI}TB6iu>v>$-A_NC1E5AkZMs<4pO@ZS6 z6Eg5Ji$}RT=cIU~*=YPKbCtVxIfkYLCwEkMGTmf6;pwt>+Qo`#U52_Iuj1%?m)Gb; zZpds(ai5lX!`i>z_w~r*>&cWX;6-kI}u2FOj;*A5Z<3b zdt*kx|I6FmkjERUwgcgD9YNU?w-zI>4Av#)DRzl+;S{$o{EYu}Txx5S`3H#gS+m{k z3=9@JQmD<^aoc!M_ZOzAYSkmCb1OcSsnM7b_oLt&ybKrR;vYX?H&Dq+{93?y-KT&- zluc+m)W(2gHE7XlRg0~qrPH~eKsQ4#&YA61885!3(Jg$taq}H^hq2e**zn1gbat3U zk-lqee&yYAIR7PS$M$qFcW-b_v|*QkFp79fM_cA*5@&{x>(^=k+tSBU_m{)wW5As>sxP`0K}Vwer`o z4DvJ~p^B1^?T|4cJLh#PQ!T5UdV?ftwLag*f+ickb3N#c$6gg0oX%1$_^SV0{{D=S zi$LP&S;nX{i#}#f{!bG}JG={~({@9)+XH(17o-PDX!-PCFcbJHlZ1M zlfKE!ozhH-20<$$BV&?HbjkeS`b=2g^~TDewHDCCa@lF-Q%Z+YXwl9X?(N0{YmSuT zYCA`}7S8Iq#uu8pby-iSq(y7Q+DDdmKP+c^T{+{aEz(^~+kGPGhnC^i0|%#M=RsS3 z>&+)$-ZIB`Gnb!L#i)r!mt~R7aGZ0@4%NEoI+|KTJd>5Q!#HSPEU2{AUmBLvmmK4$ zUWF#pS%{XB_$t5R38$bF&$W*E5L%Mg81{#UH)Py1-ru26x`q+Li5BS(ywa}uozP?1 zxMCvy)=IA?Ytht?51o1>)^;o9rJH`gVE+pH*82?g-Bg}U6elNj@fwh>J6;Fp5Cc34fHD16p_q9bg%tNh_}4pWK7j1 zcYE?KtCPLi?=Rz7&PGyYc(guc*Xc6Mx0$F?na@{nbo~5iDUjTa(_I#_i<3PUYlG~% z)I>iOQA|9UZ%sm#aGd93NOE&Ge-1Wo@k_|*_2$Xj#&=Kni-uO)2Tjxno<;Gpo zV}-E***iv>q|~p^4IR<}mpQ~s_lCQIu6K8agVZ2{_^jNm7O#D78`ngW3a*MSjlX)9A$w8!qsf9K*m5VvR+{lGM=Ni`jCMsFotU zd*R9SYZ%#u2iEiLlkzX;`E<&FIWmoPo*Uc0*OWre6w9OJD%B<5yKYH{1Jj_*H^Vd^%)8Zp9Aeag^{2JJf%kH$MJ?cq& zIg#nTQ`_qCRZmVQKfx&^C_28j?NRzv^gP#hcSdJtrC;_xxIeCK?;C7HYHrwB#2h|TGY0{F^&Wr6_N49(z#*P|x3WeU-$iYHCHXqy!@PlMy} zlU)~8gY0l>qDe*Fjt*7$-xpo*H!feRt=?3QT2}YbP=C>BLg~~xpS7D(esS)M&u>$w zoa~-$IHJ49b76o}a1h_>fVsqC%W7I(kQC@Tw5bHAfXXlKIvZ}7#>vt*e3Fsyi?Oq_ z&$d~g1c*t#eiZg2#vX2F}ltMD@=X1i# zhSQrMAOUxugj1;4PA-ub=~A|HvkIWyBwOnSf97fTUeyzDxUMI8^(VE-o1yVfA(LM} zwaUn3UO9ye!Y{<-Ge(zMFyL$kt_Y4Q`$_02MjW7paW=2T55jLvumG#opn7(u@vyfiAu|P{i}x=9A~e z7Su^axdZA#r_pxQ{3;7GUz9CxXyse45X7{phkpWJQH5xbfm0Z(TFytGl{tO$SC#uc zG8*ijgwBCRIT(wu^eyn^3m}v>ATv0l9< zA^N8#nuPtM>YE_I!$HCO(dP-4CM?0P&?n(1gC0{@1_5bprb}W*jnhfL%AJ*-YbKws z1=22UR!9%?^jiW#0&)F)7O3QI**q zV)6=US#PnUekNO(45YGghtOi*n;{`(WNM%oO~Po$>dxWVEL?<2EG==3uM#fY{FUH- z?Xd5HpC+rpeyXfvJO%)35-wT| zEpbKory1X^NEpo9Cy3VS;%WB=wVz``%GT`XcoQdS2Z>+LQK-zkdscbgRnamWNPZ&x zz*x0Y?&hRlp2`Sfa==H)B9zkD$ObBz=@ws6m$J^^_L>ZK*Pry8JP~iq#%rhE6=&Bu zX%la$Xd75hQsp+0uqQMVdEsyH*>QHWYq+2e+dB$^lr%ANMR3GqVYy=WfW32bY-L+p zn&-xQi=Dx=*@JftiyWQ)5wD!>&VY7vSdTe^bTEU%ZyRufB-UCQ&&dXsIttJ4-8UE)yS zZkd{QYSDx9b`P9{>3Hue>fIVCKU=6?WXr>Hy{9W@m5NTXUu8s@sR$p^$uVHo>&1Q+ z9d%})OTfchnI0!`tUvZ+H=|OkN4wsKO_7_wK4wa2AxmA}k(Zx7$EY*JsEy+`&wx87 z8{1{=B+<;itB7TZvA8a~Arwvz_0J8(lG3aQcB69j~21*GU1ip;YUu zL7K?pA@!|w5D={CO~$V@rJVFPYN^u$^s<2tTD>8f@p6_nwWcbn;$rIk$CywGC_}3A+_QurV#<{q-znOdM|* zHs<_nDe5Z@Q8<3@^SR*;uo>0Ro++Rji-zBVOyX=nDLF-YG8!E+EW<{T-ATHtl>~kyMbuj!mKSkv$@~Ut*369 z=PgI&HA0qE0D$mKP<*ZNja7$_(V< zU=BT6iNZ@?t4qf+F802>Pu$8kGv?NB{Pyc(LlI6zhk$OM+1|jEl{du(cSHDxr}tP} zeJ$Kop)GB&ouuhEw>|O7_4diMg8SnU%ZhG!Ij?A{v|&d0ryBP1)G93T%TDQ7)v5l1TYX6Jjc z5?WIW(PwsTRj=9YKFHkSdVTmM2dPv}t74YHn=0|wef;si?|$lrCT|RSwI0OIrO#zS zbE?LldYA_fW`4H^D1fef`fn!Q?LP8ZdcWE-wkXDOt(Of~I^D!5vr0i`GU3IhitzCGQR(E5 z>pO0_@1{Y$lzAdh@;akI^CZ*Ra627jWkV-8|xC~#G;qz8-&}*=-GiJcZYs~H?rDFp&_$C{D@43knOa2SvAIf&o0X8AT zBGH=KArq*8k5yv!_Tos~O{T9cJW(z-5m4ENR? z6?#xomo?}$+_IMPm;V2^7X$Yyth%XyF|@iJ#ad}kSdB#e(r(sMcAcb|jV}!l{5tq0 zP5b^kem|qvF9R>Y4WvHhzu&l=vfPL=dL5WcT#sM|GvjaT{q#K5=4Ot_`hn2(yZ0^x z=u$f;@Idy(l(fh@sCByh1q~IXHP7oeq8#;(3Cyi&7c{guqj|Z}1uw5&iwVCci3yp! z6V1yPas3sD?Y;8hbd&0Zcng)4&(~kkUq15#WjFW!=ZkUf=w=aa_d92P96LpOA5rXl z>%o=f=hr8q!SZvo_eoy-ZzFGu4*Lzin<}QRu8v64K zLzew%?~B>Y|B1XU8tjJwo9#zCwL9|>!bL+xebq@^TyQ$he}q2f6}adv#mOHKFq9wZ zbFU7QS4{e!hE&MpUWuB2EQ`vM8YG$dl8FmG>%W zWiO-tBhwq4@a>P>k~0P@6GF8AiRJ+6q=`+G5m;ev&j^FvRiWfWV`L&hqt6)EnI&2R zxYy9T%2A1oZC`S(X8|XoSm-&Ur(PZ6Z^01xluSySyca&ol*D~|weDaqfWm)7FYk|u ziHR+NI_fP3?8MNLTg1!z=oUA+mOU6#k2yGj;}iAk^DO>=|H0+As>qoOSa0R^SYNU) zVZs#gsziGzrA`VDUrL>KPrMk#A+cS!Au-RdsWhP>Pp}*!#3YxGsO{><50w4ZqDK## zm_+vb`}rlv0F4t@+%^#>{@w`iG+IgHqAI~~Q^fK41N5BA=j30}%OeGG9x^)D1GLsg z$X6L0*-7>cNgheL;b>uJB+An@6dJh)8xd(v1oBt}oSyT?F;2w*Pt*2y*{0sPmKn8M zHHr(-AMQV%5YQq%;0Xry(urx!Fq*hMH)#&lb`O%W&bj5=ob0>j3Q#R)5}Da(Ox70T zZ4Ct1ml|Y5KB8{IZoMZaa8^w5-`^qMC<|u(Ktk^9uSf-t!0CMHKEX7!zH*E?Ad0#F zTTcJ~#7kDWGvvg6LTg${!6q-_04l>L<=?U{@7wO(|2Cli&p8r5BQUf6zj6jJ@ULU| zpZ)%ob*$fy6;XWrzg-Ezl`xI&PDOf;dEoP6Qw1vVIX?Fhys)#kh~A~c;1rLiq$+`h zM7Scy-!Mrei|>3OkL2J|6#9G7+uLKR$`=@tmDySQwfR@FlOLohC+V>hLh*y^eN`u* z)aLT@W7PLasFMN$@Hd-1+?AQ6oh|(Ul7rZ6xGTXy={;sk3@`I>-|WCX`rE`L0ApOT z@+;BPQ;riIuBKioQ3n2{b=K}II%_+dX~RvK$tjZpetSP`z(D8qZH#vmo{<{+;Y{U9 z+R*N5Q(GIW&vwJ23Uw0f{bdqVE-^|NA&*QPkly)`*rg5bKK^x15y4AzAO&dR>}1S5 z;l9~*eV!O5pDPNNc2uB%wytegToBtGHO`yGR*rV{>+?iF8^e6Li9mA&u)=G@+3DdT zc5J34P~>{(v9Ir=36VYp+JV;0a?y2NyDBymekctS6abDdzxTuZ!!3#l^mZ0;9Mbs9 zBLxW6g-;ZNf5|?|jeh<&T0TR8ChH=9rO$*GlJKBd2Q5Mi|9NOJSlCBYd3iB#`**n? zkH)`4E|RRSDz7B^@JV|F{nZHXW3sReEl7q-I2(pI5KwOPzco6zu!d>b?uYvZ9B;A1{Py~& zx;ft+>O-}L01mS2znT&~vnT7{oj7z8XTkYHKkEAy@WEAzTr4?yzydXh-NF=hofwpo z__BoNzducMV9lId=-{pA>2PXj;a5{Vor32d?+h3>;2Z1gteKn^bpw6TC zJ^NuFoak+aH7iT2qb0vV1dZp}swU+R|*w=qkR;2sz}(XXNHx6M=sv&*B1$uE||9MsM#fq76NVn2LQQ=7Os zv<`{XAU%rb)~vGzNMOGA>e+O5^Vpq>yDZP2lK!%^t!}?+ScX^GNcGrlEE9&HoAZPa z8H`^!kl2J-AasVD`pkPgY`71+>?uUl&WKqUDWlJYLkBCbgzWLx7NC;dXk)%Mekcb{ zXe(mrdZ|U436>UvcV8bVJtQpxG^wg43r;v^<$FMF3k`PnP!|8n<-ht~hg$Uaac{%c zN_&}V9jN0i7aEuFyI=p=1lWB1Ksu)o>m{oGC_9_Or#KadGE_k9>_HrY;GcNg<<%GW zfpKz#INu@Ks7=mumaQ3^3u0gg*zp@-H2G~XsGO?cb!fWK=Gw}w-VcCrT&cLy;Z;#Y z@#4tjUoQv!9~Z5G_;{#CVL25PfP)>73H4H~n|zYnfL$`2c&~H@poA;K7F(mQi2w&q z1)`LU`L9Q!LqrWo5=7f2LJ2L{;z!Z%>;yY6Qmj%j~%dk z8?j#D=1?G(;4$A*TO4L*en17mlC{6Q^>#bB0Fm-F<32UE>`+|_$fE5c9gi1g$h?23 z8(04*C-G&o-ysrjyfN&6kx9URSy?7OOi+m7{Ol@G9t&El?>EUX1{Le*7b6M>nU$|E z;DDEjsjLfKciep^Zn-`j@^t19u;SjJk!Nb5k*um7Q;uuFYy|azu&HUVYnF&8DtzYl zTkkvZ=iIHQ2&K3`kwFRhVRtFVJh$%&A!~#@z}9qoRDU23kNWn#gj*zs zzV9QdWz@7s6@*@e_(Kt$axv9m3`5y5{|~=QLT|IQI&=wb40rjI1t=j89W*^yvE}MP zf~_z3fMHfXh*FlQ#VQe=OX`9$=MV?+>@sR`(2Pg0>y76M;u&yy-&@|K#`1h1%ktb2 z8uDCj;wabKEtt&Xp-wtV$jR+l9$t!N>tvud`MvmIN#gqH1sTmDq=&>G3hikgQe$Db zV{_3*zAA=7{>YqWR$5AtkY(~znTydLL$xeZ4-P-Ru2eKo;j{U{cq3BUbAmNBHPvT* zsTTYC4?^u}IMIIeeYHPX`<9ziNBFx!63r9nGak zPDq-^=;V>-HItK-*LBZtO?CA5MK0iTH(Ip)tJ!!ve?K>x=%FVBKM4|QllJ-x^XJi? zR-&Fe-@p0r^2mC@8|SpuQG--e2L@(;j1&E_fyZEKW3+n_vthT$=QC2&uUgYbg`Zwo ziA@@&q@S6*oV7fAj4+jnBSzV+H(w}{?7F(%-@UkTEs}lvW%!YA9E?~Ofk58GQY^g4KI8(1cJTVC4tbJ$VBg(%ey`$qS%fJ zAHy=Q--CH!jBK*_JdSbvhH?}YW1saIG}*sIM*zX4wc-X}Y@`F;;U&?&qq3!L?jyEG ze0r+q2G-BN_(u*{CQz?Y2)#G;`YOw-EWU8bfn-o{H{PXGDu*3pS@7PafnER;7e?7B z!$t2}-G-fMqT~E=_G`Q4ciL$lkXtbfWO?7^=KPdUMpT1ptuCN_Zb;&aBqnn&tvc%q z1Sqd>YE~vJK1JD`nsQ1oQ+m|kMc}s2{{}T2eZssMElOVdwzvc{j{4t0J41 zfg=+?{>-$-=sqfocj!Xt=Th`FtjEIuARbtDHj_)ZY5Naitf%c>xRk6jT71M7(EL#1E-WzLTtOER(5cdj9sX)!Q!id1V5Z1qkF@p~er{Ys4$wdVSpf|2_I$tf!3(td!&=`YQB zBKs6_qN|}82`&HZLyU-;3vO`ypH3Dz;Rdvach7+~XJV=U7KGG%^^h+M=ozqrVmA6P zXd&#yjI@-}o@ao;Lm07Jw$hQy<%x~A-x(b^6Nt~t&^vdX#ZMM{mjn;I7J)cunpEO& ze&^*#qRM&7KOQ~~h7wjmZg7*cWeT`m^g8fov~Nq?iNQ4uk45N(z_D04_xayT;X?dU zXAb+jc>(}UI5w6E@BH12T^J4>Hlb6;Xo+$h@?r(rfF=>cDShElRO4QY1s@i^g#KB# zpnVHs+qsf_frYV=Dh?f6uNUFu#&O9yT!&1E!s8@Q8C*xkHkoh!U{48N?EJ989_nhV z1wG+B5nWoHMZ3yt9bxcVn-AS&g@{T#H$nk4aADu25<*mZvxrBqG0(6D1J{>xS$fF4 z@u&6hMk>%bjLdx~j7Z`X(UI1O+rOtmEz1)GyE{+?NQCb=N8QIRQNJO0k)mwk)8nJ)mX6{Q^oCBLJxrO$PnvYj`8k}=;N zw@awS%L;pU5P`y_uDIVS{@TVmYe{7i(28Xy5I%(L)zISdJIAdUAP$auE}A!!Ex)pW zLGU3+CX)s+NiBr-f-;@Mp{cP~FTY)G3^|R?~D*dr&1RBpj*TszSD)t$?4e?ZkIRCWL^@l%3^alcIll;&Y+ zRiRk6-@y}joVg-7STWeIF{kBlg2d%bbnH<{3?yU7>7SDjqxT1r7cOpEE`J`LlDO9O zuM{YPgnd}NR+j#C~4vB7=I%tdX3;f z_HHu8Pi%Yco~gY0KAB&M_)g)bKDO!>lD7KvDfIANllyXEV6!@LyoLGR(4i3C0w!PH zj|t|#3aR8szKkCI6?|4Dn1*;-OmA^m50&$?}&kt*^{p_(&HL0xp^X_P``Z%BVp&5WPI*8U~YOF9-f<%s+ z{geij!|!tmz#RjrvE{XD2AKjI!e|Qc>OS$OPN7f0DQ*qujQ{AuFExn`ZMUX{&tbKo zjGjmpDYY7PJ0dKXVkYYX)V^%0@Uc)dF5%NcW%kB@sw zp@}w8Z?ona0^u40iT@|P$unT`Cc0S zIJjWrA84ik4TF(figN#>j4l%PhcTj{anggm0M@7YAqDBtxr9G1wjXe%B#BgSY}k~- z^#8$RkT9P#3J~yw=gT9PbN`BS8_utQJcF{sq*pFCp4jt?&y7H}$-wEVza`xkP9;3oRAHB_x9USn*^MPDx}HfU6ZdT zps}?6js;N;d3{{sBU`@ZQT2(lT7(JX9^cfO$T4e&vv3MCO42MZA8ddyG+EelGbcT! zh)~%|ub>w$t*!^|y4RRKg=UN5@J4Fv`6obacB(A2)g2+7R8g#F%8^=^f1u=}u|2ev z9EfhnttLW0G-07exbqO4pX*vw(17Si2}@l73$?GsNpG}m*I!53on2Xa%BT30Z~Ap| zx)Kf4f6|q3VCLGy%(59Z_QmAbae{15R>>+CDB^m7#Al-bPv?{ zDR)aJ?bato*>a&jwEVgA#EcFr7_h6&jpnIXD0>P-Dhe6zX$}}y-^MN|AQ{TxWoz5& z@kP|wTZaQlBBHp^3@IwO5TlAc7X{AVLFywcsik#O%I$}LXvXp9NxN?l6SSymSHVLI zM^olRs^3G|>8>o15TqIgE&LQcb_I==jJCd$3w|_aDEIUu_*iavZj-=;kw8rxdq{=%A_f`m&V& zpBN7A-8hYI^gf0CiAh!cfhWfhuC5NhEBghL!dgSE|ztNz!c zS%X+txBV%MBcfO-@(Kx-_qZPbVx1%~I2S!n2bMo!ShGCiWIQL9 zsw2HSbaxB2!zmABm||DUh3MXZ!TaN{wR%lOR;L*R8apxi?Eahztz_$m>Z*ILJQ?CN zF9N9TwO)nu7v`#i<7;WEo;VpLbi-JJ$-CnRj}aJre-0f^u_3da*4Ab#*|6ZD5@<+` z6+8u}-BVf(or$)Z$OT?>>zX1`&^Gp+N2zsrc!|x5FOaI){1j7A0F}U?AYe(5WMEJW z`_aLL1V$FZB5}W;Lj#g;?J8uL;UBy5h~XhAj%4us!sj0WIiGquLmVe|Y)NQmy2vL! zQFpVplERi0R2$#!7sh@j3m|wtrWGzb)q z&H6E2%Mab0_e_QbG1*h|JgB84D@4S0Gp61!3c{4Hd#+H;CgDfwT27*bKw|?}mzw~L!4ZtsD zXinT_L5Lr@lL!6WN1#TjnalBN&sHO4@unG7e)O9C)-1Mf*CTsO_@d-a;dCh~$)7A}87ntDr7r31Z2@MYO-eXj`p5&Cp+fE= zW(P_IZs=^Z5P|b`yx=oNZgkF387Q_R6X>Z;M4`=!L;lGNkNg0(XPMlNav^}Va|5Ho z3GF9_{^e#GAq4^Nj;Nxv<$uj~-OgVHZ#GvUTLc-&c!IYUC7CjOK9wa^XK zBkJ$ukt3FUKWdVU$`mUJe%?fsj|SVFi2|g`2D&jgr27bb6H`eq`BQ>N zD*0Z1ZT4v!31mDv#fLWV5i{Bq_gHUkYWB@ONt3`(qytr57DJ(Gy!hur`v>J=WG84d zZ|tM5fftnX;(Z0#ToG|D6o$07t zyiRhPOciqsCHzJODf0#INh$UnWp_^-fn@jAES<06>yR36YM0&W{8U7Xs6ml2_TS>#EH~o?BT2S}U zA`#@f{TGwviPrYKJ z1C1~7?Qs^|N~Jh(R~D+=B%Od8kW2M{6uXL?5!pj+%>^~2lq0PIXhUss?)rlCM9)z$ zQ+{to!PJlqU}nB?vcUOW>b@6XSeGiPO)gxYmUen?hUk_~vlCF-XYYfCY8D{YM**s2 z_M4ZyyQGhZf@w-(#Hk7s^#k^%qrz|Q1lo;`@cg94GJu(h!={Jfg2cX}^*`_+xPVjxF^^m2`v?O4HKD?h3eJ_er z(M+0YqRQRgk*#FElVL=Z4>72c5nI4R`vzKuCKoPQ)?q)%jjqo-Ap-5Nl}A3O8+faY zoFEStzNGLawp#2hoe(!$XFF*+t!s=KyBzqrvNmoyB?4eZxKV5 zcF}p}vdCVZ_B;f{+U(rpfIqZ$a3#o3@j8h8sM{K}dOb`lJ~jRF1_NALlG^0dV|f4k z4Pu3c}S3%BqJU6)n^uhmhzbd&<_~ZU!|KuTf+(RFNV)L&V5mK{q!+U_r}iw9|8we__>xUCdicp@HYju5m_rFO zLleSUTLf}z&qd9P%|PzWk;~*gpjz)-0PlyRzoRgWtBsSHL#~t1k{=Wn1mS45O`BT~ z1kOPFZ?1 z*z1!ZwrasSPn6(bH+BSf;G!Ob;^6#+Q|;7AkK_?i6wfzI$BD39`yL+akk^zD030ES z=S63je1$|B@GWrhCSjS;UP+LX` z-)_l)_rDq%C)8}T)vs6Rn94`7H4*}j8~DcSk{WVNZ#BS*s#ySijVfW)(?%9lD?4XJ zMgYPc_>%Gf$N27algafx!zqWSZ^d(?&uob;*q#J!cwD;QBg8j*hphr^1PE363ltN< zAEaGB?jvI@(9SG@ej3D{;YZgSD$65le6!sH0ZkKO<96Cp$30yhfBHGNFH)3UIKfcA z2hw8U?9veg>`lX^Z7t;E)t!_rT{Aa5+or_A02gt{fW4r^U-*^Kn^>l%Y5jg~bag9a zLyhWz%+w|q`$ibCDGXTWO8Ch(W^RPItiuf&tOWdete@v&BN?v;%pm){eIGyscKVms zAY-!uF_dtaIVB62a@D8eW9ij!peRARHD3w6^Pr9o%`KKh2!Y&+rG{Pp<@CYAyL`|K zWRS|ALNBR$WCw0{P76OjdDotffWzaUb072*VUNOrKAQ!0cw-8?s}!_a(Wr!+6G?-d z^U8RzIMth^p?O|(`2zqv$0>+jj#n<8qQ$<-v@e4{%p%UShZd&=pm(IaHcY$yGXYH| z8p>e1ETh5W1ZYmU*-``wH?Yt`FT6VZoTThhKY1BB5-fR#5I~~1Ky&a2I%C4yca)WUNeJcDFg#(_If6%qjHTSl6sNa@9x$ zS$}~O?M(%BX!XW1&z6=Fwb=h&zgd)^6@KN(tJT!lLU!sBcsfaR34l2hnEivIb%y1L zA|gr<>#0HF@&MF&2K~fi+Nrx+*_#RxndGbKZw1iHdH@kPp0%l5T#w2B9b^}M3CLm zDs2EYwucfPa^v!X`U%t8eZ+ch<)PHt;+&+ zp_m2CkcY>0IyRYx0|NXtBT234^YMYD zKY90QT`$yIoHhPpWxP2&u`OFH29?BZ+8;k#7R|*t&-w|Xou?;K z03At6yU-XQYn=6Xrk7!*0g6^ipvlXV8XCCnMZK`!H_i^DyC5c|%G>&K2-w3WXy`uU z12+Kzz{3R;blW2c*ow-4E#O*lpH)r8Eziw-G6z10rhP^e{m%Eci%gU60@a%vR5q z>WZ%9dNwSr0m^7J?y5b_j((&iJZY3c?Bz)VXoWu!&ch)Zv$5P)@Dq*4!)59~e|}@H z#(^EBX3({P&Pxut6;*TWuZ{2tp=8>?X-YpajIPmu$Xnf6K;%$(a6PBm<2=0OuYg*rdXAKpWk@Eblu z4jSN*L7fp-%5gkPC0XjjpVuy}Ed6Sg z=o;o#Aj8P3i5M~a36RU#>MEeW`mo1~EwjKe`@+O)w#6ae(wte`;^7cUxAQIIOskm8 z)!!wTvhrZ&&cbmn2uK-#S?YS>C)>I@pgd>LE>^U>zOEFUfiY@PC5XGT# z2A%bkwmFlok`+EKEhJUGyz;&d=PkVRNEHFQJMhy`L^uSl<88;E%!)=B86rGX@b!s< zTrM8aeqPEHOHH>YCI39WsFYs7$111-;+&->GSc~_QD!h;RHnG-%1qQ&-h!&rX`$#c z=p24+-G;l_)}MuZ9$TQFIl=%2+~cOn%06PZ@pLM8#*xd7^T}J+`}{70x35>1qtmX!PcqB>`|d2H!%>aw>9K|L z!PpUs2WW@yA%l-;ARJdOr=q0F?umBZFnd{<90%fbpX>w<1n>x?9|l8jRgE0RSAm4$ zL9q=Ld`&x6evcLmA(Bq_Bmjpc_%mpT3F3GQLRhwZgs%)$GQ7j>1Htt5zkCOZ57tC+ z$I2 z2-&`!*E}zJGor=K<+BvfcRDM5etPipP`6)Fc z{kv1sFAkFTMjJ^qN-OgzD;7COFC#P`b7w(TgN_@W zJ)be3pnb{sMd=J%^=s|XHN2e(WCh5MCXg5gyYdbwP)(DyQln=E(`$(Hq6agLTE7_$ zd1g}b`~C3cQxLoAt&Dib$BI4(0U57zs(J@*X+RbVLlEKA3u*a>5dwYEM{s*ozuPP+ z;6DJpAqzZiUuZee6)FfnMk?i~n(8_ZYrt+;jr!9D=&tiTT_x{j+J#jfvLg<(kO9J? zwag3=paSaScjNpLmfDotSxKC}*GWK-9} znsy_G0pVeQ$i{s>2>(Vw7OfCVz3}I-9V#3xQ4aExrkgSV{5b%0Y$!$(49_+85X<88 zCF=%4u3fP|mtjLU)}g|<>Y&$gGz&m*W>M;kI7C^iSt-KV{lRWjjrZ8e>h>}g3?HrM zE5*KR5r;|(nW`|dGqR(Xl>Uh`0AR=7%QAP{>Y5XoazEaUrG@{FaI1!H0^xjh#*I>p zg;E+|y5OD`7!|wmiXGA2SHN+bTdjc?dgT!$?a+E_hYHOZpm`>6IvO<81!a_o-iWH% zH6QXtWrc!1bW*`t2Q>=j9s)U%) zRR+5_`v-`eQy;$0=o_pfi*jbb0?D5i2yI@wIW2@h=={qD=SHL6H<^JO4vLfvtF~i6 zCzE*Q<2UobgvD8!yN$_}mI`W!D!inVqX~q<;|eapIrms2mnLtg9BEwF5>P1ePY_9X zip0;X15gbkboNvaxFRZGQozY2d%cDOYa# z)dW~JnCY=;4|6IpXQMh!v<0IdP@KR zSRu-DUk5l9{HPvaO@OeTHc&CP;8%v^&mtZ4`$$W*&}b^HiHJ@U;6?kAa4RF;T%LUH z1BDe=Gp(L{wg##Im zKZpd~@ubV0SVBCd@ZylLRQk-mZ@0*bBLu9lI#5OrsU{#dwqm&uuD=QSCw`~KV}A|m zUaSxR_$|?8w8j7m$zb%AbGC&xjy6A}-)KoPx57%V1W>F1oKy+~zHeAA3Ba^Be~lEd zavYD@^D#uQ6V{q}(D<@H*EbvjTAKnW0T_zbD%%-vNw`N#D4V1%Lc=2M9y%axm`9;p z(gmvi<{vx5=JP?EffX43lC(xCjgJdGFdYXK4hx$2ZU2$(Y)vBI-d@Kpl0Fq9c@}bey(*^YFsQ5#p2Q&nwS7*^Qec*331gTn~C zSsQC<1j#;%bpBe~?@EDuDK{T-p23Dzvgrv4yBd8z7Bo;04AixdDA_o^Zo0|qh<*zi zx&`^RKh9gk26)tkuql%}X-k{b3yo$7O9K{BxLcaTd(eqgDm!|>lM|vpJxl|)fA|=& zHtIcGYpyB6_X_pKgChqYQ(6D2pP+)kR$31{mR~77nA6ZkXpr?pI-ha;WA3!CXK*M4 zsR&4J{&ebW*#YFL=m(GmB~{AwFc{9oavaS-b9sT%<46ZWQ|8vafb54zj-&3nYMr7N z*9%$?W@-Y=kn?RLRnKccA=m&4K?{+snSzl(5ieCg@AS22wH9p<|Yp zK>PDEgC20k0cUG~Kq(@OerDwUfL3U-(uu-XeyY{2owo=>H_vwMqMa9;hk}kDd`ivu zCW-+xbKI7^HN3~WK*?r(cx1i?bjBi)qY)Yct>3`)h$deiE&{gd(A*B)&mlGU`n!!; zN8u)k=_xfK3x5&>^bvw?1s+ca{4BbM$c-XLe35@iAyp|eAq-9>SvD^+>TsL=`58H_ zr$>CocJsTYRsjZIlHE!LysP?+tl|;ujmc2}pT7k;v_b1z+z;Y*UvJfr4Ol1Yr|f#Z z!-QDC=)~^X=le6Wqvthe)MG?dp0@f~=hhGM07-+Dr7jL6QjvL+5if(4gw_WNO+zbi zQc`|>oapoX1}gGWXU;8z7JVgZwvH4Ho4W@GDDWhzX7ruYG!WfxRb!aZwT)VmznzWb z$h?QnW6Qgb9uU2UPHP^S326ke%h&{@;y+K3KwomN98l(B&!1p-^lu1#>Ib5lOpugA z9@tb_?Y3#VIE$cqlZ05>i-Y+O%9T~V(jN+Z^%JP!KRwOIl<1zN2))a2IGr1%13%iISu5;9Wi?ue^TS!Q@jI8I%?Lu0;c%p^Gwlv(QK72q$MMTBe`G~xH;*Jj8JlKn zrPbZ77%yU4yPq#_EBa;J0jOdn?ai%#bIpkytPs>yK^VC$EG(_eKZ313;H;wj>*wb7 zI*{}(LCMeV_VnkA8TQAa};@5HIj`; zLV$Rp&`JX-zR3?CTAhWFOL_^xI5@RdTFLW3Xq^1wK;J;0c7z7xnF--d=L+193#Zavpk+2(qeGOdf*IM88}S=>WLnvqY67o=0;bZQ6D02 zMGXHj$7njh<^wu(bC&s)nyh#!eRT^vb|+o!E^6a$iH2Vv>NQvjJB7|pBbe?|I1IlC zP=;VQDvsXxOB_c1bCpeKWR=BD5ym@DxlxYOgLd2Z(B?-~`E8}7h`cCp6+`x8u|^l-05_ym*^ExWSJ3mXE+$P zHG!nu_b8OnLDVXawL`6mWgw!=AMc^{wGX-`0UwPwVp<}0h_3mIsl~=pg&kV+sKpPN zE%xdi*Rlj?--l;?tzEp@;79CvdJCb&Tjx=$41p51W_8x zG`LAddu4I8y8+M!D&!k`CvOsACzPK-y{}|Q-lY(Wk!o9O8C?Ag6hh^%+H<{i`8|Li zkk61(KmMwB_;ArOGpDV49jhrAJLcasJ!~u$3qtDiK^DqNx*Ulf>LZjdnv!rsL%a~0 z92+HXjOm9J5%@>=FPP!ko;%jZCU);0e$c?zl9(*Q6S;< z#;o7lC&xo}kVd9{D)_QP`qrmqIx1f)xbJ~(z(ZE_b~1A!v|er!2e%MK61~v>K0*c0 z8Y5L&OA@I3R{4#&>$e1o5-E}A%A~Y!Ag4$$G1pO#J?}tL`m!D5^ zDsuDOc@kOE9M_-w=QabR)~BL+TidIgD|5EoWV1xnZ)=jrlwK78Ih0t}=^S+;KXag}{H0Ku)q8RdB)#6+6o# z>8&O*6IR>6qJX|Za}ByFypHW0W6ZL8(`MIR(u&4N^VPG1kCKmz zPedk^-ut|ech3KAX1nv=_fb*IUSm53P5)-5ymh`VYCTHeg7fh8-5_oxrho~u@IZj% zu4DhE|3dw*l;xDorQlzZgkN>v6xA~P67?%<=OT==Awa+Z{w37(SSdOw38iLPSBt|g zlzjP9nuNj?evjEOZR%~r#ECw%t&f~;7t%xu>~0{ZA`YIVLw}(tl5=p+B{J`iE1Ah z)_HZjhw&5bw*t%JTo;8lNJ|59TnZYMVLio5#7WpTnYs}-iwye!?LB#4uVf;PElnx`^%0OXu?F3 z$WET5=M$Ufk_63z!Km&ROq418qUO^2JO~L*$f4n%_gH;hPYRdUa~S($RyPfZq(8=} zm4L5k#*G_QqD3j2inEnGH}c|}p~4qpq=i^drOj!v!{c)7@|Qut-*7`S!@Mu*m#_u2 zsf<~mSlQbV`a(bEU%P1;xH9UT>NV!p?NwowSGYBk$+BA~@Y%H0*`8ex_}Tu~UE+qL z@l{vJljicykBL2Zww!D}{MLDqmnsuI>@j-H``)Vmk^}o#=GnIirRBDr{w!b2A=9$6 z@3OJeg!S+Qhj4rg?Hq5LYeb$F5Ke4w9P)6|{N?7Be#X#vVDQ@nsc2~*+oE*|%fYe{ z@bB_B5m%S)#K_@IkvtL)F`=2Kt1Mvf6RcK{Ct$@oB2;Xe&J#8N<=m;JDtnRlofm_2`eFh0^MY_p!C{ zH{{IVeBhvDLp7DfiEB;T0+r|qC$<3O);=MWebj1!de<$|163%-isyYE_2xrApgn2C z{20t>olQi47n1Mboehvm50 z=gLoEGY$RzqZ3-M4etImbYp^Fq%}OO3GiaDBW++1ps-ht5SU%5FNnT@;n?|nh-S%h;!@mhHl0d~6zq~W)$0Mm-$v;j$ zpTv#WW_VR}e`5*b&%(WSh~9CJ6*|(hlUz(S@f(Ac^Bjb7Y+JyRVh1Eyye|5!on$<0 z2B}KU<{cgW$T}}9Exlj2JLEtk2aX4kQXg`zN83@+{^--oR{@BKl9~)(?~F;wsug?-~p~HgCh) zSm#PDDiyk zyD6eD6T&T`$x~S~O{6L=ux`-}U463#U)fZZ=}KLjC5N*DjBdDc_`s6+0Q36Ju#8&y z{Uwsa`wD(ZUKjiOM{>-yO>BG+{jqy<8{Oro#WyW;ud%0v>(SQM-->)qoGvP7-yMJL z8ropsP7mI7^3M(Rk(05CWkqg$*chA*S+H_)ti)e;sM^xA16eHm`EB)TFqr;*5z2$a!-6zF# z=)UHwLk!R9k5;cr%BCC-+Pl`(X=k6x;L`&*+l@CiZVC(Qux{(a`{*IFNBmK%jKqwF zvwvpnJdIzr+&uo#?^8fXJ`x>;m&N^VoYnjt^TD#sudp?E*Gr~0;bfBY;-^I42aZS*|#ZA73MCfFj`c&kaZx$9oI%gc^_6e+3C4RMYpgV zZ0EOr6MGr>4QncicYN`y;!~9^UC z1oMS~Vn1AMPu?jFJ?jK8F#%vHv2)QslYf4NO`2vR-I&5INCa-H$j0&BTPod4xQ)g2 zl1APrRK5ZAA9(F#;tZi+auhd}wgLqV?j*bw{}$6##T6<&>S9>4SCKycBzy!}gua(K;-C`Pr82zX~?%8~$dUnBOA&+*Ad z#fZ_*he`i}5dpwdb;Xr!fHLd<3L^S{h1dFV)&qg3;ko*sfU0}4JG^5V+w8b3OJ5o> zp!)m2qINEu0&R`|iRik6U%NfP#h(M(k`2grav}c@08mAl_+gp5R_6bwKeWr{p+=2Y z$qoXdd4LYA{|XYjqlIY3Ikug;0Kk%&CU;DoRURP7|@@;WKiv|=xC;Ju1DUhQ8VyeMr5*v5&n1fYdrJt`oH+r`ZwA)R} z6ZqZ;KR3EsR`Hmir;ONOJxdX$FRQqsr_Xx!fF13T5U55^uBZR@0Z&3;GGsyWNyq)z zum?Pklc}F{07$`1g}C?1ipkWuy*CQY0F+>gQKzQ`dA&EZEr~~grY6Mo#K4tzZ~zf) zP30~G{q9Kz{)+$r%(-6>16p`oi1RV01K^4Y09-M!zyHzquENRAJ33H4zP^j`7c3hC zm;K`V`}>q;=iW1!HIJCjkL22$)gDK>O3uoijaK(}#Pjt=fR|Sm%yRVomr}P{JDQE! zeHN3sozT61S0q&d;bL*}P)Al-w)IW)pH%=}8SZ%rQP&mQQHg8Ep?nBiyO%>r*;R{! zo^_}t#V59@WJ0A;TM|Ed$B$x1~-vD zEk6_+bTYGj&!{7-Aj@MVMjp!qPlB-Z4`3al`pr@+<#tF9#=oDn7<6}#@hm=4J*+rF zmU~6+CGOT_Tz67*j{y!@K{EA~AaFn_09+S#`RkK2mD9``s|-e!r1;n&vtF%G!W8`=lLfFe?~@N~TR9;U&d_rW zLlKYuh`kY)OU%6C>`Ccf;4lmm;@3Ag_gGT4rpNSu03R4p3bY3;UboPHxJ5$dVDN_b~{x)s1 zZ7UXEC7w%3Cz0^sM!4e0wvlb@z z&dYe`Pb=)dU%z`=E7r%T;$z&cl``E@pbpO0UH1JhDx0G%DZ(c&_(StuL0geGhHF^U zo9D|Z@o{m;dQ_y3ctBU^YEIBaiF?$L&ipfZu;Zc*2dMV-I_-S+@$|8ALHduq5_=T5 zy`U=k9Ohmc4NMZuI{OWn|JC$!awBP@tsdM=C#Itzi1dO%-F(iO&38FIlJPf}Q+Z86 z9}Tl*Fu3nivA{{@MOt@m;JW87w)z|_dp;ec6?8gh)}q_Bd~<|COH8ryrKd*pIt~gfM@7l(_}gTVpv;A@7>Mt%vbN={(J75%M)^S7)@ zL6;vl4&76NRf>t&2*IpGH7};k1^m^m@9vYzgK|eFMh5o0GRWhdPE8AjavomDyrlu2 zgL*!D+cQze>%q%*R{z$Hld=%x)eI=;>OGBY@;E6Q%8YiuRAo-BupF;L#=Z7xcED2~lWqod@x{@O|!em`9Z<17_2U3Wj zvi^u-D9QiYabI+%kf(r&XhBsr2nrJ0AR;nGup+n~h@8629?yNL;r^@>!YRqMZCiDV zGg!NQmn2|!ikXN_DbkUO#v{V>YLxsph_&R8E6W z@BYD3MVgdKHwSXPcp;H5nhfoK95Sl=*-jO|b#AXx^gd=ZM8&b=`N>^o*;unOe$!+n z@cI~42EtG#82lNLZV>YUjaylANa||q4 zRV`#_O*~>wpE}DTS`w7{9x}|wB6}$3)FOPGjc2awT76J*&RZlt`eBX6Nn6Rb?w8(E z@@batGp~2atRObE1Rtx92*PCMjZQmZR70m;Qw_Fz&Mt~6CWOz^p`j||kI{M&fz^M7 z%H}YIkae@W=X;3r@2%r09>W%4-yx$!yOHkiwPYe@H2!2heziusGv7DGZdFjpgN%YR z5sj8B)`{Cs)*BiXjvJ?QXWKcd|Mr}e9^m!1&!oNI3}Krdfr1G4rqXk~x|KbNB66OD zmW`G;cpjcTzbU8oQ5jA_vt*~=Ci?9r3D=)MkOFAYE2h>*^l-Fmr!`G3V*fOj(1D`X zf4-xGq?k0juQh1m!Q!w-5RQ|=j~hAinR%;>R|BQ-s5F0Q zQ`PR!%~I3>nD^NZxqCb-LSSA)VKM=~eUmV$*`u@g-SYWxo$#&aa^r0i%7GNidV#yT z0pOVdG?t;V8L_o1{WpVZXqel-9njE2CSN0*F0`1~Wfv|m|y zICFXXI6bK7q56BJN*1|F?9HhXmBQ9?aZb?Iwmai=PJVgq?$q}WgwaC3u$dt`lkAx7 z2-Mjay9^@#l5m;H`zf7e04rMEd96D#>>@@|mr*8e`!iknJ$cmLSj(Jtj1HZQ(HQG3 zhD6$PEz^=?F@m~_t*Y(}$4kx|=)K>1d{L9i%!oDDt8;81w%GQks|J|EV4JntS4n!c~T%r;B*5vf3+Gs6?JB$v+7FCGN5|??f`Qws{l5ttT0^pQcU0F_$gBBdCHET*1wbYlNerbxIE#$=Pw7jrz=-Id$CLm zf3%IEMo>%WQJ~AL;~&a_@M4^xT3aHvuRr!ACGDxxWgm?^e{4`BAb1zP$Y#s%Py%Ff z?cfn;g|-?Xf}K2Afl;s4j3^$KIa6HW6QG)0o61TWALu3m;{UXMy65_eA-Kjr-q}O` zdy!5BAlqG{G7&mrgKgY&vVpA;?@3oW0t-H{HI>`=W_u^x zwg@^}SJSV`k4{6A42jt8)doPrSe?%AHAxD^KGU?zTHkdeWv-Y*N;vVJLy zO<_Uw%f34Rq}DJmPvEntU>Dg+GvU@z^P%y+V|B$qnaW2SW6wk>NLXex+Aw+^U=pE) zWuc1(N(CVaC0W?%{KwJpxqkKjIEH>%cy$&)nqij?(daXZgXHJUMPc5$&WeGdyvF>}BivrAT0_LzP89H(+d037bkuNvf z;Q}?oB9hrbY}$!TI&x<^Z{W7~vV(5gJ%2$JBYn%Xl0req+G!y={N}Bkzs((_NPWFG z>%jsdLa;U#zW|SBdAfn&s}&%5(7QdmFc(->GOd;Tf!ryyY`({oy)PmgR%f?|gy^zXu!`M|K8)+}BT z5N&2FnYR-#(GBZFzIzP!KG0g*&Se!8uNQmw!w4_t=kV9t2SSQR%Jk&L`_j!y*7zux zaq6_U(9;he9_dM#iE?WM{8oaAz)qi0yLkT<_RatD@mGU@rvJs48-U@Xu;8|=Z>TVm@;jYE1u(4@U_cl$1cM)=qdo|@4gI{T4_JB$k9-=@ z_xhV2Mu`AR6q;;>$J=f6^SZ_VkguQwrb2J6{nvvgO;Oqvt;s)tENjej@c{D6#1+aquWJ53e6l^`Pg8jZRgLzjiZ1I*0!TqAIrVv zjk*KQg)q#kjfaPIr}vhJGz1;_2Xx#oGDBFuJ_93M*GS-hdWs81iqut7?jls@Yqn7L zjU5#2YDH+V^;;cWQG!x&-SVCnnc@E$Un+(0TgZ16^)#QBFY#&$PT9m5xh+XWwQ%!u zg2cu#{t4tTaIc7Jp^EMFXFeGa{&c(TeyazD1<~n4C*QQK08$3`Cf{gpO8!fD7T?J7 zNqNJ>Y;ezdrDS!&xjc}bIaz5<-QAeUS@K~#ZU(H$`rgjXI8560tz~@u#^2B z1_dqAC-cXKaSR2s-S}ktEU3BrI?=N{2-JuNH4b`9<;O;xNL75;NzOmrI^`$^r28EW0*_(hizWm{SRxkr|zIE_sV zYmyqN$${>~-a{@F^v(E9xd19&mg91hsfO)~2UF)?x2C?mxYM{Mkja8Lr!Tj*6|5$6 zU_hEiPx9(cl*o7p3|;%KPP7_7;$FVCZ+t{f!(^?ubP^(=bvID9lJ~nZ(L$xnqU%{O zF2k}%?l}ot&ow?UB6vwe^A{@H&%?V)1-tRVRqofm8ZI+0oOGG^-ox2(Bt@wY#qyeY|qr&$KgtMn|u}apG6V08OB+n0=expOkLD zK~x@-(@Au1u)PA9&@CE1C*?dmDZZud}73X%R{;OYqN*f!rp$%Q7s}pp9QP&UJ}52-|g|WkF7xpKTeJPLb8T}i(hopGMEHCJM-Ff z+&fAgF%k-2M;UeWI{e&_Gm%!R@zlJ|o>Mnj5Rn)P0vu>ETf#>g;N2ZgA zt67@w&}}?9c~o6=A^`E;I{TKjfA*b02k&7tm#pcp@i&?A#FC2O-a`lHc*j-TP={aO za`^k3r8Uu?D1=Tv+>~ffL0+fTbIkIt2`i&{=0yNbqDp(&lVM97q#}P%D%)C#73Oxa%;8L%^>j1V{X(He7aU!Kw*e8&p)f(FqqA#)A{Q& z5v2p3DSL9^zHsrIIPao3E1hY|WA<)ihi1MBl1)A>nZO(yVm=i0-unDmo$B)3bvslt z&?on<_NX$0Aky4-PP#B9hp9UlAN^S{W%X;^*v{^s`Ck#{Qdyd~)Me}N+Z%oIbco1R z-Itk~e3aMJCX9UF&E?mtI$vYrGgStA7L|1Gm47`iApQLFMEJn3W_V z%R~=1X^P%O={;?$@I#nH`aM{8tQmVFZ8cj?HuvlxHcLHZy|!Cl$ctZALI9Ul>c2(% zJGr9m@=>_Xm&7CGdTmUrb>fKWSwV31?3GBb1sbKN2lMha48hpDi211oe=bkMmGot` z)?TD1k5igSbT4vhNt6hVF=qrg3J*s7c^yb)lI+?`40m4n^avF4&9Yd2D&7SF9Jle$wkm@f0x z=j86{oA!N`S>V(=KHRM})nKj_b)96;t6jW9pL+7dg}3HPuy)1oB_#$Smk`I_gxY$L zf)l0Vx5voPDuK4Xx`o9V^s@;f`1$v75q);ka8j9@J->T{ydQV7XHG0`R)vH%?m4t2 z6VUtn%#+9X;&L9`_(MM$#5#_0%PH*y_wzfAajHIxRZi2iQcwNY;=sTn zjqmMkk+}!-X1S>xJUC{}vky1Wr>S4h_<0+}@`{dGFSI9&!Ytka(ZA+B!t2RQH-(&B zU)rLm^lQ}v!ueIONnz00m`~6vGcR&`a}LOnRw4U@ytohk*Er8i#?*^`^7eYOAC;L4 zU747J^Mg09@>-j)?mSNC2?asis8IK%%qh#E;2In2E#eEja%tLSWEWA(C%I4_8T;sSVs{lpC35q#_UNNRXx;_$sr%8*r3c`MXd9}D(BCK zvp<<>G(xbQewv9Gc7SmN|FNXF{nlv1&7R+iDIrG(?QuxoVwSZJieNUY%e0>wAV<#` zlnxLch)7nIS8B&wTn%Ntv*l4bz2afA`^eVYe^HsP@vf|(pn)FgcE7|dI_UA@A8C`; zelm1c&yPx9fXC&;X|zEK)A=j5EF^s8Kca;W)&~>UZ_-jkILXHSA=sO5U*kY(43=*>O5jUc5&5m2wn=kxcrDC3Cl1Z%f#nEl4{Zb|>OO%KAxvM{hyCOZW=^X38( zU=n%5$bT>59>Q9ow1j10yvaqx)*=tq|MvvoIabhBdr!E7X##>&fdo*bN$&zmZ_+y|0qLMf?;tf0Kp=F`s8s2_ zgCHdkdV=(O!uzUx=gxEIkD0m8%=7%>;h^W7z4zLm^;v7Lwa$(~%8Ig=FVI{dA|kr{ zP!9Tph=>G4M0BPYbQ-uaB)Y;&L`0mZ{8$YJ{F8`Cn25-fNLZLi7&u1~!2*a(O^Hk+ ziA+(z4dALUktyLO;bSUn3LKHbz^%wg;Yi>-szCVIDky|2*xD-C0%wFmc(dtokEX{h z37rwz0iQ_Vk7*=uMwv#AnxasqDByeqG$u49e8O$R5w_vYwusqqphsKaAY2MR{s~7k zhXdD}f#WDrm?+W|ID`rP0X+h;5PqQu9ixEXz+XlqM^TZZ!1)MatAGf%MIe9v6)B901kQw(1aXdkp-`hhYt$%kK0+O#P)A42;R?;+w#^9O2yaFJ z-OM)69yK2wjYbNOMw*VIfCCuqxWy>&IRe@Nr_rOMiHV6>gzYRMe6|@l5QKKKN3%yq zM<`REQ=t9PD2njlEaGSu=#MZI(Cg9hBhi>g_JDHE+skP?5)pB+5Ppc=vLsxHh?s~T zLM7GQl9ucCYUsYjr)iS}d1xd^e$-k58ERS3q85p#QDHTn*S|N5;E}_hZD~s~S4j3h z^IhoZw01L02;Qiih~X@&})CJL1N0HPu(Y8?6`9%5foN%yh3eSA{| zbBT!QTs%bYjzLKAs{_jEA3HDm6;kxV)Xa#8c;zUJLaiI-A!DsRfuPL(>qHMORfVi2 ziDTRL1Urg2Uv$(xfx57v+eSW+Y}*wiR=(f|<{$T(2b|)t;Zr7!wtW(0U(@I!e0)_D zY}*;HgAY`Y0^2^WG#~+Bd@Pv(TAIYqHI#B?fd<12?dbo#IOw>qSp|jUfd=2ei*SW2 zx32&3_RV`7T&dgLxZw4>LwjQMFyV)Aq znT3J|W$R+a5OyPub3eF4pMaT(UOr@ocsVFkVW%?Ir{X;|qvJ^m+1p3i6m63yxt#I( z`nP3ciV8fr>%Dx_GsZRTXmBeGp|h{V(bx9dbqRM6lqVFAkthurv|-X?RySa8(z zM>b6yBp_&wbUv)TY$ccj9YwoqdgaiP?=&EEWh6Vg$WU*=vUv58Z@vCVN>wy`Hp{ArVK!cVw)?R}aa||M;wio*K@a4DS%ns*? zAx<_o7rJ?*xnoN5hZD$-yJthQ;T}r=d>0u;#8tQ1)XQyX>-%6-&fGhAeX2(`T266A zUv;ow4^^`G&GIvMBICu=u*&Y<&m5$fc56o8(!70Y@Pu^*vamjHE?zUg@m|ERyTULj z!1M>wF(4%dui^v$g7}jADkBC=rH6%fCgCHH&N9B$WV`mvYHRN^14GW6zY>(eNO~uv z^Z3XBai`p7puK*YxAcLBhbMDKc1jq&(()S7ryH)|T^^t0Uauvq`k~7V79RXzpn|S?(%gpr*RhisBSq$n3n4b2PAw&#I1T5{ym zpTF&Tv`{uYw6rVqRYwf&4{&b@sK-`a%DnB824dX*QvMAJzE^R;fv~b2*zWy_5(2cI z_O1q$hkc~=y0yOye%oVZG*eK{{gwDKuk zH40I4@ktJZfT|>9?9r;bGxL0u20wU2iMVbn?}-8S?tJt(g0WT2l{^UgDrp3m5=tTl}UQvHWvkN1PTzn{2WN0 z?(X2^9hl4QGPZvuS6fQ^vnWKb<}vv@e3#9V_6N3B&ls=Hv2boFhU&{iJk;(Gex>k) zRfJ(-O6`!GC6=Qw5W25~?;}ff}j&kLKx5^)l#94DhheJpNBpi7jg&@RA?|+M^rwi} zPrZVSjTP7{>e}wnbU#c zH~Z_wx#`)(@0PTr;^ub9hOq(Wa8LzKNL9k4wo2rqilNwE!Cs*%5z%vqGJMVkx6%|= zpB?ifC2vy3P8_#6HJ=ZPXosZK)$owA+58CUs>*X=6DSlL-3uiqdMOpjF10zE+XioM zksjQmPthFMjB(JeOP{zsH#KhZ{P`%#>?i{7&dm#}+#y!8Q`B{uvGQRD2*vaSKG)KX zRdOlJHc+R$XLfIbH#M=4)6F(3M0tC5(McU1b3XM*t!i34AH->7RWxHxO1+a#M)WjH z4s1*6HS)~Y&~pK|S?#o9!N)CZ@Z}k&)-a4}+S0kgTh9V_ctHV<@a(*mm^-=EXYlE| zCOn6t1oiyRm?10CgZs_b(hokAV^lKA8M*X4nlw71beH1IxDL^^RLTt@hlgR7Rk$qn zY><*oMao`mxo3D-^y*}#vfU5eRdy=30pVaybT58?AMNg}dx5PY-;z$xtv`vFNSXb5 z2oOCy75@J_hWK9`oy>BeXZ&0ILyGoaNWC&_sMMmXT}p6t()m?&y%qc8Fl;kNSIluy z^|{XY?4X|fMLwe&mw79xU?mFf(kIblIoiANV7B`ZWRH#|dnOKn2ih*M`( zcT`2;OxE0wq7HTC_GS5FKTaYPtiZ zJ_CWmiwB#pPVauo+Pg6ga^aF%J(rAKYEWa1yb|SZ2?zN-fCrM{X^bFS2AcPS4#4S~ zV+$plUW*{I>Bme`P>^RB4|pIpEce!Yn=VzpUv5Ydb%xtUsmHE=ti(pN?~|ihx9n;G zUeSp08Wk$fw3yL&P|AL-&h)3;R9`>YaK}u+uuQ0HJk3%gy`GnBB8@)0zE0xl{D3QW z0tNQAhxw&l&(}p=*}Tr`9s5}?<~zEs%ofUNih9?W;obngLtY`Q@fvSNO9z%oYRLCl z$XZJn-m+&tx@2e8QsiK&za8rR>2TUh#IVIg5LX(h6JTXqj<~;vEY-VQ&M>;$uP|hs zyjJkcB#BmlEBZzBqRp5EC!)X8M&7_=S)){D^kbO-9byk(?>e8aM(d96b%|xD&BO{B zb~Ez|Y4|*J!Ji>lN>?`%vazb+E6-s(gLY$8c=^E9@R-tAeG2-W8n-PTnkxk4}J*V_T-_?;s6jZCz8#S}mt)1On znTUZLwdp~&u--=<>Uq6eM>(9s9b1(2SN*uJkyd-YepS>}PN8N}CUD-?#1JO@V{t;P z92C*_jf9F9*}|+(`cwkUie_;ZWu(n?uW|BJO1jtDPmIVjeqjV=l0x)h@wGuy&00Qn z$`v52VAZ0s$G=?=D(Yg^!xH&<~G)glCEa>Zvzciy3pP zOL&?0MibZ6Yd7dTD}}xUE%mvswfbQ;cT1A4d``GL)VJEEJD+IX%Yqh;NaYK*xB?b? zE=;q%&zJ}^1*f~Nx-RQQ+i;2Rb>#azQ;>TqZJg%OHAwDM>u+nLIXHW$?%e5Lp>p5c zQSAd?%F1|Y{N{cRg3Zp5LGvq|)zww(r5G$6h#JQ{6x)PwVy^8)oUV!81rl$vye;F` zx83<%BKn@xK?(*fmNsX<`AZkywyM)}@mZ>@%rH>4*;cT-g{eSY#i`B2=Cz|vamSqZ z_!w%p>WbBiR!Gp;4x~Bl+da zY5epUqWX6gAbsnIaLoJdgnBPACB`_z{TlhzfFLsQ+Q?iZU;>Qq{B3Kp^}UI(-9G|g&(j=A4KkSLYYqN# zC{=t)yOiPmj||k5w5nehShtvr7glpM!ykatJ*%fx>HTQmRoJQ zgMA@dBU{T4&j?cOs&iZVtX@rjVXLOwXP8~_qG>a*t7f~#1sUw#^eoZw0JhyY73A`P z^4E=1cIk7x&qhBI+bl1?8wYHG!NkNQn0j=!9!XMM1R|f7bUYp9bNS)7ZquZq&dVdN zYCFA8rm*B1xN4~Ry!cH|mmuX%m=2#v>lU5Yf;(Rd=)kkVYCc~m7U7cHV1AMBTmVU( zSUUNa3y=CE`jY8K8u5L(`fpR*gk2*rr6sVh<{vYch?hCvLEYwhM6k=2zZM@JxQW~q zjIBs^-*MG>HL@x&w3Osbn|2Xhr=9>S`b$JN(G1Dt{~d6LS6A(=f{ON=o)qxBIO8nQh8!Q0ziVR$;yUGlhNGe?zsLLiYSOGZ$2z5q;j1 zTWTizvX!Q5<0q{iq**WdV^Mz(kuUb(YL2^o#^H{WnZbeG&!C|D%rN*8c|d0w>+<*5 z-P0dZ1dufJx6m~Mly8ER-|AF=maaKZ77FB)M3ZZBG~vX5lw%C7JdDpu?s7a=SkW}|3>6k+5>EBG7^a4?GV9416?q4Budk*vFWc-r)u59|$KkK4oaei*M; zGb)7?GD@I3{2xKs;LyV``~AFb55-Vc7OCd*k`TS4{vvU%65n4ohZk0>ihC+8`AxsK+-s`9&~Gl*(UaYhh9?0xy}gYiZK@}7f}Ql3Sf}Uk@DhL zIYC_pJ!mMaV?X;WoC$2}!#ei(qn+TUeHqV@L-|V3lRHlXi%SB_t1=nDI<)8OBZ|Gx z!f*}M7lm85lJ55!>Iuwy!zYA2Ml7-ASck(5KV$o6&a^f!tTbfP4LCw=GgaP3x(N$T z;J&{+gkVB>N)|qvV?>`AveVW_n^WLauv{9b6tlj15T1i`SxHmC5J5z zw{{I9p(LIbwxr{JyN6zBdxf`pG!SCUKRgVqbQCHOy;QpKP*wFi?c0`JG`_z?6sP+f z%#|+F-$HgZd5SdAVFgDwty7>~Nt1e+Vi#+a;EAZ~+Ifh_buU^eXzV&!q*f_g>Cqv*&$Ib*uA<{LO}T4oXn?oJJaGC_DM#IE|ntN)VPa7O87xYR?s$bfIs~H9x6k@yq zO@|#G)tj^0`o_!5B!u86HE1=l*Ogi^WJaX{yWfsIUF&W{LU!fR$i45nPERjg$`bZ? ztxoEi?!$4(+{7$)nc&~4$8Dfs@`SN*0t(uYvT!@f5I!IhRj*T1cqo%tQK;VAP`j73 z#65`1r$Uh1ZWnPr))X@2*QBcUk)1F#Ns;I-KPO~3HNcI=RdpYE8|nXC;8e|n)_s@6 ziKC;iSmQ*S{_AV*^L0)PU`s1=!&=V>}g5OcE zqQW_(YbdZFDTk7(%=<#M`bNT56!8KvaC2%?_puYNe(ew9U>CC%`**;Sld?i$} zZr7@Vf{tRHY6R!xzjm*FRQqiQ!6|Rj#2EpG?;z_>guh}0(TixrK4hKQp>C&52*)kX zhqATt|FoV*RJ^h|3P)BIeDB`;^x4;~=1B0WNwjPE^<>DHaFao^YPL=gc|W{!OiL?< zlq$Xc9~qYQ02z*c+RU%4Q_@rW;b(Je*qm0nQC%JL*s~Qc92e#hK)je-)3jpi7ZTVt z+i`(-nYIU-JNft*)LrAv?&B5izD3`xg8Z?U{dYF@b95L)s=5nyFprWmpUwNtOW4?z zEy$g*6zfxcR|gqmO&(mnzj7D%Xg@s?GL=NClLcn8rECwetlI*=`;*2a> zD5fscT&X+`(N@@sNh-Sa#&Q8s^lO^B#{(#N>sk&0MMMC_m^rFq(=l)NB`JaIPOmn% zs!vg=HaUV(--$gNJX)J1qZvX)@w4;&=d&&r`B;9xzw^e*Iew`^Qk`P4A^lewgSt2O zp%lWP0W^qqm7wia&vrlmt7c{rX2)Q!4M=vs1V1Gb9 zy1V`0vQoDZuh5g-z)ZF{w+mQLiih^Jp0|4_lsvbEYDS9zqq?647!~tQFxii%qL8PC zOx`Y6jkb&55TlsTJ(cc+`c~0rrKw@w4~vRq%nzVsMi$g&rJ`nWQPK%3XTYbRXTULy zC3xC=AC7GX$-kF&TXg!L-)+bCc)FRs=N|`((t#kzohzG-^WL>;0sP~q|G5yc?My13 zS}m?9*PF~F^)iqNeM*J#y8}MCul&WI0VrGQXmQf4+_n2EM;|Si6kK0}h#|nw|E7xf z|2SKHb{oA7)aB3pxOV}lJ-w8&r@g5Q&PIOba*wM%RWoa(Qg{>f`c{6q`&UZv++#}p zJCyF1a?P*x>lkyyiW-N299cuSC__ZgsqqI}a+XBPGnByK_oHA`Auxv1w`pMIF+;64 zBZeU8q?U}3Z;%LLim(hFdF!9=WUawQ9nZSI8NY3M87xB>#i4}-706@ualyEx+2jE% zGk4&sZq+PU7aGT>?Np*Q%bS*=qGlCTsJ9Ww3Hcs>r&{aI2DNfGdw%&>4X*zZ@BeW0 z)|*_a^j1DXl9|v+Mh{xDj&eT_+~B=XKrDeIrFL8>qRcQjB;nQ%W?TU#Ts^O-35KJ$gjXVPa6vuo70 zExN?~ckr5D)>h>lcJ8tF1yXOLo8AO=y(GRFd(7$AAQ9y(ylUs&$^BVn@@W>RIr`;0 z`D1EJ!hP~flQbuGy>MF{&iXDFe8q8T_f}Dp@tl7rDJ7Ak=s6v=tD5z7wT4pr2$CDP zmMD0oXdhMa49ZUVE=w=4P|vGGAA)}5FzQ#+)FF+|IjR*uo&Wu=5AW6qP_{PYc*lAT z=@|}(^rj3EUp}uM*0G|SQlw?+|MWwa9y^-fYdiXSZ!S!g^l-uP;OY8X>9~6*#9`c( zoHE(F+NBEi*%qAB?oG3LPL{4G7vsQ;a*%|J=bx@0un1>7->@?}spY7s=`p?Sd+6+3 zwMZ(l9vk*oMO*9r&bVErgT!D~bnmzNJ=f71kne&w!{xuK?rLHOTXshCDrVQ`Yyf3F ze4-9KkE1(M4lcP(VhJfo;c)yZdxX*vJ5Y7bsdMoryccXf4;6X@$BO+zQW=t2k=mJa( zRL~LS!H`{uQIt5h#R!A^rB5C8D$7=#ohC*4T$`nLgeW*&>o=f2wu1Q0`gEV?lgbUz z^MVrVDc50ehd*NGZMptz@6=RU)!Swy)3Hkx5-ngX!4Eqh`JL1XeQre8giyPWUZ~H* z?=wrS!V{WXCx!>uivZYblf4yWkLy>u((Y_c_E&;r(Ynpuyq@|^)69AUFjB*JH}O%b z?*Z-VC5e__^z=08#D1+weA655 zeV?flYZ01DyvC<;u2py9d3`l9gy-3b_1lOff>hTBqdk|HN@oeVq)h^D{j&niZ)vS= z6|Zde_lgXXhV`aiCWITp+=S-T|AY}_>8YbRxA#6Asx4yokg)pvPQTmei&|#>ptI8d z#$sDf;;lU$HcK|wRu(0SlwP4qcL($SESy=Ya8DET4T#r=z~#lFE2O^GTx&)B(^IZT z1~~myVXG7V-@q1;bI)#c{(gh|OrM{`uAa!+lCIh56U+Y_p9ik_HLKSJ&!q&f)iiW> zzQiL-iT^Gw3z@=GR;#}D`%~NPlZTB-y)_-@{w_A@5k*KwgPp?p#NhmzF6R>?i)Vza ziABF5A}XFNfW=i)>Rt^}zF)G_PWuY7RYb^*98Q5{sM1g6$b3UD@)06Ud&|BzT;)@$ znUYHLF0>*w-W1T#)4e^_e zULPMfpHQh3_p8p!KeaQxdD3Q|9H%p6=~TFvNa6WK_o%NXGgxxwlOqH10_B$8c18$~ z{R!Oz$_s0$p15~3>16K`(XGhZogK_#^3tK7h&0^jWM?8m&U#=_k*L@Cr~$sqc5p-TN^n!j0|7%`_BBK^(`qlTSbbln&_qyqMvHMv!1-jnB}is zo&isYHE8ieM1>EIcH*3A|JvCG%x&Y)I6ZL96gRCmhPnJ#i93*j_6ng*s(CALO0B-H zH>d4E!0X@Y4{-xCXij+IXZi=ZkrALJ$IK8ji7?&Iul^VaL?0e~gyBmM12$Sc_LTb* zH-|WZ8SH#$)Sz0acNF$GnEzOO4@~Rfssm0EJpE$BG4oIC4Wcq~w)y_Krk@Q4H%zh< zXFc_YX44RBTuz|!P8{e2VgCXTpqNCXaOq#04EQL!0)ke8miFeCbZ=H_v0jH|krMo# z4b$Fi_yc%IalLnay?O?P5oc2yFG7&|-#%@aJa0zudt_CfAX~1ZrW#F#vUq`}k-S$4tN>2}SxWk$C;Y-r!Z=1ejfoq55-;6yE z9t;20+NHTL_i+{^xu&Gc(_a= zFfv82pWp4?x_dVTG^f5C)Iv^?WC#DMvqaXv&fEns7q(ZM97 z;`03blnT#Zyk5>V{T~xk(nSq-U z*yEVjcV@zK71$IdXX)NNw02ipSMM=+x@8YT-XD&is=7-Dz7UXkjxZM?pu_W!g47a} z&x*@t;ZDMZKiCG^v$6&ji=VL$Cswi*t01lDWBE5PI!zeR0N&3cgOCkFsjjG3T+8<6 z=7zjKE(P2pg9?%NPRLev6@}+9erewWxyq_6`Vq3NWBJ!1wTr)CT>>^0zX^HzAqQGT zmy!#O`9ZyuEZ@&;G;&e)cc%4<2^~+(iN@D$d6T3Y%o z)cJuq{mm81lRz|v*dN$;+i^6(_tu7NPTpY^wJH<8p+{G{p^{Y}wO27<*uG@ua_OX; zss>-md@v}*A7-{JQdR%(kAUFfw_0BzJ9D0cME8@Ejl&1*vI+8&8te+0_RIV(wp=~~ z?)b_NBzeI8Pa8)qxAkZVJh!;WzqUB~fB*o6QG1JDS#0p_KfnURfMIaYGbhFQZ(sxJ zJ12?s3gnobyCq48DUOF!1B?HPCB5v^G|J{8^IMH_cRiWVS61|$MRfzV!7Je>5m$x& zs+aZ)w2!?OEqdKfHJB*_o>n|L6z{q>JSV9t%@GV<2|d|G?}Re2Rm;#=(;V_= zelDh@jvT;FDK5ZWEp2aPi(SV2v5IEovXRZr3{Y$aurV?u2ja!);hp{4A6|YI3(?ad zCrekjiS8@Pbp2g-IiB4O@XBO7P;j97$J-Dne;^YGB3J$GL|%i;j7QWn_hsV#gI2vO zETU93!co87_&LIJKcb%FS0c&&^?}D+ztu@oR|V`5qN(_Ap6wZB!@OzpT8ga=xJB`w z6kJ=fqT*WX!j}CffM_cBJ*eeL!k^R}mqWof)Daw|3e>9TrtDaC#nAce*e$( zATYQ*REYZz%7l$K|DSw-I)PL6S(IXi|GH?Ak8kR(Lx) z|Ag(LZg|Z>Qr-G_ZPMS0lDiG&0;fl``p)N*MuWLE88M8P4KI$anCT+)-8r1_Gty9V z<&%Uc11U{R=oAUd>d=-PUUQMleT2<DxBj=dS zR^8O1l!^NXYv|Q4rjsthy}z@?W41hm=q(iq-vgE-H_z&_H>x>xYYz|d945B?Ono;S zr=utFF`@si@&xt*?>{t}UM-n?>2l1Bo9I-e_{FkPt@y z0)C93RG2K1?ft+>7tX5!zs;6j1WDqOn*U03a`k}(^TeragA;Btp($FP+$AJ9fGe7x zDxvxht;NJrvboEBo`Psj?w~){sjYCUr-pR2-0fkcH z&P4VTF6VmO9W6B zSqgIZUH+|~R*-_mOA*rOFS}r?RQ+uUt#kjT&IF@*6$IHg#(wsT_1&3%!{}pga!`0Q zPA-69DHBvwWu%&ktMl;Ek6-YHai6e=)4fow1}}>PhHQatq%9+w{*#$*p}xBnAI#G> zL2PeJXr1j19!h=!>2ujZYn1~j9z zgAMETVPrsb^*h>mWdU)jg;)5{t2Ucd%%A@4atMMygjgHO7ujDsz9?(0{1@UU#pPx`Rt>3IKDNah<*gy z2lzpuLsJyfv81T6Bc&Wx(al!Ir53hr*m8>TU<%W=QX*N|J|z(x#xZc^6&ynClHZ9he#k!>MxdCT~x>? zW#e|Qk5U5OGEkW-u$Yt?Vy(+814m@4l8e{a#fAZI449;Vw{GHO>4@OtDLY7e;|@Q6 z`&{9(p5D0nj^XB?NA@8}?AMM4$c$h`poaSFdaod}uOWxdPGQu`ck_SEoNF z`+?X1%=XUzp8A(t=;wSSU_~PEoZ{~X-^#%QNWey10Q>(_e5vCQ#hj#%PTF^sogW3` z(SWzn2Nm}-0DFqB18ebvWBi$i8x9#fG);YCUo9oN+2z2Y~PA~*AVtcd#^zH&U7^&_4}@YHHvQV z3nlKV*Zt}BI%Mn`vpigv)WB;emeFUe$8m|flU1A*h(eB8A!c1udn=a$lGFhOYpk*W znL)L{WJ}@h^J}p)eKvq-|48@72i!;pQ0L}y`e6uL-8%`2gM_91fU}Wf=&O3M!mDo%~O3b<9#?u<#PVQUnt;PT)5e{~gTqejtw> z;AM^hCV?f;upY{o>oa>K?ZPm`|kLfjn#R3POj0;U|avF@SFgD=nq4}+puHOl8TTU zsR~2%$Ty4)HtT9bzHNdn?*(m7c!GL{!@u|8hytO8b`$ttHcfW*ahXOxx_IO@VZZD* z;zlXcD8;f0R5)l6-^iwSH9u2gslM>r0~1&ZRK_zKrI&D?LX_8yYm2e>MhuV1!cCe2 z92RmIP`9Eq6Ehp1;+F%v^f-e-nryDAR{U;r{a?9%7XJ1lF0KRF%TXYbn1(kHy@W}& zkm4Vo-%yas^jVw(oH9Z1^!{Yr!)j1$pgk$9QuAMPk*Wa2?g~Q92b^|20+opzb0X^A zT_z}Sj1;Vs#UcfbBj(GAIQV#cE%XLD3va{2458EUQGpb2C)_u;MJfSx(Pp1vU^zVt z26p;78$A;W>;f!oyU2Dz#Zbbwus(tZ=bstK1KE2H#EMkVKv0vK0NMi#{pGU>El+G0 zyC$k_8VfM?TGlxzwJv<-90{Zh)Lx46O|t)N0-ma?kWdlc)2;+~Wi(IM7+Qscf!8sg?UnmWDlDMrbjE z+>D}@1`ST{_cf)UL*G6jD-5gGgX|;nsiQLbUV^~Warxo;+`#uRFTzIUpAW=FXfy>_ zOnwgm)daGjp>ykj_C?R=-x40(eh6=5g$LW`c{6gNG5iZ7KDhJU<%jtZ7QQ#2aQ!&_ zq8g4W4~&EHcJhN*(Ak7yb^#`-QgYhUm%+jaVVAmQh@MDMod-~%hzo)&FUkk<+=S(& ztAS}eR3E^ZaY@CNUSO027=orRbp$e@txtKCusEbRpXz%WGNU+i-Ovn zyFiW;;ZM7_PCIRToej{efSbkhCs#KKzC&tKj;~%P#v$0g;QV-ER}Pa@@|J6zH3$Aq-|aNUqoKAIB^UP`pGt$$pbemF|Hl492pD(>$2`7%!A z=3{uw$Uel0(}p6pS(M-}x&(Vdi(;~ZsiwP5eWwsKYz!%OpZPl1yf%CA4YC7d;pS;`2f zZr{Cm8jM-c|0Ym95`o|WD^{}GTvY^LVTc)42GC1){IEFFyLiJ}a`Wg_rQmeR)rp}q zkma}>WbXUBKLsA^lH1N|9%#8m;=i&(_`7TTx+O+BN0pFS?LWw-71OKQpr)ij}JU{DgGJHeWVlfvMlCaux=QG*+0`ZWwUM1 zYU@URXhQF-jJZvE@4}jq{$kCJ%%q0d0t(^rF zW7%Wx!g8<6tbVo07@)!lJ*02K9G!k)C$)JFvSq*VS)NL9XP~WN)XxwkPiZ9E7gp4` z@I-vEu4!e%L+J{0M!FtkneMVXfx7A4K@^+jA^BFbtWtFXK;^Nsg;2pV%$)6V(ux44S6>X#X^*dKb{ABS?Y>kF7cb3qBG*rkX z5DO-NKqIEX8-dDAIVwLj(obe|+yhXb__dFoweE=pBOg(vgI!7mg-G5GZ_|&fb0{Bm zwJ#u7(9Gy8ZCIhrTU25o!5M@xjIv_zh~%R}=BI}eWE|I>f_R)x|A1Ax7k~fU*08_! zg;b*Qg%2ZxKrl%C`$Sqe@;O!O51qXB*iQ_i^+h6Ufy#)`iO)0Ef`C-%a$wY#_Kp#m z&Vd+9s(}mUnu&&R>3fkH@RZ(X8cW&YPP*0u{!?_|*iVM~56nd5|rC zy~G0ibQXyfPu@2g{i=`@pvR|RuEZS|?~J}@Yy`JuzNP5R&Ptx1z>yuKY?Y>S2z2+T z*frw5>+{v_Zb(7+VL@+NKaQ{SMxA}x1MqEc=L*R3@|R?NXFZc-NMHU>%K-IM_UQQ3 zV}&9uwv6~}I7~`8pFa;9PdERzB;CS{{=^BGQ=5B7kVuv&IN!UU!r^(faCHnrKwvR~ zeA{V&H;kT3ily``qU{RcCjz^=^)(x{%HF7LcGI0_sj1Sa<$do2zA}XVViRLI$V0LQ zw;X{9xkTLe1VnszoU@H^&E1Xae;&Oest&L7y-M?iUB<){mK$-|yOf^AOyU;MtG$Km zU^Fjf;oF2{Q29U@V@PAT90z*W`1+)__URxX!diPwg9fzR& zm{{uWT+ln1xhn(b9QKT(QK@QPrgiz<*s@2iMtBL=2>P!*1#g~wz&8l=7ht~zS7InD zDg_8kyl3K82j~4&mNk-M7v^m?N!pknk^rWITpImqVcqT@wn5*oW!Gt_;HVVmZ*@_4 zp62-_s{d~OD)j=g+`Ojqee|gOZRtl?rNg0_U7E=at%J_N`7bILl^frV*Jtf2NCYky zR+yB&61d346L$<*^8Ql+@`8_mYI?X?m8=m=yYPVX|_f=XCc+a=1-3T^_)M zn=(;dFJsO;AvoQ)17V-dxCP|kuf)_wFF^G8pm3T%dsnAm#gl12au^Bp)xgE#+SU73=NL4A8Z}=k zC>F_^W%o&hOjP=Y)6}nEuiU}rh2C(^T*LNGZ-GVHP<+N|-9Gta_oS&hFC2SU=3`0i z_+*VoZp?#(EF60DXnZ&=vjpD=NbDYfNRnqSFKfd;=GiVrzZdLVWeF_)yz+5i&0>zL z+yXB+c+TteXF*IgiHTr;zA7}=uBHL9`(R10-u2bn<0y&xHAkiyZJsBEJRJFgLIoaf z;~IL$iX5*|mi)ARHR0)s(OGER>rY&LHHvRQ`uYPj;;rvG#Eq{Zws|`r*t<@cDn7Ns z3J5j`@Eg(#@V9Pb6Aqb|M;P_hX(#VW0IPr~Sa|oNN!L#71uCObWX@fz#%M-gyK@lF zhh7m%zSeCntX_sL9Dkt^*>%qOA|#2vrWEdyJ`rsVrtv+8N{v1WW5~sMJ`XP6B?Eit z@-$K{;XGgqG~^xCc#SXAFZC%5JFgEHa|J&+4N-IOHK!7wpA0P%(AO|HqI1x9Fj=!-Om6Wi1ld)=;Q@KoWkfcy^ea2Feh+Axjpv^d&f}X zTiCDJb5v~$ZpMXhlLz-rjb1^VE^&AY$TDg#B9thnn@!N|IzC{J#_GD$eW&*BnJcVw z(J21_9ZPS{YQ}^#ly&yWFF`5{Bh101;6C=fJy3wc;8556MMXi6^)$J9GsIo|-wSGbVaZeVCG;GB7ETR|E%n`?NN3e#J@<#Li~$j&c^H$u>h%TV~b34e@!h;nMiM{86A6(N{bbW}r@56u z#l^J|W2~%WASV97QCbGFkcvhYj`W^jky4`f=2&v9d4mLmVTXuT^^03=O+~*90rox_ z&<}Xmdw9%meYw~`nlN745#UWWUEK+|pCzZ$7w*MW7}#gvJnBxDk;fq8!)LThwPfEo zZI8r3tP$0G;Oc}aZRyd;4xNa(=@h!UW%v$kfm%!j%^&>CoNx+yr<^CybGy*>Ba>x)a^)TPb*%Yk)+UJPwjbXU+V2TZwYgk zPGMR+4Bp12VVZMsx5m9-h{P0nwsmDOqc7@8~ z!|N^{=kN0>!oM7*-Q7EAr8z&7|J057Lzw|MU)nj#`Bzp|+`u-Lp{T60TMe;~QifKt zD#J0Kr-ofmttRC@Mu}DJ42jn|cC2WdwS~hf>0T#{m2nM>riMDuxZIR_UYS6iERRQJ zIi9z&P=Jpx76Ut;I@hi5+UKjE&1!wszPvwb(wx$ozzd-(^VE~Pel4fN7%&WJVerVz z0|e9>JP`6Gq^oY5?&7zrMl~06fSCC5&-V+A(gV5fzju7m@c<;@tf83hkxDgnk`-9f z5fb_MkyYMNI|oGnkq>3!YL+7#8UTbgHN2Mk!m%&7#_AV6_*#~yG)i>*unuC0diTxl zYicE^D`V)on!|s-Zj1ap1{vd8Vz`#+y3wOF?_mKok5IH>#)asl0=o)gUA_*mPv%FM zSgf}0>dBsOy_8xS2JqUhqesUR-=-kVJP?z3!zF|XE!*S!luJSfL!*SZ> zxPGqblxZCN|uJxR&00~of%ZZi2U@%YS_FRR`Y zA^?!*lpN1x5ogJksfu2VV~^Ss{Grob6Ip_d?)FYrFKtz6!0?^6S{k|BXgq%N>zKExq&b1u(7j=YxMSxAZi?5U(G}XX$^t?w#HQ#wk zoLwdHW@ZsZbfoPCJNC6nDn-Blk>J}Wd`s8rs6WI`B4O!1%pCt?ZdO+J{Bz$0e-YQ{ z-EUUKEfA-w4$CTpcPoFV;n^tI&;(~m<<<+FX*M%tf9^8wkYtHOVtzTrnP#kgaU}+0 zjJUV#k@N9Qnj^aq<+g2`UbjIf`;d9CfKt58Hhn2+=+$(A?h-B6hp%Xztc^INR>|j+ zqsD!WfGUpRbv#OMT>93eSiedfOC&~kuEeb7bw3OnbC1tjo-3>$E1-G!vWD^rNu=4T z8;3dfjDEK!dAa_aj}FEVb5wJouT{X3>w!vc&@HS$F2`ik5-Wmrz zC=NBa4f*#l|B$YV-sP;upsw--R2na2Y(lu9PTVvX)KKl?_Ol|zt{!l={6p=Ft1+02 z4)7ePK_wqAU~RSQ^8Rv7tO}cR+2cY#_3*>~gTm5};XwoMS6+KrdBj>Zh*}#M%nT!I z0#ZEOS$8-FGy_a@<+(X*7~>KP8^o;5hSjYvZbYw+S{v4RAeK|H4~H;Pl38asO>A3j zxDZpOZ*G%E-%W~s5j#{KxgPt{F`LG!RQm;NsN7;E;_lBj9&oiw%iJapc-J-C?73@5 zLHSHbahuC$;CafNs*&OD>sb%FI7nr$(pSQ@vs z;(F))et~jNblQ(3`TK+XY!xD1`jUo{(zkzVr`ze;M8;SeZs0@_4B^V4IG}zgNs`D<=#?!Lmua2h$O|#q_XcKi*pZ`16{{}=4c34?+adiqMIns2DsF_*GwDO$ul1;VmN3YP$>4;5MTVfJM#L`P^ zC!W)J_EpX7L8%RP>iY(GB`+r+8pG47V?Mf+)7xpb_ylm$>pkoHA>8KDD3?5)Kk?gwz^`= zhC7{tK(UD$shVjzuJ?R_&yxeA)tEq8FYkdGM%5<|B+-;>>MN})xN5d(?;uCE%QV7* ztK#${J(nyi87=uVkkr&xcl3Xux=L)Co*;vg6Z@5R@qOO|3r*?`)UDX|XrIQG#y@Lc zyu*^FXQmK#Q=emr{QF2h{x%b9K!ERIzoZ|h{#H7a!T&);3QtCNip%r4kn5hFj$UhjYE4U}GedClyRmuo^ zo24^fu+Fd;S|xy&??V7GZ=5_JCbyk`u88ElV`ov$uk1HL#jf021!*!_2x=wT0&|J2 zj`abHz4ofyoG<2x-KCYnSBQ5h7hJBbt)-)&OXRjE{_51K)O4q!Vpm zqiSRCgYXN73S^yjeLdz6iVhpbl^nS^PLzl#!iiZ%d##(07%NM|x7a(5rq94vkhNB+ z0k(*uJI=eNjnXET?|lSi=fgfrFF}iAC%n4_6%#-AYTkOj9~LfoWMSmp+LN2S+s~DG zV7^_CG}XDQ$&ntN=T(fs3j&Bo4|3P)jv~c&@In3d;0{m5^zp^zTRwuwvGYaA z6W0s7sgsov5#`SY?}{&;R^q&i&7vIrrYV^UaVM81`Ok?Y(y1 zcfap?o@YmN9H-4rD!8yyaPcvz)V!-NjKzqsth&UILZH5_<|oi-%M@=`z?|b=YY|+a8+LOp2``PC?3L0cTviTK&He(t{L&N8%JXDg-Bgb2&8uNfY=n94_lqvvNUWwl_I04a=v(XOwO^cX>5fgZ z?Sjbq3pmdX$dnZE1RkHW+q?`VO;52fAF!U^TBI93v9<=y8{EG848oad6}8#ds!UAQ zcyppet8O?eW&57H%lNsu?6jSs^;_6}4e#^;!%yhKgsSaAZH3oIQ;5SsBA$d?jjD*~ zW<#8Lzj0Nsd#5yI;x|w&F{TO#L6u$vc4ef(&H=Uu)J^={_LtSl1CG@`}1wqAOTGJtdhGnzQQ`< z4cali4(<31(tn_GEziPmOef3JPEKnQ<9JE)KxE}A_tQU;Gn1=)NflZ*lOx`+NI;~Byc;il!c9Dmca8O$`F;>Idlpbgm z!?Nkjy&DU*!qH~uFX61Ggq9ycEaCU#n{2%U;iohO(-2M6Rrz+bRgR5rhR<{+63^y8 zJ&y}6IiM|a>y(rZ_Z%u(EJZ<*rE|41pVvg7=5_~Rqj-*LE%SlwE28fnRuKk&DruZa?9zOMEOe=6`_WoE(v z=Yn;;L@gA_Y$8T4z(mtDYoRrcjD@OLlrI0iD^?2>Sr(WKF(2Y0s z)?YpS@~m-7FPqM2UnteV0V7rqH^Jrw3I(z^!iVxTw0cak+pSr}AusJ+oog%_QhC>> z9~oo+Xu8B?W=JuqJ!_(2SP4=zfT zSXu6SoyBH;Tu%gDC?#;D+Gp)2*gptZ9R7)!vg>hh=S!F# zZaAO(qK}nzA3Q!};|{j@95nV(d!qIeNQYUi3%bz3cze_OI5dAiLiL}hADakCudfMbuh~sBdm(!x=EbOOTY2m4m8ebvmyK>I8!>@I0 zp}OCOc0G~hA|uAO`3(xxO@r-vsQQvGVH_|s7D))6Z+=O1Ax}uQkGofNgIl* z;Cg85eh9wirGg>`??`iEz$;5Fx6k!*(235=Y&hcph}`%$4b*|Qkh6%cjT6Xw0TB1r zPJ!}RJrp#XId1ChC>OeW^)!?&O9XDKh>}tEgSfAU%yGPEb^{g4I|1jJp;Y}9Hm*qC z=&3JvOp%|r32;Z$^?W0*UoFZEQ8=~f;Bz0V>EOq%lh)qiJ7gSNjNl_$z0GccKaFTt z`W`~^zTCddj&`IYa+b>Mhq5plIX@0@yg3a`p@WaeZ32OjBgpb`at|9JcsxM6wEMiK zM@mv}LUE`4Aq2h|Th}W{Nr1JE{@o1exQ+!J!^eTBUr+%M2j@cex1&&WcUflEVWcD| zl}CZbn;eKGLLd4ZHA9NK0rCWhBuefId)4`lW6)0Rbg7|;!9`GteHS}j4{jn{S5QPf zB(HyJuZr5cwIgXpa+hr>MIs=RF0NT{(F*_;jMVsY=k7ZIs_=s-=_;Y17f}JcXT6Wb z3p8pu+Coz<*l9LW1IPe?T<}U71ZR94gd@y{UkB44gtn$+u4y>FJEm3-6a-p}uQ0Jw z!e1(Cd`bIwmoG8kP6*_cRm53&FhsKV`W8)D%I4$Hvwhq;UdPbt`<2tf10vEN91g>e z1r_oEoCOEw$lp1xQSpax{pJ|s)?4fmz8`uOfK`4t?znw3jg|TT=XAqMSHMmN}g*g z$4(g{2XC-c1%XUa0C2S?%Uo8a%8&3g;uA8T9DH}b(b&U#T{1r7&d4V=IBImQT|1EeA;QC^+$#s^GX?9 z1uozixn&M`dn{NQEiIbTT+MC@%Aa@6J=q8C?0sss2SNT}9twj$1pumRd+k7t($cEw z+}=>H-iYkwlPZltJGwZfz)#iq^Zu8f*N#tImAe>wY;Ugi1|bOG4J!|qY5>QqLY*Jx z)iO;~FmJui)GPmf9I0c`mz>!cu9yhX!rqEHMsRm&QK2P!I0e0rJi(6Sjr`3BfKBrK z7!2Z{{PT$o7!x&kKmKE=%FS*7fBEocNxp$y>j{SM#OvT2kr-GhY~eDP@Jv652w32I z0DLn&_=nQ6?Q@kcO`wa9090xKteEehdKd?0V{b;klU<(pK>)aryiWFb7Kp>pIrb*M zKcyFF&9HDI7{G*peC|q7=g5#^Xfj^<|fCu(ru02Gg6z$mX4>9^Z z!<^QxGn7!bGI>+E8fVhP`(XUL5h`;#=>_pA)^M`{mt=f5L2Axsa%;{0P;fPP9Yyi^L$Sg+l(G(~zo(&Mbg&EPY1@?EXWahp3LpP_ggTHH8T2PX@S%Ml znj0l83fN5bxIIjJLVj{J0VeoUQQpA!2Lm~Yjzn*d`1J@S&r~vO_J^!aVFbCDr8De4 zW-GMwft|y;BY(YbT-#@Be*D2W;41y%fB!pLJQVN|*H@>&)%=&#&%Z3;;}YUn!Vc(= z1`R(&biP0*68#{~PyW=~`Ohc;{pYoY{_^mXHTSP;K847D>$J&tI_ka!krIfO9^&HO z25UJg-RQdr8I20+AJeLt|GZ=60nGWI{NaoLM>{kMV~nw{X~0eF2yexADK%y_Tj)gY zPu9j?>S%vy%l#|Tce;r{%3|M>iC+?al;GqHMOb<0i!4Y;YA!p{D$nR%p3wydLHLO8 zg{9jEQcCWFpO)$pwBv3|bqFnLp!M-UE7$4(9J9@{DkRQulb`t}e^k3+2;^H*d)1&K z=>0!5fEX0Mz^>j+0i*zDz=M3D>0SBc9c`LfZuPazIBF;b7=p|xx!|qDAQMn=E1YO`DAQsu zW2E<$_JS`^?&iLqSysViz1OAd|E#0TD^QANaBIZ(`7bx9-Jn0RyVOTNj*I8s$d=Y4 z4b0|bxaXH05F~fh$=~cW+;wBYkqUNID>+N=uR9a;a*v+0B2N)#HpR*$p}E=aoovY@ zO_Jzpoq`MC_Ne*x@0hR7O2oRT*fuWfc)Mx!L>H4IgO=g$8hD$8qpfXi)uLp_!itx{ zkmH*!DPXtzI<#-|2V}&FjN9FM-*_B~vCj-+@u}YadXK+RrM3HBBqRyqS$}8RA^yDC znNm+xZ`cQ**isT*4h&yb7On25@9=z@ z`2!9H1p`GRLs0%&n0ve9iBQI`RN5<|*uOCv z8UQuTd$QTe>j@oqs0q#D-m6V+3kPqYY9`|(Ue3=1<#8N=9wxg_xW8Gji>=EkXxe#A z;&xDEy5VZ~entXzo1X>=VTkI=FRSDH5^ndd`34p_C}K@-FLd-w>AU3+b%ZSxcIMWm z(u?YGmf)E<;sxH@{Iout2hklfy@-bgvhU7OYwqZ8T(YI~hfv%uItl%{sB$*COO*bo zp_wB)Owm@nE>^FOucTp0WAj{aVNjupHuiw2#+ZbPt+|=J!6jW_|Me};Fyx2`O-Q=O z#rhdn8CG;2?}Gu}KU~(5s7uqXZZp1>4teK&%ljj8ka=gLn{+2>Fc`s@LQc#eZ9m7o z9TwZMDeLMy+q_ng9vHF#-iHLOyPlMVi-T&=hVeW2kdZYWo3pn;DyXx&rG)}GN?&v< z^9qu!DtpHbMRGgH>vD@nMUgZ5u_vXTyYjs*LsK3-hMZ2ztqmUBisQ6Gsg?qcB@;QTQ+2zQEQ|^dv}8hwYn}6fcp5$`HPnX>JT(cR-TgxQ zC(Pt_|Iq`${*fGNA+y)^Cz0Kkm2~Rd;4l%Qe?%EGnxWSZLUD^;vZ6u}^$Y@{`XVI< z_M*=YgI`-J+^Ev6BPA%i8BeDDZ!E^+VEo`xzGt7b@uD>uoyd41pRl zMFU5@%gRj|Yp&T5Q&%|FGB*=+GP^2Hq=62q%i4LbS*et4U{VF6+KE+*j+Iawsd7rG z{kVc@V}EQn)n-UI%xvmp^x&apm&|IEQsM>g-6kusE~DYxudhjNj#*i4x~Tat;~tiZ zb~}zc#T+@@5~C8~vKt0Eo%N0G?FOU$s}l@n+m?p{QRigP42M4b?Qi;Lr%U3nRe4qjI=qm z)lco(r16PVzP_N+Ph~Iqf+lB-VGe(H)mG+j$B~e9=Mn1+xrQt@%CjcfTHc#!{Sid0 z$aYFPep;-5ji^#t)#~4)ir2@#IiI0~>hc=V)!i-4H{dU^Amlx&E-@&W6n)h*1I}x_ zzi6*V3rri~sL*ue(fFLPrJs5^PTB9A(cDz8F%M+5G>tQ}KfG+T&t@~q*y<>=hl=AA zbi)ZR?`UdSt90Dn8Fo35VR9u&N6osVuI4pYu7^_hwS&=zK$KbrHj~`SS}LIzigT=L zt6f#)v@+t}KPPl#xbg>x<)dwVbrzszT1I(kGjUGh1Jx2=@4MTL=sgj)6TP9vQit|g zSrY0mQ%C7I0P&)$`H}uH;2S0@Atqr*=Q7Mr6)vs$*2%9-?y@z~Od+qThH3Imeqx$B zbdLIYLDu-OtSp5!yPQ4^R-4n_CzVjdwj3&L2Z#-{a-Ncb771zW+q#^|JwJoWBsMbzV57%gW=p;)&`aABPXC^8h% z0IBd-gQk6KA*I%d@7@?`-E_)5F@%=Me)a{eeCy@~K znAst<4jUMjIbu#i?X#N2d1U#D-$Q(s@V0wM_rsH_<&ct4dz&GRxZS#%%?&$v%>l`U zXWdNCBSm}eBa;QsR!uo1XH^DXn(Mfn%*N8%Puse9R*wdr!t3iMS2uoA#_iM#1KIJ} zii!3k@*8RH7GvLxzh-PaL}6>3-`+~mN-O}`b6SH+Cqxc zovQ6qFFL!-YlbLE)+$40XQ1*ockCijj`gh+^X^kS~uJ5G&6dhfl6g zsZsm-#*UrDkGZt_X2dxM<1+KEw&Sg2hVtE3joC0n-%1}y#BTASNy4~A_X2Cc7nd z$OeR=ncP;}@q$5U&^y&R!Ai=uYLj8uJHP}2o61|a7ozODZCKa2cr{I>f9d|)K6R2z zg4n#Uv)!pspG>tYm-MiKjMsWi-%n zE?tAffl}`Zz85ann(XooCs?-1|82r%v?6DQ=S)AZ{BWoEbWZ7_A;JFM!_J*6HC7+< z5YZ;d(qD!hiUd%3LK)bhHv62N*g)~!O}WS2oQTCZ2E=GsrzdH$f}XkK{WW&8&{=t_ z4q4l60*OJ_lNjma;}PwV zVxc};W!DT??ij{@lMCfo;#iRKn31~oneFL#cb=oiDCbAoHn#+AMDNDDn#s=K{rt6KEN`e#YY2!x)9`#d!O~XovM`E4-+U{ux~TWa;|Y^Pu)?d6 zuXmzq6Ftmd`aocXz3e@&7v82yq1G-!{QJ4L=?`VtKka3N9n_7Z?eg$(m~PX``Tn>4 zEnSRHl_=5gSuF(S$S4=(*qd8_;M;YGKWl|o-kn+20|N0mI>fh?dg-<^?;$4MSbjXTbENiFGj}ZXZRQK)F2<>Poca z+G^!J1UnCb9l;nqx?u_Pdf-!rtzKpPXvl#&2U(?M3BP2xTRCYnMmV%A$N;)+P^s3D z#xfa>J_6=*ArnJAi?)8{zP(!;t3BU_L_@42mGAFN1K`o*nA7Uef+oGZzrNT3rp>zhp{zwWIJ*)5Z?HvQ4;95%TPOAx`R zsTO7@hgKB{#P*mvFT1xXMVq8KLkG_wAabO>yu8YOnl_4oA-jA2zHdys=-C@bLit|wA`rfG7rrq(%Pu7UKnKz_CdYmV#(EuM#t=(oT%9$G zoN5|P`4lnLkTAJAurWEHIXcM%tA6lpa&oOi19q455bOwIIJr;5@H7i4qP1>BCIyrbcS6|x>ZE(>-8uW&(muc-8wNQnxNKmQ(Dv@ zb!KAx#q3jpSN)t$Z)fq-yY-rb0wDTx*RWl>g zBKfV4Uh#B{G@HBj^!#RN!8KN4I?!$|0C{m9Sn2BY)4!IhX#%+Dth%gV~i%gZY&Dn5Mp z@bTlv>TvbyaJ%XZ@C~od$fyRNpFgXA603>C=H}+^Na^lK^X`1`1tK-Vp7tT>Qh1J@@J1Cx6sy(S+?U z7?_xfAOYHG;TqI9fgp{rbwN^!{}RNf!TvElidC0Z5Rd6+Vv0@MUrg@VT1ii5w8gM zSs35>IQsip>Dd-KKD6G}U7-*H-jQ@S#TVS|JYIi9NalMcJvZ9w&)W{yg`=y{Wc0}! z)>4>`@l#4jb3BZOg+kK59QD2C3r7kE86sxK7ZQom_tim=qa)ks1Fo@A&R)VkWNebO>D?lCaoKdt|md-2%N(@W8Kac>|Lp)*{i5p~+m3?Q)b zY15Di$Xm6Q0}dtj9WlF9Jz*yrvBAC{?v16msmpdk@3U)5Tne?o)-&%>6TNO@Rpmt< zGg$9Lo5B!_7hm}L%EUf1SAM~bp*)s%TO7Iq_p%l=V>&$RGDO7nSnLd1%zXhx;wkkH zn%r}2vy{Y1X+)k*q@UPxYvL?ThKr=r%j39^2rswdxeK*IZEWEe;*7PtJ-j{Qu}iX4 zlegOVxo)hz)<=@cCl8@hFTlT|z70hYmjwuH1Ttqq22cAI6uiw6~V?{RQ7W zjoYJmNyp!Nlsk0t%`S}VWYyw)A;vYey$pprQ^}k-g=XbSBe8er64sLW^Qp=oL0q9z z`$JXFqHxDG^K;G|)-7+(GigYH>g;s9DS&cEPUa}V<}u=K@jTZLCO6U1dY}v(+D4S^ zb1mi)Z|@K0cpFFvzJ2_gHZrMP&)X}bB^OIVn={zq>%yp=8=G%yvBwYBJ5>(EQ|ykg zQPD~sr`7jrZDeRzD}DL`3BKbqlvuBp8DsL>j7vI5X>n4bZMsSEQzH_m=ne)u2%#oS zo%O@PZ;|ITE+L=aYS!4f-3-Ytr&)H2dZF|P>W&Z#i5v#2;;R%0Y4kz@;sjGlhM6vw zK&SQm>2CjsPlxJs8V~2*NfAlX-AwDQdMTQ(EJ|aI1V=_|0$Vp4+?c~%xn}{Q9a>1@ z4W&VUKxJYOt z#UfYKkg^X=Qt<2vHH7ZnUHF)Ai?MS%N@io`XPCyWi+HDk&DX*>VY>0hoVQT>-9)q2 z+-T5{-kCUNd>(!={$X@!SE5^S=hVI72B$rT4&HK}tm2eZO**3po4DL#?Y6)MXP5JI ze_J%~}TSe{c#7bso`Y!V|~>tjk49#QN-gHGXqr` zTRMHC2IV0tHNoc}t;A3!)A<;8YC$AjC#r)|*%aH6!1|3PAjIM{H{ju0GdR37L1({6 z0K;`|9iz6zRH3p14i>C~XS(Est|F)K*0hB&gQ0Y2iK-}UM+9ooJf@`NXXWsvJu&@PWp9|;TtxyxB<&@fi&oyvm{l?p2_6}~ zahe+)PPV-P1#ziWFOQ0%oD9`sP`FAwp4MK%-e{vshT0z(;_5WrSRfckWXbe*~*xXgP%ZMduB_;ZLGxYRykdwKdolk5wAoQGApYl?M$L%z0H1qGsdD8}hcy17~}wZD2RA{#799_#=jpk1^!iU}_D zYIov}w{yU3Oxj4?HA9rxrO+{@|2)$6Q#OV++F$K4^~afmg7EeuC8n0Uzq&J;P%z>_ zoJ9Wm%c<}%InnTFUIjRjf1Ek_0yY5>>9u)NP`=tae{(HB-ln&F_NVGQrk2UgK6PjB znGbW5z1|a@>-V}RzmvV`@tCodeP3?VmsEDRq?B81K;oVM40cV$V$Oi0#bF_}PpZ3M zpeDclCTp|h#z#Ag=(zo=`>RsC%WgTFy@qt?57OU0yttu$mb1^f)iN$N`88+$UALP| zF+$#NWV^>cCpr#DwB!an&OI&aK0C$wS?L9pzfYQ-T~;TS--e%NMhNw;G=Re`zjhTf zk{*)+RUN0vQ@zD0=ORIvuNt6iu#AgvFLyCWYi&r#uO@butj$bX%UeCUce)mT;kli< zsZ*CaIWFJjzIkUF@%r3~bJc4Zskj!Gf^TtbGMVC)Tu6$CDT^5Sy>%U%Iaq6nWMwR=l zMNiIJvF>fVPV)zgjSnRDv_;)$unByz@zlcH-tdGZuWZ=B`LsppwY|Gr0#|{Yu}CnB zKl;dox0)8BeWE#Sw1>k@qW(R`a`i-dW3X0fvlgpRlZe8E^KDJT7l$2L*%U6W)?K{_ zzq;&fYbnI+(ppN?lz@+^n^|5=+mnB{ziskxa%VnkSxgjS_rZ+q5X$4}b({6VLpw`H+4&*LD~8l8)a=rzdCMlhP}7!83*o-_sc_X5}V{k+!Qti z-JLy|t?Pxl)x_zpG=Hw>LD@vhO^wJ&H+Pha7PL>G9*IB7Wy0G|Z%BU~ zoe*w64bOY*a(A)U^L;Y&Hi>tFvN`cjl32B)5)G~Ei#?X(uX56U-eX*H*Hrge-c$Fh zFJ(tIGea7S)?Rp@n)vQPVdLU3n7U|3R@Keq%-QSZw3aF?=UShiX9`x*X8T!0;`E2+ z1S|1CLgDJ$(OgdPpv6L!IobDnK8svmdFL5Y(zc)MFmrl<=p3K3q^@i6N>@R#vyB`| zeq#nWki=WO+VSJr)AsvUuVpsj*$u2T_zsK2mv)x#tx3Am5I%jqp~x&wrR(1Lu5W_w zL*DU=58r4ypK^i|tR_xgx5|pe^4s#O2%(;qT9+^Hrj?DeFhd>MH``SnS3~H)e5)BR zMin-`Db_Li9v2n4`YQ8rEM!|eeLRExcEQ2L4jjjU0`*qSmQFjASzj;w#4~OtWc1?H z`#-c3OurhjF3K%_?Mw1#BV61_g;({N%`m=pjxZsWTM9bPUmL2NKU_i@ zbe-kHzo~_naIfAxU(>8P;Jqm?BOZHxq+3o(>`vT_;zC6Ei`22|`|pUO>NKAjHKx4o zG{jSON6V&7vf4ThGQXZ-;G5(1ca~wmcf3EWa!I8wkGR(Dm)|z>v#|4xWC>eU-sCp& z6Q>L8Q_{AOKW%ZLw}l~7bN8*ZTWW!+rRI#uxyeWKAaD1iq+NTZ0N!~)S_xC%IN-!9 zQ+LHy&Yr3#FLg{yGUD8;A~JGZzLiol?ZNFSBY~e(Q8+n|nW4FxjEXD%Mh9%VNrYz~ z40$;<&PQ#PUR5><-|V^ez+a>;L8v=A!H83W!(=i^Dt7o(?m#T`xNcIV^;|WuNCkUr zGn>AI&-O> z8^*X->ar_9b32XX(&aLU2H1h}fP-24(Z!N}MZvE`hwr)w*)>J7bcQn?2QKTF4?cwLq z&hT4t6DUT>N6(o~n058?aj418+e91;&c?TUuY62LPmVG?JUx(eQAyclTYH+iw_&rNTK&x|FLX85tutOv!s)RI zMqj*IHepk>u{n_>C4WRsVsgoPtuBMF>Adcn-R0#xmdasWt?kpcjL9dw!)5hJlznqG zZZSZHXL4_?5Zcy8du?<`Wx(Mz{7inD?wZm{aq}->|;9(ZkR5WY5o<0~TiABv*GAtuVZhpQI{5iSgdjxU`M1 zX4u$0Jqeg?Znz`o;@D7pK(Of3=Z3yT-H{SQ&pt6cP||U)fhtyVC=>`L9(LUC(zBa)^cO!n#tKV>c%Z~QnUkQpJc)8amqnce>tD;d!v#!J+?Mz+A^D4YMbIuGmJYct7faWO z8hjt#V_ipVVE4caS2g7sU9$`a=cbP04`(La#YkD_T!G8vGy0R=`eMq@Fel$}4}fgD zEvZ^f*4!-~PF?KQc%-OE3A2??cub~ZEQ#Efm|^JxDDOk?t$oo@*oxz2q900(_;`2u zJ5A(kk5=j1yUkMTUkyVbZvBrRzW0h0J!{aDqgYSS@cR~`RoZ|-M`TZvi&H(a@b9{K zUi1a@&AQdTY&mBsFFW_N!esX;xT~OmGyXLR1-a`3R@8Oer-5UC_X#ty&W*gjlByhY z8Ns?CR0GDR3CGtk>1ye%mDHoK9T1zvUITCG(uyDb8)p(Itm%_iCW3Dt;Kw50b7O|W zbPjmx5Iz*9R3tY=IwFP}UX!T>a;qJM-|_dlJ%d~lT7Ac-CNrt{)+DYO~@i>e_i!;md1clih!p?O$-yI*H9h~SF7 zD?f+rq;5Nn)>BlmgcBEgdjdWTYcix&jTkv`2C_Z6E zm*EJmQ7>h6@`zwn|5SVIs7tJ=`}l`1Wno?llm3|L5vtLFtaG;Mt;dr3zc@sRoEZ;Y zOzx6zlICjV!abEoU)Yx12B#`flHA6L-&_@5jIRnNToW0c*Gu`@F>)j7RNHIqEtI$> zOYfw<{3dlkw%bA-l?#0q!L7Vi?rgc|Ja@)$S1up*x1{U4Q1NYM$0vO5&MgUEZZENy zPL#^ulGBLQ4ko_xvk?U|P1CpRN^h7Xnl-$&G58|NgX!$q49ZcRoidc|b!`yFRmh{y zzfmkNKMgE^e@J7Dyv_nud)&=ZAxv;< zuTT|p!?UoQV=$Y4L0)-jj`4GjNjaT*mI5jwado$u&y<_IS(Ez6B1dpXr)@oE0x9HB+pZwwf zpb_QQRlIojY(OHzwacjZD@rx@W|Twof}YqZq}RuIOc2YGtLJBk>4G$HvhYZX{5oI2 zlkZ_U*B{O1gtm1S&`!TT)~&{r_X3;uN7Dd}Qc|LSGDoI=`+z~>TcYchd)>HwTl#i9 zmp$?0mj`%h>jKDD<!^CIlz9`4xBj z>1!M?oL+MGNUWFQIOFwfjp~_|dxJy5-8hvvE2GWhwm0U(SF8_}_q7LjhG$;pRPpS4 zK#BqqBM!Y=PO2)8*ZG@;vVEVP zI2J?SOf$2d8`d@R;Y^K(iEC~1S;HDB7t)6oUtOuE2!H~FTA7>uA2g%LyVo!;dr7zp z!yKvuPiAX_7T4dbE{RJv4LrZz!qDj-bj48IDJxh1j9UcRXxAA=RjIPFkI}LQ> ziHa{Yde6w2Oc6eixJjk28-paeag{kv)Q&YS?UWEETd?O)6efNsm978=89B*?ZU~*jCNPZ??ELC(qh_ zdXT~2HVw6IAWtV7V{h^P(x_VZxrSNda%Q#|zkElMRv%|dj`t6zpsu9TQzo;rhgBX8 zfoOpgjah!Y!K%9X`rGufa9ezLfp!bWmF7kB(Ss($T{-fJ$HT@n%}rg$bVMiGkDzV$ zc{-XXs#w9klb%vRbjvPXa-g37`fHwiLW-WIM7;Xv<_Mav4yrMbNNdzWhpnot`t{|c zfO{QyU!(A}@EAvTcM!{mIu6h88ekoY(=k}PzxbgtdKs{EF4}frMN?js7&ei#TqaPl zsbE2u%pLT@fQl6G=Cg&-B@21ykGXg<>(_6TQ+03fJ)YMLEf#M+Q{}%{GDMn8wr3MZ|T{Zjzc}u=t5+t%h2&l3MHQ4BCwPNXzX6@)$Fhq*7&+V@@KKXR=v3HZ->kEiw&)wP7 zg2&Nsx^MSiccnMc?wBwW_5SesdFiakRk~o&-49I;4bl@2ns^6ZXZ`iwYQnL3>r3tE zg``h5izj2suU%<2T45G~ura;^rIAlsrYg-|`)~_gDO)a#yLV;5vcg>C-pW36o~_BX zkkc`S-yzqr@AY(^-%@tPmF^!BiNBMpvx(h@hRyLbrG|A=muS?zQ!(G&&u4emT-!wH zV%-OgbB{2ZaI~_^8t8WpN_{tss&&y7q}&?qFaGD~p&y|1lNTmw?9p8=%*0&xxKy)E zj%^FZj|%&&^$;e6R3-nv+=kns==k4s3HAPfh>4&C317?Kx79bqh<2M@M!i1l8?ctQ zo8Z7HSJAc0^&0v83O+j7dumVVg0so`#eMpM`v>mPW;>H{^fLq|p5@hou)1UfwhDVJ zVdevs?in�yU=L2m?Q;{E@lR^cSF(m-~0WKI}uaO!3Sjl9~|>Gm({067*pY55lgt z0~NbH$eT`8Q|wKK_K_LwUe1K%>K z{FgkRB0WT|_&eA^)*fx7`ge)0P(vBmbd69Sbg0V@zfwkO};*Sy=u(G77(g2Z`Cf7>Avw z=CA7?kq@S$-(i#@(&9aMV~*N@?f0AiEyjW(xCT4V0i7Y9h~BluO#On*!je@LR>Dh_#L`l9KAB$qb>-3eI!FY=TrA^$*5M!_wK&m<0x(xtIN|Cu^g#$>wXzZd(;`ga z3+RLZA1H{{~FpIc6Y7jZ1pf@rt;b%$p;U=Dv_lfGO>qc5Htn@gYJ|*5x|4P$9P3!%cn)cUhYw1L9i#9v*z;dL<=y^8?v$#x z+6ThO$pvt?ES)xgL+`2JJ$H3PHO66p+JNH_eEXf6_&=m;5Orx&1^%&v+1Qdhzre_L zxa}V#ibOpk=Qt7w#l=;J*00?t$*G-C-~9_W6|^ar7~m-Zw3Gs-+CA)_0JH>g35$Lx z%x)}l(>sfme&fx;Z{ncv7RqC0%!JU*a zGSAoA&=-I9SKi-n(1bbqRq2$Fu+c=%$(G8LC8NV@UY{i`epR7VRF75GY($uyv@cKk zah$o4r8g7d_J;~%ero_2{R`k)KAf2bJ?YsB7>_T=a{lbTxNz&vKpexbqPk^>d@-)B z^SuQkVM|n5RyzCG`dX8r`xSqWDE6KN63t$*TTmFc=jpHau!V6Yy%&*dJJ{P$l#CYQ z^ZN~jV6DBbK06rMa%k>}Lk+bc`R~zAtq`uq5GTZ!4ec=Q1r*J~{{1$2h{EsQU`tvq z{1)C+%Kwh&0$eiHD<-|}LzU=+KS z_diE(4<_at!me?R^>muHGBHIZ@G(&@wRcQq!!%$I}U2~PmAW1;b%MO z6c!bqbl^GEv;)L{@m5dOkk2kl?|hu{<0{a<)3BnJ#QYtk;@_C>Kn)Mcs1$yuVDkH) zd(xMzx!)E2Q4~9b9_KNZ?=vi?tWx6CuLGuDAkDo4ihLH;k zQT{&Lze!&-Y$C^CC+_=c2fnXhV_dpMt}y8CFx7t>Km5-lo@-Yrmkz)~2|_td6j3|y zFfGKvg2ALs7_Y>jdtiqJ!^vh`*g%T^`Fj7&7^GriY7lnyYo~t~lzw_tZ6{BUCHYPf z?7zVKHyIZdxK}?uDuCwyeVS|Upv?A`VL*yH3XsSCmemQPaG{1cTi$GtC;ysy{cml~ z9#pPy8sxhJ&ufB2Bd7~vEBtm)XfsSqmTKY7*!?dfT@p?2K5&Sm7Th7PRr~UEcr56( zAx@n)`{@7k#r_M6DtNFll}Mc0HI?6a(SHF|`;DjP2D$1x8n~Aaq2munIlXQS$=1bu z{3?ObJws00FYizA*1-KI`xPx!9?|ucMIYJ$8VXe_rEmU_T9Ep8K{dF9u&Nb)p@`av z<-9nxf1`pZ*S%hq6h`wS%cc=l>1Q8Tq)DEuhU#R!50D){^Z!rrCZnG32t+Z0!0uP#EijCnxmb`5rSiT`QsC_0^{bE9 zlK1VzvWQycGMI!5n`}_5lKqyW1*}r{xT~Fm_x_%~1&mSmOv~~@nv8BqefXZSX41O+l{<*$MFYHxztvyusJ(>W}cZKN#kcEZuu2@3K%OmNyag~*Rf{e1!|GFXEs z?z{F>gT$5qH;3uSgd#2EQ1AEtEm z98&aIX~&^HaB`k?K47#VdU-EK zc_+-}vFBOzZvq_0U@}rYfCM4>A;vFAPl4GtnhKSA~pyM|ggVO|h25pGW$4eyJpnhVdnW5p@n0c$ZIVuh>oUqsp7ZbZN(`P_oe(U$loxQ6CSbe zk$u4qa*Z!z9qc}6+`sBN;%)M~&LzKszO}QUWMaM-v`1Y)PXFeMRFI*Ei1x0}cN?7y zpMLinxNwJkN2S-oxGKQ-RwONz(M0K25~e?@7&Tx$0>3(z>*2R5x1;tkCf_w1e_$28 zGe29Hl2cV(9RzMS^Xy2SU0MhOLmNZ#1~=I9`>U{MsUoKa^s^WUMD znx^Z@N&?cx!oA}YqNv=&qp!Kp(NqGs62^o0l%+Dy@wQBPugR9q2Mu=Wu8Y%MOWwp+ zv%Q>k1=jye+Ji-}BJa12n`$tjp!8d!r|0`>Ui74AumjiM>MU4G-R{Y=!J^0aVAIb} ziX5uB1bdM*=)X!&HmXPhRVCJPirx*AUN`ScvZR81IP*tyo$d0nGH%neoPEoWP3szz zE|#5f`K1`r@f=D)#b!;-Jnh}4BN(ar!gC;cvYd^_tEKFE&T?^;H>fI=S&#SukMm!B zk8DigDT8wmKkhI#CgM8EX1>j3O3v{PHRr~H6y#R)N6xe>@{a+>f*PIpG*zRs3!zeu zR$Raqp1e3s#uf25Yj)MaNvDg$W&cqP($Yq9Bz3sa;$9>P`*0oQp>wCJ*!hFN?vzZ% zOx&SgDC+Ru%Li~G^bvh>FZFt@^qxzHS!m*qE5hghR?-9cmu~b0)cTnFtCk5qYWa&< znT0(g?B%P`(AldV zK!_W=>AgI>aT)1*Yk)lm2mgIKJjTN$nrn(5XW$b=$k87o-#F>+DY`Iyd5Qsjj!_w| z?<@UTW~CyU0CC@IlIYlDYrjr@^u8bJ5~ZSTJJr}>++x|uhRsp$au1?QU%7a!G3lrq zMGV%pJP~r~%7_dDkgo-4ol#6Ty65dW{|5ir=I|l5gXHpW$p7pVX<1mdIEl|32BtLQ2t`N>T#lah?zUOc?{kGhtkEX>v`k$BYLD)NL{v4ErD z_Et=RPT;mli=s5N%=%}sRG-nrMvR(NR4DSHPnNs5@Y{zMXUGFj`FroNYe_n~rPhLXEn>BiB$kGy)5=Pn+y)2!tGMiQ6sKql zE5#ch(xBf$4E5c*_4LWHLUx*elxADcJza5IRTPJvd3)~n7})k8s9MD@FEsZjD5$pE zcWJh+`3xD|*!_<&TFCd|sb?}$i#NBNgtcr$W9vfPB7?Z`P0iHCf6AR2{A%C6Ktkj( z+{WHxAg~%ll`Io7%RTU)B1DKYe>j%9P_5}DYROOY9b<0tUhrJ2^bq(*MOqVS5jN3= zKih!*>sfwWh-8wKwd(|PK;^LHn~jdQH&eU?;tVB`St5wbg|gxNkmK>$_KvOe(Mbfa(aDyULU9acxutdh%# zo0+2$Y191?dB^_I4SkBSj2GH1gp>6GPVXrO$y}*_v)Rp_35j?$mU(=7`+;O5U*^iY z+QzJp9>n7b#q!qkD}3J8o@`uLe#*aDH7x`;f*yUp?H$QsIm?oz`N`=?m1@sy{XoxD4cV4>zybE z)_;^;lhNdv50&be>92=4(2`UnMi{5$)*wdI!Yn`i+QI)1LFo^2=;HZ!5Fd`JRd@%* z6`j!WYF<}`@xzk--k?hGPlIX6#*RIR_eIsB-$BY70-%1bNB4_{JWPgiwzE9fL(w== zJDBvBBlKJWN|m7h%TbjoO6vLE;KvCD*25ekkNa=1a`uZ?3=}f*YMrBjyJY$4O`6zi z4t=&tNtF{hNFZym2+UK;jVUhmYC_f8W8iq27WA0Ypg&p}#e$lw$gHs&ya zj7Jlk+LV~ZED>idAOZ9Vnecrkq-OW18r7|{yF|`5-MbqwJbR#(07`iGt8Q_rJ&hbg z$rxur3Cw=|WJZ4P_*&&XG+O%e_6|Iw3f9^mF@TOy;5vem;f%h3!~y`ZkjQ0M_mP8g z3(ooJKR|JuASH}YGhWa~hAClSmg9Y*pI$;}I6ddvx;Y;w2}&#cMIQ=vgeq86vY#hL z5y=B8|L4H7NZKFTrC_B)6eSdML4+D&m|_akUlfb{ijt9TJc=`U+(;JEr)w_MqVz#k zix)?m#F@qJ;o$5%I4F4H6KDu*^MK+4LgfpcQW~>3Xox1zKMExLpjimNxpeHijz5aA za-fh7aMciYzV~bl2wn_3fu1oiyR@onrmVX%18=4R1b3TajGF!RM{v8bg-7~%_~}f# z_Z(XFVYZjk9)I8lBy5{13)l`KvBX#|RtOmGT_PWVq7<;$+KEe-&7E~rF`(TYCND8o1+k8SRz{SKVS0eOk1e0=bdjD5}I% zirdo7{_cM;YGq75c|@9(9c+lzIU%vv$nOivhPSFVv8dIFx<>O5us+)aB?sr=43JVI zFc6Sh5I0jaUna>MfMR@r7tOWlmiMI)-sj=*7~4^v83Jk`L%U11Q&$E5%0|1+I4c`@ z-+j9|jc>tYFQB!8s$P?4(D5GKAqCi6;V7=NksoVGQ9{X&761as2y=+RQ*AtG8wS7V zrz3~(uKKazRG0090X+bNfiWRqq!NS}_;4P+lyCj5QUEQBJ+2>w4@F2aZ@h2jdwr+d z7H|R!)Q<6jHZsg;0#~U1sVUBbsRir{h91j9GlNc>YP-PbA7F6>ufYNFid5f-tT#~A zo(v|gTxuXovn*)?h6Q(y^*F|%9sxlD6DkBb#7n&D*kgzgNK(Wo8?%&TuO_BD{G|k} zdTUk+C8SLlSXdylW}4~VuKIKR7v&pR^rRS*BW+LyV`SMY6v8wf9*oIQuvV}d5>QDx zgMDXTlEzB0m1ZxG(i{`Rp z&U4MP{k0dMuo1onx}k@bm(PbZ-d>=<7P0^yW0A)I>7R7?ejm1vcQ&CwpyRm`xhJjtA3~ zszQGbKN1Z^Z?{!)sKt>wx>`kV0a|f)qvIjSrS0A zqQF7Fczo|k4-Wi(0$U`9zw;}I`7~rB<68sdtCMU}M^jgm{sMvqd_&1oh{S;j#w*J!#ep2-(4CY`K$NWLXO zfbRlA=(Xzf)dScVm_V<_WU^+^J6rjb7syU5rm#=M47ZI^C4Dk}mD&l$B^{*@`EUdF zTFF#}%O0GGKMJ0F2c!&z+ru_M>V+;ZJ76q}B1M&u&L8`M{-Nki!m66sfyt}}J?3)R zy;?|QMOAGCh)|`^YHmEDBQ*jfA%@+9%u4>WSpF@AQwgxUO*(L@JQ7D z-6fQ>K@Kn7iFRjv_xMC)J%EOFG+!Gag}f9ZXFFeOCvxv6FQI%FNa%o=pA_d$QZSLp zl?9{Xg~c@44Sk`v#Ry3W!wGIfmdyZ_zypfKK~S`1c$~&H>c0q%xJ3DmkT~-ZH6be% zDC+3m<3z3sP>F$tTa*;ZU%M<|9)gOf-%q0ym-_lQCGp}<#K7`z!&3)g4t}&$|G;s! zr{kYbQq?Rl0F5E3kms|~qT2S&;0TjhupcWHBjx@_ggRd~1z|=TISIy&qSj|u;w103 zOdhGQK9U15gZ}2$q%wVP=QdaWqR*guM%De~&#l&~f%N!@=WCo&J!ua{sRNs>YMDxOjQ>f~{!+TDiqE*v%qH z4Bsjy`u3n|eftcJ zQD3>esd5r6=IObL=pmLxE7_4=! zi30fcy}-9CAW`}?TF9vi>uUn=ko5z7jcYJq_c3&X0qcMb2%o{i_F`PCJVNqbxQ09I zb)^yH!j=3*$ZcMOAR{Tk&=Y^ZhG@LfwNFH*spR#n2O3zseo-;^u8(#>Z<}a9vl$RR zn2;?8`#k~6Y{7QOg=Ww6CQPX;&?XhHR}FkxyT_Ouvme#kclrhg`*+Z~CIg3CF)_!# zN=d`yF2J~p8X{rDHsH5NW&Lr{_~3iwKepZwS-Tuaw@M-mZ%Fp&rs0YTG0X1NNWw8gfOPeB&^+PY z2BxEkT%mpPCJAU3pw&4QT1HxjgwShm4G z0SV&f=H8(`iUIV3d25_DDonb7m!<@UB1F_B+JV#>_wdj~iK($020^#B4S>gw^zxb7 zYp2A{!}VlYz9lGw>)TCq505xF`L6MOOrQ)Y$QT8$0O-+ik~t++rbEBw`AGiur0-@1 z-vdmcOK{_g6)RXQWdGKAa+qr20q)G@DN;D3BEP?G_^aUU2M)#5f)pMeU^Q>bY3Y;i z+?davFVP09UQX+-lg*ENi0F8E6uJ)Bum}rLgT)ErM%};TeNdQPa&kA|sds@6og_bt zS!YQbr`qsU`%dxX0iXvk2Y;~#GkdMq*&%n5td||DTc!v)wR#s2y{m)H47$+r^0B~1 zo;0v8Lqr69jufR}kbr=KwSCa^<#`YS^OQrUT&N2`Lmvo&Eqs8eTZ`O-Otxr5kH3@IDIg^)0hX)2`{dIFTY4cJb;( zSJs;tK-y62hpKJi`SZcM@cT?q-DN&WV&f59Lj*_3><{D8g*JWpQcsV|o1MT#u=qk@ zvU0(6G|S6Ru`F62^J}0xOWH^_NRT|2n`cg|Da*OODW`TZ0USVsDoPuc-!7W8&!K;y zk~z6JP*ECTHHJ50pbH*o=ZDl^_bia6ZI+Wu?Eg4sF0r*)Vbh!aPniIrJ!stpx z*Y2tlGk3Sl7z~>qX8*pmD9$I4sV2Q&5M3j1B&68+?fl-QWyFo4Up&$f>8w)PhUFrS zGWZP4^jVUefXC97B-tr#hZDnA>WM*Lq+cULSV6!Pw`2RPqD-wkp7MJGcH z&w&Ww51C{R5PesJexviBa~J5r{w2}Au@Ig_gTKYpfOP59A16qPqJY@TY{ZqkeZHMT z02>8p(hB+=<{)%)4#~5YZvcfgu=tOakr^LYF_tA%msv6?h7;p9=!VEsh;a#vQf{zB)Aw7_zwuZxm1;h)$ASbUJ z1tr`)UZkXM2Wp@G_f#`~of%uylAKj2aYy6{B=`aw3>!_ZW#3-Q3 zPbzK$@zq7RB%TB|dhwXl8n6b_G5SJ6E`4bbNnlVY88r<56Ujdz=7luo`k*cW!fy3Y zBi&eLYt`AGyR0i0-+uNdI1u@5D_)q43aqg!%NH;xD~}Zu)5X(cPQH(v)A%J>r6zn8 zW0`K$ebE0g7BUBk#?KbMy&#a?7nCh&GA(yDdTVcohsSX^`R(wq6xI?p@nRUG#*jo~ zyAP^+0V&q@WHgcO9{@2`S@XudOjQ<19rI+8d)wX&A;^QPJc3*NcI!@XHYFgP0fOfS zTON3~1n$}im}AX*BiS^m_fNd~f-zE=M!}*GfnM+!PI=mMtu0gEd%f#L+Wm6xg|=!= zPqy4T7^puhy!SoQt#<9~UjhD4)HA4759XkJ*-S>~tP9Pn zIolTR03TgzP!=GE-E=O{vNM{9gShfIPLx@l)Qhhe2S8%^ zD`GAp=CFo0c=werASNNLJK`nnkms^cm25%ZW$e;ak6RLp%y4%ahz+(4$m=V}q8_NS z9B`#h3n83s;am?|Y#UZjA{-p(atoL`wQ&9ew|~*e-Ys0WW1;6z-ZwW`L*sV0{w^OV znPjU#A<0pobbQzJ;T6!K85!bR7moHG&>_xB)(JLEub*^?Bl!mvn71yf6Kww>=j=O% zk(#ELb~Cz+g*te)Qe26PX1s@SrqPWuhC`rB^ANqD^Zg8|L38k4--?)J+{_u*>zOpJ zG|vzFU+}tp0eS2bVQ-5%#38B#Q-X{M)TuP!`g$t1KARa8_2MiwNy@RFA<(dS_(P0F z$SQ78>Kz7yxQ+xbPVwxrZn)ANv8U$};SJb$@ww|kWJGj76dJ?Nk2bsJ=+$)1(KyzE zIA6|rAi`^DL;rg&%diBai5UpplTb$=gVKyZe+~VVEX#3RV??w9tmKEn%`~r6rnnTZ zyL|5v|YNIBYE+Y4V z&;q~FhQhraD}I@hj`}zb%*VC&5I7QgT;%w4iFc(}PE(^b`PyUl;TdTh`uQRMW-o^e z$Q@7!Q1iL<0!ly~GQNPE1rpY8ltLS>X*6d4ZV^AzgbW=paqqQ%)Wz3U{4v)lp}f%+ zNcc;XTK7%ozU%V(YS*-Z8+r&meqT@kUVB6iGC+<>rx)&v&2@1iJrf*qCZ`o$p)z|* z)xMR1Ql%O#4J2rLTN7dCY_OK$TUxCQ_p0nbO(a$wxKLO&#%0x@Hz(&s=J>0_@6Bs3 zmRII`k!KsXmxj$ACcmCZ?MkDCTmUG%;KA7#qIqP3wfxT^RXKj#U96SV4=wg-43%0w zvA(kL#+!Zc4D#{ne*z8gf}2u&pT7_@Gk#^6RD_I$Xql(wPgoMhz>)0P{E{;F@L2}x$GO;W7)N? z7XixCr8h@<#0_!!lR|A?YhxprC5ZtSC_L{#zqr;_1XvU?V4SrP;TA?Z{7RrUa*b3a ztUZF$YF)eO@@#yXt3}ZBvfjF3l?3Um#2&2cxhE3u!TvCCULaUBO2hX%ar@89w$tw| zjHi3GF|NxSOZMu_>;8HoQ`_Ejw+jOTjHy1AsZ%rM93iW)|pAGyw+wyW7H|~RX zeV?Cdh*m70B0O~DA=IsMO29iM-udjd=v5C%?k$E%q?R#;~or?FQpj#L>WHtZ2lDF#szFi(1(LL3@dyM%$Ac_I< zmXBI8rs5q)=y>7qWBWUVZSN}RGMZdL8n{b(T?uoWGpd>FLJ>*2+m&2WIp8GhCc=5_ z2zo;tq$rEX>OdvcG);u@d!0c+;GB*Wm#V4M>qAd!(a!DxGiG|1r~HZ?Biw6!%sk8Xe-El{v0wr zn)@7TQD-@ZP8S9_oH-rdH8>I_28uZcF)Vi<&2xWyYL z7V?SQV!*jFnn(?WyaaI5SLO$=ul4f+!FIV>taW7I=oVuxCdd~ z02_|_ei!}Rg|(cp>wN*4K_cnIRpseE79}Ol&Hhm4);Lge5QEdgL(^)bcB%C9mj{9O zdUBmR)fWWmz<);_ zoM){yn2ZGEMbE>*$^VC|?~bSP4gdc%@R0S`dpx$RL}cbTN3tc7l|%N3Y@+0`i87OQ zQf5|Wwv*8y%HFiBj3P?Z?>_o|f4|r3_xCx^{oMC;U)ObC_xpNZ*8?5P)MqxGeMEA< zL=s;COZTNUa4WW^rcBx|ffEHeE3 zXD>%mk-8CTCmtj77X88Kygk2p1_V=<2z9kpDJ1#34cz}k`3s;jaB~xrApVrX|2S@; zGA<3AJ`)o@JN!N_(>^C=EdfEZNXW}!(8sqYQ>!iyTc|2#R(YMPK7=WE*68_Tz>@z_ zvIJvgRthJ2*2V-d(G<;*o3|D~c`X?7_c|6jL~!h2oBi#`hZ#55y7Nqx06Y?Rfr0SH z>{7GM6KE#>4OvRpsJKk5WXz!dUiAeq!*im<-8{C+Qh<;9w>8>F$smR2 zcL)yZV1Lf{Or*MX^J;;4c3)$}I}h2UK}o&$bK>wc$uANk%S~;mMEEhG{5ZCReHORN zHXu@)4PGs3xIWx80+c`~4>~rrvx04Wc*^q0MPIyo`B9S&Mtlopxn&)toG+!fI3sW> z3NvQwLR+0a2L}x&fK!cCq3*BDRa8$pjsNQYAd6Bi#E9;X+S_kEeLZ0LsjJH=Shi8x z`#5K-c?Nzh2XLX=Jf$}_LTg*rLlrPn2t^9UcquUA`w|{7$9h%9RE55HOv3)YU^Csy z2NTI*A_)coNA*S@1?HEn&1n!4gX`7{)#@Rwlkr}YN3u&c)tV?3%)&1`wo5 zpaelu{#QRw-n;Vk71Evk5*qQJeXmx;v4l8jk@RyS!YXm}A8*@VvuDoiA_qNlo?HN@ z0}FoW_d}Y9Gh0qPC)K=Dfk|qjd+J30Bhti=-d${kj$kARCpvu^*uEg~!B)a`DO!@| z%6;6N*JysaDH}d6JZ(-U?2RDVne>GczXEl-h0vfTaVu@@Sdu1xN|HaR+>|J zF1xuC0HMi85xwSMJJ9#gmlD6i01_xE4uy-*L&Cf7V}`)teZV=Z;n-%I#`uUix2#GO z@G0jq1@6XrnA$SLAPMsLI}o1aw*O`SQn)fm=|~N9>sIhC{O!MZ4od3Hd0W!7E1=&r z&*EhWx=UUnVESH850q=%g!DWm{=Hs3dV-K>HR%kgjN${6oHV^z24D; z36%`VIGGkOHnk^F-_(}FB?EpGJ6PW*g-IoO_J7HNK)94j*^mYQv-aJ4%7pLp98KuM z(hfO;^Ju2X|8)V6W4vybH?+K*kPXkHl*06*Z*W4kCd`>VE-~~0_0%Ai%QZ>@c`m^k zNT5ec^H@TR^s#ClF7opL=LDk(UIakxN#ZyK#u(N8SDkYsPUgEHe%>iv-*%&O^F?oH zoKa5{mTkS^IBdacfrCzyQk92<=iA!okbnD2_XkP{_1p)NhMR_80BSuYsDnNq+pesL zrGG{OgC+pD?xvPR$_K>YiluDYA>%6{2X1QqsWE`&=p~8EBaD+&y4ivf zl0@@7c}f)IG)j&RnYThS?J~go|HA(4=2Qs$g|d_ID&~tS#WD2TRB@6(><{S)p(WO+ zsKS+F(w$bw{`^^+^Uh@8{KG1?6+(2@NAESGmO$i9>Tg_Pj5ZkTQU$@W3omp(1aWX> zOV=w|6M)ts#9z1jn{b(*KrpN$1`7vz0mSG$qc~=`+W0Uu1bl_-C%1+Nwoqm=pxC0A z(8$aQ*@q1L&nO!%g}eM0CnL^bSOX3qZCtTGdF4T4k7lMQ<`f*wKlj*p%W_ARjGT=t zFIkR`1n#op_r!?WaF6en9d5~7j|2p6E_gU-Z!56BhyyViz*QEl9^iVk#`rO|jGo0u zheXARjjB#pGJvNJ!i0v@Ve753sMi~T7NL@^WqbiECo z9!M8U>98)Pph2F7O~0D}k5&7_dmL#dC_O1u)`Ri4mT#)7N0FfIW8V-i8;&WbKNGTU zF#bly4VN=OAnqDy#b@Am0^z%tb+@$u3}nn&nd2cmv1O3LaYtfw?=OZPlLga z09rWfoFT5bLJuZS{)6rn&6>?Uf&g-Kt_v?ZzY;qVC)27~EJ$Cg+n7V82S_698<+wi z`WqzU5RTh?#cK%8e$w9`L#jnkgA{R#_D5?h^sVrXd(lzG3+=gT1}L1zK+=6K4oT3m;u14H znG%l;4D*x&G37NESVv3C7`tQzfIJ5ED~>HUKD-{vmS8*%?$Ln7uPN^vD0*|!Is7=# zrTui*ql`RW?J6=~Cx`!+3oumz{D2|qRpS8g#hbsn!jWwd-z`KFS~bw9k!MMXcVdiE z^7e?L#L4qKY5kXMks=`s@DX5lgEbC*c2S}yRyI-)U!Lh7l^Zs8=KbI6g90Y*Fjgyv zl?x-QN&y?LSKYr~oEn*ZE^slc;yvbs52nk}JCDAp{>l40yUq4z_q5x(v%ZhVmH{A` zbCXxoTNSe*Ml{`ljwzu-?6R-vQ`66NNi8^v%fQA-RWnarlLp&u&LvgdI15hKPs@xe z5g^Y6H0B)a&*Qt|w%++oQZ-yN!;4_cIIc$~d{ly%JkpIEXX7LTxTt;RFoluIulidD z4!}Pfp#*NsP{^V%e3UEb(ixJ>8Supu!#`@Co?+#mbO#QCNu6L5Du_>895O-eT;pVl zgQRjgI%o;MW*mhhub_&;)8HN84pklU_SvLhI1^sN4qlldmH~Q`Hi+~Dw`Hzn$+?n> z@$l?$Fol-KMxG%^5cgo4B zCL_%*n5q6^cnQ}D$#)U-$o5kPgxK^M=tK}U(5RwDTHOQCl5VUZm$bAb-4xr5YL?ao z&ou(<9mwoTwAT~lI44+rr#r&c6v;%QQRG9R0TJGJ^^MURqL>AXA)w3mt}!hv1Zt2S zhV6DZ#g?}SG5O1L_oFy&qW|(tbCfmm!0RM)CIs@~!7on|zbO5_)oKlwwi4JtrhQvR zF6X2GD}G7!tZt0V1aJn~i7_&P>E^@a{3nC3&><_uC%%gO38+aB0*P31JFFr%`%D~U zO$emJW&maZ#Y3r@dsKQjQKJ90vRCU%I*6HYJ%YObnRJ0E?* zjVXdO^cuncKg;1_UYf6G16Pv;~V)ssW4iHbTR{ ziV`ESY=bHpdigDy&W!jU_5&}q#AQGu%CJ);l$A|uqeGDK&e*wmymR|)=$IkHC=-4V zzqEc+s90*@jJV7L(|DOBl?X%hhtr$ehY!rLs(8ce^mis#C<3WovKN=^4a^u)Ui1YRs^DQfL^gS&IvA!Oz zDh)KcofdAHr`mQu4=WKMO{1j0zeBg*(X@~gX*Ex!X!#^1N}a@blU8^X+?%C>gVrfs zXTMnSdlWgsuGYlYb%!g3K7PAZN#AldkOqyH@qNGKid|Z!kGi{ghO+jd5!aJ!{Y$p8 z^T^G`{b@Y$68tC;#JfP|9bWr$tEeX(2x@?Y6kz~{^+;m=WAuD{Cqyhet?VC={0)V z%P~2%(2S(q&rJGZl?)x*!h7$G(PI08hs7P2?xvj(CkEU_E(H+Q1nsm;G_NNq)fqJ(j-6FY%+Bl?l$r}I5xG*!dpKWcYgYF^Yc2)Dr!bo>GFAHc%5L* z)DyvkgHi#u);WJ?-zHWE_2qvC3&zmBl|N&MWt$Z`UKuV5(_TLpYs={=9eKPnOdeD9{Q@{pA49F8+?XHb)|*4ygKm7EWaN}_nffSy|BxiH z%jwRiReB{H^iF8{99dz6IC1O9(4EFmK<@$RP_1S5PfMV25(WqQ6Avmi?^6g9Vpv5E-^Q3f3SAqOa_VM}C9YI7PD(GSSPd)KnCvuhVV( zL#0=g3KfWJQTC1qQO`QXK&!ccnFV$r!XXS$JoV8d{X<-H1|V4>m+p?BOAHn5M~B43 zh?%NQhQ}ri`8cZM=)aJt9T!oaK5ooM9J5)6TYd$k8CC@Fi!gY*dV*YQ1h}9J*||_} zo#d1QJ^%1HaQ@)`qC`z~2mg4aRx&Nd%aOQeUr<(g?nn-V7eCnMY5uE?daI!~v@ zgRC^*dnK_XwU}ArQMnu=18fc(;}zIDw-OQUR~jSJ5wVPPadKLRk`>lmjesPriChTw zfh1rFF%dYMp#j75s2K3r2AuNU3XE4%DR<8*qiV30O7S)RQJe6i&-&8Na;--t+&&)G zam_R&!)xyvm2&#=qyJpOl2$X#Sm2J*ThdAeiQ^_{HR9_yD2zEsZ0+@=YLg$r#Y_lU zg^*E!b~GKK#%Q1s>N!li@cd#2sBD6RA37yNy8>-V)ZakjEP03#|1y0sC3;5*V#N2S zfJ>w{tYmy%Yv6~b6$;LbjsP}}^IEJhzGLH(=FOq-!Gq&t>pKTQ0-V(p`jX*=iEf4& zSAxiNIv5wWi!MIr!S`Rib~wfZKPb(i39=rEG&-i-D^?4NKtpWlk?bzEQX(JSYi!J@ z5VrUnE2x_4o}ZAVh3_OBI=rQ8ll+%560I?T@Vb^>JU^E0!8yrngV2xtbXMYD$NK4i z(dQYWbwzJ3Ri2}J6K}NCnSjV~Yg+->xl9s78GK9x#%KzGCbZ7=+_wmm$ZrVs@@cZ& zvV9TC#cwWikH>8O7Metc(NW=I6wgqFFbRoNptsOie#V5~3rC#{mt!+X3K;}&vio=cZbrQE)XMsp#xo*%h60dzBA z_UlH9bePfQ+2%^c1a(IPQZNKg%+uM3RSk6N-wEhT2!Iyf9BW1+-8!CXL{sHN^FPrP zWhAufhcu&7aB0P9>dY*!5HEIkG)L+fSY0@@5#mqZbZhJ7eN&Y1f^ifW8r}$%l7q9% zmh@u;F{U?PeC92nq7kNMUij&F2jXt`{D@QJK5jaf*W)E_ zteqC~g4RCk97wU>XrK5`ohs)pBw1wcj?{XbqC4bXG;Jm%h-Vnxjxid__iVXRWE49f zP0TSuBPh6$gr$qCVPkW77v2sF(NZfX)5B(fJHs0(N_>VqHI6z|x22?kyB5PuX#D|G z*%8eEF9k~_1;R&}Ya8@Yv71)EibAt{$Ao-Ay1GN-&pqRU!;m5gv&xFM9m%|0)6UuA zRs`|?k00%r;-~(~kX}j}$H~H8{Ys`F@pfR;NK{+CP)arOH6l-BW^Bgtv8JM7ew{8` z^P=8u-bm1piVy=G+p#P8O9pQ6hk+O2*sW+8_a;38$7YC^xl5(w4ye01Bdf%`u$lC$ z5EN8AdMKg6!oLyd4sycl%CL@VCWz&(=M7jUodhWxa@Zm-ETx=z{5X85zlAjY8E8&|q?t9<4;A_Ng=@ z{{72hvG7qT!u5-*2$1S1A7)qTS-g>T1_GEig9b*?^qQzQPj=SeXk1hdhY||=eA=!9 zkAnuug;PI1XDrie#U@`q&1v2YMOdJrLND%5B%R+~w+GZUDpCwtJH(=QE;dBJF_5M! z*h|)-M}*jQ?_F5;s}(!=?!=jjuX}qA;5a6^hDj7^ZT8~QNoV2j_!k9~ANPljV4XMf z1O78mAcUrcC9T|1gbhwFG2jO;m^DyXKRfZ=mIt=;qwGw=6bTULaa(w%fWW)Q?fyA8 zXYd`S>-u?=tQFx*bUePyO#vra3D;M1nspUf32#Jqj!O*lgU%{|rx1F}jO83!!F#0! zx99^asq;Fx z>%RKCLG201cF(F+C+0Eq22ezkFm9}P?f7C5Ov1mjWzu=dX#Q0DBdCrMeaCZ2IkJAH zFe#zlt<9ck!IuKANo?V%wbFo-K}US-GD(-}`7i@J>jJNQUB+eNIBaSmUDm^3;*1@3 z>D0m8paD>%e{*x$>H_KNg+!cYm#!Pq7tC@8Zt1FIr0lEBPZV zgue^|13TWx(|4ro`y=EgXjOH6rs+p-WvHvo-rxO+vZ3zw>$A(h1h)Lj!;lJT;; z#mYob^e!?P@GiJbxuimKl)$vyx7*qtHL!Eup}k=6eL)t3`tkG}2QF6!eIczv4M$18 zl_stLlN18Xl=ijqov*7=PyTv%&DQ)~-TdOz0Itl9n&XBU)tO%JqRV4d1KHy+i5Vd?ij zwYPRtERbnBgxV4axA|64$e;w~w?Q{jo0v$h-%P_f_TV^AYWAml##8thgxbLvV5cIO zp~(rHc_Y-RTa^txG=A%J^)IPz@6D~7A1|joNfi1!|Ko3%qKfP9#8%Nc`LjN+FCx>p z*gF-_H3k#Eed4d-|Bo< z(=8U1u@bn)!IY5DgpI*tHVX#dBdH;SCo#LD_)^~uBhWjZ1T{+hD*!%d-*DAcHyQZv zZoK+KKW=>qL1HHDLiMn_uoWo9Y$p?e=v+@``4v$A?&HJ!9xt9i?T_xll8SF5?iV~+ zlflB|&k~?rQH1(u;*$#em6^H>b2xp2L`FCTx0NZaSr^S~!C|t@g)js+HKA|nzOT>8 z(v_Br+Nzu~LkrU!5bA?%HX0Ttd?e>xU?d>&@O*+KOzS>|PLf;=;Eu24bPRkoIalWw z@#VDyAMt>XxamYcHj5Hwv!ruU!38_`q{7=j!BcYXT&o44Az% zFE&mLcig-fZ|f9%^81g18!=r zTkL$)wLSQsw@kWczA6)YvE21$~7?=q;}ehnifO3X|QW=v;X_?Bl!*TWrU7i_Rd ziO4;uiof0tABql)DUDgI*U)#g>TL=(fLTc53TPLfw1bVd zTW+%LjxO-}BV1s66_oT>e63R(o&`L-Yan@-zU{{Y)aA3kE+dOA9YT}|m6XPKykR(B zB7X$b!x!q^I^zw#PO`aV{V{RE;s#x!KaDf1a`t;#^=;uxtk-y%U!Ii;)@I{KG#~RC z@R;)aYG3e??C*DJHx0R9N5g#3^I`r9X4AXGAxf(^xI|fw!(Uc|m*Yo;9L+#R$3M?> z9^E0l8;vN`6&?;5&@Ci=_B{{4D5FdHq{{7_RLt12QcXu5S?|0qf{Oj!IqdEwEh@~hMpnAYBl(qqxw zy=GbV7oe*91y>1~p>SDl@3gSJliWhv?mUs3=zxs@CyhE)ITroGEy;)ZYf-bwfHMcT zHzCNk^4*trEpt_K=X$~vvOqtq_x??Gpv%cG)yBur$8}cuuqOuzFWw_e?zw!#XW#@c z7(|e1%@~<|5wk{!=FJPNxev+h>8gd=Ege7e@o^12cq_~Lbmi`m{??aK`^YpU)>#Js zmcxjgvgQhCG0`JJR%wQg06yt?LN_*ZZH2NKQZ0;UBowqZ?y@F#ygodyR)f$QJihaRX0!#=4abvsuJLMwwwk;J${%Yp!)<5RHpN)qDU6wpuMg3Xv}%o`nqB$#gL)& z2v5E;ntQyd8GS@YO9lcM6xuT2;KnJ=n1;boPtTl?zJLmmsKFq>_ORYWt+cdd_-FLbx!>6cmubqRFKGXzC!e3q=NopjmTEOd=81dkp<6@6s@>rvBp_U|7Sq_ja5C-p*l*0U4uSbZk|6*j)b6`76944@AUf*nAzgL8#DudQ1 zpz|ov`X{)S2fvgi_N8cfAlvoNGY1;C=bun&n&~m(M}k1Krwxl=V`En>9;tsLf+?ZM zd6U6FxGu1DG~)ZZ^ipRNB5{pm#u%h8FwO`j)YoKl6JHQu{LA1i)p)FV7uZfP!Y4NN zksd8&#@BA=)-}dBHX2AnIJ8%mar9ir zPh1Senj0B!6!F%_QnxtVQv37L|KjLxe?=}8rjIb-Z$@vb=%ABrz}Z%i%#Ue7JC~L~ z&=oBUcju|CU=Tt)~TX$rpBhvlKVh2H|y^_B>`xoAZ5bvCb;iJ6= z>H3mpQpQ4Xh(KxaG%yQ^_epxXOw)OZp>V^Mb&@|JPI4J}tl6c3`ZkZgWW|oVY}%#Ch+##|Qn)&E^?wK9plk#2t=S14*um z_(1~#562rzv8cm8eCg}U3I5?;trUH>51o%Se|6SXg2eM;%WEp&|G zp8`(iLX24sXJIqoJ%B97Px(SMu^@rp!#Zil!<1vIZE*^Ritqe%{1AVdKMu+`1I|{_ z21uj`y39}9(uP;cbUbNsB=TZzwPt3)$P%J=vX)FWbI<1nKfJf=k~omxnwfe{SqC8Z zGeTCI=A^q725o-o0f6>hL5sN59mi;4+oYhzCCw#c9L-*VgF`UQ5oRcpj#0=ZiSD zwt&?lp|8U%c|q;VL<6A+C_|nU8Sukr{#s$s#n5d{O`KvKndCLkE3jGi9H zjVJ$@j1{m*)AFMX5K<|wix$GNHMtCCRCPH`$!VcS%6?tADN*|N+ft5DE;~55`;h4j zn9$k>8e(KhF^UnXNCg0KRs6qSF6p5QX)KEx8Z943fzPNN(}tsX^g-vNPxGYL9)Z_i z#|$=lKB5?y3GoX%WG%VB3|Z@f>vSSKVIRTqh!5ed-oJ-?Et^NTTN$4@cW~u-6`5j} zRvDxY-Igrk{zuG1@E93(X`*b)$Bx0g_fU&@SeEGxuxvN8s-@`>`t6ul5D zJ^p78|J5#WVlmsrQA&Za@$Ysd`}@qiz)%F)V>8G3C4?~_&r6V+Jv@e3SAg;dL#G#{ z-bb9pj(;sEg*12E;s$E2bl8-|3{DAIUGo9}KimA~fvHnA?~9npy)n(- z*YF6?Rax*Cxh6lnM*z6_MV;gYUW*e$+2P5R^T7S7Utp8Q{PulN+=>OHZKj2#P8@dJ zZ28+0YribAV{xZGo@$vG*~79iC4@XlI1BPGUr9USz)D!@1Q!E~Q^x2{hQ^d|OjXrC z;*R>J3VMi`5UaybvPg=EQ&qgQ{4>fD?fl)xXcUoLb6^N5`d$Q8x( z-esgUr2NY_C39Q9i@0wRY-yLLF{t=J{+4 z@$@_keq0ShuXfzYz>}movhhZo?ABUnx~kJMePKePBg4X-e}PK|;Osvp_ZPpQ+{bL) z3&wAz{$nl*D-C=ahVi!B4-OqaXfw0pMo++(s~~!8oQa0E%ZIP8hnVSDm;Yr% zV+L!6*ywubw6tPngpXAmGh0$SN{V?7ZIE%{qCf#2>HE})0;*8#+#fods(;bIBW_}a z&epor+^o|2A~Svx8Cy@mIZydGz)=rnhBPRF34$8f}s5$B(6kzNw_HTj<8 zy}QSznva_1b5$V9AMW4AN^acBR^C|84KoNB*q%{aWVHp9*;`xshIz|DO7Z&$Kx1t5h0OSsdwK(H zoHv-hT2_0s$syGJ=N=&2WiuNoR%%SMCxjRm_8IUr$h0IY0k56eiAE}DU^9cxjn}_V zMf5JEYD;5u-%*mI1{W;E0msQR{8KOE0&nNHtan=XE=7Ee)&C!!VG6d*!P}N!#s8F}lR{YDBtxgU{F@FFh2?4WnpKllkO8eeM zZicAoVqo$-PHTkdrw<;*q7%4AWk2=8#VbZyuv9>%tfdPwEOGHRbomT^q18wne(j`H z6YEvPjMt$9&;1Bw8gJi|5IKM1`kfzfUh;IpjCd)!CfrhUk~FW`q?;nE(^kw28;|d& z3&hmoUHR@&p4f=I7`HjGj|_uS5kqv8AMcRYg++hi8hyZ9HTV96ul?Rqu* zCXy|gs+RN%+Zb}@RV0xZLIC|T{^~Tn=&OL=e$ig;oF7-6jfIVL@1_()Ds;Ny8Xr+G z#>uoXai>6%%})$9?*4j&Ym^{+eUY73^!`njk#h`;EI@b+_@2`Rp0F@CJvl`?XgY5p zo6RNJLTM&Rbh^wy_ z{bIj=mPb08s#K_z60E;2&a3|j$N&wRM{cOCXZ6>8M1%64@Or6Lu4`z~1;-8+aq+@Z zO2_YlPw(1NBGgul-wLe5nSX#`xU(SnN)CM$zG(||IT~nCXB@6^^0rJQpwP?-EZ#Lq zihY|PrLM4|{;HaQQIs*rvG5VDN6c-Sn>eq@90ig5IGRgYnx24~8P1 zLGmMlN~fFlr=6cdk+>QzV?nTj2TlT}=7G|wIMk(~c3;#@999aOy@-|^K7JW>n-Qzg z|c$=?@ir_xH98|5{W!t~fnsHX{66^W1$l zEBy~|Nb?uRHGaSCwRqDzKBW#@T>jFBZY#52N!I|rd&244JQecQv~l~-JD>%r2$#q; zhK2b~5SUmylEcD03@o$9-Ix}d0$zU=hK1P%uXSpoJWqc1fkgg7ukU#Vp;#HYyAU&J z^XV7d&t+Ppn1!<{Y!XD`;p|OOH(IEGLM|wHgR+|Q{iVA5kfeG~yqCF(q3{??a3|*T zly2IH5}+b6c3d$_E)LZ=nT$g(96oG>mW9YH>nEKx!WBP1J#8H`=INaCN}M>(rFU={ zMy%LgT_nA@JKk%(Qx9x=j7$^w>08ry&Y3mx<#|Z= zfJ237IMjTU)*Ah;fBH}8B_KRnSa^2WG*0FTN!xzJdWF(ysnO+@Y_TLa^Vca2tS~OU zM~FYUvT3`R3mh(}x5=gA#DQ~*W5MqnAvDqr7*sEQvmMOcxM{sfbbf#6t#TmsaWmBA zp$qZ_Q8E4FpK;G_8hjf_AHL2iO#CcNeF<#ZAU@7ZG)zPPbF57Bp`OQjouKP!J+0JE zG2*FRaVl~_Mfdcd%oT_7Ed~20cvD!)n6%YTA$guYQB2)Wt7F9E`#Br^SFH@k?4?96 z5rCI`0IAdS=9pWfx=GxZSr#5`sa@Dvdx}gi&!%NZ;SK_8DUV$Os>UQn#22Lt12S-J zf8mFWpurHQZzq3SB}%IxL)T;VfZDcjAS$~K+w(6}XLW__HOeiI?-@NEmcAX`=54Wf z`XE!7lCJ&l!N&FK5t_gvy{4hL&KL3P_&P8GftM7za5G7ze`7u#HfS z%47NM>=UoK#eky|A^tE-ca0R=6Dz@K;cndATi>ZAVwg%j zw_2GW;Y>%2#i;Fb=*P!S6(qHO>>?cH;XC)d0Ox#FDx9PdpkAYlvA_o==cadzIgcBo zAzNGIKk1O8Py_j>s#o8GgqSTh_<`%RkRmQiB(5w6#gIw&Q@!Om|-s*T8W zp}~dDVPsgYZ(jH9iRfeyKKb5|drz8z61F(d%N{1T3Vg%xmReKcQ*)6BGhw|^x!XXF z{DD9@S1eQ2}(o zqW~oix9xqeEQ-Y{rdgyyj1A`tsKC*iE;tz6FCGCo;d1LYDrm%BY*EL1ijC>*NSBa} zIQ;q*5pyCE%!mV99PH%-@71o!ACvdf3=0Vkd>oGGRWnjPanyDf19oa{ep8w$y9572 z&-yzDkeO;1S$gE>n#>=^WS2|hWJo^kC``pO?RXB{0_E?T9;=HTJTQ3Hg`~b-{rgZ0 zwW*UvK6Hz+pQ-JMjNHZGDYHlWhIyT|OTYLv5Uzi<1yZ9S9i!Ek%D0~b;H_X*nt*U=0nap0RNWDrP3WTNR-Y+11&cr9; zAfTxRjS1*hCT|O*`U%wKa`b!Cjs<*<{`(kk7A>g+j`r1+Br3d3jd42qg!x%thT4;? zu^IBPS=kTcqxP>JBYk!lY$o?Z$caY+i|&v&+{jOF*2+Pwm`aPF-oIVzSe;N)P`C8= ze&}Ozzf*s`-9!0Ohcz+3mNwsm}Hps|o%DGXvvfx7^0{7w{ z@O;F7n;S;-W{tH%4Ww5`)#zE37?;9wO0~ZyxY`7SaBOd5KWQ}jEOa4#wxo&FKyNnl z+h{UhTnYW;8k9e~>gpJnXroDVDSVmZY-YJ~JmVxW=WQhWNy`|4a6Cs}^1J6ybOCnm z^G6I7>w=E(_GNyg@2)W#88|pdo^Yg`r^E!^QMP0mZmfn(=-3}&Ge3^fMt<1Ht`?Rt zinv0K){M>M(gsTLvfp?6g(B3a@E!T|uw!p6l@A?@5GG}Flx}#x!q`di3RZE|;e$V7 z?cn0W1uhDl`zq7IWgnREM)M_GK}xKI;NmY%5=jxsi%EI=qzb-PCdn(;;D@@ zn!;6b6@xtPZI<2@9)`HfB3m&s*6AOyjl|@t#L9U*K`8u$-CKUlTKv|5xX$}s2}XPZ zrS<7h`a+Ua*2Hfb-K9wMILA7|a?e8Th1~wY4atdI;T-I$!#%#+`ZBvU z#@t#Hvuyl_D`WoRmtVHnMw9dAkxPTA9XPz>Wf=l&!hB;=f182`jvqtek37fq3fC*v*B+YzarZHm6&f{AbuJ&@x?nkiwhC~y%k9Nu)jY%Z`)4f`zx{ESct3r# z;1Og&5t0Jt$!><9ycc!#^=5tzjW1qFeLI=v7Mwe|NZDo7W%LeQE=(hKH*z1t_}w4p zn-^J{29?z^a_pEsR|w&RD0h)lt&3Y1c2=HktM*{H5vyMGgMZFJ6jU=*POMc(RA>62 z5y0uJ%C`Mr;PKDU5fcN)xZ%mY;N`_9%J-CehyTY)-jksj-6QKn zcE04yf|T^|h^-kg2!k3b4jPt^8cAmc{UWX_FTRObTr7X$ zD}15+3i^E@2*=jW^DPh0pvTshAHvPj?Q}WgmHiRjWhOS|d4LZ{MPyy#yq{OTaVpi# zExatt$W{I#8ZTfTS;mj?Sc(6ZZ^*fXHSdWT%sj(Sh`m@QrZw&Q;uh;VR!u|LMG!`q ztm@~DUXDe=twzP;c1&!yCgo?;DnI!$5FFdGy?>^;dxWoM4Q|?~U^8PTKKG|hT8X*)MV_<2)*PVWXSMqw;(=RX2cdF!_4A3%%ZE-of`f`U}Y2Cu|IJPF7WTFcj**C`(&LU)DwM+BlxHqHC@Q9(oYvE&aXt?5`N3mLt8s zG+*#uq2cTade5EID>70YbGyTfM-qr`jrf=Gl%+ z*C>;hX!@hKWZf^1aQJ1e^i%O@|FGeQ(@Qmc6s}PQnwI1}w0T^dB>wA_<>Ip0n;fdW z?<`o>6t4kG=6!MPG|TGO;#jskg*D-o!Yk6(sgZ;-Rkm;1y(h!PcBY<)50g0$6GXco zSMtb?`Z-|DE65XPl2t!2n+B@2slOhGc%{G8bYxMbxGAy|_i1X;+wm_k<+Fb&E4;^I zyP5y->02{tDxPDsO*%P`-w)pDJEG*vR<2cfzcLECoZ7>%?a={$e=kr;mYqitEK^OH zBY@c&>f8H}9$Bw4!*e~DI#FHUGdks{ihtgL#Qc0HcX3*>rDuSDSV<|ILS{PYU@_tW|#$3;D- z%k_T_{?1`s-nDH1^`gPc|Ccq;Anr)Aj|QJ?e3_YZn<=QX_}+I31qemGSEp%> zH`ep+(zmE43`RR=)#P#d&7$8w4Y74mCrT3*B^S`f4bc9U{yEe(Wc(XgTT1{G=DeU^9*FApdeiL z^6PBaVegkar5{0mYi|=jSg1cvb(2#WL`vbYUdC6iO&>fu>w#OUnAlr=pOxmI|3vI+ zuZ(GigerloUu`Lq@BZT{i?jDd4I--%t45u4_hR+pXojuGGy1Du?GLY0i&=(Wodc~) zeasQ7$)g^>ZI2ffjat6VmY1T_Zg@CtXgqi z6D#Jjr}DzqXOA`Lt^5j_H#T^GW`0P4pZJw46|$eqGYql3IRB!!`EN$|$2qb!l_bIU zJL?)xat3-&lwh=t-o6ctEMsHsiIpil;>t2?aBIn6DqW0u?*0-xZc=#u>qC;bE}+$k z0~539sSZm~Ehnk&_E=PW5y|s;Q_@UG<~p%atjn&|^eACW=7cvs70P%T9dzKQo}C-4 zdixn3^O^2tV9&iqvh3HzaAB!1U5ppm@QF3=CqgSds4Q1fXHW*SMNNPUPs5Dk61qRO zvaj-#f{Ka{cOkuKzJ8@i$PU|R%iUL2@r&?#YPF(o?R`m@<&^Y&JxMc5bs+xE7?~?I z@f$slyUUY0BU4!~)r91JyKb-EmjCC!789@Bv(eYmc6avM zj@N^u(#a`j|BUKCbcWIsI^eqX@y~lJNLrVM}$!`UT1?Dnu+E+snAL=X0 zw%^J*(5IsQA@vUZ`_4M~b5Z>b-y%b=z4-F^2-4SIvdHb^ZK@csljGo3 zvoz}#LesO!!tA7$#iiP4b4T9f{!QB%(-1wF=bPlLj+lA!xdEdb<(}nnl!-MzY`oBdy;qIw2aER1b1BnLc-(_N zh25*w=62k&w}FM1EDkUzRjbX3PG zy~=0xBY%99qS+JmQeO)}UT1@W&72OHlq~aw^>>2qpD#XvU-K^{BprdjV8#d8EBVg4 z=K7tOe85X}-Ys_J^6$LHqclaPUFw&|pATE*R)`SCHSqI+JxH<&`x!Ozq8Akk@nqdD z949O;%ekL$@{IMlX^}tR*w=8+ukxc`R0?y64K|a)WvJrTVpW@EvgH&Lex-NbAWf&> z#4wNk+v#M#29EgQ?M}BC8BZhU_UB+S+>i-XB}9 zYX6zKcW$3^`4TKHNusz? z#~i38A|$lzy^t=jMOf-U;0Xd0p8IQEDW?HfeEdl2dBS~T|NLFk&ay3?^W-OApQwND zfr=XPn~qM4oQc<%MtXi0W7-3fy$(m3GU5Kam)UywT#`wnH zb|Aj9-bWcBwOtJhbXBEQB&`KHW71K-CRpC1Uf)RXi^kx^A#N?d?Gy}Kxl!SvT_)Ja zJP@5I=hE`qu=5n`W$6x09mYT>t|%h=`TCb$GErRrOz&=oxDu~c`w%PRv<*B-%3Z9qBo5nCyuDBxO2}A>E_68 z{j?2tlzs(dc~T~7vFcgZVX#dLM&dFH?6Jc-+@&|JkQZIuh?hJgUcMulx!R*pM{meiuRD5VF;i9u z*NF!Aju8vDH|kE%OYP{iWtSO$O0T*z>~igF4q130#W=HJqwEk zbisTBtkEW!46->3>E$Lj4&DvO^wrT#CJ9pvXLtC+Urd^nx0HL00V3f+OpKUK=$|r(V`6Zci%ogWeXk5hmu)^7FF5ytRr$#UI~iWuBLP0(MDCbG7Zv z8zkCt#W3e4mU5xG1%7bkWPd}n!Q(c=uA_XzvkMaRe+vJmc{gol+nlA5MjM}RL?vJy z{mXH)m&L%M>v20}&y;}jPjel&;L@`Uq*&cfluwhN@9=vY9fA2a6Q}gi>FvB!-`JOj z>K$lXDi?LE+<--h#4$>?L$G#ujFA5-F{>4z{JczS{ zCh<@{BpZK=e$#R#I86o-!tuOIzF!KYS|=bN=pUKB4kjW{ytB6bN)qx%8csmqF}HT~ zN&~niA|<}1xxPow@pOF;{FJ|-$G4FXg0iQ1%3aW767;&DNBwnmGW+a2Nfana>2+c< zyY(Jn3Ofhk_lE&Nku01L9TGw{;If<4G$4rhmiGD{o7?LsA*TNt(=yTrx5&ueB8b&s zM0QFDMUvZGp^5LlX=psJM{_c;w00l_0m z2r3^PYtha}`ofQL3XvhW4NNrrYRqOI3cuPs zN5U76;rH&BWSMfkA}K2IRp7&Gk_;4+;U^Sk8&HhMGwM+t?%}uZzv*8d@3e2E@zJ6` zVZwh$a}T3x?CH5tZKqvgC%YAT2nD9YlLZdF+UHQ?sP`S&*7$mE*aIgu%{eGsz79Er zUlaw7dNZUwf%k+>GG0AR*CHBl^0o1XkkwTQnJq`{G9o=qo`i91s_;(jB}7PlrQ=f> zcseBGs|tRvB%(!>q0keLM^YMT<}%$0g+s9@YnHzB30)T3@Lr;sQ1P!5_x9t;V6M@mI1J@tp0=9ONPUNUUC@?LV>=E?-P> zTq1*srmyXWxbuWM)U{MeClWs~%`AJUg0=+Tr0#*6OOkV-eRYv%35)oguR3K3W+dIc zcE&$)!D68Uv&i2U$DJh{&``Bx;*fpEvH8v+cpyHMn0W+?ss)twbKm|07fSyuiMOWj zYu1^N7TzP(T&7xDlxeH*YSPjWVL#j@8@dDfSUAh{P=iSKCvD?UOc3le;jDz)Al8R5 zTc0~r%@)`c3z~M>$T_VXCBYkbS{&Fd`yDjArE^jK*pb2`bM;c|4wI;mer|F!2Q`p$ zk7R`mZ_qqBoz6$=gbo*@)69)7w*SD1TB-luVtrl`#C>2lFdn3yyto_bWBbfW1U<}- z2WfJJ1-vEOVp7#0I%=eq^pWH?NDvQg24qmQs38Z>J6^)rMqRKU5~;nhJ*j zas{4QNcL*WaYC<*(vpOwITYBS`M~L0^0#ab>LLAiir3It;>&e4`sY1{P5Hf|Ouc9S zHZ}Kfym;t>3hmlcvzid&FQ9I9_Q*te*KeUUjAD`Ux>s?a;1MrnOJ!CoMJ1x`R29jY zLOr5wPLydyDk$T)ul3~Xip?LKUl2Nag_;>K@t7J$%Hu0-2zMBRD8}IUO}_Q{#olLP zvbv`<^Mc=dK$^L19N_ngEdB2vmw}2L*?n_b#}vX;SUfm)R5_>^>uK@?)7{pxX7T#S ziJ25ky&A2Px*!T?GmfpfK~@(AvTL%1++?yc1Jm9#Uf0ruQ=e(=#tkTKX{#kzl5Va^jA&tO+*xgC1n ziwxiGRS72Z>JS6OLW{x3HkpS>)VgkvSL!Pw+CBIgqIp6Ggu4#^F#M|qeUPo8#eGoR zHJfcXPpf{yDk%6Rdu*bj%)y7N=p`lEwQqM}v}d-{8@Q(3G>)NS^Sw-Tz)q2tl!K#z%OBBMgS zQ{>Z9xb*dP45OoU>K1^}Iyu_ZkkjYY3B$#MxE{Ceipk$8$})vU5XN~BtB{lz>w3s~ zuz^y&N0K(u;-!B;%xf?cnVOe zC;6UBlmS%O)|!iCrUuN*4QOT=iloP1KrIQ{VwI*Y?lPNM=&p-}ohz^7-dUtH z8_o%8932Vj&5iS?!*3{PxS!q*_4&p1b)}G!)~Qn&kgyMB|KT1A6In_Au^~h|RlRxT zS+?nIc0eWKD>5TL&;?0~6t+Z;A4|?}zE`9G{tq=~;3+i)V?%Jj$&{U?S1cj>Uv|34 z_rP3Cb-CQTt44JAFz0(@qPMxLf~(W@fLFXp0BkZYy!RgPNgD=PT|D7ZU6vVAF2>~DJd3kdbB9$ zSPD|42K+E-pb@6m9PbskyU$(ZN$3TzuR7RkD`S5&!(S^gFOo`Q41kl@9}*ONy>7c) z@3YK5R}khZBZnZQCy%k}>c`8@(1CnR&uscYkvhMNn{hwj%iMlE7F3$5v;nPmA@E=E20?ws49P0&}?P=-ykeauAkr{>C9O zbB%-De?P7;b8*$m2woHE2)m8KRUx>z%7`I|=ZRSp3Q#WVn@J8$L6)uOR{^WTlc}0P z53hQ|oI~cXr(-C26&j`RqQSEoQgl*sEh8AYS5hgy>M@SIxpecQ7bo;DgO5hM?)dut zWao2Kn)XgxFTO~1vsS8ngxu9xW1mzo+?l=pgY@sKG9_f8BY3_ba;00MA)+y*tCx+L z0fD;K-@@yo`3G6xJ&U3SG~4)|TIFE6jY`dh0XK zE1o-fEP`j@jHt;}o7Y=F!!oQx<|S+BEPu^t+=8wr{_7~U4Pn(We$VYfCozA^M=ZVUTZ;!2f{55~qU)vv5JUjj z{Vh|l4;Naw)wenjyxzYfcI7S@euQaxW!~e3)N&l$9PqB|_uVOJW(f%h(ys$RitB~K z)OL2=_a-s?ottt$n)yx(e4^dAea4;6o>}?9tt%d!xR84H@m8}iTElBg<~n$#kh?Ia zO{rAh>5kAaP@dI&o^2gR$!^2kxq|xAocmAY(kilh1qHI)DxC}U8Q0m#uI1A?m-&3c z+k)qdX42n$xY~eZd=|eiFZtt^Zo}L0M}5-zBUH<>%nU~qg2a{>f;2^hfgnm1<;)4S zV7xh$WyKqo-)lIURZwG~T0&Nv6~(^QjK36Y0ri{-c2#E!@jNc@5g&Aj|8ASez;P|&!ykcbr9g^)TRm=x zqib2~sJXNPK4TKUPEO~W-FR2bSpF?&O~7D~Dlau;Cl*fjkWTQBa^Cb)n!xR${3wsh zy)Ul;HY&vl6r93QH1`}@HF$l-7s*B@U7FOhLsmoQK=WS~xLKFm#AFPsVsu+oojhV? zo0A~y*zm6^`RA}|gEoHHSdSzgML`Hg#Q>(1x_6s&)Vtj#v$);YYiN0KCuqJvpX2D~ z7F5zMp?RrKR{kPSfb>!;a-dVl_>d3L5{ zBgF)V2TZKO8%j(pJPh;pxe(PgDnXD6XcHLX9Ma=2+7F-9VNO!S=Cem5C^|SB+D|4D z;+K+2%8|tS7T3XpmEZ~}OfT*qandd!d9PR;C2l5LBQd2*rys92+Qx5;KJK0$q*HRP zr@mFrhjMsxC!G^KRRLb1;R3t^kpH_lJ*lwBWG8&fjpqYL_Pg1ipQ5UcUkB`zl$Q2qIJRd>+@ifMSVAyX9QMN{DD`un)ch3C}&CgDI_w`&q zvFcJY>v(FbuB-ahC?aZCLGI}M>L`N)2c{z_RIQ73z?e)c4GmWr2!ihfTFKjh)I0Wbi_ui(h<9OB~^%VEVIaCR+}a2tXFUui|W@HqYe0< zn*O*Ir;A7z{N=kWJCSJ|TuJYG9>@cJ6-_e^s2g*LHNcK3r0M>Wi-uaEq|89NdRYg0IG(P* z?rw&64kY-RLidvJRVaw?TNFOK=}6K>5ybZfxck}5b6lpQZ1b945kc^@&~Wsuvb}vS z27O`lHJW{xI|i%ArT04nO8keA_!Q=2Ym21S6&|1PreAHt9SshG+C=lt&@NdGOg zajP-t_@E&kXAy{9Zm5sHPViKWhRaLV--Fu&-^c77f^Q1eoh3J0Sa5o>u%NLpRW8_` zc3Xp>af1`)1eoM_-^dZYTDYbv`s{r9*t3g_zyweMr6Y3*G1GH!uWDmFl5p;MD9C0= zecNyMOk&pM((kMj%fBu%scyog(inks6)p9GkAWDf{n0z^zh1P!Wy1G5_o7xJLwdvy z9;1T_QeNiTaEM3I__Xv_@_oFXBT5&KU8(>wkma0Vcl(zEXZ=eE=-8bE>%GyHzUsnP zZlJ~9FdGrQE6>*;8!6z}Ny5Ckov+U``IDlPAurZQ>QB{c7^vzPrzN*+Jgz>-zrBdq zYS=$i0Ol|$0FY{d`6*|M`r45^jI9#z2v6MlZMQghtkR?}6$heD=BtH70`Rw4*@n_M-grb;wOo8~xqjoYZqm#^KkX{`tPLA6$UP zXHlDM&Pe!Gw0(Y2M?c?lT)6Jr-0~v8O$VTcBi0w!jA-Y>AN6`)tm_tm%uC$;+`Klr zvt>^X<&#|muQX1+X85?I`;0rRV|c>H4Ez=LE|;ybl)Hb-3AMMI@HlN<+RC{6y;$6M zo^M9UgjLn`nrEvra-9K4ibZ>T;F-0==Hh8@L_e-0HkkQ^M1PgQH(-Wh<+alA#k(Ol z>afr`2>Er0WZ{ZvD^1C&^`+o|+UdB`23J|urAs6o!&b1>{zOL3| z7diioz%h(y>S)*UdBb@}GU{@0vhd(ybzX7#q+iC4lavbuUF4eZvfEYftYf^K@&=l&yP=77A({!GOn%QhW&+rSf5+r zW@Xzf>mmgOU!!Vc-*$yVgq4mgXCs$N;bFY4g!I5vw;#zMdf-#d4jpU=xN=+^|3C%yZl#D+}OqEZ8urVB|7Tp zX{`F1H?f4S2{#n{Ww9~#_C?rUBm`9}jK@ZN3i*28IQ3$dgNMqfhpCIj=i;Mu+Jo_5 z{*D?WhH$@^5A5|!mI$MEUrg=mx-ij=RA#TB*U8-}G;Tl;@f;cxYw_Lvr~0#gn#rTw zcTX7xj2#xOla{8M5JWtWbq|WET}0d7V6}405w7rsR#(vmkp5?Et=VZc9s3G%;L^*D z;oxjt%jT+C>@lg-)jQ&sRJa*AA?;mdf-y z!rzVO!GANDwFCJ};@Wa5)9#h`N$UI|^R)c!N*Jw#;N0zW4+?mghs(;+M;^>+FyyHP zQ;wxpq}?YgU9XuUTcoWu`@HD*>=ilKA%Ca4d8})pg>>*Ug6g70)O(FEJep8DPWBR~ zt!}gm#Km;ijS|CU)q$LUH+^aocQ%X2fL_C>0wPzyfA@I*Xtej=rWO6~lYcwX<#GQu z3Q6=HWb)cTmIePlM-K{6by!C%pDLX$_ z4Nf#C@1|NRu1+)h)2sNc?6CqCUdIU=e#Mi%HuBRb2~o0@wFG-;;?_cHb zy+)zqW)gYMeA*8RzO&ApEo3;7j-Rg3|EqHh-){BM#oxr23tk@O1AFlTEG-;9TWvW9 zh8M>|kJlSJan|PI)v13l=>D;BBF^g7Z0?A?U8}@?*XU`AUzpn3zyrAuiGCeGt-wSb zcj6uL*cC6HgdhF*43dlxV-VtCZsxt*q_Y&{!9CN3xS6`O=NQl1rb~JyTxv%LKesMu zKM>eU2}brn9RyU)M7x9N(F}7G5aLdgR1)xD_MVJ6C#-~;B}b_qXvS}wfe4mtrtQG$ z>SLF+0RMI3JxL7)j*qO2v}cA_1zoi-7Hgr+gC^$or;yC>U^uks^u;*hUkoouSw2h1 zN4Gn}LG*b6cRx>$72R=wiVjsc%M)y!hM!Rmy`^ePT?u}=!svC>Hj^gw(&G9~0V1*Y zFowf&)qKIFEy$|c=RubH3zV^dmoQQ@#+9%gXs;YSRAd z^o`G#`U8R8F$HO`Pr3bB4r~3cYQK%@W$n5H(?0{ekQa0!++DA(rwAoga;Y790j`kz zbU>fyCn^|%_LaWwBO0V^AscTj6uZ0M<~~aYn~tew%*bwI^&I6;5e4OV2e0hO4Roz< zRqQ-Ok!l6p@gX1}+SOE1dZglZbu3SLHfUmGZv)xtF_ZXwMW$b(4=rbwb=!5^` zVx-V)5|k8aE|`!s6;dCZIJCFj@Hx6=xB#avXc>Nfil}~9agfDmmJaewNI!8y3SPJ) zBXW>;9c?Gz_s*t5-Y-i5+C>A}^(Zv#qr6Dyu}-|XdKY!I@12KmUr#Zxvi7u;sq&23 zJu`3aj!`}KvZyHdMm7D(mWHdYRfYve)=&Y8mkyb~SSRaz*8{!JaYI#yba0<`;hZVK zdffLu71%0JwdGOM@M+4mf2h28cYcTHF`HS2oENN2xHM##&o7ZKT;$vi!jF!4&>OU< z9BBP8cNH5#I&3`QhqNByCE)g^Uo6&w`a@j}fuUH9{YvvVtH5OlF0x#)eKD0vo_8QX zTCdv83Hw0_5mjC_r+N_^ql9?JqT&=W*uaWrpbrCaNkk3b$a0se61YbKhPeTV`X(g= z@dudw@B%Qi35aYPh(^)80+x4kooKk0fTdi;5#Ztfx{~|f0*C)UuJg*(wYHJ6c&!6c S4De9^fu^dSN(JocoBsjKFbvsV4=L9l{!V*wO_C`d0V8&DBYK|rdAf=Vya ziv|IeE+QoqL+`x>NOC4o(D(nHd%jcd_dNGG_l?_V_MTZYv(|5wSu=YcoYL0Vyn%NE z6BEcQ^gn5BebO3yC!F;EY{npG z#;8UwPX9bMdkn5Dv&TfUtSqxE@J$2N=#}Une{25)YyZ#I3ElpHmNmHOxBMA@{S!X> zgZrPsMSCpI^wxd7K5liI0ikq9s_LOz^i(NB~v46S`>`85vn- zOj%~~S!QNgkL9x-gKv5rdPf-lWMvUS)hr_Tre)ExvS_r={wF{CTYpXfm;dJkK&Jb1 zH|;ZxMtm$!d~8O{0@q_As0M1#KQvGed=Y81_V)Jf1nceu|L)J=N}$*4rghV3v@A0~ z6x62?v*-o86KLIl9=$0*mBuJywZB~uNP`7`Oy8D?Nm7LVca`I76?-P8?M%my96sk5 zG2BM+vTuo)S5R5dFko9cXtgWX15xyV%mPghPa1`>4Pjg zmg$ZR7Gip=4y|JP1|dwUyvSOnVogSM$=4b3|@Y_5iFR6P$1 ztOT71w|LNT=b((+T<7yX)9mQnqVc0siB1(RPt<-@P=3x z(s3QA-s?hjMv4n9wBWXqz?d&45!39Rbr2n?6A%<)+AX|+M6vA6p9{CWJkr{NiH_*5 zAa^+pc?HxrD|;k#wKsQE8k=+;r*QW4medC!eC=4cjXnY%%!o!7azx zwJnERGE3Qy)^tlOGIY*4&waLTWSbC^b0-UKig=z7u7Eb^IQYU-@AE=3-Z8NX3DS<8wJfgn@HTMk;RAlfyzsq)HxprRv}A zDp~K=C~yoa9;EC&q8m$%O#HYwo~hIx;#Z+}Euqaz0J-tVdTgGlmQxebSrC;PYK#k- zGLs*mhV*Ky9`X~b@AMGo##_%$CMFoXmb7Z#SY?~Ae%izV2vN9UhP8HSYs84lfK|V8 z=2F|)d~8MY7iXec6Hgm;V$}<=r?8m|(_%=wX582M#m0)aQqOdJ&8>Hs4xD$NIlk}x zGtLh8Thwb4tBv+0ZCzvzQ89^ZcNy&+?&%R|DxQ!wZtUzlda6jyG=JLD($6VpF3%Gp zbu|vo6}g@KMjBLPC4F$a5aBT}({18-tJq15%e2$J3wO)j{Zsr52BAq6TiG!@IK4jaJ21oO;N4u<@+S4Z`E2G5=^-Y|H z7S9;Q5)UaeO&{SP1eV-HQ~CyjDHEX?#>Vn~STi;oB$E3!lxt9ztZKB1cAe^Ih8-1+*dN zygGSln=TPy${eoceOZ;3jkCRB03P~JGOm4bb*BVtFEyT6V{Yqokj|c;rSw-ON zCo9SP+Y`?#6e#slDHzE%R?;*7jci5^(uk{l|MvWNhp=6VZWmH$%6pY9^$jo1cpVIG zP;ndSWSi`}D1julU0y?{x&x_nV<>SB`ikSPz5u$_3HuLN#@9|&Av)pF zszN!Vs@SH5^-Kwqk;+$<61c{S*#fK*9E_scXjiR*Vb;Q1Eh^4T_QpGqL}g4CZ7D_h z9VLnquJw&Ynm8u^ma4zM_ghz4vu#M@^mx*+QnDFjDV4fSPtLAw6^f^I`UMzp58qmt zovY%}&7Y>s#f)TdKHoF5SW?D8Xir(Ne#FM4^aM?%md(3OEgl-_u(}pBa3w`)h%ZG> z0Auzsw_=Zy)A+1ZvYtRcb?uRZx7m#6WIGNnj8{!(8Sy%w$sCw=pE-G`=j2c!n?!VQ ziWlB-F8?OqaIvKjU0^IY%ehw(k4J7wYrj94H$ce92tV7?+VgtUqnOOm{03$9{XhTV_boP+Yq84BM-z4uvDA6EBD$PGD&L6s^p3Qu3b zU@vSLyft*MgxBZ&SRq@IX>yk|T1e-+B4VWEl(Em_>Va!`BvD{1E*^Vf$Mx8fq4on( zc~$Ui02nj77rwz+%R})7 z*I~?hi(jw#K83N8WVOYxjV+2OL&8Rgk;`Q8&CtBbe325T3@!5NMrtXy2W7Nmy7d~e zX}W5E*)=zzydn4SII?>)2~#m`RGNsX*yIO#Q0FCm+I7gjCbM}dN9}Uhf%c+~h~4Ir zDf8*Iy@%^HyzsN-VoM$a_Oo@~qg`{iJsy8*ts5$4V}1l9ZIE zI#X13bJuecVt(1HDCz(=clG<4WdFPyi# zd4=dsLnPvTLGqZL;5I_8X&RVO;2}lEa4T=!PV$4Q0N`QMhC{wn0>oOONTYDR$y2fi{8l;raFl! z847q`8yjBiy=RcZH1|tuYu$IC;k_xc&!+6;Eln(+#Y z0vbXt-yUcj=$npGoWI&Wb*q87>{Zv0dcvMe{^*y~?vE|alac4%i^#LlX{MpIvNPv9 zoX9y!`R8>KuG%!H4CW<{5XH@JLq@nC(qDSZ_jYTFNZD2rVWn z1i`F|hw`rbo!=TU2x+U$#au10)X1@kG)}txzQV!ws=zOI8U`op&RLoUyQbYVD(Ji# zcW&f`Q>jmOz(~l5+^L$f3d0nOp_f%`$ELkg88Ji}v4Olka4}daOSVJ#fTK|I*AOm= z5bJ2GsKuibZkc+zAV?7a1`5PL*JtLdXY5!NY$x=Bc@#m!b!CI%)Y8z*feM>_PPfEz zr@hM9e<-lE<&h>i*sSAIJf3kMEIM{o3sOi?2!&bQ>kX88U8>eB_~)?c4a|Lw)6B&W z+$M4<(51Ccn)E=XCVq4NEAiyKa1uVj< zauDf9Nc{c(+W)Nu6984rf9)&)%qMW(F^Y8?2AO53F=K5czq)^+pPnCOA88(wa^isi|>Ab5QANXCTRD~G^sSJ%}& z+K+59-W#yP;bpTU|F`@vkJ9g1s6U6jC4)7dD%9OjWF2U`qON~fCRPhlRnzL<%q=7j!MLxi>l3--9>Y|BLTE>(u5` zj;}kbN2|7{nwOIGOh=5?BU|9V`BC9DZpyk@hQx&`tqnL zt@6j=_PzCfej0Zf=(T$^dDj^Vocq#LbP&whE_I!L!B8e8WK#lK;XR(=&pLUCV0}Yz z14B{nz%8y}{I?sO6F+u8D~S#-F2_`CX>#1sPuHwfNaiuts&Jv}Z@tENM+jxHstjF) zaE9ML`U?~;XkVOE+@%pMo;o33OV`fT*run7QVVU#tg-Duy5|{I41(b7We|MnJb{Dwjg|*3xnbasHWJ00*T>Zy8T1-rv zruQi&A;YdCsUW&q_OVv9uwhpBMIm|YeE;}(eo4h2&xxyOluA*U53CWojgHrslti;i zp?@k$48iV;4g*oq2hrH}J!%lwZbE>;BwDG>;;@ggnGvz||f7dn! z?e!#;*wCydb`gXeTpvD$PyFgqs{iCFWOx&9#N{e)bi7B&Gz-&qgQH;nA{ciH8|s=; z*$}<7cztHN<7rK6W4r1JXw^jxm~h@48cWupN-y@+&lKmk%axpsUG4ZyiyrgDtLNJl zT7Dm&&W<#dJ+Trx5F|ygp^7>!6AFLvf4?Yd+CI3@e)>#^bVc29+_R9_ zN<4?AR)oU#G}b?{M}CutUI+71kb|G@A9FbjGQ+nl9!~z`{6cb3@IUe=gds?_3B8e0 zK0=$R$%|I{6BOY>Mq_pO1>;Q9W}A~nrGgQ3!|!kj7h(YUjXid)PeJPBUt^6#jFPA$DS?HA;sxWrI*27^?f<3PE3cNbArS==+ds?yn}553^19c?bNlm@+yidm?>Pkk1=?Cr4x`oss9ak01ijohzgBe)aFin&k!cLH?4x#;tTAC=Z zF8Kh~VyXVWJF~DrAIGb6e^{O%*{h%feSP%-C&taTr7Uap$59_?%Dn5s=?A;fYy2rW zMunn(_47;pivdX-7vZwSN(NAOEbrT9IJ@3C6A48 zjYUta*yvLbZnoiNZr>!$#m#HQOg@Hiw~gAL_OWtc*ZtCdUXXb&(yjQZUtHsx3@z*T z6FB*-V}9$Ng6XLIhC%Ey!#<F{SARvpS9yX>t+Pt%%?rvNTBh`S!HX@_6qa zgM^GylrfI!+1a$G;m-!um#G~?$EQzD@iq8UJW@6xLBD2UFJQv7!jJT^Hc5}&9@8tH z0}Ll`RQSDCFcLTn2E<+4Ryy%h)`CZ*$(Bc=34TXXsA@J^BE`iQ9wF@2&S_=nT z`2%VtWChnTGD+KEf=I=lds+1nD-#(Ys4wA{4a$v9*s~NC-3(gxS9EcgzZR0OdyQ$I zU&{n1y}H}%L0~tAlq404_GlU|?*-6W;(GgQb}cgt8S40PVCR;H&k#2grK;?KSW&Uj zig*C!IH70@^#BLIyz*tdti@W8YcHm&HMMBkJzVYs7{+YR%MR&T7Vh~LtG}SqEJAQo~^Lx{CCx5AzFCh4=q1lh5XT!|A%?F zswm1vo7OJL=XWFQT9(KQcEV!g-VTY938-zwMRFjn^-m9D`+1kqehP{iNl<5rv0XON zK&?%?JH%~!v291O{acpHG34$zTbySS`U*Jq#M6^sqcAy(q5*YbHglXg00`-2OznTXr8rx(& zb7+O3Fd=D}o__kJavKmMfsv7s;%@uf-YdBZ4y3ZksF!SN%Oe`SjGeoxP;s6+X|-wI z$O`#W5NS?s;Sgl7Ls8530u8c+L#sgNsOhUYo#{D-Am z?-is9@D#;p5xYmrSu46C%L=`j3s}A(j;3}cT!mr`S44%N8nY=E@;_Ok+G)%ACa^}q z()t`0)p*kZOg>@b5N%9_M%Y-hQ)NL}8TpHO(-+a>bN-Ve4Jt)h)bb4FIp&o>N3xoL0ewOl# z{DdIV(IEkHs=vZy;IL@lM!FTU0=Ze{Oid$;a`lvr2U(WK3vB1Gv{s+)%$of@HZLar zHlDNH7I|wNjl61ySdnEk125drMJ#280zwA1FW&^Z2$Vm1GP`WY$yQ?id{pdT_Wuo9 zYd1J|3f;A0hW4SF{~5k&Sx5s!DWeN6)KUj-#|Mv>?ei%XQeoda9e6Zyh7tur=evw# zqpAoRkTTL>JXxr>;->+=x|dAq^`m{FF0f-+=vvexS2^?y3l)Es&!KgubU5`zX4{yn zI4RAp{q0En36&-+sI=1j8GHV?N{VG^2!3&ykFj`ZsSB$S#p4;~qfBwvy8Ai(kLFBN zexj!V{Z}LWd9Ql57YvX>9`2DEJvHqqBq%6I?SEF2FQxTchL=^Lax}F;ap=Kq zFlX36GS6l`0Fw3vGQWlBzY5`>`rf}DSz0jn5kOq+E|8t(23Zq-j6V3g#lfomRgF+! zyt<2u%0%C7<`KkbY*(_wIu%nT%1>Rr-FoP$)%4uxq4g;Kd%0LxT}El$^wovo_=C0} zTkmm!`VHjjm#rS?lTWdJ@0%HY7DK+xI<%cGo%LG@uiQ&HUk2o@D9x=+5D5>}vz>A+ znNR&xI8`VVHQ#u}VVp?2n9>?w_C?3T#c{qqxk11v$(XaF>;U)g_EQg_I)YmTm*Q`; z)U?ivE0L$EGwR%YMeblO8tvMimhaH$DnD)AXB+$5T7y2P?m-8#%Vma5rTx|FW|He} zL&cQ*zx45)fGp+J<}t;ZRCA!!`4`;GUM?P84*r06`W4Yb zF5N{1w;gBZ1XLRIvK>hI;zfSulJvO@7!^(xaivcfFS6)EZBiNYHqyQPG43Lfh>SL6 z;VM{mGgODxY+z*h$6r0C^HlMmJU;;=<&pW3%bx{FVdw26I`&?o=by{(!2Syl-)D^J z6k*%<9ysmFS7XG$D-TRK4OY=V*7dWHj!al7+WrQWbOxF)gdMu;r18@h9nrRqw6@nGXzy}%|I=R- z`Kj}tCi2i4ZFi!D2E7wgk@!nqBj<4nhgHsUTl#ZW)ajOiP5HGZZkNjv; zc!>t#it^MF-rK$;I+|Ukb6VpL?5wcxNpTqntI@}>w{V`Hx$N&QAjqbpe-XuEc^>x5 zMm000!|dC^TyIOAm0|`%3?e`&ea1gVa&r_r*EH;&0SjKs#YEKR=kq352pLqvWqSll zYj}-MSC#n;NS##SEtUDx1-up%sKy~1(f0FH;o0B5y$1}49oZ}II8ka^JT<$q=BkR~ zkV7yF6f*_RBJWAFcd&L}^(`ntd_qQ*gbLz8Hn|qm}^jO!}W{)pL*a;ytH-M-c!P!4sTXKx>|Wu#a4pEG(L$Uq zL=kiYgagCNsbQD3XOR#)1m*=Wb{#6cdY}wrzHtkLTWIa4YL@Mqt9GHK(^D((?(HZL zoJf)7^bUo|GZQ;4+0xZGo!gKdfK<$CEYB*eT(7j2201N6(#Vm7bsuLbPJubFEFcC( z9x);Ow=cH$-gKIqmCQH7Z2Uto78_c)`@-A8OZ{MistR$z1R$}Sh!NP}mt6VtdB~Dr z5C&vkesvDTUx7H;I*u#aWnw9SvtW@7R=)#lL!_sFesK^^9RYf0X06DK;x*U-y=C;Z zAgvUR>jCKx`>ppQ5j=$HlLr=ie1-~vD3*t?8%*YU%HQY|TT4**WBM@uAaGnB0Ve@d zVRKGlw~E?FOhwMtwz30!$T?Mrj$il2{@h8^+&z+w$slOiPUr4?uNd&oU+Vg&JWsw- zKsy}gf3`&RtpT&Ab##K8gb;ogMS|^d=3;Ty;-IW2UF>;W#IgfIbdn_+kcME4vcmk& zn@;nuFZ-VwGrGZ7DdTB2R8c>FuM#K%>#oIptD8jnOt&_j;I^)QDX{7eXaCpcFjzOqvMz> zxw5~jaduv{&^FCVaf+ReHdkdexfB#^GFI$7Qe^J9(Ayq0W)5Zf zk%Bp+nYRmt8Docx_9^^^{$XKs^JVP(e2Yoj&JGu^-(&JT0`aLY2VBe|Mj+r~2%Q7D z!9(G)T$G|NL^`xPEzXkH63Pt9zd~-ZoWCE7FwhqN9M&%et*+g zqXVorW8Cb>4c?iF2WHbZZqg^^jN#sgaP{Mu3jX)XdvKPq^l3M}n`%d(aBsCx_dA_@ zWj;GcBm4IJXx-@1b<>aDS40>+8Hu<~rjGwqNz!!eEz=nI5kzC@_4p{qx^9g3_MRob@`DT@e%?ypLNZgmKoUNWi(1yj%V_XBC!s-fM3}MUz1-Oi z2hnKNW0UwA>Y5MvifEZm&x3}VsT9HztvBJ2%lS>V{-=u94YO~!7;tKp3yQoOVGmoh z9%f&^Y&5{wIFU_9=J^6Fmr1tBpz$7^j;OX*@kGuqp56ATRm3Saz{*8c`RW3HMw#x7 zzq%9+`{TzBDJzqVR;WBtLVI)TgT;6VVm48Iwx}SwLh2|NHYDR-0^D9)#ym)Y{$|)& ztfO=MLUJ92uRy=-?KnoTk)Z-F*Bsb~;t%cwhEmUTkL`e)#!$oEzeMvH4pZ)4vunK3QISadWO!xw--5)>cUSfJA3D8kMuf3V z--QT+^&BoC?K=LIM<6$rzq_i0>{XUGEl}}>7q+a(2LM7|?Sh-ZOGl4Q$n>riY2Jrr zHw(s4zq#}tM{7e?#`UWS-xQ3tFk1A7L7z%=ODjS-yZ1c{Oo&SpiUzZ%;_2RvbVO;VHi@c2;p>%8nF`#z$M${kHOBND zpU&(>F*N@^c=}!R6s;r>PWCRoR3$h3XuK34PFq2s~E5)<`fh*1OE@&3j6X)rUPgI8=jI&yXG zR>Fcc={cV}+Zml-9`;vhJSeSvDs3*YX3KBy_lx=^NUyAKxUk3yB+}@bNLq`g7Cur{ zyD+*HxPz6USwQ(`k3t$JlusRo+P;NL(NQCJcj#L2m@|Z{Qb)9u&1uCP*!blNst~aP zQb40X7LzfOi+hkvqrUEjUrDT$!5xO)|2@|K>7N(5)#S`GL{St!NB22+#lCv?4lZ^A zFO~-?B;TV0w2K{Eu^)=r`v0+?68r>bHi^Cf4aVLW1{(#D%)OrQ^}63&{a^YSwdhpb z_fS^}i743h$AkH6KoVd9(crf<{*#~C&tQX;C$RT#g(o?pwdtF%Z;sj&F#zER00Cje z)&Ij!MiBZnHqjFXX>QKnnqDq~jvR%t`<$oN(J@(WxEp=1&Q92ZY(m>z57WKF1cY;8 zM^8Qa-}=eQs;ET~Xgr%w813MB0Ml2L=usrTU^nWHS%Yl?^U4^EDdUzRP?ELCme}7v z3ye45-mk^x9Qy6*y1@4A{g+rt^=$5rj*j!Oddk_6WUv(a)giGM3+-GXq5cV3N<7xq zpeNC%EWZPlT^<-w7jkjG41A(l@Mzyi27Ouh_ahBWA*!!8zQO4#XX9NsYln`TiQCLn zLp|FM+I+8&L0`xF-n3<2TL4}^vQW!mZNsQ&(Vp#?$gj#Mb|;SyjxlqCMFK`IWDcMv z*Pu17+41pszbPU8Sq|dwXu&^N zX^91AwJptiJb7DQ{>Y$Pi*@XBU|#ptM+K2-l>7?+a9Az$zJptSuy8+JKY{Qxz@ELU zM|cS-rm|{{?oaS;RK_~8PP_g>7h66zNdEllAJ#%&{S~q_8BC6=UC<%#>Yx%k&!Q@$ z^IMSL5m;Ro47_b60DsHeSD7e`8^{jW?O?N?qTP8hNg8uekPh~!y=k1G7jsj9PpV|X zE$t%YC#FUe;?*kB>mAggy1jQ^uu)OCQSi(gekY86_<@xh-_xFa`TKr*8ML8%L{Dd| zrPx#ABYnB~`ngp)e*Rg0@#=a4dOhQB>#A(DoeyU_l-XmO+^>HRDk#b9ssI5gW2WJs z^$fPA?hysC%``8rD*lI*$jRS<3cnxR5{$rv(TwG?>X22%{R604w8#zWeq`@&)5R#q zZVm-DQr>|LkZzwou604zmrosCdvX^hs#NsONPPmxfzhdfQq0Ac-@g}@9D^`hYpS_^ zvpMUkT>gP?J$s#|AKVg?c8bcRZYIvSeHax`$L75C9KLCbhuzOHj0G=}DN)i8`K0PT zQC<+&^|r=({!)p*J zE)3Zux0f#AUp=yf0+)>4dg%DHeovpr5=y4`{7}wspp@=M@dubkSl1hErTaI3`snd? z=KOmFfE2Iy#T+P7>#dXM8m2FO6E+9+R0zs{3`rFrv`NL7a6u#s#0%dkzgCEFX}^&) zno#rbhq2p1mC~jC@1;EKn-uf?U~Th_rnNiib4`+kuN58Q+;@@zYtU%P5p zPz;aKz+(9sYQvbbGVT}@KjJ%L$WZkQ%N>zVBB-$uukTb-5t-@Ta_QIBXxueF-G9fmfq*7?@-I?dV;w zWAvAL5rHQO)}K1+(F@_Er{4k9;L8?}Yr;Y}K4jCUVYr(1%!}cOGWQYh1{PbeFz$1J zJ*Es@;x%Q4E4qbD`v#m&`WQjgh?*S8PtJ*~P z$(F0U7%g08#}3iEUe)KzBE`EF#QAhV9*pq!+>P4Ga$+qGLu=9oTyILpc%pbBePHFh z+=QqMOwP;a#pgCCq74NakXrUJ$a6PHa)YPB=#Q&88*sByAXBl;CO2yG7|R>_{#1nD z(p)WPVu1sTmHW}{b6hS7?2~{<7jRzqmS-p*;SxJ4&5?l-v5oj*k`=d*7>_ZAY%@?aB?H5 zQZ8p9$*3RM>jAdM*Ka2MT$`%)iwiv>2z6If~o zuuT*7t|d)*9dO^%$lKHMI-3hy(RKusx!v{La6dL@v-5fS@SvD3?rO6oUCGaIOWZNg z9Y3sG--hgVeg+7RLP-g!6DO6nqx-@@s=gzJ=xj>|Q&T zl$*pl2IrfK_1A19y&8gK(JD^BX9zddk$)^@1IQFw=VUdPnt7$(76zlsBwwN)h)qb+ z^PzJZ#e?XtV+7>A>eb{Hce9W>r{8S{DO%0*TRjIXti@PWj4^$UXYP8Zy6py)w_|ovX(A40q@kI_-jziI-s!M;k;a3Y|dV~#GH`5w4+eG@i+H< zfJGBiUiku8Y>o{55gAdmh}40YrLGl&_@ylqmd|gI2xbf^1ADHU!}$Y?jo5M6w!S>z&H<2Z}rn;xX*V@Y2k2dnL5c!vSc! zU!+v4gD)(p0c0Tk1J=%ccn8~5yha;<;a1Uj8ZGPfLN{N4+v=v%bWBjOIn8k|VM4Vn z;80l=w@Fla>$gC#N&t3xvBglnJSM@`MQ>p&A4rc#c;hw6bfM#Hpak3Df$b=#l%lj6 z2WT@)O7ZqRSn?=nGgS&L%d|RK4wCEJQ6+QmLJ2!zB8 zV}A&}(Ms<2{b|prbn!|%9dS@hW|LQI+=Nqjji&bPkAwiENI!J19M)a1o?PAwK<{}q zwy9`X-IA^xS?K_62DgLSppRVVeX9p5Ig< zE1T?QN7<$sc$P}nywC7L-h#xI`*dVdkl}ehFzAA$VLasH@eBwIUo_rw7@M;R006t_ zVm#Q#P8b~$L(iyt)pj&+5{~wtzYE(}_cEL9V8J!c1QZY7cUuQqmhi!EWJ&kJH)_7o zTQ>o34d_dTgK1-IF;)-f1PLs~$LaCD)kYNGyq4}LYR^OYlFAL$-uTKb>OfdBrjAla z9Fbvz$oraaLD%JWqgBTvVC$`fm<|Mu*(i+qikfXljfXOpk`vVE9Pvc<-ZDRABaVjO zfbw|>r;CB1#`L~DU2K_ZhbseNrLu9n#$mdM_MlZhc{|Yt4=Xk&@R}{qeSFDHvHcO+LiAU}u!;WR*)f|I>r`2pYpQ@~TEFllY(aZ5`0ZX@Ib1Yag{NgYB z?vuS&t)))4GpSwdM3vhCn@MF(Hy0DskX8%do#;>lW$iP&AnyFQqsecEczwgKFV)Bu z&*R7qYh`iDm)H{frj4zC-Ylv!lO|yg^hWmX#OR-K+s(7oaJnKu5+#~=md;Q}1wUD9 z@9AA_1F_vU$BWdrdelHAf<>x^g~w-BMYMdFz1o>jH!^1J5`drXq}#rj+|}o)@@hO+ zf3xqCrInG{r=#Ukk+65NdC>*C7SqwM-q;HYG4tk&pWe`c!$Ek^*pl=4=TXZV-p$+5 zn4u`C;5G`2B>E#4h0E^22GO5*S}MO~_z3o(sY|748^u7GFsZnu+^!>!k-cJpKd#-Z zOSoqbDbVcs8stEB{$-#U0KPod!o+RlyXRo$to0=$y7CceHz?ojPw_0he!C|-5aBO8 z1vu(YzBIuq*%&$s%UVw#F2AOk`06qpOCuis$D2aoYNw44i5)xX-j=XcbZNx9R(8z= zs-g*XY>n72n*14l?1U#sge)h3i5Dl~b+WB1l;7F!Az)08ac|IUD?LNtVD5q9;mn=D z7&Q0!CJoP{+}Mf(pHOL5w06D^#VBzSCXk3!&>{ID5PIAU70?&m58i)Qhq_cD37RN+ zHo0Ifos%25UGs1$b*_(|FjmfPK%(v7fdRn7ESl0RTj9qJVf3s67cdxLqv3p5;?~_@ zZ*F<}bu16id+J=j%Cx;0%9l8p1E*``T;4lXI&1H|HP?*p`T&8!7{1%kh~Z3Af|b$B zzL$YwyXoA4C5wf7&My{?+I2NAIlpwZK9{oL8PsJ zJv4qd5m-__vflR7E6qnHR9zs(FI}R5uqBk8ChTim>PGYSR?!i zcYLuDKVg7x4;ThcYvMGDUv#M7LPyQBX^rfFW?-v&8$;Mg-VP#w122&2oUK!8JY{V% zUZ5ph&-T9YcZxpv;S^4+%6B!M&&mEB4UCMh7p#4HBW~y=U%MX&41o8uJi3XhCO5TV zHQ5uVNVmS8Q>@w@tA#hk%)A6^K3+W7;+UH-;o|68YKhII&h3}0#0iuF_(*o#5CBuNNbmV!}}!|gf=npoviTQ8r45oF%TIzb(b1MZ`r_^NmvH%pA0pD4BJ zIvc5VF$mb)WeB-Y8bmX%c%-TeDtX$UuQU`e3r(HkKT%d!kXUr zCE>lGhv^z;-qhy>aOAPzQXQT@17eMF;8g3sJW+w-sbKTVCXi;aD==eKtyi;xCLU{>g!YncObP5zH{f~X%JpC)R za|R5BTCHw#%om&%@E+sdc$%37H-3*TW{SfMu}giCI+n#-xcjp=zAnkB`?giq2@&fr z^RV?omY~L*CMcGFf-b(Tk$Uu%_;(;gi#qD>0X1^qQv(<^EaQ7Q;{D4YznNdgCkjx>JPwMl$5*AFbdeTwJ=uQ4z?II}eLs-%& zQY5RgD!VNS#dqhORD;%VS7f*_kDlq5NB6b5(baF`w$`;~H*$gDbdeBg{Lm4p0eSY$ zmSR#`pVbZ!J%w{=Aj;+?NZhDZ(>rAT%v-VrBDLP$jvh*b)xRJ1q0hTfwVdgOS(}iI zECW4+-=WyCU<$&0;8$+Tfix0^X4i<^Z1tiyRdI77vD+*pS>5TP!VWa>n3wd>39Tuw za1N0C9pCxrT2NcbV#xwrmZDe(Q5=xM)n z&OD@*z%_Sc%|`mtm<&<`rhQa zTgY@i*!_P>pu1xhZgwTTK&yqu*n_0gPut&tCEs1mezSV2qK%# zkw5rZ70HE0V&~W#xfkEMm&$&fdh3lhY_w{V6u7aK;>#n1<(3kz1`D(2lq|Z!rOeFA z%SGJXBb9t@g8I&EBIyd8PX9sG-OF zd*1#lZVT4B%3oux9s7E7KLu+-YtHe_%JupB3FQk4O&}rC)u*G>q|n2P^ATfkva?N- z*jazYtESca!zGYSI&Q6(Bc)_rmg2Z4>;p?q;u2#E4&}n$Q?<4RAJ30*hD2-0PX<{X z+Gv%5N-NIb0vw8(ej=_vF(^s-Fz=YS%?Szgu<|hfKzp3>^I4^?o_nm7LLoU_5Dw2< zA~@!{kAjPEsO>wcd;#ATw!Qsyd(Z{Q)8*5lhTOwfnVX|{38LA1fE`h*=O@4E^L-G| zGmKHvd7^1^DfWocSH9DmNUR;*{(jd7?X!|t!Gs}GU3t>a{A<@Cn#9=ID|dE1at*?~ z;36#P6j-HrYX~UV)??DGu7J%ZaZ0mwHj0;pzW3Pd-FKAL+RAfi$bOBVdyrV*2Hb>L zdsbtK7-n0d)R%JS7LfC4QupANjUsI>QM7!!E8Qi@8*{lad_eNiqzo2Gq<$jKhRyf9 z@iaUPmEb&n4wseHXE-+~vPU)*oKqQ-c;zV2XJ+2k?a%SJb{QYY*Z9~FAF zd9}7m`c2B!X+5#M67YEP^h!#{Ang9&^Qku4y-Ma13zb-aKM&UK>#=QiTW zC>sUDu8mN%&+2lJ=lhG0kbthcGI_X?)eCPCyX(`hg9pqLADkX`k_#F;Z*1M;_FVSs z0h{Uj$8H;?<_#XdY>{orHjJygQ2}1KuQ2>l)ZPd7FD23@s#LTT6|(mrdu2n}iC2H0 zh)@TR zP|m*e->;Kv)gK&;66?^n9CFWnofca_lE^Y4lo}fwcE37*$&j__5~4M!tJp<;Q&@w+ z+asN@b?UzO<+BnVmOOX*cBwqMJT7}D`Rx>U#pz^YpL(|gLw=#oX=xP#Y9n_A>aq$h zKq?0ZXQ#7$d{iRs?2%-c^~Q;=tsKjTHGB@ZTA`y@l#ee?Tb8@5UhU0OoYx1aaQA1t5r5FD=9 zx$nT};o>#DZ9hM{czl;S^kVLVznP)QZgi%wK*PtUgX~IZ-l++R$P7fS91t;OogS`n zb@A}vm0VjZM_=={n5cfG)Y#_WkPYCSws4_`7KIz+@b*33G z^*-bvO}VC1!Ygf=w#yeREc!=#*GL}SO1SdOmu9p3pQl#vt3e&oZr@I+$2)l+ov>`C zl^eY|a8sb~yQIt|KPDz(7FZK7S15MR6#yxD7d43K1OGm>7H%vTi@4vDyUyXIlYHsQ zF&5dJSmN1OH}eoE=FZ>8VEB^`V!{4^e>u(p#6SN$eWRyeS)Z2dh8-a^!@SKtL+l zEcEVwIHWbyfmd_vXP(u7jCsygVi%v>f3HN;#NM8od%v~} zW=6Du1>}D@OX415&)`^VgWlBHO4y*1c-{-$mx%iDUFvVe}6# zVE~U2s>Zh~tyk88Yog-{mdATu=y>4GKrVbB*C!9)%Xm6HcAP9bsr%uiE=)TqisJ6m zp2%$bpC^E1?V$QGmw&pMpOXPh8{yhsjXEVKPlm=P`ntE(dXaQu+G7b!?^( zwXdT?Ua?@Ii)NxQ0nVdPR8(B5+Y@bLFT8qcx|lMPbZE_2@$#-Z5{7n>T3`tdwIQ|F z7pqjdEtU*^ud(hCGjY2e$jKh+A)!7nKG<o8X|+7v3<>$)4Hydb_$) zpDTs2A>6-Ko8Bo5Ex2Gve$h8|w*6seJm8Tip9c0&n1OzPQt5aXDZ6_d$#pNeuqe-et@u$18vZQMx2gp z6cSY#0R)ar`rluA26{lJVH@4{&P3^*$I-Jc3Ihu4A5SQR79V_ky8V0`()t9za{R3$ z*+R@zPnEiEsMN4~TaR(6CHjG%%(ubeR@dR#gFz|>-7f_>a3E`YKMPS5$ju_IxU5orzT2B*mrXWk!oHE^5wl*7sXsyp(do?mR`zOVW3$W{9lFo1t1Ts1z!opYS; zG+8wt3tbTdvK23~+!7i`J)@eo?zso6XiexAQ*D*WBWRx~tD#5dfv*bhwi1l_!M^wM zr_8S85L2h6A7xLzq@VLwVgGnMiko8H^;S~dNuvRq<26Znle7RDE$FiAauBX@-~gjlWabTpoQtb%*B- zr=c~m1>u88>qo#Fyd(v$9}^)Vv`sA7W+$JA@V&_aoSJg=qe<=SuG6?VaFi6GP=%K0 zIBZJE2P*bZd8^N>P@s-a-P6J(P8Y#N0Zn}###W>|4Yx>P2FtjHul`3eO8`n7Z$p>QQMR#f{#?3c<^JQ9c&ga&|gn~Cf}An zown#DIA%(1a&7F7Y-}@SmR^OdttI(dn!Cvi9_P>#K}{o67K?lmR+WL%ZWFaTTJwi- z9;p}dCcgI%ST1^yMjqZdjKX)S^3LfkNftT#jZc3zx4pXx+$z;;EU-_VsMREC zXR$ZHnNv?+InRhKeUp{dQPhv-s7f5(iE1RN@W|Sx>**y~?0H}A5;b@Dt|SVdc+ex0LRo zeI3dVB@pz~(;dlM{W66+Z0u4ZD;_&RBo3cr*L|dOk-A}@%kePw*dglz!BCm8W*0wB zqRtENN;fD_p>%O1yFj2%{AIQ{j$Y=PtfbpP>EjQ`Pn%9_)jV>BNW$429E2Py(??bW zef;!X$r8WA?DdOodOO~+={R0!yBf7E3zg38yg%wV%!-9}`Ej#M9V(`x*QQE1=WI-m zb&NZbO6SUqzXU1_tdnd{Etr^;Q5vgci*v1*_9PB9DBA8S{@m3aPtokj+k#YTdlbz` zG%Hz7l}`<=d;g>RGnMqDy!cpfhR4KAuRbNAv6O=_UBh9|lBS4-BxZVhq66O)i|Z~v ztH)G1(4wn&TUyNbtGuPn+s`bPaa)+#sFJ(Lor#0<>L9U}P-A^%Oz@CIh{NkF<@PfwUl$`@|@nfy=9w+wXD=Ho^Zsj&NbE(^D30|)yi!=HGK zf4(qz^>XR3WuPQkZp@(T%jZDh>v3Hzk&j2D{0$3t`B%8`T;M>^;1*xBCn~b}<+R_c zvUXi#`{u5~S)yh716p^%$Xtf0Q}2Ik?>fVp%GR|yIz$;ISO8%FgD4gtN)rL$oX|w1 zN^g;lw1`Lz#gUB^5k?{%f`AZOXdxg7#6iknC`umtDsF&57Xd4AI) z`qz_JmTyXkwR4OYjJ9OXd(-$MJ69N$Mym?UnFl~kmeEDEN_P29<#4&avuY8PikeO{oZ*6igyY&aBX8gU z-egvHBivZN{Jn(y9Zr^8SYvJ52g%{cfr+qr#cV+ zQvg0x+&BvBu!17~G`PshAy(_!r_I!PwBVEiTuv{vKc`bCE3~q*S>!Jr@<0twboLQ! zq0H=ihH`gx+q))J366ho#!yR_!}hw=1%?!coh)UkVJ^~m`T;%ivuigCJpC@l*3gv^ zlCXt7h3{Fw7P*z6+JqI*iVt`nPBBp)4}fd*e{8kl9EYN#A$U~LS;=-vnvl-~LFJYw zQA>ZE*)NKOEd&BTB4gYRp*G-Y`WMT!9PM(_SMy~D20glJS7Ux2L5&Hy3(S808Ri?A z{MBKf!T>&f0}+b@f)e@cKhQe@{Oxx{oja`4v%3u3CSaz@1mO=MpY?VCb z)(g7|oz={SZqLLbHY=_ss(47-%i+P9t_|YZaa-Tqu^o@Bxt*pBZ4d(Iq7H#EqzR0) z(Xrx69M^M?zC}yub5Nq1X0?%M`(-@idHb7vbn#UIXQIWtAwdRAi{RkL~>H`#}aL?;Y9Q)9lJiQ5nhM|nkM8Pe1Ej!#_zXonK{ zgQ|>>5IOzQf%L%ZVRlSsQ3@l%1h#MiA)5?Em{OCwxQrA#8H#3tXB!YStX9nG`9Nu! zhRG&R#kRgqblXC-tK zm!tRLVnf`7T8yPvgmB-4ixd5*bFE26>`sLdVrM|_F1qb3&L)Q%qpd_0!^q(pGFMD3 zjJ0iA`1x!^V1N|4_F1Lmuh+EeqS^B_zN2+dm9b=WM4#8-i>^31Zy(csHm;G(-%?MJ z1txrA9;{I%opPv9JArZ^S16$7Y)qNq0}60%nU-ti_%^Y>l5>!Z0IHy%dHFuC~1M%AS;M zCl5SN-)46IKJ%h#?bQDJLlD@LX3lo6+)}*w_c}TJ>0y1^cBRF;_V;z*t7p;%dD+sja=UG5)otC4NiOza+=if| z8S8_BaHxw9DAe#g)-co|l24!ply7)XWAq&{4DH=29G3#`HmGdQ7%`0Czu~SHzYYVv zIE}W3{lTxOK2|4@Pz`^m{15Or?du_)u<-ajbYKGI(DeU`^22{lL*oA}{f~ki9rCKJ z`#gTMkEc8}G$pHaxQ16PE^PT)L948z#l%_#^8V} z6rn?>vcs)d{qi-|UzC6cBvizj>#c*oNCENFwHK~nju8cyU=AfS2PhDj)V6N3Rw&C_ z03(Ury^Kz0*wWF~5{S1tB(!wn7n+LoeZ`kmDo+s*!N#F6Q8>S*vGMr3Id1q;94NdY z-+wc5hs9jaxHed*(@cRJgXv6xeAg76%#zyjBpG?_%s+#DdGwy(=k=HV%gVx;_CO|v z;>UO&1Q|LaUnBD_5cGG>1M!nDizOO{90DcUD`%+NZXqXN9T5ODfS_C5lo7fg%z40# zoWwCDrku8ydW(0D=cHirS#V;M91jonSZkb;_RfNFxVZ2;t-~OJ_1b!M@A4@@M6W)W z@FLc|q97b>Lu#ft@TOX6gynCP{~{F1LK;_ zPy>rB%_L@`{97-2`bW6s=HvwzsI9BEVm4&9?-Ow?nwzv`Ei96*LDHHv_rakYO*TF# zF81#jaQX|lJ!PKq+jz*|c{kJ^`m{6JxEpDoA)6OrBGV$YVV{F$;dJx2M@fU zJ-YXqw%14=iIwtfpeXvaRG9$y+U^yRVE%OT9A`^_;cVH{9#G zWl2yE(qk4g1q0t#k)OKuYr8IWgHm=Wk-h!?rfa8Y@tssFo_ExTQJFSVr-zJUZ|f}N z5=TPK)nU(LDG~akHkwwB_7SwaItn2W#aL+Y3BWVKau;Mr`FRZ7Lp?#;%#Ogx5~F!Ki+c)Latq)E8N*0 zth-VyQx!5ILDE_@?`aKSwa(Gw*VG7fYLmlmmO0ptZX@E^5SWW+TYX~)jgJUl^VOWN zY0X#4yH_F1?&V?XkLVprQn9SQZ3Xk)=+0Z4&=Qd}fTWO#15}e&Gb<6qL3OT2fJ=Zk zo1exF>PD`VHh)N6Z84wHMzfK^`kmsQ_R>FUZjBCK|(g`w@EN%A=%lI3Wv2J!a9rW0@a zc9FcL;lxY9_BmmbBpOl30CHUt)^XxbWcJm2JHn2nafox%cG}+Kq1_%x!OcDiVg5_e zILhSp=w0VbG}V$?x@2dw!4c ze5w4j9f`2jGugPk0;_)mH(MXNfE#<7wx(7h^D4uOcgN4OB%tm&l#?oa0i8a+yYkyS zh1b-^mq@e32`MWW=RPbOjA^W*Tf$`dI_enSF99eBnqB){i&q$$TAz*?;zN-h@|wb> zSC?1$o#o2iSsxASHA}}WU977GIfD^nUL2M2k#d&Xa=BIU%J723ySnmX@Al$RYzvde z-x+BQ)U?DTDf_@vp)Q(;_~}RCGFPd6E5KHRULRNr=ilbQlr;4-BW2sD`3wD7675vO z#eADAk@kpxrzF>vptEh4SB|hLE`E9o1*bN1^#EVUWX2VG zJ4o3cau)*5mE)&fBi6ISF71F%(C{zN6OoR&NMfNzScRHJ4IQU9l%WS=T%9)!bg-hG zpyZN^hn9#rQ!lf{d|)PY$(j9my$qyE5S=ZBL&U)ylu30Z6c>MWtj^Orl4N_aN%7-$ znFJH~{Ra8{DMWl`vHGcX>yeMHiX$Y3I{`ZS)KdO+tBvO%g(9|LPoP)_s18s#p|e z_VMI}x@p4b(l~jbUpV^dD`ACfl|6HsB6d;V#1}kf|98Qb+6s)DayfE@8@OseXgh7y ze4^gov5*PSHqVj|J^^vwQRsoBY{}AnBcdMrUaB}UJzev-#x-(4`p}E0+N#tV{d@?%be8q)Noj zGqCK%gW|~iyokK%7)pXWL?3yj>BHa$w8m}H*Vi&Y!{5zSu(94R!$-z4pm)zw!h%k0 zeSxsS24+iSeZ4b(()N!wGbh8Mykc-Q;dA6}Nvue9hh<&I<6ljCRE^DpT!<#>9CKpP zwMCqr_Mgs~fAN9CR-Hwja`MfW8?qw$w?C$w&ZPTiq940zzikXDo8rGNu$F_A%E=@A z)SRQPe0&;&PVbB=yN)!xk-fwGO#UVx<{&=%LA7IpAW&s%T#20$M_-=bfo1Gf?>g1Q zeX9HWzay1Ff1k^<4F5VUb(wuHtwDfobbNL%kXHPBMgbn+LOMoH40bA{=HW{dA7w|y zgUT+eUHs_+{xTsSV#O8>9&8QLHz!DpsP&GKVMF|WXiwEc9=a>4Ob&#k{piDj?_3Sd z`zHpb_Q}ZtdLS7&Nt92cGE(p{TYG-hr{6AQ?Pu*!R^((SV#F6aV0bV}5cCwHd>RKr zR}(*%^2n0b`PXv4Z6*xO*^ab&!%L!$ZjlwXQRAMR-=NsAp765!U}rvoh~H6ev*x<^ z4SeVP>S^+nzd$#vj6N5&y9AMxHko#>K4b@f8KJcl%kaiVxB6h|M`vS~qM2sh#ZPr1 zwcwm7xIG5x(QT`?wOj4bPbea(=n23&HqHT{WWjg>)FlLpcr6B7)A2SeAenz_Str zmiUYKkEMhq_zjZ)FNIl3goR0jf&Um#$A28u)kD-B9Mm1aW0rbIgC$7xa3r1>ejNA- z1OHftfyWZdumQ`G63Y_scmR&XkHddL973`jLK+;h#zH`H4&WDmD&+7dB=Jl_C* z55gn}!Ysir$OWD#o)P?CC3wOm;Bg>qpd@SnJRW2@sAq*ZWMzS)$Fjx_@;Vj@3kypu z2}&#_N-Ql)!X!$Ts^FY>+6RYsMN?`_fGQ$!x^~lKXG$+Me!UtH<9p}poo4mQ zF8;I|dJQZMeqVV{az4F-=vEPCc`hiDR4viDpkJExF6+b0`0#Y=3X#8KwZX`TH8uU} zi@f0MPcJ%idf_caPK5~p{#9`rev*J7-}e9gFPj02?VlUxEcdr6Vh`M>eyOZ`Jt&__ z+32~@V=z+G$|%;)D{Mbf_Jvz)*mGg!ix2By+15mBmts}fldDU2H$Wr3{i}-wyK=DS z_2|*E5ZP(CUHRG+R-QNeEGJg|7a0Kopc4$aWY*KH_~bNJ5%5ddnfG~^l z!*x5KCLlndc(Jyx&ip!$8MzO`^`#}2Y>syl_eiGSeEdjoU!8w>cFM;gb)WJi8cINL z{uxACv~;~p6ulU+LOEoD@PY8TZ;*E~gW51W3196U>>urC$D*1aPDqS1kqb#uyR7>_ z2nlY(&~4_H1s{b!v14;pH`g~c z@zWX4UITu~miM^gCMS&8g_2}#ehu51{Q}o-WsB@xV;P`34XfJx9BlbBI#HI@iV(Dh z*|X*F3zw3`B{?fsotK>rcfUyAT~^<&i&+WHrCiCaGAn>259)uzu9DI>T_qxTDxFUQ z>#$mT_^h%lt92BP)mKPyfxVJ#)5Nx$tqFmK^(my!57PRJGPyd72oKUQZ*37*#9*XBK z&IFyG{BY)@nc4p4gE9@#sxO5-V=bDz!As+=1^HzVv&tDMiY$m`TCp%}{Y&NY4d?T9 zG(AN}ON%2#_Wr1}ExLqCatNE^C82me>8>^UbMK5vW5D8WpQhi88*`qa?c`fg@7Gm{ zGG5=_@cqh=9uy%Z=)K&mXnh;%Qw{m`W@?_p&EuA#?x&QyFo_UVW+WgwyC+l#@$Oq& z{qX)Wd^RBaV$l9idQbuRx-Lvu7x@SEDz<0`RTFRRo&I*UVCMQ%s60R+(xSLIp7*4U z(slidJ~G4jYFFv&kR${Edg*&2SP3ap@|x}q8D0C=*`E;rpQMcT!X{Z~zP%z4I`O5e zi3E0nz@?D_x!KT#Ej9A?*o~FJ_BtdygXC3N$pD#Q=P4=r4Un#a=i?j@bj-e>4M|!M z!;8+0u8SwqVkb3PM|FDP*p$S%p_dfd;~yj(+^8^pbJLdyq09ug)A?yoK!s981u`2h zO#jnP1t3|V_gY7Jh%CgIYZcYNu`J{I?;;@sCf^(?uj;Oo9Ws-v=o;)``5Jbuyq@Dj zx@6r(a$j8F;$&TxY}beINJz^FMk^h^yq7xFkYGN&c%=0#SM)jDkNF-;?t8tA83s>} zEIkYZ@iTWZq5$>%l(vfxG1{AcSBNN8QM~eW((rgDj1}t=YYF>F4>CG3iv-rszZz;0 zY!ohy!z!W^?}A96u?H8Hm4A%kVc6Y7ZpS)2F2(lBd=}=#aU-N;2th9dweo_Tjxpoc zB5HWN36O^iZ$DXY)W>T~0k5&$&>+%R)gI$5mmX=-7rk$@8aO%e$e3|pX`8IGuj7Yx z9Aqg#gn)p*kO=1D#qFhP)%lUrr1Tnfw~2 z`HKbk-afCEN>u}j;{H>A>%kPEbRnC9XzKSs5$}4DPr#W zj^IK%Bq1=R zI1`Otw0qdQ8bNy_2vWuotZzY*Xgy@(mO*haMc8S-Mh!`{gQc zcjvBGf1@KHnDx1i6c2(^STf1-xw#wYf3jW0081UW zZHal|7e3f1iM$A0{P}ZZX!v)^*2P-+6s+Z1yhCz?w!O~DtkScFP-{gp;9uBFj$g6TIkKAB!j3Sykvpy+! zp+{%_=~d6BgVoP#6O><#lDRv-QIyPHy~(8vyc1^B9=sRNcJjL@tirDl43V;v#xLDp zKv4wIfs0GYyOmwJ#AP5n*2p|Ey`k9KMLdct5lXTdH;T>{&rwa5QYG569p-5 zPV$?-^8rWd2QGdcs!@evUI_TD`q;j&f7rozGfi_-pG{dUibbb1HK%~tqRz)G3x{-1A^^mv><+paK zM&>5hm=XDeC2+e)osU;Gf0~G3bkX^@n6O>^=TO|0M%Ay>9Ur|7jwuoTC8#8Qzqa-P z63WbZ#t2q&5uyGlhu-hxGYHXBh;EG`P#5X^fd4z%Fx3!>L7hiJ8nHJ3U-z63FgO_j zT#Z~8c8hYxPR4lJIV*@GB+f7d0zY{d#f_y_NaN~c!V-W}UZcj`w_9x%H~nw|4ZWri z1&RJJ4C*Om!fl7Ubh2}u?@61Q?1!!HlFE6pgIJ4|Uz+p9M&6F7H4e)DQo;*Et}E1g zlT{-c>5(6M9$!ef|I&VH=Wa!M&91RaIE+NA^$f-TXEqSHuu6uMW(Ye4sl_Ew9T zsq6)H5$q$Xb2pM^TE z{7LQBIjc{ny5SGIW;B4#NZ)><8oqf(CDR?xTey;v?V>g1A*s}u0#uLdKI z5#63~qeQxU5p^k@rc^<7h7+%#fW*968tfGPx-|B^& zj3mp9L|NjwJQ?ihTf*0yhhC}c(7SbtW|FAI%iVb+7i!%bQ{szSQ`dL8Yhu*!Hm1;W zVUMr%?P+5aH=;8+o77(Sjf_o3(9|R)(>jCOTi(tPvS6EjR_nsE=P(Ip4C<3)WVK88 zNBWQ%tgCTbX>=tO-*aXpDOyUt8S>Aut_tyL`X~Ta{p{%`Q#t+iiICQ~j^v$6M@Y^D7NTGwKh`Ou4571Q+7Ay>TV=s|-6<_2Rg4k?d{KBA5jV*UUr z)&KnHk-b2q@7<_++2#rY!Q0%}+=QXh7KaCm1%OT3%qGgM9_0HJ3q5T#{U@IsLOv?>caxY+u*= zuy^CysCx@1mV56l^Xrlvd#Rqp#)b1ZSzV*K*e6f!7@E}^j^yi6>R!C0ZkY zFAog;G4-{6MqNRt<||a(FQ!YIw#*>UaSPo$b6&p>AqG{gqlrw~Cu$ zGE!lSrSzq|qU*r>EgPhNQ6=^Eo$LEEVho;3t&Sh9DhaV4sx~m~6OX2Usy9hVH1k;{ zaSx>PiNt9zyD9gutl+tov@b3G9$j4+?7{l@aZpZ+8lcNCChpH=+q$+5+OE?FhSAsi z?<+UH+``SVy$W%Yfb5AvXGGVkGq1!$wE?57AMZYtB&n>}axBZ3_mdu4;)NYN`+LnO+2^SrPny?SXaEP`%0=t+h%7t zPw5Vc4YIz)l*Qi>NM=vt=M-g&hi)P$U;ZDATd2Omif z?jDRWd~zp%W_egO&ZXeI22KX*y!B&+fXi*d(d@O&IzW zi7SL;9o!HTv(v2hx)Ud9tp0r>E);viaCEvQym!OeGxs4Uz>e6t=<$j&$RlYcc-#z% z89wD@v?oG?Nx||-8KvJem0St24a@MiEl%I=dyZwtj0T8Ao$*eQ9L(XRI3E)^a*!n)!lbeZ}%bYh~-xlB%_~ z3wY6Wj)ZOY6LjuU{d6L=O8>kpo|>9pNKQFWxNv{iE?nPlu76*!NAu0OYUhsyyJz4< z8Lhp~9_w$Og55I@?7yTKVt5hX8A~LBut>05sNz&G0k=6t0 z?mkAPl^B#)cKMxk{_ka9`)sV&e?0M&|=dP6%8U!M*=@7*U2%(W#C zQ4{>ms+#nSwidnkrc}|II(2N5|LkUl$yne%9OvIne+BK-{oYV<(>2D*Jj6>pS%L=h z$jc96KVwZkUACV>G$m8qmo0o7hP1vi>p7(dFCvy_*)(>%Qf&n23iSAE_4yhBjUO@Y zA})5$Qmh8-PSmK|CKXOr9c;=ylwO; zTVrtCpDl1P?3b3C8;gg`%?v17n^?Kn?iQbE`a+$P8qAE)MHTwD(Va~GQWDr^xL*Wc zoriIW=}i-lb+TmN0=}u;do}x(($F|=l&toX9uWArAqR%?Hc}J9%>`n(T}AC1oUOZl z(W8>@=2fjN6}AS?m`J(tv)&m|xmf;Nxb5F2oSdQh;vdg_`~K<$`nIXz#v_Im#*cY0 zt}{HuD4POWxNuamKcs@AailtKNVa)~9#_Iu_9mCdLTAO7s3z+cgEc7MxB#d9mq1M9 zm$X_pYLn8Ao7Kq2;fogcOr(&L9z7ZR9i*xZg9qd`+cWJ2RmHI4ycDsFy|79D;cOT0 znR^PUH?~|y-lxAl@6t_ok>Y!m@(ekK0_J`S^&M|yJLH-;xUqLnhM?&7HCaZ}$H5L+ z&$*`)G}+tJmy|Eyp-c}r|M^Ow)9`IBBMDmr*{LiWk8rI$pLPX6*y9$;h>=N1x)N!V zHei}~_vVO;b;zUDl=)j^%drnO=#zKmQ)uH~j=wnn_|~~M@HFNT1oY$L6=CL+Ix$6?3GXF za^b>cSX+^G3+%3 zRfYFUvV|PA%(l1UyU)+?#a?**Yq>*a&r130g{Bdr66`&(d9#e*1h3H0D;`CGZD4}f zjR!7{;%iqg;@}T&Y_iF2&YyyQVRhU)t9cEE;hp?;$rAR?zWb~AEyVti# zb9c4vEs8uoPui~XcZojQl^$wxHj{+ZfFWs}`@z)*A3{f}lm)Fk=?8fb11frk&beY> zuKBsKpBp*(Zc!CJtI2ga%{H-<`RZ?=7kSje7a8?gyZY_vBpes^j6!F2V|za`-ZV*e zLRnYQ(Yll><59OVa7(hY`uyM(Y)vt$Vrb)G+ETAg=)A1C`V1dgPkaw^{Lt>MRe!^z ze>ttmR+WH*^F7_w@UHrp&fDB}kEI_-1s>cFi1P{^5*Ripm8zor>=gbO$I6v`wTGc8 zFK{CK{W>Y^1J`Z@q@wEEfx-gEeY?nq{>|~P>wq6nT$%5-x$QY)-5x0+f6hk&nS@ro z0r^><45A%1iVQH{Z%w+RKP_G^4qS4{ullxLU1T81>z_a1xwF5pfv9h-QMf%5%5zbH|c<;G4-Qa6!d|7am)`lsRn_Z&%=nij#B$g(wKM{e)x5}dC4p>P9Zc?SyGy&uN~ z2N;!RUWkyU?uw&zv4&zweAkco-xXBZsu<+UBsA|0aB_|LHBC9tYA&<$btrSG!b#@F z@Z(jbsOxGY&cN7|8tbu_fZCky(oo+3@82Tb#s`l<> zI}fP?)2+d`?oR8{GNKoMv|V68PKqBTpqhJ8F#~4y)R>Q0z5pkukge@BRN^#qpAgQ% zg*A;u@YA6N~v6znU=eL%EZnC?&WQo^CF4W4`x12#JX_wjkgyU zntHYByEbj-Dimf5Q3Fqml68R=#Wy(XsgZKcL>ik5BI<$qC+n~j^_`~uQ@QQdy&Icv z_Sk#c)gLKsNUU>jkdHq+_1UW6#jTQ(-J#V>!hT+(`@d+wxR$lp1fTtoHsNtWeSkH+ zH-+Knf#k$;uE6p!X z)z%18YxO*(98_!wj!bm)db9hmlJteZw<^WcZQ}Y*!_?$Vh-BmdRM=@Q zB*XR-F`7TDuQQm;5t=W==+!QICRmreq2Xkg$PXeUZKI$2dh4)WO9D>C|Gi_C+^F6u zxFF#p@=XHR>6EIFpYQVhe77IV$Bz)jlM8D+Vq!jG21oiz$~xJ;a%qC2scHFVrQ80d zi@_#J`&x4&q@_Gv*@(7`vaf~{n*+k5*4g#k=vtRDAi z#e(o?LKVo-PApIiD-)LUH7uI)kiC=esFO(AQ-9bCMxVoNX;!T@ z;v%^7_9s_P8hJ10FwAv3R;}6W=H#9Jd*Tc5-Jjd3Bo2}OW?m~!;_k9jD$BU3As=ju zrg76N6W*nc)~~f`7yL?jY%5(~JM2w9iBd5AS$kiO=G{%b?_D?d!;A4RzZ5fJ?T*>5<;C7OS6Fg265PmnSz$YNhU=Zr zN*qFQv!VRaukf2ohG*c-r;kN63!n9JQcq4$27;%ve@;rfu6A>%i!Jsk=RK6op&~hp zD&5MG_3Yl=TsAQI;7NU2e} z4s-8+1X^NUbI!uw01?=?GXfVjo?j{Gmyf&_4It zE*FNY{%%=Z@zB35_wwi&9Iu*UTu8TjPsVu8z0)w$@?66vQ)Yxqr0 z{p~2t@Fd~({Tb1C=da%w|pqr{A`7S)NgLZ794fC0pPVK`*vZJgaiuDEaudNNSIIr)7rVl?zLzqvSW=(|`MK zoT95so6_vrHML;xrd56g?lBRM_zKc%hne=*;X*+5$+86gPnWsSXGsCkU6fIq<=UV&4Rkiu6 zba-d5NaoS(m`3r!O~X0*?LW@~=l}sElw+3NXM7;(H4mfoOag;&A>M*X)*LbGwUU2h zP%S5-c!+%-LpdA#tteQegSad4oIC2(WTMV|PmzCHwx5l1oiZ;%(G@e;(C@U`pO=19 z2<$ph8(x2xtN7{~-GN1ZaxfnBFu{`rN(trxYHJBkA$TaIRm>2X+TOb?bdG$^eIw*s zpY!t-<>mCAlJJt@y`ooc3lXkY!8nM3XIf=yMc`YmAqjS30Mxj_!kiDlj-&nMmw^C{9%+&1bVUA2r=2S?HO!L5U z)tvXU`#m2ewJ$2q^QHl?!Pbb zF6=uyEFtg5@5py2OQ;JO3?w ze(iM($D9xHnrWiwz;gv41f(V+v0lQA)kmI3<@dyegx<&_K_6xY=P+9;A2Zb#98=3j z`1WwFs@E$TI5TX7UZzwDG`lXf_^jt@S3r1r20qM9vCpRU&FhgIAof-Za5gt+hnKcearp{dKuQNZRHpQtDd_?fN?AHpgqnz=bKuUFQd?RSDGnPrx8W16y}5f*#}b5L=5o46r3Ht~eHvAJ*{PGJ*egY+R|{lD z-)+CRrP}HJ6N*`Ce`M>;zx&L+^USH$yoG+GHP7YCt>*TZ$7h0|DE=j6*%!-MHN%hW zObC2Fh6EZV^&a~2r9FlxnWm+MFh9Xm-cZ_l(EjDinMZZ2sqD&~2l~~%3^(!p)DlKmlcDi-3$?gi;@KLW<<{lVTi*G9Y%Ly*nT7Cy>l$Z*R-$6uM1F*$SNLzBYR&*Lo*83} zu!o}V=|+qE51H;j{_^xj(?1Jr2*MAf3SjTL2eWKDi;Sbfql$$RUjHPD)c2On&?LmL zG>LbwBK~*CE!f0;a0tb}honNB*ScguGjcSrt#W%w?lmOyv2jHP`2p5 zN%BY6zt_RGViOEu5V&iHJoCS7oj@8|I~5&8xqq1D2J?A-TNYAS8Ua3_A5THWjD`P4 z5Z5Pk%OFOV<$>jAV0!XLVS>pP=zQRR)^zp?Rzn3WB=Im2Mu!iRtWnJz%|G@2U z4O+;&2*{_=fx#yJt3&>mdRtrQ#j+^K%H#jge?C>D1hgES5q?vy{u_&aPjXf*T@Dr^ z_#84$gpX&xC%G+Qvuq@cyRQP95dDv(@V~?=_U>gxL4*?iqscf8dAJ@@?=9>FB;~}v zh`j*0DuS&1?*I(^!oGz&FXK}{TiVW>i|FN0IyVOYQ^nV*& ztojqUFgo3iCE?5e(0LA-!{fj|t~vhxt17@gch&*v{0Ddb7;mh4gkoI(|B!%B3&pq1 zUO;Qf{N;U(cO&&+6a1j=IWN|b>G5DG2{HnHeX(w~I_T@5n|3KzK~@etz^{HNkeUsc9_Hrln6aqTZAQk{@YSm7Pllt%Z3=5~(ZY zJM|25O83x53oLG($FzuzGialoxW~=oKz8{53_!QZFHxnXd6GpE!AR2%G2qVEB2L5% z0jrOaa4|_!EWZHRojCe`580w(_mwBp{cFe=8)7u!0)2ZeyM-3E$O(B9RK9V>|dLkWv3NjMWJ6S8u=oDkxY@ksRbh$!|79rV_7O10s5!tsNEoZpw@0y$X=4F?f7JEA zxL`sMOI?qHvJ0q@{6nhqJ;dJjfen&6Axwp&^D~<-$zNi75YRS7%NxvzEMw#qPy^dR zM+{sa@0i_kbAzi{BY4@=PAAf)5y8(M7D^K_gw z^noS^93By7ew?jA9xFnRSDzJolHEcNE9?}2g8xOv4!+8NCSB<)+?Y6>mi@#(>(8Wu zu?sS%Q?WnOC+j5mV^cciV^lcoyKH*U1kYvPi97wro}wDr0wG>S*esa(9mEYbHNrev zcEW$Ck-#5*eg|Csaju5-FQ(!ZC)v(f;`MUEQb3LHpLI|nC!ZUTP=C7Od--pH1UR|r zI|N&wpcdptd6s?QC;Ur{P|O)iwjjz7P}kCLn1?fZ6M`3{M1tDE@Fnn%Xhw1I3)EpsMpVBTG3pd_<-NHKz3g z8AE$7`<}SrL8MKz zb*KKh1PUEn0BED=YRdkiq|bpZ)6~kpf>Lv> zs{6BRG^pAF?Oe8?(*v}1$G-bQ2fy%Qp#3&Ojq6`?WOgv@GMfTRY7Heo!4HNS>%XpD z?vV6_SmpDeu58xv)BiOM5_p(ET^DS9g?gC>#Y$VxfByJlq)J*i=myUnNmxFM`xYD< zYP_0Ya8NfB){x!87%T1+f?_>33HC@PgjkR&E%7&jpp$=$tI;B2iVAfO9%O;|#ujv9 zhPLk5aqbG*JQ%+J0zT;Qf4Ky%vZfr+zJ0Mq{CFj5?7`o3KWe{#jK+mMA~F9Y>8t%0 zU(X>!`MfAH*Lr@^zgCd|`K3F=?}%hZP{!5spZ@DgaiCKciCZlHiDq+JqCbj^`ubMh ztsaVj4YLIitkBjSyW3qsm2)`H=@Wza_(V4^5Jd3L3PFeVbt5UQk@kiC#m{u~W8+i^ zOI(--iCB${@4&IrjOQ?%;t5@FFWc_Bg?Ky;4YNVwe|6DOT1u@vjlnQOXN> z0EDrJg{P3>pQ-@{7_=tmFHwHy z#pbY|)xz3eL*w@peuqK!Nc!;>6YY42Se%v|Nhve4FSw!b+gQVqf{!7#RJb}`3_#_8 zK$4Xb{_z*Mzr{Qh0kBYAFC&2o44(cYn*i1h4P@Cc@W1DE_z;~Ip~ZKF-+g9iFkSJry?q&LmQjPLjtdTcCkKcS!KmOI{U=^h&sMDnVv0b7NMhmf z<^I8mFmbp=?1Z}cTNVy)cnXYQrxUacNovB+*PL@Yi@Q{vV!DxN#;T{y$3ew}SON>> zGXIiK0?0|fd@A4HROTFLmjjm>21RZOfD#3%v@xKp;Kl-?TsgpJbRbF`t0?aA;b%S9 zB?7H;tHuyO=kgs|GF{lVG0W~~wTn9xU#;P9&tk!LknlRcLIgr+jgKEGdvyS@-d_#g0}!Uhwt7HR<{{)wFX~n+UHRf#JK92z-f3V(NdM5DkUvLFsDv zm;D!))@o2^aVbp))s|)@?ISZIdqZD(l0OP9Kt+9014rM`KvAdUfRo9{z^Cp5W4wyA zmWXgRGI>ifp9VJU3MD16BEZoio7+d@DB(r4$7JKoXERehGRSP04LOw36^>hHr4%Rc zBI3c!Edws(D?dhsvaPC#b~JHRblrE@S+U<)o-=<=p68vHEQrqcDxgR9YT=7L?1MLo z^4~wnDAHOW;@QaLtjQD_Sh0n59(>;JOW(yR7*UdvO90dwq|Uzmmi4 zl$4mUF^A>Vd1@Z8e+SMg?8`g`LxEPp`tU3&T}e6CN%F|e8a?C1eIY(-oJGL?wO|y1 z8`8Dgj9w4fOA#ZHOXWa(1XJ;R)ColER}h-iq&yf|9dlYaMwn3wyfy?&=SN+3*M@R?5S}U1Hhb^d? zeU(O!iev0Ux~skra1)KNTws-bKmo^38w2;8%BHK2IzXnmJgQvHhdJ!mkYB;zq{)Sm@b**Ytf26%C} zVzUjnr~85v?R>Hdm;o@N!@`77x2#7gVZ1D*z$^Tmfo;^3b&3e0<`$z&294*;6KL|6T z54<5A!thFZXEV}D#qs>b-xB)OT!|Yg#jEB6Akz?np($64gB^vRN8dnaLFdc6kbUH2 z!RGB-kp(NgKI}!*UN*O0f6R->^P9dK+eU;FSY=LzBo8OPVvv%&5He3Z>vrzQCVxhe z%t7aofGT^G34#)+Z}T&TOC4x=rSzw)E<`_ra1+2;-?qg4pukZeCp+2Bnqu$1t#9*D zgWHW1bboy8u`9B#1|~}Q6^oiPA;5%Vm)1Q@1+b@ank9PWy?WhOd7AkU`QMV5)1Lw$ z(sfENVx8!w1Xh_sA&CY-qIvW$)1+(|FRN{vnBx0A%*=PIZgo8^tPf zwq;AwSoOocNSL5m5RVKJ0=ogNxx0*BtaVas6XpR6D|{qt^n3n*i*@qJ5{*dHLtP=@13u_=GeW8O-JqYY?;1|Mg(mW>( zPS6dlQ9MpS_)VA)41wk;KUK?sU0U79p2XG~$&AH6=pzN6HRatVPt}aW6%QP(`-5FU(Haz0gNV(4PW2&^ z+4qcvdyn-1o79DmYbq&KE9sXW$&OI=x``j%{@$WM1iYOHX}ArEh@25p8!{?=)KTTk za2VFE#aw}6sL}Z@py6-C_V}NU^p2-F0;g#1ZeB`c@6UOvZY>0der=mN-u7KzyDfI7 z|6}`H24L9*Ma_*-{7nJ4s6l;08$t7^woOF? zR+1#E>YkMWX1RD3aOyK**_g16UwN^fM`LUR?|vkH%z{WKnc>9vT)#7U+&i%mJOwvC z4bNuyQ-Qqwde(!15*8wEXR{;q=UD(XLlu&_E-D4$V`Pg2J7C06)c3KoxI!~8wN1Jz znSvLG`iNi+Nb&cBa4=yLzOrLE9+NM`eBOYF9d+&_koS%EoU)Z?rfhOV(#sTon#mm@IqV=<|QFY-Ak3mw{f#$K$~X9ZXWs{R8}>K z5r90p;w_@5hY%9^(uSz2P`V$?FLCG!wXIZWegg0%!ewb?SDxFNU_Fdy{tbseJ_NDG zX&R`r3G3*SwODu-s?GBg+Ur#?yHh% zuQHzaehDX}20QF{GP{Ia2?E(YJ4%xE4q%@Sz=TV|cc+Jg8C<7a4tHX%p1{Zft%o6@A7PU-o74;Dk?BaiT|x zA0)fEd^8}^PONF{C|sixnV~pRGWP6j!1-PvhVYLKBGtnb!EkY!3Cnd{+H`?$OBx7> zq3qd`v`xr<{VBniEuUQRfWn0dVco~A(mNBx$g+rdk}PiK)GFFG6DYj zDN53_7_;(0@UpfXu=g}WP=NeM5ZQxIA?68T+9aKyF8lg7xD=|5P+o8ZN0uICQ*XP_ z;(}b-KtTl%bUp60hJYHfs-8n)Pu<{jB0kJeANm&ZI=L+64GwH48m`yMoJ__3T$@Zc zTp6$$^-xUb_USAFJJ5%kyOrOhqD{7; zYeX*c_toonHeJBvMQqgOPtW{;S6u1E3-*#vL)l^Mb6^VwUk7MYvE)KxV}5p`U)_TT zb+XyDvLsTaJ=Y|Q1Z|UskCBWLD$_VBe-!_fOkF+lm0;fv%E1LNzV`>;Y~Q`KZDdZ* z!AKz{OVYdcJ8h+PBLqY4vqgWDAXo#AOUAnBG0q_DD2X@r( zXo(ud=0P+&(TlY3>}T0vQZ&UN#_P7$ zl69GP9d!~3tr7Xd~g{h*jvkgu^j2@vL{!bu-r*a(}H_K zAg3=ia=p`Ohj*X>KJnm1JB3h(z$L#VO)U}zB6EJn!mTHvvDykgyXSatW!GJ$pwqq-UMpN z^SH~%GJ0^&=2{iy3S(~O#ZNbaH@9n#Af-2sN}e%W3n(#TcnX;Tvp4cfID6T8U;*av z<}m3DzDx*9@U~}~jUs)aN=6-_2y|LaonyqESu;9BYn1tQK&1aL=w8G-;7%gBkLX5g zWz=$=_MvXT8{`1+jb<RUy-jSg@pX56-8fSKr<}N=?Dx>)?ZI3v08V0JS@D5uTx%T2t|3 z_?A0p5hz^*P|^#TbL1=(f`X1LwY-iU;?mkYz;Fg5d6$ zpntyC)1M5DHB_N_qvvcBk2ujquug;a4%YtQ)0<6JM4AUJsU&%oYcnp(Tag~Mf#BW> zJ`|RWDZC4B9}3KWa!4y8Am7V_3^(b!e32B)2>lO}1@NBt;o2ndw_@NznHSM0o%ezG z2dI#Tk2)}PFqakNY5?;j46YRToc8xF8bb#m+&JNV!mr}TByNB0@EInP)u@*1$V#6eo?N6!E*7_{%!;HI-kFa^3EU6UaD2;8AGsdo=1+qgR~R)kFBi zHtHFEH+u&0qC*j(kyx#bQ=wb9(2{pahn$h!2d7@-)xG` z3@cLrV}F-D0^A5yO{?c%G)Y(-Z!QIeipR+rLFToFjB79@VK5CzHm2+n8@U8#%-c1g zB2Qx8#~$?*vYUV|7SNwT5yaz@i&xuAY?ZdcRELNRUK|Q+Ta@ymhuye`pb$_~V~5=u zt|I^A68ir6xi50nfhW`kgm}#Ot*9(2lnD_z%)K)f3Z5##XtRhhV|fnKt9*9K8zrq! zj936h&F*UNg1M$gwb+5E{btSKz;9tS3|T7pkP7o8q@^N(yP z&((7}5YI}1+x2+7=RfrzIOs!+RU6v!Eb8SEzn)X;s?&aMW}ZT8lBLXuEznjzo#iiX ze3B!Jqy@brSqd&?yX~`J8(C$&4LB0dO4A+@yFzq@an)v@8B0(ErWf$9EZ9iZDU+4B z^G8s^e1!;n1z&ni2&E1$iWcvuUK4_KTVj_5)HJ|Kw6rmd0@cH&=3a4B7eZqQZ&31< z9u)iY+bJ=Du<;(9Uyc;7V6;xc@8jW_=OmoHh`mcF2M|uO0T8z1-N4r;;{x+_U;B~x zD3dc|!$~WEzn@Py$@a8d!4;QMep^uvV1Z(g?@d^ehM3)Bw!__z=)T=IQd0VU0Pf2u zFtKH~9*!Oq;X2xe-y*=S` z=MaZk;&bmgvEnb+E5JTZGb!o@0Ah-K)vBshtI|FTnq=f) zcf|KAusZ)J58_o~XTZl)CQoo*nG%7Prg@+pPZZwFE0HLhfZxQgCG*LSdOtED1{Xjg z7FW9RS3SWmdJ^tA$EEp3$&kTzl7BQXIf~k%!B_t}Apw^CM$1sSm7AegPy_(_+D%5x z*2l#6f3SOIc+`9aCrr)yZu$%Q78N}F0*ml@^zy7Jku5)Jj>ZC

M~R>eMD`9rAr5 zdH+PbKe46(MjhJ}X)@<>H_pK3`!+lizw@=<1y@+%TD2uJ@8ENeal`jcju`;^2Z0RQ z|8|W(kb`xD_k&G-n?El7jUog*YAknys8~LH0sMh_-uNOoWn3hRa4n>0m)7UFIP|m3 zPK2e(3O$A2JNlEj!fMWrFR-N8?~0CKZ_N(qv1LtxMx<|zY{o+VIuQhKJsqu|k=fTO zofi!4_L)?90Mjx9`)fK%Jzo_?E=em@w*fKAns{)6q2wk#T*Ep30(=8hvTJi;w&Z%| zv=W!MdOkWPY_wJ5$yKQ-7pVJqXJXO+iOQff8k`Lx!27sOIx<{%9lEqJcyN187Q6wd z+t>FaVxs7?a8ebaWJ#TH-bi4dcFibJGu3m;zzG*SG5PKqUdON0M*CtPgG5QjxV<_| z%M>hU4uE7TprP2OCuh=X*4A0(_tJ+AvY-jH&6@`&%U4id#YN=|1uzGEz0j1dW0g$( z_g^yTo3h&B;8hVzprD^zMc*}5=C8-kIS3T?Jp9F3WLELfpHQq?sC@6f*~qBH>snoq zdc&Q#c^lm1Bgol(jmC3yvK8*6XAD^F*1GBRh;&ku}IdNP3c-85i1V8bKbIYmasaJoE9kXf|2;%MP|i=tH=YAdYNc8_s2z6{Sh z1N;Y#nR;2_wzHR*zBoCP)=DI z(?k}k2M`!BV=ko2Z?7pr!O&;ja;^}ZJ6F!YDD*eS`q!QAY~O|zJP-=$4n6>P$*f{E zbd*uzn;a?q!yCrU3wXaze={`*GP8hl5YK>1P2*T#XMSG|KnEvzniB>cOX(1mnmGMu ziI5sOkK2Fw2p6yNeW$Oq%ZDMs+rIZ-#PsysTngLAoI+n_Kqfg$aVJ)Fp|+Ukx;%s5 z!5Q}X~csaQmWJOCLG!0a7N{ASJ$*)$JZW+TKj?Uo`TP*XDdG7Rm zV(uxdb08Qp<%Zk8h_|ROAD^Dl6a472aOcGPGcH`xLkiQ_y}#J8?+Lfu}^#L=!rEV;K-5-CbT(E42udHZ@pjLR%++jzsbn?EX;RBCJcKmzu7q7{>!x{sdlxdJdXJGtn z|LtyIoV!4>lqYY>P#@TIT^h}mt^@%>MN126GEVN+0U0?)pQrR>X)emaH?D{wD@eiq zEd3v^2*w3-3iiG+oo}dvC1Nk5+NbE;V^u%l7-9e4E(>3^d#L3FOFX(ua}g0)ig$GJhfq`fsNkui zAijeW6lwI*`O6ck^l|RqV~48^AbH*UXKy>N?Erf{qzI&-1G3-9pyMW2Ib5`0#DZW2 zj2pxAmQ4ImD4w-?ZJ=UyS^je5YCHI2G~o|fAcWtb$*F9ne3mGiwL$`4 z^oNKH zUTk#4@8GjN6W8pwH~r>=m6$L&z}pVC=~P9JbXJ7(Vut^4rD+2-r5#4@Tx)bPIvxWY zlcC<>QF2=~I&g%dra)ptM$nQKGu-(=AYHmfJj4m)JWSiD=L2_wMCtazcZX&f>Rjf& z`fZB2SUMA&m_mTN8hT(rd}4j0e!Oo2iX}jPql$$0iTTHW*>_pv#b!W`8~utRk|Obz zA=qZTY*GPE+VOQ$l_-`1l@t^~5UQGv+jM=nov3&3ZA!wi!#{opqw7U)e4+bmE!?6>wixP*kFSk!dHMSAs@(&E7}e<^ z_Fy?dlhD-`gKZb|7l?C2H~x4njoc6Ge#1iajSaCmk=a{E6RtWSbiE^;oRz_?72G}V<_JH88GfL` z>bqYPPtZYAoTxb^HvD4i%h^H$g*%RMiO8Mg-DGpnHT(VIOWKf^?*>;VeZsogtNUru zka$qC{n{sI)c zQQCkV$n1zuq>{Z?D{oc#2xKR41-jDt6U{GVvlay(GbjBMSSici1%#oA7IrDBlYG0` zJ+$cRrKKgyL&V_)Tzc!DJFr{!JCewRyMg9N_EwzSR6sH_S%UXX50FE%E1N4v%fA-7 z#*5uRZ2lx_5Hmj}`0)!wsl($cOt~szB!u-3$Vw0ZGjl|;SuUx@#uZ-V{NtX~y^$XZ zITMn^r(#Nw;rS3YlC++LOlS%mmSyk6Vf6qu?j5DL2E{fyPRt4J>}~Jegktgi7avE) zgfi@8g_niCKql>##}-fM{y>fGFPCJA_C~sc+LsA1%N_b9z*o2( zLQ*=0zPIt=-$x}K*Acmp+rN_%wG7l`X{;Z9RB{~J`U38dDc|;jJU64!11r7q_(0sO z%@((8Lg@__B>OkqPFTR^$1og@!&2%DcqXOg4nHJm)kD`1P1>mCDzH?}NcS{x%eNb!LA4(6I@0oo9^(R`U!W%* zY!al|feBfGk3c1P=6`;38}@xV#UEn2D7D#9h|3A8GN(g$zFfS;c$$pu?gOKg$vQlG zGTGqEb;__XKHL%Y2;Jeb<#!I|kaiLmBzatz76qaFIK&T=r9s{9Tq>LZwa0H?!xiy& z%Dbb=F!&E&f;q9zK+va%K$PHL53O_#4Pgct;+knsyH$Q}y!%SsC_6h@)SF?>uRq6m z1HpuI9{&BE3R^8g&4}rJwK+NjveqX}uK1pqbJju^LY(HH$|}@K36leZ>hKtxXZ!El z5V95B!+OBQ)CPt7fB*W#Dz_4Nlf*h057MyX#kMJSBp)mc=ZF67))1A1e{kzEYZ1KI z6~E`1x$f6R_28-N$g4bq-O6S%DXkmg;G+DuktMAuuSK7h*qj?NM*kW1T|8*$6Lr)= z$|Xj`rPF(1TCgHavi$l5!RI<`iLFJxLYe5FWUE5|@xoi{geB)-ovhGgJK7Rb#y5~a zp?W`@?EP*2xsnYpr3*H{tWkcSo4i0uv-MAbCZLM`G(DxkD-bUS6P>7xW5|R=*s}BM zhzwN(*u(pL`*7y^FXdOnMbY#O?CqWFGhg45(wo2T3e1%q%G*v+hKyZCYX9wrNU@@A zd+tfL4MXjT>lp_@HrpJm$yG+DS~uTxvGtq(2SE8qmT=ykDw<)5iY>D;+e9SIXReSU zfzy<%@OMwuQi#mBNAyJCg7N?u)VqmOx>K4k{+)qfIL(vxE|tL$bwN&gT?g_4>a;W% znbgyeBHmLNLoSOPh$p%h(b}rWZ+V3|CDSkWo=itrng54`6lHE3R{&)kKIg-nlk4A{ zW{tdpsvu&*d^+6#RP#^iukeliZltspU0+dfHY^`!e*dzapR#mXFirzYsp>Q8H0Zut%`llFLz} ztibfs*MDDK|6AGsJ^l2lop0ifoIO&+i+9Icscn?D#|C#Aoi;U5?=hf8PG%P1Dsn16q+qGtN@E)z2RgT0qA3$`g`n+ZjkpRUA;!VFjcy!#*r=0f-KJR%A_ zzJawuNb~9An_P@b8a1+OIVK)&hVgLInEipZK^sNbW2J z@!vYr(A03JY3UGNuG-8Efig&9qN+OSqrV|HC`uWD%sP0%fe2=exm*vrNpVd#`&3xa zsDRQ{4|S4_e;G@}(&)tUx4?ikd-EFnMPz2_tjRJ(!6L?AHr?!CpRUnexl;cG57UbZ%ZE&0D0C6kWB&rFOjOk%9mH21FKVOZKvFsM5A8Jr z&|S?+YQT0KSDt#J)h2at@nA^!PiOU+aLyPf&3D>~s-Ud&bfp%W3arfbhbVmu!{Yl| zLVd!!c@6R>pr~_kDmkdo%WyMugbtrRC}09{z~V=+5%H`r)sTxpg6ZMZ8;T_EAx;MI zFT;t<8=XKp6!gqA0wP_cFO+RlVa?wMhr@-7AY4Xf5!{79HXIreSO3 zw{K{SNyWeYEA0K(;2;oZb@#uXe~5mHd*0co`*xS&4TL1?WvY5XJWHxBr)?@HK8KGi?@d+Zg722SdegbG_>sPY7E@$4{1;Z zO)y?J7M0MSqm*ALmg$9Eyl^Ky?xEg2G@T+lPw-bfp<M?-UP=8`KZ92LRYp5)Udg(dJ6*pceI1LMgGB zleLumQk9*(soLnNDl~;D4ZhT%m;>esG6(JTb~kz@N)vU_jY{l%!T$KAAT^dV21Px{ z+WBEQ`VjrN3Jo^}g%~H&!3NvIt!v2UE(nTVdWh&TK!Bo9d{4;GD~QAib1YH)G^d|QjY3fpN1z~hjyoVL4%mH~HL92}4eUM`ZTOE77ETL9 zHXj%ueWEj<;R)PQEq-e>R(^OyWa>(!kf;jE9`QVS%7S>C(cH?_6c}(#O$*Lxg8+4j z`0DhbP)H3}INjJ4cm$8JLA3B~oND27$RQ45lYC%p#O(CT*xPBdG<&C*BGBX15C#NV z9Hbu}mq)_Eq$6C@VuLSowsJ$ek_jOPG8cT5|NfmGN%KoOLV^_7t6m1;;vNjY65&*20RO5y8N0rk7VWZPU|iU{66c zhN>ipVB;_j7KZtrIrHetkuhVJR}$-{2vn{#>j~?NPdA~F!Z6mohi}LPx8rqhEyFHR zLmq8HE=WlDk2fHzv&@$%@Z6d2N2)Bry(^^AvMwBF1k#yd$G$DLr^weN&1OGBPm+P) zw0E@v4WEOK(#agF_AD*R^Zj8?o=)dL(47x9&3`h@ivPWq(u=-Z7}Jm<)(0WHxu#9o;=yW-`o)DWGFx2BKc)r;5HoO4C8FtQL zAHb+O^UrjLTO7AMOy7q@SHfy?Ix!TGf3i9jfW`F>oXyAnBQ9=1=R_7 zYW{AYH3q2(7w~k-fGEspox%Nx$n z;yUvfyF)0{WqH&7Qe=gZy#jajSw5SnCWW?4wuM zIsESWv;O!-jr|jFaWJIF)g;JYF6K3FaHt|)te}OVEDhmKJ%NUNcKguYx(94pGyv?) zz=S3|Skk#9ZR8h7yu>VJeeav+P$m_cP~MIpJhy_KlsK97(QULFq1c;gu7(!^X+fW!oRpd{RjJ*IQWaQS~N8BBf^vz}BA?NA7 z-mrl~LgA#}8IjuOIb_+JPg&@n1d(|MsTZh#%7}u5!Y4B&qT3S0l$P$7Pj-k&h0;F+ zOzw4CO?wV0Bg$~GxnPCtxc8S)Nvr`dR!mWDAn29x)(YosTY$l{@M6iNK*{lv1tUoB z+T?WS1hN6qdJUUZ$tf}E0>y-CaQ&&TvatDw4^HqM`R0J>zlEpg-uH%EH$t6a2~+t} zK-dHkX9qVwxKJ;8aE%tW3DnkrfUarHzJ&z>8pI z9yhA9E7XqfbY%$Z0J9?6Rx1cH#f(5xUu%-ba~B~{On(*rqnp9Cq5C)Pd{|IO*e8kR z&^(pKv{0@PPz6c`YKM!I&@75HS*QC&pk#*trEu0x(&&;UA1kx2Q^J9bj%1P6bQhw`qyvjWZHZy_w4)(E8_xvQsCS;H^9K)RO66$pntv(MXth7a57pGD<9YNG(1zNGnDQbWVM_kEk~LC6OPds`}%yH z<_)ML31PutSWBzAVKP+B*KzfqiUO}LU4kpJeN3`>UZ*4cfkZ`exOXN49!}&Bifonk;!h79Q=B0y_DUlD3xEtz3 zl_FE_ggWn}^bO@}C@e`^tikzr7WNSyMR3g(#?56QnyGaL=2_o?R^X<)6gMngh@q?Z z*kwWl-$h%0v-tY_A!*GCBtxR%#8nJD(4xsT>)?_o4K0|(RRzX9wLgPQMi=r70hi9> zWS2vDA(6LAwNawV!O!VhX=IYm#@6zlpvGGIYi8Ki2qAUC6J3PwAWG*)q_%kGuQpc-ErN6IA=*c2HfRl_&zj0;nYIQz|JdQ#NqEm*5rDxh(Rie zVoyS}NA-kp1wm0n9q<$-nvZ5$iLHBZLQWDG|9LnmCP{+NjiQwiQI~~BNuSN{UPzjcK?8w zjij}LyC~b-5otFKZPZyf8bSgJ?VJr|f13RBh8%ISJI+L8tnGGm6f$ivCz=KWG8}wW zb7{XHq(d(AewpnuAuril6tqXso}~8sGtLq&xN9nCZZluudt_X1oq$tsGj{Cn1PVl- ziPc1*83>#P3`al$Kd@n*T~EXLmai+(yP8=|-Nn7?@w}$EOCBMtz%51lFam7@h5x>P zL}8(oMj^9JKa~WkfZC^z)D2?D?J|f$c{?LZ=tfLH z;>yR59C?q7PT0xH5>DDoafm zJfKSTsLJRk$>twEauYHKG-T>w1$z2RMn`1Pa}pJDLeA#UMw(kJ0g%MkAJ1CeC4;*H zJoC=pVR1d^D9fm$soom7ex>26jJmrsT(PIXIsKec#Va06j|VFeDEwGMX=3{M``8>y zvcxGzOogQ`0+nsBH6a>@_n|F}%(QK|fw-zl{&+AugXqxM6NtJZ9>pX*2baFoMJKa< zAE+75!Wy$6O!$;+so0X*sLeyd|69zXUWK+7~ z{|eIV{jN@hL08n*>;egpS+m&g0ezK`6Tx{mP_bG1aa;oMyFk)c{1rx*W$uUKH0qizuN&y;z57q9aRr zxsj|ozBz(sN-Ti>hdxA;jjC=v>G^T2FDt1d?YXb;y@PsPPOGxMHZz}Z>SR0XO#0FO zF%_2fW;<_4_fu~1sBe<(*$xJY781L!@DM1QoOColRxX!`k7b^PiRxHg=vc~jY?~Xc z{yyMomI|T#JU^nWH78?a4XPC@A!4EPtfbfIj%ANtt-iqH4Q@4dumbDOJmU2Anf$r6 z&U4-#Hip9bXyowvVVyjc4U^Lxkq^LYCDOAZq{+8BPXc&Y0ccjU2Jq@ zcW`+Qmzho@ziqc%3!z!Ke*Zfzf$L!zR9nrg9 zJ<41{uiE3^Fx-3e4|(3qKh=%9x=lOO6B6N?5xbpD&-HJtpnOV>6am za=T`pK9o$b?@l9r^7-hP_oKnp$i1{XgEcUPw0@&}h*EA&UFO{9j&1{5UaqNkE%LF#yXT{0J2*Paf7_GT2WGNP&osIO zx>iMA_o9ElXY0%bloZgMMx^of8Bd^i~dWY4#-}cSUvAp7+t2-HcL*9BY5L z)vwHc@g%E`XL2pC-j;NTJax8d$h~Rqzk<40ZK5)VkG(g6GrL3sovC$nnJtuPC`L;wNs$?9nsT zT(v-L;mf?CB0Z1slf2~yc>1EeX&*iRKF-hjEP$x+*d{@s)#vb*+lbPglTCme*X!g{H z9Diq1pN_}F--Pg!#ZL#r;l1>e;o^U%)OBWG`8xvpbm$rW{&6w^{qNK};BovNasGF{ z-^qm$Kjr*%ir&dh8$am$@659QZz9E{j2nG_*Q~wOAACRb%pyU_W9_h_jclMis>~KM z;Ddm3%=gG1urtJ{O0uVU|B8XaInVw3PY@q_hhCE=nhK=AmARAtU;TmLg)}MHRKWU; z^KgRucmGfS5txC)?3w=m?IHcYsj-@PC6Qg}FytBOt!p7}{rHu1yjoQ!}6PZ@7fu(Zyr`p0m<+03vZ#=~`@ zViLCx1tiG5#BSHPO>8ev4-I=%7rg1(Qrv#A^+;u{rBL$t&%wHi?_qP-jMUQ+tC$BbY=(q?NZ85$omo)#VREpX)p-zcz5Se`0FtPd(2DGV{Py#3wm^ zypgJ$%gkifREhVoOaPeRw# zln}!UZL3C$@BDAy|925=-> zkE@@u`|5QM2~lg!#~yn|xe11~j)%88I@*>uc{UJIISC<#L9KwUq~1BVl?BiKYU7?< zCkZ>lDfar=2RSLISia37!#ZjA341~dze5jcf^fcL*t!7E^iL#?P3r;9JVhB9eHF$% zg~s@0J7Af`MHaBEP&(mqXV*G;)Y5`Y5W|hA{7*gM7ueDtedYI_-;nKf5#R=_(kD-T zgk$yVTbaY=NQpdZN4hj3OtZg9g=4(I5tA_NkN9U>(@u@trVHWju2=6AK90eL-DFLC zf{O7RLY6X?wsJdh3~~)G4yri8e-RzO7I>IU#rdn}!uRS{wcy;3s<0)J_kH!O=@+o3 zW98dZ`|EOhZgZ>S-ip26Nt#cG1s8uJ8`gIaKUu3Q_q!{MVNu-m)0&a|`hr_zQjL|? z_ay8X)uBf>uQtaV!V}|vk^9AxTY0S9m+TO2w0Ijp2@5v}{@kqfHVklHJCFZ_bDHZz zB%eOiSQb1{C%+Z~L(kn)J`_IhcG+qKnR%{2xR8|VKF)qFfrF373P8AI}*b-}0bAY{kgj{^YVX@B7p~nYiLtHGki0QEj?+1`mruFkCVL zs|lZS^;@rL;fT|LN00aHoEpmb}l9MLU_m;|8Jf5%}N!m znub?1=;LMuA!D;%v|of?9p5STdq4YD7_ZZo))}sTn%t^Ivzis8I5Bl%xtyEwOK2tQ zxzYwLx`jdic6H9Ge`Ja52x zC|B$)A(v!N3$1xn#2c};EELc3q|r>B{bJ}|^NYi*A#x6&mj3+S-e04Y4c`H*jV1Ko z0re@4)u=RPK+dCTYP}+Sx5Ez{{r(7f{yI(!9atc(^(mi2Zse#2&)-x@)2+Pw6==3+ z#a)~cyOsa=E1y5k@Q}aVS@})&irV*AZTU}?Iz`r_jg{0;ocRsHT)PC&6*K0a0-vuA zyN{IC;3*{SFN-(M*9R#4H78lEx%%!-;+sWs4bI?DY>iX$Yg0r&m$0 zv=^^Y)e~!1Pt%>JmeA`X% zCI-{sjA|ubfJ4~q524zOkmyM(7H@x982aV!;g84YHZ{+Hr>r?_2!>>r#}}oCT$3w@dczED=bn9eAv?(3GWFTSv2kpN2ATjzNPV+xinuHqi&FZ?6Y(5=S@{*2;= zQg@vKplB$|eKIdPH&3B%`!KrPuawsp9i$!wpO;Rs+o3tcIzI+aG*;bDNL?Qz`FQj* z^rDwuPW|LSe^tkwwS!3ApNnO8o7=MY9G3EB-|!zgIo2lIjt;}0w`5{JkH?Ecdgo?{ zRay#$l6iz?IBqSru#3C@UVU#SQC}i-SeWBhsK^NE@1jUT&oW3ubbhqAHQlceYE04j zSiUrVyinfPfJknk&-SaZoGzz-m-zJV?&I6Xt<@9Xswk|R96r>@fAsX3Nj+?N^pY?w zQL@^B!O`9EyI`h-#q)7Z)hC=m!sPB&pP?KF8F;J9$A0fvfvMDY3&I@mwF|pACh^+#F3dODt0o>;GZ;r}taO zSG(h+rExf`JgKU&2muqiSgdJQJXw1VwQZotfb?8aTl0Iu!6{bbH72U)7b_q#7`<=R zdolj7qOH!;eONi8l~H5#*z=BcLDo8V}TY}OK8vgIiDH{elwLqlXG#=87mzP@^%?& zJ+P5G-4X#%jJ6Pwl1%3p9xEfURQCwxXf@?7bs^Oy)e?(q!y*Z9)=E_RrL)SVibui6 ze)`DEir?gWJKmy@=lboN!J0VKRaGhgu&l5p*aO0!aHH&#-6s>9Jm&g2rS*f(EBg;p zlW+K!)E<{Qa2VInznU&EQG(9*XA6ISTb)~cH1ut~--~kjYED#7mH6Bk%x7z6)CMA3 zGNy+d$@@@Fx+e!kB)y7O(vfNYK|}W_C9H_CKX zi@(cT9!IvluIs7Ek_Q_d9F~NMh&`S91(Nrd@>wEj(5y;10Y$uDq;_*m9B%5itsCF77i(O!)T7)$-l2$(9#GM19owG({k69unK>79dNrZ^kx(CI z2vgS$5&!)qmO~5p_Ty|9-KX+#nLQTIO^5HEzg=FE;{=V2grb9-(bxLD9>UQ6Y;8M} zkY-!QG5cz-a7GC1qBO*#PYH3nSv9}>Qz(9sXF`=GuWz67p_X z5c^5&?b%dG&(@@!pCyup_STBkG+v{AAUa!Dgi_85hO6E{Pqa53O%bm|U_j9G) zOWlOdDgX(3wNEvySR~DV`1=9>%E(s7?`WxMxHs3zZYozEi^2EiNF;=gK*G0w)rmJ?;K81tBu7-`cZ*lw_tACwT_xS+mvo@bjeLp#Y z6Dj-WcG!2zMu8xIU*Nll-v_bG*##m4IT&EcKh(_8uSdgPFd;7k|0uxuSP4T!Ee9h3 zo|Eyo_(J7GYq)~A`Q;OLX8Qh+BX>lFbchvjv(8GeVTZ&6FV0>Aev+AIRr3ux7lX?% z@B+-1&{%WX6N@*MV!s)GF+tA82v>_&kJnqgF)*wfuD5u`kMqRH3%0t|t9)wq?ay5K z-|jp9@AX9ge`x=6M}LIZXSHd-*kNh0%&U0&!Wk+A)WqYt*ZHL#x zs|hTu=bJ}>)3>w&e>UmQ*zg?)k@nTR?e1H4f)Gt#BQYyKp0jl437FypFQHrWJIhBr zphlA~EK%kQ2zb$XsVDUh#Ud$*4WbUMO`n_R>sY zQsV|mNnVBtcJ*9yQr>%65(t9R(zCvb%RNDnCS}F5s_h~+yKBwyW0YjgCyM*-Vr0MT z+Pemxd+pLE9`{31=QyY(oqHG;ta^w8plxboh?&0h^qvoj@*|`e;=QR+X5wVv2$DzZE3lJff!Hdrh>A>z7~7^I)r%c@1|s)vCC5r+BY zlTxdT(jikX&dtG+20jl2@^-9r>V49b8+RlQScRBf=K_AUiAY-ax?U*xR-e^A%Bpm{ zzQ*Gy&)#zE+NEff`X!8=O#yZ|*&>Vq-L;ZspTfmJphk_h-X2V_ydO|>;V%kmf4*ng zdX8RAcj8D+NqKe0;-SRlBohEOiDDRCG!HdExAlO3n4L5rgodo zMMy#~YQu89&UN5<z0+@wl|0K$6G{oOM@629&2>RN@;Q}1(>vTO0`f=)L|7FhD(;_E0vGmmmGMMm|V9t z915<_lY}gZcn%6f$Ttfw_BLDWqeQz2{e#yv5SS=HCJt z&;v4XQ(`mbP(W+qQek$_*1S;Zb?5oq!u7Q0db?~-B8Q7+X!F?OkqlWppFVsF;7zqY zoRcPI@ ziFn<9p<}b07?s7}nsW0}he3rvjq+H@Aj`z|` zwuKKR1xz#O1Dt{)sW>7T8`f%FmwU*TBrkNW=oibhpkqd59|k2JnIV)r%=7<2#wIp1 z($9qwV?9ZRP%k+ z7aBcRuQE~nxQXn(&|XeJH<9LbFV9fS-NsKh92V$NZnOm0Z&KasN5Thc9?&nhE%dT+ z#3psoJO`2}20@hCda@~18{Gb?kdqOpDnvkpxeJXr?mMF^ZG0*rs?QmHJD}(aUdMYR7m97Sa(|W=969@C1QsnjI~&+ip@WhWQVnUj z#`*2VP3cap0jbbGi`jF-!V1|ggGa0P$W;slAlH5{+if^SS#;4x9C#N6iME-ItZ+uV zNswJ4%UZIeh{vPKDYIF^X-M;Z#o{r;-s4h6*K-Pm?}h~OT)f96)g-*ror*g5sWxU; z|JjbXc=@*}AwrMinn%$s)4!(dCbpb+N?My{Qb-a36`i4z@T@hVLxqkozVI`di6gx5qA15F8xijyUI2e>TDrJ|`7k02+ z2s3RYK2a47n5Qg5ohUIy_5<~hTixe}V z$0P1a|13|+J*rTL{LZ3HpwpqD72g@Q>(U_^66^x|c~z`ha%66o+9CC_!77UDxj8xV z_pFFqGHfKve#?6*K?@9wj(E=g6ox~J#aAjvEK}q9H=;RO%56u5qE$Md?MzQX7!0re zb~_uWaKrJ;xO%dPTgjrXrYzJUb$@5!b;g+#cLFBeKdWwYUU37RK0l_FqMM>3&OUn& u0JZ{WHWk>~|KWfC9}B1czs`x>Iu7a!WW#bkivSteGxueckp&3jfd2(A1Mi6d literal 0 HcmV?d00001 diff --git a/vignettes/deconvoluting-spectra-toluene_two-1.png b/vignettes/deconvoluting-spectra-toluene_two-1.png new file mode 100644 index 0000000000000000000000000000000000000000..9bc663b67ddf46a8ea5894bb81c742bea79aa525 GIT binary patch literal 37924 zcmdqJcU)6jw>FBEpi%+|NGFIO-9kq|NGQ@3>4JeRA|N2Wqq2ZNXo><-rKt2GQlv@{ zQIRH9dO(Ww7CPjvB(TrRe$Tz<`u8vKkRLj;joS&>;q zky(|37r<|&$*c$$2`?*YEASm94PJ_}l8%a!jspLuUz6~%*VK&Aw71u^2S0N(BfeUJ zM2RyA#0c}iR}}c4RTTJHY8BOQRa$CQ3V!0jnS^fL;;3RNO@DqID!P($PKOR3cH1s>i{&!Bq z@2}uHhcNXw{x=?vSERz1T7jfND)|0V!r0$A_}?H^a7_YjJaN=ZYOM)SMHG&zM$Tkp z!rX*EM?BuhyOEJ`lBvP3>v<&3R&N)xHoCt46-(xDM)ZP$sQ&R?+VTrMt5Gj3?L5U5 zxt(8^e3+oRCKL0C?R#3xDP6OcKGDn*B}!jI+1Acpe^oJC>*a9U-C$hmrO`s}ciCNE z`KYOUm7c6<-r5A*z%01DR$Ox*3;1{81r!bVFJ?GsO}vz_<7AJcPePB9eNqd693dOY zxDJq!IsW8SBqNi2K*L2wmU#7let3oeCOCmpgrP%ZxMHj4ihTHTKXtyo?^;XT+}838 z_FLDDrdQKA?;el2?i>gIzK_pBP0Gx7i)5N6B?@YMN`1vZ&Lh~MW_uh9<>;KqdQ}C0 z$KCH|(KEKwl=RpP-;-of7p>qMQ*T9MwzP9fSNLp(9Dv@a&9EBUQh`x>6&tc?5|KLl;61|B$t{ZM3hw-4T;=hg<-O`&yaE6 zqGiN}Ctnc}!ua*S0T{Q2%D#xO57&NlH(q?luIEpu=d--A=a*W~0RhGKnhxG;>1tVK z`xH`8?o;NgIt9hfkJOB<|Le7QNMxf1OTM%C&nu4{Fx9)D&=q)5g^kl+?0fW}G4HMi zz)qtaYb$p9pogx^zXRBrX=t&2svF8UZBUzSUnoKrmxDzZ%_J*#<6FU+ph>dhs zLja7H@Ny277&=*)&(@$xLu`+|zxLb-a1QT{8d$Dw8C6sGM((tISiFkB$fr+yk=GXWL+w$!>aUp18NLBT$A9W@28F7(;W;VtF19`p?{Ma$xZ4E6p32g_#uMv?~7brE0Tf@1Ph8Q%awy(^eM#YC`|Cao4q5i@S^jly$p!|3+O`%KMXn@VbRch%XEf(A*CAqBN_ z!+`YH$K;WH?(mJ*rwj`)Qi@^wRD%MSEX0h?VP;yA`^QBQ!2PnO92pbH7uRZIXCcMf z{z3Vppur{bg`gdSa+KE%LXIP*#6BZpA>3wSTi+_je^to{kt5cR!#yTsZ1N( zI|wJ5D}&leOZ)(FnCfD^c>Mj)9Nl)MO!j0-pmpftZ1>7AUHw;MU~gTgd>97mT6Y%R zwyp5e7#K?ZSpk!+*be;i^l2L|~*FbjN+vYx31vsRj@NILu zZ$wiKL~lE{a+;E=fZ4DF`^UdU--z$jt!paFuiom} zmZ7|1^z|Fp6I@?D`^+C4^ILR&Kzcp=D|a^;*-qkP$hxJ#$G7M$;}^Sys*pF^sr~9z zk%coOQ=-u2wufY7^1Pgit>~c?zrk}naszyb50MQFbjY5%b|mb#mrryDwbUd45E=U%4t~W2Znx=_+aREg=!wEG=>Q*jSAzJ_2`*lodpdF zHdZ!%O#Lg}>%QgXMXg}KIL-~rRgrPCwdH*%9mR}UpFN2#2 zoSrfSVR5WAS)#MpN~@iyD{+JsK z4X^(-(~?1MU|w};rPX&6m&4(Cf8ym^g`H3AW^cxne{iTKx{Uez;H{Q|el=y9_X2Ys{)^(&? zD`0|s0q)LC6nXc$$}XO89<_UB8f$0)zX9da;6y^@2CioIbHZ33KY;rAIINt3ozdxv z8YoZm@{yTCj%>&KX=d^8wlI90p;ZsNaS;YkfMLG1X=wzv;Cs_&V{~$ToTC)wNEU-I zyh;aWdd-S`S;bdF&B{{klXK~vLwFKl`aFXaVY)hD`gsA&d%nSrr`p3#r=^1+%}*hg z(U}l+?BFJ1Z2P9lsPzN2B9TdJULh$8J17irRnrH?AM0f1>x~sD&|t}Ekan~TsqT}q zy&J}#O?6#RZC5Cun2PfPirSTKgD433VT9lzGUsT`j2%*OG@5(D*zjeL;@r2Mk*2?9?DSuF&o_KA(BfS% zc_;p)fL2e7b(MjwhbLxHP%eui!p@fMrJj@S&KCAoYg&*VsM;ENBew7PpQ}6Cq~3Bn zD9GmiPLY-*G69PMCRdVbK6H0831zpt83ee0hF5Dj7lf=Xow9 zQlPB*ZsK_*hd6j!{JZyR=l@EokuYChCF~DO)vP-rRhWR72CCd-U zwu1%O{i=5UT+VEYTnLP@H>$bU@wBP)NmhqKFx4+^%khr0;6uti)hn}3J%c(qSwW~LuA$5ndYB)u#J=MyB_-@H&+o;|8+Aqr{|PM=PMGl@ zc!8}!J5h_V#ZSK}Ul`h4)sb*nzx6AP1$HKHuXm4{_oU*u!TK@noM4&n9WJRVcLHM_ zetlTH?0R<@^Qr!s?l-^KYTdkQ_LuTEYj0EXv7dBP;_FqKTurMir%PIATz^(Guf@ms zNM&mqr{CZHp6-tF!c6;;d&uIelumS$cJdcmyT!`x)2hrl-ZZA@?JWBnLND7^EMA#u z$Gqy@=UBG4IFk$c^K9zQv76@a*I)k{pEF6TP|D7CZ#)t_>bUn+h}Rlg!(`~|3s=Kc zi8+bC+Z%5Q*re2!%WVerhcSSe}Hxtaf0{hHQ_9@}|AGCR-J;O5G}jmWehK+O=CM?AO}x%hPDuM4>Q2EJ#f0>Y~xuWjbv z&$iSEP%T-jmE;dyEJG`7&eeD<+;bPmhRt|)I9YGTXr2}sJ3djd;PEW#)7-YJys^k@ zxBA$3^Gd|fvZ@CojFD+`(hxPV!j4se1OJJTGmmUB371k~EAu=Pv zLyhWZUa0&!_EIz*@=m-?_hDY~^W@N4g9&fiBe}{yVY$?M9C{nPUG%q4T72f||4Z!t z;I?V=?kwJUrFU4~j=^(gda#90&o4gv#TxmGlfy%q()WkomI$VMC0d48;@u3~O;f6T zMkR3`; z(Kj+Qa3F+c=y|^>z7$P?ypyPdKGgh~n}OH#bkx&TGR_deJWcVR^oZ)L9%$%6h~cLT z_}|)WHpmZ24hYUM=ukt&^@sbqOy&041w;&(3)KI7!sXwhs2Q(>Gi_k84gLObl=Upyv$}_=5%J{fdqd=^RM}L zy+nRfcMnTto&M7$a&lW=NHHt4O-t|0U=Q7xwh}O3q$?#mEr8MCIWK})E7fnisa6w1 z|MkjWO5(5qHoHq7&`vfx9(;>Psiw)`Xn-2-(8h&PZl$HirYk4i7F)Al>3<6eXevXA zeh8b=$rqC*PBD15CFgcTij9wBH*E`=U>Q9 z&E7B;N$VGJc@$^q|9tWKVC5prE9FTzMPd^ zyTcWuIuCT@szrV|I|e*Fqa2yQyw@;tB2@@B`x4M42poGlISB2zb347Is6E)p`)7rX zi!mK*d-s;!^BR`gv^OCB(w;>shz`Q++~Qi|g}*m&u*N^|eBQPjP!tSt#l65#4Jb@h zdaB*>;qbE4zq{E6!UcDk*RW+~?ThuuCC_SK0e)uhkLith_n+6Fs`l7mWLbyGRh9ZL zni&GuqD8Ghi#I2~CDD$B**#ojOK@fF>2#-Y%`fiDD7}I5)M_0;Yakn3j~B+dP_U+F5|ejMw)lS?<@F8O_jH;doQn)L_*%YUf)|px6Ku^>#3-BnxmhjyJE+; zsr8fYb!IGo$dtTX;s0sswAYmZxsokY^QM)GUP!Aw38 zoM|@Ahq|R;I^8<0?DL!B_6c*`itVke?5F1$u@he&Rd28V>1?!|F}K5C=`QnW#7g5Y zXTL{B;%~5?^BtkK#HM*p30_kK9#Yn*1KUL{_?!aX2S)FhX*UJxnnThMKo{+NaF(W{hRKYP z+KsFv1m(qOFbAaEs90$USr+`zf2!XewpexJp}`$0H|yeH?a}s#JFo$;iMh8vzGRjD zso`?4L=u}>@+AA&{#vB{dPDl8_!D;SDxYlv>qGL7l1gUr@oPJjmBUIs-}A2Jt^~=9 zyFKFjv(z+KnR;$ku59#fUB=B#8X4 zbl&r{TlF8j8WBp~^T+OHIqg8AhhH1FViB+*T0#-=z;>7a+h%1IC~XW_d5u-e_S72G zu&+dO4CTnw-kEtg9{j{Cu!E1~ahAI|CrZ3L-+SQ)K&(ZCbX!e6SKu`G8 zu#ayjAy&MDM6&eu3Z=SEb3K!gmEcXrdBOQ&qR`rQPc8e5TW@4jwXO@=sK&VfqJ=#~u_M`_THE$%I*~Q%h&2Hl)mQ*gzFoc){L1H& zZ6>kbB=$j_2xy##5nfa#rSO<^MGrY)U zuu{RFbzQt)u<$liw0A@X;W4{>tqi)+b5Y`=9)*^cZ0#gns-dC~p{%k6m7G=M^zOc{ z()$cS#ogci{aP&cb7}d^8}9aJg_hUWJ5#Kd;iVMv+cGu>EPdLZAM(Ct@Bz6wSJO_%WmB+aKBDhCfE4$sZ)1y`!#k zeCTdu|E=V{Un%KOz<=q%rdED&|2(ie)>}|LA5ts?hOZgxdzNFv{`f(QVu$LzKlT+6 zCCVBTU^_Jn&#W>m-6c$QTQP|ap$a%rRBr$mB;V)Zax#|bXRww9gv!tuFp%Aw-_zvl zN$$~74`}1$eu&vJ1Kt*Ldei0|?_*x&a)rMA63}1ZJK|&KNq+ahm{gK;A#jv}-3%u8C+oZl<3zf>>@ zkmJOpRte04|nrb(~nt`hVBzFJzk8S>~W%aLTNEbArd*JEP zUHhHy#3Llw#>?nzh`dH*^M&T56VG#Gg*rHEQ9 zg)bI_sxa4V z;w6Qdp1I#9u6bfMDN`nkI&$G5tG$1l_(DS$YwM1luhHisPwv9c9ozGLt!63rqANYx z-d|Ut!3ws8Oi)YFb7De1pbDp6Nwj8TyDeZot1^9e#9|foPPiK@2L>R(6EEX!*Gv3% z{qIGS)VVMXe{Y%sU8sjhcQ8{0IEHO2az>qnvNdPKDbHf-yGzRKjiT89F?w+%fMvP= z9^5cfm@guLywz;`HPcDIL&ZMS(($I3A$D5MZ&lE~m=?4z3`fB@oCw_!*A z*40y(;MP0~HA`$$t}y1N-gM`ih01s&Oz@h(g%`H+`D9R=pn3H1|JYV&;cRRI+r~7^ zXG+SgZm^3m9xtqa^;3~o*87MP~eT1|E=>F!b?kwHS>6LcgWh0!&^SELHAUy z)S5soRi;%Ogu^3j+9wzyrnHVY`nR9~xJS`?vr=ACIwWPNcDlbc+22GMw<z%*m%5r{D!DMH{Wrnslp#P#(@O*{!6vMUh#TI17hP|t0-3;!-yOuliqrxuhCvl86 z*Jb(U7PY&YX@V1uBvo=V@9~#4xnCBQM210d&w99RnnGO%dWY>jtE{^ivv}F>YbUXV ze`LgRS4$lKS64U+lchr5s4X|^MK9KU`Li&1k98W^6&UAO?R4`Z#+@a)58hk#VqDca zQ*we8In`SLHpD75*3cf@55I6P=*do1(qro<)`bt#%%wVMgMI72}>8 z$<3$1nun;3YnO(I=3ZPlhIOlgVp-$A9~2=r&C-cJL51<*G#EE6I7gdmPK~4Xboj^w=FQGrwspTw*JkpH z!TInPAn{4neaP>m=*-v zxK9>`GOq)grKq-meUSgmi$RA=dhka4606w$9@a8P*E2KuW@CuW!*tsbTAIY2Xaby& z$G1FMiIit%K$>K<+^oCb$%T2usmL+GeV!N?Qb13aUbXb+U`V}MhpVsesen(FTc<%H z8Jo)8|9CnC=89LE01evgL+(=__io+c=+p-4-ZcgiHfC3d0OWqCs1mW99qQ%1ItD31 z0F_PdyQku`0pEGHv(j&)oA9yE{XMq~4+1S|Ay#K6}ktUo5 zxnY#fsA8l^n~Fb^e8ssEqV#O-nhJQ75df*)51#ONSZ>(OF;n4=sm89CVm!f5kV~%p z+ox4fqHF!UzgHf8juCeNqKZlo*>I*R8+s_!NvPK)4lZJBxr&(j7+qOK=P<11y}-R{ zTH_=ebgs(euEY&sdnx(8uXA-|8=m2<9Lx^=VNMPc+_R?bqy(h*Mu`5caaHh8KOnNj z7K>vUwY?xvDshk-Td($wpMb-0JvcRM-v07jD^%h#CRgJ<` zKH5w6A1bnjo}4!<$VXgUh@mNXDWCoN5yv2o_>H~d8x(mjiP5zqVr_M9=Q-~b*O@!m71zHb!c7T$mZH$6eQqTwg-F2$HcNL zFiah%qR4^2@hDE7<9|NJ(y6uCz1YnH#n;kv2G=C6nrR>y~;CejFL{DaW~? zc;M9h&Sx3RZzH@-J_9s)EAO5Z-%FMuKlW_eBk@-@TOg#d(0~)xd0^%lkovMW93rt& za;g&#mUiN7-Q}X3ukE(vS=89J*5)zbN2|w<-yeT?2ft_3(_=zl=|k3wx|QaKJBcfFxX%8_s=%P;7ve(wGS zcK`M9<$sG?ipNMwL0ZK19Ea)U8tb4$ zACuhgLXf8>r(#3)i9pD|4JyG0#YOEW_5WYv{z)tz_q&%Gdg_3UAGSxK{N1^{a3&0C zn{@S67idx~n!OYOuK&LbdWZ3woSba*U%L}_SYq)w7aHs))q%Zd^7u zs72O)s7GHARL{N@?yIN4Nm|bEBvgFg=01xSfM#!4lt_c5`3Kh&(3AUC_b_I+k@&PEGh*kCUX3rb%D zRe0i%7P~?zprv<7_5ME7#+RhrwK)&s{l3)y4;Q6_+0`9#_7V$4K&;C?An&m1^lqRE&;EmrEH2CugQkOa!ajCoy`Vt~91_}pe}Vt* zK0&`e41oW0Ou6!BEj4(YQy>pZ+S;*dV2UxE&Mc%Sc{SHWg&|KYIzDJzP=++hXZQbQH89a69> zKPdnIDZc)XITJ-GdA(+L*uApg`yLRY*G)ynw;@H9i_DV0l{^ zzx8u?e)?M~7Z+*R$2PAg|1r#5dRgF$zrXO?y$W`ktqTU6nAz(<=&RFtjHtrXL^)Z& zc3yc)uHFx~OczGAT}J6#a!$p;_%MDKGKePyhBttl_7-HlmkP+BR@5-PA12nj3cwwr z#l_HK9cuq1uiGY{cX_1EyDzb-z;5b;on3^6<{&$Hn?*j_bc%ws9a3?}pl-z23%0Vu zD+T;UmWip=lbb;D!aB^<$C*su>N-?9y=vI+iXdiK+#U=?cjL}x`{9=XSu5R>-0J6G9)%I5Ap8J5(D~*~k&5 zhGBL<>3I^RM@N+2bM2Tc#D@Ap^gTbLsuvO-Ng5O+HIxz5AVUPo^Q*b-qg_?OjAAE9 z)^~-`n1cq%OSBiBVL4sOqv)}WaPHTEjQ5`UZu>t zr3_c?x%F2yyk7W<<$Ul+=)s>_^P$_vb5W3DP+DGR`>GD4)d4;uG+}isWD(niH@8lx ztkNtTdE>xQBNbZcQ^*VxBo-x8x2&&pz%XX}W)=s-G`UN#r~uTV{sYz~BRP>ZkH*V~ zxAl2GrbE!&U>^OMP=BUXwpo!w-H3?@IOV5Lf~~(xF+FzNWV})0)Z*ilRilX;NWU)yEHH_yt|KXzqFb19+ejt{V&- zT;HIm38aAP6UF=my*TP<(*}|${D2e0>XBCa;RUW%Nz`>1Ba*9{5$!Jtt3vsLhiL?l zfeXfxVZj|N5=*+fA0TL3%a);wd*i6Zm4q(&vByLK!eZ3P;Jw5?9XP~xR|@8`ca9t$ zcMYWjEiygIiLpO~h~V(Y4A3?24`+x?;kxrsCuAz<|HXJp9yxkLZZI%2T48 zM-9SH?r$KDAM;dO&J!P?on|Iz{DgR!;UepigXzH##^XeO11t1Qo5LK`eve<+V zR7$^cmry1`Yi;Ns9#e#S5W}*lCb-r71(vE_yB0H!e`V@=4#ay<{yMR#1wJqoyHKI6 z=goxwcp24322v@rkmba%ljMdf^!d`a_p!h0-L&O-l8Ft3Ec8v6rcs^xro5MhUpK-!T+51CkR?qK_agUq}iZII+jU zf?tQ*VUyPJc}I@`S<94}|ytHZUjbzp;!o^w=&jcWIS7OIp3w<~$oA#i1qo zC-@knsUI!wrY;F4igfLn65Dk*!5WvLb zbHRJb_t)`TURggYKQTvli-_GQLt(Rn@zHSbNygUVdmbFv^ZW3FW;~cl53QML=LC;x z4%GV;vb}G_io@y3P^{j+P5HbIHG4D{^III2`1D}bPaaIZO5xlTTu6cHM8}X$?Z-V1 z@}2H8q#fQ9$P9*52JffX=?KG`Scz$*4hK>97Fb$EpqjYZFa~U_c`YrL<(S_C22v9C zQw%s@=sf0YLHargi~nWs=b^%We}OkefH*FAM+sF(O@gIK2o$?R?8}1RCdDg()s*#< z@qFfSR_yG-*9U_itV4&G7S)UYjrM2WCc$gx;lv#BbSw>QmYCt*{a&ohVJCjSfO;eE z90}8!^mWz=Sqcea{>;&h*WXLV+nUv1<=%(&2J(a1RghYr&2Ay~ifc0ecI_#o7QCAb zM#8NkQy)%@8PQs3_Iu25K}HT#At{l45UlLG$oy7~xSM~ypvKrFNKH&~49fu;q{tzw zVGvHWhq?_vIB4GQSE2u*1WwF;5%HhSWrxkms*&c3RzgJZ5xh+rb;P&=Vur%L9yRE( zmg`uXh3e(+O%fj?9hndI8H|9sv3+N|ZUJr4wvh_^bQ4xp)k=vgwj|;-xL+oEnb};F799u&$vhK)nMVYt&0&F8(cs33xdI zuvFy_eq=aLiA!iMF);hMh5xluP_=BjbZKoHyyJ!d$OEAd+LV}$LLIH>-qIuKpMOWP z#z2vqmoYu=+s}|oZ$bCZ-&?Z#vBU|xN(SZ#LU9+m36#@SF9ts|R0aa^_VjqZunmi) z$mI-z$@)l=u*|0JY7rj>($jRF9?5$1JMugO6wH29X3jRMs&mKSLuK|2>e5WZG1x3Z z5&DJe4Xd&R6v|LvTkIZzmp0|!;#`ZO*@wQ^3)k{re$xet6GT%XV^KG$xQpT->sta} zg2s*IoRxr8;VKRC0Qs( zCW>)UhNeNeq8@W!t3t`Ep%7kTR~F2Lz(DDjL5Dm~`yDA51H~e6rtMol?(W{%50&6T zU}^VE3wWl=7hGhx2(|6;fA1_Q_O<=sUI2%SJ~Z3EE|cVG@zFy8*j44lsGfgOZz#Cc zHaB{%zd;RCT;?9TV4q$8<{8NcFU`COxdgR`VpV^BLtbU@rR)e#^5N>h9*tKe!B8CT zXGScfQkX^a9bKM;%LEHWbciU!pWmX)>focNvXaJBWE|bFFlkOWunCr+x~JbhF@m

=N;);KO4tPf-!**50)wJy@9XWvMW7*bgRR>W4V}wHz{e1<4Op z=6=Qc#Zni%No(q*iGeJBI+9Tm?9LLZCI-F)=6YD7yK3AGpk4Js@RFep5Sg5_z&T(V z>Dz2w^l_M6v>}@3BBEEy;3DQksnul*8RuWts!;@#>{p%t%zpMV2rkM%=vN-@KT@z+ zCfW;E;_t#GtV~;jcp3&~yH`c|FwStvAQHVP zPYQ=k=?gk?EvadOv5>%g@hSZD#2H-Hs( z7ENvp>iqNiI6*gSdT2}Jegq|4pF}ybhWr-2&~!&Iy%o&tmD7jhNja}YxB9VY@No_M zR0ZIe>iOVHM)PYFLf2AQ@Bf|tHJh;wuDGi5Jkz3wYH<=+NabykwH^?_I*)-_C84PR z3RskIYQd@slM4H$2orR8y%FzR{5d^A*5cu1BE;&RR&HPU$_Mr%Poe}cB63p88}g>F z7W-^#`D$x+Htvl#Fp+4LpXL4|fQg6(9=N16R`RZ;fVYSK{EE~|11m_cu+iC=74}p4 z%t@rg^|RB1yTt9CfACwBAB`s5m3Dv?%)JcQ#0wfQOkBpZ`pg3>2L(z=gEW7R61_l} zf)cenD4dR=VX{7oK)ot=u&&WGB~D=9S8_Svy|L$EVQS1$VW$opf@h}jIb?rbg; ztqAC7|h}RYxs@h4ZuzEL`39FxiD)WS}ez{l8 zxS~vI8h{h35xsuTMMDT`f)OqjF|J&OC2|n0@kGij+aI^aruS z3I*xUc&^AhEj1hhAtwx}@8`Yzg|MK-$LU`%%n%qIObM&eAit0jG=po$gqab*O74X_ z|M*@B-s|;TG>{-e?m$*$urMZ;Ck;+rmTEvveU&$~#S(+#4%0X)6-Ier4CC32@eo%* zXEX5%Kj4`fXK;~`J`g$V{bt0QvRLyw=h7#ThtUdDmc=h1XaidQd=24@vF~> zDSx}^F!#;^cBEZ*E7AoF>Hz|O2B($=b4gOm5-S>9yNVTsmfjI6_T!z7y!WL^*&tF> zd}dNq8jUI}*Hfm1tSezMW1Ie-FlVa>mwepC9oD=h71jcS32H&bTgbg?6X}Sie5vUC z+NoJ223ZE)X)%_YQa^P74snLG!O68LkZp5;07!VTA60q)EYw)N{ov&ZEAQJ6 z2wO}-SPW2RpKIQ*6Ei9eK?(yP?^Gc#W}*jGC_!M*R4o1y5&k;()7CgZ@H=KGAKY#< zFQ+JWe$_|p3JEBT5uI%KS=br%dpNC5e-><_1Z_SW(nY@&=>sN?;4>z(u9FEW66x~$ zT_uei$VH6!2}8P6kr$i!F-9_&sodoH4MDKkh~7@Bdr^%QciP6Wvkq0e%ybKsQHi9Wyn|?<%w$mhx3}RAP^#*18fc#tj`hoZ z5J9Hbm+i$x&TRa-L=vysiK5%EGctFlp0$_e+|yrxL$QAm7-gWt?&aPMm$YO$K@xHn z=YTy26o%O&vc`)U98aI*r!@1vHm~k^nuLKFPiY4Iawz6P+9bfz`5s}#>re)tWxqNQ zC|zVp!nt`p@hwCNJlF;)CDorWGz8R1-JG|b0Xa1*YY9`iA#EI|V6#nqQl@0^IFh_? zO<(t-fws7-RC{U?rYY=$$)z{!(^~kQohsaoXLG7hFM~2S-o6W%S3$spSdkkQChbRl?)^RP@+dX3M3G59pv@6#&8 z+`r+4SElstO7(9VF4*ihkfFzK;2ZWhcnNveHF{YiD;Uuj=)NO!5KQc}eRQe*;Gqt2 z98ZdvSNc}Z6GrlbPG$q()CQh2p$bK8CmoM~hOi{QRo`^s`w?u9oTrZi-R21#u`y<$ zD0LOiB#wnZgG5;Fe59isRz^X*10W~phE+V$7e^)=dqiH^|Mmrk&*<&xk#JdJT^$ zH&3U+zvMXuQzX4SL~aR^ykyE^(Oh8ccAX*gWX5|d-o8hnh2x%*0R(08#Vs?xO{bt< z7SLiyMqCpOg-||*oVB#&a?JbDlKwRB60}qq>^nVyoQO92;k`NJ4A!hYROCt`;t4ZF z=DLx@w&#~_#i_5Elc)(*YAb$>k%l#)WENEeo;TH^cf7XPh(&5xULXV1<}4?sju1iV zfAC>=NVO5Tm`i9|DWuZj_;sLK0XPcZzmWyJ;1Rm``e|NV$8$(OcxT@~E($8nJzYKq zV$chdNk=X?rL(_m|ty!lvaRh&D? zLAcdZ)qzP&KoGq590WFd3`QTufRx(lScvyv+7=`o2!i_%Vho?ppvVzX-U-E@Cx!!p zCtIxcNS-k^m0!{LaR6LjZ(7Ua4Ez>69IGI{`f4UXapL)_M2Vlr1g%t=w~!9EAXjnu zHC4e7liDd2W7w=K=#FckvtM8%q*KIn4eRh{sGlLeqaW^(U(2NHI5}jQZW~&t!U;Aw zLA#o>IOiJy7WK@yJqn^yun(vDX9hePWC6m&TKbxV`56cb2k0!z*7qC7|*tH1I(my zuz9tod#m~|Rm)0(1T^&_O)93RB^cEvKM4NF6NsX9gK+RL_|g7h@Rrr4rspg@H2x%%U$(ib0Mh>ftaYl%fz%!fYGOWp zmjQYT{BgAN?y{U)wgup-+q=kH1hmdvyt={#JJT#$3~6|qA&fak2yY+?phFg8Bd|4F z36<`6)7Hh-2FJy9ygS^Ql{n)g+(TF{(4ZUh(LuFbnYUst4EzB$H!zTZ)9%k>+fu|L z!}rz_4A^&yTXzBw_noiURn?HeSl5^8=}|}hx$JF-3Lq zy;_sjPMZkD(@*}K!2Mo{kTS`N2#>f^M^-BAg^A|91Lcr1w|1^ObA|9LQsBeJ%k2+p zcQ3$>^F3e~FJei#4or5{D!W5ZhdNeLzH$U0m$+8%>qF(dggv^Z=%Lb%)>pkHuV!19 zE{{E_UOZCsK7FCeDI;DE`!#brVt6`7HMlD=J#BevYDsArZGOM}S=-JNC93dK6LeU{ zg(16-zKWqy&cJnIgp1FsN`X}3#8V)xv2>~13lDb-)?&3Tg6C(TpT$DtYkK@RxEPyO zNvEg3z6TzyauwA8=;mR$`rM^FTD<)Aw}aJ!&w!zi8Vr35;DN7!yzT02$uE(ZMq(_s5pXjtHx;KV)H z8H4Z1E1~&PmHMu6vhF^7FGKAxF(CHq)e7uIG&TpZ+jVhDHyvU&W)kliJ?t_)U z0zKAE7b+eMIJ>8r6p;HST!I79`+;nn5;s0bI~UoP|A_oa!=s;H`gzwlF(ne5pkub% zjaS2a7ZkwXi!;>#s>Rb8I|^b5=??)UMTX|UN6wjXa+ptG1HO$=Pp19)KFNrj^hpwc znp|<_?Hdk2If{d_$bigL@`$_p-K=_*bqi>~wgv1yb;tyN>jZB7I0Tma|Frj(QBihL zps%^!H4bIz`_&px}J?L`6D`YOipycS6?tBj|((mh`oHVeq>B^bSJ zyrdCBn=0CG&j{CXkU8SUD+b(zhelASJeS<$OyhO}JnpPGOI#6o`-Z~lQ#1nka%e*^ z+78z7wLIhM_)*KYpHv3&pjhi+q08xxBSfkzb$rHmtd6%IiTl~sG@@REDtMW#ZT8^R~q4ERzXnV_su}w>&3M6^b zrnKPKq=7__?(_o#>)YaUlW9>zqtPYDPxZ9;dx<==ss_68rCp^8-_SRIVj{AqFx0_$ zv$Y;X2alsXf>#^#tC*;Ju6CZ7IVf-G`Lf#7J4$8@DFAi${Ms4~0tfWf*~5EBa?9_2 zuD()8H9ZB}xdDSqKof$4B8B18_!sA4y+nnq27<#|ceAy@>QLpp$JTTCcqUz1n44Uu zm#7>O$ih0X&en-H4ytwNPVOJ(HFxf6~P#_!|Lp&OK_KQfjVq|tLk@(3SDFW67i$Wn4a4XcFEk9hMa zsn=x~-q*l|v6rpn0{L@*dSQ?!jh^dwxIs&ngWRdlp@PWt@|88@q=cdAjc@K#6DMKC z;D9Iq%%lQdpF{7;qyU%b;yVblR&=5cJOuc&yG|Y&jQxB5BuBP4N&nAsWT~Md8iVG| z;+lU7$N-4D5}a4swD$yh(!!>>Bc|#Lc8E`LU@Zs3XM;QPKqfNy6-Yi-I?X|&{6O^x;MwQxOD?2h0bP_ISI$- z@RPKE?|;_Xf)1qyU1-;D{^BSP1OfdnQaC6K#z(8vl*LS7pV_RUEz9TlP^0dMT7G5> z*z_l0_zY`5i{b70?RNq1AQv-*6myxd&b`){&HrVRFSpUX{Bn~9-`XU)dO;~N`A-HY z9OL|-c}zA8r;=QY>SGk-!{8pRNu||=dBhhNhrVwk*5fBB-mv`#EQ9B2WL8>qPd8!&pMyXZ!NSWTvXzXG7F18$8n3e*th&fwb~^jg)38z|=eL1YQ~(f++HN4FqmreDqPKcu@jwkly8kMs|I+)(>#wyuKv%Chg+bUDb6;D4wC8rn*rurhev7jjVN%C6m7i707BQCBEb;TEn2QT)8evKoB{lj)E>`9nS1Uc4K z_WbZjnXjlUziKP|%QUh{^K^$&;6LPlcvdp7dBt!k_mjf5>9``N%)W`(1j#<_C&9;m z8bvtT&V7yg@3bgbM|B?I*~X>_#M-wz_U=R2#2#Pz305wQMP@?`6h?9!vi(gpAd5cR zq5rf3@`iZqPE*R{DK-O)ZweQUCVgMozJQ4g5)}L6_X3l?%T07|A+l7R?T^`h9Mpqt zHSEHKY5lwdax&-lb!?n|Df~ZV!+E^JIlKiXGMm_46)U&gCFLQzslJddLnAVgkxst# zecFEsO*f_*F1E+~?8RnH#4Rduv2-H8q&EK*UOBXb+%N9duKfce`&b^41RHeJnt&^R zdaj7J_!HMDdey`W>fRS6dY-rbZWei-^xyO_A40)w!uEACI`mxN3FWO~l9Rd*&x2Yy zJvJ5@VHPDO!iaxKM)EWFu#k>ZO7AZ^BPYusY>Z`N;zFA&C{He}C&__4vd13az%v6} z7!5b9EJ9=v9`%7=C=D_f{V&pj=j<43_V~q5^!3gKn6a!&pa?~w%Da+8lX67?~AA99}okOax59LLm1Dh}X0|i+y&l^$1t%r!1 ztTO>YcIA?i?t#^9K_ujj#X*+fY&oWS-#Xp;y}J+Ff=DT`IVF$+L6m?nEr{hG#`j1{ zJee`B)XS%S-9nEcjM1t7=m4$$2*O54_0&M`4a@kgdBSTv3v{9a+~x+Lqu8<5X7L6 zHvn1m@($@QpCfNC=Fvc)oimP(hEi4g+9Oy}C=*IvnD*>3+G(!Lm~Lt|3@%m;qzZz3 zPJCEFsDTD#A27fKhyaUD9Ag+a9)EiyMjg>J!h&^v2WjGrW2wIy0Q@2N=*FFrd4n@( zU8iL67ol!qU91?ZJyYUvbyASBhW9)t+w=$Woa%>X8Hu(ipyz>w6Ke1*&OzwHF(I60 z+#MYW#N7PL}@rkz1Je{?{T z7n!qD@>U{CJy!sTrr^15Z{8z({(AllGOWkJIhU7lm9s?_?aDyY@ZWa=dEgVussSqyfj#h~ehK$J06mGsq?yw%NsdW{6-&8!)i(p{k@u6MsH|#RZI0Mc+bJZbk*n zItYOjHoRjzAT<>7U^ptT?}s7%EGx$2!Z=eEEvQ)k*Wldo&LEN8H@U?9B6pgpnczzF z$Ah;c<26fSPzX0Qqc-5$;5eql!n(8$OX+>*Tikii?1NqsZ~hwf^zixiJqA85N!L z(g)7DBQ#8^8#51vXquhYSB1{|2l7P3J#whWN*znb>+^u23K_Z8zT$FGcN+P0$L;=V zO)zQaB)m!G&vjI%OP)5M9{Dl#XpZ5OE0;$*`9`#?O9=aJI$#qATRF3Y2eOc;dRTiogV``nnK zl2fS>@et-+SmL?yU$;Xbl;u10cQNL}Qbv!+4;sZB6{qf~z*>W}M&AftJZSlYw*p=b zUIn!}U?YPJXuN8NqJj@ST6ip5K)Vbc~=s1>P0SN=*uxLK3>t)3E;Yzd#;Ee`J*I`uaa43qKbY(i(K@M%@7YKajob z2jMCJS=la~x(w)4fj6p29K>$iLa7&;G(pL_GJNT2uv8L76G5LHj zZNjha@SFbt%=%&P1|76DNTAEq?6C3EA(!*+xij7-1OJsm6CXi`4JaZC%QDm^NFuk+ z+s|aHP5u51G;+eH{?!kF$(8eIF8sqtA~LV2Y@#V-EF)(1=*(QSOR5iGFm?6Hd#X~X zXv22U{sT|mFnW$$>fOcaB1?~a%T~Jx+)EZm{|SWf0-pfyjbkDO zMO;KV`P(gkoF|rl(0vUqPf;w)@cJ38f3Q+BVE2WzJ$w&Yq5cb~kP~bgB-isO{zOK# zzdY!4g~#Z%f;sBR*Cli#7!vW&00=$n z5w(v-hww0vA5%og`tVTaQDh6`2}}ER{BJ2Rir}YwRKwr3zbihs>n+td1B77`^7tP} zrO*r{Ae6uo&4QuzKWs^Iu#r@B(Ul-Zs}#NjGrhs`4@EzK5|wZza@3i>RJNanbL@pd zBFtpau2IK`ekXq3Jaa%gb-Ac7fA>vX4n!QBzFCIq%C`Ig(Ffp-o$aG5Sqg^`7xu)f62}Vf}h~>%Mwiss^<;xy3)P}Zgn6p zHLDPE!DFrkMNpvXfOmkcMhUL8Ax?3ufmH6GpPALp>XxUr||T<3KOAUO=R4G0^W+j*k)g=k=8XRJ7*F-JJbLw zifB(zJrwaU71G9!%7j=SWLba%IW7*ev48FmGXof#B}R%gtT$#{o(x2n51zh+6ai*S z)Kg-&T$9;WC-MgVun4;0PpaYX$kKi7=Lf=2Pla_&WB^~FtzYFBadjK4% zQ7n(;uP8+Y8_2+4Ctm38vOnCaLF%w1_fBN&;o6t6Wp_~|UQ45D);e$+5xg~E4~L7< zUOK2ZQVMrv?i2KRuhdnKdQcwT)kut=g8TxC`%vbEF%M*K{z7}f1S)krMG;3#l0{>D z=N{(*F$H}Ag$w;2+I+GdZ7xtIwi-WT##CV5+cPj!3^H)>3l_uwE5H*ORR(fw4;ZBw zX!rC0xbNWET~r(T`L_H-bNTr|C@cpA6yu^Gwx?GjL^{?=nY6UK~N+-@A2x(){Ll==)cJL(sMs1os z762i%OEWP%+?XC;@ryc#E2P=Y+hdngWCa5_CCfUl)&rLt^#cR)4mlSI4IpRA!}2ck zudo<)M~ALG_pO)%v3R6Rp+kk;f*g=1hz?u!%P*nLe~Cq7B5y^|0r*eqFIC5MJ&;59 zj)+FaalZ(VBg!_Pi@6LMA2quATHHNHDd4SQ^!0Mo6#?^Qd5&}7edZX*16g!Hj2l%X-s+7OP^|h6R z&1aSLuU9w=%~IQE+>YVO(S)>Txy|#B$J1bRiJulqPdD3XmggVAlI9>(3ty9 zni>o=XIFJH^i?DH3BiI>t93%7NOU*%+(^{O7lG)l_yN@5s(G6IDgKWwiegQbJ&3}x% zjZ>4w0;lj!4Y!Q#?SB3o65$&H0o8QmT{%B9aJk+h=QWuz-+{~u@mVdQW-2=StKPA! zR^%kFTg#xgBCOFWqSo=Yj-(1fX2c?Wnd9n2wlLJ$A4bp190ofB?VwI89V9FDZ3ZgY zvU_wi85#3XBELLm<=L)y%LtiCZmLpW7=Fjtk@FD-s2I&1pyD|v($KXzlJ9x0Q=)dIwu#tY3YvCB zrd<`6+EF0J)9ahMVa$;b+4vRj)(NAvH!Xb^HP^kVa{!q-m(Dne{c0=(TiC2iiGmO^jgYdkg3pmH&^{K>-J zREY!)f0?jTSBkW+h_07tj1fiekNbb$=$oVz7cw!xTWYB zwz>G(?Q0dq%k*y@C(K2q-8 z|K6edMd)$SIN}u86NiNoXM-0zpIGiWERKpxZhl*|$?m2UsC24N?bO~6Tv1ONY+v!5 zWXR{&8dci%df<1zO=guxbEdU62)oszJ-l&mqB?2y{s7G-v8w)f7jf;xF*aYw%3;NS zUL3@G#q@f|w$(q& zesDl*Uq=S-Mtwi6C%>tAd5>cK$H-fB$F%-|)R~-f`M%QGaNYRVD6<00W@cW;X?wuP zea5XOzHK*cevxLS#@MR7Z#wI$SpyOy@|h64o} zP3=Lt{i?nc1ysjmKMZ>Jc9Di3tppRG6Uq}x?^PT?C08ehLbW7 zT61t{b){(2A)ZrvFqeEbA>8$rZV#)6g@qw*^pWm8Z)F_a^EFK8& z+pxcn)LN5vZP-!>Akvr9;VfV1KXuFe)7Or=(gc_DIGgpS3Rz=C1Qvhkc_E2*Y!?U8 z88)rHjs{oHkvAmCjM$*9J(I=)8pq;n$TU3Xd$Be@EJp8!?hWRmsZ<|kf7@eOmB8p6 z?;hIiZNESxYEPAgZL93g6R}kqEZ; zb!^*+U6#M9`*ULK?e_f{*~f3by&+f~CO(l>?*n&y;S4eZK*AVe1Df&OsxN-WSO~{4J4S)vF26dzKo!xUUuf^JqDe&` zJu)!L*E=k67!X&gk>n`*?*+ql6osWat1cGJyk$pa=M~MvvWF$6dG8=ks@ztF%HCFbZvLc9GIKb} zd-YC|3pj3iFb{H6XtWcyD{M74AS5sWgy2!BB?+eh9+v09cEAk-3Z?HK90o`ICyy@r z_`BX=8{VTR)4?h9KXqm~w9fIZV)1T+|2xtDGmT!xgKveNF#VZJd-xSmA7f#~V7oa( z!V@Q`mP8SEK&}JfCnn4e{uhmqL6!nHjwJpEoH;<*;eX&B1C$K@2W;8DL%{7v7QKc4 z0XL#QWF_G6M+B3>ysQRoo&htrpFx;NMtQt{qxN1_dojuco)WHSaEOu|&0|mu246V6 zclCe&^QAFka+~|RX@Uzt@eJ+_HfmRu;ZldmBt*S-+Z6^&aXV>)xO&6BZB~xwh=B6k zy_qU^bu-hO_ffhY!nA4*qjsK`SvO|NgWv8I?<9!KJ_KJ(TT6VgwYlq^UP-Z)xxAYB zVBHAkT=8Y&who0Y>3&&8(c3-GwXvt)G085Eh2D++#^U&HbFs)w=SBF*ZT41~vrGjW z7F_B??T0f5%#2(udkOhitwKcwPC#c|RRxZG zHFLkN=H`+$Gx-nmy$`nD&io!#2kkx{)V<9EmnQh=Tb;X? zI_TVYY1uGfhW$;L@H45&ifeK|Ql z{3LwtMc7n5o)0M6&j`8y<6o za&3?KxO7(8J?I4_$F5Xw-ck{6;9_p9c3Z;1Vi-LrulSoecaJgnki(j;ZClkxw`JIW zgVP)OH>e8N+T9CQH0{4MCT0cKgX)=Fba_1!X|+Cs5P~hCy%l3VDxalVnmqN$tM-n+ zthx|vjwU58KpA-!qy5=>fy}!Ae6xpZZXkB!k)BFHEmwH}U0k4xQ3Z_)#5O?!!1O(( zE^q6q0ySyq?pIZN`pXXV0??}v@7UD`wO+3{ZZ9=?B|I_T>fYGmo4F9{Nuq+}aHj4t z(zRxfq2###sTM!B;Treva9l!JXN_x@R0yMzyTf!Rb!mlE8@mW%=&P%V`Ss9GG#5FN z?do1K_UZWTk>$qg^T!38{|>>diW7OqR1I@&Z4MZ-ip#byw0#k;Tq8%!5Ru0PUior^ z&x^-1=JMfK{91KnUV<_uGQVBBkRgm7>upv0uFE&jvz!5`W)s63P5JJ*-XulF z`Tij7;U|24rSAp{MDVp|?T0Tmeqd3gCC7^4;tvT|OGHUrJ!kYV^1C{RtkYfp&n%i$ z9K$UpT|2K+&IPd8)rw!UJzeXn12>YyEI#+l|5Yg#+XeBW-cxJ!GQDG%7kGtRHUVby z{_EAZee9fb3{9?=sO;|QTaEl4%rS98)IJxaiEX9q!-GwZ;cTp74*^cuMtY} zUN-*lSc{4SUR(F_NvKWC;#F-|v)3zm$Xw}3`N5gyf}ov}pj{fd{qMvo$Xp+j(wnNc zHnhh`2%j7I9m$2v(rfjdX}Sp%dBqvjGErxh*s}i@m8+9)Q{AggKCn{91sW07@l+_T zOblKex6;X*)GR$0o9OTw3q7qO{3Cb3o?f73A-m=MY`&n#R8IWa-NZspJFRM$)U&@V zQWy?LFFH-WH%PkIl6j9h#}0_`5}|6DT)NvYAWT)#Q53D^lG~~iCX!RgwKI(EXV|ah zzjqwi4p_KYwcnsxzwl-Vxyr8LUsE`&979P$RY8&va4pW^HOdjIZiCfYtIvuH;CHj( zNcmh*n(J-2SNsVv&A_{!d4K<-1Kf@BO11WaTWifV3Jy0)F*0o-usgeMsg&KLL4w`s zS#o)|e{kG;dt>j8>W(CD%jL$Q@Crw48?W*y+2JLGyO zb1CeSW0?36FadH_0dhjh<23j}GoKIi1mk6C$O&jD)iavo` z_jm%H3mrTcku*ph+GCOqOk#wbT(uOr92#cM;fn=-ycX$~wDkVaw)8E!-(q#icfI6f z)>FpQYQqg!=Zn-%uh5y4Xj|u!MCUx}cUOI&Qq4Oplka?S_bQ!dIwp7aHb)u-PXB>J zPNF#?rkzVN1)Crf5nQ|%)1{%OATI7*k4W8YBX!xZPT|l`0H)x90qQx&&nI)+CzqKO z19c!Wko+&7!{mR>7b>DdbLr} zckSocODFL7+$)W9m{BQ#RQea!{20+!)E8Xug}ZjDRs{W^Ntf;Lg0gwPZVZ!brZvl# zR(@^w0g8tHXcAiE;|aR3{i^F>#C(V|6kS2<%?J^kA%f&UeW1xKA5j}4Dv4)4YrYDd z7Hj!7zy8=v2#T)p7n~#u%k%|{49H?;V-^N@) zsImQtK123$q2z0%pJrj?vkcUQ=HtJY36 z6rQZrF5l8N^$O(Lv*gjAh!2B%qm^-W*9``KGxdp?0q@cgO;2JWSH^~-7n%JGsidd618 z?wL{3RXoiIA85W18L?ACV84ZWNJ*0~MxpsTH?k;(BWy7jCV{O3p9m8qxNA)SyONY!7l!O|aXq zFRONBtmLV5dT4Vl*?mgyi?xdOEf{mFs7=iH<688+(CEu9OZV3x(lXQX5|X0$P}dT= z98$1kz0z!yXq+==b1kdWM?tde#)dZDjSnAEU6pV2i@jfy#BrWD0ozhUN^6J~vCEUE zD~RXT72=T3h%A^;jW?6G1yEzh!YyyzdmNk4W zW?tJOJZSfe;_ZTdeZO+~cig9$(294j)v;YmO%=Hj*THu&Y@z4LbRP?`!P;(#lm5w> zqCh@XN=qNLT$LZM_D1_d*S6&cat31U>eM_#2IdqOf+k}n`?L+O#LNw_w_31fn=}jh zKwFjKtZLas#=i{}4&R;CTwJ~tP8vMi`&n5#B#1`5Eme9_3m!J7s+HbNhFk9c*cFSp zF)wBWr6S7JLv3iiI)ieldO8n9zm%6`Ddg_J`I}>l`g(p`L}fNpH4 z-O0h$H)Q_US+ZfgN#$%5z28oV;+elsh*DIc^v#>?Pnjb^eYW?3dIAR%}7bSlQ z4H2Yhe#E4-9MZfr)P7!{R3<{o_Z$Y-uTLx;cm*O87-7&A7T=l7xvJlhCGa6A`VFHy z!ye9YbU;aS%Vg}kCImCgi`nyesh<)E^odZntV}MonI5I1aaFurO}2ZL+sE*4t{I@+ z!zXyQ#fcOzU!G{SPlDG7QSH1KE}xe_Z%ooiLtNQv-VE5DjTT^Y5>+j=HC^)IsXJLU z_o#cUN(AEDU>-x1RM6tVeQiB;IP<k~=`fIlYC?PE{pP5^J%hL*~9#e;Tf^A3v& zK6gI=1xcZWExQj74-Q?DpsQtVDG8zWJO!iyY937~$&UQSLD$hlWB8~r!uW05EC1OU z$8cQ+ihO%MHwEtd?K!o+&D6w#bX&G-jP*nTHv<9(KX%7v1Vle;v5#*-tX8zG`@UR) z96=<;?WTC=9sbs@RCF?WViI;wN3mC?&RnsKL8wyjG;;n*e)K)RhkIN74+pY$iE0p4 zO>&z?13yN@i|Vt92C__~OY5VJ*{bzt>Eb!LsL^$rakFgOTkmTIG!$NxWNvYJ#mo+G zjuR||p5iYr@zEVxAX^1y&5*+&Z)YMgrObC=pDZdR7wTTuM7=Wx_L%Ag#oa2Ln|#C_ zB(SX(fBb$w`U&m{fe}hW-rei*eq;AD^v-wi% z=+7n~$mL7Q2j+3oE^~D|v0HWA^Q3TMh7Zqner>hmc31|PSE?>2UGp5nXmeeDNXMxs z4ZSa(Av0;9r@TRGe_6{sOD#`IV9%O3G8Q*m$qtid$cD@ceEta zoo4EY5M%1IM^F}gBCsY((gQo7o1HwjhEv*wIR6FJ93$jYf+C~1Oj}Qf8#HyR-&MJ| z_WQQ7G}Oo^D@9HeAdjGM^Wt3E3YxZ-Bwg!px6iLn%-+p%t#)00^u;(zxq-iO>#Nd| z@8a;Mo}UfNDo`isC;{(K*EcK>eMW#Uu)SuYDQrVOkB7x^k&qSC)KES$yWVNIWGh-Q zpBP=1lNdeqfX>eb+GB_#yOo?L0BLV%seLeYNxJKluEKL*-Rm?JrhXcusVebwroJn^ zx!$Z)6T_dQ`wr^#t|FmB8?mU2dC1tUOfx+ZPj)KdOa+9k(Z zJW3$PcKH#}pcYY*rcLX~6=IjnM%lMRJ#yOcZuLL7ZW(reY(O8In#~-T)N&Uf6M@T%hF}Ly7fXKeNGk(k7 zCIRzd%4zOn1?jf>XEiGH)~*^QmFX5oNBHx^j}Zxao!1mRp&8lj0#9~*>oW8|dC5l^ zN6R)r+9lXFCb{SrdbFSLb7r1=Bf+e}JKzz%f6q>UD#X9Jqjlf~(H7Yy+lyJ$*LD|7 z+Ou6=Dm;J24Ee;h-7;W4!#uI3wbvlumY`vHyI!{P)$Y};ig>R@(T!+CI2&Zwtq z%4R&3o{;KIW7hK?4rz=09K9o}$%igZ-E-d3GffGmzUIV$mKD)EM=Kpj^)PJQk;2OW z6a%7h7ReHHy@^?jg}F0r9)xc6yAKAV5o)>R7o^RNzea3@f8-V2B;coTN6lQs@EK|z z&N=eV`RA>EBJ9f-R0ImpWL9Huw`wG6QE(a9&CG%jf|j>DPM;rsCfBKPGE#27O<`*9 z_1!(97lN7RgUF=qy_#LHcZuQrVkc3?e%Z&em>|{Rr_g}_Nkfz6jJ;z9S)7I+?hQXD zn;)=~Z4Ir=V04tx{FPvo+$1-y(X2zKqD3RObuvR1USLlUCk+ z;Df~1nxsizDq_I;Fk1QHl|*5a+gyw|#m+!Ll?0t5w4;J6$FjjEZxLG1rl0adAvM%2 zMD|D>Vb4T~^H*FpyXrJEkZUwOUz2$TCTZqXk^{2*fu_Jzdb91$Xg`|)~ptZ<;5YLHi9tUL`FC#2e8i; zXr5g8y?qW{tktn{?}{e`Pq6!(*gH|nz$#vfHG)IpEnm!w8@GhzA+4c5D|vegWh>fl z?+ERloqW_bY@FhO{UTafe!cCQWMNTj<)k0=$V)s7MW>0Z?2OD!CK`73SbdtkTOSOZ zebf^s^duuy|Jli>Grns5KSSN>GHb4Ngr|t#GE?1CvhdCpgw&s!^Ngu*tpEHucB9a* zn94&`*Zi23_c_1y28o#Nkn}%vjAktCxF>&(?{@l$0-L7Kxt5PNGJuq7r^@eIFA$-Y z7esNnCVPTCowngx+nLUu`&0MrU%j|DONTD8tFcUPW4Nl?FZd*&SZlA+!uIb1;_SVo zaf)oTZTn+YZ`)cTwa8?48w^5~Tzd84%6U&#wZ6>$$?)Z&YvHze@Kp_(N@TS+Q5;@$ z#;o38f8rk0pURntEuUs{elj)fSvFw`Q>p$Pyl8xPYn^E<<{wAnURm}3u9GM6un#vB zR0_=j`l+gN?wMzUXY~h8eiGN>H)`+R5Mg)5CIUKg!-iR?xhuWs=W!6o6i`G@Nx5S!5=CvrmF_jIDsnprDwRJO##eT87`NlO#Dqfjq zu$%rBjuLMxzH@vD`uZZ03!5bxDFfwFiFhz5`FO8n=i`#svRQw*nPkk}6na}u1ffr} z?&go0^Jb`->6`(Q_x?J?+QYWlESE9ml)gZcX%5f&z}NAMZ%0&biO6f5!B*)I(2H1pN*#_v4|7c)FN)XA@<{3J3<4ZyPZBgVH3HQV7Vh3GQ% zqBy-}<_b1Q$%~Ht+b6n!mD({;p}n1|UJ&E$CAj5mxi7t3GX)*|!hn5Vp0acGo?Xzx z(?jA#(fVYy^O~Bcu>;vnl~;91zPGS8$9g(sfkro~K;0+cB6M*%>CwP&-OyHw~MC$JD z?$5CA&j|1T0Nxqo(fy=;5{ZP_Mas7zeF!IYM3Or4$@lhWkov*IV14ijhLZ34boX)x z5EreZ+Bqi*ibMOz|53W8D!EWl@KBtiJP+T-YsJc%p3=)UWweX zxfUp~-@N*6F|qga9@pdCa6pPUrRz{R4YZWfdsw?T4{#XjD zrb%)xqXS#n#mPo|M|$zl=EtZw1-5Ofrd~nWUD{9(qgw~@QYYDkPWf}jzUD7GM2$l& z^-ZqQ41dtB6^B1vQ-ydJZO@?*iLEtKOVzp~0I7A@DF_TXm`szg?&-1v6%@mUEU-G@eoUHy#2CuXGW=x>}^ zb`nHx$L`Jxo%$A@h#n-p^tcJgj^8FAObA{2I9PwcVQz_T?X|u#wkhMuq%z*@d8~iTyg2IXhUZ*+t!(Vk3V}mUfUZfw%Nt zjH@;+9g4U|r$0R=xitGG`u*a?BL)UWXhgU3dovbd*VTiXXqUZ-*XufhBQchL2Y`0J zWZN^yCO$*;4afVdei|NX*=$(3o4ZZAjT=&*L!yey!wGfj>W5yQZ8~Y^jqzGpbd?LW zSE3oe+9Jq%d1X%uL^pd8Vj~(!j=SI0uVS;=UO35y-*@O1AChavo%9g5C_1i|)g^;N z#}C<546$XBm8xU#G_I}K@zuA-hp{VK?)W4llR4j`-FT6;$M<==Fj z!KUvy+T5d@a5R-XYyb=sym0Njl6ha?GrIdCJlMs@eXMig9b$8nFM_7lJ!R(B9{--- zwWqmKW^#RG>Yid{Td|Zcl(p87$Q2D`&9>`fU2n7zhtCU2yaf!n+!6l_8Yj5gySiV5 zQslPuor(;a`qWfAqDAv%tw_3fMi7(J(V|2JwEV;TQB|1VK&m~H@nuMZRZyTJoLOi+ zn^F*);#PlzA9r3DDSl*h@;bBG%$=NDGV~9$pOC2uMB=Y`ElVrp9s87^*qGRL*oai~ z-U!vV_x`@pE_RI>zof`Kl0qhBB|aSrV>``(v)Xgu0gKt>gry~?b(>bYJ{bzwTZlX> zJb(C&$Z?=3A23>{(f6;lt2<`zvzqyEObs8<4#Od~il2osT>AjRcBTnqJm~2Q3{>4} zM4o&{`Y&=|J_I{GLL`%v^{-?ZdoI6SX6v$#CbZdCNERcfQF*VMz_jV3i8A8xIuVYS zOh{$~93r{w?eg&qSq<#8&Y-ocJ(tf;eXGq7T}xJIO1^VzJy-LB^3|=y+6{IwT+95& zqk|)(4S)*VV=?}H*wc<$!?5~ToD8Z)k`%!_id25e>F84R|rbn7s8V-CLYo}MrO!8Xai9@@#TG%G# z>7Z+TUo)lIX1pEK-Z&AHOHTm%blD$Rwo1A^nQMfpjHPQS_b49|9!x3+H8>froq~6Z zzLfAD+Yc<bSPO94+i=p_XLzAAe~M zho>ay)0OR_d8?XP{HP>)e)hWW!D_)3tCie$NIb3Sn~HbBFyV21OvDs9%kBCm zx`{;|OXV5CN)z-wg{zU=eBOH0UwU4yM4ML4Nhwjp>-G2u0Z)}KvQSg?-cq!?6z@W< zZ+f`&0Jlo+70$C!NV}~7TU}%D)Rq^kqOYaHw+j)r+8UwUt1G7WmxmJdn9YiEO^aKk zrUb%}__;0C$H5YYC1zJ>gFo!T#ROhrBCcIo%IM+275Zw1PE`)pCniHV_r%9l)MZkE zlDR4A4|nUG21sAVGf5LrBSCeOK}PTEvKH>EhhpHEq=pN6Pc8X2$%?W-h0m zlpLy$8XVA`=ki>p(L6rYsGTTki;*%+B`;Y`Ub2tTtcjwz@@7Q$>9|k3kxpS|V!IAX z#r1`5g`;|R%$qQ$#50Lrv&CMlQd^>|ga|3bLTuYkNUBB3daODWF`~c~N;Bhq11;wl ztOt0rhB7W4+I=+2dhI{=TBUDq31cQw2@>+~(AFb&TWeJ6P8KZPD{PKzU=+c*O74k< zCU@`R5RA}8cO*lt0SI%iTDRBCoyz4V^|=9N;!CGh~WqGINaZZ;pTPMXR-mov)W8Gud?h!dul4e9@>N0P$5KlhBU^6S{dzhV9 zvQt#!YId5hrGIRa$SJp7aw^GrVLx_M#$H0x!{9{RmK=dB4u;qO@1}0vDfP1|hiS%o zB96e@IdyA)e0h~E3XMmFC-gDlQw|uy;g;-I(!S*fHk}9dtF!m0-OO~?WI?@<)U^Vk zexJi-Yl~BP+%0?#yPS@6rF*0vF8bIQ5jk#*KbJpzrsDdY<+yxEB5Q zy(UAgpj}fKJ)GUzsU31Uwz9!qL!15V z?KcHCP>T+Ww!1s2+T_FYMxUPH2&<=PGd~}A?bU9@yf;8*XD6o^tsP|eqY{+6nn6W zy&GDd7e;ca$GRfa;7_}Cjclgpx31aTZ&He1Dcu{cj*drPUaNk5=m%R~mc1Z;ICybf zMj@`K!6T_CFg9qaET(6D;w!Tr{gFhw<|ePjFN;s!l0!R_N@b4Ew^@%8duC$G1b%%-UP+u-tJ#Xf&h}YHQff1PRW7gI z;~QH$&C-mehh=N2fs_5$_mM7imjJ$;LbBa1_2^0r7Fe?4Q-r%#U;zSknAKIA>4mNC zqU>!Vb~k|rD^*GGL@Yq19^Y@n1}|>t?QLW0d`Dhw6i8lhjxq?dwefgX%g4Zov@~gEbcEbkt)6V0N_*iQQztuji7XngxT{qoPh{%CTqIIt?LL|8?e^O9z(;K9 zxmotrp1a#R>RdEej$U^%pS+#aHZgo~gsE}}JJ}d`WY3Ay!F72zNOsESZE`#O1-vum z@oNLsNoxt?E8nVLU*+T*SLPdsYP@~t@UfS7Bs$dZ$EcV4Y3hYZ4}B6R{N6#Wzu!tJ z9dNPBNv2Ka_BRHNO;!{XPlu|GD>BnKr>3s5bju%RAv#4BaCZzm9^Cs-nuwnp3e8s} zB_%!-=9{(S-qY@Uz-rI8u&mcvsn5P++(^Tw{g<{2WUx=fHC^cVDs5MPCGMb4>Tac% zZmOo^lDD-a;c$_*JJ<(pMk@48jCj7@@+YrP|Kk0sSHvwVF?Ub6*v4dLUe3pCO zy9wb?WrxY5T`!5DN!=WmCRyu^y@o9-I2!T`0tVVtzaGw;W{(Y%R*+Ca+tM7Pwp9<` zk4i`=xk~b$*N&H2{`h2VrF}iK<(?IvaI4>n18uu*iuByvq;yC_j8c`{c`_LEUuagz zC*F108l{8IIMkOKSa3NSG#LqE-1dc7iO9~B_L5fLOZvcFpBt||MxHOt^~~OTJaUaq zk12uFqSV}>BQr;z&aAM@BRgWqelJ zVIxdurQzK(fV*kUwMXe$%#NLSL#57(87&x;^SWplmAID98Y-r_&#=vK&pD18r!s2z zx<0>jdW$?Csg}>{Nw>U`oAQos@5jmk(u!r@iGijE@9GL#ty@-Q3^=DAYrVbOpo(!N0-U&Ut5yTx>IH@RoVq{l3!@OiibRDLoca4(un~dhzbg11(g4cCO~9RWd<85r{FcnG*Fgx%-0w%cnjG zr$Q}G&7fSAL!XRmH^vEiIbMPMK2R;{prJ^RM2XAg>&%`{fMAAd$aIcwfYcZ!BA5ow1NX+!CicglLV zwAt<+?axs|XA-V+&x!e5oH~s8j$0S4SP;iUec^CGu-FJYUK7oCVkY1WB$lGK-1vGu z-pl>-yYiTaF;U-W+g@^?xeu9#2|gmnF3Y>=qC8}aei1gfaKeh6zB^E6^jx)TTgf8@ zHP;(sHdI*lBJ0y-{r;)+6YEqGdCpbyUk2=YR3~-b2sOTO7wB3~O|Mls_noP@xAs*| zPK6csvo)p{J1~2Zoy&}muI()(MI|d_s8(XFYLXmU(n+(|63mh3V|;rHtaH~^8fITa zD0`GD^ekJemxn*$cxiq5OAunHu4Z~6;fBlDiu4hF*pRx9jaWRX+dXWSv(z=AZoiB1 znUDR}AV))wuCl~+)+YBqdJj<6hC{WDQ< zVOm}30-tYV_lsBbJ9bQd#j!8)z3rEECe;G_C20ig?CWPrh4%dCMH$V^g|1lUm>RxPALkxA#95eC;gb4jps5IL0`Z{b3b8W+_+VG*gKDUPqSonh)y?|r#hy| zUM6io`BE5(vmFkuN7nHd?H)Y|-Tmw!f6}6ly`Z?)k21mffFK<<=TUl61^$Twea6N6 zj5#%5z827PKR?i+k!Zau)LJ5Ce5-0wLI8gLY~^I1VdB+Q*PeI~MXZ}$JMv>%+3lbpI5HngKV?tg47_v+bpoR9FSK`P@~uC#8G`9$Ezv$Ebe!yRYKrWs&s zkwUqwkJlWB+)1V5YtHYN49s8W&qN$+nok^-osquhqDxwy%zfDSW}wSzVKSrABV6QE z(uuWla?q1swJ%V3yv>0l&}Z{m8;t zsMMef{A}%M)??$^&r(_4xsAhiCpz@{x54eD3Yw)0Rg)hWfy;0Xc3jMCHhml>_#}^d zek)VzPo+7HJ`3U3csZG+Mm+x*Xb5_m(Ieo0+ejD-&JTyDm%< zShRv(U%>0JP3GN*$tYdyeVQZD)bl2Dyi3n$!0xsW&wmt^RJF;sVTKL;16tXhv z<&Cx9%DYx11T59%_q=cskRG43>=E#u{j&H@YI4q&^Nrcd+kC;Ff9=X9>=2AU>@z>I zFdiy2IB(ZX4nkAT$Z(!*MJ05Bsmu-^%oU^Lrvrm|=uW;~_-bmjiXW+UO zQ^GCVZ^VqH?fVDi2EvyI$YiZlH z36e*)8!7$n`kiUJl8!lfn~#r|`4%oc4H&#n22q2z0XCfvOTx7UJu+0kV4A$gc-QhS znTnUe*~^aemSNrzdZQm-B^}gPb3MDFT6IZ%?d-kl=9CJ_*W%tD%Bk$mi#ybzr0Zs( z(aBvzV=6V4wx-T7DC~!0W!mZ(2Xw&HXXEfX6YnNZiuMb$P zc`2@~4F|t!H|za)G!>5&-_CGbaR0o%{_wR!iD#p>NqW!vh(zsH+q~-r(T!5tUhl5k zo$r{>Y!L3Kp~j0wxP)XYK5jZLw{~z^*^49O;Pp!9;0vWWUh=hmcjlqMfHfv=sfGTc zAGym|kE8P$S?u#ob9`uVjh?ykio>oV@zx7w$ z+T20CG_wnwmoHpuy}>#_K-7;^tQvbRrpd&;{8YQXr|KS&x@`RV(Ub6_s|&-?EdfJC z!Ze2hF6NU4hP~B6X&bVHQ<4JR zg_*hEzq(R=VO@*XyCWD6F*TS>rkn6f#6NS_kVrB0?0g|{(Aq)Tj-#eWsKP<+Ftgcq z3rnfJEvFvxEO<-KjXHtRri6UM8IS0?EG$je?&KJS9?cy{O5!RfQrR;xT0y2#?6+KipK5T{}}pzTM0FGA0tr-9AENM z)wujRx`Zs=?0EpGAMYg=J5zAg5w{5M^`+t0fjp@iB|cDZ$3qenCR-L?K#Gcs6zVj+ zl!|^s9G9tX>7X1GS(K}1skym5eN(qgQ6wFk-6`&e5hU#NZKd!&cr$`tvHUZotFJbX z`?iP2c$v+%mD^C1u~byia9g|C9g!688;bNq`qF?heD z!ba3yxVv*g5M!{(g%I)uqfIW{Bwx6&@j|k^zg!3d$3~>bsG%7moC!)4ZY(W|2C{i|P515$ z0VeeyRxw$O3<~-3c*JwHetb{b2{dnL`E`B$ax^=4yvkoBYw%#2>OZ!*Q|Sw&K&0ae zdsh2M)xx>j_XD{}<1fzl)?Z54Bo&@7!I??mmy(5>IiKO|yWu+Wwl=#in9lNl* zZ{yvxxWZ47j-#|j31b4yabEK)t@d5(E5i=&Y3OuNOz%HUwGc+Amy+uRL{k19&wx30 z#X=>oXZto4jou&~x7q5+StMSmjeLL?PG#)H%*%89AO=(jw)-XN`~8oXNf!2BzATug zO6kW;JR&9Q(?IbTI>hoIy*S4{S|jc~@U@p3hyNfzFT^p7m-wEkQ1M?d$P)y)ahaX? zW6)2kZw6(T2GtA|Yrj8OUBe~0DcB$cV`7uL{||gU+Nq^qrGvUA2kGpcY|(qPnG6M4 z@uLgWwsL+P$6#Xr7yt2B?0x=De@o?;HYSwsOb*IUTpGis_29kNH{k83kdLv$U!J^K zTTW}~TQKFU@_tWaxv40kSjBz0k;KgtpZE-Liy?tXPZ2J3q z8i7scq6*G-UtO0G4O=*#Wn;NxH+M50x>f#92YyogNLjuh4m$1vXZ|fUodcMjeW#=o z%J*zE8s#iFSN0%Mkez@S%|@{~D!^Qlk19K^Q8^vk7#uW(=(r6zs$C>#Za!E9)>2@% z`M0Zlu=T{f7{?~s8p@4^+vqr|H}fv;U#>D=cJ$tDCQ5j{AV@g1aZktaP*}vn_dYNA zJFijYY(ls`6LI#T8k7A|KhXNKAv8M})bPCcLnV4%>jLXWN7Q=~kt~i!gsCQ8;Yjh1WIzvY-z7UZ4i0r!9yp*Vwq7WB(Fgh=oD)J8U)!QJcosfj?+xKdK61?A&wCvstqd-=dUGDc_lfwrq^hLjUg-+d8!SqCx51$-NME5x9z&cNmuPa`SKPy3dMVF5`F!tpv^=MrM-+g4XF$qI;#W zu38Z9;pXsRlG0Dml2}KpYn76lFFW>J;2`rdzlpq^kkP&@W_BZ17K@S#g50%byFj&YCw~ z+_vdDj##UEnpfauEhj7~pizB8`nD4;x_nOy%^4imLBIa3*Jjm7JQpxOlRTdG%%xNt zhX=k0&0g^mWxx-P?V5F9FQNWBn-q*LuRM*ietkoH>FYsk^H2} zLzri4su?1@)@^0!ZP<)u_|sH_*5}Tk@1yrWR*zu1cuZUbM^^g))4JP~@YgW$V ztP(lsSn%R9*52@@l$>WFDl_4iq!i(^yfn0%a=z^q)M0uzsNrQg%cdw6#E?Vxzr%pG zVn`$q^2ZIy{fh+f)Vsr9f8AAy3vTcT68ox*S=^4@L={8C`d^*|tQy23x%38`BWo1N zt-Z}3w>gW5%vdXrJEkZLu2A-G17)j+QU*do7>2*87d%Ml(rVPb2~T0 z%IgliNhB&)+C;fNQCOoJQxP zby4VVU#O#l`h&95nT^GyKmuaxtu8_!S|vJJIQv0W{%F9|rm&^dM4ejR24^o-3|Ab3 z&nC8rZ|WVAgBld~8=XOayw=@R^bFXcL{4K(bjN^d$GyEm1gXC*AYP4XE>HX^j@>oL z(GR-8OmyF{o3m)w1)7i}4AhTS^P6jiXQ>l>t z--Y+U+Tf|=kcOFd9{8*tJQ7#FIU)(h;_w7xaJG+0*+hOR-KJ)QkMYQPNyE81As$RL z?HRZ|0Ns?$_nGm_Z6I!VRTCpaFN+=GWDKuAg^q3rX`>)b6^tKLBI*+2cpM(s5Yg?2 zV+U2Ew-#Q0q2UX?;TAwn7x-<)O-dX(?~hjF*xiE~L@;wltE@RTg_DKw8%Ay`s$a&BCh6C>;CLwUF#1f1}4%0}Z^7oc7M+-j8lZqnSU_ z$;Uu+u50#=WZ2Y?Q_)IhJ{WGkbR6OtX0-nWDA)cF}mop=JodJ_yYuOpd{CLzLu4*~@BG_UdKTJ1c>GJ7Ahwb_CW?y^-aB}r%HKgz8JNT)73Oi3>m z2icU&`M;?*QXy3N$Z6d)vG3m_m;YyxD;zrb8e-!{BtsfJI~@-Y)>(dH_bYZW7%6MN z-m}Y%XjzB9ME^%Ik|#t*hKPX=$zcmM&=G5JG5~`Ci6glSV>k8qRXK$WZym+_L6a2{ zPfxoK$6olc)7^sJaPU`{;}opJP3>)AO!Z9b_O?uL5Rm#`*3tYF#Ua>xX>ZFFfa9d6 zgJ+HGXY)+gI(k~FHOuDIS3LCoS%y_vr*4-wP(__4zh)L$9R1~ZW7N?yA5CM@Q_>S1 zdZ;Y3bS#4OOeu8gd{hqbe24#A(KJ&>0a+c3T1LHNOB5e2(;pZ_ z85p$&?<_He-HlD#I@wuVU7~)opnbSv?Dor+*-7{83Cdue6zIW6osK2HW#8=AnKk2O zi>=jFJ_}vv@6Abp$Da1HzEM2|!pw|>CyH-qXkgiSUtt<`v>nFG?O7d}_6XRKbKTMU zG_+d0{Xa*54bAD_u>^Cylru6?ySXA1Wvml8@?J#!RCeKgn2zQlkNF)TBh@FQ{wS&X zA{JU1otaf8iMC#{{R<-5T+Kbpj3VF;AvE_W2xabvi32YM3+x-49cbd z36gloQUyFEb(@{x*}RjR;~qxq)?ZYhvJnkeD>z!W77G1w{Gf@>yl#|7I_Z?Ynp*yj zLStq=iKjqHhq)%5>TX}d7IOWU`IINn0e_SOH#85P64|cSy8C+FZP`rKKTi=-u~weX zA|W}Z30pS((ZgK73`&jLLa-Tw700q>Rq!%ky@@Ox*qfyI2vHlcS6- zh?0E1OkbR1Y)@#)t$xQIb<2A`_Ep$*WuZUlC=Yg&-e1E@IQAsNJoZXWaR!S?7wYr;R*4m!dkzf%z$(%)>w z{zr3xAi-P*eG2d0XRH07_aX=P9~Y$&f)(A1WMhd(v?>qU|qx zmE1qUL|?C(II>>vgGM6ETmE}Qse?NbE4IJf*2a9`_YQF~1A8Z`<#Y)C;Kca9j?-6= zaNs0b`DIl6w}TdZqq3GVC`D&-P)yWN7rpooHNzD~4*w2}9zvpLTrJsI6ld&ptf+HqOt*Y#1YzR4^CK)R6KqA9J8^;m zYlRG;CFMCp!xRuIR_zPSy~Uh1GZk0zF|=0dOZ%ujeHmTZ0E#dZyp13x!N)<6aaK%% zk{>_et1@9uNq3v8FBL4UQf{`>b$VVeRqJUQbSs;ijX=E}oL1UDgmTEvn~6!3u*{e; zm#SKIT=BWKP>qkN2`F2yT;&CAGDqOLU5o+2+3RJ#5Iqpq*EOhqw&ifGd7+yUfumQd z+}mh7xjV+FW=uUWh2ZL&m($$4hBXVOZIT8*# z)WJznuCBA6@U>YGXGLAS?Q>{$D}L6_gWSd77a?ln%X=w(c!?loEC~akfRUGQ6&|??W3LKVMMbi4S9J1!v}WbREooLR393*J`U`7jy~seu+P31ZlL`wj{c z%q~bNE8S^e>h(irDNJs@l518fN^zTdn3T3tggr#(!%0M=z{p~T)`)X)Q4Cjjem`NN z_GBv=joY>vl8RQ#V}7X z-VezpeoI+Z$C2;)Y;ScOjtU2TRi4ad)Ly;EU)nMkQ{M~976S}oMxK-6+(aMH79^Ip z_(f#JLkk|EAPX(5KR`&4RfB#PcYTrjAgZNgAl9JjScA(iK!4w__OHm3=(cfPl)bzv zTH@GRq~X4M%*a^xZA21q;%7$0lL`sEINbQNn_%za;`Y!63&Kn9h+}9QKeedxQ%Grf zPL9d@J$PV-GRuzz7h|PXI7gki%hMC2&o@FG14Rj!&XL)Qz}}0+#CGvwZsN|V-H|RT zBiB{aUfe-Y3dPb@P+=UVvl1g-gDp%BI-Pb(0StqQ=eNUBYB}yDb z>FLRU#K(Y=4X{Bw01&WNMPx`*6>nn<$zH#rgn@5TaGPF*cL$)=*tRknoE4D&t%ZHX z{Ue$QX+i{{Ua9PS=sSO>D^)9vV(BTQ6C5E?h$?^GJ5ryy*4j*o0~YZF@JGt%(*TrH zyLb5~N}7_kg{z>)Uy;$2f@|xHmLW-|(*pe#hrcMz+1*2^sT4~!gB*dyJ1)7OTC~Cn zUMF%!Bc4)j@`r)yUhZnB6DHK5%)C@n)4ZYCPfhiG-+lR{gMMTP&VD;SMDEMzN1m&~ z6V3jIRwQX?3qV%^SXmAANP=$Qk+GheNG`w}0$;4T4Vr^a1!c1&9v~d(>Kw{vilGF8 z3CZ?oc3P(frn;CKR|N?X!~o|WLK&~2rkXH&(8%B$kyQ*SRI7q`7qIud)Tc|RvTy6L zYp{#94k`u!aJbz2x>MMB^h^xYqJr{aj~wExU91SD1k75!>@Z zIEcd2(;Qo<4SsurPCPU_VtJ1@8E%Aw)yH>CrmM078gGS zJG#arMl1l~MmDn(U%x)k{~SP`cK;nH<0*8Hj#dV=8vs&_(b@=RGeuysoEL%zzKNSI zQ94xiQx=217$J}g*ur1Fa|#mn;;bl(srzt?fo%5O{kQ^uiY&jk$m#R@a6tek;LI`! z{MLzWGuMTWdEzR~gHsviU_u^(!_)+mAJ{n+?2=INe4msSiu^1a`KEKW(;?4yA{vtW$*lnt+}ux~j7vAP%__EX>d!ak>c{pta24euAj(P8f0nLW$hOS$W6IxAN|fi(uy%0Vk=Bq-_Z`MpEaQi}8RvDhJbHLD%jv%Da&r2B|-osKAeRl_{B zTMY!)9PfT&`2hpbmYV$_;cDMEN^Q<2eGJPx14OP9EDe2Z9h&&*>kegQjlN@6tw0Lpzf|z=jM3JOQEN)_!JQ z3efx-)R1rZo|ga)rYwPmoCsnwbCMvmd)#;<*P`UU{v%KzCxQlK;zBqpW08H^bzWTs z=;UQboJBb4Sj|RU*P6M#B9QyAD52e_b(GtBpQ1jgVUMJzl)1ARzy#Rng9~4W$ju6i ziw!u}si5p$!-oTv9`LtV2C|U>35r9BdwA~Qi!*wDydW9D3KIPF(a*d;TNM@;BXNZ} zp$tR@A`fPa7cgEmG@EPPcuAL}S8#gP{tkJ>eo*e+A`IHLrlwiI!Aj7D`_KasA&eZ* ze@3&6GI!gy;3+dD<5-rThHO5pw=zL)J#FyTr~NYDltyv0OdN) zKo@-nI={}M57dDL7Gs}c)Ywn3$DDQ(+XwU#bhm*;O{vaV+&~-TI1)gheo%|j6a6D<8QdYCx_DR;)`5?aBU&Lp7`3r&rJ>DQ%`S2swT(GcON#@M9%y;q4l1TigqTaL#8QF@ z*}r}35Hrr2`R0gZ(lCcKpZV zD0|m*(Ipxb1eJFndVi>@ss_33@QB=<(c4$aig!~xvX|i$dI(r8gfP;Wuue@_*{T4J zwBgX~*buSlNXIv{HPoJ-Jcv=Q;kMIgG7Z@v?I%1dTCB3aqA~t9Cnv2(llcn*aCrq+ zNa!3QcW^8&`r@n<)U0FyL)yVE@z9w=+dD(DK}re;2Q>)rqe1liFn@&1Z9}w|Y%|61 zP$!r7vs(7WGqVW5U=?< zYV8XX3rm+WEAs0 z2E1A0(DrIonYePJ@~S|D(96sF1?*3d&jhWljc#8N%ky0H^noX8fbyf@_eQurMu*u; z`@Qy!m~6wQudBiVDwA)>DyX<0MT%dbj+cx+3M-Jh%|S~%<%+3ae{&bL2?2SWkOV()Nugj^=_!x zlJ&!1^ASUJI2jGMp<8jTT5w1ZtC_-boTmSmQOm>+rH=RigNDm&`0t+XaXbPlm>2iq zZ6M7yqbGAq4V4(=;5OO|Oh++Pg-bC*ZreVJ)4Xs9gvz{_z8!*u2LN1+AUI>+M%H$# zA^B6HKO03TxqDs)fzr-L+Z`bdbgs0YSgSQ6;4gY9OZ7>hrv1xb9_J-|62t`Mi6=mJ z98Q41;#HHtlg|<#uX+J6zwC+}XE6I=o^oFEf;32kfG1ZWR949H2p=Hug1~lL#RKz+ zy1EBquMcklwxA!;C^59ipsm^F>G_b#R-w=cJrfD((;fw#!9gI8q-8ceqZPH-yG`_^ z1;~wl#u$;s$n!nOY+aaE8W%a1Qg?g}l`WzTtlXAL7Y!fs`?Zl{<6o^I zXBo`^G+ywFasIUK-}zv~Sw3M0*#?sz;4n}|gXtOVrTo4EfC*x)PVL39L$0(ZCv+mH z{-XdDY{a8DL15;8wHV+8L9Z#W0lHYIh#csGBG>5Gp8dP{8G(>(WiBfKpi={?F0l}~ zG|4KN;H&*#A{x7gE&@E>Wf~b>p-(hk z`n1r~xOi?}7XjRefHD?Wv~4B*mVf{ZuvUflJ#jyEd>UD;+%Zxc?fOEO24o|#(2eE# zl_6fDDpL&oPf$d8JY!G#P-}!*k#j6RNJPKq$!{%x&QEqAH$gZPkD%ucru>H5&lU*3 z>)0dnyVmHta9@z3+rL=5Hw!w5=81bz2@wpidMT=jPoOjq`d*fCPKG=Hy5TW_b zAsoyLdUSqI<=293Gu3%QlKSsWyo6xd^W!`_p+M?W=$$`~!}OZ&mHCW+`H(IAaUl5^I=rjqI+FY-noQ zoK|cowgZUY3C6er*Ml$ zXYMn`#a*4Zza6d4P}0TDFFH7MEzkEa)$iP=*dx6csHqj~zH*5t;Lr`~w3+mtOAlx64#dyhu@b<6@~zldXRNE^~YZvkEWfGy0( zmQUZ$aGjj6HX_fXKWS`3$0HkxjRqF7o`z!PdWw#(FJ>)EY%80)(jeWZ=z39v&K0ES zrvUZG1qk!TF3e_Py?mggzRW-zb4{ME*p}3sJNn7lDY?#W9Xv_V|77@d-DC^u;Joy0 zel@tu-4DKq7gaEAbWe1cyRr0af=0L5IKRT-LK`2rUO`tstboIR-LYQt|0%vbsbIqO|v*7eiZMAvm z)x*XiCfb6S^5-ChcCv0hpF8oi(Yi23{!_7)dE9PXEaz6>kq;BTZf^|yqBnB=>DP#b zmgWrH=*PweJFqpltAY0<`jUoLCZ@a?@Yx7?-XMPjHgj^{hbu&lGE`OAN+q2IK0CeC z;74%mpVKswp=wZV38zqL{X`w)=A>!C0>zG-Y+3UJj z5}~YQT{1#klFTGWx!1@jdtEBZERsZW6NN-&WaT!5Lb5{idtaaL_xt<(@%xjAR2IQOBn)_`1MhA3R8`p1RoTC?PLVIuAwWa5ikHNqUm$pWpO#GS~T$huuT$sk)V3` zD$kf@gwUjrg?IB# zqQ6F+u6{UH8|$Qh`Jcv%sTvW^Nk63rYh%NvGR=<#*2T4kR6(!k{~G)UM2;>1Qsx+; zOZw<$dR;{}b2&p$F5OYAj^+iUiKhF$gn|!drZYSE3B^jN#BMN zzH;HyUK|m_G||Fs^IDC_m_PTvJh{D_o;rk3q@=NCQvnId9vDE99Ehz}yIB8*JmwY6 zmq_Nr$7pUYcyqnE@~cu*KYXV*EPm4t1Y6eVWsCO~@wDA^$x?2&9|Qk`7LSIvu1$U4 zp3fH4bP6(cloebjYmrB+^RPkQ~lRiOy*19pZO``I<+D%-U z3gUd3R;>I+7Kx3Um9f3CAQ26G#O4Q41ZDi>6Xi#h6aB~nP}OyzU_tg2t58IZ9bR|~^8B;WvV*xDBr3`p!5!Ocq-rL_uEZdKd4 zvzE(ZN@yGG=IddVv9g_?N<#{OL>zxgevzT%W!k&Jh2xr8JWc>F6{>tLd%_ZR-wkGW zR){;c#H}x@XY;(&HVy+QiG|34pTY^TbyQ^?%6d2`P5&+~txK65^cr z3*D@}ywaY6_g)#u_t7IyG61nBDTmCCtB?qPybRrA*$}V_KkxR&G_Uw%sZAO5z`kcU z8FXFuM5x4zq{n@Iq+RItGmd`=e^eTi#Izb?*fkr}8&E~(>G;t1!>{`vCxq(=M2<35 z5XKV*=BKCJO?1TqYP3ctvJc7AbZ9?mH2tSca&74@O#_e)0a_^b^@v3)v+l+q)Bf78 z#r$`mmuGqKy+qUtH?plY8sts65Xuz@)&RA^LD%6=mAaVhJ8 zv6Z?KZ@}=cY=|6$>Rvq{-KqeI=LaDjcG$m2aH1SxxU@@W>~e;o-+Q!O{m# zB-^0YG;;jsB3h%o&LST~fSV6w%zZG>6ji207ys3WbCVOu>?#q~g-9hAbe?h^P=y#;E_V_M}NlmFgH2m;WGDwlXya`jOU^e0z z!W`wu{_}J;%?Ii8??0DqeyFbxm$K53n#;sT@`tyl3NKA=%oYmWQPMDn&0im;=s$z( z*cYZlYyFNU?HbO+)2P`lb{#oz{+pAksKF<PDxyr=>|EHLeImxTqjYFheYM3 zfb&QPIIV@)5DgZ;shE{3B2iUtx?F4sz%4Q)Qy~&M?*+EJzBZSojdAYGl2c9vMo0Jz zoioy*McdK;7lYuYqBdwz;m@O8f7X3zPx1fHvV7qIZEZ>e|IDPe15?v?b^!-Le7)uK=E*r za(JM65FN-KM8ONUQXCEtw1vR+g9@$)0<*F-hu{A{Hj(CnCb4s7!T1@se~~(3k%fn7 zPh}P9t3-WMN#gJb+)X-K$L}gxZgS^IcKgi%paSW3{g3}@R26veBdVNyW1Q5lIrl<6 zO8>VO;7}>Erfpm>=!P)K10dIKV$t1L^XAzB*+yu~#rfU$cF;a{DlT1;Q+&=TcMqJU zbPP~voGh{rXckqN#FrwH0P(FxEWaKYq$GLj^6($Sz<1e|_D(ab^_aruoc{-5RFoco zOfD@Qj4^8}WJ&&d76+-(k_Nj=mJ~oHmN_bMD)f{dhWid=GQ^j89NquSmZYo*ydP(j zuWfpJH$J`%?GtTs(~|5}q9h!RcY^8i31CfToMW>Xz}_A}q7zh)Tma8;OtJ}c5(%^8 zzRws;*`OaFP~}X;qILdW7_4Ix0)7iJq~WAWQ%iu+slq3$#BR_zqsO1N=)|4ks^NA& zn1AoN<2#~qOu(T!Ne*8cWk63MU(m$VEElki?quj&IsBPK&>}pk>QN(dbfe$_GvoyE zBMGvZHU;m$1sO&ceTSVu_7#H7qfjj~XfCrL?nry>uAl(pGjL_ctt5MI8l5)+_}p_7 zO0})KLb(#=N<1xn{=_8aLL>HplqyIw(0t4AH05&WhiKMX_=}8Bj)=$0iN`)hqZ-40;g4^7`)c|_J^*T4SE3Fb1rnMz!Xvd zn|&!xGAU=X$OBht(3(KAZ0q>aIJw_eMv6y=`?~655MJ2Xw^aVDU>7% zHf+2!3()i#z;V2Zb>>QxlDkhX)2;3Wbq)dmd_9G7(CmD&KKXLX7X}LR>i4rTb77&E zC;wiISe(?KeL7M3sVwF=!vPc7byW9K?TP-c`o~T?!AjeKs}7$sc}>OV>c%q8YU?CE z>&OckBUS<}D)h_n8gB~pUO~{MDIj!}A(fs|Vfc5D0ds))u}$2-ZGITT4!JOYO;l!h zJt6Z!2)Lnu1+E|k2gPp^3F_iFewJPL8hOf=8A(qn|Fqh6nO2KuJkgJTfp8yyRvE(l zx#VtNEX%KW9xh99MZa~!Act|O!XfCG4~S zB$snhDT`re5CwhO%{+is@c>HRKYkmyUnenWQdY_|2USb#CW(Wv`*WE%Xi>NtGTs&R zI7ogTCDqH+R{~pm(gG!0s&(Cx9TWZ1tg9b)#e`yM>#j${<`~qS1)TRTvF>DF{oA$x zVB~?KfCsT8{FhuC{i`bB_~TOcjEZKCgrNmB7>2t_-4VG2%sa(zD^UEt}1Kq;r0fk z>TUhM^)ViD$c;iAV5B;z(hketuU;RTX=2?2VjIv79J9TXh)WEnNz|#NI)*3MrZF7I z&@i%qauEchQSq%8tChoXHZXKQ55E-xG{$LFFhcUaAPrAs^*#zqJIlWpNu>w1_eLOM z4L6}Ef}?YbKd1RHw;_{{^QD%ME4?@XGoC=%2PJzCQF7LEXt@p+35(~9a@KorX7FYS zME}tS)JElVk>}bUVI3z?p$enD;4S~9%wNn1^8<7Vh**MJnKXPLd-5(sZ^TF4slY+I zI|n&|O~YSS&gkq33Fn4@&{hU%0ggVd#3P!`aV*^ZF|U)_TwPFkhOAU0n77K5wzGKt z?^sU@ur)Ap#(Q9<)T<2Opr573jrMiEzud(wj+?oHuzGy>bdL0^&IVqK`O0Cf17p~j zZ?w_v>*xbjABR9G21yyh#lq4Iwcv9sL;qw71om-~1+BT4f#pfs1NQd{=eUYLLZ0&ZKNp5q1Pe3gwD`d&sA;>8bv(G${ zms$tPIhbhXcuyEN`G}asAxg=Ufs33Y5rm5{9V_#VXLM55ASK90Qocgm;LQhgKjDlz zX$3oC9S@mMM#SC|R(NEM6)4*SNp*6D`g?)xCKuoP115oqo^eF4?Ztb*yo=F{so*`5 zuy{D*_O3KpiQ#5^rdv;OQTIBbJ>~a>4$OL+rZA&mTT%N+B_K99%uN<8gR(fue`ddp2n6qX`kZ^wf+? z#Dbpk6&ZIByHM8U8pjz4n?|?KOK;65*10QQl}STZJZ8N4!od5j%~9%wvc^AQs_$V-m;zdQ&U-o0D+j zuac>Vd*wXU4ffLM(BMClbL(c?-Z-_g18|t=$w=Ul@s&b%fVj(IL_1G}eN3w}Vmm0U z<#tevGR*`=Pk*AQa*3G2eq^jCk9aqbH`>n?xbbmL47B@t(cg6~rQY=6@N?VvB42t? zux5o8IqT471?_nm?@t1S*vYZ6DpRc-4bXZ%2i|TIb94#>M*6*-m#OsCaUO_mY*F_R|GdO_ zFk$)+3sE`zQL+`wv1+|<1&RswhmX8XA(;dRF zo5$X}RM&mh`7aM8!*gJ&0^=E7v!|aWY-(NlfN*AnY!$UC2t z8?BI1-@-L##{3~tVi?EiK16Z+B5=zYoWrn?xE=yrr#-b5w= zI=Vmd#`LIOQx+6Vd(8R(Y#P%w#*I%uxl3bj)otECA5dqFl4K^Iw@*6J8vEN%>CMpY zbIjLX_jO;GQl9OtumUweGyj|ZpJ=)klQ~ejZK*nVr6>Lb*Cuvk=fm6N8VSlv6Tg@7 zU+6P0Fe~y_y;Hgs{9jbSN5@MwJa397fV41>g3z)zZMntu`uZ8=jN>AqxrAKkJysXB zo&Rfs$%j^3b3yHbu%NALo-wKn0HaopCQzU8T#a9vk^#yWz+rV}bu5x*FqS!Y7^6i( zbNUBJoes5i_TEhgeNc$aQ{hEgzo|EzYJwT)>Y$(8Z-bu90wr{x&eB-3P)lFS@Db&= z(gxOdeX54yqA0irD1dO6-d?2Y(@&Pt{+$#z{)2&c?8zVb-PJ~m8q6Ti=orf z4UbDr41n7d=KtIMPnvb?1PQ_Jva&p>Zk<-G%nn4s+0Zwa}!)nq&JvUo^bs?R`3GxB7h8Ntf1`Yxk>j1?R4?|^^%?E z9q5p~dai(FtFNsXX4y>!TuqCg9elMn1;}3=G9F}udI7ypTayr3x7e|rS>``{WqS|R zHvZNCdIFZqmns$*>??K*!O`Vw2jd*WXbP!YjM5Yo@u~Kf@mqICy5k4_XVY)I=PzQe zq4K*gaE{OZ>EjZj4Ks>J7QFO{is(-xEVMf#3f`Dsu8F&)s$|IJk3Rod%0Yy6t)v}o zv{x?_NPx+MGUA|!O>Bi&_xFF)*)9c{mQ#;w>o|S{N!E&0^QC*m+Cekd&JCpAV|GDo zClylErO6D!lIq0%pSoJK%FuUKNqbuOFg(=D`G`VD8V5~Z#Gh-s<41^oZYb&Oh9>Ea zxW+hWTlk*C%{?rT>a zM{f8_tFMMefWE!CckUV*yo%NOz=Cr$ zfk#UqVTOo0!@=<;o1Q!kj&JSv3*XIKHepdB#h(7OETu6>7lb`vi|d#sUu*2 zez`)n=++xz-PC_i^UPaGXESY8*5ow$JDx_f_L8Ga22o?A${r|lW6C`!yP|J9AkXDD zscwZvEubfg5DR*mMwFks(m&fy{q5O(ZFKp^piu+Uqb-9Rr}RcH0qo4dLx+|wiiG|w z`tk9!w`w8>{(lS|02@5TX)30H-1q#6{)`5-8OUjJq~>|c5fSN?M8c&|gjN4)j_-z5 z1(ZaSaG;AHT!%E}D0Cpo08)DdSbROLR%ErI^328af2vZp*g1}bGV0`PdA+|vh=E5( zzvURUF}Wbl=ZyHpC=~FND|8Co0zvgS$W()k@1G;f{%dO2mvpYbC5q_J9HF*LQm`*% zJh>OdsR*oN0owTX?2_mf&hcduzyZ1T78#NHDWOI)msii4Y2ACEab}}|$P`ugssAkH z3Da<%fH3$GemTzEE4B1{_Y4zNQvfc5~o=1nr_CKd}I9AI81 z5{OLKEz6|~B7^N<#y2Tz%&dYO%{bpb0or>J1%KLcPoi6vq`Hy+jw{hkuBfvC(EFB_vd3Z1z`;`N)^Y8z)I^=vXlo=VNrEW(4)Q7%kItXdVF`ko&^KIqDmo|J*2wY z%4%ZW2bwML<|fNMYAe#;dVBx(PHF5)rU&92{UV{UTqBQ=B4|c!zq~$Ye|FM2CRCXH z1kN`g$CB=;%taNZy#AI;FR?ijK*9GnBUQ19T;$(|;f!B!IhCyKTsc1hqO@nHY zw%Cmq!l?v=x4ZrYbsu=J+42p{c)_Jv@pmZ zI0kn5hpGOen@mp$RtYL$o)=LNqj1t#%U6-s;-$T%O0%|Lnd}o=qlfd0{iH6t#Qt9T zluG|BcB@aU`@dp?s810*a35p1>rWF3kKc1WG3UQWNYHob0zJUl>qY)GD@fJK1#LQu z3irQX)wh6Sow3XO8aP=!Y|}9~D@SObl{>&3)_yQuDt>bf&3>EOxfQ_A>1v=Sq}z8) zf%0lESygiUM$m`9Y0nrBoPs+e>VA;7>~9NrPT#nN|?e$|0vqRUvQ3b4@K? zV_~O})CfKx^++4$1vzcn0+&l))r$O!ITN*}whB%CS@EeSmobAPXPKkJFnP||-)GT; zi;U-g^xjR5bxaWRtw=~;^h|)zdu+^QE+>O*q+`!1bPibPWDfi^NGj3Q6MyLso?F!3 zr%C#ic~3dzHi&2y{LU>4=$@Oeem88i^~}>sWWIgPav^1}&NNq25+N~2$>0XFOL6{H z<^LRDENl++FWoM`Nnv6*{^Z6mSFDYeJW{PpB=CVI*ffGLEWI>ki>3zKg6Zum1OvS) zR>&vlp>j(VqM#?qu$b@*tCjVB4VP0+V~OKnZsyU8qkqN7-2|;Lr|4~a{rLW(97JJ5?0e*qqKdrV@w z2n!0`U1%>n9dR6&bMhy^MJVdClI@U6(F%TZslCdQ=h#Jr7~C~pwqZkcF}GS(GblWYI}cnfbfLRHoq ziBX)k&cZc~?u;0o*l6iP1?aVmo!EyA6?Y!qVpHWaXPncY(@ml8sT1FAVjkXzb4x9U zhlX!G+2&h4z1Ft1Q2lx{PXTd$7IOraUUmBly`g;RpEtMo(-IBP zeA$`_Q|0tOz;rT{$U7FX>cM(UZIOSAmM8&i%;lzA8}|cQls*evWR{)t+1DU}QX&Sf zZMR14ecC+wp#mRhn_p!kN_gvdm|103{B0WXUMZmb@=5s7BSmvcTGW~=2e-x zWN7|WSqhV7xkbfrQEpuZ^kwt)YzP?kpVJ@jjubTZ-ebD7rj_+dadrVE)qyf9nxoL| z0eib?vJ@HBc>*pN{%pLR99;;$s`Bp!A9>4lmD!pR?HnwG_Yeu*lz6;R4$}D(QP82W z&=AO5Rre0za{SGJHBo?%JQi&zzyyin0MKmAg&&XlDg7d=<6;;;6M9c?B(eYT<74HV z--9OpD)UjvXJp@R&v8+&iqtkh%K)R{!*Ee|u-Kdnf!um=*5BcsA*yj#Firuk37`ZU z<@Cn4BNo4G`W_E?`yT+a0AnP6i#}mXRjnQd>FvtIx?{EB-l0i|f(kgv^8$w~0o)(r zQn*{a*@sA}TviFpoA{+`A7_Qb-eG=B`u}pz(A01HzIe!ZGz_W;qTIfHm*j)=~Lc1Xh?oFQfpeD3hmpz-HtMso|=@eW;&kK ze?;=2UPV&>mc4i|F9+GnEJulj>Ay$|RI||-HfMQ(>xEcdkxb#6D?7_S3nF4zeMN9X zw>ha(?X4eFGPPSmZw;|S?=6#t3W~S3ZOqa0R|bED3c}I`p9Q2S1=8TYpJTP|rA}-9 zVpXzq-=W35S9-!x+YH{VCNVySFNEjvEAPd`=uDkDQCj=9vd*PkHy!FK za!|s={0b?$|E_uc*w6N6o{eTwhe^dozNXdazzwY9 z|21`=HxR30id`nY-5facMrtT;^>*V$^?SG`E3&|&VFN4mjgkoKoiO@BC{v*;86SNi z8;WN{<3Pslfuj}r#;WJp!nu9t?f#Q{U{yw?8g$FqvXeHx4xvM&;?}!*XIpVW;G%>% zPGECpf@;=WGNL#zX#EqLTOSY$0K$k-RB6{|4^xd1%E!ei0q26}KX;X1 z^u`Jjpj74EJlH|2G--ZQ(1DE0z+^wlvihCIET(+>ufZ?wBkCfOw%WBaoYYjLAuWb>XfRL@)Wqaxn{Sm3U)Syj#n}fdHj0k7ZS^=6$L@G;vCY3vB&dop zaO1c57L*(z>QrLC2c?>%oKN%nZ{cLY=m-~huCl=)(R`m?+-Y1BCm2}lYgCc^mfmS)7p*ZoqAGyjA%7!uJqCYJ#!N1X=$7DhhNtVlE zIR4*ZMe}++r)l} zmluDTX2azZm4E+a{^GBxK#8WQiIb@R0muh&4#32W21tpgRKM~dBFOk5L#2Pw<&Z>t z14z@W#u(t5NRY&EH@_&uTX$Pfs|J%mN(#(hTe0}{LY1qJR#W|RMU!y&1o|=ck~9ak zc~`aJ91SCbc4Rr1klu^A8Z=D1a`p;=4K_W%EYl-91UdyIz#K$PssR~tcuhS?n9zay4@791}FGOKg{+3>rB8gXZ_X zjJH#yR9x!SXma_$b_?*~ItI*MGi(7D>Y@Y^=iJo1<6eH={vz=|&Oh!^6Z_zlZi)Iw z*DOnLvj@7N{s30yGd~OlVemf(NwysjeKJ_NqV;?6esEu)7wp z?9V^Wz$pI^*@N{}r;>zWK)zJyQqtS#EOULA0F;vsZFF&ktDA19qzPe2?_f z8d3pA4PKCO>U(2?IsSS+B&uJGvb_>_%Rqa|V z8VnxUz|%k_fJvAme{GFWQ?60H96R*A2pFug&lTeyTHS!2@j^W zps!0$(y}sj-ff?saM_)q_kMqW=)Jnuq0Wmg>i)RAt>5AOpT|J{!u&c-4U??RRpAQPH>Gf?R1==ug593I!U>U#_NYD za+%QjehaM_n?Ts!45^Y#k$szrB`TNGw#9>OIwObi5gMz59*I*)pvR#7JrCZ1Jxs%0 zh3cG8?@$$U6ErKg{$3`D*2LWXrgB=|E%s>EC6iRgA!XWqT!XgUvJ(53&VDF-{yW_W z%tiUH)?Wsb&wNWFep(Q;;XE>Q-m*B(f7SG+*HKUkkn(~CWVS$+DM`xl;Mc#-;&KM! zW7u*mn}q5D+Zsu%)xH73PxO2_?f!wD>dv+snOblp$WS*+076&OCReTe&20d8A-GHF z9DvH?{-#rJ+R0%xL6@yYWjLvGx|{=S5!X;6%~agsBZnm_+oCn)R>o*0tpUu+4mH=T zZw8ic;S#TNel`d74>}jv2r-4s zScQZJw(b}=XTs#E^92BlDyH4#Z)8Q|p<wl&b|xS_Y(rww$H03+(j)=>DHbHDfLN9TB`246~T>Y=e>@O_^b zmnFd=p0xgHVg%c|jU>Cue~G^Q191kJfmApc>lfQS)eca$y<(J$hB2GO(ZzWyB33qn zPv!yAOM_B@;^<-&UTcjKI<1H~%hk>4%S}D!vaqI(`}6Pdr3I_7gWvHJJVql%=3?#G zJzhAv;~qp#s-fYtqj&m|2HK;S)~<-5r9!M>v~7)-U4U^mxRj z_0aW|70pboNG zVkPsGo2=5S|B2=I4}F0nfRogIW-yrgFsDNGy-X?;lBmQi7=pPa+)R@}AuP zl9$TE4xi`^=|^m@qYfN+t3!zM^Z3sO%8!q_VzIpNuWYBiFteL4mf)_V#|mI<8mG_dy=f1 zw1oL@nSs+&5$BHh-v-KO(18~M_yF8%HdUu$Ny_C&Uy0`IS|}S_QLD8x?3#NBQ(pF_ z{skXdPcr#DZKdB>*?`GG?96CsmH-Drv5tN!e*Mi@Tdb^ELhd>y9Vh#DUXJqmD!Vf} zyL+aW#9#5>n9wbG%Ba}-JEs10b2PU|@Z#Ln>zYgZDrk3*2Mwx~CHCL4^yBh=wx1W& zeYOcb&W^bzu}HrVcIH()7oZfj$!5nPxMUcbIP&WiDpGg~Y|nOgdynnIW)NFdjg}$V zhVfLe!FSju3UMHY7k@rYqc5df!?3qYrZF`hrq2I-CfD1-N0P?`UoC^mk1N^GC<`Ob z-SKkZ408{}^Sy(S=@kS`Mzy5%io36q?m}%FAQW`^=t22j4{VDOjMD ztkC*t^j_D=vQ-WFu?}vkbP(L9N-k$nTTJjE_4^nlLXXRwUy5+jj-)_&si!r{*D0_ZS-mQBV*+GgZlrhvqjq)zH|3M~@J|HLq^;`!&UYt}s;09DCjm__aatRKR zD-fT7=KUI#t5D{eXHTNFp={{f9hy|EeEGsvcHpTJa*+Q!9V~Ji8W!a6TZ>CnRHtK7 z#4H8)-}hr6_3JAPpxfJJ2exeiZPj79u15IG>Ai@Bu4FH`aWmAT_`y`6>ex09)jO`9 z)NGe(&o4)L_O)cB7Y#L8rZj&pr-?fMcGGl+EK+bi!i>M2c8dwby6weVI3~0?#{J$|U-(!|3fy(ZCJ!3g~;s9esVB!Bbw7`*AZ}8ZxHBxEcG)%*Y2@l_F-f zPy2cR6xjZa5j6n)(t}`F$E-NDH59S1O)3fW4RqX;Pgtvw1B{#j9X&t#&G$kURIh>8 zgHtVMmgtz+z#gPXgmdhE>v2Ty1PE8^d{vhlzOP%CMB|mKTTAQ>BFXZUs_Q5ylu7~6 zH#n^+dY>tK{Lc3z!p9>%zPKdTyXx}7Z9UR`t+KOzuma{VSD!UaLVXQ);?_E5&Z^~Q zZXnp4ceDdv7pK%8o3lLquXfgC!Rl~E&K6IjXf~@i0{K@xaM&C=6ZG;-F8`mak8%>M z9IIKL8Zz;8vYj{d)epxN8a!(ES>VWBFi;urzO6& zZa{Yo*Id!poI)dP8`A6DuM(tb>ugB>qOW9q+;dI<4- zD)b={me!`lC@-&$1|Uh++qyVKdrtCG8m0bn{%J>2ai-Tw&F#hoFu_P#)hCjml zo7nl+w6Xj^7)=ZBLGhnMP6G0zSO)u17fPK8z=fo@I#xh#5B2M9c*(L5(E`TR6z-QK3Iv%@lgf}c$p}RuqGXEb&{sP%weIX) z{k30mN0wcFf!?`iOp062JzO5$ipDn0rpat2SwE$#eHWl0PDx1&ye3cDkE7l56KU(l zlFhr?JZDb$EHZsdR8FT|GP^4}VH`Z>{g96;Ct)uGE5S|{u;18)yGQ}azsyTL|1-r{ z5ZI7F<_}K&?+!^|3ux%Z8z!k&PXnfLoRo5Uhk8v zU2j-Ps5VSX7M?}}&G?4Vy@k$y+FhFns&SF~owmNb_DqU^!;;=O`Ke@alG~VJe24;a zGq2B2_u+X_YYYYzdJ{?FCcg};cWz>rYmm0S5S1LyB=a`8FS$SH!JR}oj0{(w9c}H? zD2eF;57l&2K1NTj1{8+7W+(9@>W$yHrIQEPKDzigQS_496R2@_pJy1^#4qrUgU`G82agYYDu|eM%e+_Hh9%*L(dI%G9$_S10AQB|D@sFnL)hahLCljdT z&aNDzOh(~uEV|<;uM?1}jYBA3M?g}=|0Zbfs2CD_Fo&ziRXcyhWwy*U=CZ^?NHP}I zk+XKSHT+k^x}S}C>&Hw0r$2ld~QsWQ-!5_;=aenusMrq$`7G(Ih_FB@0{SmSnaI!b1I?hP4+?$bdr?M zCBiu0WwS|S1w7esPP>}rLI_zp&WWv0_FaKV?YvtK^o6$GQMY{$;6bjTG2*%vnjQtq zpckci@K@zJX0IKYkFwXdJb#LMdRpnAlr`(Xi>qTJ^cZY~SZHnFK5$syO6A|~&yb(U znV^pQJmkxhFR`*UUV#!1Daa zw;?p-b5cL~e!XoXl&MyOaTOW2f(5^y;P%17CvZ7s(2tyja|Y%=9WpfHO!;c=zA%Uj z5!(^OqU}w#7dtm>usH=bJfUY~{NbVXV^vxnZ;a58;p)(@={WugG~Kn?Wsx5KELch4 zE`F0BZ}#9sN%Pzl>eP|V%(`zxLMpQ`ZP_w=aWIydq)c&to*98yWFCKMDUKAR9@d1{ zCP_Rwei)bN6H3lzDNh+v?YV9ndxB8|YJnGd?0oat!J+S6UE`3t01sVatW44F>Vpnra}GXX z8BKY(u=C>~yY2chN%oE_C(ycj0YZ_QaAlm4x3%Kx$Rq5(#Duc zQa;Kh%|%UCA-g0bDr^j6P7T>Gxo7e^ zS?|d0SB*u~f9~7)IIrrM0Ts&sD8+zFB(pd~vUgvoYFS_Ss6mU_c*-;q$TkE_s_CAqh5 zZG-juQ`6<}Xo`5+$b;0!)*f)@giOm*al802b?I@fE}sunvy}Fe2jBYruJvhkDc6aE zWH=t*30xMZd=0gm>5MNE7@CY&|EY~R3U@BlbY*TDdaEPD&qFwADPS+rBRh`{az{_~jkXp9XW=)y707(vHQCaX&Ryr1&OuW_%9cG25$i(CN)xTX^%s zrIve-6A63$U_Zt$Yyv-<)?(a!OZ-z@VzB%wweNkPLZN|z5>P@HtTpmaP%xu6HzvWL zSNPB8Mqp(rEuI9T~6UtSyE-zYSUY1V8lD)Ygm|$k4A8{bX@nAVyQ`g7cCS zmY00Dlx!zT=X@A6C6Bi)R^C5%)uQR6^XVTiW9qdI!hW&$A9qlw$qyPrG@jeh@jfMM z@9iKC+LAb4v%;N@%K_diU(PR1DLXitsrpcwJ+p+87?6TI)l4t!%=!GU2&*!F9uq69 zB=HK|(@u7zyn;~jfeZ4VKr^hwSv$0*2S*%qyk^~eMpN4`&+$pvVpo^YxSpFCmgTd2 znVK($#K|P(mdQg{{?EJ#T1dl70l|&!l<;(|JZ?|s-$vMqf9=f|`Oad{FNgMbMN2>a z?G>b{lCAPLL>6gS*PJUb7Jn`4kcMO(y#Dc$kmcVhe>*jklMqb4eq>rTQMoEFi-jS} zM#eh!hpkIAr$+Ps-^y6uKjPV@K>^>I_c%bKXHZy&|2VUW!ikC7Rto7M^CLIj&ffdH zuAysd-Ofk+zFz+I4wK za^6!*^zQ6&Q>7%roks!g=~+DDya=1`7a zGt9f*waC#Apw@{Td&l!(8bt4>D`SM6NvL5Fm@nImc}|X#PBy#ikDHvhD98MSq%7&8 za`OD*wP-c&V441o>{FV7=2H#(jxL}7+G_4J;u7V#uwUxi%_mtvcqi~442e*+@BK78 z`SqD=St*8QD0$f3d7AJi)$XCqz5R`WukJ`ZR-6;cL^rGzZkU!@mdHLn#vSzN6rCFh zF|DXkxZS*T+6aw%qhNW(_&3*n9Shj|Lx+6l*7LJhDvAA`!Jh(j6^;O`aQLv&LR;v| zuTn~F9$)4=8}~XS|27$rBxEr@mGWC`-SGbYEJCE=Xhr9=;Gin-i0if!7GY^0+k|Mr z@OUaq%Eer%N`myb&_aES+q1%~5E$=!pK?n7BC+T3xUcTR)x9EZJWaYCaW-^?B$0bn zt5XLY*qe`5)P$SP^MVi5F+So3=1O$iZ1TZ{<&sbOQTy!?TXZiU--LJGGX~8|-^w_z zvM66PX^--#a{0IuSeEM#J?_>rm|qrdMyj1ECmbT`);^8I@9gy}>R^>sFz88CzWo_! z>rzOQveOpktlw=gH6-h~8h4<8&24r`q22Rz7fu?-FJVQNnt4k8HK{r3s=OUaN%ocg zMY7uF$g#co-cNTj02jXarh?5kV9rtMC~(XfLpi}qA403&P3+mMFE#15eh7)Xo0Nin_W0ea!UU9c{)m;&VzG5i(<#@OGPfj zGlHiG{#?%x^`r4wgnW!QsvI}%e#DhZRgl8`W4sP!O4#B%V?6dVY8fnkX&gTpH&iW4 zuv7Ca%ud)!AM#_DnG!fuJVtgV+GM<^|JUd6^)4yb(C0Aa9NUQx4Ta_MULJv$)U!29 zZwbe}#Ll$(NKn2eBHWD`PZXbMR%#_rZZ9@ZVN^Ofs4b2@eg2&ImcJ;^?JyIYOEvsn zPoBMZ(hYXKprYt;{#qf#CRkwe-h1tCRZcY%92UNC1KgYmPx9ESQ5OBYF+Fs@n3}^) zt-7rHJPEZvro7(=??+Z&_e$yehGjiw994T1E$N_(ClUU2r~fVw`qCt$I)6hz~m8O<-}ootc^wPXn1 zcPxcgC%virbXGAYQx}9l#^_Bjb-UiIi#=oYF zNq@`EvoB{THqq;rZM~iiB;PT5m=u1N2fVKOYMZw-big|L*7u+9keBXXeku&fIbSVw z6R(EKzDt$pEu}CVJL2H`pr$n~Iz8~<^JtKFc8GF|F2A@(X!V_YgJNmSAyZ%S67T^< z-T*JP{2u1lj=?}Fy*cmGW1pJn>Wi2vaJJ1%Goiwy0gPD{zuhZ zdMMLt?IYRuyc=eNvX-igZ0YaZHamlhaw9mVtDJU5>(|YI6gIOwXfAnDJ)S^~xLCWV zO#Q6Tx<=`emz;fV^SJ2YOhjtZtElkKpgYc*dZ4v`>iOCmg%gVH5Bjole;i9+d!7>Z zRlw`TOfff`oT_wB5@A7v2s|%4@nfRgBb!lubY5AF*C#sXu8qE{YTq3EYT+VhiD@}5 ztQ0KuQ_!SaGbZP;NlVuH-7msQuGGq&#@J7q<9vFV(tgX`^dwW%)7y)7m9g~}d7tMe z;(E;AUKR4_W;xRJMWsirYwmQ4+WGZaVKV$l?nJnH3VWlNG zG47Fn!G@-qPgEiaLX%fnKXI=r9i|nZ4Jmm`+0^J0`~YO( z)kYD(loFJE4!%F_LZfiQY%iV8`D*8REDE{dc~8!1*)Osb5PPJLnRNA1#v)DiAM3U1 zY#ioeMQ$ooxY%7ioAhJBoPDuNlS^cru~F>3|6nUi5~zj`4N?JubPIBDoNoz~{mdf4 zEtM_st>flhXDR!CGuQJ~Ge2pom;c4nA2rNSuI`=R2%Q&^{Zi8WTHxw^WJ9w~bdjZ@ zOTbp>%k{=-zFSvU0ov^W9P2Q|Iq2KaPWkyCK`*1##r?kcla9Y5eQ-3v@C80inUt^8 zs>MJu-gMQvA39GZtmS(hj3+vDQF#K+x9?@<=2R2#G&;{g7AU_7!pxleby}NBm7Mt7 z3zA{wAF^)QqC&IJptgt2Oe!)(J*nvNijete&Zec8Va9J8RNpgA31?{gdmn9%T=^DR zoXPR-Gk5W&^DBEzdynx~lKSttVbIsFO;I-U*hl^goo9Gj_TPBF(|ncl5kfBg;&7|C zR2ZJC@seuK@|cirkm_%kr|)+gtXJ9Gd0kcb$`j6hcl$z*t5=eCuCU$WmXd;{c$mzcNaW!rYvO7r5APG#Lt^@i4>a=kFa!Y zR(#L;uAp1oH#4qoDTSiQE3O z@aFBg*h6OqlvUSmgaLupz;5fj)X@0XTCR+8*`XIoFBJY$cy;y5MaJwBi!4qp&8*8; zeH6qm{oA^W9H~qq=-ztAO4kqvm8ne%g}PN<@b=&-skHxmOKZ2<2F_NkF=|=rrnw%rw2g!a765ibU{9W%O8tMFFs&v|k1b=;_9tk6f zL}lde-GCr$y};og!oEUoqo>O9cLb?FeaED3%bT5e8GhIP_S!`Li>I23n)e)WGllwH zUmb_v?c-MzxiPA(5OP=lQf0ow`qS9f@k);XgsAyYA~%ts+s4()faTv8#r6NR_nlEq z2Hm;{2tia5Kza>Gl_Et%Is^mKL5d0l6zN5!OP7c==}ka-k&c3tP=fR#2qIDgh7O@a zLJi#4@B7X@=f}D0-m~ugbJn`~k(GDNo;`cderNVGGnu`;CMl(EYUdIL_d_@5wZ0?@ zHC8Y7JXQ{vuK2{+l$dwhOy48d>o*>iYru<&U|rIH5*{pl)%#u|_UcRpUhEh#`fRLQ zJj0iovQp{#arkg;uEZ66O6b+jLanqWn$>|{w>^h+uiaNt@DetBn!#A%I&`{>z_>59 z-Bs*+(|x6C@|wdur|GTr0h=CNa`lkI}Tmr#V4}o01UM9_BGi1t8f^2bi0L zBv|Qn6PGFpi2!+v1p$t9TA?8!A+WVrIyy!Vk&tk%X~I+<5;T!caPdo*C=&eqCn?kX z{K=UfZ0&Bk1&52XkTYp)?LOzU+S-L!2{iW9qc1_*?ZH-DjXkLW!Hqre;M_%yxpRte zP`*lV$RY=VaA}!?^HLbV>6DcV8cp$k$8;d%DupU38FxrXT$?_aJMNpZh7}jDIGC2{ z3J^|;2}E@jNe&RGO$I?oNl17}fN$lIf2hj>1CfxZhk`DV5xbdE9bj`q#JY|iJ-tq32KIExaL zC8zkxb$LS=PM3U5}IxL2JK)j>b0x_NM`G7Y3=V%BgZ0mhu?UA z0Wi0_y1qQyMcoVf+0VFi#fzH2bFs&KDLn$A^NWhYHpAiRZR^`^(ig-Rt38@Ikeead z=YubfcBb79mEx3nrugL3HAn}K_=Ra8fm2zqc;m{=Urh${?=Uk{5nZ``R+26HHJhTObb>Dt3R%1o3e8HCIihyG6a)I3L!%b=8GJcs-PpThK;7_I8L!3rI63tAw1uex2%9 zzD|xSlu8PmQmzdx8OzjF*NjDfgNYrR;b6fKk$^~zoRA1| zf-E$IqL%8HHg5>un*_WA1N4kWsr)>i5MoiGc<}@6!eMtlDXtUuOs>i6sl%#-*~nEJ z3P^$qSrK_%^PGZ`3h6a%-fFa{8tFBAx=$Z8NOj0>;=BRj)u#fR!uH=P;W+R|-EJs{ z_V)#wh^dITd3C`w8RvdrZsywjZPoKa)XgT@Fy0U^=am#3r$!FD3u#vb?+a42O+aQD zs0+@~6t8&NM*cv!^m;()IV%K}w-%Pp{@L%+Wvbd|wAMix_o!+^L29z%5R>g>-{p+4 zjt2a$&v}8tMVMemP3N}(1NNvRd56Og zU%uSH?tEV$jMh)v#Z6H1#XT8$hj}XkTa7GYeSI2xF`7MA|9sq!hpIN8(V8gkS@l#!J$ZZU-Og^bLJb)d$ZgtocsO@Fd!j5KqYxkK<#V;+EN z4CXKmQWu~r5fInWfp52>z#)aPrOC9bZ<$ZrUeS63%GDR@(){^JWbb*G-!qG4ZJ>BJqTn;AEOKM;E*pUp z1}c12YEDz0dDuzzeEx{saj28gIyq?(KRy%V{smqy@a;Sll>6{u&zLEhaB_HRr!Hab zyFI|gFz7w#5Jv*I6@Z1|BQ^h+rbZS48g;@tHi8^0>TYYs)9%>im*g|y4(3jZd=+24 zxxYkLwBA9tJ=0=2x8p->9LJdK9gV#X;m;nQ@$ogd@LDT#pOql)Y>9r?l9^KHFb-m$ zTYa_$o6rt&JVf;d5pEvVnWg@%(;1d{WSI8Z9Q;c2zD_0ftH6 zO?TQo_1g|9QKp?u7h*Ek+24QYH-m{>d}c=9R~VsJC{ihrQ==yZM&pBHkxUzown0NQVkN$Nlc6-7Ejt#xMA^!5Iz=>CCU)2rlf z2!&5Z_ag=yj`nb4SGEWV?$mDA@vjNX7_aITz#ysnDsmmnx-aPkd`h;~-$j|khLzdv zX=%Nib}C)#P)AX=x2?ih%03F9&0t3#WWubL(CNJtCHN@s>k{`zZ{nM$ z&spMp#)V!}KWt;VpJu-1J}!R!Gl#g9!cf1n%#{j?qlbZ(3?G$wCgzlkS~CB{NW~%o zOyrIDGhm~*GB+FpdD#p^*4#J~Y>hCl$UhfbaxOn{UexiEI+0U5y(d)6pDdimNz7oy z^Uwq0Pg?dk#*r%Dj>$09Va^=ID zdCqTY=rj+HzkL>ATN^DO3&iK`DYHe&yt|J)X&`|DBhTt23i;FylMQBXNoiWyjorQy z1FjUh-fl4aq~^xuvWd<|NQ(O2d^y4SElV>kDU=vJby=#q{Rz`M!0^h*YOZkbm7lto)_h?3kCkJ3RReF>MMA^6DRUKU& z5^0u|f-W9YnUTXlmq!u2NxCLpcGrG9N4SVtwiH47Ob*6&(1H+0&-xV5wJesX;e)M_ zBdD`U49FS+jQQ^lqws;zCsO5<@TkPC(Emzf=yfJk{1iijFBfT7=nA?ruR{Sq&H@t>Wy@|W@>5d zo@e$}21=&ZV!0bfgp;+v1Q>=zY@)mQR0kQ?GhStt>z1`XiK;tShzB*oKm);`T<6E$ z0*7na(R}M!opfT>AES#j^f(@%)72*eYU-D8h&>AO*&$#M{TZL4neh zpky%*k^*vw>ZH`l)v=fp5Bc4P>*ulPN{{W8cCIotU&g_uN<@8lHS4G}^t=;}RD#$z z`bz3DzQ-?s`&(}7$Qs`6DE^ceS=~fUX+;H0@G;9z)TSsYVexDLra0kJc_zMOKAS)N zCNayDqb?4*dU_VsL?jh+Cc-AnS<9avc6&&fKpd4yg_GRRzUIb#f*zcD(FJn?LlAx* z=^W*y{AzcqW~@2Ywb`6lsOX-nlzMnHhQmwfwUmE%q{R+N1{nv;&Yw_kyC|qP2+wbQ z6&f11$onh|r}|30>t`I^qt{yAY+wa#X3lilqlvo$Ah-LAhu=kdsK`{!z`&EOu1TZa zbEYd~w@3iQBAJ|!5`@Rg)d1ym@~K2bU97I6h-_>LDemW(o(ha9|W@?*>{& zcn0njV$uV}?IQN`tt0k%BDBV{{S?&WNM5XRsebZ(q4T?cWa;w#w+8BFr>DnDB;J z+E3g{jq(mUbEe>%8MSoYtVTG*JUzEy?9Ok(*s`6=T!NAZfw^nRR7*C;9NBIqhNnTx z?J4Tk;9nRBwTw?>H(Xy_;O|6Z!kp{(03QqHJ_4{nqpFW_mXy~s(x*|?qAxVT;Vq0EHGfB2ByR+isblcZPWBqRQL+Lr! zf~IoXH6g$G;T4{ju7!(pUN3^4l0%WUOwVzyiiX*BZqp7T?Ru^>qi%P+Cu_~wmtW6c zfJRS8fauxo4mVTr#WMUrzT$u`_k1-m!s?ctcdq&C^VIgL!CG8L?dUzN?T3PFVf{@J z-lFHOcES8}X`g?^M2%-vB>0qYzRw=7zusb`({fNN5+^M;hh_dPr^Ccgoa?wqf5aK1 zcgOq}jpfEqtENX`E|w);;k$^rPZhJb3_W$h4UB2mXR%=3^z(9bG6$R4Tzyl*%zp(g|(wz#7|ocdbFhZD8Dcc*Ir{U zbM;93S~2N5Z+de1V`_rQWTks*o>u#wcXY@`D5$HtX;YLMQ8s^?gs#QD<4h>M*aDDckkDP0q(Q}NDECNq2QwKyk)|&ZZsMZNd|=ZqsY_btuCkGG?kHDpAxO1wB+o7I&mn5mFQ(E_kUP z-G8;m5-4hsFUKIZq7;aKWbh!gVDX8R(+7OewS=-2+AB;CrN8GZmK)%&po9ZPq2;HE zebe`iqIO{Gie>$WA799r&hZ=?HEr#Ctp3ELCZK-Mj52#TeUUZP#tDVJD8?Jw)X{y)zV3d4<;SX@8@fP7< zC8sI0wm6TCMel9cJ=g4CuZhr4aI9(p8VHT#qw7K4PrHiO?K)AM*fa^SHD9HAS7O}n z>RPzVd0plMTIR>OOf}>@s7enc5iX{yGx6aB#PI^Aywekhsci z<7&`p$e)l%eIR?AFa49PeH3<}d1xG!w3CL39;z4F1H*jQci6b6No%=OhhGV$uYT(_ z3I!EX%K)*SLk9|gYoW631ksE9^WgT0_p?cSD6iIq!V@;jpe_8U0?vOlGS20a5m1$< z*-Ph){tUlzj#c>$&3tWP{*2w)<;NIzI_zqH)k4V# zOWkENWh581cIH%V&u>FLg^R;&f*$pc8@V0Qs>O^*REv{Gm)?GiTWSL)+R|_?$KZKB zT4t~F=kc;nX!lIU^T#u;Da=++f-k{9_+8vl>EjC*zT-l%Kxh(jj8U9}MK_)}&Yy0n zy)jSpEltcyQLKo;MnvaU?pQge8>L?msupRx0Rx3qiF-oX z6c)VKxm8POaM>z#@^JgMH9w?q7PE`r=hnkA``5l}%o4huVLoQXC3 zs3FrQHs?^bw*hv-#m64C)Sv&s@Py`$hMPZafYF7xDRR9quBebkD_Yk+%krl`$;2)- z9^kwA`u5;y+jp^5N52*$>!*mzD}~7TzMV);3qVGv7IVwbUJ{vZXqNCCw1hQabI-5#bdl|D zUJ5h4W4c}AC!n(-hgc~rjUJmj^zo@bADcN|kNmC;+;zytd4I+R!DUXWarU@PiiVHPE*)lHhb1%z`B@sxX7$ZKF%1ua1isIB9&CvBx!3z>-a~?Qq z2r><#NOv9FfpB7{5P`^qo!5@sjjJ|$!3(GzqiKw2`3cKjDrbg6m2<>I-$P84A zSONIl!u!>uqh(ltzffkPBbt7K0~^V6&lC~~-=BXM@Xp8zj*;o?TCl%d0}`7J*sKFj zJw9le*x7iVok-xyQ#~rj(b2d$@m;s`wn(K_D&7|=r#b@b$3i)sr0;Op-L;#ogN$Ht0{n` zMBPjpA213YYJ<%~kt9LF2;^AP&S>|h}$S0=caCRl)><$u}*~2fo z<)wa=a%his{**a3d)!-;4%&S1#;e3XcYlzwPW>A&ed^Da5euZgpnNtb*T=PFN}pgC zDd#cSJpM-;2HrRHn_&0{y*RvM*6Yb%U(H}X#FFicpVbdrhmV)Zrt_@8+z0Y!Wy^9} zsaYq1--|ZSrqW3NCvOcPmZI89290yn8x>?63(P)jNQQHQ;c_U5TRMFBDi9~DTI31^ zMAZ@40k#1U|KFTQ|36l6 a`GPDe&RU%%g+H7G_-Lx@!YWm*-uw?X(qJ0^ literal 0 HcmV?d00001 diff --git a/vignettes/deconvoluting-spectra.Rmd b/vignettes/deconvoluting-spectra.Rmd new file mode 100644 index 0000000..0d80721 --- /dev/null +++ b/vignettes/deconvoluting-spectra.Rmd @@ -0,0 +1,208 @@ +--- +title: "Deconvoluting Spectra" +author: "Philip Bulsink" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{deconvoluting-spectra} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + + +# Deconvoluting Spectra with PlotFTIR + +## Introduction + +Spectral deconvolution and peak fitting are integral to the understanding and comparison of FTIR spectra. By peak fitting, quantification of components, discovery of subtle shoulder peaks or comparisons of subtle spectral changes are facilitated with ease. These tasks, as well as others, are possible by using `PlotFTIR`. An example of these capabilities is worked here. + +## Data Preparation + +We'll load some data from the package and use it for this example. We'll plot the spectra so there's an understanding of what we're working with. + + +``` r +library(PlotFTIR) + +isopropanol <- sample_spectra[sample_spectra$sample_id == 'isopropanol', ] + +plot_ftir(ftir = isopropanol, plot_title = "Isopropanol FTIR Spectra") |> + move_plot_legend('bottom') +``` + +

+plot of chunk setup +

plot of chunk setup

+
+ +In this spectra we can see a few identifiable features. A broad peak from 3500 to 3000 cm⁻¹ corresponds to the O-H stretch of isopropanol. Sharp peaks at 2900 to 2800 cm⁻¹ are assignable to C-H stretching. The sharp peaks above 1500 cm⁻¹ correspond to O-H bending, C-O stretching and C-H bending, as well as some background absorption. + +## Deconvoluting the Spectra + +The `PlotFTIR` package has a number of functions to do peak fitting / deconvolutional analysis. These permit peak discovery by `find_ftir_peaks()`, and fitting peaks by expectation maximization algorithms in `fit_ftir_peaks()`. The latter function can use a peak list provided (from literature, other spectra, or from the `find_ftir_peaks()` function), or will internally call `find_ftir_peaks()` if no peak list is given. + +### Finding Peaks + +The first function to explore is `find_ftir_peaks()`. This function uses second derivatives of a Savitzky-Golay smoothed spectra (spectra is smoothed to reduce noise and spurious hits) to identify maxima - see the documentation for `PlotFTIR::smooth_ftir()` for more information on the smoothing algorithm. It further validates the derivative-discovered peak list with a standard maxima-finder to ensure broad peaks (like the O-H stretch) are included in the list. + + +``` r +peaklist <- find_ftir_peaks(ftir = isopropanol) + +str(peaklist) +#> num [1:45] 662 686 710 816 857 ... +``` + +This list includes just the wavenumbers (x axis values) of the peaks - it does not have any information on the peak height or width. Those will be numerically evaluated in our peak fitting discussion below. + +***Note that additional smoothing, peak filtering and peak selection parameters are available, check the documentation for a detailed dive into those options*** + +### Fitting Peaks + +The primary goal of peak-fitting is the determination of location, width, and intensity (height) of the peaks. These are performed as one peak fitting function call to `fit_peaks()`. This function uses expectation maximization algorithms (an iterative algorithm that optimizes peak parameters (position, height, and width) to best match the observed spectrum) as initially published by Matsumura *et. al.* in 2019 and 2021. The functions have been modified slightly in this package but were releaed in the `EMpeaksR` package initially. + +The function `fit_peaks()` requires the spectra be provided. Optionally, a `peak_list` may be passed - this is useful when using peaks found in a different sample's spectra to compare the differences in the two spectra's peaks. If so, consider setting the the argument `fixed_peaks` to `TRUE`, this prevents the peaks from being moved along the x axis to fully optimize the fitting to the spectra (which is the default behaviour). You might fix the peak locations for direct comparison with a known standard or another spectrum, rather than allowing the algorithm to slightly adjust the peak positions for the best mathematical fit to the current spectrum. + +Finally, the method (essentially, the peak type) can be passed to the function. For this, the options are `gaussian`, `lorentzian`, `pseudo-voigt` and `doniach-šunjić-gauss`. Short-forms of those options are accepted in the argument call, see the documentation for `fit_peaks()` for clarification. The default is to use pseudo-Voigt peaks, this is the theoretical peak shape (derived of Lorentzian peaks with Gaussian diffusion). + +The output of a call of `fit_peaks()` is a named list. This includes the resulting peak list, shape and size parameters (slightly different for each peak type) and information about the fitting process (e.g. the number of peak fitting iterations, peak location and shape at each iteration, fitting time and fit type). The output of this can be simplified to a data.frame with additional helper functions available in the package. + +We'll demonstrate the fitting with basic arguments here, and in later examples change some parameters. Note that additional unnamed arguments are available and the details are contained in the documentation for `fit_peaks()`. + + +``` r +isopropanol_fitted <- fit_peaks(ftir = isopropanol, peaklist = peaklist, method = "gauss") +``` + +This has made a named list with the following names: . It took 77 iterations (in 3.6 secs). + +Printing this `fitted` object directly is a bit of a mess. Instead, we'll display it as a `data.frame`. + + +``` r +head(fit_peak_df(isopropanol_fitted)) +#> sample_id peak wavenumber sigma mix_ratio peak_shape +#> 1 isopropanol 1 660.1588 6.579431 0.017278435 gauss +#> 2 isopropanol 2 688.5609 17.281410 0.034598063 gauss +#> 3 isopropanol 3 746.0055 37.092936 0.049503935 gauss +#> 4 isopropanol 4 816.4743 3.953275 0.016806822 gauss +#> 5 isopropanol 5 828.0860 17.561836 0.008822024 gauss +#> 6 isopropanol 6 875.9587 19.303977 0.004910134 gauss +``` + +This `data.frame` contains a row for each of the 45 peaks we found with `find_ftir_peaks()`. + +The `wavenumber` column evidently shows the wavenumber (x axis value) of each peak. Sigma is the peak width (determined as the standard deviation of the peak). For pseudo-Voigt and Doniach-Šunjić-Gauss shaped peaks, eta is the mixing parameter (from 0 to 1, where the eta value is the proportion of Lorentzian shape of the peak). Mix Ratio is the proportional area of the peak (not the peak height!), and peak_shape reflects the method used for peak fitting. + +Different methods may have different columns in this `data.frame` output. If calling `gauss` method, only sigma and mix_ratio indicate the peak shape and size. For `lorentz`, sigma is replaced by gam (gamma) which indicates peak width. In `doniach-šunjić-gauss`, a column called alpha is added to the sigma, eta, and mix_ratio; alpha corresponds to the skew shape of the peak. + +One might choose to use gaussian peak shapes for simiplicity (these are the most mentally accessible peak shapes for most users). Lorentzian shapes might be best for dilute gas spectra where spectral diffusion is less of an issue. The Doniach-Šunjić-Gauss shapes are less commonly observed in FTIR spectra but are commonly applied to XPS spectroscopy. + +## Plotting Fits + +While a numerical result such as provided by `fit_peak_df()` may satisfy a research need, it may be desirable to plot the fitted peaks against the original spectra. `PlotFTIR` has a collection of plotting functions to support visual analysis of the fitting. + +### Plotting Components + +It's possible to plot the fitted peaks components, the sum of fitted peaks and the initial spectra. + + +``` r +p <- plot_fit_ftir_peaks(ftir = isopropanol, fitted_peaks = isopropanol_fitted, plot_components = TRUE) |> + move_plot_legend('bottom') + +p +``` + +
+plot of chunk plot_fit_components +

plot of chunk plot_fit_components

+
+ +In this plot, the grey peaks are the individual peaks (at location *mu*, with width *sigma*, area *mix_ratio* and proportion Lorentz of *eta*). The red line is the sum of these peaks and the blue the original spectra. + +We can look closely at the more complex region from 1500 to 1000 cm⁻¹ to see how this spectrum fit matches the original. + +
+plot of chunk zoom_plot_fit +

plot of chunk zoom_plot_fit

+
+ +As with all `PlotFTIR` graphics, additional functions can be used to highlight regions of the plot, to zoom in on a particular spectral range, or move chart elements. + +The fit shows that a few peaks have been missed. Maybe retrying the fit with those added peaks will help? + + +``` r +isopropanol_fitted <- fit_peaks(ftir = isopropanol, peaklist = c(peaklist, 1120, 1365)) + +plot_fit_ftir_peaks(ftir = isopropanol, fitted_peaks = isopropanol_fitted, plot_components = TRUE) |> + zoom_in_on_range(c(1000, 1500)) |> + move_plot_legend('bottom') +``` + +
+plot of chunk repeat_isopropanol +

plot of chunk repeat_isopropanol

+
+ +This process works well iteratively to optimze the fitting of peaks. + +### Plotting Residuals + +Instead of plotting the fit with the spectra, it's also possible to plot the residual of the fit (i.e. the fitting error). This is a useful diagnostics tool to ensure that no major peaks have been missed or the fit algorithms incorrectly converged. + + +``` r +plot_fit_residuals(ftir = isopropanol, fitted_peaks = isopropanol_fitted) |> + move_plot_legend('bottom') +``` + +
+plot of chunk plot_residual +

plot of chunk plot_residual

+
+ +Look for systematic patterns in the residuals, which might indicate missing peaks, an inappropriate peak shape choice, or other model misfit issues. Ideally, the residuals should look like random noise centered around zero. + +## Repeating With Another Spectra + +We can repeat this analysis with another spectrum from `PlotFTIR`, demonstrating some optional arguements and changes. We'll start by using the peak list as optimized for isopropanol (which might not be wise), fit with pseudo-Voigt peaks, and look specifically at the fit around the C-H stretch area. As an example of additional parameters, the `maxit` (max iterations) argument is set at 100 (usually it's 1000). + + +``` r +toluene <- spectra[spectra$sample_id == 'toluene', ] + +toluene_fitted <- fit_peaks(toluene, peaklist = isopropanol_fitted$mu, method = 'pv', fixed_peaks = TRUE, maxit = 100) + +plot_fit_ftir_peaks(toluene, toluene_fitted) |> + zoom_in_on_range(c(3500, 2600)) |> + move_plot_legend('bottom') |> + add_band(wavenumber_range = c(3100, 3500), text = 'Absent O-H Stretch') +``` + +
+plot of chunk toluene_one +

plot of chunk toluene_one

+
+ +Our fit struggled significantly because the spectra are so different. You can see this in the peak fit performance through the C-H stretch region - there seems to be significant averaging of the peaks instead of a good fit. + +If instead we repeat this, allowing the fitting algorithm to use peaks found in the toluene spectra and allowing their locations to be optimized, we get the resulting fit curve: + + +``` r +toluene_fitted2 <- fit_peaks(toluene, method = 'pv', maxit = 100, fixed_peaks = FALSE) + +plot_fit_ftir_peaks(toluene, toluene_fitted2) |> + zoom_in_on_range(c(3500, 2600)) |> + move_plot_legend('bottom') |> + add_band(wavenumber_range = c(3100, 3500), text = 'Absent O-H Stretch') +``` + +
+plot of chunk toluene_two +

plot of chunk toluene_two

+
+ +This has a better alignment of the fitted curve to the sample spectra, and converged in 35 iterations in 85.3 secs. diff --git a/vignettes/deconvoluting-spectra.Rmd.orig b/vignettes/deconvoluting-spectra.Rmd.orig new file mode 100644 index 0000000..6ee91ae --- /dev/null +++ b/vignettes/deconvoluting-spectra.Rmd.orig @@ -0,0 +1,178 @@ +--- +title: "Deconvoluting Spectra" +author: "Philip Bulsink" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{deconvoluting-spectra} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r preamble, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + dpi = 300, + warning = FALSE, + message = FALSE, + fig.path = "deconvoluting-spectra-", + out.width = "90%", + fig.width = 6, + fig.height = 4 +) + +options(rmarkdown.html_vignette.check_title = FALSE) + +library() +library(ggplot2) +``` + +# Deconvoluting Spectra with + +## Introduction + +Spectral deconvolution and peak fitting are integral to the understanding and comparison of FTIR spectra. By peak fitting, quantification of components, discovery of subtle shoulder peaks or comparisons of subtle spectral changes are facilitated with ease. These tasks, as well as others, are possible by using ``. An example of these capabilities is worked here. + +## Data Preparation + +We'll load some data from the package and use it for this example. We'll plot the spectra so there's an understanding of what we're working with. + +```{r setup} +library(PlotFTIR) + +isopropanol <- sample_spectra[sample_spectra$sample_id == 'isopropanol', ] + +plot_ftir(ftir = isopropanol, plot_title = "Isopropanol FTIR Spectra") |> + move_plot_legend('bottom') +``` + +In this spectra we can see a few identifiable features. A broad peak from 3500 to 3000 cm⁻¹ corresponds to the O-H stretch of isopropanol. Sharp peaks at 2900 to 2800 cm⁻¹ are assignable to C-H stretching. The sharp peaks above 1500 cm⁻¹ correspond to O-H bending, C-O stretching and C-H bending, as well as some background absorption. + +## Deconvoluting the Spectra + +The `PlotFTIR` package has a number of functions to do peak fitting / deconvolutional analysis. These permit peak discovery by `find_ftir_peaks()`, and fitting peaks by expectation maximization algorithms in `fit_ftir_peaks()`. The latter function can use a peak list provided (from literature, other spectra, or from the `find_ftir_peaks()` function), or will internally call `find_ftir_peaks()` if no peak list is given. + +### Finding Peaks + +The first function to explore is `find_ftir_peaks()`. This function uses second derivatives of a Savitzky-Golay smoothed spectra (spectra is smoothed to reduce noise and spurious hits) to identify maxima - see the documentation for `PlotFTIR::smooth_ftir()` for more information on the smoothing algorithm. It further validates the derivative-discovered peak list with a standard maxima-finder to ensure broad peaks (like the O-H stretch) are included in the list. + +```{r find_peaks} +peaklist <- find_ftir_peaks(ftir = isopropanol) + +str(peaklist) +``` + +This list includes just the wavenumbers (x axis values) of the peaks - it does not have any information on the peak height or width. Those will be numerically evaluated in our peak fitting discussion below. + +***Note that additional smoothing, peak filtering and peak selection parameters are available, check the documentation for a detailed dive into those options*** + +### Fitting Peaks + +The primary goal of peak-fitting is the determination of location, width, and intensity (height) of the peaks. These are performed as one peak fitting function call to `fit_peaks()`. This function uses expectation maximization algorithms (an iterative algorithm that optimizes peak parameters (position, height, and width) to best match the observed spectrum) as initially published by Matsumura *et. al.* in 2019 and 2021. The functions have been modified slightly in this package but were releaed in the `EMpeaksR` package initially. + +The function `fit_peaks()` requires the spectra be provided. Optionally, a `peak_list` may be passed - this is useful when using peaks found in a different sample's spectra to compare the differences in the two spectra's peaks. If so, consider setting the the argument `fixed_peaks` to `TRUE`, this prevents the peaks from being moved along the x axis to fully optimize the fitting to the spectra (which is the default behaviour). You might fix the peak locations for direct comparison with a known standard or another spectrum, rather than allowing the algorithm to slightly adjust the peak positions for the best mathematical fit to the current spectrum. + +Finally, the method (essentially, the peak type) can be passed to the function. For this, the options are `gaussian`, `lorentzian`, `pseudo-voigt` and `doniach-šunjić-gauss`. Short-forms of those options are accepted in the argument call, see the documentation for `fit_peaks()` for clarification. The default is to use pseudo-Voigt peaks, this is the theoretical peak shape (derived of Lorentzian peaks with Gaussian diffusion). + +The output of a call of `fit_peaks()` is a named list. This includes the resulting peak list, shape and size parameters (slightly different for each peak type) and information about the fitting process (e.g. the number of peak fitting iterations, peak location and shape at each iteration, fitting time and fit type). The output of this can be simplified to a data.frame with additional helper functions available in the package. + +We'll demonstrate the fitting with basic arguments here, and in later examples change some parameters. Note that additional unnamed arguments are available and the details are contained in the documentation for `fit_peaks()`. + +```{r fit_peaks} +isopropanol_fitted <- fit_peaks(ftir = isopropanol, peaklist = peaklist, method = "gauss") +``` + +This has made a named list with the following names: `r cli::cli_text("{.val {names(isopropanol_fitted)}}")`. It took `r isopropanol_fitted$it` iterations (in `r round(as.double(isopropanol_fitted$cal_time),1)` `r units(isopropanol_fitted$cal_time)`). + +Printing this `fitted` object directly is a bit of a mess. Instead, we'll display it as a `data.frame`. + +```{r fit_peak_df} +head(fit_peak_df(isopropanol_fitted)) +``` + +This `data.frame` contains a row for each of the `r length(peaklist)` peaks we found with `find_ftir_peaks()`. + +The `wavenumber` column evidently shows the wavenumber (x axis value) of each peak. Sigma is the peak width (determined as the standard deviation of the peak). For pseudo-Voigt and Doniach-Šunjić-Gauss shaped peaks, eta is the mixing parameter (from 0 to 1, where the eta value is the proportion of Lorentzian shape of the peak). Mix Ratio is the proportional area of the peak (not the peak height!), and peak_shape reflects the method used for peak fitting. + +Different methods may have different columns in this `data.frame` output. If calling `gauss` method, only sigma and mix_ratio indicate the peak shape and size. For `lorentz`, sigma is replaced by gam (gamma) which indicates peak width. In `doniach-šunjić-gauss`, a column called alpha is added to the sigma, eta, and mix_ratio; alpha corresponds to the skew shape of the peak. + +One might choose to use gaussian peak shapes for simiplicity (these are the most mentally accessible peak shapes for most users). Lorentzian shapes might be best for dilute gas spectra where spectral diffusion is less of an issue. The Doniach-Šunjić-Gauss shapes are less commonly observed in FTIR spectra but are commonly applied to XPS spectroscopy. + +## Plotting Fits + +While a numerical result such as provided by `fit_peak_df()` may satisfy a research need, it may be desirable to plot the fitted peaks against the original spectra. PlotFTIR has a collection of plotting functions to support visual analysis of the fitting. + +### Plotting Components + +It's possible to plot the fitted peaks components, the sum of fitted peaks and the initial spectra. + +```{r plot_fit_components} +p <- plot_fit_ftir_peaks(ftir = isopropanol, fitted_peaks = isopropanol_fitted, plot_components = TRUE) |> + move_plot_legend('bottom') + +p +``` + +In this plot, the grey peaks are the individual peaks (at location *mu*, with width *sigma*, area *mix_ratio* and proportion Lorentz of *eta*). The red line is the sum of these peaks and the blue the original spectra. + +We can look closely at the more complex region from 1500 to 1000 cm⁻¹ to see how this spectrum fit matches the original. + +```{r zoom_plot_fit, echo = FALSE} +p |> + zoom_in_on_range(c(1000, 1500)) +``` + +As with all `PlotFTIR` graphics, additional functions can be used to highlight regions of the plot, to zoom in on a particular spectral range, or move chart elements. + +The fit shows that a few peaks have been missed. Maybe retrying the fit with those added peaks will help? + +```{r repeat_isopropanol} +isopropanol_fitted <- fit_peaks(ftir = isopropanol, peaklist = c(peaklist, 1120, 1365)) + +plot_fit_ftir_peaks(ftir = isopropanol, fitted_peaks = isopropanol_fitted, plot_components = TRUE) |> + zoom_in_on_range(c(1000, 1500)) |> + move_plot_legend('bottom') +``` + +This process works well iteratively to optimze the fitting of peaks. + +### Plotting Residuals + +Instead of plotting the fit with the spectra, it's also possible to plot the residual of the fit (i.e. the fitting error). This is a useful diagnostics tool to ensure that no major peaks have been missed or the fit algorithms incorrectly converged. + +```{r plot_residual} +plot_fit_residuals(ftir = isopropanol, fitted_peaks = isopropanol_fitted) |> + move_plot_legend('bottom') +``` + +Look for systematic patterns in the residuals, which might indicate missing peaks, an inappropriate peak shape choice, or other model misfit issues. Ideally, the residuals should look like random noise centered around zero. + +## Repeating With Another Spectra + +We can repeat this analysis with another spectrum from `PlotFTIR`, demonstrating some optional arguements and changes. We'll start by using the peak list as optimized for isopropanol (which might not be wise), fit with pseudo-Voigt peaks, and look specifically at the fit around the C-H stretch area. As an example of additional parameters, the `maxit` (max iterations) argument is set at 100 (usually it's 1000). + +```{r toluene_one} +toluene <- spectra[spectra$sample_id == 'toluene', ] + +toluene_fitted <- fit_peaks(toluene, peaklist = isopropanol_fitted$mu, method = 'pv', fixed_peaks = TRUE, maxit = 100) + +plot_fit_ftir_peaks(toluene, toluene_fitted) |> + zoom_in_on_range(c(3500, 2600)) |> + move_plot_legend('bottom') |> + add_band(wavenumber_range = c(3100, 3500), text = 'Absent O-H Stretch') +``` + +Our fit struggled significantly because the spectra are so different. You can see this in the peak fit performance through the C-H stretch region - there seems to be significant averaging of the peaks instead of a good fit. + +If instead we repeat this, allowing the fitting algorithm to use peaks found in the toluene spectra and allowing their locations to be optimized, we get the resulting fit curve: + +```{r toluene_two} +toluene_fitted2 <- fit_peaks(toluene, method = 'pv', maxit = 100, fixed_peaks = FALSE) + +plot_fit_ftir_peaks(toluene, toluene_fitted2) |> + zoom_in_on_range(c(3500, 2600)) |> + move_plot_legend('bottom') |> + add_band(wavenumber_range = c(3100, 3500), text = 'Absent O-H Stretch') +``` + +This has a better alignment of the fitted curve to the sample spectra, and converged in `r toluene_fitted2$it` iterations in `r round(as.double(toluene_fitted2$cal_time), 1)` `r units(toluene_fitted2$cal_time)`. diff --git a/vignettes/plotting_ftir_spectra.Rmd b/vignettes/plotting_ftir_spectra.Rmd index 8ed8926..416c6ae 100644 --- a/vignettes/plotting_ftir_spectra.Rmd +++ b/vignettes/plotting_ftir_spectra.Rmd @@ -200,7 +200,7 @@ It's possible to adjust baselines by a few different mechanisms in `PlotFTIR.` T This can be done on a single sample in the data set, on each sample individually (where the amount of shift could be different for each sample), or the amount of baseline shift can be applied to all of the samples at once (i.e. where the same shift is applied to all of the samples). -All of these shifts are achieved by calling the `recalculate_baseline()` function. +All of these shifts are achieved by calling the `shift_baseline()` function. For this demonstration, we'll use the `biodiesel` data contained in the package. It's a set of spectra of diesel samples containing increasing amount of biodiesel. @@ -213,7 +213,7 @@ If you look closely, all of the spectra are floating just above the 0 absorbance ```{r plot_biodiesel_baseline_1_en} biodiesel |> - recalculate_baseline(method = "average", wavenumber_range = c(2000, 1900), individually = TRUE) |> + shift_baseline(method = "average", wavenumber_range = c(2000, 1900), individually = TRUE) |> plot_ftir() |> zoom_in_on_range(c(2000, 1000)) ``` @@ -222,7 +222,7 @@ Of course, if you aren't careful with baselining you can get some weird results. ```{r plot_biodiesel_baseline_2_en} biodiesel |> - recalculate_baseline(method = "point", wavenumber_range = 1250, individually = TRUE) |> + shift_baseline(method = "point", wavenumber_range = 1250, individually = TRUE) |> plot_ftir() |> zoom_in_on_range(c(2000, 1000)) ``` @@ -231,7 +231,7 @@ Instead, it might be more useful to adjust all of the spectra by the minimum poi ```{r plot_biodiesel_baseline_3_en} biodiesel |> - recalculate_baseline(method = "minimum", wavenumber_range = c(1300, 1000), individually = FALSE) |> + shift_baseline(method = "minimum", wavenumber_range = c(1300, 1000), individually = FALSE) |> plot_ftir() |> zoom_in_on_range(c(2000, 1000)) ``` @@ -419,7 +419,7 @@ Il est possible d'ajuster les lignes de base par différents mécanismes dans `P Cette opération peut être effectuée sur un seul échantillon de l'ensemble de données, sur chaque échantillon individuellement (où l'ampleur du décalage peut être différente pour chaque échantillon), ou l'ampleur du décalage de la ligne de base peut être appliquée à tous les échantillons en même temps (c'est-à-dire que le même décalage est appliqué à tous les échantillons). -Tous ces changements sont réalisés en appelant la fonction `recalculate_baseline()`. +Tous ces changements sont réalisés en appelant la fonction `shift_baseline()`. Pour cette démonstration, nous utiliserons les données `biodiesel` contenues dans le paquet. Il s'agit d'un ensemble de spectres d'échantillons de diesel contenant des quantités croissantes de biodiesel. @@ -433,7 +433,7 @@ Si vous regardez de près, tous les spectres flottent juste au-dessus de la lign ```{r plot_biodiesel_baseline_1_fr} biodiesel |> - recalculate_baseline(method = "average", wavenumber_range = c(2000, 1900), individually = TRUE) |> + shift_baseline(method = "average", wavenumber_range = c(2000, 1900), individually = TRUE) |> plot_ftir(lang = "fr") |> zoom_in_on_range(c(2000, 1000)) ``` @@ -442,7 +442,7 @@ Bien sûr, si l'on ne fait pas attention à l'alignement de base, on peut obteni ```{r plot_biodiesel_baseline_2_fr} biodiesel |> - recalculate_baseline(method = "point", wavenumber_range = 1250, individually = TRUE) |> + shift_baseline(method = "point", wavenumber_range = 1250, individually = TRUE) |> plot_ftir(lang = "fr") |> zoom_in_on_range(c(2000, 1000)) ``` @@ -451,7 +451,7 @@ Il serait plus utile d'ajuster tous les spectres en fonction du point minimum d' ```{r plot_biodiesel_baseline_3_fr} biodiesel |> - recalculate_baseline(method = "minimum", wavenumber_range = c(1300, 1000), individually = FALSE) |> + shift_baseline(method = "minimum", wavenumber_range = c(1300, 1000), individually = FALSE) |> plot_ftir(lang = "fr") |> zoom_in_on_range(c(2000, 1000)) ``` From ea59bd3bf823249bf34bbfdaac5885f65ebc85c7 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 11:16:16 -0400 Subject: [PATCH 02/12] Cover for missing `signal` and `baseline` in tests --- R/maths.R | 18 ++++++++ tests/testthat/test-maths.R | 31 ++++++++----- tests/testthat/test-peak-fit.R | 80 ++++++++++++++++++++++++++++++++++ 3 files changed, 117 insertions(+), 12 deletions(-) diff --git a/R/maths.R b/R/maths.R index 47a7bc6..dfd196c 100644 --- a/R/maths.R +++ b/R/maths.R @@ -995,6 +995,15 @@ transmittance_to_absorbance <- function(ftir) { #' plot_ftir(ftir_smoothed, plot_title = "Smoothed FTIR") #' } smooth_ftir <- function(ftir, polynomial = 2, points = 13, derivative = 0) { + # Package Checks + if (!requireNamespace("signal", quietly = TRUE)) { + cli::cli_abort(c( + "{.pkg PlotFTIR} requires {.pkg signal} package installation.", + i = "Install {.pkg signal} with {.run install.packages('signal')}" + )) + } + + # arg checks if (!is.null(attr(ftir, "treatment"))) { if (grepl("smoothed", attr(ftir, "treatment"))) { cli::cli_warn(c( @@ -1097,6 +1106,15 @@ smooth_ftir <- function(ftir, polynomial = 2, points = 13, derivative = 0) { #' plot_ftir(ftir_baselined_lowpass, plot_title = "Lowpass Baselined FTIR") #' } baseline_ftir <- function(ftir, method = "modpolyfit", ...) { + # Package Checks + if (!requireNamespace("baseline", quietly = TRUE)) { + cli::cli_abort(c( + "{.pkg PlotFTIR} requires {.pkg baseline} package installation.", + i = "Install {.pkg baseline} with {.run install.packages('baseline')}" + )) + } + + # arg checks if ( !(method %in% c( diff --git a/tests/testthat/test-maths.R b/tests/testthat/test-maths.R index 13c9a36..471cec9 100644 --- a/tests/testthat/test-maths.R +++ b/tests/testthat/test-maths.R @@ -1622,22 +1622,26 @@ test_that("Normalization carries thorugh other functions", { }) -test_that("baseline_ftir returns a data.frame with same number of rows", { +test_that("baseline_ftir works", { test_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] + + if (!requireNamespace('baseline', quietly = TRUE)) { + expect_error( + baseline_ftir(test_data), + "requires baseline package installation" + ) + testthat::skip("baseline not available for testing") + } + expect_equal(nrow(baseline_ftir(test_data)), nrow(test_data)) expect_equal( unique(baseline_ftir(test_data)$sample_id), unique(test_data$sample_id) ) expect_equal(baseline_ftir(test_data)$wavenumber, test_data$wavenumber) -}) -test_that("baseline_ftir corrects attributes", { - test_data <- sample_spectra[ - sample_spectra$sample_id == "isopropanol", - ] baselined <- baseline_ftir(test_data) expect_equal("baselined", attr(baselined, "treatment")) @@ -1646,12 +1650,6 @@ test_that("baseline_ftir corrects attributes", { smooth_baselined <- baseline_ftir(smooth_ftir(test_data)) expect_true(grepl("baselined", attr(smooth_baselined, "treatment"))) expect_true(grepl("smoothed", attr(smooth_baselined, "treatment"))) -}) - -test_that("baseline_ftir error check is ok", { - test_data <- sample_spectra[ - sample_spectra$sample_id == "isopropanol", - ] expect_error( baseline_ftir(test_data, method = "fake"), @@ -1834,6 +1832,15 @@ test_that("smooth_ftir returns a data.frame with same number of rows", { test_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] + + if (!requireNamespace('signal', quietly = TRUE)) { + expect_error( + baseline_ftir(test_data), + "requires signal package installation" + ) + testthat::skip("signal not available for testing") + } + expect_equal( nrow(smooth_ftir(test_data, polynomial = 2, points = 13, derivative = 0)), nrow(test_data) diff --git a/tests/testthat/test-peak-fit.R b/tests/testthat/test-peak-fit.R index ad3b6dc..3b67304 100644 --- a/tests/testthat/test-peak-fit.R +++ b/tests/testthat/test-peak-fit.R @@ -4,6 +4,10 @@ test_that("find_ftir_peaks handles input errors ok", { wavenumber = seq(4000, 400, length.out = 100), absorbance = rnorm(100) ) + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + expect_error(find_ftir_peaks(ftir), NA) # No error expected expect_error( find_ftir_peaks(ftir, zero_norm = "non-numeric"), @@ -33,6 +37,10 @@ test_that("find_ftir_peaks handles input errors ok", { test_that("find_ftir_peaks returns sorted peaks", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- data.frame( sample_id = "sample1", wavenumber = seq(4000, 400, length.out = 100), @@ -43,6 +51,10 @@ test_that("find_ftir_peaks returns sorted peaks", { }) test_that("find_ftir_peaks returns correct peaks", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- data.frame( sample_id = "sample1", wavenumber = round(seq(4000, 400, length.out = 100)), @@ -65,6 +77,10 @@ test_that("find_ftir_peaks returns correct peaks", { }) test_that("Fixed Peak Locations don't move", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -152,6 +168,10 @@ test_that("Fixed Peak Locations don't move", { }) test_that("zero_normalization and zero_deriv check ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- data.frame( sample_id = "sample1", wavenumber = round(seq(4000, 400, length.out = 100)), @@ -223,6 +243,10 @@ test_that("zero_threshold sets to zero values below threshold", { }) test_that("fit_peaks (voigt) returns correct results", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- data.frame( sample_id = "sample1", wavenumber = round(seq(4000, 400, length.out = 100)), @@ -245,6 +269,10 @@ test_that("fit_peaks (voigt) returns correct results", { }) test_that("fit_peaks (gaussian) returns correct results", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- data.frame( sample_id = "sample1", wavenumber = round(seq(4000, 400, length.out = 100)), @@ -267,6 +295,10 @@ test_that("fit_peaks (gaussian) returns correct results", { }) test_that("fit_peaks (lorentz) returns correct results", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- data.frame( sample_id = "sample1", wavenumber = round(seq(4000, 400, length.out = 100)), @@ -289,6 +321,10 @@ test_that("fit_peaks (lorentz) returns correct results", { }) test_that("fit_peaks (dsg) returns correct results", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- data.frame( sample_id = "sample1", wavenumber = round(seq(4000, 400, length.out = 100)), @@ -311,6 +347,10 @@ test_that("fit_peaks (dsg) returns correct results", { }) test_that("fit_peaks error checks are ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -332,6 +372,10 @@ test_that("fit_peaks error checks are ok", { }) test_that("Peak data.frame is created ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -378,6 +422,10 @@ test_that("Peak data.frame is created ok", { }) test_that("get_fit_spectra works ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -400,6 +448,10 @@ test_that("get_fit_spectra works ok", { }) test_that("get_fit_spectra checks are ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -427,6 +479,10 @@ test_that("get_fit_spectra checks are ok", { test_that("plot_fit_ftir_peaks work", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -462,6 +518,10 @@ test_that("plot_fit_ftir_peaks work", { }) test_that("plot_fit_residuals work", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -497,6 +557,10 @@ test_that("plot_fit_residuals work", { }) test_that("plot_components work", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -537,6 +601,10 @@ test_that("plot_components work", { }) test_that("plot_fit_ftir_peaks error checks are ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + if (!require("ggplot2", quietly = TRUE)) { testthat::skip("ggplot2 not available for testing fit peak plot production") } @@ -579,6 +647,10 @@ test_that("plot_fit_ftir_peaks error checks are ok", { }) test_that("plot_fit_residuals error checks are ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + if (!require("ggplot2", quietly = TRUE)) { testthat::skip( "ggplot2 not available for testing fit residual plot production" @@ -620,6 +692,10 @@ test_that("plot_fit_residuals error checks are ok", { }) test_that("plot_components error checks are ok", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + if (!require("ggplot2", quietly = TRUE)) { testthat::skip( "ggplot2 not available for testing fit component plot production" @@ -661,6 +737,10 @@ test_that("plot_components error checks are ok", { }) test_that("Languages are handled properly", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + if (!require("ggplot2", quietly = TRUE)) { testthat::skip( "ggplot2 not available for testing fit component plot production" From c439fc192fd23e1e1c731ffea0177b34060adc83 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 11:30:08 -0400 Subject: [PATCH 03/12] Fixing more hard test failures --- R/io.R | 2 +- R/manipulations.R | 16 ++++++++-------- R/utils.R | 2 +- tests/testthat/test-manipulations.R | 4 ++-- tests/testthat/test-maths.R | 16 +++++++++++++++- tests/testthat/test-peak-fit.R | 6 +++--- tests/testthat/test-plot_ftir.R | 10 +++++----- 7 files changed, 35 insertions(+), 21 deletions(-) diff --git a/R/io.R b/R/io.R index 0d0f0e2..5063ff7 100644 --- a/R/io.R +++ b/R/io.R @@ -504,7 +504,7 @@ save_plot <- function(ftir_spectra_plot, filename, ...) { )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::save_plt}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) diff --git a/R/manipulations.R b/R/manipulations.R index 38b8180..06256db 100644 --- a/R/manipulations.R +++ b/R/manipulations.R @@ -46,7 +46,7 @@ zoom_in_on_range <- function(ftir_spectra_plot, zoom_range = c(1000, 1900)) { )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) @@ -160,7 +160,7 @@ compress_trans <- function(intercept = 2000, ratio = 5) { i = "Did you accidentally put {.code -} on a new line?" )) } - if (!ggplot2::is.ggplot(plot)) { + if (!ggplot2::is_ggplot(plot)) { cli::cli_abort( "You need to have a ggplot on the left side. You provided {.obj_type_friendly { plot }}." ) @@ -228,7 +228,7 @@ compress_low_energy <- function( )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::compress_low_energy}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) @@ -397,7 +397,7 @@ add_wavenumber_marker <- function( text <- as.character(as.integer(wavenumber)) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) @@ -484,7 +484,7 @@ rename_plot_sample_ids <- function(ftir_spectra_plot, sample_ids) { )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::rename_plot_sample_ids}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) @@ -608,7 +608,7 @@ move_plot_legend <- function( i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}" )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::move_plot_legend}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) @@ -708,7 +708,7 @@ highlight_sample <- function(ftir_spectra_plot, sample_ids, ...) { )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::highlight_sample}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) @@ -803,7 +803,7 @@ add_band <- function( )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::add_band}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) diff --git a/R/utils.R b/R/utils.R index 4b6a7da..66e6397 100644 --- a/R/utils.R +++ b/R/utils.R @@ -33,7 +33,7 @@ get_plot_sample_ids <- function(ftir_spectra_plot) { i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}" )) } - if (!ggplot2::is.ggplot(ftir_spectra_plot)) { + if (!ggplot2::is_ggplot(ftir_spectra_plot)) { cli::cli_abort( "Error in {.fn PlotFTIR::get_plot_sample_ids}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}." ) diff --git a/tests/testthat/test-manipulations.R b/tests/testthat/test-manipulations.R index 0f72710..b9d6340 100644 --- a/tests/testthat/test-manipulations.R +++ b/tests/testthat/test-manipulations.R @@ -289,7 +289,7 @@ test_that("rename is ok", { ) rp <- rename_plot_sample_ids(p, new_ids) - expect_true(ggplot2::is.ggplot(rp)) + expect_true(ggplot2::is_ggplot(rp)) expect_true("Toluene" %in% rp$scales$scales[[1]]$labels) expect_true("C7 Alkane" %in% rp$scales$scales[[1]]$labels) @@ -307,7 +307,7 @@ test_that("rename is ok", { # check only partial names still makes a plot rp <- rename_plot_sample_ids(p, new_ids[1]) - expect_true(ggplot2::is.ggplot(rp)) + expect_true(ggplot2::is_ggplot(rp)) expect_true("Toluene" %in% rp$scales$scales[[1]]$labels) expect_false("C7 Alkane" %in% rp$scales$scales[[1]]$labels) }) diff --git a/tests/testthat/test-maths.R b/tests/testthat/test-maths.R index 471cec9..7dd7123 100644 --- a/tests/testthat/test-maths.R +++ b/tests/testthat/test-maths.R @@ -1759,6 +1759,9 @@ test_that("remove_continuum_ftir warns when continuum has already been removed", }) test_that("remove_continuum_ftir works after other treatments.", { + if (!requireNamespace('baselined', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } ftir_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -1835,7 +1838,7 @@ test_that("smooth_ftir returns a data.frame with same number of rows", { if (!requireNamespace('signal', quietly = TRUE)) { expect_error( - baseline_ftir(test_data), + smooth_ftir(test_data), "requires signal package installation" ) testthat::skip("signal not available for testing") @@ -1878,6 +1881,10 @@ test_that("smooth_ftir returns a data.frame with same number of rows", { }) test_that("smooth_ftir checks repeat calls", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + test_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -1891,6 +1898,13 @@ test_that("smooth_ftir checks repeat calls", { }) test_that("smooth_ftir corrects attributes", { + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + if (!requireNamespace('baseline', quietly = TRUE)) { + testthat::skip("baseline not available for testing") + } + test_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] diff --git a/tests/testthat/test-peak-fit.R b/tests/testthat/test-peak-fit.R index 3b67304..9ddb7a4 100644 --- a/tests/testthat/test-peak-fit.R +++ b/tests/testthat/test-peak-fit.R @@ -501,7 +501,7 @@ test_that("plot_fit_ftir_peaks work", { } p <- plot_fit_ftir_peaks(ftir, fitpeaks) - expect_true(ggplot2::is.ggplot(p)) + expect_true(ggplot2::is_ggplot(p)) expect_equal(p$labels$title, "Fitted FTIR Plot") expect_equal( p$labels$subtitle, @@ -540,7 +540,7 @@ test_that("plot_fit_residuals work", { } p <- plot_fit_residuals(ftir, fitpeaks) - expect_true(ggplot2::is.ggplot(p)) + expect_true(ggplot2::is_ggplot(p)) expect_equal(p$labels$title, "Residual Plot") expect_equal( p$labels$subtitle, @@ -581,7 +581,7 @@ test_that("plot_components work", { p <- plot_components(ftir, fitpeaks) - expect_true(ggplot2::is.ggplot(p)) + expect_true(ggplot2::is_ggplot(p)) expect_equal(p$labels$title, "Fitted FTIR Plot") expect_equal( p$labels$subtitle, diff --git a/tests/testthat/test-plot_ftir.R b/tests/testthat/test-plot_ftir.R index ff5f10f..9eeb104 100644 --- a/tests/testthat/test-plot_ftir.R +++ b/tests/testthat/test-plot_ftir.R @@ -17,19 +17,19 @@ test_that("Plots are generated", { p4 <- plot_ftir_stacked(absorbance_to_transmittance(biodiesel)) p5 <- plot_ftir(normalize_spectra(biodiesel)) - expect_true(ggplot2::is.ggplot(p1)) - expect_true(ggplot2::is.ggplot(p2)) + expect_true(ggplot2::is_ggplot(p1)) + expect_true(ggplot2::is_ggplot(p2)) expect_equal(p1$labels$y, "Absorbance") expect_equal(p2$labels$y, "Absorbance (a.u.)") - expect_true(ggplot2::is.ggplot(p3)) - expect_true(ggplot2::is.ggplot(p4)) + expect_true(ggplot2::is_ggplot(p3)) + expect_true(ggplot2::is_ggplot(p4)) expect_equal(p3$label$y, "% Transmittance") expect_equal(p4$label$y, "Transmittance (a.u.)") expect_equal(p5$label$y, "Normalized Absorbance") # ensure lots of samples can be plotted with rollover to viridis palette. p6 <- suppressWarnings(plot_ftir(rbind(biodiesel, sample_spectra))) - expect_true(ggplot2::is.ggplot(p6)) + expect_true(ggplot2::is_ggplot(p6)) expect_equal(p1$labels$y, "Absorbance") }) From 0fa05679eb78cfb27d4aae074293a783ff6ccb1f Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 13:14:49 -0400 Subject: [PATCH 04/12] Escape package install requirements in Examples --- R/maths.R | 20 +++++++++++--------- R/peak-fit.R | 22 +++++++++++++++------- 2 files changed, 26 insertions(+), 16 deletions(-) diff --git a/R/maths.R b/R/maths.R index dfd196c..7339c5b 100644 --- a/R/maths.R +++ b/R/maths.R @@ -987,9 +987,11 @@ transmittance_to_absorbance <- function(ftir) { #' sample_spectra$sample_id == "isopropanol", #' ] #' -#' # Apply smoothing -#' ftir_smoothed <- smooth_ftir(ftir_data) - +#' if (requireNamespace("signal", quietly = TRUE)) { +#' # Apply smoothing +#' ftir_smoothed <- smooth_ftir(ftir_data) +#' } +#' #' # --- Optional: Visualize the results --- #' \dontrun{ #' plot_ftir(ftir_smoothed, plot_title = "Smoothed FTIR") @@ -1092,13 +1094,13 @@ smooth_ftir <- function(ftir, polynomial = 2, points = 13, derivative = 0) { #' ftir_data <- sample_spectra[ #' sample_spectra$sample_id == "isopropanol", #' ] +#' if (requireNamespace("baseline", quietly = TRUE)) { +#' # Apply baseline correction using the default 'modpolyfit' method +#' ftir_baselined_modpoly <- baseline_ftir(ftir_data) #' -#' # Apply baseline correction using the default 'modpolyfit' method -#' ftir_baselined_modpoly <- baseline_ftir(ftir_data) -#' -#' # Apply baseline correction using the 'lowpass' method -#' ftir_baselined_lowpass <- baseline_ftir(ftir_data, method = "lowpass") -#' +#' # Apply baseline correction using the 'lowpass' method +#' ftir_baselined_lowpass <- baseline_ftir(ftir_data, method = "lowpass") +#' } #' # --- Optional: Visualize the results --- #' \dontrun{ #' plot_ftir(ftir_baselined_modpoly, plot_title = "ModPoly Baselined FTIR") diff --git a/R/peak-fit.R b/R/peak-fit.R index b497376..24dafd4 100644 --- a/R/peak-fit.R +++ b/R/peak-fit.R @@ -319,8 +319,10 @@ zero_threshold <- function(x, threshold = 1e-4) { #' fitted_voigt_default <- fit_peaks(ftir_data) #' print("Fitted Voigt Peaks (Default):") #' # Show key results like final parameters and convergence status -#' print(fit_peak_df(fitted_voigt_default)) -#' print(paste("Convergence:", fitted_voigt_default$convergence)) +#' if (requireNamespace("signal", quietly = TRUE)) { +#' print(fit_peak_df(fitted_voigt_default)) +#' print(paste("Convergence:", fitted_voigt_default$convergence)) +#' } #' #' \dontrun{ #' # Example 2: Fit peaks using the 'gauss' method @@ -525,14 +527,16 @@ fit_peaks <- function( #' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, #' ] #' -#' # First, fit the peaks (using the default 'voigt' method) -#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' if (requireNamespace("signal", quietly = TRUE)) { +#' # First, fit the peaks (using the default 'voigt' method) +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") #' #' # Now, convert the fitted model object to a data frame #' peak_df_voigt <- fit_peak_df(fitted_voigt) #' #' print("Peak Data Frame from Voigt Fit:") #' print(peak_df_voigt) +#' } fit_peak_df <- function(fitted_peaks) { peak_table <- data.frame( "sample_id" = fitted_peaks$sample_id, @@ -827,7 +831,9 @@ get_fit_spectra <- function(ftir, fitted_peaks, peak = NULL) { #' ] #' #' # First, fit the peaks using the default 'voigt' method -#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' if (requireNamespace("signal", quietly = TRUE)) { +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' } #' #' # --- Example 1: Plot components only (default) --- #' \dontrun{ @@ -1095,8 +1101,10 @@ plot_components <- function( #' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, #' ] #' -#' # First, fit the peaks using the default 'voigt' method -#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' if (requireNamespace("signal", quietly = TRUE)) { +#' # First, fit the peaks using the default 'voigt' method +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' } #' #' # --- Example 1: Plot residuals with default settings --- #' \dontrun{ From 919ab2d6e71d290752b5b616642b8255ba8b3d86 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 13:25:10 -0400 Subject: [PATCH 05/12] Update Docs --- man/baseline_ftir.Rd | 12 ++++++------ man/fit_peak_df.Rd | 6 ++++-- man/fit_peaks.Rd | 6 ++++-- man/plot_components.Rd | 4 +++- man/plot_fit_residuals.Rd | 6 ++++-- man/smooth_ftir.Rd | 7 +++++-- 6 files changed, 26 insertions(+), 15 deletions(-) diff --git a/man/baseline_ftir.Rd b/man/baseline_ftir.Rd index b4af120..c7173be 100644 --- a/man/baseline_ftir.Rd +++ b/man/baseline_ftir.Rd @@ -46,13 +46,13 @@ disponibles dans le package [baseline::baseline()]. ftir_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] +if (requireNamespace("baseline", quietly = TRUE)) { + # Apply baseline correction using the default 'modpolyfit' method + ftir_baselined_modpoly <- baseline_ftir(ftir_data) -# Apply baseline correction using the default 'modpolyfit' method -ftir_baselined_modpoly <- baseline_ftir(ftir_data) - -# Apply baseline correction using the 'lowpass' method -ftir_baselined_lowpass <- baseline_ftir(ftir_data, method = "lowpass") - + # Apply baseline correction using the 'lowpass' method + ftir_baselined_lowpass <- baseline_ftir(ftir_data, method = "lowpass") +} # --- Optional: Visualize the results --- \dontrun{ plot_ftir(ftir_baselined_modpoly, plot_title = "ModPoly Baselined FTIR") diff --git a/man/fit_peak_df.Rd b/man/fit_peak_df.Rd index b79a9f2..7787f24 100644 --- a/man/fit_peak_df.Rd +++ b/man/fit_peak_df.Rd @@ -33,8 +33,9 @@ ftir_data <- ftir_data[ ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, ] -# First, fit the peaks (using the default 'voigt' method) -fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +if (requireNamespace("signal", quietly = TRUE)) { + # First, fit the peaks (using the default 'voigt' method) + fitted_voigt <- fit_peaks(ftir_data, method = "voigt") # Now, convert the fitted model object to a data frame peak_df_voigt <- fit_peak_df(fitted_voigt) @@ -42,3 +43,4 @@ peak_df_voigt <- fit_peak_df(fitted_voigt) print("Peak Data Frame from Voigt Fit:") print(peak_df_voigt) } +} diff --git a/man/fit_peaks.Rd b/man/fit_peaks.Rd index 95e4cef..a21ed2e 100644 --- a/man/fit_peaks.Rd +++ b/man/fit_peaks.Rd @@ -98,8 +98,10 @@ ftir_data <- ftir_data[ fitted_voigt_default <- fit_peaks(ftir_data) print("Fitted Voigt Peaks (Default):") # Show key results like final parameters and convergence status -print(fit_peak_df(fitted_voigt_default)) -print(paste("Convergence:", fitted_voigt_default$convergence)) +if (requireNamespace("signal", quietly = TRUE)) { + print(fit_peak_df(fitted_voigt_default)) + print(paste("Convergence:", fitted_voigt_default$convergence)) +} \dontrun{ # Example 2: Fit peaks using the 'gauss' method diff --git a/man/plot_components.Rd b/man/plot_components.Rd index 9d763a9..1ae6ec4 100644 --- a/man/plot_components.Rd +++ b/man/plot_components.Rd @@ -72,7 +72,9 @@ ftir_data <- ftir_data[ ] # First, fit the peaks using the default 'voigt' method -fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +if (requireNamespace("signal", quietly = TRUE)) { + fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +} # --- Example 1: Plot components only (default) --- \dontrun{ diff --git a/man/plot_fit_residuals.Rd b/man/plot_fit_residuals.Rd index 8bc0b50..54dce48 100644 --- a/man/plot_fit_residuals.Rd +++ b/man/plot_fit_residuals.Rd @@ -68,8 +68,10 @@ ftir_data <- ftir_data[ ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, ] -# First, fit the peaks using the default 'voigt' method -fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +if (requireNamespace("signal", quietly = TRUE)) { + # First, fit the peaks using the default 'voigt' method + fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +} # --- Example 1: Plot residuals with default settings --- \dontrun{ diff --git a/man/smooth_ftir.Rd b/man/smooth_ftir.Rd index f89f33d..79ce3af 100644 --- a/man/smooth_ftir.Rd +++ b/man/smooth_ftir.Rd @@ -44,8 +44,11 @@ ftir_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] -# Apply smoothing -ftir_smoothed <- smooth_ftir(ftir_data) +if (requireNamespace("signal", quietly = TRUE)) { + # Apply smoothing + ftir_smoothed <- smooth_ftir(ftir_data) +} + # --- Optional: Visualize the results --- \dontrun{ plot_ftir(ftir_smoothed, plot_title = "Smoothed FTIR") From 67d9343c5916680a144375abe28800684a3b39a3 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 13:33:41 -0400 Subject: [PATCH 06/12] More examples escapes --- R/peak-fit.R | 26 ++++++++++++++------------ man/find_ftir_peaks.Rd | 26 ++++++++++++++------------ 2 files changed, 28 insertions(+), 24 deletions(-) diff --git a/R/peak-fit.R b/R/peak-fit.R index 24dafd4..c1ab3ca 100644 --- a/R/peak-fit.R +++ b/R/peak-fit.R @@ -65,19 +65,21 @@ #' ] #' #' # Find peaks using default settings -#' peaks_default <- find_ftir_peaks(ftir_data) -#' print("Peaks found with default settings:") -#' print(peaks_default) +#' if (requireNamespace("signal", quietly = TRUE)) { +#' peaks_default <- find_ftir_peaks(ftir_data) +#' print("Peaks found with default settings:") +#' print(peaks_default) #' -#' # Find peaks with adjusted smoothing and window parameters -#' # Example: Less smoothing on derivative, wider window for normal peaks -#' peaks_adjusted <- find_ftir_peaks( -#' ftir_data, -#' sg_n_deriv = 11, # Fewer points for derivative smoothing -#' window_norm = 15 # Wider window (wavenumbers) for normal peak check -#' ) -#' print("Peaks found with adjusted settings:") -#' print(peaks_adjusted) +#' # Find peaks with adjusted smoothing and window parameters +#' # Example: Less smoothing on derivative, wider window for normal peaks +#' peaks_adjusted <- find_ftir_peaks( +#' ftir_data, +#' sg_n_deriv = 11, # Fewer points for derivative smoothing +#' window_norm = 15 # Wider window (wavenumbers) for normal peak check +#' ) +#' print("Peaks found with adjusted settings:") +#' print(peaks_adjusted) +#' } find_ftir_peaks <- function(ftir, ...) { ftir <- PlotFTIR::check_ftir_data(ftir) diff --git a/man/find_ftir_peaks.Rd b/man/find_ftir_peaks.Rd index 871f6cc..003e5d3 100644 --- a/man/find_ftir_peaks.Rd +++ b/man/find_ftir_peaks.Rd @@ -74,19 +74,21 @@ ftir_data <- PlotFTIR::sample_spectra[ ] # Find peaks using default settings -peaks_default <- find_ftir_peaks(ftir_data) -print("Peaks found with default settings:") -print(peaks_default) +if (requireNamespace("signal", quietly = TRUE)) { + peaks_default <- find_ftir_peaks(ftir_data) + print("Peaks found with default settings:") + print(peaks_default) -# Find peaks with adjusted smoothing and window parameters -# Example: Less smoothing on derivative, wider window for normal peaks -peaks_adjusted <- find_ftir_peaks( - ftir_data, - sg_n_deriv = 11, # Fewer points for derivative smoothing - window_norm = 15 # Wider window (wavenumbers) for normal peak check -) -print("Peaks found with adjusted settings:") -print(peaks_adjusted) + # Find peaks with adjusted smoothing and window parameters + # Example: Less smoothing on derivative, wider window for normal peaks + peaks_adjusted <- find_ftir_peaks( + ftir_data, + sg_n_deriv = 11, # Fewer points for derivative smoothing + window_norm = 15 # Wider window (wavenumbers) for normal peak check + ) + print("Peaks found with adjusted settings:") + print(peaks_adjusted) +} } \references{ Savitzky, A.; Golay, M.J.E. (1964). "Smoothing and From 75d42bb89450ddd5ccb6e6179001ee40d2d5815e Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 13:45:22 -0400 Subject: [PATCH 07/12] More Examples Fixes --- R/peak-fit.R | 6 +++--- man/fit_peaks.Rd | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/peak-fit.R b/R/peak-fit.R index c1ab3ca..91199c2 100644 --- a/R/peak-fit.R +++ b/R/peak-fit.R @@ -318,10 +318,10 @@ zero_threshold <- function(x, threshold = 1e-4) { #' #' # Example 1: Fit peaks using the default 'voigt' method #' # Peaks will be found automatically using find_ftir_peaks defaults -#' fitted_voigt_default <- fit_peaks(ftir_data) -#' print("Fitted Voigt Peaks (Default):") -#' # Show key results like final parameters and convergence status #' if (requireNamespace("signal", quietly = TRUE)) { +#' fitted_voigt_default <- fit_peaks(ftir_data) +#' print("Fitted Voigt Peaks (Default):") +#' # Show key results like final parameters and convergence status #' print(fit_peak_df(fitted_voigt_default)) #' print(paste("Convergence:", fitted_voigt_default$convergence)) #' } diff --git a/man/fit_peaks.Rd b/man/fit_peaks.Rd index a21ed2e..e07bdcd 100644 --- a/man/fit_peaks.Rd +++ b/man/fit_peaks.Rd @@ -95,10 +95,10 @@ ftir_data <- ftir_data[ # Example 1: Fit peaks using the default 'voigt' method # Peaks will be found automatically using find_ftir_peaks defaults -fitted_voigt_default <- fit_peaks(ftir_data) -print("Fitted Voigt Peaks (Default):") -# Show key results like final parameters and convergence status if (requireNamespace("signal", quietly = TRUE)) { + fitted_voigt_default <- fit_peaks(ftir_data) + print("Fitted Voigt Peaks (Default):") + # Show key results like final parameters and convergence status print(fit_peak_df(fitted_voigt_default)) print(paste("Convergence:", fitted_voigt_default$convergence)) } From f2499fdd06623bb9a616b3a5b52a1150b1219506 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 14:24:35 -0400 Subject: [PATCH 08/12] Found another examples issue --- R/peak-fit.R | 17 ++++++++++++++--- man/find_ftir_peaks.Rd | 2 +- man/plot_fit_ftir_peaks.Rd | 6 ++++-- tests/testthat/test-maths.R | 4 ++++ 4 files changed, 23 insertions(+), 6 deletions(-) diff --git a/R/peak-fit.R b/R/peak-fit.R index 91199c2..4230b52 100644 --- a/R/peak-fit.R +++ b/R/peak-fit.R @@ -53,7 +53,7 @@ #' Un vecteur de nombres d'ondes correspondant aux pics trouvés dans les #' spectres IRTF fournis. #' @export -#' @seealso [signal::sgolayfilt()], [smooth_ftir()] +#' @seealso [signal::sgolayfilt()], [smooth_ftir()], [shift_baseline()] #' @md #' @references Savitzky, A.; Golay, M.J.E. (1964). "Smoothing and #' Differentiation of Data by Simplified Least Squares Procedures". Analytical @@ -81,6 +81,15 @@ #' print(peaks_adjusted) #' } find_ftir_peaks <- function(ftir, ...) { + #Check Packages + if (!requireNamespace("signal", quietly = TRUE)) { + cli::cli_abort(c( + "{.pkg PlotFTIR} requires {.pkg signal} package installation.", + i = "Install {.pkg signal} with {.run install.packages('signal')}" + )) + } + + #check args ftir <- PlotFTIR::check_ftir_data(ftir) if (length(unique(ftir$sample_id)) != 1) { @@ -1289,8 +1298,10 @@ plot_fit_residuals <- function(ftir, fitted_peaks, lang = NA, ...) { #' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, #' ] #' -#' # First, fit the peaks using the default 'voigt' method -#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' if(!requireNamespace('signal', quietly = TRUE)){ +#' # First, fit the peaks using the default 'voigt' method +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +#' } #' #' # --- Example 1: Plot original spectrum and the overall fitted sum --- #' \dontrun{ diff --git a/man/find_ftir_peaks.Rd b/man/find_ftir_peaks.Rd index 003e5d3..e2fbdba 100644 --- a/man/find_ftir_peaks.Rd +++ b/man/find_ftir_peaks.Rd @@ -96,5 +96,5 @@ Differentiation of Data by Simplified Least Squares Procedures". Analytical Chemistry 36. pp. 1627–1639. doi:10.1021/ac60214a047 } \seealso{ -\code{\link[signal:sgolayfilt]{signal::sgolayfilt()}}, \code{\link[=smooth_ftir]{smooth_ftir()}} +\code{\link[signal:sgolayfilt]{signal::sgolayfilt()}}, \code{\link[=smooth_ftir]{smooth_ftir()}}, \code{\link[=shift_baseline]{shift_baseline()}} } diff --git a/man/plot_fit_ftir_peaks.Rd b/man/plot_fit_ftir_peaks.Rd index 3e355ba..e2e6595 100644 --- a/man/plot_fit_ftir_peaks.Rd +++ b/man/plot_fit_ftir_peaks.Rd @@ -79,8 +79,10 @@ ftir_data <- ftir_data[ ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, ] -# First, fit the peaks using the default 'voigt' method -fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +if(!requireNamespace('signal', quietly = TRUE)){ + # First, fit the peaks using the default 'voigt' method + fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +} # --- Example 1: Plot original spectrum and the overall fitted sum --- \dontrun{ diff --git a/tests/testthat/test-maths.R b/tests/testthat/test-maths.R index 7dd7123..5c5fd33 100644 --- a/tests/testthat/test-maths.R +++ b/tests/testthat/test-maths.R @@ -1647,6 +1647,10 @@ test_that("baseline_ftir works", { expect_equal("baselined", attr(baselined, "treatment")) #make sure the attr is appended and not overwriting + if (!requireNamespace('signal', quietly = TRUE)) { + testthat::skip("signal not available for testing") + } + smooth_baselined <- baseline_ftir(smooth_ftir(test_data)) expect_true(grepl("baselined", attr(smooth_baselined, "treatment"))) expect_true(grepl("smoothed", attr(smooth_baselined, "treatment"))) From 5ccbf2dbe7ed534122b9ae8e3c1842ad3f5ead6b Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Tue, 29 Apr 2025 14:42:11 -0400 Subject: [PATCH 09/12] revert signal to 'imports' --- DESCRIPTION | 6 ++-- R/peak-fit.R | 66 ++++++++++++++----------------------- man/find_ftir_peaks.Rd | 26 +++++++-------- man/fit_peak_df.Rd | 6 ++-- man/fit_peaks.Rd | 13 ++++---- man/plot_components.Rd | 4 +-- man/plot_fit_residuals.Rd | 6 ++-- tests/testthat/test-maths.R | 23 ++----------- 8 files changed, 53 insertions(+), 97 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0048f14..87a5cb2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,7 +18,8 @@ LazyData: true Imports: cli, rlang, - scales + scales, + signal RoxygenNote: 7.3.2 Depends: R (>= 3.3) @@ -34,8 +35,7 @@ Suggests: ChemoSpec, R.utils, readJDX, - baseline, - signal + baseline Config/testthat/edition: 3 VignetteBuilder: knitr BugReports: https://github.com/NRCan/PlotFTIR/issues diff --git a/R/peak-fit.R b/R/peak-fit.R index 4230b52..26d6ecb 100644 --- a/R/peak-fit.R +++ b/R/peak-fit.R @@ -65,30 +65,20 @@ #' ] #' #' # Find peaks using default settings -#' if (requireNamespace("signal", quietly = TRUE)) { -#' peaks_default <- find_ftir_peaks(ftir_data) -#' print("Peaks found with default settings:") -#' print(peaks_default) -#' -#' # Find peaks with adjusted smoothing and window parameters -#' # Example: Less smoothing on derivative, wider window for normal peaks -#' peaks_adjusted <- find_ftir_peaks( -#' ftir_data, -#' sg_n_deriv = 11, # Fewer points for derivative smoothing -#' window_norm = 15 # Wider window (wavenumbers) for normal peak check -#' ) -#' print("Peaks found with adjusted settings:") -#' print(peaks_adjusted) -#' } +#' peaks_default <- find_ftir_peaks(ftir_data) +#' print("Peaks found with default settings:") +#' print(peaks_default) +#' +#' # Find peaks with adjusted smoothing and window parameters +#' # Example: Less smoothing on derivative, wider window for normal peaks +#' peaks_adjusted <- find_ftir_peaks( +#' ftir_data, +#' sg_n_deriv = 11, # Fewer points for derivative smoothing +#' window_norm = 15 # Wider window (wavenumbers) for normal peak check +#' ) +#' print("Peaks found with adjusted settings:") +#' print(peaks_adjusted) find_ftir_peaks <- function(ftir, ...) { - #Check Packages - if (!requireNamespace("signal", quietly = TRUE)) { - cli::cli_abort(c( - "{.pkg PlotFTIR} requires {.pkg signal} package installation.", - i = "Install {.pkg signal} with {.run install.packages('signal')}" - )) - } - #check args ftir <- PlotFTIR::check_ftir_data(ftir) @@ -327,13 +317,12 @@ zero_threshold <- function(x, threshold = 1e-4) { #' #' # Example 1: Fit peaks using the default 'voigt' method #' # Peaks will be found automatically using find_ftir_peaks defaults -#' if (requireNamespace("signal", quietly = TRUE)) { -#' fitted_voigt_default <- fit_peaks(ftir_data) -#' print("Fitted Voigt Peaks (Default):") -#' # Show key results like final parameters and convergence status -#' print(fit_peak_df(fitted_voigt_default)) -#' print(paste("Convergence:", fitted_voigt_default$convergence)) -#' } +#' fitted_voigt_default <- fit_peaks(ftir_data) +#' print("Fitted Voigt Peaks (Default):") +#' +#' # Show key results like final parameters and convergence status +#' print(fit_peak_df(fitted_voigt_default)) +#' print(paste("Convergence:", fitted_voigt_default$convergence)) #' #' \dontrun{ #' # Example 2: Fit peaks using the 'gauss' method @@ -538,16 +527,15 @@ fit_peaks <- function( #' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, #' ] #' -#' if (requireNamespace("signal", quietly = TRUE)) { -#' # First, fit the peaks (using the default 'voigt' method) -#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") + +#' # First, fit the peaks (using the default 'voigt' method) +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") #' #' # Now, convert the fitted model object to a data frame #' peak_df_voigt <- fit_peak_df(fitted_voigt) #' #' print("Peak Data Frame from Voigt Fit:") #' print(peak_df_voigt) -#' } fit_peak_df <- function(fitted_peaks) { peak_table <- data.frame( "sample_id" = fitted_peaks$sample_id, @@ -842,9 +830,7 @@ get_fit_spectra <- function(ftir, fitted_peaks, peak = NULL) { #' ] #' #' # First, fit the peaks using the default 'voigt' method -#' if (requireNamespace("signal", quietly = TRUE)) { -#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") -#' } +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") #' #' # --- Example 1: Plot components only (default) --- #' \dontrun{ @@ -1112,10 +1098,8 @@ plot_components <- function( #' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, #' ] #' -#' if (requireNamespace("signal", quietly = TRUE)) { -#' # First, fit the peaks using the default 'voigt' method -#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") -#' } +#' # First, fit the peaks using the default 'voigt' method +#' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") #' #' # --- Example 1: Plot residuals with default settings --- #' \dontrun{ diff --git a/man/find_ftir_peaks.Rd b/man/find_ftir_peaks.Rd index e2fbdba..17d9cc8 100644 --- a/man/find_ftir_peaks.Rd +++ b/man/find_ftir_peaks.Rd @@ -74,21 +74,19 @@ ftir_data <- PlotFTIR::sample_spectra[ ] # Find peaks using default settings -if (requireNamespace("signal", quietly = TRUE)) { - peaks_default <- find_ftir_peaks(ftir_data) - print("Peaks found with default settings:") - print(peaks_default) +peaks_default <- find_ftir_peaks(ftir_data) +print("Peaks found with default settings:") +print(peaks_default) - # Find peaks with adjusted smoothing and window parameters - # Example: Less smoothing on derivative, wider window for normal peaks - peaks_adjusted <- find_ftir_peaks( - ftir_data, - sg_n_deriv = 11, # Fewer points for derivative smoothing - window_norm = 15 # Wider window (wavenumbers) for normal peak check - ) - print("Peaks found with adjusted settings:") - print(peaks_adjusted) -} +# Find peaks with adjusted smoothing and window parameters +# Example: Less smoothing on derivative, wider window for normal peaks +peaks_adjusted <- find_ftir_peaks( + ftir_data, + sg_n_deriv = 11, # Fewer points for derivative smoothing + window_norm = 15 # Wider window (wavenumbers) for normal peak check +) +print("Peaks found with adjusted settings:") +print(peaks_adjusted) } \references{ Savitzky, A.; Golay, M.J.E. (1964). "Smoothing and diff --git a/man/fit_peak_df.Rd b/man/fit_peak_df.Rd index 7787f24..b79a9f2 100644 --- a/man/fit_peak_df.Rd +++ b/man/fit_peak_df.Rd @@ -33,9 +33,8 @@ ftir_data <- ftir_data[ ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, ] -if (requireNamespace("signal", quietly = TRUE)) { - # First, fit the peaks (using the default 'voigt' method) - fitted_voigt <- fit_peaks(ftir_data, method = "voigt") +# First, fit the peaks (using the default 'voigt' method) +fitted_voigt <- fit_peaks(ftir_data, method = "voigt") # Now, convert the fitted model object to a data frame peak_df_voigt <- fit_peak_df(fitted_voigt) @@ -43,4 +42,3 @@ peak_df_voigt <- fit_peak_df(fitted_voigt) print("Peak Data Frame from Voigt Fit:") print(peak_df_voigt) } -} diff --git a/man/fit_peaks.Rd b/man/fit_peaks.Rd index e07bdcd..4c47fe7 100644 --- a/man/fit_peaks.Rd +++ b/man/fit_peaks.Rd @@ -95,13 +95,12 @@ ftir_data <- ftir_data[ # Example 1: Fit peaks using the default 'voigt' method # Peaks will be found automatically using find_ftir_peaks defaults -if (requireNamespace("signal", quietly = TRUE)) { - fitted_voigt_default <- fit_peaks(ftir_data) - print("Fitted Voigt Peaks (Default):") - # Show key results like final parameters and convergence status - print(fit_peak_df(fitted_voigt_default)) - print(paste("Convergence:", fitted_voigt_default$convergence)) -} +fitted_voigt_default <- fit_peaks(ftir_data) +print("Fitted Voigt Peaks (Default):") + +# Show key results like final parameters and convergence status +print(fit_peak_df(fitted_voigt_default)) +print(paste("Convergence:", fitted_voigt_default$convergence)) \dontrun{ # Example 2: Fit peaks using the 'gauss' method diff --git a/man/plot_components.Rd b/man/plot_components.Rd index 1ae6ec4..9d763a9 100644 --- a/man/plot_components.Rd +++ b/man/plot_components.Rd @@ -72,9 +72,7 @@ ftir_data <- ftir_data[ ] # First, fit the peaks using the default 'voigt' method -if (requireNamespace("signal", quietly = TRUE)) { - fitted_voigt <- fit_peaks(ftir_data, method = "voigt") -} +fitted_voigt <- fit_peaks(ftir_data, method = "voigt") # --- Example 1: Plot components only (default) --- \dontrun{ diff --git a/man/plot_fit_residuals.Rd b/man/plot_fit_residuals.Rd index 54dce48..8bc0b50 100644 --- a/man/plot_fit_residuals.Rd +++ b/man/plot_fit_residuals.Rd @@ -68,10 +68,8 @@ ftir_data <- ftir_data[ ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, ] -if (requireNamespace("signal", quietly = TRUE)) { - # First, fit the peaks using the default 'voigt' method - fitted_voigt <- fit_peaks(ftir_data, method = "voigt") -} +# First, fit the peaks using the default 'voigt' method +fitted_voigt <- fit_peaks(ftir_data, method = "voigt") # --- Example 1: Plot residuals with default settings --- \dontrun{ diff --git a/tests/testthat/test-maths.R b/tests/testthat/test-maths.R index 5c5fd33..3453c41 100644 --- a/tests/testthat/test-maths.R +++ b/tests/testthat/test-maths.R @@ -1647,10 +1647,6 @@ test_that("baseline_ftir works", { expect_equal("baselined", attr(baselined, "treatment")) #make sure the attr is appended and not overwriting - if (!requireNamespace('signal', quietly = TRUE)) { - testthat::skip("signal not available for testing") - } - smooth_baselined <- baseline_ftir(smooth_ftir(test_data)) expect_true(grepl("baselined", attr(smooth_baselined, "treatment"))) expect_true(grepl("smoothed", attr(smooth_baselined, "treatment"))) @@ -1763,8 +1759,8 @@ test_that("remove_continuum_ftir warns when continuum has already been removed", }) test_that("remove_continuum_ftir works after other treatments.", { - if (!requireNamespace('baselined', quietly = TRUE)) { - testthat::skip("signal not available for testing") + if (!requireNamespace('baseline', quietly = TRUE)) { + testthat::skip("baseline not available for testing") } ftir_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", @@ -1840,14 +1836,6 @@ test_that("smooth_ftir returns a data.frame with same number of rows", { sample_spectra$sample_id == "isopropanol", ] - if (!requireNamespace('signal', quietly = TRUE)) { - expect_error( - smooth_ftir(test_data), - "requires signal package installation" - ) - testthat::skip("signal not available for testing") - } - expect_equal( nrow(smooth_ftir(test_data, polynomial = 2, points = 13, derivative = 0)), nrow(test_data) @@ -1885,10 +1873,6 @@ test_that("smooth_ftir returns a data.frame with same number of rows", { }) test_that("smooth_ftir checks repeat calls", { - if (!requireNamespace('signal', quietly = TRUE)) { - testthat::skip("signal not available for testing") - } - test_data <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -1902,9 +1886,6 @@ test_that("smooth_ftir checks repeat calls", { }) test_that("smooth_ftir corrects attributes", { - if (!requireNamespace('signal', quietly = TRUE)) { - testthat::skip("signal not available for testing") - } if (!requireNamespace('baseline', quietly = TRUE)) { testthat::skip("baseline not available for testing") } From 756eebe81eca6e3cab63be5b32258c5a24a83c94 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Wed, 30 Apr 2025 07:00:05 -0400 Subject: [PATCH 10/12] Skip tests without gghighlight --- tests/testthat/test-peak-fit.R | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/tests/testthat/test-peak-fit.R b/tests/testthat/test-peak-fit.R index 9ddb7a4..9b43ffa 100644 --- a/tests/testthat/test-peak-fit.R +++ b/tests/testthat/test-peak-fit.R @@ -579,6 +579,18 @@ test_that("plot_components work", { ) } + if (!require("gghighlight", quietly = TRUE)) { + expect_error( + plot_components(ftir, fitpeaks), + "requires gghighlight package installation", + fixed = TRUE + ) + + testthat::skip( + "gghighlight not available for testing component plot production" + ) + } + p <- plot_components(ftir, fitpeaks) expect_true(ggplot2::is_ggplot(p)) @@ -657,6 +669,12 @@ test_that("plot_fit_residuals error checks are ok", { ) } + if (!require("gghighlight", quietly = TRUE)) { + testthat::skip( + "ggplot2 not available for testing fit residual plot production" + ) + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] @@ -702,6 +720,12 @@ test_that("plot_components error checks are ok", { ) } + if (!require("gghighlight", quietly = TRUE)) { + testthat::skip( + "gghighlight not available for testing fit component plot production" + ) + } + ftir <- sample_spectra[ sample_spectra$sample_id == "isopropanol", ] From e1091abe79e51bd7320315640765092383a0a6f5 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Wed, 30 Apr 2025 07:09:09 -0400 Subject: [PATCH 11/12] one more gghighlight skip --- tests/testthat/test-peak-fit.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-peak-fit.R b/tests/testthat/test-peak-fit.R index 9b43ffa..c30a262 100644 --- a/tests/testthat/test-peak-fit.R +++ b/tests/testthat/test-peak-fit.R @@ -793,6 +793,10 @@ test_that("Languages are handled properly", { "Residual of Voigt fitted peaks and isopropanol" ) + if (!requireNamespace('gghighlight')) { + testthat::skip("gghighlight not available for testing") + } + p <- plot_components(ftir, fitpeaks) expect_equal(p$labels$title, "Fitted FTIR Plot") expect_equal( From 7d98dc14bbb15127f558f1f8382bbe284856f2a6 Mon Sep 17 00:00:00 2001 From: Philip Bulsink Date: Wed, 30 Apr 2025 08:03:15 -0400 Subject: [PATCH 12/12] Style & Lint --- R/io.R | 50 ++++++------- R/manipulations.R | 6 +- R/maths.R | 34 ++++----- R/peak-fit.R | 130 ++++++++++++++++----------------- R/plot_ftir.R | 12 +-- R/utils.R | 6 +- R/zzz.R | 22 +++--- README.Rmd | 8 +- tests/testthat/test-io.R | 14 ++-- tests/testthat/test-maths.R | 10 +-- tests/testthat/test-peak-fit.R | 74 +++++++++---------- tests/testthat/test-utils.R | 16 ++-- 12 files changed, 192 insertions(+), 190 deletions(-) diff --git a/R/io.R b/R/io.R index 5063ff7..15ad455 100644 --- a/R/io.R +++ b/R/io.R @@ -189,15 +189,15 @@ read_ftir_directory <- function(path, files, sample_names = NA, ...) { ) } - if (!all(is.na(sample_names))) { + if (all(is.na(sample_names))) { + sample_names <- rep(NA, length(files)) + } else { if (length(sample_names) != length(files)) { cli::cli_abort(c( "Error in {.fn PlotFTIR::read_ftir_directory}: If providing {.arg sample_names} the same number of names as the number of {.arg files} must be provided.", i = "You provided {length(sample_names)} {.arg sample_name{?s}} and {length(files)} {.arg file{?s}}" )) } - } else { - sample_names <- rep(NA, length(files)) } ftir <- data.frame() @@ -219,11 +219,12 @@ read_ftir_directory <- function(path, files, sample_names = NA, ...) { } } }, - error = function(e) + error = function(e) { cli::cli_warn(c( "{e}", i = "{.fn PlotFTIR::read_ftir_directory} will try to continue with the next file." )) + } ) } if (nrow(ftir) > 0) { @@ -381,7 +382,10 @@ read_ftir_jdx <- function(path, file, sample_name = NA, ...) { ) } if ( - !grepl("INFRARED", toupper(metadata[grepl("DATATYPE|DATA TYPE", metadata)])) + !grepl( + "INFRARED", + toupper(metadata[grepl("DATATYPE|DATA TYPE", metadata)]) + ) ) { cli::cli_abort( c( @@ -392,9 +396,9 @@ read_ftir_jdx <- function(path, file, sample_name = NA, ...) { } intensity <- NA - if (any(grepl("absorbance", tolower(metadata)))) { + if (any(grepl("absorbance", tolower(metadata), fixed = TRUE))) { intensity <- "absorbance" - } else if (any(grepl("transmittance", tolower(metadata)))) { + } else if (any(grepl("transmittance", tolower(metadata), fixed = TRUE))) { intensity <- "transmittance" } @@ -402,13 +406,11 @@ read_ftir_jdx <- function(path, file, sample_name = NA, ...) { sample_name_jdx <- names(jdx[4]) if (is.na(sample_name)) { sample_name <- sample_name_jdx - } else { - if (sample_name != sample_name_jdx) { - cli::cli_alert_warning(c( - 'Note: provided sample name of "{sample_name}" does not match that contained in the .jdx file: "{sample_name_jdx}".', - i = "Will use the provided sample name." - )) - } + } else if (sample_name != sample_name_jdx) { + cli::cli_alert_warning(c( + 'Note: provided sample name of "{sample_name}" does not match that contained in the .jdx file: "{sample_name_jdx}".', + i = "Will use the provided sample name." + )) } ftir_data <- data.frame( @@ -418,7 +420,7 @@ read_ftir_jdx <- function(path, file, sample_name = NA, ...) { if (!is.na(intensity)) { if (intensity_type(ftir_data) != intensity) { - if (intensity == 'transmittance' & max(ftir_data$intensity < 1.2)) { + if (intensity == "transmittance" && max(ftir_data$intensity < 1.2)) { # It's possible to do transmittance in 0..1 scale instead of percent. # PlotFTIR works better with %Transmittance ftir_data$intensity <- ftir_data$intensity * 100 @@ -435,7 +437,7 @@ read_ftir_jdx <- function(path, file, sample_name = NA, ...) { intensity <- intensity_type(ftir_data) } - if (intensity == 'absorbance') { + if (intensity == "absorbance") { ftir_data$absorbance <- ftir_data$intensity } else { ftir_data$transmittance <- ftir_data$intensity @@ -554,7 +556,7 @@ ir_to_plotftir <- function(ir_data, what = NA) { # Param checks - if (!("ir" %in% class(ir_data))) { + if (!(inherits(ir_data, "ir"))) { cli::cli_abort( "Error in {.fn PlotFTIR::ir_to_plotftir}. {.arg ir_data} must be of class {.cls ir}, produced by the {.pkg ir} package. You provided {.obj_type_friendly {ir_data}}." ) @@ -564,7 +566,7 @@ ir_to_plotftir <- function(ir_data, what = NA) { what <- seq_along(ir_data$spectra) } - if (suppressWarnings(any(is.na(as.numeric(what))))) { + if (suppressWarnings(anyNA(as.numeric(what)))) { if (all(what %in% ir_data$id_sample)) { what <- which(what %in% ir_data$id_sample) } else { @@ -596,7 +598,7 @@ ir_to_df <- function(ir, what) { } # Param checks - if (!("ir" %in% class(ir))) { + if (!(inherits(ir, "ir"))) { cli::cli_abort( "Error in {.fn PlotFTIR::ir_to_df}. {.arg ir} must be of class {.cls ir}, produced by the {.pkg ir} package. You provided {.obj_type_friendly {ir}}." ) @@ -620,12 +622,10 @@ ir_to_df <- function(ir, what) { if (intensity == sample_intensity) { ftir <- rbind(ftir, sampleir) + } else if (intensity == "absorbance") { + ftir <- rbind(ftir, transmittance_to_absorbance(sampleir)) } else { - if (intensity == "absorbance") { - ftir <- rbind(ftir, transmittance_to_absorbance(sampleir)) - } else { - ftir <- rbind(ftir, absorbance_to_transmittance(sampleir)) - } + ftir <- rbind(ftir, absorbance_to_transmittance(sampleir)) } } @@ -905,7 +905,7 @@ chemospec_to_plotftir <- function(csdata) { } # Param Checks - if (!("Spectra" %in% class(csdata))) { + if (!(inherits(csdata, "Spectra"))) { cli::cli_abort( "Error in {.fn PlotFTIR::chemospec_to_plotftir}. {.arg csdata} must be of class {.cls Spectra}, produced by the {.pkg ChemoSpec} package. You provided {.obj_type_friendly {csdata}}." ) diff --git a/R/manipulations.R b/R/manipulations.R index 06256db..dfd0950 100644 --- a/R/manipulations.R +++ b/R/manipulations.R @@ -52,7 +52,7 @@ zoom_in_on_range <- function(ftir_spectra_plot, zoom_range = c(1000, 1900)) { ) } - if (!(length(zoom_range) == 2) || !all(is.numeric(zoom_range))) { + if (length(zoom_range) != 2 || !all(is.numeric(zoom_range))) { cli::cli_abort( "Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg zoom_range} must be a numeric vector of length two." ) @@ -69,7 +69,7 @@ zoom_in_on_range <- function(ftir_spectra_plot, zoom_range = c(1000, 1900)) { } if ("transmittance" %in% colnames(data)) { - if ('normal' %in% attr(ftir_spectra_plot, 'spectra_style')) { + if ("normal" %in% attr(ftir_spectra_plot, "spectra_style")) { yrange <- c(0, 100) } else { yrange <- c(0, max(c(data$transmittance, 100), na.rm = TRUE)) @@ -827,7 +827,7 @@ add_band <- function( text <- "" } - if (!(length(wavenumber_range) == 2) || !all(is.numeric(wavenumber_range))) { + if (length(wavenumber_range) != 2 || !all(is.numeric(wavenumber_range))) { cli::cli_abort( "Error in {.fn PlotFTIR::add_band}. {.arg wavenumber_range} must be a numeric vector of length two." ) diff --git a/R/maths.R b/R/maths.R index 7339c5b..89999bd 100644 --- a/R/maths.R +++ b/R/maths.R @@ -81,7 +81,7 @@ average_spectra <- function( all(other_wavenumbers %in% first_wavenumbers) ) { # make average - when all wavenumbers are present in all samples - if (grepl("absorbance", intensity_attribute)) { + if (grepl("absorbance", intensity_attribute, fixed = TRUE)) { avg_spectra <- stats::aggregate( absorbance ~ wavenumber, data = ftir, @@ -433,9 +433,9 @@ shift_baseline <- function( } if (length(wavenumber_range) < 1 || length(wavenumber_range) > 2) { - cli::cli_abort(c( + cli::cli_abort( "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be of length 1 or 2." - )) + ) } if (!(all(is.na(wavenumber_range)) || all(is.numeric(wavenumber_range)))) { cli::cli_abort(c( @@ -472,8 +472,8 @@ shift_baseline <- function( ) { cli::cli_abort(c( "Error in {.fn PlotFTIR::shift_baseline}. {.arg wavenumber_range} must be {.code NA} or two numeric values if {.code method = '{method}'}.", - i = "The minimum (for absorbance spectra) or maximum (for transmittance spectra) value between the provided wavenumbers will be used to baseline adjust data.", - i = "To adjust by a single point, call the function with {.code method = 'point'}" + "!" = "The minimum (for absorbance spectra) or maximum (for transmittance spectra) value between the provided wavenumbers will be used to baseline adjust data.", + "i" = "To adjust by a single point, call the function with {.code method = 'point'}" )) } @@ -799,11 +799,11 @@ normalize_spectra <- function(ftir, sample_ids = NA, wavenumber_range = NA) { } if (length(wavenumber_range) < 2 || length(wavenumber_range) > 2) { - cli::cli_abort(c( + cli::cli_abort( "Error in {.fn PlotFTIR::normalize_spectra}. {.arg wavenumber_range} must be of length 2." - )) + ) } - if (any(is.na(wavenumber_range)) | !all(is.numeric(wavenumber_range))) { + if (anyNA(wavenumber_range) || !all(is.numeric(wavenumber_range))) { cli::cli_abort(c( "Error in {.fn PlotFTIR::normalize_spectra}. {.arg wavenumber_range} must be {.code numeric} or {.code NA}.", x = "You provided a {.obj_type_friendly wavenumber_range}." @@ -895,7 +895,7 @@ NULL #' @rdname conversion absorbance_to_transmittance <- function(ftir) { ftir <- check_ftir_data(ftir) - normalized <- grepl("normalized", attr(ftir, "intensity")) + normalized <- grepl("normalized", attr(ftir, "intensity"), fixed = TRUE) if ( !("absorbance" %in% colnames(ftir)) || attr(ftir, "intensity") %in% @@ -924,7 +924,7 @@ absorbance_to_transmittance <- function(ftir) { #' @rdname conversion transmittance_to_absorbance <- function(ftir) { ftir <- check_ftir_data(ftir) - normalized <- grepl("normalized", attr(ftir, "intensity")) + normalized <- grepl("normalized", attr(ftir, "intensity"), fixed = TRUE) if ( !("transmittance" %in% colnames(ftir)) || @@ -994,7 +994,7 @@ transmittance_to_absorbance <- function(ftir) { #' #' # --- Optional: Visualize the results --- #' \dontrun{ -#' plot_ftir(ftir_smoothed, plot_title = "Smoothed FTIR") +#' plot_ftir(ftir_smoothed, plot_title = "Smoothed FTIR") #' } smooth_ftir <- function(ftir, polynomial = 2, points = 13, derivative = 0) { # Package Checks @@ -1007,7 +1007,7 @@ smooth_ftir <- function(ftir, polynomial = 2, points = 13, derivative = 0) { # arg checks if (!is.null(attr(ftir, "treatment"))) { - if (grepl("smoothed", attr(ftir, "treatment"))) { + if (grepl("smoothed", attr(ftir, "treatment"), fixed = TRUE)) { cli::cli_warn(c( "Warning in {.fn PlotFTIR::smooth_ftir}: Spectra have been previously smoothed.", i = "Repeat smoothing of spectra may eliminate small or shoulder peaks." @@ -1103,9 +1103,9 @@ smooth_ftir <- function(ftir, polynomial = 2, points = 13, derivative = 0) { #' } #' # --- Optional: Visualize the results --- #' \dontrun{ -#' plot_ftir(ftir_baselined_modpoly, plot_title = "ModPoly Baselined FTIR") +#' plot_ftir(ftir_baselined_modpoly, plot_title = "ModPoly Baselined FTIR") #' -#' plot_ftir(ftir_baselined_lowpass, plot_title = "Lowpass Baselined FTIR") +#' plot_ftir(ftir_baselined_lowpass, plot_title = "Lowpass Baselined FTIR") #' } baseline_ftir <- function(ftir, method = "modpolyfit", ...) { # Package Checks @@ -1147,7 +1147,7 @@ baseline_ftir <- function(ftir, method = "modpolyfit", ...) { ftir <- check_ftir_data(ftir) if (!is.null(attr(ftir, "treatment"))) { - if (grepl("baselined", attr(ftir, "treatment"))) { + if (grepl("baselined", attr(ftir, "treatment"), fixed = TRUE)) { cli::cli_warn(c( "Warning in {.fn PlotFTIR::baseline_ftir}: Spectra have been previously baselined.", i = "Repeat baseline adjustment of spectra may produce unexpected results." @@ -1276,7 +1276,7 @@ remove_continuum_ftir <- function( } if (!is.null(attr(ftir, "treatment"))) { - if (grepl("continuum removed", attr(ftir, "treatment"))) { + if (grepl("continuum removed", attr(ftir, "treatment"), fixed = TRUE)) { cli::cli_warn(c( "Warning in {.fn PlotFTIR::remove_continuum_ftir}: Spectra have previously had continuum removed.", i = "Repeat continuum removal of spectra may produce unexpected results." @@ -1309,7 +1309,7 @@ remove_continuum_ftir <- function( c(x[1] - 1, x, x[length(x)] + 1), c(0, y_for_hull, 0) )) - #take off the bumpers, subtract by 1 to 'shift everything' back to actual x indexes + # take off the bumpers, subtract by 1 to 'shift everything' back to actual x indexes hull <- hull[2:(length(hull) - 1)] - 1 # Build functions for interpolating diff --git a/R/peak-fit.R b/R/peak-fit.R index 26d6ecb..84b4e7c 100644 --- a/R/peak-fit.R +++ b/R/peak-fit.R @@ -79,7 +79,7 @@ #' print("Peaks found with adjusted settings:") #' print(peaks_adjusted) find_ftir_peaks <- function(ftir, ...) { - #check args + # check args ftir <- PlotFTIR::check_ftir_data(ftir) if (length(unique(ftir$sample_id)) != 1) { @@ -319,7 +319,7 @@ zero_threshold <- function(x, threshold = 1e-4) { #' # Peaks will be found automatically using find_ftir_peaks defaults #' fitted_voigt_default <- fit_peaks(ftir_data) #' print("Fitted Voigt Peaks (Default):") -#' +#' #' # Show key results like final parameters and convergence status #' print(fit_peak_df(fitted_voigt_default)) #' print(paste("Convergence:", fitted_voigt_default$convergence)) @@ -347,7 +347,7 @@ zero_threshold <- function(x, threshold = 1e-4) { #' ftir_data, #' peaklist = fixed_peak_locations, #' fixed_peaks = TRUE -#' ) +#' ) #' print("Fitted Voigt Peaks (Fixed Locations):") #' print(fit_peak_df(fitted_voigt_fixed)) #' @@ -580,7 +580,9 @@ fit_peak_df <- function(fitted_peaks) { #' Une valeur de caractère pour le type de pic ajusté aux spectres. #' @keywords internal get_fit_method <- function(fitted_peaks) { - if (!("method" %in% names(fitted_peaks))) { + if (("method" %in% names(fitted_peaks))) { + method <- fitted_peaks$method + } else { cli::cli_warn( "Warning in {.fn PlotFTIR::get_fit_method}. {.arg fitted_peaks} should be generated with {.fn PlotFTIR::fit_peaks}." ) @@ -593,8 +595,6 @@ get_fit_method <- function(fitted_peaks) { } else { method <- "gauss" } - } else { - method <- fitted_peaks$method } return(method) } @@ -834,29 +834,29 @@ get_fit_spectra <- function(ftir, fitted_peaks, peak = NULL) { #' #' # --- Example 1: Plot components only (default) --- #' \dontrun{ -#' plot_components(ftir_data, fitted_voigt) +#' plot_components(ftir_data, fitted_voigt) #' } #' #' # --- Example 2: Plot components AND the overall fitted sum --- #' \dontrun{ -#' plot_components(ftir_data, fitted_voigt, plot_fit = TRUE) +#' plot_components(ftir_data, fitted_voigt, plot_fit = TRUE) #' } #' #' # --- Example 3: Plot components and fit with custom titles and name --- #' \dontrun{ -#' plot_components( -#' ftir_data, -#' fitted_voigt, -#' plot_fit = TRUE, -#' plot_title = c("Isopropanol Peak Fit", "Voigt Components"), -#' legend_title = "Spectrum Type", -#' fitted_sample_name = "Total Fit (Voigt)" -#' ) +#' plot_components( +#' ftir_data, +#' fitted_voigt, +#' plot_fit = TRUE, +#' plot_title = c("Isopropanol Peak Fit", "Voigt Components"), +#' legend_title = "Spectrum Type", +#' fitted_sample_name = "Total Fit (Voigt)" +#' ) #' } #' #' # --- Example 4: Plot components in French --- #' \dontrun{ -#' plot_components(ftir_data, fitted_voigt, plot_fit = TRUE, lang = "fr") +#' plot_components(ftir_data, fitted_voigt, plot_fit = TRUE, lang = "fr") #' } plot_components <- function( ftir, @@ -1009,15 +1009,15 @@ plot_components <- function( lang = lang )) - if (!requireNamespace("ggthemes", quietly = TRUE)) { + if (requireNamespace("ggthemes", quietly = TRUE)) { suppressWarnings( p <- p + - ggplot2::scale_color_viridis_d() + ggthemes::scale_color_calc() ) } else { suppressWarnings( p <- p + - ggthemes::scale_color_calc() + ggplot2::scale_color_viridis_d() ) } @@ -1103,20 +1103,20 @@ plot_components <- function( #' #' # --- Example 1: Plot residuals with default settings --- #' \dontrun{ -#' plot_fit_residuals(ftir_data, fitted_voigt) +#' plot_fit_residuals(ftir_data, fitted_voigt) #' } #' #' # --- Example 2: Plot residuals with custom titles in French --- #' \dontrun{ -#' plot_fit_residuals( -#' ftir_data, -#' fitted_voigt, -#' lang = "fr", -#' plot_title = c( -#' "R\u00e9sidus de l'ajustement", -#' "Diff\u00e9rence entre le spectre et l'ajustement Voigt" -#' ) +#' plot_fit_residuals( +#' ftir_data, +#' fitted_voigt, +#' lang = "fr", +#' plot_title = c( +#' "R\u00e9sidus de l'ajustement", +#' "Diff\u00e9rence entre le spectre et l'ajustement Voigt" #' ) +#' ) #' } #' plot_fit_residuals <- function(ftir, fitted_peaks, lang = NA, ...) { @@ -1282,36 +1282,36 @@ plot_fit_residuals <- function(ftir, fitted_peaks, lang = NA, ...) { #' ftir_data$wavenumber < 1500 & ftir_data$wavenumber > 1000, #' ] #' -#' if(!requireNamespace('signal', quietly = TRUE)){ +#' if (!requireNamespace("signal", quietly = TRUE)) { #' # First, fit the peaks using the default 'voigt' method #' fitted_voigt <- fit_peaks(ftir_data, method = "voigt") #' } #' #' # --- Example 1: Plot original spectrum and the overall fitted sum --- #' \dontrun{ -#' plot_fit_ftir_peaks(ftir_data, fitted_voigt) +#' plot_fit_ftir_peaks(ftir_data, fitted_voigt) #' } #' #' # --- Example 2: Plot original, overall fit, AND individual components --- #' # This internally calls plot_components() with plot_fit = TRUE #' \dontrun{ -#' plot_fit_ftir_peaks(ftir_data, fitted_voigt, plot_components = TRUE) +#' plot_fit_ftir_peaks(ftir_data, fitted_voigt, plot_components = TRUE) #' } #' #' # --- Example 3: Plot original and fit with custom titles and name --- #' \dontrun{ -#' plot_fit_ftir_peaks( -#' ftir_data, -#' fitted_voigt, -#' plot_title = c("Isopropanol Fit Comparison", "Original vs. Voigt Sum"), -#' legend_title = "Spectrum Source", -#' fitted_sample_name = "Total Voigt Fit" -#' ) +#' plot_fit_ftir_peaks( +#' ftir_data, +#' fitted_voigt, +#' plot_title = c("Isopropanol Fit Comparison", "Original vs. Voigt Sum"), +#' legend_title = "Spectrum Source", +#' fitted_sample_name = "Total Voigt Fit" +#' ) #' } #' #' # --- Example 4: Plot original and fit in French --- #' \dontrun{ -#' plot_fit_ftir_peaks(ftir_data, fitted_voigt, lang = "fr") +#' plot_fit_ftir_peaks(ftir_data, fitted_voigt, lang = "fr") #' } #' plot_fit_ftir_peaks <- function( @@ -1398,25 +1398,23 @@ plot_fit_ftir_peaks <- function( ) if ("plot_title" %in% argnames) { plot_title <- args$plot_title - } else { - if (lang == "en") { - plot_title <- c( - "Fitted FTIR Plot", - paste0( - "Showing as-analyzed spectra and sum of ", - tools::toTitleCase(method), - " fitted peaks" - ) + } else if (lang == "en") { + plot_title <- c( + "Fitted FTIR Plot", + paste0( + "Showing as-analyzed spectra and sum of ", + tools::toTitleCase(method), + " fitted peaks" ) - } else { - plot_title <- c( - "Trac\u00e9 IRTF ajust\u00e9", - paste0( - "Montrer les spectres et de la somme des pics ajust\u00e9s par la m\u00e9thode ", - tools::toTitleCase(method) - ) + ) + } else { + plot_title <- c( + "Trac\u00e9 IRTF ajust\u00e9", + paste0( + "Montrer les spectres et de la somme des pics ajust\u00e9s par la m\u00e9thode ", + tools::toTitleCase(method) ) - } + ) } fitted_y <- get_fit_spectra(ftir = ftir, fitted_peaks = fitted_peaks) @@ -1680,7 +1678,7 @@ spect_em_dsgmm <- function( "Error in {.fn spect_em_dsgmm}. All of {.param mu}, {.param sigma}, {.param alpha}, {.param eta} and {.param mix_ratio} must be of the same length." ) } - if (!maxit > 1) { + if (maxit <= 1) { cli::cli_abort( "Error in {.fn spect_em_dsgmm}. Provided {.param maxit} must be greater than 1 to perform optimization." ) @@ -1806,7 +1804,7 @@ spect_em_dsgmm <- function( eta_1 <- rbind(eta_1, eta) mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) - #Check for convergance + # Check for convergance if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { status <- "converged" cal_time <- difftime(Sys.time(), start_cal, units = "sec") @@ -1892,7 +1890,7 @@ spect_em_gmm <- function( "Error in {.fn spect_em_gmm}. All of {.param mu}, {.param sigma}, and {.param mix_ratio} must be of the same length." ) } - if (!maxit > 1) { + if (maxit <= 1) { cli::cli_abort( "Error in {.fn spect_em_gmm}. Provided {.param maxit} must be greater than 1 to perform optimization." ) @@ -1938,7 +1936,7 @@ spect_em_gmm <- function( sigma_1 <- rbind(sigma_1, sigma) mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) - #Check for convergance + # Check for convergance if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { status <- "converged" cal_time <- difftime(Sys.time(), start_cal, units = "sec") @@ -2018,7 +2016,7 @@ spect_em_lmm <- function( "Error in {.fn spect_em_lmm}. All of {.param mu}, {.param gam}, and {.param mix_ratio} must be of the same length." ) } - if (!maxit > 1) { + if (maxit <= 1) { cli::cli_abort( "Error in {.fn spect_em_lmm}. Provided {.param maxit} must be greater than 1 to perform optimization." ) @@ -2097,7 +2095,7 @@ spect_em_lmm <- function( gam_1 <- rbind(gam_1, gam) mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) - #Check for convergance + # Check for convergance if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { status <- "converged" cal_time <- difftime(Sys.time(), start_cal, units = "sec") @@ -2184,7 +2182,7 @@ spect_em_pvmm <- function( "Error in {.fn spect_em_pvmm}. All of {.param mu}, {.param sigma}, {.param eta}, and {.param mix_ratio} must be of the same length." ) } - if (!maxit > 1) { + if (maxit <= 1) { cli::cli_abort( "Error in {.fn spect_em_pvmm}. Provided {.param maxit} must be greater than 1 to perform optimization." ) @@ -2207,7 +2205,7 @@ spect_em_pvmm <- function( eta_1 <- rbind(eta_1, eta) mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) - #Iterative optimization + # Iterative optimization for (i in 1:maxit) { tmp <- sapply(1:K, f_k) den <- apply(tmp, 1, sum) @@ -2285,7 +2283,7 @@ spect_em_pvmm <- function( eta_1 <- rbind(eta_1, eta) mix_ratio_1 <- rbind(mix_ratio_1, mix_ratio) - #Check for convergance + # Check for convergance if (abs(LL_1[i + 1] - LL_1[i]) < conv_cri) { status <- "converged" cal_time <- difftime(Sys.time(), start_cal, units = "sec") diff --git a/R/plot_ftir.R b/R/plot_ftir.R index b9e4505..f556053 100644 --- a/R/plot_ftir.R +++ b/R/plot_ftir.R @@ -152,14 +152,14 @@ plot_ftir_core <- function( "% Transmittance" ) - if (grepl("normalized", mode)) { + if (grepl("normalized", mode, fixed = TRUE)) { ytitle <- paste("Normalized", ytitle) } ftir <- ftir[stats::complete.cases(ftir), ] ftir$wavenumber <- as.numeric(ftir$wavenumber) - if (grepl("absorbance", mode)) { + if (grepl("absorbance", mode, fixed = TRUE)) { ftir$absorbance <- as.numeric(ftir$absorbance) p <- ggplot2::ggplot(ftir) + ggplot2::geom_line(ggplot2::aes( @@ -208,7 +208,7 @@ plot_ftir_core <- function( ggthemes::scale_color_calc() } - if (grepl("normalized", mode)) { + if (grepl("normalized", mode, fixed = TRUE)) { p <- p + ggplot2::theme( axis.text.y = ggplot2::element_blank() @@ -280,7 +280,7 @@ plot_ftir_stacked <- function( nsamples <- length(unique(stack_samples)) if (nsamples > 1) { - if (grepl("absorbance", mode)) { + if (grepl("absorbance", mode, fixed = TRUE)) { # Transmittance gets an offset of stack_offset % against a percentage scale # for absorbance, most signals max out around 2 so that's the range. stack_offset <- (stack_offset / 100) * 2.0 @@ -291,7 +291,7 @@ plot_ftir_stacked <- function( ) ftir <- merge(x = ftir, y = offset, by = "sample_id") - if (grepl("absorbance", mode)) { + if (grepl("absorbance", mode, fixed = TRUE)) { ftir$absorbance <- ftir$absorbance + ftir$offset } else { ftir$transmittance <- ftir$transmittance + ftir$offset @@ -309,7 +309,7 @@ plot_ftir_stacked <- function( p <- p + ggplot2::theme(axis.text.y = ggplot2::element_blank()) suppressMessages(p <- p + ggplot2::coord_cartesian(ylim = c(0, NA))) - if (grepl("absorbance", mode)) { + if (grepl("absorbance", mode, fixed = TRUE)) { p$labels$y <- "Absorbance (a.u.)" } else { p$labels$y <- "Transmittance (a.u.)" diff --git a/R/utils.R b/R/utils.R index 66e6397..42af037 100644 --- a/R/utils.R +++ b/R/utils.R @@ -72,18 +72,18 @@ get_plot_sample_ids <- function(ftir_spectra_plot) { #' check_ftir_data(biodiesel) check_ftir_data <- function(ftir) { fn <- try(deparse(sys.calls()[[sys.nframe() - 1]]), silent = TRUE) - if (inherits(fn, 'try-error')) { + if (inherits(fn, "try-error")) { fn <- "PlotFTIR::check_ftir_data" } else { fn <- paste0("PlotFTIR::", strsplit(fn, "(", fixed = TRUE)[[1]][1]) } - if ("ir" %in% class(ftir)) { + if (inherits(ftir, "ir")) { cli::cli_inform("Converting {.pkg ir} data to {.pkg PlotFTIR} structure.") ftir <- ir_to_plotftir(ftir) } - if ("Spectra" %in% class(ftir)) { + if (inherits(ftir, "Spectra")) { cli::cli_inform( "Converting {.pkg ChemoSpec} data to {.pkg PlotFTIR} structure." ) diff --git a/R/zzz.R b/R/zzz.R index 99a1300..0206872 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -11,19 +11,17 @@ 'Plotting spectra with PlotFTIR. Please cite if plots are used in publishing (`citation("plotFTIR")`).\n', 'PlotFTIR is set to English as default. Changer au fran\u00e7ais par la fonction `options("PlotFTIR.lang" = "en")`' ) + } else if ( + tolower(lang_option) %in% + c("fr", "fra", "french", "francais", "fran\u00e7ais") + ) { + packageStartupMessage( + 'Trac\u00e9 des spectres avec PlotFTIR. Veuillez citer si les tracu00e9s sont utilisu00e9s dans un publication (`citation("plotFTIR")`).' + ) } else { - if ( - tolower(lang_option) %in% - c("fr", "fra", "french", "francais", "fran\u00e7ais") - ) { - packageStartupMessage( - 'Trac\u00e9 des spectres avec PlotFTIR. Veuillez citer si les tracu00e9s sont utilisu00e9s dans un publication (`citation("plotFTIR")`).' - ) - } else { - packageStartupMessage( - 'Plotting spectra with PlotFTIR. Please cite if plots are used in publishing (`citation("plotFTIR")`).' - ) - } + packageStartupMessage( + 'Plotting spectra with PlotFTIR. Please cite if plots are used in publishing (`citation("plotFTIR")`).' + ) } } # nocov end diff --git a/README.Rmd b/README.Rmd index d8abbe7..b0f7bb8 100644 --- a/README.Rmd +++ b/README.Rmd @@ -75,8 +75,8 @@ biodiesel_marked <- add_wavenumber_marker(biodiesel_plot, wavenumber = 1742, text = "C=O Stretch", label_aesthetics = list("color" = "red") -) -add_band(biodiesel_marked, c(2750,3050), "C-H Stretch") +) +add_band(biodiesel_marked, c(2750, 3050), "C-H Stretch") ``` If the need arises to rename samples listed in the legend, this is possible via `rename_plot_sample_ids()`. Samples must be listed in the rename vector with the format `"new name" = "old name"`. @@ -235,8 +235,8 @@ biodiesel_marked <- add_wavenumber_marker(biodiesel_trace, wavenumber = 1742, text = "C=O étirement", label_aesthetics = list("color" = "red") -) -add_band(biodiesel_marked, c(2750,3050), "C-H étirement") +) +add_band(biodiesel_marked, c(2750, 3050), "C-H étirement") ``` S'il est nécessaire de renommer les échantillons répertoriés dans la légende, cela est possible via `rename_plot_sample_ids()`. Le vecteur de renommage doit avoir le format `"nouveau nom" = "ancien nom"`. diff --git a/tests/testthat/test-io.R b/tests/testthat/test-io.R index c7e71d7..1b9e9cf 100644 --- a/tests/testthat/test-io.R +++ b/tests/testthat/test-io.R @@ -283,16 +283,16 @@ test_that("reading .jdx works", { expect_equal(names(jdx_jdx)[4], unique(jdx_ftir$sample_id)) expect_equal(nrow(jdx_ftir), nrow(jdx_jdx[[4]])) - expect_true('transmittance' %in% colnames(jdx_ftir)) + expect_true("transmittance" %in% colnames(jdx_ftir)) expect_message( read_ftir( path = system.file("extdata", "SBO.jdx", package = "readJDX"), - sample_name = 'test_sample' + sample_name = "test_sample" ), "does not match that contained in the .jdx file" ) - #More IR Data + # More IR Data jdx_ir2 <- read_ftir( path = system.file("extdata", "MiniDIFDUP.JDX", package = "readJDX") ) @@ -488,17 +488,17 @@ test_that("interface to ir is ok", { ) allir <- ir_to_plotftir(irdata) - expect_equal(length(unique(allir$sample_id)), nrow(irdata)) + expect_length(unique(allir$sample_id), nrow(irdata)) expect_equal(colnames(allir), c("wavenumber", "absorbance", "sample_id")) irnum <- ir_to_plotftir(irdata, what = c(1:5)) - expect_equal(length(unique(irnum$sample_id)), 5) + expect_length(unique(irnum$sample_id), 5) irname <- ir_to_plotftir( irdata, what = c("GN 11-389", "GN 11-400", "GN 11-407") ) - expect_equal(length(unique(irname$sample_id)), 3) + expect_length(unique(irname$sample_id), 3) plotir <- plotftir_to_ir(biodiesel) @@ -558,7 +558,7 @@ test_that("Interface to ChemoSpec is ok", { csftir <- chemospec_to_plotftir(SrE.IR) expect_equal(colnames(csftir), c("wavenumber", "absorbance", "sample_id")) - expect_equal(length(unique(csftir$sample_id)), length(SrE.IR$names)) + expect_length(unique(csftir$sample_id), length(SrE.IR$names)) expect_error( plotftir_to_chemospec(biodiesel, group_colours = "blue"), diff --git a/tests/testthat/test-maths.R b/tests/testthat/test-maths.R index 3453c41..61b257d 100644 --- a/tests/testthat/test-maths.R +++ b/tests/testthat/test-maths.R @@ -1627,7 +1627,7 @@ test_that("baseline_ftir works", { sample_spectra$sample_id == "isopropanol", ] - if (!requireNamespace('baseline', quietly = TRUE)) { + if (!requireNamespace("baseline", quietly = TRUE)) { expect_error( baseline_ftir(test_data), "requires baseline package installation" @@ -1644,7 +1644,7 @@ test_that("baseline_ftir works", { baselined <- baseline_ftir(test_data) - expect_equal("baselined", attr(baselined, "treatment")) + expect_equal(attr(baselined, "treatment"), "baselined") #make sure the attr is appended and not overwriting smooth_baselined <- baseline_ftir(smooth_ftir(test_data)) @@ -1759,7 +1759,7 @@ test_that("remove_continuum_ftir warns when continuum has already been removed", }) test_that("remove_continuum_ftir works after other treatments.", { - if (!requireNamespace('baseline', quietly = TRUE)) { + if (!requireNamespace("baseline", quietly = TRUE)) { testthat::skip("baseline not available for testing") } ftir_data <- sample_spectra[ @@ -1886,7 +1886,7 @@ test_that("smooth_ftir checks repeat calls", { }) test_that("smooth_ftir corrects attributes", { - if (!requireNamespace('baseline', quietly = TRUE)) { + if (!requireNamespace("baseline", quietly = TRUE)) { testthat::skip("baseline not available for testing") } @@ -1895,7 +1895,7 @@ test_that("smooth_ftir corrects attributes", { ] smoothed <- smooth_ftir(test_data) - expect_equal("smoothed", attr(smoothed, "treatment")) + expect_equal(attr(smoothed, "treatment"), "smoothed") #make sure the attr is appended and not overwriting smooth_baselined <- smooth_ftir(baseline_ftir(test_data)) diff --git a/tests/testthat/test-peak-fit.R b/tests/testthat/test-peak-fit.R index c30a262..183d9b4 100644 --- a/tests/testthat/test-peak-fit.R +++ b/tests/testthat/test-peak-fit.R @@ -4,7 +4,7 @@ test_that("find_ftir_peaks handles input errors ok", { wavenumber = seq(4000, 400, length.out = 100), absorbance = rnorm(100) ) - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -37,7 +37,7 @@ test_that("find_ftir_peaks handles input errors ok", { test_that("find_ftir_peaks returns sorted peaks", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -51,7 +51,7 @@ test_that("find_ftir_peaks returns sorted peaks", { }) test_that("find_ftir_peaks returns correct peaks", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -69,7 +69,7 @@ test_that("find_ftir_peaks returns correct peaks", { window_norm = 50, window_deriv = 50 ) - expect_equal(length(peaks), 10) + expect_length(peaks, 10) expect_equal( peaks, c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) @@ -77,7 +77,7 @@ test_that("find_ftir_peaks returns correct peaks", { }) test_that("Fixed Peak Locations don't move", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -107,26 +107,26 @@ test_that("Fixed Peak Locations don't move", { gmm_loose <- fit_peaks( ftir, peaklist = peaklist, - fixed_peaks = F, + fixed_peaks = FALSE, method = "g" ) lmm_loose <- fit_peaks( ftir, peaklist = peaklist, - fixed_peaks = F, + fixed_peaks = FALSE, method = "l" ) pvmm_loose <- fit_peaks( ftir, peaklist = peaklist, - fixed_peaks = F, + fixed_peaks = FALSE, method = "pv" ) dsgmm_loose <- fit_peaks( ftir, peaklist = peaklist, - fixed_peaks = F, + fixed_peaks = FALSE, method = "dsg" ) @@ -168,7 +168,7 @@ test_that("Fixed Peak Locations don't move", { }) test_that("zero_normalization and zero_deriv check ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -243,7 +243,7 @@ test_that("zero_threshold sets to zero values below threshold", { }) test_that("fit_peaks (voigt) returns correct results", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -254,7 +254,7 @@ test_that("fit_peaks (voigt) returns correct results", { ) fitted_peaks <- fit_peaks(ftir, method = "voigt") expect_equal(fitted_peaks$method, "voigt") - expect_equal(length(fitted_peaks$mu), 10) + expect_length(fitted_peaks$mu, 10) expect_equal( round(fitted_peaks$mu), c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) @@ -269,7 +269,7 @@ test_that("fit_peaks (voigt) returns correct results", { }) test_that("fit_peaks (gaussian) returns correct results", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -280,7 +280,7 @@ test_that("fit_peaks (gaussian) returns correct results", { ) fitted_peaks <- fit_peaks(ftir, method = "gaussian") expect_equal(fitted_peaks$method, "gauss") - expect_equal(length(fitted_peaks$mu), 10) + expect_length(fitted_peaks$mu, 10) expect_equal( round(fitted_peaks$mu), c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) @@ -295,7 +295,7 @@ test_that("fit_peaks (gaussian) returns correct results", { }) test_that("fit_peaks (lorentz) returns correct results", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -306,7 +306,7 @@ test_that("fit_peaks (lorentz) returns correct results", { ) fitted_peaks <- fit_peaks(ftir, method = "lorentz") expect_equal(fitted_peaks$method, "lorentz") - expect_equal(length(fitted_peaks$mu), 10) + expect_length(fitted_peaks$mu, 10) expect_equal( round(fitted_peaks$mu), c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3819) @@ -321,7 +321,7 @@ test_that("fit_peaks (lorentz) returns correct results", { }) test_that("fit_peaks (dsg) returns correct results", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -332,7 +332,7 @@ test_that("fit_peaks (dsg) returns correct results", { ) fitted_peaks <- fit_peaks(ftir, method = "dsg") expect_equal(fitted_peaks$method, "doniach-šunjić-gauss") - expect_equal(length(fitted_peaks$mu), 10) + expect_length(fitted_peaks$mu, 10) expect_equal( round(fitted_peaks$mu), c(545, 909, 1273, 1636, 2000, 2364, 2727, 3091, 3455, 3818) @@ -347,7 +347,7 @@ test_that("fit_peaks (dsg) returns correct results", { }) test_that("fit_peaks error checks are ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -372,7 +372,7 @@ test_that("fit_peaks error checks are ok", { }) test_that("Peak data.frame is created ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -422,7 +422,7 @@ test_that("Peak data.frame is created ok", { }) test_that("get_fit_spectra works ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -436,19 +436,19 @@ test_that("get_fit_spectra works ok", { fitl <- fit_peaks(ftir, method = "lorentz") fitd <- fit_peaks(ftir, method = "dsg") - expect_equal(length(get_fit_spectra(ftir, fitg)), length(ftir$wavenumber)) - expect_equal(length(get_fit_spectra(ftir, fitv)), length(ftir$wavenumber)) - expect_equal(length(get_fit_spectra(ftir, fitl)), length(ftir$wavenumber)) - expect_equal(length(get_fit_spectra(ftir, fitd)), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitg), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitv), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitl), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitd), length(ftir$wavenumber)) - expect_equal(length(get_fit_spectra(ftir, fitg, 3)), length(ftir$wavenumber)) - expect_equal(length(get_fit_spectra(ftir, fitv, 3)), length(ftir$wavenumber)) - expect_equal(length(get_fit_spectra(ftir, fitl, 3)), length(ftir$wavenumber)) - expect_equal(length(get_fit_spectra(ftir, fitd, 3)), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitg, 3), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitv, 3), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitl, 3), length(ftir$wavenumber)) + expect_length(get_fit_spectra(ftir, fitd, 3), length(ftir$wavenumber)) }) test_that("get_fit_spectra checks are ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -479,7 +479,7 @@ test_that("get_fit_spectra checks are ok", { test_that("plot_fit_ftir_peaks work", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -518,7 +518,7 @@ test_that("plot_fit_ftir_peaks work", { }) test_that("plot_fit_residuals work", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -557,7 +557,7 @@ test_that("plot_fit_residuals work", { }) test_that("plot_components work", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -613,7 +613,7 @@ test_that("plot_components work", { }) test_that("plot_fit_ftir_peaks error checks are ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -659,7 +659,7 @@ test_that("plot_fit_ftir_peaks error checks are ok", { }) test_that("plot_fit_residuals error checks are ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -710,7 +710,7 @@ test_that("plot_fit_residuals error checks are ok", { }) test_that("plot_components error checks are ok", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } @@ -761,7 +761,7 @@ test_that("plot_components error checks are ok", { }) test_that("Languages are handled properly", { - if (!requireNamespace('signal', quietly = TRUE)) { + if (!requireNamespace("signal", quietly = TRUE)) { testthat::skip("signal not available for testing") } diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 1bec5a0..78563f4 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -15,7 +15,10 @@ test_that("Plot SampleID extraction is ok", { p <- plot_ftir(biodiesel) - expect_equal(get_plot_sample_ids(p), as.factor(unique(biodiesel$sample_id))) + expect_identical( + get_plot_sample_ids(p), + as.factor(unique(biodiesel$sample_id)) + ) expect_error( get_plot_sample_ids(biodiesel), @@ -25,14 +28,14 @@ test_that("Plot SampleID extraction is ok", { }) test_that("Intensity Typing works", { - expect_equal(intensity_type(biodiesel), "absorbance") - expect_equal( + expect_identical(intensity_type(biodiesel), "absorbance") + expect_identical( intensity_type(absorbance_to_transmittance(biodiesel)), "transmittance" ) b2 <- biodiesel colnames(biodiesel)[colnames(biodiesel) == "absorbance"] <- "intensity" - expect_equal(intensity_type(b2), "absorbance") + expect_identical(intensity_type(b2), "absorbance") }) test_that("Checking FTIR data works", { @@ -49,5 +52,8 @@ test_that("Checking FTIR data works", { no_attr_ftir <- biodiesel attr(no_attr_ftir, "intensity") <- NULL - expect_equal(attr(check_ftir_data(no_attr_ftir), "intensity"), "absorbance") + expect_identical( + attr(check_ftir_data(no_attr_ftir), "intensity"), + "absorbance" + ) })