From aacf348771030ba82066ed310c0069ffeef3c719 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 12 Feb 2020 17:41:27 -0600 Subject: [PATCH 001/132] First pass at reworking input strategy, defaults, and names. Includes split of forecasting script file into main and helpers. The 'cases_epidemiar' field is used for the modeling variable name (not old 'modeledvar'). Most input checks are turned off until testing on this phase is complete and the checks can be reworked. 'fc_model_family' is currently a rename of 'model_choice' temporarily until next phase of model expansion. --- R/event_detection.R | 62 +- R/forecasting.R | 1420 ------------------------------------ R/forecasting_helpers.R | 662 +++++++++++++++++ R/forecasting_main.R | 786 ++++++++++++++++++++ R/formatters_calculators.R | 30 +- R/run_epidemia.R | 487 +++++++++---- 6 files changed, 1838 insertions(+), 1609 deletions(-) delete mode 100644 R/forecasting.R create mode 100644 R/forecasting_helpers.R create mode 100644 R/forecasting_main.R diff --git a/R/event_detection.R b/R/event_detection.R index c28600c..bbbb789 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -30,15 +30,16 @@ #' "thresh" : threshold values per week #' run_event_detection <- function(epi_fc_data, - quo_popfield, - inc_per, quo_groupfield, - groupings, + quo_popfield, + #rpt settings items ed_method, ed_control, - report_dates, - vt, - mc){ + val_type, + inc_per, + #internal/calc + groupings, + report_dates){ #message("Running early detection...") #only supporting Farrington Improved method from Surveillance right now, @@ -49,14 +50,13 @@ run_event_detection <- function(epi_fc_data, message("Running early detection: Farrington...") ed_far_res <- run_farrington(epi_fc_data, + quo_groupfield, quo_popfield, + ed_control, + val_type, inc_per, - quo_groupfield, groupings, - ed_control, - report_dates, - vt, - mc) + report_dates) return(ed_far_res) } else if (ed_method == "none") { @@ -97,14 +97,13 @@ run_event_detection <- function(epi_fc_data, #' "thresh" : threshold values per week #' run_farrington <- function(epi_fc_data, + quo_groupfield, quo_popfield, + ed_control, + val_type, inc_per, - quo_groupfield, groupings, - ed_control, - report_dates, - vt, - mc){ + report_dates){ ## Make sts objects #check about population offset # did the user set population offset @@ -114,18 +113,18 @@ run_farrington <- function(epi_fc_data, #if so, did they give the population field if (!is.null(quo_popfield)){ epi_stss <- make_stss(epi_fc_data, - quo_popfield, quo_groupfield, + quo_popfield, groupings) } else stop("Population offset is TRUE, but population field not given") - #<<>> add to earlier input checks so fails early rather than later + #<<>> add to earlier input checks so fails early rather than later? } else epi_stss <- make_stss(epi_fc_data, - quo_popfield = NULL, quo_groupfield, + quo_popfield = NULL, groupings) #popoffset is FALSE, so no pop to sts } else epi_stss <- make_stss(epi_fc_data, - quo_popfield = NULL, quo_groupfield, + quo_popfield = NULL, groupings) #if null, default is false, so pop = NULL ## Set up new control list for Farrington (using their names) @@ -237,13 +236,12 @@ run_farrington <- function(epi_fc_data, #results into output report data form far_res <- stss_res_to_output_data(stss_res_list = far_res_list, epi_fc_data, + quo_groupfield, quo_popfield, + val_type, inc_per, - quo_groupfield, groupings, - report_dates, - vt, - mc) + report_dates) } @@ -262,7 +260,10 @@ run_farrington <- function(epi_fc_data, #'@return A list of surveillance time series (sts) objects, #'one for each geographic grouping. #' -make_stss <- function(epi_fc_data, quo_popfield, quo_groupfield, groupings){ +make_stss <- function(epi_fc_data, + quo_groupfield, + quo_popfield, + groupings){ #create a list of surveillance::sts objects, one for each group stss <- vector('list', length(groupings)) for (i in 1:length(groupings)){ @@ -329,13 +330,12 @@ make_stss <- function(epi_fc_data, quo_popfield, quo_groupfield, groupings){ #' stss_res_to_output_data <- function(stss_res_list, epi_fc_data, + quo_groupfield, quo_popfield, + val_type, inc_per, - quo_groupfield, groupings, - report_dates, - vt, - mc){ + report_dates){ #take results of a surveillance event detection and reshape to output data format #stss to dfs stss_res_dfs <- lapply(stss_res_list, surveillance::as.data.frame) @@ -387,9 +387,9 @@ stss_res_to_output_data <- function(stss_res_list, obs_date = epoch, value = dplyr::case_when( #if reporting in case counts - vt == "cases" ~ upperbound, + val_type == "cases" ~ upperbound, #if incidence - vt == "incidence" ~ upperbound / !!quo_popfield * inc_per, + val_type == "incidence" ~ upperbound / !!quo_popfield * inc_per, #otherwise TRUE ~ NA_real_), #value = upperbound / !!quo_popfield * inc_per, #Incidence, from stss & epi_fc_data diff --git a/R/forecasting.R b/R/forecasting.R deleted file mode 100644 index 4ef8e6a..0000000 --- a/R/forecasting.R +++ /dev/null @@ -1,1420 +0,0 @@ -# All run_epidemiar() subfunctions related to forecasting -## Forecasting - -#' Runs the forecast modeling -#' -#'@param epi_data Epidemiological data with case numbers per week, with date -#' field "obs_date". -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables -#'@param quo_valuefield Quosure of user given field name of the value of the -#' environmental data variable observations. -#'@param env_variables alphabetical list of all unique environmental variables -#' present in the original env_data dataset. -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. -#'@param env_ref_data Historical averages by week of year for environmental -#' variables. Used in extended environmental data into the future for long -#' forecast time, to calculate anomalies in early detection period, and to -#' display on timeseries in reports. -#'@param env_info Lookup table for environmental data - reference creation -#' method (e.g. sum or mean), report labels, etc. -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. -#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi -#' weeks) that the weeks of the year in epidemiological and environmental -#' reference data use ["ISO" or "CDC"]. -#'@param model_run TRUE/FALSE flag for whether to only generate the model -#' regression object plus metadata. This model can be cached and used later on -#' its own, skipping a large portion of the slow calculations for future runs. -#'@param model_cached The output of a previous model_run = TRUE run of -#' run_epidemia() that produces a model (regression object) and metadata. The -#' metadata will be used for input checking and validation. Using a prebuilt -#' model saves on processing time, but will need to be updated periodically. -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-gam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param valid_run Internal binary for whether this is part of a validation run. -#' -#' -#'@return Named list containing: -#'fc_epi: Full forecasted resulting dataset. -#'fc_res: The forecasted series in report format. -#'env_data_extd: Data set of the environmental data variables extended into the -#' unknown/future. -#'env_variables_used: list of environmental variables that were used in the -#' modeling (had to be both listed in model variables input file and present the -#' env_data dataset) -#'env_dt_ranges: Date ranges of the input environmental data. -#'reg_obj: The regression object from modeling. -#'Unless model_run is TRUE, in which case only the regression object is returned. -#' -#' -run_forecast <- function(epi_data, - quo_popfield, - inc_per, - quo_groupfield, - groupings, - env_data, - quo_obsfield, - quo_valuefield, - env_variables, - fc_control, - env_ref_data, - env_info, - report_dates, - week_type, - model_run, - model_cached = NULL, - model_choice, - valid_run){ - - message("Preparing for forecasting...") - - #set up default parallel processing number of cores to use number - #if user-supplied, use that, otherwise create a default number - #used in anomalize_env() and forecast_regression() - if (!is.null(fc_control$ncores)) { - ncores <- fc_control$ncores - #because re-using ncores argument for nthreads & - # nthreads above 2 is not actually helpful - ncores <- ifelse(ncores > 1, 2, 1) - } else { - #no ncores value fed in, so test and determine - #cap at 2 for nthread re-use of this variable - #ncores <- max(parallel::detectCores(logical=FALSE) - 1, 1) - ncores <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) - } #end else for ncores not given - - # create the modeling variable - # epi_data <- mutate(epi_data, logcase = log(cases_epidemiar + 1)) - epi_data <- dplyr::mutate(epi_data, modeledvar = floor(cases_epidemiar)) - - # trim to the needed env variables as dictated by the model - env_data <- pull_model_envvars(env_data, quo_obsfield, fc_control) - #create alphabetical list of ONLY USED unique environmental variables - env_variables_used <- dplyr::pull(env_data, !!quo_obsfield) %>% unique() %>% sort() - - # extract start & end dates for each variable for log file - env_dt_ranges <- dplyr::group_by(env_data, !!quo_obsfield) %>% - dplyr::summarize(start_dt = min(obs_date), end_dt = max(obs_date)) - - # extend data into future, for future forecast portion - env_data_extd <- extend_env_future(env_data, - quo_groupfield, - groupings, - quo_obsfield, - quo_valuefield, - env_ref_data, - env_info, - env_variables_used, - report_dates, - week_type, - model_choice, - valid_run) - - epi_data_extd <- extend_epi_future(epi_data, - quo_popfield, - quo_groupfield, - groupings, - report_dates) - - # format the data for forecasting algorithm - env_fc <- env_format_fc(env_data_extd, - quo_groupfield, - quo_obsfield) - epi_fc <- epi_format_fc(epi_data_extd, - quo_groupfield, - fc_control) - - # anomalizing the environ data, if requested. - #For backwards compatibility, poisson-gam default is TRUE. - #Default for negbin is FALSE - if (is.null(fc_control[["anom_env"]])){ - #fc_control$anom_env <- TRUE - fc_control$anom_env <- dplyr::case_when( - model_choice == "poisson-gam" ~ TRUE, - model_choice == "negbin" ~ FALSE, - model_choice == "naive-persistence" ~ FALSE, - model_choice == "naive-weekaverage" ~ FALSE, - #should never occur, but if it does, default to FALSE - TRUE ~ FALSE) - } - if (fc_control$anom_env){ - message("Anomalizing the environmental variables...") - env_fc <- anomalize_env(env_fc, - quo_groupfield, - env_variables_used, - ncores) - } - - # create the lags - epi_lag <- lag_environ_to_epi(epi_fc, - quo_groupfield, - groupings, - env_fc, - env_variables_used, - laglen = fc_control$lag_length) - - # add week of year, needed for null-weekaverage model - # here with week_type, else need to pass that in to further down functions - epi_lag <- add_datefields(epi_lag, week_type) - - - # If only model_run, then return to run_epidemia() here - if (model_run){ - model_run_result <- forecast_regression(epi_lag, - quo_groupfield, - groupings, - env_variables_used, - report_dates, - req_date = report_dates$full$max, - ncores, - fit_freq = "once", - model_run, - model_cached, - model_choice, - theta = fc_control$theta) - - model_run_only <- create_named_list(env_variables_used, - env_dt_ranges, - reg_obj = model_run_result) - return(model_run_only) - } - - - #Split regression call depending on {once|week} model fit frequency - # default "once" - if (!is.null(fc_control$fit_freq)) { - fit_freq <- fc_control$fit_freq - } else fit_freq <- "once" - - if (fit_freq == "once"){ - message("Generating forecasts...") - #for single fit, call with last week (and subfunction has switch to return all) - forereg_return <- forecast_regression(epi_lag, - quo_groupfield, - groupings, - env_variables_used, - report_dates, - req_date = report_dates$full$max, - ncores, - fit_freq, - model_run, - model_cached, - model_choice, - theta = fc_control$theta) - preds_catch <- forereg_return$date_preds - reg_obj <- forereg_return$regress - - } else if (fit_freq == "week") { - # for each week of report, run forecast - # initialize: prediction returns 4 columns - preds_catch <- data.frame() - #loop by week - for (w in seq_along(report_dates$full$seq)){ - message("Forecasting week ", w, " starting at ", Sys.time()) - dt <- report_dates$full$seq[w] - forereg_return <- forecast_regression(epi_lag, - quo_groupfield, - groupings, - env_variables_used, - report_dates, - req_date = dt, - ncores, - fit_freq, - model_run, - model_cached, - model_choice, - theta = fc_control$theta) - - dt_preds <- forereg_return$date_preds - preds_catch <- rbind(preds_catch, as.data.frame(dt_preds)) - - #taking advantage that only result will be of the last loop through - reg_obj <- forereg_return$regress - } - - } else stop("Model fit frequency unknown") #shouldn't happen with default "once" - - - # Interval calculation - preds_catch <- preds_catch %>% - dplyr::mutate(fc_cases = fit, - fc_cases_upr = fit+1.96*sqrt(fit), - fc_cases_lwr = fit-1.96*sqrt(fit)) - - # extract fc series into report format - fc_res <- preds_catch %>% - dplyr::mutate(series = "fc", - value = dplyr::case_when( - #if reporting in case counts - fc_control$value_type == "cases" ~ fc_cases, - #if incidence - fc_control$value_type == "incidence" ~ fc_cases / !!quo_popfield * inc_per, - #otherwise - TRUE ~ NA_real_), - lab = "Forecast Trend", - upper = dplyr::case_when( - #if reporting in case counts - fc_control$value_type == "cases" ~ fc_cases_upr, - #if incidence - fc_control$value_type == "incidence" ~ fc_cases_upr / !!quo_popfield * inc_per, - #otherwise - TRUE ~ NA_real_), - lower = dplyr::case_when( - #if reporting in case counts - fc_control$value_type == "cases" ~ fc_cases_lwr, - #if incidence - fc_control$value_type == "incidence" ~ fc_cases_lwr / !!quo_popfield * inc_per, - #otherwise - TRUE ~ NA_real_) - #value = fc_cases / !!quo_popfield * inc_per, - #upper = fc_cases_upr / !!quo_popfield * inc_per, - #lower = fc_cases_lwr / !!quo_popfield * inc_per - ) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) - - # return list with res and other needed items - fc_res_full <- create_named_list(fc_epi = preds_catch, - fc_res, - env_data_extd, - env_variables_used, - env_dt_ranges, - reg_obj) -} - -#forecasting helper functions -# this creates a modified b-spline basis (which is a piecewise polynomial) - -#' Truncates poly. Creates a modified b-spline basis. -#' -#' The modified basis splines are used to capture any long term trends per -#' geographic group. -#' -#'@param x Vector of weekly observation dates. -#'@param degree Degree passed to splines::bs(). -#'@param maxobs Date of the last known value. -#'@param minobs Date of the first known value. -#' -#'@return A modified b-spline basis with the last basis splines reversed and -#' the second to last basis spline function removed (to reduce the edge effects -#' of using splines). -#' -truncpoly <- function(x = NULL, degree = 6, maxobs = NULL, minobs = NULL){ - - # Some of the later functions will convert date to type spline, so - # it's best to go ahead and convert now. Left_join doesn't convert - # dates to numeric on the fly. - x <- as.numeric(x) - - # create frame to hold modified b-spline basis - xdf <- data.frame(x=x) - - # figure out where we apparently have data - apparentminobs <- min(xdf$x, na.rm=TRUE) - apparentmaxobs <- max(xdf$x, na.rm=TRUE) - - # figure out where the bspline basis will have support - if (!is.null(minobs)) { - - actualminobs <- max(apparentminobs, minobs) - - } else { actualminobs <- apparentminobs } - if (!is.null(maxobs)) { - - actualmaxobs <- min(apparentmaxobs, maxobs) - - } else { actualmaxobs <- apparentmaxobs } - - # create a full frame to hold this basis before truncation - xdf2 <- data.frame(x = actualminobs:actualmaxobs) - xdf2$bas <- splines::bs(x=xdf2$x, degree=degree) - - # reverse the last spline basis function - xdf2$bas[,degree] <- rev(xdf2$bas[,degree]) - - # delete the next to last spline basis function - xdf2$bas <- xdf2$bas[,-(degree-1)] - - # merge with original frame - xdf <- dplyr::left_join(xdf, xdf2, by="x") - - # make values 0 where we extend beyond actualmax/minobs - for (colnum in 1:ncol(xdf$bas)) { - - xdf$bas[is.na(xdf$bas[,colnum]),colnum] <- 0 - - } - - tempdf <- data.frame(xdf$bas) - names(tempdf) <- paste("modbs_reserved_", names(tempdf), sep="") - - return(tempdf) - -} - -#' Pull only model env variables. -#' -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. -#' -#'@return List of environmental variables that were used in the -#' modeling (had to be both listed in model variables input file and present the -#' env_data dataset). -#' -pull_model_envvars <- function(env_data, quo_obsfield, fc_control){ - - #pull variables from model info input - model_vars <- fc_control$env_vars %>% dplyr::pull(!!quo_obsfield) - - #filter env_data for those model_vars - env_data <- env_data %>% - dplyr::filter(!!quo_obsfield %in% model_vars) -} - -#' Extend environmental data into the future. -#' -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables -#'@param quo_valuefield Quosure of user given field name of the value of the -#' environmental data variable observations. -#'@param env_ref_data Historical averages by week of year for environmental -#' variables. Used in extended environmental data into the future for long -#' forecast time, to calculate anomalies in early detection period, and to -#' display on timeseries in reports. -#'@param env_info Lookup table for environmental data - reference creation -#' method (e.g. sum or mean), report labels, etc. -#'@param env_variables_used List of environmental variables that were used in -#' the modeling -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. -#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi -#' weeks) that the weeks of the year in epidemiological and environmental -#' reference data use ["ISO" or "CDC"]. -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-gam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param valid_run Internal boolean for whether this is part of a validation run. -#' -#'@return Environmental dataset, with data extended into the future forecast -#' period. Unknown environmental data with runs of < 2 weeks is -#' filled in with last known data (i.e. "persistence" method, using the mean of -#' the previous week of known data). For missing data runs more than 2 weeks, the -#' values are filled in using a progressive blend of the the mean of the last -#' known week and the historical means. -#' -extend_env_future <- function(env_data, - quo_groupfield, - groupings, - quo_obsfield, - quo_valuefield, - env_ref_data, - env_info, - env_variables_used, - report_dates, - week_type, - model_choice, - valid_run){ - - # Extend environmental data into the future forecast time period, while - # also dealing with any other missing environmental data. - - # Progressive blend (over # of missing weeks) of - # mean of last known week & historical/climatological means (weekly value) - # but only if missing run is larger than 2 weeks * 7 = 14 days - # if less than, just use persistence/carry forward/last known value - # E.g. if 20 missing in a run: - # 1 was filled in with previous week mean (recent value) - # 2: 19/20 recent + 1/20 historical, 3: 18/20 recent + 2/20 historical, ... 20: 1/20 recent + 19/20 historical. - # Will ALWAYS include part of recent known data (relevant if recent patterns are departure from climate averages) - - - #Do not need data past end of forecast period - env_trim <- env_data %>% - dplyr::filter(obs_date <= report_dates$forecast$max) - - #Calculate the earliest of the latest known data dates - # per env var, per geographic grouping - earliest_end_known <- env_trim %>% - #per geographic grouping, per environmental variable - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - #the last known date for each - dplyr::summarize(max_dates = max(obs_date, na.rm = TRUE)) %>% - #the earliest of the last known - dplyr::pull(max_dates) %>% min() - - - #If earliest_end_known is end of forecast period, then no missing data - if (earliest_end_known >= report_dates$forecast$max){ - - env_extended_final <- env_trim - - } else { - #Some amount of missing data exists - - #Calculate full/complete data table - #combination of all groups, env vars, and dates (DAILY) - #from earliest_end_known through the end of the forecast period - env_future_complete <- tidyr::crossing(obs_date = seq.Date(earliest_end_known + 1, - report_dates$forecast$max, 1), - group_temp = groupings, - obs_temp = env_variables_used) - #and fix names with NSE - env_future_complete <- env_future_complete %>% - dplyr::rename(!!rlang::quo_name(quo_groupfield) := group_temp, - !!rlang::quo_name(quo_obsfield) := obs_temp) - - #could have ragged env data per variable per grouping - #so, antijoin with env_known_fill first to get the actually missing rows - env_future_missing <- env_future_complete %>% - dplyr::anti_join(env_trim, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), - "obs_date"), - c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), - "obs_date"))) - - - - #bind with existing data (NAs for everything else) - env_future <- dplyr::bind_rows(env_trim, env_future_missing) %>% - #mark which are about to be filled in - dplyr::mutate(data_source = ifelse(is.na(val_epidemiar), "Extended", data_source)) - - #Optimizing for speed for validation runs with naive models, skip unneeded - - if (valid_run == TRUE & - (model_choice == "naive-persistence" | model_choice == "naive-averageweek")){ - - #Missing environmental data is fine for naive models - # as they do not use that data - # and validation runs do not return env data - env_extended_final <- env_future - - } else { - #need to fill in missing data - - #function for rle needed to honor group_bys - # computes an rle based on if value is NA or not - # returns the number of rows in the run - get_rle_na_info <- function(x){ - x_na_rle <- rle(is.na(x)) - run_id = rep(seq_along(x_na_rle$lengths), times = x_na_rle$lengths) - run_tot <- rep(x_na_rle$lengths, times = x_na_rle$lengths) - as_tibble(create_named_list(run_id, run_tot)) - } - - - env_na_rle <- env_future %>% - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - #make doubly sure in sorted date order - arrange(obs_date) %>% - #since adding multiple columns, use do instead of mutate - do(cbind(., get_rle_na_info(.$val_epidemiar))) %>% - #add a groupby with the new run ID - group_by(!!quo_groupfield, !!quo_obsfield, run_id) %>% - #creates an index of where that row is in the run - mutate(id_in_run = seq_along(val_epidemiar)) - - #find 1st NA, then take mean of previous week, input for that day - #first NA now can be found with is.na(val_epidemiar) & id_in_run == 1 - #use zoo::rollapply for mean - - #Fill in first NA of a run with the mean of previous week - env_na1fill <- env_na_rle %>% - #confirm proper grouping - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - #create a 1 day lag variable since need previous 7 days not including current - mutate(val_lag1 = dplyr::lag(val_epidemiar, n = 1), - #if_else to find the first NA - val_epidemiar = ifelse(is.na(val_epidemiar) & id_in_run == 1, - #zoo:rollapply to calculate mean of last 7 days (week) on lagged var - zoo::rollapply(data = val_lag1, - width = 7, - FUN = mean, - align = "right", - na.rm = TRUE), - #if not first NA, then contine with original val_epidemiar value - val_epidemiar)) %>% - #drop unneeded lag column - select(-val_lag1) - - ##Prep for blending previous week mean & historical averages for other missing - - #Prep ref data - get only used vars - env_ref_varused <- env_ref_data %>% - dplyr::filter(!!quo_obsfield %in% env_variables_used) - - - #joins for ref summary type, and summary for week - env_join_ref <- env_na1fill %>% - #add week, year fields - epidemiar::add_datefields(week_type) %>% - #get reference/summarizing method from user supplied env_info - dplyr::left_join(env_info %>% - dplyr::select(!!quo_obsfield, reference_method), - by = rlang::set_names(rlang::quo_name(quo_obsfield), - rlang::quo_name(quo_obsfield))) %>% - #get weekly ref value - dplyr::left_join(env_ref_varused %>% - dplyr::select(!!quo_obsfield, !!quo_groupfield, week_epidemiar, ref_value), - #NSE fun - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), - "week_epidemiar"), - c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), - "week_epidemiar"))) - - #calculate NA missing values using carry|blend - env_filled <- env_join_ref %>% - #order very important for filling next step - dplyr::arrange(!!quo_groupfield, !!quo_obsfield, obs_date) %>% - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - #propagate last known value down rows - dplyr::mutate(last_known = val_epidemiar) %>% - #fill down, so missing weeks has "last known value" IN row for calculations - tidyr::fill(last_known, .direction = "down") %>% - #calculate parts (for all, will only use when needed) - # with progressive blending based on id_in_run and run_tot - mutate(recent_modifier = (run_tot - id_in_run - 1) / run_tot, - recent_part = recent_modifier * last_known, - historical_modifier = (id_in_run - 1) / run_tot, - #historical is by week, so get pseudo-daily value depending on reference method, - # i.e. how to summarize a week of data - historical_value = dplyr::case_when( - reference_method == "mean" ~ ref_value, - reference_method == "sum" ~ ref_value / 7, - #default as if mean - TRUE ~ ref_value), - historical_part = historical_modifier * historical_value, - #testing - val_orig = val_epidemiar, - #only fill NA values - val_epidemiar = ifelse(is.na(val_epidemiar), - #persist if <15 days, blend if greater - ifelse(run_tot < 15, - last_known, - recent_part + historical_part), - #if notNA, then use existing val_epidemiar value - val_epidemiar)) - - #clean up - env_extended_final <- env_filled %>% - #remove all added columns to match original format - select(-c(run_id, run_tot, id_in_run, - week_epidemiar, year_epidemiar, - last_known, - reference_method, ref_value, - recent_modifier, recent_part, - historical_modifier, historical_value, historical_part, - val_orig)) %>% - #fill everything except original value field - #for any other column that got vanished during crossing, etc. - tidyr::fill(dplyr::everything(), -!!quo_valuefield, -!!quo_groupfield, -!!quo_obsfield, .direction = "down") %>% - #ungroup to end - ungroup() - - } #end else, meaning some missing data - - - } #end else on valid run & naive models - - #several paths to get to an env_extended_final - return(env_extended_final) - -} # end extend_env_future - - - - -#' Extend epidemiology dataframe into future. -#' -#'@param epi_data Epidemiological data with case numbers per week, with date -#' field "obs_date". -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. -#' -#'@return Epidemiological dataset extended past the known epi data time range -#' and into the future/forecast period. Case numbers are filled in the NA (to -#' be forecasted), and the population is estimated in a persistence method. -#' -extend_epi_future <- function(epi_data, quo_popfield, quo_groupfield, groupings, report_dates){ - #extended epi data into future dates - #for use in modeling later (results will be put elsewhere), this is for env and lags and modeling dataset - epi_future <- tidyr::crossing(obs_date = report_dates$forecast$seq, - group_temp = groupings) - #and fix names with NSE - epi_future <- epi_future %>% - dplyr::rename(!!quo_name(quo_groupfield) := group_temp) - - #bind with exisiting data (NAs for everything else in epi_future) - extended_epi <- dplyr::bind_rows(epi_data, epi_future) %>% - dplyr::arrange(!!quo_groupfield, obs_date) - - #fill population down - extended_epi <- tidyr::fill(extended_epi, !!quo_popfield, .direction = "down") - - extended_epi -} - -#' Format env data for modeling -#' -#'@param env_data_extd An environmental dataset extended into the -#' future/forecast period with estimated values for the environmental -#' variables. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables. -#' -#'@return An environmental dataset formatted to pass over to BAM/GAM modeling. -#' -env_format_fc <- function(env_data_extd, quo_groupfield, quo_obsfield){ - #turns long format into wide format - one entry per day per group - #1: groupfield, 2: Date, 3: numericdate, 4+: env var (column name is env name) - env_spread <- env_data_extd %>% - dplyr::mutate(numericdate = as.numeric(obs_date)) %>% - dplyr::select(!!quo_groupfield, !!quo_obsfield, obs_date, numericdate, val_epidemiar) %>% - tidyr::spread(key = !!quo_obsfield, value = val_epidemiar) - - env_spread -} - -#' Format epi data for modeling -#' -#'@param epi_data_extd An epidemiological dataset extended into the -#' future/forecast period with NA values for to-be-forecasted case numbers. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. -#' -#'@return An epidemiological dataset formatted to pass over to BAM/GAM modeling. -#' -epi_format_fc <- function(epi_data_extd, quo_groupfield, fc_control){ - - #Get cluster information from model - epi_format <- epi_data_extd %>% - #join with cluster info - dplyr::left_join(fc_control$clusters, - #NSE - by = rlang::set_names(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_groupfield))) %>% - #set cluster id as factor, must be for regression later - dplyr::mutate(cluster_id = as.factor(cluster_id), - #need numeric date for regression - numericdate = as.numeric(obs_date)) - - epi_format -} - -#' Convert environmental data into anomalies. -#' -#' Raw environmental values are not used in modeling, but rather their -#' anomalies, departures for the historical "normal". We are looking at the -#' influence of deviation from normal in the environmental factors to help -#' explain deviations from normal in the human cases. -#' -#'@param env_fc Environmental data formatted for forecasting by env_format_fc(). -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param env_variables_used List of environmental variables that were used in -#' the modeling. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. -#' -#'@return Environmental dataset in same format as env_fc but with the residuals -#' from a GAM with geographic unit and cyclical cubic regression spline on day -#' of year per geographic group in place of the original raw values. -#' -anomalize_env <- function(env_fc, quo_groupfield, env_variables_used, ncores) { - - # Loop through each environmental variable replacing non-NA observations - # with residuals from a gam with only geographic area (group) and day of year - - #Originally written with dataframes. Tibble/NSE/dplyr conversion not yet fully done. - # #new tibble - # env_fc_anom <- env_fc %>% - # mutate(group_factor = factor(!!quo_groupfield), - # doy = format(obs_date, "%j")) %>% as.numeric() - - # needed data for gam - group_factor <- env_fc %>% pull(!!quo_groupfield) %>% factor() - doy <- env_fc %>% pull(obs_date) %>% format("%j") %>% as.numeric() - - env_fc <- as.data.frame(env_fc) - - # loop through environmental columns - # note: brittle on column position until rewrite - for (curcol in 4:ncol(env_fc)) { - - #if more than one geographic area - if (nlevels(group_factor) > 1){ - tempbam <- mgcv::bam(env_fc[,curcol] ~ group_factor + s(doy, bs="cc", by=group_factor), - data=env_fc, - discrete = TRUE, - nthreads = ncores) - } else { - #if only 1 geographic area, then run without group_factor - tempbam <- mgcv::bam(env_fc[,curcol] ~ s(doy, bs="cc"), - data=env_fc, - discrete = TRUE, - nthreads = ncores) - } - - # could perhaps more cleverly be figured out by understanding the na.options of bam, - # but for the moment just replace non-NA observations with their residuals - env_fc[!is.na(env_fc[,curcol]),curcol] <- tempbam$residuals - - } - - env_fc <- tibble::as_tibble(env_fc) - return(env_fc) - -} - -#' Lag the environmental data. -#' -#'@param epi_fc An epidemiological dataset extended into the -#' future/forecast period with NA values for to-be-forecasted case numbers, -#' as formatted for forecasting by epi_format_fc(). -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param env_fc Environmental data formatted for forecasting by env_format_fc(). -#'@param env_variables_used List of environmental variables that were used in -#' the modeling. -#'@param laglen The maximum number of days in the past to consider interactions -#' between the environmental variable anomalies and the disease case counts. -#' -#'@return Wide dataset based on epidemiological data dates with five -#' bandsummaries per environmental variable, from the basis spline summaries of -#' the lagged environmental variable. -#' -lag_environ_to_epi <- function(epi_fc, quo_groupfield, groupings, - env_fc, env_variables_used, laglen){ - - #create lag frame - datalagger <- tidyr::crossing(group_temp = groupings, - obs_date = unique(epi_fc$obs_date), - lag = seq(from = 0, to = laglen - 1, by = 1)) %>% - # #same order from originally written expand.grid - # arrange(lag, Date, group_temp) %>% - #add lagging date - dplyr::mutate(laggeddate = obs_date - as.difftime(lag, units = "days")) - - #and fix names with NSE - datalagger <- datalagger %>% - dplyr::rename(!!quo_name(quo_groupfield) := group_temp) - - #add env data - datalagger <- dplyr::left_join(datalagger, env_fc, - #because dplyr NSE, notice flip order - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), "laggeddate"))) - - # pivot lagged environmental data to epi data - epi_lagged <- epi_fc #to more easily debug and rerun - for (curcol in which(colnames(env_fc) %in% env_variables_used)){ - valuevar <- colnames(env_fc)[curcol] - #wide data for all lags of that env var - meandat <- datalagger %>% - dplyr::select(!!quo_groupfield, obs_date, lag, valuevar) %>% - tidyr::spread(key = lag, value = valuevar) - #rename lag columns (but not groupfield or Date) - names(meandat)[-(1:2)] <- paste0(valuevar, "_", names(meandat)[-(1:2)]) - - #join cur var wide data to epi data - epi_lagged <- dplyr::left_join(epi_lagged, meandat, - #dplyr NSE - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), "obs_date"))) - } #end pivot loop - - # # set up distributed lag basis functions (creates 5 basis functions) - # lagframe <- data.frame(x = seq(from = 1, to = laglen, by = 1)) - # alpha <- 1/4 - # distlagfunc <- splines::ns(lagframe$x, intercept = TRUE, - # knots = quantile(lagframe$x, - # probs=seq(from = alpha, to = 1 - alpha, - # by = alpha), - # na.rm = TRUE)) - # dlagdeg <- pracma::size(distlagfunc)[2] - - # set up distributed lag basis functions (creates 7 basis functions) - alpha <- 1/4 - distlagfunc <- splines::bs(x=seq(from=1, to=laglen, by=1), intercept=TRUE, - knots=quantile(seq(from=1, to=laglen, by=1), - probs=seq(from=alpha, to=1-alpha, by=alpha), - na.rm=TRUE)) - dlagdeg <- ncol(distlagfunc) - - - # create actual distributed lag summaries - for (curvar in env_variables_used){ - bandsum <- matrix(data = rep(0, nrow(epi_lagged) * dlagdeg), - nrow = nrow(epi_lagged), ncol = dlagdeg) - #first column of that variable (0 lag) - mindex <- which(colnames(epi_lagged) == paste0(curvar, "_0")) - #temp working matrix - bandtemp <- as.matrix(epi_lagged[, (mindex:(mindex+laglen-1))]) - #distributed lag summaries - for (j in 1:dlagdeg){ - bandsum[, j] <- bandtemp %*% distlagfunc[,j] - } - bandsum <- data.frame(bandsum) - names(bandsum) <- paste0("bandsum_", curvar, "_", 1:dlagdeg) - - # we used to do a submatrix here so that the regression formulae would - # be more easily written, but this was incompatible with dplyr - epi_lagged <- dplyr::bind_cols(epi_lagged, bandsum) - - #created summary value for each basis function (5) per env variable per group per week (based on epidemiological data time unit) - - } #end distr lag summary loop - - #only keep bandsummaries (daily lags can be removed to free up a lot of space) - # note: ^ matches beginning of string, otherwise we'd get the bandsummaries too, which we want to keep - for (cvar in env_variables_used){ - epi_lagged[, which(grepl(paste0("^", cvar, "_"), colnames(epi_lagged)))] <- NULL - } - - epi_lagged -} - -#' Run forecast regression -#' -#'@param epi_lag Epidemiological dataset with basis spline summaries of the -#' lagged environmental data (or anomalies), as output by lag_environ_to_epi(). -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param env_variables_used List of environmental variables that were used in -#' the modeling. -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. -#'@param req_date The end date of requested forecast regression. When fit_freq -#' == "once", this is the last date of the full report, the end date of the -#' forecast period. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. -#'@param fit_freq String indicating "once" or "weekly" on how often to fit the -#' model - once for the whole report, or every week of the report. Unless -#' otherwise needed, the value should be "once", as weekly drastically -#' increases processing time. -#'@param model_run TRUE/FALSE flag for whether to only generate the model -#' regression object plus metadata. This model can be cached and used later on -#' its own, skipping a large portion of the slow calculations for future runs. -#'@param model_cached The output of a previous model_run = TRUE run of -#' run_epidemia() that produces a model (regression object) and metadata. The -#' metadata will be used for input checking and validation. Using a prebuilt -#' model saves on processing time, but will need to be updated periodically. -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-bam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param theta From fc_control$theta, the value of theta for a "negbin" model. -#' If present, will use glm(..., family = MASS::negative.binomial(theta)). If -#' missing, will use MASS::glm.nb(). -#' -#'@return Named list containing: -#'date_preds: Full forecasted resulting dataset. -#'reg_obj: The regression object from modeling. -#'Unless model_run is TRUE, in which case only the regression object is returned. -#' -#' -forecast_regression <- function(epi_lag, - quo_groupfield, - groupings, - env_variables_used, - report_dates, - req_date, - ncores, - fit_freq, - model_run, - model_cached = NULL, - model_choice, - theta){ - - if (fit_freq == "once"){ - #single fits use all the data available - last_known_date <- report_dates$known$max - } else if (fit_freq == "week"){ - # for "week" model fits, forecasts are done knowing up to just before that date - last_known_date <- req_date - lubridate::as.difftime(1, units = "days") - } - - ## Set up data - - #mark known or not - epi_lag <- epi_lag %>% - dplyr::mutate(known = ifelse(obs_date <= last_known_date, 1, 0)) - - # ensure that quo_name(quo_groupfield) is a factor - gam/bam will fail if given a character, - # which is unusual among regression functions, which typically just coerce into factors. - epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::quo_name(quo_groupfield) := factor(!!quo_groupfield)) - #number of geographic area groupings - n_groupings <- epi_lag %>% pull(!!quo_groupfield) %>% nlevels() - - #number of clusters - n_clusters <- nlevels(epi_lag$cluster_id) - - # create a doy field so that we can use a cyclical spline - epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(obs_date, "%j"))) - - # create modified bspline basis in epi_lag file to model longterm trends - epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, - degree=6, - maxobs=max(epi_lag$obs_date[epi_lag$known==1], na.rm=TRUE))) - - - - ## If model_cached is NOT given, then create model / run regression - if (is.null(model_cached)){ - - #create variable bandsummaries equation piece - # e.g. 'bandsummaries_{var1} * cluster_id' for however many env var bandsummaries there are - bandsums_list <- grep("bandsum_*", colnames(epi_lag), value = TRUE) - bandsums_cl_list <- paste(bandsums_list, ": cluster_id") - #need variant without known multiplication if <= 1 clusters - if (n_clusters > 1) { - bandsums_eq <- glue::glue_collapse(bandsums_cl_list, sep =" + ") - } else { - bandsums_eq <- glue::glue_collapse(bandsums_list, sep = " + ") - } - - # get list of modbspline reserved variables and format for inclusion into model - modb_list <- grep("modbs_reserved_*", colnames(epi_lag), value = TRUE) - # variant depending on >1 geographic area groupings - if (n_groupings > 1){ - modb_list_grp <- paste(modb_list, ":", rlang::quo_name(quo_groupfield)) - modb_eq <- glue::glue_collapse(modb_list_grp, sep = " + ") - } else { - modb_eq <- glue::glue_collapse(modb_list, sep = " + ") - } - - #filter to known - epi_known <- epi_lag %>% dplyr::filter(known == 1) - - - # Model building switching point - - regress <- build_model(model_choice, - n_groupings, - quo_groupfield, - modb_eq, - bandsums_eq, - epi_known, - ncores, - theta) - - } else { - #if model_cached given, then use that as regress instead of building a new one (above) - - #message with model input - message("Using given cached ", model_cached$model_info$model_choice, " model, created ", - model_cached$model_info$date_created, ", with epidemiological data up through ", - model_cached$model_info$known_epi_range$max, ".") - - regress <- model_cached$model_obj - } - - ## If model run, return regression object to run_forecast() at this point - if (model_run){ - return(regress) - } - - ## Creating predictions switching point on model choice - preds <- create_predictions(model_choice, - regress, - epi_lag, - req_date, - ncores) - - - ## Clean up - #remove distributed lag summaries and bspline basis, which are no longer helpful - band_names <- grep("bandsum_*", colnames(epi_lag), value = TRUE) - bspl_names <- grep("modbs_reserved_*", colnames(epi_lag), value = TRUE) - #remove - epi_lag_trim <- dplyr::select(epi_lag, -dplyr::one_of(band_names)) - epi_lag_trim <- dplyr::select(epi_lag_trim, -dplyr::one_of(bspl_names)) - - - #now cbind to get ready to return - epi_preds <- cbind(epi_lag_trim %>% - filter(obs_date <= req_date), - as.data.frame(preds)) %>% - #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) - dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) - - if (fit_freq == "once"){ - #for single model fit, this has all the data we need, just trim to report dates - date_preds <- epi_preds %>% - filter(obs_date >= report_dates$full$min) - } else if (fit_freq == "week"){ - #prediction of interest are last ones (equiv to req_date) per groupfield - date_preds <- epi_preds %>% - dplyr::group_by(!!quo_groupfield) %>% - dplyr::filter(obs_date == req_date) - } - - forecast_reg_results <- create_named_list(date_preds, - regress) -} - - -#'Build the appropriate model -#' -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-bam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param n_groupings Count of the number of geographic groupings in the model. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param modb_eq Pieces of the regression formula that include the modified -#' basis functions to account for long term trend (with or without groupings, -#' as appropriate). -#'@param bandsums_eq Pieces of the regression formula that include the b-spline -#' bandsummaries of the environmental factors. -#'@param epi_known Epidemiological dataset with basis spline summaries of the -#' lagged environmental data (or anomalies), with column marking if "known" -#' data and groupings converted to factors. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. -#'@param theta From fc_control$theta, the value of theta for a "negbin" model. -#' If present, will use glm(..., family = MASS::negative.binomial(theta)). If -#' missing, will use MASS::glm.nb(). - -#' -#'@return Regression object -#' -#' -build_model <- function(model_choice, - n_groupings, - quo_groupfield, - modb_eq, - bandsums_eq, - epi_known, - ncores, - theta){ - - #POISSON-BAM (set as default in first round input checking) - if (model_choice == "poisson-bam"){ - - message("Building Poisson model using bam() and forced cyclical...") - - #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create - #expression to give to modeling function - #different versions if multiple geographic area groupings or not - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("modeledvar ~ ", - rlang::quo_name(quo_groupfield), - " + s(doy, bs=\"cc\", by=", - rlang::quo_name(quo_groupfield), - ") + ", - modb_eq, " + ", - bandsums_eq)) - } else { - reg_eq <- stats::as.formula(paste("modeledvar ~ ", - "s(doy, bs=\"cc\") + ", - modb_eq, " + ", - bandsums_eq)) - } - - # run bam - # Using discrete = TRUE was much faster than using parallel with bam. - regress <- mgcv::bam(reg_eq, data = epi_known, - family=poisson(), - control=mgcv::gam.control(trace=FALSE), - discrete = TRUE, - nthreads = ncores) - - - } else if (model_choice == "negbin"){ - #NEGATIVE BINOMIAL using GLM - - message("Building negative binomial model...") - - #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create - #expression to give to modeling function - #different versions if multiple geographic area groupings or not - #No cycical (as opposed to bam with s()) - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("modeledvar ~ ", - rlang::quo_name(quo_groupfield), " + ", - modb_eq, " + ", - bandsums_eq)) - } else { - reg_eq <- stats::as.formula(paste("modeledvar ~ ", - modb_eq, " + ", - bandsums_eq)) - } - - # run glm - # Which negative binomial function depends on if fc_control$theta exists - if(!is.null(theta)){ - message("Theta value provided. Running with glm(..., family = MASS::negative.binomial(theta = ", theta, "))...") - regress <- stats::glm(reg_eq, - data = epi_known, - #theta value REQUIRED - #family = MASS::negative.binomial(theta=2.31), - family = MASS::negative.binomial(theta = theta)) - } else { - message("Theta estimate (fc_control$theta) not provided, running with MASS::glm.nb()...") - regress <- MASS::glm.nb(reg_eq, - data = epi_known) - } - - - } else if (model_choice == "naive-persistence"){ - - #naive model - #persistence (carry forward) - #no regression object - - #create "model" using known data. - #Will fill down in create_predictions - regress <- epi_known %>% - #grouping by geographical unit - dplyr::group_by(!!quo_groupfield) %>% - #prediction is 1 lag (previous week) - #fit is name of value from regression models - dplyr::mutate(fit = dplyr::lag(modeledvar, n = 1)) %>% - #cleaning up as not needed, and for bug hunting - dplyr::select(-dplyr::starts_with("band")) %>% - dplyr::select(-dplyr::starts_with("modbs")) - - - - } else if (model_choice == "naive-averageweek"){ - - #naive model - #average of week of year (from historical data) - #not a regression object - - #create "model" (averages) using known data. - regress <- epi_known %>% - #calculate averages per geographic group per week of year - dplyr::group_by(!!quo_groupfield, week_epidemiar) %>% - dplyr::summarize(fit = mean(modeledvar, na.rm = TRUE)) - - - } else { - #Shouldn't happen, just in case. - stop("Error in selecting model choice.") - } -} # end build_model() - - - -#'Create the appropriate predictions/forecasts. -#' -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-gam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param regress The regression object, either the user-supplied one, or -#' the one just generated. -#'@param epi_lag Epidemiological dataset with basis spline summaries of the -#' lagged environmental data (or anomalies), with groupings as a factor. -#'@param req_date The end date of requested forecast regression. When fit_freq -#' == "once", this is the last date of the full report, the end date of the -#' forecast period. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. -#' -#'@return A dataset from predict() using the regression object generated in -#' build_model or a newly created one. The dataset includes the -#' predicted/forecast values through the end of the report requested. -#' -#' -create_predictions <- function(model_choice, - regress, - epi_lag, - req_date, - ncores){ - - #POISSON-BAM (set as default in first round input checking) - if (model_choice == "poisson-bam"){ - - message("Creating Poisson predictions...") - - - ## Create predictions from either newly generated model, or given one - - #output prediction (through req_date) - preds <- mgcv::predict.bam(regress, - newdata = epi_lag %>% dplyr::filter(obs_date <= req_date), - se.fit = TRUE, # included for backwards compatibility - type="response", - discrete = TRUE, - n.threads = ncores) - - - - } else if (model_choice == "negbin"){ - #NEGATIVE BINOMIAL using GLM - - message("Creating negative binomial predictions...") - - - ## Create predictions from either newly generated model, or given one - - #output prediction (through req_date) - preds <- stats::predict.glm(regress, - newdata = epi_lag %>% dplyr::filter(obs_date <= req_date), - se.fit = TRUE, # included for backwards compatibility - type="response") - - - } else if (model_choice == "naive-persistence"){ - - message("Creating predictions using persistence naive model...") - - #persistence model just carries forward the last known value - #the important part is the forecast / trailing end part - #manipulating to be in quasi-same format as the other models return - - #cleaning up as not needed, and for bug hunting - epi_lag <- epi_lag %>% - dplyr::select(-dplyr::starts_with("band")) %>% - dplyr::select(-dplyr::starts_with("modbs")) - - #regress is a tibble not regression object here - # has a variable fit with lag of 1 on known data - #epi_lag has the newer rows - preds <- epi_lag %>% - #filter to requested date - dplyr::filter(obs_date <= req_date) %>% - #join to get "fit" values from "model" - #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming - dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% - #important at end/fc section, when we fill down - tidyr::fill(fit, .direction = "down") %>% - #format into nominal regression predict output - dplyr::select(fit) %>% - as.data.frame() - - } else if (model_choice == "naive-averageweek"){ - - message("Creating predictions using average week of year naive model...") - - #average week null model calculates the average cases of that - # week of year from historical data - #manipulating to be in quasi-same format as the other models return - - #regress is the averages per week of year from known data - - epi_lag <- epi_lag %>% - #filter to requested date - dplyr::filter(obs_date <= req_date) - - #join back - preds <- epi_lag %>% - #join to get average values - #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming - # and so don't need column names not passed into this function - dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% - #format into nominal regression output - dplyr::select(fit) %>% - as.data.frame() - - - } else { - #Shouldn't happen, just in case. - stop("Error in selecting model choice.") - } - -} #end create_predictions() diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R new file mode 100644 index 0000000..e863061 --- /dev/null +++ b/R/forecasting_helpers.R @@ -0,0 +1,662 @@ +# helper/subfunctions related to forecasting + +#' Pull only model env variables. +#' +#'@param env_data Daily environmental data for the same groupfields and date +#' range as the epidemiological data. It may contain extra data (other +#' districts or date ranges). The data must be in long format (one row for each +#' date and environmental variable combination), and must start at absolutel +#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for +#' forecasting. +#'@param quo_obsfield Quosure of user given field name of the environmental data +#' variables +#'@param fc_control Parameters for forecasting, including which environmental +#' variable to include and any geographic clusters. +#' +#'@return List of environmental variables that were used in the +#' modeling (had to be both listed in model variables input file and present the +#' env_data dataset). +#' +pull_model_envvars <- function(env_data, quo_obsfield, env_var){ + + #pull variables into list + model_vars <- env_var %>% dplyr::pull(!!quo_obsfield) + + #filter env_data for those model_vars + env_data <- env_data %>% + dplyr::filter(!!quo_obsfield %in% model_vars) +} + +#' Extend environmental data into the future. +#' +#'@param env_data Daily environmental data for the same groupfields and date +#' range as the epidemiological data. It may contain extra data (other +#' districts or date ranges). The data must be in long format (one row for each +#' date and environmental variable combination), and must start at absolutel +#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for +#' forecasting. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param quo_obsfield Quosure of user given field name of the environmental data +#' variables +#'@param quo_valuefield Quosure of user given field name of the value of the +#' environmental data variable observations. +#'@param env_ref_data Historical averages by week of year for environmental +#' variables. Used in extended environmental data into the future for long +#' forecast time, to calculate anomalies in early detection period, and to +#' display on timeseries in reports. +#'@param env_info Lookup table for environmental data - reference creation +#' method (e.g. sum or mean), report labels, etc. +#'@param env_variables_used List of environmental variables that were used in +#' the modeling +#'@param report_dates Internally generated set of report date information: min, +#' max, list of dates for full report, known epidemiological data period, +#' forecast period, and early detection period. +#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi +#' weeks) that the weeks of the year in epidemiological and environmental +#' reference data use ["ISO" or "CDC"]. +#'@param model_choice Critical argument to choose the type of model to generate. +#' The options are versions that the EPIDEMIA team has used for forecasting. +#' The first supported options is "poisson-gam" ("p") which is the original +#' epidemiar model: a Poisson regression using bam (for large data GAMs), with +#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is +#' TRUE for using the anomalies of environmental variables rather than their +#' raw values. The second option is "negbin" ("n") which is a negative binomial +#' regression using glm, with no external seasonality terms - letting the +#' natural cyclical behavior of the environmental variables fill that role. The +#' default for fc_control$anom_env is FALSE and uses the actual observation +#' values in the modeling. The fc_control$anom_env can be overruled by the user +#' providing a value, but this is not recommended unless you are doing +#' comparisons. +#'@param valid_run Internal boolean for whether this is part of a validation run. +#' +#'@return Environmental dataset, with data extended into the future forecast +#' period. Unknown environmental data with runs of < 2 weeks is +#' filled in with last known data (i.e. "persistence" method, using the mean of +#' the previous week of known data). For missing data runs more than 2 weeks, the +#' values are filled in using a progressive blend of the the mean of the last +#' known week and the historical means. +#' +extend_env_future <- function(env_data, + quo_groupfield, + quo_obsfield, + quo_valuefield, + env_ref_data, + env_info, + fc_model_family, + #pull from report_settings + epi_date_type, + #calculated/internal + valid_run, + groupings, + env_variables_used, + report_dates){ + + # Extend environmental data into the future forecast time period, while + # also dealing with any other missing environmental data. + + # Progressive blend (over # of missing weeks) of + # mean of last known week & historical/climatological means (weekly value) + # but only if missing run is larger than 2 weeks * 7 = 14 days + # if less than, just use persistence/carry forward/last known value + # E.g. if 20 missing in a run: + # 1 was filled in with previous week mean (recent value) + # 2: 19/20 recent + 1/20 historical, 3: 18/20 recent + 2/20 historical, ... 20: 1/20 recent + 19/20 historical. + # Will ALWAYS include part of recent known data (relevant if recent patterns are departure from climate averages) + + + #Do not need data past end of forecast period (if exists) + env_trim <- env_data %>% + dplyr::filter(obs_date <= report_dates$forecast$max) + + #Calculate the earliest of the latest known data dates + # per env var, per geographic grouping + earliest_end_known <- env_trim %>% + #per geographic grouping, per environmental variable + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + #the last known date for each + dplyr::summarize(max_dates = max(obs_date, na.rm = TRUE)) %>% + #the earliest of the last known + dplyr::pull(max_dates) %>% min() + + + #If earliest_end_known is end of forecast period, then no missing data + if (earliest_end_known >= report_dates$forecast$max){ + + env_extended_final <- env_trim + + } else { + #Some amount of missing data exists + + #Calculate full/complete data table + #combination of all groups, env vars, and dates (DAILY) + #from earliest_end_known through the end of the forecast period + env_future_complete <- tidyr::crossing(obs_date = seq.Date(earliest_end_known + 1, + report_dates$forecast$max, 1), + group_temp = groupings, + obs_temp = env_variables_used) + #and fix names with NSE + env_future_complete <- env_future_complete %>% + dplyr::rename(!!rlang::quo_name(quo_groupfield) := group_temp, + !!rlang::quo_name(quo_obsfield) := obs_temp) + + #could have ragged env data per variable per grouping + #so, antijoin with env_known_fill first to get the actually missing rows + env_future_missing <- env_future_complete %>% + dplyr::anti_join(env_trim, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + rlang::quo_name(quo_obsfield), + "obs_date"), + c(rlang::quo_name(quo_groupfield), + rlang::quo_name(quo_obsfield), + "obs_date"))) + + + + #bind with existing data (NAs for everything else) + env_future <- dplyr::bind_rows(env_trim, env_future_missing) %>% + #mark which are about to be filled in + dplyr::mutate(data_source = ifelse(is.na(val_epidemiar), "Extended", data_source)) + + #Optimizing for speed for validation runs with naive models, skip unneeded + + if (valid_run == TRUE & + (fc_model_family == "naive-persistence" | fc_model_family == "naive-averageweek")){ + + #Missing environmental data is fine for naive models + # as they do not use that data + # and validation runs do not return env data + env_extended_final <- env_future + + } else { + #need to fill in missing data + + #function for rle needed to honor group_bys + # computes an rle based on if value is NA or not + # returns the number of rows in the run + get_rle_na_info <- function(x){ + x_na_rle <- rle(is.na(x)) + run_id = rep(seq_along(x_na_rle$lengths), times = x_na_rle$lengths) + run_tot <- rep(x_na_rle$lengths, times = x_na_rle$lengths) + as_tibble(create_named_list(run_id, run_tot)) + } + + + env_na_rle <- env_future %>% + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + #make doubly sure in sorted date order + arrange(obs_date) %>% + #since adding multiple columns, use do instead of mutate + do(cbind(., get_rle_na_info(.$val_epidemiar))) %>% + #add a groupby with the new run ID + group_by(!!quo_groupfield, !!quo_obsfield, run_id) %>% + #creates an index of where that row is in the run + mutate(id_in_run = seq_along(val_epidemiar)) + + #find 1st NA, then take mean of previous week, input for that day + #first NA now can be found with is.na(val_epidemiar) & id_in_run == 1 + #use zoo::rollapply for mean + + #Fill in first NA of a run with the mean of previous week + env_na1fill <- env_na_rle %>% + #confirm proper grouping + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + #create a 1 day lag variable since need previous 7 days not including current + mutate(val_lag1 = dplyr::lag(val_epidemiar, n = 1), + #if_else to find the first NA + val_epidemiar = ifelse(is.na(val_epidemiar) & id_in_run == 1, + #zoo:rollapply to calculate mean of last 7 days (week) on lagged var + zoo::rollapply(data = val_lag1, + width = 7, + FUN = mean, + align = "right", + na.rm = TRUE), + #if not first NA, then contine with original val_epidemiar value + val_epidemiar)) %>% + #drop unneeded lag column + select(-val_lag1) + + ##Prep for blending previous week mean & historical averages for other missing + + #Prep ref data - get only used vars + env_ref_varused <- env_ref_data %>% + dplyr::filter(!!quo_obsfield %in% env_variables_used) + + + #joins for ref summary type, and summary for week + env_join_ref <- env_na1fill %>% + #add week, year fields + epidemiar::add_datefields(week_type) %>% + #get reference/summarizing method from user supplied env_info + dplyr::left_join(env_info %>% + dplyr::select(!!quo_obsfield, reference_method), + by = rlang::set_names(rlang::quo_name(quo_obsfield), + rlang::quo_name(quo_obsfield))) %>% + #get weekly ref value + dplyr::left_join(env_ref_varused %>% + dplyr::select(!!quo_obsfield, !!quo_groupfield, week_epidemiar, ref_value), + #NSE fun + by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + rlang::quo_name(quo_obsfield), + "week_epidemiar"), + c(rlang::quo_name(quo_groupfield), + rlang::quo_name(quo_obsfield), + "week_epidemiar"))) + + #calculate NA missing values using carry|blend + env_filled <- env_join_ref %>% + #order very important for filling next step + dplyr::arrange(!!quo_groupfield, !!quo_obsfield, obs_date) %>% + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + #propagate last known value down rows + dplyr::mutate(last_known = val_epidemiar) %>% + #fill down, so missing weeks has "last known value" IN row for calculations + tidyr::fill(last_known, .direction = "down") %>% + #calculate parts (for all, will only use when needed) + # with progressive blending based on id_in_run and run_tot + mutate(recent_modifier = (run_tot - id_in_run - 1) / run_tot, + recent_part = recent_modifier * last_known, + historical_modifier = (id_in_run - 1) / run_tot, + #historical is by week, so get pseudo-daily value depending on reference method, + # i.e. how to summarize a week of data + historical_value = dplyr::case_when( + reference_method == "mean" ~ ref_value, + reference_method == "sum" ~ ref_value / 7, + #default as if mean + TRUE ~ ref_value), + historical_part = historical_modifier * historical_value, + #testing + val_orig = val_epidemiar, + #only fill NA values + val_epidemiar = ifelse(is.na(val_epidemiar), + #persist if <15 days, blend if greater + ifelse(run_tot < 15, + last_known, + recent_part + historical_part), + #if notNA, then use existing val_epidemiar value + val_epidemiar)) + + #clean up + env_extended_final <- env_filled %>% + #remove all added columns to match original format + select(-c(run_id, run_tot, id_in_run, + week_epidemiar, year_epidemiar, + last_known, + reference_method, ref_value, + recent_modifier, recent_part, + historical_modifier, historical_value, historical_part, + val_orig)) %>% + #fill everything except original value field + #for any other column that got vanished during crossing, etc. + tidyr::fill(dplyr::everything(), -!!quo_valuefield, -!!quo_groupfield, -!!quo_obsfield, .direction = "down") %>% + #ungroup to end + ungroup() + + } #end else, meaning some missing data + + + } #end else on valid run & naive models + + #several paths to get to an env_extended_final + return(env_extended_final) + +} # end extend_env_future + + + + +#' Extend epidemiology dataframe into future. +#' +#'@param epi_data Epidemiological data with case numbers per week, with date +#' field "obs_date". +#'@param quo_popfield Quosure of user-given field containing population values. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param report_dates Internally generated set of report date information: min, +#' max, list of dates for full report, known epidemiological data period, +#' forecast period, and early detection period. +#' +#'@return Epidemiological dataset extended past the known epi data time range +#' and into the future/forecast period. Case numbers are filled in the NA (to +#' be forecasted), and the population is estimated in a persistence method. +#' +extend_epi_future <- function(epi_data, + quo_popfield, + quo_groupfield, + #calculated/internal + groupings, + report_dates){ + #extended epi data into future dates + #for use in modeling later (results will be put elsewhere), this is for env and lags and modeling dataset + epi_future <- tidyr::crossing(obs_date = report_dates$forecast$seq, + group_temp = groupings) + #and fix names with NSE + epi_future <- epi_future %>% + dplyr::rename(!!quo_name(quo_groupfield) := group_temp) + + #bind with exisiting data (NAs for everything else in epi_future) + extended_epi <- dplyr::bind_rows(epi_data, epi_future) %>% + dplyr::arrange(!!quo_groupfield, obs_date) + + #fill population down + extended_epi <- tidyr::fill(extended_epi, !!quo_popfield, .direction = "down") + + extended_epi +} + + +#' Format env data for modeling +#' +#'@param env_data_extd An environmental dataset extended into the +#' future/forecast period with estimated values for the environmental +#' variables. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param quo_obsfield Quosure of user given field name of the environmental data +#' variables. +#' +#'@return An environmental dataset formatted to pass over to BAM/GAM modeling. +#' +env_format_fc <- function(env_data_extd, + quo_groupfield, + quo_obsfield){ + #turns long format into wide format - one entry per day per group + #1: groupfield, 2: Date, 3: numericdate, 4+: env var (column name is env name) + env_spread <- env_data_extd %>% + dplyr::mutate(numericdate = as.numeric(obs_date)) %>% + dplyr::select(!!quo_groupfield, !!quo_obsfield, obs_date, numericdate, val_epidemiar) %>% + tidyr::spread(key = !!quo_obsfield, value = val_epidemiar) + + env_spread +} + +#' Format epi data for modeling +#' +#'@param epi_data_extd An epidemiological dataset extended into the +#' future/forecast period with NA values for to-be-forecasted case numbers. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param fc_control Parameters for forecasting, including which environmental +#' variable to include and any geographic clusters. +#' +#'@return An epidemiological dataset formatted to pass over to BAM/GAM modeling. +#' +epi_format_fc <- function(epi_data_extd, + quo_groupfield, + fc_clusters){ + + #Get cluster information from model + epi_format <- epi_data_extd %>% + #join with cluster info + dplyr::left_join(fc_clusters, + #NSE + by = rlang::set_names(rlang::quo_name(quo_groupfield), + rlang::quo_name(quo_groupfield))) %>% + #set cluster id as factor, must be for regression later + dplyr::mutate(cluster_id = as.factor(cluster_id), + #need numeric date for regression + numericdate = as.numeric(obs_date)) + + epi_format +} + +#' Convert environmental data into anomalies. +#' +#' Raw environmental values are not used in modeling, but rather their +#' anomalies, departures for the historical "normal". We are looking at the +#' influence of deviation from normal in the environmental factors to help +#' explain deviations from normal in the human cases. +#' +#'@param env_fc Environmental data formatted for forecasting by env_format_fc(). +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param env_variables_used List of environmental variables that were used in +#' the modeling. +#'@param ncores The number of physical cores to use in parallel processing, set +#' in fc_control$ncores, else the max of the number of physical core available +#' minus 1, or 1 core. +#' +#'@return Environmental dataset in same format as env_fc but with the residuals +#' from a GAM with geographic unit and cyclical cubic regression spline on day +#' of year per geographic group in place of the original raw values. +#' +anomalize_env <- function(env_fc, + quo_groupfield, + nthreads, + #internal/calculated + env_variables_used) { + + # Loop through each environmental variable replacing non-NA observations + # with residuals from a gam with only geographic area (group) and day of year + + #Originally written with dataframes. Tibble/NSE/dplyr conversion not yet fully done. + # #new tibble + # env_fc_anom <- env_fc %>% + # mutate(group_factor = factor(!!quo_groupfield), + # doy = format(obs_date, "%j")) %>% as.numeric() + + # needed data for gam + group_factor <- env_fc %>% pull(!!quo_groupfield) %>% factor() + doy <- env_fc %>% pull(obs_date) %>% format("%j") %>% as.numeric() + + env_fc <- as.data.frame(env_fc) + + # loop through environmental columns + # note: brittle on column position until rewrite + for (curcol in 4:ncol(env_fc)) { + + #if more than one geographic area + if (nlevels(group_factor) > 1){ + tempbam <- mgcv::bam(env_fc[,curcol] ~ group_factor + s(doy, bs="cc", by=group_factor), + data=env_fc, + discrete = TRUE, + nthreads = ncores) + } else { + #if only 1 geographic area, then run without group_factor + tempbam <- mgcv::bam(env_fc[,curcol] ~ s(doy, bs="cc"), + data = env_fc, + discrete = TRUE, + nthreads = nthreads) + } + + # could perhaps more cleverly be figured out by understanding the na.options of bam, + # but for the moment just replace non-NA observations with their residuals + env_fc[!is.na(env_fc[,curcol]),curcol] <- tempbam$residuals + + } + + env_fc <- tibble::as_tibble(env_fc) + return(env_fc) + +} + +#' Lag the environmental data. +#' +#'@param epi_fc An epidemiological dataset extended into the +#' future/forecast period with NA values for to-be-forecasted case numbers, +#' as formatted for forecasting by epi_format_fc(). +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param env_fc Environmental data formatted for forecasting by env_format_fc(). +#'@param env_variables_used List of environmental variables that were used in +#' the modeling. +#'@param laglen The maximum number of days in the past to consider interactions +#' between the environmental variable anomalies and the disease case counts. +#' +#'@return Wide dataset based on epidemiological data dates with five +#' bandsummaries per environmental variable, from the basis spline summaries of +#' the lagged environmental variable. +#' +lag_environ_to_epi <- function(epi_fc, + env_fc, + quo_groupfield, + lag_len, + #calculated/internal + groupings, + env_variables_used){ + + #create lag frame + datalagger <- tidyr::crossing(group_temp = groupings, + obs_date = unique(epi_fc$obs_date), + lag = seq(from = 0, to = lag_len - 1, by = 1)) %>% + # #same order from originally written expand.grid + # arrange(lag, Date, group_temp) %>% + #add lagging date + dplyr::mutate(laggeddate = obs_date - as.difftime(lag, units = "days")) + + #and fix names with NSE + datalagger <- datalagger %>% + dplyr::rename(!!quo_name(quo_groupfield) := group_temp) + + #add env data + datalagger <- dplyr::left_join(datalagger, env_fc, + #because dplyr NSE, notice flip order + by = rlang::set_names(c(rlang::quo_name(quo_groupfield), "obs_date"), + c(rlang::quo_name(quo_groupfield), "laggeddate"))) + + # pivot lagged environmental data to epi data + epi_lagged <- epi_fc #to more easily debug and rerun + for (curcol in which(colnames(env_fc) %in% env_variables_used)){ + valuevar <- colnames(env_fc)[curcol] + #wide data for all lags of that env var + meandat <- datalagger %>% + dplyr::select(!!quo_groupfield, obs_date, lag, valuevar) %>% + tidyr::spread(key = lag, value = valuevar) + #rename lag columns (but not groupfield or Date) + names(meandat)[-(1:2)] <- paste0(valuevar, "_", names(meandat)[-(1:2)]) + + #join cur var wide data to epi data + epi_lagged <- dplyr::left_join(epi_lagged, meandat, + #dplyr NSE + by = rlang::set_names(c(rlang::quo_name(quo_groupfield), "obs_date"), + c(rlang::quo_name(quo_groupfield), "obs_date"))) + } #end pivot loop + + # # set up distributed lag basis functions (creates 5 basis functions) + # lagframe <- data.frame(x = seq(from = 1, to = laglen, by = 1)) + # alpha <- 1/4 + # distlagfunc <- splines::ns(lagframe$x, intercept = TRUE, + # knots = quantile(lagframe$x, + # probs=seq(from = alpha, to = 1 - alpha, + # by = alpha), + # na.rm = TRUE)) + # dlagdeg <- pracma::size(distlagfunc)[2] + + # set up distributed lag basis functions (creates 7 basis functions) + alpha <- 1/4 + distlagfunc <- splines::bs(x=seq(from=1, to=lag_len, by=1), intercept=TRUE, + knots=quantile(seq(from=1, to=lag_len, by=1), + probs=seq(from=alpha, to=1-alpha, by=alpha), + na.rm=TRUE)) + dlagdeg <- ncol(distlagfunc) + + + # create actual distributed lag summaries + for (curvar in env_variables_used){ + bandsum <- matrix(data = rep(0, nrow(epi_lagged) * dlagdeg), + nrow = nrow(epi_lagged), ncol = dlagdeg) + #first column of that variable (0 lag) + mindex <- which(colnames(epi_lagged) == paste0(curvar, "_0")) + #temp working matrix + bandtemp <- as.matrix(epi_lagged[, (mindex:(mindex+lag_len-1))]) + #distributed lag summaries + for (j in 1:dlagdeg){ + bandsum[, j] <- bandtemp %*% distlagfunc[,j] + } + bandsum <- data.frame(bandsum) + names(bandsum) <- paste0("bandsum_", curvar, "_", 1:dlagdeg) + + # we used to do a submatrix here so that the regression formulae would + # be more easily written, but this was incompatible with dplyr + epi_lagged <- dplyr::bind_cols(epi_lagged, bandsum) + + #created summary value for each basis function (5) per env variable per group per week (based on epidemiological data time unit) + + } #end distr lag summary loop + + #only keep bandsummaries (daily lags can be removed to free up a lot of space) + # note: ^ matches beginning of string, otherwise we'd get the bandsummaries too, which we want to keep + for (cvar in env_variables_used){ + epi_lagged[, which(grepl(paste0("^", cvar, "_"), colnames(epi_lagged)))] <- NULL + } + + epi_lagged +} + + + +# this creates a modified b-spline basis (which is a piecewise polynomial) + +#' Truncates poly. Creates a modified b-spline basis. +#' +#' The modified basis splines are used to capture any long term trends per +#' geographic group. +#' +#'@param x Vector of weekly observation dates. +#'@param degree Degree passed to splines::bs(). +#'@param maxobs Date of the last known value. +#'@param minobs Date of the first known value. +#' +#'@return A modified b-spline basis with the last basis splines reversed and +#' the second to last basis spline function removed (to reduce the edge effects +#' of using splines). +#' +truncpoly <- function(x = NULL, degree = 6, maxobs = NULL, minobs = NULL){ + + # Some of the later functions will convert date to type spline, so + # it's best to go ahead and convert now. Left_join doesn't convert + # dates to numeric on the fly. + x <- as.numeric(x) + + # create frame to hold modified b-spline basis + xdf <- data.frame(x=x) + + # figure out where we apparently have data + apparentminobs <- min(xdf$x, na.rm=TRUE) + apparentmaxobs <- max(xdf$x, na.rm=TRUE) + + # figure out where the bspline basis will have support + if (!is.null(minobs)) { + + actualminobs <- max(apparentminobs, minobs) + + } else { actualminobs <- apparentminobs } + if (!is.null(maxobs)) { + + actualmaxobs <- min(apparentmaxobs, maxobs) + + } else { actualmaxobs <- apparentmaxobs } + + # create a full frame to hold this basis before truncation + xdf2 <- data.frame(x = actualminobs:actualmaxobs) + xdf2$bas <- splines::bs(x=xdf2$x, degree=degree) + + # reverse the last spline basis function + xdf2$bas[,degree] <- rev(xdf2$bas[,degree]) + + # delete the next to last spline basis function + xdf2$bas <- xdf2$bas[,-(degree-1)] + + # merge with original frame + xdf <- dplyr::left_join(xdf, xdf2, by="x") + + # make values 0 where we extend beyond actualmax/minobs + for (colnum in 1:ncol(xdf$bas)) { + + xdf$bas[is.na(xdf$bas[,colnum]),colnum] <- 0 + + } + + tempdf <- data.frame(xdf$bas) + names(tempdf) <- paste("modbs_reserved_", names(tempdf), sep="") + + return(tempdf) + +} + + + + + diff --git a/R/forecasting_main.R b/R/forecasting_main.R new file mode 100644 index 0000000..58f072b --- /dev/null +++ b/R/forecasting_main.R @@ -0,0 +1,786 @@ +# Main run_epidemiar() subfunctions related to forecasting + +#' Runs the forecast modeling +#' +#'@param epi_data Epidemiological data with case numbers per week, with date +#' field "obs_date". +#'@param quo_popfield Quosure of user-given field containing population values. +#'@param inc_per Number for what unit of population the incidence should be +#' reported in, e.g. incidence rate of 3 per 1000 people. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param env_data Daily environmental data for the same groupfields and date +#' range as the epidemiological data. It may contain extra data (other +#' districts or date ranges). The data must be in long format (one row for each +#' date and environmental variable combination), and must start at absolutel +#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for +#' forecasting. +#'@param quo_obsfield Quosure of user given field name of the environmental data +#' variables +#'@param quo_valuefield Quosure of user given field name of the value of the +#' environmental data variable observations. +#'@param env_variables alphabetical list of all unique environmental variables +#' present in the original env_data dataset. +#'@param fc_control Parameters for forecasting, including which environmental +#' variable to include and any geographic clusters. +#'@param env_ref_data Historical averages by week of year for environmental +#' variables. Used in extended environmental data into the future for long +#' forecast time, to calculate anomalies in early detection period, and to +#' display on timeseries in reports. +#'@param env_info Lookup table for environmental data - reference creation +#' method (e.g. sum or mean), report labels, etc. +#'@param report_dates Internally generated set of report date information: min, +#' max, list of dates for full report, known epidemiological data period, +#' forecast period, and early detection period. +#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi +#' weeks) that the weeks of the year in epidemiological and environmental +#' reference data use ["ISO" or "CDC"]. +#'@param model_run TRUE/FALSE flag for whether to only generate the model +#' regression object plus metadata. This model can be cached and used later on +#' its own, skipping a large portion of the slow calculations for future runs. +#'@param model_cached The output of a previous model_run = TRUE run of +#' run_epidemia() that produces a model (regression object) and metadata. The +#' metadata will be used for input checking and validation. Using a prebuilt +#' model saves on processing time, but will need to be updated periodically. +#'@param model_choice Critical argument to choose the type of model to generate. +#' The options are versions that the EPIDEMIA team has used for forecasting. +#' The first supported options is "poisson-gam" ("p") which is the original +#' epidemiar model: a Poisson regression using bam (for large data GAMs), with +#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is +#' TRUE for using the anomalies of environmental variables rather than their +#' raw values. The second option is "negbin" ("n") which is a negative binomial +#' regression using glm, with no external seasonality terms - letting the +#' natural cyclical behavior of the environmental variables fill that role. The +#' default for fc_control$anom_env is FALSE and uses the actual observation +#' values in the modeling. The fc_control$anom_env can be overruled by the user +#' providing a value, but this is not recommended unless you are doing +#' comparisons. +#'@param valid_run Internal binary for whether this is part of a validation run. +#' +#' +#'@return Named list containing: +#'fc_epi: Full forecasted resulting dataset. +#'fc_res: The forecasted series in report format. +#'env_data_extd: Data set of the environmental data variables extended into the +#' unknown/future. +#'env_variables_used: list of environmental variables that were used in the +#' modeling (had to be both listed in model variables input file and present the +#' env_data dataset) +#'env_dt_ranges: Date ranges of the input environmental data. +#'reg_obj: The regression object from modeling. +#'Unless model_run is TRUE, in which case only the regression object is returned. +#' +#' +run_forecast <- function(epi_data, + quo_popfield, + quo_groupfield, + env_data, + quo_obsfield, + quo_valuefield, + env_ref_data, + env_info, + report_settings, + #internal/calculated + valid_run, + groupings, + env_variables, + report_dates){ + + # epi_data, + # quo_popfield, + # inc_per, + # quo_groupfield, + # groupings, + # env_data, + # quo_obsfield, + # quo_valuefield, + # env_variables, + # fc_control, + # env_ref_data, + # env_info, + # report_dates, + # week_type, + # model_run, + # model_cached = NULL, + # model_choice, + # valid_run + + + message("Preparing for forecasting...") + + + # trim to the needed env variables as dictated by the model + env_data <- pull_model_envvars(env_data = env_data, + quo_obsfield = quo_obsfield, + env_var = report_settings[["env_var"]]) + #create alphabetical list of ONLY USED unique environmental variables + env_variables_used <- dplyr::pull(env_data, !!quo_obsfield) %>% unique() %>% sort() + + # extract start & end dates for each variable for log file + env_dt_ranges <- dplyr::group_by(env_data, !!quo_obsfield) %>% + dplyr::summarize(start_dt = min(obs_date), end_dt = max(obs_date)) + + # extend data into future, for future forecast portion + env_data_extd <- extend_env_future(env_data, + quo_groupfield, + quo_obsfield, + quo_valuefield, + env_ref_data, + env_info, + fc_model_family, + #pull from report_settings + epi_date_type, + #calculated/internal + valid_run, + groupings, + env_variables_used, + report_dates) + + epi_data_extd <- extend_epi_future(epi_data, + quo_popfield, + quo_groupfield, + #calculated/internal + groupings, + report_dates) + + # format the data for forecasting algorithm + env_fc <- env_format_fc(env_data_extd, + quo_groupfield, + quo_obsfield) + epi_fc <- epi_format_fc(epi_data_extd, + quo_groupfield, + fc_clusters) + + # anomalizing the environ data, if requested. + + + if (report_settings[["anom_env"]]){ + message("Anomalizing the environmental variables...") + env_fc <- anomalize_env(env_fc, + quo_groupfield, + nthreads = report_settings[["fc_nthreads"]], + #calculated/internal + env_variables_used) + } + + # create the lags + epi_lag <- lag_environ_to_epi(epi_fc, + env_fc, + quo_groupfield, + lag_len = report_settings[["env_lag_length"]], + #calculated/internal + groupings, + env_variables_used) + + # add week of year, needed for null-weekaverage model + # switch epi_date_type to week_type needed for add_datefields() + week_type <- dplyr::case_when( + report_settings[["epi_date_type"]] == "weekISO" ~ "ISO", + report_settings[["epi_date_type"]] == "weekCDC" ~ "CDC", + #default as if mean + TRUE ~ NA_character_) + epi_lag <- add_datefields(epi_lag, week_type) + + + #<<>> FIX + # # If only model_run, then return to run_epidemia() here + # if (model_run){ + # model_run_result <- forecast_regression(epi_lag, + # quo_groupfield, + # fc_model_family, + # nthreads, + # model_run, + # model_cached = report_settings[["model_cached"]], + # fit_freq = report_settings[["fc_fit_freq"]], + # #internal calculated + # groupings, + # env_variables_used, + # report_dates, + # req_date = report_dates$full$max) + # + # model_run_only <- create_named_list(env_variables_used, + # env_dt_ranges, + # reg_obj = model_run_result) + # return(model_run_only) + # } + + + #Split regression call depending on {once|week} model fit frequency + + if (report_settings[["fc_fit_freq"]] == "once"){ + message("Generating forecasts...") + #for single fit, call with last week (and subfunction has switch to return all) + forereg_return <- forecast_regression(epi_lag, + quo_groupfield, + fc_model_family, + nthreads, + model_run, + model_cached = report_settings[["model_cached"]], + fit_freq = report_settings[["fc_fit_freq"]], + #internal calculated + groupings, + env_variables_used, + report_dates, + req_date = report_dates$full$max) + preds_catch <- forereg_return$date_preds + reg_obj <- forereg_return$regress + + } else if (report_settings[["fc_fit_freq"]] == "week") { + # for each week of report, run forecast + # initialize: prediction returns 4 columns + preds_catch <- data.frame() + #loop by week + for (w in seq_along(report_dates$full$seq)){ + message("Forecasting week ", w, " starting at ", Sys.time()) + dt <- report_dates$full$seq[w] + forereg_return <- forecast_regression(epi_lag, + quo_groupfield, + fc_model_family, + nthreads, + model_run, + model_cached = report_settings[["model_cached"]], + fit_freq = report_settings[["fc_fit_freq"]], + #internal calculated + groupings, + env_variables_used, + report_dates, + req_date = dt) + + dt_preds <- forereg_return$date_preds + preds_catch <- rbind(preds_catch, as.data.frame(dt_preds)) + + #taking advantage that only result will be of the last loop through + reg_obj <- forereg_return$regress + } + + } else stop("Model fit frequency unknown") #shouldn't happen with default "once" + + + # Interval calculation + preds_catch <- preds_catch %>% + dplyr::mutate(fc_cases = fit, + fc_cases_upr = fit+1.96*sqrt(fit), + fc_cases_lwr = fit-1.96*sqrt(fit)) + + # extract fc series into report format + fc_res <- preds_catch %>% + dplyr::mutate(series = "fc", + value = dplyr::case_when( + #if reporting in case counts + report_settings[["report_value_type"]] == "cases" ~ fc_cases, + #if incidence + report_settings[["report_value_type"]] == "incidence" ~ fc_cases / !!quo_popfield * inc_per, + #otherwise + TRUE ~ NA_real_), + lab = "Forecast Trend", + upper = dplyr::case_when( + #if reporting in case counts + report_settings[["report_value_type"]] == "cases" ~ fc_cases_upr, + #if incidence + report_settings[["report_value_type"]] == "incidence" ~ fc_cases_upr / !!quo_popfield * inc_per, + #otherwise + TRUE ~ NA_real_), + lower = dplyr::case_when( + #if reporting in case counts + report_settings[["report_value_type"]] == "cases" ~ fc_cases_lwr, + #if incidence + report_settings[["report_value_type"]] == "incidence" ~ fc_cases_lwr / !!quo_popfield * inc_per, + #otherwise + TRUE ~ NA_real_) + #value = fc_cases / !!quo_popfield * inc_per, + #upper = fc_cases_upr / !!quo_popfield * inc_per, + #lower = fc_cases_lwr / !!quo_popfield * inc_per + ) %>% + dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + + # return list with res and other needed items + fc_res_full <- create_named_list(fc_epi = preds_catch, + fc_res, + env_data_extd, + env_variables_used, + env_dt_ranges, + reg_obj) +} + + +#' Run forecast regression +#' +#'@param epi_lag Epidemiological dataset with basis spline summaries of the +#' lagged environmental data (or anomalies), as output by lag_environ_to_epi(). +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param env_variables_used List of environmental variables that were used in +#' the modeling. +#'@param report_dates Internally generated set of report date information: min, +#' max, list of dates for full report, known epidemiological data period, +#' forecast period, and early detection period. +#'@param req_date The end date of requested forecast regression. When fit_freq +#' == "once", this is the last date of the full report, the end date of the +#' forecast period. +#'@param ncores The number of physical cores to use in parallel processing, set +#' in fc_control$ncores, else the max of the number of physical core available +#' minus 1, or 1 core. +#'@param fit_freq String indicating "once" or "weekly" on how often to fit the +#' model - once for the whole report, or every week of the report. Unless +#' otherwise needed, the value should be "once", as weekly drastically +#' increases processing time. +#'@param model_run TRUE/FALSE flag for whether to only generate the model +#' regression object plus metadata. This model can be cached and used later on +#' its own, skipping a large portion of the slow calculations for future runs. +#'@param model_cached The output of a previous model_run = TRUE run of +#' run_epidemia() that produces a model (regression object) and metadata. The +#' metadata will be used for input checking and validation. Using a prebuilt +#' model saves on processing time, but will need to be updated periodically. +#'@param model_choice Critical argument to choose the type of model to generate. +#' The options are versions that the EPIDEMIA team has used for forecasting. +#' The first supported options is "poisson-bam" ("p") which is the original +#' epidemiar model: a Poisson regression using bam (for large data GAMs), with +#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is +#' TRUE for using the anomalies of environmental variables rather than their +#' raw values. The second option is "negbin" ("n") which is a negative binomial +#' regression using glm, with no external seasonality terms - letting the +#' natural cyclical behavior of the environmental variables fill that role. The +#' default for fc_control$anom_env is FALSE and uses the actual observation +#' values in the modeling. The fc_control$anom_env can be overruled by the user +#' providing a value, but this is not recommended unless you are doing +#' comparisons. +#'@param theta From fc_control$theta, the value of theta for a "negbin" model. +#' If present, will use glm(..., family = MASS::negative.binomial(theta)). If +#' missing, will use MASS::glm.nb(). +#' +#'@return Named list containing: +#'date_preds: Full forecasted resulting dataset. +#'reg_obj: The regression object from modeling. +#'Unless model_run is TRUE, in which case only the regression object is returned. +#' +#' +forecast_regression <- function(epi_lag, + quo_groupfield, + fc_model_family, + nthreads, + model_run, + model_cached = NULL, + fit_freq, + #internal calculated + groupings, + env_variables_used, + report_dates, + req_date){ + + if (fit_freq == "once"){ + #single fits use all the data available + last_known_date <- report_dates$known$max + } else if (fit_freq == "week"){ + # for "week" model fits, forecasts are done knowing up to just before that date + last_known_date <- req_date - lubridate::as.difftime(1, units = "days") + } + + ## Set up data + + #mark known or not + epi_lag <- epi_lag %>% + dplyr::mutate(known = ifelse(obs_date <= last_known_date, 1, 0)) + + # ensure that quo_name(quo_groupfield) is a factor - gam/bam will fail if given a character, + # which is unusual among regression functions, which typically just coerce into factors. + epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::quo_name(quo_groupfield) := factor(!!quo_groupfield)) + #number of geographic area groupings + n_groupings <- epi_lag %>% pull(!!quo_groupfield) %>% nlevels() + + #number of clusters + n_clusters <- nlevels(epi_lag$cluster_id) + + # create a doy field so that we can use a cyclical spline + epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(obs_date, "%j"))) + + # create modified bspline basis in epi_lag file to model longterm trends + epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, + degree=6, + maxobs=max(epi_lag$obs_date[epi_lag$known==1], na.rm=TRUE))) + + + + ## If model_cached is NOT given, then create model / run regression + if (is.null(model_cached)){ + + #create variable bandsummaries equation piece + # e.g. 'bandsummaries_{var1} * cluster_id' for however many env var bandsummaries there are + bandsums_list <- grep("bandsum_*", colnames(epi_lag), value = TRUE) + bandsums_cl_list <- paste(bandsums_list, ": cluster_id") + #need variant without known multiplication if <= 1 clusters + if (n_clusters > 1) { + bandsums_eq <- glue::glue_collapse(bandsums_cl_list, sep =" + ") + } else { + bandsums_eq <- glue::glue_collapse(bandsums_list, sep = " + ") + } + + # get list of modbspline reserved variables and format for inclusion into model + modb_list <- grep("modbs_reserved_*", colnames(epi_lag), value = TRUE) + # variant depending on >1 geographic area groupings + if (n_groupings > 1){ + modb_list_grp <- paste(modb_list, ":", rlang::quo_name(quo_groupfield)) + modb_eq <- glue::glue_collapse(modb_list_grp, sep = " + ") + } else { + modb_eq <- glue::glue_collapse(modb_list, sep = " + ") + } + + #filter to known + epi_known <- epi_lag %>% dplyr::filter(known == 1) + + + # Model building switching point + + regress <- build_model(fc_model_family, + quo_groupfield, + epi_known, + nthreads, + #calc/internal + n_groupings, + modb_eq, + bandsums_eq) + + } else { + #if model_cached given, then use that as regress instead of building a new one (above) + + #message with model input + message("Using given cached ", model_cached$model_info$fc_model_family, " model, created ", + model_cached$model_info$date_created, ", with epidemiological data up through ", + model_cached$model_info$known_epi_range$max, ".") + + regress <- model_cached$model_obj + } + + ## If model run, return regression object to run_forecast() at this point + if (model_run){ + return(regress) + } + + ## Creating predictions switching point on model choice + preds <- create_predictions(fc_model_family, + nthreads, + regress, + epi_lag, + req_date) + + + ## Clean up + #remove distributed lag summaries and bspline basis, which are no longer helpful + band_names <- grep("bandsum_*", colnames(epi_lag), value = TRUE) + bspl_names <- grep("modbs_reserved_*", colnames(epi_lag), value = TRUE) + #remove + epi_lag_trim <- dplyr::select(epi_lag, -dplyr::one_of(band_names)) + epi_lag_trim <- dplyr::select(epi_lag_trim, -dplyr::one_of(bspl_names)) + + + #now cbind to get ready to return + epi_preds <- cbind(epi_lag_trim %>% + filter(obs_date <= req_date), + as.data.frame(preds)) %>% + #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) + dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) + + if (fit_freq == "once"){ + #for single model fit, this has all the data we need, just trim to report dates + date_preds <- epi_preds %>% + filter(obs_date >= report_dates$full$min) + } else if (fit_freq == "week"){ + #prediction of interest are last ones (equiv to req_date) per groupfield + date_preds <- epi_preds %>% + dplyr::group_by(!!quo_groupfield) %>% + dplyr::filter(obs_date == req_date) + } + + forecast_reg_results <- create_named_list(date_preds, + regress) +} + + +#'Build the appropriate model +#' +#'@param model_choice Critical argument to choose the type of model to generate. +#' The options are versions that the EPIDEMIA team has used for forecasting. +#' The first supported options is "poisson-bam" ("p") which is the original +#' epidemiar model: a Poisson regression using bam (for large data GAMs), with +#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is +#' TRUE for using the anomalies of environmental variables rather than their +#' raw values. The second option is "negbin" ("n") which is a negative binomial +#' regression using glm, with no external seasonality terms - letting the +#' natural cyclical behavior of the environmental variables fill that role. The +#' default for fc_control$anom_env is FALSE and uses the actual observation +#' values in the modeling. The fc_control$anom_env can be overruled by the user +#' providing a value, but this is not recommended unless you are doing +#' comparisons. +#'@param n_groupings Count of the number of geographic groupings in the model. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param modb_eq Pieces of the regression formula that include the modified +#' basis functions to account for long term trend (with or without groupings, +#' as appropriate). +#'@param bandsums_eq Pieces of the regression formula that include the b-spline +#' bandsummaries of the environmental factors. +#'@param epi_known Epidemiological dataset with basis spline summaries of the +#' lagged environmental data (or anomalies), with column marking if "known" +#' data and groupings converted to factors. +#'@param ncores The number of physical cores to use in parallel processing, set +#' in fc_control$ncores, else the max of the number of physical core available +#' minus 1, or 1 core. +#'@param theta From fc_control$theta, the value of theta for a "negbin" model. +#' If present, will use glm(..., family = MASS::negative.binomial(theta)). If +#' missing, will use MASS::glm.nb(). + +#' +#'@return Regression object +#' +#' +build_model <- function(fc_model_family, + quo_groupfield, + epi_known, + nthreads, + #calc/internal + n_groupings, + modb_eq, + bandsums_eq){ + + #POISSON-BAM (set as default in first round input checking) + if (fc_model_family == "poisson-bam"){ + + message("Building Poisson model using bam() and forced cyclical...") + + #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create + #expression to give to modeling function + #different versions if multiple geographic area groupings or not + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), + " + s(doy, bs=\"cc\", by=", + rlang::quo_name(quo_groupfield), + ") + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + "s(doy, bs=\"cc\") + ", + modb_eq, " + ", + bandsums_eq)) + } + + # run bam + # Using discrete = TRUE was much faster than using parallel with bam. + regress <- mgcv::bam(reg_eq, data = epi_known, + family = poisson(), + control = mgcv::gam.control(trace=FALSE), + discrete = TRUE, + nthreads) + + + } else if (fc_model_family == "negbin"){ + #NEGATIVE BINOMIAL using GLM + + message("Building negative binomial model...") + + #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create + #expression to give to modeling function + #different versions if multiple geographic area groupings or not + #No cycical (as opposed to bam with s()) + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), " + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + modb_eq, " + ", + bandsums_eq)) + } + + # run glm + # Which negative binomial function depends on if fc_control$theta exists + #<<>> temp set theta to null until switch to real model family + theta <- NULL + + if(!is.null(theta)){ + message("Theta value provided. Running with glm(..., family = MASS::negative.binomial(theta = ", theta, "))...") + regress <- stats::glm(reg_eq, + data = epi_known, + #theta value REQUIRED + family = MASS::negative.binomial(theta=2.31)) + #family = MASS::negative.binomial(theta = theta)) + } else { + message("Theta estimate (fc_control$theta) not provided, running with MASS::glm.nb()...") + regress <- MASS::glm.nb(reg_eq, + data = epi_known) + } + + + } else if (fc_model_family == "naive-persistence"){ + + #naive model + #persistence (carry forward) + #no regression object + + #create "model" using known data. + #Will fill down in create_predictions + regress <- epi_known %>% + #grouping by geographical unit + dplyr::group_by(!!quo_groupfield) %>% + #prediction is 1 lag (previous week) + #fit is name of value from regression models + dplyr::mutate(fit = dplyr::lag(cases_epidemiar, n = 1)) %>% + #cleaning up as not needed, and for bug hunting + dplyr::select(-dplyr::starts_with("band")) %>% + dplyr::select(-dplyr::starts_with("modbs")) + + + + } else if (model_choice == "naive-averageweek"){ + + #naive model + #average of week of year (from historical data) + #not a regression object + + #create "model" (averages) using known data. + regress <- epi_known %>% + #calculate averages per geographic group per week of year + dplyr::group_by(!!quo_groupfield, week_epidemiar) %>% + dplyr::summarize(fit = mean(cases_epidemiar, na.rm = TRUE)) + + + } else { + #Shouldn't happen, just in case. + stop("Error in selecting model choice.") + } +} # end build_model() + + + +#'Create the appropriate predictions/forecasts. +#' +#'@param model_choice Critical argument to choose the type of model to generate. +#' The options are versions that the EPIDEMIA team has used for forecasting. +#' The first supported options is "poisson-gam" ("p") which is the original +#' epidemiar model: a Poisson regression using bam (for large data GAMs), with +#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is +#' TRUE for using the anomalies of environmental variables rather than their +#' raw values. The second option is "negbin" ("n") which is a negative binomial +#' regression using glm, with no external seasonality terms - letting the +#' natural cyclical behavior of the environmental variables fill that role. The +#' default for fc_control$anom_env is FALSE and uses the actual observation +#' values in the modeling. The fc_control$anom_env can be overruled by the user +#' providing a value, but this is not recommended unless you are doing +#' comparisons. +#'@param regress The regression object, either the user-supplied one, or +#' the one just generated. +#'@param epi_lag Epidemiological dataset with basis spline summaries of the +#' lagged environmental data (or anomalies), with groupings as a factor. +#'@param req_date The end date of requested forecast regression. When fit_freq +#' == "once", this is the last date of the full report, the end date of the +#' forecast period. +#'@param ncores The number of physical cores to use in parallel processing, set +#' in fc_control$ncores, else the max of the number of physical core available +#' minus 1, or 1 core. +#' +#'@return A dataset from predict() using the regression object generated in +#' build_model or a newly created one. The dataset includes the +#' predicted/forecast values through the end of the report requested. +#' +#' +create_predictions <- function(fc_model_family, + nthreads, + regress, + epi_lag, + req_date){ + + #POISSON-BAM (set as default in first round input checking) + if (fc_model_family == "poisson-bam"){ + + message("Creating Poisson predictions...") + + + ## Create predictions from either newly generated model, or given one + + #output prediction (through req_date) + preds <- mgcv::predict.bam(regress, + newdata = epi_lag %>% dplyr::filter(obs_date <= req_date), + se.fit = TRUE, # included for backwards compatibility + type="response", + discrete = TRUE, + n.threads = nthreads) + + + + } else if (fc_model_family == "negbin"){ + #NEGATIVE BINOMIAL using GLM + + message("Creating negative binomial predictions...") + + + ## Create predictions from either newly generated model, or given one + + #output prediction (through req_date) + preds <- stats::predict.glm(regress, + newdata = epi_lag %>% dplyr::filter(obs_date <= req_date), + se.fit = TRUE, # included for backwards compatibility + type="response") + + + } else if (fc_model_family == "naive-persistence"){ + + message("Creating predictions using persistence naive model...") + + #persistence model just carries forward the last known value + #the important part is the forecast / trailing end part + #manipulating to be in quasi-same format as the other models return + + #cleaning up as not needed, and for bug hunting + epi_lag <- epi_lag %>% + dplyr::select(-dplyr::starts_with("band")) %>% + dplyr::select(-dplyr::starts_with("modbs")) + + #regress is a tibble not regression object here + # has a variable fit with lag of 1 on known data + #epi_lag has the newer rows + preds <- epi_lag %>% + #filter to requested date + dplyr::filter(obs_date <= req_date) %>% + #join to get "fit" values from "model" + #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming + dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% + #important at end/fc section, when we fill down + tidyr::fill(fit, .direction = "down") %>% + #format into nominal regression predict output + dplyr::select(fit) %>% + as.data.frame() + + } else if (fc_model_family == "naive-averageweek"){ + + message("Creating predictions using average week of year naive model...") + + #average week null model calculates the average cases of that + # week of year from historical data + #manipulating to be in quasi-same format as the other models return + + #regress is the averages per week of year from known data + + epi_lag <- epi_lag %>% + #filter to requested date + dplyr::filter(obs_date <= req_date) + + #join back + preds <- epi_lag %>% + #join to get average values + #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming + # and so don't need column names not passed into this function + dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% + #format into nominal regression output + dplyr::select(fit) %>% + as.data.frame() + + + } else { + #Shouldn't happen, just in case. + stop("Error in selecting model choice.") + } + +} #end create_predictions() diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index 2a64d0f..726e751 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -29,9 +29,14 @@ #' during the report period for each geographic unit. Returned as #' environ_timeseries in the run_epidemia() output. #' -environ_report_format <- function(env_ext_data, env_ref_data, quo_groupfield, - quo_obsfield, env_used, env_info, - week_type, report_dates){ +environ_report_format <- function(env_ext_data, + env_ref_data, + quo_groupfield, + quo_obsfield, + env_used, + env_info, + epi_date_type, + report_dates){ #daily env data env_data_varused <- env_ext_data %>% dplyr::filter(!!quo_obsfield %in% env_used) @@ -48,6 +53,11 @@ environ_report_format <- function(env_ext_data, env_ref_data, quo_groupfield, by = rlang::set_names(rlang::quo_name(quo_obsfield), rlang::quo_name(quo_obsfield))) %>% #add week, year fields + week_type <- dplyr::case_when( + epi_date_type == "weekISO" ~ "ISO", + epi_date_type == "weekCDC" ~ "CDC", + #default as if mean + TRUE ~ NA_character_) epidemiar::add_datefields(week_type) %>% #trim dates to reduce processing (dates are rough, technically just need week prior to start. 8 is not magical) dplyr::filter(obs_date >= report_dates$full$min - 8 & obs_date <= report_dates$full$max + 8) %>% @@ -107,7 +117,9 @@ environ_report_format <- function(env_ext_data, env_ref_data, quo_groupfield, #'@return Data set of early detection and early warning alert summaries for each #' geographic group. Returned as summary_data in the run_epidemia() output. #' -create_summary_data <- function(ed_res, quo_groupfield, report_dates){ +create_summary_data <- function(ed_res, + quo_groupfield, + report_dates){ #levels alert_level <- c("Low", "Medium", "High") @@ -173,9 +185,12 @@ create_summary_data <- function(ed_res, quo_groupfield, report_dates){ #'@return Mean disease incidence per geographic group during the early detection #' period, returned as epi_summary in the run_epidemia() ouput. #' -create_epi_summary <- function(obs_res, quo_groupfield, report_dates){ +create_epi_summary <- function(obs_res, + quo_groupfield, + report_dates){ #using obs_res - if cases/incidence becomes a user set choice, this might make it easier (value is already what it needs to be) #but note that (as of writing this) that obs_res using the original, UNinterpolated values (so that end users are disturbed to see case data where there should not be) + #<<>> epi <- obs_res %>% #epi data is weekly, get the data for the early detection summary period @@ -206,7 +221,10 @@ create_epi_summary <- function(obs_res, quo_groupfield, report_dates){ #' environmental anomalies calculated as residuals from GAM in anomalize_env() #' as part of forecasting. #' -calc_env_anomalies <- function(env_ts, quo_groupfield, quo_obsfield, report_dates){ +calc_env_anomalies <- function(env_ts, + quo_groupfield, + quo_obsfield, + report_dates){ # anomalies anom_env <- env_ts %>% # only mapping those in the early detection period diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 34eb862..a6d8ced 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -138,26 +138,34 @@ ## Main Modeling (Early Detection, Forecasting) Function run_epidemia <- function(epi_data = NULL, + env_data = NULL, + env_ref_data = NULL, + env_info = NULL, casefield = NULL, - populationfield = NULL, - inc_per = 1000, groupfield = NULL, - week_type = c("ISO", "CDC"), - report_period = 26, - ed_summary_period = 4, - ed_method = c("none", "farrington"), - ed_control = NULL, - env_data = NULL, + populationfield = NULL, obsfield = NULL, valuefield = NULL, - forecast_future = 4, - fc_control = NULL, - env_ref_data = NULL, - env_info = NULL, - model_run = FALSE, - model_obj = NULL, - model_cached = NULL, - model_choice = c("poisson-bam", "negbin")){ + fc_clusters = NULL, + fc_model_family = NULL, + report_settings = NULL) + + # inc_per = 1000, + # week_type = c("ISO", "CDC"), + # report_period = 26, + # ed_summary_period = 4, + # ed_method = c("none", "farrington"), + # ed_control = NULL, + # forecast_future = 4, + # fc_control = NULL, + # model_run = FALSE, + # model_obj = NULL, #clean up & remove + # model_cached = NULL, + # model_choice = c("poisson-bam", "negbin")) # to replace with model_family? +{ + + #Note for model family + # need to figure out how to handle naive models # For validation runs, special escapes ------------------------------------ @@ -193,17 +201,23 @@ run_epidemia <- function(epi_data = NULL, # Preparing: Input checking ----------------------------------------------- - # 1. Test for critical inputs - # This will not check if they've assigned the right thing to the argument, or got the argument order correct if not explicit argument declarations - # But, no other checks can really proceed if things are missing - # NSE is a little tricky: can't test directly on fields-to-be-enquo'd because it'll try to evaluate them, and complain that the object (actually field name) doesn't exist - #naming the quosures AS the input fields to create more meaningful error messages if the items are missing - nec_nse <- list(casefield = quo_casefield, groupfield = quo_groupfield, obsfield = quo_obsfield, + #1. Test for critical inputs This will not check if they've assigned the right + #thing to the argument, or got the argument order correct if not explicit + #argument declarations. But, no other checks can really proceed if things are + #missing. + + #NSE is a little tricky: can't test directly on fields-to-be-enquo'd because + #it'll try to evaluate them, and complain that the object (actually field + #name) doesn't exist. Renaming the quosures AS the input fields to create more + #meaningful error messages if the items are missing. + + #note: population can be missing (case based reports, not incidence) + nec_nse <- list(casefield = quo_casefield, + groupfield = quo_groupfield, + obsfield = quo_obsfield, valuefield = quo_valuefield) - necessary <- create_named_list(epi_data, env_data, env_ref_data, env_info, fc_control) - #ed_control can be NULL if ed_method == None. - # rest has defaults - # Note: only checking if control list exists, nothing about what is in the list (later checks) + necessary <- create_named_list(epi_data, env_data, env_ref_data, env_info, fc_clusters) + #initialize missing info msgs & flag missing_msgs <- "" missing_flag <- FALSE @@ -222,118 +236,281 @@ run_epidemia <- function(epi_data = NULL, } #note: fix this later: Error in create_named_list() : object 'fc_control' not found } + #if missing, stop and give error message if (missing_flag){ stop("Missing critical argument(s). Please make sure the following is/are included:\n", missing_msgs) } - # 2. match.arg for arguments with options - #Note: using message() instead of warning() to get message to appear right away - #model_choice = c("poisson-bam", "negbin") - #tolower to capture upper and lower case user-input variations since match.arg is case sensitive - #but must only try function if ed_method is not null (i.e. was given) - if (!is.null(model_choice)){ - model_choice <- tolower(model_choice) + # # 2. match.arg for arguments with options + # #Note: using message() instead of warning() to get message to appear right away + # + # #model_choice = c("poisson-bam", "negbin") + # #tolower to capture upper and lower case user-input variations since match.arg is case sensitive + # #but must only try function if ed_method is not null (i.e. was given) + # if (!is.null(model_choice)){ + # model_choice <- tolower(model_choice) + # } + # model_choice <- tryCatch({ + # #including hidden naïve models for skill test in validation + # match.arg(model_choice, c("poisson-bam", "negbin", "naive-persistence", "naive-averageweek")) + # }, error = function(e){ + # message("Warning: Given 'model_choice' does not match 'poisson-bam' or 'negbin', running as 'poisson-bam'.") + # "poisson-bam" + # }, finally = { + # if (length(model_choice) > 1){ + # #if model_choice was missing at run_epidemia() call, got assigned c("poisson-bam", "negbin") + # message("Note: 'model_choice' was missing, running as 'poisson-bam'.") + # #no return, because in match.arg() it will take the first item, which is "poisson-bam". + # } + # }) + # + # #ed_method = c("none", "farrington") + # #tolower to capture upper and lower case user-input variations since match.arg is case sensitive + # #but must only try function if ed_method is not null (i.e. was given) + # if (!is.null(ed_method)){ + # ed_method <- tolower(ed_method) + # } + # ed_method <- tryCatch({ + # match.arg(ed_method, c("none", "farrington")) + # }, error = function(e){ + # message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") + # "none" + # }, finally = { + # if (length(ed_method) > 1){ + # #if ed_method was missing at run_epidemia() call, got assigned c("none", "farrington") + # message("Note: 'ed_method' was missing, running as 'none'.") + # #no return, because in match.arg() it will take the first item, which is "none". + # } + # }) + # + # #week_type = c("ISO", "CDC") + # week_type <- tryCatch({ + # match.arg(week_type, c("ISO", "CDC")) + # }, error = function(e){ + # message("Warning: Given 'week_type' does not match 'ISO' or 'CDC', running as 'ISO'.") + # "ISO" + # }, finally = { + # if (length(week_type) > 1){ + # #if week_type was missing at run_epidemia() call, got assigned c("ISO", "CDC") + # message("Note: 'week_type' was missing, running as 'ISO'.") + # #no return, because in match.arg() it will take the first item, which is "ISO". + # } + # }) + + + ##### <<>> fix later + # # 3. More input checking + # check_results <- input_check(epi_data, + # quo_casefield, + # quo_popfield, + # inc_per, + # quo_groupfield, + # week_type, + # report_period, + # ed_summary_period, + # ed_method, + # ed_control, + # env_data, + # quo_obsfield, + # quo_valuefield, + # forecast_future, + # fc_control, + # env_ref_data, + # env_info, + # model_obj, + # model_cached, + # model_choice) + # #if warnings, just give message and continue + # if (check_results$warn_flag){ + # message(check_results$warn_msgs) + # } + # #if then if errors, stop and return error messages + # if (check_results$err_flag){ + # #prevent possible truncation of all error messages + # options(warning.length = 4000L) + # stop(check_results$err_msgs) + # } + + + + # Preparing: generating listings, defaults and date sets ---------------------------- + + #create alphabetical list of unique groups + #must remain in alpha order for early detection using surveillance package to capture results properly + groupings <- dplyr::pull(epi_data, !!quo_groupfield) %>% unique() %>% sort() + #create alphabetical list of all unique environmental variables + env_variables <- dplyr::pull(env_data, !!quo_obsfield) %>% unique() %>% sort() + + + # <<>> eventually separate out into own function, here for building + #processing or defaults + + if (is.null(report_settings[["report_period"]])){ + report_settings[["report_period"]] <- 26 } - model_choice <- tryCatch({ - #including hidden naïve models for skill test in validation - match.arg(model_choice, c("poisson-bam", "negbin", "naive-persistence", "naive-averageweek")) + + if (is.null(report_settings[["report_inc_per"]])){ + report_settings[["report_inc_per"]] <- 1000 + #okay if not used, if report_value_type is cases instead of incidence + } + + if (is.null(report_settings[["epi_interpolate"]])){ + report_settings[["epi_interpolate"]] <- FALSE + } + + if (is.null(report_settings[["ed_summary_period"]])){ + report_settings[["ed_summary_period"]] <- 4 + } + + if (is.null(report_settings[["model_run"]])){ + report_settings[["model_run"]] <- FALSE + } + + if (is.null(report_settings[["model_cached"]])){ + report_settings[["model_cached"]] <- NULL + } + + if (is.null(report_settings[["env_lag_length"]])){ + #maybe make default based on data length, but for now + report_settings[["env_lag_length"]] <- 180 + } + + if (is.null(report_settings[["fc_cyclicals"]])){ + report_settings[["fc_cyclicals"]] <- FALSE + } + + if (is.null(report_settings[["fc_future_period"]])){ + report_settings[["fc_future_period"]] <- 8 + } + + #<<>> temporary settings until switch fc_model_family to real input (relabeled model_choice atm) + if (is.null(report_settings[["anom_env"]])){ + report_settings[["anom_env"]] <- dplyr::case_when( + fc_model_family == "poisson-gam" ~ TRUE, + fc_model_family == "negbin" ~ FALSE, + fc_model_family == "naive-persistence" ~ FALSE, + fc_model_family == "naive-weekaverage" ~ FALSE, + #default to FALSE + TRUE ~ FALSE) + } + + + # For things that are being string matched: + # tolower to capture upper and lower case user-input variations since match.arg is case sensitive + # but must only try function if ed_method is not null (i.e. was given) + + #report_value_type + # if provided, prepare for matching + if (!is.null(report_settings[["report_value_type"]])){ + report_settings[["report_value_type"]] <- tolower(report_settings[["report_value_type"]]) + } else { + #if not provided/missing/null + message("Note: 'report_value_type' was not provided, returning results in case counts ('cases').") + report_settings[["report_value_type"]] <- "cases" + } + #try match + report_settings[["report_value_type"]] <- tryCatch({ + match.arg(report_settings[["report_value_type"]], c("cases", "incidence")) }, error = function(e){ - message("Warning: Given 'model_choice' does not match 'poisson-bam' or 'negbin', running as 'poisson-bam'.") - "poisson-bam" + message("Warning: Given 'report_value_type' does not match 'cases' or 'incidence', running as 'cases'.") + "cases" }, finally = { - if (length(model_choice) > 1){ - #if model_choice was missing at run_epidemia() call, got assigned c("poisson-bam", "negbin") - message("Note: 'model_choice' was missing, running as 'poisson-bam'.") - #no return, because in match.arg() it will take the first item, which is "poisson-bam". - } + #failsafe default + "cases" }) - #ed_method = c("none", "farrington") - #tolower to capture upper and lower case user-input variations since match.arg is case sensitive - #but must only try function if ed_method is not null (i.e. was given) - if (!is.null(ed_method)){ - ed_method <- tolower(ed_method) + # epi_date_type + # if provided, prepare for matching + if (!is.null(report_settings[["epi_date_type"]])){ + report_settings[["epi_date_type"]] <- tolower(report_settings[["epi_date_type"]]) + } else { + #if not provided/missing/null + message("Note: 'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').") + report_settings[["epi_date_type"]] <- "weekISO" } - ed_method <- tryCatch({ - match.arg(ed_method, c("none", "farrington")) + #try match + report_settings[["epi_date_type"]] <- tryCatch({ + match.arg(report_settings[["epi_date_type"]], c("weekISO", "weekCDC")) #"monthly" reserved for future }, error = function(e){ - message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") - "none" + message("Warning: Given 'epi_date_type' does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).") + "weekISO" }, finally = { - if (length(ed_method) > 1){ - #if ed_method was missing at run_epidemia() call, got assigned c("none", "farrington") - message("Note: 'ed_method' was missing, running as 'none'.") - #no return, because in match.arg() it will take the first item, which is "none". - } + #failsafe default + "weekISO" }) + #<<>> set internal week type? - #week_type = c("ISO", "CDC") - week_type <- tryCatch({ - match.arg(week_type, c("ISO", "CDC")) + + # ed_method + # if provided, prepare for matching + if (!is.null(report_settings[["ed_method"]])){ + report_settings[["ed_method"]] <- tolower(report_settings[["ed_method"]]) + } else { + #if not provided/missing/null + message("Note: 'ed_method' was not provided, running as 'none'.") + report_settings[["ed_method"]] <- "none" + } + #try match + report_settings[["ed_method"]] <- tryCatch({ + match.arg(report_settings[["ed_method"]], c("none", "farrington")) }, error = function(e){ - message("Warning: Given 'week_type' does not match 'ISO' or 'CDC', running as 'ISO'.") - "ISO" + message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") + "none" }, finally = { - if (length(week_type) > 1){ - #if week_type was missing at run_epidemia() call, got assigned c("ISO", "CDC") - message("Note: 'week_type' was missing, running as 'ISO'.") - #no return, because in match.arg() it will take the first item, which is "ISO". - } + #failsafe default to no event detection + "none" }) - # 3. More input checking - check_results <- input_check(epi_data, - quo_casefield, - quo_popfield, - inc_per, - quo_groupfield, - week_type, - report_period, - ed_summary_period, - ed_method, - ed_control, - env_data, - quo_obsfield, - quo_valuefield, - forecast_future, - fc_control, - env_ref_data, - env_info, - model_obj, - model_cached, - model_choice) - #if warnings, just give message and continue - if (check_results$warn_flag){ - message(check_results$warn_msgs) - } - #if then if errors, stop and return error messages - if (check_results$err_flag){ - #prevent possible truncation of all error messages - options(warning.length = 4000L) - stop(check_results$err_msgs) + + # For more complicated defaults + + #env_var -- what is listed in env_info & also in env_data + if (is.null(report_settings[["env_var"]])){ + #create list of all environmental variables in env_info + env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) + #env_variables already gen list of env_data + report_settings[["env_var"]] <- intersect(env_variables, env_info_variables) } + #nthreads -- grab calc from forecast + #set up default parallel processing number of cores to use number + #if user-supplied, use that cap at 2, otherwise create a default number + #used in anomalize_env() and forecast_regression() + if (!is.null(report_settings[["fc_nthreads"]])) { + # nthreads above 2 is not actually helpful + report_settings[["fc_nthreads"]] <- ifelse(report_settings[["fc_nthreads"]] > 1, 2, 1) + } else { + #no ncores value fed in, so test and determine + #ncores <- max(parallel::detectCores(logical=FALSE) - 1, 1) + #cap at 2 for nthread + report_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) + } #end else for ncores not given - # Preparing: generating listings and date sets ---------------------------- + # Developer options + if (is.null(report_settings[["fc_fit_freq"]])){ + report_settings[["fc_fit_freq"]] <- "once" + } + if (is.null(report_settings[["fc_modbsplines"]])){ + report_settings[["fc_modbsplines"]] <- FALSE + } + if (is.null(report_settings[["fc_formula"]])){ + report_settings[["fc_formula"]]NULL + } + - #create alphabetical list of unique groups - #must remain in alpha order for early detection using surveillance package to capture results properly - groupings <- dplyr::pull(epi_data, !!quo_groupfield) %>% unique() %>% sort() - #create alphabetical list of all unique environmental variables - env_variables <- dplyr::pull(env_data, !!quo_obsfield) %>% unique() %>% sort() ## Create report date information - for passing to interval functions, and report output - #REM: report_period is full # of weeks of report. forecast_future is how many - #of those weeks should be in the future. + #REM: 'report_period' is full # of weeks of report. + #'fc_future_period' is how many of those weeks should be in the future. #full report report_dates <- list(full = list(min = max(epi_data$obs_date, na.rm = TRUE) - - lubridate::as.difftime((report_period - forecast_future - 1), + lubridate::as.difftime((report_settings[["report_period"]] - report_settings[["fc_future_period"]] - 1), unit = "weeks"), max = max(epi_data$obs_date, na.rm = TRUE) + - lubridate::as.difftime(forecast_future, + lubridate::as.difftime(report_settings[["fc_future_period"]], units = "weeks"))) report_dates$full$seq <- report_dates$full %>% {seq.Date(.$min, .$max, "week")} #dates with known epidemological data @@ -356,14 +533,27 @@ run_epidemia <- function(epi_data = NULL, # Preparing: data checks for NA and interpolation ------------------------- - #check for NAs and interpolate as necessary - #Note: cases_epidemiar is field name returned (epi) - epi_data <- epi_NA_interpolate(epi_data, quo_casefield, quo_groupfield) %>% - #and sort by alphabetical groupfield - dplyr::arrange(!!quo_groupfield, obs_date) + #check for NAs and interpolate as necessary and user set + if (report_settings[["epi_interpolate"]] == TRUE){ + #Note: cases_epidemiar is field name returned (epi) + epi_data <- epi_NA_interpolate(epi_data, quo_casefield, quo_groupfield) %>% + #force into integer after interpolating (would cause problems with modeling otherwise) + dplyr::mutate(cases_epidemiar = floor(cases_epidemiar)) %>% + #and sort by alphabetical groupfield + dplyr::arrange(!!quo_groupfield, obs_date) + } else { + epi_data <- epi_data %>% + #copy over value + dplyr::mutate(cases_epidemiar = !!quo_valuefield) %>% + #force into integer, just in case + dplyr::mutate(cases_epidemiar = floor(cases_epidemiar)) %>% + #and sort by alphabetical groupfield + dplyr::arrange(!!quo_groupfield, obs_date) + } + #Note: val_epidemiar is field name returned (env) - #interpolation is no longer necessary with new extend_env_future() - #env_data <- env_NA_interpolate(env_data, quo_obsfield, quo_valuefield, quo_groupfield) %>% + #interpolation is no longer necessary with new extend_env_future() + #env_data <- env_NA_interpolate(env_data, quo_obsfield, quo_valuefield, quo_groupfield) %>% env_data <- env_data %>% #first, mark which ones during known time range were observed versus (will be) interpolated dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% @@ -376,17 +566,6 @@ run_epidemia <- function(epi_data = NULL, # Set up output report data format ---------------------------------------- - #User selection if return type should be in case counts or incidence (default) - #using tolower() to handle case sensitivity of match.arg - #but must only call tolower() on it if value_type was given (i.e. not null) - #if null, it will default to the first value "incidence" - if (!is.null(fc_control[["value_type"]])){ - fc_control$value_type <- tolower(fc_control[["value_type"]]) - } - fc_control$value_type <- match.arg(fc_control[["value_type"]], - c("incidence", "cases")) - #in future, override here if necessary based on model choice - #create observed data series obs_res <- epi_data %>% #include only observed data from requested start of report @@ -394,9 +573,9 @@ run_epidemia <- function(epi_data = NULL, dplyr::mutate(series = "obs", value = dplyr::case_when( #if reporting in case counts - fc_control$value_type == "cases" ~ !!quo_casefield, + report_settings[["report_value_type"]] == "cases" ~ !!quo_casefield, #if incidence - fc_control$value_type == "incidence" ~ !!quo_casefield / !!quo_popfield * inc_per, + report_settings[["report_value_type"]] == "incidence" ~ !!quo_casefield / !!quo_popfield * inc_per, #otherwise TRUE ~ NA_real_), #note use of original not interpolated cases @@ -412,22 +591,29 @@ run_epidemia <- function(epi_data = NULL, fc_res_all <- run_forecast(epi_data, quo_popfield, - inc_per, quo_groupfield, - groupings, env_data, quo_obsfield, quo_valuefield, - env_variables, - fc_control, env_ref_data, env_info, - report_dates, - week_type, - model_run, - model_cached, - model_choice, - valid_run) + report_settings, + #internal/calculated + valid_run, + groupings, + env_variables, + report_dates + + #inc_per, + #fc_control, + #week_type, + #model_run, + #model_cached, + #model_choice + + ) + + #<<>> resume editing here after finished with forecasting update #if we are only generating the model, then end here if (model_run){ @@ -439,6 +625,7 @@ run_epidemia <- function(epi_data = NULL, obsfield = quo_name(quo_obsfield), valuefield = quo_name(quo_valuefield)) + #<<>> needs to be updated model_meta <- create_named_list(fieldnames, week_type, groupings, @@ -446,9 +633,7 @@ run_epidemia <- function(epi_data = NULL, env_dt_ranges = fc_res_all$env_dt_ranges, known_epi_range = report_dates$known, env_info, - value_type = fc_control$value_type, - model_choice, - theta = fc_control$theta, + report_value_type = report_settings[["report_value_type"]], date_created = Sys.Date()) #if a model run, forecast result contains regression object @@ -479,15 +664,14 @@ run_epidemia <- function(epi_data = NULL, #run event detection on combined dataset ed_res <- run_event_detection(epi_fc_data = obs_fc_epi, - quo_popfield, - inc_per, quo_groupfield, + quo_popfield, + ed_method = report_settings[["ed_method"]], + ed_control = report_settings[["ed_control"]], + val_type = report_settings[["report_value_type"]], + inc_per = report_settings[["report_inc_per"]], groupings, - ed_method, - ed_control, - report_dates, - vt = fc_control$value_type, - mc = model_choice) + report_dates) # Combining forecast and event detection results -------------------------- @@ -511,7 +695,7 @@ run_epidemia <- function(epi_data = NULL, quo_obsfield, env_used = fc_res_all$env_variables_used, env_info, - week_type, + epi_date_type = report_settings[["epi_date_type"]], report_dates) ##Environmental Anomaly Data (during ED period) @@ -539,16 +723,15 @@ run_epidemia <- function(epi_data = NULL, valuefield = quo_name(quo_valuefield)) params_meta <- create_named_list(fieldnames, - week_type, ed_method, groupings, + fc_model_family, env_variables_used = fc_res_all$env_variables_used, env_dt_ranges = fc_res_all$env_dt_ranges, report_dates, env_info, - value_type = fc_control$value_type, - model_choice, - theta = fc_control$theta, + epi_date_type = report_settings[["epi_date_type"]], + report_value_type = report_settings[["report_value_type"]], date_created = Sys.Date()) #regression object for future other use or troubleshooting regression_object <- fc_res_all$reg_obj From 83b674b6e4da1640b433a7658a5e0fe9a1d48fd3 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 14 Feb 2020 15:58:48 -0600 Subject: [PATCH 002/132] Input redesign commit after successful test from backstage. Validation and model caching features are non-functional, will be updated after model families feature change. --- DESCRIPTION | 2 +- NAMESPACE | 6 - R/event_detection.R | 28 +- R/forecasting_helpers.R | 42 +- R/forecasting_main.R | 182 ++--- R/formatters_calculators.R | 59 +- R/model_validation.R | 1292 +++++++++++++++---------------- R/run_epidemia.R | 130 ++-- man/anomalize_env.Rd | 10 +- man/build_model.Rd | 42 +- man/calc_skill.Rd | 19 - man/calc_skill_stat.Rd | 23 - man/calc_val_stats.Rd | 35 - man/create_predictions.Rd | 24 +- man/env_format_fc.Rd | 2 +- man/environ_report_format.Rd | 6 +- man/epi_format_fc.Rd | 7 +- man/extend_env_future.Rd | 38 +- man/extend_epi_future.Rd | 2 +- man/forecast_regression.Rd | 62 +- man/get_group_validations.Rd | 18 - man/get_overall_validations.Rd | 19 - man/lag_environ_to_epi.Rd | 16 +- man/make_stss.Rd | 6 +- man/pull_model_envvars.Rd | 7 +- man/run_epidemia.Rd | 89 +-- man/run_event_detection.Rd | 25 +- man/run_farrington.Rd | 25 +- man/run_forecast.Rd | 58 +- man/run_validation.Rd | 111 --- man/save_geog_validations.Rd | 22 - man/save_overall_validations.Rd | 22 - man/stss_res_to_output_data.Rd | 19 +- man/truncpoly.Rd | 2 +- 34 files changed, 927 insertions(+), 1523 deletions(-) delete mode 100644 man/calc_skill.Rd delete mode 100644 man/calc_skill_stat.Rd delete mode 100644 man/calc_val_stats.Rd delete mode 100644 man/get_group_validations.Rd delete mode 100644 man/get_overall_validations.Rd delete mode 100644 man/run_validation.Rd delete mode 100644 man/save_geog_validations.Rd delete mode 100644 man/save_overall_validations.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 275ef93..907cec7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: epidemiar Type: Package Title: epidemiar: Create EPIDEMIA Environmentally-Mediated Disease Forecasts -Version: 2.1.0 +Version: 3.0.0001 Authors@R: c( person(given = c("Dawn", "M"), family = "Nekorchuk", email = "dawn.nekorchuk@ou.edu", role = c("aut", "cre")), diff --git a/NAMESPACE b/NAMESPACE index 369e7ca..13a5bea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,18 +2,12 @@ export(Mode) export(add_datefields) -export(calc_skill_stat) export(create_named_list) export(data_to_daily) export(env_daily_to_ref) export(epiwday) -export(get_group_validations) -export(get_overall_validations) export(make_date_yw) export(na_approx) export(run_epidemia) -export(run_validation) -export(save_geog_validations) -export(save_overall_validations) importFrom(magrittr,"%>%") importFrom(rlang,"!!") diff --git a/R/event_detection.R b/R/event_detection.R index bbbb789..17f87e5 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -5,24 +5,21 @@ #' #'@param epi_fc_data Internal pass of epidemiological data complete with future #' forecast values. -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param quo_popfield Quosure of user-given field containing population values. #'@param ed_method Which method for early detection should be used ("Farrington" #' is only current option, or "None"). #'@param ed_control All parameters for early detection algorithm, passed through #' to that subroutine. +#'@param val_type From match.arg evaluation of fc_control$value_type, whether to return +#' epidemiological report values in "incidence" (default) or "cases". +#'@param inc_per Number for what unit of population the incidence should be +#' reported in, e.g. incidence rate of 3 per 1000 people. +#'@param groupings A unique list of the geographic groupings (from groupfield). #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#'@param vt From match.arg evaluation of fc_control$value_type, whether to return -#' epidemiological report values in "incidence" (default) or "cases". -#'@param mc From match.arg evaluation of model_choice. Reserved for future overrides on value_type depending on -#' model choice selection. - #' #'@return Returns a list of three generated series: #' "ed" : early detection alerts (ed period of most recent epi data) @@ -85,10 +82,8 @@ run_event_detection <- function(epi_fc_data, #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#'@param vt From match.arg evaluation of fc_control$value_type, whether to return +#'@param val_type From match.arg evaluation of fc_control$value_type, whether to return #' epidemiological report values in "incidence" (default) or "cases". -#'@param mc From match.arg evaluation of model_choice. Reserved for future overrides on value_type depending on -#' model choice selection. #' #'@return Returns a list of three generated series from the Farrington algorithm: @@ -317,11 +312,8 @@ make_stss <- function(epi_fc_data, #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#'@param vt From match.arg evaluation of fc_control$value_type, whether to return +#'@param val_type From match.arg evaluation of fc_control$value_type, whether to return #' epidemiological report values in "incidence" (default) or "cases". -#'@param mc From match.arg evaluation of model_choice. Reserved for future overrides on value_type depending on -#' model choice selection. - #' #'@return Returns a list of three series from the Farrington sts result output: #' "ed" : early detection alerts (ed period of most recent epi data) @@ -419,7 +411,9 @@ stss_res_to_output_data <- function(stss_res_list, #' "ew" : early warning alerts (forecast/future portion) #' "thresh" : threshold values per week #' -run_no_detection <- function(epi_fc_data, quo_groupfield, report_dates){ +run_no_detection <- function(epi_fc_data, + quo_groupfield, + report_dates){ #early detection (KNOWN - pre-forecast) event detection alert series diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index e863061..f969c05 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -10,8 +10,7 @@ #' forecasting. #'@param quo_obsfield Quosure of user given field name of the environmental data #' variables -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. +#'@param env_var <<>> which environmental variable to include #' #'@return List of environmental variables that were used in the #' modeling (had to be both listed in model variables input file and present the @@ -37,7 +36,6 @@ pull_model_envvars <- function(env_data, quo_obsfield, env_var){ #' forecasting. #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). #'@param quo_obsfield Quosure of user given field name of the environmental data #' variables #'@param quo_valuefield Quosure of user given field name of the value of the @@ -48,28 +46,15 @@ pull_model_envvars <- function(env_data, quo_obsfield, env_var){ #' display on timeseries in reports. #'@param env_info Lookup table for environmental data - reference creation #' method (e.g. sum or mean), report labels, etc. +#'@param fc_model_family model choice stand in <<>> +#'@param epi_date_type weekISO/CDC/month <<>> +#'@param valid_run Internal boolean for whether this is part of a validation run. +#'@param groupings A unique list of the geographic groupings (from groupfield). #'@param env_variables_used List of environmental variables that were used in #' the modeling #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi -#' weeks) that the weeks of the year in epidemiological and environmental -#' reference data use ["ISO" or "CDC"]. -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-gam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param valid_run Internal boolean for whether this is part of a validation run. #' #'@return Environmental dataset, with data extended into the future forecast #' period. Unknown environmental data with runs of < 2 weeks is @@ -105,6 +90,12 @@ extend_env_future <- function(env_data, # 2: 19/20 recent + 1/20 historical, 3: 18/20 recent + 2/20 historical, ... 20: 1/20 recent + 19/20 historical. # Will ALWAYS include part of recent known data (relevant if recent patterns are departure from climate averages) + # switch epi_date_type to week_type needed for add_datefields() + week_type <- dplyr::case_when( + epi_date_type == "weekISO" ~ "ISO", + epi_date_type == "weekCDC" ~ "CDC", + #default as if mean + TRUE ~ NA_character_) #Do not need data past end of forecast period (if exists) env_trim <- env_data %>% @@ -377,8 +368,7 @@ env_format_fc <- function(env_data_extd, #' future/forecast period with NA values for to-be-forecasted case numbers. #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. +#'@param fc_clusters <<>>geographic clusters. #' #'@return An epidemiological dataset formatted to pass over to BAM/GAM modeling. #' @@ -413,9 +403,7 @@ epi_format_fc <- function(epi_data_extd, #' run_epidemia(). #'@param env_variables_used List of environmental variables that were used in #' the modeling. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. +#'@param nthreads mx threasds <<>> #' #'@return Environmental dataset in same format as env_fc but with the residuals #' from a GAM with geographic unit and cyclical cubic regression spline on day @@ -451,7 +439,7 @@ anomalize_env <- function(env_fc, tempbam <- mgcv::bam(env_fc[,curcol] ~ group_factor + s(doy, bs="cc", by=group_factor), data=env_fc, discrete = TRUE, - nthreads = ncores) + nthreads = nthreads) } else { #if only 1 geographic area, then run without group_factor tempbam <- mgcv::bam(env_fc[,curcol] ~ s(doy, bs="cc"), @@ -482,7 +470,7 @@ anomalize_env <- function(env_fc, #'@param env_fc Environmental data formatted for forecasting by env_format_fc(). #'@param env_variables_used List of environmental variables that were used in #' the modeling. -#'@param laglen The maximum number of days in the past to consider interactions +#'@param lag_len The maximum number of days in the past to consider interactions #' between the environmental variable anomalies and the disease case counts. #' #'@return Wide dataset based on epidemiological data dates with five diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 58f072b..2485a36 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -4,58 +4,37 @@ #' #'@param epi_data Epidemiological data with case numbers per week, with date #' field "obs_date". -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). #'@param env_data Daily environmental data for the same groupfields and date #' range as the epidemiological data. It may contain extra data (other #' districts or date ranges). The data must be in long format (one row for each #' date and environmental variable combination), and must start at absolutel #' minimum \code{laglen} (in \code{fc_control}) days before epi_data for #' forecasting. -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables -#'@param quo_valuefield Quosure of user given field name of the value of the -#' environmental data variable observations. -#'@param env_variables alphabetical list of all unique environmental variables -#' present in the original env_data dataset. -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. #'@param env_ref_data Historical averages by week of year for environmental #' variables. Used in extended environmental data into the future for long #' forecast time, to calculate anomalies in early detection period, and to #' display on timeseries in reports. #'@param env_info Lookup table for environmental data - reference creation #' method (e.g. sum or mean), report labels, etc. +#' +#'@param quo_popfield Quosure of user-given field containing population values. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#'@param quo_obsfield Quosure of user given field name of the environmental data +#' variables +#'@param quo_valuefield Quosure of user given field name of the value of the +#' environmental data variable observations. +#' +#'@param fc_model_family model choice stand in <<>> +#'@param fc_clusters clusters <<>> +#'@param report_settings all the settings <<>> +#' +#'@param env_variables List of environmental variables <<>> +#' +#'@param groupings A unique list of the geographic groupings (from groupfield). #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi -#' weeks) that the weeks of the year in epidemiological and environmental -#' reference data use ["ISO" or "CDC"]. -#'@param model_run TRUE/FALSE flag for whether to only generate the model -#' regression object plus metadata. This model can be cached and used later on -#' its own, skipping a large portion of the slow calculations for future runs. -#'@param model_cached The output of a previous model_run = TRUE run of -#' run_epidemia() that produces a model (regression object) and metadata. The -#' metadata will be used for input checking and validation. Using a prebuilt -#' model saves on processing time, but will need to be updated periodically. -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-gam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. #'@param valid_run Internal binary for whether this is part of a validation run. #' #' @@ -80,6 +59,8 @@ run_forecast <- function(epi_data, quo_valuefield, env_ref_data, env_info, + fc_model_family, + fc_clusters, report_settings, #internal/calculated valid_run, @@ -87,26 +68,6 @@ run_forecast <- function(epi_data, env_variables, report_dates){ - # epi_data, - # quo_popfield, - # inc_per, - # quo_groupfield, - # groupings, - # env_data, - # quo_obsfield, - # quo_valuefield, - # env_variables, - # fc_control, - # env_ref_data, - # env_info, - # report_dates, - # week_type, - # model_run, - # model_cached = NULL, - # model_choice, - # valid_run - - message("Preparing for forecasting...") @@ -155,7 +116,7 @@ run_forecast <- function(epi_data, # anomalizing the environ data, if requested. - if (report_settings[["anom_env"]]){ + if (report_settings[["env_anomalies"]]){ message("Anomalizing the environmental variables...") env_fc <- anomalize_env(env_fc, quo_groupfield, @@ -189,7 +150,7 @@ run_forecast <- function(epi_data, # model_run_result <- forecast_regression(epi_lag, # quo_groupfield, # fc_model_family, - # nthreads, + # nthreads = report_settings[["fc_nthreads"]], # model_run, # model_cached = report_settings[["model_cached"]], # fit_freq = report_settings[["fc_fit_freq"]], @@ -214,7 +175,7 @@ run_forecast <- function(epi_data, forereg_return <- forecast_regression(epi_lag, quo_groupfield, fc_model_family, - nthreads, + nthreads = report_settings[["fc_nthreads"]], model_run, model_cached = report_settings[["model_cached"]], fit_freq = report_settings[["fc_fit_freq"]], @@ -237,7 +198,7 @@ run_forecast <- function(epi_data, forereg_return <- forecast_regression(epi_lag, quo_groupfield, fc_model_family, - nthreads, + nthreads = report_settings[["fc_nthreads"]], model_run, model_cached = report_settings[["model_cached"]], fit_freq = report_settings[["fc_fit_freq"]], @@ -270,7 +231,7 @@ run_forecast <- function(epi_data, #if reporting in case counts report_settings[["report_value_type"]] == "cases" ~ fc_cases, #if incidence - report_settings[["report_value_type"]] == "incidence" ~ fc_cases / !!quo_popfield * inc_per, + report_settings[["report_value_type"]] == "incidence" ~ fc_cases / !!quo_popfield * report_settings[["report_inc_per"]], #otherwise TRUE ~ NA_real_), lab = "Forecast Trend", @@ -278,14 +239,14 @@ run_forecast <- function(epi_data, #if reporting in case counts report_settings[["report_value_type"]] == "cases" ~ fc_cases_upr, #if incidence - report_settings[["report_value_type"]] == "incidence" ~ fc_cases_upr / !!quo_popfield * inc_per, + report_settings[["report_value_type"]] == "incidence" ~ fc_cases_upr / !!quo_popfield * report_settings[["report_inc_per"]], #otherwise TRUE ~ NA_real_), lower = dplyr::case_when( #if reporting in case counts report_settings[["report_value_type"]] == "cases" ~ fc_cases_lwr, #if incidence - report_settings[["report_value_type"]] == "incidence" ~ fc_cases_lwr / !!quo_popfield * inc_per, + report_settings[["report_value_type"]] == "incidence" ~ fc_cases_lwr / !!quo_popfield * report_settings[["report_inc_per"]], #otherwise TRUE ~ NA_real_) #value = fc_cases / !!quo_popfield * inc_per, @@ -310,6 +271,19 @@ run_forecast <- function(epi_data, #' lagged environmental data (or anomalies), as output by lag_environ_to_epi(). #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). +#'@param fc_model_family model choice stand in +#'@param nthreads max threads <<>> +#'@param model_run TRUE/FALSE flag for whether to only generate the model +#' regression object plus metadata. This model can be cached and used later on +#' its own, skipping a large portion of the slow calculations for future runs. +#'@param model_cached The output of a previous model_run = TRUE run of +#' run_epidemia() that produces a model (regression object) and metadata. The +#' metadata will be used for input checking and validation. Using a prebuilt +#' model saves on processing time, but will need to be updated periodically. +#'@param fit_freq String indicating "once" or "weekly" on how often to fit the +#' model - once for the whole report, or every week of the report. Unless +#' otherwise needed, the value should be "once", as weekly drastically +#' increases processing time. #'@param groupings A unique list of the geographic groupings (from groupfield). #'@param env_variables_used List of environmental variables that were used in #' the modeling. @@ -319,36 +293,7 @@ run_forecast <- function(epi_data, #'@param req_date The end date of requested forecast regression. When fit_freq #' == "once", this is the last date of the full report, the end date of the #' forecast period. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. -#'@param fit_freq String indicating "once" or "weekly" on how often to fit the -#' model - once for the whole report, or every week of the report. Unless -#' otherwise needed, the value should be "once", as weekly drastically -#' increases processing time. -#'@param model_run TRUE/FALSE flag for whether to only generate the model -#' regression object plus metadata. This model can be cached and used later on -#' its own, skipping a large portion of the slow calculations for future runs. -#'@param model_cached The output of a previous model_run = TRUE run of -#' run_epidemia() that produces a model (regression object) and metadata. The -#' metadata will be used for input checking and validation. Using a prebuilt -#' model saves on processing time, but will need to be updated periodically. -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-bam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param theta From fc_control$theta, the value of theta for a "negbin" model. -#' If present, will use glm(..., family = MASS::negative.binomial(theta)). If -#' missing, will use MASS::glm.nb(). +#' #' #'@return Named list containing: #'date_preds: Full forecasted resulting dataset. @@ -499,36 +444,19 @@ forecast_regression <- function(epi_lag, #'Build the appropriate model #' -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-bam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param n_groupings Count of the number of geographic groupings in the model. +#'@param fc_model_family model choice stand in <<>> #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). +#'@param epi_known Epidemiological dataset with basis spline summaries of the +#' lagged environmental data (or anomalies), with column marking if "known" +#' data and groupings converted to factors. +#'@param nthreads thread count <<>> +#'@param n_groupings Count of the number of geographic groupings in the model. #'@param modb_eq Pieces of the regression formula that include the modified #' basis functions to account for long term trend (with or without groupings, #' as appropriate). #'@param bandsums_eq Pieces of the regression formula that include the b-spline #' bandsummaries of the environmental factors. -#'@param epi_known Epidemiological dataset with basis spline summaries of the -#' lagged environmental data (or anomalies), with column marking if "known" -#' data and groupings converted to factors. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. -#'@param theta From fc_control$theta, the value of theta for a "negbin" model. -#' If present, will use glm(..., family = MASS::negative.binomial(theta)). If -#' missing, will use MASS::glm.nb(). #' #'@return Regression object @@ -572,7 +500,7 @@ build_model <- function(fc_model_family, family = poisson(), control = mgcv::gam.control(trace=FALSE), discrete = TRUE, - nthreads) + nthreads = nthreads) } else if (fc_model_family == "negbin"){ @@ -657,19 +585,8 @@ build_model <- function(fc_model_family, #'Create the appropriate predictions/forecasts. #' -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-gam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. +#'@param fc_model_family model choice <<>> +#'@param nthreads max threads <<>> #'@param regress The regression object, either the user-supplied one, or #' the one just generated. #'@param epi_lag Epidemiological dataset with basis spline summaries of the @@ -677,9 +594,6 @@ build_model <- function(fc_model_family, #'@param req_date The end date of requested forecast regression. When fit_freq #' == "once", this is the last date of the full report, the end date of the #' forecast period. -#'@param ncores The number of physical cores to use in parallel processing, set -#' in fc_control$ncores, else the max of the number of physical core available -#' minus 1, or 1 core. #' #'@return A dataset from predict() using the regression object generated in #' build_model or a newly created one. The dataset includes the diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index 726e751..2421463 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -18,9 +18,9 @@ #' the modeling. #'@param env_info Lookup table for environmental data - reference creation #' method (e.g. sum or mean), report labels, etc. -#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi +#'@param epi_date_type String indicating the standard (WHO ISO-8601 or CDC epi #' weeks) that the weeks of the year in epidemiological and environmental -#' reference data use ["ISO" or "CDC"]. +#' reference data use ["ISO" or "CDC"]. <<>> #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. @@ -37,6 +37,14 @@ environ_report_format <- function(env_ext_data, env_info, epi_date_type, report_dates){ + + #for adding week, year fields + week_type <- dplyr::case_when( + epi_date_type == "weekISO" ~ "ISO", + epi_date_type == "weekCDC" ~ "CDC", + #default NA + TRUE ~ NA_character_) + #daily env data env_data_varused <- env_ext_data %>% dplyr::filter(!!quo_obsfield %in% env_used) @@ -52,12 +60,7 @@ environ_report_format <- function(env_ext_data, dplyr::select(!!quo_obsfield, reference_method), by = rlang::set_names(rlang::quo_name(quo_obsfield), rlang::quo_name(quo_obsfield))) %>% - #add week, year fields - week_type <- dplyr::case_when( - epi_date_type == "weekISO" ~ "ISO", - epi_date_type == "weekCDC" ~ "CDC", - #default as if mean - TRUE ~ NA_character_) + #add date fields epidemiar::add_datefields(week_type) %>% #trim dates to reduce processing (dates are rough, technically just need week prior to start. 8 is not magical) dplyr::filter(obs_date >= report_dates$full$min - 8 & obs_date <= report_dates$full$max + 8) %>% @@ -237,43 +240,3 @@ calc_env_anomalies <- function(env_ts, dplyr::ungroup() } -## Chooses the appropriate function to return the results in the desired form -#' Calculate the epidemiological value to be shown as result, and on the reports. -#' -#'@param cases Field containing case counts, if a quosure, c_quo_tf should be TRUE. -#'@param c_quo_tf Binary T/F if case field is a quosure rather than a column name. -#'@param q_pop Quosure of user-given field containing population values. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. Parameter ignored if -#' vt == "cases" ("incidence" is default, if not set). -#'@param vt From match.arg evaluation of fc_control$value_type, whether to return -#' epidemiological report values in "incidence" (default) or "cases". -#'@param mc From match.arg evaluation of model_choice. Reserved for future overrides on value_type depending on -#' model choice selection. -#' -#'@return Epidemiolgical return values, either in cases or incidence, depending -#' on user settings. -#' -# calc_return_value <- function(cases, -# c_quo_tf = FALSE, -# q_pop = NULL, -# inc_per, -# vt, -# mc){ -# dplyr::case_when( -# #if reporting in case counts -# #if quosure, evaluate -# vt == "cases" & c_quo_tf ~ !!cases, -# #otherwise given case field directly -# vt == "cases" ~ cases, -# #if incidence and case field quosure -# vt == "incidence" & c_quo_tf ~ !!cases / !!q_pop * inc_per, -# #if incidence -# vt == "incidence" ~ cases / !!q_pop * inc_per, -# #otherwise -# TRUE ~ NA_real_ -# ) -# #FAILS. -# ##Error: Quosures can only be unquoted within a quasiquotation context. -# -# } diff --git a/R/model_validation.R b/R/model_validation.R index 30391c2..f02a285 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -1,646 +1,646 @@ - -#'Run EPIDEMIA model validation statistics -#' -#'This function takes a few more arguments than `epidemiar::run_epidemia()` to -#'generate statistics on model validation. The function will evaluate a number -#'of weeks (`total_timesteps`) starting from a specified week (`date_start`) and -#'will look at the n-week ahead forecast (1 to `timesteps_ahead` number of -#'weeks) and compare the values to the observed number of cases. An optional -#'`reporting_lag` argument will censor the last known data back that number of -#'weeks. The validation statistics include Root Mean Squared Error (RMSE) and -#'Mean Absolute Error (MAE), and an R-squared staistic both in total and per -#'geographic grouping (if present). -#' -#'@param date_start Date to start testing for model validation. -#'@param total_timesteps Number of weeks from `week_start` to run validation -#' tests. -#'@param timesteps_ahead Number of weeks for testing the n-week ahead forecasts. -#' Results will be generated from 1-week ahead through `weeks_ahead` number of -#' weeks. -#'@param reporting_lag Number of timesteps to simulate reporting lag. For -#' instance, if you have weekly data, and a reporting_lag of 1 week, and are -#' working with a timesteps_ahead of 1 week, then that is functional equivalent -#' to reporting lag of 0, and timesteps_ahead of 2 weeks. I.e. You are -#' forecasting next week, but you don't know this week's data yet, you only -#' know last week's numbers. -#'@param per_timesteps When creating a timeseries of validation results, create -#' a moving window with per_timesteps width number of time points. Should be a -#' minimum of 10 timesteps. -#'@param skill_test Logical parameter indicating whether or not to run -#' validations also on two naïve models for a skill test comparison. The naïve -#' models are "persistence": the last known value (case counts) carried -#' forward, and "average week" where the predicted value is the average of that -#' week of the year, as calculated from historical data. -#'@param epi_data See description in `run_epidemia()`. -#'@param casefield See description in `run_epidemia()`. -#'@param populationfield See description in `run_epidemia()`. -#'@param groupfield See description in `run_epidemia()`. -#'@param week_type See description in `run_epidemia()`. -#'@param report_period The number of weeks that the entire report will cover. -#' The \code{report_period} minus \code{forecast_future} is the number of weeks -#' of past (known) data that will be included. Overwritten to be `weeks_ahead` -#' + 1 for validation runs. -#'@param ed_summary_period Overwritten to 1 for validation runs (no-op for no -#' event detection during validation runs). -#'@param ed_method Overwritten to "none" for validation runs. -#'@param env_data See description in `run_epidemia()`. -#'@param obsfield See description in `run_epidemia()`. -#'@param valuefield See description in `run_epidemia()`. -#'@param forecast_future Number of future weeks from the end of the -#' \code{epi_data} to produce forecasts, as in `run_epidemia()`, but -#' overwritten as `weeks_ahead` for validation runs. -#'@param fc_control See description in `run_epidemia()`. Note, -#' fc_control$value_type is overwritten as "cases" for validation runs. -#'@param env_ref_data See description in `run_epidemia()`. -#'@param env_info See description in `run_epidemia()`. -#'@param model_cached See description in `run_epidemia()`. -#'@param model_choice See description in `run_epidemia()`. -#'@param ... Accepts other arguments that are normally part of `run_epidemia()`, -#' but ignored for validation runs. For example, `inc_per`, `ed_control`, -#' `model_run`. -#' -#' -#'@return Returns a nested list of validation results. Statistics are calculated -#' on the n-week ahead forecast and the actual observed case counts. Statistics -#' returned are Mean Absolute Error (MAE), Root Mean Squared Error (RMSE). The -#' first object is `skill_scores`, which contains `skill_overall` and -#' `skill_grouping`. The second list is `validations`, which contains lists per -#' model run (the forecast model and then optionally the naive models). Within -#' each, `validation_overall` is the results overall, and `validation_grouping` -#' is the results per geographic grouping. Lastly, a `metadata` list contains -#' the important parameter settings used to run validation and when the results -#' where generated. -#' -#'@export -#' -run_validation <- function(date_start = NULL, - total_timesteps = 26, - timesteps_ahead = 2, - reporting_lag = 0, - per_timesteps = 12, - skill_test = TRUE, - #for run_epidemia() - epi_data = NULL, - casefield = NULL, - populationfield = NULL, - groupfield = NULL, - week_type = c("ISO", "CDC"), - report_period = 3, #default is timesteps_ahead default + 1 - ed_summary_period = 1, #0 causes errors, 1 and "none" is no-op equivalent - ed_method = "none", - env_data = NULL, - obsfield = NULL, - valuefield = NULL, - forecast_future = 2, #default same as timesteps_ahead default - fc_control = NULL, - env_ref_data = NULL, - env_info = NULL, - model_cached = NULL, - model_choice = c("poisson-bam", "negbin"), - ...){ - #date_start: week to start reporting of results - #total_timesteps: number of weeks forward from week_start to gather test results - #timesteps_ahead: calculate stats on 1 to n week ahead predictions - - #this means that the start of calculations will be date_start minus timesteps_ahead # of weeks - #then trimmed at the end to start at date_start. - - # Non-standard evaluation quosures ---------------------------------------- - - # dplyr programming steps for passing of field names - quo_casefield <- rlang::enquo(casefield) - quo_popfield <- rlang::enquo(populationfield) - quo_groupfield <- rlang::enquo(groupfield) - quo_obsfield <- rlang::enquo(obsfield) - quo_valuefield <- rlang::enquo(valuefield) - - #Note: if field name does not exist in any dataset, enquo() will throw an error. - - - # Adjust parameters for validation runs ----------------------------------- - - #Assumed that run_epidemia() parameters just copied and pasted, so adjust for validation - #new lengths - forecast_future <- timesteps_ahead + reporting_lag - report_period <- forecast_future + 1 - #no event detection - ed_summary_period <- 1 - ed_method <- "none" - #report out in CASES for validation - fc_control$value_type <- "cases" - - #for params accepted by run_epidemia, but are meaningless for validation runs - # e.g. `inc_per`, `ed_control`, `model_run` - #captured, but then do nothing with them - # Also used for hidden raw_data argument for testing/development - dots <- list(...) - - #Create parameter metadata - metadata <- create_named_list(date_start, - total_timesteps, - timesteps_ahead, - reporting_lag, - per_timesteps, - skill_test, - casefield = quo_name(quo_casefield), - date_created = Sys.Date()) - - - # All loop prep ------------------------------------------------------ - - #Set up for looping - #preserve full data - epi_data_orig <- epi_data - env_data_orig <- env_data - - #Pull obs from original - # Will have extra dates, but will be trimmed back to user requested dates later - obs_only <- epi_data_orig %>% - dplyr::select(!!quo_groupfield, obs_date, !!quo_casefield) %>% - #rename observation - dplyr::rename(obs := !!quo_name(quo_casefield)) - - - #Skill test loop set up - if (skill_test == TRUE){ - models_to_run = c(model_choice, "naive-persistence", "naive-averageweek") - } else { - models_to_run = c(model_choice) - } - - # Skill test loop --------------------------------------------------------- - - #skill test collection - all_validations <- vector("list", length = length(models_to_run)) - #add names - names(all_validations) <- models_to_run - - #model loop - for (m in seq_along(models_to_run)){ - - this_model <- models_to_run[m] - - #If naive-averageweek, timesteps_ahead is meaningless, just use 1 - if (this_model == "naive-averageweek"){ - this_timesteps_ahead <- 1 - this_forecast_future <- this_timesteps_ahead - this_report_period <- this_forecast_future + 1 - } else { - #use modified forecast_future which is timesteps_ahead + reporting_lag - this_timesteps_ahead <- forecast_future #timesteps_ahead - this_forecast_future <- this_timesteps_ahead - this_report_period <- this_forecast_future + 1 - } - - # Week loop --------------------------------------------------------------- - - #Create list of dates - #the start of calculations will be date_start minus timesteps_ahead # of weeks - date_list <- date_start + lubridate::weeks(-this_timesteps_ahead:(total_timesteps-1)) - - #output will be list of dataframes (forecasts) until we collapse later - fcs_list <- vector("list", length = length(date_list)) - - #loop - for (i in seq_along(date_list)){ - this_dt <- date_list[i] - - message("Validation run - date: ", this_dt) # for testing for now - - #set up data - #censoring as appropriate - #reporting_lag will be handled with offset timesteps - epi_data <- epi_data_orig %>% - dplyr::filter(obs_date <= this_dt) - env_data <- env_data_orig %>% - dplyr::filter(obs_date <= this_dt) - - #run_epidemia - #passing quosures, which will have an escape built into run_epidemia() - reportdata <- run_epidemia(epi_data = epi_data, - casefield = quo_casefield, - populationfield = quo_popfield, - inc_per = inc_per, - groupfield = quo_groupfield, - week_type = "ISO", - report_period = this_report_period, #this - ed_summary_period = ed_summary_period, - ed_method = ed_method, - ed_control = ed_control, - env_data = env_data, - obsfield = quo_obsfield, - valuefield = quo_valuefield, - forecast_future = this_forecast_future, #this - fc_control = fc_control, - env_ref_data = env_ref_data, - env_info = env_info, - model_cached = model_cached, - model_choice = this_model) ##models_to_run - - - - #pull needed and reformat - fcs_list[[i]] <- reportdata$modeling_results_data %>% - #get forecasts only - dplyr::filter(series == "fc") %>% - #get base date of report ('current date' in relation to forecast) - dplyr::mutate(preadj_date = this_dt, - #how many weeks ahead is the prediction (not adjusting for reporting lag yet) - timestep_ahead_orig = difftime(obs_date, preadj_date) %>% - as.numeric(units = "weeks")) %>% - #don't need 0 week predictions (same week) - dplyr::filter(timestep_ahead_orig > 0) - - - } #end timestep loop - - #have list of dataframes - #collapse/bindrows - fcs_only <- dplyr::bind_rows(fcs_list) %>% - #nicely arrange - dplyr::arrange(!!quo_groupfield, timestep_ahead_orig, obs_date) - - - #join - fc_join <- fcs_only %>% - dplyr::left_join(obs_only, - #NSE fun - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - "obs_date"), - c(rlang::quo_name(quo_groupfield), - "obs_date"))) - - #make all the reporting_lag adjustments - # basically, we ran extra forecast future steps - # so we now can simply shift everything backwards except for averageweek - if (this_model == "naive-averageweek"){ - fc_join <- fc_join %>% - dplyr::mutate(run_date = preadj_date, - #timestep_ahead is meaningless for average week. - # NA may cause unexpected results with grouping, so replace with 0 - timestep_ahead = 0, - #Add column for showing reporting_lag - reporting_lag = reporting_lag) - } else { - fc_join <- fc_join %>% - dplyr::mutate(run_date = preadj_date - lubridate::weeks(reporting_lag), - timestep_ahead = timestep_ahead_orig - reporting_lag, - #Add column for showing reporting_lag - reporting_lag = reporting_lag) %>% - #filter out the timesteps that are now less than 1 step - dplyr::filter(timestep_ahead > 0) - } - - - #Filter to report weeks (trim off edges gathered b/c of weeks_ahead, etc.) - fc_trim <- fc_join %>% - dplyr::filter(between(obs_date, - date_start, - date_start + lubridate::weeks(total_timesteps-1))) - - - ## Calculate statistics - val_results <- calc_val_stats(fc_trim, quo_groupfield, per_timesteps, dots) - - #add results to list by name - all_validations[[this_model]] <- val_results - - } #end model loop - - - - #Get skill test list of results - if (skill_test == TRUE){ - #calc skill comparison statistics - skill_overall <- calc_skill(get_overall_validations(all_validations)) - skill_grouping <- calc_skill(get_group_validations(all_validations), quo_groupfield) - skill_scores <- create_named_list(skill_overall, skill_grouping) - - val_return <- create_named_list(skill_scores, validations = all_validations, metadata) - } else { - #just the one model validation datasets - val_return <- create_named_list(all_validations, metadata) - } - - - - - message("Validation run finished.") - val_return - -} #end run validation - - - -#'Calculate validation statistics from forecast results. -#' -#'Helper function to calculate the validation statistics from each model run. -#'Mean Absolute Error (MAE), Root Mean Square Error (RMSE), Proportion of -#'observations in in prediction interval, and R^2. Calculates it both at a -#'global model level per timestep ahead, and at a geographical grouping level -#'per timestep ahead. Also calculates a timeseries of evaluation metrics at -#'every per_timesteps number of timesteps per grouping (if applicable) and -#'timestep_ahead. -#' -#'@param fc_trim The forecast results of one model type, combined with observed -#' values, trimmed to user requested date range. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_validation()/run_epidemia(). -#'@param per_timesteps When creating a timeseries of validation results, create -#' a moving window with per_timesteps width number of time points. Should be a -#' minimum of 10 timesteps. -#'@param dots The non-required arguments to run_validation() for developer -#' testing. -#' -#'@return A named list of validation statistic results: validation_overall, -#' validation_grouping, validation_timeseries -#' -calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ - # MAE: mean(|obs - pred|) - # RMSE: sqrt(mean((obs - pred)^2)) - # R2 (R^2): 1 - SSE/TSS. SSE = sum((obs-pred)^2). TSS = sum((obs - mean(obs))^2). - # B/c involves mean of group of observations, must be calculated after grouping - - #Removed - # Proportion in Interval: 1/T if inside, summed. Over all non-NA entries. - - #per line stats - fc_stats <- fc_trim %>% - dplyr::mutate(diff = obs - value, - absdiff = abs(diff), - diffsq = diff ^ 2) - #,predinterval = ifelse(obs >= lower & obs <= upper, TRUE, FALSE)) - - - #overall timestep_ahead - validation_overall <- fc_stats %>% - dplyr::group_by(timestep_ahead) %>% - #Now calc TSS part of R2 - dplyr::mutate(meanobs = mean(obs), - total_squares = (obs - meanobs)^2) %>% - #stat calc - dplyr::summarize(MAE = mean(absdiff, na.rm = TRUE), - MSE = mean(diffsq, na.rm = TRUE), - #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), - SSE = sum(diffsq, na.rm = TRUE), - TSS = sum(total_squares, na.rm = TRUE)) %>% - #and mutate for final calc - dplyr::mutate(RMSE = sqrt(MSE), - R2 = 1 - (SSE/TSS)) %>% - #drop unneeded columns - dplyr::select(-SSE, -TSS, -MSE) - - - - #overall timestep_ahead by grouping - validation_grouping <- fc_stats %>% - dplyr::group_by(!!quo_groupfield, timestep_ahead) %>% - #Now calc TSS part of R2 - dplyr::mutate(meanobs = mean(obs), - total_squares = (obs - meanobs)^2) %>% - #stat calc - dplyr::summarize(MAE = mean(absdiff, na.rm = TRUE), - MSE = mean(diffsq, na.rm = TRUE), - #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), - SSE = sum(diffsq, na.rm = TRUE), - TSS = sum(total_squares, na.rm = TRUE)) %>% - #and mutate for final calc - dplyr::mutate(RMSE = sqrt(MSE), - R2 = 1 - (SSE/TSS)) %>% - #drop unneeded columns - dplyr::select(-SSE, -TSS, -MSE) - - - - #timeseries calculations - # minimum of ~10 timesteps per summary - # ROLLING window - validation_timeseries <- fc_stats %>% - dplyr::group_by(!!quo_groupfield, timestep_ahead) %>% - #rollapply for get mean of obs - dplyr::mutate(meanobs = zoo::rollmeanr(x = obs, - k = per_timesteps, - fill = NA), - total_squares = (obs - meanobs)^2, - MAE = zoo::rollmeanr(x = absdiff, - k = per_timesteps, - fill = NA), - MSE = zoo::rollmeanr(x = diffsq, - k = per_timesteps, - fill = NA), - RMSE = sqrt(MSE), - #prop_interval = zoo::rollsumr(x = predinterval, - # k = per_timesteps, - # fill = NA) / - # zoo::rollsumr(x = !is.na(predinterval), - # k = per_timesteps, - # fill = NA), - SSE = zoo::rollsumr(x = diffsq, - k = per_timesteps, - fill = NA), - TSS = zoo::rollsumr(x = total_squares, - k = per_timesteps, - fill = NA), - R2 = 1 - (SSE/TSS)) %>% - #rename columns to be clearer - dplyr::rename(forecast = value, - observed = obs) %>% - # drop unneeded columns - dplyr::select(-series, -preadj_date, -timestep_ahead_orig, -run_date, - -diff, -absdiff, -diffsq, -meanobs, -total_squares, -MSE, -SSE, -TSS) %>% - # for now, drop R2 until can figure out how to include better - dplyr::select(-R2) - - - - #return all - # and raw data with hidden option - #possibly make "time series" version for clean full data table - if (!is.null(dots[['raw_data']])){ - if (dots[['raw_data']] == TRUE){ - val_stats <- create_named_list(validation_overall, validation_grouping, validation_timeseries, raw_stats = fc_stats) - } #end raw data TRUE - } else { - #normal return with just results - val_stats <- create_named_list(validation_overall, validation_grouping, validation_timeseries) - } -} #end calc_val_stats() - - -#' Get overall model validation statistics -#' -#' Small function to pull out just overall validation statistics. -#' -#' @param validations The set of validation statistics produced by -#' run_validation() - only the list of validation data sets, not including the skill metrics. -#' -#' @return A list of tibbles containing only the model overall statistics (and -#' not including the geographic grouping results, if present). -#' -#' @export -#' -get_overall_validations <- function(validations){ - lapply(validations, `[[`, "validation_overall") -} - - -#' Get geographic grouping model validation statistics -#' -#' Small function to pull out just the geographic grouping validation statistics. -#' -#' @param validations The set of validation statistics produced by -#' run_validation() - only the list of validation data sets, not including the skill metrics. -#' -#' @return A list of tibbles containing only the model geographic grouping statistics. -#' -#' @export -#' -get_group_validations <- function(validations){ - lapply(validations, `[[`, "validation_grouping") -} - - - -#' Calculate model skill comparison statistics -#' -#' Helper function to calculate the relative improvement of the forecast over the specified naive model. -#' Skill score = (score_fc - score_naive) / (score_perfect - score_naive) -#' Skill metric has an upper bound of 1. No improvement is 0. Lower bound depends on statistic. -#' -#'@param fc_stat The forecast model statistic value. -#'@param naive_stat The naive model statistic value (same statistic as forecast model). -#'@param perfect_stat The value of a perfect score for that stastistic. -#' -#'@return Skill score: the relative improvement the forecast model has over the naive model. -#' -#'@export -#' -calc_skill_stat <- function(fc_stat, naive_stat, perfect_stat){ - skill_stat <- (fc_stat - naive_stat) / (perfect_stat - naive_stat) -} - - -#' Calculate the forecast model skill score compared to the naive model predictions. -#' -#'@param val_list A list of 3 datasets of validation results: the first is the forecast model, the following two are the naive model results, as created by binding the results of calc_val_stats() in run_validation(). -#'@param grp Optional inclusion of quo_groupfield when calculating skill scores by groupfield. -#' -#'@return Single dataset with skill scores of the main forecast model against each of the naive models, per timestep ahead, and optionally, per geographic grouping -#' -calc_skill <- function(val_list, grp = NULL){ - - #separate out, rename columns, and join/crossing - val_fc <- val_list[[1]] %>% - dplyr::rename(fc_MAE = MAE, - fc_RMSE = RMSE, - #fc_prop_interval = prop_interval, - fc_R2 = R2) %>% - dplyr::select(group_cols(), timestep_ahead, starts_with("fc_")) - - val_np <- val_list$`naive-persistence` %>% - dplyr::rename(np_MAE = MAE, - np_RMSE = RMSE, - #np_prop_interval = prop_interval, - np_R2 = R2) %>% - dplyr::select(group_cols(), timestep_ahead, starts_with("np_")) - - val_naw <- val_list$`naive-averageweek` %>% - rename(naw_MAE = MAE, - naw_RMSE = RMSE, - #naw_prop_interval = prop_interval, - naw_R2 = R2) %>% - #no timestep_ahead for average week, all same - select(group_cols(), starts_with("naw_")) - - #appropriate joins - if (is.null(grp)){ - #join together - val_join <- val_fc %>% - #join with persistence - dplyr::left_join(val_np, - by = "timestep_ahead") %>% - #join with average week (1 value to all timesteps ahead) - tidyr::crossing(val_naw) - } else { - #else join with groupfield - #join together - val_join <- val_fc %>% - #join with persistence - dplyr::left_join(val_np, - #NSE fun - by = rlang::set_names(c(rlang::quo_name(grp), - "timestep_ahead"), - c(rlang::quo_name(grp), - "timestep_ahead"))) %>% - #join with average week (1 value to all timesteps ahead) - dplyr::left_join(val_naw, - by = rlang::set_names(rlang::quo_name(grp), - rlang::quo_name(grp))) - } #end joinings - - #perfect skill metrics - perfect_MAE <- 0 - perfect_RMSE <- 0 - #perfect_prop_interval <- 1 - perfect_R2 <- 1 - - #calc skill metrics of fc model to each of naive models - val_skill <- val_join %>% - mutate(skill_MAE_persistence = calc_skill_stat(fc_MAE, np_MAE, perfect_MAE), - skill_RMSE_persistence = calc_skill_stat(fc_RMSE, np_RMSE, perfect_RMSE), - #skill_interval_persistence = calc_skill_stat(fc_prop_interval, np_prop_interval, - # perfect_prop_interval), - skill_R2_persistence = calc_skill_stat(fc_R2, np_R2, perfect_R2), - skill_MAE_averageweek = calc_skill_stat(fc_MAE, naw_MAE, perfect_MAE), - skill_RMSE_averageweek = calc_skill_stat(fc_RMSE, naw_RMSE, perfect_RMSE), - #skill_interval_averageweek = calc_skill_stat(fc_prop_interval, naw_prop_interval, - # perfect_prop_interval), - skill_R2_averageweek = calc_skill_stat(fc_R2, naw_R2, perfect_R2)) %>% - #select final stats only - select(group_cols(), timestep_ahead, starts_with("skill_")) - - val_skill -} - - - -#' Save overall model validation statistics -#' -#' Small function to pull out just overall validation statistics and save to -#' csv. -#' -#' @param validations The set of validation statistics produced by -#' run_validation() - only the list of validation data sets, not including the skill metrics. -#' @param save_file File name to save results into csv format -#' -#' @return A csv file containing only the model overall statistics (and not -#' including the geographic grouping results, if present). -#' -#' @export -#' -save_overall_validations <- function(validations, save_file){ - lapply(validations, `[[`, "validation_overall") %>% - bind_rows(.id = "model") %>% - write_csv(save_file) -} - - -#' Save geographic grouping model validation statistics -#' -#' Small function to pull out validation statistics per geographic grouping and -#' save to csv. -#' -#' @param validations The set of validation statistics produced by -#' run_validation() - only the list of validation data sets, not including the skill metrics. -#' @param save_file File name to save results into csv format -#' -#' @return A csv file containing the model validation statistics for the -#' geographic grouping results. -#' -#' @export -#' -save_geog_validations <- function(validations, save_file){ - lapply(validations, `[[`, "validation_grouping") %>% - bind_rows(.id = "model") %>% - write_csv(save_file) -} +#' +#' #'Run EPIDEMIA model validation statistics +#' #' +#' #'This function takes a few more arguments than `epidemiar::run_epidemia()` to +#' #'generate statistics on model validation. The function will evaluate a number +#' #'of weeks (`total_timesteps`) starting from a specified week (`date_start`) and +#' #'will look at the n-week ahead forecast (1 to `timesteps_ahead` number of +#' #'weeks) and compare the values to the observed number of cases. An optional +#' #'`reporting_lag` argument will censor the last known data back that number of +#' #'weeks. The validation statistics include Root Mean Squared Error (RMSE) and +#' #'Mean Absolute Error (MAE), and an R-squared staistic both in total and per +#' #'geographic grouping (if present). +#' #' +#' #'@param date_start Date to start testing for model validation. +#' #'@param total_timesteps Number of weeks from `week_start` to run validation +#' #' tests. +#' #'@param timesteps_ahead Number of weeks for testing the n-week ahead forecasts. +#' #' Results will be generated from 1-week ahead through `weeks_ahead` number of +#' #' weeks. +#' #'@param reporting_lag Number of timesteps to simulate reporting lag. For +#' #' instance, if you have weekly data, and a reporting_lag of 1 week, and are +#' #' working with a timesteps_ahead of 1 week, then that is functional equivalent +#' #' to reporting lag of 0, and timesteps_ahead of 2 weeks. I.e. You are +#' #' forecasting next week, but you don't know this week's data yet, you only +#' #' know last week's numbers. +#' #'@param per_timesteps When creating a timeseries of validation results, create +#' #' a moving window with per_timesteps width number of time points. Should be a +#' #' minimum of 10 timesteps. +#' #'@param skill_test Logical parameter indicating whether or not to run +#' #' validations also on two naïve models for a skill test comparison. The naïve +#' #' models are "persistence": the last known value (case counts) carried +#' #' forward, and "average week" where the predicted value is the average of that +#' #' week of the year, as calculated from historical data. +#' #'@param epi_data See description in `run_epidemia()`. +#' #'@param casefield See description in `run_epidemia()`. +#' #'@param populationfield See description in `run_epidemia()`. +#' #'@param groupfield See description in `run_epidemia()`. +#' #'@param week_type See description in `run_epidemia()`. +#' #'@param report_period The number of weeks that the entire report will cover. +#' #' The \code{report_period} minus \code{forecast_future} is the number of weeks +#' #' of past (known) data that will be included. Overwritten to be `weeks_ahead` +#' #' + 1 for validation runs. +#' #'@param ed_summary_period Overwritten to 1 for validation runs (no-op for no +#' #' event detection during validation runs). +#' #'@param ed_method Overwritten to "none" for validation runs. +#' #'@param env_data See description in `run_epidemia()`. +#' #'@param obsfield See description in `run_epidemia()`. +#' #'@param valuefield See description in `run_epidemia()`. +#' #'@param forecast_future Number of future weeks from the end of the +#' #' \code{epi_data} to produce forecasts, as in `run_epidemia()`, but +#' #' overwritten as `weeks_ahead` for validation runs. +#' #'@param fc_control See description in `run_epidemia()`. Note, +#' #' fc_control$value_type is overwritten as "cases" for validation runs. +#' #'@param env_ref_data See description in `run_epidemia()`. +#' #'@param env_info See description in `run_epidemia()`. +#' #'@param model_cached See description in `run_epidemia()`. +#' #'@param model_choice See description in `run_epidemia()`. +#' #'@param ... Accepts other arguments that are normally part of `run_epidemia()`, +#' #' but ignored for validation runs. For example, `inc_per`, `ed_control`, +#' #' `model_run`. +#' #' +#' #' +#' #'@return Returns a nested list of validation results. Statistics are calculated +#' #' on the n-week ahead forecast and the actual observed case counts. Statistics +#' #' returned are Mean Absolute Error (MAE), Root Mean Squared Error (RMSE). The +#' #' first object is `skill_scores`, which contains `skill_overall` and +#' #' `skill_grouping`. The second list is `validations`, which contains lists per +#' #' model run (the forecast model and then optionally the naive models). Within +#' #' each, `validation_overall` is the results overall, and `validation_grouping` +#' #' is the results per geographic grouping. Lastly, a `metadata` list contains +#' #' the important parameter settings used to run validation and when the results +#' #' where generated. +#' #' +#' #'@export +#' #' +#' run_validation <- function(date_start = NULL, +#' total_timesteps = 26, +#' timesteps_ahead = 2, +#' reporting_lag = 0, +#' per_timesteps = 12, +#' skill_test = TRUE, +#' #for run_epidemia() +#' epi_data = NULL, +#' casefield = NULL, +#' populationfield = NULL, +#' groupfield = NULL, +#' week_type = c("ISO", "CDC"), +#' report_period = 3, #default is timesteps_ahead default + 1 +#' ed_summary_period = 1, #0 causes errors, 1 and "none" is no-op equivalent +#' ed_method = "none", +#' env_data = NULL, +#' obsfield = NULL, +#' valuefield = NULL, +#' forecast_future = 2, #default same as timesteps_ahead default +#' fc_control = NULL, +#' env_ref_data = NULL, +#' env_info = NULL, +#' model_cached = NULL, +#' model_choice = c("poisson-bam", "negbin"), +#' ...){ +#' #date_start: week to start reporting of results +#' #total_timesteps: number of weeks forward from week_start to gather test results +#' #timesteps_ahead: calculate stats on 1 to n week ahead predictions +#' +#' #this means that the start of calculations will be date_start minus timesteps_ahead # of weeks +#' #then trimmed at the end to start at date_start. +#' +#' # Non-standard evaluation quosures ---------------------------------------- +#' +#' # dplyr programming steps for passing of field names +#' quo_casefield <- rlang::enquo(casefield) +#' quo_popfield <- rlang::enquo(populationfield) +#' quo_groupfield <- rlang::enquo(groupfield) +#' quo_obsfield <- rlang::enquo(obsfield) +#' quo_valuefield <- rlang::enquo(valuefield) +#' +#' #Note: if field name does not exist in any dataset, enquo() will throw an error. +#' +#' +#' # Adjust parameters for validation runs ----------------------------------- +#' +#' #Assumed that run_epidemia() parameters just copied and pasted, so adjust for validation +#' #new lengths +#' forecast_future <- timesteps_ahead + reporting_lag +#' report_period <- forecast_future + 1 +#' #no event detection +#' ed_summary_period <- 1 +#' ed_method <- "none" +#' #report out in CASES for validation +#' fc_control$value_type <- "cases" +#' +#' #for params accepted by run_epidemia, but are meaningless for validation runs +#' # e.g. `inc_per`, `ed_control`, `model_run` +#' #captured, but then do nothing with them +#' # Also used for hidden raw_data argument for testing/development +#' dots <- list(...) +#' +#' #Create parameter metadata +#' metadata <- create_named_list(date_start, +#' total_timesteps, +#' timesteps_ahead, +#' reporting_lag, +#' per_timesteps, +#' skill_test, +#' casefield = quo_name(quo_casefield), +#' date_created = Sys.Date()) +#' +#' +#' # All loop prep ------------------------------------------------------ +#' +#' #Set up for looping +#' #preserve full data +#' epi_data_orig <- epi_data +#' env_data_orig <- env_data +#' +#' #Pull obs from original +#' # Will have extra dates, but will be trimmed back to user requested dates later +#' obs_only <- epi_data_orig %>% +#' dplyr::select(!!quo_groupfield, obs_date, !!quo_casefield) %>% +#' #rename observation +#' dplyr::rename(obs := !!quo_name(quo_casefield)) +#' +#' +#' #Skill test loop set up +#' if (skill_test == TRUE){ +#' models_to_run = c(model_choice, "naive-persistence", "naive-averageweek") +#' } else { +#' models_to_run = c(model_choice) +#' } +#' +#' # Skill test loop --------------------------------------------------------- +#' +#' #skill test collection +#' all_validations <- vector("list", length = length(models_to_run)) +#' #add names +#' names(all_validations) <- models_to_run +#' +#' #model loop +#' for (m in seq_along(models_to_run)){ +#' +#' this_model <- models_to_run[m] +#' +#' #If naive-averageweek, timesteps_ahead is meaningless, just use 1 +#' if (this_model == "naive-averageweek"){ +#' this_timesteps_ahead <- 1 +#' this_forecast_future <- this_timesteps_ahead +#' this_report_period <- this_forecast_future + 1 +#' } else { +#' #use modified forecast_future which is timesteps_ahead + reporting_lag +#' this_timesteps_ahead <- forecast_future #timesteps_ahead +#' this_forecast_future <- this_timesteps_ahead +#' this_report_period <- this_forecast_future + 1 +#' } +#' +#' # Week loop --------------------------------------------------------------- +#' +#' #Create list of dates +#' #the start of calculations will be date_start minus timesteps_ahead # of weeks +#' date_list <- date_start + lubridate::weeks(-this_timesteps_ahead:(total_timesteps-1)) +#' +#' #output will be list of dataframes (forecasts) until we collapse later +#' fcs_list <- vector("list", length = length(date_list)) +#' +#' #loop +#' for (i in seq_along(date_list)){ +#' this_dt <- date_list[i] +#' +#' message("Validation run - date: ", this_dt) # for testing for now +#' +#' #set up data +#' #censoring as appropriate +#' #reporting_lag will be handled with offset timesteps +#' epi_data <- epi_data_orig %>% +#' dplyr::filter(obs_date <= this_dt) +#' env_data <- env_data_orig %>% +#' dplyr::filter(obs_date <= this_dt) +#' +#' #run_epidemia +#' #passing quosures, which will have an escape built into run_epidemia() +#' reportdata <- run_epidemia(epi_data = epi_data, +#' casefield = quo_casefield, +#' populationfield = quo_popfield, +#' inc_per = inc_per, +#' groupfield = quo_groupfield, +#' week_type = "ISO", +#' report_period = this_report_period, #this +#' ed_summary_period = ed_summary_period, +#' ed_method = ed_method, +#' ed_control = ed_control, +#' env_data = env_data, +#' obsfield = quo_obsfield, +#' valuefield = quo_valuefield, +#' forecast_future = this_forecast_future, #this +#' fc_control = fc_control, +#' env_ref_data = env_ref_data, +#' env_info = env_info, +#' model_cached = model_cached, +#' model_choice = this_model) ##models_to_run +#' +#' +#' +#' #pull needed and reformat +#' fcs_list[[i]] <- reportdata$modeling_results_data %>% +#' #get forecasts only +#' dplyr::filter(series == "fc") %>% +#' #get base date of report ('current date' in relation to forecast) +#' dplyr::mutate(preadj_date = this_dt, +#' #how many weeks ahead is the prediction (not adjusting for reporting lag yet) +#' timestep_ahead_orig = difftime(obs_date, preadj_date) %>% +#' as.numeric(units = "weeks")) %>% +#' #don't need 0 week predictions (same week) +#' dplyr::filter(timestep_ahead_orig > 0) +#' +#' +#' } #end timestep loop +#' +#' #have list of dataframes +#' #collapse/bindrows +#' fcs_only <- dplyr::bind_rows(fcs_list) %>% +#' #nicely arrange +#' dplyr::arrange(!!quo_groupfield, timestep_ahead_orig, obs_date) +#' +#' +#' #join +#' fc_join <- fcs_only %>% +#' dplyr::left_join(obs_only, +#' #NSE fun +#' by = rlang::set_names(c(rlang::quo_name(quo_groupfield), +#' "obs_date"), +#' c(rlang::quo_name(quo_groupfield), +#' "obs_date"))) +#' +#' #make all the reporting_lag adjustments +#' # basically, we ran extra forecast future steps +#' # so we now can simply shift everything backwards except for averageweek +#' if (this_model == "naive-averageweek"){ +#' fc_join <- fc_join %>% +#' dplyr::mutate(run_date = preadj_date, +#' #timestep_ahead is meaningless for average week. +#' # NA may cause unexpected results with grouping, so replace with 0 +#' timestep_ahead = 0, +#' #Add column for showing reporting_lag +#' reporting_lag = reporting_lag) +#' } else { +#' fc_join <- fc_join %>% +#' dplyr::mutate(run_date = preadj_date - lubridate::weeks(reporting_lag), +#' timestep_ahead = timestep_ahead_orig - reporting_lag, +#' #Add column for showing reporting_lag +#' reporting_lag = reporting_lag) %>% +#' #filter out the timesteps that are now less than 1 step +#' dplyr::filter(timestep_ahead > 0) +#' } +#' +#' +#' #Filter to report weeks (trim off edges gathered b/c of weeks_ahead, etc.) +#' fc_trim <- fc_join %>% +#' dplyr::filter(between(obs_date, +#' date_start, +#' date_start + lubridate::weeks(total_timesteps-1))) +#' +#' +#' ## Calculate statistics +#' val_results <- calc_val_stats(fc_trim, quo_groupfield, per_timesteps, dots) +#' +#' #add results to list by name +#' all_validations[[this_model]] <- val_results +#' +#' } #end model loop +#' +#' +#' +#' #Get skill test list of results +#' if (skill_test == TRUE){ +#' #calc skill comparison statistics +#' skill_overall <- calc_skill(get_overall_validations(all_validations)) +#' skill_grouping <- calc_skill(get_group_validations(all_validations), quo_groupfield) +#' skill_scores <- create_named_list(skill_overall, skill_grouping) +#' +#' val_return <- create_named_list(skill_scores, validations = all_validations, metadata) +#' } else { +#' #just the one model validation datasets +#' val_return <- create_named_list(all_validations, metadata) +#' } +#' +#' +#' +#' +#' message("Validation run finished.") +#' val_return +#' +#' } #end run validation +#' +#' +#' +#' #'Calculate validation statistics from forecast results. +#' #' +#' #'Helper function to calculate the validation statistics from each model run. +#' #'Mean Absolute Error (MAE), Root Mean Square Error (RMSE), Proportion of +#' #'observations in in prediction interval, and R^2. Calculates it both at a +#' #'global model level per timestep ahead, and at a geographical grouping level +#' #'per timestep ahead. Also calculates a timeseries of evaluation metrics at +#' #'every per_timesteps number of timesteps per grouping (if applicable) and +#' #'timestep_ahead. +#' #' +#' #'@param fc_trim The forecast results of one model type, combined with observed +#' #' values, trimmed to user requested date range. +#' #'@param quo_groupfield Quosure of the user given geographic grouping field to +#' #' run_validation()/run_epidemia(). +#' #'@param per_timesteps When creating a timeseries of validation results, create +#' #' a moving window with per_timesteps width number of time points. Should be a +#' #' minimum of 10 timesteps. +#' #'@param dots The non-required arguments to run_validation() for developer +#' #' testing. +#' #' +#' #'@return A named list of validation statistic results: validation_overall, +#' #' validation_grouping, validation_timeseries +#' #' +#' calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ +#' # MAE: mean(|obs - pred|) +#' # RMSE: sqrt(mean((obs - pred)^2)) +#' # R2 (R^2): 1 - SSE/TSS. SSE = sum((obs-pred)^2). TSS = sum((obs - mean(obs))^2). +#' # B/c involves mean of group of observations, must be calculated after grouping +#' +#' #Removed +#' # Proportion in Interval: 1/T if inside, summed. Over all non-NA entries. +#' +#' #per line stats +#' fc_stats <- fc_trim %>% +#' dplyr::mutate(diff = obs - value, +#' absdiff = abs(diff), +#' diffsq = diff ^ 2) +#' #,predinterval = ifelse(obs >= lower & obs <= upper, TRUE, FALSE)) +#' +#' +#' #overall timestep_ahead +#' validation_overall <- fc_stats %>% +#' dplyr::group_by(timestep_ahead) %>% +#' #Now calc TSS part of R2 +#' dplyr::mutate(meanobs = mean(obs), +#' total_squares = (obs - meanobs)^2) %>% +#' #stat calc +#' dplyr::summarize(MAE = mean(absdiff, na.rm = TRUE), +#' MSE = mean(diffsq, na.rm = TRUE), +#' #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), +#' SSE = sum(diffsq, na.rm = TRUE), +#' TSS = sum(total_squares, na.rm = TRUE)) %>% +#' #and mutate for final calc +#' dplyr::mutate(RMSE = sqrt(MSE), +#' R2 = 1 - (SSE/TSS)) %>% +#' #drop unneeded columns +#' dplyr::select(-SSE, -TSS, -MSE) +#' +#' +#' +#' #overall timestep_ahead by grouping +#' validation_grouping <- fc_stats %>% +#' dplyr::group_by(!!quo_groupfield, timestep_ahead) %>% +#' #Now calc TSS part of R2 +#' dplyr::mutate(meanobs = mean(obs), +#' total_squares = (obs - meanobs)^2) %>% +#' #stat calc +#' dplyr::summarize(MAE = mean(absdiff, na.rm = TRUE), +#' MSE = mean(diffsq, na.rm = TRUE), +#' #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), +#' SSE = sum(diffsq, na.rm = TRUE), +#' TSS = sum(total_squares, na.rm = TRUE)) %>% +#' #and mutate for final calc +#' dplyr::mutate(RMSE = sqrt(MSE), +#' R2 = 1 - (SSE/TSS)) %>% +#' #drop unneeded columns +#' dplyr::select(-SSE, -TSS, -MSE) +#' +#' +#' +#' #timeseries calculations +#' # minimum of ~10 timesteps per summary +#' # ROLLING window +#' validation_timeseries <- fc_stats %>% +#' dplyr::group_by(!!quo_groupfield, timestep_ahead) %>% +#' #rollapply for get mean of obs +#' dplyr::mutate(meanobs = zoo::rollmeanr(x = obs, +#' k = per_timesteps, +#' fill = NA), +#' total_squares = (obs - meanobs)^2, +#' MAE = zoo::rollmeanr(x = absdiff, +#' k = per_timesteps, +#' fill = NA), +#' MSE = zoo::rollmeanr(x = diffsq, +#' k = per_timesteps, +#' fill = NA), +#' RMSE = sqrt(MSE), +#' #prop_interval = zoo::rollsumr(x = predinterval, +#' # k = per_timesteps, +#' # fill = NA) / +#' # zoo::rollsumr(x = !is.na(predinterval), +#' # k = per_timesteps, +#' # fill = NA), +#' SSE = zoo::rollsumr(x = diffsq, +#' k = per_timesteps, +#' fill = NA), +#' TSS = zoo::rollsumr(x = total_squares, +#' k = per_timesteps, +#' fill = NA), +#' R2 = 1 - (SSE/TSS)) %>% +#' #rename columns to be clearer +#' dplyr::rename(forecast = value, +#' observed = obs) %>% +#' # drop unneeded columns +#' dplyr::select(-series, -preadj_date, -timestep_ahead_orig, -run_date, +#' -diff, -absdiff, -diffsq, -meanobs, -total_squares, -MSE, -SSE, -TSS) %>% +#' # for now, drop R2 until can figure out how to include better +#' dplyr::select(-R2) +#' +#' +#' +#' #return all +#' # and raw data with hidden option +#' #possibly make "time series" version for clean full data table +#' if (!is.null(dots[['raw_data']])){ +#' if (dots[['raw_data']] == TRUE){ +#' val_stats <- create_named_list(validation_overall, validation_grouping, validation_timeseries, raw_stats = fc_stats) +#' } #end raw data TRUE +#' } else { +#' #normal return with just results +#' val_stats <- create_named_list(validation_overall, validation_grouping, validation_timeseries) +#' } +#' } #end calc_val_stats() +#' +#' +#' #' Get overall model validation statistics +#' #' +#' #' Small function to pull out just overall validation statistics. +#' #' +#' #' @param validations The set of validation statistics produced by +#' #' run_validation() - only the list of validation data sets, not including the skill metrics. +#' #' +#' #' @return A list of tibbles containing only the model overall statistics (and +#' #' not including the geographic grouping results, if present). +#' #' +#' #' @export +#' #' +#' get_overall_validations <- function(validations){ +#' lapply(validations, `[[`, "validation_overall") +#' } +#' +#' +#' #' Get geographic grouping model validation statistics +#' #' +#' #' Small function to pull out just the geographic grouping validation statistics. +#' #' +#' #' @param validations The set of validation statistics produced by +#' #' run_validation() - only the list of validation data sets, not including the skill metrics. +#' #' +#' #' @return A list of tibbles containing only the model geographic grouping statistics. +#' #' +#' #' @export +#' #' +#' get_group_validations <- function(validations){ +#' lapply(validations, `[[`, "validation_grouping") +#' } +#' +#' +#' +#' #' Calculate model skill comparison statistics +#' #' +#' #' Helper function to calculate the relative improvement of the forecast over the specified naive model. +#' #' Skill score = (score_fc - score_naive) / (score_perfect - score_naive) +#' #' Skill metric has an upper bound of 1. No improvement is 0. Lower bound depends on statistic. +#' #' +#' #'@param fc_stat The forecast model statistic value. +#' #'@param naive_stat The naive model statistic value (same statistic as forecast model). +#' #'@param perfect_stat The value of a perfect score for that stastistic. +#' #' +#' #'@return Skill score: the relative improvement the forecast model has over the naive model. +#' #' +#' #'@export +#' #' +#' calc_skill_stat <- function(fc_stat, naive_stat, perfect_stat){ +#' skill_stat <- (fc_stat - naive_stat) / (perfect_stat - naive_stat) +#' } +#' +#' +#' #' Calculate the forecast model skill score compared to the naive model predictions. +#' #' +#' #'@param val_list A list of 3 datasets of validation results: the first is the forecast model, the following two are the naive model results, as created by binding the results of calc_val_stats() in run_validation(). +#' #'@param grp Optional inclusion of quo_groupfield when calculating skill scores by groupfield. +#' #' +#' #'@return Single dataset with skill scores of the main forecast model against each of the naive models, per timestep ahead, and optionally, per geographic grouping +#' #' +#' calc_skill <- function(val_list, grp = NULL){ +#' +#' #separate out, rename columns, and join/crossing +#' val_fc <- val_list[[1]] %>% +#' dplyr::rename(fc_MAE = MAE, +#' fc_RMSE = RMSE, +#' #fc_prop_interval = prop_interval, +#' fc_R2 = R2) %>% +#' dplyr::select(group_cols(), timestep_ahead, starts_with("fc_")) +#' +#' val_np <- val_list$`naive-persistence` %>% +#' dplyr::rename(np_MAE = MAE, +#' np_RMSE = RMSE, +#' #np_prop_interval = prop_interval, +#' np_R2 = R2) %>% +#' dplyr::select(group_cols(), timestep_ahead, starts_with("np_")) +#' +#' val_naw <- val_list$`naive-averageweek` %>% +#' rename(naw_MAE = MAE, +#' naw_RMSE = RMSE, +#' #naw_prop_interval = prop_interval, +#' naw_R2 = R2) %>% +#' #no timestep_ahead for average week, all same +#' select(group_cols(), starts_with("naw_")) +#' +#' #appropriate joins +#' if (is.null(grp)){ +#' #join together +#' val_join <- val_fc %>% +#' #join with persistence +#' dplyr::left_join(val_np, +#' by = "timestep_ahead") %>% +#' #join with average week (1 value to all timesteps ahead) +#' tidyr::crossing(val_naw) +#' } else { +#' #else join with groupfield +#' #join together +#' val_join <- val_fc %>% +#' #join with persistence +#' dplyr::left_join(val_np, +#' #NSE fun +#' by = rlang::set_names(c(rlang::quo_name(grp), +#' "timestep_ahead"), +#' c(rlang::quo_name(grp), +#' "timestep_ahead"))) %>% +#' #join with average week (1 value to all timesteps ahead) +#' dplyr::left_join(val_naw, +#' by = rlang::set_names(rlang::quo_name(grp), +#' rlang::quo_name(grp))) +#' } #end joinings +#' +#' #perfect skill metrics +#' perfect_MAE <- 0 +#' perfect_RMSE <- 0 +#' #perfect_prop_interval <- 1 +#' perfect_R2 <- 1 +#' +#' #calc skill metrics of fc model to each of naive models +#' val_skill <- val_join %>% +#' mutate(skill_MAE_persistence = calc_skill_stat(fc_MAE, np_MAE, perfect_MAE), +#' skill_RMSE_persistence = calc_skill_stat(fc_RMSE, np_RMSE, perfect_RMSE), +#' #skill_interval_persistence = calc_skill_stat(fc_prop_interval, np_prop_interval, +#' # perfect_prop_interval), +#' skill_R2_persistence = calc_skill_stat(fc_R2, np_R2, perfect_R2), +#' skill_MAE_averageweek = calc_skill_stat(fc_MAE, naw_MAE, perfect_MAE), +#' skill_RMSE_averageweek = calc_skill_stat(fc_RMSE, naw_RMSE, perfect_RMSE), +#' #skill_interval_averageweek = calc_skill_stat(fc_prop_interval, naw_prop_interval, +#' # perfect_prop_interval), +#' skill_R2_averageweek = calc_skill_stat(fc_R2, naw_R2, perfect_R2)) %>% +#' #select final stats only +#' select(group_cols(), timestep_ahead, starts_with("skill_")) +#' +#' val_skill +#' } +#' +#' +#' +#' #' Save overall model validation statistics +#' #' +#' #' Small function to pull out just overall validation statistics and save to +#' #' csv. +#' #' +#' #' @param validations The set of validation statistics produced by +#' #' run_validation() - only the list of validation data sets, not including the skill metrics. +#' #' @param save_file File name to save results into csv format +#' #' +#' #' @return A csv file containing only the model overall statistics (and not +#' #' including the geographic grouping results, if present). +#' #' +#' #' @export +#' #' +#' save_overall_validations <- function(validations, save_file){ +#' lapply(validations, `[[`, "validation_overall") %>% +#' bind_rows(.id = "model") %>% +#' write_csv(save_file) +#' } +#' +#' +#' #' Save geographic grouping model validation statistics +#' #' +#' #' Small function to pull out validation statistics per geographic grouping and +#' #' save to csv. +#' #' +#' #' @param validations The set of validation statistics produced by +#' #' run_validation() - only the list of validation data sets, not including the skill metrics. +#' #' @param save_file File name to save results into csv format +#' #' +#' #' @return A csv file containing the model validation statistics for the +#' #' geographic grouping results. +#' #' +#' #' @export +#' #' +#' save_geog_validations <- function(validations, save_file){ +#' lapply(validations, `[[`, "validation_grouping") %>% +#' bind_rows(.id = "model") %>% +#' write_csv(save_file) +#' } diff --git a/R/run_epidemia.R b/R/run_epidemia.R index a6d8ced..5c97ec5 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -15,61 +15,35 @@ #' #'@param epi_data Epidemiological data with case numbers per week, with date #' field "obs_date". +#'@param env_data Daily environmental data for the same groupfields and date +#' range as the epidemiological data. It may contain extra data (other +#' districts or date ranges). The data must be in long format (one row for each +#' date and environmental variable combination), and must start at absolutel +#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for +#' forecasting. +#'@param env_ref_data Historical averages by week of year for environmental +#' variables. Used in extended environmental data into the future for long +#' forecast time, to calculate anomalies in early detection period, and to +#' display on timeseries in reports. +#'@param env_info Lookup table for environmental data - reference creation +#' method (e.g. sum or mean), report labels, etc. +#' #'@param casefield The column name of the field that contains disease case #' counts (unquoted field name). #'@param populationfield Column name of the population field to give population #' numbers over time (unquoted field name). Used to calculated incidence. Also #' optionally used in Farrington method for populationOffset. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. Parameter ignored if -#' fc_control$value_type == "cases" ("incidence" is default, if not set). #'@param groupfield The column name of the field for district or geographic area #' unit division names of epidemiological AND environmental data (unquoted #' field name). If there are no groupings (all one area), user should give a #' field that contains the same value throughout. -#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi -#' weeks) that the weeks of the year in epidemiological and environmental -#' reference data use ["ISO" or "CDC"]. (Required: epidemiological observation -#' dates listed are LAST day of week). -#'@param report_period The number of weeks that the entire report will cover. -#' The \code{report_period} minus \code{forecast_future} is the number of weeks -#' of past (known) data that will be included. -#'@param ed_summary_period The number of weeks that will be considered the -#' "early detection period". It will count back from the week of last known -#' epidemiological data. -#'@param ed_method Which method for early detection should be used ("farrington" -#' is only current option, or "none"). -#'@param ed_control All parameters for early detection algorithm, passed through -#' to that subroutine. -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. #'@param obsfield Field name of the environmental data variables (unquoted field #' name). #'@param valuefield Field name of the value of the environmental data variable #' observations (unquoted field name). -#'@param forecast_future Number of futre weeks from the end of the -#' \code{epi_data} to produce forecasts. -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. -#'@param env_ref_data Historical averages by week of year for environmental -#' variables. Used in extended environmental data into the future for long -#' forecast time, to calculate anomalies in early detection period, and to -#' display on timeseries in reports. -#'@param env_info Lookup table for environmental data - reference creation -#' method (e.g. sum or mean), report labels, etc. -#'@param model_run TRUE/FALSE flag for whether to only generate the model -#' regression object plus metadata. This model can be cached and used later on -#' its own, skipping a large portion of the slow calculations for future runs. -#'@param model_obj Deprecated, use model_cached. -#'@param model_cached The output of a previous model_run = TRUE run of -#' run_epidemia() that produces a model (regression object) and metadata. The -#' metadata will be used for input checking and validation. Using a prebuilt -#' model saves on processing time, but will need to be updated periodically. -#'@param model_choice Critical argument to choose the type of model to generate. +#' +#'@param fc_clusters Clusters. <<>> +#'@param fc_model_family Critical argument to choose the type of model to generate. #' The options are versions that the EPIDEMIA team has used for forecasting. #' The first supported options is "poisson-bam" ("p") which is the original #' epidemiar model: a Poisson regression using bam (for large data GAMs), with @@ -82,6 +56,7 @@ #' values in the modeling. The fc_control$anom_env can be overruled by the user #' providing a value, but this is not recommended unless you are doing #' comparisons. +#'@param report_settings Optional report settings. <<>> #' #' #'@return Returns a suite of summary and report data. @@ -141,27 +116,17 @@ run_epidemia <- function(epi_data = NULL, env_data = NULL, env_ref_data = NULL, env_info = NULL, + #fields casefield = NULL, groupfield = NULL, populationfield = NULL, obsfield = NULL, valuefield = NULL, + #required settings fc_clusters = NULL, fc_model_family = NULL, + #optional report_settings = NULL) - - # inc_per = 1000, - # week_type = c("ISO", "CDC"), - # report_period = 26, - # ed_summary_period = 4, - # ed_method = c("none", "farrington"), - # ed_control = NULL, - # forecast_future = 4, - # fc_control = NULL, - # model_run = FALSE, - # model_obj = NULL, #clean up & remove - # model_cached = NULL, - # model_choice = c("poisson-bam", "negbin")) # to replace with model_family? { #Note for model family @@ -386,8 +351,8 @@ run_epidemia <- function(epi_data = NULL, } #<<>> temporary settings until switch fc_model_family to real input (relabeled model_choice atm) - if (is.null(report_settings[["anom_env"]])){ - report_settings[["anom_env"]] <- dplyr::case_when( + if (is.null(report_settings[["env_anomalies"]])){ + report_settings[["env_anomalies"]] <- dplyr::case_when( fc_model_family == "poisson-gam" ~ TRUE, fc_model_family == "negbin" ~ FALSE, fc_model_family == "naive-persistence" ~ FALSE, @@ -424,7 +389,13 @@ run_epidemia <- function(epi_data = NULL, # epi_date_type # if provided, prepare for matching if (!is.null(report_settings[["epi_date_type"]])){ - report_settings[["epi_date_type"]] <- tolower(report_settings[["epi_date_type"]]) + #want to keep ISO and CDC capitalized, but drop 'Week' to 'week' if had been entered that way + first_char <- substr(report_settings[["epi_date_type"]], 1, 1) %>% + tolower() + #remainder of user entry + rest_char <- substr(report_settings[["epi_date_type"]], 2, nchar(report_settings[["epi_date_type"]])) + #paste back together + report_settings[["epi_date_type"]] <- paste0(first_char, rest_char) } else { #if not provided/missing/null message("Note: 'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').") @@ -440,7 +411,12 @@ run_epidemia <- function(epi_data = NULL, #failsafe default "weekISO" }) - #<<>> set internal week type? + # switch epi_date_type to week_type needed for add_datefields() + week_type <- dplyr::case_when( + report_settings[["epi_date_type"]] == "weekISO" ~ "ISO", + report_settings[["epi_date_type"]] == "weekCDC" ~ "CDC", + #default as if mean + TRUE ~ NA_character_) # ed_method @@ -474,17 +450,15 @@ run_epidemia <- function(epi_data = NULL, report_settings[["env_var"]] <- intersect(env_variables, env_info_variables) } - #nthreads -- grab calc from forecast - #set up default parallel processing number of cores to use number + #nthreads + #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) #if user-supplied, use that cap at 2, otherwise create a default number - #used in anomalize_env() and forecast_regression() + #used to decide if run anomalize_env() prior to forecasting if (!is.null(report_settings[["fc_nthreads"]])) { # nthreads above 2 is not actually helpful report_settings[["fc_nthreads"]] <- ifelse(report_settings[["fc_nthreads"]] > 1, 2, 1) } else { - #no ncores value fed in, so test and determine - #ncores <- max(parallel::detectCores(logical=FALSE) - 1, 1) - #cap at 2 for nthread + #no value fed in, so test and determine report_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) } #end else for ncores not given @@ -497,14 +471,14 @@ run_epidemia <- function(epi_data = NULL, report_settings[["fc_modbsplines"]] <- FALSE } if (is.null(report_settings[["fc_formula"]])){ - report_settings[["fc_formula"]]NULL + report_settings[["fc_formula"]] <- NULL } - ## Create report date information - for passing to interval functions, and report output - #REM: 'report_period' is full # of weeks of report. - #'fc_future_period' is how many of those weeks should be in the future. + # Create report date information: for passing to interval functions, and report output + # report_period is full # of weeks of report. + # fc_future_period is how many of those weeks should be in the future. #full report report_dates <- list(full = list(min = max(epi_data$obs_date, na.rm = TRUE) - lubridate::as.difftime((report_settings[["report_period"]] - report_settings[["fc_future_period"]] - 1), @@ -544,7 +518,7 @@ run_epidemia <- function(epi_data = NULL, } else { epi_data <- epi_data %>% #copy over value - dplyr::mutate(cases_epidemiar = !!quo_valuefield) %>% + dplyr::mutate(cases_epidemiar = !!quo_casefield) %>% #force into integer, just in case dplyr::mutate(cases_epidemiar = floor(cases_epidemiar)) %>% #and sort by alphabetical groupfield @@ -575,7 +549,7 @@ run_epidemia <- function(epi_data = NULL, #if reporting in case counts report_settings[["report_value_type"]] == "cases" ~ !!quo_casefield, #if incidence - report_settings[["report_value_type"]] == "incidence" ~ !!quo_casefield / !!quo_popfield * inc_per, + report_settings[["report_value_type"]] == "incidence" ~ !!quo_casefield / !!quo_popfield * report_settings[["report_inc_per"]], #otherwise TRUE ~ NA_real_), #note use of original not interpolated cases @@ -597,23 +571,15 @@ run_epidemia <- function(epi_data = NULL, quo_valuefield, env_ref_data, env_info, + fc_model_family, + fc_clusters, report_settings, #internal/calculated valid_run, groupings, env_variables, - report_dates - - #inc_per, - #fc_control, - #week_type, - #model_run, - #model_cached, - #model_choice - - ) + report_dates) - #<<>> resume editing here after finished with forecasting update #if we are only generating the model, then end here if (model_run){ diff --git a/man/anomalize_env.Rd b/man/anomalize_env.Rd index 2362572..3d18efe 100644 --- a/man/anomalize_env.Rd +++ b/man/anomalize_env.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{anomalize_env} \alias{anomalize_env} \title{Convert environmental data into anomalies.} \usage{ -anomalize_env(env_fc, quo_groupfield, env_variables_used, ncores) +anomalize_env(env_fc, quo_groupfield, nthreads, env_variables_used) } \arguments{ \item{env_fc}{Environmental data formatted for forecasting by env_format_fc().} @@ -12,12 +12,10 @@ anomalize_env(env_fc, quo_groupfield, env_variables_used, ncores) \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} +\item{nthreads}{mx threasds <<>>} + \item{env_variables_used}{List of environmental variables that were used in the modeling.} - -\item{ncores}{The number of physical cores to use in parallel processing, set -in fc_control$ncores, else the max of the number of physical core available -minus 1, or 1 core.} } \value{ Environmental dataset in same format as env_fc but with the residuals diff --git a/man/build_model.Rd b/man/build_model.Rd index c021acb..2b66e75 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -1,50 +1,32 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_main.R \name{build_model} \alias{build_model} \title{Build the appropriate model} \usage{ -build_model(model_choice, n_groupings, quo_groupfield, modb_eq, - bandsums_eq, epi_known, ncores, theta) +build_model(fc_model_family, quo_groupfield, epi_known, nthreads, + n_groupings, modb_eq, bandsums_eq) } \arguments{ -\item{model_choice}{Critical argument to choose the type of model to generate. -The options are versions that the EPIDEMIA team has used for forecasting. -The first supported options is "poisson-bam" ("p") which is the original -epidemiar model: a Poisson regression using bam (for large data GAMs), with -a smoothed cyclical for seasonality. The default for fc_control$anom_env is -TRUE for using the anomalies of environmental variables rather than their -raw values. The second option is "negbin" ("n") which is a negative binomial -regression using glm, with no external seasonality terms - letting the -natural cyclical behavior of the environmental variables fill that role. The -default for fc_control$anom_env is FALSE and uses the actual observation -values in the modeling. The fc_control$anom_env can be overruled by the user -providing a value, but this is not recommended unless you are doing -comparisons.} - -\item{n_groupings}{Count of the number of geographic groupings in the model.} +\item{fc_model_family}{model choice stand in <<>>} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} +\item{epi_known}{Epidemiological dataset with basis spline summaries of the +lagged environmental data (or anomalies), with column marking if "known" +data and groupings converted to factors.} + +\item{nthreads}{thread count <<>>} + +\item{n_groupings}{Count of the number of geographic groupings in the model.} + \item{modb_eq}{Pieces of the regression formula that include the modified basis functions to account for long term trend (with or without groupings, as appropriate).} \item{bandsums_eq}{Pieces of the regression formula that include the b-spline bandsummaries of the environmental factors.} - -\item{epi_known}{Epidemiological dataset with basis spline summaries of the -lagged environmental data (or anomalies), with column marking if "known" -data and groupings converted to factors.} - -\item{ncores}{The number of physical cores to use in parallel processing, set -in fc_control$ncores, else the max of the number of physical core available -minus 1, or 1 core.} - -\item{theta}{From fc_control$theta, the value of theta for a "negbin" model. -If present, will use glm(..., family = MASS::negative.binomial(theta)). If -missing, will use MASS::glm.nb().} } \value{ Regression object diff --git a/man/calc_skill.Rd b/man/calc_skill.Rd deleted file mode 100644 index d5dd518..0000000 --- a/man/calc_skill.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{calc_skill} -\alias{calc_skill} -\title{Calculate the forecast model skill score compared to the naive model predictions.} -\usage{ -calc_skill(val_list, grp = NULL) -} -\arguments{ -\item{val_list}{A list of 3 datasets of validation results: the first is the forecast model, the following two are the naive model results, as created by binding the results of calc_val_stats() in run_validation().} - -\item{grp}{Optional inclusion of quo_groupfield when calculating skill scores by groupfield.} -} -\value{ -Single dataset with skill scores of the main forecast model against each of the naive models, per timestep ahead, and optionally, per geographic grouping -} -\description{ -Calculate the forecast model skill score compared to the naive model predictions. -} diff --git a/man/calc_skill_stat.Rd b/man/calc_skill_stat.Rd deleted file mode 100644 index eeb363b..0000000 --- a/man/calc_skill_stat.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{calc_skill_stat} -\alias{calc_skill_stat} -\title{Calculate model skill comparison statistics} -\usage{ -calc_skill_stat(fc_stat, naive_stat, perfect_stat) -} -\arguments{ -\item{fc_stat}{The forecast model statistic value.} - -\item{naive_stat}{The naive model statistic value (same statistic as forecast model).} - -\item{perfect_stat}{The value of a perfect score for that stastistic.} -} -\value{ -Skill score: the relative improvement the forecast model has over the naive model. -} -\description{ -Helper function to calculate the relative improvement of the forecast over the specified naive model. -Skill score = (score_fc - score_naive) / (score_perfect - score_naive) -Skill metric has an upper bound of 1. No improvement is 0. Lower bound depends on statistic. -} diff --git a/man/calc_val_stats.Rd b/man/calc_val_stats.Rd deleted file mode 100644 index 82d8bcd..0000000 --- a/man/calc_val_stats.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{calc_val_stats} -\alias{calc_val_stats} -\title{Calculate validation statistics from forecast results.} -\usage{ -calc_val_stats(fc_trim, quo_groupfield, per_timesteps, dots) -} -\arguments{ -\item{fc_trim}{The forecast results of one model type, combined with observed -values, trimmed to user requested date range.} - -\item{quo_groupfield}{Quosure of the user given geographic grouping field to -run_validation()/run_epidemia().} - -\item{per_timesteps}{When creating a timeseries of validation results, create -a moving window with per_timesteps width number of time points. Should be a -minimum of 10 timesteps.} - -\item{dots}{The non-required arguments to run_validation() for developer -testing.} -} -\value{ -A named list of validation statistic results: validation_overall, - validation_grouping, validation_timeseries -} -\description{ -Helper function to calculate the validation statistics from each model run. -Mean Absolute Error (MAE), Root Mean Square Error (RMSE), Proportion of -observations in in prediction interval, and R^2. Calculates it both at a -global model level per timestep ahead, and at a geographical grouping level -per timestep ahead. Also calculates a timeseries of evaluation metrics at -every per_timesteps number of timesteps per grouping (if applicable) and -timestep_ahead. -} diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index 72c1780..4cad709 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -1,25 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_main.R \name{create_predictions} \alias{create_predictions} \title{Create the appropriate predictions/forecasts.} \usage{ -create_predictions(model_choice, regress, epi_lag, req_date, ncores) +create_predictions(fc_model_family, nthreads, regress, epi_lag, req_date) } \arguments{ -\item{model_choice}{Critical argument to choose the type of model to generate. -The options are versions that the EPIDEMIA team has used for forecasting. -The first supported options is "poisson-gam" ("p") which is the original -epidemiar model: a Poisson regression using bam (for large data GAMs), with -a smoothed cyclical for seasonality. The default for fc_control$anom_env is -TRUE for using the anomalies of environmental variables rather than their -raw values. The second option is "negbin" ("n") which is a negative binomial -regression using glm, with no external seasonality terms - letting the -natural cyclical behavior of the environmental variables fill that role. The -default for fc_control$anom_env is FALSE and uses the actual observation -values in the modeling. The fc_control$anom_env can be overruled by the user -providing a value, but this is not recommended unless you are doing -comparisons.} +\item{fc_model_family}{model choice <<>>} + +\item{nthreads}{max threads <<>>} \item{regress}{The regression object, either the user-supplied one, or the one just generated.} @@ -30,10 +20,6 @@ lagged environmental data (or anomalies), with groupings as a factor.} \item{req_date}{The end date of requested forecast regression. When fit_freq == "once", this is the last date of the full report, the end date of the forecast period.} - -\item{ncores}{The number of physical cores to use in parallel processing, set -in fc_control$ncores, else the max of the number of physical core available -minus 1, or 1 core.} } \value{ A dataset from predict() using the regression object generated in diff --git a/man/env_format_fc.Rd b/man/env_format_fc.Rd index a023e6e..f3e97da 100644 --- a/man/env_format_fc.Rd +++ b/man/env_format_fc.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{env_format_fc} \alias{env_format_fc} \title{Format env data for modeling} diff --git a/man/environ_report_format.Rd b/man/environ_report_format.Rd index a602dc1..e437e15 100644 --- a/man/environ_report_format.Rd +++ b/man/environ_report_format.Rd @@ -5,7 +5,7 @@ \title{Formats environmental data for report timeseries.} \usage{ environ_report_format(env_ext_data, env_ref_data, quo_groupfield, - quo_obsfield, env_used, env_info, week_type, report_dates) + quo_obsfield, env_used, env_info, epi_date_type, report_dates) } \arguments{ \item{env_ext_data}{An environmental dataset extended into the @@ -29,9 +29,9 @@ the modeling.} \item{env_info}{Lookup table for environmental data - reference creation method (e.g. sum or mean), report labels, etc.} -\item{week_type}{String indicating the standard (WHO ISO-8601 or CDC epi +\item{epi_date_type}{String indicating the standard (WHO ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and environmental -reference data use ["ISO" or "CDC"].} +reference data use ["ISO" or "CDC"]. <<>>} \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, diff --git a/man/epi_format_fc.Rd b/man/epi_format_fc.Rd index 9dfb306..50a7e69 100644 --- a/man/epi_format_fc.Rd +++ b/man/epi_format_fc.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{epi_format_fc} \alias{epi_format_fc} \title{Format epi data for modeling} \usage{ -epi_format_fc(epi_data_extd, quo_groupfield, fc_control) +epi_format_fc(epi_data_extd, quo_groupfield, fc_clusters) } \arguments{ \item{epi_data_extd}{An epidemiological dataset extended into the @@ -13,8 +13,7 @@ future/forecast period with NA values for to-be-forecasted case numbers.} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{fc_control}{Parameters for forecasting, including which environmental -variable to include and any geographic clusters.} +\item{fc_clusters}{<<>>geographic clusters.} } \value{ An epidemiological dataset formatted to pass over to BAM/GAM modeling. diff --git a/man/extend_env_future.Rd b/man/extend_env_future.Rd index ed1d09e..890ef62 100644 --- a/man/extend_env_future.Rd +++ b/man/extend_env_future.Rd @@ -1,12 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{extend_env_future} \alias{extend_env_future} \title{Extend environmental data into the future.} \usage{ -extend_env_future(env_data, quo_groupfield, groupings, quo_obsfield, - quo_valuefield, env_ref_data, env_info, env_variables_used, report_dates, - week_type, model_choice, valid_run) +extend_env_future(env_data, quo_groupfield, quo_obsfield, quo_valuefield, + env_ref_data, env_info, fc_model_family, epi_date_type, valid_run, + groupings, env_variables_used, report_dates) } \arguments{ \item{env_data}{Daily environmental data for the same groupfields and date @@ -19,8 +19,6 @@ forecasting.} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{groupings}{A unique list of the geographic groupings (from groupfield).} - \item{quo_obsfield}{Quosure of user given field name of the environmental data variables} @@ -35,32 +33,20 @@ display on timeseries in reports.} \item{env_info}{Lookup table for environmental data - reference creation method (e.g. sum or mean), report labels, etc.} +\item{fc_model_family}{model choice stand in <<>>} + +\item{epi_date_type}{weekISO/CDC/month <<>>} + +\item{valid_run}{Internal boolean for whether this is part of a validation run.} + +\item{groupings}{A unique list of the geographic groupings (from groupfield).} + \item{env_variables_used}{List of environmental variables that were used in the modeling} \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, forecast period, and early detection period.} - -\item{week_type}{String indicating the standard (WHO ISO-8601 or CDC epi -weeks) that the weeks of the year in epidemiological and environmental -reference data use ["ISO" or "CDC"].} - -\item{model_choice}{Critical argument to choose the type of model to generate. -The options are versions that the EPIDEMIA team has used for forecasting. -The first supported options is "poisson-gam" ("p") which is the original -epidemiar model: a Poisson regression using bam (for large data GAMs), with -a smoothed cyclical for seasonality. The default for fc_control$anom_env is -TRUE for using the anomalies of environmental variables rather than their -raw values. The second option is "negbin" ("n") which is a negative binomial -regression using glm, with no external seasonality terms - letting the -natural cyclical behavior of the environmental variables fill that role. The -default for fc_control$anom_env is FALSE and uses the actual observation -values in the modeling. The fc_control$anom_env can be overruled by the user -providing a value, but this is not recommended unless you are doing -comparisons.} - -\item{valid_run}{Internal boolean for whether this is part of a validation run.} } \value{ Environmental dataset, with data extended into the future forecast diff --git a/man/extend_epi_future.Rd b/man/extend_epi_future.Rd index 3d93e31..e575358 100644 --- a/man/extend_epi_future.Rd +++ b/man/extend_epi_future.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{extend_epi_future} \alias{extend_epi_future} \title{Extend epidemiology dataframe into future.} diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index a3a9e3a..c5d59ab 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -1,12 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_main.R \name{forecast_regression} \alias{forecast_regression} \title{Run forecast regression} \usage{ -forecast_regression(epi_lag, quo_groupfield, groupings, env_variables_used, - report_dates, req_date, ncores, fit_freq, model_run, - model_cached = NULL, model_choice, theta) +forecast_regression(epi_lag, quo_groupfield, fc_model_family, nthreads, + model_run, model_cached = NULL, fit_freq, groupings, + env_variables_used, report_dates, req_date) } \arguments{ \item{epi_lag}{Epidemiological dataset with basis spline summaries of the @@ -15,27 +15,9 @@ lagged environmental data (or anomalies), as output by lag_environ_to_epi().} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{groupings}{A unique list of the geographic groupings (from groupfield).} +\item{fc_model_family}{model choice stand in} -\item{env_variables_used}{List of environmental variables that were used in -the modeling.} - -\item{report_dates}{Internally generated set of report date information: min, -max, list of dates for full report, known epidemiological data period, -forecast period, and early detection period.} - -\item{req_date}{The end date of requested forecast regression. When fit_freq -== "once", this is the last date of the full report, the end date of the -forecast period.} - -\item{ncores}{The number of physical cores to use in parallel processing, set -in fc_control$ncores, else the max of the number of physical core available -minus 1, or 1 core.} - -\item{fit_freq}{String indicating "once" or "weekly" on how often to fit the -model - once for the whole report, or every week of the report. Unless -otherwise needed, the value should be "once", as weekly drastically -increases processing time.} +\item{nthreads}{max threads <<>>} \item{model_run}{TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used later on @@ -46,23 +28,23 @@ run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated periodically.} -\item{model_choice}{Critical argument to choose the type of model to generate. -The options are versions that the EPIDEMIA team has used for forecasting. -The first supported options is "poisson-bam" ("p") which is the original -epidemiar model: a Poisson regression using bam (for large data GAMs), with -a smoothed cyclical for seasonality. The default for fc_control$anom_env is -TRUE for using the anomalies of environmental variables rather than their -raw values. The second option is "negbin" ("n") which is a negative binomial -regression using glm, with no external seasonality terms - letting the -natural cyclical behavior of the environmental variables fill that role. The -default for fc_control$anom_env is FALSE and uses the actual observation -values in the modeling. The fc_control$anom_env can be overruled by the user -providing a value, but this is not recommended unless you are doing -comparisons.} +\item{fit_freq}{String indicating "once" or "weekly" on how often to fit the +model - once for the whole report, or every week of the report. Unless +otherwise needed, the value should be "once", as weekly drastically +increases processing time.} + +\item{groupings}{A unique list of the geographic groupings (from groupfield).} + +\item{env_variables_used}{List of environmental variables that were used in +the modeling.} + +\item{report_dates}{Internally generated set of report date information: min, +max, list of dates for full report, known epidemiological data period, +forecast period, and early detection period.} -\item{theta}{From fc_control$theta, the value of theta for a "negbin" model. -If present, will use glm(..., family = MASS::negative.binomial(theta)). If -missing, will use MASS::glm.nb().} +\item{req_date}{The end date of requested forecast regression. When fit_freq +== "once", this is the last date of the full report, the end date of the +forecast period.} } \value{ Named list containing: diff --git a/man/get_group_validations.Rd b/man/get_group_validations.Rd deleted file mode 100644 index 4e4bf04..0000000 --- a/man/get_group_validations.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{get_group_validations} -\alias{get_group_validations} -\title{Get geographic grouping model validation statistics} -\usage{ -get_group_validations(validations) -} -\arguments{ -\item{validations}{The set of validation statistics produced by -run_validation() - only the list of validation data sets, not including the skill metrics.} -} -\value{ -A list of tibbles containing only the model geographic grouping statistics. -} -\description{ -Small function to pull out just the geographic grouping validation statistics. -} diff --git a/man/get_overall_validations.Rd b/man/get_overall_validations.Rd deleted file mode 100644 index 2ad5403..0000000 --- a/man/get_overall_validations.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{get_overall_validations} -\alias{get_overall_validations} -\title{Get overall model validation statistics} -\usage{ -get_overall_validations(validations) -} -\arguments{ -\item{validations}{The set of validation statistics produced by -run_validation() - only the list of validation data sets, not including the skill metrics.} -} -\value{ -A list of tibbles containing only the model overall statistics (and - not including the geographic grouping results, if present). -} -\description{ -Small function to pull out just overall validation statistics. -} diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index f15ccb1..754e28a 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -1,29 +1,29 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{lag_environ_to_epi} \alias{lag_environ_to_epi} \title{Lag the environmental data.} \usage{ -lag_environ_to_epi(epi_fc, quo_groupfield, groupings, env_fc, - env_variables_used, laglen) +lag_environ_to_epi(epi_fc, env_fc, quo_groupfield, lag_len, groupings, + env_variables_used) } \arguments{ \item{epi_fc}{An epidemiological dataset extended into the future/forecast period with NA values for to-be-forecasted case numbers, as formatted for forecasting by epi_format_fc().} +\item{env_fc}{Environmental data formatted for forecasting by env_format_fc().} + \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{groupings}{A unique list of the geographic groupings (from groupfield).} +\item{lag_len}{The maximum number of days in the past to consider interactions +between the environmental variable anomalies and the disease case counts.} -\item{env_fc}{Environmental data formatted for forecasting by env_format_fc().} +\item{groupings}{A unique list of the geographic groupings (from groupfield).} \item{env_variables_used}{List of environmental variables that were used in the modeling.} - -\item{laglen}{The maximum number of days in the past to consider interactions -between the environmental variable anomalies and the disease case counts.} } \value{ Wide dataset based on epidemiological data dates with five diff --git a/man/make_stss.Rd b/man/make_stss.Rd index 8716929..dbdc6ab 100644 --- a/man/make_stss.Rd +++ b/man/make_stss.Rd @@ -4,17 +4,17 @@ \alias{make_stss} \title{Make the list of sts objects} \usage{ -make_stss(epi_fc_data, quo_popfield, quo_groupfield, groupings) +make_stss(epi_fc_data, quo_groupfield, quo_popfield, groupings) } \arguments{ \item{epi_fc_data}{Internal pass of epidemiological data complete with future forecast values.} -\item{quo_popfield}{Quosure of user-given field containing population values.} - \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} +\item{quo_popfield}{Quosure of user-given field containing population values.} + \item{groupings}{A unique list of the geographic groupings (from groupfield).} } \value{ diff --git a/man/pull_model_envvars.Rd b/man/pull_model_envvars.Rd index e8f3550..e4a04a8 100644 --- a/man/pull_model_envvars.Rd +++ b/man/pull_model_envvars.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{pull_model_envvars} \alias{pull_model_envvars} \title{Pull only model env variables.} \usage{ -pull_model_envvars(env_data, quo_obsfield, fc_control) +pull_model_envvars(env_data, quo_obsfield, env_var) } \arguments{ \item{env_data}{Daily environmental data for the same groupfields and date @@ -17,8 +17,7 @@ forecasting.} \item{quo_obsfield}{Quosure of user given field name of the environmental data variables} -\item{fc_control}{Parameters for forecasting, including which environmental -variable to include and any geographic clusters.} +\item{env_var}{<<>> which environmental variable to include} } \value{ List of environmental variables that were used in the diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index 257e7c1..dbf7b2a 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -4,55 +4,15 @@ \alias{run_epidemia} \title{Run EPIDEMIA forecast models and early detection algorithm.} \usage{ -run_epidemia(epi_data = NULL, casefield = NULL, - populationfield = NULL, inc_per = 1000, groupfield = NULL, - week_type = c("ISO", "CDC"), report_period = 26, - ed_summary_period = 4, ed_method = c("none", "farrington"), - ed_control = NULL, env_data = NULL, obsfield = NULL, - valuefield = NULL, forecast_future = 4, fc_control = NULL, - env_ref_data = NULL, env_info = NULL, model_run = FALSE, - model_obj = NULL, model_cached = NULL, - model_choice = c("poisson-bam", "negbin")) +run_epidemia(epi_data = NULL, env_data = NULL, env_ref_data = NULL, + env_info = NULL, casefield = NULL, groupfield = NULL, + populationfield = NULL, obsfield = NULL, valuefield = NULL, + fc_clusters = NULL, fc_model_family = NULL, report_settings = NULL) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date field "obs_date".} -\item{casefield}{The column name of the field that contains disease case -counts (unquoted field name).} - -\item{populationfield}{Column name of the population field to give population -numbers over time (unquoted field name). Used to calculated incidence. Also -optionally used in Farrington method for populationOffset.} - -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people. Parameter ignored if -fc_control$value_type == "cases" ("incidence" is default, if not set).} - -\item{groupfield}{The column name of the field for district or geographic area -unit division names of epidemiological AND environmental data (unquoted -field name). If there are no groupings (all one area), user should give a -field that contains the same value throughout.} - -\item{week_type}{String indicating the standard (WHO ISO-8601 or CDC epi -weeks) that the weeks of the year in epidemiological and environmental -reference data use ["ISO" or "CDC"]. (Required: epidemiological observation -dates listed are LAST day of week).} - -\item{report_period}{The number of weeks that the entire report will cover. -The \code{report_period} minus \code{forecast_future} is the number of weeks -of past (known) data that will be included.} - -\item{ed_summary_period}{The number of weeks that will be considered the -"early detection period". It will count back from the week of last known -epidemiological data.} - -\item{ed_method}{Which method for early detection should be used ("farrington" -is only current option, or "none").} - -\item{ed_control}{All parameters for early detection algorithm, passed through -to that subroutine.} - \item{env_data}{Daily environmental data for the same groupfields and date range as the epidemiological data. It may contain extra data (other districts or date ranges). The data must be in long format (one row for each @@ -60,18 +20,6 @@ date and environmental variable combination), and must start at absolutel minimum \code{laglen} (in \code{fc_control}) days before epi_data for forecasting.} -\item{obsfield}{Field name of the environmental data variables (unquoted field -name).} - -\item{valuefield}{Field name of the value of the environmental data variable -observations (unquoted field name).} - -\item{forecast_future}{Number of futre weeks from the end of the -\code{epi_data} to produce forecasts.} - -\item{fc_control}{Parameters for forecasting, including which environmental -variable to include and any geographic clusters.} - \item{env_ref_data}{Historical averages by week of year for environmental variables. Used in extended environmental data into the future for long forecast time, to calculate anomalies in early detection period, and to @@ -80,18 +28,27 @@ display on timeseries in reports.} \item{env_info}{Lookup table for environmental data - reference creation method (e.g. sum or mean), report labels, etc.} -\item{model_run}{TRUE/FALSE flag for whether to only generate the model -regression object plus metadata. This model can be cached and used later on -its own, skipping a large portion of the slow calculations for future runs.} +\item{casefield}{The column name of the field that contains disease case +counts (unquoted field name).} -\item{model_obj}{Deprecated, use model_cached.} +\item{groupfield}{The column name of the field for district or geographic area +unit division names of epidemiological AND environmental data (unquoted +field name). If there are no groupings (all one area), user should give a +field that contains the same value throughout.} -\item{model_cached}{The output of a previous model_run = TRUE run of -run_epidemia() that produces a model (regression object) and metadata. The -metadata will be used for input checking and validation. Using a prebuilt -model saves on processing time, but will need to be updated periodically.} +\item{populationfield}{Column name of the population field to give population +numbers over time (unquoted field name). Used to calculated incidence. Also +optionally used in Farrington method for populationOffset.} + +\item{obsfield}{Field name of the environmental data variables (unquoted field +name).} -\item{model_choice}{Critical argument to choose the type of model to generate. +\item{valuefield}{Field name of the value of the environmental data variable +observations (unquoted field name).} + +\item{fc_clusters}{Clusters. <<>>} + +\item{fc_model_family}{Critical argument to choose the type of model to generate. The options are versions that the EPIDEMIA team has used for forecasting. The first supported options is "poisson-bam" ("p") which is the original epidemiar model: a Poisson regression using bam (for large data GAMs), with @@ -104,6 +61,8 @@ default for fc_control$anom_env is FALSE and uses the actual observation values in the modeling. The fc_control$anom_env can be overruled by the user providing a value, but this is not recommended unless you are doing comparisons.} + +\item{report_settings}{Optional report settings. <<>>} } \value{ Returns a suite of summary and report data. diff --git a/man/run_event_detection.Rd b/man/run_event_detection.Rd index 8508b26..c8f4472 100644 --- a/man/run_event_detection.Rd +++ b/man/run_event_detection.Rd @@ -4,22 +4,17 @@ \alias{run_event_detection} \title{Main subfunction for running event detection algorithm.} \usage{ -run_event_detection(epi_fc_data, quo_popfield, inc_per, quo_groupfield, - groupings, ed_method, ed_control, report_dates, vt, mc) +run_event_detection(epi_fc_data, quo_groupfield, quo_popfield, ed_method, + ed_control, val_type, inc_per, groupings, report_dates) } \arguments{ \item{epi_fc_data}{Internal pass of epidemiological data complete with future forecast values.} -\item{quo_popfield}{Quosure of user-given field containing population values.} - -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people.} - \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{groupings}{A unique list of the geographic groupings (from groupfield).} +\item{quo_popfield}{Quosure of user-given field containing population values.} \item{ed_method}{Which method for early detection should be used ("Farrington" is only current option, or "None").} @@ -27,15 +22,17 @@ is only current option, or "None").} \item{ed_control}{All parameters for early detection algorithm, passed through to that subroutine.} +\item{val_type}{From match.arg evaluation of fc_control$value_type, whether to return +epidemiological report values in "incidence" (default) or "cases".} + +\item{inc_per}{Number for what unit of population the incidence should be +reported in, e.g. incidence rate of 3 per 1000 people.} + +\item{groupings}{A unique list of the geographic groupings (from groupfield).} + \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, forecast period, and early detection period.} - -\item{vt}{From match.arg evaluation of fc_control$value_type, whether to return -epidemiological report values in "incidence" (default) or "cases".} - -\item{mc}{From match.arg evaluation of model_choice. Reserved for future overrides on value_type depending on -model choice selection.} } \value{ Returns a list of three generated series: diff --git a/man/run_farrington.Rd b/man/run_farrington.Rd index 973ddde..490dbcd 100644 --- a/man/run_farrington.Rd +++ b/man/run_farrington.Rd @@ -4,35 +4,32 @@ \alias{run_farrington} \title{Run the Farrington early detection algorithm} \usage{ -run_farrington(epi_fc_data, quo_popfield, inc_per, quo_groupfield, - groupings, ed_control, report_dates, vt, mc) +run_farrington(epi_fc_data, quo_groupfield, quo_popfield, ed_control, + val_type, inc_per, groupings, report_dates) } \arguments{ \item{epi_fc_data}{Internal pass of epidemiological data complete with future forecast values.} -\item{quo_popfield}{Quosure of user-given field containing population values.} - -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people.} - \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{groupings}{A unique list of the geographic groupings (from groupfield).} +\item{quo_popfield}{Quosure of user-given field containing population values.} \item{ed_control}{All parameters for early detection algorithm, passed through to that subroutine.} +\item{val_type}{From match.arg evaluation of fc_control$value_type, whether to return +epidemiological report values in "incidence" (default) or "cases".} + +\item{inc_per}{Number for what unit of population the incidence should be +reported in, e.g. incidence rate of 3 per 1000 people.} + +\item{groupings}{A unique list of the geographic groupings (from groupfield).} + \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, forecast period, and early detection period.} - -\item{vt}{From match.arg evaluation of fc_control$value_type, whether to return -epidemiological report values in "incidence" (default) or "cases".} - -\item{mc}{From match.arg evaluation of model_choice. Reserved for future overrides on value_type depending on -model choice selection.} } \value{ Returns a list of three generated series from the Farrington algorithm: diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index af4d215..9bac414 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_main.R \name{run_forecast} \alias{run_forecast} \title{Runs the forecast modeling} \usage{ -run_forecast(epi_data, quo_popfield, inc_per, quo_groupfield, groupings, - env_data, quo_obsfield, quo_valuefield, env_variables, fc_control, - env_ref_data, env_info, report_dates, week_type, model_run, - model_cached = NULL, model_choice, valid_run) +run_forecast(epi_data, quo_popfield, quo_groupfield, env_data, + quo_obsfield, quo_valuefield, env_ref_data, env_info, fc_model_family, + fc_clusters, report_settings, valid_run, groupings, env_variables, + report_dates) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date @@ -15,14 +15,9 @@ field "obs_date".} \item{quo_popfield}{Quosure of user-given field containing population values.} -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people.} - \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{groupings}{A unique list of the geographic groupings (from groupfield).} - \item{env_data}{Daily environmental data for the same groupfields and date range as the epidemiological data. It may contain extra data (other districts or date ranges). The data must be in long format (one row for each @@ -36,12 +31,6 @@ variables} \item{quo_valuefield}{Quosure of user given field name of the value of the environmental data variable observations.} -\item{env_variables}{alphabetical list of all unique environmental variables -present in the original env_data dataset.} - -\item{fc_control}{Parameters for forecasting, including which environmental -variable to include and any geographic clusters.} - \item{env_ref_data}{Historical averages by week of year for environmental variables. Used in extended environmental data into the future for long forecast time, to calculate anomalies in early detection period, and to @@ -50,38 +39,21 @@ display on timeseries in reports.} \item{env_info}{Lookup table for environmental data - reference creation method (e.g. sum or mean), report labels, etc.} -\item{report_dates}{Internally generated set of report date information: min, -max, list of dates for full report, known epidemiological data period, -forecast period, and early detection period.} +\item{fc_model_family}{model choice stand in <<>>} -\item{week_type}{String indicating the standard (WHO ISO-8601 or CDC epi -weeks) that the weeks of the year in epidemiological and environmental -reference data use ["ISO" or "CDC"].} +\item{fc_clusters}{clusters <<>>} -\item{model_run}{TRUE/FALSE flag for whether to only generate the model -regression object plus metadata. This model can be cached and used later on -its own, skipping a large portion of the slow calculations for future runs.} +\item{report_settings}{all the settings <<>>} -\item{model_cached}{The output of a previous model_run = TRUE run of -run_epidemia() that produces a model (regression object) and metadata. The -metadata will be used for input checking and validation. Using a prebuilt -model saves on processing time, but will need to be updated periodically.} +\item{valid_run}{Internal binary for whether this is part of a validation run.} + +\item{groupings}{A unique list of the geographic groupings (from groupfield).} -\item{model_choice}{Critical argument to choose the type of model to generate. -The options are versions that the EPIDEMIA team has used for forecasting. -The first supported options is "poisson-gam" ("p") which is the original -epidemiar model: a Poisson regression using bam (for large data GAMs), with -a smoothed cyclical for seasonality. The default for fc_control$anom_env is -TRUE for using the anomalies of environmental variables rather than their -raw values. The second option is "negbin" ("n") which is a negative binomial -regression using glm, with no external seasonality terms - letting the -natural cyclical behavior of the environmental variables fill that role. The -default for fc_control$anom_env is FALSE and uses the actual observation -values in the modeling. The fc_control$anom_env can be overruled by the user -providing a value, but this is not recommended unless you are doing -comparisons.} +\item{env_variables}{List of environmental variables <<>>} -\item{valid_run}{Internal binary for whether this is part of a validation run.} +\item{report_dates}{Internally generated set of report date information: min, +max, list of dates for full report, known epidemiological data period, +forecast period, and early detection period.} } \value{ Named list containing: diff --git a/man/run_validation.Rd b/man/run_validation.Rd deleted file mode 100644 index adde16a..0000000 --- a/man/run_validation.Rd +++ /dev/null @@ -1,111 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{run_validation} -\alias{run_validation} -\title{Run EPIDEMIA model validation statistics} -\usage{ -run_validation(date_start = NULL, total_timesteps = 26, - timesteps_ahead = 2, reporting_lag = 0, per_timesteps = 12, - skill_test = TRUE, epi_data = NULL, casefield = NULL, - populationfield = NULL, groupfield = NULL, week_type = c("ISO", - "CDC"), report_period = 3, ed_summary_period = 1, - ed_method = "none", env_data = NULL, obsfield = NULL, - valuefield = NULL, forecast_future = 2, fc_control = NULL, - env_ref_data = NULL, env_info = NULL, model_cached = NULL, - model_choice = c("poisson-bam", "negbin"), ...) -} -\arguments{ -\item{date_start}{Date to start testing for model validation.} - -\item{total_timesteps}{Number of weeks from `week_start` to run validation -tests.} - -\item{timesteps_ahead}{Number of weeks for testing the n-week ahead forecasts. -Results will be generated from 1-week ahead through `weeks_ahead` number of -weeks.} - -\item{reporting_lag}{Number of timesteps to simulate reporting lag. For -instance, if you have weekly data, and a reporting_lag of 1 week, and are -working with a timesteps_ahead of 1 week, then that is functional equivalent -to reporting lag of 0, and timesteps_ahead of 2 weeks. I.e. You are -forecasting next week, but you don't know this week's data yet, you only -know last week's numbers.} - -\item{per_timesteps}{When creating a timeseries of validation results, create -a moving window with per_timesteps width number of time points. Should be a -minimum of 10 timesteps.} - -\item{skill_test}{Logical parameter indicating whether or not to run -validations also on two naïve models for a skill test comparison. The naïve -models are "persistence": the last known value (case counts) carried -forward, and "average week" where the predicted value is the average of that -week of the year, as calculated from historical data.} - -\item{epi_data}{See description in `run_epidemia()`.} - -\item{casefield}{See description in `run_epidemia()`.} - -\item{populationfield}{See description in `run_epidemia()`.} - -\item{groupfield}{See description in `run_epidemia()`.} - -\item{week_type}{See description in `run_epidemia()`.} - -\item{report_period}{The number of weeks that the entire report will cover. -The \code{report_period} minus \code{forecast_future} is the number of weeks -of past (known) data that will be included. Overwritten to be `weeks_ahead` -+ 1 for validation runs.} - -\item{ed_summary_period}{Overwritten to 1 for validation runs (no-op for no -event detection during validation runs).} - -\item{ed_method}{Overwritten to "none" for validation runs.} - -\item{env_data}{See description in `run_epidemia()`.} - -\item{obsfield}{See description in `run_epidemia()`.} - -\item{valuefield}{See description in `run_epidemia()`.} - -\item{forecast_future}{Number of future weeks from the end of the -\code{epi_data} to produce forecasts, as in `run_epidemia()`, but -overwritten as `weeks_ahead` for validation runs.} - -\item{fc_control}{See description in `run_epidemia()`. Note, -fc_control$value_type is overwritten as "cases" for validation runs.} - -\item{env_ref_data}{See description in `run_epidemia()`.} - -\item{env_info}{See description in `run_epidemia()`.} - -\item{model_cached}{See description in `run_epidemia()`.} - -\item{model_choice}{See description in `run_epidemia()`.} - -\item{...}{Accepts other arguments that are normally part of `run_epidemia()`, -but ignored for validation runs. For example, `inc_per`, `ed_control`, -`model_run`.} -} -\value{ -Returns a nested list of validation results. Statistics are calculated - on the n-week ahead forecast and the actual observed case counts. Statistics - returned are Mean Absolute Error (MAE), Root Mean Squared Error (RMSE). The - first object is `skill_scores`, which contains `skill_overall` and - `skill_grouping`. The second list is `validations`, which contains lists per - model run (the forecast model and then optionally the naive models). Within - each, `validation_overall` is the results overall, and `validation_grouping` - is the results per geographic grouping. Lastly, a `metadata` list contains - the important parameter settings used to run validation and when the results - where generated. -} -\description{ -This function takes a few more arguments than `epidemiar::run_epidemia()` to -generate statistics on model validation. The function will evaluate a number -of weeks (`total_timesteps`) starting from a specified week (`date_start`) and -will look at the n-week ahead forecast (1 to `timesteps_ahead` number of -weeks) and compare the values to the observed number of cases. An optional -`reporting_lag` argument will censor the last known data back that number of -weeks. The validation statistics include Root Mean Squared Error (RMSE) and -Mean Absolute Error (MAE), and an R-squared staistic both in total and per -geographic grouping (if present). -} diff --git a/man/save_geog_validations.Rd b/man/save_geog_validations.Rd deleted file mode 100644 index 6396f89..0000000 --- a/man/save_geog_validations.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{save_geog_validations} -\alias{save_geog_validations} -\title{Save geographic grouping model validation statistics} -\usage{ -save_geog_validations(validations, save_file) -} -\arguments{ -\item{validations}{The set of validation statistics produced by -run_validation() - only the list of validation data sets, not including the skill metrics.} - -\item{save_file}{File name to save results into csv format} -} -\value{ -A csv file containing the model validation statistics for the - geographic grouping results. -} -\description{ -Small function to pull out validation statistics per geographic grouping and -save to csv. -} diff --git a/man/save_overall_validations.Rd b/man/save_overall_validations.Rd deleted file mode 100644 index b817e54..0000000 --- a/man/save_overall_validations.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/model_validation.R -\name{save_overall_validations} -\alias{save_overall_validations} -\title{Save overall model validation statistics} -\usage{ -save_overall_validations(validations, save_file) -} -\arguments{ -\item{validations}{The set of validation statistics produced by -run_validation() - only the list of validation data sets, not including the skill metrics.} - -\item{save_file}{File name to save results into csv format} -} -\value{ -A csv file containing only the model overall statistics (and not - including the geographic grouping results, if present). -} -\description{ -Small function to pull out just overall validation statistics and save to -csv. -} diff --git a/man/stss_res_to_output_data.Rd b/man/stss_res_to_output_data.Rd index 3b4dc58..73462fa 100644 --- a/man/stss_res_to_output_data.Rd +++ b/man/stss_res_to_output_data.Rd @@ -4,8 +4,8 @@ \alias{stss_res_to_output_data} \title{Formats output data from sts result objects} \usage{ -stss_res_to_output_data(stss_res_list, epi_fc_data, quo_popfield, inc_per, - quo_groupfield, groupings, report_dates, vt, mc) +stss_res_to_output_data(stss_res_list, epi_fc_data, quo_groupfield, + quo_popfield, val_type, inc_per, groupings, report_dates) } \arguments{ \item{stss_res_list}{List of sts output object from Farrington algorithm.} @@ -13,25 +13,22 @@ stss_res_to_output_data(stss_res_list, epi_fc_data, quo_popfield, inc_per, \item{epi_fc_data}{Internal pass of epidemiological data complete with future forecast values.} +\item{quo_groupfield}{Quosure of the user given geographic grouping field to +run_epidemia().} + \item{quo_popfield}{Quosure of user-given field containing population values.} +\item{val_type}{From match.arg evaluation of fc_control$value_type, whether to return +epidemiological report values in "incidence" (default) or "cases".} + \item{inc_per}{Number for what unit of population the incidence should be reported in, e.g. incidence rate of 3 per 1000 people.} -\item{quo_groupfield}{Quosure of the user given geographic grouping field to -run_epidemia().} - \item{groupings}{A unique list of the geographic groupings (from groupfield).} \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, forecast period, and early detection period.} - -\item{vt}{From match.arg evaluation of fc_control$value_type, whether to return -epidemiological report values in "incidence" (default) or "cases".} - -\item{mc}{From match.arg evaluation of model_choice. Reserved for future overrides on value_type depending on -model choice selection.} } \value{ Returns a list of three series from the Farrington sts result output: diff --git a/man/truncpoly.Rd b/man/truncpoly.Rd index 100303c..17e6f9d 100644 --- a/man/truncpoly.Rd +++ b/man/truncpoly.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/forecasting.R +% Please edit documentation in R/forecasting_helpers.R \name{truncpoly} \alias{truncpoly} \title{Truncates poly. Creates a modified b-spline basis.} From c044d4e06510e20dfdd7aeb61abfe600e0fcfac8 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 17 Feb 2020 13:35:31 -0600 Subject: [PATCH 003/132] Resolved all non visible binding notes, plus some report_settings references found by looking at said notes --- NAMESPACE | 2 + R/add_datefields.R | 8 +-- R/cleaners_helpers.R | 6 +- R/data_to_daily.R | 6 +- R/environmental_reference.R | 44 ++++++------- R/event_detection.R | 42 ++++++------ R/forecasting_helpers.R | 128 ++++++++++++++++++------------------ R/forecasting_main.R | 54 +++++++-------- R/formatters_calculators.R | 65 +++++++++--------- R/globals.R | 1 + R/input_checks.R | 2 +- R/run_epidemia.R | 56 ++++++++-------- 12 files changed, 209 insertions(+), 205 deletions(-) create mode 100644 R/globals.R diff --git a/NAMESPACE b/NAMESPACE index 13a5bea..2bf360f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,3 +11,5 @@ export(na_approx) export(run_epidemia) importFrom(magrittr,"%>%") importFrom(rlang,"!!") +importFrom(rlang,":=") +importFrom(rlang,.data) diff --git a/R/add_datefields.R b/R/add_datefields.R index 1ea02fa..0496174 100644 --- a/R/add_datefields.R +++ b/R/add_datefields.R @@ -18,13 +18,13 @@ add_datefields <- function(df, type = "ISO"){ if (week_type == "ISO"){ df <- df %>% #add iso wk/yr - dplyr::mutate(week_epidemiar = lubridate::isoweek(obs_date), - year_epidemiar = lubridate::isoyear(obs_date)) + dplyr::mutate(week_epidemiar = lubridate::isoweek(.data$obs_date), + year_epidemiar = lubridate::isoyear(.data$obs_date)) } else if (week_type == "CDC"){ #add CDC epi wk/yr - dplyr::mutate(week_epidemiar = lubridate::epiweek(obs_date), - year_epidemiar = lubridate::epiyear(obs_date)) + dplyr::mutate(week_epidemiar = lubridate::epiweek(.data$obs_date), + year_epidemiar = lubridate::epiyear(.data$obs_date)) } df diff --git a/R/cleaners_helpers.R b/R/cleaners_helpers.R index be77e9b..4f6e236 100644 --- a/R/cleaners_helpers.R +++ b/R/cleaners_helpers.R @@ -18,7 +18,7 @@ epi_NA_interpolate <- function(epi_data, quo_casefield, quo_groupfield){ epi_data %>% dplyr::group_by(!!quo_groupfield) %>% #confirm date sorting - dplyr::arrange(obs_date) %>% + dplyr::arrange(.data$obs_date) %>% #interpolate dplyr::mutate(cases_epidemiar = epidemiar::na_approx(!!quo_casefield)) %>% #finish by ungrouping @@ -47,10 +47,10 @@ env_NA_interpolate <- function(env_data, quo_obsfield, quo_valuefield, quo_group #two levels of group_by dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% #confirm date sorting - dplyr::arrange(obs_date) %>% + dplyr::arrange(.data$obs_date) %>% #interpolate dplyr::mutate(val_epidemiar = !!quo_valuefield, - val_epidemiar = epidemiar::na_approx(val_epidemiar)) %>% + val_epidemiar = epidemiar::na_approx(.data$val_epidemiar)) %>% #finish by ungrouping dplyr::ungroup() } diff --git a/R/data_to_daily.R b/R/data_to_daily.R index fa382e3..359a106 100644 --- a/R/data_to_daily.R +++ b/R/data_to_daily.R @@ -26,7 +26,7 @@ data_to_daily <- function(data_notdaily, valuefield, interpolate = TRUE){ data_1day <- data_notdaily %>% #should handle all grouping/categories - dplyr::group_by_at(dplyr::vars(-obs_date, -!!quo_valuefield)) %>% + dplyr::group_by_at(dplyr::vars(-.data$obs_date, -!!quo_valuefield)) %>% #all explicit missing data - line for every Date for all groupings (above) tidyr::complete(obs_date = tidyr::full_seq(c(min(data_notdaily$obs_date), max(data_notdaily$obs_date)), 1)) %>% dplyr::ungroup() @@ -34,9 +34,9 @@ data_to_daily <- function(data_notdaily, valuefield, interpolate = TRUE){ if (interpolate){ data_1day <- data_1day %>% #should handle all grouping/categories - dplyr::group_by_at(dplyr::vars(-obs_date, -!!quo_valuefield)) %>% + dplyr::group_by_at(dplyr::vars(-.data$obs_date, -!!quo_valuefield)) %>% #will not extrapolate beyond last known value, that will happen inside run_epidemia() - mutate(!!quo_name(quo_valuefield) := epidemiar::na_approx(!!quo_valuefield)) %>% + dplyr::mutate(!!rlang::quo_name(quo_valuefield) := epidemiar::na_approx(!!quo_valuefield)) %>% #finish by ungrouping dplyr::ungroup() } diff --git a/R/environmental_reference.R b/R/environmental_reference.R index 02dd542..8295287 100644 --- a/R/environmental_reference.R +++ b/R/environmental_reference.R @@ -72,22 +72,22 @@ env_daily_to_ref <- function(daily_env_data, env_weekly <- daily_env_data %>% #get reference/summarizing method from user supplied env_info dplyr::inner_join(env_info %>% - dplyr::select(!!quo_obsfield, reference_method), + dplyr::select(!!quo_obsfield, .data$reference_method), by = rlang::set_names(rlang::quo_name(quo_obsfield), rlang::quo_name(quo_obsfield))) %>% #add week, year fields epidemiar::add_datefields(week_type) %>% #group by grouping, env var, and date week - dplyr::group_by(!!quo_groupfield, !!quo_obsfield, year_epidemiar, week_epidemiar) %>% + dplyr::group_by(!!quo_groupfield, !!quo_obsfield, .data$year_epidemiar, .data$week_epidemiar) %>% #calculate with case_when at row level (fx is not vectorized, so can't be used inside summarize) - dplyr::mutate(val_epidemiar = case_when( - reference_method == "sum" ~ sum(!!quo_valuefield, na.rm = TRUE), - reference_method == "mean" ~ mean(!!quo_valuefield, na.rm = TRUE), + dplyr::mutate(val_epidemiar = dplyr::case_when( + .data$reference_method == "sum" ~ sum(!!quo_valuefield, na.rm = TRUE), + .data$reference_method == "mean" ~ mean(!!quo_valuefield, na.rm = TRUE), #default is mean, but since inner_join with info table should not be invoked TRUE ~ mean(!!quo_valuefield, na.rm = TRUE))) %>% #now summarize #val_epi is the same for the whole grouped set, so just taking the first value - dplyr::summarize(val_epidemiar = first(val_epidemiar)) %>% + dplyr::summarize(val_epidemiar = dplyr::first(.data$val_epidemiar)) %>% #ungroup to end dplyr::ungroup() @@ -95,24 +95,24 @@ env_daily_to_ref <- function(daily_env_data, message("Summarizing weekly values over years") env_ref <- env_weekly %>% #dropping year from grouping list - dplyr::group_by(!!quo_groupfield, !!quo_obsfield, week_epidemiar) %>% + dplyr::group_by(!!quo_groupfield, !!quo_obsfield, .data$week_epidemiar) %>% #summarize over years - dplyr::summarize(ref_value = mean(val_epidemiar, na.rm = TRUE), - ref_sd = sd(val_epidemiar, na.rm = TRUE), - ref_yrcount = n(), - ref_max = max(val_epidemiar, na.rm = TRUE), - ref_uq = quantile(val_epidemiar, probs = 0.75, na.rm = TRUE), - ref_median = median(val_epidemiar, na.rm = TRUE), - ref_lq = quantile(val_epidemiar, probs = 0.25, na.rm = TRUE), - ref_min = min(val_epidemiar, na.rm = TRUE)) %>% + dplyr::summarize(ref_value = mean(.data$val_epidemiar, na.rm = TRUE), + ref_sd = stats::sd(.data$val_epidemiar, na.rm = TRUE), + ref_yrcount = dplyr::n(), + ref_max = max(.data$val_epidemiar, na.rm = TRUE), + ref_uq = stats::quantile(.data$val_epidemiar, probs = 0.75, na.rm = TRUE), + ref_median = stats::median(.data$val_epidemiar, na.rm = TRUE), + ref_lq = stats::quantile(.data$val_epidemiar, probs = 0.25, na.rm = TRUE), + ref_min = min(.data$val_epidemiar, na.rm = TRUE)) %>% #clean up NaN and Inf values (if entire week missing data) - dplyr::mutate(ref_value = ifelse(is.finite(ref_value), ref_value, NA), - ref_sd = ifelse(is.finite(ref_sd), ref_sd, NA), - ref_max = ifelse(is.finite(ref_max), ref_max, NA), - ref_uq = ifelse(is.finite(ref_uq), ref_uq, NA), - ref_median = ifelse(is.finite(ref_median), ref_median, NA), - ref_lq = ifelse(is.finite(ref_lq), ref_lq, NA), - ref_min = ifelse(is.finite(ref_min), ref_min, NA)) %>% + dplyr::mutate(ref_value = ifelse(is.finite(.data$ref_value), .data$ref_value, NA), + ref_sd = ifelse(is.finite(.data$ref_sd), .data$ref_sd, NA), + ref_max = ifelse(is.finite(.data$ref_max), .data$ref_max, NA), + ref_uq = ifelse(is.finite(.data$ref_uq), .data$ref_uq, NA), + ref_median = ifelse(is.finite(.data$ref_median), .data$ref_median, NA), + ref_lq = ifelse(is.finite(.data$ref_lq), .data$ref_lq, NA), + ref_min = ifelse(is.finite(.data$ref_min), .data$ref_min, NA)) %>% #ungroup to end dplyr::ungroup() diff --git a/R/event_detection.R b/R/event_detection.R index 17f87e5..a28a7d1 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -199,7 +199,7 @@ run_farrington <- function(epi_fc_data, wks_diff_grps <- epi_fc_data %>% dplyr::group_by(!!quo_groupfield) %>% dplyr::count() %>% - dplyr::pull(n) %>% + dplyr::pull(.data$n) %>% range() %>% diff() #only run if b > 0. If 0 full years available (or b=0 requested), then "none" @@ -265,11 +265,11 @@ make_stss <- function(epi_fc_data, g <- groupings[i] g_data <- dplyr::filter(epi_fc_data, !!quo_groupfield == g) %>% #confirming sorting by date - dplyr::arrange(obs_date) + dplyr::arrange(.data$obs_date) #Surveillance::sts() expecting a dataframe g_df <- as.data.frame(g_data) #get NA interpolated case field - g_cases <- dplyr::select(g_df, cases_epidemiar) %>% + g_cases <- dplyr::select(g_df, .data$cases_epidemiar) %>% #sts() likes matrices as.matrix() #if population field given, get population @@ -338,14 +338,14 @@ stss_res_to_output_data <- function(stss_res_list, #flatten out of list (now that we have the grouping labels) stss_res_flat <- do.call(rbind, stss_res_grp) %>% #fix group name field with dplyr programming - dplyr::rename(!!quo_name(quo_groupfield) := group_temp) %>% + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) %>% #and convert to character for joining dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) #recover population (for incidence calculations), not present if popoffset was FALSE #<> stss_res_flat <- stss_res_flat %>% dplyr::left_join(epi_fc_data %>% - dplyr::select(!!quo_groupfield, !!quo_popfield, obs_date), + dplyr::select(!!quo_groupfield, !!quo_popfield, .data$obs_date), by = rlang::set_names(c(rlang::quo_name(quo_groupfield), "obs_date"), c(rlang::quo_name(quo_groupfield), @@ -353,30 +353,30 @@ stss_res_to_output_data <- function(stss_res_list, #gather early detection (KNOWN - pre-forecast) event detection alert series ed_alert_res <- stss_res_flat %>% - dplyr::filter(epoch %in% report_dates$known$seq) %>% + dplyr::filter(.data$epoch %in% report_dates$known$seq) %>% dplyr::mutate(series = "ed", - obs_date = epoch, - value = alarm, + obs_date = .data$epoch, + value = .data$alarm, lab = "Early Detection Alert", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #gather early WARNING event detection alert series ew_alert_res <- stss_res_flat %>% - dplyr::filter(epoch %in% report_dates$forecast$seq) %>% + dplyr::filter(.data$epoch %in% report_dates$forecast$seq) %>% dplyr::mutate(series = "ew", - obs_date = epoch, - value = alarm, + obs_date = .data$epoch, + value = .data$alarm, lab = "Early Warning Alert", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #gather event detection threshold series ed_thresh_res <- stss_res_flat %>% dplyr::mutate(series = "thresh", - obs_date = epoch, + obs_date = .data$epoch, value = dplyr::case_when( #if reporting in case counts val_type == "cases" ~ upperbound, @@ -388,7 +388,7 @@ stss_res_to_output_data <- function(stss_res_list, lab = "Alert Threshold", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #combine ed results ed <- rbind(ed_alert_res, ew_alert_res, ed_thresh_res) @@ -418,33 +418,33 @@ run_no_detection <- function(epi_fc_data, #early detection (KNOWN - pre-forecast) event detection alert series ed_alert_res <- epi_fc_data %>% - dplyr::filter(obs_date %in% report_dates$known$seq) %>% + dplyr::filter(.data$obs_date %in% report_dates$known$seq) %>% dplyr::mutate(series = "ed", value = NA_integer_, lab = "Early Detection Alert", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #gather early WARNING event detection alert series ew_alert_res <- epi_fc_data %>% - dplyr::filter(obs_date %in% report_dates$forecast$seq) %>% + dplyr::filter(.data$obs_date %in% report_dates$forecast$seq) %>% dplyr::mutate(series = "ew", value = NA_integer_, lab = "Early Warning Alert", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #gather event detection threshold series ed_thresh_res <- epi_fc_data %>% - dplyr::filter(obs_date %in% report_dates$full$seq) %>% + dplyr::filter(.data$obs_date %in% report_dates$full$seq) %>% dplyr::mutate(series = "thresh", value = NA_real_, lab = "Alert Threshold", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #combine ed results ed <- rbind(ed_alert_res, ew_alert_res, ed_thresh_res) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index f969c05..7636f9d 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -99,7 +99,7 @@ extend_env_future <- function(env_data, #Do not need data past end of forecast period (if exists) env_trim <- env_data %>% - dplyr::filter(obs_date <= report_dates$forecast$max) + dplyr::filter(.data$obs_date <= report_dates$forecast$max) #Calculate the earliest of the latest known data dates # per env var, per geographic grouping @@ -107,9 +107,9 @@ extend_env_future <- function(env_data, #per geographic grouping, per environmental variable dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% #the last known date for each - dplyr::summarize(max_dates = max(obs_date, na.rm = TRUE)) %>% + dplyr::summarize(max_dates = max(.data$obs_date, na.rm = TRUE)) %>% #the earliest of the last known - dplyr::pull(max_dates) %>% min() + dplyr::pull(.data$max_dates) %>% min() #If earliest_end_known is end of forecast period, then no missing data @@ -129,8 +129,8 @@ extend_env_future <- function(env_data, obs_temp = env_variables_used) #and fix names with NSE env_future_complete <- env_future_complete %>% - dplyr::rename(!!rlang::quo_name(quo_groupfield) := group_temp, - !!rlang::quo_name(quo_obsfield) := obs_temp) + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp, + !!rlang::quo_name(quo_obsfield) := .data$obs_temp) #could have ragged env data per variable per grouping #so, antijoin with env_known_fill first to get the actually missing rows @@ -147,7 +147,7 @@ extend_env_future <- function(env_data, #bind with existing data (NAs for everything else) env_future <- dplyr::bind_rows(env_trim, env_future_missing) %>% #mark which are about to be filled in - dplyr::mutate(data_source = ifelse(is.na(val_epidemiar), "Extended", data_source)) + dplyr::mutate(data_source = ifelse(is.na(.data$val_epidemiar), "Extended", .data$data_source)) #Optimizing for speed for validation runs with naive models, skip unneeded @@ -169,20 +169,20 @@ extend_env_future <- function(env_data, x_na_rle <- rle(is.na(x)) run_id = rep(seq_along(x_na_rle$lengths), times = x_na_rle$lengths) run_tot <- rep(x_na_rle$lengths, times = x_na_rle$lengths) - as_tibble(create_named_list(run_id, run_tot)) + dplyr::as_tibble(create_named_list(run_id, run_tot)) } env_na_rle <- env_future %>% dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% #make doubly sure in sorted date order - arrange(obs_date) %>% + dplyr::arrange(.data$obs_date) %>% #since adding multiple columns, use do instead of mutate - do(cbind(., get_rle_na_info(.$val_epidemiar))) %>% + dplyr::do(cbind(., get_rle_na_info(.$val_epidemiar))) %>% #add a groupby with the new run ID - group_by(!!quo_groupfield, !!quo_obsfield, run_id) %>% + dplyr::group_by(!!quo_groupfield, !!quo_obsfield, .data$run_id) %>% #creates an index of where that row is in the run - mutate(id_in_run = seq_along(val_epidemiar)) + dplyr::mutate(id_in_run = seq_along(.data$val_epidemiar)) #find 1st NA, then take mean of previous week, input for that day #first NA now can be found with is.na(val_epidemiar) & id_in_run == 1 @@ -193,19 +193,19 @@ extend_env_future <- function(env_data, #confirm proper grouping dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% #create a 1 day lag variable since need previous 7 days not including current - mutate(val_lag1 = dplyr::lag(val_epidemiar, n = 1), + dplyr::mutate(val_lag1 = dplyr::lag(.data$val_epidemiar, n = 1), #if_else to find the first NA - val_epidemiar = ifelse(is.na(val_epidemiar) & id_in_run == 1, + val_epidemiar = ifelse(is.na(.data$val_epidemiar) & .data$id_in_run == 1, #zoo:rollapply to calculate mean of last 7 days (week) on lagged var - zoo::rollapply(data = val_lag1, + zoo::rollapply(data = .data$val_lag1, width = 7, FUN = mean, align = "right", na.rm = TRUE), #if not first NA, then contine with original val_epidemiar value - val_epidemiar)) %>% + .data$val_epidemiar)) %>% #drop unneeded lag column - select(-val_lag1) + dplyr::select(-.data$val_lag1) ##Prep for blending previous week mean & historical averages for other missing @@ -220,12 +220,12 @@ extend_env_future <- function(env_data, epidemiar::add_datefields(week_type) %>% #get reference/summarizing method from user supplied env_info dplyr::left_join(env_info %>% - dplyr::select(!!quo_obsfield, reference_method), + dplyr::select(!!quo_obsfield, .data$reference_method), by = rlang::set_names(rlang::quo_name(quo_obsfield), rlang::quo_name(quo_obsfield))) %>% #get weekly ref value dplyr::left_join(env_ref_varused %>% - dplyr::select(!!quo_obsfield, !!quo_groupfield, week_epidemiar, ref_value), + dplyr::select(!!quo_obsfield, !!quo_groupfield, .data$week_epidemiar, .data$ref_value), #NSE fun by = rlang::set_names(c(rlang::quo_name(quo_groupfield), rlang::quo_name(quo_obsfield), @@ -237,51 +237,51 @@ extend_env_future <- function(env_data, #calculate NA missing values using carry|blend env_filled <- env_join_ref %>% #order very important for filling next step - dplyr::arrange(!!quo_groupfield, !!quo_obsfield, obs_date) %>% + dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) %>% dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% #propagate last known value down rows - dplyr::mutate(last_known = val_epidemiar) %>% + dplyr::mutate(last_known = .data$val_epidemiar) %>% #fill down, so missing weeks has "last known value" IN row for calculations - tidyr::fill(last_known, .direction = "down") %>% + tidyr::fill(.data$last_known, .direction = "down") %>% #calculate parts (for all, will only use when needed) # with progressive blending based on id_in_run and run_tot - mutate(recent_modifier = (run_tot - id_in_run - 1) / run_tot, - recent_part = recent_modifier * last_known, - historical_modifier = (id_in_run - 1) / run_tot, - #historical is by week, so get pseudo-daily value depending on reference method, - # i.e. how to summarize a week of data - historical_value = dplyr::case_when( - reference_method == "mean" ~ ref_value, - reference_method == "sum" ~ ref_value / 7, - #default as if mean - TRUE ~ ref_value), - historical_part = historical_modifier * historical_value, - #testing - val_orig = val_epidemiar, - #only fill NA values - val_epidemiar = ifelse(is.na(val_epidemiar), - #persist if <15 days, blend if greater - ifelse(run_tot < 15, - last_known, - recent_part + historical_part), - #if notNA, then use existing val_epidemiar value - val_epidemiar)) + dplyr::mutate(recent_modifier = (.data$run_tot - .data$id_in_run - 1) / .data$run_tot, + recent_part = .data$recent_modifier * .data$last_known, + historical_modifier = (.data$id_in_run - 1) / .data$run_tot, + #historical is by week, so get pseudo-daily value depending on reference method, + # i.e. how to summarize a week of data + historical_value = dplyr::case_when( + .data$reference_method == "mean" ~ .data$ref_value, + .data$reference_method == "sum" ~ .data$ref_value / 7, + #default as if mean + TRUE ~ .data$ref_value), + historical_part = .data$historical_modifier * .data$historical_value, + #testing + val_orig = .data$val_epidemiar, + #only fill NA values + val_epidemiar = ifelse(is.na(.data$val_epidemiar), + #persist if <15 days, blend if greater + ifelse(.data$run_tot < 15, + .data$last_known, + .data$recent_part + .data$historical_part), + #if notNA, then use existing val_epidemiar value + .data$val_epidemiar)) #clean up env_extended_final <- env_filled %>% #remove all added columns to match original format - select(-c(run_id, run_tot, id_in_run, - week_epidemiar, year_epidemiar, - last_known, - reference_method, ref_value, - recent_modifier, recent_part, - historical_modifier, historical_value, historical_part, - val_orig)) %>% + dplyr::select(-c(.data$run_id, .data$run_tot, .data$id_in_run, + .data$week_epidemiar, .data$year_epidemiar, + .data$last_known, + .data$reference_method, .data$ref_value, + .data$recent_modifier, .data$recent_part, + .data$historical_modifier, .data$historical_value, .data$historical_part, + .data$val_orig)) %>% #fill everything except original value field #for any other column that got vanished during crossing, etc. tidyr::fill(dplyr::everything(), -!!quo_valuefield, -!!quo_groupfield, -!!quo_obsfield, .direction = "down") %>% #ungroup to end - ungroup() + dplyr::ungroup() } #end else, meaning some missing data @@ -324,11 +324,11 @@ extend_epi_future <- function(epi_data, group_temp = groupings) #and fix names with NSE epi_future <- epi_future %>% - dplyr::rename(!!quo_name(quo_groupfield) := group_temp) + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) #bind with exisiting data (NAs for everything else in epi_future) extended_epi <- dplyr::bind_rows(epi_data, epi_future) %>% - dplyr::arrange(!!quo_groupfield, obs_date) + dplyr::arrange(!!quo_groupfield, .data$obs_date) #fill population down extended_epi <- tidyr::fill(extended_epi, !!quo_popfield, .direction = "down") @@ -355,9 +355,9 @@ env_format_fc <- function(env_data_extd, #turns long format into wide format - one entry per day per group #1: groupfield, 2: Date, 3: numericdate, 4+: env var (column name is env name) env_spread <- env_data_extd %>% - dplyr::mutate(numericdate = as.numeric(obs_date)) %>% - dplyr::select(!!quo_groupfield, !!quo_obsfield, obs_date, numericdate, val_epidemiar) %>% - tidyr::spread(key = !!quo_obsfield, value = val_epidemiar) + dplyr::mutate(numericdate = as.numeric(.data$obs_date)) %>% + dplyr::select(!!quo_groupfield, !!quo_obsfield, .data$obs_date, .data$numericdate, .data$val_epidemiar) %>% + tidyr::spread(key = !!quo_obsfield, value = .data$val_epidemiar) env_spread } @@ -384,9 +384,9 @@ epi_format_fc <- function(epi_data_extd, by = rlang::set_names(rlang::quo_name(quo_groupfield), rlang::quo_name(quo_groupfield))) %>% #set cluster id as factor, must be for regression later - dplyr::mutate(cluster_id = as.factor(cluster_id), + dplyr::mutate(cluster_id = as.factor(.data$cluster_id), #need numeric date for regression - numericdate = as.numeric(obs_date)) + numericdate = as.numeric(.data$obs_date)) epi_format } @@ -425,8 +425,8 @@ anomalize_env <- function(env_fc, # doy = format(obs_date, "%j")) %>% as.numeric() # needed data for gam - group_factor <- env_fc %>% pull(!!quo_groupfield) %>% factor() - doy <- env_fc %>% pull(obs_date) %>% format("%j") %>% as.numeric() + group_factor <- env_fc %>% dplyr::pull(!!quo_groupfield) %>% factor() + doy <- env_fc %>% dplyr::pull(.data$obs_date) %>% format("%j") %>% as.numeric() env_fc <- as.data.frame(env_fc) @@ -492,11 +492,11 @@ lag_environ_to_epi <- function(epi_fc, # #same order from originally written expand.grid # arrange(lag, Date, group_temp) %>% #add lagging date - dplyr::mutate(laggeddate = obs_date - as.difftime(lag, units = "days")) + dplyr::mutate(laggeddate = .data$obs_date - as.difftime(.data$lag, units = "days")) #and fix names with NSE datalagger <- datalagger %>% - dplyr::rename(!!quo_name(quo_groupfield) := group_temp) + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) #add env data datalagger <- dplyr::left_join(datalagger, env_fc, @@ -510,8 +510,8 @@ lag_environ_to_epi <- function(epi_fc, valuevar <- colnames(env_fc)[curcol] #wide data for all lags of that env var meandat <- datalagger %>% - dplyr::select(!!quo_groupfield, obs_date, lag, valuevar) %>% - tidyr::spread(key = lag, value = valuevar) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$lag, .data$valuevar) %>% + tidyr::spread(key = .data$lag, value = .data$valuevar) #rename lag columns (but not groupfield or Date) names(meandat)[-(1:2)] <- paste0(valuevar, "_", names(meandat)[-(1:2)]) @@ -535,7 +535,7 @@ lag_environ_to_epi <- function(epi_fc, # set up distributed lag basis functions (creates 7 basis functions) alpha <- 1/4 distlagfunc <- splines::bs(x=seq(from=1, to=lag_len, by=1), intercept=TRUE, - knots=quantile(seq(from=1, to=lag_len, by=1), + knots=stats::quantile(seq(from=1, to=lag_len, by=1), probs=seq(from=alpha, to=1-alpha, by=alpha), na.rm=TRUE)) dlagdeg <- ncol(distlagfunc) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 2485a36..2ab6244 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -80,7 +80,7 @@ run_forecast <- function(epi_data, # extract start & end dates for each variable for log file env_dt_ranges <- dplyr::group_by(env_data, !!quo_obsfield) %>% - dplyr::summarize(start_dt = min(obs_date), end_dt = max(obs_date)) + dplyr::summarize(start_dt = min(.data$obs_date), end_dt = max(.data$obs_date)) # extend data into future, for future forecast portion env_data_extd <- extend_env_future(env_data, @@ -91,7 +91,7 @@ run_forecast <- function(epi_data, env_info, fc_model_family, #pull from report_settings - epi_date_type, + epi_date_type = report_settings[["epi_date_type"]], #calculated/internal valid_run, groupings, @@ -176,7 +176,7 @@ run_forecast <- function(epi_data, quo_groupfield, fc_model_family, nthreads = report_settings[["fc_nthreads"]], - model_run, + model_run = report_settings[["model_run"]], model_cached = report_settings[["model_cached"]], fit_freq = report_settings[["fc_fit_freq"]], #internal calculated @@ -199,7 +199,7 @@ run_forecast <- function(epi_data, quo_groupfield, fc_model_family, nthreads = report_settings[["fc_nthreads"]], - model_run, + model_run = report_settings[["model_run"]], model_cached = report_settings[["model_cached"]], fit_freq = report_settings[["fc_fit_freq"]], #internal calculated @@ -220,9 +220,9 @@ run_forecast <- function(epi_data, # Interval calculation preds_catch <- preds_catch %>% - dplyr::mutate(fc_cases = fit, - fc_cases_upr = fit+1.96*sqrt(fit), - fc_cases_lwr = fit-1.96*sqrt(fit)) + dplyr::mutate(fc_cases = .data$fit, + fc_cases_upr = .data$fit+1.96*sqrt(.data$fit), + fc_cases_lwr = .data$fit-1.96*sqrt(.data$fit)) # extract fc series into report format fc_res <- preds_catch %>% @@ -253,7 +253,7 @@ run_forecast <- function(epi_data, #upper = fc_cases_upr / !!quo_popfield * inc_per, #lower = fc_cases_lwr / !!quo_popfield * inc_per ) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) # return list with res and other needed items fc_res_full <- create_named_list(fc_epi = preds_catch, @@ -326,19 +326,19 @@ forecast_regression <- function(epi_lag, #mark known or not epi_lag <- epi_lag %>% - dplyr::mutate(known = ifelse(obs_date <= last_known_date, 1, 0)) + dplyr::mutate(known = ifelse(.data$obs_date <= last_known_date, 1, 0)) # ensure that quo_name(quo_groupfield) is a factor - gam/bam will fail if given a character, # which is unusual among regression functions, which typically just coerce into factors. epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::quo_name(quo_groupfield) := factor(!!quo_groupfield)) #number of geographic area groupings - n_groupings <- epi_lag %>% pull(!!quo_groupfield) %>% nlevels() + n_groupings <- epi_lag %>% dplyr::pull(!!quo_groupfield) %>% nlevels() #number of clusters n_clusters <- nlevels(epi_lag$cluster_id) # create a doy field so that we can use a cyclical spline - epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(obs_date, "%j"))) + epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(.data$obs_date, "%j"))) # create modified bspline basis in epi_lag file to model longterm trends epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, @@ -372,7 +372,7 @@ forecast_regression <- function(epi_lag, } #filter to known - epi_known <- epi_lag %>% dplyr::filter(known == 1) + epi_known <- epi_lag %>% dplyr::filter(.data$known == 1) # Model building switching point @@ -421,7 +421,7 @@ forecast_regression <- function(epi_lag, #now cbind to get ready to return epi_preds <- cbind(epi_lag_trim %>% - filter(obs_date <= req_date), + dplyr::filter(.data$obs_date <= req_date), as.data.frame(preds)) %>% #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) @@ -429,12 +429,12 @@ forecast_regression <- function(epi_lag, if (fit_freq == "once"){ #for single model fit, this has all the data we need, just trim to report dates date_preds <- epi_preds %>% - filter(obs_date >= report_dates$full$min) + dplyr::filter(.data$obs_date >= report_dates$full$min) } else if (fit_freq == "week"){ #prediction of interest are last ones (equiv to req_date) per groupfield date_preds <- epi_preds %>% dplyr::group_by(!!quo_groupfield) %>% - dplyr::filter(obs_date == req_date) + dplyr::filter(.data$obs_date == req_date) } forecast_reg_results <- create_named_list(date_preds, @@ -497,7 +497,7 @@ build_model <- function(fc_model_family, # run bam # Using discrete = TRUE was much faster than using parallel with bam. regress <- mgcv::bam(reg_eq, data = epi_known, - family = poisson(), + family = stats::poisson(), control = mgcv::gam.control(trace=FALSE), discrete = TRUE, nthreads = nthreads) @@ -555,14 +555,14 @@ build_model <- function(fc_model_family, dplyr::group_by(!!quo_groupfield) %>% #prediction is 1 lag (previous week) #fit is name of value from regression models - dplyr::mutate(fit = dplyr::lag(cases_epidemiar, n = 1)) %>% + dplyr::mutate(fit = dplyr::lag(.data$cases_epidemiar, n = 1)) %>% #cleaning up as not needed, and for bug hunting dplyr::select(-dplyr::starts_with("band")) %>% dplyr::select(-dplyr::starts_with("modbs")) - } else if (model_choice == "naive-averageweek"){ + } else if (fc_model_family == "naive-averageweek"){ #naive model #average of week of year (from historical data) @@ -571,8 +571,8 @@ build_model <- function(fc_model_family, #create "model" (averages) using known data. regress <- epi_known %>% #calculate averages per geographic group per week of year - dplyr::group_by(!!quo_groupfield, week_epidemiar) %>% - dplyr::summarize(fit = mean(cases_epidemiar, na.rm = TRUE)) + dplyr::group_by(!!quo_groupfield, .data$week_epidemiar) %>% + dplyr::summarize(fit = mean(.data$cases_epidemiar, na.rm = TRUE)) } else { @@ -616,7 +616,7 @@ create_predictions <- function(fc_model_family, #output prediction (through req_date) preds <- mgcv::predict.bam(regress, - newdata = epi_lag %>% dplyr::filter(obs_date <= req_date), + newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), se.fit = TRUE, # included for backwards compatibility type="response", discrete = TRUE, @@ -634,7 +634,7 @@ create_predictions <- function(fc_model_family, #output prediction (through req_date) preds <- stats::predict.glm(regress, - newdata = epi_lag %>% dplyr::filter(obs_date <= req_date), + newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), se.fit = TRUE, # included for backwards compatibility type="response") @@ -657,14 +657,14 @@ create_predictions <- function(fc_model_family, #epi_lag has the newer rows preds <- epi_lag %>% #filter to requested date - dplyr::filter(obs_date <= req_date) %>% + dplyr::filter(.data$obs_date <= req_date) %>% #join to get "fit" values from "model" #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% #important at end/fc section, when we fill down - tidyr::fill(fit, .direction = "down") %>% + tidyr::fill(.data$fit, .direction = "down") %>% #format into nominal regression predict output - dplyr::select(fit) %>% + dplyr::select(.data$fit) %>% as.data.frame() } else if (fc_model_family == "naive-averageweek"){ @@ -679,7 +679,7 @@ create_predictions <- function(fc_model_family, epi_lag <- epi_lag %>% #filter to requested date - dplyr::filter(obs_date <= req_date) + dplyr::filter(.data$obs_date <= req_date) #join back preds <- epi_lag %>% @@ -688,7 +688,7 @@ create_predictions <- function(fc_model_family, # and so don't need column names not passed into this function dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% #format into nominal regression output - dplyr::select(fit) %>% + dplyr::select(.data$fit) %>% as.data.frame() diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index 2421463..a56c76c 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -57,37 +57,37 @@ environ_report_format <- function(env_ext_data, env_data_varused_sum <- env_data_varused %>% #get reference/summarizing method from user supplied env_info dplyr::left_join(env_info %>% - dplyr::select(!!quo_obsfield, reference_method), + dplyr::select(!!quo_obsfield, .data$reference_method), by = rlang::set_names(rlang::quo_name(quo_obsfield), rlang::quo_name(quo_obsfield))) %>% #add date fields epidemiar::add_datefields(week_type) %>% #trim dates to reduce processing (dates are rough, technically just need week prior to start. 8 is not magical) - dplyr::filter(obs_date >= report_dates$full$min - 8 & obs_date <= report_dates$full$max + 8) %>% + dplyr::filter(.data$obs_date >= report_dates$full$min - 8 & .data$obs_date <= report_dates$full$max + 8) %>% #group by grouping, env var, and date week - dplyr::group_by(!!quo_groupfield, !!quo_obsfield, year_epidemiar, week_epidemiar) %>% + dplyr::group_by(!!quo_groupfield, !!quo_obsfield, .data$year_epidemiar, .data$week_epidemiar) %>% #calculate with case_when at row level (fx is not vectorized, so can't be used inside summarize) - dplyr::mutate(val_epidemiar = case_when( - reference_method == "sum" ~ sum(val_epidemiar, na.rm = TRUE), - reference_method == "mean" ~ mean(val_epidemiar, na.rm = TRUE), + dplyr::mutate(val_epidemiar = dplyr::case_when( + .data$reference_method == "sum" ~ sum(.data$val_epidemiar, na.rm = TRUE), + .data$reference_method == "mean" ~ mean(.data$val_epidemiar, na.rm = TRUE), #default is mean - TRUE ~ mean(val_epidemiar, na.rm = TRUE))) %>% + TRUE ~ mean(.data$val_epidemiar, na.rm = TRUE))) %>% #now summarize #max Date of that week is how the weekly dates are set up - dplyr::summarize(obs_date = max(obs_date), + dplyr::summarize(obs_date = max(.data$obs_date), #val_epi is the same for the whole grouped set, so just taking the first value - val_epidemiar = first(val_epidemiar), + val_epidemiar = dplyr::first(.data$val_epidemiar), #will be same throughout week - reference_method = first(reference_method), + reference_method = dplyr::first(.data$reference_method), #observed/interpolated/extended -- Mode, whatever source was most often that week. - data_source = Mode(data_source, na.rm = TRUE)) %>% + data_source = Mode(.data$data_source, na.rm = TRUE)) %>% #ungroup to end dplyr::ungroup() #filter exact dates environ_timeseries <- env_data_varused_sum %>% - dplyr::filter(obs_date >= report_dates$full$min & obs_date <= report_dates$full$max) %>% - dplyr::arrange(!!quo_groupfield, obs_date, !!quo_obsfield) + dplyr::filter(.data$obs_date >= report_dates$full$min & .data$obs_date <= report_dates$full$max) %>% + dplyr::arrange(!!quo_groupfield, .data$obs_date, !!quo_obsfield) # add climatology data # climatology is based on week number @@ -95,8 +95,9 @@ environ_report_format <- function(env_ext_data, environ_timeseries <- environ_timeseries %>% #join dplyr::left_join(env_ref_varused %>% - dplyr::select(!!quo_obsfield, !!quo_groupfield, week_epidemiar, - ref_value, starts_with("ref_")), + dplyr::select(!!quo_obsfield, !!quo_groupfield, + .data$week_epidemiar, + .data$ref_value, dplyr::starts_with("ref_")), #NSE fun by = rlang::set_names(c(rlang::quo_name(quo_groupfield), rlang::quo_name(quo_obsfield), @@ -130,43 +131,43 @@ create_summary_data <- function(ed_res, #Early Detection ed_summary <- ed_res %>% #get the alert series - dplyr::filter(series == "ed") %>% + dplyr::filter(.data$series == "ed") %>% #filter to early detection period - dplyr::filter(obs_date %in% report_dates$ed_sum$seq) %>% + dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% #group (because need to look at period per group level) dplyr::group_by(!!quo_groupfield) %>% #summarize to 1 obs per grouping - dplyr::summarize(ed_alert_count = if_else(all(is.na(value)), NA_real_, sum(value, na.rm = TRUE))) %>% + dplyr::summarize(ed_alert_count = dplyr::if_else(all(is.na(.data$value)), NA_real_, sum(.data$value, na.rm = TRUE))) %>% # create 3 levels (0, 1, 2 = >1) - dplyr::mutate(warning_level = if_else(ed_alert_count > 1, 2, ed_alert_count), + dplyr::mutate(warning_level = dplyr::if_else(.data$ed_alert_count > 1, 2, .data$ed_alert_count), #factor to label - ed_sum_level = factor(warning_level, levels = 0:2, + ed_sum_level = factor(.data$warning_level, levels = 0:2, labels = alert_level, ordered = TRUE)) %>% #ungroup dplyr::ungroup() %>% #select minimal cols - dplyr::select(!!quo_groupfield, ed_alert_count, ed_sum_level) + dplyr::select(!!quo_groupfield, .data$ed_alert_count, .data$ed_sum_level) #Early Warning: ED results on forecast ew_summary <- ed_res %>% #get the alert series - dplyr::filter(series == "ew", + dplyr::filter(.data$series == "ew", #get the forecast results ##not needed anymore b/c of new ew series, but just for completeness - obs_date %in% report_dates$forecast$seq) %>% + .data$obs_date %in% report_dates$forecast$seq) %>% #group dplyr::group_by(!!quo_groupfield) %>% #summarize to 1 obs per grouping - dplyr::summarize(ew_alert_count = if_else(all(is.na(value)), NA_real_, sum(value, na.rm = TRUE))) %>% + dplyr::summarize(ew_alert_count = dplyr::if_else(all(is.na(.data$value)), NA_real_, sum(.data$value, na.rm = TRUE))) %>% # create 3 levels (0, 1, 2 = >1) - dplyr::mutate(warning_level = if_else(ew_alert_count > 1, 2, ew_alert_count), + dplyr::mutate(warning_level = dplyr::if_else(.data$ew_alert_count > 1, 2, .data$ew_alert_count), #factor to label - ew_level = factor(warning_level, levels = 0:2, + ew_level = factor(.data$warning_level, levels = 0:2, labels = alert_level, ordered = TRUE)) %>% #ungroup dplyr::ungroup() %>% #select minimal cols - dplyr::select(!!quo_groupfield, ew_alert_count, ew_level) + dplyr::select(!!quo_groupfield, .data$ew_alert_count, .data$ew_level) #join results summary_data <- dplyr::inner_join(ed_summary, ew_summary, @@ -197,11 +198,11 @@ create_epi_summary <- function(obs_res, epi <- obs_res %>% #epi data is weekly, get the data for the early detection summary period - dplyr::filter(obs_date %in% report_dates$ed_sum$seq) %>% + dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% #group by groupings dplyr::group_by(!!quo_groupfield) %>% #get mean incidence - dplyr::summarize(mean_inc = mean(value, na.rm = TRUE)) + dplyr::summarize(mean_inc = mean(.data$value, na.rm = TRUE)) } @@ -231,12 +232,12 @@ calc_env_anomalies <- function(env_ts, # anomalies anom_env <- env_ts %>% # only mapping those in the early detection period - dplyr::filter(obs_date %in% report_dates$ed_sum$seq) %>% + dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% # anomaly value is observed value minus the ref value from env_ref - dplyr::mutate(anom = val_epidemiar - ref_value) %>% + dplyr::mutate(anom = .data$val_epidemiar - .data$ref_value) %>% # summarized over ED period - dplyr::summarize(anom_ed_mean = mean(anom, na.rm = TRUE)) %>% + dplyr::summarize(anom_ed_mean = mean(.data$anom, na.rm = TRUE)) %>% dplyr::ungroup() } diff --git a/R/globals.R b/R/globals.R new file mode 100644 index 0000000..ea96b2b --- /dev/null +++ b/R/globals.R @@ -0,0 +1 @@ +utils::globalVariables(".") diff --git a/R/input_checks.R b/R/input_checks.R index cd5410a..baa43b6 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -394,7 +394,7 @@ input_check <- function(epi_data, #subset to env variables as dictated by the model env_model_data <- pull_model_envvars(env_data, quo_obsfield, fc_control) #get earliest dates available - env_start_dts <- env_model_data %>% dplyr::group_by(!!quo_obsfield) %>% summarize(start_dt = min(obs_date)) + env_start_dts <- env_model_data %>% dplyr::group_by(!!quo_obsfield) %>% dplyr::summarize(start_dt = min(.data$obs_date)) #date needed by laglength and first epidemiological data date need_dt <- min(epi_data$obs_date) - as.difftime(fc_control$lag_length, units = "days") #all env dates equal or before needed date? diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 5c97ec5..7336583 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -109,6 +109,8 @@ #' #'@importFrom magrittr %>% #'@importFrom rlang !! +#'@importFrom rlang := +#'@importFrom rlang .data ## Main Modeling (Early Detection, Forecasting) Function @@ -499,7 +501,7 @@ run_epidemia <- function(epi_data = NULL, report_dates$forecast$seq <- report_dates$forecast %>% {seq.Date(.$min, .$max, "week")} #early detection summary period (ED runs over full report, this is for summary in defined ED period) report_dates$ed_sum <- list(min = report_dates$known$max - - lubridate::as.difftime(ed_summary_period - 1, units = "weeks"), + lubridate::as.difftime(report_settings[["ed_summary_period"]] - 1, units = "weeks"), max = report_dates$known$max) report_dates$ed_sum$seq <- report_dates$ed_sum %>% {seq.Date(.$min, .$max, "week")} @@ -512,17 +514,17 @@ run_epidemia <- function(epi_data = NULL, #Note: cases_epidemiar is field name returned (epi) epi_data <- epi_NA_interpolate(epi_data, quo_casefield, quo_groupfield) %>% #force into integer after interpolating (would cause problems with modeling otherwise) - dplyr::mutate(cases_epidemiar = floor(cases_epidemiar)) %>% + dplyr::mutate(cases_epidemiar = floor(.data$cases_epidemiar)) %>% #and sort by alphabetical groupfield - dplyr::arrange(!!quo_groupfield, obs_date) + dplyr::arrange(!!quo_groupfield, .data$obs_date) } else { epi_data <- epi_data %>% #copy over value dplyr::mutate(cases_epidemiar = !!quo_casefield) %>% #force into integer, just in case - dplyr::mutate(cases_epidemiar = floor(cases_epidemiar)) %>% + dplyr::mutate(cases_epidemiar = floor(.data$cases_epidemiar)) %>% #and sort by alphabetical groupfield - dplyr::arrange(!!quo_groupfield, obs_date) + dplyr::arrange(!!quo_groupfield, .data$obs_date) } #Note: val_epidemiar is field name returned (env) @@ -532,9 +534,9 @@ run_epidemia <- function(epi_data = NULL, #first, mark which ones during known time range were observed versus (will be) interpolated dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% #copy over value - mutate(val_epidemiar = !!quo_valuefield) %>% + dplyr::mutate(val_epidemiar = !!quo_valuefield) %>% #and sort by alphabetical groupfield - dplyr::arrange(!!quo_groupfield, !!quo_obsfield, obs_date) + dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) @@ -543,7 +545,7 @@ run_epidemia <- function(epi_data = NULL, #create observed data series obs_res <- epi_data %>% #include only observed data from requested start of report - dplyr::filter(obs_date >= report_dates$full$min) %>% + dplyr::filter(.data$obs_date >= report_dates$full$min) %>% dplyr::mutate(series = "obs", value = dplyr::case_when( #if reporting in case counts @@ -557,7 +559,7 @@ run_epidemia <- function(epi_data = NULL, lab = "Observed", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, obs_date, series, value, lab, upper, lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) @@ -582,14 +584,14 @@ run_epidemia <- function(epi_data = NULL, #if we are only generating the model, then end here - if (model_run){ + if (report_settings[["model_run"]]){ message("Model run only, returning regression object and model information.") - fieldnames <- list(casefield = quo_name(quo_casefield), - populationfield = quo_name(quo_popfield), - groupfield = quo_name(quo_groupfield), - obsfield = quo_name(quo_obsfield), - valuefield = quo_name(quo_valuefield)) + fieldnames <- list(casefield = rlang::quo_name(quo_casefield), + populationfield = rlang::quo_name(quo_popfield), + groupfield = rlang::quo_name(quo_groupfield), + obsfield = rlang::quo_name(quo_obsfield), + valuefield = rlang::quo_name(quo_valuefield)) #<<>> needs to be updated model_meta <- create_named_list(fieldnames, @@ -617,16 +619,16 @@ run_epidemia <- function(epi_data = NULL, #need to calculate event detection on existing epi data & FUTURE FORECASTED results future_fc <- fc_res_all$fc_epi %>% #get future forecasted results ONLY - dplyr::filter(obs_date %in% report_dates$forecast$seq) + dplyr::filter(.data$obs_date %in% report_dates$forecast$seq) #combine existing and future obs_fc_epi <- dplyr::bind_rows(epi_data, future_fc) %>% - dplyr::mutate(cases_epidemiar = ifelse(!rlang::are_na(cases_epidemiar), - cases_epidemiar, - fc_cases)) %>% + dplyr::mutate(cases_epidemiar = ifelse(!rlang::are_na(.data$cases_epidemiar), + .data$cases_epidemiar, + .data$fc_cases)) %>% #will be lost by end, but need for event detection methods using surveillance::sts objects epidemiar::add_datefields() %>% #arrange (for viewing/checking) - dplyr::arrange(!!quo_groupfield, obs_date) + dplyr::arrange(!!quo_groupfield, .data$obs_date) #run event detection on combined dataset ed_res <- run_event_detection(epi_fc_data = obs_fc_epi, @@ -682,22 +684,20 @@ run_epidemia <- function(epi_data = NULL, ## Parameters and metadata that might be useful in report generation # all of these may not be needed - fieldnames <- list(casefield = quo_name(quo_casefield), - populationfield = quo_name(quo_popfield), - groupfield = quo_name(quo_groupfield), - obsfield = quo_name(quo_obsfield), - valuefield = quo_name(quo_valuefield)) + fieldnames <- list(casefield = rlang::quo_name(quo_casefield), + populationfield = rlang::quo_name(quo_popfield), + groupfield = rlang::quo_name(quo_groupfield), + obsfield = rlang::quo_name(quo_obsfield), + valuefield = rlang::quo_name(quo_valuefield)) params_meta <- create_named_list(fieldnames, - ed_method, groupings, fc_model_family, env_variables_used = fc_res_all$env_variables_used, env_dt_ranges = fc_res_all$env_dt_ranges, report_dates, env_info, - epi_date_type = report_settings[["epi_date_type"]], - report_value_type = report_settings[["report_value_type"]], + report_settings, date_created = Sys.Date()) #regression object for future other use or troubleshooting regression_object <- fc_res_all$reg_obj From 2f98ea486538bfe7d48124031ec581f4c609d9f2 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 17 Feb 2020 15:18:01 -0600 Subject: [PATCH 004/132] Removed incorrect data pronoun --- R/forecasting_helpers.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 7636f9d..3b50f40 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -510,8 +510,8 @@ lag_environ_to_epi <- function(epi_fc, valuevar <- colnames(env_fc)[curcol] #wide data for all lags of that env var meandat <- datalagger %>% - dplyr::select(!!quo_groupfield, .data$obs_date, .data$lag, .data$valuevar) %>% - tidyr::spread(key = .data$lag, value = .data$valuevar) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$lag, valuevar) %>% + tidyr::spread(key = .data$lag, value = valuevar) #rename lag columns (but not groupfield or Date) names(meandat)[-(1:2)] <- paste0(valuevar, "_", names(meandat)[-(1:2)]) From 7559a9383e99af68ea2a80dd62ff476baa68f255 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 17 Feb 2020 17:21:15 -0600 Subject: [PATCH 005/132] Moved fc_clusters into report_settings; changed to full pass of report_settings to forecast_regression() function and downstream --- R/forecasting_main.R | 451 ++++++++++++++++++++++++------------- R/run_epidemia.R | 34 +-- man/build_model.Rd | 4 +- man/forecast_regression.Rd | 21 +- man/run_epidemia.Rd | 4 +- man/run_forecast.Rd | 5 +- 6 files changed, 328 insertions(+), 191 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 2ab6244..a81d288 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -26,7 +26,6 @@ #' environmental data variable observations. #' #'@param fc_model_family model choice stand in <<>> -#'@param fc_clusters clusters <<>> #'@param report_settings all the settings <<>> #' #'@param env_variables List of environmental variables <<>> @@ -60,7 +59,6 @@ run_forecast <- function(epi_data, env_ref_data, env_info, fc_model_family, - fc_clusters, report_settings, #internal/calculated valid_run, @@ -89,7 +87,7 @@ run_forecast <- function(epi_data, quo_valuefield, env_ref_data, env_info, - fc_model_family, + fc_model_family, #reduced processing for naive models #pull from report_settings epi_date_type = report_settings[["epi_date_type"]], #calculated/internal @@ -111,7 +109,7 @@ run_forecast <- function(epi_data, quo_obsfield) epi_fc <- epi_format_fc(epi_data_extd, quo_groupfield, - fc_clusters) + fc_clusters = report_settings[["fc_clusters"]]) # anomalizing the environ data, if requested. @@ -169,16 +167,13 @@ run_forecast <- function(epi_data, #Split regression call depending on {once|week} model fit frequency - if (report_settings[["fc_fit_freq"]] == "once"){ + if (report_settings[["dev_fc_fit_freq"]] == "once"){ message("Generating forecasts...") #for single fit, call with last week (and subfunction has switch to return all) forereg_return <- forecast_regression(epi_lag, quo_groupfield, fc_model_family, - nthreads = report_settings[["fc_nthreads"]], - model_run = report_settings[["model_run"]], - model_cached = report_settings[["model_cached"]], - fit_freq = report_settings[["fc_fit_freq"]], + report_settings, #internal calculated groupings, env_variables_used, @@ -187,7 +182,7 @@ run_forecast <- function(epi_data, preds_catch <- forereg_return$date_preds reg_obj <- forereg_return$regress - } else if (report_settings[["fc_fit_freq"]] == "week") { + } else if (report_settings[["dev_fc_fit_freq"]] == "week") { # for each week of report, run forecast # initialize: prediction returns 4 columns preds_catch <- data.frame() @@ -198,10 +193,7 @@ run_forecast <- function(epi_data, forereg_return <- forecast_regression(epi_lag, quo_groupfield, fc_model_family, - nthreads = report_settings[["fc_nthreads"]], - model_run = report_settings[["model_run"]], - model_cached = report_settings[["model_cached"]], - fit_freq = report_settings[["fc_fit_freq"]], + report_settings, #internal calculated groupings, env_variables_used, @@ -215,7 +207,7 @@ run_forecast <- function(epi_data, reg_obj <- forereg_return$regress } - } else stop("Model fit frequency unknown") #shouldn't happen with default "once" + } else stop("Dev setting model fit frequency unknown") #shouldn't happen with default "once" # Interval calculation @@ -272,18 +264,7 @@ run_forecast <- function(epi_data, #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). #'@param fc_model_family model choice stand in -#'@param nthreads max threads <<>> -#'@param model_run TRUE/FALSE flag for whether to only generate the model -#' regression object plus metadata. This model can be cached and used later on -#' its own, skipping a large portion of the slow calculations for future runs. -#'@param model_cached The output of a previous model_run = TRUE run of -#' run_epidemia() that produces a model (regression object) and metadata. The -#' metadata will be used for input checking and validation. Using a prebuilt -#' model saves on processing time, but will need to be updated periodically. -#'@param fit_freq String indicating "once" or "weekly" on how often to fit the -#' model - once for the whole report, or every week of the report. Unless -#' otherwise needed, the value should be "once", as weekly drastically -#' increases processing time. +#'@param report_settings report settings #'@param groupings A unique list of the geographic groupings (from groupfield). #'@param env_variables_used List of environmental variables that were used in #' the modeling. @@ -304,20 +285,18 @@ run_forecast <- function(epi_data, forecast_regression <- function(epi_lag, quo_groupfield, fc_model_family, - nthreads, - model_run, - model_cached = NULL, - fit_freq, + report_settings, #internal calculated groupings, env_variables_used, report_dates, req_date){ - if (fit_freq == "once"){ + + if (report_settings[["fc_fit_freq"]]){ #single fits use all the data available last_known_date <- report_dates$known$max - } else if (fit_freq == "week"){ + } else if (report_settings[["fc_fit_freq"]]){ # for "week" model fits, forecasts are done knowing up to just before that date last_known_date <- req_date - lubridate::as.difftime(1, units = "days") } @@ -348,7 +327,7 @@ forecast_regression <- function(epi_lag, ## If model_cached is NOT given, then create model / run regression - if (is.null(model_cached)){ + if (is.null(report_settings[["model_cached"]])){ #create variable bandsummaries equation piece # e.g. 'bandsummaries_{var1} * cluster_id' for however many env var bandsummaries there are @@ -380,7 +359,7 @@ forecast_regression <- function(epi_lag, regress <- build_model(fc_model_family, quo_groupfield, epi_known, - nthreads, + report_settings, #calc/internal n_groupings, modb_eq, @@ -389,6 +368,8 @@ forecast_regression <- function(epi_lag, } else { #if model_cached given, then use that as regress instead of building a new one (above) + model_cached <- report_settings[["model_cached"]] + #message with model input message("Using given cached ", model_cached$model_info$fc_model_family, " model, created ", model_cached$model_info$date_created, ", with epidemiological data up through ", @@ -398,13 +379,13 @@ forecast_regression <- function(epi_lag, } ## If model run, return regression object to run_forecast() at this point - if (model_run){ + if (report_settings[["model_run"]]){ return(regress) } ## Creating predictions switching point on model choice preds <- create_predictions(fc_model_family, - nthreads, + nthreads = report_settings[["fc_nthreads"]], regress, epi_lag, req_date) @@ -426,11 +407,11 @@ forecast_regression <- function(epi_lag, #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) - if (fit_freq == "once"){ + if (report_settings[["fc_fit_freq"]] == "once"){ #for single model fit, this has all the data we need, just trim to report dates date_preds <- epi_preds %>% dplyr::filter(.data$obs_date >= report_dates$full$min) - } else if (fit_freq == "week"){ + } else if (report_settings[["fc_fit_freq"]] == "week"){ #prediction of interest are last ones (equiv to req_date) per groupfield date_preds <- epi_preds %>% dplyr::group_by(!!quo_groupfield) %>% @@ -450,7 +431,7 @@ forecast_regression <- function(epi_lag, #'@param epi_known Epidemiological dataset with basis spline summaries of the #' lagged environmental data (or anomalies), with column marking if "known" #' data and groupings converted to factors. -#'@param nthreads thread count <<>> +#'@param report_settings report settings #'@param n_groupings Count of the number of geographic groupings in the model. #'@param modb_eq Pieces of the regression formula that include the modified #' basis functions to account for long term trend (with or without groupings, @@ -465,84 +446,15 @@ forecast_regression <- function(epi_lag, build_model <- function(fc_model_family, quo_groupfield, epi_known, - nthreads, + report_settings, #calc/internal n_groupings, modb_eq, bandsums_eq){ - #POISSON-BAM (set as default in first round input checking) - if (fc_model_family == "poisson-bam"){ - - message("Building Poisson model using bam() and forced cyclical...") - - #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create - #expression to give to modeling function - #different versions if multiple geographic area groupings or not - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), - " + s(doy, bs=\"cc\", by=", - rlang::quo_name(quo_groupfield), - ") + ", - modb_eq, " + ", - bandsums_eq)) - } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - "s(doy, bs=\"cc\") + ", - modb_eq, " + ", - bandsums_eq)) - } - - # run bam - # Using discrete = TRUE was much faster than using parallel with bam. - regress <- mgcv::bam(reg_eq, data = epi_known, - family = stats::poisson(), - control = mgcv::gam.control(trace=FALSE), - discrete = TRUE, - nthreads = nthreads) - - - } else if (fc_model_family == "negbin"){ - #NEGATIVE BINOMIAL using GLM - - message("Building negative binomial model...") - - #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create - #expression to give to modeling function - #different versions if multiple geographic area groupings or not - #No cycical (as opposed to bam with s()) - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), " + ", - modb_eq, " + ", - bandsums_eq)) - } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - modb_eq, " + ", - bandsums_eq)) - } - - # run glm - # Which negative binomial function depends on if fc_control$theta exists - #<<>> temp set theta to null until switch to real model family - theta <- NULL - - if(!is.null(theta)){ - message("Theta value provided. Running with glm(..., family = MASS::negative.binomial(theta = ", theta, "))...") - regress <- stats::glm(reg_eq, - data = epi_known, - #theta value REQUIRED - family = MASS::negative.binomial(theta=2.31)) - #family = MASS::negative.binomial(theta = theta)) - } else { - message("Theta estimate (fc_control$theta) not provided, running with MASS::glm.nb()...") - regress <- MASS::glm.nb(reg_eq, - data = epi_known) - } + #first, deal with naive models - - } else if (fc_model_family == "naive-persistence"){ + if (fc_model_family == "naive-persistence"){ #naive model #persistence (carry forward) @@ -561,7 +473,6 @@ build_model <- function(fc_model_family, dplyr::select(-dplyr::starts_with("modbs")) - } else if (fc_model_family == "naive-averageweek"){ #naive model @@ -576,9 +487,175 @@ build_model <- function(fc_model_family, } else { - #Shouldn't happen, just in case. - stop("Error in selecting model choice.") - } + #user supplied family + + #cyclical or not + if (report_settings[["fc_cyclicals"]]) { + #TRUE, include cyclicals + + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), + " + s(doy, bs=\"cc\", by=", + rlang::quo_name(quo_groupfield), + ") + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + "s(doy, bs=\"cc\") + ", + modb_eq, " + ", + bandsums_eq)) + } + + # run bam + #<<>> formula override add here report_settings[["dev_fc_formula"]] + regress <- mgcv::bam(reg_eq, + data = epi_known, + family = fc_model_family, + control = mgcv::gam.control(trace=FALSE), + discrete = TRUE, + nthreads = report_settings[["fc_nthreads"]]) + + + + } else { + # FALSE, no cyclicals + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), " + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + modb_eq, " + ", + bandsums_eq)) + } + + + # run bam + regress <- mgcv::bam(reg_eq, + data = epi_known, + family = fc_model_family, + control = mgcv::gam.control(trace=FALSE)) + + + } #end cyclicals if else + + } #end else, user supplied family + + + # #POISSON-BAM (set as default in first round input checking) + # if (fc_model_family == "poisson-bam"){ + # + # message("Building Poisson model using bam() and forced cyclical...") + # + # #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create + # #expression to give to modeling function + # #different versions if multiple geographic area groupings or not + # if (n_groupings > 1){ + # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + # rlang::quo_name(quo_groupfield), + # " + s(doy, bs=\"cc\", by=", + # rlang::quo_name(quo_groupfield), + # ") + ", + # modb_eq, " + ", + # bandsums_eq)) + # } else { + # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + # "s(doy, bs=\"cc\") + ", + # modb_eq, " + ", + # bandsums_eq)) + # } + # + # # run bam + # # Using discrete = TRUE was much faster than using parallel with bam. + # regress <- mgcv::bam(reg_eq, data = epi_known, + # family = stats::poisson(), + # control = mgcv::gam.control(trace=FALSE), + # discrete = TRUE, + # nthreads = nthreads) + # + # + # } else if (fc_model_family == "negbin"){ + # #NEGATIVE BINOMIAL using GLM + # + # message("Building negative binomial model...") + # + # #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create + # #expression to give to modeling function + # #different versions if multiple geographic area groupings or not + # #No cycical (as opposed to bam with s()) + # if (n_groupings > 1){ + # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + # rlang::quo_name(quo_groupfield), " + ", + # modb_eq, " + ", + # bandsums_eq)) + # } else { + # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + # modb_eq, " + ", + # bandsums_eq)) + # } + # + # # run glm + # # Which negative binomial function depends on if fc_control$theta exists + # #<<>> temp set theta to null until switch to real model family + # theta <- NULL + # + # if(!is.null(theta)){ + # message("Theta value provided. Running with glm(..., family = MASS::negative.binomial(theta = ", theta, "))...") + # regress <- stats::glm(reg_eq, + # data = epi_known, + # #theta value REQUIRED + # family = MASS::negative.binomial(theta=2.31)) + # #family = MASS::negative.binomial(theta = theta)) + # } else { + # message("Theta estimate (fc_control$theta) not provided, running with MASS::glm.nb()...") + # regress <- MASS::glm.nb(reg_eq, + # data = epi_known) + # } + # + # + # } else if (fc_model_family == "naive-persistence"){ + # + # #naive model + # #persistence (carry forward) + # #no regression object + # + # #create "model" using known data. + # #Will fill down in create_predictions + # regress <- epi_known %>% + # #grouping by geographical unit + # dplyr::group_by(!!quo_groupfield) %>% + # #prediction is 1 lag (previous week) + # #fit is name of value from regression models + # dplyr::mutate(fit = dplyr::lag(.data$cases_epidemiar, n = 1)) %>% + # #cleaning up as not needed, and for bug hunting + # dplyr::select(-dplyr::starts_with("band")) %>% + # dplyr::select(-dplyr::starts_with("modbs")) + # + # + # + # } else if (fc_model_family == "naive-averageweek"){ + # + # #naive model + # #average of week of year (from historical data) + # #not a regression object + # + # #create "model" (averages) using known data. + # regress <- epi_known %>% + # #calculate averages per geographic group per week of year + # dplyr::group_by(!!quo_groupfield, .data$week_epidemiar) %>% + # dplyr::summarize(fit = mean(.data$cases_epidemiar, na.rm = TRUE)) + # + # + # } else { + # #Shouldn't happen, just in case. + # stop("Error in selecting model choice.") + # } + } # end build_model() @@ -606,40 +683,9 @@ create_predictions <- function(fc_model_family, epi_lag, req_date){ - #POISSON-BAM (set as default in first round input checking) - if (fc_model_family == "poisson-bam"){ - - message("Creating Poisson predictions...") - - ## Create predictions from either newly generated model, or given one - - #output prediction (through req_date) - preds <- mgcv::predict.bam(regress, - newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), - se.fit = TRUE, # included for backwards compatibility - type="response", - discrete = TRUE, - n.threads = nthreads) - - - - } else if (fc_model_family == "negbin"){ - #NEGATIVE BINOMIAL using GLM - - message("Creating negative binomial predictions...") - - - ## Create predictions from either newly generated model, or given one - - #output prediction (through req_date) - preds <- stats::predict.glm(regress, - newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), - se.fit = TRUE, # included for backwards compatibility - type="response") - - - } else if (fc_model_family == "naive-persistence"){ + #handle naive models + if (fc_model_family == "naive-persistence"){ message("Creating predictions using persistence naive model...") @@ -693,8 +739,111 @@ create_predictions <- function(fc_model_family, } else { - #Shouldn't happen, just in case. - stop("Error in selecting model choice.") + #user supplied family, use predict.bam on regression object (regress) + + #output prediction (through req_date) + preds <- mgcv::predict.bam(regress, + newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), + se.fit = TRUE, # included for backwards compatibility + type="response", + discrete = TRUE, + n.threads = nthreads) + + } + + + + # #POISSON-BAM (set as default in first round input checking) + # if (fc_model_family == "poisson-bam"){ + # + # message("Creating Poisson predictions...") + # + # + # ## Create predictions from either newly generated model, or given one + # + # #output prediction (through req_date) + # preds <- mgcv::predict.bam(regress, + # newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), + # se.fit = TRUE, # included for backwards compatibility + # type="response", + # discrete = TRUE, + # n.threads = nthreads) + # + # + # + # } else if (fc_model_family == "negbin"){ + # #NEGATIVE BINOMIAL using GLM + # + # message("Creating negative binomial predictions...") + # + # + # ## Create predictions from either newly generated model, or given one + # + # #output prediction (through req_date) + # preds <- stats::predict.glm(regress, + # newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), + # se.fit = TRUE, # included for backwards compatibility + # type="response") + # + # + # } else if (fc_model_family == "naive-persistence"){ + # + # message("Creating predictions using persistence naive model...") + # + # #persistence model just carries forward the last known value + # #the important part is the forecast / trailing end part + # #manipulating to be in quasi-same format as the other models return + # + # #cleaning up as not needed, and for bug hunting + # epi_lag <- epi_lag %>% + # dplyr::select(-dplyr::starts_with("band")) %>% + # dplyr::select(-dplyr::starts_with("modbs")) + # + # #regress is a tibble not regression object here + # # has a variable fit with lag of 1 on known data + # #epi_lag has the newer rows + # preds <- epi_lag %>% + # #filter to requested date + # dplyr::filter(.data$obs_date <= req_date) %>% + # #join to get "fit" values from "model" + # #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming + # dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% + # #important at end/fc section, when we fill down + # tidyr::fill(.data$fit, .direction = "down") %>% + # #format into nominal regression predict output + # dplyr::select(.data$fit) %>% + # as.data.frame() + # + # } else if (fc_model_family == "naive-averageweek"){ + # + # message("Creating predictions using average week of year naive model...") + # + # #average week null model calculates the average cases of that + # # week of year from historical data + # #manipulating to be in quasi-same format as the other models return + # + # #regress is the averages per week of year from known data + # + # epi_lag <- epi_lag %>% + # #filter to requested date + # dplyr::filter(.data$obs_date <= req_date) + # + # #join back + # preds <- epi_lag %>% + # #join to get average values + # #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming + # # and so don't need column names not passed into this function + # dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% + # #format into nominal regression output + # dplyr::select(.data$fit) %>% + # as.data.frame() + # + # + # } else { + # #Shouldn't happen, just in case. + # stop("Error in selecting model choice.") + # } + } #end create_predictions() diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 7336583..886fad5 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -42,7 +42,6 @@ #'@param valuefield Field name of the value of the environmental data variable #' observations (unquoted field name). #' -#'@param fc_clusters Clusters. <<>> #'@param fc_model_family Critical argument to choose the type of model to generate. #' The options are versions that the EPIDEMIA team has used for forecasting. #' The first supported options is "poisson-bam" ("p") which is the original @@ -125,7 +124,6 @@ run_epidemia <- function(epi_data = NULL, obsfield = NULL, valuefield = NULL, #required settings - fc_clusters = NULL, fc_model_family = NULL, #optional report_settings = NULL) @@ -183,7 +181,7 @@ run_epidemia <- function(epi_data = NULL, groupfield = quo_groupfield, obsfield = quo_obsfield, valuefield = quo_valuefield) - necessary <- create_named_list(epi_data, env_data, env_ref_data, env_info, fc_clusters) + necessary <- create_named_list(epi_data, env_data, env_ref_data, env_info) #initialize missing info msgs & flag missing_msgs <- "" @@ -352,11 +350,9 @@ run_epidemia <- function(epi_data = NULL, report_settings[["fc_future_period"]] <- 8 } - #<<>> temporary settings until switch fc_model_family to real input (relabeled model_choice atm) + #default false, with explicit false for naive models (probably ok w/out, just being careful) if (is.null(report_settings[["env_anomalies"]])){ report_settings[["env_anomalies"]] <- dplyr::case_when( - fc_model_family == "poisson-gam" ~ TRUE, - fc_model_family == "negbin" ~ FALSE, fc_model_family == "naive-persistence" ~ FALSE, fc_model_family == "naive-weekaverage" ~ FALSE, #default to FALSE @@ -465,15 +461,28 @@ run_epidemia <- function(epi_data = NULL, } #end else for ncores not given + #fc_clusters + #default is one cluster, probably not what you actually want for any type of large system + if (is.null(report_settings[["fc_clusters"]])){ + #create tbl of only one cluster + #groupings already exist as list of geographic groups + cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% + #and fix names with NSE + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + #assign + report_settings[["fc_clusters"]] <- cluster_tbl + } + + # Developer options - if (is.null(report_settings[["fc_fit_freq"]])){ - report_settings[["fc_fit_freq"]] <- "once" + if (is.null(report_settings[["dev_fc_fit_freq"]])){ + report_settings[["dev_fc_fit_freq"]] <- "once" } - if (is.null(report_settings[["fc_modbsplines"]])){ - report_settings[["fc_modbsplines"]] <- FALSE + if (is.null(report_settings[["dev_fc_modbsplines"]])){ + report_settings[["dev_fc_modbsplines"]] <- FALSE } - if (is.null(report_settings[["fc_formula"]])){ - report_settings[["fc_formula"]] <- NULL + if (is.null(report_settings[["dev_fc_formula"]])){ + report_settings[["dev_fc_formula"]] <- NULL } @@ -574,7 +583,6 @@ run_epidemia <- function(epi_data = NULL, env_ref_data, env_info, fc_model_family, - fc_clusters, report_settings, #internal/calculated valid_run, diff --git a/man/build_model.Rd b/man/build_model.Rd index 2b66e75..b762587 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -4,7 +4,7 @@ \alias{build_model} \title{Build the appropriate model} \usage{ -build_model(fc_model_family, quo_groupfield, epi_known, nthreads, +build_model(fc_model_family, quo_groupfield, epi_known, report_settings, n_groupings, modb_eq, bandsums_eq) } \arguments{ @@ -17,7 +17,7 @@ run_epidemia().} lagged environmental data (or anomalies), with column marking if "known" data and groupings converted to factors.} -\item{nthreads}{thread count <<>>} +\item{report_settings}{report settings} \item{n_groupings}{Count of the number of geographic groupings in the model.} diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index c5d59ab..ca449da 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -4,9 +4,8 @@ \alias{forecast_regression} \title{Run forecast regression} \usage{ -forecast_regression(epi_lag, quo_groupfield, fc_model_family, nthreads, - model_run, model_cached = NULL, fit_freq, groupings, - env_variables_used, report_dates, req_date) +forecast_regression(epi_lag, quo_groupfield, fc_model_family, + report_settings, groupings, env_variables_used, report_dates, req_date) } \arguments{ \item{epi_lag}{Epidemiological dataset with basis spline summaries of the @@ -17,21 +16,7 @@ run_epidemia().} \item{fc_model_family}{model choice stand in} -\item{nthreads}{max threads <<>>} - -\item{model_run}{TRUE/FALSE flag for whether to only generate the model -regression object plus metadata. This model can be cached and used later on -its own, skipping a large portion of the slow calculations for future runs.} - -\item{model_cached}{The output of a previous model_run = TRUE run of -run_epidemia() that produces a model (regression object) and metadata. The -metadata will be used for input checking and validation. Using a prebuilt -model saves on processing time, but will need to be updated periodically.} - -\item{fit_freq}{String indicating "once" or "weekly" on how often to fit the -model - once for the whole report, or every week of the report. Unless -otherwise needed, the value should be "once", as weekly drastically -increases processing time.} +\item{report_settings}{report settings} \item{groupings}{A unique list of the geographic groupings (from groupfield).} diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index dbf7b2a..d5a6318 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -7,7 +7,7 @@ run_epidemia(epi_data = NULL, env_data = NULL, env_ref_data = NULL, env_info = NULL, casefield = NULL, groupfield = NULL, populationfield = NULL, obsfield = NULL, valuefield = NULL, - fc_clusters = NULL, fc_model_family = NULL, report_settings = NULL) + fc_model_family = NULL, report_settings = NULL) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date @@ -46,8 +46,6 @@ name).} \item{valuefield}{Field name of the value of the environmental data variable observations (unquoted field name).} -\item{fc_clusters}{Clusters. <<>>} - \item{fc_model_family}{Critical argument to choose the type of model to generate. The options are versions that the EPIDEMIA team has used for forecasting. The first supported options is "poisson-bam" ("p") which is the original diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index 9bac414..be5c911 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -6,8 +6,7 @@ \usage{ run_forecast(epi_data, quo_popfield, quo_groupfield, env_data, quo_obsfield, quo_valuefield, env_ref_data, env_info, fc_model_family, - fc_clusters, report_settings, valid_run, groupings, env_variables, - report_dates) + report_settings, valid_run, groupings, env_variables, report_dates) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date @@ -41,8 +40,6 @@ method (e.g. sum or mean), report labels, etc.} \item{fc_model_family}{model choice stand in <<>>} -\item{fc_clusters}{clusters <<>>} - \item{report_settings}{all the settings <<>>} \item{valid_run}{Internal binary for whether this is part of a validation run.} From 6b78424625fa5de9b5c76ccc81c52a7eedbea27c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 19 Feb 2020 13:47:04 -0600 Subject: [PATCH 006/132] Updating model_run option code --- R/forecasting_main.R | 38 +++++++++++++++++--------------------- R/run_epidemia.R | 16 +++++++++------- 2 files changed, 26 insertions(+), 28 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index a81d288..42e1f8c 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -142,27 +142,23 @@ run_forecast <- function(epi_data, epi_lag <- add_datefields(epi_lag, week_type) - #<<>> FIX - # # If only model_run, then return to run_epidemia() here - # if (model_run){ - # model_run_result <- forecast_regression(epi_lag, - # quo_groupfield, - # fc_model_family, - # nthreads = report_settings[["fc_nthreads"]], - # model_run, - # model_cached = report_settings[["model_cached"]], - # fit_freq = report_settings[["fc_fit_freq"]], - # #internal calculated - # groupings, - # env_variables_used, - # report_dates, - # req_date = report_dates$full$max) - # - # model_run_only <- create_named_list(env_variables_used, - # env_dt_ranges, - # reg_obj = model_run_result) - # return(model_run_only) - # } + # If only model_run, then return to run_epidemia() here + if (report_settings[["model_run"]]){ + model_run_result <- forecast_regression(epi_lag, + quo_groupfield, + fc_model_family, + report_settings, + #internal calculated + groupings, + env_variables_used, + report_dates, + req_date = report_dates$full$max) + + model_run_only <- create_named_list(env_variables_used, + env_dt_ranges, + reg_obj = model_run_result) + return(model_run_only) + } #Split regression call depending on {once|week} model fit frequency diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 886fad5..e49fbf8 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -601,17 +601,18 @@ run_epidemia <- function(epi_data = NULL, obsfield = rlang::quo_name(quo_obsfield), valuefield = rlang::quo_name(quo_valuefield)) - #<<>> needs to be updated - model_meta <- create_named_list(fieldnames, - week_type, + model_meta <- create_named_list(date_created = Sys.Date(), + fieldnames, groupings, + fc_model_family, env_variables_used = fc_res_all$env_variables_used, env_dt_ranges = fc_res_all$env_dt_ranges, known_epi_range = report_dates$known, env_info, - report_value_type = report_settings[["report_value_type"]], + report_settings, date_created = Sys.Date()) + #if a model run, forecast result contains regression object model_results <- list(model_obj = fc_res_all$reg_obj, model_info = model_meta) @@ -698,15 +699,16 @@ run_epidemia <- function(epi_data = NULL, obsfield = rlang::quo_name(quo_obsfield), valuefield = rlang::quo_name(quo_valuefield)) - params_meta <- create_named_list(fieldnames, + params_meta <- create_named_list(date_created = Sys.Date(), + fieldnames, groupings, fc_model_family, env_variables_used = fc_res_all$env_variables_used, env_dt_ranges = fc_res_all$env_dt_ranges, report_dates, env_info, - report_settings, - date_created = Sys.Date()) + report_settings) + #regression object for future other use or troubleshooting regression_object <- fc_res_all$reg_obj From 97b998b2d9ddd4f1c2954f352ca990cd1489de87 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 19 Feb 2020 13:47:57 -0600 Subject: [PATCH 007/132] Fix dev option fit freq name --- R/forecasting_main.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 42e1f8c..3562edc 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -203,7 +203,7 @@ run_forecast <- function(epi_data, reg_obj <- forereg_return$regress } - } else stop("Dev setting model fit frequency unknown") #shouldn't happen with default "once" + } else stop("Developer setting model fit frequency unknown, please review/remove report_settings$dev_fc_fit_freq parameter.") # Interval calculation @@ -289,10 +289,10 @@ forecast_regression <- function(epi_lag, req_date){ - if (report_settings[["fc_fit_freq"]]){ + if (report_settings[["dev_fc_fit_freq"]] == "once"){ #single fits use all the data available last_known_date <- report_dates$known$max - } else if (report_settings[["fc_fit_freq"]]){ + } else if (report_settings[["dev_fc_fit_freq"]] == "week"){ # for "week" model fits, forecasts are done knowing up to just before that date last_known_date <- req_date - lubridate::as.difftime(1, units = "days") } @@ -403,11 +403,11 @@ forecast_regression <- function(epi_lag, #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) - if (report_settings[["fc_fit_freq"]] == "once"){ + if (report_settings[["dev_fc_fit_freq"]] == "once"){ #for single model fit, this has all the data we need, just trim to report dates date_preds <- epi_preds %>% dplyr::filter(.data$obs_date >= report_dates$full$min) - } else if (report_settings[["fc_fit_freq"]] == "week"){ + } else if (report_settings[["dev_fc_fit_freq"]] == "week"){ #prediction of interest are last ones (equiv to req_date) per groupfield date_preds <- epi_preds %>% dplyr::group_by(!!quo_groupfield) %>% From 21acf89c1f3155e9177e5d0d3c383f961c7ea24b Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 19 Feb 2020 13:49:07 -0600 Subject: [PATCH 008/132] Added dev option formula override to modeling building in forecast functions --- R/forecasting_main.R | 86 ++++++++++++++++++++++++++++++-------------- 1 file changed, 59 insertions(+), 27 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 3562edc..7ed39ff 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -448,7 +448,15 @@ build_model <- function(fc_model_family, modb_eq, bandsums_eq){ - #first, deal with naive models + #1. check and handle naive models + # else is the user supplied model family + #2. check on fc_cyclicals, b/c need different bam call if s() used or not + #3. within each cyclical if/else section, use formula override if given, + #4. else build model: + # still within each cyclical if/elese section, + # check for number of geo graphic groupings (one or more than one) + # and build appropriate regression equations, + # and run appropriate bam call if (fc_model_family == "naive-persistence"){ @@ -483,30 +491,43 @@ build_model <- function(fc_model_family, } else { - #user supplied family + #user supplied model family + + #note, if using formula override AND cyclicals, + # dev users should put fc_cyclicals = TRUE, else message about discrete ignored. #cyclical or not if (report_settings[["fc_cyclicals"]]) { #TRUE, include cyclicals - #need different formulas if 1+ or only 1 geographic grouping - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), - " + s(doy, bs=\"cc\", by=", - rlang::quo_name(quo_groupfield), - ") + ", - modb_eq, " + ", - bandsums_eq)) + #Formula override: report_settings[["dev_fc_formula"]] + if (!is.null(report_settings[["dev_fc_formula"]])){ + + reg_eq <- report_settings[["dev_fc_formula"]] + } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - "s(doy, bs=\"cc\") + ", - modb_eq, " + ", - bandsums_eq)) - } + #build equation + + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), + " + s(doy, bs=\"cc\", by=", + rlang::quo_name(quo_groupfield), + ") + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + "s(doy, bs=\"cc\") + ", + modb_eq, " + ", + bandsums_eq)) + } + + } #end else on dev_fc_formula override + # run bam - #<<>> formula override add here report_settings[["dev_fc_formula"]] regress <- mgcv::bam(reg_eq, data = epi_known, family = fc_model_family, @@ -518,17 +539,28 @@ build_model <- function(fc_model_family, } else { # FALSE, no cyclicals - #need different formulas if 1+ or only 1 geographic grouping - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), " + ", - modb_eq, " + ", - bandsums_eq)) + + + #Formula override: report_settings[["dev_fc_formula"]] + if (!is.null(report_settings[["dev_fc_formula"]])){ + + reg_eq <- report_settings[["dev_fc_formula"]] + } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - modb_eq, " + ", - bandsums_eq)) - } + #build equation + + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), " + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + modb_eq, " + ", + bandsums_eq)) + } + } #end else for override # run bam From e9e124d625e2042004ea2a58ff9d24a012db25c7 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 19 Feb 2020 13:49:38 -0600 Subject: [PATCH 009/132] Updated validation code with new epidemiar input scheme and variable names --- R/model_validation.R | 1283 +++++++++++++++++++++--------------------- R/run_epidemia.R | 7 +- 2 files changed, 642 insertions(+), 648 deletions(-) diff --git a/R/model_validation.R b/R/model_validation.R index f02a285..ec5f455 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -1,646 +1,637 @@ -#' -#' #'Run EPIDEMIA model validation statistics -#' #' -#' #'This function takes a few more arguments than `epidemiar::run_epidemia()` to -#' #'generate statistics on model validation. The function will evaluate a number -#' #'of weeks (`total_timesteps`) starting from a specified week (`date_start`) and -#' #'will look at the n-week ahead forecast (1 to `timesteps_ahead` number of -#' #'weeks) and compare the values to the observed number of cases. An optional -#' #'`reporting_lag` argument will censor the last known data back that number of -#' #'weeks. The validation statistics include Root Mean Squared Error (RMSE) and -#' #'Mean Absolute Error (MAE), and an R-squared staistic both in total and per -#' #'geographic grouping (if present). -#' #' -#' #'@param date_start Date to start testing for model validation. -#' #'@param total_timesteps Number of weeks from `week_start` to run validation -#' #' tests. -#' #'@param timesteps_ahead Number of weeks for testing the n-week ahead forecasts. -#' #' Results will be generated from 1-week ahead through `weeks_ahead` number of -#' #' weeks. -#' #'@param reporting_lag Number of timesteps to simulate reporting lag. For -#' #' instance, if you have weekly data, and a reporting_lag of 1 week, and are -#' #' working with a timesteps_ahead of 1 week, then that is functional equivalent -#' #' to reporting lag of 0, and timesteps_ahead of 2 weeks. I.e. You are -#' #' forecasting next week, but you don't know this week's data yet, you only -#' #' know last week's numbers. -#' #'@param per_timesteps When creating a timeseries of validation results, create -#' #' a moving window with per_timesteps width number of time points. Should be a -#' #' minimum of 10 timesteps. -#' #'@param skill_test Logical parameter indicating whether or not to run -#' #' validations also on two naïve models for a skill test comparison. The naïve -#' #' models are "persistence": the last known value (case counts) carried -#' #' forward, and "average week" where the predicted value is the average of that -#' #' week of the year, as calculated from historical data. -#' #'@param epi_data See description in `run_epidemia()`. -#' #'@param casefield See description in `run_epidemia()`. -#' #'@param populationfield See description in `run_epidemia()`. -#' #'@param groupfield See description in `run_epidemia()`. -#' #'@param week_type See description in `run_epidemia()`. -#' #'@param report_period The number of weeks that the entire report will cover. -#' #' The \code{report_period} minus \code{forecast_future} is the number of weeks -#' #' of past (known) data that will be included. Overwritten to be `weeks_ahead` -#' #' + 1 for validation runs. -#' #'@param ed_summary_period Overwritten to 1 for validation runs (no-op for no -#' #' event detection during validation runs). -#' #'@param ed_method Overwritten to "none" for validation runs. -#' #'@param env_data See description in `run_epidemia()`. -#' #'@param obsfield See description in `run_epidemia()`. -#' #'@param valuefield See description in `run_epidemia()`. -#' #'@param forecast_future Number of future weeks from the end of the -#' #' \code{epi_data} to produce forecasts, as in `run_epidemia()`, but -#' #' overwritten as `weeks_ahead` for validation runs. -#' #'@param fc_control See description in `run_epidemia()`. Note, -#' #' fc_control$value_type is overwritten as "cases" for validation runs. -#' #'@param env_ref_data See description in `run_epidemia()`. -#' #'@param env_info See description in `run_epidemia()`. -#' #'@param model_cached See description in `run_epidemia()`. -#' #'@param model_choice See description in `run_epidemia()`. -#' #'@param ... Accepts other arguments that are normally part of `run_epidemia()`, -#' #' but ignored for validation runs. For example, `inc_per`, `ed_control`, -#' #' `model_run`. -#' #' -#' #' -#' #'@return Returns a nested list of validation results. Statistics are calculated -#' #' on the n-week ahead forecast and the actual observed case counts. Statistics -#' #' returned are Mean Absolute Error (MAE), Root Mean Squared Error (RMSE). The -#' #' first object is `skill_scores`, which contains `skill_overall` and -#' #' `skill_grouping`. The second list is `validations`, which contains lists per -#' #' model run (the forecast model and then optionally the naive models). Within -#' #' each, `validation_overall` is the results overall, and `validation_grouping` -#' #' is the results per geographic grouping. Lastly, a `metadata` list contains -#' #' the important parameter settings used to run validation and when the results -#' #' where generated. -#' #' -#' #'@export -#' #' -#' run_validation <- function(date_start = NULL, -#' total_timesteps = 26, -#' timesteps_ahead = 2, -#' reporting_lag = 0, -#' per_timesteps = 12, -#' skill_test = TRUE, -#' #for run_epidemia() -#' epi_data = NULL, -#' casefield = NULL, -#' populationfield = NULL, -#' groupfield = NULL, -#' week_type = c("ISO", "CDC"), -#' report_period = 3, #default is timesteps_ahead default + 1 -#' ed_summary_period = 1, #0 causes errors, 1 and "none" is no-op equivalent -#' ed_method = "none", -#' env_data = NULL, -#' obsfield = NULL, -#' valuefield = NULL, -#' forecast_future = 2, #default same as timesteps_ahead default -#' fc_control = NULL, -#' env_ref_data = NULL, -#' env_info = NULL, -#' model_cached = NULL, -#' model_choice = c("poisson-bam", "negbin"), -#' ...){ -#' #date_start: week to start reporting of results -#' #total_timesteps: number of weeks forward from week_start to gather test results -#' #timesteps_ahead: calculate stats on 1 to n week ahead predictions -#' -#' #this means that the start of calculations will be date_start minus timesteps_ahead # of weeks -#' #then trimmed at the end to start at date_start. -#' -#' # Non-standard evaluation quosures ---------------------------------------- -#' -#' # dplyr programming steps for passing of field names -#' quo_casefield <- rlang::enquo(casefield) -#' quo_popfield <- rlang::enquo(populationfield) -#' quo_groupfield <- rlang::enquo(groupfield) -#' quo_obsfield <- rlang::enquo(obsfield) -#' quo_valuefield <- rlang::enquo(valuefield) -#' -#' #Note: if field name does not exist in any dataset, enquo() will throw an error. -#' -#' -#' # Adjust parameters for validation runs ----------------------------------- -#' -#' #Assumed that run_epidemia() parameters just copied and pasted, so adjust for validation -#' #new lengths -#' forecast_future <- timesteps_ahead + reporting_lag -#' report_period <- forecast_future + 1 -#' #no event detection -#' ed_summary_period <- 1 -#' ed_method <- "none" -#' #report out in CASES for validation -#' fc_control$value_type <- "cases" -#' -#' #for params accepted by run_epidemia, but are meaningless for validation runs -#' # e.g. `inc_per`, `ed_control`, `model_run` -#' #captured, but then do nothing with them -#' # Also used for hidden raw_data argument for testing/development -#' dots <- list(...) -#' -#' #Create parameter metadata -#' metadata <- create_named_list(date_start, -#' total_timesteps, -#' timesteps_ahead, -#' reporting_lag, -#' per_timesteps, -#' skill_test, -#' casefield = quo_name(quo_casefield), -#' date_created = Sys.Date()) -#' -#' -#' # All loop prep ------------------------------------------------------ -#' -#' #Set up for looping -#' #preserve full data -#' epi_data_orig <- epi_data -#' env_data_orig <- env_data -#' -#' #Pull obs from original -#' # Will have extra dates, but will be trimmed back to user requested dates later -#' obs_only <- epi_data_orig %>% -#' dplyr::select(!!quo_groupfield, obs_date, !!quo_casefield) %>% -#' #rename observation -#' dplyr::rename(obs := !!quo_name(quo_casefield)) -#' -#' -#' #Skill test loop set up -#' if (skill_test == TRUE){ -#' models_to_run = c(model_choice, "naive-persistence", "naive-averageweek") -#' } else { -#' models_to_run = c(model_choice) -#' } -#' -#' # Skill test loop --------------------------------------------------------- -#' -#' #skill test collection -#' all_validations <- vector("list", length = length(models_to_run)) -#' #add names -#' names(all_validations) <- models_to_run -#' -#' #model loop -#' for (m in seq_along(models_to_run)){ -#' -#' this_model <- models_to_run[m] -#' -#' #If naive-averageweek, timesteps_ahead is meaningless, just use 1 -#' if (this_model == "naive-averageweek"){ -#' this_timesteps_ahead <- 1 -#' this_forecast_future <- this_timesteps_ahead -#' this_report_period <- this_forecast_future + 1 -#' } else { -#' #use modified forecast_future which is timesteps_ahead + reporting_lag -#' this_timesteps_ahead <- forecast_future #timesteps_ahead -#' this_forecast_future <- this_timesteps_ahead -#' this_report_period <- this_forecast_future + 1 -#' } -#' -#' # Week loop --------------------------------------------------------------- -#' -#' #Create list of dates -#' #the start of calculations will be date_start minus timesteps_ahead # of weeks -#' date_list <- date_start + lubridate::weeks(-this_timesteps_ahead:(total_timesteps-1)) -#' -#' #output will be list of dataframes (forecasts) until we collapse later -#' fcs_list <- vector("list", length = length(date_list)) -#' -#' #loop -#' for (i in seq_along(date_list)){ -#' this_dt <- date_list[i] -#' -#' message("Validation run - date: ", this_dt) # for testing for now -#' -#' #set up data -#' #censoring as appropriate -#' #reporting_lag will be handled with offset timesteps -#' epi_data <- epi_data_orig %>% -#' dplyr::filter(obs_date <= this_dt) -#' env_data <- env_data_orig %>% -#' dplyr::filter(obs_date <= this_dt) -#' -#' #run_epidemia -#' #passing quosures, which will have an escape built into run_epidemia() -#' reportdata <- run_epidemia(epi_data = epi_data, -#' casefield = quo_casefield, -#' populationfield = quo_popfield, -#' inc_per = inc_per, -#' groupfield = quo_groupfield, -#' week_type = "ISO", -#' report_period = this_report_period, #this -#' ed_summary_period = ed_summary_period, -#' ed_method = ed_method, -#' ed_control = ed_control, -#' env_data = env_data, -#' obsfield = quo_obsfield, -#' valuefield = quo_valuefield, -#' forecast_future = this_forecast_future, #this -#' fc_control = fc_control, -#' env_ref_data = env_ref_data, -#' env_info = env_info, -#' model_cached = model_cached, -#' model_choice = this_model) ##models_to_run -#' -#' -#' -#' #pull needed and reformat -#' fcs_list[[i]] <- reportdata$modeling_results_data %>% -#' #get forecasts only -#' dplyr::filter(series == "fc") %>% -#' #get base date of report ('current date' in relation to forecast) -#' dplyr::mutate(preadj_date = this_dt, -#' #how many weeks ahead is the prediction (not adjusting for reporting lag yet) -#' timestep_ahead_orig = difftime(obs_date, preadj_date) %>% -#' as.numeric(units = "weeks")) %>% -#' #don't need 0 week predictions (same week) -#' dplyr::filter(timestep_ahead_orig > 0) -#' -#' -#' } #end timestep loop -#' -#' #have list of dataframes -#' #collapse/bindrows -#' fcs_only <- dplyr::bind_rows(fcs_list) %>% -#' #nicely arrange -#' dplyr::arrange(!!quo_groupfield, timestep_ahead_orig, obs_date) -#' -#' -#' #join -#' fc_join <- fcs_only %>% -#' dplyr::left_join(obs_only, -#' #NSE fun -#' by = rlang::set_names(c(rlang::quo_name(quo_groupfield), -#' "obs_date"), -#' c(rlang::quo_name(quo_groupfield), -#' "obs_date"))) -#' -#' #make all the reporting_lag adjustments -#' # basically, we ran extra forecast future steps -#' # so we now can simply shift everything backwards except for averageweek -#' if (this_model == "naive-averageweek"){ -#' fc_join <- fc_join %>% -#' dplyr::mutate(run_date = preadj_date, -#' #timestep_ahead is meaningless for average week. -#' # NA may cause unexpected results with grouping, so replace with 0 -#' timestep_ahead = 0, -#' #Add column for showing reporting_lag -#' reporting_lag = reporting_lag) -#' } else { -#' fc_join <- fc_join %>% -#' dplyr::mutate(run_date = preadj_date - lubridate::weeks(reporting_lag), -#' timestep_ahead = timestep_ahead_orig - reporting_lag, -#' #Add column for showing reporting_lag -#' reporting_lag = reporting_lag) %>% -#' #filter out the timesteps that are now less than 1 step -#' dplyr::filter(timestep_ahead > 0) -#' } -#' -#' -#' #Filter to report weeks (trim off edges gathered b/c of weeks_ahead, etc.) -#' fc_trim <- fc_join %>% -#' dplyr::filter(between(obs_date, -#' date_start, -#' date_start + lubridate::weeks(total_timesteps-1))) -#' -#' -#' ## Calculate statistics -#' val_results <- calc_val_stats(fc_trim, quo_groupfield, per_timesteps, dots) -#' -#' #add results to list by name -#' all_validations[[this_model]] <- val_results -#' -#' } #end model loop -#' -#' -#' -#' #Get skill test list of results -#' if (skill_test == TRUE){ -#' #calc skill comparison statistics -#' skill_overall <- calc_skill(get_overall_validations(all_validations)) -#' skill_grouping <- calc_skill(get_group_validations(all_validations), quo_groupfield) -#' skill_scores <- create_named_list(skill_overall, skill_grouping) -#' -#' val_return <- create_named_list(skill_scores, validations = all_validations, metadata) -#' } else { -#' #just the one model validation datasets -#' val_return <- create_named_list(all_validations, metadata) -#' } -#' -#' -#' -#' -#' message("Validation run finished.") -#' val_return -#' -#' } #end run validation -#' -#' -#' -#' #'Calculate validation statistics from forecast results. -#' #' -#' #'Helper function to calculate the validation statistics from each model run. -#' #'Mean Absolute Error (MAE), Root Mean Square Error (RMSE), Proportion of -#' #'observations in in prediction interval, and R^2. Calculates it both at a -#' #'global model level per timestep ahead, and at a geographical grouping level -#' #'per timestep ahead. Also calculates a timeseries of evaluation metrics at -#' #'every per_timesteps number of timesteps per grouping (if applicable) and -#' #'timestep_ahead. -#' #' -#' #'@param fc_trim The forecast results of one model type, combined with observed -#' #' values, trimmed to user requested date range. -#' #'@param quo_groupfield Quosure of the user given geographic grouping field to -#' #' run_validation()/run_epidemia(). -#' #'@param per_timesteps When creating a timeseries of validation results, create -#' #' a moving window with per_timesteps width number of time points. Should be a -#' #' minimum of 10 timesteps. -#' #'@param dots The non-required arguments to run_validation() for developer -#' #' testing. -#' #' -#' #'@return A named list of validation statistic results: validation_overall, -#' #' validation_grouping, validation_timeseries -#' #' -#' calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ -#' # MAE: mean(|obs - pred|) -#' # RMSE: sqrt(mean((obs - pred)^2)) -#' # R2 (R^2): 1 - SSE/TSS. SSE = sum((obs-pred)^2). TSS = sum((obs - mean(obs))^2). -#' # B/c involves mean of group of observations, must be calculated after grouping -#' -#' #Removed -#' # Proportion in Interval: 1/T if inside, summed. Over all non-NA entries. -#' -#' #per line stats -#' fc_stats <- fc_trim %>% -#' dplyr::mutate(diff = obs - value, -#' absdiff = abs(diff), -#' diffsq = diff ^ 2) -#' #,predinterval = ifelse(obs >= lower & obs <= upper, TRUE, FALSE)) -#' -#' -#' #overall timestep_ahead -#' validation_overall <- fc_stats %>% -#' dplyr::group_by(timestep_ahead) %>% -#' #Now calc TSS part of R2 -#' dplyr::mutate(meanobs = mean(obs), -#' total_squares = (obs - meanobs)^2) %>% -#' #stat calc -#' dplyr::summarize(MAE = mean(absdiff, na.rm = TRUE), -#' MSE = mean(diffsq, na.rm = TRUE), -#' #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), -#' SSE = sum(diffsq, na.rm = TRUE), -#' TSS = sum(total_squares, na.rm = TRUE)) %>% -#' #and mutate for final calc -#' dplyr::mutate(RMSE = sqrt(MSE), -#' R2 = 1 - (SSE/TSS)) %>% -#' #drop unneeded columns -#' dplyr::select(-SSE, -TSS, -MSE) -#' -#' -#' -#' #overall timestep_ahead by grouping -#' validation_grouping <- fc_stats %>% -#' dplyr::group_by(!!quo_groupfield, timestep_ahead) %>% -#' #Now calc TSS part of R2 -#' dplyr::mutate(meanobs = mean(obs), -#' total_squares = (obs - meanobs)^2) %>% -#' #stat calc -#' dplyr::summarize(MAE = mean(absdiff, na.rm = TRUE), -#' MSE = mean(diffsq, na.rm = TRUE), -#' #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), -#' SSE = sum(diffsq, na.rm = TRUE), -#' TSS = sum(total_squares, na.rm = TRUE)) %>% -#' #and mutate for final calc -#' dplyr::mutate(RMSE = sqrt(MSE), -#' R2 = 1 - (SSE/TSS)) %>% -#' #drop unneeded columns -#' dplyr::select(-SSE, -TSS, -MSE) -#' -#' -#' -#' #timeseries calculations -#' # minimum of ~10 timesteps per summary -#' # ROLLING window -#' validation_timeseries <- fc_stats %>% -#' dplyr::group_by(!!quo_groupfield, timestep_ahead) %>% -#' #rollapply for get mean of obs -#' dplyr::mutate(meanobs = zoo::rollmeanr(x = obs, -#' k = per_timesteps, -#' fill = NA), -#' total_squares = (obs - meanobs)^2, -#' MAE = zoo::rollmeanr(x = absdiff, -#' k = per_timesteps, -#' fill = NA), -#' MSE = zoo::rollmeanr(x = diffsq, -#' k = per_timesteps, -#' fill = NA), -#' RMSE = sqrt(MSE), -#' #prop_interval = zoo::rollsumr(x = predinterval, -#' # k = per_timesteps, -#' # fill = NA) / -#' # zoo::rollsumr(x = !is.na(predinterval), -#' # k = per_timesteps, -#' # fill = NA), -#' SSE = zoo::rollsumr(x = diffsq, -#' k = per_timesteps, -#' fill = NA), -#' TSS = zoo::rollsumr(x = total_squares, -#' k = per_timesteps, -#' fill = NA), -#' R2 = 1 - (SSE/TSS)) %>% -#' #rename columns to be clearer -#' dplyr::rename(forecast = value, -#' observed = obs) %>% -#' # drop unneeded columns -#' dplyr::select(-series, -preadj_date, -timestep_ahead_orig, -run_date, -#' -diff, -absdiff, -diffsq, -meanobs, -total_squares, -MSE, -SSE, -TSS) %>% -#' # for now, drop R2 until can figure out how to include better -#' dplyr::select(-R2) -#' -#' -#' -#' #return all -#' # and raw data with hidden option -#' #possibly make "time series" version for clean full data table -#' if (!is.null(dots[['raw_data']])){ -#' if (dots[['raw_data']] == TRUE){ -#' val_stats <- create_named_list(validation_overall, validation_grouping, validation_timeseries, raw_stats = fc_stats) -#' } #end raw data TRUE -#' } else { -#' #normal return with just results -#' val_stats <- create_named_list(validation_overall, validation_grouping, validation_timeseries) -#' } -#' } #end calc_val_stats() -#' -#' -#' #' Get overall model validation statistics -#' #' -#' #' Small function to pull out just overall validation statistics. -#' #' -#' #' @param validations The set of validation statistics produced by -#' #' run_validation() - only the list of validation data sets, not including the skill metrics. -#' #' -#' #' @return A list of tibbles containing only the model overall statistics (and -#' #' not including the geographic grouping results, if present). -#' #' -#' #' @export -#' #' -#' get_overall_validations <- function(validations){ -#' lapply(validations, `[[`, "validation_overall") -#' } -#' -#' -#' #' Get geographic grouping model validation statistics -#' #' -#' #' Small function to pull out just the geographic grouping validation statistics. -#' #' -#' #' @param validations The set of validation statistics produced by -#' #' run_validation() - only the list of validation data sets, not including the skill metrics. -#' #' -#' #' @return A list of tibbles containing only the model geographic grouping statistics. -#' #' -#' #' @export -#' #' -#' get_group_validations <- function(validations){ -#' lapply(validations, `[[`, "validation_grouping") -#' } -#' -#' -#' -#' #' Calculate model skill comparison statistics -#' #' -#' #' Helper function to calculate the relative improvement of the forecast over the specified naive model. -#' #' Skill score = (score_fc - score_naive) / (score_perfect - score_naive) -#' #' Skill metric has an upper bound of 1. No improvement is 0. Lower bound depends on statistic. -#' #' -#' #'@param fc_stat The forecast model statistic value. -#' #'@param naive_stat The naive model statistic value (same statistic as forecast model). -#' #'@param perfect_stat The value of a perfect score for that stastistic. -#' #' -#' #'@return Skill score: the relative improvement the forecast model has over the naive model. -#' #' -#' #'@export -#' #' -#' calc_skill_stat <- function(fc_stat, naive_stat, perfect_stat){ -#' skill_stat <- (fc_stat - naive_stat) / (perfect_stat - naive_stat) -#' } -#' -#' -#' #' Calculate the forecast model skill score compared to the naive model predictions. -#' #' -#' #'@param val_list A list of 3 datasets of validation results: the first is the forecast model, the following two are the naive model results, as created by binding the results of calc_val_stats() in run_validation(). -#' #'@param grp Optional inclusion of quo_groupfield when calculating skill scores by groupfield. -#' #' -#' #'@return Single dataset with skill scores of the main forecast model against each of the naive models, per timestep ahead, and optionally, per geographic grouping -#' #' -#' calc_skill <- function(val_list, grp = NULL){ -#' -#' #separate out, rename columns, and join/crossing -#' val_fc <- val_list[[1]] %>% -#' dplyr::rename(fc_MAE = MAE, -#' fc_RMSE = RMSE, -#' #fc_prop_interval = prop_interval, -#' fc_R2 = R2) %>% -#' dplyr::select(group_cols(), timestep_ahead, starts_with("fc_")) -#' -#' val_np <- val_list$`naive-persistence` %>% -#' dplyr::rename(np_MAE = MAE, -#' np_RMSE = RMSE, -#' #np_prop_interval = prop_interval, -#' np_R2 = R2) %>% -#' dplyr::select(group_cols(), timestep_ahead, starts_with("np_")) -#' -#' val_naw <- val_list$`naive-averageweek` %>% -#' rename(naw_MAE = MAE, -#' naw_RMSE = RMSE, -#' #naw_prop_interval = prop_interval, -#' naw_R2 = R2) %>% -#' #no timestep_ahead for average week, all same -#' select(group_cols(), starts_with("naw_")) -#' -#' #appropriate joins -#' if (is.null(grp)){ -#' #join together -#' val_join <- val_fc %>% -#' #join with persistence -#' dplyr::left_join(val_np, -#' by = "timestep_ahead") %>% -#' #join with average week (1 value to all timesteps ahead) -#' tidyr::crossing(val_naw) -#' } else { -#' #else join with groupfield -#' #join together -#' val_join <- val_fc %>% -#' #join with persistence -#' dplyr::left_join(val_np, -#' #NSE fun -#' by = rlang::set_names(c(rlang::quo_name(grp), -#' "timestep_ahead"), -#' c(rlang::quo_name(grp), -#' "timestep_ahead"))) %>% -#' #join with average week (1 value to all timesteps ahead) -#' dplyr::left_join(val_naw, -#' by = rlang::set_names(rlang::quo_name(grp), -#' rlang::quo_name(grp))) -#' } #end joinings -#' -#' #perfect skill metrics -#' perfect_MAE <- 0 -#' perfect_RMSE <- 0 -#' #perfect_prop_interval <- 1 -#' perfect_R2 <- 1 -#' -#' #calc skill metrics of fc model to each of naive models -#' val_skill <- val_join %>% -#' mutate(skill_MAE_persistence = calc_skill_stat(fc_MAE, np_MAE, perfect_MAE), -#' skill_RMSE_persistence = calc_skill_stat(fc_RMSE, np_RMSE, perfect_RMSE), -#' #skill_interval_persistence = calc_skill_stat(fc_prop_interval, np_prop_interval, -#' # perfect_prop_interval), -#' skill_R2_persistence = calc_skill_stat(fc_R2, np_R2, perfect_R2), -#' skill_MAE_averageweek = calc_skill_stat(fc_MAE, naw_MAE, perfect_MAE), -#' skill_RMSE_averageweek = calc_skill_stat(fc_RMSE, naw_RMSE, perfect_RMSE), -#' #skill_interval_averageweek = calc_skill_stat(fc_prop_interval, naw_prop_interval, -#' # perfect_prop_interval), -#' skill_R2_averageweek = calc_skill_stat(fc_R2, naw_R2, perfect_R2)) %>% -#' #select final stats only -#' select(group_cols(), timestep_ahead, starts_with("skill_")) -#' -#' val_skill -#' } -#' -#' -#' -#' #' Save overall model validation statistics -#' #' -#' #' Small function to pull out just overall validation statistics and save to -#' #' csv. -#' #' -#' #' @param validations The set of validation statistics produced by -#' #' run_validation() - only the list of validation data sets, not including the skill metrics. -#' #' @param save_file File name to save results into csv format -#' #' -#' #' @return A csv file containing only the model overall statistics (and not -#' #' including the geographic grouping results, if present). -#' #' -#' #' @export -#' #' -#' save_overall_validations <- function(validations, save_file){ -#' lapply(validations, `[[`, "validation_overall") %>% -#' bind_rows(.id = "model") %>% -#' write_csv(save_file) -#' } -#' -#' -#' #' Save geographic grouping model validation statistics -#' #' -#' #' Small function to pull out validation statistics per geographic grouping and -#' #' save to csv. -#' #' -#' #' @param validations The set of validation statistics produced by -#' #' run_validation() - only the list of validation data sets, not including the skill metrics. -#' #' @param save_file File name to save results into csv format -#' #' -#' #' @return A csv file containing the model validation statistics for the -#' #' geographic grouping results. -#' #' -#' #' @export -#' #' -#' save_geog_validations <- function(validations, save_file){ -#' lapply(validations, `[[`, "validation_grouping") %>% -#' bind_rows(.id = "model") %>% -#' write_csv(save_file) -#' } + +#'Run EPIDEMIA model validation statistics +#' +#'This function takes a few more arguments than `epidemiar::run_epidemia()` to +#'generate statistics on model validation. The function will evaluate a number +#'of weeks (`total_timesteps`) starting from a specified week (`date_start`) and +#'will look at the n-week ahead forecast (1 to `timesteps_ahead` number of +#'weeks) and compare the values to the observed number of cases. An optional +#'`reporting_lag` argument will censor the last known data back that number of +#'weeks. The validation statistics include Root Mean Squared Error (RMSE) and +#'Mean Absolute Error (MAE), and an R-squared staistic both in total and per +#'geographic grouping (if present). +#' +#'@param date_start Date to start testing for model validation. +#'@param total_timesteps Number of weeks from `week_start` to run validation +#' tests. +#'@param timesteps_ahead Number of weeks for testing the n-week ahead forecasts. +#' Results will be generated from 1-week ahead through `weeks_ahead` number of +#' weeks. +#'@param reporting_lag Number of timesteps to simulate reporting lag. For +#' instance, if you have weekly data, and a reporting_lag of 1 week, and are +#' working with a timesteps_ahead of 1 week, then that is functional equivalent +#' to reporting lag of 0, and timesteps_ahead of 2 weeks. I.e. You are +#' forecasting next week, but you don't know this week's data yet, you only +#' know last week's numbers. +#'@param per_timesteps When creating a timeseries of validation results, create +#' a moving window with per_timesteps width number of time points. Should be a +#' minimum of 10 timesteps. +#'@param skill_test Logical parameter indicating whether or not to run +#' validations also on two naïve models for a skill test comparison. The naïve +#' models are "persistence": the last known value (case counts) carried +#' forward, and "average week" where the predicted value is the average of that +#' week of the year, as calculated from historical data. +#'@param epi_data See description in `run_epidemia()`. +#'@param env_data See description in `run_epidemia()`. +#'@param env_ref_data See description in `run_epidemia()`. +#'@param env_info See description in `run_epidemia()`. +#'@param casefield See description in `run_epidemia()`. +#'@param groupfield See description in `run_epidemia()`. +#'@param populationfield See description in `run_epidemia()`. +#'@param obsfield See description in `run_epidemia()`. +#'@param valuefield See description in `run_epidemia()`. +#'@param fc_model_family See description in `run_epidemia()`. +#'@param report_settings See description in `run_epidemia()`. +#'@param ... Accepts other arguments that may normally part of `run_epidemia()`, +#' but ignored for validation runs. +#' +#' +#'@return Returns a nested list of validation results. Statistics are calculated +#' on the n-week ahead forecast and the actual observed case counts. Statistics +#' returned are Mean Absolute Error (MAE), Root Mean Squared Error (RMSE). The +#' first object is `skill_scores`, which contains `skill_overall` and +#' `skill_grouping`. The second list is `validations`, which contains lists per +#' model run (the forecast model and then optionally the naive models). Within +#' each, `validation_overall` is the results overall, and `validation_grouping` +#' is the results per geographic grouping. Lastly, a `metadata` list contains +#' the important parameter settings used to run validation and when the results +#' where generated. +#' +#'@export +#' +run_validation <- function(date_start = NULL, + total_timesteps = 26, + timesteps_ahead = 2, + reporting_lag = 0, + per_timesteps = 12, + skill_test = TRUE, + #for run_epidemia() + epi_data = NULL, + env_data = NULL, + env_ref_data = NULL, + env_info = NULL, + #fields + casefield = NULL, + groupfield = NULL, + populationfield = NULL, + obsfield = NULL, + valuefield = NULL, + #required settings + fc_model_family = NULL, + #optional + report_settings = NULL, + ...){ + + #date_start: week to start reporting of results + #total_timesteps: number of weeks forward from week_start to gather test results + #timesteps_ahead: calculate stats on 1 to n week ahead predictions + + #this means that the start of calculations will be date_start minus timesteps_ahead # of weeks + #then trimmed at the end to start at date_start. + + # Non-standard evaluation quosures ---------------------------------------- + + # dplyr programming steps for passing of field names + quo_casefield <- rlang::enquo(casefield) + quo_popfield <- rlang::enquo(populationfield) + quo_groupfield <- rlang::enquo(groupfield) + quo_obsfield <- rlang::enquo(obsfield) + quo_valuefield <- rlang::enquo(valuefield) + + #Note: if field name does not exist in any dataset, enquo() will throw an error. + + + # Adjust parameters for validation runs ----------------------------------- + + #Assumed that run_epidemia() parameters just copied and pasted, so adjust for validation + #new lengths + report_settings[["fc_future_period"]] <- timesteps_ahead + reporting_lag + report_settings[["report_period"]] <- report_settings[["fc_future_period"]] + 1 + #no event detection + report_settings[["ed_summary_period"]] <- 1 # 0 throws an error. with method = "none", no ED takes place + report_settings[["ed_method"]] <- "none" + #report out in CASES for validation + report_settings[["report_value_type"]] <- "cases" + #model run would make no sense here + report_settings[["model_run"]] <- FALSE + + + #for any future params accepted by run_epidemia, but are meaningless for validation runs + # Captured, but then do nothing with them + # Also used for hidden raw_data argument for testing/development + # could have placed inside report_settings, but this was created first this way + dots <- list(...) + + #Create parameter metadata + metadata <- create_named_list(date_created = Sys.Date(), + date_start, + total_timesteps, + timesteps_ahead, + reporting_lag, + per_timesteps, + skill_test, + casefield = rlang::quo_name(quo_casefield)) + + + # All loop prep ------------------------------------------------------ + + #Set up for looping + #preserve full data + epi_data_orig <- epi_data + env_data_orig <- env_data + + #Pull obs from original + # Will have extra dates, but will be trimmed back to user requested dates later + obs_only <- epi_data_orig %>% + dplyr::select(!!quo_groupfield, .data$obs_date, !!quo_casefield) %>% + #rename observation + dplyr::rename(obs = !!rlang::quo_name(quo_casefield)) + + + #Skill test loop set up + if (skill_test == TRUE){ + models_to_run = c(fc_model_family, "naive-persistence", "naive-averageweek") + } else { + models_to_run = c(fc_model_family) + } + + # Skill test loop --------------------------------------------------------- + + #skill test collection + all_validations <- vector("list", length = length(models_to_run)) + #add names + names(all_validations) <- models_to_run + + #model loop + for (m in seq_along(models_to_run)){ + + this_model <- models_to_run[m] + + #If naive-averageweek, timesteps_ahead is meaningless, just use 1 + if (this_model == "naive-averageweek"){ + + this_timesteps_ahead <- 1 + this_report_settings <- report_settings + this_report_settings[["fc_future_period"]] <- this_timesteps_ahead + this_report_settings[["report_period"]] <- this_report_settings[["fc_future_period"]] + 1 + + } else { + #use modified fc_future_period which is timesteps_ahead + reporting_lag + + this_report_settings <- report_settings + this_timesteps_ahead <- this_report_settings[["fc_future_period"]] + + } + + # Week loop --------------------------------------------------------------- + + #Create list of dates + #the start of calculations will be date_start minus timesteps_ahead # of weeks + date_list <- date_start + lubridate::weeks(-this_timesteps_ahead:(total_timesteps-1)) + + #output will be list of dataframes (forecasts) until we collapse later + fcs_list <- vector("list", length = length(date_list)) + + #loop + for (i in seq_along(date_list)){ + this_dt <- date_list[i] + + message("Validation run - date: ", this_dt) # for testing for now + + #set up data + #censoring as appropriate + #reporting_lag will be handled with offset timesteps + epi_data <- epi_data_orig %>% + dplyr::filter(.data$obs_date <= this_dt) + env_data <- env_data_orig %>% + dplyr::filter(.data$obs_date <= this_dt) + + #run_epidemia + #passing quosures, which will have an escape built into run_epidemia() + reportdata <- run_epidemia(epi_data = epi_data, + env_data = env_data, + env_ref_data = env_ref_data, + env_info = env_info, + casefield = quo_casefield, + groupfield = quo_groupfield, + populationfield = quo_popfield, + obsfield = quo_obsfield, + valuefield = quo_valuefield, + fc_model_family = fc_model_family, + report_settings = this_report_settings) #this + + + #pull needed and reformat + fcs_list[[i]] <- reportdata$modeling_results_data %>% + #get forecasts only + dplyr::filter(.data$series == "fc") %>% + #get base date of report ('current date' in relation to forecast) + dplyr::mutate(preadj_date = this_dt, + #how many weeks ahead is the prediction (not adjusting for reporting lag yet) + timestep_ahead_orig = difftime(.data$obs_date, .data$preadj_date) %>% + as.numeric(units = "weeks")) %>% + #don't need 0 week predictions (same week) + dplyr::filter(.data$timestep_ahead_orig > 0) + + + } #end timestep loop + + #have list of dataframes + #collapse/bindrows + fcs_only <- dplyr::bind_rows(fcs_list) %>% + #nicely arrange + dplyr::arrange(!!quo_groupfield, .data$timestep_ahead_orig, .data$obs_date) + + + #join with the obs only extract to get observation series + fc_join <- fcs_only %>% + dplyr::left_join(obs_only, + #NSE fun + by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + "obs_date"), + c(rlang::quo_name(quo_groupfield), + "obs_date"))) + + #make all the reporting_lag adjustments + # basically, we ran extra forecast future steps + # so we now can simply shift everything backwards except for averageweek + if (this_model == "naive-averageweek"){ + fc_join <- fc_join %>% + dplyr::mutate(run_date = .data$preadj_date, + #timestep_ahead is meaningless for average week. + # NA may cause unexpected results with grouping, so replace with 0 + timestep_ahead = 0, + #Add column for showing reporting_lag + reporting_lag = reporting_lag) + } else { + fc_join <- fc_join %>% + dplyr::mutate(run_date = .data$preadj_date - lubridate::weeks(reporting_lag), + timestep_ahead = .data$timestep_ahead_orig - reporting_lag, + #Add column for showing reporting_lag + reporting_lag = reporting_lag) %>% + #filter out the timesteps that are now less than 1 step + dplyr::filter(.data$timestep_ahead > 0) + } + + + #Filter to report weeks (trim off edges gathered b/c of weeks_ahead, etc.) + fc_trim <- fc_join %>% + dplyr::filter(dplyr::between(.data$obs_date, + date_start, + date_start + lubridate::weeks(total_timesteps-1))) + + + ## Calculate statistics + val_results <- calc_val_stats(fc_trim, + quo_groupfield, + per_timesteps, + dots) + + #add results to list by name + all_validations[[this_model]] <- val_results + + } #end model loop + + + + #Get skill test list of results + if (skill_test == TRUE){ + #calc skill comparison statistics + skill_overall <- calc_skill(get_overall_validations(all_validations)) + skill_grouping <- calc_skill(get_group_validations(all_validations), quo_groupfield) + skill_scores <- create_named_list(skill_overall, skill_grouping) + + val_return <- create_named_list(skill_scores, + validations = all_validations, + metadata) + } else { + #just the one model validation datasets + val_return <- create_named_list(all_validations, + metadata) + } + + message("Validation run finished.") + val_return + +} #end run validation + + + +#'Calculate validation statistics from forecast results. +#' +#'Helper function to calculate the validation statistics from each model run. +#'Mean Absolute Error (MAE), Root Mean Square Error (RMSE), Proportion of +#'observations in in prediction interval, and R^2. Calculates it both at a +#'global model level per timestep ahead, and at a geographical grouping level +#'per timestep ahead. Also calculates a timeseries of evaluation metrics at +#'every per_timesteps number of timesteps per grouping (if applicable) and +#'timestep_ahead. +#' +#'@param fc_trim The forecast results of one model type, combined with observed +#' values, trimmed to user requested date range. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_validation()/run_epidemia(). +#'@param per_timesteps When creating a timeseries of validation results, create +#' a moving window with per_timesteps width number of time points. Should be a +#' minimum of 10 timesteps. +#'@param dots The non-required arguments to run_validation() for developer +#' testing. +#' +#'@return A named list of validation statistic results: validation_overall, +#' validation_grouping, validation_timeseries +#' +calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ + # MAE: mean(|obs - pred|) + # RMSE: sqrt(mean((obs - pred)^2)) + # R2 (R^2): 1 - SSE/TSS. SSE = sum((obs-pred)^2). TSS = sum((obs - mean(obs))^2). + # B/c involves mean of group of observations, must be calculated after grouping + + #Removed + # Proportion in Interval: 1/T if inside, summed. Over all non-NA entries. + + #per line stats + fc_stats <- fc_trim %>% + dplyr::mutate(diff = .data$obs - .data$value, + absdiff = abs(.data$diff), + diffsq = .data$diff ^ 2) + #,predinterval = ifelse(obs >= lower & obs <= upper, TRUE, FALSE)) + + + #overall timestep_ahead + validation_overall <- fc_stats %>% + dplyr::group_by(.data$timestep_ahead) %>% + #Now calc TSS part of R2 + dplyr::mutate(meanobs = mean(.data$obs), + total_squares = (.data$obs - .data$meanobs)^2) %>% + #stat calc + dplyr::summarize(MAE = mean(.data$absdiff, na.rm = TRUE), + MSE = mean(.data$diffsq, na.rm = TRUE), + #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), + SSE = sum(.data$diffsq, na.rm = TRUE), + TSS = sum(.data$total_squares, na.rm = TRUE)) %>% + #and mutate for final calc + dplyr::mutate(RMSE = sqrt(.data$MSE), + R2 = 1 - (.data$SSE / .data$TSS)) %>% + #drop unneeded columns + dplyr::select(-.data$SSE, -.data$TSS, -.data$MSE) + + + + #overall timestep_ahead by grouping + validation_grouping <- fc_stats %>% + dplyr::group_by(!!quo_groupfield, .data$timestep_ahead) %>% + #Now calc TSS part of R2 + dplyr::mutate(meanobs = mean(.data$obs), + total_squares = (.data$obs - .data$meanobs)^2) %>% + #stat calc + dplyr::summarize(MAE = mean(.data$absdiff, na.rm = TRUE), + MSE = mean(.data$diffsq, na.rm = TRUE), + #prop_interval = sum(predinterval, na.rm = TRUE) / sum(!is.na(predinterval)), + SSE = sum(.data$diffsq, na.rm = TRUE), + TSS = sum(.data$total_squares, na.rm = TRUE)) %>% + #and mutate for final calc + dplyr::mutate(RMSE = sqrt(.data$MSE), + R2 = 1 - (.data$SSE / .data$TSS)) %>% + #drop unneeded columns + dplyr::select(-.data$SSE, -.data$TSS, -.data$MSE) + + + + #timeseries calculations + # minimum of ~10 timesteps per summary + # ROLLING window + validation_timeseries <- fc_stats %>% + dplyr::group_by(!!quo_groupfield, .data$timestep_ahead) %>% + #rollapply for get mean of obs + dplyr::mutate(meanobs = zoo::rollmeanr(x = .data$obs, + k = per_timesteps, + fill = NA), + total_squares = (.data$obs - .data$meanobs)^2, + MAE = zoo::rollmeanr(x = .data$absdiff, + k = per_timesteps, + fill = NA), + MSE = zoo::rollmeanr(x = .data$diffsq, + k = per_timesteps, + fill = NA), + RMSE = sqrt(.data$MSE), + #prop_interval = zoo::rollsumr(x = predinterval, + # k = per_timesteps, + # fill = NA) / + # zoo::rollsumr(x = !is.na(predinterval), + # k = per_timesteps, + # fill = NA), + SSE = zoo::rollsumr(x = .data$diffsq, + k = per_timesteps, + fill = NA), + TSS = zoo::rollsumr(x = .data$total_squares, + k = per_timesteps, + fill = NA), + R2 = 1 - (.data$SSE / .data$TSS)) %>% + #rename columns to be clearer + dplyr::rename(forecast = .data$value, + observed = .data$obs) %>% + # drop unneeded columns + dplyr::select(-.data$series, -.data$preadj_date, -.data$timestep_ahead_orig, -.data$run_date, + -.data$diff, -.data$absdiff, -.data$diffsq, -.data$meanobs, + -.data$total_squares, -.data$MSE, -.data$SSE, -.data$TSS) %>% + # for now, drop R2 until can figure out how to include better + dplyr::select(-.data$R2) + + + + #return all + # and raw data with hidden option + #possibly make "time series" version for clean full data table + if (!is.null(dots[['raw_data']])){ + if (dots[['raw_data']] == TRUE){ + val_stats <- create_named_list(validation_overall, + validation_grouping, + validation_timeseries, + raw_stats = fc_stats) + } #end raw data TRUE + } else { + #normal return with just results + val_stats <- create_named_list(validation_overall, + validation_grouping, + validation_timeseries) + } +} #end calc_val_stats() + + +#' Get overall model validation statistics +#' +#' Small function to pull out just overall validation statistics. +#' +#' @param validations The set of validation statistics produced by +#' run_validation() - only the list of validation data sets, not including the skill metrics. +#' +#' @return A list of tibbles containing only the model overall statistics (and +#' not including the geographic grouping results, if present). +#' +#' @export +#' +get_overall_validations <- function(validations){ + lapply(validations, `[[`, "validation_overall") +} + + +#' Get geographic grouping model validation statistics +#' +#' Small function to pull out just the geographic grouping validation statistics. +#' +#' @param validations The set of validation statistics produced by +#' run_validation() - only the list of validation data sets, not including the skill metrics. +#' +#' @return A list of tibbles containing only the model geographic grouping statistics. +#' +#' @export +#' +get_group_validations <- function(validations){ + lapply(validations, `[[`, "validation_grouping") +} + + + +#' Calculate model skill comparison statistics +#' +#' Helper function to calculate the relative improvement of the forecast over the specified naive model. +#' Skill score = (score_fc - score_naive) / (score_perfect - score_naive) +#' Skill metric has an upper bound of 1. No improvement is 0. Lower bound depends on statistic. +#' +#'@param fc_stat The forecast model statistic value. +#'@param naive_stat The naive model statistic value (same statistic as forecast model). +#'@param perfect_stat The value of a perfect score for that stastistic. +#' +#'@return Skill score: the relative improvement the forecast model has over the naive model. +#' +#'@export +#' +calc_skill_stat <- function(fc_stat, naive_stat, perfect_stat){ + skill_stat <- (fc_stat - naive_stat) / (perfect_stat - naive_stat) +} + + +#' Calculate the forecast model skill score compared to the naive model predictions. +#' +#'@param val_list A list of 3 datasets of validation results: the first is the forecast model, the following two are the naive model results, as created by binding the results of calc_val_stats() in run_validation(). +#'@param grp Optional inclusion of quo_groupfield when calculating skill scores by groupfield. +#' +#'@return Single dataset with skill scores of the main forecast model against each of the naive models, per timestep ahead, and optionally, per geographic grouping +#' +calc_skill <- function(val_list, grp = NULL){ + + #separate out, rename columns, and join/crossing + val_fc <- val_list[[1]] %>% + dplyr::rename(fc_MAE = .data$MAE, + fc_RMSE = .data$RMSE, + #fc_prop_interval = prop_interval, + fc_R2 = .data$R2) %>% + dplyr::select(dplyr::group_cols(), .data$timestep_ahead, dplyr::starts_with("fc_")) + + val_np <- val_list$`naive-persistence` %>% + dplyr::rename(np_MAE = .data$MAE, + np_RMSE = .data$RMSE, + #np_prop_interval = prop_interval, + np_R2 = .data$R2) %>% + dplyr::select(dplyr::group_cols(), .data$timestep_ahead, dplyr::starts_with("np_")) + + val_naw <- val_list$`naive-averageweek` %>% + dplyr::rename(naw_MAE = .data$MAE, + naw_RMSE = .data$RMSE, + #naw_prop_interval = prop_interval, + naw_R2 = .data$R2) %>% + #no timestep_ahead for average week, all same + dplyr::select(dplyr::group_cols(), dplyr::starts_with("naw_")) + + #appropriate joins + if (is.null(grp)){ + #join together + val_join <- val_fc %>% + #join with persistence + dplyr::left_join(val_np, + by = "timestep_ahead") %>% + #join with average week (1 value to all timesteps ahead) + tidyr::crossing(val_naw) + } else { + #else join with groupfield + #join together + val_join <- val_fc %>% + #join with persistence + dplyr::left_join(val_np, + #NSE fun + by = rlang::set_names(c(rlang::quo_name(grp), + "timestep_ahead"), + c(rlang::quo_name(grp), + "timestep_ahead"))) %>% + #join with average week (1 value to all timesteps ahead) + dplyr::left_join(val_naw, + by = rlang::set_names(rlang::quo_name(grp), + rlang::quo_name(grp))) + } #end joinings + + #perfect skill metrics + perfect_MAE <- 0 + perfect_RMSE <- 0 + #perfect_prop_interval <- 1 + perfect_R2 <- 1 + + #calc skill metrics of fc model to each of naive models + val_skill <- val_join %>% + dplyr::mutate(skill_MAE_persistence = calc_skill_stat(.data$fc_MAE, .data$np_MAE, perfect_MAE), + skill_RMSE_persistence = calc_skill_stat(.data$fc_RMSE, .data$np_RMSE, perfect_RMSE), + #skill_interval_persistence = calc_skill_stat(.data$fc_prop_interval, .data$np_prop_interval, + # perfect_prop_interval), + skill_R2_persistence = calc_skill_stat(.data$fc_R2, .data$np_R2, perfect_R2), + skill_MAE_averageweek = calc_skill_stat(.data$fc_MAE, .data$naw_MAE, perfect_MAE), + skill_RMSE_averageweek = calc_skill_stat(.data$fc_RMSE, .data$naw_RMSE, perfect_RMSE), + #skill_interval_averageweek = calc_skill_stat(.data$fc_prop_interval, .data$naw_prop_interval, + # perfect_prop_interval), + skill_R2_averageweek = calc_skill_stat(.data$fc_R2, .data$naw_R2, perfect_R2)) %>% + #select final stats only + dplyr::select(dplyr::group_cols(), .data$timestep_ahead, dplyr::starts_with("skill_")) + + val_skill +} + + + +#' Save overall model validation statistics +#' +#' Small function to pull out just overall validation statistics and save to +#' csv. +#' +#' @param validations The set of validation statistics produced by +#' run_validation() - only the list of validation data sets, not including the skill metrics. +#' @param save_file File name to save results into csv format +#' +#' @return A csv file containing only the model overall statistics (and not +#' including the geographic grouping results, if present). +#' +#' @export +#' +save_overall_validations <- function(validations, save_file){ + lapply(validations, `[[`, "validation_overall") %>% + dplyr::bind_rows(.id = "model") %>% + readr::write_csv(save_file) +} + + +#' Save geographic grouping model validation statistics +#' +#' Small function to pull out validation statistics per geographic grouping and +#' save to csv. +#' +#' @param validations The set of validation statistics produced by +#' run_validation() - only the list of validation data sets, not including the skill metrics. +#' @param save_file File name to save results into csv format +#' +#' @return A csv file containing the model validation statistics for the +#' geographic grouping results. +#' +#' @export +#' +save_geog_validations <- function(validations, save_file){ + lapply(validations, `[[`, "validation_grouping") %>% + dplyr::bind_rows(.id = "model") %>% + readr::write_csv(save_file) +} diff --git a/R/run_epidemia.R b/R/run_epidemia.R index e49fbf8..52a1b6d 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -136,10 +136,12 @@ run_epidemia <- function(epi_data = NULL, # For validation runs, special escapes ------------------------------------ valid_run <- FALSE calling_check <- as.list(sys.call(-1)) + #print(calling_check) if (length(calling_check) > 0){ calling_function <- as.list(sys.call(-1))[[1]] + #print(calling_function) } else {calling_function <- "directly"} - if(calling_function == "run_validation"){ + if(calling_function == "run_validation" | calling_function == "epidemiar::run_validation"){ valid_run <- TRUE message("Running model validation...") #rename already enquo'd variables @@ -492,7 +494,8 @@ run_epidemia <- function(epi_data = NULL, # fc_future_period is how many of those weeks should be in the future. #full report report_dates <- list(full = list(min = max(epi_data$obs_date, na.rm = TRUE) - - lubridate::as.difftime((report_settings[["report_period"]] - report_settings[["fc_future_period"]] - 1), + lubridate::as.difftime((report_settings[["report_period"]] - + report_settings[["fc_future_period"]] - 1), unit = "weeks"), max = max(epi_data$obs_date, na.rm = TRUE) + lubridate::as.difftime(report_settings[["fc_future_period"]], From 9a8b26226cfb6f5fd9924c47faee8a4afb8db85e Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 19 Feb 2020 13:50:03 -0600 Subject: [PATCH 010/132] Added readr package dependency --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 907cec7..ec06c8e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,6 +26,7 @@ Imports: dplyr (>= 0.8.3), mgcv (>= 1.8-28), parallel (>= 3.6.1), pracma (>= 2.2.5), + readr (>= 1.3.1), rlang (>= 0.4.0), surveillance (>= 1.17.0), splines (>= 3.6.1), From 72baa3219b256c286371d57fcae3f37763c70a0e Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 19 Feb 2020 13:50:56 -0600 Subject: [PATCH 011/132] Autoupdated documentation --- NAMESPACE | 6 +++ man/calc_skill.Rd | 19 +++++++ man/calc_skill_stat.Rd | 23 +++++++++ man/calc_val_stats.Rd | 35 +++++++++++++ man/get_group_validations.Rd | 18 +++++++ man/get_overall_validations.Rd | 19 +++++++ man/run_validation.Rd | 89 +++++++++++++++++++++++++++++++++ man/save_geog_validations.Rd | 22 ++++++++ man/save_overall_validations.Rd | 22 ++++++++ 9 files changed, 253 insertions(+) create mode 100644 man/calc_skill.Rd create mode 100644 man/calc_skill_stat.Rd create mode 100644 man/calc_val_stats.Rd create mode 100644 man/get_group_validations.Rd create mode 100644 man/get_overall_validations.Rd create mode 100644 man/run_validation.Rd create mode 100644 man/save_geog_validations.Rd create mode 100644 man/save_overall_validations.Rd diff --git a/NAMESPACE b/NAMESPACE index 2bf360f..2e54a61 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,13 +2,19 @@ export(Mode) export(add_datefields) +export(calc_skill_stat) export(create_named_list) export(data_to_daily) export(env_daily_to_ref) export(epiwday) +export(get_group_validations) +export(get_overall_validations) export(make_date_yw) export(na_approx) export(run_epidemia) +export(run_validation) +export(save_geog_validations) +export(save_overall_validations) importFrom(magrittr,"%>%") importFrom(rlang,"!!") importFrom(rlang,":=") diff --git a/man/calc_skill.Rd b/man/calc_skill.Rd new file mode 100644 index 0000000..d5dd518 --- /dev/null +++ b/man/calc_skill.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{calc_skill} +\alias{calc_skill} +\title{Calculate the forecast model skill score compared to the naive model predictions.} +\usage{ +calc_skill(val_list, grp = NULL) +} +\arguments{ +\item{val_list}{A list of 3 datasets of validation results: the first is the forecast model, the following two are the naive model results, as created by binding the results of calc_val_stats() in run_validation().} + +\item{grp}{Optional inclusion of quo_groupfield when calculating skill scores by groupfield.} +} +\value{ +Single dataset with skill scores of the main forecast model against each of the naive models, per timestep ahead, and optionally, per geographic grouping +} +\description{ +Calculate the forecast model skill score compared to the naive model predictions. +} diff --git a/man/calc_skill_stat.Rd b/man/calc_skill_stat.Rd new file mode 100644 index 0000000..eeb363b --- /dev/null +++ b/man/calc_skill_stat.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{calc_skill_stat} +\alias{calc_skill_stat} +\title{Calculate model skill comparison statistics} +\usage{ +calc_skill_stat(fc_stat, naive_stat, perfect_stat) +} +\arguments{ +\item{fc_stat}{The forecast model statistic value.} + +\item{naive_stat}{The naive model statistic value (same statistic as forecast model).} + +\item{perfect_stat}{The value of a perfect score for that stastistic.} +} +\value{ +Skill score: the relative improvement the forecast model has over the naive model. +} +\description{ +Helper function to calculate the relative improvement of the forecast over the specified naive model. +Skill score = (score_fc - score_naive) / (score_perfect - score_naive) +Skill metric has an upper bound of 1. No improvement is 0. Lower bound depends on statistic. +} diff --git a/man/calc_val_stats.Rd b/man/calc_val_stats.Rd new file mode 100644 index 0000000..82d8bcd --- /dev/null +++ b/man/calc_val_stats.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{calc_val_stats} +\alias{calc_val_stats} +\title{Calculate validation statistics from forecast results.} +\usage{ +calc_val_stats(fc_trim, quo_groupfield, per_timesteps, dots) +} +\arguments{ +\item{fc_trim}{The forecast results of one model type, combined with observed +values, trimmed to user requested date range.} + +\item{quo_groupfield}{Quosure of the user given geographic grouping field to +run_validation()/run_epidemia().} + +\item{per_timesteps}{When creating a timeseries of validation results, create +a moving window with per_timesteps width number of time points. Should be a +minimum of 10 timesteps.} + +\item{dots}{The non-required arguments to run_validation() for developer +testing.} +} +\value{ +A named list of validation statistic results: validation_overall, + validation_grouping, validation_timeseries +} +\description{ +Helper function to calculate the validation statistics from each model run. +Mean Absolute Error (MAE), Root Mean Square Error (RMSE), Proportion of +observations in in prediction interval, and R^2. Calculates it both at a +global model level per timestep ahead, and at a geographical grouping level +per timestep ahead. Also calculates a timeseries of evaluation metrics at +every per_timesteps number of timesteps per grouping (if applicable) and +timestep_ahead. +} diff --git a/man/get_group_validations.Rd b/man/get_group_validations.Rd new file mode 100644 index 0000000..4e4bf04 --- /dev/null +++ b/man/get_group_validations.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{get_group_validations} +\alias{get_group_validations} +\title{Get geographic grouping model validation statistics} +\usage{ +get_group_validations(validations) +} +\arguments{ +\item{validations}{The set of validation statistics produced by +run_validation() - only the list of validation data sets, not including the skill metrics.} +} +\value{ +A list of tibbles containing only the model geographic grouping statistics. +} +\description{ +Small function to pull out just the geographic grouping validation statistics. +} diff --git a/man/get_overall_validations.Rd b/man/get_overall_validations.Rd new file mode 100644 index 0000000..2ad5403 --- /dev/null +++ b/man/get_overall_validations.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{get_overall_validations} +\alias{get_overall_validations} +\title{Get overall model validation statistics} +\usage{ +get_overall_validations(validations) +} +\arguments{ +\item{validations}{The set of validation statistics produced by +run_validation() - only the list of validation data sets, not including the skill metrics.} +} +\value{ +A list of tibbles containing only the model overall statistics (and + not including the geographic grouping results, if present). +} +\description{ +Small function to pull out just overall validation statistics. +} diff --git a/man/run_validation.Rd b/man/run_validation.Rd new file mode 100644 index 0000000..5adec0a --- /dev/null +++ b/man/run_validation.Rd @@ -0,0 +1,89 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{run_validation} +\alias{run_validation} +\title{Run EPIDEMIA model validation statistics} +\usage{ +run_validation(date_start = NULL, total_timesteps = 26, + timesteps_ahead = 2, reporting_lag = 0, per_timesteps = 12, + skill_test = TRUE, epi_data = NULL, env_data = NULL, + env_ref_data = NULL, env_info = NULL, casefield = NULL, + groupfield = NULL, populationfield = NULL, obsfield = NULL, + valuefield = NULL, fc_model_family = NULL, report_settings = NULL, + ...) +} +\arguments{ +\item{date_start}{Date to start testing for model validation.} + +\item{total_timesteps}{Number of weeks from `week_start` to run validation +tests.} + +\item{timesteps_ahead}{Number of weeks for testing the n-week ahead forecasts. +Results will be generated from 1-week ahead through `weeks_ahead` number of +weeks.} + +\item{reporting_lag}{Number of timesteps to simulate reporting lag. For +instance, if you have weekly data, and a reporting_lag of 1 week, and are +working with a timesteps_ahead of 1 week, then that is functional equivalent +to reporting lag of 0, and timesteps_ahead of 2 weeks. I.e. You are +forecasting next week, but you don't know this week's data yet, you only +know last week's numbers.} + +\item{per_timesteps}{When creating a timeseries of validation results, create +a moving window with per_timesteps width number of time points. Should be a +minimum of 10 timesteps.} + +\item{skill_test}{Logical parameter indicating whether or not to run +validations also on two naïve models for a skill test comparison. The naïve +models are "persistence": the last known value (case counts) carried +forward, and "average week" where the predicted value is the average of that +week of the year, as calculated from historical data.} + +\item{epi_data}{See description in `run_epidemia()`.} + +\item{env_data}{See description in `run_epidemia()`.} + +\item{env_ref_data}{See description in `run_epidemia()`.} + +\item{env_info}{See description in `run_epidemia()`.} + +\item{casefield}{See description in `run_epidemia()`.} + +\item{groupfield}{See description in `run_epidemia()`.} + +\item{populationfield}{See description in `run_epidemia()`.} + +\item{obsfield}{See description in `run_epidemia()`.} + +\item{valuefield}{See description in `run_epidemia()`.} + +\item{fc_model_family}{See description in `run_epidemia()`.} + +\item{report_settings}{See description in `run_epidemia()`.} + +\item{...}{Accepts other arguments that may normally part of `run_epidemia()`, +but ignored for validation runs.} +} +\value{ +Returns a nested list of validation results. Statistics are calculated + on the n-week ahead forecast and the actual observed case counts. Statistics + returned are Mean Absolute Error (MAE), Root Mean Squared Error (RMSE). The + first object is `skill_scores`, which contains `skill_overall` and + `skill_grouping`. The second list is `validations`, which contains lists per + model run (the forecast model and then optionally the naive models). Within + each, `validation_overall` is the results overall, and `validation_grouping` + is the results per geographic grouping. Lastly, a `metadata` list contains + the important parameter settings used to run validation and when the results + where generated. +} +\description{ +This function takes a few more arguments than `epidemiar::run_epidemia()` to +generate statistics on model validation. The function will evaluate a number +of weeks (`total_timesteps`) starting from a specified week (`date_start`) and +will look at the n-week ahead forecast (1 to `timesteps_ahead` number of +weeks) and compare the values to the observed number of cases. An optional +`reporting_lag` argument will censor the last known data back that number of +weeks. The validation statistics include Root Mean Squared Error (RMSE) and +Mean Absolute Error (MAE), and an R-squared staistic both in total and per +geographic grouping (if present). +} diff --git a/man/save_geog_validations.Rd b/man/save_geog_validations.Rd new file mode 100644 index 0000000..6396f89 --- /dev/null +++ b/man/save_geog_validations.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{save_geog_validations} +\alias{save_geog_validations} +\title{Save geographic grouping model validation statistics} +\usage{ +save_geog_validations(validations, save_file) +} +\arguments{ +\item{validations}{The set of validation statistics produced by +run_validation() - only the list of validation data sets, not including the skill metrics.} + +\item{save_file}{File name to save results into csv format} +} +\value{ +A csv file containing the model validation statistics for the + geographic grouping results. +} +\description{ +Small function to pull out validation statistics per geographic grouping and +save to csv. +} diff --git a/man/save_overall_validations.Rd b/man/save_overall_validations.Rd new file mode 100644 index 0000000..b817e54 --- /dev/null +++ b/man/save_overall_validations.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/model_validation.R +\name{save_overall_validations} +\alias{save_overall_validations} +\title{Save overall model validation statistics} +\usage{ +save_overall_validations(validations, save_file) +} +\arguments{ +\item{validations}{The set of validation statistics produced by +run_validation() - only the list of validation data sets, not including the skill metrics.} + +\item{save_file}{File name to save results into csv format} +} +\value{ +A csv file containing only the model overall statistics (and not + including the geographic grouping results, if present). +} +\description{ +Small function to pull out just overall validation statistics and save to +csv. +} From 5f8775143d78b2b61e23cf54c8c78fe22524a753 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 21 Feb 2020 16:33:56 -0600 Subject: [PATCH 012/132] Testing documentation links and formatting --- R/run_epidemia.R | 48 +++++++++++++++++++++++-------------------- man/run_epidemia.Rd | 50 ++++++++++++++++++++++++--------------------- 2 files changed, 53 insertions(+), 45 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 52a1b6d..9611b7f 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -4,14 +4,17 @@ #'Integrated Assessment (EPIDEMIA) Forecasting System is a set of tools coded in #'free, open-access software, that integrate surveillance and environmental data #'to model and create short-term forecasts for environmentally-mediated -#'diseases. This function, `epidemiar::run_epidemia()` is the central function -#'to model and forecast a wide range of environmentally-mediated diseases. +#'diseases. This function, \code{epidemiar::run_epidemia()} is the central +#'function to model and forecast a wide range of environmentally-mediated +#'diseases. #' -#'For more a longer description of the package, see the overview vignette: -#'\code{vignette("overview-epidemiar", package = "epidemiar")} +#'For more a longer description of the package, run the following command to see +#'the overview vignette: \code{vignette("overview-epidemiar", package = +#'"epidemiar")} #' -#'For more details see the vignette on input data and modeling parameters: -#'\code{vignette("data-modeling", package = "epidemiar")} +#'For more details run the following command to see the vignette on input data +#'and modeling parameters: \code{vignette("data-modeling", package = +#'"epidemiar")} #' #'@param epi_data Epidemiological data with case numbers per week, with date #' field "obs_date". @@ -19,8 +22,8 @@ #' range as the epidemiological data. It may contain extra data (other #' districts or date ranges). The data must be in long format (one row for each #' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. +#' minimum \code{report_settings$env_lag_length} days (default 180) before +#' epi_data for forecasting. #'@param env_ref_data Historical averages by week of year for environmental #' variables. Used in extended environmental data into the future for long #' forecast time, to calculate anomalies in early detection period, and to @@ -42,21 +45,22 @@ #'@param valuefield Field name of the value of the environmental data variable #' observations (unquoted field name). #' -#'@param fc_model_family Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-bam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. -#'@param report_settings Optional report settings. <<>> +#'@param fc_model_family The \code{\link[stats]{family}} parameter passsed to +#' \code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +#' \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +#' generalized additive model (GAM) to run: it specifies the distribution and +#' link to use in model fitting. E.g. for a Poisson regression, the user would +#' input "poisson()". #' +#'@param report_settings This is a named list of all the report, forecasting, +#' event detection and other settings. All of these have defaults, but they are +#' not likely the defaults needed for your system, so each of these should be +#' reviewed: \itemize{ +#'\item \code{report_period} = 26: The number of weeks that the entire report will +#' cover. The \code{report_period} minus \code{fc_future_period} is the number +#' of weeks of past (known) data that will be included. +#'\item fjdklsajfdksl +#'} #' #'@return Returns a suite of summary and report data. #' diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index d5a6318..e4049f5 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -17,8 +17,8 @@ field "obs_date".} range as the epidemiological data. It may contain extra data (other districts or date ranges). The data must be in long format (one row for each date and environmental variable combination), and must start at absolutel -minimum \code{laglen} (in \code{fc_control}) days before epi_data for -forecasting.} +minimum \code{report_settings$env_lag_length} days (default 180) before +epi_data for forecasting.} \item{env_ref_data}{Historical averages by week of year for environmental variables. Used in extended environmental data into the future for long @@ -46,21 +46,22 @@ name).} \item{valuefield}{Field name of the value of the environmental data variable observations (unquoted field name).} -\item{fc_model_family}{Critical argument to choose the type of model to generate. -The options are versions that the EPIDEMIA team has used for forecasting. -The first supported options is "poisson-bam" ("p") which is the original -epidemiar model: a Poisson regression using bam (for large data GAMs), with -a smoothed cyclical for seasonality. The default for fc_control$anom_env is -TRUE for using the anomalies of environmental variables rather than their -raw values. The second option is "negbin" ("n") which is a negative binomial -regression using glm, with no external seasonality terms - letting the -natural cyclical behavior of the environmental variables fill that role. The -default for fc_control$anom_env is FALSE and uses the actual observation -values in the modeling. The fc_control$anom_env can be overruled by the user -providing a value, but this is not recommended unless you are doing -comparisons.} - -\item{report_settings}{Optional report settings. <<>>} +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()".} + +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: \itemize{ +\item \code{report_period} = 26: The number of weeks that the entire report will + cover. The \code{report_period} minus \code{fc_future_period} is the number + of weeks of past (known) data that will be included. +\item fjdklsajfdksl +}} } \value{ Returns a suite of summary and report data. @@ -111,15 +112,18 @@ The Epidemic Prognosis Incorporating Disease and Environmental Monitoring for Integrated Assessment (EPIDEMIA) Forecasting System is a set of tools coded in free, open-access software, that integrate surveillance and environmental data to model and create short-term forecasts for environmentally-mediated -diseases. This function, `epidemiar::run_epidemia()` is the central function -to model and forecast a wide range of environmentally-mediated diseases. +diseases. This function, \code{epidemiar::run_epidemia()} is the central +function to model and forecast a wide range of environmentally-mediated +diseases. } \details{ -For more a longer description of the package, see the overview vignette: -\code{vignette("overview-epidemiar", package = "epidemiar")} +For more a longer description of the package, run the following command to see +the overview vignette: \code{vignette("overview-epidemiar", package = +"epidemiar")} -For more details see the vignette on input data and modeling parameters: -\code{vignette("data-modeling", package = "epidemiar")} +For more details run the following command to see the vignette on input data +and modeling parameters: \code{vignette("data-modeling", package = +"epidemiar")} } \examples{ "See model_forecast_script in epidemiar-demo for full example: From f322df8b4fbdfcbba7aa55eba0f122c13df7ec89 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 24 Feb 2020 12:04:27 -0600 Subject: [PATCH 013/132] Removing GPL3 license in prep for switching to MIT license file --- DESCRIPTION | 2 +- LICENSE | 674 ---------------------------------------------------- 2 files changed, 1 insertion(+), 675 deletions(-) delete mode 100644 LICENSE diff --git a/DESCRIPTION b/DESCRIPTION index ec06c8e..8e00508 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,7 +14,7 @@ Description: The Epidemic Prognosis Incorporating Disease and Environmental Moni create short-term forecasts for environmentally-mediated diseases. This R package contains the functions for modeling, forecasting, validation, and early detection & early warning alerts. -License: GPL-3 + file LICENSE +License: MIT Encoding: UTF-8 LazyData: true RoxygenNote: 6.1.1 diff --git a/LICENSE b/LICENSE deleted file mode 100644 index f288702..0000000 --- a/LICENSE +++ /dev/null @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. From 4c6664b090bd6660d29cf26bbf4250fd65e6f998 Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk <28901045+michdn@users.noreply.github.com> Date: Mon, 24 Feb 2020 12:06:35 -0600 Subject: [PATCH 014/132] Switched to MIT license --- LICENSE | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 LICENSE diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..de33073 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2020 EcoGRAPH: Ecological Geospatial Research and Applications in Planetary Health + +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. From 6b54e6a8d32b4110b0dad19a67ac209f69e59d36 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 26 Feb 2020 15:20:25 -0600 Subject: [PATCH 015/132] Updated license file info --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8e00508..78c429f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,7 +14,7 @@ Description: The Epidemic Prognosis Incorporating Disease and Environmental Moni create short-term forecasts for environmentally-mediated diseases. This R package contains the functions for modeling, forecasting, validation, and early detection & early warning alerts. -License: MIT +License: MIT + file LICENSE Encoding: UTF-8 LazyData: true RoxygenNote: 6.1.1 From 439e16922bc2d6b65b5c8e5c6287ef6a480af04c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 26 Feb 2020 16:28:09 -0600 Subject: [PATCH 016/132] Updated parameter documentation in functions, making use of inheritParams. --- R/cleaners_helpers.R | 9 +- R/event_detection.R | 76 ++++-------- R/forecasting_helpers.R | 118 +++++++----------- R/forecasting_main.R | 257 +++------------------------------------- R/model_validation.R | 14 +-- R/run_epidemia.R | 89 +++++++++++++- 6 files changed, 169 insertions(+), 394 deletions(-) diff --git a/R/cleaners_helpers.R b/R/cleaners_helpers.R index 4f6e236..4e547b3 100644 --- a/R/cleaners_helpers.R +++ b/R/cleaners_helpers.R @@ -4,12 +4,12 @@ #' Interpolates missing epi data. #' -#' @param epi_data Input data tibble with case counts in casefield, grouping -#' field groupfield, and date column "obs_date". #' @param quo_casefield Quosure of user given casefield to run_epidemia(). #' @param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). #' +#'@inheritParams run_epidemia +#' #' @return Same data as epi_data with new interpolated case field, #' cases_epidemiar. #' @@ -27,9 +27,6 @@ epi_NA_interpolate <- function(epi_data, quo_casefield, quo_groupfield){ #' Interpolates missing environmental data. #' -#' @param env_data Input data tibble with environmental data: geographic -#' groupings in groupfield, environmental variable identified in obsfield, and -#' data values in valuefield. Contains a date column "obs_date". #' @param quo_obsfield Quosure of the user given field that holds the #' environmental variable identifiers/names/IDs. #' @param quo_valuefield Quosure of the user given field that holds the @@ -37,6 +34,8 @@ epi_NA_interpolate <- function(epi_data, quo_casefield, quo_groupfield){ #' @param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). #' +#'@inheritParams run_epidemia +#' #' @return Same data as env_data, with new interpolated field, val_epidemiar, of #' the environmental variable data. #' diff --git a/R/event_detection.R b/R/event_detection.R index a28a7d1..259e2fe 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -1,6 +1,5 @@ # All run_epidemiar() subfunctions related to early detection -## Early Detection #'Main subfunction for running event detection algorithm. #' #'@param epi_fc_data Internal pass of epidemiological data complete with future @@ -8,23 +7,27 @@ #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). #'@param quo_popfield Quosure of user-given field containing population values. -#'@param ed_method Which method for early detection should be used ("Farrington" -#' is only current option, or "None"). -#'@param ed_control All parameters for early detection algorithm, passed through -#' to that subroutine. -#'@param val_type From match.arg evaluation of fc_control$value_type, whether to return -#' epidemiological report values in "incidence" (default) or "cases". -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. +#'@param ed_method An extract of report_settings$ed_method after defaults have +#' been applied - which method for early detection should be used ("farrington" +#' or default "none", currently). +#'@param ed_control An extract of report_settings$ed_control - all parameters +#' for early detection algorithm, passed through to that subroutine. +#'@param val_type An extract of report_settings$report_value_type after defaults +#' applies - whether to return epidemiological report values in "incidence" or +#' "cases" (default). +#'@param inc_per An extract of report_settings$report_inc_per after defaults +#' applies - number for what unit of population the incidence should be +#' reported in, e.g. incidence rate per 1000 people. Ignored when +#' report_settings$report_value_type is 'cases'. #'@param groupings A unique list of the geographic groupings (from groupfield). #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. #' -#'@return Returns a list of three generated series: -#' "ed" : early detection alerts (ed period of most recent epi data) -#' "ew" : early warning alerts (forecast/future portion) -#' "thresh" : threshold values per week +#' +#'@return Returns a list of three generated series: "ed" : early detection +#' alerts (ed period of most recent epi data) "ew" : early warning alerts +#' (forecast/future portion) "thresh" : threshold values per week #' run_event_detection <- function(epi_fc_data, quo_groupfield, @@ -69,22 +72,7 @@ run_event_detection <- function(epi_fc_data, #' Run the Farrington early detection algorithm #' -#'@param epi_fc_data Internal pass of epidemiological data complete with future -#' forecast values. -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param ed_control All parameters for early detection algorithm, passed through -#' to that subroutine. -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. -#'@param val_type From match.arg evaluation of fc_control$value_type, whether to return -#' epidemiological report values in "incidence" (default) or "cases". - +#'@inheritParams run_event_detection #' #'@return Returns a list of three generated series from the Farrington algorithm: #' "ed" : early detection alerts (ed period of most recent epi data) @@ -245,12 +233,7 @@ run_farrington <- function(epi_fc_data, #' Make the list of sts objects #' -#'@param epi_fc_data Internal pass of epidemiological data complete with future -#' forecast values. -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@inheritParams run_event_detection #' #'@return A list of surveillance time series (sts) objects, #'one for each geographic grouping. @@ -301,19 +284,8 @@ make_stss <- function(epi_fc_data, #' Formats output data from sts result objects #' #'@param stss_res_list List of sts output object from Farrington algorithm. -#'@param epi_fc_data Internal pass of epidemiological data complete with future -#' forecast values. -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. -#'@param val_type From match.arg evaluation of fc_control$value_type, whether to return -#' epidemiological report values in "incidence" (default) or "cases". +#' +#'@inheritParams run_event_detection #' #'@return Returns a list of three series from the Farrington sts result output: #' "ed" : early detection alerts (ed period of most recent epi data) @@ -398,13 +370,7 @@ stss_res_to_output_data <- function(stss_res_list, #' Run No outbreak detection algorithm #' -#'@param epi_fc_data Internal pass of epidemiological data complete with future -#' forecast values. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. +#'@inheritParams run_event_detection #' #'@return Returns a list of three generated series with all NAs: #' "ed" : early detection alerts (ed period of most recent epi data) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 3b50f40..ecc01db 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -2,21 +2,18 @@ #' Pull only model env variables. #' -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables -#'@param env_var <<>> which environmental variable to include +#'@param env_var Extract from report_settings$env_var, a user list of environmental variables to attempt to use for modeling +#' +#'@inheritParams run_epidemia +#'@inheritParams run_forecast #' #'@return List of environmental variables that were used in the #' modeling (had to be both listed in model variables input file and present the #' env_data dataset). #' -pull_model_envvars <- function(env_data, quo_obsfield, env_var){ +pull_model_envvars <- function(env_data, + quo_obsfield, + env_var){ #pull variables into list model_vars <- env_var %>% dplyr::pull(!!quo_obsfield) @@ -28,33 +25,12 @@ pull_model_envvars <- function(env_data, quo_obsfield, env_var){ #' Extend environmental data into the future. #' -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables -#'@param quo_valuefield Quosure of user given field name of the value of the -#' environmental data variable observations. -#'@param env_ref_data Historical averages by week of year for environmental -#' variables. Used in extended environmental data into the future for long -#' forecast time, to calculate anomalies in early detection period, and to -#' display on timeseries in reports. -#'@param env_info Lookup table for environmental data - reference creation -#' method (e.g. sum or mean), report labels, etc. -#'@param fc_model_family model choice stand in <<>> -#'@param epi_date_type weekISO/CDC/month <<>> -#'@param valid_run Internal boolean for whether this is part of a validation run. -#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param epi_date_type Extract from `report_settings$epi_date_type` #'@param env_variables_used List of environmental variables that were used in -#' the modeling -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. +#' the modeling (in `report_settings$env_var` & found in env_data) +#' +#'@inheritParams run_epidemia +#'@inheritParams run_forecast #' #'@return Environmental dataset, with data extended into the future forecast #' period. Unknown environmental data with runs of < 2 weeks is @@ -298,15 +274,8 @@ extend_env_future <- function(env_data, #' Extend epidemiology dataframe into future. #' -#'@param epi_data Epidemiological data with case numbers per week, with date -#' field "obs_date". -#'@param quo_popfield Quosure of user-given field containing population values. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. +#'@inheritParams run_epidemia +#'@inheritParams run_forecast #' #'@return Epidemiological dataset extended past the known epi data time range #' and into the future/forecast period. Case numbers are filled in the NA (to @@ -342,10 +311,8 @@ extend_epi_future <- function(epi_data, #'@param env_data_extd An environmental dataset extended into the #' future/forecast period with estimated values for the environmental #' variables. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables. +#' +#'@inheritParams run_forecast #' #'@return An environmental dataset formatted to pass over to BAM/GAM modeling. #' @@ -362,13 +329,14 @@ env_format_fc <- function(env_data_extd, env_spread } -#' Format epi data for modeling +#'Format epi data for modeling #' #'@param epi_data_extd An epidemiological dataset extended into the #' future/forecast period with NA values for to-be-forecasted case numbers. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param fc_clusters <<>>geographic clusters. +#'@param fc_clusters Extract from `report_settings$fc_clusters`, the +#' geographic clusters to use in modeling. +#' +#'@inheritParams run_forecast #' #'@return An epidemiological dataset formatted to pass over to BAM/GAM modeling. #' @@ -391,19 +359,22 @@ epi_format_fc <- function(epi_data_extd, epi_format } -#' Convert environmental data into anomalies. +#'Convert environmental data into anomalies. #' -#' Raw environmental values are not used in modeling, but rather their -#' anomalies, departures for the historical "normal". We are looking at the -#' influence of deviation from normal in the environmental factors to help -#' explain deviations from normal in the human cases. +#'Raw environmental values are not used in modeling, but rather their anomalies, +#'departures for the historical "normal". We are looking at the influence of +#'deviation from normal in the environmental factors to help explain deviations +#'from normal in the human cases. #' -#'@param env_fc Environmental data formatted for forecasting by env_format_fc(). -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). +#'@param env_fc Environmental data formatted for forecasting by +#' `env_format_fc()`. #'@param env_variables_used List of environmental variables that were used in -#' the modeling. -#'@param nthreads mx threasds <<>> +#' the modeling, created by `pull_model_envvars()`, from list in +#' `report_settings$env_var` & found in `env_data` +#'@param nthreads Extract from `report_settings$fc_nthreads`, max thread count +#' for parallelization +#' +#'@inheritParams run_forecast #' #'@return Environmental dataset in same format as env_fc but with the residuals #' from a GAM with geographic unit and cyclical cubic regression spline on day @@ -459,19 +430,20 @@ anomalize_env <- function(env_fc, } -#' Lag the environmental data. +#'Lag the environmental data. #' -#'@param epi_fc An epidemiological dataset extended into the -#' future/forecast period with NA values for to-be-forecasted case numbers, -#' as formatted for forecasting by epi_format_fc(). -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param groupings A unique list of the geographic groupings (from groupfield). +#'@param epi_fc An epidemiological dataset extended into the future/forecast +#' period with NA values for to-be-forecasted case numbers, as formatted for +#' forecasting by epi_format_fc(). #'@param env_fc Environmental data formatted for forecasting by env_format_fc(). #'@param env_variables_used List of environmental variables that were used in -#' the modeling. -#'@param lag_len The maximum number of days in the past to consider interactions -#' between the environmental variable anomalies and the disease case counts. +#' the modeling, created by `pull_model_envvars()`, from list in +#' `report_settings$env_var` & found in `env_data` +#'@param lag_len Extract from `report_settings$env_lag_length`. The maximum +#' number of days in the past to consider interactions between the +#' environmental variable anomalies and the disease case counts. +#' +#'@inheritParams run_forecast #' #'@return Wide dataset based on epidemiological data dates with five #' bandsummaries per environmental variable, from the basis spline summaries of diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 7ed39ff..25b11e2 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -2,40 +2,21 @@ #' Runs the forecast modeling #' -#'@param epi_data Epidemiological data with case numbers per week, with date -#' field "obs_date". -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. -#'@param env_ref_data Historical averages by week of year for environmental -#' variables. Used in extended environmental data into the future for long -#' forecast time, to calculate anomalies in early detection period, and to -#' display on timeseries in reports. -#'@param env_info Lookup table for environmental data - reference creation -#' method (e.g. sum or mean), report labels, etc. -#' #'@param quo_popfield Quosure of user-given field containing population values. #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). #'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables +#' variables. #'@param quo_valuefield Quosure of user given field name of the value of the #' environmental data variable observations. -#' -#'@param fc_model_family model choice stand in <<>> -#'@param report_settings all the settings <<>> -#' -#'@param env_variables List of environmental variables <<>> -#' +#'@param env_variables List of environmental variables that exist in env_data. #'@param groupings A unique list of the geographic groupings (from groupfield). #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#'@param valid_run Internal binary for whether this is part of a validation run. +#'@param valid_run Internal TRUE/FALSE for whether this is part of a validation run. #' +#'@inheritParams run_epidemia #' #'@return Named list containing: #'fc_epi: Full forecasted resulting dataset. @@ -257,20 +238,14 @@ run_forecast <- function(epi_data, #' #'@param epi_lag Epidemiological dataset with basis spline summaries of the #' lagged environmental data (or anomalies), as output by lag_environ_to_epi(). -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#'@param fc_model_family model choice stand in -#'@param report_settings report settings -#'@param groupings A unique list of the geographic groupings (from groupfield). #'@param env_variables_used List of environmental variables that were used in #' the modeling. -#'@param report_dates Internally generated set of report date information: min, -#' max, list of dates for full report, known epidemiological data period, -#' forecast period, and early detection period. #'@param req_date The end date of requested forecast regression. When fit_freq #' == "once", this is the last date of the full report, the end date of the #' forecast period. #' +#'@inheritParams run_epidemia +#'@inheritParams run_forecast #' #'@return Named list containing: #'date_preds: Full forecasted resulting dataset. @@ -421,20 +396,18 @@ forecast_regression <- function(epi_lag, #'Build the appropriate model #' -#'@param fc_model_family model choice stand in <<>> -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). #'@param epi_known Epidemiological dataset with basis spline summaries of the #' lagged environmental data (or anomalies), with column marking if "known" #' data and groupings converted to factors. -#'@param report_settings report settings #'@param n_groupings Count of the number of geographic groupings in the model. #'@param modb_eq Pieces of the regression formula that include the modified #' basis functions to account for long term trend (with or without groupings, #' as appropriate). #'@param bandsums_eq Pieces of the regression formula that include the b-spline #' bandsummaries of the environmental factors. - +#' +#'@inheritParams run_epidemia +#'@inheritParams run_forecast #' #'@return Regression object #' @@ -575,131 +548,23 @@ build_model <- function(fc_model_family, } #end else, user supplied family - # #POISSON-BAM (set as default in first round input checking) - # if (fc_model_family == "poisson-bam"){ - # - # message("Building Poisson model using bam() and forced cyclical...") - # - # #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create - # #expression to give to modeling function - # #different versions if multiple geographic area groupings or not - # if (n_groupings > 1){ - # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - # rlang::quo_name(quo_groupfield), - # " + s(doy, bs=\"cc\", by=", - # rlang::quo_name(quo_groupfield), - # ") + ", - # modb_eq, " + ", - # bandsums_eq)) - # } else { - # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - # "s(doy, bs=\"cc\") + ", - # modb_eq, " + ", - # bandsums_eq)) - # } - # - # # run bam - # # Using discrete = TRUE was much faster than using parallel with bam. - # regress <- mgcv::bam(reg_eq, data = epi_known, - # family = stats::poisson(), - # control = mgcv::gam.control(trace=FALSE), - # discrete = TRUE, - # nthreads = nthreads) - # - # - # } else if (fc_model_family == "negbin"){ - # #NEGATIVE BINOMIAL using GLM - # - # message("Building negative binomial model...") - # - # #due to dplyr NSE and bandsum eq and modb_eq pieces, easier to create - # #expression to give to modeling function - # #different versions if multiple geographic area groupings or not - # #No cycical (as opposed to bam with s()) - # if (n_groupings > 1){ - # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - # rlang::quo_name(quo_groupfield), " + ", - # modb_eq, " + ", - # bandsums_eq)) - # } else { - # reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - # modb_eq, " + ", - # bandsums_eq)) - # } - # - # # run glm - # # Which negative binomial function depends on if fc_control$theta exists - # #<<>> temp set theta to null until switch to real model family - # theta <- NULL - # - # if(!is.null(theta)){ - # message("Theta value provided. Running with glm(..., family = MASS::negative.binomial(theta = ", theta, "))...") - # regress <- stats::glm(reg_eq, - # data = epi_known, - # #theta value REQUIRED - # family = MASS::negative.binomial(theta=2.31)) - # #family = MASS::negative.binomial(theta = theta)) - # } else { - # message("Theta estimate (fc_control$theta) not provided, running with MASS::glm.nb()...") - # regress <- MASS::glm.nb(reg_eq, - # data = epi_known) - # } - # - # - # } else if (fc_model_family == "naive-persistence"){ - # - # #naive model - # #persistence (carry forward) - # #no regression object - # - # #create "model" using known data. - # #Will fill down in create_predictions - # regress <- epi_known %>% - # #grouping by geographical unit - # dplyr::group_by(!!quo_groupfield) %>% - # #prediction is 1 lag (previous week) - # #fit is name of value from regression models - # dplyr::mutate(fit = dplyr::lag(.data$cases_epidemiar, n = 1)) %>% - # #cleaning up as not needed, and for bug hunting - # dplyr::select(-dplyr::starts_with("band")) %>% - # dplyr::select(-dplyr::starts_with("modbs")) - # - # - # - # } else if (fc_model_family == "naive-averageweek"){ - # - # #naive model - # #average of week of year (from historical data) - # #not a regression object - # - # #create "model" (averages) using known data. - # regress <- epi_known %>% - # #calculate averages per geographic group per week of year - # dplyr::group_by(!!quo_groupfield, .data$week_epidemiar) %>% - # dplyr::summarize(fit = mean(.data$cases_epidemiar, na.rm = TRUE)) - # - # - # } else { - # #Shouldn't happen, just in case. - # stop("Error in selecting model choice.") - # } - } # end build_model() #'Create the appropriate predictions/forecasts. #' -#'@param fc_model_family model choice <<>> -#'@param nthreads max threads <<>> -#'@param regress The regression object, either the user-supplied one, or -#' the one just generated. +#'@param nthreads Extract of `report_settings$fc_nthreads` +#'@param regress The regression object, either the user-supplied one from +#' `report_settings$model_cached`, or the one just generated. #'@param epi_lag Epidemiological dataset with basis spline summaries of the #' lagged environmental data (or anomalies), with groupings as a factor. #'@param req_date The end date of requested forecast regression. When fit_freq #' == "once", this is the last date of the full report, the end date of the #' forecast period. #' +#'@inheritParams run_epidemia +#' #'@return A dataset from predict() using the regression object generated in #' build_model or a newly created one. The dataset includes the #' predicted/forecast values through the end of the report requested. @@ -780,98 +645,4 @@ create_predictions <- function(fc_model_family, } - - - - # #POISSON-BAM (set as default in first round input checking) - # if (fc_model_family == "poisson-bam"){ - # - # message("Creating Poisson predictions...") - # - # - # ## Create predictions from either newly generated model, or given one - # - # #output prediction (through req_date) - # preds <- mgcv::predict.bam(regress, - # newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), - # se.fit = TRUE, # included for backwards compatibility - # type="response", - # discrete = TRUE, - # n.threads = nthreads) - # - # - # - # } else if (fc_model_family == "negbin"){ - # #NEGATIVE BINOMIAL using GLM - # - # message("Creating negative binomial predictions...") - # - # - # ## Create predictions from either newly generated model, or given one - # - # #output prediction (through req_date) - # preds <- stats::predict.glm(regress, - # newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), - # se.fit = TRUE, # included for backwards compatibility - # type="response") - # - # - # } else if (fc_model_family == "naive-persistence"){ - # - # message("Creating predictions using persistence naive model...") - # - # #persistence model just carries forward the last known value - # #the important part is the forecast / trailing end part - # #manipulating to be in quasi-same format as the other models return - # - # #cleaning up as not needed, and for bug hunting - # epi_lag <- epi_lag %>% - # dplyr::select(-dplyr::starts_with("band")) %>% - # dplyr::select(-dplyr::starts_with("modbs")) - # - # #regress is a tibble not regression object here - # # has a variable fit with lag of 1 on known data - # #epi_lag has the newer rows - # preds <- epi_lag %>% - # #filter to requested date - # dplyr::filter(.data$obs_date <= req_date) %>% - # #join to get "fit" values from "model" - # #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming - # dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% - # #important at end/fc section, when we fill down - # tidyr::fill(.data$fit, .direction = "down") %>% - # #format into nominal regression predict output - # dplyr::select(.data$fit) %>% - # as.data.frame() - # - # } else if (fc_model_family == "naive-averageweek"){ - # - # message("Creating predictions using average week of year naive model...") - # - # #average week null model calculates the average cases of that - # # week of year from historical data - # #manipulating to be in quasi-same format as the other models return - # - # #regress is the averages per week of year from known data - # - # epi_lag <- epi_lag %>% - # #filter to requested date - # dplyr::filter(.data$obs_date <= req_date) - # - # #join back - # preds <- epi_lag %>% - # #join to get average values - # #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming - # # and so don't need column names not passed into this function - # dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% - # #format into nominal regression output - # dplyr::select(.data$fit) %>% - # as.data.frame() - # - # - # } else { - # #Shouldn't happen, just in case. - # stop("Error in selecting model choice.") - # } - } #end create_predictions() diff --git a/R/model_validation.R b/R/model_validation.R index ec5f455..b8908a6 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -25,26 +25,16 @@ #' know last week's numbers. #'@param per_timesteps When creating a timeseries of validation results, create #' a moving window with per_timesteps width number of time points. Should be a -#' minimum of 10 timesteps. +#' minimum of 10 timesteps. In beta-testing. #'@param skill_test Logical parameter indicating whether or not to run #' validations also on two naïve models for a skill test comparison. The naïve #' models are "persistence": the last known value (case counts) carried #' forward, and "average week" where the predicted value is the average of that #' week of the year, as calculated from historical data. -#'@param epi_data See description in `run_epidemia()`. -#'@param env_data See description in `run_epidemia()`. -#'@param env_ref_data See description in `run_epidemia()`. -#'@param env_info See description in `run_epidemia()`. -#'@param casefield See description in `run_epidemia()`. -#'@param groupfield See description in `run_epidemia()`. -#'@param populationfield See description in `run_epidemia()`. -#'@param obsfield See description in `run_epidemia()`. -#'@param valuefield See description in `run_epidemia()`. -#'@param fc_model_family See description in `run_epidemia()`. -#'@param report_settings See description in `run_epidemia()`. #'@param ... Accepts other arguments that may normally part of `run_epidemia()`, #' but ignored for validation runs. #' +#'@inheritParams run_epidemia #' #'@return Returns a nested list of validation results. Statistics are calculated #' on the n-week ahead forecast and the actual observed case counts. Statistics diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 9611b7f..72720c5 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -55,12 +55,88 @@ #'@param report_settings This is a named list of all the report, forecasting, #' event detection and other settings. All of these have defaults, but they are #' not likely the defaults needed for your system, so each of these should be -#' reviewed: \itemize{ -#'\item \code{report_period} = 26: The number of weeks that the entire report will -#' cover. The \code{report_period} minus \code{fc_future_period} is the number -#' of weeks of past (known) data that will be included. -#'\item fjdklsajfdksl -#'} +#' reviewed: +#' +#' \itemize{ +#' +#' \item \code{report_period} = 26: The number of weeks that the entire report +#' will cover. The \code{report_period} minus \code{fc_future_period} is the +#' number of weeks of past (known) data that will be included. Default is 26 +#' weeks. +#' +#' \item \code{report_value_type} = "cases": How to report the results, either +#' in terms of "cases" (default) or "incidence". +#' +#' \item \code{report_inc_per} = 1000: If reporting incidence, what should be +#' denominator be? Default is per 1000 persons. +#' +#' \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO +#' ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and +#' environmental reference data use ("weekISO" or "weekCDC"). Required: +#' epidemiological observation dates listed are LAST day of week. +#' +#' \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given +#' epidemiological data be linearly interpolated for any explicitly missing +#' values before modeling? Note: epidemiological data cannot have implicit +#' missing data (missing row as opposed to a row with NA). +#' +#' \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate +#' the model regression object plus metadata. This model can be cached and used +#' later on its own, skipping a large portion of the slow calculations for +#' future runs. +#' +#' \item \code{model_cached} = NULL: The output of a previous model_run = TRUE +#' run of run_epidemia() that produces a model (regression object) and +#' metadata. The metadata will be used for input checking and validation. Using +#' a prebuilt model saves on processing time, but will need to be updated +#' periodically. +#' +#' \item \code{env_var}: List environmental variables to actually use in the +#' modelling. (You can therefore have extra variables or data in the +#' environmental dataset.) Input should be a one column tibble, header row as +#' `obsfield` and each row with entries of the variables (must match what is in +#' env_data, env_ref-data, and env_info). Default is to use all environmental +#' data present in all three: env_data, env_ref_data, and env_info. +#' +#' \item \code{env_lag_length} = 180: The number of days of past environmental +#' data to include for the lagged effects. The distributed lags are summarized +#' using a thin plate basis function. Default is 180 days. +#' +#' \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the +#' environmental variables should be replaced with their anomalies. The +#' variables were transformed by taking the residuals from a GAM with +#' geographic unit and cyclical cubic regression spline on day of year per +#' geographic group. +#' +#' \item \code{fc_future_period} = 8: Number of future weeks from the end of +#' the \code{epi_data} to produce forecasts. Default is 8 weeks. +#' +#' \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a +#' smooth term based on day of year in the modelling (as one way of accounting +#' for seasonality). +#' +#' \item \code{fc_nthreads}: The number of parallel threads that can be used by +#' `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. +#' +#' \item \code{ed_summary_period} = 4: The number of weeks that will be +#' considered the "early detection period". It will count back from the week of +#' last known epidemiological data. Default is 4 weeks. +#' +#' \item \code{ed_method} = 'none': Which method for early detection should be +#' used ("farrington" is only current option, or "none"). +#' +#' \item \code{ed_control} = Controls passed along to the event detection +#' method. E.g. for `ed_method = 'farrington'`, these are passed to +#' \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. +#' Currently, these parameters are supported for Farrington: `b`, `w`, +#' `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, +#' `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. +#' Any control not included will use surveillance package defaults, with the +#' exception of `b`, the number of past years to include: epidemiar default is +#' to use as many years are available in the data. +#' +#' +#' } #' #'@return Returns a suite of summary and report data. #' @@ -452,6 +528,7 @@ run_epidemia <- function(epi_data = NULL, env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) #env_variables already gen list of env_data report_settings[["env_var"]] <- intersect(env_variables, env_info_variables) + #maybe add intersection with env_ref also? <<>> } #nthreads From 50ef2dc2a70279a40a70860d450e7d1bd9b6a30f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 26 Feb 2020 16:29:20 -0600 Subject: [PATCH 017/132] Autogenerated documentation updates --- man/anomalize_env.Rd | 17 ++-- man/build_model.Rd | 93 +++++++++++++++++++- man/create_predictions.Rd | 13 ++- man/env_NA_interpolate.Rd | 9 +- man/epi_NA_interpolate.Rd | 4 +- man/epi_format_fc.Rd | 3 +- man/extend_env_future.Rd | 19 +++-- man/forecast_regression.Rd | 93 +++++++++++++++++++- man/lag_environ_to_epi.Rd | 14 +-- man/pull_model_envvars.Rd | 8 +- man/run_epidemia.Rd | 88 +++++++++++++++++-- man/run_event_detection.Rd | 27 +++--- man/run_farrington.Rd | 15 ++-- man/run_forecast.Rd | 103 ++++++++++++++++++++-- man/run_validation.Rd | 151 ++++++++++++++++++++++++++++----- man/stss_res_to_output_data.Rd | 11 ++- 16 files changed, 573 insertions(+), 95 deletions(-) diff --git a/man/anomalize_env.Rd b/man/anomalize_env.Rd index 3d18efe..57f9728 100644 --- a/man/anomalize_env.Rd +++ b/man/anomalize_env.Rd @@ -7,15 +7,18 @@ anomalize_env(env_fc, quo_groupfield, nthreads, env_variables_used) } \arguments{ -\item{env_fc}{Environmental data formatted for forecasting by env_format_fc().} +\item{env_fc}{Environmental data formatted for forecasting by +`env_format_fc()`.} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{nthreads}{mx threasds <<>>} +\item{nthreads}{Extract from `report_settings$fc_nthreads`, max thread count +for parallelization} \item{env_variables_used}{List of environmental variables that were used in -the modeling.} +the modeling, created by `pull_model_envvars()`, from list in +`report_settings$env_var` & found in `env_data`} } \value{ Environmental dataset in same format as env_fc but with the residuals @@ -23,8 +26,8 @@ Environmental dataset in same format as env_fc but with the residuals of year per geographic group in place of the original raw values. } \description{ -Raw environmental values are not used in modeling, but rather their -anomalies, departures for the historical "normal". We are looking at the -influence of deviation from normal in the environmental factors to help -explain deviations from normal in the human cases. +Raw environmental values are not used in modeling, but rather their anomalies, +departures for the historical "normal". We are looking at the influence of +deviation from normal in the environmental factors to help explain deviations +from normal in the human cases. } diff --git a/man/build_model.Rd b/man/build_model.Rd index b762587..4d77829 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -8,7 +8,12 @@ build_model(fc_model_family, quo_groupfield, epi_known, report_settings, n_groupings, modb_eq, bandsums_eq) } \arguments{ -\item{fc_model_family}{model choice stand in <<>>} +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()".} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} @@ -17,7 +22,91 @@ run_epidemia().} lagged environmental data (or anomalies), with column marking if "known" data and groupings converted to factors.} -\item{report_settings}{report settings} +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + data present in all three: env_data, env_ref_data, and env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts. Default is 8 weeks. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_nthreads}: The number of parallel threads that can be used by + `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} \item{n_groupings}{Count of the number of geographic groupings in the model.} diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index 4cad709..b3efe73 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -7,12 +7,17 @@ create_predictions(fc_model_family, nthreads, regress, epi_lag, req_date) } \arguments{ -\item{fc_model_family}{model choice <<>>} +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()".} -\item{nthreads}{max threads <<>>} +\item{nthreads}{Extract of `report_settings$fc_nthreads`} -\item{regress}{The regression object, either the user-supplied one, or -the one just generated.} +\item{regress}{The regression object, either the user-supplied one from +`report_settings$model_cached`, or the one just generated.} \item{epi_lag}{Epidemiological dataset with basis spline summaries of the lagged environmental data (or anomalies), with groupings as a factor.} diff --git a/man/env_NA_interpolate.Rd b/man/env_NA_interpolate.Rd index 81791b8..815e21c 100644 --- a/man/env_NA_interpolate.Rd +++ b/man/env_NA_interpolate.Rd @@ -7,9 +7,12 @@ env_NA_interpolate(env_data, quo_obsfield, quo_valuefield, quo_groupfield) } \arguments{ -\item{env_data}{Input data tibble with environmental data: geographic -groupings in groupfield, environmental variable identified in obsfield, and -data values in valuefield. Contains a date column "obs_date".} +\item{env_data}{Daily environmental data for the same groupfields and date +range as the epidemiological data. It may contain extra data (other +districts or date ranges). The data must be in long format (one row for each +date and environmental variable combination), and must start at absolutel +minimum \code{report_settings$env_lag_length} days (default 180) before +epi_data for forecasting.} \item{quo_obsfield}{Quosure of the user given field that holds the environmental variable identifiers/names/IDs.} diff --git a/man/epi_NA_interpolate.Rd b/man/epi_NA_interpolate.Rd index 734b541..6a09d58 100644 --- a/man/epi_NA_interpolate.Rd +++ b/man/epi_NA_interpolate.Rd @@ -7,8 +7,8 @@ epi_NA_interpolate(epi_data, quo_casefield, quo_groupfield) } \arguments{ -\item{epi_data}{Input data tibble with case counts in casefield, grouping -field groupfield, and date column "obs_date".} +\item{epi_data}{Epidemiological data with case numbers per week, with date +field "obs_date".} \item{quo_casefield}{Quosure of user given casefield to run_epidemia().} diff --git a/man/epi_format_fc.Rd b/man/epi_format_fc.Rd index 50a7e69..04d0251 100644 --- a/man/epi_format_fc.Rd +++ b/man/epi_format_fc.Rd @@ -13,7 +13,8 @@ future/forecast period with NA values for to-be-forecasted case numbers.} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{fc_clusters}{<<>>geographic clusters.} +\item{fc_clusters}{Extract from `report_settings$fc_clusters`, the +geographic clusters to use in modeling.} } \value{ An epidemiological dataset formatted to pass over to BAM/GAM modeling. diff --git a/man/extend_env_future.Rd b/man/extend_env_future.Rd index 890ef62..6f32864 100644 --- a/man/extend_env_future.Rd +++ b/man/extend_env_future.Rd @@ -13,14 +13,14 @@ extend_env_future(env_data, quo_groupfield, quo_obsfield, quo_valuefield, range as the epidemiological data. It may contain extra data (other districts or date ranges). The data must be in long format (one row for each date and environmental variable combination), and must start at absolutel -minimum \code{laglen} (in \code{fc_control}) days before epi_data for -forecasting.} +minimum \code{report_settings$env_lag_length} days (default 180) before +epi_data for forecasting.} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} \item{quo_obsfield}{Quosure of user given field name of the environmental data -variables} +variables.} \item{quo_valuefield}{Quosure of user given field name of the value of the environmental data variable observations.} @@ -33,16 +33,21 @@ display on timeseries in reports.} \item{env_info}{Lookup table for environmental data - reference creation method (e.g. sum or mean), report labels, etc.} -\item{fc_model_family}{model choice stand in <<>>} +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()".} -\item{epi_date_type}{weekISO/CDC/month <<>>} +\item{epi_date_type}{Extract from `report_settings$epi_date_type`} -\item{valid_run}{Internal boolean for whether this is part of a validation run.} +\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation run.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} \item{env_variables_used}{List of environmental variables that were used in -the modeling} +the modeling (in `report_settings$env_var` & found in env_data)} \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index ca449da..bdeaeea 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -14,9 +14,98 @@ lagged environmental data (or anomalies), as output by lag_environ_to_epi().} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{fc_model_family}{model choice stand in} +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()".} -\item{report_settings}{report settings} +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + data present in all three: env_data, env_ref_data, and env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts. Default is 8 weeks. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_nthreads}: The number of parallel threads that can be used by + `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} \item{groupings}{A unique list of the geographic groupings (from groupfield).} diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index 754e28a..bdaffa2 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -8,22 +8,24 @@ lag_environ_to_epi(epi_fc, env_fc, quo_groupfield, lag_len, groupings, env_variables_used) } \arguments{ -\item{epi_fc}{An epidemiological dataset extended into the -future/forecast period with NA values for to-be-forecasted case numbers, -as formatted for forecasting by epi_format_fc().} +\item{epi_fc}{An epidemiological dataset extended into the future/forecast +period with NA values for to-be-forecasted case numbers, as formatted for +forecasting by epi_format_fc().} \item{env_fc}{Environmental data formatted for forecasting by env_format_fc().} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{lag_len}{The maximum number of days in the past to consider interactions -between the environmental variable anomalies and the disease case counts.} +\item{lag_len}{Extract from `report_settings$env_lag_length`. The maximum +number of days in the past to consider interactions between the +environmental variable anomalies and the disease case counts.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} \item{env_variables_used}{List of environmental variables that were used in -the modeling.} +the modeling, created by `pull_model_envvars()`, from list in +`report_settings$env_var` & found in `env_data`} } \value{ Wide dataset based on epidemiological data dates with five diff --git a/man/pull_model_envvars.Rd b/man/pull_model_envvars.Rd index e4a04a8..a017d67 100644 --- a/man/pull_model_envvars.Rd +++ b/man/pull_model_envvars.Rd @@ -11,13 +11,13 @@ pull_model_envvars(env_data, quo_obsfield, env_var) range as the epidemiological data. It may contain extra data (other districts or date ranges). The data must be in long format (one row for each date and environmental variable combination), and must start at absolutel -minimum \code{laglen} (in \code{fc_control}) days before epi_data for -forecasting.} +minimum \code{report_settings$env_lag_length} days (default 180) before +epi_data for forecasting.} \item{quo_obsfield}{Quosure of user given field name of the environmental data -variables} +variables.} -\item{env_var}{<<>> which environmental variable to include} +\item{env_var}{Extract from report_settings$env_var, a user list of environmental variables to attempt to use for modeling} } \value{ List of environmental variables that were used in the diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index e4049f5..1f928ac 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -56,12 +56,88 @@ input "poisson()".} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are not likely the defaults needed for your system, so each of these should be - reviewed: \itemize{ -\item \code{report_period} = 26: The number of weeks that the entire report will - cover. The \code{report_period} minus \code{fc_future_period} is the number - of weeks of past (known) data that will be included. -\item fjdklsajfdksl -}} + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + data present in all three: env_data, env_ref_data, and env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts. Default is 8 weeks. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_nthreads}: The number of parallel threads that can be used by + `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} } \value{ Returns a suite of summary and report data. diff --git a/man/run_event_detection.Rd b/man/run_event_detection.Rd index c8f4472..483b117 100644 --- a/man/run_event_detection.Rd +++ b/man/run_event_detection.Rd @@ -16,17 +16,21 @@ run_epidemia().} \item{quo_popfield}{Quosure of user-given field containing population values.} -\item{ed_method}{Which method for early detection should be used ("Farrington" -is only current option, or "None").} +\item{ed_method}{An extract of report_settings$ed_method after defaults have +been applied - which method for early detection should be used ("farrington" +or default "none", currently).} -\item{ed_control}{All parameters for early detection algorithm, passed through -to that subroutine.} +\item{ed_control}{An extract of report_settings$ed_control - all parameters +for early detection algorithm, passed through to that subroutine.} -\item{val_type}{From match.arg evaluation of fc_control$value_type, whether to return -epidemiological report values in "incidence" (default) or "cases".} +\item{val_type}{An extract of report_settings$report_value_type after defaults +applies - whether to return epidemiological report values in "incidence" or +"cases" (default).} -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people.} +\item{inc_per}{An extract of report_settings$report_inc_per after defaults +applies - number for what unit of population the incidence should be +reported in, e.g. incidence rate per 1000 people. Ignored when +report_settings$report_value_type is 'cases'.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} @@ -35,10 +39,9 @@ max, list of dates for full report, known epidemiological data period, forecast period, and early detection period.} } \value{ -Returns a list of three generated series: -"ed" : early detection alerts (ed period of most recent epi data) -"ew" : early warning alerts (forecast/future portion) -"thresh" : threshold values per week +Returns a list of three generated series: "ed" : early detection + alerts (ed period of most recent epi data) "ew" : early warning alerts + (forecast/future portion) "thresh" : threshold values per week } \description{ Main subfunction for running event detection algorithm. diff --git a/man/run_farrington.Rd b/man/run_farrington.Rd index 490dbcd..6c2d185 100644 --- a/man/run_farrington.Rd +++ b/man/run_farrington.Rd @@ -16,14 +16,17 @@ run_epidemia().} \item{quo_popfield}{Quosure of user-given field containing population values.} -\item{ed_control}{All parameters for early detection algorithm, passed through -to that subroutine.} +\item{ed_control}{An extract of report_settings$ed_control - all parameters +for early detection algorithm, passed through to that subroutine.} -\item{val_type}{From match.arg evaluation of fc_control$value_type, whether to return -epidemiological report values in "incidence" (default) or "cases".} +\item{val_type}{An extract of report_settings$report_value_type after defaults +applies - whether to return epidemiological report values in "incidence" or +"cases" (default).} -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people.} +\item{inc_per}{An extract of report_settings$report_inc_per after defaults +applies - number for what unit of population the incidence should be +reported in, e.g. incidence rate per 1000 people. Ignored when +report_settings$report_value_type is 'cases'.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index be5c911..aae00ab 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -21,11 +21,11 @@ run_epidemia().} range as the epidemiological data. It may contain extra data (other districts or date ranges). The data must be in long format (one row for each date and environmental variable combination), and must start at absolutel -minimum \code{laglen} (in \code{fc_control}) days before epi_data for -forecasting.} +minimum \code{report_settings$env_lag_length} days (default 180) before +epi_data for forecasting.} \item{quo_obsfield}{Quosure of user given field name of the environmental data -variables} +variables.} \item{quo_valuefield}{Quosure of user given field name of the value of the environmental data variable observations.} @@ -38,15 +38,104 @@ display on timeseries in reports.} \item{env_info}{Lookup table for environmental data - reference creation method (e.g. sum or mean), report labels, etc.} -\item{fc_model_family}{model choice stand in <<>>} +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()".} -\item{report_settings}{all the settings <<>>} +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: -\item{valid_run}{Internal binary for whether this is part of a validation run.} + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + data present in all three: env_data, env_ref_data, and env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts. Default is 8 weeks. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_nthreads}: The number of parallel threads that can be used by + `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} + +\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation run.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} -\item{env_variables}{List of environmental variables <<>>} +\item{env_variables}{List of environmental variables that exist in env_data.} \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 5adec0a..016b84a 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -31,7 +31,7 @@ know last week's numbers.} \item{per_timesteps}{When creating a timeseries of validation results, create a moving window with per_timesteps width number of time points. Should be a -minimum of 10 timesteps.} +minimum of 10 timesteps. In beta-testing.} \item{skill_test}{Logical parameter indicating whether or not to run validations also on two naïve models for a skill test comparison. The naïve @@ -39,27 +39,134 @@ models are "persistence": the last known value (case counts) carried forward, and "average week" where the predicted value is the average of that week of the year, as calculated from historical data.} -\item{epi_data}{See description in `run_epidemia()`.} - -\item{env_data}{See description in `run_epidemia()`.} - -\item{env_ref_data}{See description in `run_epidemia()`.} - -\item{env_info}{See description in `run_epidemia()`.} - -\item{casefield}{See description in `run_epidemia()`.} - -\item{groupfield}{See description in `run_epidemia()`.} - -\item{populationfield}{See description in `run_epidemia()`.} - -\item{obsfield}{See description in `run_epidemia()`.} - -\item{valuefield}{See description in `run_epidemia()`.} - -\item{fc_model_family}{See description in `run_epidemia()`.} - -\item{report_settings}{See description in `run_epidemia()`.} +\item{epi_data}{Epidemiological data with case numbers per week, with date +field "obs_date".} + +\item{env_data}{Daily environmental data for the same groupfields and date +range as the epidemiological data. It may contain extra data (other +districts or date ranges). The data must be in long format (one row for each +date and environmental variable combination), and must start at absolutel +minimum \code{report_settings$env_lag_length} days (default 180) before +epi_data for forecasting.} + +\item{env_ref_data}{Historical averages by week of year for environmental +variables. Used in extended environmental data into the future for long +forecast time, to calculate anomalies in early detection period, and to +display on timeseries in reports.} + +\item{env_info}{Lookup table for environmental data - reference creation +method (e.g. sum or mean), report labels, etc.} + +\item{casefield}{The column name of the field that contains disease case +counts (unquoted field name).} + +\item{groupfield}{The column name of the field for district or geographic area +unit division names of epidemiological AND environmental data (unquoted +field name). If there are no groupings (all one area), user should give a +field that contains the same value throughout.} + +\item{populationfield}{Column name of the population field to give population +numbers over time (unquoted field name). Used to calculated incidence. Also +optionally used in Farrington method for populationOffset.} + +\item{obsfield}{Field name of the environmental data variables (unquoted field +name).} + +\item{valuefield}{Field name of the value of the environmental data variable +observations (unquoted field name).} + +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()".} + +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + data present in all three: env_data, env_ref_data, and env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts. Default is 8 weeks. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_nthreads}: The number of parallel threads that can be used by + `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} \item{...}{Accepts other arguments that may normally part of `run_epidemia()`, but ignored for validation runs.} diff --git a/man/stss_res_to_output_data.Rd b/man/stss_res_to_output_data.Rd index 73462fa..26197b2 100644 --- a/man/stss_res_to_output_data.Rd +++ b/man/stss_res_to_output_data.Rd @@ -18,11 +18,14 @@ run_epidemia().} \item{quo_popfield}{Quosure of user-given field containing population values.} -\item{val_type}{From match.arg evaluation of fc_control$value_type, whether to return -epidemiological report values in "incidence" (default) or "cases".} +\item{val_type}{An extract of report_settings$report_value_type after defaults +applies - whether to return epidemiological report values in "incidence" or +"cases" (default).} -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people.} +\item{inc_per}{An extract of report_settings$report_inc_per after defaults +applies - number for what unit of population the incidence should be +reported in, e.g. incidence rate per 1000 people. Ignored when +report_settings$report_value_type is 'cases'.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} From 1fea34eeae03d4a4d4df9a63124ecc53daa9d24c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 3 Mar 2020 17:33:35 -0600 Subject: [PATCH 018/132] All new input checking and default settings with new input scheme --- R/input_checks.R | 539 +++++++++++++++++++++++++++++------------------ R/run_epidemia.R | 303 ++++---------------------- 2 files changed, 376 insertions(+), 466 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index baa43b6..f44f399 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -1,70 +1,242 @@ + +#'Set defaults of any missing report_settings parameters +#' +#'Function sets defaults to report_settings parameters. +#' +#'@param raw_settings The report_settings object as given by the user. +#'@param env_variables List of all unique environmental variables in env_data. +#'@param quo_obsfield Quosure of user given field name of the environmental data +#' variables. +#'@param groupings List of all unique geographical groupings in epi_data. +#'@param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#' +#'@inheritParams run_epidemia +#' +#'@return Returns a full report_settings object, using user supplied values or +#' defaults is option was missing. +#' + +set_report_defaults <- function(raw_settings, + env_info, + env_ref_data, + env_variables, + quo_obsfield, + groupings, + quo_groupfield){ + + #set up list in case no report_settings were given + if (is.null(raw_settings)){ + new_settings <- list() + } else { + #copy over to begin before editing below + new_settings <- raw_settings + } + + if (is.null(raw_settings[["report_period"]])){ + new_settings[["report_period"]] <- 26 + } + + if (is.null(raw_settings[["report_inc_per"]])){ + new_settings[["report_inc_per"]] <- 1000 + #okay if not used, if report_value_type is cases instead of incidence + } + + if (is.null(raw_settings[["epi_interpolate"]])){ + new_settings[["epi_interpolate"]] <- FALSE + } + + if (is.null(raw_settings[["ed_summary_period"]])){ + new_settings[["ed_summary_period"]] <- 4 + } + + if (is.null(raw_settings[["model_run"]])){ + new_settings[["model_run"]] <- FALSE + } + + if (is.null(raw_settings[["model_cached"]])){ + new_settings[["model_cached"]] <- NULL + } + + if (is.null(raw_settings[["env_lag_length"]])){ + #maybe make default based on data length, but for now + new_settings[["env_lag_length"]] <- 180 + } + + if (is.null(raw_settings[["fc_cyclicals"]])){ + new_settings[["fc_cyclicals"]] <- FALSE + } + + if (is.null(raw_settings[["fc_future_period"]])){ + new_settings[["fc_future_period"]] <- 8 + } + + #default false, with explicit false for naive models (probably ok w/out, just being careful) + if (is.null(raw_settings[["env_anomalies"]])){ + new_settings[["env_anomalies"]] <- dplyr::case_when( + fc_model_family == "naive-persistence" ~ FALSE, + fc_model_family == "naive-weekaverage" ~ FALSE, + #default to FALSE + TRUE ~ FALSE) + } + + + # For things that are being string matched: + # tolower to capture upper and lower case user-input variations since match.arg is case sensitive + # but must only try function if ed_method is not null (i.e. was given) + + #report_value_type + # if provided, prepare for matching + if (!is.null(raw_settings[["report_value_type"]])){ + new_settings[["report_value_type"]] <- tolower(raw_settings[["report_value_type"]]) + } else { + #if not provided/missing/null + message("Note: 'report_value_type' was not provided, returning results in case counts ('cases').") + new_settings[["report_value_type"]] <- "cases" + } + #try match + new_settings[["report_value_type"]] <- tryCatch({ + match.arg(new_settings[["report_value_type"]], c("cases", "incidence")) + }, error = function(e){ + message("Warning: Given 'report_value_type' does not match 'cases' or 'incidence', running as 'cases'.") + "cases" + }, finally = { + #failsafe default + "cases" + }) + + # epi_date_type + # if provided, prepare for matching + if (!is.null(raw_settings[["epi_date_type"]])){ + #want to keep ISO and CDC capitalized, but drop 'Week' to 'week' if had been entered that way + first_char <- substr(raw_settings[["epi_date_type"]], 1, 1) %>% + tolower() + #remainder of user entry + rest_char <- substr(raw_settings[["epi_date_type"]], 2, nchar(raw_settings[["epi_date_type"]])) + #paste back together + new_settings[["epi_date_type"]] <- paste0(first_char, rest_char) + } else { + #if not provided/missing/null + message("Note: 'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').") + new_settings[["epi_date_type"]] <- "weekISO" + } + #try match + new_settings[["epi_date_type"]] <- tryCatch({ + match.arg(new_settings[["epi_date_type"]], c("weekISO", "weekCDC")) #"monthly" reserved for future + }, error = function(e){ + message("Warning: Given 'epi_date_type' does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).") + "weekISO" + }, finally = { + #failsafe default + "weekISO" + }) + + + # ed_method + # if provided, prepare for matching + if (!is.null(raw_settings[["ed_method"]])){ + new_settings[["ed_method"]] <- tolower(raw_settings[["ed_method"]]) + } else { + #if not provided/missing/null + message("Note: 'ed_method' was not provided, running as 'none'.") + new_settings[["ed_method"]] <- "none" + } + #try match + new_settings[["ed_method"]] <- tryCatch({ + match.arg(new_settings[["ed_method"]], c("none", "farrington")) + }, error = function(e){ + message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") + "none" + }, finally = { + #failsafe default to no event detection + "none" + }) + + + # For more complicated defaults + + #env_var -- what is listed in env_data, env_ref_data, & env_info + if (is.null(raw_settings[["env_var"]])){ + + #create list of all environmental variables in env_info + env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) + + #create list of all environmental variables in env_ref_data + env_ref_variables <- dplyr::pull(env_ref_data, !!quo_obsfield) + + #env_variables already gen list of env_data + + #Two sets of intersection to create list that are present in all three + env_data_info <- dplyr::intersect(env_variables, env_info_variables) + default_env_var <- dplyr::intersect(env_data_info, env_ref_variables) + new_settings[["env_var"]] <- dplyr::tibble(obs_temp = default_env_var) %>% + #rename NSE fun + dplyr::rename(!!rlang::quo_name(quo_obsfield) := .data$obs_temp) + + #message result + message("No user supplied list of environmetal variables to use. Using: ", paste(default_env_var, ""), + " based on presence in env_data, env_ref_data, and env_info.\n") + } + + #nthreads + #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) + #if user-supplied, use that cap at 2, otherwise create a default number + #used to decide if run anomalize_env() prior to forecasting + if (!is.null(raw_settings[["fc_nthreads"]])) { + # nthreads above 2 is not actually helpful + new_settings[["fc_nthreads"]] <- ifelse(raw_settings[["fc_nthreads"]] > 1, 2, 1) + } else { + #no value fed in, so test and determine + new_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) + } #end else for ncores not given + + + #fc_clusters + #default is one cluster, probably not what you actually want for any type of large system + if (is.null(raw_settings[["fc_clusters"]])){ + #create tbl of only one cluster + #groupings already exist as list of geographic groups + cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% + #and fix names with NSE + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + #assign + new_settings[["fc_clusters"]] <- cluster_tbl + } + + + # Developer options + if (is.null(raw_settings[["dev_fc_fit_freq"]])){ + new_settings[["dev_fc_fit_freq"]] <- "once" + } + if (is.null(raw_settings[["dev_fc_modbsplines"]])){ + new_settings[["dev_fc_modbsplines"]] <- FALSE + } + if (is.null(raw_settings[["dev_fc_formula"]])){ + new_settings[["dev_fc_formula"]] <- NULL + } + + new_settings + +} + + + #'Functions to check input to epidemiar #' #'Function does basic existance checks and variety of logic checks on input data #'to run_epidemia(). #' -#'@param epi_data Epidemiological data with case numbers per week, with date -#' field "obs_date". #'@param quo_casefield Quosure of user given field containing the disease case #' counts. #'@param quo_popfield Quosure of user-given field containing population values. -#'@param inc_per Number for what unit of population the incidence should be -#' reported in, e.g. incidence rate of 3 per 1000 people. #'@param quo_groupfield Quosure of the user given geographic grouping field to #' run_epidemia(). -#'@param week_type String indicating the standard (WHO ISO-8601 or CDC epi -#' weeks) that the weeks of the year in epidemiological and environmental -#' reference data use ["ISO" or "CDC"]. (Required: epidemiological observation -#' dates listed are LAST day of week). -#'@param report_period The number of weeks that the entire report will cover. -#' The \code{report_period} minus \code{forecast_future} is the number of weeks -#' of past (known) data that will be included. -#'@param ed_summary_period The number of weeks that will be considered the -#' "early detection period". It will count back from the week of last known -#' epidemiological data. -#'@param ed_method Which method for early detection should be used ("Farrington" -#' is only current option, or "None"). -#'@param ed_control All parameters for early detection algorithm, passed through -#' to that subroutine. -#'@param env_data Daily environmental data for the same groupfields and date -#' range as the epidemiological data. It may contain extra data (other -#' districts or date ranges). The data must be in long format (one row for each -#' date and environmental variable combination), and must start at absolutel -#' minimum \code{laglen} (in \code{fc_control}) days before epi_data for -#' forecasting. #'@param quo_obsfield Quosure of user given field name of the environmental data #' variables #'@param quo_valuefield Quosure of user given field name of the value of the #' environmental data variable observations. -#'@param forecast_future Number of futre weeks from the end of the -#' \code{epi_data} to produce forecasts. -#'@param fc_control Parameters for forecasting, including which environmental -#' variable to include and any geographic clusters. -#'@param env_ref_data Historical averages by week of year for environmental -#' variables. Used in extended environmental data into the future for long -#' forecast time, to calculate anomalies in early detection period, and to -#' display on timeseries in reports. -#'@param env_info Lookup table for environmental data - reference creation -#' method (e.g. sum or mean), report labels, etc. -#'@param model_obj Deprecated, use model_cached. -#'@param model_cached The output of a previous model_run = TRUE run of -#' run_epidemia() that produces a model (regression object) and metadata. The -#' metadata will be used for input checking and validation. Using a prebuilt -#' model saves on processing time, but will need to be updated periodically. -#'@param model_choice Critical argument to choose the type of model to generate. -#' The options are versions that the EPIDEMIA team has used for forecasting. -#' The first supported options is "poisson-gam" ("p") which is the original -#' epidemiar model: a Poisson regression using bam (for large data GAMs), with -#' a smoothed cyclical for seasonality. The default for fc_control$anom_env is -#' TRUE for using the anomalies of environmental variables rather than their -#' raw values. The second option is "negbin" ("n") which is a negative binomial -#' regression using glm, with no external seasonality terms - letting the -#' natural cyclical behavior of the environmental variables fill that role. The -#' default for fc_control$anom_env is FALSE and uses the actual observation -#' values in the modeling. The fc_control$anom_env can be overruled by the user -#' providing a value, but this is not recommended unless you are doing -#' comparisons. #' +#'@inheritParams run_epidemia #' #'@return Returns a flag if there were any errors, plus accompanying error #' messages. Also returns a flag and messages for warnings, as well. @@ -73,25 +245,16 @@ #' input_check <- function(epi_data, + env_data, + env_ref_data, + env_info, quo_casefield, quo_popfield, - inc_per, quo_groupfield, - week_type, - report_period, - ed_summary_period, - ed_method, - ed_control, - env_data, quo_obsfield, quo_valuefield, - forecast_future, - fc_control, - env_ref_data, - env_info, - model_obj, - model_cached, - model_choice){ + fc_model_family, + report_settings){ # Want ALL data checks to happen, whether or not error happen before the end of the tests. # Want to collect all errors, and return all of them to console @@ -111,8 +274,7 @@ input_check <- function(epi_data, # Existing & Types -------------------------------------------------------- # Quick test for some simple settings - # inc_per (0 could be "cases" so allow when that is built) - if (!is.numeric(inc_per) || inc_per <= 0){ + if (!is.numeric(report_settings[["report_inc_per"]]) || report_settings[["report_inc_per"]] <= 0){ err_flag <- TRUE err_msgs <- paste(err_msgs, "'inc_per' must be numeric and a positive number.\n") } @@ -219,65 +381,69 @@ input_check <- function(epi_data, rpt_len_flag <- FALSE # check data types - if (!(is.numeric(report_period) | is.integer(report_period))){ + if (!(is.numeric(report_settings[["report_period"]]) | is.integer(report_settings[["report_period"]]))){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "'report_period' must be numeric or integer type - integer number of weeks only.\n") + err_msgs <- paste(err_msgs, "'report_settings$report_period' must be numeric or integer type - integer number of weeks only.\n") rpt_len_flag <- TRUE } - if (!(is.numeric(forecast_future) | is.integer(forecast_future))){ + if (!(is.numeric(report_settings[["fc_future_period"]]) | is.integer(report_settings[["fc_future_period"]]))){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "'forecast_future' must be numeric or integer type - integer number of weeks only.\n") + err_msgs <- paste(err_msgs, "'report_settings$forecast_future' must be numeric or integer type - integer number of weeks only.\n") rpt_len_flag <- TRUE - } else if (forecast_future > 12){ + } else if (report_settings[["fc_future_period"]] > 13){ # warn on long forecasts warn_flag <- TRUE - warn_msgs <- paste(warn_msgs, "Warning: It is not recommended to forecast more than 12 weeks into the future. You are forecasting for ", forecast_future, " weeks.\n") + warn_msgs <- paste(warn_msgs, "Warning: It is not recommended to forecast more than 12 weeks into the future. You are forecasting for ", report_settings[["fc_future_period"]], " weeks.\n") } - if (!(is.numeric(ed_summary_period) | is.integer(ed_summary_period))){ + if (!(is.numeric(report_settings[["ed_summary_period"]]) | is.integer(report_settings[["ed_summary_period"]]))){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "'ed_summary_period' must be numeric or integer type - integer number of weeks only.\n") + err_msgs <- paste(err_msgs, "'report_settings$ed_summary_period' must be numeric or integer type - integer number of weeks only.\n") rpt_len_flag <- TRUE } # report length must be equal to or larger than forecast and ED period together if (!rpt_len_flag){ - if (report_period < ed_summary_period + forecast_future){ + if (report_settings[["report_period"]] < report_settings[["ed_summary_period"]] + report_settings[["fc_future_period"]]){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "The report length ", report_period, " must be longer than the early detection period ", ed_summary_period, " plus the forecast ", forecast_future, ".\n") + err_msgs <- paste(err_msgs, "The report length ", report_settings[["report_period"]], " must be longer than the early detection period ", report_settings[["ed_summary_period"]], " plus the forecast ", report_settings[["fc_future_period"]], ".\n") } } # Models & Caching -------------------------------------------------------- - #use model_cached not old model_obj - if (!is.null(model_obj) & is.null(model_cached)){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "Please use the new 'model_cached' argument, and not deprecated 'model_obj'.\n") + #check if fc_model_family is cached that a cached model was given, else fail with error + if (fc_model_family == "cached"){ + if (is.null(report_settings[["model_cached"]])){ + err_flag <- TRUE + err_msgs <- paste(err_msgs, "If 'fc_model_family' == 'cached', a cached model must be supplied in 'report_settings$model_cached'.\n") + } } + #if given a full model - if (!is.null(model_cached)){ + if (!is.null(report_settings[["model_cached"]])){ #check that $model_info and $model_obj exists in model_cached - if (all(c("model_obj", "model_info") %in% names(model_cached))){ + if (all(c("model_obj", "model_info") %in% names(report_settings[["model_cached"]]))){ #if model looks okay so far, then check further - #make sure model_choice matches between cached model and settings. - #model choice already checked - if (!model_cached$model_info$model_choice == model_choice){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "The model choice of the given cached model, \"", model_cached$model_info$model_choice, "\", does not match the current setting of 'model_choice' of \"", model_choice, "\".\n") - } #end model_choice #make sure given model (if given) is a regression object (using basic "lm" as test) #model_cached$model_obj - classes <- class(model_cached$model_obj) + classes <- class(report_settings[["model_cached"]][["model_obj"]]) if (!"lm" %in% classes){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "The object in 'model_cached$model_obj' is not a regression object, found classes are: ", classes, ".\n") + err_msgs <- paste(err_msgs, "The object in 'report_settings$model_cached$model_obj' is not a regression object, found classes are: ", classes, ".\n") } #end lm check + #if using a cached model, the model family from the cached model will be used + #warn about overriding any user input family + if (fc_model_family != "cached"){ + warn_flag <- TRUE + warn_msgs <- paste(warn_msgs, "Warning: the cached model family ", report_settings$model_cached$model_info$fc_model_family, " will override any user input.", + "Found 'fc_model_family' set to ", fc_model_family, "instead of 'cached'.\n") + } #end if names } else { @@ -285,141 +451,110 @@ input_check <- function(epi_data, err_msgs <- paste(err_msgs, "The given cached model is missing $model_obj and/or $model_info.\n") } #end else on if names - } #end if is.null model_cached + } #end if !is.null model_cached # things that must exist in model_cached$model_info - # model_cached$model_info$model_choice + # model_cached$model_info$fc_model_family # model_cached$model_info$date_created # model_cached$model_info$known_epi_range$max #but will probably give decent error messages on their own if missing. + + # Control lists ----------------------------------------------------------- # Forecasting - #special flag for initial forecasting checks - fc_flag <- FALSE - #fc_control - # env_vars, clusters, lag_length - if (is.null(fc_control[["env_vars"]])){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "List of environmental variables to use for modeling is missing. Check 'fc_control$env_vars'.\n") - fc_flag <- TRUE - } - if (is.null(fc_control[["clusters"]])){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "Cluster information to use for modeling is missing. Check 'fc_control$clusters'.\n") - fc_flag <- TRUE - } - if (is.null(fc_control[["lag_length"]])){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "Length of maximum lag in days, 'lag_length', is missing. Check 'fc_control$lag_length'.\n") - fc_flag <- TRUE - } else if (!(is.numeric(fc_control[["lag_length"]]) | is.integer(fc_control[["lag_length"]]))){ + # model_env + # has obsfield + if(!rlang::quo_name(quo_obsfield) %in% colnames(report_settings[["env_var"]])){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "'lag_length' must be an integer number of days. Check 'fc_control$lag_length'.\n") - fc_flag <- TRUE - } + err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", to indicate the list of model environmental variables in 'report_settings$env_vars'.\n") + } else { + #does have obsfield, + #check that model variables exist in env data and env ref data + #but only if no other problems so far, since that could cause errors in the checks below + if (!err_flag){ - #if no initial fc errors, then continue - if (!fc_flag){ + #pull variables from model info input + model_vars <- report_settings[["env_var"]] %>% dplyr::pull(!!quo_obsfield) + #pull variables in env data + env_in_data <- env_data %>% dplyr::pull(!!quo_obsfield) %>% unique() + #pull variables in env ref data + env_in_ref <- env_ref_data %>% dplyr::pull(!!quo_obsfield) %>% unique() - # model_env - # has obsfield - if(!rlang::quo_name(quo_obsfield) %in% colnames(fc_control$env_vars)){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", to indicate the list of model environmental variables in 'fc_control$env_vars'.\n") - } else { - #does have obsfield, - #check that model variables exist in env data and env ref data - - #but only if no other problems so far, since that could cause errors in the checks below - if (!err_flag){ - - #pull variables from model info input - model_vars <- fc_control$env_vars %>% dplyr::pull(!!quo_obsfield) - #pull variables in env data - env_in_data <- env_data %>% dplyr::pull(!!quo_obsfield) %>% unique() - #pull variables in env ref data - env_in_ref <- env_ref_data %>% dplyr::pull(!!quo_obsfield) %>% unique() - - if (!all(model_vars %in% env_in_data)){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "Model variable(s) given in 'fc_control$env_vars' is/are missing from 'env_data':\n", - model_vars[which(!model_vars %in% env_in_data)], "\n") - } - if (!all(model_vars %in% env_in_ref)){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "Model variable(s) given in 'fc_control$env_vars' is/are missing from 'env_ref_data':\n", - model_vars[which(!model_vars %in% env_in_ref)], "\n") - } - } #end err_flag - } #end else obsfield - - #clusters - # has groupfield - if(!rlang::quo_name(quo_groupfield) %in% colnames(fc_control$clusters)){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in 'fc_control$clusters'.\n") - } - # has cluster_id - if(!"cluster_id" %in% colnames(fc_control$clusters)){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column 'cluster_id' in 'fc_control$clusters'.\n") - } - #now check that all geographic groupings from epi data have a cluster assigned - #as long as no previous errors - if (!err_flag){ - #groupings in cluster info - model_cl <- fc_control$clusters %>% dplyr::pull(!!quo_groupfield) - #groupings in epidemiological data - groups_epi <- dplyr::pull(epi_data, !!quo_groupfield) %>% unique() - #check all in cluster list - if (!all(groups_epi %in% model_cl)){ + if (!all(model_vars %in% env_in_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "Geographic groupings present in the epidemiological data are missing in 'fc_control$clusters':\n", - groups_epi[which(!groups_epi %in% model_cl)]) + err_msgs <- paste(err_msgs, "Model variable(s) given in 'report_settings$env_var' is/are missing from 'env_data':\n", + model_vars[which(!model_vars %in% env_in_data)], "\n") } - #Don't need to check environmental data. Extra env data for other groupings not in epidemiological data are just ignored. - } - - #lag_length - #already checked existance and numeric/integer type - #check that enough environmental data exists for lag length selected - - #but only if no other problems so far, since that could cause errors in the checks below - if (!err_flag){ - #subset to env variables as dictated by the model - env_model_data <- pull_model_envvars(env_data, quo_obsfield, fc_control) - #get earliest dates available - env_start_dts <- env_model_data %>% dplyr::group_by(!!quo_obsfield) %>% dplyr::summarize(start_dt = min(.data$obs_date)) - #date needed by laglength and first epidemiological data date - need_dt <- min(epi_data$obs_date) - as.difftime(fc_control$lag_length, units = "days") - #all env dates equal or before needed date? - if (!all(env_start_dts$start_dt <= need_dt)){ + if (!all(model_vars %in% env_in_ref)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "Not enough environmental data for a lag length of ", fc_control$lag_length, - "days.\n Epidemiological start is", min(epi_data$obs_date), - "therefore environmental data is needed starting", need_dt, "for variables:\n", - env_start_dts[which(!env_start_dts$start_dt <= need_dt),1]) - + err_msgs <- paste(err_msgs, "Model variable(s) given in 'report_settings$env_var' is/are missing from 'env_ref_data':\n", + model_vars[which(!model_vars %in% env_in_ref)], "\n") } } #end err_flag + } #end else obsfield - } #end fc flag + #clusters + # has groupfield + if(!rlang::quo_name(quo_groupfield) %in% colnames(report_settings[["fc_clusters"]])){ + err_flag <- TRUE + err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in 'report_settings$clusters'.\n") + } + # has cluster_id + if(!"cluster_id" %in% colnames(report_settings[["fc_clusters"]])){ + err_flag <- TRUE + err_msgs <- paste(err_msgs, "There must be a column 'cluster_id' in 'report_settings$clusters'.\n") + } + #now check that all geographic groupings from epi data have a cluster assigned + #as long as no previous errors + if (!err_flag){ + #groupings in cluster info + model_cl <- report_settings[["fc_clusters"]] %>% dplyr::pull(!!quo_groupfield) + #groupings in epidemiological data + groups_epi <- dplyr::pull(epi_data, !!quo_groupfield) %>% unique() + #check all in cluster list + if (!all(groups_epi %in% model_cl)){ + err_flag <- TRUE + err_msgs <- paste(err_msgs, "Geographic groupings present in the epidemiological data are missing in 'report_settings$clusters':\n", + groups_epi[which(!groups_epi %in% model_cl)]) + } + #Don't need to check environmental data. Extra env data for other groupings not in epidemiological data are just ignored. + } + + #lag_length + #already checked existance and numeric/integer type + #check that enough environmental data exists for lag length selected + + #but only if no other problems so far, since that could cause errors in the checks below + if (!err_flag){ + #subset to env variables as dictated by the model + env_model_data <- pull_model_envvars(env_data, quo_obsfield, env_var = report_settings$env_var) + #get earliest dates available + env_start_dts <- env_model_data %>% dplyr::group_by(!!quo_obsfield) %>% dplyr::summarize(start_dt = min(.data$obs_date)) + #date needed by laglength and first epidemiological data date + need_dt <- min(epi_data$obs_date) - as.difftime(report_settings[["env_lag_length"]], units = "days") + #all env dates equal or before needed date? + if (!all(env_start_dts$start_dt <= need_dt)){ + err_flag <- TRUE + err_msgs <- paste(err_msgs, "Not enough environmental data for a lag length of ", report_settings[["env_lag_length"]], + "days.\n Epidemiological start is", min(epi_data$obs_date), + "therefore environmental data is needed starting", need_dt, "for variables:\n", + env_start_dts[which(!env_start_dts$start_dt <= need_dt),1]) + + } + } #end err_flag - # ed_method & ed_control - if (ed_method == "farrington"){ + # ed_method & ed_control - # if Farrington, then check for controls for Farrington - #w = 4, reweight = TRUE, weightsThreshold = 2.58, trend = TRUE, pThresholdTrend = 0, populationOffset = TRUE, noPeriods = 10, pastWeeksNotIncluded = 4, thresholdMethod = "nbPlugin" - #allow b + if (report_settings[["ed_method"]] == "farrington"){ - #actually, all have defaults in farringtonFlexible() and can be missing - if (is.null(ed_control)){ + #controls for Farrington all have defaults in farringtonFlexible() and can be missing, just warn + if (is.null(report_settings[["ed_control"]])){ #warning if missing though warn_flag <- TRUE warn_msgs <- paste(warn_msgs, "Warning: Early Detection controls not found, running with surveillance package defaults.\n") diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 72720c5..34d8ce0 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -50,7 +50,7 @@ #' \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of #' generalized additive model (GAM) to run: it specifies the distribution and #' link to use in model fitting. E.g. for a Poisson regression, the user would -#' input "poisson()". +#' input "poisson()". If a cached model is being used, set the parameter to `"cached"`. #' #'@param report_settings This is a named list of all the report, forecasting, #' event detection and other settings. All of these have defaults, but they are @@ -89,14 +89,14 @@ #' run of run_epidemia() that produces a model (regression object) and #' metadata. The metadata will be used for input checking and validation. Using #' a prebuilt model saves on processing time, but will need to be updated -#' periodically. +#' periodically. If using a cached model, also set `fc_model_family = "cached"`. #' #' \item \code{env_var}: List environmental variables to actually use in the #' modelling. (You can therefore have extra variables or data in the #' environmental dataset.) Input should be a one column tibble, header row as #' `obsfield` and each row with entries of the variables (must match what is in #' env_data, env_ref-data, and env_info). Default is to use all environmental -#' data present in all three: env_data, env_ref_data, and env_info. +#' variables that are present in all three of env_data, env_ref_data, and env_info. #' #' \item \code{env_lag_length} = 180: The number of days of past environmental #' data to include for the lagged effects. The distributed lags are summarized @@ -246,9 +246,9 @@ run_epidemia <- function(epi_data = NULL, #Note: if field name does not exist in any dataset, enquo() will throw an error. } - # Preparing: Input checking ----------------------------------------------- + # Preparing: Basic Input checking ----------------------------------------------- - #1. Test for critical inputs This will not check if they've assigned the right + #First: Test for critical inputs. This will not check if they've assigned the right #thing to the argument, or got the argument order correct if not explicit #argument declarations. But, no other checks can really proceed if things are #missing. @@ -263,7 +263,7 @@ run_epidemia <- function(epi_data = NULL, groupfield = quo_groupfield, obsfield = quo_obsfield, valuefield = quo_valuefield) - necessary <- create_named_list(epi_data, env_data, env_ref_data, env_info) + necessary <- create_named_list(epi_data, env_data, env_ref_data, env_info, fc_model_family) #initialize missing info msgs & flag missing_msgs <- "" @@ -290,207 +290,24 @@ run_epidemia <- function(epi_data = NULL, } - # # 2. match.arg for arguments with options - # #Note: using message() instead of warning() to get message to appear right away - # - # #model_choice = c("poisson-bam", "negbin") - # #tolower to capture upper and lower case user-input variations since match.arg is case sensitive - # #but must only try function if ed_method is not null (i.e. was given) - # if (!is.null(model_choice)){ - # model_choice <- tolower(model_choice) - # } - # model_choice <- tryCatch({ - # #including hidden naïve models for skill test in validation - # match.arg(model_choice, c("poisson-bam", "negbin", "naive-persistence", "naive-averageweek")) - # }, error = function(e){ - # message("Warning: Given 'model_choice' does not match 'poisson-bam' or 'negbin', running as 'poisson-bam'.") - # "poisson-bam" - # }, finally = { - # if (length(model_choice) > 1){ - # #if model_choice was missing at run_epidemia() call, got assigned c("poisson-bam", "negbin") - # message("Note: 'model_choice' was missing, running as 'poisson-bam'.") - # #no return, because in match.arg() it will take the first item, which is "poisson-bam". - # } - # }) - # - # #ed_method = c("none", "farrington") - # #tolower to capture upper and lower case user-input variations since match.arg is case sensitive - # #but must only try function if ed_method is not null (i.e. was given) - # if (!is.null(ed_method)){ - # ed_method <- tolower(ed_method) - # } - # ed_method <- tryCatch({ - # match.arg(ed_method, c("none", "farrington")) - # }, error = function(e){ - # message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") - # "none" - # }, finally = { - # if (length(ed_method) > 1){ - # #if ed_method was missing at run_epidemia() call, got assigned c("none", "farrington") - # message("Note: 'ed_method' was missing, running as 'none'.") - # #no return, because in match.arg() it will take the first item, which is "none". - # } - # }) - # - # #week_type = c("ISO", "CDC") - # week_type <- tryCatch({ - # match.arg(week_type, c("ISO", "CDC")) - # }, error = function(e){ - # message("Warning: Given 'week_type' does not match 'ISO' or 'CDC', running as 'ISO'.") - # "ISO" - # }, finally = { - # if (length(week_type) > 1){ - # #if week_type was missing at run_epidemia() call, got assigned c("ISO", "CDC") - # message("Note: 'week_type' was missing, running as 'ISO'.") - # #no return, because in match.arg() it will take the first item, which is "ISO". - # } - # }) - - - ##### <<>> fix later - # # 3. More input checking - # check_results <- input_check(epi_data, - # quo_casefield, - # quo_popfield, - # inc_per, - # quo_groupfield, - # week_type, - # report_period, - # ed_summary_period, - # ed_method, - # ed_control, - # env_data, - # quo_obsfield, - # quo_valuefield, - # forecast_future, - # fc_control, - # env_ref_data, - # env_info, - # model_obj, - # model_cached, - # model_choice) - # #if warnings, just give message and continue - # if (check_results$warn_flag){ - # message(check_results$warn_msgs) - # } - # #if then if errors, stop and return error messages - # if (check_results$err_flag){ - # #prevent possible truncation of all error messages - # options(warning.length = 4000L) - # stop(check_results$err_msgs) - # } - - - - # Preparing: generating listings, defaults and date sets ---------------------------- + # Preparing: generating listings, defaults ---------------------------- #create alphabetical list of unique groups #must remain in alpha order for early detection using surveillance package to capture results properly groupings <- dplyr::pull(epi_data, !!quo_groupfield) %>% unique() %>% sort() - #create alphabetical list of all unique environmental variables + #create alphabetical list of all unique environmental variables in env_data env_variables <- dplyr::pull(env_data, !!quo_obsfield) %>% unique() %>% sort() - # <<>> eventually separate out into own function, here for building - #processing or defaults + #set defaults in report_settings if not supplied + report_settings <- set_report_defaults(raw_settings = report_settings, + env_info, + env_ref_data, + env_variables, + quo_obsfield, + groupings, + quo_groupfield) - if (is.null(report_settings[["report_period"]])){ - report_settings[["report_period"]] <- 26 - } - - if (is.null(report_settings[["report_inc_per"]])){ - report_settings[["report_inc_per"]] <- 1000 - #okay if not used, if report_value_type is cases instead of incidence - } - - if (is.null(report_settings[["epi_interpolate"]])){ - report_settings[["epi_interpolate"]] <- FALSE - } - - if (is.null(report_settings[["ed_summary_period"]])){ - report_settings[["ed_summary_period"]] <- 4 - } - - if (is.null(report_settings[["model_run"]])){ - report_settings[["model_run"]] <- FALSE - } - - if (is.null(report_settings[["model_cached"]])){ - report_settings[["model_cached"]] <- NULL - } - - if (is.null(report_settings[["env_lag_length"]])){ - #maybe make default based on data length, but for now - report_settings[["env_lag_length"]] <- 180 - } - - if (is.null(report_settings[["fc_cyclicals"]])){ - report_settings[["fc_cyclicals"]] <- FALSE - } - - if (is.null(report_settings[["fc_future_period"]])){ - report_settings[["fc_future_period"]] <- 8 - } - - #default false, with explicit false for naive models (probably ok w/out, just being careful) - if (is.null(report_settings[["env_anomalies"]])){ - report_settings[["env_anomalies"]] <- dplyr::case_when( - fc_model_family == "naive-persistence" ~ FALSE, - fc_model_family == "naive-weekaverage" ~ FALSE, - #default to FALSE - TRUE ~ FALSE) - } - - - # For things that are being string matched: - # tolower to capture upper and lower case user-input variations since match.arg is case sensitive - # but must only try function if ed_method is not null (i.e. was given) - - #report_value_type - # if provided, prepare for matching - if (!is.null(report_settings[["report_value_type"]])){ - report_settings[["report_value_type"]] <- tolower(report_settings[["report_value_type"]]) - } else { - #if not provided/missing/null - message("Note: 'report_value_type' was not provided, returning results in case counts ('cases').") - report_settings[["report_value_type"]] <- "cases" - } - #try match - report_settings[["report_value_type"]] <- tryCatch({ - match.arg(report_settings[["report_value_type"]], c("cases", "incidence")) - }, error = function(e){ - message("Warning: Given 'report_value_type' does not match 'cases' or 'incidence', running as 'cases'.") - "cases" - }, finally = { - #failsafe default - "cases" - }) - - # epi_date_type - # if provided, prepare for matching - if (!is.null(report_settings[["epi_date_type"]])){ - #want to keep ISO and CDC capitalized, but drop 'Week' to 'week' if had been entered that way - first_char <- substr(report_settings[["epi_date_type"]], 1, 1) %>% - tolower() - #remainder of user entry - rest_char <- substr(report_settings[["epi_date_type"]], 2, nchar(report_settings[["epi_date_type"]])) - #paste back together - report_settings[["epi_date_type"]] <- paste0(first_char, rest_char) - } else { - #if not provided/missing/null - message("Note: 'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').") - report_settings[["epi_date_type"]] <- "weekISO" - } - #try match - report_settings[["epi_date_type"]] <- tryCatch({ - match.arg(report_settings[["epi_date_type"]], c("weekISO", "weekCDC")) #"monthly" reserved for future - }, error = function(e){ - message("Warning: Given 'epi_date_type' does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).") - "weekISO" - }, finally = { - #failsafe default - "weekISO" - }) # switch epi_date_type to week_type needed for add_datefields() week_type <- dplyr::case_when( report_settings[["epi_date_type"]] == "weekISO" ~ "ISO", @@ -499,76 +316,34 @@ run_epidemia <- function(epi_data = NULL, TRUE ~ NA_character_) - # ed_method - # if provided, prepare for matching - if (!is.null(report_settings[["ed_method"]])){ - report_settings[["ed_method"]] <- tolower(report_settings[["ed_method"]]) - } else { - #if not provided/missing/null - message("Note: 'ed_method' was not provided, running as 'none'.") - report_settings[["ed_method"]] <- "none" - } - #try match - report_settings[["ed_method"]] <- tryCatch({ - match.arg(report_settings[["ed_method"]], c("none", "farrington")) - }, error = function(e){ - message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") - "none" - }, finally = { - #failsafe default to no event detection - "none" - }) - - - # For more complicated defaults - - #env_var -- what is listed in env_info & also in env_data - if (is.null(report_settings[["env_var"]])){ - #create list of all environmental variables in env_info - env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) - #env_variables already gen list of env_data - report_settings[["env_var"]] <- intersect(env_variables, env_info_variables) - #maybe add intersection with env_ref also? <<>> + # Preparing: Detailed Input checking ----------------------------------------------- + + # More detailed input checking + check_results <- input_check(epi_data, + env_data, + env_ref_data, + env_info, + quo_casefield, + quo_popfield, + quo_groupfield, + quo_obsfield, + quo_valuefield, + fc_model_family, + report_settings) + #if warnings, just give message and continue + if (check_results$warn_flag){ + message(check_results$warn_msgs) } - - #nthreads - #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) - #if user-supplied, use that cap at 2, otherwise create a default number - #used to decide if run anomalize_env() prior to forecasting - if (!is.null(report_settings[["fc_nthreads"]])) { - # nthreads above 2 is not actually helpful - report_settings[["fc_nthreads"]] <- ifelse(report_settings[["fc_nthreads"]] > 1, 2, 1) - } else { - #no value fed in, so test and determine - report_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) - } #end else for ncores not given - - - #fc_clusters - #default is one cluster, probably not what you actually want for any type of large system - if (is.null(report_settings[["fc_clusters"]])){ - #create tbl of only one cluster - #groupings already exist as list of geographic groups - cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% - #and fix names with NSE - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) - #assign - report_settings[["fc_clusters"]] <- cluster_tbl + #if then if errors, stop and return error messages + if (check_results$err_flag){ + #prevent possible truncation of all error messages + options(warning.length = 4000L) + stop(check_results$err_msgs) } - # Developer options - if (is.null(report_settings[["dev_fc_fit_freq"]])){ - report_settings[["dev_fc_fit_freq"]] <- "once" - } - if (is.null(report_settings[["dev_fc_modbsplines"]])){ - report_settings[["dev_fc_modbsplines"]] <- FALSE - } - if (is.null(report_settings[["dev_fc_formula"]])){ - report_settings[["dev_fc_formula"]] <- NULL - } - + # Preparing: date sets ---------------------------- # Create report date information: for passing to interval functions, and report output # report_period is full # of weeks of report. From fefe035404153e9613271abf47ca750660bd6edc Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 3 Mar 2020 17:35:09 -0600 Subject: [PATCH 019/132] Correcting case_when to if else blocks for switching on return values for cases or incidence. Case_when tries to calculate all RHS, which will not work in different environments like here. --- R/event_detection.R | 23 +++++++----- R/forecasting_main.R | 83 +++++++++++++++++++++++++++++--------------- R/run_epidemia.R | 23 +++++++----- 3 files changed, 85 insertions(+), 44 deletions(-) diff --git a/R/event_detection.R b/R/event_detection.R index 259e2fe..c77a333 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -349,19 +349,26 @@ stss_res_to_output_data <- function(stss_res_list, ed_thresh_res <- stss_res_flat %>% dplyr::mutate(series = "thresh", obs_date = .data$epoch, - value = dplyr::case_when( - #if reporting in case counts - val_type == "cases" ~ upperbound, - #if incidence - val_type == "incidence" ~ upperbound / !!quo_popfield * inc_per, - #otherwise - TRUE ~ NA_real_), - #value = upperbound / !!quo_popfield * inc_per, #Incidence, from stss & epi_fc_data + #value calculations change depending on report_value_type + #case_when is not viable because it evaluates ALL RHS + value = if(val_type == "cases"){ + .data$upperbound + } else if (val_type == "incidence"){ + .data$upperbound / !!quo_popfield * inc_per + } else {NA_real_}, + # value = dplyr::case_when( + # #if reporting in case counts + # val_type == "cases" ~ upperbound, + # #if incidence + # val_type == "incidence" ~ upperbound / !!quo_popfield * inc_per, + # #otherwise + # TRUE ~ NA_real_), lab = "Alert Threshold", upper = NA, lower = NA) %>% dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) + #combine ed results ed <- rbind(ed_alert_res, ew_alert_res, ed_thresh_res) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 25b11e2..e426708 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -194,36 +194,63 @@ run_forecast <- function(epi_data, fc_cases_lwr = .data$fit-1.96*sqrt(.data$fit)) # extract fc series into report format - fc_res <- preds_catch %>% - dplyr::mutate(series = "fc", - value = dplyr::case_when( - #if reporting in case counts - report_settings[["report_value_type"]] == "cases" ~ fc_cases, - #if incidence - report_settings[["report_value_type"]] == "incidence" ~ fc_cases / !!quo_popfield * report_settings[["report_inc_per"]], - #otherwise - TRUE ~ NA_real_), - lab = "Forecast Trend", - upper = dplyr::case_when( - #if reporting in case counts - report_settings[["report_value_type"]] == "cases" ~ fc_cases_upr, - #if incidence - report_settings[["report_value_type"]] == "incidence" ~ fc_cases_upr / !!quo_popfield * report_settings[["report_inc_per"]], - #otherwise - TRUE ~ NA_real_), - lower = dplyr::case_when( - #if reporting in case counts - report_settings[["report_value_type"]] == "cases" ~ fc_cases_lwr, - #if incidence - report_settings[["report_value_type"]] == "incidence" ~ fc_cases_lwr / !!quo_popfield * report_settings[["report_inc_per"]], - #otherwise - TRUE ~ NA_real_) - #value = fc_cases / !!quo_popfield * inc_per, - #upper = fc_cases_upr / !!quo_popfield * inc_per, - #lower = fc_cases_lwr / !!quo_popfield * inc_per - ) %>% + # if else off of report_value_type of reporting in terms of cases or incidence + # using full if else blocks to do all 3 at once, rather than if_elses in each variable + if (report_settings[["report_value_type"]] == "cases"){ + fc_res <- preds_catch %>% + dplyr::mutate(series = "fc", + lab = "Forecast Trend", + value = .data$fc_cases, + upper = .data$fc_cases_upr, + lower = .data$fc_cases_lwr) + } else if (report_settings[["report_value_type"]] == "incidence"){ + fc_res <- preds_catch %>% + dplyr::mutate(series = "fc", + lab = "Forecast Trend", + value = .data$fc_cases / !!quo_popfield * report_settings[["report_inc_per"]], + upper = .data$fc_cases_upr / !!quo_popfield * report_settings[["report_inc_per"]], + lower = .data$fc_cases_lwr / !!quo_popfield * report_settings[["report_inc_per"]]) + + } else { #shouldn't happen + fc_res <- preds_catch %>% + dplyr::mutate(series = "fc", + lab = "Forecast Trend", + value = NA_real_, + upper = NA_real_, + lower = NA_real_) + + } + + #select only the needed columns + fc_res <- fc_res %>% dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) + # case_when evaluates ALL RHS. Not appropriate to use here as populationfield may not exist. + # value = dplyr::case_when( + # #if reporting in case counts + # report_settings[["report_value_type"]] == "cases" ~ fc_cases, + # #if incidence + # report_settings[["report_value_type"]] == "incidence" ~ fc_cases / !!quo_popfield * report_settings[["report_inc_per"]], + # #otherwise + # TRUE ~ NA_real_), + # + # upper = dplyr::case_when( + # #if reporting in case counts + # report_settings[["report_value_type"]] == "cases" ~ fc_cases_upr, + # #if incidence + # report_settings[["report_value_type"]] == "incidence" ~ fc_cases_upr / !!quo_popfield * report_settings[["report_inc_per"]], + # #otherwise + # TRUE ~ NA_real_), + # + # lower = dplyr::case_when( + # #if reporting in case counts + # report_settings[["report_value_type"]] == "cases" ~ fc_cases_lwr, + # #if incidence + # report_settings[["report_value_type"]] == "incidence" ~ fc_cases_lwr / !!quo_popfield * report_settings[["report_inc_per"]], + # #otherwise + # TRUE ~ NA_real_) + + # return list with res and other needed items fc_res_full <- create_named_list(fc_epi = preds_catch, fc_res, diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 34d8ce0..3d353cf 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -415,15 +415,22 @@ run_epidemia <- function(epi_data = NULL, #include only observed data from requested start of report dplyr::filter(.data$obs_date >= report_dates$full$min) %>% dplyr::mutate(series = "obs", - value = dplyr::case_when( - #if reporting in case counts - report_settings[["report_value_type"]] == "cases" ~ !!quo_casefield, - #if incidence - report_settings[["report_value_type"]] == "incidence" ~ !!quo_casefield / !!quo_popfield * report_settings[["report_inc_per"]], - #otherwise - TRUE ~ NA_real_), + #value calculations change depending on report_value_type + #case_when is not viable because it evaluates ALL RHS + #condition is scalar, so vectorized ifelse is not appropriate + value = if(report_settings[["report_value_type"]] == "cases"){ + !!quo_casefield + } else if (report_settings[["report_value_type"]] == "incidence"){ + !!quo_casefield / !!quo_popfield * report_settings[["report_inc_per"]] + } else {NA_real_}, + # value = dplyr::case_when( + # #if reporting in case counts + # report_settings[["report_value_type"]] == "cases" ~ !!quo_casefield, + # #if incidence + # report_settings[["report_value_type"]] == "incidence" ~ !!quo_casefield / !!quo_popfield * report_settings[["report_inc_per"]], + # #otherwise + # TRUE ~ NA_real_), #note use of original not interpolated cases - #value = !!quo_casefield / !!quo_popfield * inc_per, lab = "Observed", upper = NA, lower = NA) %>% From 6b8e2bc98e75f7d1d047c64a3a121306fb1e392c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 3 Mar 2020 17:36:14 -0600 Subject: [PATCH 020/132] Format report_settings for inclusion in metadata in final report output. Standard order and format will allow default parameter testing to match with previous runs. --- R/formatters_calculators.R | 13 +++++++++++++ R/run_epidemia.R | 5 +++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index a56c76c..0ce4cf2 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -241,3 +241,16 @@ calc_env_anomalies <- function(env_ts, dplyr::ungroup() } + +#' Formats report_settings for including in metadata part of final report data +#' +#'@param rpt_settings Report settings after processing defaults and matching. +#' +#'@return Named list of report_settings, in alphabetical order and no developer settings +#' +format_report_settings <- function(rpt_settings){ + #order alphabetically + clean_settings <- rpt_settings[order(names(rpt_settings))] + #remove dev + clean_settings <- clean_settings[!grepl("[$dev]", names(clean_settings))] +} diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 3d353cf..6abfdb6 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -467,6 +467,7 @@ run_epidemia <- function(epi_data = NULL, obsfield = rlang::quo_name(quo_obsfield), valuefield = rlang::quo_name(quo_valuefield)) + model_meta <- create_named_list(date_created = Sys.Date(), fieldnames, groupings, @@ -475,7 +476,7 @@ run_epidemia <- function(epi_data = NULL, env_dt_ranges = fc_res_all$env_dt_ranges, known_epi_range = report_dates$known, env_info, - report_settings, + report_settings = format_report_settings(report_settings), date_created = Sys.Date()) @@ -573,7 +574,7 @@ run_epidemia <- function(epi_data = NULL, env_dt_ranges = fc_res_all$env_dt_ranges, report_dates, env_info, - report_settings) + report_settings = format_report_settings(report_settings)) #regression object for future other use or troubleshooting regression_object <- fc_res_all$reg_obj From 068a9a0de399f80303f87cc7632b96d321b0ccb3 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 3 Mar 2020 17:37:19 -0600 Subject: [PATCH 021/132] Automatic documentation update --- man/build_model.Rd | 6 +- man/create_predictions.Rd | 2 +- man/extend_env_future.Rd | 2 +- man/forecast_regression.Rd | 6 +- man/format_report_settings.Rd | 17 ++++ man/input_check.Rd | 177 +++++++++++++++++++++------------- man/run_epidemia.Rd | 6 +- man/run_forecast.Rd | 6 +- man/run_validation.Rd | 6 +- man/set_report_defaults.Rd | 37 +++++++ 10 files changed, 181 insertions(+), 84 deletions(-) create mode 100644 man/format_report_settings.Rd create mode 100644 man/set_report_defaults.Rd diff --git a/man/build_model.Rd b/man/build_model.Rd index 4d77829..06cd624 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -13,7 +13,7 @@ build_model(fc_model_family, quo_groupfield, epi_known, report_settings, \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()".} +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} @@ -59,14 +59,14 @@ data and groupings converted to factors.} run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. + periodically. If using a cached model, also set `fc_model_family = "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - data present in all three: env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index b3efe73..95b1958 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -12,7 +12,7 @@ create_predictions(fc_model_family, nthreads, regress, epi_lag, req_date) \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()".} +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} \item{nthreads}{Extract of `report_settings$fc_nthreads`} diff --git a/man/extend_env_future.Rd b/man/extend_env_future.Rd index 6f32864..f85c459 100644 --- a/man/extend_env_future.Rd +++ b/man/extend_env_future.Rd @@ -38,7 +38,7 @@ method (e.g. sum or mean), report labels, etc.} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()".} +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} \item{epi_date_type}{Extract from `report_settings$epi_date_type`} diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index bdeaeea..e3266e7 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -19,7 +19,7 @@ run_epidemia().} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()".} +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -58,14 +58,14 @@ input "poisson()".} run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. + periodically. If using a cached model, also set `fc_model_family = "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - data present in all three: env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized diff --git a/man/format_report_settings.Rd b/man/format_report_settings.Rd new file mode 100644 index 0000000..4d04d89 --- /dev/null +++ b/man/format_report_settings.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formatters_calculators.R +\name{format_report_settings} +\alias{format_report_settings} +\title{Formats report_settings for including in metadata part of final report data} +\usage{ +format_report_settings(rpt_settings) +} +\arguments{ +\item{rpt_settings}{Report settings after processing defaults and matching.} +} +\value{ +Named list of report_settings, in alphabetical order and no developer settings +} +\description{ +Formats report_settings for including in metadata part of final report data +} diff --git a/man/input_check.Rd b/man/input_check.Rd index c9218fb..6289d3f 100644 --- a/man/input_check.Rd +++ b/man/input_check.Rd @@ -4,92 +4,135 @@ \alias{input_check} \title{Functions to check input to epidemiar} \usage{ -input_check(epi_data, quo_casefield, quo_popfield, inc_per, quo_groupfield, - week_type, report_period, ed_summary_period, ed_method, ed_control, - env_data, quo_obsfield, quo_valuefield, forecast_future, fc_control, - env_ref_data, env_info, model_obj, model_cached, model_choice) +input_check(epi_data, env_data, env_ref_data, env_info, quo_casefield, + quo_popfield, quo_groupfield, quo_obsfield, quo_valuefield, + fc_model_family, report_settings) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date field "obs_date".} +\item{env_data}{Daily environmental data for the same groupfields and date +range as the epidemiological data. It may contain extra data (other +districts or date ranges). The data must be in long format (one row for each +date and environmental variable combination), and must start at absolutel +minimum \code{report_settings$env_lag_length} days (default 180) before +epi_data for forecasting.} + +\item{env_ref_data}{Historical averages by week of year for environmental +variables. Used in extended environmental data into the future for long +forecast time, to calculate anomalies in early detection period, and to +display on timeseries in reports.} + +\item{env_info}{Lookup table for environmental data - reference creation +method (e.g. sum or mean), report labels, etc.} + \item{quo_casefield}{Quosure of user given field containing the disease case counts.} \item{quo_popfield}{Quosure of user-given field containing population values.} -\item{inc_per}{Number for what unit of population the incidence should be -reported in, e.g. incidence rate of 3 per 1000 people.} - \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{week_type}{String indicating the standard (WHO ISO-8601 or CDC epi -weeks) that the weeks of the year in epidemiological and environmental -reference data use ["ISO" or "CDC"]. (Required: epidemiological observation -dates listed are LAST day of week).} - -\item{report_period}{The number of weeks that the entire report will cover. -The \code{report_period} minus \code{forecast_future} is the number of weeks -of past (known) data that will be included.} - -\item{ed_summary_period}{The number of weeks that will be considered the -"early detection period". It will count back from the week of last known -epidemiological data.} - -\item{ed_method}{Which method for early detection should be used ("Farrington" -is only current option, or "None").} - -\item{ed_control}{All parameters for early detection algorithm, passed through -to that subroutine.} - -\item{env_data}{Daily environmental data for the same groupfields and date -range as the epidemiological data. It may contain extra data (other -districts or date ranges). The data must be in long format (one row for each -date and environmental variable combination), and must start at absolutel -minimum \code{laglen} (in \code{fc_control}) days before epi_data for -forecasting.} - \item{quo_obsfield}{Quosure of user given field name of the environmental data variables} \item{quo_valuefield}{Quosure of user given field name of the value of the environmental data variable observations.} -\item{forecast_future}{Number of futre weeks from the end of the -\code{epi_data} to produce forecasts.} - -\item{fc_control}{Parameters for forecasting, including which environmental -variable to include and any geographic clusters.} - -\item{env_ref_data}{Historical averages by week of year for environmental -variables. Used in extended environmental data into the future for long -forecast time, to calculate anomalies in early detection period, and to -display on timeseries in reports.} - -\item{env_info}{Lookup table for environmental data - reference creation -method (e.g. sum or mean), report labels, etc.} - -\item{model_obj}{Deprecated, use model_cached.} - -\item{model_cached}{The output of a previous model_run = TRUE run of -run_epidemia() that produces a model (regression object) and metadata. The -metadata will be used for input checking and validation. Using a prebuilt -model saves on processing time, but will need to be updated periodically.} - -\item{model_choice}{Critical argument to choose the type of model to generate. -The options are versions that the EPIDEMIA team has used for forecasting. -The first supported options is "poisson-gam" ("p") which is the original -epidemiar model: a Poisson regression using bam (for large data GAMs), with -a smoothed cyclical for seasonality. The default for fc_control$anom_env is -TRUE for using the anomalies of environmental variables rather than their -raw values. The second option is "negbin" ("n") which is a negative binomial -regression using glm, with no external seasonality terms - letting the -natural cyclical behavior of the environmental variables fill that role. The -default for fc_control$anom_env is FALSE and uses the actual observation -values in the modeling. The fc_control$anom_env can be overruled by the user -providing a value, but this is not recommended unless you are doing -comparisons.} +\item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to +\code{\link[mgcv:bam]{mgcv::bam}}, and the extended families in +\code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of +generalized additive model (GAM) to run: it specifies the distribution and +link to use in model fitting. E.g. for a Poisson regression, the user would +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} + +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. If using a cached model, also set `fc_model_family = "cached"`. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + variables that are present in all three of env_data, env_ref_data, and env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts. Default is 8 weeks. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_nthreads}: The number of parallel threads that can be used by + `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} } \value{ Returns a flag if there were any errors, plus accompanying error diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index 1f928ac..9c525e0 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -51,7 +51,7 @@ observations (unquoted field name).} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()".} +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -90,14 +90,14 @@ input "poisson()".} run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. + periodically. If using a cached model, also set `fc_model_family = "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - data present in all three: env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index aae00ab..afdc4d3 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -43,7 +43,7 @@ method (e.g. sum or mean), report labels, etc.} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()".} +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -82,14 +82,14 @@ input "poisson()".} run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. + periodically. If using a cached model, also set `fc_model_family = "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - data present in all three: env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 016b84a..9303050 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -80,7 +80,7 @@ observations (unquoted field name).} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()".} +input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -119,14 +119,14 @@ input "poisson()".} run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. + periodically. If using a cached model, also set `fc_model_family = "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - data present in all three: env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized diff --git a/man/set_report_defaults.Rd b/man/set_report_defaults.Rd new file mode 100644 index 0000000..2fe7a00 --- /dev/null +++ b/man/set_report_defaults.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/input_checks.R +\name{set_report_defaults} +\alias{set_report_defaults} +\title{Set defaults of any missing report_settings parameters} +\usage{ +set_report_defaults(raw_settings, env_info, env_ref_data, env_variables, + quo_obsfield, groupings, quo_groupfield) +} +\arguments{ +\item{raw_settings}{The report_settings object as given by the user.} + +\item{env_info}{Lookup table for environmental data - reference creation +method (e.g. sum or mean), report labels, etc.} + +\item{env_ref_data}{Historical averages by week of year for environmental +variables. Used in extended environmental data into the future for long +forecast time, to calculate anomalies in early detection period, and to +display on timeseries in reports.} + +\item{env_variables}{List of all unique environmental variables in env_data.} + +\item{quo_obsfield}{Quosure of user given field name of the environmental data +variables.} + +\item{groupings}{List of all unique geographical groupings in epi_data.} + +\item{quo_groupfield}{Quosure of the user given geographic grouping field to +run_epidemia().} +} +\value{ +Returns a full report_settings object, using user supplied values or + defaults is option was missing. +} +\description{ +Function sets defaults to report_settings parameters. +} From bcc90da942bb75a5a11f7fbec0be25f722f5ab8f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 4 Mar 2020 14:18:31 -0600 Subject: [PATCH 022/132] Adding additional/clarifying messages and comments regarding modeling settings --- R/forecasting_main.R | 9 +++++++++ R/input_checks.R | 3 ++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index e426708..4bfea76 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -160,6 +160,7 @@ run_forecast <- function(epi_data, reg_obj <- forereg_return$regress } else if (report_settings[["dev_fc_fit_freq"]] == "week") { + message("DEVELOPER: Fitting model per week...") # for each week of report, run forecast # initialize: prediction returns 4 columns preds_catch <- data.frame() @@ -500,9 +501,13 @@ build_model <- function(fc_model_family, if (report_settings[["fc_cyclicals"]]) { #TRUE, include cyclicals + message("Including seasonal cyclicals into model...") + #Formula override: report_settings[["dev_fc_formula"]] if (!is.null(report_settings[["dev_fc_formula"]])){ + message("DEVELOPER: Using user-supplied formula: ", report_settings[["dev_fc_formula"]]) + reg_eq <- report_settings[["dev_fc_formula"]] } else { @@ -544,6 +549,8 @@ build_model <- function(fc_model_family, #Formula override: report_settings[["dev_fc_formula"]] if (!is.null(report_settings[["dev_fc_formula"]])){ + message("DEVELOPER: Using user-supplied formula: ", report_settings[["dev_fc_formula"]]) + reg_eq <- report_settings[["dev_fc_formula"]] } else { @@ -661,6 +668,8 @@ create_predictions <- function(fc_model_family, } else { #user supplied family, use predict.bam on regression object (regress) + message("Creating predictions...") + #output prediction (through req_date) preds <- mgcv::predict.bam(regress, newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), diff --git a/R/input_checks.R b/R/input_checks.R index f44f399..cb9c059 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -29,7 +29,7 @@ set_report_defaults <- function(raw_settings, if (is.null(raw_settings)){ new_settings <- list() } else { - #copy over to begin before editing below + #copy over to begin before editing/updating below new_settings <- raw_settings } @@ -215,6 +215,7 @@ set_report_defaults <- function(raw_settings, new_settings[["dev_fc_formula"]] <- NULL } + new_settings } From e5c82af404a0bdea4d4992956f6a5bdafa2e0d5a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 4 Mar 2020 16:43:12 -0600 Subject: [PATCH 023/132] Correcting to pass the model for this loop --- R/model_validation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/model_validation.R b/R/model_validation.R index b8908a6..f0a4e84 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -207,7 +207,7 @@ run_validation <- function(date_start = NULL, populationfield = quo_popfield, obsfield = quo_obsfield, valuefield = quo_valuefield, - fc_model_family = fc_model_family, + fc_model_family = this_model, #this report_settings = this_report_settings) #this From ed77df87d4e7f09fe718dae663c6890477ce482a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 16 Mar 2020 10:38:48 -0500 Subject: [PATCH 024/132] quick commit from campus --- vignettes/overview-epidemiar.Rmd | 59 +++++++++----------------------- 1 file changed, 16 insertions(+), 43 deletions(-) diff --git a/vignettes/overview-epidemiar.Rmd b/vignettes/overview-epidemiar.Rmd index 17a97a5..d64cae2 100644 --- a/vignettes/overview-epidemiar.Rmd +++ b/vignettes/overview-epidemiar.Rmd @@ -61,43 +61,16 @@ For example GEE scripts and R project, see the `epidemiar-demo` repository at ht The main requirements for using this package are: -* surveillance / disease case counts per week per geographic group -* daily environmental data per geographic group with enough lead time for lagged effects (user set) -* pre-identified model: which environmental covariates to include, any clustering of geographic groups. +* Surveillance / disease case counts: per week per geographic group (if present) +* Daily environmental data: per geographic group with enough lead time for lagged effects (user set time period) +* Pre-identified model: which environmental covariates to include, any clustering of geographic groups, etc. # Modeling Overview -There are two models currently implemented in epidemiar. The first, `model_choice = poisson-bam`, is based on a general additive model (GAM) regression of multiple factors, including the geographic group, long terms trends, seasonality, lagged environmental drivers and clustering of geographic groups. - - - -$log(cases) \sim ~geo + bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo + \\ -~~~~~~~~~~~~~~~~~~~~s(doy, bs = "cc", by = geo) + \\ -~~~~~~~~~~~~~~~~~~~~(env_1 sum_1 * cl + env_1 sum_2 * cl + env_1 sum_3 * cl + \\ -~~~~~~~~~~~~~~~~~~~~~~~~~~~~env_1 sum_4 * cl + env_1 sum_5 * cl)~ + \cdots \\ -~~~~~~~~~~~~~~~~~~~~(env_n sum_1 * cl + env_n sum_2 * cl + env_n sum_3 * cl + \\ -~~~~~~~~~~~~~~~~~~~~~~~~~~~~env_n sum_4 * cl + env_n sum_5 * cl) + \\ -~~~~~~~~~~~~~~~~~~~~~~~~~~~~env_n sum_6 * cl + env_n sum_7 * cl)$ - -where $geo$ is the geographic group, $bs_1$ ... $bs_5$ are modified basis functions, $doy$ is the day of the year, $env$ are the environmental variables (1, 2 ... n) and the 7 summary ($sum$) statistics from the lagged basis functions, and $cl$ is the cluster identification of that geographic group. The regression is done with `family=poisson()` for a log link function to the case count. See the following sections for more details. +The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality,and clustering of geographic groups. + +The model family is user set, for example, you can run regression with a Poisson distribution (`fc_family = "poisson()"`) or <<>>. + ## Geographic group, long term trends, and seasonality @@ -111,6 +84,7 @@ The modified basis splines are created within the function as follows: - the last basis spline function is reverse, and - the second to last basis spline function is removed. +<<>> Option for To account for seasonality in each geographic group, a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ @@ -118,9 +92,13 @@ To account for seasonality in each geographic group, a cyclical cubic regression The rates of environmentally-mediated infectious diseases can be influenced by the environmental factors via a range of potential mechanisms, e.g. affecting the abundance and life cycle of disease vectors. The influences on disease generally lags behind the changes in the environmental covariates. +<<>> update variable names +<<>> note spline description +In the modeling controls, the user selects the maximum number of days in the past (lag length, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. + +<<>> default = false now, talk about option In our modeling, the **anomalies** of the environmental covariates are used as factors (by default - this can be changed by setting `fc_control$anom_env = FALSE`) . We are looking at the influence of deviation from normal in the environmental factors to help explain deviations from normal in the human cases. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group: $geo + s(doy, bs="cc", by=geo)$ -In the modeling controls, the user selects the maximum number of days in the past (lag length, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. ## Clusters @@ -134,19 +112,14 @@ On the other extreme, you could run separate models for each geographic group (e We allow the user to identify their own clusters of geographic units. The clustering determination can be done prior however the user chooses - for example, global model, individual models, clustering by ecological zones, or by identifying similar temporal disease patterns. -## Second Model Choice +<<>> environmental lags per cluster with thin plate smooths -There is also an option to use a negative binomial model (`model_choice = negbin`) instead. This is a glm with `family = MASS::negative.binomial(theta)`. If theta is not specified in `fc_control$theta`, then the call uses the `MASS::glm.nb()` function instead. - -In this model, the environmental data is *not* anomalized, but rather the raw values are used (by default, however this can be changed by setting `fc_control$anom_env = TRUE`). - -There is also *no* forced cyclical factor for seasonality, with the idea that the environmental variables are capturing this information. - -The long term trend and lagged basis functions are the same as in the main model. This model was added for comparison, but is not actively used in the EPIDEMIA-Ethiopia forecasting. ## Model Caching Option +<<>> update variable names + The results of `run_epidemiar(..., model_run = TRUE)` is a cached model: the regression object plus some metadata information about what was used to generate the model. Once a model has been generated, it can be fed back into `run_epidemiar(..., model_cached = {cached model object})` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. From 96fd4fbea6ffa5614807f5c4d7080e39e76f23c1 Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk Date: Tue, 17 Mar 2020 16:29:51 -0500 Subject: [PATCH 025/132] Finished full review of vignette with new input scheme and settings. --- vignettes/overview-epidemiar.Rmd | 37 ++++++++++++++++---------------- 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/vignettes/overview-epidemiar.Rmd b/vignettes/overview-epidemiar.Rmd index d64cae2..0d823f1 100644 --- a/vignettes/overview-epidemiar.Rmd +++ b/vignettes/overview-epidemiar.Rmd @@ -69,7 +69,7 @@ The main requirements for using this package are: The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality,and clustering of geographic groups. -The model family is user set, for example, you can run regression with a Poisson distribution (`fc_family = "poisson()"`) or <<>>. +The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_family` parameter. For example, you can run regression with a Poisson distribution (`fc_family = "poisson()"`). ## Geographic group, long term trends, and seasonality @@ -84,20 +84,22 @@ The modified basis splines are created within the function as follows: - the last basis spline function is reverse, and - the second to last basis spline function is removed. -<<>> Option for -To account for seasonality in each geographic group, a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ + + +There is a an option to explicitly include a cyclical for account for seasonality. If `report_settings$fc_cyclical` is set to TRUE (default is FALSE), a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ ## Environmental Variables The rates of environmentally-mediated infectious diseases can be influenced by the environmental factors via a range of potential mechanisms, e.g. affecting the abundance and life cycle of disease vectors. The influences on disease generally lags behind the changes in the environmental covariates. -<<>> update variable names -<<>> note spline description -In the modeling controls, the user selects the maximum number of days in the past (lag length, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. +In the modeling controls, the user selects the maximum number of days in the past (`report_settings$env_lag_length`, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. + + -<<>> default = false now, talk about option -In our modeling, the **anomalies** of the environmental covariates are used as factors (by default - this can be changed by setting `fc_control$anom_env = FALSE`) . We are looking at the influence of deviation from normal in the environmental factors to help explain deviations from normal in the human cases. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group: $geo + s(doy, bs="cc", by=geo)$ +In our modeling options, it is possible to specify that the _anomalies_ of the environmental covariates are used as factors (`fc_control$env_anomalies = TRUE`, the default is false to run with raw actual values). In some case, you may want to look at the influence of deviation from normal in the environmental factors to help explain deviations from normal in the disease cases. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group: $geo + s(doy, bs="cc", by=geo)$ @@ -109,36 +111,35 @@ If you were working with areas not likely or shown not to have spatial non-stati On the other extreme, you could run separate models for each geographic group (each geographic group as its own cluster). However, especially with noisy data or short time-series, this could lead to overfitting. -We allow the user to identify their own clusters of geographic units. The clustering determination can be done prior however the user chooses - for example, global model, individual models, clustering by ecological zones, or by identifying similar temporal disease patterns. +We allow the user to identify their own clusters of geographic units with `report_settings$fc_clusters`, a table of geographic unit and a cluster id (see data vignette for full format details). The clustering determination can be done prior however the user chooses - for example, global model, individual models, clustering by ecological zones, or by identifying similar temporal disease patterns. By default, without information in `fc_clusters`, the model will run as a global model (one cluster). + ## Model Caching Option -<<>> update variable names - -The results of `run_epidemiar(..., model_run = TRUE)` is a cached model: the regression object plus some metadata information about what was used to generate the model. -Once a model has been generated, it can be fed back into `run_epidemiar(..., model_cached = {cached model object})` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. +The results of `run_epidemiar()` with `report_settings$model_run = TRUE` is a cached model: the regression object plus some metadata information about what was used to generate the model. +Once a model has been generated, it can be fed back into `run_epidemiar()` with `report_settings$model_cached = {cached model object}` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. # Event Detection Overview The central idea behind outbreak detection is to identify when the case volume exceeds a baseline threshold, and to use this information in a prospective (not retrospective) manner to identify epidemics in their early stages. -Currently, epidemiar supports the Farrington improved algorithm for event detection, using `surveillance::Farringtonflexible()`. +Currently, epidemiar supports the Farrington improved algorithm for event detection, using `surveillance::Farringtonflexible()` by setting `report_settings$ed_method = "farrington"`. This family of methods developed by Farrington and later, Noufaily, have been implemented at several European infectious disease control centers. Farrington methods are based on quasi-Poisson regression and can take advantage of historical information while accounting for seasonality, long-term trends, and previous outbreaks. -The Farrington improved method offer parameters to control various model settings, such as the number of time points to include in the historical window through a specified number of years, the number of knots in the splines to account for seasonality, and the number of weeks to exclude at the beginning of the evaluation period (for events that may already be in progress). However, this method does generally require several years of historical data. +The Farrington improved method offer parameters to control various model settings, such as the number of time points to include in the historical window through a specified number of years, the number of knots in the splines to account for seasonality, and the number of weeks to exclude at the beginning of the evaluation period (for events that may already be in progress). These can be set using `report_settings$ed_control`, though `surveillance` package defaults will generally be used if not set. See the data & modeling vignette for more details. Note, the Farrington method does generally require several years of historical data. Alerts are generated by the Farrington algorithm run over the entire time length of the report on the number of cases, observed or future forecast (optionally adjusted for population). -**Early Detection** alerts are alerts that are triggered during the early detection period, a user set number of week of the most recently known epidemiological data (case counts). +**Early Detection** alerts are alerts that are triggered during the early detection period, a user set number of week of the most recently known epidemiological data (case counts) via `report_settings$ed_summary_period`. -**Early Warning** alerts are alerts that are triggered in the future forecast estimates (early warning period). These early warning alerts indicate that the environmental conditions are favorable (or unfavorable) for abnormally high case counts, based on past trends. +**Early Warning** alerts are alerts that are triggered in the future forecast (`report_settings$fc_future_period`) estimates (early warning period). These early warning alerts indicate that the environmental conditions are favorable (or unfavorable) for abnormally high case counts, based on past trends. Alerts per week per geographic group are recorded. As the algorithm runs over the entire length of the report, historical alerts (weeks included in the report that are prior to the early detection period) are also marked. From a971250a83f1076274ff5450934b9faa0c9abb3e Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk Date: Fri, 20 Mar 2020 11:32:33 -0500 Subject: [PATCH 026/132] Added missing fc_clusters description under report_settings, other minor documentation edits --- R/run_epidemia.R | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 6abfdb6..54ddc11 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -50,7 +50,8 @@ #' \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of #' generalized additive model (GAM) to run: it specifies the distribution and #' link to use in model fitting. E.g. for a Poisson regression, the user would -#' input "poisson()". If a cached model is being used, set the parameter to `"cached"`. +#' input "poisson()". If a cached model is being used, set the parameter to +#' `"cached"`. #' #'@param report_settings This is a named list of all the report, forecasting, #' event detection and other settings. All of these have defaults, but they are @@ -89,14 +90,16 @@ #' run of run_epidemia() that produces a model (regression object) and #' metadata. The metadata will be used for input checking and validation. Using #' a prebuilt model saves on processing time, but will need to be updated -#' periodically. If using a cached model, also set `fc_model_family = "cached"`. +#' periodically. If using a cached model, also set `fc_model_family = +#' "cached"`. #' #' \item \code{env_var}: List environmental variables to actually use in the #' modelling. (You can therefore have extra variables or data in the #' environmental dataset.) Input should be a one column tibble, header row as #' `obsfield` and each row with entries of the variables (must match what is in #' env_data, env_ref-data, and env_info). Default is to use all environmental -#' variables that are present in all three of env_data, env_ref_data, and env_info. +#' variables that are present in all three of env_data, env_ref_data, and +#' env_info. #' #' \item \code{env_lag_length} = 180: The number of days of past environmental #' data to include for the lagged effects. The distributed lags are summarized @@ -111,6 +114,13 @@ #' \item \code{fc_future_period} = 8: Number of future weeks from the end of #' the \code{epi_data} to produce forecasts. Default is 8 weeks. #' +#' \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster +#' id. This clusters, or groups, certain geographic locations together, to +#' better model when spatial non-stationarity in the relationship between +#' environmental variables and cases. See the overview and data & mdoeling +#' vignettes for more discussion. Default is a global model, all geographic +#' units in one cluster. +#' #' \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a #' smooth term based on day of year in the modelling (as one way of accounting #' for seasonality). @@ -128,7 +138,7 @@ #' \item \code{ed_control} = Controls passed along to the event detection #' method. E.g. for `ed_method = 'farrington'`, these are passed to #' \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. -#' Currently, these parameters are supported for Farrington: `b`, `w`, +#' Currently, these parameters are supported for Farrington: `b`, `w`, #' `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, #' `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. #' Any control not included will use surveillance package defaults, with the From 665245069f279fdd803b713a4a880813c98ee21d Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk Date: Fri, 20 Mar 2020 11:33:05 -0500 Subject: [PATCH 027/132] Autogenerated man pages documentation update --- man/build_model.Rd | 18 ++++++++++++++---- man/create_predictions.Rd | 3 ++- man/extend_env_future.Rd | 3 ++- man/forecast_regression.Rd | 18 ++++++++++++++---- man/input_check.Rd | 18 ++++++++++++++---- man/run_epidemia.Rd | 18 ++++++++++++++---- man/run_forecast.Rd | 18 ++++++++++++++---- man/run_validation.Rd | 18 ++++++++++++++---- 8 files changed, 88 insertions(+), 26 deletions(-) diff --git a/man/build_model.Rd b/man/build_model.Rd index 06cd624..0641c59 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -13,7 +13,8 @@ build_model(fc_model_family, quo_groupfield, epi_known, report_settings, \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} @@ -59,14 +60,16 @@ data and groupings converted to factors.} run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. If using a cached model, also set `fc_model_family = "cached"`. + periodically. If using a cached model, also set `fc_model_family = + "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - variables that are present in all three of env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and + env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized @@ -81,6 +84,13 @@ data and groupings converted to factors.} \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a smooth term based on day of year in the modelling (as one way of accounting for seasonality). @@ -98,7 +108,7 @@ data and groupings converted to factors.} \item \code{ed_control} = Controls passed along to the event detection method. E.g. for `ed_method = 'farrington'`, these are passed to \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. - Currently, these parameters are supported for Farrington: `b`, `w`, + Currently, these parameters are supported for Farrington: `b`, `w`, `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. Any control not included will use surveillance package defaults, with the diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index 95b1958..25c828b 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -12,7 +12,8 @@ create_predictions(fc_model_family, nthreads, regress, epi_lag, req_date) \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{nthreads}{Extract of `report_settings$fc_nthreads`} diff --git a/man/extend_env_future.Rd b/man/extend_env_future.Rd index f85c459..24c1d46 100644 --- a/man/extend_env_future.Rd +++ b/man/extend_env_future.Rd @@ -38,7 +38,8 @@ method (e.g. sum or mean), report labels, etc.} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{epi_date_type}{Extract from `report_settings$epi_date_type`} diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index e3266e7..13ca48e 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -19,7 +19,8 @@ run_epidemia().} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -58,14 +59,16 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. If using a cached model, also set `fc_model_family = "cached"`. + periodically. If using a cached model, also set `fc_model_family = + "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - variables that are present in all three of env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and + env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized @@ -80,6 +83,13 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a smooth term based on day of year in the modelling (as one way of accounting for seasonality). @@ -97,7 +107,7 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{ed_control} = Controls passed along to the event detection method. E.g. for `ed_method = 'farrington'`, these are passed to \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. - Currently, these parameters are supported for Farrington: `b`, `w`, + Currently, these parameters are supported for Farrington: `b`, `w`, `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. Any control not included will use surveillance package defaults, with the diff --git a/man/input_check.Rd b/man/input_check.Rd index 6289d3f..84810e0 100644 --- a/man/input_check.Rd +++ b/man/input_check.Rd @@ -46,7 +46,8 @@ environmental data variable observations.} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -85,14 +86,16 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. If using a cached model, also set `fc_model_family = "cached"`. + periodically. If using a cached model, also set `fc_model_family = + "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - variables that are present in all three of env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and + env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized @@ -107,6 +110,13 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a smooth term based on day of year in the modelling (as one way of accounting for seasonality). @@ -124,7 +134,7 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{ed_control} = Controls passed along to the event detection method. E.g. for `ed_method = 'farrington'`, these are passed to \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. - Currently, these parameters are supported for Farrington: `b`, `w`, + Currently, these parameters are supported for Farrington: `b`, `w`, `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. Any control not included will use surveillance package defaults, with the diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index 9c525e0..d81e65a 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -51,7 +51,8 @@ observations (unquoted field name).} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -90,14 +91,16 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. If using a cached model, also set `fc_model_family = "cached"`. + periodically. If using a cached model, also set `fc_model_family = + "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - variables that are present in all three of env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and + env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized @@ -112,6 +115,13 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a smooth term based on day of year in the modelling (as one way of accounting for seasonality). @@ -129,7 +139,7 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{ed_control} = Controls passed along to the event detection method. E.g. for `ed_method = 'farrington'`, these are passed to \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. - Currently, these parameters are supported for Farrington: `b`, `w`, + Currently, these parameters are supported for Farrington: `b`, `w`, `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. Any control not included will use surveillance package defaults, with the diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index afdc4d3..b33753e 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -43,7 +43,8 @@ method (e.g. sum or mean), report labels, etc.} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -82,14 +83,16 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. If using a cached model, also set `fc_model_family = "cached"`. + periodically. If using a cached model, also set `fc_model_family = + "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - variables that are present in all three of env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and + env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized @@ -104,6 +107,13 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a smooth term based on day of year in the modelling (as one way of accounting for seasonality). @@ -121,7 +131,7 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{ed_control} = Controls passed along to the event detection method. E.g. for `ed_method = 'farrington'`, these are passed to \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. - Currently, these parameters are supported for Farrington: `b`, `w`, + Currently, these parameters are supported for Farrington: `b`, `w`, `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. Any control not included will use surveillance package defaults, with the diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 9303050..83d908b 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -80,7 +80,8 @@ observations (unquoted field name).} \code{\link[mgcv]{family.mgcv}} can also be used. This sets the type of generalized additive model (GAM) to run: it specifies the distribution and link to use in model fitting. E.g. for a Poisson regression, the user would -input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} +input "poisson()". If a cached model is being used, set the parameter to +`"cached"`.} \item{report_settings}{This is a named list of all the report, forecasting, event detection and other settings. All of these have defaults, but they are @@ -119,14 +120,16 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache run of run_epidemia() that produces a model (regression object) and metadata. The metadata will be used for input checking and validation. Using a prebuilt model saves on processing time, but will need to be updated - periodically. If using a cached model, also set `fc_model_family = "cached"`. + periodically. If using a cached model, also set `fc_model_family = + "cached"`. \item \code{env_var}: List environmental variables to actually use in the modelling. (You can therefore have extra variables or data in the environmental dataset.) Input should be a one column tibble, header row as `obsfield` and each row with entries of the variables (must match what is in env_data, env_ref-data, and env_info). Default is to use all environmental - variables that are present in all three of env_data, env_ref_data, and env_info. + variables that are present in all three of env_data, env_ref_data, and + env_info. \item \code{env_lag_length} = 180: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized @@ -141,6 +144,13 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a smooth term based on day of year in the modelling (as one way of accounting for seasonality). @@ -158,7 +168,7 @@ input "poisson()". If a cached model is being used, set the parameter to `"cache \item \code{ed_control} = Controls passed along to the event detection method. E.g. for `ed_method = 'farrington'`, these are passed to \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. - Currently, these parameters are supported for Farrington: `b`, `w`, + Currently, these parameters are supported for Farrington: `b`, `w`, `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. Any control not included will use surveillance package defaults, with the From aa66b00bcae1083acc9a524a11da86161db35031 Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk Date: Fri, 20 Mar 2020 11:33:30 -0500 Subject: [PATCH 028/132] Update on data & modeling vignette --- vignettes/data-modeling.Rmd | 55 +++++++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 21 deletions(-) diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index 6e8f685..75a583f 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -1,7 +1,7 @@ --- title: "Modeling Data and Parameters" author: | - | Dawn Nekorchuk, Michael Wimberly, and EPIDEMIA Team Members + | Dawn M. Nekorchuk, Michael C. Wimberly, and EPIDEMIA Team Members | Department of Geography and Environmental Sustainability, University of Oklahoma | dawn.nekorchuk@ou.edu; mcwimberly@ou.edu date: "Updated `r format(Sys.time(), '%B %d, %Y')`" @@ -53,17 +53,19 @@ When calling the epidemiar function: * `casefield`: Give the field name for the case counts. * `populationfield`: Give the population field to give population numbers over time. It is used to calculated incidence, and also optionally used in Farrington method for populationOffset. * `groupfield`: Give the field name for districts or area divisions of epidemiological AND environmental data. If there are no groupings (all one area), user should give a field with the same value throughout the entire datasets. -* `inc_per`: At what rate should incidence be calculated for? Default is "1000", meaning x cases per 1000 population. -* `week_type`: For the `obs_date` in `epi_data`, you need to specify if you are using "CDC" epiweeks, or ISO-8601 ("ISO") standard weeks of the year (what WHO uses), the default assumption is ISO. The date should be the _last_ day of the epidemiological week. + +In the `report_settings` there is an additional parameters for epidemiological settings: +* `report_settings$epi_date_type`: For the `obs_date` in `epi_data`, you need to specify if you are using "weekCDC" epiweeks, or ISO-8601 ("weekISO") standard weeks of the year (what WHO uses). The default setting is "weekISO". The date should be the _last_ day of the epidemiological week. + #### Missing Data There should be a line for each week and geographic grouping, even for missing data (i.e. explicit missing data). -Any missing data will be filled in by linear interpolation inside of the epidemiar modeling functions. +Any missing data has the option of being filled in by linear interpolation inside of the epidemiar modeling function by using `report_settings$epi_interpolate = TRUE` (default is FALSE). ### Environmental Data, `env_data` -For the environmental data, daily data is expected for each environmental variable for each geographic unit. Based on the lag length chosen, you must have at least that number of days _before_ the first epidemiology data date. +For the environmental data, daily data is expected for each environmental variable for each geographic unit. Based on the lag length (`report_settings$env_lag_length`, default 180 days) chosen, you must have at least that number of days _before_ the first epidemiology data date. When calling the epidemiar function: @@ -87,7 +89,7 @@ The environmental reference / climate data should contain a reference value (col * `ref_value`: Historical mean, or other reference value, for that week of the year for that `groupfield` for that `obsfield`. * `ref_*`: You can have other field(s) in here that begin with `ref_`. These fields will propogate through to the `environ_timeseries` dataset in the ouput, which you can then use for plotting or other uses. -If you have `env_data`, but do not yet have a reference/climatology built from it, you can use the `env_daily_to_ref()` function to create one in the format accepted by `run_epidemiar()` for `env_ref_data`. Because of processing time (especially for long histories), it is recommended that you run this infrequently to generate a reference dataset that is then saved to be read in later, rather than regenerated each time. The `week_type` defaults to "ISO" for ISO8601/WHO standard week of year. This function also requires the `env_info` data, see below. +If you have `env_data`, but do not yet have a reference/climatology built from it, you can use the `env_daily_to_ref()` function to create one in the format accepted by `run_epidemiar()` for `env_ref_data`. Because of processing time (especially for long histories), it is recommended that you run this infrequently to generate a reference dataset that is then saved to be read in later, rather than regenerated each time. The `week_type` of this function defaults to "ISO" for ISO8601/WHO standard week of year. This function also requires the `env_info` data, see below. ### Reference Data @@ -104,36 +106,47 @@ In order to create summaries from Google Earth Engine, you will need to upload a If you are creating a formatted report later and wish to have maps of the results, you may need shapefiles for this. +## Setting up the Report and Model +### Report level settings -## Setting up the Report and Model +Many of the settings are bundled into the named list `report_settings` argument. These all have defaults, but they are not likely the correct defaults for your dataset and modeling. + +* `report_settings$report_period`: Total number of weeks for the report to include, including the number of future forecast weeks, `report_settings$fc_future_period`, see forecasting section below. Default for total report period is 26 weeks. +* `report_settings$report_value_type`: How to report the results, either in terms of "cases" (default) or "incidence". If 'incidence', population data must be supplied in the `epi_data` under `{populationfield}`. +* `report_settings$report_inc_per`: If reporting incidence, what should be denominator be? Default is per 1000 persons, and ignored if `report_settings$report_value_type = "cases"`. ### Setting up for Forecasting -* `report_period`: Total number of weeks for the report to include, including the number of future forecast weeks, `forecast_future`. -* `forecast_future`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks. +*`fc_model_family`: The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). This is required, with no default. + +Besides `fc_model_family`, the rest of the forecasting controls (along with other settings) are bundled into the named list `report_settings`: -The rest of the forecasting controls are bundled into a named list `fc_control`: +* `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks. +* `report_settings$fc_clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. The default is a global model (one cluster), which is the equivalent to `fc_clusters` having each entry for the geographic group contains the same "cluster_id" value. If you only have one geographic group, this would contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). Neither global model or individual model are recommended for large numbers of geographic groups, or for geographic groups in different environmental contexts. See overview vignette for more discussion. +* `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE. +* `report_settings$nthreads`: For the number of threads argument for parallel processing in modelling. Either 1 or 2, if multiple cores are present. -* `fc_control$env_vars`: Environmental variables. This informs the modeling system which environmental variables to actually use. (You can therefore have extra variables or data in the environmental dataset.) This is just a simple 1 column tibble with the variable names to use - `obsfield` - same field name as in the environmental data and environmental reference datasets, with entries for which variables to use in the modeling. -* `fc_control$clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. If you only have one cluster (global model), each entry for the geographic group should contain the same "cluster_id" value. If you only have one geographic group, this should contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). -* `fc_control$lag_length`: The number of days of past environmental data to include for the lagged effects. -* `fc_control$fit_freq`: When fitting the model, either fit "once" (highly recommended) or per every "week". Per "week" will increase the processing time by the number of weeks in the model. It is recommended to only use "once" unless you are doing detailed analyses on the difference. -* `fc_control$ncores`: For the number of threads argument for model processing, the number of cores to use. If unset, it will default to the number of physical cores available minus one. -* `fc_control$anom_env`: Boolean argument indicating if the environmental variables should be replaced with their anomalies. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group. Default is true, that anomalies will be calculated and used. +Environmental data-related forecasting settings: + +* `report_settings$env_var`: Environmental variables. This informs the modeling system which environmental variables to actually use. (You can therefore have extra variables or data in the environmental dataset.) This is just a simple 1 column tibble with the variable names to use - `obsfield` - same field name as in the environmental data and environmental reference datasets, with entries for which variables to use in the modeling. +* `report_settings$env_lag_length`: The number of days of past environmental data to include for the lagged effects. +* `report_settings$env_anomalies`: Boolean argument indicating if the environmental variables should be replaced with their anomalies. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group. Default is false. ### Setting up for Event Detection -* `ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. In the demo, we have both displayed the results as a map and listed in tables. -* `ed_method`: At the moment, the only choices are "Farrington" for the Farrington improved algorithm or "None". -* `ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "Farrington" option. It is unused for the "None" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. +The event detection settings are also bundled into the named list `report_settings`: + +* `report_settings$ed_method`: At the moment, the only choices are "farrington" for the Farrington improved algorithm or "none". +* `report_settings$ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `report_settings$ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. In the demo, we have both displayed the results as a map and listed in tables. +* `report_settings$ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. ## Setting up Model Input (Optional) -* `model_run`: This is a boolean indicating if it should ONLY generate and return the regression object (`model_obj`) and metadata (`model_info`) on the model. -* `model_obj`: Once a model has been generated, it can be fed into `run_epidemiar()` using this argument. This will skip the model building portion of forecasting, and will continue start into generating predictions. +* `report_settings$model_run`: This is a boolean indicating if it should ONLY generate and return the regression object (`model_obj`) and metadata (`model_info`) on the model. +* `report_settings$model_cached`: Once a model (and metadata) has been generated, it can be fed into `run_epidemiar()` using this argument. This should be the exact object that was returned by a `report_settings$model_run = TRUE`. This will skip the model building portion of forecasting, and will continue start into generating predictions. Using a prebuilt model saves on processing time, but will need to be updated periodically. If using a cached model, also set `fc_model_family = "cached"`. Pre-generating a model can save substantial processing time, and users can expect faster report data generation time. The trade-off of potential hits to model accuracy in the age of the model versus the time range of the requested predictions should be examined, which would vary depending on the situation/datasets. From 1fd15e19637ac88d90a23b540b6a092c662e01ef Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk Date: Fri, 20 Mar 2020 11:33:47 -0500 Subject: [PATCH 029/132] Update package overview vignette --- vignettes/overview-epidemiar.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/overview-epidemiar.Rmd b/vignettes/overview-epidemiar.Rmd index 0d823f1..ecce850 100644 --- a/vignettes/overview-epidemiar.Rmd +++ b/vignettes/overview-epidemiar.Rmd @@ -1,7 +1,7 @@ --- title: "Overview of epidemiar Package" author: | - | Dawn Nekorchuk, Michael Wimberly, and EPIDEMIA Team Members + | Dawn M. Nekorchuk, Michael C. Wimberly, and EPIDEMIA Team Members | Department of Geography and Environmental Sustainability, University of Oklahoma | dawn.nekorchuk@ou.edu; mcwimberly@ou.edu date: "Updated `r format(Sys.time(), '%B %d, %Y')`" @@ -69,7 +69,7 @@ The main requirements for using this package are: The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality,and clustering of geographic groups. -The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_family` parameter. For example, you can run regression with a Poisson distribution (`fc_family = "poisson()"`). +The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). ## Geographic group, long term trends, and seasonality From 86612c700ff839d9b48b87d5fd49527f798d8986 Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk Date: Fri, 20 Mar 2020 11:34:02 -0500 Subject: [PATCH 030/132] Updated validation vignette --- vignettes/validation-assessment.Rmd | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/vignettes/validation-assessment.Rmd b/vignettes/validation-assessment.Rmd index 63be6d7..181d77b 100644 --- a/vignettes/validation-assessment.Rmd +++ b/vignettes/validation-assessment.Rmd @@ -1,17 +1,17 @@ --- title: "Model Validation and Assessment" author: | - | Dawn Nekorchuk, Michael Wimberly, and EPIDEMIA Team Members + | Dawn M. Nekorchuk, Michael C. Wimberly, and EPIDEMIA Team Members | Department of Geography and Environmental Sustainability, University of Oklahoma | dawn.nekorchuk@ou.edu; mcwimberly@ou.edu date: "Updated `r format(Sys.time(), '%B %d, %Y')`" output: - rmarkdown::html_vignette: - fig_caption: yes html_document: df_print: paged toc: yes toc_depth: '2' + rmarkdown::html_vignette: + fig_caption: yes pdf_document: number_sections: yes toc: yes @@ -44,7 +44,7 @@ With on-demand implementation and time-range flexibility, one can also investiga The `run_validation()` function takes 4 arguments, plus all the `run_epidemia()` arguments. -* `date_start`: The week to begin validation, can be built with `epidemiar::make_date_yw()` and isoyear and isoweek numbers (or epiweeks, with appropriate modifications). +* `date_start`: The week to begin validation, can be built with `epidemiar::make_date_yw()` and isoyear and isoweek numbers (or epiweeks, with appropriate settings). * `total_timesteps`: The number of weeks from `week_start` to run the validation. * `timesteps_ahead`: To validate 1 through _n_-week ahead predictions (the number of weeks into the future the predictions are made). * `reporting_lag`: Default of 0 weeks, but can be adjusted for different assumptions about the length of the lag in data reporting. Enter the number of timesteps to simulate reporting lag. For instance, if you have weekly data, and a `reporting_lag` of 1 week, and are working with a timesteps_ahead of 1 week, then that is the functional equivalent to reporting lag of 0, and timesteps_ahead of 2 weeks. I.e. You are forecasting next week, but you don’t know this week’s data yet, you only know last week’s numbers. @@ -53,7 +53,7 @@ The `run_validation()` function takes 4 arguments, plus all the `run_epidemia()` ## Other Arguments & Adjustments -The `run_validation()` function will call `run_epidemia()`, so it will also take all the arguments for that function. The user does not need to modify any of these arguments (e.g. event detection settings, `forecast_future`), as `run_validation()` will automatically handle all of thse adjustments. +The `run_validation()` function will call `run_epidemia()`, so it will also take all the arguments for that function. The user does not need to modify any of these arguments (e.g. event detection settings, `fc_future_period`), as `run_validation()` will automatically handle all of thse adjustments. It is envisioned that users can take their usual script for running EPIDEMIA forecasts, and simply sub in the validation function with those five validation settings for doing model assessments. From 17d7001959d6de3509fe8e36cdcf2ee7c1e419ed Mon Sep 17 00:00:00 2001 From: Dawn Nekorchuk Date: Fri, 20 Mar 2020 11:59:09 -0500 Subject: [PATCH 031/132] Rerendering to test that pandoc error was resovled with latest Rstudio install --- vignettes/validation-assessment.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/validation-assessment.Rmd b/vignettes/validation-assessment.Rmd index 181d77b..204dc28 100644 --- a/vignettes/validation-assessment.Rmd +++ b/vignettes/validation-assessment.Rmd @@ -6,12 +6,12 @@ author: | | dawn.nekorchuk@ou.edu; mcwimberly@ou.edu date: "Updated `r format(Sys.time(), '%B %d, %Y')`" output: + rmarkdown::html_vignette: + fig_caption: yes html_document: df_print: paged toc: yes toc_depth: '2' - rmarkdown::html_vignette: - fig_caption: yes pdf_document: number_sections: yes toc: yes From 6f725d7a2e50469a4537c2fa52caa4517873763c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 8 Apr 2020 14:45:40 -0500 Subject: [PATCH 032/132] Added new user parameter report_settings$fc_start_date: defaults and basic type checking, calculations of report_dates objects; minor edit to other defaults and warnings (no warning on long forecasts now) --- R/input_checks.R | 36 ++++++++++++++----- R/run_epidemia.R | 94 +++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 110 insertions(+), 20 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index cb9c059..d3f99ed 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -18,6 +18,7 @@ #' set_report_defaults <- function(raw_settings, + epi_data, env_info, env_ref_data, env_variables, @@ -71,7 +72,7 @@ set_report_defaults <- function(raw_settings, new_settings[["fc_future_period"]] <- 8 } - #default false, with explicit false for naive models (probably ok w/out, just being careful) + #default false, with explicit false for naive models if (is.null(raw_settings[["env_anomalies"]])){ new_settings[["env_anomalies"]] <- dplyr::case_when( fc_model_family == "naive-persistence" ~ FALSE, @@ -155,14 +156,24 @@ set_report_defaults <- function(raw_settings, # For more complicated defaults + #fc_start_date: date when to start forecasting + if (is.null(raw_settings[["fc_start_date"]])){ + # defaults to last known epidemiological data date + one week + last_known <- max(epi_data[["obs_date"]], na.rm = TRUE) + new_settings[["fc_start_date"]] <- last_known + lubridate::as.difftime(1, units = "weeks") + } else { + #other checks will come later, for now, copy user entry as is over + new_settings[["fc_start_date"]] <- raw_settings[["fc_start_date"]] + } + #env_var -- what is listed in env_data, env_ref_data, & env_info if (is.null(raw_settings[["env_var"]])){ #create list of all environmental variables in env_info - env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) + env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) %>% unique() #create list of all environmental variables in env_ref_data - env_ref_variables <- dplyr::pull(env_ref_data, !!quo_obsfield) + env_ref_variables <- dplyr::pull(env_ref_data, !!quo_obsfield) %>% unique() #env_variables already gen list of env_data @@ -275,9 +286,15 @@ input_check <- function(epi_data, # Existing & Types -------------------------------------------------------- # Quick test for some simple settings + + #report_settings tests if (!is.numeric(report_settings[["report_inc_per"]]) || report_settings[["report_inc_per"]] <= 0){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "'inc_per' must be numeric and a positive number.\n") + err_msgs <- paste(err_msgs, "'report_settings$report_inc_per' must be numeric and a positive number.\n") + } + if (!class(report_settings[["fc_start_date"]]) == "Date"){ + err_flag <- TRUE + err_msgs <- paste(err_msgs, "'report_settings$fc_start_date' must be type Date.\n") } @@ -391,11 +408,14 @@ input_check <- function(epi_data, err_flag <- TRUE err_msgs <- paste(err_msgs, "'report_settings$forecast_future' must be numeric or integer type - integer number of weeks only.\n") rpt_len_flag <- TRUE - } else if (report_settings[["fc_future_period"]] > 13){ - # warn on long forecasts - warn_flag <- TRUE - warn_msgs <- paste(warn_msgs, "Warning: It is not recommended to forecast more than 12 weeks into the future. You are forecasting for ", report_settings[["fc_future_period"]], " weeks.\n") } + #removed with new report_settings$fc_start_date, potentially add back in + # else if (report_settings[["fc_future_period"]] > 13){ + # # warn on long forecasts + # warn_flag <- TRUE + # warn_msgs <- paste(warn_msgs, "Warning: It is not recommended to forecast more than 12 weeks into the future. You are forecasting for ", report_settings[["fc_future_period"]], " weeks.\n") + # } + if (!(is.numeric(report_settings[["ed_summary_period"]]) | is.integer(report_settings[["ed_summary_period"]]))){ err_flag <- TRUE err_msgs <- paste(err_msgs, "'report_settings$ed_summary_period' must be numeric or integer type - integer number of weeks only.\n") diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 54ddc11..9311c85 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -200,6 +200,7 @@ #'@importFrom rlang !! #'@importFrom rlang := #'@importFrom rlang .data +#'@importFrom lubridate %within% ## Main Modeling (Early Detection, Forecasting) Function @@ -310,7 +311,9 @@ run_epidemia <- function(epi_data = NULL, #set defaults in report_settings if not supplied + # some specific data checks that need overrides report_settings <- set_report_defaults(raw_settings = report_settings, + epi_data, env_info, env_ref_data, env_variables, @@ -355,35 +358,102 @@ run_epidemia <- function(epi_data = NULL, # Preparing: date sets ---------------------------- + # Some additional checks and overrides now that the others have been done + #is the user given date the end date of a epidemiolgical week? + # calculate expected date and compare + #switch on ISO/CDC weeks + if(report_settings[["epi_date_type"]] == "weekISO"){ + user_st_year <- lubridate::isoyear(report_settings[["fc_start_date"]]) + user_st_week <- lubridate::isoweek(report_settings[["fc_start_date"]]) + expected_date <- make_date_yw(year = user_st_year, + week = user_st_week, + weekday = 7, + system = "ISO") + } else { + #can add more if blocks later for other date types + #"weekCDC" + user_st_year <- lubridate::epiyear(report_settings[["fc_start_date"]]) + user_st_week <- lubridate::epiweek(report_settings[["fc_start_date"]]) + expected_date <- make_date_yw(year = user_st_year, + week = user_st_week, + weekday = 7, + system = "CDC") + } + #if not, override and provide message + if(!report_settings[["fc_start_date"]] == expected_date){ + message("Note: 'report_settings$fc_start_date was not the end date of an epidemiological week\n + Using ", expected_date, " instead.") + report_settings[["fc_start_date"]] <- expected_date + } + + # Create report date information: for passing to interval functions, and report output # report_period is full # of weeks of report. # fc_future_period is how many of those weeks should be in the future. + # *Nearly all dates are calculated from fc_start_date* + # Forecast begins on fc_start_date, runs for fc_future_period + # Report_period minus fc_future_period is the number of 'past' weeks to include + # Known data is independent of fc_start_date but important for early detection + #full report - report_dates <- list(full = list(min = max(epi_data$obs_date, na.rm = TRUE) - + report_dates <- list(full = list(min = report_settings[["fc_start_date"]] - lubridate::as.difftime((report_settings[["report_period"]] - - report_settings[["fc_future_period"]] - 1), + report_settings[["fc_future_period"]]), unit = "weeks"), - max = max(epi_data$obs_date, na.rm = TRUE) + - lubridate::as.difftime(report_settings[["fc_future_period"]], + max = report_settings[["fc_start_date"]] + + lubridate::as.difftime((report_settings[["fc_future_period"]] - 1), units = "weeks"))) report_dates$full$seq <- report_dates$full %>% {seq.Date(.$min, .$max, "week")} - #dates with known epidemological data - report_dates$known <- list(min = report_dates$full$min, + + #dates with known epidemological data (note: may NOT be in report period) + report_dates$known <- list(min = min(epi_data$obs_date, na.rm = TRUE), max = max(epi_data$obs_date, na.rm = TRUE)) - report_dates$known$seq <- report_dates$known %>% {seq.Date(.$min, .$max, "week")} + #can't assume known is complete sequence now + #report_dates$known$seq <- report_dates$known %>% {seq.Date(.$min, .$max, "week")} + #any known data in range (across any geographical groupings) + report_dates$known$seq <- epi_data %>% dplyr::pull(.data$obs_date) %>% unique() %>% sort() + #forecast period - report_dates$forecast <- list(min = report_dates$known$max + - lubridate::as.difftime(1, units = "weeks"), + report_dates$forecast <- list(min = report_settings[["fc_start_date"]], #could calculate from forecast_future, but already done so in $full max = report_dates$full$max) report_dates$forecast$seq <- report_dates$forecast %>% {seq.Date(.$min, .$max, "week")} + #early detection summary period (ED runs over full report, this is for summary in defined ED period) - report_dates$ed_sum <- list(min = report_dates$known$max - - lubridate::as.difftime(report_settings[["ed_summary_period"]] - 1, units = "weeks"), - max = report_dates$known$max) + report_dates$ed_sum <- list(min = report_settings[["fc_start_date"]] - + lubridate::as.difftime(report_settings[["ed_summary_period"]], + units = "weeks"), + max = report_settings[["fc_start_date"]] - + lubridate::as.difftime(1, units = "weeks")) report_dates$ed_sum$seq <- report_dates$ed_sum %>% {seq.Date(.$min, .$max, "week")} + # #full report + # report_dates <- list(full = list(min = max(epi_data$obs_date, na.rm = TRUE) - + # lubridate::as.difftime((report_settings[["report_period"]] - + # report_settings[["fc_future_period"]] - 1), + # unit = "weeks"), + # max = max(epi_data$obs_date, na.rm = TRUE) + + # lubridate::as.difftime(report_settings[["fc_future_period"]], + # units = "weeks"))) + # report_dates$full$seq <- report_dates$full %>% {seq.Date(.$min, .$max, "week")} + # #dates with known epidemological data + # report_dates$known <- list(min = report_dates$full$min, + # max = max(epi_data$obs_date, na.rm = TRUE)) + # report_dates$known$seq <- report_dates$known %>% {seq.Date(.$min, .$max, "week")} + # #forecast period + # report_dates$forecast <- list(min = report_dates$known$max + + # lubridate::as.difftime(1, units = "weeks"), + # #could calculate from forecast_future, but already done so in $full + # max = report_dates$full$max) + # report_dates$forecast$seq <- report_dates$forecast %>% {seq.Date(.$min, .$max, "week")} + # #early detection summary period (ED runs over full report, this is for summary in defined ED period) + # report_dates$ed_sum <- list(min = report_dates$known$max - + # lubridate::as.difftime(report_settings[["ed_summary_period"]] - 1, units = "weeks"), + # max = report_dates$known$max) + # report_dates$ed_sum$seq <- report_dates$ed_sum %>% {seq.Date(.$min, .$max, "week")} + + # Preparing: data checks for NA and interpolation ------------------------- From c0f6eeb3e13ebb69327fb01b2d94c44168a5208a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 13 Apr 2020 12:31:41 -0500 Subject: [PATCH 033/132] Added import of %within% from lubridate: handling dates and intervals --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 2e54a61..29772fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(run_epidemia) export(run_validation) export(save_geog_validations) export(save_overall_validations) +importFrom(lubridate,"%within%") importFrom(magrittr,"%>%") importFrom(rlang,"!!") importFrom(rlang,":=") From 08267da7143b72343d83bf3221673a90bf32a27f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 13 Apr 2020 12:32:13 -0500 Subject: [PATCH 034/132] Linespace formatting --- R/event_detection.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/event_detection.R b/R/event_detection.R index c77a333..1c9f327 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -114,7 +114,8 @@ run_farrington <- function(epi_fc_data, far_control <- list() #get evaluation period (range of row numbers) - far_control[["range"]] <- seq(nrow(epi_stss[[1]]) - length(report_dates$full$seq) + 1, nrow(epi_stss[[1]])) + far_control[["range"]] <- seq(nrow(epi_stss[[1]]) - length(report_dates$full$seq) + 1, + nrow(epi_stss[[1]])) #test for all other parameters that can be passed onto Farrington flexible method # if not null, use user parameter, otherwise leave as null to use its defaults From f207da2d9fde0bade0c4769d3b7e251cbc55b3d4 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 13 Apr 2020 12:33:27 -0500 Subject: [PATCH 035/132] Made sure to group by geographic group before filling population down in extending epidemiological data into the future --- R/forecasting_helpers.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index ecc01db..3613d4a 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -287,6 +287,7 @@ extend_epi_future <- function(epi_data, #calculated/internal groupings, report_dates){ + #extended epi data into future dates #for use in modeling later (results will be put elsewhere), this is for env and lags and modeling dataset epi_future <- tidyr::crossing(obs_date = report_dates$forecast$seq, @@ -299,8 +300,16 @@ extend_epi_future <- function(epi_data, extended_epi <- dplyr::bind_rows(epi_data, epi_future) %>% dplyr::arrange(!!quo_groupfield, .data$obs_date) - #fill population down - extended_epi <- tidyr::fill(extended_epi, !!quo_popfield, .direction = "down") + #fill population down (if pop field given) + if (!is.null(quo_popfield)) { + extended_epi <- extended_epi %>% + #per geographic group + dplyr::group_by(!!quo_groupfield) %>% + #fill population down ('persistence' fill, last known value carried forward) + tidyr::fill(!!quo_popfield, .direction = "down") %>% + #ungroup to finish + dplyr::ungroup() + } extended_epi } From 3607fef40d65e6b33d1f605be99bd7a4a92763d6 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 13 Apr 2020 12:39:25 -0500 Subject: [PATCH 036/132] autoupdated documentation --- man/set_report_defaults.Rd | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/man/set_report_defaults.Rd b/man/set_report_defaults.Rd index 2fe7a00..12416ee 100644 --- a/man/set_report_defaults.Rd +++ b/man/set_report_defaults.Rd @@ -4,12 +4,15 @@ \alias{set_report_defaults} \title{Set defaults of any missing report_settings parameters} \usage{ -set_report_defaults(raw_settings, env_info, env_ref_data, env_variables, - quo_obsfield, groupings, quo_groupfield) +set_report_defaults(raw_settings, epi_data, env_info, env_ref_data, + env_variables, quo_obsfield, groupings, quo_groupfield) } \arguments{ \item{raw_settings}{The report_settings object as given by the user.} +\item{epi_data}{Epidemiological data with case numbers per week, with date +field "obs_date".} + \item{env_info}{Lookup table for environmental data - reference creation method (e.g. sum or mean), report labels, etc.} From 7d3cea9640bcda07dcf710be7583840db59e9603 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 13 Apr 2020 12:42:45 -0500 Subject: [PATCH 037/132] Added more for new user parameter for user set forecast start date: handles implicit missing data in epi data; revised calculations on all date sequences; notes on event detection work to do --- R/forecasting_main.R | 1 + R/run_epidemia.R | 62 ++++++++++++++++++++++++++++++++++---------- 2 files changed, 50 insertions(+), 13 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 4bfea76..26e00c8 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -77,6 +77,7 @@ run_forecast <- function(epi_data, env_variables_used, report_dates) + #extend into future and/or gaps in requested report dates & known data epi_data_extd <- extend_epi_future(epi_data, quo_popfield, quo_groupfield, diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 9311c85..94c248a 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -426,6 +426,11 @@ run_epidemia <- function(epi_data = NULL, max = report_settings[["fc_start_date"]] - lubridate::as.difftime(1, units = "weeks")) report_dates$ed_sum$seq <- report_dates$ed_sum %>% {seq.Date(.$min, .$max, "week")} + #period of report NOT in forecast ("previous" to forecast) + report_dates$prev <- list(min = report_dates$full$min, + max = report_settings[["fc_start_date"]] - + lubridate::as.difftime(1, units = "weeks")) + report_dates$prev$seq <- report_dates$prev %>% {seq.Date(.$min, .$max, "week")} # #full report @@ -455,26 +460,60 @@ run_epidemia <- function(epi_data = NULL, - # Preparing: data checks for NA and interpolation ------------------------- + # Preparing: data checks for implicit missing, NA and interpolation --------------------- - #check for NAs and interpolate as necessary and user set + #Implicit missing, or gaps introduced by user start parameter, may exist + #all weeks in report period NOT in forecast period ("previous" to forecast) + epi_full <- tidyr::crossing(obs_date = report_dates$prev$seq, + group_temp = groupings) + #and fix names with NSE + epi_full <- epi_full %>% + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + + #antijoin with existing data to find rows are implicitly missing + epi_implicit <- epi_full %>% + dplyr::anti_join(epi_data, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + "obs_date"), + c(rlang::quo_name(quo_groupfield), + "obs_date"))) + #bind missing + epi_data <- epi_data %>% + dplyr::bind_rows(epi_implicit) %>% + #and sort by alphabetical groupfield and date + dplyr::arrange(!!quo_groupfield, .data$obs_date) + + #fill down for population that we would need values, if pop field present + #rest will remain NA for implicit missing data: casefield, and any extra/extraneous columns in original data + if(!rlang::quo_is_null(quo_popfield)){ + epi_data <- epi_data %>% + #per geographic group + dplyr::group_by(!!quo_groupfield) %>% + #fill population down ('persistence' fill, last known value carried forward) + tidyr::fill(!!quo_popfield, .direction = "down") %>% + #ungroup to finish + dplyr::ungroup() + } + + + #Interpolate NAs if user selected if (report_settings[["epi_interpolate"]] == TRUE){ #Note: cases_epidemiar is field name returned (epi) epi_data <- epi_NA_interpolate(epi_data, quo_casefield, quo_groupfield) %>% #force into integer after interpolating (would cause problems with modeling otherwise) dplyr::mutate(cases_epidemiar = floor(.data$cases_epidemiar)) %>% - #and sort by alphabetical groupfield + #and sort by alphabetical groupfield (dates should already be sorted from interpolate function) dplyr::arrange(!!quo_groupfield, .data$obs_date) } else { epi_data <- epi_data %>% #copy over value dplyr::mutate(cases_epidemiar = !!quo_casefield) %>% - #force into integer, just in case + #force into integer, just in case/keeping consistency dplyr::mutate(cases_epidemiar = floor(.data$cases_epidemiar)) %>% - #and sort by alphabetical groupfield + #and sort by alphabetical groupfield, dates dplyr::arrange(!!quo_groupfield, .data$obs_date) } + #Note: val_epidemiar is field name returned (env) #interpolation is no longer necessary with new extend_env_future() #env_data <- env_NA_interpolate(env_data, quo_obsfield, quo_valuefield, quo_groupfield) %>% @@ -503,18 +542,12 @@ run_epidemia <- function(epi_data = NULL, } else if (report_settings[["report_value_type"]] == "incidence"){ !!quo_casefield / !!quo_popfield * report_settings[["report_inc_per"]] } else {NA_real_}, - # value = dplyr::case_when( - # #if reporting in case counts - # report_settings[["report_value_type"]] == "cases" ~ !!quo_casefield, - # #if incidence - # report_settings[["report_value_type"]] == "incidence" ~ !!quo_casefield / !!quo_popfield * report_settings[["report_inc_per"]], - # #otherwise - # TRUE ~ NA_real_), #note use of original not interpolated cases lab = "Observed", upper = NA, lower = NA) %>% - dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) + dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, + .data$lab, .data$upper, .data$lower) @@ -572,6 +605,9 @@ run_epidemia <- function(epi_data = NULL, # Event detection --------------------------------------------------------- + #<> Need to combine datasets appropriately now with fc_start_date + #<> Will need to rework following steps: + #need to calculate event detection on existing epi data & FUTURE FORECASTED results future_fc <- fc_res_all$fc_epi %>% #get future forecasted results ONLY From 51330c5f90699ee3df90389c6239a589e3275f13 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 15 Apr 2020 12:01:43 -0500 Subject: [PATCH 038/132] Fixed documentation on populationfield parameter. --- R/run_epidemia.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 94c248a..638c7e5 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -33,8 +33,9 @@ #' #'@param casefield The column name of the field that contains disease case #' counts (unquoted field name). -#'@param populationfield Column name of the population field to give population -#' numbers over time (unquoted field name). Used to calculated incidence. Also +#'@param populationfield Column name of the optional population field to give +#' population numbers over time (unquoted field name). Used to calculated +#' incidence if \code{report_settings$report_value_type} = "incidence". Also #' optionally used in Farrington method for populationOffset. #'@param groupfield The column name of the field for district or geographic area #' unit division names of epidemiological AND environmental data (unquoted From d59d7d09febf14ab027019c0e084f3c426c82fd4 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 24 Apr 2020 13:04:26 -0500 Subject: [PATCH 039/132] Rename of input to modeling dataset to reduce confusion on calling it 'known', which may not be the case with new fc_start_date. --- R/forecasting_main.R | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 26e00c8..25224e7 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -303,9 +303,9 @@ forecast_regression <- function(epi_lag, ## Set up data - #mark known or not + #mark within prior known range or not, to be used as input to create model epi_lag <- epi_lag %>% - dplyr::mutate(known = ifelse(.data$obs_date <= last_known_date, 1, 0)) + dplyr::mutate(input = ifelse(.data$obs_date <= last_known_date, 1, 0)) # ensure that quo_name(quo_groupfield) is a factor - gam/bam will fail if given a character, # which is unusual among regression functions, which typically just coerce into factors. @@ -322,7 +322,7 @@ forecast_regression <- function(epi_lag, # create modified bspline basis in epi_lag file to model longterm trends epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, degree=6, - maxobs=max(epi_lag$obs_date[epi_lag$known==1], na.rm=TRUE))) + maxobs=max(epi_lag$obs_date[epi_lag$input==1], na.rm=TRUE))) @@ -350,15 +350,15 @@ forecast_regression <- function(epi_lag, modb_eq <- glue::glue_collapse(modb_list, sep = " + ") } - #filter to known - epi_known <- epi_lag %>% dplyr::filter(.data$known == 1) + #filter to input data + epi_input <- epi_lag %>% dplyr::filter(.data$input == 1) # Model building switching point regress <- build_model(fc_model_family, quo_groupfield, - epi_known, + epi_input, report_settings, #calc/internal n_groupings, @@ -425,7 +425,7 @@ forecast_regression <- function(epi_lag, #'Build the appropriate model #' -#'@param epi_known Epidemiological dataset with basis spline summaries of the +#'@param epi_input Epidemiological dataset with basis spline summaries of the #' lagged environmental data (or anomalies), with column marking if "known" #' data and groupings converted to factors. #'@param n_groupings Count of the number of geographic groupings in the model. @@ -443,7 +443,7 @@ forecast_regression <- function(epi_lag, #' build_model <- function(fc_model_family, quo_groupfield, - epi_known, + epi_input, report_settings, #calc/internal n_groupings, @@ -468,7 +468,7 @@ build_model <- function(fc_model_family, #create "model" using known data. #Will fill down in create_predictions - regress <- epi_known %>% + regress <- epi_input %>% #grouping by geographical unit dplyr::group_by(!!quo_groupfield) %>% #prediction is 1 lag (previous week) @@ -486,7 +486,7 @@ build_model <- function(fc_model_family, #not a regression object #create "model" (averages) using known data. - regress <- epi_known %>% + regress <- epi_input %>% #calculate averages per geographic group per week of year dplyr::group_by(!!quo_groupfield, .data$week_epidemiar) %>% dplyr::summarize(fit = mean(.data$cases_epidemiar, na.rm = TRUE)) @@ -535,7 +535,7 @@ build_model <- function(fc_model_family, # run bam regress <- mgcv::bam(reg_eq, - data = epi_known, + data = epi_input, family = fc_model_family, control = mgcv::gam.control(trace=FALSE), discrete = TRUE, @@ -573,7 +573,7 @@ build_model <- function(fc_model_family, # run bam regress <- mgcv::bam(reg_eq, - data = epi_known, + data = epi_input, family = fc_model_family, control = mgcv::gam.control(trace=FALSE)) From 876181b167d1805e72fb22fa02f93411a614c034 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 27 Apr 2020 15:20:20 -0500 Subject: [PATCH 040/132] Updated early detection series gathering with new report date sequences (from fc_start_date) --- R/event_detection.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/event_detection.R b/R/event_detection.R index 1c9f327..e8f83a1 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -324,9 +324,11 @@ stss_res_to_output_data <- function(stss_res_list, c(rlang::quo_name(quo_groupfield), "epoch"))) - #gather early detection (KNOWN - pre-forecast) event detection alert series + #gather early detection (pre-forecast) event detection alert series + #early detection alerts show for all time previous and including early detection period + #"historical" alerts were wanted ed_alert_res <- stss_res_flat %>% - dplyr::filter(.data$epoch %in% report_dates$known$seq) %>% + dplyr::filter(.data$epoch %in% report_dates$prev$seq) %>% dplyr::mutate(series = "ed", obs_date = .data$epoch, value = .data$alarm, @@ -348,6 +350,7 @@ stss_res_to_output_data <- function(stss_res_list, #gather event detection threshold series ed_thresh_res <- stss_res_flat %>% + dplyr::filter(.data$epoch %in% report_dates$full$seq) %>% dplyr::mutate(series = "thresh", obs_date = .data$epoch, #value calculations change depending on report_value_type From a259d88bf6a662550e46bf4c1906d9e5ec7bf092 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 27 Apr 2020 15:21:29 -0500 Subject: [PATCH 041/132] Updated event detection data / dates gathering with new fc_start_date scheme and report_dates; minor comment edits --- R/run_epidemia.R | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 638c7e5..ac380c1 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -326,7 +326,7 @@ run_epidemia <- function(epi_data = NULL, week_type <- dplyr::case_when( report_settings[["epi_date_type"]] == "weekISO" ~ "ISO", report_settings[["epi_date_type"]] == "weekCDC" ~ "CDC", - #default as if mean + #default NA TRUE ~ NA_character_) @@ -396,6 +396,9 @@ run_epidemia <- function(epi_data = NULL, # Report_period minus fc_future_period is the number of 'past' weeks to include # Known data is independent of fc_start_date but important for early detection + #time units #report_settings[["epi_date_type"]] + #as.difftime cannot do monthly, so will have to build switch for different function calculations + #full report report_dates <- list(full = list(min = report_settings[["fc_start_date"]] - lubridate::as.difftime((report_settings[["report_period"]] - @@ -420,7 +423,7 @@ run_epidemia <- function(epi_data = NULL, max = report_dates$full$max) report_dates$forecast$seq <- report_dates$forecast %>% {seq.Date(.$min, .$max, "week")} - #early detection summary period (ED runs over full report, this is for summary in defined ED period) + #early detection summary period (ED runs over full report, this is for defined early DETECTION period) report_dates$ed_sum <- list(min = report_settings[["fc_start_date"]] - lubridate::as.difftime(report_settings[["ed_summary_period"]], units = "weeks"), @@ -532,8 +535,8 @@ run_epidemia <- function(epi_data = NULL, #create observed data series obs_res <- epi_data %>% - #include only observed data from requested start of report - dplyr::filter(.data$obs_date >= report_dates$full$min) %>% + #include only observed data from during report period + dplyr::filter(.data$obs_date %in% report_dates$full$seq) %>% dplyr::mutate(series = "obs", #value calculations change depending on report_value_type #case_when is not viable because it evaluates ALL RHS @@ -606,18 +609,24 @@ run_epidemia <- function(epi_data = NULL, # Event detection --------------------------------------------------------- - #<> Need to combine datasets appropriately now with fc_start_date - #<> Will need to rework following steps: + #need to calculate event detection on observed data; & in forecast period, the FORECASTED results + #existing data before forecast start + epi_to_fc <- epi_data %>% + dplyr::filter(.data$obs_date < report_dates$forecast$min) - #need to calculate event detection on existing epi data & FUTURE FORECASTED results - future_fc <- fc_res_all$fc_epi %>% + #modeled values in forecast period = forecast values + forecast_values <- fc_res_all$fc_epi %>% #get future forecasted results ONLY - dplyr::filter(.data$obs_date %in% report_dates$forecast$seq) + dplyr::filter(.data$obs_date %in% report_dates$forecast$seq) %>% + #assign forecasted values into cases_epidemiar column (so event detection will run on these values) + dplyr::mutate(cases_epidemiar = .data$fc_cases) + # dplyr::mutate(cases_epidemiar = ifelse(!rlang::are_na(.data$cases_epidemiar), + # .data$cases_epidemiar, + # .data$fc_cases)) + + #combine existing and future - obs_fc_epi <- dplyr::bind_rows(epi_data, future_fc) %>% - dplyr::mutate(cases_epidemiar = ifelse(!rlang::are_na(.data$cases_epidemiar), - .data$cases_epidemiar, - .data$fc_cases)) %>% + obs_fc_epi <- dplyr::bind_rows(epi_to_fc, forecast_values) %>% #will be lost by end, but need for event detection methods using surveillance::sts objects epidemiar::add_datefields() %>% #arrange (for viewing/checking) From b18348cbcd795106916f7500c463359ced122908 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 27 Apr 2020 15:21:43 -0500 Subject: [PATCH 042/132] Autogenerated documentation update --- man/build_model.Rd | 4 ++-- man/run_epidemia.Rd | 5 +++-- man/run_validation.Rd | 5 +++-- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/man/build_model.Rd b/man/build_model.Rd index 0641c59..2241dc5 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -4,7 +4,7 @@ \alias{build_model} \title{Build the appropriate model} \usage{ -build_model(fc_model_family, quo_groupfield, epi_known, report_settings, +build_model(fc_model_family, quo_groupfield, epi_input, report_settings, n_groupings, modb_eq, bandsums_eq) } \arguments{ @@ -19,7 +19,7 @@ input "poisson()". If a cached model is being used, set the parameter to \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{epi_known}{Epidemiological dataset with basis spline summaries of the +\item{epi_input}{Epidemiological dataset with basis spline summaries of the lagged environmental data (or anomalies), with column marking if "known" data and groupings converted to factors.} diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index d81e65a..ea5f6a1 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -36,8 +36,9 @@ unit division names of epidemiological AND environmental data (unquoted field name). If there are no groupings (all one area), user should give a field that contains the same value throughout.} -\item{populationfield}{Column name of the population field to give population -numbers over time (unquoted field name). Used to calculated incidence. Also +\item{populationfield}{Column name of the optional population field to give +population numbers over time (unquoted field name). Used to calculated +incidence if \code{report_settings$report_value_type} = "incidence". Also optionally used in Farrington method for populationOffset.} \item{obsfield}{Field name of the environmental data variables (unquoted field diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 83d908b..abe8c0c 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -65,8 +65,9 @@ unit division names of epidemiological AND environmental data (unquoted field name). If there are no groupings (all one area), user should give a field that contains the same value throughout.} -\item{populationfield}{Column name of the population field to give population -numbers over time (unquoted field name). Used to calculated incidence. Also +\item{populationfield}{Column name of the optional population field to give +population numbers over time (unquoted field name). Used to calculated +incidence if \code{report_settings$report_value_type} = "incidence". Also optionally used in Farrington method for populationOffset.} \item{obsfield}{Field name of the environmental data variables (unquoted field From 8909b336c9db2d0c31bdaa6c70047a91de69c528 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 1 May 2020 00:16:01 -0500 Subject: [PATCH 043/132] allowed for recovery of population field after event detection ONLY if population field was given --- R/event_detection.R | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/R/event_detection.R b/R/event_detection.R index e8f83a1..4f9553b 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -315,14 +315,17 @@ stss_res_to_output_data <- function(stss_res_list, #and convert to character for joining dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) - #recover population (for incidence calculations), not present if popoffset was FALSE #<> - stss_res_flat <- stss_res_flat %>% - dplyr::left_join(epi_fc_data %>% - dplyr::select(!!quo_groupfield, !!quo_popfield, .data$obs_date), - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - "obs_date"), - c(rlang::quo_name(quo_groupfield), - "epoch"))) + #recover population (for incidence calculations), not present if popoffset was FALSE + #only if optional population field was given + if (!rlang::quo_is_null(quo_popfield)) { + stss_res_flat <- stss_res_flat %>% + dplyr::left_join(epi_fc_data %>% + dplyr::select(!!quo_groupfield, !!quo_popfield, .data$obs_date), + by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + "obs_date"), + c(rlang::quo_name(quo_groupfield), + "epoch"))) + } #gather early detection (pre-forecast) event detection alert series #early detection alerts show for all time previous and including early detection period From bae360737305f7a114f7ff6dd24a13759bf78bfc Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 1 May 2020 00:16:48 -0500 Subject: [PATCH 044/132] Added ifelse capture of event detection alarm value to be actually NA is observed was NA --- R/event_detection.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/event_detection.R b/R/event_detection.R index 4f9553b..6d87457 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -338,6 +338,10 @@ stss_res_to_output_data <- function(stss_res_list, lab = "Early Detection Alert", upper = NA, lower = NA) %>% + #surveillance returns an alarm value (0) for when observed is NA, we want NA in this case + dplyr::mutate(value = ifelse(is.na(.data$observed), + NA_integer_, + .data$value)) %>% dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #gather early WARNING event detection alert series From ef276dbe3814cbdc68242de9da9d625bbfdbb6f2 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 1 May 2020 00:17:07 -0500 Subject: [PATCH 045/132] minor comment edit --- R/forecasting_helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 3613d4a..043bff2 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -170,7 +170,7 @@ extend_env_future <- function(env_data, dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% #create a 1 day lag variable since need previous 7 days not including current dplyr::mutate(val_lag1 = dplyr::lag(.data$val_epidemiar, n = 1), - #if_else to find the first NA + #ifelse to find the first NA val_epidemiar = ifelse(is.na(.data$val_epidemiar) & .data$id_in_run == 1, #zoo:rollapply to calculate mean of last 7 days (week) on lagged var zoo::rollapply(data = .data$val_lag1, From 83dc2d739b527a231a2e4772da9f168ba4e091b7 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 1 May 2020 00:17:54 -0500 Subject: [PATCH 046/132] Fixed report_settings cleaner for report output --- R/formatters_calculators.R | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index 0ce4cf2..7824beb 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -251,6 +251,14 @@ calc_env_anomalies <- function(env_ts, format_report_settings <- function(rpt_settings){ #order alphabetically clean_settings <- rpt_settings[order(names(rpt_settings))] - #remove dev - clean_settings <- clean_settings[!grepl("[$dev]", names(clean_settings))] + + #remove dev IF no dev settings were changed from default + #so if dev settings all default, then remove + if (rpt_settings[["dev_fc_fit_freq"]] == "once" & + rpt_settings[["dev_fc_modbsplines"]] == FALSE & + is.null(rpt_settings[["dev_fc_formula"]])){ + clean_settings <- clean_settings[!grepl("^dev", names(clean_settings))] + } + + clean_settings } From 993b63e6fd04f1469b729c1875c34f5db218e5c4 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 1 May 2020 00:19:52 -0500 Subject: [PATCH 047/132] Allowing for ed_summary_period of 0, in event dection code handling --- R/formatters_calculators.R | 132 ++++++++++++++++++++++++++----------- 1 file changed, 93 insertions(+), 39 deletions(-) diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index 7824beb..193cc84 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -128,25 +128,44 @@ create_summary_data <- function(ed_res, #levels alert_level <- c("Low", "Medium", "High") - #Early Detection - ed_summary <- ed_res %>% - #get the alert series - dplyr::filter(.data$series == "ed") %>% - #filter to early detection period - dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% - #group (because need to look at period per group level) - dplyr::group_by(!!quo_groupfield) %>% - #summarize to 1 obs per grouping - dplyr::summarize(ed_alert_count = dplyr::if_else(all(is.na(.data$value)), NA_real_, sum(.data$value, na.rm = TRUE))) %>% - # create 3 levels (0, 1, 2 = >1) - dplyr::mutate(warning_level = dplyr::if_else(.data$ed_alert_count > 1, 2, .data$ed_alert_count), - #factor to label - ed_sum_level = factor(.data$warning_level, levels = 0:2, - labels = alert_level, ordered = TRUE)) %>% - #ungroup - dplyr::ungroup() %>% - #select minimal cols - dplyr::select(!!quo_groupfield, .data$ed_alert_count, .data$ed_sum_level) + #if early detection period was defined (ed_summary_period > 0) + if (!is.na(report_dates$ed_sum$seq)) { + #Early Detection + ed_summary <- ed_res %>% + #get the alert series for all early detection + dplyr::filter(.data$series == "ed") %>% + #filter to defined early detection period + dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% + #group (because need to look at period per group level) + dplyr::group_by(!!quo_groupfield) %>% + #summarize to 1 obs per grouping + dplyr::summarize(ed_alert_count = dplyr::if_else(all(is.na(.data$value)), NA_real_, sum(.data$value, na.rm = TRUE))) %>% + # create 3 levels (0, 1, 2 = >1) + dplyr::mutate(warning_level = dplyr::if_else(.data$ed_alert_count > 1, 2, .data$ed_alert_count), + #factor to label + ed_sum_level = factor(.data$warning_level, levels = 0:2, + labels = alert_level, ordered = TRUE)) %>% + #ungroup + dplyr::ungroup() %>% + #select minimal cols + dplyr::select(!!quo_groupfield, .data$ed_alert_count, .data$ed_sum_level) + + } else { + #create NA ED results for when ed_summary_period = 0 + ed_summary <- ed_res %>% + #create an entry for each geogroup, for creating NA results) + dplyr::select(!!quo_groupfield) %>% + dplyr::group_by(!!quo_groupfield) %>% + unique() %>% + #add in NA results + dplyr::mutate(ed_alert_count = NA, + ed_sum_level = NA) %>% + #confirm same output structure + #ungroup + dplyr::ungroup() %>% + #select minimal cols + dplyr::select(!!quo_groupfield, .data$ed_alert_count, .data$ed_sum_level) + } #Early Warning: ED results on forecast @@ -192,17 +211,28 @@ create_summary_data <- function(ed_res, create_epi_summary <- function(obs_res, quo_groupfield, report_dates){ - #using obs_res - if cases/incidence becomes a user set choice, this might make it easier (value is already what it needs to be) - #but note that (as of writing this) that obs_res using the original, UNinterpolated values (so that end users are disturbed to see case data where there should not be) - #<<>> - epi <- obs_res %>% - #epi data is weekly, get the data for the early detection summary period - dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% - #group by groupings - dplyr::group_by(!!quo_groupfield) %>% - #get mean incidence - dplyr::summarize(mean_inc = mean(.data$value, na.rm = TRUE)) + #if early detection period was defined (ed_summary_period > 0) + if (!is.na(report_dates$ed_sum$seq)) { + epi <- obs_res %>% + #epi data is weekly, get the data for the early detection summary period + dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% + #group by groupings + dplyr::group_by(!!quo_groupfield) %>% + #get mean incidence/cases (which ever user had selected will be in value field) + dplyr::summarize(mean_epi = mean(.data$value, na.rm = TRUE)) + } else { + #create NA epi results for when ed_summary_period = 0 + epi <- obs_res %>% + #create an entry for each geogroup, for creating NA results) + dplyr::select(!!quo_groupfield) %>% + dplyr::group_by(!!quo_groupfield) %>% + unique() %>% + #add NA result + dplyr::mutate(mean_epi = NA) + } + + epi } @@ -229,16 +259,40 @@ calc_env_anomalies <- function(env_ts, quo_groupfield, quo_obsfield, report_dates){ - # anomalies - anom_env <- env_ts %>% - # only mapping those in the early detection period - dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - # anomaly value is observed value minus the ref value from env_ref - dplyr::mutate(anom = .data$val_epidemiar - .data$ref_value) %>% - # summarized over ED period - dplyr::summarize(anom_ed_mean = mean(.data$anom, na.rm = TRUE)) %>% - dplyr::ungroup() + + #if early detection period was defined (ed_summary_period > 0) + if (!is.na(report_dates$ed_sum$seq)) { + #environmental observed data in early detection period + env_ed <- env_ts %>% + # only mapping those in the early detection period + dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% + # do not use "Extended" or "Interpolated" data, only "Observed" + dplyr::mutate(val_epidemiar = dplyr::if_else(.data$data_source == "Observed", .data$val_epidemiar, NA_real_)) + + # anomalies + anom_env <- env_ed %>% + #group + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + # anomaly value is observed value minus the ref value from env_ref + dplyr::mutate(anom = .data$val_epidemiar - .data$ref_value) %>% + # summarized over ED period + dplyr::summarize(anom_ed_mean = mean(.data$anom, na.rm = TRUE)) %>% + dplyr::ungroup() + + } else { + #create NA results for when there is no early detection period + anom_env <- env_ts %>% + #create an entry for each geogroup, for creating NA results) + dplyr::select(!!quo_groupfield, !!quo_obsfield) %>% + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + unique() %>% + #add NA result + dplyr::mutate(anom_ed_mean = NA) %>% + dplyr::ungroup() + + } + + anom_env } From 3c7a3f57a622eeedec13cb314a309c33ccd49179 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 1 May 2020 00:20:43 -0500 Subject: [PATCH 048/132] Allowed for an ed_summary_period of 0 in the internal report_dates metadata --- R/run_epidemia.R | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index ac380c1..f64e92d 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -424,12 +424,18 @@ run_epidemia <- function(epi_data = NULL, report_dates$forecast$seq <- report_dates$forecast %>% {seq.Date(.$min, .$max, "week")} #early detection summary period (ED runs over full report, this is for defined early DETECTION period) - report_dates$ed_sum <- list(min = report_settings[["fc_start_date"]] - - lubridate::as.difftime(report_settings[["ed_summary_period"]], - units = "weeks"), - max = report_settings[["fc_start_date"]] - - lubridate::as.difftime(1, units = "weeks")) - report_dates$ed_sum$seq <- report_dates$ed_sum %>% {seq.Date(.$min, .$max, "week")} + if (report_settings[["ed_summary_period"]] > 0) { + report_dates$ed_sum <- list(min = report_settings[["fc_start_date"]] - + lubridate::as.difftime(report_settings[["ed_summary_period"]], + units = "weeks"), + max = report_settings[["fc_start_date"]] - + lubridate::as.difftime(1, units = "weeks")) + report_dates$ed_sum$seq <- report_dates$ed_sum %>% {seq.Date(.$min, .$max, "week")} + } else { + #no early detection period (ed_summary_period = 0 or weird) + report_dates$ed_sum <- list(min = NA, max = NA, seq = NA) + } + #period of report NOT in forecast ("previous" to forecast) report_dates$prev <- list(min = report_dates$full$min, max = report_settings[["fc_start_date"]] - From 29097489f4495c0ac2c40ac00e113a496c016e1b Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 1 May 2020 00:22:13 -0500 Subject: [PATCH 049/132] Corrects observed series to use cases_epidemiar field, as it will have original/interpolated cases depending on the new user epi_interpolation setting --- R/run_epidemia.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index f64e92d..3c4db50 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -293,7 +293,6 @@ run_epidemia <- function(epi_data = NULL, missing_flag <- TRUE missing_msgs <- paste0(missing_msgs, names(necessary[arg]), sep = "\n") } - #note: fix this later: Error in create_named_list() : object 'fc_control' not found } #if missing, stop and give error message @@ -548,11 +547,11 @@ run_epidemia <- function(epi_data = NULL, #case_when is not viable because it evaluates ALL RHS #condition is scalar, so vectorized ifelse is not appropriate value = if(report_settings[["report_value_type"]] == "cases"){ - !!quo_casefield + .data$cases_epidemiar } else if (report_settings[["report_value_type"]] == "incidence"){ - !!quo_casefield / !!quo_popfield * report_settings[["report_inc_per"]] + .data$cases_epidemiar / !!quo_popfield * report_settings[["report_inc_per"]] } else {NA_real_}, - #note use of original not interpolated cases + #note: uses cases_epidemiar, so will return interpolated values if user selected interpolation lab = "Observed", upper = NA, lower = NA) %>% From b9517012372f5e355bcaade0b7cd905b3addadb1 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:01:10 -0500 Subject: [PATCH 050/132] Rewrite of input checks to combine input checks with setting report defaults. --- R/input_checks.R | 1134 ++++++++++++++++++++++++++++++---------------- R/run_epidemia.R | 48 +- 2 files changed, 760 insertions(+), 422 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index d3f99ed..74f415f 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -1,242 +1,9 @@ -#'Set defaults of any missing report_settings parameters -#' -#'Function sets defaults to report_settings parameters. -#' -#'@param raw_settings The report_settings object as given by the user. -#'@param env_variables List of all unique environmental variables in env_data. -#'@param quo_obsfield Quosure of user given field name of the environmental data -#' variables. -#'@param groupings List of all unique geographical groupings in epi_data. -#'@param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#' -#'@inheritParams run_epidemia -#' -#'@return Returns a full report_settings object, using user supplied values or -#' defaults is option was missing. -#' - -set_report_defaults <- function(raw_settings, - epi_data, - env_info, - env_ref_data, - env_variables, - quo_obsfield, - groupings, - quo_groupfield){ - - #set up list in case no report_settings were given - if (is.null(raw_settings)){ - new_settings <- list() - } else { - #copy over to begin before editing/updating below - new_settings <- raw_settings - } - - if (is.null(raw_settings[["report_period"]])){ - new_settings[["report_period"]] <- 26 - } - - if (is.null(raw_settings[["report_inc_per"]])){ - new_settings[["report_inc_per"]] <- 1000 - #okay if not used, if report_value_type is cases instead of incidence - } - - if (is.null(raw_settings[["epi_interpolate"]])){ - new_settings[["epi_interpolate"]] <- FALSE - } - - if (is.null(raw_settings[["ed_summary_period"]])){ - new_settings[["ed_summary_period"]] <- 4 - } - - if (is.null(raw_settings[["model_run"]])){ - new_settings[["model_run"]] <- FALSE - } - - if (is.null(raw_settings[["model_cached"]])){ - new_settings[["model_cached"]] <- NULL - } - - if (is.null(raw_settings[["env_lag_length"]])){ - #maybe make default based on data length, but for now - new_settings[["env_lag_length"]] <- 180 - } - - if (is.null(raw_settings[["fc_cyclicals"]])){ - new_settings[["fc_cyclicals"]] <- FALSE - } - - if (is.null(raw_settings[["fc_future_period"]])){ - new_settings[["fc_future_period"]] <- 8 - } - - #default false, with explicit false for naive models - if (is.null(raw_settings[["env_anomalies"]])){ - new_settings[["env_anomalies"]] <- dplyr::case_when( - fc_model_family == "naive-persistence" ~ FALSE, - fc_model_family == "naive-weekaverage" ~ FALSE, - #default to FALSE - TRUE ~ FALSE) - } - - - # For things that are being string matched: - # tolower to capture upper and lower case user-input variations since match.arg is case sensitive - # but must only try function if ed_method is not null (i.e. was given) - - #report_value_type - # if provided, prepare for matching - if (!is.null(raw_settings[["report_value_type"]])){ - new_settings[["report_value_type"]] <- tolower(raw_settings[["report_value_type"]]) - } else { - #if not provided/missing/null - message("Note: 'report_value_type' was not provided, returning results in case counts ('cases').") - new_settings[["report_value_type"]] <- "cases" - } - #try match - new_settings[["report_value_type"]] <- tryCatch({ - match.arg(new_settings[["report_value_type"]], c("cases", "incidence")) - }, error = function(e){ - message("Warning: Given 'report_value_type' does not match 'cases' or 'incidence', running as 'cases'.") - "cases" - }, finally = { - #failsafe default - "cases" - }) - - # epi_date_type - # if provided, prepare for matching - if (!is.null(raw_settings[["epi_date_type"]])){ - #want to keep ISO and CDC capitalized, but drop 'Week' to 'week' if had been entered that way - first_char <- substr(raw_settings[["epi_date_type"]], 1, 1) %>% - tolower() - #remainder of user entry - rest_char <- substr(raw_settings[["epi_date_type"]], 2, nchar(raw_settings[["epi_date_type"]])) - #paste back together - new_settings[["epi_date_type"]] <- paste0(first_char, rest_char) - } else { - #if not provided/missing/null - message("Note: 'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').") - new_settings[["epi_date_type"]] <- "weekISO" - } - #try match - new_settings[["epi_date_type"]] <- tryCatch({ - match.arg(new_settings[["epi_date_type"]], c("weekISO", "weekCDC")) #"monthly" reserved for future - }, error = function(e){ - message("Warning: Given 'epi_date_type' does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).") - "weekISO" - }, finally = { - #failsafe default - "weekISO" - }) - - - # ed_method - # if provided, prepare for matching - if (!is.null(raw_settings[["ed_method"]])){ - new_settings[["ed_method"]] <- tolower(raw_settings[["ed_method"]]) - } else { - #if not provided/missing/null - message("Note: 'ed_method' was not provided, running as 'none'.") - new_settings[["ed_method"]] <- "none" - } - #try match - new_settings[["ed_method"]] <- tryCatch({ - match.arg(new_settings[["ed_method"]], c("none", "farrington")) - }, error = function(e){ - message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") - "none" - }, finally = { - #failsafe default to no event detection - "none" - }) - - - # For more complicated defaults - - #fc_start_date: date when to start forecasting - if (is.null(raw_settings[["fc_start_date"]])){ - # defaults to last known epidemiological data date + one week - last_known <- max(epi_data[["obs_date"]], na.rm = TRUE) - new_settings[["fc_start_date"]] <- last_known + lubridate::as.difftime(1, units = "weeks") - } else { - #other checks will come later, for now, copy user entry as is over - new_settings[["fc_start_date"]] <- raw_settings[["fc_start_date"]] - } - - #env_var -- what is listed in env_data, env_ref_data, & env_info - if (is.null(raw_settings[["env_var"]])){ - - #create list of all environmental variables in env_info - env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) %>% unique() - - #create list of all environmental variables in env_ref_data - env_ref_variables <- dplyr::pull(env_ref_data, !!quo_obsfield) %>% unique() - - #env_variables already gen list of env_data - - #Two sets of intersection to create list that are present in all three - env_data_info <- dplyr::intersect(env_variables, env_info_variables) - default_env_var <- dplyr::intersect(env_data_info, env_ref_variables) - new_settings[["env_var"]] <- dplyr::tibble(obs_temp = default_env_var) %>% - #rename NSE fun - dplyr::rename(!!rlang::quo_name(quo_obsfield) := .data$obs_temp) - - #message result - message("No user supplied list of environmetal variables to use. Using: ", paste(default_env_var, ""), - " based on presence in env_data, env_ref_data, and env_info.\n") - } - - #nthreads - #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) - #if user-supplied, use that cap at 2, otherwise create a default number - #used to decide if run anomalize_env() prior to forecasting - if (!is.null(raw_settings[["fc_nthreads"]])) { - # nthreads above 2 is not actually helpful - new_settings[["fc_nthreads"]] <- ifelse(raw_settings[["fc_nthreads"]] > 1, 2, 1) - } else { - #no value fed in, so test and determine - new_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) - } #end else for ncores not given - - - #fc_clusters - #default is one cluster, probably not what you actually want for any type of large system - if (is.null(raw_settings[["fc_clusters"]])){ - #create tbl of only one cluster - #groupings already exist as list of geographic groups - cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% - #and fix names with NSE - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) - #assign - new_settings[["fc_clusters"]] <- cluster_tbl - } - - - # Developer options - if (is.null(raw_settings[["dev_fc_fit_freq"]])){ - new_settings[["dev_fc_fit_freq"]] <- "once" - } - if (is.null(raw_settings[["dev_fc_modbsplines"]])){ - new_settings[["dev_fc_modbsplines"]] <- FALSE - } - if (is.null(raw_settings[["dev_fc_formula"]])){ - new_settings[["dev_fc_formula"]] <- NULL - } - - new_settings - -} - - - -#'Functions to check input to epidemiar +#'Functions to check input to epidemiar and set report settings defaults. #' #'Function does basic existance checks and variety of logic checks on input data -#'to run_epidemia(). +#'to run_epidemia(), and sets defaults to report_settings parameters. #' #'@param quo_casefield Quosure of user given field containing the disease case #' counts. @@ -247,11 +14,14 @@ set_report_defaults <- function(raw_settings, #' variables #'@param quo_valuefield Quosure of user given field name of the value of the #' environmental data variable observations. +#'@param raw_settings The report_settings object as given by the user. +#'@param groupings List of all unique geographical groupings in epi_data. +#'@param env_variables List of all unique environmental variables in env_data. #' #'@inheritParams run_epidemia #' -#'@return Returns a flag if there were any errors, plus accompanying error -#' messages. Also returns a flag and messages for warnings, as well. +#'@return Returns a list of items: a flag if there were any errors, plus accompanying error +#' messages; a flag and messages for warnings; updated report_settings #' #' #' @@ -266,7 +36,13 @@ input_check <- function(epi_data, quo_obsfield, quo_valuefield, fc_model_family, - report_settings){ + raw_settings, + groupings, + env_variables){ + + #input checks and setting defaults have logic interwoven, so are both handled here. + # in general, check given setting and copy over if pass, otherwise if missing, assign default + # this will double-check that default values are good (avoid possible unexpected situations) # Want ALL data checks to happen, whether or not error happen before the end of the tests. # Want to collect all errors, and return all of them to console @@ -274,7 +50,6 @@ input_check <- function(epi_data, # Note: does not test for integer value (versus simply numeric), which is non-trivial, for various items. # Create err_flag (binary if any error) and err_msgs (all error messages) variables - # these will be passed to each sub check function and returned err_flag <- FALSE err_msgs <- "" @@ -282,48 +57,40 @@ input_check <- function(epi_data, warn_flag <- FALSE warn_msgs <- "Warning messages:\n" + #set up cleaned list + new_settings <- list() - # Existing & Types -------------------------------------------------------- - # Quick test for some simple settings - - #report_settings tests - if (!is.numeric(report_settings[["report_inc_per"]]) || report_settings[["report_inc_per"]] <= 0){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "'report_settings$report_inc_per' must be numeric and a positive number.\n") - } - if (!class(report_settings[["fc_start_date"]]) == "Date"){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "'report_settings$fc_start_date' must be type Date.\n") - } + # 1. Required fields checking -------------------------------------------------------- + #Confirm that user supplied field names exists in datasets # epi_data tests # has obs_date as Date if (!"obs_date" %in% colnames(epi_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column 'obs_date' in the epidemiological dataset, 'epi_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column 'obs_date' in the epidemiological dataset, 'epi_data'.\n") } else if (!class(epi_data$obs_date) == "Date"){ #has obs_date, now check type err_flag <- TRUE - err_msgs <- paste(err_msgs, "'obs_date' in the epidemiological dataset, 'epi_data', must be type Date.\n") + err_msgs <- paste0(err_msgs, "The 'obs_date' field in the epidemiological dataset, 'epi_data', must be type Date.\n") } # has casefield if (!rlang::quo_name(quo_casefield) %in% colnames(epi_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_casefield), ", in the epidemiological dataset, 'epi_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_casefield), ", in the epidemiological dataset, 'epi_data'.\n") } # has groupfield if(!rlang::quo_name(quo_groupfield) %in% colnames(epi_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the epidemiological dataset, 'epi_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the epidemiological dataset, 'epi_data'.\n") } # has populationfield, but only if given as it is optional #testing if quosure was created on NULL object. if(!rlang::quo_is_null(quo_popfield)){ if(!rlang::quo_name(quo_popfield) %in% colnames(epi_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "The specified column ", rlang::quo_name(quo_popfield), ", for population must be in the in the epidemiological dataset, 'epi_data'.\n") + err_msgs <- paste0(err_msgs, "The specified column ", rlang::quo_name(quo_popfield), ", for population must be in the in the epidemiological dataset, 'epi_data'.\n") } } @@ -332,26 +99,26 @@ input_check <- function(epi_data, # has obs_date as Date if(!"obs_date" %in% colnames(env_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column 'obs_date' in the environmental dataset, 'env_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column 'obs_date' in the environmental dataset, 'env_data'.\n") } else if(!class(env_data$obs_date) == "Date"){ #has obs_date, now check type err_flag <- TRUE - err_msgs <- paste(err_msgs, "'obs_date' in the environmental dataset, 'env_data', must be type Date.\n") + err_msgs <- paste0(err_msgs, "The 'obs_date' field in the environmental dataset, 'env_data', must be type Date.\n") } # has groupfield if(!rlang::quo_name(quo_groupfield) %in% colnames(env_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the environmental dataset, 'env_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the environmental dataset, 'env_data'.\n") } # has obsfield if(!rlang::quo_name(quo_obsfield) %in% colnames(env_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental dataset, 'env_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental dataset, 'env_data'.\n") } # has valuefield if(!rlang::quo_name(quo_valuefield) %in% colnames(env_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_valuefield), ", in the environmental dataset, 'env_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_valuefield), ", in the environmental dataset, 'env_data'.\n") } @@ -359,233 +126,562 @@ input_check <- function(epi_data, # has groupfield if(!rlang::quo_name(quo_groupfield) %in% colnames(env_ref_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the environmental reference dataset, 'env_ref_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the environmental reference dataset, 'env_ref_data'.\n") } # has obsfield if(!rlang::quo_name(quo_obsfield) %in% colnames(env_ref_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental reference dataset, 'env_ref_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental reference dataset, 'env_ref_data'.\n") } #has week_epidemiar if(!"week_epidemiar" %in% colnames(env_ref_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column 'week_epidemiar' for the week of the year in the environmental reference dataset, 'env_ref_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column 'week_epidemiar' for the week of the year in the environmental reference dataset, 'env_ref_data'.\n") } else if(!(is.numeric(env_ref_data$week_epidemiar) | is.integer(env_ref_data$week_epidemiar))){ #week_epidemiar exists, now check class/type err_flag <- TRUE - err_msgs <- paste(err_msgs, "The column 'week_epidemiar' in 'env_ref_data' must be numeric or integer type (integer values only).\n") + err_msgs <- paste0(err_msgs, "The column 'week_epidemiar' in 'env_ref_data' must be numeric or integer type (integer values only).\n") } #has ref_value if(!"ref_value" %in% colnames(env_ref_data)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column 'ref_value' for the historical reference value in the dataset, 'env_ref_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column 'ref_value' for the historical reference value in the dataset, 'env_ref_data'.\n") } # env_info # has obsfield if(!rlang::quo_name(quo_obsfield) %in% colnames(env_info)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental metadata file, 'env_info'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental metadata file, 'env_info'.\n") } # has reference_method if(!"reference_method" %in% colnames(env_info)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column 'reference_method' in 'env_info' for how to summarize values from daily to weekly ('sum' or 'mean').\n") + err_msgs <- paste0(err_msgs, "There must be a column 'reference_method' in 'env_info' for how to summarize values from daily to weekly ('sum' or 'mean').\n") } - # Lengths of Report Sections -------------------------------------- - - #special flag for all dates - rpt_len_flag <- FALSE + #STOP early if errors by now - # check data types - if (!(is.numeric(report_settings[["report_period"]]) | is.integer(report_settings[["report_period"]]))){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "'report_settings$report_period' must be numeric or integer type - integer number of weeks only.\n") - rpt_len_flag <- TRUE - } - if (!(is.numeric(report_settings[["fc_future_period"]]) | is.integer(report_settings[["fc_future_period"]]))){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "'report_settings$forecast_future' must be numeric or integer type - integer number of weeks only.\n") - rpt_len_flag <- TRUE + #if errors, stop and return error messages + if (err_flag){ + #prevent possible truncation of all error messages + options(warning.length = 4000L) + stop(err_msgs) } - #removed with new report_settings$fc_start_date, potentially add back in - # else if (report_settings[["fc_future_period"]] > 13){ - # # warn on long forecasts - # warn_flag <- TRUE - # warn_msgs <- paste(warn_msgs, "Warning: It is not recommended to forecast more than 12 weeks into the future. You are forecasting for ", report_settings[["fc_future_period"]], " weeks.\n") - # } - if (!(is.numeric(report_settings[["ed_summary_period"]]) | is.integer(report_settings[["ed_summary_period"]]))){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "'report_settings$ed_summary_period' must be numeric or integer type - integer number of weeks only.\n") - rpt_len_flag <- TRUE - } - # report length must be equal to or larger than forecast and ED period together - if (!rpt_len_flag){ - if (report_settings[["report_period"]] < report_settings[["ed_summary_period"]] + report_settings[["fc_future_period"]]){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "The report length ", report_settings[["report_period"]], " must be longer than the early detection period ", report_settings[["ed_summary_period"]], " plus the forecast ", report_settings[["fc_future_period"]], ".\n") - } - } + # 2. Report dates and lengths -------------------------------------------------------- + #special flag for all length periods + rpt_len_flag <- FALSE - # Models & Caching -------------------------------------------------------- - #check if fc_model_family is cached that a cached model was given, else fail with error - if (fc_model_family == "cached"){ - if (is.null(report_settings[["model_cached"]])){ + #fc_start_date: date when to start forecasting + if (!is.null(raw_settings[["fc_start_date"]])){ + #check that date type + if (!class(raw_settings[["fc_start_date"]]) == "Date"){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "If 'fc_model_family' == 'cached', a cached model must be supplied in 'report_settings$model_cached'.\n") + err_msgs <- paste0(err_msgs, "'report_settings$fc_start_date' must be type Date.\n") + } else { + #copy over checked user value + new_settings[["fc_start_date"]] <- raw_settings[["fc_start_date"]] } + } else { + # defaults to last known epidemiological data date + one week + last_known <- max(epi_data[["obs_date"]], na.rm = TRUE) + new_settings[["fc_start_date"]] <- last_known + lubridate::as.difftime(1, units = "weeks") + #Removed warning message, this is a good default / normal setting + #warn_flag <- TRUE + #warn_msgs <- paste0(warn_msgs, "'report_settings$fc_start_date' was not provided, running with default ", new_settings[["fc_start_date"]], ".\n") } + #report_period + if (!is.null(raw_settings[["report_period"]])){ + #check type + if (!(is.numeric(raw_settings[["report_period"]]) | is.integer(raw_settings[["report_period"]]))){ + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "'report_settings$report_period' must be numeric or integer type - integer number of weeks only.\n") + rpt_len_flag <- TRUE + } else { + #copy over checked user value + new_settings[["report_period"]] <- raw_settings[["report_period"]] + } + } else { + #default + new_settings[["report_period"]] <- 26 + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "'report_settings$report_period' was not provided, running with default ", new_settings[["report_period"]], ".\n") + } - #if given a full model - if (!is.null(report_settings[["model_cached"]])){ - - #check that $model_info and $model_obj exists in model_cached - if (all(c("model_obj", "model_info") %in% names(report_settings[["model_cached"]]))){ - - #if model looks okay so far, then check further - - #make sure given model (if given) is a regression object (using basic "lm" as test) - #model_cached$model_obj - classes <- class(report_settings[["model_cached"]][["model_obj"]]) - if (!"lm" %in% classes){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "The object in 'report_settings$model_cached$model_obj' is not a regression object, found classes are: ", classes, ".\n") - } #end lm check + #ed_summary_period + if (!is.null(raw_settings[["ed_summary_period"]])){ + if (!(is.numeric(raw_settings[["ed_summary_period"]]) | is.integer(raw_settings[["ed_summary_period"]]))){ + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "'report_settings$ed_summary_period' must be numeric or integer type - integer number of weeks only.\n") + rpt_len_flag <- TRUE + } else { + #copy over checked user value + new_settings[["ed_summary_period"]] <- raw_settings[["ed_summary_period"]] + } + } else { + #default + new_settings[["ed_summary_period"]] <- 4 + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "'report_settings$ed_summary_period' was not provided, running with default ", new_settings[["ed_summary_period"]], ".\n") - #if using a cached model, the model family from the cached model will be used - #warn about overriding any user input family - if (fc_model_family != "cached"){ - warn_flag <- TRUE - warn_msgs <- paste(warn_msgs, "Warning: the cached model family ", report_settings$model_cached$model_info$fc_model_family, " will override any user input.", - "Found 'fc_model_family' set to ", fc_model_family, "instead of 'cached'.\n") - } + } - #end if names - } else { + #fc_future_period + if (!is.null(raw_settings[["fc_future_period"]])){ + if (!(is.numeric(raw_settings[["fc_future_period"]]) | is.integer(raw_settings[["fc_future_period"]]))){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "The given cached model is missing $model_obj and/or $model_info.\n") - } #end else on if names + err_msgs <- paste0(err_msgs, "'report_settings$forecast_future' must be numeric or integer type - integer number of weeks only.\n") + rpt_len_flag <- TRUE + } else { + #copy over checked user value + new_settings[["fc_future_period"]] <- raw_settings[["fc_future_period"]] + } + } else { + #default + new_settings[["fc_future_period"]] <- 8 + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "'report_settings$fc_future_period' was not provided, running with default ", new_settings[["fc_future_period"]], ".\n") - } #end if !is.null model_cached + } - # things that must exist in model_cached$model_info - # model_cached$model_info$fc_model_family - # model_cached$model_info$date_created - # model_cached$model_info$known_epi_range$max - #but will probably give decent error messages on their own if missing. + #if none of the user entered lengths throw an error, now continue with testing override settings if needed + if (!rpt_len_flag){ + #report lengths structure: + # full report length must be at least 1 time unit longer than forecast period + any ed summary period + # (will also handle: ed summary period must be <= time points than 'prev' period (report length - forecast length)) + if (new_settings[["report_period"]] < new_settings[["fc_future_period"]] + min(1, new_settings[["ed_summary_period"]])) { + #make report period make sense with forecast period and (possible) ed summary period + new_settings[["report_period"]] <- new_settings[["fc_future_period"]] + max(1, new_settings[["ed_summary_period"]]) + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "With forecast period ", new_settings[["fc_future_period"]], + " and event detection summary period ", new_settings[["ed_summary_period"]], + ", the report length has been adjusted to ", new_settings[["report_period"]], ".\n") + } + } + # 3. Forecasting --------------------------------------------------------------------- - # Control lists ----------------------------------------------------------- + #fc_cyclicals + if (!is.null(raw_settings[["fc_cyclicals"]])){ + #skipping trying to test for boolean given R + #copy + new_settings[["fc_cyclicals"]] <- raw_settings[["fc_cyclicals"]] + } else { + #default + new_settings[["fc_cyclicals"]] <- FALSE + } - # Forecasting - # model_env - # has obsfield - if(!rlang::quo_name(quo_obsfield) %in% colnames(report_settings[["env_var"]])){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", to indicate the list of model environmental variables in 'report_settings$env_vars'.\n") - } else { - #does have obsfield, - #check that model variables exist in env data and env ref data + #env_var + #has entries in env_data, env_ref_data, & env_info? + #create list of all environmental variables in env_info + env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) %>% unique() + #create list of all environmental variables in env_ref_data + env_ref_variables <- dplyr::pull(env_ref_data, !!quo_obsfield) %>% unique() + #env_variables already gen list of env_data - #but only if no other problems so far, since that could cause errors in the checks below - if (!err_flag){ + if (!is.null(raw_settings[["env_var"]])){ + # given env_var + # check has obsfield + if(!rlang::quo_name(quo_obsfield) %in% colnames(raw_settings[["env_var"]])){ + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "There must be a column", rlang::quo_name(quo_obsfield), + ", to indicate the list of model environmental variables in 'report_settings$env_vars'.\n") + } else { + #does have obsfield, + #check that model variables exist in env data and env ref data + #special flag for env var existing + env_var_flag <- FALSE #pull variables from model info input - model_vars <- report_settings[["env_var"]] %>% dplyr::pull(!!quo_obsfield) - #pull variables in env data - env_in_data <- env_data %>% dplyr::pull(!!quo_obsfield) %>% unique() - #pull variables in env ref data - env_in_ref <- env_ref_data %>% dplyr::pull(!!quo_obsfield) %>% unique() + model_vars <- raw_settings[["env_var"]] %>% dplyr::pull(!!quo_obsfield) - if (!all(model_vars %in% env_in_data)){ + if (!all(model_vars %in% env_variables)){ + env_var_flag <- TRUE err_flag <- TRUE - err_msgs <- paste(err_msgs, "Model variable(s) given in 'report_settings$env_var' is/are missing from 'env_data':\n", - model_vars[which(!model_vars %in% env_in_data)], "\n") + err_msgs <- paste0(err_msgs, "Model variable(s) given in 'report_settings$env_var' is/are missing from 'env_data':\n", + model_vars[which(!model_vars %in% env_variables)], ".\n") } - if (!all(model_vars %in% env_in_ref)){ + if (!all(model_vars %in% env_ref_variables)){ + env_var_flag <- TRUE err_flag <- TRUE - err_msgs <- paste(err_msgs, "Model variable(s) given in 'report_settings$env_var' is/are missing from 'env_ref_data':\n", - model_vars[which(!model_vars %in% env_in_ref)], "\n") + err_msgs <- paste0(err_msgs, "Model variable(s) given in 'report_settings$env_var' is/are missing from 'env_ref_data': ", + model_vars[which(!model_vars %in% env_ref_variables)], "\n") } - } #end err_flag - } #end else obsfield - - #clusters - # has groupfield - if(!rlang::quo_name(quo_groupfield) %in% colnames(report_settings[["fc_clusters"]])){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in 'report_settings$clusters'.\n") + if (!all(model_vars %in% env_info_variables)){ + env_var_flag <- TRUE + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "Model variable(s) given in 'report_settings$env_var' is/are missing from 'env_info': ", + model_vars[which(!model_vars %in% env_info_variables)], "\n") + } + if (!env_var_flag){ + #if passed checks, copy + new_settings[["env_var"]] <- raw_settings[["env_var"]] + } + } #end else obsfield + } else { + #default + #Two sets of intersection to create list that are present in all three + env_data_info <- dplyr::intersect(env_variables, env_info_variables) + default_env_var <- dplyr::intersect(env_data_info, env_ref_variables) + new_settings[["env_var"]] <- dplyr::tibble(obs_temp = default_env_var) %>% + #rename NSE fun + dplyr::rename(!!rlang::quo_name(quo_obsfield) := .data$obs_temp) + #message result + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "No user supplied list of environmetal variables to use. Using: ", + paste(unlist(default_env_var), collapse = " "), + " based on presence in env_data, env_ref_data, and env_info.\n") } - # has cluster_id - if(!"cluster_id" %in% colnames(report_settings[["fc_clusters"]])){ - err_flag <- TRUE - err_msgs <- paste(err_msgs, "There must be a column 'cluster_id' in 'report_settings$clusters'.\n") + + #fc_clusters + if (!is.null(raw_settings[["fc_clusters"]])){ + #given clusters + # special cluster flag + cluster_flag <- FALSE + # has groupfield + if(!rlang::quo_name(quo_groupfield) %in% colnames(raw_settings[["fc_clusters"]])){ + cluster_flag <- TRUE + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), + ", in 'report_settings$clusters'.\n") + } + # has cluster_id + if(!"cluster_id" %in% colnames(raw_settings[["fc_clusters"]])){ + cluster_flag <- TRUE + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "There must be a column 'cluster_id' in 'report_settings$clusters'.\n") + } + #now check that all geographic groupings from epi data have a cluster assigned + #as long as no previous errors + if (!cluster_flag){ + #groupings in cluster info + model_cl <- raw_settings[["fc_clusters"]] %>% dplyr::pull(!!quo_groupfield) + #groupings in epidemiological data + groups_epi <- dplyr::pull(epi_data, !!quo_groupfield) %>% unique() + #check all in cluster list + if (!all(groups_epi %in% model_cl)){ + cluster_flag <- TRUE + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "Geographic groupings present in the epidemiological data are missing in 'report_settings$clusters': ", + groups_epi[which(!groups_epi %in% model_cl)], + ".\n") + } + #Don't need to check environmental data too. + #Extra env data for other groupings not in epidemiological data are just ignored. + } + if(!cluster_flag){ + #if passed checks, copy + new_settings[["fc_clusters"]] <- raw_settings[["fc_clusters"]] + } + } else { + #default + #default is one cluster, probably not what you actually want for any type of large system + #create tbl of only one cluster + #groupings already exist as list of geographic groups + cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% + #and fix names with NSE + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + #assign + new_settings[["fc_clusters"]] <- cluster_tbl + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "'report_settings$fc_clusters' was not provided, running with default of one cluster, i.e. a global model.\n") + } - #now check that all geographic groupings from epi data have a cluster assigned - #as long as no previous errors - if (!err_flag){ - #groupings in cluster info - model_cl <- report_settings[["fc_clusters"]] %>% dplyr::pull(!!quo_groupfield) - #groupings in epidemiological data - groups_epi <- dplyr::pull(epi_data, !!quo_groupfield) %>% unique() - #check all in cluster list - if (!all(groups_epi %in% model_cl)){ + + + #env_lag_length + if (!is.null(raw_settings[["env_lag_length"]])){ + if (!(is.numeric(raw_settings[["env_lag_length"]]) | is.integer(raw_settings[["env_lag_length"]]))){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "Geographic groupings present in the epidemiological data are missing in 'report_settings$clusters':\n", - groups_epi[which(!groups_epi %in% model_cl)]) + err_msgs <- paste0(err_msgs, "'report_settings$env_lag_length' must be an integer number of days only.\n") + } else { + #copy over checked user value + new_settings[["env_lag_length"]] <- raw_settings[["env_lag_length"]] } - #Don't need to check environmental data. Extra env data for other groupings not in epidemiological data are just ignored. + } else { + #default + #maybe make default based on data length, but for now + new_settings[["env_lag_length"]] <- 180 + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "'report_settings$env_lag_length' was not provided, running with default ", new_settings[["env_lag_length"]], ".\n") + } - #lag_length + + #has enough environmental data for lag length? #already checked existance and numeric/integer type #check that enough environmental data exists for lag length selected - - #but only if no other problems so far, since that could cause errors in the checks below + #but only if no other problems so far (would include env_var issues if found above) if (!err_flag){ #subset to env variables as dictated by the model - env_model_data <- pull_model_envvars(env_data, quo_obsfield, env_var = report_settings$env_var) + env_model_data <- pull_model_envvars(env_data, quo_obsfield, env_var = new_settings$env_var) #get earliest dates available env_start_dts <- env_model_data %>% dplyr::group_by(!!quo_obsfield) %>% dplyr::summarize(start_dt = min(.data$obs_date)) #date needed by laglength and first epidemiological data date - need_dt <- min(epi_data$obs_date) - as.difftime(report_settings[["env_lag_length"]], units = "days") + need_dt <- min(epi_data$obs_date) - as.difftime(new_settings[["env_lag_length"]], units = "days") #all env dates equal or before needed date? if (!all(env_start_dts$start_dt <= need_dt)){ err_flag <- TRUE - err_msgs <- paste(err_msgs, "Not enough environmental data for a lag length of ", report_settings[["env_lag_length"]], + err_msgs <- paste0(err_msgs, "Not enough environmental data for a lag length of ", + new_settings[["env_lag_length"]], "days.\n Epidemiological start is", min(epi_data$obs_date), - "therefore environmental data is needed starting", need_dt, "for variables:\n", - env_start_dts[which(!env_start_dts$start_dt <= need_dt),1]) + "therefore environmental data is needed starting", need_dt, + "for variables:", + env_start_dts[which(!env_start_dts$start_dt <= need_dt),1], + ".\n") } } #end err_flag - # ed_method & ed_control + #nthreads + #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) + #if user-supplied, use that cap at 2, otherwise create a default number + #used to decide if run anomalize_env() prior to forecasting + if (!is.null(raw_settings[["fc_nthreads"]])) { + # nthreads above 2 is not actually helpful + new_settings[["fc_nthreads"]] <- ifelse(raw_settings[["fc_nthreads"]] > 1, 2, 1) + } else { + #calc default + new_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) + } + - if (report_settings[["ed_method"]] == "farrington"){ + # Developer options + if (is.null(raw_settings[["dev_fc_fit_freq"]])){ + new_settings[["dev_fc_fit_freq"]] <- "once" + } + if (is.null(raw_settings[["dev_fc_modbsplines"]])){ + new_settings[["dev_fc_modbsplines"]] <- FALSE + } + if (is.null(raw_settings[["dev_fc_formula"]])){ + new_settings[["dev_fc_formula"]] <- NULL + } + + + + # 4. Report settings ----------------------------------------------------------------- + + #epi_interpolate + if (!is.null(raw_settings[["epi_interpolate"]])){ + #skipping trying to test for boolean given R + #copy + new_settings[["epi_interpolate"]] <- raw_settings[["epi_interpolate"]] + } else { + #default + new_settings[["epi_interpolate"]] <- FALSE + } + + + #env_anomalies + if (!is.null(raw_settings[["env_anomalies"]])){ + #skipping trying to test for boolean given R + #copy + new_settings[["env_anomalies"]] <- raw_settings[["env_anomalies"]] + } else { + #default + new_settings[["env_anomalies"]] <- dplyr::case_when( + #being very explicit to make sure in naive models this is false + fc_model_family == "naive-persistence" ~ FALSE, + fc_model_family == "naive-weekaverage" ~ FALSE, + #default to FALSE + TRUE ~ FALSE) + } + + + #report_inc_per + if (!is.null(raw_settings[["report_inc_per"]])){ + if (!is.numeric(raw_settings[["report_inc_per"]]) || raw_settings[["report_inc_per"]] <= 0){ + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "'report_settings$report_inc_per' must be numeric and a positive number.\n") + } else { + #copy + new_settings[["report_inc_per"]] <- raw_settings[["report_inc_per"]] + } + } else { + #default + new_settings[["report_inc_per"]] <- 1000 + } + + + # For things that are being string matched: + # tolower to capture upper and lower case user-input variations since match.arg is case sensitive + # but must only try function if ed_method is not null (i.e. was given) + + #report_value_type + # if provided, prepare for matching + if (!is.null(raw_settings[["report_value_type"]])){ + new_settings[["report_value_type"]] <- tolower(raw_settings[["report_value_type"]]) + } else { + #if not provided/missing/null + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "'report_value_type' was not provided, returning results in case counts ('cases').\n") + new_settings[["report_value_type"]] <- "cases" + } + #try match + new_settings[["report_value_type"]] <- tryCatch({ + match.arg(new_settings[["report_value_type"]], c("cases", "incidence")) + }, error = function(e){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "Given 'report_value_type'", + raw_settings[["report_value_type"]], + "does not match 'cases' or 'incidence', running as 'cases'.\n") + "cases" + }, finally = { + #failsafe default + "cases" + }) + + # epi_date_type + # if provided, prepare for matching + if (!is.null(raw_settings[["epi_date_type"]])){ + #want to keep ISO and CDC capitalized, but drop 'Week' to 'week' if had been entered that way + first_char <- substr(raw_settings[["epi_date_type"]], 1, 1) %>% + tolower() + #remainder of user entry + rest_char <- substr(raw_settings[["epi_date_type"]], 2, nchar(raw_settings[["epi_date_type"]])) + #paste back together + new_settings[["epi_date_type"]] <- paste0(first_char, rest_char) + } else { + #if not provided/missing/null + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').\n") + new_settings[["epi_date_type"]] <- "weekISO" + } + #try match + new_settings[["epi_date_type"]] <- tryCatch({ + match.arg(new_settings[["epi_date_type"]], c("weekISO", "weekCDC")) #"monthly" reserved for future + }, error = function(e){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "Given 'epi_date_type'", raw_settings[["epi_date_type"]], + "does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).\n") + "weekISO" + }, finally = { + #failsafe default + "weekISO" + }) + + + + # 5. Early Detection settings -------------------------------------------------------- + + # For things that are being string matched: + # tolower to capture upper and lower case user-input variations since match.arg is case sensitive + # but must only try function if ed_method is not null (i.e. was given) + + # ed_method + # if provided, prepare for matching + if (!is.null(raw_settings[["ed_method"]])){ + new_settings[["ed_method"]] <- tolower(raw_settings[["ed_method"]]) + } else { + #if not provided/missing/null + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs,"'ed_method' was not provided, running as 'none'.\n") + new_settings[["ed_method"]] <- "none" + } + #try match + new_settings[["ed_method"]] <- tryCatch({ + match.arg(new_settings[["ed_method"]], c("none", "farrington")) + }, error = function(e){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs,"Given 'ed_method' ", raw_settings[["ed_method"]], + " does not match 'none' or 'farrington', running as 'none'.\n") + "none" + }, finally = { + #failsafe default to no event detection + "none" + }) + + #ed_control + if (!is.null(raw_settings[["ed_control"]])){ + #just copy over, no testing here + new_settings[["ed_control"]] <- raw_settings[["ed_control"]] + } + + + #special check/message for Farrington + if (new_settings[["ed_method"]] == "farrington"){ #controls for Farrington all have defaults in farringtonFlexible() and can be missing, just warn - if (is.null(report_settings[["ed_control"]])){ + if (is.null(raw_settings[["ed_control"]])){ #warning if missing though warn_flag <- TRUE - warn_msgs <- paste(warn_msgs, "Warning: Early Detection controls not found, running with surveillance package defaults.\n") + warn_msgs <- paste(warn_msgs, "Early Detection controls not found, running with surveillance package defaults.\n") + } + } + + + # 6. Model runs and caching ----------------------------------------------------------- + + #model_run + if (!is.null(raw_settings[["model_run"]])){ + #copy over (skipping boolean check because R) + new_settings[["model_run"]] <- raw_settings[["model_run"]] + } else { + #default + new_settings[["model_run"]] <- FALSE + } + + #model_cached + if (!is.null(raw_settings[["model_cached"]])){ + #check that $model_info and $model_obj exists in model_cached + if (all(c("model_obj", "model_info") %in% names(raw_settings[["model_cached"]]))){ + + #if model looks okay so far, then check further + + #make sure given model (if given) is a regression object (using basic "lm" as test) + #model_cached$model_obj + classes <- class(raw_settings[["model_cached"]][["model_obj"]]) + if (!"lm" %in% classes){ + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "The object in 'report_settings$model_cached$model_obj' is not a regression object, found classes are: ", classes, ".\n") + } #end lm check + + #if using a cached model, the model family from the cached model will be used + #warn about overriding any user input family + if (fc_model_family != "cached"){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "The cached model family ", raw_settings$model_cached$model_info$fc_model_family, ", will override any user input. ", + "Found 'fc_model_family' set to ", fc_model_family, " instead of 'cached'.\n") + } + + #end if names + } else { + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "The given cached model is missing $model_obj and/or $model_info.\n") + } #end else on if names + + #copy model over + new_settings[["model_cached"]] <- raw_settings[["model_cached"]] + + } else { + #default + new_settings[["model_cached"]] <- NULL + } + + + #check if fc_model_family is cached that a cached model was given, else fail with error + if (fc_model_family == "cached"){ + if (is.null(new_settings[["model_cached"]])){ + err_flag <- TRUE + err_msgs <- paste(err_msgs, "If 'fc_model_family' is set to 'cached', a cached model must be supplied in 'report_settings$model_cached'.\n") } } + # Return ----------------------------------------------------------- + ## Return - create_named_list(err_flag, err_msgs, warn_flag, warn_msgs) + create_named_list(err_flag, err_msgs, warn_flag, warn_msgs, clean_settings = new_settings) } #end input_check() @@ -594,4 +690,246 @@ input_check <- function(epi_data, - +# #'Set defaults of any missing report_settings parameters +# #' +# #'Function sets defaults to report_settings parameters. +# #' +# #'@param raw_settings The report_settings object as given by the user. +# #'@param env_variables List of all unique environmental variables in env_data. +# #'@param quo_obsfield Quosure of user given field name of the environmental data +# #' variables. +# #'@param groupings List of all unique geographical groupings in epi_data. +# #'@param quo_groupfield Quosure of the user given geographic grouping field to +# #' run_epidemia(). +# #' +# #'@inheritParams run_epidemia +# #' +# #'@return Returns a full report_settings object, using user supplied values or +# #' defaults is option was missing, or overrides in certain cases. +# #' +# +# set_report_defaults <- function(raw_settings, +# epi_data, +# env_info, +# env_ref_data, +# env_variables, +# quo_obsfield, +# groupings, +# quo_groupfield){ +# +# #set up list in case no report_settings were given +# if (is.null(raw_settings)){ +# new_settings <- list() +# } else { +# #copy over to begin before editing/updating below +# new_settings <- raw_settings +# } +# +# if (is.null(raw_settings[["report_period"]])){ +# new_settings[["report_period"]] <- 26 +# } +# +# if (is.null(raw_settings[["report_inc_per"]])){ +# new_settings[["report_inc_per"]] <- 1000 +# #okay if not used, if report_value_type is cases instead of incidence +# } +# +# if (is.null(raw_settings[["epi_interpolate"]])){ +# new_settings[["epi_interpolate"]] <- FALSE +# } +# +# if (is.null(raw_settings[["ed_summary_period"]])){ +# new_settings[["ed_summary_period"]] <- 4 +# } +# +# if (is.null(raw_settings[["model_run"]])){ +# new_settings[["model_run"]] <- FALSE +# } +# +# if (is.null(raw_settings[["model_cached"]])){ +# new_settings[["model_cached"]] <- NULL +# } +# +# if (is.null(raw_settings[["env_lag_length"]])){ +# #maybe make default based on data length, but for now +# new_settings[["env_lag_length"]] <- 180 +# } +# +# if (is.null(raw_settings[["fc_cyclicals"]])){ +# new_settings[["fc_cyclicals"]] <- FALSE +# } +# +# if (is.null(raw_settings[["fc_future_period"]])){ +# new_settings[["fc_future_period"]] <- 8 +# } +# +# #default false, with explicit false for naive models +# if (is.null(raw_settings[["env_anomalies"]])){ +# new_settings[["env_anomalies"]] <- dplyr::case_when( +# fc_model_family == "naive-persistence" ~ FALSE, +# fc_model_family == "naive-weekaverage" ~ FALSE, +# #default to FALSE +# TRUE ~ FALSE) +# } +# +# +# # For things that are being string matched: +# # tolower to capture upper and lower case user-input variations since match.arg is case sensitive +# # but must only try function if ed_method is not null (i.e. was given) +# +# #report_value_type +# # if provided, prepare for matching +# if (!is.null(raw_settings[["report_value_type"]])){ +# new_settings[["report_value_type"]] <- tolower(raw_settings[["report_value_type"]]) +# } else { +# #if not provided/missing/null +# message("Note: 'report_value_type' was not provided, returning results in case counts ('cases').") +# new_settings[["report_value_type"]] <- "cases" +# } +# #try match +# new_settings[["report_value_type"]] <- tryCatch({ +# match.arg(new_settings[["report_value_type"]], c("cases", "incidence")) +# }, error = function(e){ +# message("Warning: Given 'report_value_type' does not match 'cases' or 'incidence', running as 'cases'.") +# "cases" +# }, finally = { +# #failsafe default +# "cases" +# }) +# +# # epi_date_type +# # if provided, prepare for matching +# if (!is.null(raw_settings[["epi_date_type"]])){ +# #want to keep ISO and CDC capitalized, but drop 'Week' to 'week' if had been entered that way +# first_char <- substr(raw_settings[["epi_date_type"]], 1, 1) %>% +# tolower() +# #remainder of user entry +# rest_char <- substr(raw_settings[["epi_date_type"]], 2, nchar(raw_settings[["epi_date_type"]])) +# #paste back together +# new_settings[["epi_date_type"]] <- paste0(first_char, rest_char) +# } else { +# #if not provided/missing/null +# message("Note: 'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').") +# new_settings[["epi_date_type"]] <- "weekISO" +# } +# #try match +# new_settings[["epi_date_type"]] <- tryCatch({ +# match.arg(new_settings[["epi_date_type"]], c("weekISO", "weekCDC")) #"monthly" reserved for future +# }, error = function(e){ +# message("Warning: Given 'epi_date_type' does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).") +# "weekISO" +# }, finally = { +# #failsafe default +# "weekISO" +# }) +# +# +# # ed_method +# # if provided, prepare for matching +# if (!is.null(raw_settings[["ed_method"]])){ +# new_settings[["ed_method"]] <- tolower(raw_settings[["ed_method"]]) +# } else { +# #if not provided/missing/null +# message("Note: 'ed_method' was not provided, running as 'none'.") +# new_settings[["ed_method"]] <- "none" +# } +# #try match +# new_settings[["ed_method"]] <- tryCatch({ +# match.arg(new_settings[["ed_method"]], c("none", "farrington")) +# }, error = function(e){ +# message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") +# "none" +# }, finally = { +# #failsafe default to no event detection +# "none" +# }) +# +# +# # For other or more complicated defaults +# +# #report lengths structure: +# # full report length must be at least 1 time unit longer than forecast period + any ed summary period +# # (will also handle: ed summary period must be <= time points than 'prev' period (report length - forecast length)) +# if (new_settings[["report_period"]] < new_settings[["fc_future_period"]] + min(1, new_settings[["ed_summary_period"]])) { +# #make report period make sense with forecast period and (possible) ed summary period +# new_settings[["report_period"]] <- new_settings[["fc_future_period"]] + min(1, new_settings[["ed_summary_period"]]) +# message("Warning: With forecast period ", new_settings[["fc_future_period"]], +# " and event detection summary period ", new_settings[["ed_summary_period"]], +# ", the report length has been adjusted to ", new_settings[["report_period"]], ".") +# } +# +# #fc_start_date: date when to start forecasting +# if (is.null(raw_settings[["fc_start_date"]])){ +# # defaults to last known epidemiological data date + one week +# last_known <- max(epi_data[["obs_date"]], na.rm = TRUE) +# new_settings[["fc_start_date"]] <- last_known + lubridate::as.difftime(1, units = "weeks") +# } else { +# #other checks will come later, for now, copy user entry as is over +# new_settings[["fc_start_date"]] <- raw_settings[["fc_start_date"]] +# } +# +# #env_var -- what is listed in env_data, env_ref_data, & env_info +# if (is.null(raw_settings[["env_var"]])){ +# +# #create list of all environmental variables in env_info +# env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) %>% unique() +# +# #create list of all environmental variables in env_ref_data +# env_ref_variables <- dplyr::pull(env_ref_data, !!quo_obsfield) %>% unique() +# +# #env_variables already gen list of env_data +# +# #Two sets of intersection to create list that are present in all three +# env_data_info <- dplyr::intersect(env_variables, env_info_variables) +# default_env_var <- dplyr::intersect(env_data_info, env_ref_variables) +# new_settings[["env_var"]] <- dplyr::tibble(obs_temp = default_env_var) %>% +# #rename NSE fun +# dplyr::rename(!!rlang::quo_name(quo_obsfield) := .data$obs_temp) +# +# #message result +# message("No user supplied list of environmetal variables to use. Using: ", paste(default_env_var, ""), +# " based on presence in env_data, env_ref_data, and env_info.\n") +# } +# +# #nthreads +# #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) +# #if user-supplied, use that cap at 2, otherwise create a default number +# #used to decide if run anomalize_env() prior to forecasting +# if (!is.null(raw_settings[["fc_nthreads"]])) { +# # nthreads above 2 is not actually helpful +# new_settings[["fc_nthreads"]] <- ifelse(raw_settings[["fc_nthreads"]] > 1, 2, 1) +# } else { +# #no value fed in, so test and determine +# new_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) +# } #end else for ncores not given +# +# +# #fc_clusters +# #default is one cluster, probably not what you actually want for any type of large system +# if (is.null(raw_settings[["fc_clusters"]])){ +# #create tbl of only one cluster +# #groupings already exist as list of geographic groups +# cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% +# #and fix names with NSE +# dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) +# #assign +# new_settings[["fc_clusters"]] <- cluster_tbl +# } +# +# +# # Developer options +# if (is.null(raw_settings[["dev_fc_fit_freq"]])){ +# new_settings[["dev_fc_fit_freq"]] <- "once" +# } +# if (is.null(raw_settings[["dev_fc_modbsplines"]])){ +# new_settings[["dev_fc_modbsplines"]] <- FALSE +# } +# if (is.null(raw_settings[["dev_fc_formula"]])){ +# new_settings[["dev_fc_formula"]] <- NULL +# } +# +# +# new_settings +# +# } +# diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 3c4db50..2400f58 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -301,7 +301,7 @@ run_epidemia <- function(epi_data = NULL, } - # Preparing: generating listings, defaults ---------------------------- + # Preparing: generating listings, detailed input checks, defaults ---------------------------- #create alphabetical list of unique groups #must remain in alpha order for early detection using surveillance package to capture results properly @@ -310,28 +310,7 @@ run_epidemia <- function(epi_data = NULL, env_variables <- dplyr::pull(env_data, !!quo_obsfield) %>% unique() %>% sort() - #set defaults in report_settings if not supplied - # some specific data checks that need overrides - report_settings <- set_report_defaults(raw_settings = report_settings, - epi_data, - env_info, - env_ref_data, - env_variables, - quo_obsfield, - groupings, - quo_groupfield) - - # switch epi_date_type to week_type needed for add_datefields() - week_type <- dplyr::case_when( - report_settings[["epi_date_type"]] == "weekISO" ~ "ISO", - report_settings[["epi_date_type"]] == "weekCDC" ~ "CDC", - #default NA - TRUE ~ NA_character_) - - - # Preparing: Detailed Input checking ----------------------------------------------- - - # More detailed input checking + # Detailed input checking and sets defaults in report_settings if not supplied check_results <- input_check(epi_data, env_data, env_ref_data, @@ -342,7 +321,9 @@ run_epidemia <- function(epi_data = NULL, quo_obsfield, quo_valuefield, fc_model_family, - report_settings) + raw_settings = report_settings, + groupings, + env_variables) #if warnings, just give message and continue if (check_results$warn_flag){ message(check_results$warn_msgs) @@ -354,6 +335,25 @@ run_epidemia <- function(epi_data = NULL, stop(check_results$err_msgs) } + #update report_settings with checked, cleaned, or newly added default values + report_settings <- check_results$clean_settings + + # report_settings <- set_report_defaults(raw_settings = report_settings, + # epi_data, + # env_info, + # env_ref_data, + # env_variables, + # quo_obsfield, + # groupings, + # quo_groupfield) + + # switch epi_date_type to week_type needed for add_datefields() + week_type <- dplyr::case_when( + report_settings[["epi_date_type"]] == "weekISO" ~ "ISO", + report_settings[["epi_date_type"]] == "weekCDC" ~ "CDC", + #default NA + TRUE ~ NA_character_) + # Preparing: date sets ---------------------------- From 44dca1c649aa3f0d21fb12cfc9c6d395212fd736 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:04:15 -0500 Subject: [PATCH 051/132] Blending of observed and forecast values to pass to event detection such that Farrington will produce continuous thresholds (plus alert censoring as necessary). --- R/event_detection.R | 22 ++++++++++-- R/run_epidemia.R | 82 +++++++++++++++++++++++++++++++++------------ 2 files changed, 80 insertions(+), 24 deletions(-) diff --git a/R/event_detection.R b/R/event_detection.R index 6d87457..2fd662a 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -217,6 +217,7 @@ run_farrington <- function(epi_fc_data, far_res_list[[i]] <- surveillance::farringtonFlexible(epi_stss[[i]], control = far_control) } + #results into output report data form far_res <- stss_res_to_output_data(stss_res_list = far_res_list, epi_fc_data, @@ -285,7 +286,6 @@ make_stss <- function(epi_fc_data, #' Formats output data from sts result objects #' #'@param stss_res_list List of sts output object from Farrington algorithm. -#' #'@inheritParams run_event_detection #' #'@return Returns a list of three series from the Farrington sts result output: @@ -327,6 +327,17 @@ stss_res_to_output_data <- function(stss_res_list, "epoch"))) } + + #recover alert censor flag (when observed was NA in 'prev' report period) + stss_res_flat <- stss_res_flat %>% + dplyr::left_join(epi_fc_data %>% + dplyr::select(!!quo_groupfield, .data$obs_date, .data$censor_flag), + by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + "obs_date"), + c(rlang::quo_name(quo_groupfield), + "epoch"))) + + #gather early detection (pre-forecast) event detection alert series #early detection alerts show for all time previous and including early detection period #"historical" alerts were wanted @@ -338,10 +349,15 @@ stss_res_to_output_data <- function(stss_res_list, lab = "Early Detection Alert", upper = NA, lower = NA) %>% - #surveillance returns an alarm value (0) for when observed is NA, we want NA in this case - dplyr::mutate(value = ifelse(is.na(.data$observed), + #censor alarms to NA for when observed value was actually NA in 'prev' period + dplyr::mutate(value = ifelse(.data$censor_flag == TRUE, NA_integer_, .data$value)) %>% + # #surveillance returns an alarm value (0) for when observed is NA, we want NA in this case + # #this should no longer happen with blending of modelled values to force threshold generation + # dplyr::mutate(value = ifelse(is.na(.data$observed), + # NA_integer_, + # .data$value)) %>% dplyr::select(!!quo_groupfield, .data$obs_date, .data$series, .data$value, .data$lab, .data$upper, .data$lower) #gather early WARNING event detection alert series diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 2400f58..7112300 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -615,27 +615,67 @@ run_epidemia <- function(epi_data = NULL, # Event detection --------------------------------------------------------- #need to calculate event detection on observed data; & in forecast period, the FORECASTED results - #existing data before forecast start - epi_to_fc <- epi_data %>% - dplyr::filter(.data$obs_date < report_dates$forecast$min) - - #modeled values in forecast period = forecast values - forecast_values <- fc_res_all$fc_epi %>% - #get future forecasted results ONLY - dplyr::filter(.data$obs_date %in% report_dates$forecast$seq) %>% - #assign forecasted values into cases_epidemiar column (so event detection will run on these values) - dplyr::mutate(cases_epidemiar = .data$fc_cases) - # dplyr::mutate(cases_epidemiar = ifelse(!rlang::are_na(.data$cases_epidemiar), - # .data$cases_epidemiar, - # .data$fc_cases)) - - - #combine existing and future - obs_fc_epi <- dplyr::bind_rows(epi_to_fc, forecast_values) %>% - #will be lost by end, but need for event detection methods using surveillance::sts objects - epidemiar::add_datefields() %>% - #arrange (for viewing/checking) - dplyr::arrange(!!quo_groupfield, .data$obs_date) + + #however, to force surveillance into giving a threshold even when input is NA, use forecast values if NA + # but will need to censor those dates from alerts later + + if (report_settings[["ed_method"]] == "farrington") { + + #existing data before report start (i.e. before we have any modelled values from forecasting) + epi_to_fc <- epi_data %>% + dplyr::filter(.data$obs_date < report_dates$prev$min) + + + #observed OR modeled values in report period before forecasting ('previous') + report_prev_values <- fc_res_all$fc_epi %>% + #get results ONLY from prev period + dplyr::filter(.data$obs_date %in% report_dates$prev$seq) %>% + #flag dates that will need to be censored later + dplyr::mutate(censor_flag = rlang::are_na(.data$cases_epidemiar), + #and fill in NA values for modelled values for continuous non-NA values + cases_epidemiar = ifelse(!rlang::are_na(.data$cases_epidemiar), + .data$cases_epidemiar, + .data$fc_cases)) + + #modeled values in forecast period = forecast values + forecast_values <- fc_res_all$fc_epi %>% + #get future forecasted results ONLY + dplyr::filter(.data$obs_date %in% report_dates$forecast$seq) %>% + #assign forecasted values into cases_epidemiar column (so event detection will run on these values) + dplyr::mutate(cases_epidemiar = .data$fc_cases) + + + #combine all + obs_fc_epi <- dplyr::bind_rows(epi_to_fc, report_prev_values, forecast_values) %>% + #will be lost by end, but need for event detection methods using surveillance::sts objects + epidemiar::add_datefields() %>% + #arrange (for viewing/checking) + dplyr::arrange(!!quo_groupfield, .data$obs_date) + + + + } else { + #normal combination of past and forecasted values + #existing data before forecast start + epi_to_fc <- epi_data %>% + dplyr::filter(.data$obs_date < report_dates$forecast$min) + + #modeled values in forecast period = forecast values + forecast_values <- fc_res_all$fc_epi %>% + #get future forecasted results ONLY + dplyr::filter(.data$obs_date %in% report_dates$forecast$seq) %>% + #assign forecasted values into cases_epidemiar column (so event detection will run on these values) + dplyr::mutate(cases_epidemiar = .data$fc_cases) + + #combine existing and future + obs_fc_epi <- dplyr::bind_rows(epi_to_fc, forecast_values) %>% + #will be lost by end, but need for event detection methods using surveillance::sts objects + epidemiar::add_datefields() %>% + #arrange (for viewing/checking) + dplyr::arrange(!!quo_groupfield, .data$obs_date) + + } + #run event detection on combined dataset ed_res <- run_event_detection(epi_fc_data = obs_fc_epi, From 4107cd3e79de4c0b9d84fd5bffb035a1492fe64a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:06:34 -0500 Subject: [PATCH 052/132] Gather early detection results with $prev seq instead of $known as meanings has changed with $known sequence. --- R/event_detection.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/event_detection.R b/R/event_detection.R index 2fd662a..dc2224d 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -416,9 +416,9 @@ run_no_detection <- function(epi_fc_data, report_dates){ - #early detection (KNOWN - pre-forecast) event detection alert series + #early detection (pre-forecast, obstensibly though not nec. known) event detection alert series ed_alert_res <- epi_fc_data %>% - dplyr::filter(.data$obs_date %in% report_dates$known$seq) %>% + dplyr::filter(.data$obs_date %in% report_dates$prev$seq) %>% dplyr::mutate(series = "ed", value = NA_integer_, lab = "Early Detection Alert", From cab7ddf99732b7273e74649a04bf302bd5dc2fb6 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:07:34 -0500 Subject: [PATCH 053/132] Switched is.na test on report_dates$ed_sum$min not the seq (would get multiple results for every item in sequence if it was not NA). --- R/formatters_calculators.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index 193cc84..2d0104e 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -129,7 +129,7 @@ create_summary_data <- function(ed_res, alert_level <- c("Low", "Medium", "High") #if early detection period was defined (ed_summary_period > 0) - if (!is.na(report_dates$ed_sum$seq)) { + if (!is.na(report_dates$ed_sum$min)) { #Early Detection ed_summary <- ed_res %>% #get the alert series for all early detection @@ -213,7 +213,7 @@ create_epi_summary <- function(obs_res, report_dates){ #if early detection period was defined (ed_summary_period > 0) - if (!is.na(report_dates$ed_sum$seq)) { + if (!is.na(report_dates$ed_sum$min)) { epi <- obs_res %>% #epi data is weekly, get the data for the early detection summary period dplyr::filter(.data$obs_date %in% report_dates$ed_sum$seq) %>% @@ -261,7 +261,7 @@ calc_env_anomalies <- function(env_ts, report_dates){ #if early detection period was defined (ed_summary_period > 0) - if (!is.na(report_dates$ed_sum$seq)) { + if (!is.na(report_dates$ed_sum$min)) { #environmental observed data in early detection period env_ed <- env_ts %>% # only mapping those in the early detection period From c4c303fcc149134b04f466c84842113319bfa7ee Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:08:43 -0500 Subject: [PATCH 054/132] Added explicit forecast start date in validation to avoid any future problems with changing default behaviors. --- R/model_validation.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/model_validation.R b/R/model_validation.R index f0a4e84..8a1ae7b 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -185,8 +185,10 @@ run_validation <- function(date_start = NULL, #loop for (i in seq_along(date_list)){ this_dt <- date_list[i] + this_fc_start <- this_dt + lubridate::weeks(1) + this_report_settings$fc_start_date <- this_fc_start - message("Validation run - date: ", this_dt) # for testing for now + message("Validation run - date: ", this_dt) #set up data #censoring as appropriate From e0ec6051a0279b8cce824911dca0cee660512104 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:09:06 -0500 Subject: [PATCH 055/132] Added documentation for new fc_start_date option under report_settings. --- R/run_epidemia.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 7112300..6a6552d 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -112,6 +112,12 @@ #' geographic unit and cyclical cubic regression spline on day of year per #' geographic group. #' +#' \item \code{fc_start_date}: The date to start the forecasting, also the +#' start of the early warning period. Epidemiological data does not have to +#' exist just before the start date, though higher accuracy will be obtained +#' with more recent data. The default is the week following the last known +#' observation in /code{epi_data}. +#' #' \item \code{fc_future_period} = 8: Number of future weeks from the end of #' the \code{epi_data} to produce forecasts. Default is 8 weeks. #' From 9cf3be663b888f2efb6e97a989cacb34da251b9c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:09:28 -0500 Subject: [PATCH 056/132] Auto-updated documentation --- man/build_model.Rd | 6 +++ man/forecast_regression.Rd | 6 +++ man/input_check.Rd | 105 +++---------------------------------- man/run_epidemia.Rd | 6 +++ man/run_forecast.Rd | 6 +++ man/run_validation.Rd | 6 +++ man/set_report_defaults.Rd | 40 -------------- 7 files changed, 38 insertions(+), 137 deletions(-) delete mode 100644 man/set_report_defaults.Rd diff --git a/man/build_model.Rd b/man/build_model.Rd index 2241dc5..f7098d7 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -81,6 +81,12 @@ data and groupings converted to factors.} geographic unit and cyclical cubic regression spline on day of year per geographic group. + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index 13ca48e..db397d5 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -80,6 +80,12 @@ input "poisson()". If a cached model is being used, set the parameter to geographic unit and cyclical cubic regression spline on day of year per geographic group. + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. diff --git a/man/input_check.Rd b/man/input_check.Rd index 84810e0..f67abef 100644 --- a/man/input_check.Rd +++ b/man/input_check.Rd @@ -2,11 +2,11 @@ % Please edit documentation in R/input_checks.R \name{input_check} \alias{input_check} -\title{Functions to check input to epidemiar} +\title{Functions to check input to epidemiar and set report settings defaults.} \usage{ input_check(epi_data, env_data, env_ref_data, env_info, quo_casefield, quo_popfield, quo_groupfield, quo_obsfield, quo_valuefield, - fc_model_family, report_settings) + fc_model_family, raw_settings, groupings, env_variables) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date @@ -49,106 +49,17 @@ link to use in model fitting. E.g. for a Poisson regression, the user would input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} -\item{report_settings}{This is a named list of all the report, forecasting, - event detection and other settings. All of these have defaults, but they are - not likely the defaults needed for your system, so each of these should be - reviewed: +\item{raw_settings}{The report_settings object as given by the user.} - \itemize{ +\item{groupings}{List of all unique geographical groupings in epi_data.} - \item \code{report_period} = 26: The number of weeks that the entire report - will cover. The \code{report_period} minus \code{fc_future_period} is the - number of weeks of past (known) data that will be included. Default is 26 - weeks. - - \item \code{report_value_type} = "cases": How to report the results, either - in terms of "cases" (default) or "incidence". - - \item \code{report_inc_per} = 1000: If reporting incidence, what should be - denominator be? Default is per 1000 persons. - - \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO - ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and - environmental reference data use ("weekISO" or "weekCDC"). Required: - epidemiological observation dates listed are LAST day of week. - - \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given - epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). - - \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate - the model regression object plus metadata. This model can be cached and used - later on its own, skipping a large portion of the slow calculations for - future runs. - - \item \code{model_cached} = NULL: The output of a previous model_run = TRUE - run of run_epidemia() that produces a model (regression object) and - metadata. The metadata will be used for input checking and validation. Using - a prebuilt model saves on processing time, but will need to be updated - periodically. If using a cached model, also set `fc_model_family = - "cached"`. - - \item \code{env_var}: List environmental variables to actually use in the - modelling. (You can therefore have extra variables or data in the - environmental dataset.) Input should be a one column tibble, header row as - `obsfield` and each row with entries of the variables (must match what is in - env_data, env_ref-data, and env_info). Default is to use all environmental - variables that are present in all three of env_data, env_ref_data, and - env_info. - - \item \code{env_lag_length} = 180: The number of days of past environmental - data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. - - \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the - environmental variables should be replaced with their anomalies. The - variables were transformed by taking the residuals from a GAM with - geographic unit and cyclical cubic regression spline on day of year per - geographic group. - - \item \code{fc_future_period} = 8: Number of future weeks from the end of - the \code{epi_data} to produce forecasts. Default is 8 weeks. - - \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster - id. This clusters, or groups, certain geographic locations together, to - better model when spatial non-stationarity in the relationship between - environmental variables and cases. See the overview and data & mdoeling - vignettes for more discussion. Default is a global model, all geographic - units in one cluster. - - \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting - for seasonality). - - \item \code{fc_nthreads}: The number of parallel threads that can be used by - `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. - - \item \code{ed_summary_period} = 4: The number of weeks that will be - considered the "early detection period". It will count back from the week of - last known epidemiological data. Default is 4 weeks. - - \item \code{ed_method} = 'none': Which method for early detection should be - used ("farrington" is only current option, or "none"). - - \item \code{ed_control} = Controls passed along to the event detection - method. E.g. for `ed_method = 'farrington'`, these are passed to - \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. - Currently, these parameters are supported for Farrington: `b`, `w`, - `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, - `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. - Any control not included will use surveillance package defaults, with the - exception of `b`, the number of past years to include: epidemiar default is - to use as many years are available in the data. - - - }} +\item{env_variables}{List of all unique environmental variables in env_data.} } \value{ -Returns a flag if there were any errors, plus accompanying error - messages. Also returns a flag and messages for warnings, as well. +Returns a list of items: a flag if there were any errors, plus accompanying error + messages; a flag and messages for warnings; updated report_settings } \description{ Function does basic existance checks and variety of logic checks on input data -to run_epidemia(). +to run_epidemia(), and sets defaults to report_settings parameters. } diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index ea5f6a1..07e661a 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -113,6 +113,12 @@ input "poisson()". If a cached model is being used, set the parameter to geographic unit and cyclical cubic regression spline on day of year per geographic group. + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index b33753e..a8d4e85 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -104,6 +104,12 @@ input "poisson()". If a cached model is being used, set the parameter to geographic unit and cyclical cubic regression spline on day of year per geographic group. + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. diff --git a/man/run_validation.Rd b/man/run_validation.Rd index abe8c0c..8cc97b7 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -142,6 +142,12 @@ input "poisson()". If a cached model is being used, set the parameter to geographic unit and cyclical cubic regression spline on day of year per geographic group. + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + \item \code{fc_future_period} = 8: Number of future weeks from the end of the \code{epi_data} to produce forecasts. Default is 8 weeks. diff --git a/man/set_report_defaults.Rd b/man/set_report_defaults.Rd deleted file mode 100644 index 12416ee..0000000 --- a/man/set_report_defaults.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/input_checks.R -\name{set_report_defaults} -\alias{set_report_defaults} -\title{Set defaults of any missing report_settings parameters} -\usage{ -set_report_defaults(raw_settings, epi_data, env_info, env_ref_data, - env_variables, quo_obsfield, groupings, quo_groupfield) -} -\arguments{ -\item{raw_settings}{The report_settings object as given by the user.} - -\item{epi_data}{Epidemiological data with case numbers per week, with date -field "obs_date".} - -\item{env_info}{Lookup table for environmental data - reference creation -method (e.g. sum or mean), report labels, etc.} - -\item{env_ref_data}{Historical averages by week of year for environmental -variables. Used in extended environmental data into the future for long -forecast time, to calculate anomalies in early detection period, and to -display on timeseries in reports.} - -\item{env_variables}{List of all unique environmental variables in env_data.} - -\item{quo_obsfield}{Quosure of user given field name of the environmental data -variables.} - -\item{groupings}{List of all unique geographical groupings in epi_data.} - -\item{quo_groupfield}{Quosure of the user given geographic grouping field to -run_epidemia().} -} -\value{ -Returns a full report_settings object, using user supplied values or - defaults is option was missing. -} -\description{ -Function sets defaults to report_settings parameters. -} From 42e37701e421365608ea85ccffe33c46b9f958ff Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 20:10:02 -0500 Subject: [PATCH 057/132] Updated system diagram to version 2, which includes validation report option --- vignettes/EPIDEMIA_overview.png | Bin 296765 -> 0 bytes vignettes/EPIDEMIA_system_v2.png | Bin 0 -> 411848 bytes 2 files changed, 0 insertions(+), 0 deletions(-) delete mode 100644 vignettes/EPIDEMIA_overview.png create mode 100644 vignettes/EPIDEMIA_system_v2.png diff --git a/vignettes/EPIDEMIA_overview.png b/vignettes/EPIDEMIA_overview.png deleted file mode 100644 index 0878b6da51da0bde980e959391a2b33c80af1625..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 296765 zcmaI7bzD?$w?3?bbfa{4hm^Fy0MgPmbT>0}i>P!+H&P-XAW}o8q=0ni(A^>R+vE3n zo^#IoIp^K~Ff;6Z$GTTs>so7vzfqOP#vsFZ^ym?`!fTMmqemEPj~+e!jD`aI@(sOi z9QZ@(F01FR>0<5fWd^l+BxUJhZbhTuWM*TfVP$6N1L?C8d-Mp2$xchpT~9?>#KOgi z%M5W3m$#EE@bsfcVv^pjW)==s?lk6BHg?Y9bcc>jETDF-?shKDG>8$+%w0U(#p!^R{<8%q*Z&Ob?Dj7)0RrRpHgo0X z<>EnX>EAc1sQmxm>g4pFyWQM1tp01g|LeeRT0X8;+!|JHE*?+|;NYz35mUK}$Uv>k z++CnrE-sG$mf{;*7k3voTNhUv85xAsglSlG?VK%Lyxds-KBJ-{qTuZ2Zsu%Zr2rDA z14iMpv$GTt76kEtc==?d1q1|md1ZyA`Q>D#_yu1G^9c#c@bdEf`&p2Sg@==sv-`iF zwfwJV<^IoS5$fRN3d{_$g4%gnS;|3OoM`@TTg2}FUW?5CIo`jXwfw)=0{TCnL!QAo1Se_M^{r?bv6xcZ@s`#-$dM z@G`NqhG*VVl=bm2OUnPYPjDve{4~>C3qF0^L)mJ*>qgIRWG#L(FC?27)zb_sn8a0CO7@(3%*RlPq}}?7 zwI9l5^`)Mrs-9m@FkOr9l8dBlgy*!v{-mSW=>6W~s7?`?0qpU=UwKO5EG0AA(t90_ zytFB{5E6$&haLZ;KDkY`965%}m$X85<|9A-V`O>#xE1wYNb;BdI1$KL4K;RslK$O$ zDH3xw^!Cov&fWcmaQ25isvxLYgqHQ^@S0nQlT>~ zkTD#eN|gBI-tu;Uajalb_?9yMI+oxIC8oX@$&Yi<6KTSgG4Y&j$;&6%K^=`@Re^?A z!rAa)8|(1Cj(1cCx5h&U5JE33WuK}qtu8bE)N7jzTh+hGu&0kc37Jil?s%pcHx`E< z68(=Q;u~Qg*7)8hRL<*6vOegr(&d(dt{qQ2Ms5wE@wsy%T9a%G&`6@yw zd74SN_4p@KkyX_n9;?Gt1%Fq|i)@?JUJlC>B;w_%Qw>pTzQBhK3zJZ8F-(oj&LX;@ zi!TFwDUgNE{<}+P}@H9^4j@Z#|dHg0j|4qDR zI#EmJc)c2$*>37>liNJrx5V~8b+kGWajM~D;)`SBcc&ZO2l5xv)X$PYU}4%R4$k$i za-?C2;VgI7hTl8+pvY?y)mf#LgFHshUtAyI!iGj}$8;?neTwgPvd1mD_e&3ZBmvtb988hvQ4ahamOSmB z$2xaC;a9mjFe9!59zYun_>rZMq$;!%p!tJuQc-&vU8Ik-&l{Dzob6VP|GT!*(d89} zq1S_ydb`?w$FvvW?1^6tn!IwoHsd8@E?rH>lG_f!@}76TYBt8oqUxGyr#;|DjPEM# z|LAeFDr&S;5yP5&w8$1F^vxTao=I_Pw~tNtSsw&EnJ>xk@vW5PTOAHhIXgwor-Ten zH}-5={ZGJhb$sMC3U%8a(zA12wgPE)MnjgbAF42*XQw|N1ZMZ{I4jr3r+@W~{ThU) zMW=rg+q67%dnqQQ$zi+c9dwyWtz-RZo<7v>x&7DRXsY8F& zt0yb^OFg@|+-a9w=Qky3otu^3-3DvJ)(uNCO6yf*F$@n99ys1V?yoBEUh3vtD&G*g z$>yxXUrc=)*cql4A@04Z6>yto&WyZY1vf1*b?!+P5zl(@kXv8g4h^j~r$t8)VD?82 z4#xbL&x-O7LtM7BJb+%@gU3Uy&TMTgrt)vd`~vT>uxQm4I+79~Do`tM*5me9k0dH| zov65*sAA(2m4I`u)@zXJNZfrV_qO|UEYrH;AlqfJ2?=@ z&B?uE>FgoUwfea27~KID z$|pQ#K4B247h)1a7^Jw&-GIeHJvrWf(5ak_`k|d{Ew3K~eMdtG4d3X_45C4a5q7ec zf*rmY3z&+fdKnH*&{yf!CV)nd5@+iahp{uS{t;h1Rj4v*=u)O6vi~G_XIu)Xd*0x8I^qkj`LGiq@B+Bnj3y_IaXXKioM*nEkE{faMq%*w4W^Hh_+ydn&DnJ>U?t}pcf?9XWaol zyWu*h=Ss4W&abcbZI5KNGyY}$i`Mdd!;R%sJ_g)oBiDPPinn1le0o0G0yYL+? zFz5)TH{WB>VWH5whK83s=-2Y&_q##t-H|aj6qotz*t&g=IeoCL^M*RpFxHEfOPR~+ zz0@P*l}pqglSTEvwSwJoeOS-QQglT=d}p{kls?-fzJTF*bC`5&oOm05z0CBn<=5@; z5X51m%1I29s*o?24UN4kTe$X`N}03ZO^IpzXnTB&6LYY0z3{N$wQLwGMgR2IQ{j3= zZE)4dSBACzkrJB@fwZ_%hIP3F$el#RiTv|>Rwq07jl7t3IM)JP11xuAkP5|w{4gm0 zdZE3>SF#@T39ZW&Ik33qVGEbU|KKR5QnNYhlc}qXS@c35eOg!;*W@wRWdN?kLTIUp zN78tdD{jTl;fLv}H51(i|Cp;a6WaDen~UQVq(OgdjUv*-)L2?fs;ZRkV^8&-6^@v` zYYB;z9Y~X&+cy0t;ajtgRX@#fGy}cVe72u9o6v?LDG{D%mc(JVcH)GZg+r6YsF4*xXAhyE3gcJhy0}W7F z?TR|LOU$_~5T{5B^fEn5TbAgh6qK5$;n-Yijrb?3cVWZ&c41F8laP&%2C+GC(NczV9 zdFjiscuUi9hnvpRBGI7RaT;T{PVH&E{huj^*OKlE$GDv0#0f6R64zJK_KqeLU#>VR zERNpA4Dk1C`cqYiC2u}lr8WWzJ{w#$9bss5l18xc=Q$ejm6=}2O#mrg)vb?OmaACM z-KYB7gIYyM->&o5S04K)dkbDDMK>Zx&2!w1t&Scs@o@tf^&q!XaY>u-dghC|=?Lg) z;8BX2Kiqe!Phu^dlP5z(@kP0;J((0z&Ro7$dscc_DSs^Sifig20f1IGXWy!(5}agK zoYPB3y?&hLuki`I`no)s+zD0UoHAoSnVf8x>SbVn`u<15r&Y^q*$i}fGcRZOD&Y>e zb%!M9JKxJ{kv%-#$}GMyZ+9@!43`vJ7|i+`+^fTqzSS7n0H~Z1wj-K0~yqy#* zt_V6ozQ5+waV%k*9&9ckBgdS-Oej)={}|ws33+z2SDmrqH|Ki`&kmUv{yPpat>?St z{lnR?=DW6>iw`4n3o${ykrSj!-B}SpR4+y+hH)nBC&)FTdSV}n-iF*goRTA>4(HM^ za~nLLLQ5D&#y?V4X6b_+Pe1|`t>$~Hg&WKjxW!~5fsjUo$y@GLpxRdKnF_M{qsU95 z;mq)nUNI6`+BRtU^5rRbAjWB_$>|V44rM-tKL_U%K%hkR%>DD(Y~TC6#SIyH*q@zJ zbra0-jB%$djmB#M^5f8=Mp*vefJv15&L6YfC+T_4{gs^K=+|9?fLC+)c0Ow_jkOa( zL>v}XtMr$CH9u8`-Kpf<+>cN`Wsms%#zv}{viH-Z$-;MxjKYhPm8yA#e+02if4CUd zSjglj{HVHGp{xcwsHTiW*HO>MA@2r=%q(uwA9r8O2-U#IAwVYS1dtbKKxgpi36Si7m~kNKJ?bQmH?r-nna7zAX!Ua0HtjDgl#R9<57 z(y^(Or-}yVp$<1S_tjpX9=59O2#LRWqdnOrt^lg$Sly3&@qz;O5ZbycrQ(zoA7xla z6n6>H}o2%wt>hsdk`EmrP*RPvbTd*1UWSB=k%NnCpY9x)KDerUg_7bjlg9v`%$PXOhu-ob+t!qRx3{7l!iha`a3S>%sX~>C+`dGOm2a4q z2z5no`lz(-adN7>`r=PEx4zN)x~3Jyd06L@Q2e-I{4=GpLV4A0?B%t-gsT&I`z%1r zUo0g<00Zr7Wq$u`j&C9PsB$RNy~Sp)o_;Clc&LJgpFaj%^^}Mae+mexa_?wi3xp#P zuohdoa<3nX2jeBMzLu*iR3(Hj-V4s)Sx+ZvW@1SRcBSD@i(;3fQ+)V(%B*I-HOwhm z8+cdSyjW$?I9Q5tunG7m18AkEPPD4G*X>&0Vz*8auBeys7pZW}B{#hqj`Y?0RU+uS=VZBc32uU+lcWJ_b0Y+Vr7fdCnn@3@xk%Iv-X z%%5*r5Bpn`v%_)81Y|vRO}v6rK1*E4O1a}b*x=wj=GA))R<0uDA#wMuxSDzJ(bE3X z^|?og8ueSL@y|5OY5*S3kSdj7A$ixc9#I;`&V45#`6Mt1{DO-R5*`+|rGdsctUK_0 zh8XvrU+o|)ef5KzEIS7xv8L2QM4+Z*9Vg0;)B7Tfy_EVi^ zp=2qbIxi`eZYR54+499$uX(MiMw*_~7ffc-T1c%GZAj4?9wZCHBLdi;GhhjvB@p6aG;@X4OWf zRe#@du_W(lYU$}+U4!2B4?&hshH~!kgRZ-ToU%0o{ER~K58=juF&~kLs%K_7-(^~9K(BDcL%LtjsYtNjL(SC70mO5!-G)d zn}hxght4`_&xZCQL>a4`e6N)yqeX@Y=!F5-2D#OFK`i`DhP$N!>j!|&rRp|tq zQnXIU4mJ)e6|0s-Jl$s+-$tSo1Io+ZPx;=%Dupm}8EZu7vC|JMkAo37{}|9DbSz?? z!ziAVJnkZ_%}v%+bKmn>tLkaJXE|%(!GNB`S=6>U@&kHFM}ftr06Pc=yyN`5vv=Xf z>GkT6j(AS$yTo0Dxh3aa1xCMI4?2%0iJ{rURA$;h=@BP!IqY;hY#0;tU7ilecgj+k zj|71*sVs^b_Z=sheKSe-0e4+%(VSa!SrcWpn`HP#7jxWjTvQl8>r0K2YQK2&g=&pR zqHhN(Q_7Q<0@$5{XfU<| z_Sc%t!(V*68N_y2iAe=>mivirwmnE{?j}Lj;E<1h2nt1R-9fMWfkvogckwaE{8nLOq5F!MU$&Qws3 zk;=ffThglU574|a_we+^NsbBZ3xnnD#V2lYJ>g?$W4u2*^Gf=9VS9mpTYzze#^Wh& z&VZ4P%RkGfKKV%RH!In=5Oz(xYPrdloXDCf7bu1fHW53_Bza4{o-_%Q7fI#22AJS^X|+I2Q~kgJ=pe{R9zQQDO+ zm=vZci`mV5Qz8?s2BT5Ek4TG89Jq`|?2?6jMT+CGkj`@HGU&*ajYVq{SX* zJ@F9Kqy&8WPiSx|gie}k(V?MRB)q#7VS5r@q}=NL(JCO;l=NZLk0+J6wtn5Ta3k7fdz%E5mxXh+!Uy)JvMOPetUhpmBx; zQ?#Mb`>ocA(Lr)CCn)5#J%%td_{AsPzLF3_xM^*!bp1i({xQZX6r7&)KRBDC-{e zhKd|5>?D@LQGU-rFdnXmO5O5nOgHHwJv4p_rx_13T% za4KQnXLXC^4zTc7WKb#MghUQ2< z38`jfW>y2(8QmU%opbxA;NkHI*vTkr>u{tg4M|GW00<21%wVVs7LzVw%2VT8{@0>e z2J|wvwtA`#ubTEFD*USQ>E4OE2GnYPh>Il&GM6Qe_E9=joid^if&D=seJm1d9Dnk^0HocSQ>O$z zI}m)b6=2X~F#(BPaWU48a;kY+$2FUhJhMkb>?ggt=49-@zUHyy|LwGaH-~C!yiB76 zULLdf*~ocFPudx`!S@egx40PTr@s<3(xOv7OvL=X&97%u5tYq=rln9u=bJ(JCIMnN zC-SC6Bg9F7-II4vRuFGo>I0sj%)kL2dClsE|@i)wb4P6GmXKkkC_2tTc5r_AHL&-F6y1v@Sdcc>Zx{-BRzmSaX7!=kEt5N$|K#?f(r z`C_YhfI=S{!EK_-`Qv9f`-&g#_*Wx2K45nw7R+yH z6iu|5RlMyi!SQG3^o_NMLv3E4M5^kJ^lJ6&JXn=>JEe;VuqGU{jE~EJyf`==mUO{J zd)gYbqK8}S)J%cxp>a#t-2Rs0;jH9Xt?7XDTe@4`+ z4Pm$LV#tRoL#1OBx_P{PA3dCN*9`9VV;uUUw?|_x_{u+)rj35lZOLj0upjFm zxVQ^F)SFoG-MhvOBwbAAS~GygIn>hhSSF{-rpe8S^9F}kLcGD{rz!@UWI3iU5dKk} zY_-~fZm4LpU%wuz;XFY=lm@s~___- zBrtVnQ@JqP_g^gXS+qXP<_|eU3(J13sQTU*6Oh5T3bX!l_GLY5J1|0$t;6=7r5#%?E`A}-AKqv{ z>{jl6R^&2fO+v_;QntI(>UBu3s^{d%NLm+|^ar^KNOSN-NkKs|>%*nQ_#x-gBKk0T9rWHiBlg-7p|{Pgh!8ZMN2!1?aCl9h`2*sCVBE{PLnP z)AlXiYcQ!UpZM4N1EChf>+b!jz`OCOp!*#+?wog0vxyc%>Lsh`*m7GQzQ|1yS4~vK z*Lg{h0JN*SBgMxM9+Jc-E2p$Pe*t+|JRw{Jie9q*ksj^lNxud_z@UHRft275H{Yll z-q|cJygWOBJaZ{_UInt7enqTo4k=>Nay6o<;qRAet>7E@5-ymJKet^)Xf|mFwwpgE zlFJ15bT8Jdxxm4qW4JR;HFzE|k&7_Kupg8(zbLMTDpS=p_unowNK;-JV}FZTEIN-G zk9i~?L-n(~m8~4S z)Z`L9Xp*DYYle(7CB)xPe}|95LYe9Rs_BnN#rJ?; zVRNr~ysHY&4tBp)nH*;8RH;^ncuv%AmU6$9Ho|M>VbXVdoON9l%%kDqAk)V3_bSxK z8N8pDfCZBfuN_4+_GLiqJ_uE^ z`ODb(7Usjzb7a*lxolz7dZx%9zv|Ycqr#403#laJngr1GjZ5$4Y}fYP3m#Gg8rz}^ zhukqj`aRSYy0KBE(fp9m{GOnxT;Wl;S-38-zq~3woMvjcxlqNz5`b_M;2XJr%PJ|% z@)VHzMM><(3@Zs9x+5(^Ud*D6qoq?q(v;`C#tB z@-G*P!-vxH)RzB=q7HF80<*g>8y4wA$E%ej00AQw%j|YufByc$WnIYTTt4$8WazV2+qsVz zWWqH-18?v28V>`7sVG9db2*KKgb;A5RtNqy^Lio&iT3p?XdM#u56{(0))8cg2m;B%uQ^bw}T4dB_00AH**)-!P-c>*C!4Xg&LG~ zV!k0UrtayJT*9n%!~sY)c=!`z0xz}Mfw}P2FFHR=zr8%O*AgbeESZ{H`ED@217m;t z#I9M*-f02)!Wpeu-013v{M(R7PefMa##2U? zh@g{^?^JsDkwIOyxB1n^SUA{f-QwZ#P=H@RU?y<9Z8uJqap<|Wj@HcNYi!rV#}0Xy zwn+^GWo2!-$%5b(F5;T!KE#v>0CkysRb;F4*sbLKyx!>k+57oE%lRd-tKNx}iZWl= z`2i~amP80RpOh&CpD15JzrV0doRH97+L<3;X!)`e4(&WV{RhIUCx<~OWq2i6b!SN~ zP?Ofc!mPxjqh8j}oGx#%*va;yi*m%POHGZ|Ro(1z5%`@Yf10eyD3^`NfKh4wh~Am(-i9E z@*fLK;7pg5PVB&*zmh$Z;8p{b!fPqp9RxSw{pru^xLlhOxGofkkqRR|yw%T)g4qlQ zX;VNWa>ORN&2O}80HR}3*5x;6jc3uU`LPvcN6 zN``qrgCOZc(*<^&|2{L&c%rSHMDW1BR;p$SjtP=8KOPolq@6m%WeEGXD1mSk$HFQk zH1#fh2e5SBQb@QgrD0r6X0jSy)aTYZOzJ?34^@sHLz$Tjy%_b??vgTm+&$%(tX#~Z zGTI3=aYPsM9(Ct~y2f6ITZG&$hYu4uW}`cwEPk|E^3e3yew1=~I}BGZUG;5JWCYi+ zl`GX#U?9Vv7&EOR!lBjFwS9f%N+|0Dv=bk6E5#_K8x{7Oq|?6vQ|q6d#lI^Wa8I@E zyY`g8Q4)&{hGU|jB|3k-s1FvlwN`F?iiV+j9BydY6VD9e;uwdzN7iw z>O9_C^uh2M?}gnw8CuA=;C~4agD((;d4+c)Z6KH576C~r5lT9xeXzn;kTa@KX?u_P z&N3&MnbPB0E#hDLe@V=DIiIiE_&b+hj=ar52}i|D8fd*9q1ScMcksJ9%EG1bx2C9< zN|4oB||7O|J{Oe$37T)guGX~Cb4~sizQ@4JOJt6CchXGdQ||vZoO>+k86pV)|J0O zZBcp~4!re*KPLJ3-+d<(S*e62Ekfyi zV5!*h|k0qG8;J57$&>rMe8(tU;Iq{-8x~+*gbwRZK%G zQVJb__TUn5IHQ6-FPRjq$CyC>#`?&)$$a8qwWDc6_Fh_`*U>so*__I##HkkBQ1ZU2 z*`{E+hzMKbb}TMmBG?Uj>n4~SCHgLb(g^LT3?H2O6Fl}GaBm(DVn**Lo=8A0ElBP9 z$^=gzSFOt&nVMzqVU)@|IPBi9(-Mx{^zO#d=`Ca=Sr~>%WJq;rN&Wb~S>DLLRDGT9 z7aHVedb7=Z*;yb&H&pjn)iIl1z_S*Zl7>W93(FL{cc{zu)OcwgNP8-F-G=3B#{A1z{Y*Vg>ut(DL zRt6#40aiAtjs)arIV3@?nKxF3PeYBeD)U)Cd440$(7V)>2hy*B8Dnb-B%H36VIzQY=h2`>qid&0#ckoFu;L}soQh^>;7E9C* zKL%D==Jaj3J%FTs2%0Kh@Iz7O7hjF<14kRRRVPg*Wu39uRzr3n-AkDn=+# zjQI8P9rhs{K*0B{JMXDzaxY?{)QrtPX?9l|zgO?ZE&0(>5B{8)zFg7b4Go&R?K8+d z$_>f6B6{!Uyq3n>5 zQrltFb1C4`XhNc4m7e*}yJ=rp@txhbWLbZj12F8Zz=a~^Rm2O;cW5XCYX3xi&LEE*p-1o@!)|e;1>NN(WV%%ped03xA*4bc{$N=D+5|F^D z7{G2FroIHh3B}_p5WTZ`A81u~3x6_h%XNfZg#bA|nu<66#ns9-X~%ugbwk-c*fN)4Ne_5S}rXsov{bxT_1Ps0X%yC^R3h@4?|5%yPn6q zo9*FNdwnJP`CR6|-KttI&96){ozjWV->Q*u4C_U%U6-D8i&Y8F@aV7PY%|j{DK$*c4x)$qtughJKuIy@y79c_7^a6JV|6a zNE2}uzSc9TzZBJ_*c)v&n=b2#uBc?6fDGgby##7XVX7XUaf|n3X!2h&O^2>R5wj)R zfnSJIsjCu<_cEiG2Y2f5!Wr6CyR7%Nx-s0)rd+uG_}f8@-D^~ParCoGJv>kYD*%Paf9LJeovUm+_gF{?>I57Zfr%>Woa zE@wKBr8AJL^erK^i`Q;e(GvFZotTI9!%UhsTWfK=l_XxS3Rvtu-&NN|)lwo~L)Tv~ zG0;TK_xpp2AE7cqc1M&W!t%Gi1ahOMP*&?tdKl=dY~#}Ht|2NxT5>?(E1Ya?)RtH( z@dzOkO{_WlyBp#`B?aRv<^?R;v>}Rk$BVeW{i*q*FWp5rQKqL~PynZCTp>YgO zck6~yB+`g~gvy)G_HW2)t=@O$&EQ%2)%F84{&VLSbvQwpFK+9&fe64YI>UNUj*nZt z_6$wbzl&xJ#{)irviFlr5i=$? zAH9Nh!|!a=4K<@13_c60-FZ^Q8OW=B6FDHQ_HyssKcR8v5pn(}C!k9|J)&(-{7x4A zwx+N&iA~FsJkdI2Hdc}XWj5yZz@(;L7PtB4x@=Ab3+H?t+UjS}z;@jTO%<|{)5j^B z%mVK<%O$V--O9yL?Vp7JCi$GJwLo(y>f;HJFH`I_RLW6}1Uf&h{sj&=*rcijoxxyp zezNaFW=X5@&+T6vDAGv!=7hj26Oe(jLWNQE;4ak5=Ei5|N@wH=YE$22VM#;=2d$7c zw0wj3;SOF}_e@)C+;dZn26opgV3=qRv(86n3PCr2iB0rC5@w<3v=x_kF5GEa#8cX9(#uOwu= zVfR-}$^pl>N<@>6ZFtWnu>qxht&{J3c{LKJ(b9at1LPYkr+h#e&biL#SF_7W2AjeH zq;>fNA)1upB$VW8VkCn*ZxB<0^wCM*+f5Xihb;e;Wk(3ORD|)H3~sNiu^&*X2T@&7 z1$(V>NZbTt-<0%YNVKA@W^2uH^P`Mflc1{9E|}cTuDALJ`bV;xb~sd&f@JQlOFG7E zP`7ufL7+@1o$!CMt-k6GSpU;9osb_j4sWbV4ewB!yU7=Va#JNH>w@gUcK=5bR8 zH@@Zk&1J(R1QG_^wIKqpGowVsx3a_r&ek-Cml~Zx-e0XQ?|%Eqd?y(M@IgruM8*33 zlgB`2(6g?Q4rB*LiYltTS?N*iOlU5$ADa-nR5I`nQq4SR^_O~25<#wZqeS_3ql#g0BCdW(+&=u01o`eg6Dw zDN=s{Hk2Wd!#|LxL6a(qiX_qeEG=Z@U+ET$Qu{0SEAT(CNqA{O!i2zr`VY z{`8Of$LHs-RL)2=Z$x>*fVFO4?Vu zy&f6EJqU2v3{Y#M+e%`Xf0rq?md?SmjeXQ0e#90IBUGe2=$cNA58H(_CfV2Ly%ZO) z*f7CBIQ*?qyrok@csct7v{?$&^!UAz@%wQ}6H3EK3VB$}xWIIva2^QhTHv?lIMP|u^+yeJ2P8SaAk9U3EPl(nNO z;vf^FKTEyJV>NraEp6q)x>rk3{1~Uy-~$^=4I+3S41^kd4=f|Pm}np`n~X1KmGsQr znOCOvLM9mA_+%%>KodZ45cP7`)No3u<65Jx;+y}nwIhL z)ZwYZV1-s!Qt8T{b*3^+_Jghm4^t78zj~WO#akZ2h6_bYn3Cmv=gPx!{=5_D-2vWF zAt8dS`n7gMh|I+tm`F~g)s^o}c98k;0nIy{!7vIt^W&MW%|6vs6=9>@9?AL}H?O;D zLaRv+`xnmWrip@4N@Z|mcb*0ZEM_$iGj~U^pQilu?tc?`VO&ZA74*`P&rOcl0Obn2 zMdPzPN7O7Y1QeNSYXi4HxDq}}ow5D8oBN#|OeobSrWITbWs5^9!S%Kj(2pT)P#`Df0Zb zO}eVF5T$Pri7*r935PJ?e+vezk&}?YbsFdZ%6&Wq=x*GuN8`$A zH#3~+4`#dc-Najj_HGQH`4BKwME=DLCV2QJk7z5X+tG35a434%AC8gcj)Dm| zr_b~FWbv1xFG_I4A}ON&X_JbLqn%0o&d6B$22s?q*D8f?JQe!aUAh z6GK(((O*Ul^h@DkeE4MR`ES(g50BrHE$(ARpLBEw7#S#-pgB~@p0j5SX8BC&5Y0L0 zrXfJriEW8^fy10?^d4xhz{Fqs(vbPhUX^Lg(!TX7?cuwp{Ob$ zK6ct`luyNeABg-eiMI4xxO(yKbJ-2?4Vh@*MNf0ylmpO1l_yJzgrhxwLc9+?*pXj-e}3^#~^ym zqduRoXDMg3AQ|+heAs`xJ%Od-dtNS;tzNM+TL1B|9zW@naIhxj!jW$Pt2OFBt@n$N z@Sl!yvh`p}A>C-DlSgi65~xE!CuCzo=2d8GF{q|yS?-scxGLq6NP69{{AzoPC6Yhy zSOPRb-j&kdK5as4mn#<>Xt8J7UeEa13=-;g!SlLKx@CN#FA(%`K} z(na@&Ef61V$_9JyAOo7J(4*A7ZyNircKhT}f{y1eTE#}Os=j_`x0NmzMzzkzm&ZX57pA*O8ozOd3y_7aaQg z+0{)PUNvL)rU+gYc=~gQ;4Q5GERLZ9>P|h{ozI0y{^?Gecw^R`_6;%| z-kwexI`<@^n$ai%0`;Yiak}uLpY&IeT;FHZU10c zK&J`b(CWLU2fte{uXSEaSLPv)(%@@n5NOuHjGZfEf&(xC(Gd+KXfiC%BK%hWp}|1K znH9<88T>{sa|+1O>Gue8(dFNURm;-1?TbaXrOtg3*d`y&+FG>w#~Hmd_IaIEFwvyj+zI28KQE( zyrAa@D(XhbA5IB3ul@%$)GV8AEPFYZ%a%!74Qj?i_GRrq=n8wd2jzf)E-e=|;>F8Z zjb}T<0gv=E@6YMr)C^&oaST+WbUv$PadcD>8Q5nQ55Aj}CRa=cETWizhKCUU~@UEG%)E@UN%E25=s80Fb|7v&-0P7g%3f2 zZayhB{D!x*IaJtDX#{D<6hy6S$9Q|IDgWqeYx9C#yMFUN1z{fU6=kWpT z6hGHfvm|jne?t{GSyK$Wxiwcyl%K1ZMF}DjrLF8_RV+ibk(VRL4(t6##J2UaOyR2p z(Q?@}7G=+36M=x{5IixG4OP-Bi}BNoP_k#o{t9Ld#N)HsO`R{@lg)r+ez;Yg&+T|)_S&Y zswY6!&)Z+oIKANNG(eyvMcJs`s}hBJ$W$l(`v56n8Djhp9CJ`tZ+pTKcJvHJ-8UDC z*`RTqrkXF|K>db@MTa=f_e;96L4&MLRGTUY&WqGtb=r#HmFc-Bno_BBr^CZRwTr=T!BYB$XDsPI4(pvprH zZ%m)f!{C%2!-*+t5+UOPu3dZ0Z%L;w}-#cd0# zyt%ssXe$DFy%I9-gT0A|H2R_9Vf-A%p@VwjA@*qS5z==yBVxWgsjEK$>-y5oSi2=I z2lTPyc!zJe@kE@D{Gx#-P zp#PtAcm@+_;c6bn4XofYe%e?@;aRF)7L$Rx_Ig)b!@((~6#fSQX1F>288xL%43|s{ z<*yirZZH-7h1LBN*<#YtGuavHDdP%`e%A=K*iB6ZiK96bVxN1w3MlurV7-;_w>ZNFw((%C&}0xA^^P`y8iDK#uoy)dRNCYf#M0|KsTz!z%s0_Dr_j zWVcj7I3=?oD%0NLX1i4vqlrVn!otempfmqus&aH82huRdLwy`WoL5Ii1YUs3~Q z+b#3Aa`;n0nS*j{ey`%9M}bJ(fSLb{I?^%YSY}ol&FZDRhC&=9UFG$}8heo=Kh%#z zJ9@F5lfJ+hoTzGXASU*}T|3Z!;PcjbXm7&S%dSB~lt9UF!ppy12i&6`r5US1rqtzrIKqo2F@LB(OS?xy;J;AsMW zEr!1X+e{caKsrV*L0o!>{rFakx1e`kot}vA!v95h89SEM5q0JyF}$^)I@90w zF!Sv6rZOsksVQ%-tnK5Cj~S0=*SV{vr}8UP=vjwb1AMSs?i-ueXKu-;IMkMCK{f*2 ze3Z(3Sag?#(|T3?;Sqt7LIWl`f`|joKiQWWzgKie*cK#pBdT+Jm(gm+1c7GVhJ-Do z546?@&dr0odHZu%e?filxrSLC5QJco<5=%sSQedOwHO;%yTJe8=@hZGx6E#51F@v9 z86C{igSSEAm1-|yY+j899<-m(Qk)Yy@-Kivs$&)h`%8T=>3zupqQcNz)Y=KN?9{iv zYKWrF`#&!CAdJlEY*pG(zS?HCmFQ~P%QOGc{~$W+VI5WF{Yu@gN2#i-qV@zGD~>+9 zD&CV!Sp<)Mi_{oo2Td!0MgjYQchq6ca|wX{yvM-VM0EfI)StTy;;u5dU+i>6pSb9~ zYS>}Er1b5Qy`oG-in?~a#>=Q+YVLz+E)!z_N$M7$=E^W-uIoB3*r3}{-OfSNKb?Ga zA0_tdnW4OM;NYQ?(RCXRD(W?49;|rbZ&V9N^o~x^kK0Z_?s8N=!&y81KAlTC{J%6_ zVi6brN|Rjq4kcb8R;=fxj)nKp-qJnaZ2hlUji5@+DxppS>R1jrsk1{@E9TV*^x`(V zr}34*fawYZ@sA^zSY&53l-oQXhYeAoUytXk3;9JON+)OxM(W)T=_h1a6B+OiA%0(X zXZvy5)7_wp!gDVuurwIt=JzAPZZ0d5E91CDrhTW4^YrPupI^&RKjeugcd%5jD|HwMqD>(69sZ}xYn%F~)jNNJ{OeXi&lJ>OrMVMN8<2iVn=`vOOEySZ z=^cr1w_SfxaolD$cRXbhH@@5(sF(hFmGjsZyXRi#l#U@wQDg04^M01z-`Py?I2kZ4 zn?v46TBZF{A{CJmB*nFC?8;o1ES)JQ*inI|&3}~d3@wJ~AO>0^iP@9|m9`;#J_5RT zZr%{Zm!TbUCey``*;M;q{(%?TI*j*W9n3f;Ue|)3NXMK$avVFk|Lb{-Uo<21aEu7E zm?F%#iacSfi*m%3U0j~S1k1_ObK zMzVa$T@Zuwm|5ej|C%`Rzy6?&h+>B14$qtxsioV7hoqaWg1giOr$w_NLMXhtRjo06 z29owVt92thC(@P^YvB1W8OXJNg@^sh@l7rJd4Bt|boJ!1$|M)CYL|yPhg2vp`IwECytYrADD+NgP3EbO)ac>^jDvp8owm0^TX+i z>fd`yLzj!`3xn0o*AatMb|{=kchKZ@4UQc1;cWt@ofo04Cu!AE$TwzCx<8|i_PlKY zWwQ&huMO>xEqyd_zEmVHc6JZBZTl;o2sdTumM0!gx>no8;UwO^ljUvO=n{6b&mL{7 zw;-Dtc!MSnN?Qe3I#2lSsJ*vRR)Hz z?U-Xd&9{oUw>EbmvoJ(AI@hx(^jdvK-pR>H0Ysf9mwa8?9;p(R&7U5NI0A5Jw1f0L zkA6Q`37l2CUc{~i;5Q|M`rhvX-h5~fBiLJv=<*W|Bs11K?f)NA<(8miH9w05fmL5n zhO3BXv}LA6Y!Q(i_hEY524?`!VdSx(ufDkBrMeRfDc$!mA)feyIfC5Jx^7_IG07PX z@$yHu=T2C;B`G8_!P+aCD=*Zy8GIv_^jMRxpmfK7WwH0R^4s&6_+z9 zv_WwX>L^0tIh`laa#3X61!47IH`EpUCGf+NE@EM2aRDhep&-?U<%{1?Nq~fo`}5?^ z?dFF)9JQ-o>~eGy#XAuc^x;~j7vKoaz}Al{{F*4_IiFt}d44hPdi`yqWsRf< zX#Jd$RHnL)BztzavMhAV^#ncn&D1e6>A%SL0V~@-yvqjmrOAGNp(23n1Mk`hk~KDQ z{IRnXyv>Kt@isqWZJO=ylFEr}pH_EZC8(Y!zQZxg$DuiAabAC^Qhe`z=2g~p!NoiF z)d_G1PnqXY7&gu&aeP4Pxj-hKfergORbs#CzxIx6^ZNSx^Qk4K$gqTIM9DfHKjqHr z6nQ&YmSdarzqagV-J2gTVQ;lA8(@RR;qG$+9zU_p+=(sN%|W$DK6E;^yS6-|Lw7%P zGl$~srO|_|31)nGX51(k>E6;c{wlShyEcARv=3R~tpzkEyrZF9Exs3(k=O1_=2(86 z__J*;!F3K60&LpaiP+wYsODjL)*ZYNPweg9{!jy(y4s6lZ|y`z^HZ~xq^T;!<%oB# z15D^86U4_Kkd~32NM{&DjFu=XRK`$&N{kdkC*7LeMUwGKz< z`<|7JjBhCE|67|nOh!3^(`=r@PEtYS??n_fYjP^!r+^17i{YG?Z34jPt{5K+V!(|$>p#h9aF{=;X zuoDk|@$h`$Zvq6i@j-MTNWDA)TNYbF&-xpt=0_c$BVM-R@Q^*$-F*-YiblPsobh+N zLSbcnHVc3SDe>BPw;$0cQ2t1|?=Dku;Lgnp1~LFJ+5#&mEx}L9UWBsMg8SrTnOIhB z-?$cm>ZZ>hh|NpvnygTyHKDHFgL$t_wL3I|=>&O%uT-zRn(}_n*(00PbD{eQsO@e1 zQFv5RwP{?w&Z|{PiWr5e5UC@G=QiRbm9+wOcaq)t>vC6aB{fjKFE?s`g)CPK~}~?)`J1tXepdgbOHS zC$Tf8^dG!X;f=Kxl5QY}JK?jk;rbI;EDGB7keI(>mQgoz;_~&QCzzUE# zt!UaUC(`qe>YeGsquJ5zX|ylX58c~9hvHX@Tzcg5`wB1eV^dlE`#bqcvbhyi^h2!X zmtp5je&PyF*z(Ba;9y5oiRWU+PfQHc_d$h1G)jH6)5)NpCZW6^dE+87Sf&Zzhow6n zWKLa2R%hP@G?U3jA7ttnR_bm%1-WNhk{z8UTQz~LKo{>RpG~*-m-rtv)hYZha0qt< zp>XPCd~#8Tp;Cb%!NNsq!fQ*=pdrG3UnHH%MaBVw=`b*T7Z+V=&GinkWkx#Tky$2j0t(2Y+l=61h^l>ZCe;GGj@-oR&OH-&`9pN<%jhgj~NC z)Z88Yg)znnHo^(MVoSEiRpM>mhkK~(V{c5CS4 zi}mO0EtFqMBs`>WamRKum?>hdAZ_<`^|P|CHjwx(Wbfeb1E(#bxB zk{%a4$<<6g%F-))LC~gTo*JpC6D)lQzTY)ysU~FMPXTv!|9fw(wS~XGtuc-{d0SC5OFfa5d+`h{Z$#Xmh15RZ%i~R~CgtF` zH~6RwOIYuvo8m;TP@H=>gsSvCG*sH}=t-OF(LTq_^S>URAdViTacgx@6N+;SW!B_r zQtx+~&o#ues#$sz7m_7LW##?1OgNOp+W~#nbs0)$pZV_B{1T@^?_JlRQIL6Axxh!`AVAlQ6~DcVWg|n%Fyx0kG_#mb!8oPW~s0 zp_Bu|TeXK_$z=AW+SaM@Tp66*Iiax%7ld!e;52ef;&T-{s!#g4I zBmsh!eUWX4Ya_2`V!Mj{Ou^WAM(Usgx)kCnrGS!g@{;0VA%3#OecN%7EkX+c$o?b3 zTMhPtqpT^V=O-)ycoxtG9p~=RZq{4-^KQOjUuhO`m}ptA9~R>|DLmU|JrMhC*qbdu`N;y84Xdi>s{h`bxe1UfBO8vo$XGdS81A^I}!cQiv)8w^yvtTG6`@+~~orv(2V*Kh$ z&VhMp1{<@cGO|48DMl(htS}w-dDNBaHa=p$s@#+2`ub(=Iw%J=#ODnweOGSyw;)>-2e+(V5p;O3>|-Bj)k@L zjvhX7u*jE-bI8+u6vdC{Gb}Dfzj&)m5*kI28#VnjG1YH@qbv^B%KW}>Iky7#4PZ0? zEK~X6*8*~Xz>WF2;=p>-lz?c z(jRz{em`}Ca7r*G3Z%b6?NEpQx9zx7cH)h+d7*3*%qD#)>71k@Gx#6FKj(en7d~&{ zhta&ZYxhda(02O4>+ow$#nq?5;$YXNBG`l06#mZpkkrJ27rd)eu{@I zzo#J%j&e{VaYE^XuXQziBH<2WPLtccb|d%KfH9wr{e95aCdDOggFYE~LGU^9fX0hB z4#nlD-i7%40;#eoFP79uMxA}07LQAc$r>X5jN#UhIo-!TPXoC|P@9wadhT3@$+7`P zdCP%_L+9R(r(EG1&HQ;Y6}op}Rqa4U)T>(jR!ZDp6L%@53doLP(1YMIV0B6oQp)y&-8oxkwM{;0)&Z6Wx|Wh58JvEK=6 zpEe23;_F;oTsCPqpq^bQnz>CAUU$t1dzX;GQq(FH>7nBHT6P9uJ7Ry9oi+N~{^X|2 z_bbPk0JTf{9(7@Z$dl`riDp5&DKei@F(V_?WO_JJX@4(Kra>Vu@`0jRrU8*C17qU< zeJr;oX+r%~n8RXpO^s4v5jlw@I$1ct;n!#7KEv2C>-QfXR(3|sj}zTxt;%5I<@hPP zWBWAmYny8e;ZFE201D7|gP3XMzOS3m6CN*wCCH>|&&nz>Hp!1mjt{kx52PNNh=w!{ z1bPJ4DdO~}5U}QVbs-7rl$TD)$LJ$2!P;bue~%Ix7J@@&iIe=yPzYo%f@m?wviG^$ zDNnKGwxUOjQ4o?={vu-rJ{N?@hA!E}pO4dw1p2M)oMY^1Tp<^4{jYi;I8+T#s%Z0y z^ouBS@hVc|wc~JtOA&aAW1bqXi%Le5d9`64T_rDwi@P}`Y_HXUK-FF>9s3VxWWS@D zu=Zwyx3#|!v)2ZK*V8%Qj!w}BTaIg(#X=-W^;*m?rQ@S?^Fr7L}( z3cU6x|F+_W*3^tFGPB6~9VwUT^eKuu9q}-X=j)fEhib_kH;PBQg)GlS5Gux%1hsGR zD`ZRZ zfQ4An&Ubh-8|E0cmO4*Y*B(xf6{i@Q#Q%CoWJ+FppS54^D>tM{Jla5ze?Csi*dMy5 zAp2V!yTe18fxw@DhgDBdOXq+{Bdg-2AK};BwcXMOY?Juj9Y*TDZRxvY2=D`zx+JqD zTvPF8P~-CHY)oAP?eLKb43M+3zW|)f2>{TxQSSXUWM+p_GU-rjcM*B?G67#{zd!{T z_0c7LF~XFgurk#7^j)0JN|=~S9m8D6sn;qMTD%q=7S>_3NYlw%prSs(5ByHaO5jt* zB-an*kA|*Sdjly}H1(x|c}L$)CJo$5f_^pH3+G#A*= zENu~kK6{g5*!ULa!jOLQHZ zXPq7AejER4w}$O-wd^AET4(qHVgn^8ak4wXVUUqUf6Abl0f$L7LuKuQa!AKy6=dqX z2=0UYi&yag&y7bTph5)s*NVU|T2=x9-hQg_?Tp*k3E7li{!kjSXy;WPSuowr`p8Yu zsr%t?U9yYI+F;9eT&PkAym(YiEc0Q*s_=Ftp+o>G`0Hzczuqfzv2MzKQ@!f9=U&>9 z{629%pjg{Zo9Ht-9ya0}`%Ui4hBJc1BD$z44*dyM1cPxs#4vY=7}?%@c{(BD{&xyy zAi2=hx{sgDSs`z#1nJNMhg1H^4Z6jO{U?2Bx|y!sn%~c+dhKAPblApE{$M$qG3&0H zU3c(St@p#88YUpxl1ekFZB%7a_pev@iQA%Y*n^tIf~oMuD5cu#`BwT{dNN{VUn<$Y z|7?_A1On^#U3bH`#SGr6b!Xdi<(;$M>$YN_D|e3{?q-ZwOqtO;df)H{g+zXwI>?FP zPp>cfB{wN(a_T9}jeWp2Vd${P5dZ_cx#eRCQJE;)5k&)9f`=zr^| zXH+wHCkU4Kt5iC!7O76QmRAgUSZNR`#962(p`q?tN*Y&8a*uiN%YNcbZ@Q(M7qh%Fu$-G&yY?+eC*BB_ZspA3JC-gk_&yu@E!#1j&7(!z@AC@Hr{!&gy1n2i}nh zzOz~tKcf~z`|_~KISx}8F~UMMczH47Avh~nMetS`U^MdVk`Bp-1v$O`g$aYh4$A6< z;qDD)7zu7|z~Y)`HhMN{FT*Gs&;t1Q*G3PxrzgS9X<~_9T`Tl_%T|M47;7fFqs=~B z*N=XEcv%(qJyG!S!l%vlQl*C|5;wekbP=1Wq#7x$y@a+5HW+4>yPVZs37n{31c);u z>{cshN9b0` zslG5aPUyzjN8{aV3wk_Wx!ImACL?L(*O)q^g$JTYu(s4f-m_KiMeFLXh3-;W2I5S^ z0dFfZeaz)=K6`iL;lC>lMQH!W*~zitR)O60UsdAL z<1Mgv;V3*VF*|D_0LVl?Bm*nqT?}%bWi({gIYuG?0rtL?dqaZICYSXO`+-d==yuuu z>TT6L*W33*W*o+3sn8Ny#5e{j9E#uZ2Rye%rwS zx=|1>kGfBk#dQ%c*jk$rBPD5h4hNb=q5!q*yPJ^6cp*>dNEU~;P1ULMjW40cxhvEK zWA{V>jwalbhxy0u|cuK_sv(_JW#tlq_!Nn z_<^v$>q4;L$7aVXy7kG?ze9gy;ueG)Q$(4cM7ZOFxtHbey&ADXx0&(#0y`&v3_Q{DG`4Fm z5_bkYumDA@9~jV~N|G`bZC^qnn2dn}w*JQC)PG&d_ZkZ)sIEB)qE%ylX=x|;UAl5g zCaj&Jr&dzvTgZCpW_8Gx3$p3Hzn-Fqeu{LfJU-!Mi`iRvaho7lL&e!^r&35D=})Cd zd_t^f=IvS#3ve7HnEq)riy!z+4Zc5@u4>fOe&us1*$5UY)JbNdQU1m^F^u#BieBeA zxaCa&i0?5-i-kDLeImKxNFfaD3Xad>_i`TI#Aug1VdmBfBDz4}k#@%7H$~a?qM*7q z^zb3ZWvIxSyW`x$#lGYOm_aA_JOpLPMmx7d-qJ*+#KQi?b$%KoTKggj7aeXXvG&(; zLHt^jrL5JZ=Folkc5kwiI#@!t zP2IL|39oR;pQLU#Y^x^xqYeKU|89z%@R(otZ12ynv%z0V>Vo16!1{tJ2|#Kd1eeYt zQqd8@dFPMC`1n#;=FP39x2P?APZ?Yl149mM`FtkmN(48zO`9wVXS&+P|W6m(FN80X1ws{UeW)qswA8 zd4Doj{!-IRHAetcPqleNO(@%WZPeA-v9QI+xF_w)*NAya^Z{8$!sm&nGw}~aV46Y5 z;;_i*t{H}&`!C|9+#uQf8qR71JQOwt!#@osuLPCw7uI0GUZ||U9@^Hi6VG;+LI?Zd z-KIW(0M$ni0>fdJGH4{RMvERMEd??`g3HLAr0xxuC{y&99n9)g<9rK-%PJOkVp>LZa;--#$c1!o`jJ86SQMZ=v;>Sg{+$w!h*=Lbt`#Tek3kwC5K zN*>8XLl?xAt)`oYF|;FL$)qE=3aziZ6s#ITYpXUWVThKKr2?8eXI4GN^KEXZ$QEl= z5r@PzI)~PE-n^Xzwz-)tIF66yP`2&l}G?WrP|Th?75bHtZX} z{*SHg4o?eB`u)^#Or#!S7>N;g#)`!^$4-oIKk0I}A7;<1EJA8F%uvqBL2bq}A8fIo zbM8fXcFkD3#R4D2MQtF>5z0zUk&%W*hvMp-zX;6wqx{CLc+Sbx zJeZVOKEMc&yEX1b?e$+TT`cH?F7vhZ*Q=(Jis@*-v$?4n<3;9w=PhB736vBQCcq2- zXRZYGmT)dZwgf1&AdxU)Cd_c@g&vdSYs$w2ix6;(%X6lZC|CT{Ax{L%6!KwaIShvv zOdc+3k5@#hi6$kOVz(%OVH;uZjC$yCVd4hpignzs@CI|o@;Lk%?nVq{b_VG|fIGjf z-`@B6!`)dLfEP z#G|((ui@JFNptoenvBnd)wQpREV$AiN|Bk$;3Hg`uF&d?^v@mbpg4KCc0I}EhNIHI z=2mH(gq9Y)vlMChIGmC{wzTLH!+$=DIjUP1aN+Wk4>>8!{oEC+{NE-(ulXYkaNb#4 z@%!m4j06Wi8=F88xy|ZpY7`MPblG_?eQ|t@muQh6i(~zk9P%5b>FNp3V27x*`;M~d z4g-3$^(=e}lcD2!$oySBWOf!(t4=E@U+OuSv8-D)z<7O?k&UgXmweJedQfOw?E1zw z#T9cmdFlR7n5N>lnIdoHI%e*4sku)jyxC*&X(#d~Y6}n!w!fNOJ%`j-VgS2rDzh z8pR1xc41I6=X#MggG&-qlgj-lSqWC~LMfb>VJxs@R# zyj2WbU4>R1yVijGVk=@55reCnx2wrT{H+%`-SqUhfSr81L{qT1fFxy0urf>ONXx#k zGMxsOZ2M7!9XxOVIh%4UZzUC#ZdR|qhmRKyNT(hAhnt?&U2F#BV@@$4o3mRUEQ3a* zBKM#^jycZ3mr%KN;{;*lDq69iojy;DDQU@Ql$1Sku!f2-dMd@kGkD0D9Ii0<0|iO< zjx!Ai&8BG7e*bkE^dG-@fFtsgqpf@H2vW#a8*cqeSg%v&Nim&mr}M)(5v1$Ohd)BY zLPZ>1$rDAEmhM*vo4q3L>hjs?|1PiKAZn z6tM{tF$v=($*Ci_8M8ZO-PPjoezkfY4vH9)_REE*Zt>qgQ1F*CDYR^^0|xC|^52d$ zoA1NXXT%*ySvZMONvv>CWFiPlN~z4L$DJ3GU|cGT0ntrR>z?0-?m;#XVV@mKmGyd8 zpt*})P>8G4kx5)c3i)r7m{)u6Y83|)(PGT>3b90t&$t0Z3dRTNtHLhpZ4zu8&ArC8 zeJhyQ3biP#fQnWwQD33FC84h?#@K~z<*VnhA5+l zpChk=Kqd$!!4zSL5+%aS?vFefHQKJXcMVeQPl7H-;hp|g?NQy09n_5R*IbG~-hR`I z(YhGS%hPzeq}f>$+LSSd_UvPC%lGttT_hoERZ>1uxZ`PNnU2N;^8a5kXw*ouL-F>uMSgp z`gHC!jWZd9@^AU@eA~)_=!T6j6Xhqviu(b}xMPY&j?9+hzwL;ua3&aiO=Wp!ocG<#y7% z#LFw<@#WUdt$#D-xa;VZpR2JNEXwvQbNcB4qV@S_m;I=cVR~}TdELfLN(15Vk89n%=UwHet(qfOePnN?1gjMm zU1A=VPz$@Z_2JVC`ThGvHQRrErt40TMVscM&rnjEc!9RcRszh@66{aNjuzS1)3{-v zm#dPYy99P{pIaDpHrW7iw30qGRT;=!1gY3ujC{D5mx z_vPUOF?9xdDKQY($buk;@eyv~rs6$4Z*gk8YdLr^9hXMFA|E2K1yp%_*|R3eZ(f#U zG`PmVr%A4A+s>AJTlEcs$2J)?rU;+ECpgBC5pNfb^ngPoA7a;K9>-i7LY)?K*bqO; zN70CG&*2RmivHZ~McBIE)dt|M(#s}oeT|0<%a^SZ6ioP6aws27(21RO*g!%hGq0cs zNLve8h2G>BSy4s)!mw0uqQ-juF7bBnR&OT2~q z#y$HayXlX*DQ0hWSZWU^Pvs%OiaLsslg@94!l;s|VS;5jf076gcI;z6bOhP{Btrz1 zbXBa2s$MmV4P@lJsAlzP9z7T&CQz4Qj;+nX8yIaw|}`O4tJ8kLw5TOmhb;?O3awkY2vcdIrZMo&P~TlG$@`& zjY=DH+rpNxVC)j}OW3Q}eKj|1^LcU8!gRI$Bh8<#zjZa|t;y4AO;d7-V>CFlhD)O4bH& zuW7{P!Dh;U&#P~5pia9vh^cu#a=CAze0$`lzaZqCf0%gk)-}E-TBOpu>I@Y=Rp$Q` zndW)rxnfPug|8T*{=|o77zh9TcQW{AfGCCVW*zYS`Vj6E(fw@J{JaO`koBEk@MG5S zkQT2LO>L6U%-&$ykCSgxwIZavUfX^~^`7<4exLQqr?zQOYENKZ!nGelG-ElJf{as% zbxnf{>u=tui6d|Thah;EmmHqe$esk(t!lN^TZo&iMRzgqou$b*TUxb1L5K zJ--lO-)ozYlh+e(z3n!p#;IAUs7aNpL4;YG*PtHPIAq|rc)k!mTx(}Sii&tDe6~1~ zzoJ;t{a4(Ky=_Z%__^1{2<#%7UA~cL>Z&!HQa); z-|a=0i+|ARc8@};{1t+ft52;OmE9r%w*yiv>OAr)yd^g0*mEP^*KW|>Z$J}0?av1t zI}qy+cPqxaASbWgDx%ZsCUrG+00lCQ#rRo;mv_!y1{wsA&=I{{cN2zuVaSI16uY@4 z9a+g-*n#eOUcbC-k8yf_Uo1gRc=Hmesyw&9yJ8!7S0m*lW#KsqYWoyHMVKi{ddj6n zoP6o@aVWMCiP2u|X3|d#{`>c;e|5ZbLxJsndxeuWV65m|PmpT%q1*Gv*ZAU)2q&SI z<~#>46vuPw@}u4y!4i{U;e&MqBGV5sU@kU2-qa;$49s5S(-S16WlU#?AK7<;>Fggv zQ??At*%_$7^Jv~|1+{S00YUpTfvk&iQ)41bPlpNhmly2rOv6n=z)GnAzYNy6kThy6 zUyJC32)Ds^>^+SIw%n?`m9EE?QOqRy{|;I= z2o6eb73iPS@vUpR!YEM$OivyMbC%_-bexVXio&q0p%9=#I$4x}1Vbdm0A*XQlkoDT z74g=+@bbBS3%0gUGfBDuCyCZ#tYpl;O5Z7KWX~~(*~lS+8TOSNp)Z0|&`PE~EiW+MQJv*#{J z_c>MTTJ(VRyygfCr&b&&Cd@!S_F*(%9!2Nr0^hrSWz9_JNE$8 zeTDBVjA74AuZN{9u*FAuj&DTgqOK}@yo!ndE5=^`4BaYbiDtZsnzTx#G6vrTxP*n^ zx#t*@_jiG6>2}W}B9F3+cZ`gTrZ`aH^e5d+2|p{!){L%2Xt%k%qROfAak8{6RYncz zTe+g9{iMQj2uG2rrl7V;m9M+XV^>!eO_e_da2M!MxOU?v0a_c54>nhiCSmHJHZX7^ zYUyziY#AoRG`n!@uEkss&3LQ7+=Ux~DM54c*Krb)j$vPD2R72NO5VDu5yf~FtJ$x0 zb_+yqy_By4r&2tsADkOy+5pO{>w<5lVOmpf{+l;%cMdh~fVyF}-oOH{l1`e=i(eNL z{pZ(nEx@3DZ}g?n1z6Z8to0Y7(WRH`_988i;c)tv(9^dmSpb-M5d(A+JzEZju8!rL z9iFAyZyFxwtRXr7X;<_II)4H2oJt5&% zsh@f>)nuCb4GDX1wpT)2f|!?%AP5pLGKvzR7 z7H|Z%8C=qgI(A7~ce?at3Qx|XPew_W_Fox04^AFl_8uCw>Ks8jtcI~d=xfZ{537}9 zyWuk-69>8qEV|& zpLiTiL80gtXO^mVtwkbZy*_sd_$bPG2&g) zri9*35Zcb^w|Wa-lQu)magaH^2FSV%T<)7ToC{xFYO;7bS>s^qXnxL5OG(_s0Nwcf zA+-quV&27%wmq=oye(k3uWb`ZokUX}R5 ztIUw83N_f$PnnNv#$_wmCSq^Dip~a*C+&lmG2clxJiS@ja2VcJkOt5TGbZ|_h8BA{ zhUhT_O#DqE<{ZO5H=sV+WY>}Ub{X}Xt-xCmZ7;4RdcEJ^Z;j3RARIZRx9nlTW?+`e zv%J4J+Ex6cJ6{%$q=VedmaWg5kKKbqNXPxeOasjVG_2edlXTB2v@>LdKne2uR+NLp zy1`^@PturJ!-i`PdH^iij=)1V{LsAfxstmb4^p>VD`oC$w2?oB5DHZ*^aWROKo&n8 zHg~$1a%4u<4?{J{c|4G3D5S2Acwj32%`8z{CX!c~QSBTaxyYELD1}Q3a%x4G4;MS^ z;envk<9J5%B*EdvJg-nHXvdUTZJAh&KqnH3r3$I?EbH(%eiWr|BLOuR0q(r}q5&te z4)eu9msK-11V9xb8>NEOsb7SceE%_AUx={#CjS2LnKc|z!3E~wpdQ*4;Z zBp9+aA$QB&)rP#PMSy$v{Mq7U_0hTiSGeRmRMJd%YACf>sK`1@VEIB#`uO3}y>K-? z%3yQb=WUH@BDCFAkWlc3wu^MNwOdn_4*p#Pp+bZ1A$D}RG^n1bG0R#J5kr49cXR2; z!Qp%Jod!pgCEUHxP6ST#vsB|DjNZe8;&fNP0Iq~h6z)=$&;dIgvx8flikd_~zBs+f}#GoJ*{;w9`i{3f$D!tM6EQ4ne5 zA@61eg!mO#?(^FmY?*F+4fwKk1Xh9ejJeJ;p8IHf6}l82RRs>{t&#P_59>YZiL&p= zm8zIS=Neja94t6BhZssaR?L~l!p}{j(=LvN712>od-L06ITVQpo#UVbx{LMxd&52a zj^C`?4+#5XG_krKORwuq^WCPWFX*QBLm~^xaf|;QOQ)s}txsJr%kax$;U3vFHT2-f z;()#YlZQtXojvjG?p_|+GyT%_Zzqqo@OeBp>&qK~^f$`=5s!u^x#`A`?!lJ%u4=&+ zJ&b|B;Hyk%jiu!@F7pqv8UW6ws;#&z%pGaKzyk2ex zP3#qay`hvmxjOCID|ehR9eSKUzy8dbVoJEm#G#K=ZxM|9IChkdc7*{>_62pt0TUuR zGNg6vD6+?YKIK#p+!K(ytecI8PVbbLe>F@qjIGh%LF*Gk*zp=g+BqQ=H#8(u)@4DzQ3$d zSe(y?B{{?Pf zrJihB+Zys(y?kAraxjI>ZJA$79f=F`AL5FxASF7p>=$Jsx>?g2o?F(b+V};BMDi$Q ztbJUr_63*zuuYV>t`oxYAZo^d=_=W25WvvGT@HI@qAib1_~@lAgiQ*y#xlyBz{=4( z{Z1lc^_7kZzf_u4+fV0))a>FTOWPDY0p@33plwl494n-~aA* z!{k?eRRz2dgl$In+^TCE*^HHm?_8n6pmJyV>8xgo0lp1hS1yYah<$Pqu!u zCXpYtLf>oqOdIo0dZbU^XW-Kteq-4l3e1#*F^w#bfX*knJHL=kZRPXbC*XXAO2X86 zmGb#TSeD1{bC0*quGzFv?bIY9zt(zRh;26lDE++SQOvQxgC->&La7q4-jbSCRDJ+E4(vHjxP?oJUy<2zbIKV^6`f@ZN}J zq6hd1HD>8`)4i-dzkrX+wN49dCqpG?=dKkFKURb@{o5o@Mt!Jm$0_2zhV8t0iIEQpMHF87x48ba=he*}4A00# zB#TAEY+mCn9qCcwHcimngb12Z3Ao7v9Zfp~Hn-d>%Up5Q7krGC+RuY_7#`A58`8ws zq4!10%EvbX{56P;&d9RJEJ%!V2l_qbzD9N%C)Bfq<7Akc=h``^QV&t^a-fws!+cky zuzMWAJ#^>2ykvk}lfB+C#0_~gSqC|M+8_PcXjFPV_@8#DBscl@WZgxvTqWK_Jj1k#DL&|%A)`ra9e7vlNM_FcE+=>!pE zWMPkojrP_eV0{mo>*w{;F%TB}iXFjp&RxWGgoSMYXNY@D#XceXhL_s|Nv|q!dkjj{ zdcCZ8yHv4Q^fN5kd;vw{^>E-D3+W8e0yiwdXlZI!ftn#{@40IzNipdSQQHF3@N11T z)|1h$E-zrl5})E3ym9R%q?>|Hf{20qPcqv0tjmheR5ewn-CAd-ggu|KKK|70C}RgP zwm#Ngwr)$?KCK?%S_PKYoyM{pR!N0XjkeYFVq@NURAu_x(>$< zKbF3MJ95g*p2N*jWe-rHpwJutj6{?_w#8A_l#$GKt$|LJUKT#&q)KY!p%B~Up>R`&L9%^C3_vb>6(+LnN#x#Ar=538mk zg#fF_^e!l}Wp3|TL)m32r>buNvL4Lf$M#+&7+oHu5 z9LxPskcv52M!UVeU!@`&L!p>751ucD_qjsd&3DNq=3+_nJ$pMnd^Bj1*)^cg^Dmx1 zd?=`=RhA7FF0 z7}Fne>-0tU@uTopR`|aZZb%{ll9I+i zK1|!1$AI+euI<4*-@8b<&^t-`2(=&U*6mvA5zzu3cH82vbv*6!%h4pY+#Clp>EGQW z@W6kVF<*&_D*l_CK5cBPgJ$+oo*l-pAc+8)*{S<>Bm~;$??LZ=zpE?P@3>#4y?9YT zT$HP~x@nd6WX}%c2Xe)hNHxlVMZ#F*=OUZjia`vKtz+C+_&&hjg;ByI=459pBr7x5 zbk3!SFQSUJY9hdQ{k01%;p&uJLHA83m0Ed?nZ=JcAw&iD{eOOvFCACt7Re3=f3$2F zu?ENaXy&@-U*;haJjYJZ9}59Q{lG`CiJS{x)LNxi_GHNn4g0<}%*m!CQQrMR*O|3Z z9^gdMaVP8Kuk81PE!aDNw{pq-otync>0sBxO5_NWa@o5W;0QRo6K=K1dwl0ge7F55 z;B<(Vg+hjoCmBJ|nkdHZx1(36Q9#a0G#2mnJFD^7*v=SlcX_deoK+{75mzOUSIB?( zYn!s0%HCcp__b_4(rbi|=9;GWd%wHO?yTL%?FtXe$Ia(vX`z!g(~-+0aHT+ra8Sm=ztOJM)p}scF@W~KVP7@8Dixh z7wVWoYo@&!rZ3Z~LK=`MRFKtC1`;@+494c!|W@2H6VSV}^M~ z?;wpyAqCy&jI{iVt$XAV<|v1iKb>|Ls)ot zv_ArFQ)bBx-xnOqyKC5Oa3n5lS~6&*;L&l` zCR%o3W=m0@{c{bo4qaX(1(M@&fLv*SHg&@L`XAS_qCOB_O4`P`tlkA9HF+u)WYO74 z6oIeT0IK7I?F8v!h0;*yd9i1yvR-u0w8Gh{Q5C>Y-1bxb1Ky>v>AxtDDxM z7dv_)*K3w;#EAlD zF-{X78$7J758ES7tnQhqe*OxfM|r188S*JDT-$V>oml9bx`HPc%wHhC)Sb=xavby? z|NPn#O44u$kM&Qv*>y+qDv)QKtiuhwa3w-G$J!O~oLhb)2-;(x)IdN4Ll|x|78WJZ z5ba$E8$>3+y?8GAo$8hAOaO|Q{#5efn8xqrr26bhhm#c8A;^|gKc(FeIzA+k2T4tR zk;wNPK;@yf!ZYxjxgW6lZT+9}3yQd>!A+{YvyWxCrqWK@>>DG>c??#rDJ9M0ACC$N zk8CpvWKQ-(49BM9)7+6yd)2J4Lv-)NfTZGvRO^eB83Did?#-~kTLWu-d9#5XC%>RS z6JKM(≶ql+IuHyE#E69M_4WsSWa80ONT|k?3IXdcWF{ceIf8D?J`O|Kod>-<2zL zxc&iZWw+bV#`@4(*#&JR)y=T>!|IA6f4q-J?N&DFD&sk=LHVVdLs0jN_O#glP_7x^ z$IKVnFXUP&6oWJrMdaxkT5ctC;;mgH!2>eN66+fw`F>P^FW#<=#K^Gad&XHLz|hjx zagqC>FYuS0ri=SmR3e=sHxn@|Prgg6Mk*J4s^N6NfjCtO60C@$OW6ty`J*P?qfyv& zu=AY{J}TUiY--g?pQ#6lc5Dn|tuL%jwW^;g+)edffxYVU`yPuuPSJJ6C4%|>ffzv% zma-_)UWq077Xeqr3n!elg7zJlHQ#@Dgzj(9*7mkxW2U&du47SO{}lLhG`We@m&5(O z8j6aFm`|O!I%ZCYe|nSqo#Q=)BuBv<#gi`V8wqJN&d<}QHQu*3)M6mT_;gIE@%H^L zd0l2lG}~`m5VFPlL4=&@BMjjoei^E3>~_Da80t0)9vr`NEzK>Hl@w5?HCOS!jy{_~ z_00nd*^q_kkgJ5u-L;T>_P&5{R%0Kz>%$4h4zoA6I1kLm2q1-r^jm;^W7EV>Gyz)0 z!FmkqQA9tc5kRxULy|4tRl|+TU{1&Xq2d&Y+V4(11?J7#1z4nZ;oXaE-r1G~g$|)M zz0Sp}#$D8u!v9KiZV`tGqpj7)9q=DAF5H9c42>WSCD&$-q@GrB*V zg3O>~{r(in-vgQi`?$v|_{I(QMRZ%4EOW7QmkMZXajhQKHRVr4TcR{mD80wI1W>sbt4{Og@p(gM9t_S zz3Th#9KZ;Xtq5PFI2K3j(nj=27|r=U%^TiS9vXxW))zW}y5g`Sz`%e7S|y-k$O+D2 z+V14uI2V=rNk^+YO0vRK7TWceH155g$@%LkvvSNmOZaxHIsDe7jatUv(DMg+3)=pfkx;A zakv<6opd$~bO!x<>cu3Qu&8ksY2_u~rf0TJ1!Q~^n7f}F1a}WU05ao70h_oN&sj;s z3jzGN|Khnccg>PbUOBBj6O@ibn)y*c;;PBTQCLH5Aa;m;Mf^UQRyj$a7WU2^BEdXC z*|Qp~@$l8F9+fY znT=Xds07udQ#%klw_ayIfrAKmqASb3<^t??S ziX((r2vTNGf(Ao@XZ%?3YolDpIIYymcaeXRVBC{mv=jL#{Kry$ckF-yAJ1GXRK_9X zw>5Za%Ea7eG>A|^+CG1o8Gg{`%i&@QYxmj1OtM{L*id-D3yRf_6oK zAn_FH{HmuM(aOn2e?tnyVlkz)TuOad*Y+Tp@_9(gTf0*>IH!->cu8}FnoCvZdxF`B zon&8kDkHXvB&RyB3ff%Qu(ebamyIN#QT>tfvKWz&?~u^vO?$)0T3p69#Cl}=Z+pPs z^JRI;;W=d#eq^1E)yK#Nc0^U19hGU+5%$7kbZg+`oa3TM!1K_%hq@d`+re>g}s1Yd$ct}TwI19K(WP&bYU+UvV{ntj*9p*GF0i@LTtgq#{su_We zx;2@3dtaK^S`&g~+7mZ4mKB=g{?#^=(z<43AgNacoDgN_GB~!;r6U@8r03ta<-(XX zjqWeSO@uC61pE@C6o1&VB+Q=Ai02TQZHpaV?*3sz_BP?N>VTIzeLL~4UM-8f0;aDz zzB+E^>i$VI!rx#JYtD2!I!kdlDFk_zFFP`U-JkAJiHsw z=6~RchhKd{bSb8iOC$=Hb#FTgQ4j}r=NVeRyquNRsbKFA-uk$RlLGK76*MZa*C1s?dYAtbNEOwN+#9y>^J4{|43h7;DlgTYOcE^V9{wz2_Zjo$| zJe1LxFcCpKL=3(IStzBd~Lh;+L*t6Wgfx}8^6+)N0MBc9|etR>*h z>5Mg)+Fhq3C8k9RF?et}-K0WE$A! z3s3dVpQqbG{C9e0G{I(@WzyZ>o*U6ju1k$~Ikrf2#Z5YfQ^xM{sjFv+c=d7wwLC%7 z=|3dQZiN0xu-xo>?}J+n1M3R1K21@N--61;%Z7kE9W%4^6>$MCW(JL*iu$i*!-5t= zI(MttS#U%^jV2Ik?QOCTCVr&*TXY_J-HmS{;*qF0J?02QhVPUAaT|k$beKwAdNx~W z6u!I|Kkl+oVbbQ|!%0Zl1-AKc+Yi36G+>hh<$lxYYj?4nz{T`~;16jV@r5lLk*&>D zK}$S{NwJ6WuaBW1>YpTM@AEJ<;H$sR>_uaP^=*%@CsXpP4z4#4P3Rq$w=$(}AV^6q zKPBY3y@yscbUTN4^N@^Qcx~l?r`4`MMF3YNgfoTTTool6m`l@5zhDvIh^zh$OD(ZZ z(&MKy8d(laG3VuG=wAGKh_fDRcRRy=+85WxmVxiF$WbqSgaB{7oQnQYuuGcVaq)jJSK(}JoQCl1hUct4vm>s4RQ+cGjPFUxn{3IxM|~^?DM?fByWjYvZRSy z*+Slpg^=NTbA+TdmFOku2IKSuxd?)n*$p8x_(JTw$#Ge!cp7L|B#k0+9xG?#O=^_% zht$vTXf05~3vKT^i)V*ZQ)_T5m1FeulNMslu_?wx<4U#7i6bH-4)qo=vP3yceXdoe6|{nEK=31@TsAU)Qx%_MW3MZV zma50S$Yf7hh9Tq&Fp7{JGV4UM8a-I(yIl=s;Nr#n_z~4{S*gl^Nk9;_c+2It{j19P z?7Nnkp$+}~!n~x(xtGAfygY)ogX;S!Ikpdg>e@Xc9yd7vmLUs zS)nx&H1f#qArYF$_fqm$hp=VE<^uYtD;S@*Q5)9Vg+;bM7T&f*lKk=pH^N1<2jD$1 z=8aYup8UK_JGVrt?sne-Tnf>o*IG#TrUzq*)Ez5kzUp5`LZ)J$K;P%MA;2_1D;E6oGMxwI{M(cYqAT+uH#&P=u$*Eh+0_AzTo`==__khV_9D>LG`SkiV@L3i1@@`%vg%h)3ArtsEa{}!Buu{RDX!|p803K{ux2k}U{x7u&49y%YD z0rH2q#ci_q6R5Q>N5wAcJp%--@HJ=s7n#cFqb%~~AtYFuLia03`5$?>pZ#C5^wo0o zUWUIvJ|4$N1+!QT8V|?6^b1FRa%3`2ph*gWiPTt`)Y&7}d#h(#_{`jv0{D@@1xGmcfLJz3L>-?NBQpx?%k(1W@MWl> zh(Ndto-75TxDD>KixvL}kE}{cm$*U3gvei5kqS72b?9ibxU@vdoH`tqG zO_Mf!JOFk!Oe)4X2VhY~1~<{ibu39qO{e~}ccTT`-Sa%)k)3Wza}JY-QZdfCQ1Ta* z@z=~S;|3$_J&2kNf){z%$dQ1kKA|xfcnBQqwZ+NzOZ{$!EU62W&@5j|p9{pR5)P-B zgQbhbOs{p|_0I^HZS|V1$$l4HOn!n;uf-|*G0M=SOf?XI--_5Ad=}f5RU{R;aG7-| zTO9QCh~m@8B)%y$(xsNBN+adB?;RncqK3N|ai_wcJ{^&T4TdV@g9hp@GM<$SQK9L_HDr4oYKu2 z$}vyNotw!}js_D(gy&PJUKP{5+>vf!Q!2|S9M7r)FHRecw;q_O$S=GQO4#e~hLb3AK4OrZz8SN3VFA2*An zY6+sXfuP#Bs%Zsr&5*O@J|*>(O#nrIT67dR9Hb7V_niWF6Bd@mYpFAtg`xd-7w0t|ur_()WE7OVmFbH(o9-J@@okUuHV@=W~Gwt|h-~#dWOtD{VS^KUsaD z2#1qwE}2Y`vS~48Vp3A@VzqchfAQ?HMX$mIsic1^DQ=b0D^c+n(l%MOWsJ6r z{FmIcR0JGdY3A2*6g5QJFR+%wVcQKL#L?+&`ld)IxvOo_Peb)5m(J!kT(T-EGJ1AI z_hf$(YHL}v!#y+N z?PG}0tBCM5yJ3C#N{j4s!u+ zrC+uptR{tM+KMkEg)EcxO9!^#D4p=DNAf!d3TnQp&0GX5M?+8~!@A5XJHavfo;nPG zYxT_O9aN+9U-W}4=PA0H4O=dtobt{AI=MeH)8)`Hmo0_YJTc?4j4wUp)xM;RdX2WT z@zconHQ;vY?~5R|_&NuvX+@%1ZI0dT>RWj9V~qRC*|fj zb#+T{burdL;ak1+=f8R(~Z zdlYz1Sf-G#!3}RanN{5mfYJDcfpYtRj^upDcI3`>5{Ex~A7iSImDYcT;7t1`9$_Ee z;y2SGO!amu5+euayvuNMnB%_U>u!E?h5ZWB%(@B(Qo0>=XhN#|)i6VzxIG&JEpgW> z6Sx)mo50MG+U6{y{jcFBS)5wkCW`4eUhk z?-Zp-)Xjx?_!nNrn?;eOslHjlNQqEVxXYS9wgs}3%A`};KQ|Q!9r(G|}+~MbYc^1nc_svUTq;^*4Xi;rrMZ4_W)9_=}HASIt$6=buSV1m26Uc=&`CmVZEE z+uYhd@NjvXtHN~)>-HhDgSLO% zRx;)oxLYYQx7Q^?V;g#$nc^t638hb9CS#%+@vG${=sXPogRqoA@Qr`k%AISbJqWwkHI` z?eanem)l~ zNMA^(FNtWWk2NU#E*MY_%9MvGjw{WLA_ut_}-Y){~P%L=k_qSD z4{)Er*_yD9h#MqSR4s^3^b9@X$H#vl^_OY=_Z4en9Pv@SXfOQu4fX8vsuq^Y__o~S zKT&1Be`87>)Qb7(JUee_Fw`aYgFfr=E*oTgeLS3B8&+y1pT8eQiCplNp$PAu>S&_SZG^{sx$I3$_ajH&-?AwCmCfY=JPzT!AL*?r2G zkN^CiNv!05Cb1cqr4m;|1X{=2YeDl1&0$78w`=>^BB!ipoFm3+_llFuFb!}C54IF; zRTWJtlC4ed5GjYwB;4*lBv_AdQ|V7iO>lrbVl5k}boJzT$sD2v}U;o zDS(lAYCUqApQA2{%927NA_0>ZWY$+UCZnjHY+TNYUNTbu(dr3~F^dGws|h~6iO-Lg9&o7!OvXk;_<;Sq8B!z8^|p0l z1u*Lq>te8Ebp6J7i@aXm98N#FjkE{>`LW=Cve?M(N4$+I8R5J~yiqPw){bYQz7UPp zV<>=10~eJ;}5LC>Ryd+$(S3eGR0z!Bc9Hbp9WpHyAZ zV`OY1`6xd*w=-0g{9_f0h8uj>=ces9@40`+;8hxO&6i!3pR$fOtpc{cEjAMYLn$e3 zJ-B`G%TxcW2)n9=l&+Bwr8C6wxP*FyN(*1>kmhrIl^ge0;4rLmPIdo>)rG*{b-IfO zGSrFn_%kn7?>g#fQfi9e-%!j=U;d>*1+E!oGBeM94pZ~MXI7Obu(3hrN^K~NjR+G( zSdAhXx$@}TA#fVg{dmcvmPx))UTCrJnxSD>76N%aN9(DwiO9UEcZ?sa^m6CSG{scN?Kyc2YAybE9XwcjM5Ik zt^#6LOrZjU0-Q7472!TIod%YfwJaaN6+Dnc>a1KKsE9Mmxu_cLCGe(*|Lmn4yk1|9 zb%l)d^|!9M@$U{ia_m@Kg+_)*uL9k1ij^zZw#S``)F^9se zX8lSht{9io6FuigS=88N?3ziOaVO`)d^E+%0u~Vb6Hzz+EX7H*`@^%TuNSGX@A$RbxzqjxA1YL+{kbW?g&6xcX~N6zY0(`Z zg{toQv6pgAw6h={dp%&_mJ*30XL7)rb)0z;LV5rSvJOwlLs#QsP}6KQ;#K@|6m{`o zn>Tg0N=x1Qsz_nD$He)g@enC;g#BtshAa?xj+ps;vYhvoiB+*bGM0=4S_+%L+siRAHMpiQkh&}t~r|*jhO*}rSomQefQdCh#3!&Xu9TvE3nw# zhvl+-l1Tjl$*;?J)#suxis->%gYciw8kM)QiCJ=RpMnQvB1nQI{R$bjap{KE4=rQl?QwFvIT~8!}sC2*;NyBj{$Sz*Jmcpy8=cWJ|xB zt?P0sI_{%i)tjn6RKiOOJo{HQtU?2vZQhBWuJ6L#iNC@$_$5-mMtY#50qM@is_qHZ zwBMxDlztBhHdeZLrGtvS)>1M!8c@%>Og5CO$cxL$<0AEyLWFj7r&FMar>NN%zsL9P z6Vd`zy`>nE=Cquomv*8`kCUZ6Q@d|FCMiL1;%`+q54XRPbxt{Kw?0DHW9)4Du1I^V zfv_mH<&&akH5K{u{d$2=Ag!|e9&u;AF#grL_%yK35V7!pdai)xMaQ89_WQrckp9(9 zyBUcmfRk}S;ndkKWuf`Kg%u>i;(5mxpsVt$g01J&N~*OQ;I3!syxF7KRsWgY6<8LF zu!8&Ek`WYa!arb`ioD6}xyZL-9unL@>6~ru1DxbGZ7W4ab#fHD*oH(I@cY&!9mkf3 z(~K-OW|<@O`hF6BfF^eq`2_Xwc@U9f$si_IkFtvRX-Z$f zdUJZNw;isa>>kFJD84YzI1wby?uA-UK4`uZtQ08)3u08*nCPx=<8_?0OZ_^pbYWK)U6 zpBM-8+O&ND=z*p}v}Ms&rCz2BVC+D6a=Y+eb+V_sZ*TBMp;o+oy@2bnF6) zouQ69V*blgQ3iey7+uQfEp+T`qBoN_7i+>kZ-ql1-p5J8po8^kt*roSzV}DXrM5OU zWvR9uwo^oFiu{aI_U4+75b%DZ6%vrt>ZQF-za-Gmp+h!`XRVNdgTs(O=BQ-0?&H8?eOWi57 zNfuHp1XQy4``;QS#RlKHQ0?qxEH%RaV42C&P4F-gFFI*<Ou&Ml zWf4W%b`c$CG^#UM=sCe37E(d&4S{WzKkq-isW|BsuV48yjsJVO%{)w7WoO5~n*#}u zt{W1w1Viz5El09ZMG#U!yQ+Mu-c3k{EDDnLZRb9U5bjJ}FAS*rOOkpWBBB$882?aM z+w0bUXvJ(Jx-rl8@g@?2R%*mE)WcQ3Bk+u&v>*V#cQT$=V5AefK#>1U!ocjQ+wY|v zzX0Ezr z1g@`1RM;b-y6b8>1|u%^(8F!w_2gWkWK{E0_Ts4=YD^@%&#p@>unWrBBFmp6)Hhxl zZ!$anS4N@$7`=1Wn+QV#%R|(RQTneZlz=JDm_?m1u6bh{=XvRa? z3Fm13HUFT*v~nhQJK|=FegoPdRUpr`@&e7%WT~@WFz$e`sbKzltp@~Q^{tRSyykP#83prDW{ zpOWai)MN?(8#$ATm1Wd|bMW@cbcJ0s(Eou)rfTd2l1QBTS7S^`ClzD1PI{%F#_7`$ zf&N1&Lq;imAhs18iu0ozPa|K~r=6x(9>%YZ!p?R(# z0Yh*kCm!|g&H@J}$$su7Jqrb?dmL(UzuvEz0%M%{`GvW~#len4AFA=vw=tYOOF{Iq zERTZ1iHi=chi-orUJ)W=2?ByL3Y;Q+6A zy^%#HGz_OvN~){n&&{bw$9{_dChz^Gho4Jdoeu4#Ya7+@8J~7&@Uvz>VSl}6YX|sn z)Su^YyiwbNlTFd=PYkfHV?Un%5O^ap@Z*Vu!?0i?t;Lb+^+h44!n)1#ch?IcNX%E) z8VD4sl8dkjs1yA+ca;~k>st7?DUqml)-FESM(2tiZ}aIAV#R2?Z#ubC_KA=EfQQSq zG`!fV8MSxrkx~ecO4P2Y0kf0?sI%bN2!4O0P z0{k*k!%j1bX``g^ur?HwmZsii|MBYzb^4_IDrpZ(!e}J(QDqVOVP;OKj{8sC?hbT{ zX}jQ|dh`SHVJASrnRvqPRA>or;@Qg}F0QV3{3PN-64u#uDI|ja!t11l2Es8%fPe)y z1&aUxbC>N|GZIi>cJ>bx6`24@2VK$?Ib4an z*Bk8a*$L=)*GEi@B^YL@76};6OM!@NV8i1?l14y7+BE9=rrWGSTwhM4Kh;Um67&<7 zS>>yCHV2y*TVZSaHvbP`aWN(2v`YNcgc`B$6l5sUt(Rb(S5390~tnY{po^I}t$1k4k2j}})<^&)lP>MbpGEz{jt zeX{Y@I#GWAwbnV-nS=(bhHOU1NgS#pncYz1hh>p7T!Qocp^5;`u6kgd|C?*7$W_Eh z(Z#d@j$-0OFUF_et=;TbMc}zZ>hYx$a;kDAU?w}E$&UO?H-ml8>u2{lW;{oN^OH9_ zYyDd|%@mZ+Zauxg@u{x-M2JGTNoP~C-xqy z)Zq#~v_oNC-QFT^eJgY20X%Xjevkf(e^mCd2aXwwx*DC5m-(q1U#(c19|^S=xM8|? zz>cHO2M%2>;|BvJ-dlEZGSNlBBr98>#40~o#Z<<@aMggOt4h?mW*Q62eM(wJgi`v0 zf;Kcu&+TY=tXZ)0c2H#y~7W;DsANZuRD^1Mc-#FWlE*H@pdqnFszEHw(XbkyBZ`%i<4^* zr;6&F?ZTG7XwKBj8lxREccV{PM@t_Wr5um4jVE0=Q>^M+L8k+pt{c0)LpFJ~ zDG8f)sp!TPh2V!H4q>*B^X4ym>cI$*5gw4wa&Yjkm#+Y8Kgk&YSIyB@mtjqJjg5`# z?{^Ub0)k*uWjI9<{ZFrEky|S+f$p592YU!AqORXob!Md`&8edu7n&X(m+FV7Cjc8| zXXl=FMw%;n^lG)V#M#V=z-DM3MMH>RSJG)Sg42BNIP*70L z`~C+8a=G&(*EN%!6K46EQbQqI4Vle#rqt@XN2Ji}>OmmE${+i&3NtM1 zeGWE7on^$ClN7GINs(`kXB0J>8XRbSyl32%R zId>X~+-kZ$533CVd$Q`J^f6?cL?^+^sMVqr7WR#fD@w=%VaP70^AJmB{X!YJyLt;H z_%*b&c264B3+G9CNX>@YQuZak0Jg=&^<|ip8HS^BhQ7;8y!8b7ZI-`qm-_2|k>|8B z-G=Ht@zfc(D#-F-#IqH*_|6bv18=@0T#+ z(Tq3^E1N0)n8+V!85COseZh-w-+Pv-(bItJ*O8PHV}Ky(xsCcbqJPY z&pZ=^SZE6K=t#!XQ!5k?rskX0#ket6R|jh%I%2T_?Ddoh^JA@;euxVg6E;42z&jX56MQQ3X1YkP;6Xe|(C7V+!{bUffCu?(Vjs z9UcOsj4Ct#9m*y3^vgsX;O9dl&5yD)K)HxzY^+3vmg#o)p=zRnvxbS*vr;h|GuW3b(g%qLm!wilhRYboPBmn+5yr9Q zWx?;!Jo{_et+yDt5g{@iZUk}3|H!}n>+kjhD+~Xp4Vh(3}V;)3v}JGDN{?4@2n=Dm-dU+Wn&fIVjyh~KE7c1 z*g0#;hHJ{$sF8wPhTY$3o``KsYXP6R%Vo_}k@p#2cwPQepA+4sYTR-ZGF(QHy>Xk~ zRNYhF%?DI-<&$Z>xf<I#-!w& zpb$ZF+PA%;_G=U46~_X|{EJbZGLa8p^)oefQ9>8ujS=jm1qs=HOq@jgNCJ+MyiMaA z>c8!EtgruebD{sqoK!67xapk3SVKE$3O-rWTwLVtHOJXqyC$a@wz&M%RFIJ4WV4;f znOMv+@F*(J%h>dL9+OdFccgQ9o{tG+oMLhkgf}441U7>xmTrQK3x)e3rdFN&1rSh}#v#|U^aw0P@k@*A&GX-|=GTn*czBC-@XmC37!bilQs&Q)sJ%d> zf#fw(%a&nmH~AXYo6VfHv!ZXcJZxKGmZ)AsK_+0vFz}UaJre9iBz?297)=9&n*=Mm zqZC?I1dOEFC#L#3&KM|o%wd$2FmR!LjsDKuiaM?dZo>r*)FF8Ai3;iB6rt)AGHhB@ zAc8r%9U9Y}K!tx*Afl7-f%qkZNHHnZXqm70+#KObHyU-C@Si@d(pnMrZ<_;o;kSZvQ=8)pk(y zu~qART6O(^e&!BX-#YndhLz$mplcV}pOpIJIWqz95Zor%jL9gKETxEI-vxrz<116= z4N=rh4ZdsqX(O&mo%Jl}UTWUT&J1f5_C-?jwhlK9|XhIkaC32y-HK@cpk{l z^bz{`@4ub&XS0Ck^%h=Nj&c@Jt7+b{KIB2&)BEE>`h_^NJqP2h#%hXI513%gBL?!W z3N6Qui#whT-xUQiVhJ@l%xI+j(SsvN?5RGG`pRbw;?lI!F0fggSF|SX56g@LUJX~M zs)IPxarNkL>?;hw?^yEQZ4l(BS-1;RnA)iMyVuK@l9N96dp~x+N?;kR|M~ldQMbTRb&4#!O8=si0C=g1rUg9OZbV! z?eu6zLgB)_F-{9m41;h}d0p+TrgL`Tci^ex6*Kvk_hhY2N|{Ibz8|?7ksMu))l22S zeYGo)gK>F1bTT3zJtPrB9y$sT+piD!M|TRGm}@`lLe_sqix`9duRSxP{imr`d&f>E zJ2q9hkd%crWOY88`&rwHoqK>-gr29MwiY+NPA=G`dv z>D9JckCjE*KGv@G7j-|XW)wWHtZdcaX9IP44iqIN{ADkelG1x*2IbK6MZZxIVHo_k zMjq0SlTWM|QJE=JZ9)Myh^*bj*4EjHyNC+8$9KZA8VvWo!xQeBI7DCC&;E3*OSL9x z|JS3zw8};Kb^Y4i<8`_IvW+C*qpu&R-SOtFHfJ`{x^MktkEg+&^kY<3(k&^=NlOpU z07y?_dmh$Og_qlraM|yC67vp&1;^@rpxNi39-h7?MJ(9dwF4|KbLH_?j#j5qV+-lbPn3#chB;SG<$3MYGMJ-x^RB5c4e2Mm;~BqI%$UXLa-z8e7ey~x;rydHT zaIl*~kw}e6HgGGY<4|WEh^$us=|Q8v25(;>emCC%JTULU2}9frL~+xT0?o}OjZXiE zX%NURm7}0W^|Cti?bd=qBO`u0eSCg>{*@CUCB->2DEB~5f%j|dZ;UuG0+!$~PNaV2 z!&(3tWaKml(wlHAXnYxo97jt#U1vQag{B2VO?24i6!s(hf{ASbC@KQjY zmVF(=O^-ttek_CK$r1UAD^EE#;>0vmmj{Rk)re>@KR!ceqczIs?i5@dMB{sEN%7=; zs5EQ2e!~jmoD+f!K{a-14+0NtTHWi(qg-xo8dMXrql=&jdbDS=zEvwC{{t&Tkd3G% z7xpK={ys%^UA)5rhw<%k@P0}4*hAYaHzuH(_J7!4`8lI7>T~nAX2zuLotIL)9|M;- z1mim!j~v4GP>jSIG%k-m>P3Vd?mlFV7AIZ2A*O=N&O#xAd5!aA7LYFhnY&e-#tjz6 z)0K=={jR1C#@k7zs(tAagM(O6;@m7q4Mq7;Xe@a^tjSoj643ubECW!i;}A6IX{enT zK{vnlkp5L&3_%A91u;&mnr&B8rwbDSgrG@CNc8al=M}H`AcJ zAmVtO!=L?biP^KHr}yiQD=iK^6+vmg_t0B+Vvqxb&PUiU-cSEYW|O7_vEGv#NT%Wq z8OZvhVpT*Va=~ZwQx8q57pWNiNP#^q5cL}Z{y(0+GN_KNi!!(q+}&M52o{{+?s9Pr z&c)p!!QI`R;9Q*G?ykXIf(4&`U(HMx|0$?*y4PN|7skl>U%%cVOJ4_|zrHn{(I9+wW7(JnP)+{zi)y3(sIUxD;QYjE+kM-3r=y=&B|IjA#Z z9$-Nb_wAqBsqC>|o1HeD^jEo?s!4ed&*WJ$KAP$2mf+#|z@HHD+E1@e3VsolVl>l^ z&i$)u0jTnKl!CL^t=9Bc#pbi#5%XW+v@k5R?f0RGRC=TM@ zar{QhrXBxdM}7Z}fcOlrV1M^r4YVuTeChtp_B82%H${%Ulgjh$ggN)6Z_QP^^8|-Q zk4ZenoO-{@=KK@8d{vE|q|P_oMr!`SV1hy1_qTc^caRE0o3En%XMmf)e)|QHRgRO> z7Sj9L)mrajJ6_pQgFmzy?lWk&OjR_}+t8iHK0-NsbXG$DP|rzd^gpsWCpJrd#~5#) zj&58ch9B+t`zOCTqY87e%|3-x=F<_<2UxH649DY#xn|r0nwJSA9wgpj9o$xVrhy>K zfSZ5}W|{cUhXS=JFv!K_G*uHSDmyji0SPO+?-8Z8%F+6L<1ar?5b6 zQLBdnp1pxq$a76*xSqdyfFlHw4`6;&>}^D15*jJrA&wlMQ^d`ej>+Pw{>iBQY_I~| z^=_fvXdXpTNon8bf>fVcoHEk=_IG;f=fD$2n*d1;)DptA| zr_ur&;r{mcaR`Xv0F=H(sT$o=jwPasSeuf~m{8gbl76zSAow zTX#2JX8*Q8_d_h_yf}T6DX=9f1*TEd`&(Nn*$dL44q8$-iZ2fW$Q3a)cWyW4f=5Fu|1PZrazd?wdR02r6^px zMWC(+Iuv1M(u)tb9#5nc(s&&3{@#3u$@wc_`$txfX9y`qm7*=uyK3O-*Wgzso&OGY znD&zjxEhQT{C0n0(n~?ccMcC-1g)VOB;cT&#F*n+IwBS51pnTTayc PBH>NqwfA z{RoobqSY1b{wYL@ zqoN)8P%zU^1hgw1F?fVctk zNS}-G(CGSqd5)R|cyuJ0vQEex8a^{(?|MPi`CWcQVf;@3bTt2K&pt|978LBkX)g<= z0i^wC=qiX4Bg|G{u$Q`q#-D__#CUAWR`hXPchoeBCC@GAg9zqemsM#kXuF8;i!SyX z56_8%X3NcI&s||5sUM<~k&b;Mq&zf9)VrbtGuEtP>xth00;Tf{V)f!Cr_pNbj;=}) z>f>w{XZPG)*ynt2=}<}ywhM>_dX08waAU}oldx^E?9Z1dLS9oRB7>I+*>y(pg_)MXiAOrU7Q6*p%9;LINE(NEZl?TBm=lc9}@{m&D z5D-}5hRb*~>gM!93y}JDTuJbPil^RuK;5|^cB*Wh7hP~l56HE; z+;}4Fb%rdMghULJFSY#fw%jl)wc+96G1&m>rg=&Mo*I>i^j2JVlRFi!;Z}pJuNSSh z!p7ifd-H(R`^zt)TV_9bl9Z4Zn!)1s6r5_rh9n9`FX#r2RC(Rp-?x|t5fGt~td6A> zF@w;=!=S(;m~i5pHxomDRbyka`i9?miZH6JOV1EhUucHfyw9qAWtGBVlQlUiFbs(z z92tR>%D;{ay=LrAmnzP4a=-Xj-I%y=G7K(8u()zRq1Y3mJ(N}5kvFp}5zEe(z~gz9M&iP*(X`h! z06dRsoxF?Mk;GlO5IaSK7Z|FfH8ZIW`c!Ps-=6DEgH6~+LhrMuhcB0T&FajVfmP## z+Sb;|w?>1r}6a%|vz z_5G(%dDN`OHcCA9I;nxumAdY>(fdpDD;_!iK)-)tAc|J0%-=OG`{#rSsm>7X?uYOj z&VW2{F`jWq3+X)Cua}K+s~=8N%nDNkI{f2~HOF7!k>+LSrHggv3wi3d+L3Ix_!9+ zO9gt$Tz3i&5963#`q-&RKit8o;MF2e8Gf8VYw!x++52Mv%HZJJ4iQZOmRx$hiVw6?2JGR8cpgLMuFxS-%lN z9u_K+8K*jeqw@!b1jXM5SR5IXIdJK+$1T3o>2hp8&1Fb<4YdFDM+&p($|}z13A(p=$i{S5n_=!9yPAMHa*|6zZnj<<>m6ho)doK8!iP zkpW%+^@D4^qR8bya8DHsjW=JH>e3^~14CZtCI5SO&t~)AYWzRva;L$tfsVIdfRULcabvK2~iGJ?a;7fe;luClqTg_*3}JMh4-?R(l_No zg{QVvYgqk{`-Vo^3!~I^2yC*gB^_2 z%Xy;LVqhs>Ma*5Ky#V0zsLW&h0MvWb;&a7GXRc2W61=37ApQi4iv`6OD@w_NKVJ$Z zg?(LL|Rc1vlGFkM!`eYO-2vbQX=!hsEUF~x9mp%Bs_Z_vg#7zhG5eiC*W zad;`&AGz9>_pXj}`=h$LEX#0(CD@kiF(ng1b06nZw5J^Oo-I0 z^Ee4a!8dx*(gxFM5c_y@VEj0%RQ#|7(_nhBk@6}(;02Y%zMi~F=cd%F z(ZcZ7fN$ug1Kv!K%USixLx{wm6qDgpHsdU+4AzO#(*ahXmX%cmiZURgxh+LeI$jUt z?EZd`E>Q1izzYN=g#^v}`&2UJoyd-=XfymeM=R=g&4C>vEHUzb*6!$z*1EdADb>1R z^Sb@FLyB@eN51zfi~!*WYseM6@Ut-+@bwa=`}q4p4LOt~^igMcN=8xzDlQQ{NxOvD z`#DhGJD^aC_*WGJ$x2;4*I_EaUM|~>?(qm~taEAsQ9x)iHsy{#DbJVd9ZhHrvKEx| z#0=TSbd@eC<$_QoHG8}&zT|*;obz)L6l{Gk2ia%eUxih2E^oXVwb-gApA1EZIoW+$+;Mf1|KPT$cEn#P}~li7rr zH~3^Srh}%+F$}5kU3P4av2^&B0i=VG+lcZL94sE>$!Tv5<^_OG?1w6MLu&}qePA&E z{F26QJvXB^Kl7XXa`>xuS}#0s`m-3sf{u{v8qjhW`*Va{9(;lP7c&pJ|H128#@1$- za^Y{5-)LyNp{>266jtHf1SA}hj^R}WAUVPr>vM_3xd~i%97<6R)~V1>48yeXWz@i~ z`kaJ_l?Kb_{i!j<$ln@=dpnPYEPW?@NI%fkjI=AsTP{)1Rkw}A$;sZ-1o}P5P@eadC5gLvak>Y*ohHapE#?GsCtNZ@UR86EBs>#- z?S?uzrzc^lviU!<)jk-yjPcKy(yLHF(Ay(6++So|^fsFguP4hl1B8^GulJtqW+0Vf z9_s_&ZtRZFot~(R)(gvDeQ8xwPn2qqO9%tHJ-2r9i z^I3Y-$OUA?C`6?&I6edd)5j5W#G$+qRUdAkrq%uOr*pyo-36txSLSd6pw+5@PZPNC z>oU0x`R2z4j)%jvjNc#;UB}b$YZ+-D=6k*&ak1c)jvm+4|C!|kYxWh7^cu*hR z78_x3r2;EX$kf#r3u+ydIk=hSW=1iF<7CCXR$pMbwD2%8n_bYKzXlv$<^kih-c^^h zW}^~mV37p&|BgM`uxL}egPGV9aqmfpLQvGVZ*{F^3h-pF-Kw{54^o9YKJf3bNdL+w z2nb$MJ|RMsM$DBhODLJSaF4%>Xu{_;he)49^{Ci;sj96Zgmxj=q|(^xK|JPtPiWGc zOP6=gXQ*)mT*F~x%n4iN_-G^dGPq#Msw25$tVzbVqSy(u0UufouT2++>LP{3h z8r@xxED(&pT0KpW_8(NZWTy>>ewjRAM5y$BE!jNSSD4!S=HTlo?~+-K_;}!I3OBM> z!#sdJK#@E^EkGNDHj6Y^0YNHQBU<(8?wMPPR4+v?dg`p5V&C(S51l;T3sUrn2F?5r z<>%(|Mu5!$_HukoOw<6YTbn}w_m}L+gX3Ifc01#sa_mAeS6m_@pgcgGXN|!^Ol6AX zjWP-9TtYEcBb*-VEuSal*ckcuGsRoJwz&K%z>LqgkXrvS&GF{I_rQs@k+92v%Nr{6XYbpjCN)(;2J^8ayW{SGNH9r5lag?(q$K~nov^v^lj1bY z1xE39+n2IWcB6Rt!8LIVcQzcApwt~~gm*rXVcEYO9i8rG{MDD0ma$K#skp&Os`2aX z6UN-=dVf=}KacHCF=2zKAKJ7CU)C)r3rXeTI~xcB&Xd%E99(}7xki6wy_(9c@fPO0 zk4!Y5n(!(b%8?l#tgy=GE^pvfUw@vgY4m=EnP#mkqd1-A>ezhuV53T#_gbU(o10jB zo9Mwf;^6x#Ffz_aF*p$p;VTdwOBO|QpIj1K+Z@x+>=xba?gnlAds}i9#C5gSj7%KN zuKt=D_1}wwX|w8AA<{-7h;KNVT<=~`|70v32)HS)78~6*p9?JdYuPbqg!GGM^T9+O z!tkx*k+#$+qRjKCVyyNEh><#6HnO;JBmEB#;qEoI0ayCZr=K^{MN&J$Qa-ME)D)+u z!4A3-EgSx?EV(`iNCf@;t~Apx3(mI27I`AF(tj%7ECwpObyzZLJjXWg1MGrZ8Ky3) zBateKRS~>{wzfDj(eU8Ai(w0)>=9J#UDRm+Y?MG^p$I1clLxY)H!@InFS8}^zP}g> ztxO>+j%&TN-Kv->@vLP>~yXU5Py#W#Z;ecc@Du*_iysxbY>Fr4njD zU4HNsK-}O#O!8(jiKO&NUy-nlFIskQ_zx&eC@DsOCt}l&%ZF7;gSf_R zjJSDfYtF+*=OejqObs*D;+m5cii#;e{>!10#~Y9?RQJLe63M7WbWi&FvhTgt7>yO&Xvku)=-3F8J{JK*DI`NN6p(|bZIt3E(!S~-56oiYp@;}>>Z zV@>VPry9;h>vtL~}eodP~1ltA$lN)WStdayo zld~pmY~M%?p{sR!$^N|I&$(T~TDg9?zp~EX@#;cz05JX9yiGRB?~)KRV8SO^?th3+ zuHBeGfqLzA)fyGdc!GKr;x|y*t`b)9<#Gq{te&|0$Dd{9AYYf0^G7&+??}k=FaYBrJ?{LgYvD!Mzmi(6`3VJZiZ z4yR($jjI$Py(x#AL1!3-e@2aKKzkt#&vL%4s(X%G*CXF4p6a5NCMqu!+78BGeABq} zqSaCyJ7&S9;Vj{qdVzqaytpaY+cwBeBAl~aM+YM#FfcrAIR^T(!)CX<<624V2~2&B zG%7RR@_q8n@_$5On}TfK2!_Y&gw|x!yu(001I_YBSe~;C3*$mKhoGZs{heMX!zR+= zN?cj4iJootB2l34?SH$YLeIw23oq1GQl^q}Ke%0T7F2a$Z5ieS@TFIra(;QS40;cN z)&C==x*|DHA1Xaye!ZJ{*={;V&zi<%i4JZZ%_RL!SL)jz+7=ig3uws*O|H??s5Zux zze)8`$J?xWCPyE!bEM~TYcisEk2jrwnr@ABdn4HjMZx|{DU%mNb$bh}Ct0Iw&;}e9$_>Zyu zl6#!&Kz3GQ{B3=t($}~`{Y|8ukJL0)Dy3@{RfC|mZAP#KpF3XnzA8P9Zhl?AD<8T z2;?t|!I7-*L4m2mjjz?G0mvSi!Z|ZMzrl%IO>?Y9mZF$>-J67I;K|yS=s6u-Gg&Rw z!K}jW@Jbr}OpAc;&nL2IS}Du*#VPl~Z#(TJME!$JEipU52rmX29E8mMT{q+CDO>2} ztqL_ZA{fLZg+I}qemb^y-6#LDwRUyU%vxfcn6a=E;%vG0p<;nm>rdZhetZ7=&Zt4n z3&tDuc(U#?^TFm`jkeY(>C#2RBMMvV&HhIsPWKDjH%Xm))Ul>CW{v3etapZ=V1(8o zBGhXX`N0wkb5SdJcrL&9mcEx)d`d*fdK`=#1>$W#1#QHJ<2g$$$U>Ti@*qbhNc13v z*u&%aRd>b?=j>J!R`E6YsT$*`!*NQ^97<)%WT!YNN;>v|k(Rg3vFRZU)}<@0rp6C- zE`%ScC(6o7`JGyB%>YMN1w>m;+AC5Mbuu4*mN-3WheonRmI27Wu|+D@kF6;iN6eOvF~=Rx`v6Cq9_{AkYu znBj>mS$-529WFI^xuE^+IX5?zrh*+VqW+1a_w!hq>O9No!FJ8*xNZHL0Q&0-q&Q=B z7w~BQJ1Wdt8!+-0hDU%`LUuwx$R{K^_!jNe>4(}7_F*l@E&BG=lZ`udF7sPo zYqlei!u5gF|L?H_WuUF0M&gkhR%Z3aJq!CR^`GoQ-c;BWOaHgempih+)#JPvV)i>& zs7t`EOxmSG(kd5{$&=kNl7jjySi0m1#ryzVKMd)p=ewp@kFyTh9d$$G((FKqf%))t zOqypRn%ni)u|o-ciE7`GW?z!n%k*`(l@}m87QZ> z99FIzsMbc)M|sCb-{!)%3Z52}G&E_wz?g?1XH0*?M>9 zDq;(z=Pr>u`jkmO^Y33R4#%$|@FPTJU0(mz;y<1}$e80HC4DnjT~=A7ZL_oAL7yrCuP0?0!1UqD~`o#S)U2xx;$Ypc6Z>XZLhQ&yGdvp)pCu&xUt=R?##@se_OMC zm$rw9P0%XFn22cTk_3<)req)GbcvQ#V>Dp8^2zURB0`gFggT0_f#W%fhFr&aQVi1? zTgl2Iga3j{ziH46hV2Zx4rq6B!1=HH5Rks|ze&i@OXjL`w~$v)_6zK9`Z;0Z;nGt` zZ&#U?F0WZ}p;H9FE(u;&pM4On&0X1$9gECQjihPqy-!J?Ff8cE)h2{h|h%l4(uRQQC* zpr62d6^Q$3h_quN@UuZI5rllLadQo{9iKB$Sy-Y5A}<$OX~2}Cho-`bc;jakM{ecs ziukrqWjVD{lySk1-m#0tMlGxi9Nn&l?PbqoNY>q+#%Nnzw+31wy*}U-unSqy{A|*q zUWEc70bR=HC^RpG@UpmKMR7Na&k@K0^Sl(H-q}TNXfQpK`d;dqWCP}<^ipWz;`v#elyaU10+F6s75I zC~xkVGKn;#F0UtDz}EZ1MWs}?4PNExYOBj*`1~}Jz$!3qxoJMa@(a1EcXzn8BBFuZ zNPHsRL@V`GQxNP(^9>W$t1RS6(R|uOHs1|1Q)@Qsx85}LATR?`{Ug04T6m8of12EX zjMXNNxTeqW=e&URvyEi!Ds;PYdC~r3>tvYsXORBEWJ%5vd2vX?veGlKk^WGR5n<Uh$ne5!UHMfL#apE)1PCbB~-zmu6WQ@hXzm1>5di?BW zBg%3ahNTnPQ6vN_*r{3E;S9-&=mzInj zS!%BzMP4NxtjZXy=y1F8mW)g&+4?GYKWLofWV!HT+GyAu+;W-=vhORT!o(#s7qYKm zZKT!(Dqh-eJ;A}67WBW9NQG%vLnUHqHff+%Jp%h%Zb_S=lnn|NY=YXMS-{D~E8Nm^N35>O&4be8 zy`>50a_#3+TT)?Nsp+s=ha5y+=^MQc7@utF1~3c-6D)Dwc&;7N6$auT5Wxeh+ZVy+ zurRLGW$#Px^SDzl&znyzE%t%08EujTxA0MD zVwuYuobd2a%0|-TzN2`1&HD;*7Ht7RGQNTCwBYc7oN5q z7HI7ABiMs!`F97)o(1jAWa}fLNItEsw=#^+ST@-DG^5VKfM))BkSj4Ep=<98VW7-H ze4Dk!9#gH8%TTf?zuFH{`lp?-+FH-&wcgo&b#8Eda9zl*7-dRCIVqHc)aJtRx#5}i5Z%Ss|$xjeuhigSNL5 z;gC|-nq7bVs5R)6&(EP76U{&#rsS{fQ+#x|AT$HD%4zuJZxx~NaaG?olZsj zuW99^@f>c}Q#uy)(8{HQd}Y#T_vSA<%D&`5!Fws#CGN_@<{ShH9y`(CmluSU9}%eH zO1YM7P2azNKRP)+h>;tN1WQRudZ^e-m=(?4@2VsqpV@stmF#xF#%flfget1t0L!?v z-K1C!{`jaTv_^Z3af);#u*s?)3-BP(Vcb63ThL3|hlKQ^BXy8%SHgnR0&4x{S z`(E{>MkNP~_;i}%2)W6cjC(SMK5@*Pc&nD^EN)*Uto_Azo5&&xaEFNR@%hV`&tfVf z&DDncgPcKRG2z*ien_a&`VsbZ>oP%sbD%Q0G@tXIqFW`0=PyVx^sBFc3n0$8p4ys* zEGb%uCq0VeNFFGCQr13*qSp7ddi0=&KV8#wc37T;)c);Czd`;|mjT>FL6sm7Gu!s4 zC+HDD%Wo?A1gU8B(@$@d8l1HcjptN`mVq{Jmo^Svmo-|#rxM1-ob?UK!!q#FCSrfn zGtiyA7Tcbn{zuvS2f*bM60G;P?CUFT;C2i3gA}SLM4^6C$WYM3V@<{v;^Qij7N>pz3$V!5Bf_(I)e|z4lz_lv!%L zbJ^`MXVmV%kgg|z)$+Bn=XTCNSac&PuW%m5GI@->&I`yAz%iHP>ulDp6?HdI={Fp^ z*SNciCHI@-w-6FBspf;sq~($apCuuVkH)wi^NTMrE5Ye3e&Z4|VLvS(e9E2-DWb8Z z7R}lf!^N7Oxy-J~dn){vY=WNI9EauLHT#}25rMrgJCFYPvf!zE_YsC|LQn?Q>-5`W zL1eVFviuEObHFW)^mJD%ui~eMNao$4dlJX@yN1CisS0nR-Akc*lhrnbc4%E1DHNRk zEUWSW%leP5I)})@4Xc>6;!xtJJ0qm6%^`cTh+Eu9YDTvRMBxgGOCu8?<)&!N; z()bK8FJ0@wxlPh7VkyH*USj#O(X_#VqfvM1ha~}v`&p1$2uO=K@*Md)P@4K(&zB+ zZM>Y1jKoq-6N0JrH;80?ju9{9p_2a7$&@Mq@fGL)dSgI3$(&3nC>e$s?ESp`ZRU@$ zbQ)po{UrKk-SSz|Sd*o{Fcmd5?Q@-CDNKr)Xmd4I*(t2NTH#V+Fe@(BfyK+VdhCGi z-Vb2GFwyg+w}yI^=H1_L`_g!KT!4W2aR17NB=_dXoG_(*)SQ+O(|x>~y)N|j>4L2! z=_wm|!4v4jXk{Iz%{Ll~0gtq~;i{T|o^k}c-x`L>Ph>o7;gH;^KVf0!D@vN#SC~Ds z_}(9O413iZt)*h6Ox;WKDxi-^8NT)GwwcC-od-cH4Pi9RTnN0;@P~zE2*AM|))hn4 z>L-snn)zO(IzPQYf^)^a-g;knrJi&7Vjb{JX z^H|}^=~SX16V6H+ctBl%tkW}MGV_Twks?%_-uieg4wm3~Yk`26iIF1`4gr{M__gnV zNmJzuMcvs?KhjIxUAY-zxEc`JJSQwV!w=aY9Ap=`F3(oR07oKhbuIER5U^QVLy)amR5&^;(i0({kA`qFLo!Tmnf15Sif) z^N#lJj6JwM?}^C{E)!CXv6+EhR+3W03@S{NSJo2dZO`IhV4^h!bVaC+3*NA7)6#EDXw`&LcHKtd}9j zXG9WIZOdiLD*4&;DBd85fhV+Oq=mGL&!3aeK6Qt@|K(|KGo+Tf{|njvUEzX*E7wf* zbRY>Tg|<>DW)50cAYXdUVxAa_#B`l3YNmek1jNath5Nr^B23NBc-F*N0qiVMuKe%C zo>{J&1CC(7=goTy72{IZ7m%kL9njzt2xNx_d3E&G0$~4{y#A;kl8$zI^2yt73wMY3 zbgil^nlD*ay8-t?$Eg)N9IHGXeTguI_{8rMb_wuPyJ4 zcCB4#nE8J!C~JVOZ`9B%?}w}DxNjjgjN(LA+!o;=tP}pzYPEcXF%8+YARG>+2`YIq zE^4D4rXDlWGi2lX!Zb|y-BF(-=iSGtjCCB7+2`^}wK-K7lPk$@Wmk#hIAB;NsHslp zq|9x!r#*`jF-q~vIP@vs+1R_v-zsTDQJ9_Hc9e&!y!=ea+1d2;bTs3nGsl1)5O9Tf z{PX8m3Aj1-sX!lmDX)9(o-%A@IO1py!ifabE{E?fad+sM2z8r?ge}nmjs$mMNOt&@ z9I3DwwA~#zToLmf#1&MZwUw)6CUcXlJ@dM7o8Dj6X%UpMLR407ufbMDuX@>RK%$M5 zJuC9SPs-7DkD!-~bV%BryzS#+-f^%4-9YcW?x9Xcf1Nwt<3RO%4GS)gY(nt4L{Bq2WK}3Q zddMlrrtmNQCV{(3ORW)ZxROSzKv-GyYByg$JG$edWY>w!CcpMGQS;$&5*PmUp`=4r z4bO;Xz29ihwrx%9{|`bGLcvEPNd{v^aEwZu^c%f80X5bd)tBU5?pGd5+<(h{&54PN zpXw+)MVUS)GAwyH?9y{YI=`bfnA+11Dy5yC83YSVDw|xinqJ7+uK%0w$mlAv>0+|! zBP_)?o@B}E7lRtXtcW@N1Bme{i|F&*pQD}nnw-N-jEpeg;B**_*beN)CS}K0%vhw4 zL_{kr{W-Vjsbne+5`jQq1fWVA!9Jp--@I3+WW8#xF>Tw!orsh*%6@7vD1*xG6VknEP;gv^wTGqTe1} zwoi9+$gb3L#uCbnTa`rM{>dYc;1a6ev_dRP3Tmmp-R=3=-r+HucuO!RDJ4C4-Ig}R zEE8@5=e2ynaVeAzJhV{IRYxc&*vTS?*hdi8TGJ_YI&bd(Rm2$;41RDkI2|n@%m^14 zGcZQcOMN^>*H!miSg{`Qq%KY-kA-X#w)p;hAk*o!B*X~jS%I#)A;${gN0uQR&x3Q{ zvtp(DP2-Vh9^9Y5*jDP7L`|Xf6BPxy?3qb;tyK!lnREVlvarSCX7k=CGMCB152z@x z=)&9cb>t_TxxqFkaRgc+Y@PU`SeyW-Vfy_W!#Mo;Z#un?GFlnw{Nv4}F z_!){z2CS{8;@bXpI=XiMa?7~gk5SM^?P+ZFBZ65}l!Ea@`F*<#LrcJAmQbs3CJHl0 zk(;vyFlaH%?i%G0MMQphC^S}O^uT0`9p@b$e#Em-DN$uyKQAMTqLHV|FGi>-qp@aV zO^?3%brnF=-vBnbZm+c16@ITAN)bPg8>yyOof1`qcojnXKNgVlQ~?%p4Y+FJ0+4n0 zavA~2$B$B5+aIBr` z8t?vAIHYTSOzeeS0k$6n>!y9?PeUgQt^)7$`_iaV2d;Spk`U2DKVNuyjz+;%t{qAQ zht%yQG5*(&Ld2s|u5s1|giYg}_jQ6URSbPHmM*&0I(-SWiK8F*z)acnKw_R>-c4fC zjCvIAGRcPMk3mBOu(h(NdG1HaLvvwmy^7#z%vg)dMNO;2!S4cvD!QR$Z>2B8Z7-T> zp%DLVWQAex!Q&P=)=k#|LfNxUlLz`ZU7tm6f1hrsNPJca3p!;S(@l|vi3|%HuSF`peM}lTX9n$Q40s?{}(HdTp3%6>B-}-?KyRe1p*82V}=Yy@ksf#`|(?&Yz&NuYRVCi`9zm?Gp^Y z6cjb~uo&oSXr1DxITH&BVftEU3srW@6Z0L4#bP=@-1S^@c?TtUkoB)ZV}E~A!*5&R z@}$qD^$sD*&B&pH93|Mq}*;6Lu z8LBxKGp-;hoyfj6(gjl12xKPD!*t84tVVx1NIT@|Zgvf5pIVq}S|>wV3#Z7v&+5j< zv}%0o&$G|v^n_mUC_jY`;HEP7_9ALl2!0#D-If-6&YK57y6^gt;}gx1^6Z5AcaGtcZt(+7$M=|-U~x^ zQ{uNR)mKaR++Oo{w|%WGQ1uh-MkmA;mj3X$#v|ko;xh{PF`n7$!Su4czB-2prt6W9 z#Hg2c4+54d0B8iBtpuT!w8KUb1xymybfzCu+oJyA#RJrL>*m89jtjn=v^vDvXl?o% zi+PMXd~w-?)j>4kR2cyhx;cpi_bnjC+d|V)Y2;!xuR!KLGIy?HoN6$lz%~;s8R@$w zVuun(fWC_F*|Fv3aaLtKz0rOI4oeooxC+==(SA1&DsKnzm+2D5D0791+7e=C@36C3 zVkmQ__J8uaF_y@&6JT68$o?Via>x)zZA=PRk+B;7>&B6XJ;E%e6?Jo4s&dwG=KJxm zJhHfak#!UbGeqO=HulQ5=C8K!WzyhN)~RW_YQ1Ww>`$u^xVVtV-5HCsuf5w-Nh2p; zXcKj^%FGV_NmzraWG(UYI2_>d*kNU{KO{hr9gbc|ZqH3U)%kA;tv3kyuMtKjOoem` z03V{7@9X|iH&UErd&A$We54qENB6hJ>1W+H#m2ndOjK{kI3KVMGRm22XMd;5I|n^p z5IFwI@?M_{f-#qxUJ@`G^8F`;LT+N@*wOqyyA8@s6~&+0`5jD$Kh;0v8HnLnE3mnn56KO%_(QD%N>|)|-mY~;bNc{?X}{h;tGsoip^3SpmQ>u2ztg|O!_o&COMq(u z@~rno=WxsnFNtpeFQyN@DbH=bfP-;syXeOd4E zE3plIl)S_UHhs-Pmwaf_nkNN0IdL~Pw;ptBh-%EfGZrRkMbByOQhrq(c?AVT3s8{0+NYgX zO!;rd5-Wa`QnBW6kz5jzE6}q}yvQMYb7(hB9?PGxe#BPM)+R6mL$v5Woo>Z!nLcD2 zGcjo4i{jS=oh6@t;5z||Lq1><{tT*p(D?v3ZjE2)rc$p|s1SSR_#_u0(&G zEw0Lq)GRXwS|y}M*8;P*j-86?v9xj%V|3`%dY>BRl2CUdaR%@h_`#&10-&RwKVhW? z|5^nYX$27=E1$AVFn41di`@`O5O#P~UO9+joBs1wPUEK5QNY*P5JSupFisC#J<~FI zOvei_+(k_|!P>rimr{ei=<@bi?<=ck&1GpZ*ToMu*U#Og=)-QMTMFl_G-f4j=|A{> z+G)mDPN@{qFs~MN-P?KMUwFKI&@0=6l4d!MX2=a`BKMgyIgGH01STF>ILKy>X$ezV ztXHCpWyiAs5ZIW@$mPAlDOL?UtNLtjKpMRxMzKXTNSk!$v};@ng)0@aJ!GR6$BC^L znETINKpr5?EibqOPN6?Wg5rgY1klYzuH$vG*5C z0lS0iCQCC2@JG0e+C0&4%Ii!+1`^>4djnoNe6rfSaETX4;1Q&*2H#Jv-*|@pC04Ze zEu6#&R4rWlCr)znN{7j%h8X$TBSz5?f&^Vj*8M+-XBf{oOU9{=2<&??jk@BCii%D< z)P|fjIRqG!p0c1Cm`=2Rq<($DHANbPZJT@Q0~%2Nd*r_$;kb-x4Cf=Fgi%TN3LG#| zi(_Wz#uTivS1V}?9oCBWiV|zHwy94n1~9GU$78c?@I}`%8mBBB(?zew`pa>T|6cFz zgK%h#BgwL~$CxVXjK0bMEepy;-Ye!>bh-W;;l%d#+OX+E*GHJx}mzB+K_1(`Lj432Je^;OW)9HAc_hh;x(0^;RO~-F&}BRp71l1M&b*9 z7kiJ3k2x>(^1;qi>A@Of0a#8>UwNP$ndt|Ynjh1qPIWo>2&p}RvA59z)Xr=}1 z{Gct&r3xvi6Z{qAc_kHVVJlCCewxzTP-ZNQ`BJV!!Bg*EE2<$$|S)!|!D}zAelFe{`{xH4#^Y)a^z>I2X{!(Bm z9Zpev7^F2jYVAVza(oU{c!YtCrNO@Loq3A-?YEmX;@m$nvm1KF-x%*!)$`nINGj!b9*`)1Px)K2X&D5r za6a&WJf*e)9DIW7t$$&HDLcTV`OkOjcI^4W>#ffX2M3Q@Krbdsy@8-5oY{3l1V*Y! zceSystm>PRQtdBlod28%|L=){F-u8rKikV)e+NTQ(+L?n1ngx$@q|yo*Rz;_bk((n zUbXa=-rrZeKlbpB3cS9jpMR@2)9b9Ek*kkjT{HUC8>TFe6tahpNSl_>^U5~z3Ql#4 zle?rfc!`oSPrKcQv%nT64E2*lOIq z_GmQ-v^NNF0e?h}XRfEgKahB(J8H z`*g0ruhVsB6;;@z5bs8B9qyHY!ChP7Rj(Px4%+nxqQnR}{vT=7%&sm7M9C)ReRH38 zX{)gs-;Y~TR$)cQ@05ky=3{;+j*QDo)zOkeR*Zm@k?kOCZCMaGRb!-=m~pE$2})bNYN`p>Yc846Zv!9UKDQi4Zh#<}6_6!cxA9EzU?}9Gy{Y=6#1473tD1D7WrzNS9wFwrJ z4k(@7(VpJgej%L8gz9LwLnN*_rM$^~FZMtpB|E;>#K4)KSSx*dJPUHzDpRj0t9MWO+Gq=zR zTDU+JmO}C~kLHOn`#Lg;X~`$`&3decAssHY!jUN#kwO?J7LHAAUP)jqd$)$(AX zy#CfD`)u}wblkdMDL&)NWgr6Cvez%0SJvlP^qrR*_hF0m^FJ@f%$1t=rPm>_dfq%$ z_ll1lu(V>B!0G?*0_?7pwkSjq-;LtI1>Q-gQfYebEWK}`C3m_lD>3h}=^gAhaHN$q z-u{{w(&6R7!8$y`(_7%5VHd?BNB#4KWtutCZgv#Tu=k9eI_ttZk%5ckhYL(?zL zbbabKw}0S9$~it+qDeKFa6f8(nSiptz}|4K32K<5xZVkahIC z-|fpc7}gj?9pBg6mHqTOpx5bC#>4XCL3TbgrK$|qGnp~ z?(=kcF(%9N+9j$ds!k23C{gE4FWkY;=Xiqmi=TvjbDUvDfhgph7|BVpNJ)|i|6D4G zeuRQuF-3brnX*~&>;lP`wNg!=9dYWr8JvW1w0ln|?S~DTiskRzM4{`YtQOd4^-i4< z)D0ghxNb-Z=YWm6MK3VC7xVU<#;#KOOmw_e*p^Y$i5iO)!}M(<`F#}pCW3;EI9(6B z_V7{9ISc6_RB8wu;9$BX_qh#gKj7HX zIjNS+m`14@;ZhU1YYIQvd)%};FxW`au>-Eq*G8+nAQ#2I3+_&3@l@QeKE1BR)|qn8 zx+;@->7F4G79xd!vX6R$NSd9nZ?J??CFPgx%TcWD5)mKK6lnH2FY7K(j6UZ@poiF? zZQQy)T;z(SwE`DYE=G%)yf{Wykrr7SD|?S24q=>iJF&K0U2B4hWx69;os6d0Wz}UN+v@?obI7g`Vk!30m#v#CGQ^IN4nU3K+N{PPhy$hU1LvLu^gSX`R;(9|C1#{HCCi*BDbm@RH)k zCYoy?dt(A{Tw8kYoh2nBURvyMwL&hkrr2_vyAd+(=EnfJ@lk1Itb*U|)+;m)S=O|2L;Pn8JO1J)GrYf3Ohy4~^pJtE&7ArnB5ScJIMp#9 z-W#^UOFtvbDzbhPMYd=NO7OuzY=n%>QOl#$h((Jq-L1NX0!PM|{UuFqcH0WU0*J>? z{za(!y2ro6jPIK`(R8^Dsi~{g=}0q}%FVbq8{C70yK{u6Dm?{&X+CNEISSJ(0g>{p zq`F_GFRI`+E_t6fF8Ln>qnfVz%b}m$o$4ntDk}67*wuimg(?r{(pa>w9D!A@rP{ha z=k;5c=LU!kRq(C6yi#ry!(g#*TQHhW%H(yt#_c9R<2d>b9g9OpMV2~6e`GwsOoVT) zlN|uiyWAuB)&d$l77B*A1Dl=X=t^n)Q|(Gs@yhlwvv-=I%PPQCJ)yupq9jPjCqj$< zlj=YpIEnU2n-1MjVkrX22*nljVHqTyhT%L(Lp>4AMtiZ@V*NZ#S8B`2FFSeDre{2Avc< zDW0C7j(SD@#c)=(a`1n}l!G7mawfEnR@OE#RT|5z)W-uFh%@ z5F(eMiN?0wN>NCVZ2H@UXgkY*jg;iP7Y!aVE+GlRQ4#eCN~ad5sbC9&H^w$Ye4hFv zc?V=3-}V&Hb$7z>^`Xy)+r>sZRBDp8yOs2{RvIZ<+}sDY({l}z=jIfq-PZuxqM=*W z_o@v2;t>V@({ja1N~$|5qa1bR38K&`ya3I&tL<(diCBb*J{$0KU3^99P7Tx9t9aN9DaY(Fftiw##koZCB|h1P=p*Yj$_h8O6)c z%4ETr%afz41d>6=$2fv%9dJJ1Kg=a$Q=&xtb8|r-%#dG`=hakd@}gXA*RdHeY!GZA zZK`gjuDkXy2t(G(Ml(C5_~x#rriJ4y=%>WivXFz`nm}5mwv4{DC`c(?$62*Yq zn^gfXpWSbw*R2X=Bq=7Ey~{Pv%FAVoU-CHGYWKPuBkBR!a(oWOKfO;RzJeu%NTnPd zOApYneRn%=(OI(Lxj#d)dA*GGPe%NrVJj5RsBEIj6$MFGghm%COn1PM79D!-IG4R8 zXR==4m&THyqy&(A3tw8BUIk{lGM^{X!+R3u=^}iW7kbXdlWSiHe)j}&yB!{h%{QiN zD`YwBd!TjN3$s=}tA7dTDamN`L4i*1ExgdFT7s1~S4L*B;4Dz5{f3PaWha%&37COB zC4`Bi-QM1!uafJOLmtBk?NDO_T-~e{5N%&=A9lX~ob&ki_kYVD$c^zPb2kbj>LQvr zLr5BpKZ---s~?geR!_Fa3ZYah!+wfj{g5Uaj@V? zo1g$$*lWi{>9&*`QA!*y9@;FDGrV)}s@e4NM39PsbC1B=%49zipTIluM>m z%#C8*OtfylvcwyBzm09RT?gNTN{mXZk`XI>(l8y%95gg@LX9rjB>+;;P=Y-LsU#NU z5~4rx!N8dcoh*a6TW@;IWF28ZjPr(M>GSdOZ^N^NTQJ+sGqJf#&@M6aN^eim)d6{e zhCswBIkW{P8}?rKm;tnq@XASLTrSa#o1Qq^Jpw$R_VY|}zc)rwJQ5Ra=6HDWu(uDN z^9&V0WNXy97vR)=<|2qbKt=P-1k{XQrn0kP80hvWUuE?{ClPW~Gf|9oc%eSk1QH|(Q-tzGo#03n#EL2V!yaHbn_on)s!0E zTC1L9Th(T8EcvYzNx%R*pWiB~KHo05#Rg2IE#@^tQ>p~Z#%q8Jq#)*h0A4evB8Fe)viyK%EBEb1ufQ^ zrnQs{c}QMSp&f+RBe#@N?Dt& z0b*umCeR-=fUP$4|6pl}m;!ExaDi%0ZaemXD9-T6$I%skXCJq4P&8KW2-;W0j3iJnHCLl+LwUP(L&^j(K2s=xyJUcLpynQlD~A!Ydl<1rb^v}mrDl|`Vdx>kFHE?}WZ zN~uoR$r9^wRgQxr@l@Z+-?wV%@-qb-k0O-&osHxSm2Zb@T3IAdZ>~U0Rkfog*#0x>%NfIoE@c?D55fKF*h||LMj?HuX?NW%ae75Zcm{y2ugj7Q% z=!DEPpr<8J!eH4G3{jb74hKh+a#WG6`@X+wSv)h@yj8D+AD4o0>T?)iSJznRYZhN} zOfT>fS>_1HN6rc`Vp0Ajw*Ax!l$T<_YV^HPEO--BFbuMUp~a1thg5t$t%_ZSZhxIL zMZ!vI&}LJpS-4OWjpNlLg;XIh6pm!4_3&qUp4asjJnzCG{+E{y=(`yGsGd)Gn;-I` zlXRytDTk?=*JDqN0WfNZjiHM6$>7pfMfv2r8>$qVtwVtRRWj@L(=!AvRQe2O>K9gBDXRNjbM zNFmXUdik3nAYxjO@$btja(2R{<#MOc&39CZpNJOZ^AHh8L}+zDh~T(9DT=GDxd4W8 zdsIHof~I%eif4H_z~{vIu+)pIk>Qj-*wuYExveUH!?w|^lZj9LmN8n@y0@6cyAf=? z)|gYCh|gY$#9Hd3y2zK^6jLPBGGlTQ)OQ5y%ujoZ1V{k-&nJ$MZ0V-L&Q5is-TA`DTd9LV`CA_?8WELt zNUBlWWsLrP{YPqQg_UpZ^ZqoNcrzyMr`1y)d{^u!8QP1-mk8W2W#qqvVH6z}HEL5q zv0U64BGwT0miZ#@u$6ARBk-e_+XM7@bIx*S1J79_Mz)+PORDjL?(Zoz$q@`x=-y^A zZQUr~=cm^D1;g*0R~JCN`D1{HwoPvowu3hTQo7BQ6A4`!@Y<~i=i^9Zn^V}w?#-j0 z31-fzfVlKg-vS2T6l&m<-D2Lt%8;A^V$>z)|P=xd%Z%8D4B zgEB?%=iH7KnryuHi>n3|l_Mw8;;UOvXma(TOp$jYJ%x3Wh)pCyUb{QQ4D8cI9SFNC>2tB@ptt@hb9g^4tx7 zV>ZBc{AP_gm`IeraCr+?{23aCWxD^QqcO|!i?58B>c>VaHUp@&n3FzRi(BvwUaxv& zeobq9?9aFg^8)$7f3RNILZLz~J$mFJMuQk_%%*~sgs=_U97T$NjaxX0jcNn21t=3X z(!f@i$a_9BO;ZrMD@$!D{x001hUs$~VG6J8O-By8-@NVXeKUCmioYE+R4u>X8RHQ&V=Zvn$ zV0J0HEAevGg6Va##orC{%nXJE_PzG-YoEgs!EgHG^WaxgQ3n1^hI^oPlUt0DHlNy}Zo=qAu zC-~Le46OATa@qtaB7a^SUpPuQEA%JQ_fsoT)|52AR7sLCSjSTo?V2#_E4F;3M5LeT z8MOhox>GPJ`c&f_cyu1$TmGsbK0nJeM?r|gGFA$Z#`3%T^o7CkV39@X+?2lgG~Dp} zv+?GGJ-5;i>Q7+0&Dwkq+ug+=?c=`Az5L}P8$!_e*fkjPK#ETIJQr41kDCUX%QsE4 zAV9}GDDE~xHPx*7+rA#?r>kZ7!!;i0DUGxmH&wpAQsgWaSKq&|QchlM7jUsdenxdV zo_j1OZJrOgknaY~kVO9Ol~gTfW6!g&hBsfR zD+*?QDzO`|&9BvOcMy9zprtmp9T%h9Ey>@dxl_Wb;}+yJSgW5n%Sgf!m{jUc>hAe3 zL}(^AYryeV6jerYpdKZdXrAXbVU|~+K#?X+SuJlm=) zoJ52N&)sWK?nLtD)%1_R<;GiSD@sVo@f@g-X3S%#R?n4r7t|=33WuySCj=4Aus?5J z-5C}_vT&VsM52~&MZP>q95}ofy6@R6W)5{6^Mk|X6#MOQAK}g#kGTs8a5_^kOF^i? zBDE@;2%It+lyOQjDd%*JV0Zx-c6D4XzI#q|Ox(W!S2EvFnso@mbom1|KLps=nqklW z`m|o+8xDBRs{>n1s3;c0x5%wpyxZ+Sqp0yzf~;IliFql{H?GU<@b0(@NAT&nJeLHA zWoCJJ)!H@Vr2;JsqlOJjZC$EF?2=te3`Fj`3Z+p>us4jv?@NdLO z;M=7`!q;9nlx$hLcdvWSZoAK}hn2d}1>PuJdt7Zs{2l4L?0$8OQ<%%4F)G)B;-+x9 zPhTn9lh@$0_?piXaOyU@-ixHsdLg$EdfR7RLDiZhXGep(?X`N9%ih85SBU9IUX1vn>0+IhS6 zv3hwZ5NG-Z_qTMAFK^PWXP4nsqi4?*i=n$e%u%L^0_=1}|Nf8&f#E(U2FwOOh7f5u zv?lF*WYbLi5^W~M(Jztspk#Qwkm~Td-II0uvOjUqnRJ_R^3H2*ig9CJB9C`l?let` zlRayxVW=`dsq|&GUM=!6LH+HJh1%_f`0d4q{q2!G^z!h#Cd2*(?W4!Y$aK$kzc*o9 zN>rw$DzLIXxP4 zb<{#&`MJKzVA^&d60ge&jW{psNKuBWr%nXzkrPkmPh z4Ze9uo#kI;$+n@9-a_M&u=eahM6yR?L#rveWg&fN-G)%B_Cxgi-D5!4-ZO-+D_plu zu6@9JImV`^K-3!#47ydT!DKq=-jxB(hnL*+Y;L@lk1z`w7FJu?S@+)^+^Ve7!7 z^EG*E^Cb_;S5wY2^%r=X#w$6M`2?@9|2X$|K9MqCCxKR<~{7DPiJmN&2@}h)VC9ZQZvD`FQXZ1TbEt*u7=MzTJnnU z=y*bMpY;}2@o=f~%S_P`WGd_%{sK$Ea_T75gMglS))5ent=qL=1*x3c)`yRXsza;l z3sBQexe!^)Del>|q~71>rKoi{zJ<43N1C7v5d4Pj5(#gS6k^boJhuwk?l(l@eKx9! zwR%~j_dcrgrFlJVq1o^jhUVbO3DQ;-Y{Jq8NaS+V2*rE-SS4iaDpm$_Du*2OY6i*Y zZYS#eEbEMEk{_pat$XpF2iJDUu=v$v?_M-cKK!9O#>$4dhzS%Gg8*)-oxQT z7G@iko@~n-(+Qf%KXiOpdBs|W$d`*k)2h*+#>G|Q$pA(Q%d|%i%4KJnJ=Z>HGn{7`BH|^)0(v^2>rI@Nq z;D=$Wpb4q+LAcWjb;bl3)R8BJ=$VolA@x7R;*CqT2@z;qfQgO;V9o$j{`tXpCzINz zN6(Q4v@_Aa)C<8ywX%hqh87?Yz@7ts3L#Y2Oe=cHX7Xh*7a}8m#fAL3V)lA(>FL(i zXKv^?$C9r7l>Yr@1<#l9VKh`@mx2qBsGa$f#^V+F^`okw^u%yfUZBTxzq6hcdc5z5e*JQI=MvW=5*+=o}iHRZ(8>cWM-^jSF`mGR~RLBo&g-| z`=VR&0(_$JnWcS=LcHQ2{Onh-a6pyqEsfAQD)FQvH$^&Dia#Rsf`g{PpgV39 zB;=ejNu{<`rfgMcKPI*#*Y-~(`wlxO@9F%Co<_o#s8_$&<)X?BPc)#djH(+AhBuhV z=ZEkhc6Hu2`mK%R+^P2mZvmA z^m!Qhe^K@eO96v5hkAwV4`Mjrp>Alobay-sQ~Xull}91+$?+@4gFb%eg9KdZRd5$f zmv%jlE7h!hFsHPsVQEH%pxP0qgY~9&-z)#CH=fJcCRtkQkKT?s@A7h;9H;fkbA|fG z2Du zS3Jm?HZE{>ZB4MRel-ig`@Eteaas5@+LtzDc%VavZj?@vi3sMwffU$jkH7=WdgO^? zGcsRb?KVe-Ec9tby$2KE4-@pNmy;Ohi6Q*qz+6c+!ZQ#yhGy^1R2iK#1WZD+-_WJ! z;Y0EY2zxo9H*%ioye)X-H=s8Zp!_5uaZ*_z7Z8@DUao6;`?UDAnHVTLn^O^bqufWFX4Kn~}BR6fjI?PowORg+hssO%5`e}l)n zl%riF1Db_ZieqLyJVKk*MXjo(jluQI=Pov^fOU6LOpJnQLu@O0X{j{&`j-J~lMA2S z6q+|>Rk6T?Np|fAhFYlR;~Fl%Oup?07_5Kh`<~lT7ygdN{OdPRO%Z}IkH?PcrN>UZ z4L3%pW%gfJ9`+AT&!g}c4)rdN-r1LOjLqUFpwYEqu9WVo-a z&1yoxM|Q^>H1u{8%BTA7xZTnPee&J1v*5m=?;`VaaCcN3HAVm(IZ~kDH-m2<22J+j zsa)-MJhf>)Wt##_WFGUlRLf_w1*fX9=b8vD%S52`~ z2%jfT1+aQ$2GAVvQ+e;KbRp9D5F5wAx4h`M{jQ4h)@T{|kCVwzP!$q{;>rwSlT<2X z4n;LnH{i;~Xvq#FA++!nJ}O31wp z+B>}LiqFOG-_0qRyQo~o%Z;2{HDBYjI_$=x+FAZn0G~;3Pzg6;2p2v|G)HD zs9+Fa55Uu`F!>$OgIXxZR%dt;e^KL%R<^HNslZiTwii2CaL5E2E(;HRjInZ$7WLU>y%0xz58Qk)mxujD}gtyn zNx#EelHrIV0JZTR?7RmS3Jh+=hYUf#u_mIPnz4f)rHC2#hg?U!pc+UHF+Gmjce5TG zfVtoCjo2{4!%KBj)0jyx#B)9=Ol7vMLKoIchqg`A%O+%?plqA&S7C;~!l0WF^CnM} zDziRF(6dJvlqaU^qOXA%+>l)fJGpe?pOD%4wx>ADab)JVcIsJ&*)?3AhJ>ObzC zh$zzUh=`q9By`u?;_YhQzV&z~Pp*eFRW-@Z7Vsl``K4lH4BqPDKS+*eb*2LyGQ}!= zt6W|?rC@uhp#}*>iCnD( zqFd!hbHmpE{0AY|L|$tmOtwy{x)?ooC-KhTrw+L6Hr+wK8*EA#S5s$4-u^p7_BoKh ztIw>#x%=eSP?MU@{I85)kVJ*9AA#nom}g|1&*&W=gK*lM8nYco$Tv!8ptAIdg|&r| zWBJDh;g+4=ePcN|BfWItx~N!Pc7;)EH#jQ1R=~qi12fsyARk2>quNN=k6%Ls0vD{|`}&Y)ns$z&m{#j_DfWz{5oNZAB1yux?Vv0eX0oCOYR$lFK%Lj;DgHp=;)E*g;0~29Yzw{ zs_g_T=OP%6S4_8cbk-^tino!#fCPj>9cM(7C9*?BQ}iM(tLu?1dBS~%$A__VSy;H= z8HjudF*ka;--53s%A+Eq`r64g*a(yq>Hd9z{gS*Wac%^Js)-caspDU+D|(EAHjz_s ziHaBO+_d$XE3tIDkkl=O2DY@#rMOM!4iZ@z4kIJ1`3}*~gvR79PPsRR^ z>PPmX7p6HZSYSlJUJH#ViRvk33lVDOCSg50);D5ln!{sR(Q?|Eh_3pKr$@IXqH2zK zl_gr?;d$kUI1t4vQqI;dd0nu_=-&0G?XvQzP_wBNXzKF@8tJUGmR#5HRD-Gfnhux2@upJnz4geXlBP zH%4 zZZu`zydD=j66C*I(qkGH)6UR^Qc^@sJN{Aw0a9ooj1B27}c;4g{31wg;?# z+*m^bxiJm__|vd`wTe(I|95(k?C@4kPtG6;o->?l3Zb0;QNrqtp={M8`_1ix3`MH_ z5W>J6GtKN>|4hiG4gF8AXw$(ADr|E$??&cD)5n5Uor=ZcJGMESHw?v3pODs$_J5#&oMbbSS-M;j@KJ}2tW@~ zWamYqkCqVz@Edqxuf;_8sCx*RqAbA-yh2MfScs@;Ov-98}gbk9M(-sl=g6l9n`4Z@&)unmD89po5N7 zRU{FHoe4PU`{ZKWR<-xkx2T})mIFaHKyAfXyw_-9Xx#8oXG6d+0pI$L?tuh!u7%ov zvm+6vkfAIgq-xnh_Hgf<{Spa3R<+T`l^x^b5I1plkg?wIVXX|drbNDs1-`sKKMkF~ zk-T+^#erY<`nL|$rq6PUL0RtUD{CRh`mddrEfEw)&w`xa24nMdw zbkFp$lw=Z~O0Y+OH0!%}K5gudzRn;}1GS78jj9w?2?Dl!MjLHBAODTOjG-zKPW6z6 z$7N;5P_PzWb=Zvh{il>X%WHxoW^F&nEm_nu*!kX%~hAr^Y?S>_m~4_ z@#9q@i+KlAdUimB|A%~mVt$+1AR4`bGzW-t9|XFphGf!@Co;O&EX2)Q3GWQ{?_ z37o!g4=k3@heF(_@*;yS~9!G18 zmZUy+_|6=k8QQ%5mVbW&jzVz`E^mkfN6?vmhtR}Fj2(o>Lx-+$#zmYUKIv6{6}g;9 z?o@DFsD#^ZmLw*hlXt&NRNe}jPMgp4%5;oQbD&Q1rEa@$`W}N9k&v@qVrkNlF$ReF zhGr!~iPH2@DXPi8*ag|T7lQ<~p>xIqD3^&lUcRpGPs=Knxc|}eQ8c1_bfF7P(`lpdjxq;M$6-S6+N|WzdAvfmddCJ3lS-ujjH4-^UZlfwcokfkZr0v@ zmY?7=PeRvgx`hrS=JS1oJS`m+SoPSgKe#R~Dt8u3OfHZccl3NQJHif3vremUgrDkK zf+&&;puCKhm)O*`q1G|KNcgt?KI$2nwY(Lb%s-u7TMQ*?DT-c>AF7!L)Fyv1~{ zOn%8^u+fZM$Bpq8KKhy6>jwC(^GgoR7gF+PO*N*_mUYvGkP@n9P_Mrk$Ph_00eraY zq@D6UTv=x>92i)ulUJwAR)=oTpwa5J0QY$ID>T8gx}z(U5TZxh9fHWfBl#QlgJ)Cc zxZ4q~7^>aNx3FYez(vJz6Q=9l8&QJI5M z?HN&w>qQW0Yl!314`P8d}tygT$5d1fB@kZy3Dp@1xYR6amb5Tjr3 zka|j;`&?3L41>o9I`7=rcsS}MARkZX(DmrDWlZX#a32M`QlP1 z7#dQ9=e`w#us){m=px5}AV&IjYXCa9f!qAnF!?UUrF4G^>FAnS% z{_Rd(*x=;B3*v0W%G!La0z(m&j3C;5+Y2yO>OwjmN4I(#HMO#&rp=P08u8vmCle>d zPfD}x_+>E|wOB4$#y3}(alRXVb6UbVf1hu%-HlqaW$%a}fu^|c!F?)n=8^h; zoD+HMNumBK|1mokGw5ZnY|3`&3@9@mx}88Ix$RzB%WArju77%=Li#f{W^0$%N6f9Z zEOYrZ3;0&trqXiJ?g`ya7EKY|EyhbymX(c#H0Y4S2WlXNLi`Ic>2Xsv8SNZ?{T~Y9 zz!fb}9l9ww4 zz{X4r{^C|c!KO!H-{cxM@%Gms-`B0ZPZh6h-HuNNz9;*(EWMo^FoEoV#=>+l(11d1 z!Pvce?MiYAndXGM^`zM+(afhce%L@U@UE>ct3|2!Pex>%+cSWj^wP*VpAOOl)y&O@ z5!m(NLj1cg?K5tuuYq*!TTZBSjYnKEX4rWc*UXcu3&88Xoy#x7cgcM;JC{i9(4VxI zO=k3kqY+OgsFnARvX@HsNY~^OGFGz3zH1erX6wu78o+6;>6qbz+5kQD@#AC7QR5m0 zX}W;5PnU*g>h%b+_W#*fq+C|@2i-L*Fu4Lh{!`q~`{=$Zrp3v32jf7u_+mCZ+9^*?wZCvz%qX3|yktQkm1XmoqLn{+=;!gJ8SP|~ z1|FR`W~)a_FMk)i25-#tw|W#boBlAojEJ&CKUP5caK-nBP5dsmP9znTv})rYe%8T$ z1UZL#Cq&a$#!AoFt5zAORV}(ehNdDiZRjE8oPOxgj^AUX`0EE9r44HV}OO} zCt`3Vp<@_A95B`OEs;yMYTg~xNd`)MH{9g*YR2izv0teuzIsHtfgrk!?>EP3p`oT~ z@`lz;)^geVk=y)LH5|y@q1oSpQ8FyeJn?*TfK}NiQx3NIA=))Mr)?{kziT7B5(OzB z{!?6%CiE)<-B^}=qYa<$hgTAt6(brEpYavK2HB`Qd_gZgM}rCl0l`*G+@zovBMj;* z=WlWK0#`D7q7OY?- zh|nZ-PilVuA{c`aIqrWFQ};2v2evzIWzUDe5f(DgIIOu56YbD7n5HSXrlmkXL4+}c zuvh zFzj3esg02pgWW5QEBn8)nIO8Ulenu>sOxd65lG!t$B~bPQqBh-v3i3pTUG7eq|3c@ z0~!2vYW`s(1k#`~Of>%1Osi92cK-6(%xkR$>3K|sTUW$c^43+ilJ~O5pi6oU2Bj1N zFT?olw7_tz<%!*>$1o7d?|*^kTY>Zv^-JN3QT#;n04DyGgP)hqAyGQgn%n#&ON35u z_`b=%&c1yF^QMXq-nAApU(ME1=sxT^qms9-Iu!1$gUaaP>Mn;U9i4P{c3DT(JT!;E9d`qDDHRVDe4&MZ;!HSvCOv)m`m48~&YewjbcAs8zx^>8u{>W&czZouvn}WNQM2Rmz zSHm17g4Udp22#>p$i^+D6(zd>;$d5l)~1b^p9$XTGz=#`z(rdcry?<$TZ!MiJv-kF z+@{?}ec;|5aNA_#eq7x|-c^mAR(3Ni0lpaG8nQ5SM?y%|zi;YMj3F%Cr*w<-zmQWd z8O6kk;X0d0lbzfC%RKS6+^_emo{n3Jp-pxtW0)&HM@UyoE%E}y@mjJ!-Sqbv@TJ!lUKE3DO3u#(-;OgP`4}TPAGVUFQYn}>KxC~vSyp{1nu3zI4wJ1x- zvZH{KW*aq9j3oqmk@6C%0KmQ!61r}u;}p*~8kmHV;u-RZFn1*kanDIrE!evBb8U_j0zRZ#DE0frfmy&~Ig>jr@|u7>@)g*Ga6%?#744AV>7OshSS2Odv zu6`@Je|hMvfNERZnw{s29s>;)5T%kwId^U(PK;dJq^dQCT0PBxjzG<&mrOLvNB$$> z7$jLFs#o;(5la1l12}1utL&9Rhf=I+;8#E#AA81*u#C2-jJRU$kKmHs>7^o;C!?ee zSSp~+xk0Y4q*|G_5-S~fo2Dk4y-{6`pU~eP#ZS1NZg{U`MjFj+<_J@4<9!ayRuH~< z`WSoGLv4{A4PMs;rLIyt)#v(wwoY;~0y zb!h8;|1g2Si*4_A*XU!YiBcTzIkQgw;h2bBsWWj6r=02 zAe7`Jv9h>{X4$46GTwI8=F`QZBNb{y&&St3)ok3aHo;9CDmA%IOv3P%ibQYU7#wF( zd(F>#S2_o^lYcC(pdSn8mDE{=H;P$D8XjDo5_|Sxz znR!;;XhgV1G^$)Wo0yE$#zSLa5uB|J4j(_GdDmmif42Ab*?>jA97j!)4Uea-Q;iJ# zTskj_`mV=j!}|>1mDj4zy=}4wN6SA-UzB5bbQOzf&&7#T4`8w`(EdNxV}MbDE~rtK zUoL@|X3t9b^+QB`&cU_*d$eYY7)S}*J9J<3*?l=#Y6P%z6Lx#Utx6r(G7 zPmz;v;bWc7l>5$zY38xv?eLh~3k-mp`o59(iYYzg^{TowKvG~DAUsVd@XcRr&Hho6 z_F7Pr$EW!1MCKEB$d`0A#4i*Wkbz$+sgkE+crahnhplZ6qr9zb_%*?_ZP-EDXlz=V z=abE>l1SBDcB@f^*YkLU(<5o$51{i7s7QR_4sHf?B<^O5D>^7ufvbyt8S9PeS&zi) zjz5FF+eH;g?Lk;vM?sgnCnWO`4YT;|Qs2YD#E+s|mHZ0F8pdi{FW{P=;Pdz=x&Qnv z()V@$a#F!CUW0At%1Ilo4WIEh2#~mZE{;cN&QaDz;`vAqPsTaid0OsrBt3?;Xi@}J zb31zcHX21VIF5#Cw)Ay?iJ5Fq3^dh+st$#OhW?ew+@hWE6{%czSCOba(?^>1_h4lk zwj-TjM7&xA*1OOBxo1j2xKuq zY}cYsvuk0*qNC3jKqdyJYnhw35NmZ|o%n&v#JVK+BwPH9YLGN9r_MtRSn1YGhm98` zfwPey6PRV3nDWui4{)xnQ7oGKf($KyesI1$Z^mL~&gEZw<$yg=`2R8W7F=zBOV?F!d(cm?0#H24ukDK5MikZ?V*(;9=+Tfcg?c+uP*iu}G3cHF~ZX zgSKqC_c@Dl=aM?Bw5}Q0UNExVTgtUwMHgYp9s!r=TWe&N(`bVP><#^=(aIdvZu9Wn zOE%XLO8@0qOz4QsvWsRcO>w~dpP_(AjAw(ms~4?V2ybo+)PZbi!@OZyAUWK!3(Ef9*8O?BFLl z`j9O@Icbm4Ga)b;Z@0Pa*idNF9L2L+iYfBdMb7Ij`>Ek|w>K`m!5cY6KRpbkfkM7Z zE?JZJi}>4B**qt6Z5+Ek+(+(AUU$c%Zqk zehfq#jF-ma(D+R=csk*$hYG#on7f+F8J8}2gfNgS!Y_={4>8szv^Uny`1!}21wCuE z>3YQaI_iOqk1e`r^|ULun>C~6rSoqXQj%P(eCkbugm4Kv*RcUb2$BkB@<=3Ojt&-_ zy#QE`uG%L3DI7=zz6ByWp4A179Km4uPa$&WAW#=Si@D{~G>l8;AyT4l?Bg%ZaLp+47MQ z3=F*s?_%(kaU2%KlytbjRiHCg><_ZIsX6Gx>fRIPD5uI zhz^d@gg49pcuer3Ag%n!T7kup=&~iR{o~`VZ#ng(ve4g3gqz{#u|zEdi{ygB3QU|6 z&#P@tr5h;VsjO@dzKmaPvx#X%3Tb1dmRx953d9ieF%XZGR>YOX@zK0(l=%>d)*v*> z)u8f$pU$?-U53*80M;UcbK`D&)Ot`={q1p9|KgymQg8O@6C>4E;f(;aqpG73p>qdp znHZ<7n@7q>cYi`+kfFge;~7JJdeJ_La@lVmn?T@Qb^lg(=oD&P@DBnrg5oRQ*)=tMDWXH-*an+wB^VSb&5v3W5%Ewlk|zcC6SHs zmogb`vW@TWDREeGq(>U#EDQ3KzWGA%#iy5nk;}#zC)6VM&(d0$nGOq6ya(}<8$nPniZptbJ%7RO4=q=iTw zlEU8?DCd9*{KwGV5}`Jv9Nvk!O^XY(>iuR4qSX9xf@X9lMIdZHBbCze{Bk7Xb2cy7 z&-t__9Gu&Ynk0?Zxsw!C_K9~l*kvkQZa53$vH#5fB%GSZT_F{kWW0C zm1s9_r+l3HEDr_JPi%)a#z0qpLQ>}q=mwzx0ss?!AXq2r2MviMTzOVxizlJ+NiZFH zSu#C-O5>oYa#x=Mw=l?zqb}QaUO;Kot#ZO5*QY~wBC;hBaDDw{pyTk({OsHMQt{Z$ zn>n?1S<3uHdykHFe>ILEi617m1vXM4n*1+OpT~T@vVKc=52>15B5{2!*f~s?H1jE^nlG zl9;NuzLe)e6^f{Bo%D)mv*5jIH9V?p<*;p}IOnx3gnuX$x` zn~v^d{izAA8RMTvaukLAbV7B)uy_HM@eVynyV^8qa)NnyWVx*eB}G2X1(x()!$n0) zz}F#oK0E%Zk^R>TBK&@JxEb+MK6Se0tse^(eB1x8AgL0DM4#?M%{}xC15$d5pLX|P z;rT^_&9jWZh#P=V?p@amm+iF?hHC3wBxRRzhBk(x&VNz=QIDcRxJF!Amlmp5-0v6T7zmU$hNqOzLyy8CnZ{-%PPGpNI@; zCsj@_ouz2|o=j1Y<2fd9J(fuR@#q{~udwv@5KK^sEcfo;kR&BE{+%_qlPN4+W#@&84!1I*9aDMWs~d45Erfsz^*|xN1#S^A6~^H31pzT+ zx#bh@{}rFqbT+BQi4&)+?`6uVIRVR=3fpFI2bQAQd%Sq!0-o>rTp{R#?C74qg^f^ddYt;*gVEGYcy7Nc8?Fq4* zcVPKlCJ$%GGLM@2T#I1b{?7j*X*Nk?R0^nEWQ~)jx2d-yP9dVVLb+OddinCQA&NC| z_XrcSlaZCW0zP-8m(wEjJ=ELrB%KPuKPDJslN6Hz>sL!0krXU}j498JpUsJf2e;{z zz5OgPZ`v;xtt!M9Z?}zOD4Gs+^j(LZLwxc&eiIR@`Ni1#PZh6|Ry`tvnl@Nk7mkyU zN>AR+aU-!TvfWBoOypKKA$vHVi9OWNgocF$%T;7on|5Xk$t8t5}E=g&c|EDE{65Ux)-U~U$ zSQvZ)z}ECC!BH2IGgQE1p<*sb~c1qn*ubd1k#zHwl1ANjhqWb#zgsog*&9bfcugsN;zKn z`AiOa!g2(}%6u3GmCEQyC8Y$#SoU+%$AL`^}R9_}s7g+I@ySsY%9GHyX9EH^wl3PYSCk0*?GEr)=m4gRnF+MAOyu zu(>Xck@Si(pI)#0s66I$+jk~dy>?1gF&Muuu8P3!#p03TaG}T?)h%@j7UWw;<1Sd^ z?-=!C6`%eD z6Oo|PYfU4Z+i?8V5+h?e`cXias)$eL6nHM)q&2Z>D<)V61c{Su>7vkK(g8lYj;Qm; zCRs|#eNTMq42zH{J)biGWs?iEp|B9p?S>F24xgUtQ94C{&A0rT#4`@vh3u66;}&2i z*Ld9|mmHTDb5tarMz~{4s)kRyzdy~%-(1iv_6_~&S(Pgk<7GD1sNiVDCKm)buGLe} zpgc9Sg#>6su+?{gcjH_^MA&v(S91>p%pC+&{==fxM!6|MVS^?1XXeI)jpOed-Y_R~ zf~I#LYU7QJ-;R-un;S7YY& zQ;dD^4CB+e?bTADhAZDD_67;V{^bwB#^+$2aJD(93a1M&xxN7fU+>PismJ~qLjB*< zy`HN2>J{OH_>K;TNvOamXTnpv!G;-Eh^lh~xA#HI4!Xh`_(v2;VPrd`_C-`Z=)2KJ zthqM?8>LvwXqumeyX?I0F8kg*DjTh1V|pKGF6f64Ill07bbt9SD}e*dt05j`w&`9G zoa77DQ~Y0;-&hlU(A8O{fe|1IGh-WtU9NdQIwKLOz{9&+`kW7lbbmiJ1u0;{m#%P< z`1tm&VXJ&%-cWF(2|E6TIJcTUl6v3qo2W6kya`Euwb#zc@WT5@5{~;uN zAc2;m`s0bAryquZIf`V*e^|lR!`-o~;d-Aykwy=9`!d|;Bi{xtCy1qIeBx7I!RYyxQbj=PTCgZt$>l7Ld- zX6_V;q!^feks52Wxff#n`seRQ>n<-75r@8dbU*oUu}3M>b?}cGr`O9JAF*=+-mrn< z*RZY+=5MqGWWWrKuPeYde?TSX9An=O%{Yd%|EC8v(e4h>!SWctOZp|QH3y7S5q#}WdshQ|{&9Sw%pP(TY z`VKZ(Nxp=g*kK91bB4WWMqZ`GwBP=%5@1J^uYU)g;G^vQtRydotSakJESC~uM7+1V zZsgC%gsc@0__Yzoej*lWAgiJ)MyMm1$OJ-Kb97G21+Eav|FqyK+cjALSeg{5-5c`Z zXais}lO;5jc-^1evD9&bj*qP+Wn{W7xSF#ObRWj2)TbM9g@(-pdWwhAWkvMIW?^W}uITFKox8OfnLArIV^~S1{LdC?L@V?i zNjPR@i%3D*qFw+ba2z=du)lGqOx>C=Kj>fo8%y6qX1{32FeW~WmSZV2;<9`fv@)3m;QP;sLsNNFXuul5A9g^=KI#0YvSjZ zZnNe4^ANR0`>Gp(Jja745a=a$FlzR6y-0yq_yFuCnQleZ|&~A z`}|cDyx7*NAsZ3{TQpvmU)e&I)AaN8bS57vXMLX5KxyL-N)189Mg_qL$H-wkua{IP zy%v(u&=hK^!J70pbN*Q^;JSmXfS{LX*fi&i4gPGhNW1gLeGGMo4b-Ygz2sb86Y&ru zCU396?GKFDX+c~(?-t3-6^Cvm@ww#T4ush|Z6c8?L|S$E!%|9PomSjrJ4M%{R?Cqo z+XzRsbi_ueN2tz9==qjir-ib0eI9^TOgYAEr}(c~Han6{_G1w1cAU#onb$mkx^Ext z-eMW<$YrY8#ivvw_{MrO$tQEI0>| zxT(@zMjvgJ!9F3Iii6QM z$XC(7IJXp$olUOAgkM+R81c!(`2$nX)I>^{Rri7D@TECPO+>5yiZ=2UcQyogy9yI7l)Ul?ix%Yi=IBT!!vP&DMQ#UBU zmtF|^`1EH>9F~q}Acvc36ld7d{Kf65&f4?z_uXk~gPEESxVtcx*&|#i9+k!Kp?>$n zMTAUYRaAmATW2mV=n{U!P-p8~qt5L#y4HGRjk23B$xhz8T^?G8g zw*4wJxd(ymrSJJ*_{kr@Z^+1sLpsEb?W1B_^-lFOrn>#m&06L6JyP7uk&xJsuRHaP zYd_Wd)3e*J4x!NyyXMxmu2*m$>YY3Ji(!jYB3SZRGRRtobt5mcn`(V)U)IrQ{l?Re z@NF)Qg%}L8Uj4kU?{27QS)5&YaP|ZMid>BiqBDKJ77Qd4c~ID;alTJZNj8FksD>dV zDZmeU{Y%-mwH9BNU^2R+DI?$|BqWU5s-H_fjWqH89h{$^-zWc(O0xDjf9B_}S95rX zH=}OSf4Rd?&#SESLe3Orock-{fQ|M=#vao=KtSxY3h{@~Xb8TRwZ?_;_axGY$cU8n zdD7ug-b%e&EYDsD_}$MOuxICW zqR)IkVjf;?GBE&bz5zynl(Gy^dvsA+Gt=`%%+PEz!lh)?1s zp6hv7++Fd72~U{^UpS6B78>g&Tzi{=j4d2P`*cWHf9 z%a+mP3$f=WfIn6Kpw_oq%u-HAWVwWQ>7>Y~x;tAQ9CR;a+k!;O7hMgTrgnsBBw?!P zL^yZH!(#V#f17b}^F|4tl?!DtudtC>_5sDPdZ=--vchR%yx_kw5{Rc@!mTXx7l(>TRmg*$7)n^_FMko?&aU!PG=k!oK9x{2A6W6Vxvjn(8)_fg3r2}YZCkM@u^S3|J*B&0b~!PdPG^82mHGDOt1MWB1rzJrYb1gl1&H!=x+Sl1LN$uY!vj7@bgwk;6kFUNW>Q$>s&rkQAyy=J)(M~RZSnA4kcF?!X=BbUyMd=3egUl!op=~ zAhyXdqoCAH^r<}A^Ji8$-gRx-|1oRq+;Qxp#9Bc=8%_vH+YA&uj0ppN&=`*0helJb z6G~oO`5^$Azc@Q2Ky{7K zcE0c~VB#cl_QGw$Z1ZnMRRqk!> zxzF(RX&w2V8!`Tw@ zFt;?UP#s3EZ6T?G9!tYSi2L2CV+pOay^|#zwA3b1+cgIt9&83hcSuSVYY)`!AIWWE)JIuUoV{m6#}5P(+gt83=8)&ZXA7*P$G-!ZryZX ztD7iP$ugr9FT>va)n~T8UGlTe#qqIu{Sj>?8(mr0wWjV1)w8lItAANmoQX3wuRD_2@6Sw*}YUT!hirtR@r%E&UM zX%xtS3&-oar=Q}RckHvfGX~9RJN9r%tx$hu8~aZkkUkYEK^AW?&~vw}5#!?%B=lqi z@JLw4BW#^k5*ktwKFtSp(YRZGImp16-vwv??}vZ!Iq+_!#cK9X;P4kWRrVw9v5NN4@nsS zZ4X(E_AkXSiQB%U`O1UU8nc<2n2)UOXo>z|ATbPv-?VB8(^7RKm&W3cB9tc~I@U*c z>(GfTD|_d=48Yv?UU!g;L7C2x9tv2yMLg{XBhGFTvn)XylQ$1q-vv0h%F+sd#0c6- zl(E_Pb|2UV8->*F?I`}IBpDe^H==ENjFaI{UFoD4PaS?x@nl5Ic`|av<@yaXRV zq_C(4VWK`n0FyR9<(vpX&wTInFD2MMtV<&DleuOM&784t862;;O$_u4P}L_~6~sZKH4FjnPX@mk7&9R!hW?{VgWCm10x0 zQlX)kTbk2z$Vaq7s@a1(H>Rvcze^(eH@{saCcicnNA^JeNo(xCWso|1A^$=; z5>#-vh_%C`gFn;$NKNl?W5J^f2R<>u?VD36&xaUj#fJHNfNh>7`hVRtu0BOohl6&E z#tpgvhsYm9CS9{k=k#6D7&tRH`psVKTtNO3NZ1{z_E}#Zw zoUR2dAFcMJ_*{qGPa3eb=KaIMMzsB(+b_a+&DhgFkh6o)gC72L@!du7AHC;aM4Fzy z*pv_81tT#AN2lRBpqZnZ0 zJ0cG*ADnoSOG*_I>FR#@FBHSQI0PdA9X>v-#2TLxHqKe%O71Pe;q$tmf@?N}>5qUY%sjv%;VCg_4ES=n&!zH^W8W=rP-W z)#Rgp58KGY?WKoHerdJHx?LLmUH=+=zBqK9CpAtb{8>KWXB2U75R>#*+^s~nus=}h ztH1nD8t0!73bMZBC~Ym3;ueXTuinJQxSt{|Xbm$~H>h@g+jls*`HLJ(wZQ4tut`6Vk6SGLvXb2IeSos{V>FQ*@G^19>{`xQ39Wu^zH z4nz-c_zv&BJF_Q{s)EZzJ`dn2eszBry-W@K5w$-l(9ZaYF5I5`XB0gl;hl3UT^uoC z%>@vNd2VCfu=?_^H0ZA-e|0RkxYg9pdH56(Z z>#R151uvw2pG)jVt0E0$GU%`!f41t&-^{X3NP$@W zc6LnoT5US_>YRwwb3cg4W30+q8~B7LOP>+L_siySF09UmqqX1jF^Ei6Peh))iEOY8 zKWr}sAgoQUz2fNUj?L}kO#r=Eo;_=?dpWP!<9zA^_VK(MSGhQ5#9E@&dK!P4bg%w$ zzqjHMU1K#}ve&3&MT8Uh+#RrfHQ$ywmK)M(;458*2j3*HQLC5Q|NCc@H16g<5m68< zC7T}ketWI;m*v{RB4Q(;=8!5-SX_<`aoHfh{;x#%dGCWg7{a53W0*r>=(D?yzq|Nl zxYbA}!=%0AeAWl5k(@2S<}NQBpT(A;U+NS_Tc75~2shvOye?>)ZS5NDbTy^sVBnUn zq?O~_>*@{*6tc#ll{De2*V0EQs{y^>F%iVJzn$~d>u3@7 zd4qy`)9#;2w18KF-m>u+X8%n(fWB{Zl$}yU6B42XyXy)Y>*XZ6V~Lo4WOY7jWnXRf z_3#m?%}_H^6;n%#MAm{t!S{&sZICYKv&dw!W@H_J`r$bOhkdfm(RRN(+=pV89oq$dHSX=*xro^{@9)^tR^XkgMH;2H z;Z;)s%VV1$VDGq#ARYqMv3EQjr+Vhl*Kmaf;MQ*gd88D zlx{p-ISThovX+J%{~{=j5f~SId2)UC@Whgn->9_>Q5tu{x-O(?q zRgBc#j(iUsf~?&HoQpP;;P;&Wn4)(a8_KDsz$QVT=Jt(AiIpiC3r? zep&Sel z^yRp^Oser$`)tiGe|%rdQz1Rr#+&=ny~TIE){(;wD`n?ZRdY)ajQBHS)tKd}QfI=c z0L96!Riwn2Cnx}6OV|cBEU^TPq{zl{Vg*}TCI?oCfJTp`b z4{1h2eHbXi4Tp_qonwp?gxnqXOLO5nv@UwXS^3ArynG%!fMcPKf<=J1%4j7^D|iKfHF|m!dp{id?7mMg~m)5?vdm>l3zm^dDG?C*ug#kxj^2ryIFXgX%0|@I=23u{H_P|5bXB3{G`B5 zCF2{R?jo)P$Q7lRY|cC@=k>a1N9IRD18Ie2_hP-N7665bv<^nc9I_*>qP$cZ#}M z>_U$n>}a9!)8^kZLq8gM?PV;gzWEJbGn}S;SJE;B-0G(IZV1&qMw+#p>gY8KHQWG2 z@o_09r~6}<A9stgsQWVx#sw}m^v}Ha?WG@qPeHazy5Go( z82c<{YgQ9S{113CC|-oy8yn}vv4(^4mDS$i_Cxk+K{?U0)$Is$rKP3kDYO_ zZsPEK_1y~8`~f=pRyJ!VJFd90{J1Ix9Pyhra}nI-Pyr{v_k+_|`kgfI$57_wIezKJ zqGycqw4>$&rRw;PEo?2t;yIDoLDk02Ls64Jz8Q<&tGCns+$e(H^5sN#(v z&b-FCXr;rGeZqBi6Ne481hS|V#cJm2HT-_3JgySe0nXw6`;6xOa-B8gDM6^Yja01s zx%Ue_fm@5wGCBfc+Xz3-e(2HGl2uE3n8SpI@63`BrSiYuI{;8&T)1N;Iok7JBjFFi? z9HqbkjxE)>%LT5KTeGfRm8nDzarzCv-qeEXk!ii#J?~gm>Q8K1eXjDa5yMh<5fO*h zdOJ$ovtmE|g+jq}g>EB2R@~@RSTsbV1??pnMk{dKd82{V(3D+)x6+H{ZWGlT+3lhN zr+sro86L_Vz#$8Zwn{57t)}2?)wt=U0M0l{NNnk&A+O^fwlg!tPk_lsp6I)5z07Ur z4voT(KHs!jU6JJoVBL^UR}VEP(}G02X1GNi%HW|4_$v~*Gu(8dFo_Ej2pGy-d{kdD|S%RNJYsY)x$0`pd1 zdo5(nnLAv3b75c(Jk-Bn2g9s;G^YMWlvPYud>7usvEL+o-tQe%#QOO z%e{_)40e|DUwrMru(YjWa%|v{{bFc7__GR7Y=NDDlZpuS{q*_rDtSd=*f$x-!6jtq4ZAE)F}c)l99!x$(vhS zw$zW7vI#YehyHz7bqG;O#0#jGk2g)J^|0J6kY^?Qhav;%ds!7P+J%ZYt8#szP0QDl zQZbDeG4!t7!CD#82u8T2;PV$0&WYM_3l{uDElo-5HwYX^!dZVr)qUx0`riNJ%!S_t zz~2bqhHcq)j{_gYZ;R0o_=l^OWJA zwZWOrh##p}cUZCw5D6!)(K?%6-T@9AayfqXpV%JZ?Qj$UZl^!;cq z6;a@~=tP#?>lnt#efd7w#*^C;&|j?)QS|HbFOtY)nOl$g{I99fl_=GLgdYR>VkhE? ziDYi@)v`)6QQCY$kB}gt>lWa>E34vN**fqNh zHGl==8_wgUG;O$dlyRpUVzD^%ntn~fj4ChF;3c295po^wCGZTK$kU;L0mn<&Li@+E z%coXQyQb&~-b&Zi0*RGJ$^#ugB@4y_fsw>FhP1PvfxF>HQc1*p%8z5qg|xT-sR*CfUUm#yAM;U7;j1_72Tk)< z-*goMNUKr_Z$>fFd(iKzF|D<9Xxv}jzWrVM$8>CA_i|vJ z))Scj;$l^7c-}GSFy84j5dZ0{fU%|#ZoEq_biHI;t5KzZDe3x2!>94{85a#dRug|( z-jSN2uyW={fL-9jiMW6>N^wPPesd|x+Jljv4fNS8VYy{3WkSzcVcC8xS~h@PR=JqQ zpm+m4$a|2bWZBwp){>}Jx4ut33p*eACro5JZ}toltIcu$**P#SaD@iC8+lqc`(QA< zIyMPQd*JXfmox|c57>v8iSN68~)ErY4)2xX!ZaH<}`8OX&TLD{U)#bmaR*%OUlvl zI>-+AscWxMx7ut)P~`sjo02vI$@j%Ikxh+2^u<3`(|K0l;ZvSpo9jo3f(cMTB0p;V z?HPHxv68Iuqh`5iG!F5*n8#rE5we<(+|0}cC)J#Hh#@SSCmTmfn!tG)fXen zg+h|`ZqK_;9fp9UF(|*>?7zWvxx;Pnvj=^vMWj=leeOkZ2{-+P9nTX^Vu{s-F|K4I ztp{KQw4#8KxzHP4=<5-hHPJ;qO0&T2SY47q+27~cP9lLw!fAweU27{MwwmJx*P6U4 zWI=v|xXLv)9Oi3njbHqr7)e@Ew`$AOExp`%(7?!qwjisRo-@-3V40=xn?5D%hj|_+ z3r>NOTI5mCj5gn4&d0v-i?$@gp5n%D1c~ zi9k*C`A&8Jx1wgrYdb_lui2*YrDjMPO3{t~iI);}OB7T!+H+tAHV*}b5B*S^aq5%HxI{_&*0MvUN5ri(E<1UQ^@ExtTd*iZ|aPG;;>j*gt#6L&Q_nXcQ)`u z@%?w9&i)JM#-r&X#OO_MnFDCmbHWLQg&re=%Kt(_#X1)pXSLSvu$lrave0|yeK*C<@hF=X}^1HRz zHbG&QU91kY1c_572~Me}3zv47ZFsQ#5&N^Cv3e{;wp#Ow=rH9%bO$FG5YL&gBQCW2 z*}VTWt74IGYIbzbW&AaXY_mvmW#(ZBMtx9$*`sxw5><2}~N7 zn63fLpWGtb$dlm(?e3aQc=1Gq*#|WJMH!ZA)N~?@k)e0xMjYrMJmJUc(qb=Xrq_K3 z&9c2xWKyz}@CHzjw*KsTGB!e=sg~YH=lQE2gJihFdK!o4-r(a%`t9r(XR^q`YwcvU zD=-wkQQz+xjZut`%D?($Qc8h(4u69GUuN1)34Lh8>>EX@1C>=l8v{fn|8Uov^ym^=2{5wbZ)=2&^FW!iWL4{Iqq74iGAr*1u z6f#bKe^t@_i?s%Y(mdPzq?bS|C~a9q_YNI zpajX+_P6=x1e$>zxc3Qul1)O=sD_1Nd397uG!Ny$m0Fs%Ij_ToFqI5F(%|jnVW}Uz z?G45rQ277ybVEk3U2SlcM(`T#_s9ceNJ=HeFPo1V@(4~L;{S-wDV=x(^!Itd;Y%?7 zH5M8&b&&aYH}y)>%8JoCnXFXeUFJe&0X!rh4pdoyt?gnQJGM&idu9BBzf?jIw@wx;n)YyE>;<@21CARP|?q$Ag z1O*f(M~K*8G;BO{REh^~k5=yDWo%`jSbV@XA`E4LU9x7K`TNm;juP~p+$`O#Z`r*8 zRO&wCedh$(K1ei*L)o|M8;N3(hRO~TUCxS|>dS=|yqFYZfYO_-jOd=BhB=cPbiu~q z;I6#@GWtB4vN?UVWO^iEAnXHD5@ol|b-&nU*CIi=d+1(Nz2&wtNrA`aSK=*4e}TV( zQgu~#w{#{)-`u^7j#xaN%fjab8g!k}jGcZtzRHeM`q=KQrDVNbtcYMh$U!V$n2>~G zu9itSVOVf>h!y$_DWMaVI_jPCOR|_s;IL#%+-2w#Mm2Vr!KIq z>stvSZ!D%J%kS-go_tByEe}f}7N`Cog)fh&pq*@-_a5v#)6r&yzjTt~A>)YuNM)tx zCOr6{UV80fF%5=4t!&LfCa3l-TMc!K%5KfXS-LCjwvhia%XQrXMR)3s;VfnLRf@;e zNcKL@Q5@B(PBn&P%L<80_RjR1WJy})H%lVAg1@5=FS-unkbM>~+o4rIUl$~^YieHT z0Vwi)wl)x}6BIRIogw>zGCh6!tE~cFzk}b$C35h(Sp0cF>8LXZA0x_X8ms9ao%ix zU$2gpkBo_?SM6T9osghxuI3<5Yl(k-1}j;|P2U)B5%8lzeB+svQhE@|J=ftHWSd8E ziVM&K#za;%1M)s_v*;$Drw*E&w{yuxLuv_UsO?1NmGk^EqYDPtOl1Ucf4{jD7Sv@= z3R$8!d&=3iPI*sy?v^q(c-_4{EhHC=S6FAYlwDA0~RO4{+(aclbmXaDRhM6M7R&gKGGg`Z)ZXER@hI;eSsKI6O->1ac_dwFErWbv4xOIm%# z0KEDC*xLT*{#j4gXo&W2+Em}*e-=P#`yA;H_>vz0HUfcEEnrSs_=MWeY+ z9>?27*#2Poc&UqbP%B*(2{?y-j=HC$X<>wDj=EWKhxXk?*E0+yS*7{i`JXTxy7R0f z`#5g%b@YLb<&tT0{SkJQDd7rr>jo!t7zMve=QR zKbEyn$<8siwAprkzP}&uzrY;1Q;+R=yGOfsM`4?vd|uvG$-B*ZQu^gQ+Lk@R;9~W3 zPngp(-`iD2-0+DK$w))yv+zY2m*UrNir1}N1C-|E%Et${W=bLGny}p5_*}f)n^y$C zk9pEQ#C)t;_^@I!j?FbyrKCrDzx|Rt$ebduZSTF-cIA)kJwtf1zIE1K7LOdNi}JAf zd>QkupU38L_N2w7q10GGhgTnX5F8ms)rvsicfa}hxQb~Wg>IDrX;%Z_nYQ266IOnjj)j% ztvg9sYHanEf8|E=qo!$4T8Y(Ae`}j)o(uxcT=dM$%+nL9k4r~6j_Cz&2WFgYT-*X_|f&-x5DXEFU>!~wgUdmteW%-O4Z>*aH zF{h3ur*+2syH`FX$1J1oS2k=VzTOwBe&8pStH_(+U?&qwN zC%QEzoDjF90Oa7bd$s0h5x>l$`R4L`U3A*OEc$UfU2v)k0uGtaT}ntma%G1+uEVGH zhZ@peN{2Ky0p+y+7$(4^+rhp&YNX-4lm@D7A}LPpF%U&El6MRYZl29=)I4BWQ8S?q z!`J5r?ogq*5@me_wZUf=<>!3q^%Q)sTd&g6jUo~ECOj!rd?OHY>Br-^oOi_XlKL#c>wBIln)<`ecS&`gt)X6OILzi>ry6x7D&( zvB~}@a5I|3dSJR5vZ;84e7zWb0u47Cx3jIa20$vVUq?g7z6H?!ICCE1hAQ8sza}l% zj92VMO8tk4$QyrD(x)^9q?L^p^SNO=x2))*pO!Ib`MvQP`t9nJoy9wGo7osY zsOslrKWa58I}1BpXYF5bq~5Cy4)X6sqy*NX?cOrc9p3D6s+n8zr&_2TJRABihOO%t zmA7%y?aShCaTFKN=0_$tqeG(oZs^7aq=3-GZeiX+kIQ`6NFO?=VaY?SJpoPIp8_HAsm~DM>Gwgu z`-A4KlioM~3UyBM9$tAJrGTbug3S_>lZ`;1*;rR!esf%DaW%rK|9?EaQ(#?f*EZU? zvF$YWO41mO*_e&3#ysO58vB&qg{S~Ri-};)V^!V$~UY=Yxy}IHq2t2 z^^~DXmqO?OYcj;19c`kTyu{n8Mz6`0Dxa2F^clz#>R|@^G7L|NStB_NLD|>)8B7(u zG{zzkKq3)a1&=L8eT_JJwKJDIyg=DaKlwa0goYe+1D;R&t&<#Ij_>bP!of#NMMt~qAPaAmvXSJ&ONm5gCxGKp5gf`Wn! zNe6BH$~^m08wN$PZSU4Rvu?BeMpT|#$Bu%Vamhnwbs*w>7v6ns2d@55XC7ONi(7g-_vJwQB7j#i0VfDcNx3Joqf09Zl#EjD*99*DR|CNDi8b>18C zK$lvn;Y)O*DrL&Y7Z<;KAz)&YlY{3Im1k(iPaMPZ*Bf2G?nV*NJLkoXlO$-VDvlp; zC~ySM4mcMMA%xx$AgQe@IPEoWXDwjQR(`Jlvd!MhEn^~%;~>X+J>kB~_MIJAtG$2V zqQCqF-hAbuu00Lf{^#4{nm~>`KrMk@(!bXGZ}ru9^3&&!I^;#CYL+O6QU`?<_wTTe z2d0+zv&ET=`qEYzcYdSd!7;A<|A{r zzN?tw;fq0H?eW`?quE;8QCo(m&j=vZI zex$(hXFpzA<`wmysCTXn^jdXoe(D-Iwi{T0f9Qk;tz;n~Al)1OvOp!Yw-VZCK6*7M z^t3zg_K&Kt?ll9e>N#HgXvmyqkIiLGrDMDUmlfv(-J4KzAkHiB>daV?q|kJ}U2JN8 zG;b*;r^W}(#+w1||CP)&*m8GyiF}?56k6G|nN?@3>~7OPo-_2zmv|VU;PlkEqvCJMOW z;`ZUOM7LeLNWUk!GTL`qaBNr)qGQeZ2R*6q^v z&eTPg{8saS;?w2`Tv(;EBm|EoFFaf@y}1nV>^=9dxAeyyh3mdMjUN#TLi&g>KX**6 z1rkuf*`(oHJIWx))Peeezz(oP3A58dS7H7A0X=Pl8>n3(G&^_@`trwk3iGFy6RUrW zY(880i28=g2&T(D$5I{nS25&~KLYfprAX(*eAj>D<^G^GXO^}U6q3Wk!}+1f`G7n4 zvn+u-Au^I)Sc-kO`a*z2RcPHh|0Dyz!?ZK*`Qp|}Go9@tg~|fu5yBK$F)G^McYT?~ z;0L6$>Miu5{Hiq3;2La%oVJH1J0howMQ9BxRF-&t(>Zsmr_fN zRu1e1nV@&6dR*{?_d9u*U6DR#2}Zi`CM5OpFtG(S&#^tr3)Y;^`}XzA`?Uf-79+jj ziUG-5!L5PM`FPjafkzJ6N7wr9k@^|2)eKRdV4bWO9 znSF^4+*ylXen*LkrQ7mFLv->VhzChqYj-j8xg+TIu;8yaShc`}DU|kDV&#X&dJcbO z;ZmrMFNoKos+n~uLfZQVu1$0^DQhoW35|9h%;F>EYBhAfSaI27nQ>4bvr))XxQd-E!x+}a&;Cv3G-|b)5J3r<#%Ye}nDkXV z0xoxqEJEN=bp2jFIAJ56%76}G+UKR6-R0h2x%K(H-B70u__cc0$octN`QKdX^U4m*QjwZeLNgAj7n&;(U^zc^i=UCR{pU5R8oMvj2L0-N~?d+ zJ21CHtLr>Tr;YDWqbu&y8Vceg*ft`@k?4khXo4|EQS+J#it$_RO01}O~w2UQqHqtHr3+V zsiK`fKVn>Q+`8x|RPSyikPZ^ihUXOv8h3MQs<@!&iM+3W5qTUQg`yKP=uRjv7>H6DqdVJ=2i{H>8L1XK{i2(%>qiuoL&^b z+TErbN5uNFlhWg5x0my9pQNF3t**=h10|&4exSJvA1=h}xcYM_EWrfWAP{;YBnpE5 zk*SP+yGRs*Wr<~Y8~$9QqrGA+p(4cwi zJDQ5S(qh2&8Z*V(V>@cgTC&?-#c~#kVtN2?fV6NyjF7Vm59s2Bpt2ha+E*F~wO890 z$|7P47odWNa2WlHHwg2sk_?6cOF5fAs6Qmypt>2|Tnt{T?;@*{*5J<~!+?rlKTn+g zpP}7Wc2D*aEcgTuy=iVyQbqyHDn)A6mvY|L_+x!{@)@^dndN5V(McL|C_4Q>~}Aa;Eb7Yb7raqj-&@x|pHx zL3kav{D`e}2Hg;M+HK|AcmjEIm(6#5U(V4o6zS{F8-&&=HPZ2oUuhPLV0@wBN+yoZ&QCyM;D}Wa zMMMO>6oQ9u2E|sJ9f8)N#_Nw9)u6sYnptzhQgD|zPha-bXgmMP(@NRzP`bI9Mn%SvcK^|OjZsp_ zqW+6*C8q~=uG8-y)uuvG-@9tpgEFIuU}$Myn3tFQ79!A{bJXJ7#u^0qhZ9qc&B*8l zI>|rZL62mPyIk57{Si+g|K%vz3=zmqUan=!*uup44P`>wUw6|6u4l@Ah?n7~&%?Q@ zRiyXncWj+*eI2n~pv2{&cX5NsBrFCkeK;1eGYhw}ogAi5@;ygPhPzc2`fF=TKR51#t&$y~plG^O81lY6$T<_GZAig}Ya z+;HT9h$Y8!(wF83(cQZ?x;!*5$_BM{5Oq)mJP=>S_!g~vz-FE>ArH$$z7iLCm9R(YVh$Gv8t_ z``+j}a*U%}xdS}@ywl4>L5r9-)vAXuQfi^T|iD2&}XXgwV=zSAYG7c)dld^Bm1ipy&z2s~|_xk_z_+|D8#!zV_m27 z%^@Xr89sagOCi#-4#7_h9=KeS`Xl(~9tUB@=nTUmqa>2s$J~f=Ody#WG(EBsrV=V7 zD2?N;U=JfpC*(Dge*XX`E}L?IMod4O3WsZ*eqAlYZ!U?d_Mm=z6<#WVousvm3M3td z0rWF`N`|i;f7yU?)359yQKisGL5_v_nAA^_`Bdd!^SJbp`4=0>0f&Jt8Gf`xCG}m{)70s<*T!8#LP5>b$7a*BI70E#+s3B4kq(Fh+h5Sme!=4y>x! zbzYh877YeA>DW~TI|$a;2@T#3&pLnMG5_SAgicwdJxojmXQz?QNPqfw_ysng!x?QY2P6sf@R0qfFUc2E_&XXnx|HdT z>S5yp{?CYf)2_d3MB$D}U^O%bcqCI34b9w5w<0@>m3ulJMprvQU*g_vQ3Z+MAhU-q zG!ezVG;$M0f@Y>q@1}7#{I#lds5UQ=5fHpuG~o7=ljQ!-(0#EUC2<<%LsJ!IzRcTq0rN zX&1H|5cPdDr7s8>wsyGOM7DWbd(UHOB1MgmHmGIBzH+Bgh25FLWtB$ClbJ9(<&^&4 z9EWIP2%sK`O3-d@Wai&)|LGV(r&<)&GbSB_m8Gu%_)iKnd7tiBR*ZpP%G_r_7|RmW z^m2nMb<`6P=-QqdX)=ov)b@4K@d3urjhegy&+rUs2^0Q4gx743U~!OCAm(H$96dU~zI$Bu46hDq+f zn`%8F3U(J7?@{Xqc-qx?d9O;25Ys1FyM2)7DE7PVc`^1JE|ouK;g(h;gvRLe_N$gl0#Ij)lUp`d(mxo5Tq3zhp z$E=BnN!hG8*}j270W_eXq+%gFx)tcI!T{Q3#n$ca+?NTQ)#(Fp8h@-$wmRd_GU|p6 zd_TGz>o6K*$aWnK+XmO7FkQE8-9=+OpIf^T6JP3z+#r8mP?bjnyGd@wRb{^!1`@%dG9yRrluo=*NRHpNAaSma)vkS0R7 z3~47Dh|n+G6Yc0+u|T_jWD<7K`s9WZ;>U2GYLbIGdyW3h*ciLflS!3n@@;Q6Xru#0 zD{@S30*q!-4Q&(Jp+_Y=Y(Cay?k+5?+jax7EJPECtnDkqEcz5<1lwynkAF*!tp2$FBR)!T8uW9ob}@ z5_(!_EO*&E6Ve6OXS_yFV%4PmS3A2nxl9&qAf_E9l1`!~8;KXLS^d{VD$8SYQt#Vl zp5#c=$j5`un<+_&R@+|uA9@I=qq)g@mo4js->J>kIu1|4XMjTS{o@g5vD(`f@2i$7 zex|VVm2=Cm{Q#lMAJMkgS+`wIQP~oQQG6P7=Gro2TX{!}TXX78n}y#vXX@E2q~*?O z$!(_JB9J=llq*hJ%s^};>p;0$ZHF>*X%@3so1WCRerUaP^)vxnCwkd47|vhW>%OVO zHm%LoZQiV*xS+8E|8_R?`yj+nZbAS2lYv#-G{(UIM5}uLb%3wcU-1@t@?3dJIJn}@ z_(Sck6TZtrDb|(b<0Exz2p5|(;u~hU0#7S>lmhum=rCqn_L!lIW336{RE6`CpDx@m z4Z@-oDrr^yKvt@`M}i7%s>i$wiQSpH9b~HA_MGX+K?Tl-_W4G;Rno{`vulQ#7w85k zSRPZ9@wIG%8v&1)fKzKkI@i3m*m8`^6-_A4o{lnu}R^;I@XqmoOSyDp2iC|x+?c+MbWp_jG^UC{`?0o9byMoQjt+Qx+Mmwk)1717N~i`@h4OvM&e$nzkn>vpdkF zgs9c9A<^3&9QzB5G3%T`sX}B6q-v6`75mBXJyQr}>Wi2ppOY_?%KFuduJ9>Jw35cT z=v-v{Alv6?*S(Bi{*}NrpJruI(~hre-Ol#RxD*SHW0n~7Y4H$X(G^~_UJX06(OjV@ zQi$|BiE=4hd?i2{YGhL^m|^g*m&mj?#&0;z=DDFKXI%Ajt@fC|%mmRgTh;X+V9l3v z5y_lZpiU|#jeaecYzwpsM`~r=XPJa-V?NpD6+m8{JKsK+MQO;W<6Z-@1P72Yv^U1wr_E1B8m8-=xq;OSzNz*Y-Jdbn13I5cvH~fsrkdwb?uGckdS@of7^DW#f0gytr;b-`#v+1FI-JM zfH~O8eGh?v&?edngv$}Qeoh-xeK}8Gh!StBhOwd6eMJ=;XqJU^9yl=WmOg^;({=wF z(~77V4?n9!2_m(LbN$?FRiO==fDf6UcztmIA^kzx-QK6W=htrwfOZ3bqt=@kj? z^8#zstQaX16?z*N>@W%=;mL^a1Dt&)I;V4AnAc0pZbe4D0=Jw)h|DX_Fog>@GRM3t zb>abO6v55KMVIEg^EAM&vLHuDM^cY|;&sS zGDtJWh?##B4=CUZrnO^dpV+m!d@9obt)xL_JmtE22>_-o&}TtJ#FsqbOuE@Y@#EAV zoD^t=7zS|DBChYiBYEFS5^0Zx?c)k6%e<}n2+Kpd!A~;E*qmadM$R~4qC6C$hR{n7 zY_sI3Tx&MpD7xgezax~x72r;rz3&Ba!UP9?IT-M_TRGp(62fvzDP*BsVn{(}bgmwg z${mx#9ITyN^ z2=cJBa=sf~4MPbGl{Cz*>0fGd0Y4SK8tJ!L!coT>?$Ti`{6jUwKWJix@1L~?G8H9d zv0iIsa+#>tWabyw;sRC2f2p1o{yg0us<9vgnBtPS3n5^gl7cM>7f7{hcgtVAuf@<+ zD>;#iD1P}HJs{%+DQ|2$`&*cw3m>FeAcQfc$D?BaXhbFmmOttEtSQJ!ph61W?rs&K zuA$9LCz6wiZ-#`&s3L``M~D4%?88#+z|hK#CI0YuK-N^1s8S33`UPgHAXpmZ$bFdP zeE(ji=?5a*(Gdv~54s!IuU)d-Wrr|6%JodO>_fZ!e5AI%t~XH%yO;x$!AqfiM_U-6 z8s$Tq`b#imxX1o3C9%so@yBD@O~8cYzowSoMW+pc_E7bF@D)Ku)pk9(>Pk!0p4EV7 z%l|SWEcgGubwE86qwKZIpz#MQL?!`9%x;K=LMT&lSK&wfQq+VA>D$Ly7py17-P^~< z>dHj+j)c&KheJZF?I@`~mS9}?!k-p-g|Z(#RjO5Q_Yp%6nmwKiix#I0Z_RH@%{@{T zRtkxW`P3>XP@`Ufw);qu!(e_|9+&S&tR3(fBjab3`^)5)R58dMJPkZNw`nUQokwra zotr9FsiiIY?#_LzZW`CSoI#A0L)7W0t&@sETC#`VF7hlzO=1_mp+95Ub_lfk6D;atDd#4Jg36|9}O@4R- z^v^b#?XhSNN?w~+BPM5ozoV(>hiKhBaoRT!QH^`%iBHSjh$x(RZQYoWYFk7(vfS zQ@`Bu+6Bu{d9MlLYaf&sPEvfHj}8OR&a@I`X7Z^aB(_Z(8!RW_bzIhG>#e(!_RiXF z`8I4vV8ekqJAiuJO

GcLUk>;dErA#mXm3-7AG8u9M2_c87?Ynnui5EIo$?IrDLq zrxu@)^Xr-c#IK67XOhNcR187$YR=)Gv+=8C*6`Ogx+>fJlHncg?fv+CX-VH-f9-Oq zlKD>qdSvVJ<>3+x!mim|ckLbCxBBqKa#?;fqTd7)FE7a=!hWb1p)7JMXn5hthM;#< z1WkVu1qkuF&nhjk!L)fO1L|SQg?pF@GoKyAXzM3_2*zd<-s-rrIxWA$ZA+BF0J{4i zdPTjZiEK3X5RIb-Uob8#&}|W-PSc`Q_T&dDebaS*3pLw^o1gek z?D&G1pkT+27KjzIybMII6Sa>sSgV&Q)XIX~_x!A7BD4EdMxbah^sP#(<-6jid!9FR zt3Ub|Zz-(U(W}#OsUlUUuBt>ZeHvAj-8ORZCfN$go4Zrcm67fKT{!}gh2k>l&J0?( z+*zjCRAohQ1%b%>5Pd1~d|FwMgVNATSwH)?j{D}h#INa1ld^tEve}D`gC-xkI&$&m z#&7m~WUKwiMHG)F81x#Oi^ZJtLiXp`bMG^97{p`?P(f2DN6LpoLxvsOxS1k!vEnvk zl9ZVICRvB1r07Sjd!=Lk@LRaZm_3oO=2x486`w(F_JR;KCD62kLo4I{RE}Sw2`&35 zxxnBqoCN6ISEAH>6|SYPF|;z1V?wH82=VBC12{ELFngbgD+zcmeqZo~TwjjODI^wm zt6{_h3R55(;NVIkwb}P+eel-3RN=J9e4?l5!|YKNUj3>DWxk~KQU7M3B}+c(w<2f@Mlk@(}H-+y)9AoqR`dKSW)fG~q`Ugs@o2TUWkC9R0PUKK( z4ob9(pf+1h0(}=-76nEgQq4+Lv;*3^q#=kXv4BY^ja2y=xaF*Q8WH4XdT$YwO(|Hy zmBy7CUi#LsMW06e37+V`C=4dvhN!!Ta&ee<(Dj$sx^eI)pK4!r)P&F^V%U**pMs}T znK{g_>3cybuof`j&Y4V}9#yvVta03cPydPX+m-o`ti@CRF^+)CIIe>~UNJJBmM0hf z6V}2d3*aHE0i|tF65U7be7Lv88-CM)tp;G$%%s(tWYM?711^r}27igVcUx6?ZNDZ` zCIu!t`nR7qV}@my;>LJipWte7`4Ek#`K~;aw8h(~ENs?SB1W0oy&6%hdxNT}Ph?;K zd^s?jKTOYrQpGjbvj0_DUclW04Au@pk5S{)o0$;4WKh8r@cX2J`8&pIRw;ZDSVC}c z_mACYF9CDw9?qKwPb7TUR(AVZoy88;2CJT#kf4NKtltsOV_h3gD!4~DjBMS>`L=T8 z&F-Z8R>%{xd0=*=}wf zQ7_Y;6zK(q!aONJd;8m7h^=-F6pWV$HFFUjj$@EhfC0VZd2&G7KYmoo5J7E35?2)7iix`3)g2dizzm;sN0#}wRFBE{bNdFRjq zZIxJl9D8=FjrBsp8eNB@1rA2`lHWDuUM~1&R#`&kq==5TD+E`Z+EG5sKAdP@kkDm%MOlSK2}3* zG5y|(;}chpHh-;etC%T)t%iHdh=+gYmqZ+OGwp&d-yVp0?~ZHObNcuDgfK9{MblnM zr>4vfG%@MMMnecOld$ET>%q?nvu0)G6aU!{aO@tnBMUi4a~^~bOpz0}yAL$pe!xUb z1O=-`?01&ht)gb^8yl=MFfkzfNvD80MPKAlj3x0U`K|XzlCVE1BZrDd_mQ3hVf0*Y zjd`WoT3Y%uWYr05NoH!5zd~=8J+Ndg5%6V^?~+sKSH%OTF35=f)K!i+bax*fxZp8+ z-2XJX_L;T!D*1thuEKt8r+`R|{k3s#`8r&BLFnJJp#}<4K=jmYb?hxG&z-#G)})9k zLZqLCZiL?R@vWy^jr$($m`#hxn1Ffi_RT)<;Z56k;+|AzDOJqx{r(*t zvS!DlUKQ5=vvYH^I=#@7UOtCREWZA9A3GHUYRQjW`_@vWP@+euP^tX&_g`9_a&Pw# z_JoArC?{xhWj}LT5ALo!R!E`nF~CShn2@l1L0vt*W-b~C?i}YjB@!H~RF95*`l8?^KtI{xD1LbO|&__-Xg zNY$;;>PQ8>h>Hz3C&)qidt9Gq8hl+o`3vudnJ3~5txa0bk>_! zvpf2fF_l(nb=6QBD+8LODcT+o9E?;>49v>8ut74%^+Mfai96|4I)bWW(tJ-5*A#vx zkPeS2w6FR1%M8P5%xJLenZQc0Znqlh&4cIDm?$|05X%7U>6C3$kpWzMP#PwDEUdmp z?~cDF|5$m_RYBfgH0=KB6@J`-bC{^~myAHwiaf=wk5bGoIW~fS8YOvu^6S(3ni$mD z=d!rS(fK!_B^_;CVzJ%Fyh69OZx>3dNStX*2`ioYS%s9j!xu)8l=&?$gT`~7FX zK6I=JO~K1M!JC(&!3mlh_6o7v zTgQ8x6Ar9+CCT5!cMA9#Y$`o54(t;y1>lWI8OY z5X2b%_s1QkWcset6V0BtPV=Md$Kvyl?Xz7uWxOboNhctjZc})E;JOb-wnf*FCmk8Q zV1f7&Fk{9BzMohTx^2(P1y((dV9Fp2uXSZP%_Q-(N8ZNB0~QHP`BZ3H^|u9%$njnb^~5R}{XU&!8=>N1e?+ zI--X`9>%}l1L>%Sq5M1cXAwhYd{U*l#A%-BIcjtbHcWF~RvP)7W?Tr%d1Goki*TTx zzC|j3JYK;OxsQjv(a6%r8NSp z#z~eSmh@kj2TV4e7d$yxzhgdZE4Q|k9Evj_+aN)d;GvuOTHgbq-MG?*$3q3h@bqNC zS-f(%?6EjK=Yzh8k6oSP&&kK5+A%R6T=aqX;hbX0u*u)A;q8Pm@8G6#p0B5htzYXa z3X4U9PO*l*#C$X)hf0G`BSJ=HYs*O|`bb1uYT79f<$>aF9Pd%ILV8T;w z6jgZV3G5qK^(G|*S$q_-CWdIAz@CDoR0j*np`d8+);*2aSz%$(`EMCwAzMX|#R5n; zFjAJkDO9-rs8LMm7VqI)nhSvrGxw`*^&3Mn?f@5U*RS}q-e~NQuxRwdVJY7@;b zIr(VPYKiAo>4Jr$ZbHB{fT=v0!FJ+fbmK8`?qMhg7(Cvxi2Nn;Z8$sj1H7X~z7fug zr%K%aO0fAH#dSRC_J%5gIktr&p~2mu`$BnF{N%VE!|XV7bKrcsxg|)**53b~JI5&t zRV6#cK^PfFDRSKSdS_BdGOz&1KxR$;bkz&i!YvbU@LS9?zOOLWf|e%x=x(>wuGpgn zTF8u3xM~;m*_n3YA9-|Y$(Z>kQsA0j3&$FyxCHM|_OZs_pVQSgtA--e8e)@RQ>oms zXMeSnyXUrJacXP^)+Z#@s#hM9{yyJ<{C7nuk_~8fxO^QL$nVvYJcY5DQ1F~;hL~{O z9(*gcydYwI8B_lOQ zCwEj{ojmU}3gy5}4n+79l88FKQ%)ib6}tF{wB@N{#c7%JVsg|xO@x>---f#lkM0_h zQ3;Ag+?6ls3utas`wd08*F=7rguF7e+S?_?0So(QC~d!zd7 zxH2ePV6NjKG2(xiHQfq!FH>=dY^~3ml~UpC)US!p3!1Z}1$G%U#8IokwX7k!SYRmc z{k?KjFBAUFDHGY@IK-qU6_%8_RbPRDNPOwXZb3jcw+qT6f%v^I$*1L*wV~>`)Y9jC z5B}qUNc>KhA9GzYY^*^4l)sQMhsi5@?*VGYXZiZcd&Gi%?MYgrMe8trEU-gysD8FP zjjh6$+cmKFz6s-OUCer@fa?sIKWdK?M@Fm$y}I`_&~m$mHE7A5k9fd!+W17MWP$9n zT@@n?S;Q=AkE8ROP9txf!DhU6D|w?+UdyAZY$*ORcnR2z(E1KNz7)b`9zi&(HS^M1 zY?j?h3K6&J?Tw`mPeyE7Qb7I)x7Nr9&G+3Bm#eD!EUs^0DhsOfS=J(_E6v$%CiedS zu+B_vp+lSoKkj&ZX|LXa7SQf}_Nr@B{>!HtU-JRu5c9ht26uzVUA%a66pbHn?fnfI zbzsEmo_I)3CNu}q!5xl;wNvr}lCQx93~$FNla|MNFf4)U>a446EyCU)N9Y(rD1;>t z+1NLqHn4T*;|K3Ig;7)v+w9ucfFTPV_q(^nz`x_XGBnCN;Q*OFrI*$?%GfQJ;cNdc zxe{g%6jVyJ?<%tWTaP?tCeo;RE`OCZ$0iH@|FG<{w?fSym5BhA>)}xe(PlSrIC$Sm zYQ6YN))!6RtPbsEpY6{V-K0>sb>|O4-nk^&2IvJ+vG8dSnzEg=N8G15moCF9VTWO& z&3;84qhyITbbGx}_2wU@c-*ku) z)qe9j5N7dqba|(FJ|e5g=iP}o7fQ8WGd8$2Gh%&%UDB7{n~p7zEDRzn;QeUO^-@=i zTytuN^6+UzQt{c8%3_mYHl6&3$hcy{^25fC0@}8EM;Cj>;8+Su4kY00lkO)T&-THz zheR(0B92eoYI7{bO`X0>64HwI4|xn#9&5{zZ|K4iwW~N2;hTMnJj~Vg#_NDZ$y?~v z`wLhkanz;=><~AL7f$sKYCu)abd^XUB%@Ad%Askxk;h5!n`0doi+jg31LrlYj7Gb} zcCVrwgugd;D)vM1WdbXbT?tbilhJSCYCb&99p*SLTN3A6>{`9;c;Rlre4>JA--j#8 zuak|f%m55z#izx1xpOwb<Kg~NRwGh-MW|}W; zSKLzR!x5uDg(x%k^goOF$jk?(w?j*+Y2oEc{Cicky|z+9t5Iuz0vH3zH6@1Jl>uq+ z^Pu#TFId2Pt7ySa>`=L@5jiO<;;?K-q7CN(xNPQbO-F1b?38TonF96W0UX%<~U zgr$%#KEzrno4soFSvjZvIo#|zY3CB*zJtB7-T~Ui?o({40R7MP`nD7CQ}6q}r!>ja zhVCYW)l^t{%cgBd)M*jCKyl2YE}vYuR?ysS({ZAiOVs*YTR6H%8!9SZ97@_%P9SGV z2Dd?E|GFJ|P1cGfw?oi6?}s@1Fyf<4Sl-Xm!L+mE3$BCeEuQ@%yKQx6*{N*t zfWD4=&BI8`P_|w+Yl1B@{qV@Z86%-US-Ma=9)^wM`9^cQT_^EnhW#i2+RI@6=tCCWW-9DOaEFhQ3aBP9qxp3S$ z>DV+_qqI)eieJ`|Ze#VTDjfNLMYyzNYe0?5VBtur0HBV8m9C|2YrUZ5!*|4W(aFi9 zKGtq?KJu-0P_^F=J=UZMspb$UC%OuBn&)Hyj^cu717K8Q_M3GRD^wkZrzQfq_)u}p zU)w;Ksb@Tx#D{WBRB~X(#!2cdhT!9X4PTUt>uY|h5)BsNg}NloeVoJZq=<-pXfB<| zG3%bU`@r=TI-T{-4op^4jQ(*0GF@GklAZ7$+sm+rv1`Hg2`aPIt^dwl_~WQ1iWF3` zh%zrN%9m@>yKd(gN=1%+Eo^Rwrik2DIuyzc0|Z|tfa(J za}y4oTR$7#FyW-mP38QeqLlEFYfDOq1cF0_jx-Uprmp_pi#Dz}C5*Wx)is28VARYL z=!A#*bGbIpe8uHb>*Kv`&vJaLql~6}0HH|`zKP%8M#t`A5M6s)J5Z;_i>KoHb(kmV z7Qb}vB+!Hz2L+Q5F=2!}luns;!IxgQU`Fc|sY*2>G!!_CE^gbJYki*IaE(I+Y)1aI zN(c@?g)HYgy=hZO!;{iae>w%9WDjvX#ztCfH>j8l?=828*>{*;HY+w?QIpSKDXc3z z)YNl&bDiWgdia;T^HuG+9o7g-`3>{kxcrzLP6#6aGSlN*3br==Wva?kiQF+cTY2Bx z_T2JaK4=zluhlMeKVx$n^8oM57ya!TDvi4^qzJXZF`|x4c9CSGzSpdp#gDD-nCh+< z0pj&Cl!D?pW?0tl2lI ze+;F3ckCt2sPTt+6RJPXQYHu~;r3D87#!vNWqiirS4u|~r|a=&RR&41%<9`sUs0(O zWLTkZtkBIfU#{_QL$fO|ym2mkNtOb#$xM<4Vx(UK_JmyJ^nA~;piW~oIFiPjC9OIv zTDd<)u)Xacf5jVH61`jqSIA@_Gw|O|z1fyq$ryiCsa#2kzv6uY7m(1WS}htTIDcT0$NZ%725d;DtoQ!L=Xlw7)J8cD1u#!$E4f zfHvYrBW;TO_yAf`p`c$Z@j@Wh{SapJ@-~}pNeiHT=inif!$d4IQp*k#s!?8l6sOXImz$DC-`i-*mI$@kf-p+(IMDXPut`o_3Z zz_^^^GXb=NdCmd)N>+A{Hya*giPqw>BXF%OVgoLt|1|n^-ZoU56H#GH>q_Th{Uk=v z9VJ&+>s08{FL>9_uQy#eQYg5<@RS*;iN1m}51@q+i|*7H?+JO-Y`BdW6iyA9yNt+8 z=TVung|>FJtYAgm-1>w0YK{plGQSzW3! z)%R&oA(eGuEhSQ_dx689E_j}UeP=uk>rsd-JPa^h^o1T>GAUrpbw4jD38wtNl}*00 z5V>-9$79~&>+l%p%UUM6a@Mfyo+0KIRW!Hn7jeG?D$5{RA`QFj!Jwd(h1~KukCEHLV1TOu?&D3V>xn`V0ZNvhTm|gagk<-b3<1cPC zJz9QW(U7bt|7gTqJiN7apcN_QYW?ZldM@j_PUH>c<*&SD-PYQ7u3Ad_BX=Yc*`tmI zeTv1e%;JqvZ!Ihv?t&VftjU5iKgza3rO!jfQ@|Fqw+*t`VRQ9~cMia_2+=en@EI^? zRNvuV1B)4RdA#;Au3bj8n*`59ZcRP>Puj}4CzO`7mxxZ*}Xhyl)%hod2GID zZYmi)@a1IfqR=d*We|$4T+=Lx z>kb+|jXB&5Pj1aUsmr(aFXNpzKSoZZCPxhY%;mOtNDNlerhL?#b#Af6p?`YaB~bd} zG&2hvv#~!)(f?Y&{ktjd-Oeop5z!ya7y-4x9zil{ycCQ$&u8)h`a?mVAn zcmj;Y)8(uBZd*AXHBT>*+}`5|-0~TcyvD!zJp?#wf})f<4VDQ|ob+Ou~6 z6-&+i91STu?~L%sf;}ab8<0*SW_*?V=YY3pu{16vA*^y-(jVv_#$|rtcPK<$?wE?& zqZ+-gDk>Y6Ro=ok(89CMs8$TM^jATF^~^E&8iz@zN{*LsSo!qRfv>vTosshB78J*% zSYc|Xz(9;n2!l73d0?1N%b8g%U57F#0+40;U=PGci;;&bJlD1}pl&8u@tyA;%Xny6nnoJm`+BJy+BPl$G zSc_)ax`mztjJe{0?#tW&g~4E${q+QlOKb+JJqK0rIr&uzB7S=E+e`UfjE(yq<840& z$Dl4NrbQQ)MF19Ff}rb#Q=kgede>*y36|1>@BXJha~*zi<^z{s-~U3kT2Z-A{X7Lv zUqw}LhHfv2nkF*;Hjw9D`r$^9-a{O`lNBI@|1jjm{N^Tra7pBEy(eg^Ifi0))p+Hd zm&8t%fAdogFtuC+dQ0Q3A8~td{s}%93DFh6M%Q1=E?@CL=M!M*5&kGAmR)}QlT?c@9Nl&#+*{k2Q0)hj>iY=3Z}_HO=T z_2jL9<`E3;0GGT*4D1a3u>FI|5k!cMR6 zePw>uK8$1TZ?09i9XTe_diK?0l87%8j&MWU?DCIDND(|%3F2O{>6crcvD2j#s~(5D zFUV&IXf>@yyD8nFcH%#T5^>gre@sHDsmj2cr%=&QQJ2+M_8GocW)ORMSV9!bGKh(B z#}Xmd&I^CpqJ31-rJ!@rTp1Nu%eg<>#!wbFZzWbxR z>PP0?WpWrQaf}W*GbF!bVE>}n$3rF*uzrSMR7^$s1(Erdq5mO_g`b;G^>_TbX&m19 zZ%n9S)0=vQar5`UG?aSjbh;bH!Wiiw)4F_+yBc_l<|dTQ`+5pZ$F(8VHPsIQTX z-AOIiAO*}1bvLjgOF zp>;hnU9J?mB4T&yHC}qptHF}*0?(&4i+cK-Lo^(d0hF_!WGheu+bjx@GJ{V^TUDT5 zWB62TtpxmlJ+YQAHx*}T(-kSZYUtVJTlAkD2$8+=8{MRGBM{#r4kKVlp z5PCL_v$D{J37BAFS38)jAlnQ+rE*8pb4}~PzNWu?LX&@pb=PugDiCZ+9kbY5^qM^q zC?JA=|0|HfFls#6P&RfXJ$cH#!LnW5*c*%fso`9^eGeOga@2UpUb*fsVq$YY=5eJ0 zQQO!+zdf1EJ-)%)D)I8WOpmeOKJQ^F!OyPW;2IUle>;3uu31etzSQ5YTviEO{I(am zfrY|#B*RZ8(RE8#E$JZd{+g!8jEBml-+8sF#{vioaAfP&9V)JkePPQKtf2R7%cX-Y z?~Qy@pZkU%L7W2&sG5-Yo;aMkG&=qwuOg8b{Tei=3@M&iROt&~->VTSepqmc$1HWe z9u9qn9Vts=HvI$Y_$;w!>UdLC4pCYSTx(zl#%4iL(|P_0`v1oI(|SEK)Y_7l=ptCS zg2GnVOZFE24U0ybB3EMknwRkgaxrq-RbrU$OaIOdeEn@A+L~8TnG zXe0lKRwAN=5AAd}&J8KeipZYb`aL(yhUq7e#LuuF=cp=wo*Sxd((#q53f3$L9y|11 zyFeKzO<@oG*gEw8!}Q_5wj(sq6l8mQyYYrniL`2-DWKorG~?-vmd%PC?4<4JVWFQB z59wkDmnm!d_*%C2A~A7kirpi-T1A!n(z(0qO&OZ*(gNSd&XtNzVTn+u=diP8Ng>cL zV&3eq`D@O&F0Y{-_5R+vH!g)MIzF}b($j8A&Tg-JOM<&NUD2TKu|LOfYp(}QWYH@q z3=h8h!D;0Qpn|N2TT)WBO*6+L2z=)7)072SX2!b^B#n!22JSCjd| zd}?^_af*C?a2H?QaYisYu=V!jh318HDV+X$pvApF&~^Y=3|MC!cm!tJHS}%z+_bMGHE2NG#@Bvzy z9mb>T`175>6t95Ot+%CQiExOU5*o-dSS@m_bXU`>V2Q9LuMU@Lv|`)d4cW$~dS%Z` zEDX2;9Eu7nt=?c?EfpqvNai$W$n)H|4v1;vw4uqFF8!GUV3LdVkmr5ob^)_YKi{%n zs{i^f8{a;+ywhJ#Ju8;iq?!4`dND2er84YA4VfzJ{@rXMikRgo3gw4Q2V=pvaIMc+__WPVaI&*%E0CbiaS@%TWE`K^Ttl?}=Gc(1_Jf zgL$=@Hh_Rjxb*Kcje{E(zW%HCZzFjsYkXWXf|2p3_XY=apEl1k$co(=u�lHLRi@ zt}bS4{9(+L<1gu;_6>u)a`gc`YDX2cllB=+1Ud?D#Gjc$Buw5hR3s!W!rU`ujX)o& zoBdpHV$lOo1GkbC!S8+X{}J_-QB}2F*Gh+UN_V%?-AGHvp+UNl?(UNAlx~pj?oj&B z-O>%;#`}54H^v_P-G_axYvr7CbpwmZPJaiS%Pk{6On4KhWFRm_tWf{D1}()R<5zoA zgF-Aen$7W4KK_8J@gLp6dm;WIfh4I3siGZ?tXBl1|FF-sH17F|+u(2KcK0Z`r4xf; z%Hn;=YG$$YZgT%_xvwv`j6WOYz~$8YF7YdMv7yMX{Y?hV`u8&Fsi|G{gGd?-Ht8s4@`?%^K#p9`YJ4_^jtXAR2KV*qZpb~4=Rp| zhs!yG#cxzlNf=&_;zLo{$NgVlxDF#&lHqktJ0Ggc$yoxLw}KzEP0wVuk`tTEf{(qw zZ0=dN9{>T-Fi(yOJ!xt11658Z0ony%4H?e?P)~b_3yVLX(X6XG3^pC9;**Z_Bn}Xt z1(`FSuBjH^BU^Q9r7s1a+akOA&o*1__3z&u?7>L^)lNL9S9| zQVwcnt8snd)YH1vW#64hjq>;Gvby?KUe*n=zwh*;22?gA5{Q^XMzdY96O9T3k^tx& z)QV}?r_J1Dhd?M(ny|HoPW~m+-2IT&$#wjQ8Hzm}R_@)}{vw7&@3o6^;S=hl>g2=h zAmyzGMw)LTJ3X=o!U2iU6V4w&taG_`X40bHm~EhOE^Fn769VKV?;gWbFOtw zWH8hzcI)XA^B4|>)#khYO}a{36t}-6;e$m&H;4{y$$^!&0cOxj^3C3)*7^?VKkksZ zap>f)1mvA6;XF@*>y4^1QZ(AUVizVz_X3!IahMMt&4UFzhByDfU#e%`?+GkSx`O#WU$CaH9m&Y(y8s7h#=pv z(b5jc4T&|Bv&QWLP1(;@E7Y{^AHX(LLTc#7Y$2vM>HCPpI*(ppwcE;qeCB|PEnsM{ zb+xMh!Np#Lf!TT@rNIm~rcwiIuI&HKSJNZfIw2GgwuIrX2 zUnB~(78$22TzTt8@d|!dA&*G!voavogq@yf%fUtF8+cUddpcl#)saMK!tAD7Je@mn1X<*?8P z!7YMT?zv6IVJ*!SV4JA>+bk%_sIayiu(6GCMnq*)oI;Gif&+L7P2pn9&Q+D^s)EDT zW%;eaTe&#Q5Vl)2DgvF0pB6;Y?x#SvJ8^i8UI}3w0gFd;YDt z^J;GD62`=a{qcZmj1lUoAJ7vJQe}(?1N-yZI36`euzuAqME%!031*(VKWn8z#G+2P z0|q7n{p|Uft| znvFe=Pn-Mg{=k?zD+?%X4wz^OB$I9WW!_c&i~W6TGrhTF2+zoJ19Q<$9o{Z}+|zz`+)og^gGVW|HBwLgwYUmyG;P zezs9Hf5xMI*_Vm9dn#hbTAA=yZ32rk;ev-K^)3uoJLH$jg(jaK!%QLucm&>-a_{WU zaQ?8-**UR^+)z;kH%L?256T-R!m9LGh+T$n-gRnfA#&+A62Fc;vq|p3)LXBQOoQ#Z zN3!w5;w>wyjZa^$_nePP0DB`)7a8?@r5bsz(j!LeYt8K!rg@nI#pUwgd@!OOIwubgUL{3j6RxokvW*cuiuG)Yz0mvc(}q^V`{Oom_zRXW zGC}fsgDA#6(k2rWQMvvAkBv9fVgbmL@U240numwJG{DkvjEuSDzXaW9i177>8IqOU z!bXMZdY<=}T+eOuDzI~`KTw*d@TR}w?`Zp304>4?SlYRbg)oOE&?ymXT*!aPlOMeO zStmDdLANP`?!E$Lc%1Iarjtyg6~mmK@VQy>8&kAvfUX?|`6o5dEA;Pyh(ax+co6tH zs3$?pJ(8_W&#a#}=U>G<=32)hQ@r_pD1Bi{oP!imQfKOD5Hc)hjq!3R|F0Gp)TAQM z@wWkV6mh9qP2ovH4KZn#&5-16+5fv`=MF_?F#) z%E!Ourvxgt-tebEjCQIVh|26~xxdru&K&;K3q60OUEA9D-mx>Gt^c$Q1!9_y^=8JP zDI;Ji9>GJqoH1pw5|A(ikx^i`zm~6aaVHppg;Eyc6XU5x0>V^MN#epJVew3XmFUFY zl;s&3i#J5>54SxnNK~?L_l+NKZye^4u&6Li@<3Esgid=( zsRo|)PhDV)HODA#|JVxVWPYYF@B(@%?$fB|{)?^iqJwwH;z z9#?A{49N&T^m3jJw?DUty9hX~Rg$m<%V3fZ^lw>5?EvK zhxdX+oeZo@0bvR2LYD;?eAJV zC{<0($54v8ZfdC8JjWBOtZ2}eKqv}`7G%<&?>fdy)uFHBdV|%M;h{0;#s;W1Dz6$(A=JD=}lj5SEJO6vc{#Qd_-wr}jkpqzIBZqN2|br1nNk z{TrkDln2V6_AQT8F)lc0gM__)`s~fqTBp>V9gj>{WANH7+T@{WF<#&H<(A}wlT+W2 zxTwxlfc`|S-(}zLr{S}%oW(OUdflH3_iB`NOiE`#W{aSz%kZ|*D#^|E?gxFTd;P~b zsuQl?X{wIc%<}23v!wuNPoLirn@*k*&Ory8mk(%w;v;xBf;fa#=iXgkrf;MsBi*t? zPnisK+ccuIXjhUrd)W$3&0!_MHr(j**Z;s+PfKLoXKEh9N)EHPZ$taZT$aPDBDihS z-#0|T#xFcQ{Uhv8`MC8|$_JLh{@av6uoNsh)kww5Xpw(P6dW=JMeVcW4t@;0O*-Uz zZ6ZelB*~3EKkBuv5>5fs4BJ%5L!q9)@kCoMHWH@s^0SvTcf`ua?VZt8W?3t(%hQ`` zbjgrqTVK}8J(MdCmiI?Sz@;$@IaSQe3>!r{+$pNDBnMQ*xz_O_CHC+1^~z?uam~>) z?8)o3xIoC=Nb`nu=i?9|Nune3yP{rR!!3Dkb-JQvl}(%PJ+e^oQ9a)g>x@N>_iAEo zdpR)4=YFQ7E{O=+|C2{qwsu#IOxfR0GXxuM*v2`yFe|J|uIL=!ER>0nVc*)q;48+h z#^d^i2qb1`cAu>C2t==d?B>h@fBbVF)+}E$5MRYmLqsPV>G6vA$i&0KdTw>)YF%~P zFMjaQ{?d7`U06QK{Ky0-ZKi?UKN*xSa7R$q>|OY{CT3(W)M}=x&846=Ggpgsyz=gV zYOb`{36G)BPB%pL@734xCB{jqc_B4ZhiQhk+_~fl9p6dH_=T6Mi5;}mSjmrk3er4Z z_U|j&pqWF83@ZTH>;yJ<(}i52?|5GvM9+4p(#jQINd71v-LP_ij~X7`aQf*405U`Vz&4nHf>NS41KzkFlC@(}rNy`XQL{}cIK47bQo3G}&n|YL1sTQ)0)WH|f@sefDRv(NuDeVkF!KF4;R^x>Vl|1+-I1Ds5fE%T zkiWe2zTV;(n^IPk-t|gWb2JEZDPN2Oh~^W!uC0s8UGc9>y@$Ss*(QGpxRLhQq5pbP z5(6sCsN=}NED2!>I?K_J9;H2Za5r6dn%q1W7+tCLcC9OrFIWVF@Z(;&_)9)SLC$)N zDw!M)mSTZ{@wmxhe{T3+=z$hzuHGn<>;7ECWU3t}8zWKNM_`nb$)Gu~GMO-`LPik=AdbWyu6z@e{Z0I20P9mT>vzh=K^zN18XKn|DXJ1)w{Uw6gx{49d@TwB3vk z#P@A~Fis`^nt{ZkfW`q;+qRPKT3PxlA87h8R_s9_?*k6`jfm~k)mM@3{09+!(l3y* zQxn}YXSC*_zsc{*>Mvw-;YzNWWgHFkEXpxa`?W*Fm%dw}WFr8YZ`t{}*gww@#wh-V z@VJ6P8`u!3x~N+HgM_|mWFW5~ETIMTIp2Nq(K2z7O1mGuFv2Q_I)+wJCm2+A*|W*c zB7UuxWjOqp6cry6mVjrxNyZdtzUju_aofD7o8i2a=3u%N^o=1qJ5ux0{mXSW@BQ4= zKF;=B?y(p&h=~(|J_rg~13=1>^q{Df1Rx`YSj3S)dyDX0xN5gf}R?L4th1X=8J7& z28xB4FVZxEpwti`SwoO-_p`^xpsJg!JIPG@^p#EiLj$^Wah{$(3C!PGU4pV|I-(5e zQ01}Il9Y@|(uf$IKD0B?CiM>}D*{sF0V68NLsPG!#256x{LHBmO$7#5Q6dXh(4v!e0-(1U)-86J55f zD{$5i>k*KfnbIMdB9Mq&6p;KRuR7_t5l+*8`lV+f%j3Tf>1EYF8t7}9Xi+QHy@xWh zK{Z=@m38=yEY{G=`Miyy?7L zUfm0?Y(uwc({7=#F>-X;1@J-;yTzMw5$r|n`wQ_AoTOy>qaAD%{NxzVi`7z?DCe+< z<^`_7SLe-~olQGJIF-*MDxmL_EGz0s*EFvYTq-aGd*OLeP-1Zb=SIq?vYp2&f%=B~#Fc6kt6ilSqno{NS96nBmsT~|tRI{}b&4^TO7A#S z{IG5Xoc&(YYw;Ica>PT!CbFzCHi=Q1-v}9jeJ^WF&E>-O$)nkgbIAKbqPrBlQ;-Kw zP{_qU9*H=HY#vs$AD#(Kd_eA+0p!%6+e%|k&Zz(_nQ z=lE3Th?hCf^qMAZj@K$-3;+P`=GL5G+W!_$OLR@>g|KphB39@^?K8EIOE~qAt~WQo z2RWLy!BoMiGc>6>3?f|ad*fiGsh3P=c@u#*@Y&yDW+wryO7YC}W_FIWMW45MF zmiLUyRLwID-TIFX>Ia(T_x+?_>=|VYN8ue(>9HuQ;mN=dFb5Y^4C=8!d9WSGg}Ge< z^Q^ter^_e_tfY}H;$f4trjF_=yW7w#(L5x^#|ypLIdZ>*x2q~vDO*3^@BHihOZ zN?T7!LY}NOG&34N%u{JxUg;!`mVkWR8_ZqR;Rf1xHYl>`(VIPx>gQgA*V+kVHkI(m zivZx#OEElDnNjik@&SYJ72@vP$Ni~;kmk^&_7;Pw&eu!cEQyhs#dxN;IP>%RfHygo zMZ|So^6k4L^88`AOufLe`A3k0+!Wr`)Auqw9knX@%5ig?tg z$kCyi2?-Eh`W&h8@Y1K}oc++>R`&M3!;p&p7FXc&2q4^h4)NLa<-;-K%QlVaWct`{ zb*Z@c?MjjG8)sqV%IUeMk)dSyM)4dob=p6RqCV7aU+z%-(qvoiJe9o~m0sK}jKV-a z+wA-FMjNEI;H^HA3N?R|XfTN6xOIixvG{b*ni!~^khw~9q0V^HrN1}9&vmO4wF<{O-~ zs;#^sDpTO^5ChdOo;B464aw%@x9&=$o4iyhAdScsWdW=_8b`I|R(>K*^+sKba8!N@ z&8=sMkz$$l=f*{fwMj#WU8&`@Lu_yRBmFQ3*jDuL+0%GWAKgQ)hxe#`sDpHdKz0rk z4fKS=Vdq1WU)|oIS*3S3Rgh2LzndUl+`rp>_&7aTP|yd3Oi%#+Xs;Pd(&!`AJmzlf z?{Xef*D2qeF@_Z0G{7?G%+)oa! zpbFLQar?g-Ryd;xx=T6l+-xkV`G}K6o~!5<)F%Vz1mTyY0@hQOaZ*TT-EtAZt&bZu z+!Avr9lHc%g52=SwPaibUfM2HYz896v(Sj2JuGw9JU`HdL`=Z+nUGSuTMK^WH9oRC z)#paX8PCZCnCHSnLFd9n;$mVXB1J*0Y)YuxY?7dWZrACLz`onO>L$Wa z25CvKHR6r&+Cw6*{TGcR|F(CWDX0L`pE{7Nk8*zsM#NkKeBg2L=Giz`a{_+@@rB!S}E zxFU^aI{L&25};cwhSV{?x>wR=`7Ed5ylMr|?@fw+B~`@S@Pb@REEYVAiWs3!SJYMY zm@fD!*^i1c`vFiI#Fbz0<=;&ifhlGsJyp~djM+ZKwptvEOJ?*@6Tb4j9+s*Cx^H5k zH3&@oG=4QBeehd>(nQd1?p3@@K3dz%RrY?il5~CnA-syJn$g+dt5O^p2NJyp(;Ikf&F{WB)hCBqU0fvGZyFbIyM~kcGIi4rG~G=H_+`L!y0= zvQ2lBftyM6T)i##lpU?aT+7^KD4U@xv(>x(WMsSo#(*(b0BC@BjYTj6ne6Kp6Elmx zxGEVsNnh`E09Vi_g}4>awp)eN;7<6#A8!6AvaItCgc7BOnEu;OUWT*WnZCtZt;xxv zpsEcSJbQmcHJSE;=ij;+4iqh$+KsYps8&~%lDpijzfit6_kE(i#Fb6J--n}2uE$m)XZluOM!I@ zg`ZN4OMJqw^*mE&%Smaxhe<-O91t&d2CIo(G<{HoYbb1_jL5^oQ%D~?wE^rnLrXYt zvHjSv%n@IvUH!fD<}n-IrWIu+DS*C67JV*V^|=Wo;qZop6A4vSNfv8<(GY**&kshb zytqvCHEB+FxvrU(TCYkIQ7dHjabi=Fe8N^3Wyk_HE_jRjgI_jq=B2rJU|voWy%PZH zDA!QyMtHi`l>jZLPL1Q6io_`hYmC-q0lE!eVBrryLDpV%hgGi3Za>^^iQ4B`VSsZ` zwU9@Rc0ZPH(y8=~y2$qCPj+7S)5y<3P6wZ@D0-&hd-X*0CR3-wPzx}I+2oX>>Qh47$Wy2F0GbFX1t<+sD&Su z0ht4FTcNkQ%socqWLgK}GtQ|I_Xz+YNY zWN5dH*lqa>uT7}68v^~)rXsYGgRYbLZ*7_xyyn^|{ke2uTvAL_5D6>RfU3I5iXEh` z(Me2pddo?1Mc?KO`6wU!ry|H7o_e6u&Bu!ZK_;H4A3Lh?SfYF?tbiV_Kb(GnTBCjs z_!Z=0rkKS4FFDD@EL)$+XI2{?oe)zprnXo*ZS7`+lxJn+ZQ~LGTTP# zmmh{tHQ`FLU;OtmD27f1{d!br<4U;>D&k$oq1zM~rV`QjAZAR=3Rf|>7*k{_|Hy?_ z*$TOW+rbXZ9lvy=NH^2YQf*m#HL)VT|P!I5`$a!Fzg%ie9e9eGy8tQ70*X%b2I^jnMwU zZ*4@gid4<_9ylTNfV$C=;eQ-WbYGcZ)q7aHFN*NK?u%s=poTtIPs};E6b*Rbk2`=5 zrJIP)nAcnu<9+K_SOuT`ixqGpAV5oJ8i`Y+D1eqtDP;nxX=O#H8i*6z$NSE_EFD}J z_OHM673Rhf&xFh%Kqd3tP))g^_6JlDgquoLiBL^`mpcU64@*o;udeq8$@7&}%waOJ zlHY#92XVinmmNgdQgwFI$tkrs=KB37yyYR-Hvla9{|#dMuP`OutV0%Jy<`ko#gY*3M>c&h-ITHHbytfC+O0yUlxnXarI-lVA+Igf74E4RB>@>Vg>F$(BYdS0uWqSsxcarv~Ns; zdH{thxq~H{wY7Yz+?CtAXaB1NI|lrtou8h4*Zfe%kcC9}w2N#fgFXuzcfHP>DO93o z1pE#)!nVKAtM3d=0p-IJsg_`2Ix3LAhR7wf9{gsMTeAPjUUu5zZGXJ6t6I?-18>=v z;Q-wTw!!D~MDgG|^+oEaU&P67(9T(EA}*bQStu&(HOYc9WB>anBj^!C-Sk7Qi?*W~ zoWEygebU#ocH&Pr0%fVo0GgH%D;VtJUwtRH1udr1DAHJjO&1a1z1Wvyf2zo>lsuW7 z(YUVg8Zdr&CTTjJD*X5oWLp(9P@J5h{+z5}4hz5-BAfs64_OMd-12N5dWnD_Uxzw5 z@PhWz;E=53VR;yJS#1FJZ?bT}m@QM#;bGf%=-)*hFm7m-i2Ol~(#XwD)2R>GkxFE{Adh~iQhI?DyKYn}um zL10qq(d6MNDflm0cykDb)sVqiVKz6}@3-#eI)p~Tpd&zr^ z!nRG!((BP5~yDOP|e9P3$%0O=b#Zr^2PDEmN~>!YIg!+UJ!+rQ;fYM0dqb zbB+C^#3Q!e729wRldj|Jufl2pq3D~>>bc4Jy%4I^-c7@`#YS2wZ|ke}FUPkVYv4Yq zcGA|b(Kc}8(*MrO;;qH8Y1?WM<96@Q%i>A~@(pYfdqwdm?5k7h(X2eSs5Xy3;YF$N zI+nC0kn|QNb#P>-k%f+YioEnJYrI>rZ+)B6C(Sv=!<$O;Vf>f6^^pX9;2-I9&vvB4 zno<4{cu@uIhUUM8=|js58mvRW@sRc-m(-qGRErrr8(zsu#JjGikwBUkbE$q0#808V z7>lq22S~!8!8aZQrtITLTBDB(IwJO1FIJr|#2P~8uC__0dZf1Iif?!+55TXu!Yhz^ zLy7-0oB>0uL@qUh7|)29^gv?)HMG7a&+_<_Rw=>3#+5-o(U8fWx#_@$wTb1dbOC#O z9Vv_ec;F0)XaU561}7#s40lR|kL; z-rLB~g;9sVr^!V1XhLaSq)|~# zKvrmU=?}Gf{_`L6`sDfi?+PEw<*egRo5$XBx@$$R`{Ji!#{fv|TALv zWnSR5CEAIgZMswZqz6{d8&^&WCpU-@`@nd8A3!Rkg?CfU_I&6+ba8P`#2t_mk$4cp zl!J-)g7r$o0B9?HO;6u7O$g-^)Voh^h%WfiClXxW=Gnj#Dh!WSFw$9DB=O^Y^WsOE zp{R?NEs6JWPflt+XU33At+1-C)P0xf5PYsoE1 zKQZ6)zU}MRki0xHSz4&@{C2&GV?(?OPg#|IE!ac+wCUMd!l@sdBX45G|4vjbFLAX7 z;ZXq)1)%>CBYKe!&06V3kh8T{O=>Nv<(FT`q@t3rsY^vUoBN49N?5H2jZX@ zBJ?aEa3HnE=z%m*CwujP2x_pHh8G^@Mnvbt<;zQl?Vi(PU`kq|(oYF$#^71c%a(ZGVozl#9p7(nVE0wXk0 zoKNp-%ExKN=1M7hKJVu6D*mxv@|!$!O>>3=imMd3g~TFz3uLX#i6ehY7S|PfBnjb! zvaKQyt~dYM{WdC2Wl>M(fL}yeQR-}M-VDQ1E;{zF{bZA~KS$XTjG`I|=-|qrN{4jP z4S5vA4|hvfIVj455KsDX^nhi`>1RAzI#H>g5LqmLA_U=`^(eGF?`X7BYL;0l^lss7 zg@bbT^{M~w3=wcu+Qpj*h#_%yO-b1)B~Z80e*03anbI9IbR%Vy7K<3Pytk)1LJzw8 z^C=@8d;6<-b)FJmfrJ?uIAZPc!FILfrCn!*a^)00C5@X%ytzwk4gYWhzd&Pr$^6fs zS-mlk8w3osQa_*q_V!A{F>(4*VD5FJ5t}_eNE-$OS_IU+N2oGB`@k4g`HWIw;WXrP z44sI&y1Fv7)io1MX=I!u!vg08_p-SbQ*fzXDYeneLE1d+06yaO+KsP%H0nEE;QQ0)GeEteyDnK`l!2OGK$h_Wt`aJ(?wb zr3=u~QLFG~C1Or7+m0`h_^0kCnbHZEI0kc(aF~Pck_eoa6)pYAPL8NTob*L_rtn^{h|irv`E#OS~~u9V;HJ9^`PbqDKOn>~;rV3AeHwdTW? zai}}FUEJqP6`j)%IOk~-WuGW;s7uhaf>6I0oLU23bUPVTw`-<~Q#)p!!VNie?Pbom zHd4wQW=~&swC>abu}OMWP9XBX(%Xna4Nd*8zTH#b)gKB9>H%Q7rX0B2s&C32;*$vR zi1N9|h(BbxQXVW&#pU(pKtr1`Y zfUoSz=J->_^8$p`nAJo2j}9 zIY*&z*X8WaxSNI&mv0$hMp7pb`T+lfDm)U;vEO=y5SveMg77I;Ey&?~N@H5Yu`+oNMt zH{-HD>Ed#w3=h(20SaHXl4&Wtl^AkS4X%H8|D-`HV^jv!eqz%3h5-o!1VG{%7Ipd1 zviOueV4l+#5!B$@whzE&bT=nq!>zc(++r7DO7^6^SPHBbnrZ;`nKjRodAUpMm1|;Z zpL-%6dc0hvGU%_BWy>&)zu{w+TT2bOE5j#RpjZpubUSld4QzV+OMt2pZ))cgn$7YC zLj5T}lP8KWY9PUO8vhc+_Z@QrAL}6qmw@4ItW5;DnAhxfPQR+H(z6bqPwFjNl@wLA z3^KJGRq$WVQaIlWQ68L?=HBo|{Y|=Lpg0=NYtD71 zJ}gz_>IG>q)B8@*nh}uwGxBh0xWMI06~DtU_a7U6_Z!Sgi%K!ax}8#!wj8+_NL### zreK;zd>zSXZcxtW79lhdIMP5=ww*7%3oxhpEX4Flvj*2A2%{feSgRHFK9vu4{OHPR z?@A9r-r~2_jx0n(cj;bvRvTTYy!Xh|&f2D$!wPc?%D&Eiy&mO#-MQXx(f`Vwrk0#j zh(;r43Q1Rf}?v3A|#K z=cJ!2ow~WCvNbE+NPVj-#julz@aYvP`tHx8Bt%JvGpq7s?wxRugSd!pD;($bqRqq? zdDa@TMRiw(Y;1wMB4Uq?-6NZ&>%M0czP3F_A3Zc~H)Ls{Sy5q6mT%z>7@}(VRm#ya z0Auubj1EKVgL0$6#=|U4CCGPb2EkF&epX}~3rBj*=Vjc+5f4Rjdd(ZNNKY`Z&SQD{ zW>RpYn=&v~GqKo%nVyD*rN7bH6x?GtO2}C}Xh#G)76W(l$DZCH<%Rm}-FV_q*o_ZNZBL(`;}+!x2-@ zgAAk@E%b!}((uxf2|Hh71F@v(Evpzg>lAeO+t&+>HJ2r%KmwPkape4LLBDQbS+U2D z4|?u(KVC5vqYu9%bKTpSMVV7$UZ5RPuIsm!MjPXG#DTlWdPm{)WxzqPfRolvb?@ zMFE8c%N7E9yfr7Pl6gMC+#jK1dE(j*zu_g%1MhiXc-mGo)LS1Vxmat|KK6YR&A}0H zn8D4)l^(MjBNQkZv>F4KvI*4Y3&9U<4J0*98yz7Psm4(W;h<5ZsecOB^uID>l5n$wv8y zoVz61xt(>Zz?-A(ZKuKOtym9(ra8Tro2mJ;*P;N8hL(><%#7lW6*~~$Gz~ z1_?jw=EE#|aN zLG(0Kn@Mkh!?zwc|E)#3D+_XXcf|o;H6EW^ynTkCWQXx=_2CXhyTJXPzgsEi+CX;!`T|D?o z@ZR~1P{PF&wxilabI_y=$E%NA!GJYgmWK|dyPh1ca?m@Dn!+c7px$^w+ddK-rU1hx zJ2BRC&s7ZKV{7h->o>_WkC!XaWgh~b8tZ=IcAP>aRX9wjTx=LL8am&!Y*=wstHzt@ z@1Jh8@cwy__)PegWL!>ExEval$Qf=ExWt5I_e$mJ8Z=CN4YuD6(c%ma2E9D%Gi8L<#&t&0J zpSFePy4njI(A26@YT;xH<$?u+j>I-idx&Yo*+b^7Do>p$ZdM0v}K4o7k474|jta=8{G4Z15-{~-H! z7^LxWd=T%kt{d2aecuR3*FwF9`tQpJeg&|O0y?+doaevT9lw6%@x(!#rofmY<#crA z-VC1u0Q&K6;~a97&m{w1vs=4lmUr`3iLlkG3_{hJH~^VorWiI}QRZaW;2h189(gP=_Xa z^*>u7*pt`LkcqN>z$(@_A8cHgmAP-X1c0!xb~u|Y&1)_24()XBxvY>=$7IBIU$&_# zuQAsU1eEXhi%uV(I6HiB$Hy(JUuHv_^*74oe z>x3*M(iyUCn#%;O-J&#gPc z4GszJ{$JP+TnxYNR8HV6D#yHT2>xW#G3&-+hBcJ${`7OyZZK-o*p{=S>AU!#iCn~~ zq>U2+#V6Fn5RxN1{NTCOl(U@yN_-B^%vhxSBPtf(ZQG*tuE`DsL|*6PeXmLCUpB9k zn;6R$0uIWy2NxDl{`YW!2&gm&WQw?-JpyCE7nw1>A2grP|M@D(d)W>KRJasi-pp-6 z!$d1wT;GSei}e0@aZZ)lx=*_*C4`+_=xgm}&L@j7dz8jOyT6L~(b-(X|Nm5av2J^$h)VsJ(kRV} zwSmJQ^>eGnn{y7iUVtRva)nc`$c#yY4r|p2rAiG%ZeH{oQdL7Mza`tzO1JY&I=o{L zoB-v`m;Ev?RU+LewyIXQay>~t)-V=ZdnlA7Ub=oj;FZ^E z{#hvkUyMr>dFYYu`_udvp;DIz*W0I%qQY>zHIW!B)fYyE4x*I=i;NOBvK&O0RpCbu z%8}Y|VGDEN^(zV}dO!EWS!>){jk70v6I~$N18WA0$ZbTFPH&bKhaspxPMU1Y{ykRr zJerl_r|P(9kYo}-t6Fs59^(c*M$^@QeqR=^XVqk(*;|7*9aWiSgi93NyE?^ZVW#%a zN<@Y*DLxp9H{W-AGL)2e9VSLpz?@3!$GwE75P8UJo;KMM@kEv}r^U25jK|=rkLKwl z1wFIZP7Adq6&k7t+%$v`HSb5NwHDq!nS-z95b8fe&JHI^TDg7I_P}YmZllSX8rT&b zi}+u5HL6BX*|ht13?@ z6=h0wrWqP%I)+e7O;L3$Z>)0UDE+Bxg!9g|nXD{2J)W+($xdE;6D0LZ!SRWa7x^RF zj=<&Co(H5!uB4#T$~b=Mh)B9ZTRl#kk?B|#wuJ3=AS)=ANQ=ziF<0VcFEjmLuD+z? zFlka+nuZh}OkPPkz(_+^FV;NZX+ZktiSL615?Uou4NV^4uWgSBE~+7#bIJbYHf{bT!5!h`krI>G(V z0NL1Sn{R7{NPIWrQKfgsSfPQ>Za;*+iybVYczH1;$mI)^90$?7ESP>Ajc_>p4`Era zb!VpYYi_sHdJYKzAvz-?Z1$B>DfC*@bmVolz6Fk7LV4szm@pc1)lCews|NNEs~!)k z)}9{n*N#AKp8eA0o%J6WzYC>yY?c!}PHGy0=b~AV8=Z4+`)G3?e@Nia{C6{cQhZm0 zvQaMWsJ1c3I*fuj)#|rcM~1k6So-bWRtvk(diEi>*Yt0*TokW5J5v+!X+G;WQF(ei zLNPx<;R-J=9zsm!ZG)<-{)Sh}=gaj)^vOGBXY&hlhBW=6HZ4-qD3oHohN z>%rLsfBgOHWnW$J2q_86_7NN+*uj0J=fOd+cF&U_^zOX7SU{DvTp>|>J zx`25!O0RDMy`<)BoSc?HIq~X#1EiY&i|3nx2IVx3#l`Pr=x}m#EB`nQ=)4>Ios4g! z*#Pg=YP7d?qi-F4 zP4|?f{$L7PpPffGkQavPbg`ceh`>oFcUwS9l|*OT0n*-9`&L#n{}LMG-h=QA+bz^q zFSq7{0aE9o??-4AUw&%#f0}$PzCD`s^muG;WLnX^KBfN((ur=HA%hC{A7Z9u%XGw2 zZ4e}jE%nJ&{uerj3Vv>88G?GT8gr`O6*}&c7`JTx%=?qE3mt$PDPd<*z2?-<-q&;< zPl6|KznbNRbzWh+a(7A{y9$R+=2xlh2D<$EVq)?xb;x7`w72u{nWzY~vA1eJ_;W-R zN5^CGwQV{ixJ64ja#=;+dW=OJEo!*eOdXs+GrvEjrKcT` zIBGeiXvuCjPx)hkKOp!MQ?rZsPLi z!3Er8zI@rq9lbM(SN&6SG6G^w;`(6Poq}@UL|k(Is~IpWB4;-ICiX92d{h0!CLP8b z->Sk`BJ^8YG_ow`E1>!we^Fi>R|QB=H+zL5XY`n!nk_W9sd2@_l795_2ZM#??3mHF zsQ7j>{oltm&B^#4vGY}>N2HYJNjQHRyOX={;B~(0I5J9aTzg$MZJhId%4|=Z*F#`W zL1|zqR=B2tJ46Xl@rq~{2Qy7l{Rrpze#Wtwj_8i6&@kfQ*?qCAjtx zQBqh@iTc*@eBG|n8R_Vazo@G7WH`#%RgInucVHeqkfB%^ z_?kj|Kea_@i4!W(ut%Oo)@+W= ztC1x-ik5_mDYDbtZk@lCrnPwd78l%pn)mV>+0~=<#JVhr7yq!KWYC3B!o}9FAYnve zG6}|a??bLH^Z(w&wR^{r@&33Pf5#(S zUE|fqc#muyzzc40@H0qS zm$PL6Dg?J8-ff-V{BIamAp>>n?EbeA8~&yj*KhmJI5}xO3;pg?+M1UBq83NZ;a=AR zGJf>f9ix5oFK^_RYe?=Gsa0k;tH|8Kn7q2_Sjhi@Af^LT+0;a?-nY zXkFV-9{0h}2O&@4UnJQdoR7qoSR$WDYhM;D%3RHj2K!JAW(s9lBBuL!rJUB4mik-E z_u0go6B)^9EzSOymx3Dkn@@hJ4)8Zsl2m|%zywHP<`uq=y$A0B*};ee{px5wAweQH zgZECDt%t=3gVw{7xa=`B)5P_s&UP}RML@#jrSPe7%Sjb|6IlPZnB#GaUjI2~SS&G~ zQKfm?c4uy5$L`LqneUcv$ldSk!dqzZIeCkE6uA5=dtXA7RjDqtmYPZ8ljz+)34~#d z1QB3l7QBou0v;q35iV`kdrEeR(<(7uyI;m{Vy-6zs7qGQiyK} z(Bj;TT7z8aL-?zQ$#M65iemQFf#Gp=C`E?{Wyyg ztcbN<5nx@o9Um$DgP{jN1Z`ZwGwzkUd`lRy0RdsFULsqo@`bb%Tvf)2L1lq z`&|bx9au-@ zPc<2!_Ga%5Kj1{uhO&KU(G80Eo?;h6^KoxiDWO-BoNZbq>+p7I`K(&zx7Y02v65QN zT^-#1%ahG*&SL*P8MhdSi3HFJYm@eP@c2^T~u@5nJYe;WwXJ9W9PehITS;XkLP1 zSE~en#xP6`>3n-1Rb4*ceq(hgca)0W$H^}L@maJigkdTy zaFTEKOjYh{yRsfI9sj;0#Ob;LM9vJ#!NH@vohNp$dq5npg06z3TFASb+BasX3x2b8EM!WUmtYOl^YcMhyu;(qJ&uT7U15w5p%ut9 zfr6`%MCw96hc~8@FP`l3Rsi^M*FsE|R`nBA9-a=M&G{!X&^7Vo6G}n<}A z`e@OvQ-wy;mn-o$+>WswJv-(OUiw-Dq(x#8(kn#Drkl9J(r2@zZc-{h|LVD29ZGnF zhK-i+AZvqK#1#x)xk+^Ca7y^-pf5Ee_?R<|8iK3*q+8E*>ix(;3Bc%+)|Du@2mXU9 z){WMjbtCURQ6uA?=~RL{@L2Xfjdo->UCTKoEv6Qe)^6`o$QbP8_}e!LT6%Rpo_?yW zWQmhx_}Ud@NJDgHG2b!&psDz9nz>q^X7Qm4dZaV;D$?z~_2hap*0X=ueAP@&clT!r zzbP2`gmhdNMMxhl-;X1U#TFf9HAeKd43V<*8R%jFk&)#ez&kiP+VLwA0873rI5rd4+keIWd9N3H2i!uAa%VEC*303saZaevNoBe+hS!BN(5j$|GM0ec1^z8hj43&0 z`j0c(YP9o*q-64&BF%-rvcl5N3LGs!&e+q@?pIw*nq(H&`j22(L(`ry z6lf<)2oS{RVGz~i;aa*=#vb5&fnI0aEeI0R`Ox}pBlUcY-TYlqU zzqn~4>|8ERwHSCj8$fs|1POi&VlD0$8Cq;_{eyfD24T=si3;` zc!8(#D^{_8usn0mXN#x(9C~zNlo93QGWix>N?~Z@?rkF*kp64M>NtrEiEcbs5sjwX z(B5N*Rp5Qm+3P#ro9#1C(3G>=&2I^v)=xB{#m^pfqXTMe5gA$$#_Lnjv%jR~NUnbn zdg$YaMPRYNa>T~Q>AW_GT$>;w$qXmp7%wYIhD)0Bnw&;G(Xd0bTfecu9K5?ZD=@{0 zY=nj!Mm|Tg(P4^2-vAGP26GwP@n)7HbJY5LdC5C0!M>F~PVQ%3Vg6?-G94!-GScn++fp9)4=6!ytpSi*D`rY3b@@R4VX-TBba@ zK-A7PrIg+(YukZOg^*6bRoIG(})?ay<0PJF( zQnlEubMy;D-v)bb-1cqPi+=fRM&I7`kpTsMLg!NB<{;b9n5h zC?8BUsE(FVQ)d9Qs%Rt81fA<;#(=q)lPL00_2EL?dAs*RNAh1hDm;1n=)T#$GucSA z7jL}?I+&v4jn3vfZWg3MPWLqh1$jDiY~N^Pf8%?vZ004NPMzPK8znKeB7!+?&oC7G z-?lrCfL<3PETzniY~t5bb|ejP*PpM{qskfjG(J|;(-y+3+DjTe4os7C#ccx)u(BHh%T34FPFVq-eno`4$gSw)@xgqHFpZsG7U(Iv`Zp{ZLy`Kr5-wk+`;Mc9$W|5(FNWccESn-noG8&?e$Brf$Nf=v(@ z196F|QUWL$1c^!nGf#3DwWg&7;Tw*`8VPe)hTDo89;V!HT+*u zDE=V#;*Zk{8T@HAjxlXeg1=POR3<3qp=YLIPKZnkU3gfP{oIKJnlKbH`1B@2hy~*%F+x(LCBE zzLb*4e-Mdalau_Iv_#5%I#wB2e`~-S7J9rc5iDX2N4B>+;m=fK7C9EJksyguzuki) zGNX;?*|BEV6snn7cIz7aQ%))((N(Mbz53@0H_5fsM*=eb(DRu9ncB9$JCXZN9lp-jxwJSC)HrnX7<^|mBcRwGtA7H)Ao~#PYN%RHjHBJR)bYf8++8{}gR}OD9 zXK80$8i+ibokDtNJB~UJx;-~}<<&eHa;V?=T^*OxxdZ`Coo`Z>Py78hhs1=%iT_nc z{)8{@?YBVs=Au5Dlm=O@x(_QtTL{>~g#PRn1OdEBEN@FHOslOU7?tkCc^EZE3mVL! zr8UX_2wN8nR>8*l9?(T_(n9CAR~wgzKkd9N{`uGOph4CF?6g1K|CJ!WqpFFBcuOK9 zUDH=$<=0FJ|8Mn`+lx8Mp_Q^$rocQ6`EQi{K7XFg`?(+Tty>Wk!o0V2hZEw=!wq?R zehT%A-=iTyc$Z^phfw_6A|X{(U>rs|{TX%skPyiF#?fa~-({r?+x6qwp-=OMg_Tr%tfMgpf>SSaoMMwu1w@7r1|u%>nyxx!osZ_AVZ%rlmx;=5luq!f&%+;ma4(fT1}s9EZt;TM?>7Q^zqDYn8lubV}d)5P(Akm2H;$K-yUdbI!)_ z(SZu2_;~i%=p?9burLoK%letaC|N{~t2tA3RByHG81JNqs75QzVqy%lJm_ zSgM7|puNuI@8J@NOZHT9pNH;csuPfa>dDH=Wm$_)sTxICf}^b}3FL(pf4@L<6Xgu@ zk0<{qW(fZ#cowuUcZBe4Yg#_(T`V~?s}EYrln&Q+L4Oo+iAh4vSpA8>(SpG7*}Ifp zot=>G>AQbyk@-5+*^LiMrL9B5p$vH$Ls_)m0Bb-~Dq;kbXL?G-5K+pjK(3D#-F63C z^HOfUyPrkOuER_6wz;gDtLig3Ckc_ZlkWM}XJBd9%+x-HS5sMgy`(-v*9Uil)j@Y5 zK~1!H34>$KqO#l%af!<({Tm8i!I5W0Rc$z^(ewWcfo*l#548!1p0R4uxcJC@$9hQ1 zGUoIv%!Oo{EAJJE;**h8PwLG5*5lNL{KPzv;ILOBTBcolfmtQh&|1mZ+ofT}R=+^2;?0de#S`+Hp*^ z@TPNCZ7&hXuHIW-e6Jl$($rS6_M>N^dt~IjS2v3hKCOoxJtN3Sscw09GrdM%o7wqr z_Qir6s1c983nrr4k2a~)!okt#MHosZ-i5Z~9KZ;< z6I0WL4DT{?&7kngjrZ<{qO6`>q*(4s8-^WNQgJrc%{(mQTMWfLHX=S?J7nD$;jHvu zM95z2iOFAxt!Yg;$*{)B*aRBa%Yut4ok7Z`Dyh(!L{}Oye;Tae=J2_HC^R}YZqHE* zGkZP!#|+HHZJh@%qQ=8dYG*f=%LgF_bmngI=mHk;_*`+NOldDJhJ|Pc9XFjR?4%`^ zrm+du6-VANAEscrf2Jj-JsFU2yZqjG-M$p@&51`C$Vccinfd%4CCeWu&Y6L>p8M2) zHCW#HGIp&GwD}>ORRVt#==ufjo?1w~^`QXTa95)=-G$4qo9Zp)wr?AghD!4y2taIo z`E8=;m5e&jpf(IYd}O$bBl*?WFzS*`-vlnb#i`5r;#XwX=WG<56Q|-BlOvuo*ATZF z!3LL;3~CXsg&@n5n9MVI9sRCT?MGK$FR-~?^%m?K>BIhmLFets(j z{B}1c<^|+KDxzdUN-*24lTJTuDrsLPOQ(v0N?;?f;%Vi69K7SCGLm~QqXKSHG!xe9 z(=+9H*Ybw!H`&$z_#-0HMhMk$HJfA>$o%@-w{PdTQ2zj8fV1lNy9Mbc%_IT_G8GZy zMR7hsnyC75vGl?Fb*abEcH8DgX0sa zNkUf-@mM(-jhWc_T=kN8@+4Mz{}&CI0;Ij=zrF-^Q;1D&NzQ4DtPml2&^B3D>I1$H zfX?<8qs}{m9#Rb)Jz#5P5yM7@E2inW!{$ZiW?~21rCa}`#d^<{#iG`5|k;R@Y~f;Lb(HNl9(__uD|t*{${h9%PmKd73N`c z=puzE)IB;fc64qc~T#>0}23D;}+u z19&v;9*+WzgP*Hxd#*5J`IfQudp6N6*>-Pt*Y63_7x$|!X%(yLTc&)N8;$j zAi`ujHjLmV9RE7_XPhhn?GEk)e6xzVFB!fRi!u z)AR*}IyMAP1@RN-B$CrrJE`d6#m`6z5vm_=xWf9hapT-tY1A6c{(1~|YtV-qMss?0 zdGq*iMm4h>s_(rlg%EE%xtZKfy>v*sM(HVuk*E^sU8i2q(z?zv#P5p#!9M2 z4<1Yd@Be6-+nZ}{U1FO;fIjfhG7)f}lyjJ9U_LhGNZ|U#)HTr?MQkDZ(A3Y`YK~kf zt`O3x3IFm49A)WDc~kl5KO-e92@-mp$j5P<0~&l#u|H1SW7=pWTTTI|bDpwEK`6){ zdy)2<&k#GC%e*IbFJ|@8PKpT?6va|=w+xO3LYXhgTzyA3UGRZnRA7&7|AvMKPN`L2 zpTF_eYw##RicZbM7j9#dw{y$e{wm$fGkG^tg&mKa|#vl4Rp+|h0XdR<+_I$gx zWg0N@em^Rax;T!a1}3-bL1gBHRXixLJz{WERHwIPbBzm$1{XLv_KN4d@*zq zq$B$ux%GHlG|jH$-}6O z!(<(3r*OiSjM*+fGntpdNZEl5xH(g@;)%=WDrfPK$`Oz6fM#m;(P`Yf<8@klt?G@$ zfM4Gq25$8@a#aiwt~?WOo{Eo0#R`zivh`%=AuwaQ8IO2Fl*!l866+ z#k>R6x{=u8vl8swR*S7R_!wXHn24Q*3qk-s$Xm1lH zJn^mTIIQ z`p(YucGR`u?ao%Ks0oa{c6L#Hf=dWx>2cW?E!Aovq^6Q*O!>vD0$iBLC`lkfI_8)O z3Nf+tX&7oAzgM{lS^NE94Ye$2rDws=K@wW0TwcVXR^v1R+TGasnNrLNB*-DCL~_yS ztmk3+;Es+t$VLn~vz-F|+mf{^XahsG$JnG_mUH(;?sVgrE560M{_0!lNzL7*W?$jU zMc$LyemvIw_v-k2v%qR#>u!#tfXG+X;M#c|ozb|bx#JNfy_#EoDc+*Q#&rr9|H1cq zaV@}Pwu!D+X$Y(h;DNvwa7?WhaFoL3J1A&#G2|yV1etq*_{}L#A#Yk}`}x@VSSGHS zdSZ=~PU?z+@_`6@l^Blne%Kpe{nU136kVCdbAPU>{{X>h>}I}+2p&InKsKMRwB7=j zJp5N}jMKQQtx7C${lgC}*m5!tBI0N_tqB07UsPlv; zEI5giUf-SU&&;BjTYi1Zl0aQ&L74POS!_PPWH_+*LADQ2+L%h?!I+d%TfXm?*MD$ zsZoV$h0>@zHC^6C6Yih(ZY!%}f zy^>;%r;G1s6#ey%k2vJ=O06<6w!ccuc3oKtFmN|o0RtW61*rs-V0)GS8J1P+?tX5G zl^aLw#wy{AYZsCrXA+_z31pE{ZjV~d^LodbqQ{H(qnq^sPp!6YK3WLbVS|ar8JI0Q$^A`|PKQ|L!}*5`i-y*aikPFk@^z>{ zULJPJjYKE)llOo``I91Ei6Bv#AV!Ih7xT?!udAH%aO(4lS?G;z-QE_-x})^n+gQk? zcejnD7Jtw@N2>RBc#dt>;rx-COo!*S)@aorPDT;jp?!V}TvbgmQzC?M<2w7S;QCxs zH$L}dRKHv0Ol{&i#qY*2IV=7|aTT87-NBU9)baiURS8%v>(ncjY}W4dxxFL?3!imN z!k{pmkifg{Fo&k(^)qRoJ|b%T&~!|v^KY5Vi*a;py-%0SWk31 zY{h)pUK)5>P2aYqZn-@J!l&>3cIb<9e^tR+`SkVSv%A%ReBU#bYXJ~J_EU83fPFFuay7&jPAM1WcKZuhi`E~auyjb;3njD|ekbT&{ zs|UmJvSA@f`7Ua;W+Kx5Cqdo#J~l=eDz`3tG}KT>Nkku zGw{kK+KBCH;%9J`Pp))It>aGfO-;x&Z`Op3^w^7}K<%>(1fa09O$qwIX7b&cDy4dc z9#c%O^QUVjyk2WD`%hA-OI3-LIwZbm>;y$?y-CeSB?&8;6xp1br8!IP7)Lf5=hmuB zA+daZuz)82ZY#|xB0PE%R8B7~m@$%UM;#n6!><>HDa4yStw)dLO9Na#Rz7vCmFBLR zwPOEp!=JeX;yLwL$Dn9`;mIJz#F#bFe*=ehA}%vXQ3uWhE( zWw#;a&;vYY{Dw224`<{E-j>Qwk3kK^sALMN$c$en(f=r; zobQ`4uO8ZH+#E*4hi4)>c}e<(bJ5VcuC`3mlMMPdm3_ib;Y?6dFHX-M^qyFVP$pUd zI$J9Hjj;G&cq1bSoc;KN>QKd=%+&2^b@2IIbIxZq;QBUJ>*9GO*(MRQhMZu&g6Tv~{j z3m9|H*-<#GWx9ydIF)eXKuNws&`R}ii@av`OIb^y#!?}@jJu|5MlJts!r?T4-fJu; zRd^I*$dCn$BcH!8dfqlf{~}F)Y*{{k=Q(d?Q^K`c9m;2#NBzUNz>N90C&k6EFxsX_ zN%=NX`;pR(PG3WQb!+u7-N<>qf@mNS-e;VY=D|H_hiFKs$g=1=trdf)4B%x6-%ow& z@58|SiLV#gESz@SWOi|1TY|f5m)X1YO&jG%&dw{sMh(zMeX@VgI0f|#U`iCsk5}}b z@!noawJgK0a$2-*|M-yJR;j4VL5aqE_=;;TJXY1!tk15~|A06qx!;Zj&eRS#E(me& z=k~65h`#UTga6gtcqcTXuz#1E;sE!_I!9vV8!vpyQ-jiXdRq776^@*6d*88*oIF$L zxU8Y;)uM^YD9e#Ys0L!bGGZ`Tx_u&5-IKHu(Cb1CXa$rYGJX+o6Cs&mh}MK|R5Cla zhPXl_c>Ue(;KLm?bHA`}gaqZRsk!ulR&rffe*MD)qbUy4T2ZMZ=sQ zZvL`UWPa`kg;ka5yYo$-3Qfr8Hau))QaSNgeV^ep1~wh-}MWDhfEiG6#9 zZ_?-s>X9T6e!-9W4(W&z74l!eEx?+~t8V+RBLNSXdf4W3uD`ROjt1T<$2hL;f8e}w zzL8nEIyjWMJvrGu#zB4j?Dur0@&Rtg_mO2e$s_sacMS6uDf_$tDe?G3;>N;y_7xJ~ zr>+IY@R5mBTqhw?dCNFH8?hF57;3EdLqP>ITW=&EAL-KqT;c4LKXEIuwHP(S1G=Y4 zPP{o$JMaaJXgnW9U3m`-C2G6(iSi7+mC|mK8SFeEEzJTy+KQRq{Rxn4fy?)Ecq?9) ze}Zt8Mwqz4zO4PwTJrR{1{Ii5OF^D?z9*bynROo;Zp)KZ+qG`_Ev$4#hmO3IIJ1lV#cSOk)IB-v>}heWje(yV?WTLzN52h`xx+0vLWoj4yS2ac-g` z+(dJ|VxRveWjW}94KGp>bp;#jqo4n^pvHeIn#&BS6PJV3Rnu5nR=>G5an097O3n6| z%D(ih?`3K^Ei_=$4W_Bb+BN!QvEN<27p7!9 zSxH~Jab9%P;QP3i!*&PazP5AsXA8{3xCaxg_f=gJVZ~t84@@x&*+bj=O>UK~8zuNb zD3ia-?^jyRs$gfdvfkDNT7N;$@2{?(9J5-hooBa*((w*Ed(@ zJ|GzfWS)lz#R{`xu!tN~9lX17!A!gzTNB*=lf|xQMz}l%kD^4E-1Tw7c(V`KXc+U5&w5PZh!?0YSURC9z=A3{*h{g}`$-!|C6*$^>Eobq< zC$FRIu}sI(hYWTBUvaJFHa?4QZcY&U7#QF|#g8CN!rPgYa}uXfUa1Y*^1BVFzY5fS zEJre2A$NrMjLGe+Xdj$Ucgn_Px_8vcF6Mo(@zZY?brFwhHx<-4pPM6DYN^}4(CRrO zBUwj|YYFayTLOQax|1Vqcj{D|_EnjCP6wi_!w`HfO1y`T*H`92*IUi{6|*1V?C+M( zcy5M$p4Qbot0K>#oo3HIz!V>U_;m7`#^tqX*SD8#RqAi_Qq*t47Zj6JN_*ss4y-s1 zJ=6STj+Pq<`Jk7^PHgy-gtHWFoiKJq|KQMesSsW<(noBjw{j#R%a7c$(X#td$BH8+ z=ZCa*=p>_^d8mmD^oyag>aNjX=xX}P9R_`fmUnN}VYyLg%D5x|GzE5+)#P}xW1ahw zUd$#v{xBpYvhtLYD}DET^ms3eHaxx-5ILR%hjx1yYU_@v$>998h4m4^cCfRvvyg=w`z~WIygJ5 z0}u7zUs6hS5Gg23tZ)%hkHk1J6DAGLik&eKQV)D}A-}ytKT#{&ldzucx+vh@`4D)J zb*&^S>|MAdBU&4vo-^BrC~a;y0ClD!9c8M87B6|P;=>|5Q##5kQEtIE@44}%{%DgU zXx;M%m5RaFlD`gOIbTg>!_u7lGbj2J9;sFz8GRr(bq~8*P)GuUza4*F0ih4;=GZ1E z=ols!xHmjo3Gw?ox83)FW{WX)-y_wXs~~N$%{O@ULvXN{yL)$ZbL9*v(VR!V@|1M39OL$Sc=&%d@SZ+J!?+sVQ2P1UKm2j^ z?Py%wS^HgXcPlc9g@P+O6U0SVUS;w&_~q%ukDP_b(CK0FLi3uBH}Y$hY$XA53liSS z#kzs?S+WUk1u9PnkXP*NBe_=rgSdz9_PptHpmq^$;9rt<`-3D((|aMkf2gPX#FYeQ zOmt1kzm|Ue3NJ~?+B9@)Gc%Xj@tl5FY}(Pj!}MEZ-H8<)UaW&-)59GM{L;$yAV%VV zH{^6zBILsHD8uT#XL2TaC$G7Gng~kgd9QVUmu~e0>rs7cj8<{ErcKMmr?f2VajWkr zw@(^76(lR5w2l+w{sF7pgip}^Bf8pbzwkXvuv&BlOJpUX6jA4<;M+#Lw!gRfo^a~V z-m?}zSPH|5*s^{yabBJ}quj)c$Bqim7SNzBA=j1KsyWl6B-N-W;gJaq)8)$+5U5F3?fIDGPND$e;tW_HtyX-83ybUqL5Xt+a+nN$`+$0KEs>rdL!{4gupL z+QayD(6FnLwcEHvT+RNB8BhRm?c#wtU3#?4q2{3!2IB2q5M5_9Y4YX|g>D5raEk(u zOP^fI*RgA*Zpa0r0gaMTvk}+`JGgWRa^Dp_vQU)DCDs+v~TnqRXfVaaR*C6UoV z8$_#t*YWoI9V+PZ{c+<3Pz=`MCoV?IJMl1PH%*QG6oQ-mX}Erdh~04xWH3QdEQO;# z;U=D9Et^{E&zKc?W)tFSuIaAoG3ts5N-a^8U(j_n)n%P1`CUCJIs0fT`&rsPhSdB) z9oMhVkWUTPD%c9qPM99|_dH`RlBE+YL<6bvd8Ny>MlY_qiqQva|InH%2170z_LW!> z{Q|2u(Ba}ViOIwhflJ9(=Ylz^sN$Ht!rOeM2y}ZxqMw~14QpQ(2H^B5>%feVR7!}< z$7h-9tg*fP^J5BU9X3A^G2$Boc|J>M%_A-t>j_hp1JCML{YO%E9s?Z@2ZWVU3~-?_ z*Kz7Gg4Q`7FXmlG&ri`VS6DDLaT_plZ#mhS9dzm4o9->{`=@Z_MNCrV8z3Oxdj(UarL{cji{AltUn8AkB$ia?vzoZVH%-MX&RzZe8y?i#hX;(NGQIDTv;BjTL^6TP zn*16Y!Aah(0E4&TFUv=p@N7+Jsm#RkuzC2Sk>BF^ym9bx?qj$ZG7*%_xs$ggtjOg_ z4eW5&$_Z^Fs(Kuo#iLIsBjjnun@n}uNZBTwj1pH9k9HiUe6-2obWBREf_;@_&cS?} zFmQ^1D-F`KXPV#lpyeB7j50pqH`FJOd`VcGhd%Ig8=u#g2hdYh9u%wc`l1I3lkhfV zT2y9*E#SsYs=$geCpmA#6cO)A6qcu?CIBMb;Do@M_-u7ia`LRGVznK2BSO{E<5DOL zv8TJ+=K2Y15oO;W_US}m361J(wmhsuSGQZZT70=e^z3ClH)uiE@87yw-u%msCbsL(A_JfdGeTf*ywC#+DSxQ}`5`9NX1_)*t<$s>{}^wi!}^$e ze}4UT>)Sz%8`ygDh9>q6mYa=O>PlEr`gq4 z1`e{S!f6M648`M8H<&*8D;rHe{`s!9WfpCUYtSVnDLc!lT~#B4;+HVFAW(*h{qND* z=kY2=F@6|FxtUs#Tf$3`E=G1U&N6Pdi66JXWbX_=?Xs+;n<9gimF`u|x+5{{9|99& z575)b%X|0J{sd9~DIZ4$OKG0`CQc=W$C!*fdU>~I^POqX##$2w3=H@lfTk|*L5A(| zlGXJp_Lo~3aaBHA7bz>F1$0ZU_=gGbt>rK0HkBfbQEvxlKA-$zx^D?(Cw?+v?KyRP z;l(;whoMkSSC^Btj?hT1@Y^G1n2%>GOA!(t1Q#fFLSw~=oAG{#k6-_@x+oXGb9w~| z!w`EV+DRMzH3ARRvT{A9g*F#Yx9r4XJ{i5$d_DomnRrINVe1KBKD4I|R>sFtok4$g z*vDpqp&brbxS5+g3Exx_h-}0=h4UHrnr4AD#yF%3!dV8EMhioeD~D7N$0Xka^zgs8 z=vs*H2b#e#PaOG~ihwjbs}WL%_7w|;<9REJ8c=NIKWEd44u@5?-gj?Qd6-wXnU{+( zJaLNN?b z%KKMpMACMO&ALyzM6t{Wl}1*$QV80-DcC<0$xL{P+zj0HDF?|UEYH7{zS_@Y8%#hT zAo`i3+JWni_y0K5;xI3jXq{|J=TmRK|4??=VP0A9-wCAKp9}nqAgumoMAxB5wnI|k zNT^wf?{_AU#j?7sBv3)NgCD@)1LCt~GyNPI)}*Xv3e$vW5f7+PHWQj2q(%x2Y6R7e)tj10y3ip%zj@o-^_51CU%A}HGu+D zN=L=IdvA4Z6CcHUci;hU6<6yhS{G^oe{bD`ZY|J2d)-CClI7d}}s zI1EOGgMD31b!R_dqmoMRWkR9OCRvmJ-Kn|;2sm~=&9E~&&M3O(FGS`@RJqCjiiZHX{#eRa-<0~NgQeEKDrk&4-*4w!$Cx0aL z^B=wU&)XbTP#xJ21Y|SN`_`%#`3RPWjk_sEn80_Lxc-T?&Q|~A0S zuK!7!OhS6myIkQ^H!VokU&~nlfD+0*Vf9@XH+y7So!57`756Vdqy&J$ z1Rn^R9%OJH>`%6u4*Lh{Ch_hbVT7>C*YWrqF=c4TN;gNDn0y?X>eVt^o32ex&Wj`s zW1hr+5KvM*=`wRTEW*GRKH$2!9qqBdSR{@O)9l5$cFMnIUbMT9sN{alN}K-5OsgdI zz+IMxQ>LG!fT0GrYFk)KRk&Dn)28}#_roqQb1$fD?WCaSqV=D5t*eEGhsb}NHuDqP zgq0uv9`1J{6kX&-ac<5by~>>mzvq5H3`7ZDm-}1z>E(-RGe2*hP4(i$XkyY|{xPmL zwB$lH`v5*tJ(E#Tg2LG44&DVpy(GsE2c_&ip)LCt zRJ8q#<){j-?F>8-WEO+@(~dlP(_`G1mL=%;c&eWRi(+j# z>N#AZZr0POD2e&QgT(1Amq?yxKI4+6p=L|4hdh7VWs^V|X#x?`V9RauT5MkF&H7~a zkWbzq0^zuH{7eV7p%h$cwAz59Z=l|OKcFx@D z?;=mRx4~6(qsgE7${~jESu}?5^YAY`YVcEGZ_jDS?h=QSpjSZEN(z?s;wW?e5J@Xl zR63+b@t}&P?frcS-k{n}#I956T29$!tq8eh%k@Z(k_pK-w;@LSdw(ny^A>aR8lRsC zbgMvBS)T)isL2LzzF5-Ov;WJaHy{O63HX`o0XBR#au4D;aZ|5eWTHgDO3r=dj|3}t zN%E9jih<8$?(e$jkBcZ$62b zv@syA^f72)e!-ZmA?mux=wpiNlx6OUuv#`UVqPFi>Exwu!LqQ3BlsEc(~D*9UBD=) zDN=sECdW)uDwvw^o8Wl_3O)N}pYp8xQwh{e)*kDS_wH6XytM$1eV@rU1$~ioNacwBnm;3(H&rqLr5HndumlQ< zNbmEGYPDHf&<7QLnvVnLDkp&ww~q(%Cq!e z`)7gq>JNJe>LXwHgwnTSPzP}Tk^Pig4OJ*#0e=TQidAN|6$9Jp<(X7HX0`)LWY^X=Q(iG`N3Ot2XuI~OSX)>`cl#e@#Wx_NI7kPMj6BCUSDQl$!L`El(CWUJ= zdo7et%1&aXCoO5D5rG(u7G&gu=CXm-WjD^Giue0Jx4xWl7;iUANATWmYPps?=cxaE z!xD}XV}N@~i>XY$!h)QnZnTD3YyQ@;);tj??^W;rO;c+(aI9-?)Wh@7t^_)l$0z9O;?rkNzKx}NKt7$V3eiak9-$xqy#FME7LD+Xf@J!1 zNypr?O_Jg{?DD$G{1|m8_}q{_S4XQR5XzFL>WLGvy)p`v`+Hj7$AegS%=rSK-7n zekcz({FWsSaWfUX-+{mt&$R~mx4P}arm}KkOLe;Bui|3-Qp84NrcL#1<=cc(C0lzH z)U1ba(}RM&LVpkaYJKW%bt`QvBn+^5)(5?#~8gol>Me-1=m7L^iv_J?jt) z2npNJqSy(aOdcV;nZDTFWVN;JHRC?WQTRXjNyHQzJ0 z9=)$qP5OMLXwl1s^$F!B0{!&RHqAmz*0;)A(4@CPEi5QHm?kCG5JIZT(Fw3Slm$C# zS}rPv*%)ls{fQRUp?}a3KCZYnF z-DVd8`@%K)(5$}fwpbNC=u-s5Hxg46mvgOd+(A}%!k_D_bD(e5os;5lP9ivw#y!?= z>b}H5=zK!ZY}jZzkK4%xtjARWt1Q~wql|Bz4N9rMG{%=7=WabAs`Y1aj25z_+IG>J z3hQUxKRp3cf7?C&X^?V$R%8r>=-sBI`%YeEplo1fnKNbR$zhe9YYEj|Ra5f1=u5ZM zG{n;S%pu{oKyg!bI(`nA3BvQ&dara6>~jo+WdZTEK`=Y(+xA>yWyZHfuW5Sj z%$y|CXt~na)(t`QgllZm5$%})oK+}YfaI5H!UYlG(}@_&7QsI|AJUzwZYBUfr-S$Vrnp?bpSvi0e% ze7}z}50cW>ejc8|8Ix2F?Kw7k#8)e^+iqE0vd_M&)v%JZbX5=TGyf3kGB3tPi8O74{+Rei4qeVL}s2>&x*=D zSbbkK+e|1hRs?OU?!|1UE7r1DkPKFTe81vUs$QBwgve9Oq7ovTd{IDO2DYbrl+Yv> zqn#?&uXMj5M%3Z@h4~+Ui^@Kud`{wo#fTCQ%>&#dC>78u_Pw=h@G9{0Y9aZ2Ow-%) zX+s{J>7BQ=MhRVIJUZ}6T?@RypZG9!q1qsk`swIjvJEk3*Jn;hqXqj$yd18^34Vxu zJZ}VE#~Ht@b;qvp-R*2k1nqv+XVqW+LUD$^ygd@8K4BV~M2`#IK$U+I-w9t^R<*0D z!O(xLT%8E*Qj=OQQ-1V5H)4;~)xS0SEpA`uzp9mYLNJrBtVd+z37wMVSku8f?&G1i zgmCq6Ay}Bb(-jhEv*6W}`S>O`B~SU_BMFW-=d0gbpd$|Z%x`?SywHAhLA~#?Y1@D@RroXQuA4na_xL7>PNm;lew$@dZ;tl+ zoM)oul=){g(M}~9bj-}drZ@V*mNxd9*t3Zly8;3B4n$-y>g-Lj;Ez=C1IA+sT6-HF zNRSJH&t?u+EDN>nV~sChWNu$V^d4FFN>hP(=K^~k10R189sqd z8oq&%wOMPr{vqA+SR2>?4g_@v z)^JzjL+#Ww$H+YXD=)Hx(P+89B~nwi-F5Eh^U`NOSZs*Iwud$7k55X;BR;}S<&SEo zFVaA?0nj| z=@i=0C)4WY7g@r?BYffw1Xo61lv~r^3>=)bbEoLB2Z)GVV0amq6^yT0Cm(5d4!rLu zVBg3+i+f+6`Bsj9;6y5s`^=Wk$qrH@TW;+7y8NnCc~#WN+S@A1tY&pAKI-|3Itv8i ze}3891%Ect<|1vp0TGK=Osp7ua$s`z?AXqFD9yjqRoq778{d)l;8UXGCkCbQ@A%nK zVX#yFnRdfEmMSCj6?<_yVx%_<=pW7YHEPMt8q)!smU;PKZE1-?@?{6LS%q=Z2Kwvt zfrCqv2uesx7!tZQl^Nr!z1FBF6Gt6qKjMQPL4|s^@a^ze)##aAx z){NH78w)EiI11Ld7u6|HhhIiG;e0LIZHu^4m@G*l^6OtUD`sns?{d9<+}*d-{B!Nb zO?8J0_HnMZ66#5mq)bJ3w$!E z^D4wIaW(0FQ6&mKIW^~Ki^3_mZizTYPUM=PoW10?ntD}ki|k#zEnPjq<|M?Ap>a&T zExK(ZK08uSo{W(?X30Asb8sL!1_>Wm4f+^wB#+Jf3896s>81nPNar%t_BHJ zPqd3mmz-GOXUsW`ZZu6h+eUU-h`!-=0TfF-W!Ql+f*lF$W@e0 z3>Q1n`Qg4NVXUxeLnpHkSDZVZlC%MlcZD61=82qKirCuIpac8TlzG=)a-vGu168L` zye0T*OCa;UZ+=uL=WzZ=FaMoUuJ%jvV>6NmRqY8ynr);HRYe)jRu60~^`Reo${%U` zq~gkQX;QTgl=>PR<)mTZ!inC+d#JvlL=2n%icz1t3(5Lj6B;XWPk2ES zY7z)NO^3IxLn1Qm>~)8gD`R{LB{nLoc-yz_4E8ic{cttktrmBjP;y1KBa!X<`t8TL zW^ij(0>WAI;pHCo(Q|vjJ~b5OJBo{R&z^^d&{N45UsAW!h@odQ*ddVqu3l`3xu+FB z)IV&oR|z)i5Z>Cn^10{1&Z9NCk#b1HH)qB1vo8n=$Eq65R*%zl#${1vCV4+g=HZT{ ze(*7YQ*)V$IulbDDh!iymJb{3!3DjEBw58=R>_MzM$0OBXUj!)(^)@kDq-V$#RBeMku-7%dvdCU~qtTooklD-i?rFaFBm#1@sff zjWSa$(6;aErK{y9W-f$J)|wvXTgv!}n^wO4R$X)d(x=DF@bo`TL{6@^2j0CzM5pDB zuV#YBTfDuX;$MirtFl|0?hG67Z)g3u4$W;DeB>f>dUbF3k|oI4G>__^^T%0{p&k06 zBpEo#iw^fGnO@GZLE5T|OfZn2d#0LJn%pm~n^{Yil7EAaxPd;vS+wC1LSql%@^^IK z^N8(l0c|NVq>xLMrBZ19L#gX_0BV}DYKT7OuA`2&+uugYUyMOpJkzk(emsE)w3GBp zo{q<`$Oq`G9FN)O`&i{mOvr2YOdpo1$BE!!LZXQ3G8wWQ^SFY?h;HObkV-9KB2|8KZV8>W376M}K%B?98#yVP@2i_I^(cAb@wPIR zc|N#{`U@%t%eA0PE3@^ynk%>m{AU*5&lDh_$W-x6ByyA6K&5YV>x+q@=2G(tj>>LjC`mo%6B%*2|u`O@k-1-`1BLL!y}HY{N@g& z41YoU_wTF49N|xUuQWj3ukE$nI!s!!k3H1M8jQ8K!c*y{*ogxjI~l!s!_c8yLdUXt!SEaPSxoXsw$VyvL1MS?~?#0-KXI3uV z`PJJ;PGR~`(wiD~!H{=wODy1z82tq;IM;O{MdXzvS)9PgP|mVy>pu9;E7oYkl8j|5 z^V)l!4FUU8xtt3z#IR8)FE7oh62rp3&>|n-8p4mhX6s`<*?7;;#aA-h`WY*D^LQumH;)FtM6@jPtz5Q){~ zIpe&=BqPFGPixE4qJ5Ay@*Fejt%O}M1LA~MKnp?8SnWJ`h{y7XpKIKGTrsY{o;N~o z5*T$$7jz0COME9IZCe@!KAQ4nuH?BNmjmn3zwY@fB2dg;Qd^X7aYbEMAK=`S_-q}^ z9q6 z#O3SMD$SzDN&Ap1MuvFuq#MQdLB~OquSU_LlI)SSC->j7?}hM3)9hh!CHb$$8)|q5 zY46qx#$%$!;sc_JgN@44ty5>UH3iyhVJ>_4!*o_=8k&R^FM0@$N$_c|y%$a72!O`J z2c0#f@T&6M?L*R8MiVhO zXRV3c?1n4&jjgX#NGTD0HOU(jqZnT>_}~QC>Z|~nu?9y*8c&z$si@xRe@sLYzPc{< zjj->5aBiUxb;g&TTL5~jmE`r;&l~2ZBK_Ng{WQ~z&HLhxwzN1KLon&}FFX%%e!j_h zdCH()Ii+I#5X*=h=bi>lvaYY>f{u#Dp|;2SA&^yHb{mxmh2^~0vJtcu^HpE_d!Zcn z<2h1hfYOPp_8E=$70!O5x)91j%1y*b)d&tKLB(^Z__9)`^p!BFZR;5)S7$Le*V3{x z*veyv^8Gon!~MN}w=WpkF3^`9srD2n1Fsli|4n0G1Y40)E7ARTqRg zM67>@8f~Zl-ob)N_x-6?`1$yCNFh;oCce(q;lm+D?T?>o%9`O`O?36;dfJLWAezmn zdi>})mkxo&-6mF%`BszCqx?`vgwGV_JjbT<;6|eR2Nec#h{5WPJvvZ!Ezkj5T7uAx z5*oV>GJ(}iOVd;)qNe5@?`>358;Zx($|guWYqWdKZP(f~<(z#0B40XQ^0bx)%>>hI zNmVMCyxg)?1h%ED0YCbN_3vG|!U1{xIzt}O8FH^)6Dp?<=JuPe-{P+#b|MD^Qb7`? znaFim_CQ*(UhmZRfnN+5UsS8;D zL^i*gWCZU(W$fIkd050*AXn*%H`sIrwro*Q|^#)dWh zXJp~nhAa1Q&W@xIzVY06TvH3eN|Kb@f}x^lTc?MMLz{W@2ed4yc{O|RgTJ8xCcw<4 znMwQnYw^pLsvW$!6K@gsu$f`6#UK!%EC6RWC!;KQ+u=socay1zRIc}|=H*Jr@?s@` z(_oc-1evSs?88p)mNj&-b%4p~?rCVLgTC1c35y|1qC% zq^-la;1Ia=%v(k7h)}Se5eAcI{8*8v`!;eTFriIH%o@4L7DDUq_@pg1kAKt?Kd_Kh zQLwJ~o9Bm_0L{-g;7WTF{8>fzaA5q6it>Gs#ShAv1Kvw+B3_E)?NzPyeo6lAVBzsb zjX@E8-OWmj@HFeE7U+o}Yp{UdiI2H)kSlf`VCjU%TbSTIoaqT!vIk=l4aq1i%|Iw; z@-*-wF)|!fURIySSMWNKB>hKt3hrbS+qH`?OYE_waDS!J5-pNM%mLgt2?LcyH~n>9 zb9CWgNmXsIY=<%g@@m|pX~q?r5oC^ACNpSbQ!zP!{CJy#n8#*^brPESzxdG)n`_7b z94A(z__6O)cwe0Tt{l#tv!ruXl#f4M7zB1i*wQ8N3k0(HdN2o5l8o_OA!odayz7VXa3$G6mp4@j*ei6qIoe^ri zc#`H>vUHInLmi%^i9xx9KQ883`-wX3$}`hzAQcy!T)bXDXV)SYmp{*Q3gvAtGYEFE zwds~QBV{Gv=jj}fQ zO#Icj6*v{zjo(tEVl~X1oqct}R-WNzzFt5bP;!m_9p8{{NY1+4d8W1Ue^=;Gc@9FI zpUOeqRGE#r?~kVy*c?Vzl0VC**{OXJ{vZ%* zpE!F3kBrMbt)19aGPu%Emyi||RZJhRr+EZ}T)i3jx}oM`9NsYL&^JZ4)rq@{YvC6e z2h61a^K(1g&U%Ku+|QxV-hZDjQ2PH|Y`G#@aLcoGAeK4FDbYxJe$DHbY)GY-!DEEO zz@ORzP;`&YmxjOz45&#NL_i0-bHLf7REVx~=7&oi6;BLdaT%;mg?>(Jaz>;tKexAx z8rumASReeTCm=3-;s<7TY=cNqKTeuA%a+M6jsw&ee(~>K=H5F7ECI& zEXN%Ucc^d=W1Vn-|y?D2mtc>xtJ3QmQ5-g5siaY$J_XT0kz4K>(vvbCys zCdvQvkjgm&2Xv(4J=wc_aIS^PwBgYjH*((r%AOW)1m7s!ty+HB)_RcKm*qmi?!l}q z7&nd+bia67#`1}gn8=)n`0$;7EnP*z;1W>XCW?Rei*YHqnh}=^N*FoF6Zdcs`4P{Y zQW&Diuq>;$Km%-+-E-emH11Fy7-!1WH-_j{m z?sv2WyEy)jh51RgG{c^0i1dg2j<<(=5MNmUbTK@C;BX` zwt)?)Az9Y4+>_*g3Pf#y#IJpj?a|?`I>8@sH@-o-K>GHSQDa3EwXu)jZWKD{7i^_B zNnTa1I`j=;zM{m4V^I?U?nX(m=?j2^OyUUQ1NLW>%r2tMpm`YxjVrh&1nzj>_VZO0 zQ+=tTjLc;hCjNIe4!*IGI6$?lkkvNhg9LSOcif4bkSLiS+-R0EVBa=bd>}V@ixSm9 zI}MA20n-q}77=ceB)XFGwu4Y^C zw?W6qHUYD1N#Sme9*mM@WLleyVMC(<{zv-_PznI*!Un93!es&n z+FO#ALO!S9_UtJnmQ#19l#$+=eXW2$TtJrpHc$Q!T_c3`{+O7?egLgaC5Y=cv4bGz z0Hj~)I9r)<0ML~n*gw(94x-aND4e;Ehfc+DKw2Vz?ETL)XlgKEMS=sy z&^&kM5Q=`hvn6gURW2gk%q;PXS&8B~C4-jofF97|idf)W6u^?T0a>9df?0^0K}Cbd zk6*PCMW@#6X$acU$VgxQPIKSCjy2vcEhch)3k*mowokR-N5hj65kTYafym4M5ux(? zowZ1vigGaft{y)mhU)+oA(`i%jV3YO&M@gs2GPn4Dg{_NlP57*I>pUZ-x5!;GXf#% z^x_L|#PzYT&fzkFx*?EpOX1gu8CLx3D(1~2g zBHsOhnGxVcxU6;LP!BsQR10n&TW5U%er!O7@+PC1l$e8Ii;Fi5hQc%L9GJJ)S@*EU z8cG$}7>1je@wF6rNM0qYSnh4`BX9l{RgV%~XE)j&;a3lXBbtW^r$PRr_)aXxbyo>O zB3S-)Pd?U990w@4H^~Sb27)rvNxv z{SG_Mab>MK^~|T@i6tzyFz|zvt-$bfS{spj5%gSKI7lfDe+HBkw13aD_n-6p2FFEV zrb@WS=?sy@NN#RpvGe?^ZMTZipNr-iO@F{ z)(FJa23Nez^0OKhqFh%%w9ioai_JW7tqHDIiU4F=8$Vxp@V^}$*U%r2d%6$;G(dfmbyEMR%@Dk0fF@WklN*>7*lOAx50TbZbV z8(0uYyaSAA0B*}~s0S%-6$Y&hg@c3A75FxJExso4GC%~##VA5qzJ_EGN6sJvSvNVT zxonG@9D6?O8??hHu!EgR*znlAS#uQBjCyc0?N`v?VPmePv}R5h|97HW?mtpnINcZ6 zl___Svib3Nx(u~QP+)+I{Dw*`*s3pP_MyjdHZW!l=yPMy}2Lep3ow}z+OI9e;VC6ax7OAqzuxd8TG~Dn3$6n8Tk`VpAj(v&juneY{=@CzQ*=WC7)5<+|t2&Ln$DS#D(o%s`7<4pOw)U1V3CA7FG;6_d!tS>YwcD<{5o6lb>B z%XK~AuF^yd3qyHvOsppSJH{Qp0gAb)LdJdMOP4vg$cr3cz?%Sy=>QYaGBZh>i6TrR z;9kr`Z$Y88)m#KlTKfPFCk zug-vQO4y6a``Q-pX^}$Yhxu}Q9(cgWc{an>i9}<|!oIYiOQD=7Wx?&=(o0cQ;#Qa+7-SKdg?M-GBf?aDD+wq;>*aU z>L_(D9=3dz-FIQ2W13^8>MbZ*6O?VI>+uZqF&)+5|HgUC;-fu%TR6&?*f~oyDYpV~ zh+vn$e(=YlM3`+Kq*&Z` zw=b~P89-t<~c$;Qmt*2R5p zE{rj3PT5iuW-nJ{d^iw3>3;$va<5-=IhRS*-b7A#K^gH10dL2&wnznGS;R~K?+9oV zv>CQE8PR;@x5ZX`VpM=IG}Z^Q*TuwO7i;hb?}8Yl+|5+6BA7~dSEuz!SL6IbE75hU z0`=ve@a^E;XT`f0BEzRTt?k@J(I!buU_oD2+toEM7kJ&Vtyd5>K}dcJOagx4KcE(} zY6wW*k5AnXY(q2swOeuH|C7{8R|~XA$slbGs5!bpL8ao7WEqh8!@zJJT3x_EAX=n% zvK%yrVm6<`vX3~o-PmG#>H4gxiwu*r(!_%8w`BH{^AhA(cXnSsqis1*R=Se_w;wE5 zK+4Gh2T*tK9|;`-lR2omLVc5wiH>%lzp}EtiM5soIUTS=Dh^myQ8ZSojC$&d0@CeX`?HvtDF;elU?7MN+dre@ z#lC;^b%+CzkHCn&TOu*oG+2efVaA{2T`DROmSF09WOX9OL=K3#=&gKEK_I1L@-?zo zb1oGCryZ_5(Wf?gMU#dp!~u=`f`zV8N2I{>y|9L;i}VUiD< znl83%)31C3dg_(dpRth#SYh-&Bz(vKNW(T zaIXQIS7_yYMxqGpMLOJ$rnzjI9^}e{Sdl6KUdN2nx3|uj(bWL0Jh)~-d9FGA3vrBn zuz5XM8U+AD^$(5!>Bo%cAgpder*1GkIL6DB8%!d2m`Z4xdT`qvN;*C49BIY}T3RO4 zQc#19LxjuJ3p2cg9=l+H^F83{%rL!M!~)FnXHPfLO+E>74o=~H_t&$blQr`L3!bAv zldHdY(t}#>H)B?js{-chRk17(hl)R^U-Ly6J5%SRu=>CN3x3a(A!|&HbM43{wdYxG zzkPmSEKzqtKuVf2LIISSqBFO~rHi9SLDd!4>JHzeZkrT-UJALXTb}pse z`^6e3Dw`V{jRr)kOR6hC{3+EYq+Ux#>4w!7Cw%)Glm+>%xY3Ua{|8VI+%yNPF6)BM z1n|wxVYAkiCU7`1G!qG85tQ2O??S`zYulf}RC#WOHgx1s zQ4|btz|OaU+27G30ld!qtMJ5?Z~YUkg9Dpd?mKV90kK|myZhZkWwPm3BWhEaAVY~S zp(m{L`>k@CV_$5ZGv7_%Y;yPR^qW68cV{8{!Yik31M}Svgl0vCvpF@M0mvTzx0rMP zn-&Low&MgYTEV!nKD6dFMye>dm(U7`B@z919cobR(>JZi%jVDmXS^sNTCjnjwjf#? zOZng_3^B9Bg!YAAd7FYZY8)YGJQtt1T)MQ-GbFbD@ql1=LVh@&C$GD+J6?g8p2QAu z`1Y?L{WgjKN&Tf9HP41uRGN|~ICdQ?U6i3wmKM}cNcBx{)=dI_i@#D)26Bkh4F;iB zkd={Qytg4cS-i9)p9KCT___+UAS0Z1{0Zaq-hf|T%8V=KfZFhAuVK67GC(&LEhY5M zmG(EXbikGS27Cgn>O^=!1uFE6JIY z0NpZHOAO`&^><;@Yext@ZV$gk?O``+R0SQdr<7g<4-;g_#lvsvqi{{V1XRV}3&N@5 zwkrEAGd4?$(dnDW6Y*w+a-A=E<|x!4#HWs26k;c_xLLV2C0lV8Xq_ z|K*Sbx&K$BzqIR5RL^@r7B)z!#muAuH>Q>362?H zr7Ng7_}0$dFJ`Sc?EEqo=m11MsIbTYd+H+4B3UWJJl6D!7dKd4S^ZZ`sR|u0)D^@N zW}buo9|oIww!pX0heF+PA&DCw6$JIhzOMna=_I7)53xcyrtTD?K;NCkhb!{HOM0dG zM@E61Fn zzkewbi2M$y$6ZI*T{pu{U$#F`WEbP#{T{dRmtp~c_}(GzLMsO#$o4r+%NaF(CJ@m9 zCz2a?YAPp6iv!KO3sCvBw<$Tr>rZ~tw~P(0)Q1E3F}PBPf}nfSQ(3*M4`H(A@zVps zOdllry3hA?hRbm z^xA+9&RrJ}e$LZZt^hUo<%nPy;!%U!$BSeeH;rdgV1Gs{RK-fIx{osS9E}wlAu=YQwhrrIAPvZ-mA9e1d zNBaZgcjz8DF%hxzw&bzbPE*6l)|bHS9UP$Kl?)nk9$oz`TrlZCp{s=$>yfFq#t5aw zItK5t_<;esoHAogELgT?kdd9X8Cz^P&GYq6q1Arq)M2QJsm^}pLM8#H=ns1iXvy5t z*9ggfr~u{QyLs*E4T$IUFUrgfe1mDAM1`)Wg&l<5ypd1jSD) z1C_a*l+`nr(!(3)V6$#;#jAbqq6z@6mrIa&Ckzfjsj(TzcM`E+zw-a#t%GETtegp% z{TZllMm#<&bCAr79Ard$!48l&RVee?@2!|2R1EW@qcc=a1Ec804G=*7`gr+Wb_3k- z&i!J^VDHSQ^-=Ys{LMl8Pp)g|A8BjUNy;f3P6vOfbZ$8|gXhbUHn6OmSFK7W;=>jG zJ>#!|bwD)!U3v^b4P1xjRU@qQ;P#+f=AF}}^JR&MVdHiEO_*jHU<|#4DfGtH=*Uov zuVRwF?{LcsrY2>OzH7yH^dwP~R%pEauvjh@FNol6>p2gmTBJ?lK6u_2UB31He>g=D zqofhVa(iJUsBnU$jui;VY)V{CHCDS#xkCko98kk~89bmu>ieeE>uR2@#4s^$KA#zF z^m@WStklKH1_oR4=SL3_I*da*36>J7u^B5dhRm2c@Ta*Bf&BWY@?WhZbxiQcFv&z8 z8a_Gn0UAE_BY$3;Tm%qQsUldMDRv^iE0}v-Wb|;`*<4pqFC6?{dlq~{vs4?C6`o%# zGXAQ=`yD~gIP_AcEXVY4>A*Kn-u5Taq97F=jpF`a+W`dfOp01$Gi;1~3d`pC?RuIK z`G(7QjZ#58<0v=;6mKt}@|H+o63SNwv>cGX0gW2u;LLvb!xs>wpvU4QXYH$hfwK;% z6yf@n1#xmr$*bu3vz7JGRU&#M!QgfgH@Sn~Qjt}>MUMGJ%7kO;(Iw)DXE=&O0 z@|+Fja^k#`anzgU#9`eos!m6ea&m@(l9!tSc%7rx920}v%`Daq#g(sTY-)o^uRZ@& z*oTSpci{g3->ZK+tDt;cVh?OaOQzj5g4}RgA((bx#Uc z!O0(S;h_2>=E*fRzqbK!lX9MQ+KN%=&7}Ays|6c-y$Nd-I3HSXA_S89drr@Ee>M3I zIQxIEe#=T1JK&znMd8Fq{@S>C-e~0G^CAO1z2R0#z$dx6s-jc`ECh2vbsS^*I)h$` zM-sE;8IoDuvwP=mxUMXQz-uGI8o@uJ{Q=V@>78IBkJ3L7H8Bn~u;IhhM~85f2x z=osLp?+E)cekHsJ>QVOEN-8!@-;5~siq*J}cf7&-p1J=a*FKB=&zk@O{n!}OpZ#CN zSizTrYhF|0lEEg9xrgh{v_RJ*R_p1d>YXrE%PtN>*$bIUL8hu7_ zN(>4MXDB1+_lkKkHt(tkA89M=9*(cCJOs8sgyqjt2&854ATTFkGH)K$x8gvXm$o(z z(}LJR**cPPf%uioR|7#=&H4P5_h*7>+9sUpg$d6HG&dXoc{$Tp$#y%8ta^L>>U%Lb}WwrUfL;7o9)KT)?IRS_=NO;vdcXq3&!cm72(`1Rw{I(f4Uv z^w{DKBT_nkiXEu@T0F&q{|fAyHn!P`B2loDR(#xbCC(k)ImF$WdEcjx$p^BN#P5z9 zAA;7I{KoPK?tf)0hhLoM0Rc3|62(BD9qHF9(KxePjkmGsHRwPBuNd$shHNf(7^(FE zvblM$=7Dc@^W5`DA_HBpGeYqE>ttJ5ej(Ba-S&I2aJw_stsU0x8@M*vVML5|x}HkYIS z%8GFVZ<&as2kHM319{#Z-R9XjEGjDoX0HGFzpY&e3zQP<5rmt&^i;66=65rU57Y!3TiF8D0;(s|Rv8 znXA*U_@{db(Zv3zNOC;A2NaAD+E;L5aHczOCtnzDnxW!GsVFv2+J^>}65);X;&4yO z&g$ju?bVfh*%zBmpm47O2cPAU0-GB){X4ruR{23=ALq+0s!emi_sH^W)V9YuqwvAB zy832=-0Eyl!8{gQZk?Gux^p<%4LMG{PMV*&xiuf1wG)cE_0mH%%xBRK#l7yX0r zmos~Nhkr-2xxE#2Yx@nY#WSvz>Q%VZ`1OtF_RdD%ltvx3mBKwaY$AP>jiG9?a&nhV zv1$7Zk-jvJ^`Vv5w>vDVfA}=%e0k#|pYJ!I$sF|6eie^5{hZylhh=823{_6{J8e2| z?R(WRs~wMjuw?UOx{~fV$w&U%Db(ridMY|dM0v2sr`E9&^kravX}yG1WW)22qXB-_ zrqin-e~~wIPaBw~pLkL)_C)vX<>puPfx(eqrIY&MCw0o`LDpV37Z_+tPq)%Q;3#rv za3g4R370%>JWmdFYkShOHS*HF+$Pn)H;Za&mqO>uPJAGzdS;E1ylkb=CvyXQFU=6ZOyty=lj2mQNJ)%!qAGj-u&E0r-Ib$wk{R$moEkh!N4b@o)i`rpKDmo)c7OAwA)>NcmvB2PVb^`<5_myERZhG;qU>6>z!cplySW*hlnD$P5`Lq43&z3bpeI{Vsl zyFS@R5#eQe)nu$_mc$RvtdkL=710S_7ukil7M_q16KrKfGJ{UZt_GG3) zed+FHUPjR9=keo4ZBxi9?321i<6{gz^M~J+7r|$kI<#so%Tef4x7K$;|0?&b5CRi< z%;-kR1vT^MbhWVX9MAAG=f_M(aZd#*MLti3b|q!vJVorMBAuvl(JXOkvb(XF!d?lu zlcG&Ih-Y{sOvm#4hQ4GvyG!!r=hFN(ULG;NuX{EO`sU3zZ z>r$+pwA7Z5bYr!%Hi14KAM-7+{Yzc&`}P^|liz+Xzur@K+h;4)ORH0loW32cDDO3g z#5Fat^K`yneW@DI7pi(9bmH*$(D%{@Ik~GH+xf?b>-Yb>??hNx<#GzR)nSiys(Sss zp>^h2<;1SSK-bN&ooqFM#q#yV^2$acDZ=iSj~?*^SGW0S)SUJM^f}7cqv}h2=4N`u z(_7|s@ek_)4IlU zhOE$vu_euB4@>1egV`r6^eyZBN6Mh(iYe(??lJy?8N{%rurv)f%A>n>nDV9P)RL{) zv5zOy6#B*px;k%ax#$x^1I^~*pYO}IZdOi6HBOP#$Ms(ZD6 zyczA~+g)=!PFA}u%=2?&aqVW1WchZkHW}9Mj3U$pURg7L6yNYb6%qf=lnu0qzqo|# zd42&D$zfg%nUcSAU;lUYxmsx0)bH|LeCpc+I&@#D~4FV?GMk^K;UKB1^=A<&+!;JaOoc=o(o>PO3HaKMG% znOKWkMC1I_rts7mzO0aY%walQh3|eU?55;*ztw;^EH&&&ubf%1X^I~^On3s7d(P@< zQ%RD>3EF6M@4=NhAV7DN7pndFowHE49XrCykFs0!rKW@_SCcosfAP-6Nq0XlSPdCc z6)|`HqFnq-(PaHDq$OaQ|JQ9G;^NWbjnx}q2Ee8Hs*!!I3kjWUISOJ! ze)?j+|K?apU^oOK{XIp(IoJ$JekSO(VFi9ug|0I%V#~CqpG#s7m323AQWMzqw19@#n_k{A3PV48vtJ+gEgz*1p&t@3R)W=x}QDIG4{ zbt!zZy83?qKHtLpQytD)CQ91%-4~{oe8vxsPy{+e-jagSqdjRR^#doO{xi58|-z zgN39m?7pDQZZA(g4A7W_?%bD8^Y0u&H;l3qg)7Q<@B7labv-k^lZUJ&;2#bHm#$*( zLj%y2yWid-=Dv?MPidtz8}q;a|A>0axTu@&f0&Sv4r!1M>2zsCK)OpBq-*K!l#rG# zK|&hoZt1S2ySo=y;$FDE|NA!&J}-E(Gv~}X?~^kF9fl3gkQM*KT`2s);L;pMr>o%) z<9VoQxIMHn_y5d@|7QjR&g08Ww9=7WESB=rmWHoa!RfJe=^P1cC|k4r8R}4-Ncs|r zu+KvmzwM2*IH+*hjw^dhzw?SI&?!0$8>9EXx0$asx7fXhF{G(QvL~^9bdX>@Qu@B+ z!?}1A_;RvA%Occ-DJ!-NQiC@bHR%COzr9`EQLM((R%?KRvLJ;UiWM6^K@XyJx#bO} zNQ+cA|87{5tIF%kJ<7pvT$z8S`}t9r>0rRP0>OL$TTT4I znPNR+pC)lO}F3Rc@O&*#)jw)}ebA%>LeG1MDI|JmAT4 z5AI6W#-+;^!C|vT40v(Mp>=rc$-@pcOX+&{6`Zw_W{X|5ZEIx}@W6lbuz*8fo%da) z5(qG#Fu_FZ*iiX>@`=bDtv98`!5_R{1~S8D$Ho}nys-Rr?8W6q*Wp?7UkSm1EazJ{Rmw4}>5$E32@f&&5N&RZ4@%hTtq z2+4AKIkz*5JQt0eoeVA%PoId;UwgIDT@M|qw1Z2kZc?j9fK4#`pi2F+s5;+9Dgu*b zh*z`e7lnb`j3inM~%PzWn6X zh-$$;7Y+J2jAv&9ypiN|J9bEIdUCG*eR8mkr}fa6obT%(F)QMeY_sIu&OPkBdALi2 z_9^@bkI)MrbcfOS-Be#;FkY8ss7lccAXcL;iCq5&7bsyOiwwZ=Lr#W)?p=3PbtlKI zbcX@{T+WT*GZY0L^9gyqFSNprUwt=*Inc6K=wEy4>ESvz}H$<92-zuj4 z$h5=|km!XR6`<>a!|;fCv{Po|fTuoumX9FS?;s9qB!E@=+6p1Y+Odqp`$kkWtd8ouC;(F({!*Nc)Nd`#fvSvn zT0Ubd(E>*@`+pO6bwXi_?|bn|sDZ-nB-?Ghi7%2aR+})uaT^Zx9B|uPPpbhHx7`;F5#!&Vm5PrPwsVS5SC2J*F)J5I^|taYpc*m$ZMMztVwkLk zacq^PFft0nh}=1!>=&l9_N!H|LL~>ZUldPd7&NyqUfbzP9h?shY!mMQtVwnrB5WSI zAFF&pnl$D4MtZH~DV_h%8h!wAcxsw2#@Y>)e5Kuh-UigP)ig@5Y=Cib;|Rk%Ja`q? zT6IPSNV&&PU1^uy!91~jFJqu%kT5edGcweB{A|m2n(6q)nbxh5C3&CIy?I;X;`D7E z*lkGtA9|7Lqw^H_UBM08&;wJJ_2{hWCf+LJ^(BGn@$c+}dp(1=`)-1dY)EoV4YrhI zwxOnlawF-_&*6gke3_+$b%-{Fq@qiu#=xJ4VI&^S>vgM0`;N5GD9L{X>IeNqtwBZpzG#OKsHR z()x>$K$rc?E-(Af>f9gc^#Hy;QGjhksh^OQ z-yZqbGcH9US7D`(+q?PadkHw{*`Rh`ed1N`KoPqCkjh_rmtX%BWduLO-UnSkclB5O zG8pN~(4hwcznsqJ6T<8bnKC&kur|4C1lhjNuygI0!7696IDA_V%o=g)w1qfWnCm(? z_u|FHo;0eg5V=_s0>ECgndN|QMHQtVk&M+zevmG)IDy_LYnQP?AzJn0iKo;@VJD3Z z)MP>>L)v&94vUnJz+Q`L0P=5ViS?7<^izKw2iFdl@AhxkpuIzAo-R42k&&sXq6XsX{fHP$!Qa?tzsg6XqHWQfMoC$0BuBfKN18r^PXUV<4T7iA^hzUT$ z`yi9eDL2^`{Y}hQ#{tT%@G9ena=WR^R*`W_27r_eIrZ!pY;S~OO;Zp3opO;6&HCWa zsf`zv%vrq5wbw55{n4BC&&k6>nQkM8(A4=2_g?>q6V$BwQvgZvdzL)`n|XG?))m+F zkWhmSY5j9uEdfYuso$PmzQc+4B+Z+Y4!n>Wm)_elH}s;6wG}r;lnJxTcuc;g=B=IGdB|tHc{B4R`Dn!sr;aitctfCefgO7ZWVU58k)y#IbRBQdJIUGW>2-t&U- zJ%>9Y)T@VK-(j3VG4O>(>9O_*W_sxSM_|M%<0tj~Qq}U)x}cuV-ky6q;m*0pg>U-!KVZtXv#_zhDC;-3KeKU2uCD*C zpR#yz5=P8u%x>k$7U@y@ZU&bk?P9MN$$v(*w}^cd_R`o$bU}PiXO$o4^3RrAV3Y3e zLeq6qF>mwgPEf-WYXeoVJuI{!42`3ip}z6WV-myKZX3K6o}~yDf%JJmebxz^g!jGA z;!c+DmmLFpJ+2?kXBpO}KybW`%`{DPf|AwcVKJ)#5JKknt8NjaVZUV(9vINRd&}M8 zdQk=qiucm+p08GD!{tXZg=rGWJ^q&ZY;tHlen-kXpOG|ugo@ZEQw--PD7RjQTws+_ z`Dtr_H!mPh4CvcbEudYNr`h2J@1gqrW^e`2E{+du(#BUHkBiclp9Rb=VibD?H8?;Y z8!1%vE$|f9Qmx`LEy?q-MmSqJ zCl*H?Q@Fbm|AH>I91nF}6P#4DtX(;cHksq`{>>SS9+WjOy=Hzt3t{XL9fq2=@X2hP zT>6g}VFAt+OSfBN zCh>EPEcM#~hPU4n!s8k@ZAj%dCOUIuF<&uR5&~9Q45m| zKgsY{R-dk<_7f&AMt{4D-&#RYRR%`tx12AyIgW1?xsEYezXJ_y;6c**?hlD^qUw8e z>qjp`ZM?{OjxW;BuD<%VxWL#zS_7j48_I|BoE8Hc4@aseE&`d`_y1Mh=mGi{%tr@% zkwmD^4-nz;j2mz!e%UgAb7_m3y1X&fMtx?e52S>)7QnE(LJ9>DKCSyINMQl|Dp~y2 zMnJS6w~naCQsF-*I!Slty0k+Tj~`R{Je2Uu=jdyr(6wa63d`YbqGNnc_X^i(*C>`| zBl(0W+0N_Wnyy$@eFpCY_fd0Ru2w})i6)v{*ikIl(wGnYdw#z z4)z*&>*q!h!xI?)g$oB1LK7TIXq!O2pHm3XLb74kjj9ILIDV6vb~bH$gwN3MQQgCnXPc4KSsR0A^=rOS|Wzsc-K*Mim;DeR1_WTPBU4)=yDw zJa%)&G98U27XYp_ftl;NPWteZ#h&)b%&o^>CYv6LaYKH$TH&YnobZIke>wk(HOARQ zRZC|5<41)ayzxJmfZm<8ntYHa0HhDljkEQI6E^c3d6Y~qAG|6Ot2!NFOH3sh>)*(E ztZMr^@xXmE3lB_x#v}b{4Y8a9spGv5CXs_$LFeb=9SU8s=NX;d-EslenZm4}L#q(E z`P*TwBA+Ajyz@N?+lnFo7yAJn>{g%Kr7Kj}Me>X!K_mPdywOdNkqH2#CZX!t_E`$w zuBpJomj_yHy(RP;FuhPMw;LYP8ztJf)~CxPxE1c0O-Hrtr~G$H{;ma+qKzGR674Rq zt$h&HG=1oj>a&xm(s+_G4Qw;e@ZC+IT6GW1NALY+YJ}t@rojxIozMVk6h?2ty^+?v z$($m0!W-Zl7jYDC$$?Mvp#Dj)h|Z1gm{XeK7wTwJQy0@i`sMWJModFnAsxq#vQ5RF zNXTI^DMA0(;%MROB_{KgfBK=J_7f)w2}zYvfm!rX@;s0{d|ofhQQR^|EBP3G~* ziCGysv%k>_Y_z)$^wO)>=z+RV5MpjRA^`17jEJ2;dG3}|HyumYpS0;!hN7RVLDaGF z2HD5Oy(UV@#h7K$rE>mVM3;IOJ-WNG#pSv+&YV-!H*Wt}?u3rNk*ZUt-qjV#IA8de zK7!g4?)&V_?Tu|TUeZ6Kwg}K##5<_JwF^58MF5k-?x?llZksRRL+N`X9)wdgn)n0d`9&+kn7R*?YKyl{k zCv*G3UDf@uV&cN;D%)ZEvt>A&?sPCWJU(<<=;)|)a4Efh9LAeF&a?a;)-KB`2sOFd z7%iJToXZguHea8fu_EfXKt2+FEvf&8B zI(~FbZvraGV)OD_yBndG7r|~P>K$?LMNhP5Tq`M(!R&G&YPt5IYP;psImz5DDbhtc zm4RzI`OajDwC*e;vai3~%D~0uRUjtp&&UVk^aNg{7DPTO^3|>G5Lc?+o?yzuk=vTat~8z~rOfxiBt(8}$92Ll&EoJ)?c{L_|S@fhBQteAOZ z;DRZe-fQLdo7P;rj)ta2`eiH9y6)v5#xS1mqz{RKz&1ZS0paNJEk%a4KGJ{Sa9dI| zeCJulde5evlDJLo8&@g_*4BaqjY)0pK*Wc~UZ_EvSgFkC=NfT>I_PvhhkrD4bTkWf zt@DvXH!%!9q@~gB zhQF8RZv+uW!6-BhOu#4arH`#`ZLBkovYcS9irDLzWyV@eZw(WdpnRw{!1UU&O|7i1 z6F$sQ#iBabhy6g=At2MebXj2e`o``qHIXfEeOF%pM@mHt7}w&_GQhN~OoC8chdc zcHRONn8^WAP|#SN0&O?>S9&)NKF$D5mlGZJm7gG*?W#0QJA|`mVCX@dk_tMAzZF>C zn-gJSV`Imu<(4f4lAS;hJOmA>A8$W7Uwg|vO-U;GjmXg)Yn_W1nW#JyHi6A}m^SgV z+RCfoNb}?UeD2vwU?lflQ2sr@t9M>EW@821n3~^+%?m$Wo{dP2X1zH!(1+0$xO*%9 zGN=P_g9?>{-ZqLqMbIua*~!Arvbo7HQgk@0e^LCV=Ht#J??MPkL}Fjhsa2>P#ON|@ z91CO13S)w+NLVd{`10A#{K+8s(^R&~zwd{lQO{DPFz&Cjwx%5pnO9Ysw_V?M`sMq` z(POZJa9OB>#lR@}IxYMl;X1uL4wOm+HRg|Ocn$hC%S(%*=3`7HYsXRo!t6W0tvR0D zP9^g!(QwWirZmpw-0z+nn)dvtfV2pFgQ;&7<7xU+BWVU=O$IETT(P}`25R>a7!MXC zxPoajwltd;DxDVf&8}BCls?<$hc|TX68blfaI(;h&~%mTz#4cF-n;1s@-B2K(!8>r zgD{AkEG1U<-H&&M9^;0(JaE9a`N(~W;r?lR5aW;MgP<^;nD6D5E7j|=2NnTE?}b7gz_f@C{m zD*EFmc|gV6?$?v7GJw|RPSH|(bmqeAlZu>W z5@RJT+cBd}_ff=zfBq3JY8CdWIEIQi@&=fe`Nz8NETj_G^*BmVabeC)@XI@*k}g}( zc!w#y!bNVD@bQcf9ezGo&?mzEYwuu0Lc(5##hl@1R^@9v)TTsL?E3hFMrzg%nnXG= z1#C-E=j3|X_dW4BvH5XZ#+rNOp8BIMtg2MW;)Y64H-qhAD_w?r>B& zqI-11vSjRv`oV1wn$p?mE1v}Z(gwslRt+~RUC;Q$Fe&YelMsr79BtbEZI zBtyHEjJ{JBO_DZr1ZLfPY5u;$ zeE<1Rh=<`i=N0CMw_N&0Y%2WfxZptU10DD9X<{Vyb@AJg>Op_&XD&;#l z_wqWK7*sW5IzfRu4P}$PGz_ksPODSV-2$-Tdp^u+>a6>DxVUL6u*6?zfci<3w098+ z7P2A8fiT%(wr6bIG3|i7+z3Yq-2*joDs1|IS=J8agE{}RqRNdA^zoLsU5@u*-cFGh=%XTj5OIG| zK8A740+qjhMS;RYoVqcXQdPlk{qEW6e5h23K#wgbdZ_lK6ytL4GYlPZmX({g`{KF? z%k($Tz@LB9xhF^w>GD6k+NqwTyIe z9{$h~sT2x{$^4U`ieA`mycQ-bJG^-$t1y05nE`q9*j^C4Jcm@#qKa6ln}oT}QQqqC zwAszaxkT$s6MdsQ`VEbIN1(5ywn`9Z0Y=VhGv@tOS*34dR5t7XuX5azKN+_;Hlm)F zAsqXE7qMgdrqFYTQ_pk{w^m7SQ_oDaLUTin(h$+)CHr<-*;n}997~}Nt0sSWLj99o zr4gfOwQxxqHGUqihY}p@Z_VjQl_3=;;hw}||?RTWAD{qw9 z=>!xbgj#-zW(X6kgB>_GHhfxhk)qBCgn1GD3Ht}s^_3TlS+}TBEW4MyYFi-AanKL3-kXf)_OHRr)2D7448b8~jD<)%?A% zCM*>5?LVeXxWxB>*wC@{&|b+|<3WN`F+prLVlbv7X$N5E6r>R%(^#yxMRlF6r2OCv$xdh1ORkd@W)d*`F9vT*V-PRtEp6T> z4;!){o5>XOeLSy|hFKxwI)+;*{!`|XCicB+l~EOw2G;x`Y+{9e5k0{l#B340VNuW)Rj z2n>0rLODi=d3~Y|RXH&$;AiKquPH^ld6v?4B4_EGr5!b@Cw0?)M-;~Ib>u#+w5 z^H%7TRD6R#$57X1cZE2%c9U>8vnW!J2dsLS!<-o|Wh@jQZnB<=b7>IK0vh0!3r_13 z^){t0ZTBJGQ?QSH*@i!L&*R2uzG_CFStqc3W*w1X`0&460)&J99wz0|zX#K7MEI(A zuyA1$Y-gdb5gE@P=G9Dxj3a#iY8kU@Lm~u3JaTbSGIE zT)fZlnl8zio1$203iPptS|t!mfGN@bCbDoJ;zKl^$zqKOPTW7P*xL=V4mW+cul+%< zl3?`)DhOW)wc@__xz0+AKSU}1wtTE|<^*CW@1+?8vOW~=?<`&MwKgqT{_$QE=Wig2 z{u0};5PsW;PXjm=yQpo&(sTHld9GYNmI{G-R)08uWVfMvOsFxCx4ob2`O-u8LxMAP zSa$fBL`At}1kYZU1}CgsCot=TrU(2nA2;~_G~v(92hQH-Z1V28?aK^fxK?#pagRP& zl!}BgHc^5T{YX-hFmbB!1%Zk44OZvJZ>Vw_J!Qn!;16FRqa924uz4}7Kl)2|u8zE@ zzH$PSe2zpL9bkVf(^IzAWy8PP8gZTgD2Q_J<;4c>v_HH{JNde;LquSz-iuzPkZRu3 z4BSOrKVrOyDE*|YPBW_i`LM+6*RcRk72~?bU?l}>O?M5O9jU+bh;vHG4u$igqc|O) zlifMR)l`QP%j64tdq}tm&cU&)QH^eZyC+g##($~?{aO(IX*WjbU8$Rt&aKJszS|~4 z`tV@DB<<;P^9$t^U)hUmDxWCw7*vr=+30?uZ)`wb0A-Hb}kxMta@S zZ{kah%D2Wk9z4zdjf_>$+i7@-sIVtujX$$uqc^?vyTwX7X~8(pI%#or>nK}GJ!w1q zX~9HnkE-zjfP*2XNE65F_Et#52Y0|Nro(FcN-ZQT$lPcyIoVafyl4os^h<*W>G1TY z^w2o2;jYKYcjZ6Rn<`ADW8b%6Z)}+wf~7IIUnW#;Z*Orzej)C52Dlb%CfCy-;tr#f z=xoDlPX&xk@r$D(>nfZD25iE_)9|S~G{jU2xd8>)C=mY%l3S)P87 zGH5`R@p%(k9n)|Fqi7W4oSxZ1VrAw3be>Mx_DD+8z47aRG=76>rxcA9*uv_uSKY#U zkB$cSylv!q{)A$nptbT%9)udMM)+_NK>kp!i48k+9&LtBoq3vJt_5m(ub*8I>N ze0_xxR*#wEHS$@Cyp?F3<9gg>MC5$dMPOGwC}$rz%G&=bKWe=FnkMh$P2Z~pf8j{j zpI&i0?cn=nO@X&bT5VkGe42x73(6;Q?!JAnSEE4P$M35Y=e=#k8vl-q?K-SU$b%}c zR{C5)q@qvNLw499$=fRx_EAaSd~OO2PJKdRRmP@1uF-i(@iWb1SWo8>6;sM z?Wuv`c=%0V`1n{oF6>3p1z`3su%wN_GqEGN;V8s3z_jdh_$4p^c>lr^Y;+>1e;tKY zn-$9hl4QR-%ocZ6!HpltFqDdg(OIire{8yjcFkLCA+DQfxdz%VBPslX6xvap-wU4@ zs?%sUQ)JB}SoU#P#FUF!JmRDjz#3^avLT=#&T%^HNm@L;lfqnvdAOCwV1AwL*@WeJSO*i0zGW{pJxo}yX?1^2%vMCl^qsVcHH+U^qUJ}_$p#ye)bs0&zsVO-^Vnb zU8IF#^TAhiTN+8cIxSaaSpO2N9wDR+zPJ;FtkXPsSuH;jxOR*eYXQ`gQ&H&{M?F`l zg@4bk;x>X@8*w+X^*>$Idto(No0_#_3pdO9rt7_-6SNh)!Ym8CsxEs_dWoT_aw)r^ zqJjMfKgiBlxDEENwHakWS!B=xMV`RB?m0IYIf;nih@zGU}lWf!iNgD(&*F z+fmudn~dQ5^IBv@8<}Hr>38xy$B%Js-!#>gK9>7?+>%y45+WtON`YKe?v-A$DF!l> z6%*`6+rz&=lGD@Y0sU247P{@j(#6bd19cD3R6uGB)#04+I~8?j;7Vll^EGp+tR|BE zyN77mhPshu;z~{+-%znC5#ZB?eX(f6&4~CTVT;4%7mE3)#$83@?as`vo(~l7Nv8)?%8(_(o?d;s&GX%*TVVwlowF0@}w$3~12xaD3-R&)ybq(UYsVx8ePY9HA# zGD6NFV5%B>ZGHV>&g5z7Vfj|zBsD4oL%B^pdyAAR=U z)6X92_;;Ubhnp-tl;oq@H>6D&Bk&G1Xtq6bHu*g?(R(;kAS(|v<>LZ_=iLSp1CMr3Ly1xNX5^|vPi$`6@T%nFqzJ=N zZ5!?r027yow*KmwFuIc6Uj_X@eH7O>y8wwK>&4b|qECPELcmGLbLJE3Q?f@N>S^d% zGy;pQQ#|iTcd~?{rH{*E<*Uz#PEJ;is%M`2rpDjv#Eh2>8P3DMi#e#f1*Rsl{LLNiS%xwMJgw1jNcwtgVCzS(%)kq@#{Qrxe)Q$ ztq%K+LZ}LPh-F#`I7cqsXb2tX^u4!{|{-n90*yKAJ_ z+CHT%H(5He^%`XSYsAsBh(wubvrQ87sz=#0A?Am;&=o3&tkQNf9-QchNa>-4i+gHR z%b0gve&AatX=c^R>th`)m1HYm9 z_PiR_yIzsM-_r6)NW-o-ZWe^Hj@kN>c8}N+W zg+%CwNuQ_U@y3F87d5VUKdrmitV3V#kbx$|4?smJCF@D z=z?#4aNrO)}#qWyWUQJ33hHz_s{1+TPyKKO-xyUcihhrl>qX z`kB0p9?o1kYCIE0mIoS6`etjVed}B~DlJe}z5gHK;@no#+MUs7T}8-%S%DcD_!)&g zH_r0r?1#3WO2}kv$Kv1^{gOryt9zjJzZfOwRIEfB>-|3F5(8C9&TC>JhcS8w_gT1A zm#y8EAlEBF6Rq>*UrU>^Hyj^4&gH^({yy0MXE8+kf_15gv0N>$dlhZ`&FD98%qDIS zM#b%%#jloG>l9Wt9w6I!2lz(<&C$h-?3>cM_dAN?ms=Wcd<(@)g`DMHi;-6;)xb($ zr&Aq!9SIMp+9INanDUu7c264xce$S~@Z3&F3P%#m+K5w;erUmLZ6TN~XdUJL2Is+M zvZ^09WtLxFQuH`lRkHQ!?Y*k)#99Ik_fw%jj%Au(>B{NcC;v?t%hYdJCxZt|s+>4{vd*{>@8$iWm87f5m2NfWmF?VnFNvt(w^PLf$HbR&EXazP$V1$5 z)t{kw`}Z(D?==|_5rWIqQPf()J?Nf`XSEJ zlQ;a&C(_1g~mjOp?v_j4dIkeDbXSFn(4>%^IP3C zc04F>Pq{xf={$mDiP@jGB?t>yMU~Z0g@aqFP}o^e4^sHQ*0Zi7!M^VM%V&bZ`u5f{ zn1qBPcz<5lh5zsyGz`=5-1ab;E3)tDYbRly}9zUcQ)IsA0v*@F%H+ll13 z3=>X7eQyGVLB(oIwP?*?_?JPt#| zgNDF=4!R=Eem#YTj6+>Vm@uZf9e#loT${^%fKug1LI$c-6&hF8C&=@os)d&V#(Mvc zjlqVHBrQZ|iO!w$lio|~)9bRIOtr3}g4OWx212H8=fTq=p*dou8R!#&Np@fUX9uBp zBbujR;~c^CHL0WlF#>O!VUkXKKbKS(Tpj6rMamm>JGE$Sna#R0FavhSW^Q*g6 zK0jNN_OWU9qq8@=`3G0s>cMKc1t;R()Q^St4yV2$4{+=^?MarDY6JluLpfv>PqKz4gS=F1>qWROV{YA2Ump>GpxB>*p`Ek@a!Q z2N%l2xbFzO?49x*Z$8t@9UT$MvRTL%?keMDR<87XzzvFHsd;=zT37Z zC+T0QIP_u@yP~n$xh4ujsoTEN@tCwJvc>R{~~67plfBF5V&i zGAM$P_$aCIF06n-gz#ni{>(nvZxa5nm+Pk`cF0~7gLJYKp&Xp*qj$4k7~2Xr=J={R zL@LVCqA192za2CMN>E`tx3>`piTGI~OG==&A)bbbAEZ5L0uXtCqTu?tQ+owOb z8i>HO{$7->96jXl>vI4SH^E+>Y(JJt%e_Da_r*MY%>YWb*vmiNiJ8uOPrd-P&yfYx zb>H4!<%KR0wj1PNJj*oRA@F*}kcPn|I&m@0)py@G1b|$-m)wfY^b58B{Lp!Dc)TC> zTYkvatc4zGmPJQrQ8n9~yJ}o9B`BwwpN-?wSmST|>BK%*r7|W!9BSD13J~a&y=#)| ztNWyIx!AWxK>BWsxU=}wSSrfGgCaYMk-{>t>)+xAJULlBl%hRhdla(gD-tQO_|$#! zKaBO9<$i)gUaJS{y?DZlY0WK4*^ikAj4pnv-8v<9oo$V>fjWd*wJ4y;)y~~?BB5s!e+yfX6;p3XFgohNQX|$ z2lYfYQ=nDT^_s3RZE7qOj_qMsnl3%~hU6GeUDxN&j*k6F9IX*uaDmHF`cnajTdh!S z=oZ$fvu9*C=UmNrVeP9&-W#E8XhXK0GFlN65NApgr{*BD#> zp9MK%dwQ9VJELtdHL2bKIR>v^{<^aC2s{LbzzYqY2>5J$x#~S4oNq}5rE2HZm2t;T zV3WLJlh*(-K#fy&)WXn$46$<$aE1$?->M=fr%zUtWG){5Skd z@(^Y~NN)@afnYinH%FffzNwrVpj-#7Y?3AsX1&MM%#XwzmeFZdGe+&*F-KgOE z{{fWPgIT_!(H5m53v;NZP;Vs4X_p)x>t8e;a{HF9rp}In2ahtBgB7ICQfu6etRhF5 zC~dGoG$PO)!n|xZz6tyEh~HrTcM}cgS4b-!FyBejKX098(esAsij2t~BbkHpHQ^C@ zr3i=rkI)t>dgAKF^jouInJC@;Z{Og{s)la(xh?f3HZ=U9iE4A+NLiHK-7V*Nn|zqiqLh7U_1^7|PoO|B1Qy zpJcqSlR7@ZE^I-H7mY0qWr{oK-*2Cd@srfE7OuUwcF@L7eoA!-$3vsA^4m&}M@Ge7 zmO9n`A|8`n^CyW5-8VF=H*$2=Pji@^4v0opyd1U|3W`}fK53b6$2b_)FYV?0{&V*_ z^Bj@G{#elz)$>;fux}A~pTCKbp02d?jBQB53q-#T3z&g~G{ZEF9gU7nn6q#<2r1H8XljT#nS{F05kE=}5s$En@7QAV z()ASz>mjYQ()Am)X3r|MKdWsBU5pP61yo|H-BRd`G+F~{!gYg7vm1*fd%R*+neLCg z&a*u3vz4QDqL~73=f!PrNt1E%BM@FKIhUBa`}1A7rOoB6dQ4xSfsUvrRyO@E%Z6uV?lip25C@_E0XWC7id{@P7V zjr)&rvFuQpET-eGCn_+amqe8BDHCMamEV)6-%U#jxmDG%HWANj+1-vwbU+0&Q4}d> zWbscW#Fp5IARgwBQ1Hy;k2#(m3;Ss^YQ-B$-qmDZyVLHYDMAEj&H8!IR%~ez=B8;INzyEEHecu$)_R$=euobJU04p= z#VNF?*1Cxna(}%d3A9vXN%oFGf4B7gb?u>B6)?o|CK#|2$V$|Ap>Z>phH0Mn1QCZv zn=3^DOSX;ef#Q`#MbP4g9F{`7>0X(pQKnr9M;hO|7Ej4o(Olkct1qEz57evu(=$5Y<#EAK z;2Aq(wLKn2Eq`kQ54?lr&4PW6fz@WS8DFI=V|pCT=zijIpRo4SO?G{CN0SKT$1|om zv$S}_5GIb3%cNXwP{X9ydpySMJyU(Vh1B4*SQ0Do*Or9?#k6#(xwvwCfw%5R#Q3)G zwJl+0FB_4&tB4eisuJzA~K z=}UU{>n@_NRirjt4<9AqhSdzT8G=o?BYs!oi&gb4ax%KJCem-3`N`xUqs>4LWrSU^ zCnt$~tijaCua#MDZE2pL9ilJfJQntgX-3lDJ-y{FH$a?X7wkh6kA)@-d&|!FK2o&I zICI5NS-DQutY`m7cUjKKbl>jPF$ytO$hA4MMfa5JutS4kA!Tu|c*td631olyMRBok zj@yavFV;1-ltJuvPZ$>S7AaN+acvN#PI?@TZ2XGY&xH}a1wqO?QS7Vt1J>-R=Wi<= z>w=qnW3HWznVI?=(*<2*YAt)O5QazZ``NNJW_Pf!Z_U4=CnfH=(6p$I|BFqd7*2ycklQ8TW2 zaqHT0?0`W>@XM#yRR>A#U|}iGr0k;<=gze#x7mgi<`3H8Aec9(s38ngCmWIS8Fa&Q z+lyugptO7_2oIr;S*spbfw7WDr3D=`g_nA`t5^M?rIShmV9E+U(^elSu5T|9=M{SJY_! zZDVQ|nFnex0EP8oK}LP_`X(dl?P8)*elNe_Mv4);QaoQ1c&&30KbZxf)G5+f{f_%pzjIpoD7PUK{RZnjp&O4J8$CxoOG zS%^d$6!#;&Z9+?=;FfTUW`oL}lk0VgbGeT%loaD1Ix}tb>HK1tPn{ivHrWt>-PA|% zLKdq+1dcXo){Ag|ji##{8gxW@)1E4tE~$XavP@`_F26o1_Fl7@#ZOVdMwohdg#~lQ zOlam&yD`&3czY9pQbNT4bDUNE;K%!Wp~V2@&&0ufK_f$rT8J#E#h=1x@+O+vk$d4YzfX!KCkgqZ3xG0Tnto~ z)p#@%aeQ)wz-pqYI=L5?MS?z!Kz<3G`~~6!#|`6JZ6ZK&+Wj~7=PL&(k8sex`udC> zqvz^1TJak30qh%H*~dy|-1y4d|3sB|yxr^-&?krUphcd$f4Gh)_IXa0A&MJi%`&VP zjBEFG+v=mWsN7#;tv^z_-D>vAi=+jsCYTr071~p|&oFM@e9YI^%R<$H4N3{I?lti4S;>#ZW`lfIR0VQr+YlTJFNh8ipqk6rTT-X9^LP<-QJ5cZ zLS%NRE@iv?Q2FY}G2RFn#PcG*zzFp|WEo4NT&krKH+=M@?KGuJB=AV{C$(RW05+%) z{Z83T420EW%$L_>AJs|~1huT}(WDtxS+HEBthW~GWk0M>ha8bd2*wO$79~y>Mxx5+ zi6EYpZX$8hzuq@?V7_?~SmOKk321di{iVh*GnF8oTe5gPv4Lw_;;davrK-+n-Uf&X z5%jvKB&majmSh>?%a!E_p2JU?y~mGcfxYfAW7UbecyBHs%IXM%agniO`s-e=&SC#| zW-jIzGPtRJ^41BY(7yixtxCJnXZ(KChQJHWkerqIr?+hY4{fo1pzqh>9zdIJ(hjWm z{t;yiHhjZE*}f4!JbPGZHVUQ6`qhS&OAd8|>{?>+P-eD}U;W$W&zCsw_i%Xao)N9Q}G3o+xFcd ziI!*+T3NQVP$Bru1^G!%jp}_@5sBkK_|OccQpHg~zIt*Alx{nN+42SYCltjUouRQK z_S$la`ag1ikSYGH(dh4mm^tuP_s zk+D0CAN~2?VJvk{=Jz_dulv8pBm(&T{^fY*$l!X1=(p!%rZB)6f2g;iUB2aeOMyT0 z#y#A7>?H(KoodV)Zn^G^FcCKr#Fz<7YM)l+!`AqF`DmY?+NZ8lFdP=aU!|fK)@Z(sWWUpS6qDrW zX5tW@&9*EGmD}q@5MtAdqK_a8#`-<4xzY5m8bnQ77Tr=hhKOu&nYwF+X#4^ebZds5 zh|2@qA7kQzIg?RM+nr&Psf4S>c+f$5(fcmcL{||Z^|Y2D4VX}p8e;o zAQ|)F_S3WDPg5(Jz|&;3*eO!DUqlP*J}C;)n#=r-&#!ONBW!_HVr$*(_qP*bV!Tr# zNO-Ex38Pdv3?o*@srj`pH&2I3_=;;IPmmvsdHdd;aRNYKA7Bz4Z=WC-cQjYY2e|Tl$a8`vF{h ziJS6}$9vJJW^KCyjZMzn2E#Id4EAZcZe#^BpSP^$D=?kYTD_sq{L5jLe%6kPKIT_e zfy12eqVbuO9^)}W%o=|rZsiL&GV1G3HeCJXw@0`h_58!7xM|>I;hk0r>B=({;V)*-b(70JjG?j zV3-hBHfC9j(*}TR7r0hO(2G?k=FN?Is3ux}H{z2=9*xE%V|P8IAb;3)jj{V)x38GOi@lMn8w5GT@CrXU=E$F9>|kk3D}YNZqxA<@sIGFZ^NL z#XceI&NU<+Tvxo!vrL`|rwHNAi}E&RzXgRRqSoO3fqC&9fjk+b*h9Qilt3l%%Yt-S zkL!E|rtRgR5(XJ;zSH&a>Jz3#O2x@}))1SFy8z30bd(v1oh6Y6tmh*vKjSyy!#+HG z<-fDrmv9`S-kbEOef_1}yT>wTXXR3?yY84u?Zr6hNNp&`VRwmI>I89Pm9hXrZLm`R z@h|dF5wz6pXpra^;QG}E_cYLy)_#v@)NFhrqr5RSF1pYJgjcNadFYW zXmZ4VOYGl8lIHx7tXH+Z(5$6JTEM;|T=3qsJ+Mz$il|RmX-3?7T30F%f-g>V*pnBk zM${zU84evySVcZ=^0qMek!<$zVBi!?Cy#2jS<<8HdLL!Ay2Bci$IDYV-;}7_JEl~) z_nsuNkvx2QdYq5^IjX>ID*xh_Wwt~3^@+)>NG(EyO(6+a5<%zAN(cBLXhpu!$F2oz zVATyqZJBb3<8TDTpR^a-!tGTQS+AXlh}QsZ*j7cOpJ|7}2L#kQU+R!#INMBLUgGLR zXb;t~Raf-o+FhU1@`QjrokEWkUh-y=+xYAgM6GHDQeOGR7@!}o~(-OIlVrO48n z+SjvceW9s~n5GZcm}1EoYhPBHJJxGncvs@uGwWOO1!yVSM!_kX+q#YQ#1Ucs6#19o zX2Sg8=KS>$8rra;YqaJdNZA_9MhSO5!sqieV5Ee#kdwVpYk%n#pxz4c{s`HvbH6@Jcn4no4gHkPAf zND-~bw{NrzSZT}emi?ogB;ZT!zZbEVQqQjz2L=0OM7TNi7m$;r)sY|&E8J?bjN+Y+ zHwJZ7n}?Ey>}``%sL$h@(d+?RYjdfMZ3GoXB0T#T5z9?c=#0~2z(`4KW|NZkJLSub zq_GK8gS4jMiogqhhKnMK?{eN>IvMh?zAju#3M>s{zWn#a#Omw3C=G7 zsJBEP!oc;e$rzCI!=O=GO9Caxlyqy|-&AfO4-RVP(vuZ*k&KA~wl%nA=5y;H$ZSLl zlx5A=gQ7~U%c-5oG?YHz`94`bbF2KMbCIf4Y&Ra# z^B^CxDW?E@b=`<>agcj>5fTf7U<}!thCBMBjH1uPsMPmDH$V0|pI&a={v;;E{iOXG z>}q-gTPg}}ar!;noE%%7xBb`z{GEkX+z!2rb(uT`Akd_&nHy+@2VQd$^OA04<~~O| z+Y2Xd_`#0%T~eI8TeO!en0JQo9`hoHyd8-(>GO_~v_%t&>W{+7dd+SR+A4H`0My@A zh}1k7H6#R74>deIXQgkQEmmrwM^2rH*|BBD{t%y)t2J=WRqPT@upW-Fo;EP|JN#R< zOtRZvd7SD6V!hQ!LN%Lec19{%^AJgW*c@faFQ^dB{3RO%(oe$GU{Ly(Ac;tG`f3LFXN5&cx#{IG4 zk6zOfsO~`kLmg=G6al0haDi1=<`T#dOL4_TCot5~>2b%W3map16@UISkfPsXxL`fM z`^6MyLwOD_3cm4^&5M}re$8*-aM#4eXFzG+S=t=f;KrjYX}@IO`?w!WsWeRboD623 zOiGC@3xk85Zt5zrI38qAiN7tttsFZ_*4%@(h$ZBa6QoTwl)v)@D955be8m64Br_bA zZ!Dz3mqhIP?=Sin;KhrXCaliM)Mahj)s4!p5LP!Z=r{X|y{1$?=QNDrB`r;AoPLUX zdh*~|O`Vi&E{<<5(3DuAX4q~Oy?|BsdJT-HoPSpY%?K!pxO-KXXE(IgY?n$^9GD$2 z8FH2xdDq1uu{7tV69{u_zWLL+XZ%cb(JA&oJpb;8B=EJ6ZB109+~NM+W7*_3u{l(z z7>E%6Qd%IaY|FtBP}5C%;*kt5@+{kFudfiv*-8s$}GETH{OW2g>M(kWJzlBm~f zkF%X4VXlr`IHK!Y7`(OZgj+I>%?)^B@gmm;Do#7MZ{l9{i;Peze&M41Ht56Qr`lBf zK1LWyCWaytT;gSzfZXUGiTJG4X~uObees`2>tRBEUIS63!@|zQB2T9=Y7|0|9K(#i zH}ytVcT2LEg)xnTo*GhI3z+w){sPIu>a7or11`w&p%@RmTFJ3?^ji_=hp zU0C<#s8iOZ*j;pUfI|Re$H0Yl87U`K!91B~fj#(sU%zmMFY=ziaq6c(2jZ zRq5y>_#aTTrm$f@lG>YC`%L^M&G2(i6RX@G1Dyt)F}9r=XF=1T#}5n;e9SX0e9><< z&{XuQ;pVkKG}e*R86zsmWXZ&@SgG$iUO|+Y^Q%aANE}eIAFnbOFDG+v$`T@$G&nBu(9^xQ zv6Wf^cn+5QTtqdQ_>v0^ z?ggM1$gWOkxgP#-T}8X^O0==RK@!&k2;R(L|QZr)?CFqGQ1qc61Nc^3rJoa$ZC3OX0a3OrQa>-ax}$t@fe7JvJ6gFU$t zwtr-~pOI>~MRF4f{1`>iCnP-7a)<8e!6Y>P{_eq0t?GMpuj=}%@kXsvAAC0Am`9qG zRIdjL>rPrfrVgd#>DTpt6ZGw9cE4xApfOf^>E7p z6GAEt^?eB-_}80l0sv*QFM69qK^bQy4PzoM-ZlW>ycfUVavUxB2uX;hIzMPg?4Roy zd}UtO4z}t7Z?>J)ok|M$d?$ZNotT|v2P9kkORA(_H|mu=7*^AK2L>K{c^FXHr-lML2LEm$GqhoR+h%r=;bhdOu?@3-h;d;+%NYr%sA-FnKDw_*2 z=he`3jpM23XtO^;oT1JKI2HGmQV$B*_hJdZo4l%4U#M97j_;T7M*I`r#u#FhXlJC; zKUs}<9xie%Js-ZYL?Y29ja_uDPk;2}ls`!6jEANk2|?O*l59$R!7DTBKJ(|9sio}A zmijL@BNtv=(DlGw)L3ak$PXpR=*e-ja7z*!ty~_1X|_)F!=kAD${n3)#*-*ZK4q_% zCw1=wqY7uGvj;v#q)EFQO5RxH?MIGok-BSU=@i#u$F?r{QnPOcR7?Y`Vh@6rVy?`y ztqjPaQ7C_umH!p9@Z4Bbp0;wgVI1lgvlT$90>AWE1-;BeMW1Z2M~I`U+ih9?f-akP z+8XHK`R<*CDRno{@6{0BjbxB3iSyR9c$+aE8(MAKB>!7Y3j?cS#R^js16d)*^*f~0 z?E4=Nupd4w$s}nX%MDR_xHVQ=;++bwA&I3D%f7E_iajx$YyXvkOo=}%^%Fi=Q^D&& zWbjM+5gqfX<4=No@t0e)8NP(rW3h@&X2u9SvFgyXiPI zW8$J9&XbOrD3K04?9TewH=gQ_wO6I5oI>9nmvRG=;Y%ub6&}frAFWPIIR81M;i3*Y zM?%iPT&M4QUjV&Cp4z?KXXxVRXC(LTZs6rgQvg^hFjHhC$54)@Es!xE2xZubbPUrZ zsNAZ%>R${$1MapIqj;86c1~=;?&CiBz%1F4!_ZQSwhjO%12?BnxNFVVmX}h83dIN` z*s(un5^vjuf<0pLNMzQp&6`-~no55qt_j30POOLHF5DIUGt%T|^uKv7M=Gy#*nd1x zw7#8*q?E>uTC4jWUi{K=!=}U^$HfrR9O5!$j-7XallRb9AopO+RbD~ij&M#VrDqB3(RRnSDg2UqK+gW5?|6M|J z=FZXz0k@ZzaV0f|A_I3IsR=U7!Ew*@J3nbH+(GtJnaibBVY+|mvmOkyvjUuF3krjD zkIA7nPU1iwPwV!LKgp*0(8exl%v^O0v)|{^386$AS5jtve`HK>m3a2s)e+M}Z7|e0=z{n!%Mx)lbTaLPa z_rR(~&nHl&c!Ic`kYCEwJERx|J7bm0cIgi>lM;g3Vur5-Kb1aFls*2v_%F1< z_49Lci(BPH8?w%*lg>wh(e-xZDadZIS+BI!z(s-`RI87*L524n-%X>*;!rNq&MsZ= z;~By}RJF_BfxH(S`MDNHGBQ6==4Zg}4PbsWF!ft2%}iBszUkgHNsZamn^6%jY`dG| z-^q2d6mzmzoiJiuJA4FX501Klm#)|@*#Ww#l#19pd+U-%ckLw@tQ|G~0UTX;j|aFo zaolIP9~C}%_7h}6h%`x}%BaS;P*oxIf=#Y^EGJ?Zqf&aFJzUs}GZxs6=yvf@E|u`J zl_3jJldn}5rlt5qCA=Ziv`_hJC+SS3fl_-ccE3j>buwVHao>rG=)RU{Qmh8)?;;_0 zuDO96&XGX9=O^ms4d&84n|5O)T6+@(&51oBoPtG5V zquTZbo(2%xH?wiN$Y1xt+SVD3#E$XqpCKDD2hdj*HJ+~&k@BA%=U&8p`*2eO;@Iwi zsPTD()UhwGY^Q;M%SSHueorW(w`*LXtxn6tma1K~Vo;h4b!bt0dm#Lh4QFqSP=@h` zU5EEi2Xw^&52dej9*+XHN8JD}cdLl}u-Qzl0MVtJ>0Xk`kLKOF6V1dTsFzvoE6_)x zqZ`3@pD3}t=SBZ*E72*}*XNxuyiwJ)kVRQXcheh{4++5vZC7@XF{tvBogO}mMrf-! zUA6O@a^x!HoHYc%m(Ixu!Q9-#}DrI_?tbGo~fuFcx~Bp&T#XQ zQe<=_(@xbvGR-l6lli7g31)@dwBnM9kekZnCg!I=<1y_0tMlmvwjF-g{gU>EHBX8u zQ&lV^&ELRz>|;qR_{Lw#mRwk@gh+^>DvZAkIinFLc$S3^q0$J=em4CA}O&4BDabXIjXTeEdI@;R>}~@7~fWzOYGRi;O=T-bNHly|Dk>T?XBPB+Ahgs?m9C+ejr%DvCn_> zX;eh_Vj^gZX0qyd{reBM2A~C;PShXYJy5BAgOLQ8jf8hbLW< z{&-3>e0RT|%hssu8d8*BA$RC0kD#gL`Q&9P|ACj)@IdJdwr2r;39tDLk)t05YZ34+GfUnvj#9^2@P=X+23 zb5bIHne#!Xb}F344U6)vo~E1SkxqTrV$i*{!@@bT5l|qEm434p+taj2q$p(p7<1Ec z2g^_ntj7^5`wl0l4a-$tEl}eR*LKbqV*YqB9k(X-zGrq?s?L@DqPCrDo~Dj$AWlcP zP50Qgr|b!wcF)ss4RHV-6~Y$8?$EXWGtpB~0WDSYZ{J9~U8hf5_S_zFz#>?F_jp+m zHJbH`wd6Gu$ENb4$0O_7t_nOax@jnjf)g$Eet3sY>I6jAU!iCMmxsMK12)|4?$v#n zq36?g11Gfd@J<+~E04r}VVEc%|PeO zlpb8uZAWxtK_`BkAUjDMD4i)wsF@~(j9?Q~&OTg&qkTQUjk}g6`F1qVNoV)U3N2L; z&smk#DEBQ!w?Lkb?Z&Tc>HaK(9d7IrWP_F_+B3}bl|4Btvlowwlg$l4VxVPLp8m0f z>~z1U%qO%7hg(=FZ4$Vn5_$843Ciw+Fzf5xM0a=qiLV!i08Zld-`>VEUpN8`uiloAa99Nb<^sbUav zx%*M>I~6&iKG8yh0X9BOt{J1Af^8;bj7<3N{Y?6dEAd1{CqYE{CEf_!_h7IPPzNhb z7Ej1Co>`(37ChyoQn2--#Y?q$QAIA^gbKC#Dgz#;jHJIGBK-IE3)$23=8f4ZxoCQ6|QR;T^EboS0tj$4|` zX50;Q708p~QYKO~SAU-gWVyZ1TCXoSI`%gn@p_}ZTtNp7u%-X=XunI%1J$?kAQjVT z=s>ddKi&%jt9AqrkyKW+gt`2SQ&jm~6ypt)=S`|zzWXv^WX%}1W&uEZ0Z{xz&5PWF zn+@guD}l<5)=h$U6LHqyK8vy0AkUD>6++4Vd5g(~qQ=w5ZyaERZTnKgzsIX!C$SWl znSob@;@eEcg3X&7Y`V!|dkgEizDVk?!-ayjT24t?{@`NiYGS2)CVuj!k--_o@rv8uoy0R-Ef;;Vj@{K;E%(9Y z@#5HxP9RQc&c`m0(3GNn6G9RBp3^lK5pk45)@wmyotW6yx3skC@Vn?*RpG1F*0Qo7 zEuMiU(W{CCQ5+w$?7>|TDxNDxJJX9C)HtbR5Bl8Oo{tCm0dij?K7u*Zjqrln3N_=s zjx4oMR+O0k4 zF2j6i`}ndr{ZH%%e0YQ~&0+U;;vX7c5SCY@AO->H!9W8#5;E9K$$;#t>o@mYPKA3Q z=UjvJufDE`o&j~Hx3-fXj0klWRAUm5b?mjTql0geYNzqkF*N+2t5;M>9F=5>erc7CHNeAG+r`G4Sk%ga#FI?V0m>KV z^~SRuAs^u_5(iC|Zz-I(k$!Hf2Br1$d{e(x%}q=Ggh)d;>)6t@JHd4{j@auo?Q)Mv zeJJqhsnL(++GF>rhf?xT;%a`8z{7?5;OXxnEUat!M8N zRbE6`YNiSyAEzoHrd)XT6P>+2y~vtA^<(G&zjYF4g%(8m*vNom{f~JCz%G*fX<=q| z8$K_iUoCWE+hGLjMau|ExM7vY_)-Y?9A}#U$wHu`Q(u8y0Ps>;8v8Ah#^G1UABPf& zuEaZ8HGhOoTvZ~r{w2wuE;B03U+q{Pb$2FR7GBuoXS=K-4q)Wzbpn}eA?DY$opMb* z$bB47tENGd#xC;T-yh9t;j7-YX?h$xoJhveryYE>GDy3cyZJE6quWp=g)!%uREA8R zTq~}dPuxn^Hk(5jz`ZZZA_g%j^wWx3X{Fy~tF7@x)_{}STRht|1oXZl z{ok`!IS-S{@d(Q3mLNPivw^EvW~)UuyW6X}pMP8Ugb#Kzr#nutrRF$J^4&VKFaNGw z=Xr1A=WXX{?D({@4m^SvND-?7ER`D@^_WZ+21O6?`&aL0?fzaj+ z@z(%SD?vzoDd_yNF$Dc{6eoUsVn@wl(p6<-lC7e?<%{1he>WA{&h7Go`4D!!-9}D4eICJTn?i}tI7qI{)h-NUU7#q%@ZS%rTOynGXNv*A{>vhNw z64*=%b=fE{KtT33$IgcjKAdNN4{YWz5nhOI<|6@{AKoH-wl|;UQP_5RqN69%XXpx$ zEo^RXzVq*iBI#FtXw+oQwekWmQ6C0ers{S%%YBhW|GG6&6m=S06>|#J`I053ZZ4;a zdK;kq;`*|c_F+f^DpLuZj7xO?CBjCk`aVsCM;4$&Y8Nj*(SvO6{)hhWn6&E9?G)B@)#F^!4BU}oteeo!*LaC(L0&e6Y1d3VU5RWo(Zf;$(W7N0?qGV@k=9m zs37n(K(8=sJy$CLhGQ8kM>XgPPfJW2wAh-nzc>H-TvQ~MXUpv^nJWdj=a@z6qFZ%v z+%JC>?6sA1-n@mB|0qm(=fGf zDUzcyu;09=dH&q(2|fOTdjmRvpi_jKJioA?4<Y9*Y)h{qWPp87%9O+0L_PG{E7= za!hetU-8X@xfM{U;2=T{n&XKr8)zlNiAJ)%@>!PFM}!)Yo<28n{oHMgtL_$>;fuudrw7Nv=QP%_Z>dK%{Dn4um&(ar_);ck8bl zXYjBa6!SpUhwx!IhIXYaB~0crbz|0K+Iy29)yO}UhsVG*71xkg+tO2rArKN6d_F&P zwo}KD`!0DbRAzWy6j2~53A`2CO{>mymLMh zi+X48jDlXgK(yd!$nzCCl;lb@RbnuHI8T92Dfv)U@$Jh`lD?q&_-wKr4%bH^2Z9E$I`UqZsm zZr$rIFf?j7JE+GjtX*6FR)3NHk@N8cV!yzZ?buN=8FCU^9JE2$KR1y+e7=oqsrnP_ z$U^FdK44UPWYuVLK&ByE%#Be)d2LNx8R!00*%H89TwO;77;>~D1su0+dao2Ym&;lk z17n6fp>2+;?Q)cvohScV>c96{elx^yR)n-UfgyKWqeF9>riI=7h=xr#sjQ%&P}tES zYWZU;%<-7a4RwpSaU#hw+*vZer$f}GvaUEtg+gLNI!x%R{I*z-3ULfEjdgp2sz%k; z1(eo6pCv-YqEB60+tg!s+T#A|H|Thdl5yCZKE4Q;-+ zeF)5W3-3#;U^)(ap;8~QubDFXs$%E>>hnoV_P$l+JsToh?%LM*JyWX#;)~Bm;_wmI zdhBh*3dD~WuS@Rkn6XPm9r5O<^gV|f7%K(vS5%(B2Zy(oIxVtd^A9E1yxrJuA__Yy zjr{-6s=J<`Fn$+R=-!ly$zL;ior{v&GF~U@t#N<6Ooz>&;+n1A`Nl{H85zB^4b++P ze%)VuIOw8Cv#l+IgH3-Dt4Krq!`6%yzSWgg)XCqHY%>k?{R2o=t0hx$wPVa4995X@ zP2qVx%+{IaM{uvsQ|dVy8tJUxm=8lL^7?!18kfgsI6UlJm??^JzLNPx2BaHGjyi%F zh+2&RfuKRp9DtP_z1gUTr{JzvTQkc6hhtdBN!?zWU}bS&yL^P_Cr`kHX2KN;`X92@ zwi(a0!PCI+PR|XIUnFL}jreWWRZW`{jYq_+vX*6FSCPe?`M9LRlo;jv#LViV`!jb{^uWgpKpB&-ou%K&)RBb zVL`6v>Ar53O(cM%6s64BtoN1eu|(rkg7j;bxaJ9)N8LK+74(87x9-hE?%6p-Ny&n& zj{DUXil2~Ue@cI)4-*9(j#APv)E4_C;LjcFhL+OD<`EH*aYqOV%m6xpeMaQ^qeDs5 z_cRPQs4WIY!kYC21ywkvI!g1fCjTVywPPhNpBb+?@U}V$)kc_7DO7Y64j^qEwPoO$ z`%yrOZX+0unmykYjYPZJ+ExVayKc`UZwxRHdT5+?7-aK>nScWfo4f=K2?XQdY5v=B zom9W&p)NQ8szo?jMZF>(>Qd!OM=mfg<8Ro>6kzIIl zYvw9cKQ}0U@!20g(5`*<>GpMr&kil>X;q`bMIY^_IEJI~*HHll7(F$gBHzt0@?F0V zp~31^-pLZbbUQvg8fQo6L82wJx6c^uH0R`$S%zM;MQ$N*GI_Hyw{_v?xr7o+ZJ6dw2?iwW4=`}Jx4aGBFHX4 z({4n6#IFeYQ=6a9h(pINgo{A*x6JdcGQ+#Y$6wsNfm}p19j8rhSIHee1|8*pYWm#-VZZei6@qOI)f8N)vu28}mINIHy6=G0sCQ5iDPtQ5zDA>DjE zOC+1eeZK~{zeXP{_dUisP&CeN1HpIZpGrbum20n)@!+@2?j=noxv(4HAfK&KTHbo| zU;|gB?`ct_+wMh0E0oWMT@o$K55LMeD_2fdhn3Bi{&T`f&@_{rt+!fCEF3>yKXB)Fdk-&z4gyNk;`l+*iTCMeoGbA>q;^%! z$C(vNT}0w0oYrgbfsvmL+}l*TotzT;!A}YBOfx!a1(?m^rv>&IvPxQKX5fayBSEA} zOR?gK%#j9QMfz0JSjUvC?#>2$On>ezRstHU35>s4YKIO54dj5LP$wh0BVv!-C6MaN zVh)ot7f+F7usbEV(Y6oQyD3XfW+fkaH{YW|1w7ELh$H4?-Z<9h6n!+P2&dOjopnA@ zOmVEv5N{@OzPl_uZG?|4oBX@yWqWp49!2>g(QQ3Fg!04MDnneRm;8R#JM88|1I9{* z6lZ>W!voR_!%-1;yPI@HtcB`;_3!hwg|g+JhS9Isvnlep2L?!#VBg}hJw`&jNT0~bZ4FMg+Gxszr zeSGhe%}7CmV5@9uV4z>pEqdU_pqBpU)^Tr;*1CqIlaZ(U7!5mUBJg3dZr&U0a=1uT z*3e(EXuLD|+SbGWul5w|^#b+_e>`u3Pw+M>@i4Bh4}FR#eNrh#~! zZBUjQ!UuMKczgaLwv#^s!T2LQDo=(&D>4h04x!D{e`~5+#I$fD{~Vq0)Y|!#grWCX zV7dv>Z?tu&>=DPRh5B zlH*yq@Qo=B+2)j_NciK|HpTC(6vAHdH6jR>J=^{e92P$-r>D1cfHT5tvSJzJ(tHTJ zB=^+m28#?-z92Yl)Px_8PJ|{&)28RSenqd?vM8kM#*=>&^eb$*ne~Y|e7zmWrtElJ z?bZ2Y8lDP)kQCcFU)rnD_j!HkUkTG5W|`kRW9 zSaX)6a?O-U#~!$EsH=zgi}=2-fHb`BfcF|%Y|$9%ZL@%Z$}TCEpiyj&KILn%H*&gM zRVK+li{`lcUVH6oB#U{UtZKy!>a91yrq_@IN-I}_Tsa!1l!-p{UR+i9pTuSHul++g z#f0T@*JpD)3b&!G*pCTMsT()BN%ypNwDr(LkG=MM@lUh-M7*Jvi!12tQyi76yo1Js zO??^#zR=bP7u81mXy5V=ES#;1ac}K)=uM~tH^4C*j^>t<^55Is$CW<#XLZOZrjWM| zd35mh!z<)Sl+(878Fkoy6!R{44!3%l!q4WGb0~`Phd210Q!fUOos92uB?o9OK~06{ zk7Dv;Bd3ZK=5j8dYHkrf0k>2l+~V*l!Miu#Y_E0gjrs1G+%osz9jp6F+<6W2PWbtD zTX$V;EwRdug-4VC5yomiLPa zFaxDuBU*4~RO=6{925rr(0%-iNg&68WgHp7d>mD3DCx!+TZXWub;EMz{@pRJvxAG? z0+vpL%=h!8A))u_DVz0CUb3*5r*JvD)ng`v)O-}DC{$9GOf^%)$}fae*I+A-T}{!#9we;@hE^y z!P(A(P22yVf-7#EwcFUEtsUnYm?ba%kEsEN!b1VF!Y?PQlKpvkViJ-H&}hp%%y9g5 zmT07L*5gdt;z^1pA>ZF*{=Jv_Y^`^0^;{=J#}IS#J)GK2xp3UOZr;<}+s#Bd_-A^5 zbjqy}2gSbyUwn5L{?zmMW+c(hvSl0?u%6=jP}iQ*QOu^ACgkxb48BWZYq^^>c;0)@ zlMX3P2|*Z&`|!E)m)*$N83HQ)dl+fSYlanSm7YoHMEb(6nA7R)6hFh$GaSE@Zrd z$LL&;Ug`1NOBmFUv0&=dlNxR6R@76B7ts3iVcBReAuaz)tv311Wb}PGJeKV6IcCET z#zgXmz!QnoYGb+B(rv0ISa8_bke4N}gnZFZ!t6fggX3phJUl%ydPw0OzQm?;orIq| z@`}b&eBkJwC#Jx=8;(l9ri7iw#X}LihG}Tf9 zoFRE^ej1I9+S}r~Ue^uar{Osk97#r<**R=_>JE<6Knl3Jc;#wl5ADHj*;w*(*lSsB zWY!}VojrFFt6nHkX&_GYK%)`#K$E*e){49-UFu-pYs`#rDHeJ6)Mz6zPBcT8jpq)# z2m0pV={i_By8Y3#9-qC|ZVv6nR7F6D!2tElGc&K9g__QH1 z%&yZ)GLFHcj(Ge-o6i0oa`M%XBWh+!TZ_uW@dyp~Z>m_i;EPSlCp5tukrvY zExc`4wHV#pu5}#ls|}na{LpQZ=5fUkOLFJ;>r-m3z(+cVJ6&H*a?5oVXBb<~pN{%>w8~VD2L*i>LlaWB7apbUe$PM|H9)+Ve`@q4@_oQhh{_x#Uj|*=B#?fr33% znTLx%({n4xFaP{xwLQ3sEdAMWn9hR%T{mPdJJCz@fUKDv?&I(I*Q-=Q+71@j_4e}B zrygV1ICtX(rv3WE@S)N1F}wy#AoqrHzkR(4ApoNIJWNFfy~7wjxH$19HgrJBUB5$G zf*LA!ytKqj6HiyYm|6V^f61Tgkj>`Z>Mu zl_1hWVZ!Y1mer~-kbdC`oo~4Hqt&n;U}5Ath|;_SMN%x#M#lrW?Fk`9k(VPh&#G} zQtGL6n7W%AKUol~mKb6UwE3{03Nk6YxcXg@*&qA|vfa@EkB$CG@R$P^vc7#gj+HP` z+4AkkBN_W3Vn8kGmYl$pNk+1)NE~^Md!WX)nFN!9GhAufKKSHyeZYbny2-Hw_!6_G z>Zer^m*WhZZ>^Z4CZP_A%U!S25XQ}>D8)chU1S>V-@Aco|C9a(ymH@q%VR&y+k&st2klq{B@obx@R?Ni1nySDN zstuMUJXhW(ip6MmGa^mN`%so#KCwT(b@NHZqJpZvDkN!>0-=Na2c8fvw`48IeB#M9 zK`I^I?>5&NE*BD+-swI1Y3@z=^*hFdn)!4d8ZxI<_j30yu|4VFJzZ!S(qQ|F)v;(* zgl#UlOWg5!q1S$0S*L7*iFr2tT2N>k*G*U00$**_<#(Q?bAL&51MX4Lhx?^ktMfN{ zfg}DQEpQoFl7c|oWT|-|qr0jy6(^weivfpvY!ZxSvcq6_cm%!~tPM9$h+92;%9k8U zR8%6&riS2LZp_F`ihYDF$_`FT57#Ms=&d}3DXr?O(vAldX*am^%Qa-)IPKz)#Ek5W zq3#WRmh}6X-w_XM5HG)ftRh8h(QljLFe}yB+GS=n7VsEQvS_np^QYJhAxOcf>T-6oPwmuIcWtRFw|{BOK3KyE-<_;XrB86F$7zXW%|u_PL|Uv67!MYo3%CT zSVVOJTtX(n(`-48jqLW>LfSUznxQ{E>${|RJ;bh(c{K#Khly+!lCBIQ;&bP{_{3@$ z=rgOWN#_~Uvr$MT(YuXmFI||UR+lL?(Xk=7^mVLP!hPXE0StK#MSDLlh2=Q+(%lV_ z3`7l|Gfd^p+r?SPuU_on!TCDb#hw4#5X9|Cmv`BsYiu1`pTmkUQd-{y^b*c$d_lfx ztR!B*KkpwZTk1(FTRIMD!oJeo5$j0bqwS1f>>Osawj(bRfxTY^`YQ{?yO*Dhh+Y0l z65*lE|H%(r@!%A`W0CpwvGGP!QX8F!c80gyRF)M>-+j_Je@3gNz^Oe0*lV`Wnw$0Y z>M;4twLXe_GY5jQWf>JA&aQXO1wNlsyMm`c9Pql2zO?ACTnJhpXd&>-hz3~J9H;O5 zLcBXTVIX-t=GDf~=_;{1Z!q`sqZQY8?Pwmq3w~Qt;*_EExEd*K1Rx=DK1V-bobHTy zCDfSWT%#J&N7}b8FZ6*nmAP5vrzlt8!~NmlVAgE zki+~hy`6c_#wXYM{Lq#awU?00MJpGl2NStT^2AQ19LfSO`M%I>x@vMU{rRd7s{DOcg#50+;H*5rMK(s1_}6wS&zeH9T>g5Htruy1w$5?`BEotK_bXekzP1P#9?jDF zsGr#YvjHVwF?g`d5#az=4T7nq7%=w%?1Kku^&>l*n>ca@vy-NcXg|tm!v#`_;6L8k zXzsvgc5zhx{3t)`YGWcsAVi;jh`22fJSY_hjc;{chy22VloT%?IjY3)U@vNo-TZ}C zur>b-GGy$Fy!N}F@+B9g=n(}|k;muQKQhyNKZ*q_@iWY2w+?N&X#DBsIju>+qX69- z_ipk401hITD`E5Q4WDGjt^-`*2k#NEk=LmwRL9Y`-{WZJrG0!TEFx0$BeK@S;Qa4z~ ztqS4mR-eg>dAK?va-9QJ)vDs7z+U@p!T9*`eTv}cN~(bi0pgz|^X_JS>+<_EoRWL% zn4`b|>24i+2uip5okna&5#x?$}1p2C9&Vggk zdESVN=4BGUc)>7B9!mJqyOcj^rrHLcdU;SDx!Cx|X#!CbIEvYhd&$pY(i84tzR+Ny$o+m; z)5E<~yr5D?656)aG0^z!|Fngj`-=N32?k)*Uvl}1m(bQW3v?QF%X@_XG~T0bDSEOF zV0}E)ANYAKR1FwkZdIAbAZOn+4v>IA`n1kuetnvMOT?Jc7|0TOb8HG^!6GhqySM0s z=cnGPeHHg9*={S<$}|L)NvC`N4^Lkm5asjye}I63fQ7VzsE9~+gGehSAuZCK$B_q$ zf=Y{kbVx|uDcy)jcOHGxaU4f?{PuW%KfnDC?zz2vc6Vl8GxM5VGb2uLb71XLDfsf( zS8`bc0rnjk#8l>UiN^CyD1c7~VMpZZ_XlpxmA9<20K_V)_XXIGokczbs&%~v*1RMqVecfVW8L@t?|IhgNz`!5qwk$()l1P2~@r1v@_4rMmZHsDyn}g;);{8dA%PsxXK5QatJeK4Jy#n4m?k zK?2KxI|jKyE%dhn_wg`Ec~EDxemLz@FD@ofR9QKimi72E?~f1x4<|PHX84uEiBG*K zoqJ~bFk2I1eWT~9asYC@te;r>(>$=dJCRX9csH?^whb=x!e%?9eFY0>>+g}`a zaOw%#^JJ#DqZ8eoC$T@ap%RmXy(Uu^t1xeU8Nw_dY({M4AI`ElJQNzRAav#A(4XC8 zBlrOR>lvYX0|!9>NcwaYeNP+D+z9jtI5;xrfK>p)IUi|uNEq(CW%@pNj}mOdE{HY`(=T(r36VG zb&4y5Cg(Cei@w9TT1m`M7L_HR=I{t!MXen=9=kMD$)>e2P|&hVc6K{$c+$jY*!yt{ zAbrdsUX};D#+roVptO3eucTp*iRi*6AcMMH`!;vlofAWm{*z&8F$P7Y!6 z2s@skKPouJQziwQQcs0~G1IhM**Ai%@>0xkiS17)GsPVF)oinj9KkRa*hmOuo)2zM z5GZ8nwP(P3f40D}t<3q1EaB#+T(4Nq z;G1g=?}e$~CoglpO}2qe-dSp?n)(`|$CPU*;l?ptNo`)z-%$fk&}i(;W6sq}!R)De zo=l0cvsJ5oTEz@}64pP`$MXuV;?36w*RskAziB^AoMj$-y*g+(VjCFmN6V(F_}RR_ z`Q6hA+7b?(K8hVEvP=8eoAz5Qi@v4ITjCYBxG&XLnBofo(-rg9#}KF8@^NEQI_5}< z!=opy-X;RjK1&f|o*MN#34(JxhplMWLgidvN_o?QPM6ssSz-NtSjG^u$K%}%5O8&w zG-;|AJs$F17GXuP9L9gMC1+*@3gx-KG5F5r1DRwhN_I83S}%+d$bQ5K7U~T zZ=uIjc$ZeyBjtw9NJ%JLXFt#SgHHHj<@s`TfX8{vNTuDTR;#M`n`eUon7NT9fwcXO zu%sepr|PsZ?5@*{HKa{f>Mq+aJhLdQGYIJK&rewre(m}5`Vq8ySx?f=xG2R%q}&&@ zTv*d14)ig^*h&A0#LlS+9%%zNRkpy>*QxGHCUvKgII9H0lwk$QR-z%>z+9{^;}YPLcDYXD6TS7RCPu?1CH`rSJTHmz4HyR@ z6?*lW+ttJRvgi`eUKY`V#^4>IWcJB=6;pobS?%pe3~zLowI}9Y?OC+6Pkmk8<<|vy zkv%1x<@TE{%}mm}r3KC^$5~Z()YynhgJ6cpyAZEE`-e=qV1K%$N?&_@&F$Hd+2o>h zxApjFM|iQ@DD7e4xkiC|(cn=|z!~$NGE1H^@6iS9L(8`ny6T2Xtmr39UnP!UIMRHZ%IuLsf0gzb!&75E ztuHh5gAg^?p5Br4eyQhDJ=Y*IRu3lVgnI@OIV%=wyB>J>>S5zIlTaULw%Inpj1W63 zRaQQ~ohBKSk|$&Ht8sdW!-xW?mv~y~K<` zd?Q`S*mun{ZZQ6rOda(K%<{A${{QnGvfBL%0G7fe4OQXgrO`?oT1DJ zrtb%dCib(HGH$|pCr+y5VTG4b&BI#YCF)=IlsszpZ1q0nmW<^7hZpcbUHR5*qi8j( zR059^=Ft_Q4sVR!XOMgv6nHo-`ZkV#7D&H|)2JVglPI`7SMvCmA@$GK-B(C5Vl6UP zl*--2ax->UwCzsSbf-#w|KfMZVt+B-`jHgF$n8)A=wJgT>J<<9@w$$%3KAu&Kp2^v z7?Yji`n~(r@mmiB;>PCT%~v7XO_f5Cqzo1>(+GVPoX%Bq7Kg0qd|MgS z<56bc{D0|_Kglx@#ST-WuH!QLY-n>2TnzuDwR-U(sV^E&Y|YWGm6N|9{HUnWvamBK4KRgU@HD@!VU>NGaLIWlhU zmPgvN20#6ws8;KYm=mSQC81yWVNln6h$$dl`dVvXox3Qi64VTCT)zXLa9ftdau`EV zVTMT#(%1>U|0u2t))MX?u0AbcpP&4Q%d+7y#Ag9P@*HbJpcKkll?i}ps!@O8@GgErVYccRxwae&r2p=^nAtb%oD-7|zcNw+b~Nc!@zIWaoJlX}kIAyQ zyVl6v-tlZyk?-3jreEE2%JCD304n=r)~O^U|8!3tGU(#9Z*k@NRL;1WqD^9dAY?N7)xW(z zaW>1>>OI94`P}zVv0`n@LNevuc!JHz^=>S<@e49f2)06B%K*rDbe?c_^c;BvU7dW% zUN7?rbM$bqSvUhk`9Z2)$0R`@B_&4&@6oh+1O918LT?7aEYJ+w7Wz)IDD^b`wIhSv zYZ+TxWcvUQl}eT9O-iBW?*_187wp@{ocsl^O~>hZArGc|9q*!^YTujawDt8hZc7Bb z(^Sp^kQhJZ{c2eu-?<}2hka*_gI=A%!TpKRk02J>8zL1Dkmi8!H7aF#r9P(>{uNjN z>k;{>+Tvu)Rxk4lA0JQ$zVBekpJIou`=SQZ5lmzozt%k z8uy1DaT5LBM7(nrZK~sU+Fl3_V$p}SBxsF&r>fB*cy-!@1~}l|dsNCJe%s#*gGFkY zD}9E;;>5;+epNI5(pB}-*w4#v<9%;>pj_B`xz5;DP?RUg+T^(n})mLh~C z3~4~W%Hp?*fw3L*e1vi?U*^&MrJ{3<&#U%-&%Txzg2{4q@j+at?8xA%oA3S=(`|h; z>KG_s%QRh-7c%T+aVAma)4DxU_1U8rX2DQ#t#Def+ujEzle@WBJfoa*jhP7I4Cv9O zAm$@s)=Wnc^tP=GYxS2Z15gLNO$@*Nga++M{zRQ{-LUzkMps8ReOcMjo7CHWQuM~v zOQUbMl7qV`kz=d1chCMMiSBymNV-~g$UpW^na-bXZ%I3aO2X zuu^vQD4p1VuRsU00`kx67xb^fpBEWJJjEAVCZ*W0PS=mTA4+a;PI!wcs2u~Q3utX7 zK2ppH?u6ZGtANh$gV=2tfwjDy;(ODYd++RCYwwL3#3!NUkEnyD%fp?YXXY%_!Cum<*WHs6;;G%uLmA2aZSUJ0_=%j-Sv~SDJ=h;f_Kh)s zRXElA#uavbUjGjAq@Im>*tLQbgOrQlcdKcuW@uJu&#C7CCaX0$0=6S&E922SORdYc z?BTz6qJ=tDKuH$g{ac@gh-czVRQQ|(bgx^jTciMEQJL7*YEh%s*wXGd2CwGB0RUFY zTVvo;t5TLN%Wj@oHR>xAJ#Ti`#7vQoQA^^)+a6=ME`Oex-Lb6+ zU?fXzaxx|@#KP@fy%LXWA$e3b8mDrtKOC-B0S>80)I<~nYo=5muAaqpeX~j=3CBuR zKtp-rxvJ>-hF|}>$yCB2<-?b^{^tlDUv%;!^j%@FE3BqgkI$pQ6%&?1##EpbrAJh1 zKs(~E8_9{SE-+@?DS0qq>)pNpGia@x+gIL}+&NGxO_H7ehI;*LkQYhdh>YaCkc%k& z_SBm;qTJ#=S438P3JrS3i*^0pzOfAlF!@iTLf#txE8VMf-4SutJAZuG-fn4;Jd!KD zgO&H!wf{AKO%AgW|HR)2A$m}(bKKQTS)HI&moea)D&z|~uL=d3V2jwH&(@BbUfT?2 z3DvH#w}w%l4^FNG+~!7rNFhil7a?nTt@vu56S&m8_~Ln`+sZ(|$Q#9ND1rF!gS+Uw zj=C$H0<+Sv>q;Tjf)S}+XX||kwXE{o_29^nukNw~xa3EKOnqZNt&l>@DTq-MY^Y!i1_Q z;iIWoJ_o&Q2U>xF6FrgjqldQ{BVg1g?F}DR7lN*vTXw`j2WpP4iNCsIxZhWzyU~X* z&${g@@GmFDqa+rQ6uk9Dym)n~|20C5epJ<`3REGGjXqRuiWq+}vf^o~5|k*mB4*zv zsHxjJjkzm9Z8OYc;}G~V7NlPWUac;1t_(E(swo=yS)?|HtLIu-aE8B$21)!cg%crh zXg<@UuEfb%+Mi-v(qg^5*9swJwNSi&dPB)7 zIa9j+5I!RleJg~1Y-LLcduM4|$_XmsC1>9={>mH#z)Nj9qPdFXO%G5Zg+6|n&{q)1 z76D*M$bzt3@jF9W)Pjz_i)wyCL0o$dJm@~{BeANd379a3n%^x0o?9JRD_h+SoE9`4 z=JYay2!xvP3&pNFfdZnc$6DHMgNo^Ziz5VZP$JJ1~5hv1i54RD@ zE>D8_ksD(bU#@^O<6b7}?q01(QMuG^B3_yM0lxw?=GI%nLTw4LX}7unuwCL85|eNT zao3S%teU`+#PDwFtxpk1HL(#^r`qS$YP5^`vvEOQlbuiH4_!2s;3 zB1vGNJPpb3BsOKmkL;ZZ;&bg3+a&&c^A+k~?%yO`#X^|N4^5#xy89d?krs-b?i}^| z?ycVA?SeE;&RH|{cwX)9-rlB7t3LKi!n)2}v<8AC1zeotZMIX!NtTXx5_)kGb{ga6 zd2{J=(Fjml*MTvuWwmdr%$3^a+;-e&;xtk-bjiioLu+ha8OW8I^i9N`y8Z@5a=+D% zJ<;TBY^6pNw@vHjyg9raKt)quLH&N}1CAo>ZAtGJp^fc+#{Iv%;C}^my@XQCB|OnX zr^!5k3m#`V?{l6<3?zGU4tDNn zTF!2h8l?_Ngkjth&}*9hPCMjX`y14;Du#lU(#}mG#bz5edA2Com&Kf@;f0b>Y2h;w z0ZG&~Q`hKPQM2l+=o&e(lpkgdoiE3YUxtdSO|h|^{7cf6eKcXa><&CVzTJLrWhi7g zFwIkGSR+TTq7b$4gfSo`ta{-whu=39Yjsd_X0TCg?z-c(aEF73sbK22i7hfg>-za@B)4`}oO(m|4$^7qD87yF=Kb8L!;^Jb;KjrB}t^uO=7l zX;FFhCH4FGV4547!&ED)$LV;|vFWj_e-_}MAzJ^5Mxw2lSljzH*79-t!ECGqwJp31uSBYbqECHpes>Ofb1Ld#nKb;=wqA8xnb-BF=*IJDhrl@mkXr z?|F8U3?j3aL6X)0qIRM^H0k}&@>Q2w1H@Tp%&h9qPeuN)$!D-jX}5?OvbQ(Q9k=v- znMCiKdT-0;v2)V|bdicqF`<@r+Or=q7Mm7Zdsj;!Xx5fsgsG^DjGU) zZ?2J=0bk5#M3k-~ZJlGAuFF>EI1+{IEq)jGz*xNevZo!SB4hQ3w(aPq9(RlJ{z%E-8%*3&J-a%sYSPxi4kOE^+kUE#GESyFC3`SPI%KHOnPvfQ=y*|;t z&Jk^H^nkxdQAoR^IwW=Xi3b(r)A{2W^J`yduFRg*i0%sI-sQUwfp{tO8cz9a`4*XM zJmsN*kZJD*tF*q(HE}>2l(tyYqz<)y_GEf;fX&){UPE6fq(bX;=&|Cu{;jfGx#uVi zRj$vhhw=x7dga@I-tHU&&7XjM;|2kL#UG6{ckuBImh5l}KA#CT;%)EV$-3}x%KNgR z+G9g0!|NS;MmJUz`=TAAtv};$7R+k3FxJJ1N=5GbD zD9Jcnqk%vy_Kvw4jc5cgkSLs#zt69^<{kQtWH0n&m{7?_TGu(ti0wTt;}mN1?2H+Q zo3A8zRc#+>+P_yL=}j1ZjLBd!Nm*t> z7RxU21{HgXE6}q#c%AejdIuLTJ7$k$54t}5(?hT2Np@U~-3E$T_*xs@iSDyXeu`9- z9-FqqXq5SoGZ4x&@>M=TQxGsiAP4nVAvSWpXrl!YuwQS5mB1LfceOXZBV>2WQEyX84P7wf~H9fZ1201Yv2N4oTO3^h-d_Q=)WHs zdGb4MckNFg5v0)h%G2MZ5J%*KMMJ5OcIVnsZ1MSI~Jta2QGZ^*L z)9(d_Awf}489R$9P5m^W)>NGg2oU!`#$5q1z3HdW;xTbI&SC+cgV722G45#+UlQzd z23PAGI<*6im&gVIq|FuYAm60?Kz9l3!EJ-NIQRThx;iHE^wtWTxg6w?60sLKC!r(+ zvf)KS;C-1z)XkycXpZ81%B&awXRDrb2ljm}qnGfU)hu}6X@@VYw) zs363d5c>_{4|onHBv9z(ZvX98Z~oM?w@b}CuV^HEk>&)YKr4*OK(fcM0OnW)g2ygf#}GeW`V6BdldyE86^})pOH)(wn=m%4JhIXEsbM(#Qg%ZTM%$y*y;_G{=yh-C8s^$9rl31dH?tg z2KPyZD~hes6K}rm)e*V{VD6N>lECF!Cxm@J>1ICqJqPJ!3mtZuyGhH=#j4 zTV4{`m=>GxHV_`BtTv(F?2Q-iakrnm=D7bQHsV-Dtn~Jp0H|jdYw!9%m34XurK^4- zel$Jw9jq`FeuZbZ1sjs@F;enB0wRT}f>!oD&A;7PmcA}e;02QNMV2d$qdR-{Y9lAD zxG^3`RKVqB{7C%)_tU_&Ro!^WK2V!`9ftX{s?b#HM6eV zxL1yuH4OM6R^|#_=@46a>+C)9L>4v1E>lRsQ0gjoFJITuGdbSrbky+)oR1S@~H&E1IFBysJ>j! zdsu$^V!(>j@dPvsMt!}pHA26-Zw-Kjk-g+Sm(^Nj&KQ*0FCdWjwp$zJ+a_32IBxZ% zD8$ZKTO87AeeBNqF0>$)@mx=M(BiNa2EEKa5*LymmPk?1DvX})tbdX zXG04G#q~_Buf&hJ8Z6;jokLi=3M!j)gCtQr3}%n~AQV{%;&KsCJBks{JA!TWC0;BB z6!+8t8r^Xn6QU1RD;4JfSefEK?OH0zX=3+iA7FA%?6YY0aUI#v)mzd8%-q-h0;TUH z&GzhFRl_a7p^S1DaLCK(^nx`GKz>NEZPj{kt)hBrS4Jp=&(<1>YG7mi8@UMdvLUjZ z@NW{$6EW(&A@TRS4LcGmr&XWISu`Daeu9u@Hg((ZKEAB2$f;7TQJ<-mJe7$Rl$ zz>AId8ftV`DRm8TOq^nClh8jr6H(3r{%DJuCIkroE_}(36i4Jvb2_35I`N1^i%io# z#X$U_c=!hr2Ppjh22)*~zu5$L5k`q-B69pzK;w|?5ZTBV#_oFxgV)wgzxhDtNeLSPpK+grc zahrfrktIze@NvW^b5x1y=m$K=ZzvM}RcoAjMZY{0fiU^#Q4b|wcuYZzxkcxTO-&*z z>cpR*Fu(+h4R$CiDFoNw1yhOH3LCO@E_FL!e;CmxwkeL1UKYFE{}%VGLT{~HH8%#} zkv0>&+IUt)0WpXtxlG`tNIofM%Toc4$IxXX;I{pxS3|=H0`)O(#31S2*YT^ha>981 z%Ho+y;=3wR+S`ye__)3YP%W0=^bRAUtUORU;s|wq@qlObe*b#?r?zM5{9F2E<_$SBuEhGFf<{8G}b!1xj@?=1qZ6hLRNW*)y-fUt|#8=}AvH(9>t3NlX zlwq{fr!dnLhI(@hLWxDva%`&$0J7tmSU?I^Y_Bsx`f@JM0k5cpl)NN zttTDSgue|Ex({&3Q}I24MAZp=%VR;|3nQ*bALQ(az@DqHXko{z&r`~_KzhETzCyZV zSL|mrx`JWxc+i*k7QF}3a^R2xO`ia#HwGD~woxA@w-HOc zlSg-jO0gltiF>Ny;rW3$J8=WF2I~VAh1nAY62^WP^vZgBu@AwFx)I140c4dZ4V$!3 zbMIcMSlsz0%GA+9y-P~yzzN~8{iquhqtb)`I^oM+(2-Jl?U2w;K1+LBN*O?st_3j8 zVUkN?6ldel>9%(D2S7HH9Xl?oQUev+Wuzz`(PN4s>O^${((p3jA{pOy6YjuIJOb zDgDVv)E1ylB-4}D)Ksq2XV1B~G`EDo&)EEztUZhXIr~L{gD{9iP=G|g`lS;%2_9KN zqHZ)Cif5bAj#c|yas{Vi7@je1F}YVyC&R7Pq+^~?ED}Q0Lf;#^za@EVD1J4Wj3U-b z>{Sv1&>MsVnpUpFSWgGT^)SksK^#EQ$Mh zf3gX0u6S1-gWQFw`IsAPzhNWqpnuVIAR#r`hw&}!6(A6Sei@CE=Vof$34@LU!Httb zXNMO9{*ALCE&_F`Zt-UDexau`ai(2CvLpbEf_c0auoHVAg>IMTKZ;AqX8$OTn@78+ zz#{_Qr~@l?vkE?)|2KK@+hFYC&O1>_M>WOK3*xCprGx!Oo8f=L0X7@`7UxHX(<-qN zZ?G7*C>G(v$@La$+=+wyiyq(1E+&|{0hCj01@y_`L(Uag(Xb82{V% zgQ}v}foS9V^8H_5GGZ5fWhn$znF{5O4czK_QDY9495fqoyfQVXCHXHsYD00+U9Bwe zA3+P0_}_}AYls>RuI!Uen#kh~0W<#q)#8y~*ggDH7NJ9S8*OIzj^@AryGRCY+_`w$ zk!S;+c=6?nF$0D7zcEu>d{`b0Z~bp_`t0!Deb?n+S^)LIW->5ZFMfLQGvcGf?%(0* z=7ISCGaI_*ZsSXy@P9xc-D?s*)z4p9ss+&kYE)pM>*H_7#|?Gb=iZzA7vq9hT!+6T z-3pBCL|=^H&MNwQ{26b5GTcT@k@h z?6kdF(1+JxvSbVgnb+03RutTQB>yelx_j~bSTK6z;!!|2lb2U3xeSCBQkr5VYvfKQ z-#dTijejbN!3fL`>;E=d)MbDgKxDX8@FPRxDR3k~YrFHmPsv_Ax}~!B;F3G&mX9q1 zFPY%Yg|jq*6e(FjDiz-XwXbynG2Bqok~LzzW%c*spKW~j1-Op0BfBeiF^x8xotbP6 zoHy`~DjDDZ=o{2`{bK62LL>j`X0U^TNQex}V<%It1^;Sg&+Y%yLIYq{V&96A2E}L zpY+6AEK9>ReUkZe#^&fdhUa`2j2ph*^rht0fJ8w8lnojTFW$o?M|Lt7h&Y3l2>xf% zH?s7D6os4(@v7|BJ3woF4&Yq!c|bk-URXhgk4GE}s_RRqo+L}t*~$%)t8FYkpsIg{k-v;;5$VW3;I!yfSD~psMrjmLh3}z@}+*0k_QVo?f zXzy0dfv~n2y;$%uwje<-3l=y(soN`&zs=i_sE?F#M;-FWQ|A?)Qqz;W5sy18j$+PV zR;$yoO!u>Jex72biB2&+U-d)bPZsK`Tl}3sne*16^tqDM zQ9sUNc&fo{1CqYm#|swi79Yi|l%-l|w{q{FBQ-VryF-|J`&ht7^L2TV(}^0i!sBg8 zh_C$hPuX5D(?sB&{i*D42{=#7+F$Cm!uQjE(a)EZ#hpOW)9<3EI(+}P9UvAoAjIj- z%ou@Yk6&DZkPUweI8EG1^LJ7~4yU728~h(pghcX2$=pu#I;R-euKmS+2fb}EQyK8) z8bP|_ykV=+DdYAS(5YUT4We}^b7`_cl@0v4sH{8zWVh=w-UxtsBmi}yzy>Cg>}l!r zSJZ^n`A7I2oSO1S$;1KM+`sCPl+R@z(za~a@ECK~JEHMYV0jF8L}SDA z+u+T`oz?b$;|Hqi+RFcD#|%Q!SRh+LW*S;Vfv^1QUCM9ie9bNktEW*jV}AQ&zWLV} zY{Y`(2BcW-{x|W_WVqKB8VsiDO^xW3qZ&|#@m=gg^v-sdf=1FlP0CW?M+zyW#4CXf z*9s2E&tcnnI$Q4V+oO$F??=V9?*HD2#PKqsA^)~5hjB4@DV5`Gqe%T?{R%_!Bn zhEnrriU>@58G!F8inF*7n8n}D3t+jNb#^e(dwiu$PRj9=S06@&w8G>Y*00`&Sg_$0 z0&|j1;vmzaN3^IUw<9gy%z`!s!VFQ7q@K*bnIVCB>oP}U;VwM)@yqc|rkn{)Iw)OV zcR)`7@m{iUFVm1S7b>J^1Ufb9MLDpai#y)#M==)4*Wyi7@tsAVu0;h+z zW+q^+u;J0G8MuyDNJU_epm}ri7I(rf94gS2D==4ES1WP}0|(y;Lh)cTt1L_%UKREB zQgPpAM_uvZCwcaU`k4*hu^kKzof4!E&FU|@pEPg6@(t`PKI;Ne|IXwdq10fyuWghWZ>O+uiD18;8CqQFS(LgwRly;g$}V{!mI4p z-_D63A`^99A5JXCVe`MYcCSbV0E%ras=>>*F_MA8Et>ps+Hq2?=O)(8VygUoYQs@T zLu>`2D*i1|;K?(*slG24REbi(LyE@&K-MsL(hY>{&lyZQPJYR+lWb0OD(9@PL)~I? z4cATzJNZgL{IZj$12D)ecfMq_#kCM6^kI!s&lOwT9;~r$bXmT zatjMyfv%oWeb35thOyh}IWeIXrOvd0FUv0j>6`VfJ7YuQDsKSiELZfjMij&rln@Yz zMy0^Vjh*jVfUtuL8FVzj z(RJYE9r`cSZ@dx@?5C*Y8#U-vaAukJ3$U*Ray7vbwgMl(YItXLg5s2(T72M>B*5_@ z5x@t5LW&_q=`t?A{*&?BVqk|vq2GuD_`8+t*`2cYH)R0OgD=WwnPmtPsx}BPy=vb{ z^aDsbREr|U)sK3tT|m6%oeUlvI2?jg(tu)RzzhBs*rlWZO9GY*Fh4`xroYbA9??8v z1V?N2FoR{oENKB#8TimrQcTr5%}HyzBy@;L#LbRO__prpwCSy=&v41CEO%e_l>u2G zgl=zoW%H)omBKW>F+GU<>S4!5F)T>Dso&`fEsMYnI5A~AozJ{%h1IVOHZx5qd*cuz z*7hQ9lO+pro`3|-#Wr_t~5n2(M1)|Y?aAV{x5UHWcm)&Op8AEV{{ z;x9c+_caV0u$^psI?7Em=4&#LO#H$ySK$5kx=+tKn(wXAQ`k zX-&M*-2yWCt>t&-u%!FZpJQ4pdT|y0a6rn&97vVgm8=Ox;*1wJ{onLvbm4jzvOi%1 z*j63y;v}qoCLb1YWPwV<0l1Q>{e(h;68sODk-?Q4Ijqgrt<<_VrCDqk89jxWEy;jH0e!$*QGzSwuxkZqz6hAHg#NUkO%gMfQ zW%ZMUH7h=4t1rFBCf+lSo)7tZCDets=fxWmUay(E>R_hS=uQ12v~Bu-zd{DP1_W?V z!jy{P`s_(k=bA$Bz3*#=<*A!Y#FpC;avyXlvK^WdwGf)!=(8fr9h}CRadnRfy!CFu zefu*q(PDek=X>m00li^TlLg^J-N#9BV>!RH+ZfpBTLi`Tj!Y_CXFbMvTocz)E8bBl z$;>oF^ZG=72c{|pm@PR3!X#9JbMY-b>D2Zo$mr!_^_rKTU(yl?gxSOFk zw`*xFK0bW_(;7ZlX7qcCM;l6)Emw7qCEpvC1T00x2|mUwNOlP3aYDIQEl-}rCuINK*}kA*X-0Y~=&qY~74OfNkl>YI1H)>L$lT(r`&06Q_UdRI@m zCcxNq9_M&sQT?3G!?djvuPo~Kz(6CpchbJ16h462{U$FF};2v~7GGx?@D zep!6=d()tB=LxB4JaJ@1S@w&blP6NP^hW)- z{WQnJMQi>2#{FU`Ty#vCwB50Y7uNSnsy<@0L3#+<8-H|og&_hu)D{R=^0~xO38|YmpX+D*anesiGMg7NGYl^By7J_qtt(% zK5x3F$j^VocvigQlld!ugu6TIb5m;#s&*S)VLN02jp*`sOu*Sg2C3AC+jsrCe~{n= zvhB3_{1Jzy+=7Iw?GFb2_)s|R-*KiAChXh}Zg^O;#FcAKsDXzbF1O!R5_r{_&=bh~ zN${Ug(&u|qyOVa7`4yof`VU7duk3V}(GzL{^da*tWdQ;Rvx(rz_Ly7$D$J2;?sg9K zA(zovgvZ&w=?gY^<{7D!pv!Ahx!|R)9y~5-|}p^25D0Y<1FJ z&q+9a_-Fo9zHk;p)1o~?T*<|uqs?xcEmsC+5|Y9nC--Mj+mf#y_DIW-&D|cdQ3}ZO zHABY0O%R%#qQ@b;EFrGjc-7H!aNtVvUEZL1?z3c!#qX~8aB_)Ex)#pDoJ9$TdvCEo;@duKFvLwxLhaJ&n}$GO=NYd__#Ez%W^wQN*WY{<#M$C$q*{nQn(a>YPGrxO*AU+|LAg z5_Hp_I!!1dV@cxoDeV2}A4{64zr=D6KwB9PycN8ZoiUlG zC*g49SJhIMWfwUjaO+yG9o4EDE5t=;@!!oGZ;c=_M*Tlm5=^Dp1dlvFwqxS+Os6hm ziSwV)sT#=s>{NxxFO-d+Y}j3cC~=EBP0?~vuU2^m-3k` z<#Q~J%|BFR)@yADb_E*m_9kjr!zt5v2XZTmhT``vJU+P>3IZDGqvh&`%;MIZy#Dp= zyF|A4A&`F}U5%~W5l3h2Qv9Ssr$D@Jvx7S!tHP#L zHkLz2*3c^z0pb(%$?7V~5l6>Y@2M8Zrt!|0elb9JbX7c%rY)R1-`T$tJ^y7z(-*rJ ziI%a3Tzd}Z*;h^kux-NO#=FYqFUhG2tdQT%<$l{GEA9zJ^aCl4?yWBDCFp-)kE#`qM6E?ZB0nX^5oT z>F$#h1q#(Rf28Eknw`Ug&Dt31rQ{-;^XVFkqP5f-3AZJyc4dVJ^Bu-(kF%JI+6$kzR4^ z(NeP-Fw*F*fDNdkLkT>x|KC{Kgr^0OeZI@0?Ue0ibZf{d!*z8tFf2$hp8Hl zn_+A>s5H>6-TI^{D0*kv4_>G0!{9HoUu86Bzy`N@+()&?Wyq$g5EdVVsc0@mu6nLA z^=hfa@?eo-Cg#6VAdqL|U`q#LV)OJ~9Qo~)X2r3uR61g|(i+-xvB4_q^>Ug4jz#di zSUdAPpwHV-r|VfU!FfQ?ZU}`L{xZI~!oPV%(a8`m#=T-DG@GcOhA6%DXtL`+$f8|U zn9Tn;qLNMNN?o(o;27~`_wL!Xeh6Sg;9DX2?R5^u zH(?)G&TI(+q(%nkveIlTe+@31Y1KK0+{37d{;&$iPrrD0;oO$wf zC*+&n8k@ z8sjW!x*#1$RWy#tnG2Zt?AlUp=%`N7YWFstfZtSToKI^jQd84xQfBAds+*5uDX^v1 z|A-*7l+=JEgUHd-9HC@|l9nwmuQ{x zFn5xtZOcB{ZSJsmx8|^Tz0Udjv=oQQ@$-naN%Ko+pgOH4eB#3oHEI>zvK1OAzl`O$ zDs{$5m)#)}{>y8^NMAZt;}yQv-6dC~a}jiac-II1kuwMs#7VVg^MOM!%$i)FORJfvN*DH&&nPsK*&7V%wa_UbEr(vOx-& zlUA`o&euFWW4j%U&86E-VxmaB7Y0-3*7_UEqd!MV7BFd+t&yRe+ySdh@k#~?wtBm+ zMPY_jgL!61#pC1EbN`oxeLr-eTwCeF%RNjx*#A^I_f(>AZ8~f5UNF+9aA%ed<2vdeyx` z=$-MO#`O#mMxLj&Yx`+X-#IB;zg^L0laOJV^&_ePo;$iLMV*sB{!LMmZ82?kjIg^~ zV&+AQEjyCa{i}Eara#r0ye`HbAGVmUwC!hUcXzaS+4&3}##NLZ(P53Qw@o#?`3~F; zWg)l_E6#a>Ym-URs&*e$x9nl-)A=EeL-i{#_&>O`k_~?lAbh#EylgHK0f7aA^;Ur^ z?qZ7b9`w)3I7ai`kEW(8Q3p7so+aA_{hFrA>Z#}hwLdEv>P1%e*#i!)NAGmG5d(GE zUG#h%dO-$-0rWtZ_j10n4I^U^VX!q3~$yQ zB)9@qMgrg>z3hzS!2a3C3geTs77Qgu(DIxJ-^qrs#M(vH|*e#^l-)0pAMf) zMF>$*{&MthzB0GE?_m&_{@VA^DWzP4dfsru%f1>4yXEb|cGiW0dYH)S0S#MNjrEM( zn9wfG7_Wc-m16`p$85q*azY8X;dTg2MkJzI82iNW6LU^ynM%h+H$)bMB z^M)qoujG)AZ1~I*BC9bSz`ysk$+0|6vh-vx*k2B49jF%Ah_Of29CnUv%|X@aVrUzI z*Kbn45>SzRI%SjR>0_vh)X9)1%JVSbAKM+|6LaP*t2{3L8HeU||K-=e`%rJ)w@$T( z=iR>ygPr*R%XRL|B z_w&GBzrCDE`9(NF*^%}4x`5AS<4!>u&l!aR2fCN`=>6Bcm&01WE8o;S^f35~KE6h? zc#*L(QVV)VuO?Um8xvD>4yZt>U(LMJDRmFS_FV9@(yg5B5PFZHko5{(X+d)LRWaZC zZFTR4y$|Ki?z#O<&zq0{%|;u$!zI}z>~enaAc7?Vye$fCzm@*$6$i$fo{H&pHCM{b zA@r~B28B$Y$>!{?!A6RDlY;Zh{K3`bmpzwuAC%xOuSboCKLC#82a~VVsiv6;{xZ66d}9Cf5QI%M zV=z7B-gFd6A8xjE=f*M$t0z)#xy9C$Mi~%Qi)5Y(^yRWlWd5ln_8&X;R6R~XPB+)B zRI>a(s=hiPs&0FG6cGgx48WIGP?R)~kQ4+&1T4CxyFp?Ik&q7Q7?AE}=%Krj9AJQ< zYv`f*_TYW*?|%Cam^tUn&b8NG>simn-XwOn2@@D3G-glb;j=Pz41eV0X8cLYM2}lEwhqquZE#ZnPw;KyvAhmvu4wvS4Adg3!F{+P!v7v-)O2K1 zs~(bil}i5x^f@@C_i4QBAEV#d=f|bX7z4MW-X_3Q*CTcrrX4*^fvr{_r6j;9kty|E zvp>LrR1;cFY-z2sh{mIm)6(X=wXFQ(txN^{(+w%Ss!Ec=wEAgHtqENY=f?nacw*-! z?`jS#Sl!iM6_;S#S&tAd`SUJDWx0pYvhw@-0uheyy8}NC#&SG80<|;)$NKoZa6t%7 zyW(x7n0QdOkQFBlB*v>n_&cKptcIN6eh$Zm_Y};f&6~Sa5{geMuUPqU#I2NrBgn&H z8`S7==!lBc&=T_gA0e0LEdI4hQA0>BF-Pa#s&g{l0zJRw9iTxAO4NxBj-Y~rizIoI zlmkbfI)CYq@=XjZqKZpYl@Ff>jtA}CaS1l(IPj+Cvtdk`FMFS$o%z)XIGMmHb$CTO zo8T?A58&yEtqQj2`~!%v$M^b;A1U|y4b-lgdwP-V%o9-g-O&L9P*v~y{tE_KKkTOM zoi59I^*6F+y1!7Il>5(0HYMrH?8+?nZplgWn}-L>m{lu1_g;(dnRflc1y?<~4epH? zk)iUBrnEq;b`u^L{lNhBWK@=@ctC&eo^;KuRx;*pTDW!TKM|q!jiEyA)cPpnzlBKu3&X#i#jQr#s^ z#nF?z>1MWtiJj17?CVDF!<;KrJBIhT6d^--Zpl|)5y`*nCb>mWg%|q|acYcbrfrRU zL;2yhXodS_*x_;i+J5~rzKwW|^1%}3%@)}-m7C~=!4G+3G<)AYjq&{)(5KUi8dlS*~Xv6y)ciQVtw-p4h zD>us@S_LU7n}2k!NW!-Y`xN?5+f94TJ-zlxYx=o)po?vr_UTmN(rF|P{5iIBdNc(k zsuhn)mxX;;92Lm&N2m^X^MkGe7uaHEkq_cyuY7_Ai%{y`=KZuJ@l-i&(cDo=mKo4j zY%U8lgNtifp(;B$GE66~Y|~$DtB4fF*{Y{3Sg2OFr4ne&kDLKiR`s@T)&=L*@p2^8r=%9fXij`tvX&d)y@cazEsz~XaH;vuoXd= zIx&v-w&YMkZa|;<z^#t0>L!f&kg@cr72toSfJ`n^Ik$@8mdP!U}8FY7TM5VNRiv)L5NoR zGyAqgd~My$N~|8C&KEjp8V^0rC>SX=*(FGm`)IpSc{myAc}l6Q#DxOJ zAe(~K5I8G{Wj)~!t(LqGP}@%3%mk~oe-I_Ie}e1*QXE6qNFi9VZp-O!Hca>3RP^<$ zg)R|{WBO~psL6m507F-AU4p2xcs_zmusmT47Z+~m58M5)Y?{lU1zg<#qm-nn1{FLf zD!~}aA-ln+dGX<&OQl`n=F^b}5KgRpx>=_*7f`A+A2*dTKvt>Nx4Juw}XGTGDS z0V_wAhs4*BhJzF@bkDP-#m*8?6v||ArRem#EM2N!bf>~d+iX3xy{$#mTf!)h2U}t1 zuf)rsLPBeMV2Pd_urmBhapAdv&j;aAOaIvDFHu4bme^u52f;PM?EWId0TW~ypeq;4 zUh5|RlB-Xpf*j4cY;4I{;iB2MUohwulpZ7BXlga-pr!EWrlhAdx*Z~x?^i4Aix8x8_kDjqY=^=N*lX^tt{yM?3`SiT|Ws8^9u zHs)^(3#AcaFSCtTsXb~Ru=>(QoHxE~+8m~{jvlMT*4mz)DOmO$2s&;SOo=w#LOboL zXo%_1Db(!gz8UVsx@`o1dOq1u7_eSHgsphki_q_^bgqzKV_W>iTz?@E5T0mxh4^Q? z?HOLIjW5sL6--qW3W8JO@jsWzB;1krQA7|uE1nIPH8DkLnud-&szfQ_XMc)&X)c%&6G(z7 z?!b#=1vL&3dQmz&(l5)mN97NT1ZU2_vz9X^9dcBv5`lJd3&l>^wX<=~$!CfV21g_ z?3@elX@nn)@*4ki9zRo7@U+CTs+t-<)KD8a3tzBTVUf93%tP+|kwz}NDFTOETT^CC z37Wd+no{RTbM6|>_r%GA##ZZgs3J8u6jg?o1_hUj>W@0O{Os>>hSfMkTKbnQl-94D zyRhN#lfner>dgO0IHX)`UMBrrmM7#R&{e5la+#UV`b6eCh2w6Iz7QBoD17{2b!ao4 zdohDCJ>9F?1gwy+nSR`k2EN#a1B)sGBj2#!a@=6po${$w?-nIWUGg1KZji(S3%WvQ z;~(-}xzCfOjx(-~4?gdBo3&+bh@K@lJqL(AB9%`7!wjJ@y2>v6;qAHBx0mAQF0t-q?zt% ztew};a4CT;H&n(WI)pSwdPQx3&j^}sk{pxP%SLtjT4!GX^9`R+I5JZ~V9Bcfaur`1 z@^}*c<5A>}_*IAx%Z2g&5daQSowm?w~;gWNz5XqkNS#nV}47irl8yPg!sN9D86bWa?lPa{P}KHAkf7GA_{%M|sG; z2P}y4WJ25x^6ep;;*;&+e-C0lI!Nt3F&!BMi5LhR4R?& zq~huf2>joI*&AH0s{wP{@CxIv+hk~l;8jVr_IjJOJ}s%v)NrO?Dxa&o0+LB6 zLbZIeDTL8y9WG{HGAs1M4BDT_F(*~|_6UBn1I}+w9ea2Iq-H>F;|CGi(XFZ4IDr8o zGq9$WjC0snIfM-A711&u-AfJ^hqmQVd;y1fY@XL1)nj8JuR`}pJ@EhRAw2QrXZ;W29!zB21czzbQ;c4@I+LL({M zE!T>ANu1dWSxetbUZBL^x}65Lr-XQ!{i$}er4V4n2kGrwsz)&jH*+Uad5OQYwfr2! z4S4aV(Nz?f$*bdxiu4nKTu%Z^tWv2**a4Q^{T>p8{`N1Mg33Ms$03lKM?poYrFvPZ zD2`_Y;;5RjKiX=Z09$!m5cSy)U3XhRw$%s>2iIBS^Cj{!@l@$9o6uV1oaytfqQCS4c1x28?(NU*TI6cn@&D-fgoO{@J+W-<}wh3U%NqS+x?nwPafCcRceJmMyQ z)=)|^G46U|-IUJ3G^}O(XHHaH8tXG18F_AF_Vu27IyM}pIt0;C-_~|}(sY&J! zv*Ne9>C9z9%}16gB4*&#DsvH8N>2n^up52HVsEnX@NVHkxQrmc*xAY9JZpMbQ2(%K zDf3+ECYl)$-s?MO>CSUn-S(F$Uf#Hd6p!h7nEs3TetgSB$foI+G#RZqM(?*|hxc2Mz4 zyYXnIikKNihh7&vV0dxFVryVzSOI7NZT)y-HVY6dHu<(8qh=u2er;Tb$;$U5w*s2_ zHalD*BIALE!NtmaFa`(VfhXiyU!QB?1|QPXSV8IbrdYe>!QdhY#k9*EfBO9nA2|}; zpOdg`UEfg9f15RmGV?OyyiBI{(F6#u1&!CP#`kvdu+34jW~in*NvUY8HjttHTiv2L zq+mZ~-xebYB-WfbAQrxJb2^mw0|BWCQtlOAmvHsd3nZ7!gt%Yd59j%wbY*2T08rTI z-0_BEZXrg-*;qRM1a--wm&rQBEuHDEIYfVY$ztuqSnj(&GLBcJqHH(mgzES%(K=qn zCMZQ_br?$V_U?O})@q{YS%5T!jlqKe1p$QN^0KBfk;ZV%q+w01QG@Yf3)?zaxBO$U3e8lV2LvX)^TmL4Ky3 zKF1VK{Q=JW@tZ{1#6`>P=4ztL%Aj*GZbBsT()S>cbilGNr-mnsJQz!`|86$VHF?Eq zJylCpHncQ|ROQi~Hn78;9&RM-lz%UOI6J_G(putIEB3Nf=d;?GM-Q_VO1K2m*n-!( z_hp2S*uJ#QYcpL45F}1>`R&e1w6gA?G`z~(s=J~rmqqa&ui`bXae#Z7AF1Y^#hXBL zHCI)(I+#9AVoEVGA#sz(mw|(8nhwT zoRVj~LIS3DyV~&6yN`0b)?eCaPdPVp6zXw+OwbHtlx(SD^~t!QFxyoQMTmXX}s>cK1i;tEaNd-detTg zPt3=gG%Y^B(6G=y&DIq8W8)l4VraFFGj;#7Hf0+Y^yfIHd*QDWa*2DGnV&CnDBn!l z|K?Qw(U6S? z(Pmf^6zhvz!pGa{amrNIR5caUeT)XrbQY;U?H1g8|c zJi34C%v;UYIsT(b1stxz&Svn&?^QtM7`{W`!{^kT)!s$GJ( zF_Ge;N8bGuJYJB+U?7JUt(p8x7LePG!}RtG*{(_&3hRDT*JVXh7VJsv910B=;I=84B^4f3Y71Mn&CeX z2n(=#E$dc^N!7nL5L=pzMUk+wErKX=g1Hbqup55g615rMfwu$Nk-5VmfD0rT$OkL2 zh~nzCOnY@BL*AO)4`HhWEzYPt<^^4C!IBaaM?GGKUn)h)kK)_(oKp(mK`J3*l_9{V zRd$)Y9sYdIKZq8`gyHL|1#A^uYMuSc0=aIm<+GL6yKMhD=_-D*>3N4Vfa8cm_K&UJ z6gEUvntPD@6H~U>iX3p>BX(kU7(TgY>>LFuL`hF@Q%ExvErg7F- zgy>YQ>1WsL2RjxlY4tIX4<7*Vj-Q^|{Yvqg=k+v&E^-`m)PV_|FXhph?4)bc zzCxykoLYxff0U^~-|p-*kLH&sb3VO81CMIBJ}19C-mrvf4p+`A*`>q=b5`v=SoAmd zb9a)<6#cAyZVW@d%tEgHYNwX{^h1zjledvef>pjv`ki!0566_Q;n)gvyt6_G@dyxS zUTfg`%8lo4fhGZj@mlU~=6%r@Gzqos{YV5b>BbJ)ckj5Q-4`L&R;ICgVlfCfwEu=7yv-kuecIQXdP<2;XS5%IG z-VNx$v!U-V{c~mpHBt6P8P(IZ6gL-*9;+NTDuqdO97>@gz_J~iCxut495TwhE~SUe zf|dbrRoqRHsP3+yc;#f}>3F&aep_VCh2i(E4Vgw}+wH40=Us`nM+5wxhXC<|ly~=^ zdiyiSu${Z4rp|u`i*5qu*kx?9|4XLzYgwsI1wel7IXU8ub{H(S0@(2& z%GhE)y5)^DppHz)-Ro+%mp)p7%bx7i+rph-uPQ|PlF{pu9{|6p6XQNVL!U0X)@^!6;YyU_d zA_osq_Ays~5@D*Y+K8s^3{bWZ>r)$O3~;UOx74H!nZ6XxAz{0GXXV*|=^xEpIh+=} zMR+rXM_W>KMkenOF~kDw282Kq2$_Oo^V@9~{|O3!^*qfAHR^lvC+s8fERLAOTwq7U?d`_Kt!NVb{ z&(%7H^UsdU1qEBE?uD1pJP}FC@{yYw+S<#n-Xd#cRV+t4o#EyGL@l!HV=xI-s#aL) z;1a^&slm#iQ|~{o;MuJIJnQ);#67s1wv*b7$_sw(a5{pocEhcak%`xklPbQ{d8|*3B0e|;54!*Sl1qDFUh90-4%46ns0f4m)Si3XVcJfJP`!(zRNq5 zim)^qJycFF^EQk0`q+E2;K0yj1Rpv-9WOhBp}guvD&$9Rc@4emJerK6(Y^*T5l|!A zoTs$j+zP^31>v9@emP(fR{ULLY2%BwFKCTW+r&jen2;(VWJZ(Iu5g)U_GU`ST}c@! zGTABD$Q{ zn1mwo0PZGud*3l@-^jXQUqS`2!U&BIU!EU7niI}b?|1D8Sd;=$h(^bC5Iw&~0&iC? zcn9K7GRi0G+XW+XnAxcoQSfRF@tZkQR?a4?=xHs6FR))RCjRE9<}?JYt@f#j3MsHU zjD6enc%(e*CqP_I0sI(MzS>A&6MiYZ*<6-Ml+r`L8rHFQ6=ue76DpsriP0z>JAkW( zjRRs(;TIF+=)v(7h!*1X#XlF3EQ{;$pGUId+?UjPCh7u(R{#fKZq>#9RpkSVr<5Hg zcE_57ZnhZ{pZ2~4jQ|``DhTc^HA&<&e%o%S_NnWEaT!6#`VG=mY&e4d`S7(NU;DbE(6Hz0`WLQxlbR`7+ygw#c{rk~g#;Fns@q2QdE_`~hFO zK(9VoJK%c2o0ov3vD0ENkZCJJfgCpcQXU|zs|g!f^cVO0;;Gv4d)x>(EM8=7-RWVz z?^*wXPLNiPICFj*;X3+c7rKG{5MzJB7@72$e&Cu&d8eBb8g9rU{Q5s^1Lv{wOwowv zGaYaq?-R3QsH~nUuw22!RlIR=I5^iiF2TN#%~x{%2o`94yu(dQ0CCC`1Gh}<)OMr>o9jHJAJuPeZHHMD#+BzLm8!sOekcm2SQ#z(vT$rH}Yw|%FkT(;eubhcig4g4P;?WG3kehN~-ZIIv;zk)o7 z^q%rLST!IU$8gZH6VcMFmUE3FjKbcpIApWB9%{Fm#-dhjTfE+6y}fnh{SN5E?(FE8|DPQxGI3>3;`DSffWbeH>7U5#aQ?HZFlp!h5`1~ z8|^oJF_vKgZaO8|@JCr1v}Z!mj?InYJ{-4gs-4F-C~^Bun9gmt4ygxkzA$%`udQ0T zG$uI2J7je#sDE<0_l7mN^T6+J?%9b_tFbPKUNRiLQbEKs!O9Tg*AM)w3hOQ4%yxW-a$TMrKaX2n!Fc-4X!0pMJ+u#*$^}W9? z`y$Wb)3ED-#~;M*jZ9Z1I>~oZ#0~<=A=X2qk`6%}bE8QNVzqk8o<)JiM8s38$spjF z3c@JcE%qvzeZOBfsblI^x{K_`9NS|Mv)C=QFG#V^bIfzM+XB3l;DQ`d60Y=YXLg>P z75ftf!=)Rim_VVD*-{waW5~5_a@kzmEBZ#>y^|4~Ik!F{fViEmXpBn$4ixET1z?%# z0E*_|TL=V)VLt)}mfMd4>-|sYq<8Y2zgB9H|IADPB`@jNeB;T-C&{BpFKSNxubPwO zq1e5*&nAJ$-cp`~o78*^=#wl7T>_h+LYOC2BwL=?rl=;zh!=dKTXqNn%lAWj)cy9c zQiZ^^aVFlX9a@L;6<4q-j9#Oror)kEghoBzRJXUUy#}QMq~PclbSss_33=B#i!Rll z;LstKcfd5h6xshS4oB<)>%DT>>84bn#%iN@ByZ)<9S>}l%{p_-=_69IY?@>_#ey+297+dCF=9- z6jI0j>Z-xcR|`(;V{26bTYrl&7B!&*44IZ@dMY89;T6lE4GtH%RS^38XkKPXMzC3b zLFxn>rrr}r9Tt7G5zU@3D&RV2{|*4nu$GYNoC|!;x0MV;i94hyg zhw`b~3$voF$BzYy<5JGarv^!3UYKfc>+Q2{-ZS$l2B$$8hLT0fvpbD#o)1$Q{V-7@ zGsnUXL7FAzwD~rC%UGCUUnOAKg+`2|*GQC{FD&dGPex?Ftjg@A8!rbGzP(hCxloj` z{}!Qcz!sD>Uo9|b3$3jdiH}BJ-<`ddYi9hVyc^Rf#|*Z`I0PAyHDmTDDLyYn4ZEy% z3cLe{!hs|c9QRw}(n2381QOMUxxs0ng5%T+IKO?{xq>AGPCRJ1SwbnHrczKDvq%2?iI=9S8}Oey5EI<%4))Zt}OXn#JwI2_=MpP8Cvdu%|Ac< z!5R!Ic~K~R{Rc@9v8k&Kl9xdyrpz%05<+;|00oe;-knpE@3<_4^9qFiIg>A#V5~iD z?mXdfO`BKgzg*}`ki!GN>ldeIKs4zK3I1&c%4f9|V=K;;z=oeR`KRh`Y`%Tz?aH#e!~O8chMtNZKxEr4e46ayzNU2W7hT2H@`E zQWGH{IC=o%|Nl>hNcA{q*FBYwfALAl~tx@0r z%fE@bcep!NcdT?Sp0ptSm)iT-jYtSQ6xXx((4Po* zZ=;FYnICl6rVQBs{Wqz4{pZk|X|On6ayq!P-~4aBe;;^j@h_%*o0Mz_T{0K;5p9CYfIlq11MQ;$q zYl89%c=!lrkJsY?w(!4+zTtnwpT6JH{_il8lKhl?>pI^bITzv(MD%JSm7@b{f><>O#ZUL?1-nl}Y;2S!|ctHYeQ2>o9dkphqj zOtVk-8ZPbfmuS0OM z|C?*W=f{YTfP{*R5dTelPYGa8L4I2&>M{=2xNE{o`eC?!b0hi|dKmNfycMRI_cT5X zzc?>iqsW((f}2MZ*jqg(qH!?ai{hqJ?v#JmHz|>z1{1C6Nj`{9{w)Dm;@2MkJ&{Ma z3ulhw(pw8jN!Rzc4l~k#%|2};$N?B+Vbt+lIn-< z;(h?BVoXgP_?tEE>wTOcJju(zeTLliZf%qf0Kc8^|Ngg|`RhYf?l${?chg*=;ERYq zZjI%+bRnq1QJ+FTU(DXf9U|1lI^_2GE~{@nwetyXNLFKcr7!Y)d~+M8k@C>pg4?aF zykPS;NN(1a9T6Wuo!J-n{?!2&Pvic4^#LvRc2?*3JA)s8`ee2JQ)t?b<=-bpA3OoO z!hi5Ba9$#%0jZVXcPU<9CNn-aw;6RwMl$Y`o-Mx2Ax6>8s~|| z#sctZ+DP&e^K8OybdVlSX}LuK8NAdxXb8wj)w~ix2nP!7R{<=4l_nF6^{SxC?gDMH zDR^{to`LS~AO*f+01a{hoiw|ZJJGxQ?-~Mj_e6#npQx0p5}^LhO;X(XaNmS&|4v?? z&`_B;@@>Z&&WpJL@`P}`)w?N(bA)F@ynkGjnwViNfm4`ur?6#yF_$K^_Qhmrnsp9% z^!5!-vUc?7k}f(767emH_+M>7{{Y7Y19I+!J!0vM8Noks$Qm)#Sg>2LS|DuH@e1*4 z6vO{bzr=zj`dxo8-h@57^ysQT#~yx6qPYK~qZZBI{nvclW{L5xKfUDjk7keR^i%7e zXx_!HF?i{S@}!(yeyJlyxpZY1o0rwApKfQbV6TA9a;(fs$TB}yrl)YE*BIcBPtn6o z7NWg}mmo`Lf@(422p|D&YPT;`%e_R_P9rmYJz$xF#G0vixAED57HOO3&8p)N?4+_5 zg=_{Gl)49BcV8$&AZjyl;4xwNk#S%>HuhgNZqpV|QnR@Kb_O@GMxR_P1a6m@U5L)7 zr|aHdjJ4ZKiyJOcSFDos#pS1PMM0kO^xy`h&g}Y}2+17ctUe4T z5(wt7Owc7v0ImHX3k=Of^vyikt@)nobG;;t$srD4lnNLmA4Kqu>Y9_gg6UFXxbuz)zk&CHJoLjg)FplqFPztiUV+7yz5)7QJe zEm`tV!RKSf;;)l{2TVc*DXcG7^x0ORO_iFtpHQ2Cs?Zy+{IhVG#t{VijxplY@U(%@ z9o&qJjb!UP9*|ni$18@ss(t|Tr&1Uh6UlZ0w;U&fsyFD$a)Is_me}86mcdK8=sJ^p zb9wt4Q@UqUTDZ9A;ZFCo z=xlCw_;xU?GUJJ@S=_dZ;01^F_dOgdzgGsW6~gYe8}c|EmB5={{YG3b`Pdinx=NgH z$~vr_hu?8EcXMM^d-DcR0K0EP86zXjtM^McTSheKcJmYlH8#Gy@Z0!f_`;+Lo!Grx zXNWhRW>+s*B4ldj8aeqYqFV*^jiq{jNTHz$g`H|J=J5yR%8^VtlBzq+57Ebfx)tyl z#&|LX!G4U?TG`$Z)WFHG3mBQe*!N~GL}%HqyH*Ei4(Il)D)&PVE)OnmE;qYN<8iuo z8nQWDA5PTRb5~>WIASs(5Sp;G-d>U}Lc8k2y?k#D=Y8yYD;S+M_pN5JgO*ir$@T1E z>ofuI2^{C7Tn|1Stfjkh^O#Oq>-upUmm>m;^mmtwNlRQy4oi1<>-DciXlS&URrhk7 zok`7X)Ev)vzz#CzuR;1g=0o>}HdPQut88}fY#-BviWi(S3!tZMgQT;zV-KhLVQ%|?phlNGp8zzIPaZxE!LdKveJOV z(_SchoG#j8G2Xnm00Mcnkjp)F19pZ$(2BQ8Oin1UQ|q_cD;1NUjuvT~WbZ0**>;)T zIn59Y%x?BfLt4cIYGZ3L<5={KY}(jBmYRLS{MF)-_}*qgI)lmTA zP4^BLGCBGV)>N{29li`js+$|ff2oA_Fq`Qd7s~d}IrHDtIBTG21Un(hj~kGts!lRs ze5SWNydzO*_a^zqJmQ;?R4vKoLsmo*BD-!fUpB%R)| zLq6%;uX&*X|1@RjZ8`g*HcV#Sz<4!9cSO^&U7x+Q!~dpc@ej_)?!_W8hF-2sC1dca zE~Rm!*s6ZLqQ!Kog-*^+at(IZlkLu#Neax%{7aBmn%i^B^Yep)=`%YVP_vyy0;~A% z19c`_28w6TbloqtZtNwE3`D9Y(v%9?)SLzHh_q(!=5p_LACira(Xxe_m_NErE_nTR zm7G{Xw+4(G(F14Q$pdGTluyBBYdeKq zi&_CN_aeI*?)B$SQXc1>Zx960d3uB~tP?^K@dnx%tG8EJW~R^Dcg0;KN_0>*^@PP* zUy5NhvTAJU%*<0=vcpt1$*1*DPFD3KCM1FLmW1C=0m1j%u5CT z^si(GH&$i48oQQw8CD-6VW`7xYMS-MtM*nd{mZ@WRf2n4-7Ys#&IJ{Qumtnnnsoix z__O9lrda6tO9GiNV(|9bRwjg@J*=Hce>J-2cDUhUxB|KDN#2mFowg13oBob-s!@?j z!J58<0u!BYKHt=4r2$)f+C$fEYvekYK-Fl+_Ikr}<5FkJGBP>jOo_JZIa2U!hS)SH z!3^pc_Hf+RQE;kjak?Je3}<>c@1yNMHneEO&nFa5*4oR#k*|RgqQW-VLr?ZOt#&rY z%3Ebw#<$9KQ0x5xNUY$AV7wW`O@IsOebyGl=ISz?i#i^dpP%82>AgceVYq=RyMD`m zqhytdyJm_CW@gXt+OOG|b~M1@jBVxKuS5?P@4<6J4f9wSi!vRmJDk5cNh5f3d4-As zt#x`AI=x0Hq@ie=)o=zJggbqA&zPe{Wc5PF2Jw;Ez z?p#H%V1Ezn%;nW^R4eV`V36S|5Kx&jpBQ$g5qhO|0<~LHJ>^53CU>$0k-IMH;4SuW zkL`1nqKY%I&L>m$W;Hck$Ba_z+UL>cYFW8|x)Eu*^4JNnMU)Ec)au^#`F(j+u3L2B zD`{v`goS_*V@2nzMQ~LdadJcXN3%8|^Ix%gZE7u{F0mxQrWfYceF*mxb%gR()Fv$C z1zAUiP3UepDnIW^r?HAuYCgUUxmToU#fuOWN`nbWJk7dylQ6RR{*(6{Ma|21pZUr|53z15f z@7Jz8re~7+k;(lAF1)-vJW>9ki~>A7aa}ERw6roZfkCZT=_3j&Z_aB%VVl zqh_3<(kS+F#SL3BwQ_cVa6#&_hHtgS|JWwY1IAgM<1P**b*h9Cd#poJ$RN8KP2aY%C_Jrv%Bi( z8lh|WGVgUzwZ2IgEpqBBS0K~-f?sb8iSfnJK@zjKhb&2~8nwRB4oogMS-!uT=nBo` z!s;7Gk>`L#maF(u8~L|tJY$f#4lx`USR1u!TY`)DkR`vUsxF1rcznyCJPwjZJG=_W zl2d67-7rx7!|+e$$83J1U#Y>*P63ZcYL|`XDb6b2SF05<6AX58hMsErVHykXx@ol! zA5bGn$(R{c98SSoBA1cq$ zLUh+sL7Eccysc?Luc+i1MLc@DRt4F^~Z$io{dM}AU+}1Iem+LS& zd`nS-yzf-lZ|Xcu-~j7FJR}#S63JwI^sthZRpS=7%59KA2X%(7( zY`U5I#}uH0nqY(VX!3}XJ}M&3$T{aAhx~$Z`ns&3xR9X*- z@U=je-|@xqheC7%69w7A8z+0m!;eaKv|L+Q?K>R}Rujs0zJ_RT>h>z7pcbv)8egvX zP%9F^CO@vrG9y;I6*>QkNl8n)tOtSbwHb}SPF-TiYHWvydtsVo<5I%=ILfP;d1095 z?G=coz_Cr?SGs&7Sgr{j#}fxL*61?WmN_rWixA?0MkZ^ucP;s>%bdIoXuO*>@Bm5Yb6{za&9w6zYhQkUBllRZ z*25D5S;vme-tJ}LllVa1(yfvIO5(#l?cYM(Cn}A8AOYglcV4TyWw&+Dd59zWmnm!@ z=1hHXl{-K`5%|MkW@4>B%VASJW!h9fEk)hMa8wb4Hm;mjm8Xtmt}1waI1N*h7K)dn z=&-FLfoQ%s_R&4olPrgBbDd{@Yu>?ohE+bazH*-j=oaieUPaidmWw}wD^!KdiV3_v zArW(0o+YSq4es}q^Yp9Q*t3HVMKnr`iJf(ziw_BlyI+?V!BPm5s$ZFro6*{2XX6&8 zM9feS!knFW$bBLU&)t-{l4qI#Qjh>GQ!H|oD@7>tQ+!|@2yu0(eQxFw1Kis_ibHEu z@%j|w#LWf5xyuEawW`8zV1lp#ouel zjYF%2!>4($WFV%GF=5RKrvlBZwurh6J5=hYCq~Kcw6F_K>CgC?8Lfa~Z&Bi|1ZfC6M7mHXlT!(0eL(7XAXrz-SW(76R z4$k?bzVOR_aLz44Li+FzcTmZj{QlV>FcrI26+W4_3Lm0zG9J`q{O(Jw=cc5Kq^b%Y2 z(+@69lE#4mgd+A##ggt>?r0EeLPRY1YDAQgN;o5-FUI{*ZROHNwA5(Fs(qnt- zyzhmFS}N`nmZJ#aJi8udQ;DjiAXD9V418H(W&Cc-W1^*qTsV~05Ol+MZn+=I*L;WV zr^BLlv~V5`i&ufDfj3SC8G8+ymHbm#QmeFRtZ=F-e{G)Na<&UQ%P)RzBIa6f_L$0; zY$iEgrQwWYp^t>1f9#LNq{$*{Jduhu71wJe))7h(JM)S;zADu<#K&LmEAZ*Z!#I}E zj`}nh_*#_1mR)Say}*iMEo53uLeiI&qebel7VHuQXa_Jiu3nS!Ye7!EI!NP>8Z z+!$n;m8n|zL{aDL-Yf_d4l~fTux&JwVXt>yF1I}ndG-s&k}*z#@0JHPYWm4pdQ-P~ z+Pc&x_O7R`7apV?$GGI?eOrUxUJ0s4CKTLtSM|zMyaZoEVswLG8a)balFc^0sBauZ z3*<1sV#s$yfTB&(G54sBeoAA>NUrwer+c314(gWGIbDS$PM&?*x(CfEr+v4N?%2Nr zs-P=piM+dE@XGuWr0NTKTW(fp6)^}sO=8lUV`^2@5TI}Ylsya4f;_%uwtBkBxCIFM zO{gbD(&)sVmwaiP46Lv;oZ)@;h0em*set(C&n@_i?{+se1q^8<>B=hn%H}IQ+?A4q zlikg(wte|V&X3=xAG`uXZ|-VVi;$PgNH)5b1kAB(xY=&nytAwu zZs`pWX-)WPX`1H7Z>@=vnZ3kNu$aR|V07PN?VqoRl@@1Psw zylSe$JA@U<7F8lB%#p7GOW=|fT}G#?=wNx)yNYI{uIG!aGzt?917NAc6(XANWaz@P zndye)TG`%pfl!0n>pkvlvk|#EwcXgmn_$mVj=e_Sy}tM$S!;Bbuif33@!Sx%ymp01 z*pHPDW|gVf7p^2gb{dz#>*mRVo~W1cE|^g@3;-?Zs7r0lf=rpM%?gJKCaUa7AN*93 zmVGs5C*IeSgj`oaiaRxyIaOhj*WA?QnkR}@<$%4dm~T?=^8W1PwVbW$vFXvH#Q4Eh zu3(b69&bT>U@zDmj$KA>Hy>NdjUZ2~)P^{nX$`@`wxTewLo7>acGaYlR>AHcW*mX( zY1f%QJM&|TF4QQ!WqMZq*Ui+TCgGzc?1oj3z7-RC`3f^!JO4vrx= z&eLbxKmKZPHY5O`PiK1W?25Z>_)FqK89}a6v1ss?UsEZ?C}Ci2t7>bhBJs?X+O0)1 z&gJ>Rcp{fE%`~<956~+v^2Q;{z?w}sZB5InFij9zJb^%<6MFK*_f5E|RrZe{H?&p$ zaMnKYQL(2{2B!8AnH3VxL>JrokPGK(nAGOO%`p#wA9N}OaqC`7X1iV6O|g;TRC~$| zIeM&dpIb;ri+jjOt_?qN6ujePRZmKg?%nmdhOaEE<#nfHmwP>-8*h*m!h8hlR3#Ee zqqLnzX2>-S`MoC;*8v}+pau%(Lgf5EuAV!P%I|#*5k)>_L@0!8nb{GFjLP1!*R{#K zDp8q{JuVG8GoJJ8=Q-!7myFLI`gn7g&s{Rq z)>J2P9cP`koYOd#^wPdWZ53kU-TXcGM?N^ls|#|QnhH{y5cwM7w8MilbkBS|N%WH_ z(L^PA6q`1o#}J0JxMjdXb`u)JAi4qB_t8+smxj4OGO*m+YP%ylQb z#!CtWHGNDD!dpcy0KImt+c{tB8jkhz3JulUuEXC(bp2kQ8Guy}mD3VtgIP_oPH1dJ zm(@76?D+veOF$1omOQIpzXtKV@x}o5M$W?D00vr$SEg#pgrEp3=%!b_#r_?sW6^V9 zl2KTTJ3Q+=gJXa~Ikz6V>lGd2NpzNk*knwvPF4XVs2&ocCC2o0WP|TXNCPwueKhFE zyl`zEEF4bFb2Re+>sfeS6{)w*7RYbGnRgZc568!Qc^G3tjhDVrRdsMh>)~|CzRs3w z1G)o_kJ^nU;QR$8=_3I=PgHRPyqzBgL!kW+=b$9Pif0-0jAI=^@aK#)Ox3)zzatiy ze?if}-v5Pp$~wJ!2=joWhRNu|7S_|yKjw`O>1i|+^Hf9dZyenK_us69f4d_iA(ZkK z!Kt}P9SuyVlk)mMf%QWTdw4s-A|W@%f)PY={x)`ydxx1SDq1g$s^x6HeJga_Q-k4g zT=olboEkuAe_HVIZuK`Yn%EtWAzIThEHC6*W!5oK4o<1t*s*gGg=i0cq=gYJ5Oj7@ z=0J^v4!@+F$5AY-34rBz}na$NhCjR7DU^b$CD8Hy660 z;c2vHM6xl;f}IJOV~! z%QFm#QEfzjcY0wYWZZuar-lc!0sW+0suTGroEs{f8SG&uG=iWpJ*pa1Sxl`3d=ST{ zf%+sG39260=&_elv{aGjNW#ShsA=L91lnGeiJS0)>kR%b;XdksY)U~n23lq+Eu*`xzx(Gq)#Awwhn#cao*f@P09H8$4 zX8OAvFtzG-_-(sK>ku#O?0NQ%Y}t{v-1dcXQ;%H|kZQxhiTI~(I$NM{$K`#4RnRy} z{(i)WoAU^-02G|d?W6S!<&Il&NVf$@Q{f0}@xJt84iVz1*9_9q;lj38je7iJuu?(k1?jN8iMT}Tx z0A31s%_+rD5UD!YJ_9Lq8Zp=&Yq-+FJmN4PYyDl)O93qK&UDao7G_81NvW|*3qyee z(r{{q{;3$k0>^Y>#ek)EF1C!{gU39l!6%sHuR8cRD+; zUHbR1tv~+#)+^`aTl>FA)VA|yfDL~K$kp9=(w;VmVEt)NLJ#(5EPo-09s%Oll>PBlH|z$%=Iti!N(dWAOAjK@?;ii z-Cs{8Cj8IDA~;l=RWSp*jzvJ6Sf}KZ)c}6eQzoOFN~r3f+K7weB8R0aAO77xh@kiv zd|k$WK)(#aIe)+huD3Nh8F#`z;|}u5I$03%zZ2B>F7{_Ugnw75s95Qw@7;e=*8+z8 zPiEr*ZY=oIkB{`S)JZ>87;o}Psk!T-c>;^vzthP}(^Wf}xA5P7*sRF^^b`Dd=&b|N zf13PD6g4a*f12d{JMp|Mn?Frz|7|kMlIl;Bf4Krq=77wfCV{SgI!Ynyf)k+Y{RNSM zDh7pg#CO$G>a;I+t6|p3*BvHKLZ~#yV8JkiDPG>O3mmavwct~)RN2lw!OTp`}g^64H(9L~y zfg{Bz8^VC17^g75RHY7ne%nqOn9a5=h5qA`pO!?yWGFTPuU#{@kAtBp;arJso>=6&AKT z4`pnXGAneyp@BLeU)Ywiwn9?X$B-I^*BL*5akSZ(pbF^|sv`FC6h#$mp?{jpH5vx& zb{AE~>P>xHYHhC=+}+26ZhO4pLym~}dl;zw!HDI2hKt9mv}n&4o9o+m1)sU_izQs6 zd+eOLEdQR9-N6r$?$Vu&EJ)*MxV&4I)O(mJeZY&D8hdO!-gXuqb*#kM z%@u>|*d4%?sN=iUJh*+ZZ=x*F&KMQ)Xp;E`1Kz~dwS$~>D&k}Hy=f1G@FC)O-NW$X z;gJcxfZw$HkH$AdTd_woZC{6saII|4bOj}72vEMwTV)#*Qv<(D2x^$9MgN_VAku< zy%4Iar-xf@_Hu;R_z_w4{>nIsnCte!daB-@> z^5ti9G`Mh*c?=b)5q7WDg=vOZtGC;(K%MHMWPbLtFg6yWFQW+=`?Ftf!3qZ~#p>0z zCM&Avl>Dc;{2FsFPP+u1asUb08`QLKXpcV75+Jq-kENK&=L1_Q;hI93;U3hr32z#6 zGNAsNJHxGw-$NTR?WP}jYE!^cZ^0|QNVO;(ZjytWcwQpby(X$StA#5Miq+c#iB4<{ zfSx{R7tgi5!5tKG&0qZZwfGgq)%a*`2{WDEGKG|5)8i1y|6~n6-tc=OQpVlZ!1N}g zthNm2(l=MnxzaZw&`BfH2mV;T>C{$*LUJe#&{9*!UauLexYW}jH{Ov`KYiEEgS3WP z6u2z6xK`&kxjSL!aL~vPwnuh*zx>4wWSp?_MZ*6};kX;D+;NV$onS`;8E4OIm5j9ZOBzSc-oF1>N}Lsrh=@_fQ0`fWO4rlU3)33I)p&`s6ZS+G2~ zqxoh8Wm`c@Q@Qi2;e`)c`(;C@!m%jfKu5;3UNBszP}k2{s_Bir(X|HLBqR|L5eF3g z$yy&q#GzF9hjtB2s1$;zX&4PX^}NTwy#!8ob+wP&#vA2}D<;3p$-c9T(cw>><)Xmz zr;D%BN;LhWC)Zrg4`0*ZW>31BnYknf?9snYmsiUV@A> zy87vQ*^Q>(bnXMyloKmPbG}DT4UHipjWuIa+Pj}nlh04fspF9Q7`EOO-t@wXM!RR$ zWmUnbNT}l*0(kf%%XeTH%fQ=kG6^o@d{a-d*gClVw*?MswOaz2G4UB7u@0w#=~QYd z(LB?b?NR0`Ss?BgWi3dv(7 zYpFfPcNH1Qr<9%D`yY9N`lDE}>6d0>GVs$F+wOsCK%ZPMip)b@aaL;qGeGySMO;{rP`4}`8xhK4h9e|VBB+;>(PlI0d8 z-Jl=)nDJ4smqo0W1E}DEwUa4c6%drDlG?Y{mOWx7o>5cCTr4K%&kRLvZ@3BGtMqa& z&3cZ3>@XI3m!7Ed4L`?m^{&#m4(zh*%&>~55(2>6(qP_cy=ezJjEsn{)i;swC*Gmhbc=oXK7GM5Tg74++B zRAV-ibkTnPp5qO}a%5ihdIdSZ6lDm$Ra%%fc~g5qTNr3y;N0otC1Aa{&zFERQMKNN zV5Z@{MP!wWRmixz!~Vz*b7RczljV~fN-!~lCg4D{@q5lJAf9ko6!lacW75uR;@y_v zN&b9_nm);_gi{=pZ8lU*x_iq93{?cvWJ+yHKYKvGK18i;uk^46xnBwkueJc&Q}$B9 zmB}T)$SF<}3pICW5r=|b0&3>(nyZCiH*c_ zuvG^)>ERftW9NVCEumNrOQ<$^S9?e%!Ja8$HO$V%-Ftt4V(KXr1oCm>{^EzUwHq|Q z+@=@(sNO{P&Bz9`;}Y1P!N%zU>m{|&QMXw84y0Wvrv}VnmOE=lUmqlVt-I+%%4!$XcpB86J5J2 zLX{&`RM;9iN-)~7TH%pZ0ZLW>VCKH+4pJ@vv_P5v z*xlV7agINEFm=VjR`WJH1^`&T=+v<>TDQI)RJgwP?K8+KC7EP1t7r|hZ0pZrul%sQ z+sgpgoZ^?)uH3i(PtS8afK2RvIE&Do28!y1IK(~A31Y-GMOeJvSjW$8mK$-!um&A9 zI}d5$BG z2iL(#?EST$WkYggB2~U*7wm?QQ{9U@^8Cb!{uWi6FjX;OM0-p|2vWWcLa@l5;NmbR zcvz3vemxO&Je;ee)}s5M?;T=&w&HL_=@=p?E=;`UwpPK8VWOfRPW^Eb{UR^W8z5_I zb@cN1Ruzn(u~GK*9!eZJD2}gxv`K4)$<+41-UmM5SC%ue(4CsUjJrBgbye&jKg93# zYr{k3d0OcH%=%7lRgMYR3Mp$cXx-HIHu3M=*dNJs=D^}_ydfV$=PZ;7zD1ySauFnn zB4WLm9$c1d*f5I>3fVQ}Qu~Ofa3KMl`;p{Brq>!2si_$1>mm)xfs^4uquCqWmO+;wOQ^H3pBTOP0L1S(U-=i*9FmV4dLVe;ha3H;*DkF*nb!o;U zPwN&IEH)E~t1~x=DX0V4q<^>jdqXAokD>&Gn(OUV&x|VDUuV@zT@~eZKiu1x*L#7Q z0cwC8BN@Bu{~HKlPeUx&Q@v$6Rhaiud3A75)4}%W3$rKa-l^Ywnq2Gvi%)*(Id>r& z)zW^4j$uo!AjT${J_N}8$!JUmTPqvj0{_gAx%*m+f?N(cZ5&Kdvwq|X*`=utVEW*# z$+6u675_R7LeUFQJaF8)Vzc3*3C_l2 zCY(j*cDB)SMSV`DE;V>x1-TGsnGS{MRhLm@!hl1&vm_G~OD0}k+VYRi8ADrq=| z2Jo;n5L2*NY;u370OTT&I*_M_Y47UILe4wPkvfDkz&Daqb}(~u!E*3uZN`t;ZZbF_>xPCBzd~G%k`zUI~OR1Rwx?je+A1|rv*y(_n z`*W_+EX&mv!;u)a*5`wT&jTYd!~E+ktGlW_MoTzFMm?m~q}yb2Qvk5iVg?NEV0~3J zI;zei8r+bWn;>CnR`MGlN3(7iuA^-r=NO3p%|p}!bFd0dOV1m-Ob8Pxl8LV~)1&?A z*6-lVKbnndadr|_EjYx^LO*I!z9JFmH>ikCQKK5N^}8aMK~m-^Bw`A(w5Qq{>0a#>L~GJ z%N4Y3_3p0*8z!)w%qNFs*UWQ2FYfQ`!WevE`;7<+Ml*6lkr<~{bYrOaHy!Gf1Xz@! z47kCPI3xrXL>VMQ37~=_408RzA5f_ISYx+qJ;tc@P>cPwgWZMghykA4XNFEBcJCee ze(n0*?G4QrE9=GUlc=#&Ztzjwvs1$FGJJHGV0?FFoXmT!8+I{-RAZkAb#9Bu`$I2 zmwikYKlvqmYXa$wa=c~AU3q+t(-N~saQVS=GVli!3FIgO%6V8r>d*yi6b zkZdgXY~K9?7z3+GO8=)!u8OsI;@jW2D1$ECd#&#^Q@p-LwY@>BjD>lh-8SHUV(yoUhps2ORIjLBdYisFvF zD4KM-Z#_$??Q#W_M{yBwhZ;4kj9mfN>0$$boCK@I|8SYscclGN0UNCH-P;XCg=~cn z09XuUv1p<5>=!@(2oZZ?VOZT%-4#Z%-v9(#fPTXdrze1LB$!aq%A)=^9XWNI^OoPM zB~Eezc^M})M#z2(Renq-gulsf{{9@#;?NG(ssGW6V5;wpivVTA=%OzGq>s!ga;)oE zyH%{-<>0FNYNF}&Th4;*d_FnOa;j}BY^OY@jGbSHlkitx5Fu%4RAkCvyTv^Vum)X^ z2DfQPv5Ngp@^FEDK39)u$}(T;pb^k zlv+QO^fD;j6RKY_DYa5)2><>Ztbq?28{3_EKQUN-6LM6rw|9kKnceknI`MR{481%+ zza+xDg-OJxqe~j1yFc<}GXIwK&CobgiyJ{HocHoW!NAH}qVAwh-SIxj0k@-o3qcdV z^hFg*Xhn%KWJvk9af?BR$Ws*txEUtzLZPZABa>YvPa(ZaY{p@P(~Ql>W@~yr(=1Ds z8?cTyam*8pXLx<(9|!8_he`i;ey|DspZq(Sv534RT6-XyS>6JmNKu>p!vB- zvL@;e)-+8vX-^@pxe|~&GwCx9gKq(tBmz#sBvFzT3K`F{QR5O=+0X>Zl}=HuIfj^> zpf;yUlg~ts>%)>YbX6(xa{n%Qi-N~v(U&8!!xa@3vJ@bj3CA3hZu7f@X50FdBq~GF zJ3Ajeg)$2~gI81(J!0*qdB#C?A0P$)?&_LN&daASPCr;T^J1Oo8|o8?*Upq&eH%D; z`_V2;2ZerS?F!dfTwPTB*bI2FPx2{_*VsMH*vj{+gIn}E;QiOL!WpXV%KpUx9={*I zx(cBOJO_uJcU~f=br}37VgFGs#}OzrLEhPlKc$M!rAH3y+m#}%h%~Z)({7j6X|$V5 zXD8cRd&%Al%F%1TlqmmNA>`V=Ax z>J!XHRtRK=E`^kWnq1(dUO?iY+|(WaWgWInn@Iie>qu6=;(^=BnX4U``SfA=;=!da zl8~Qs-1K4XnUnn2npQZDizRb#Fr4KQHg=q*pMBFN+XwQqvm~n@$a|b2tT*jYHN64t zB~^sRwd$tn4!gOU_JlqN;2BO)=qY=u(}gAvWz88^DTehBjrO^>`3x&_L|KWIR8$N% z0c5z=^_GO*Ns^>d;g7;8kt27mOgzf6Y^|~?zXK@rI5_QC=F6L+<~;gRttKJ~OvE63 zu?#vi@Kx$PuS+?m9w@PjzkulRS=OhN_qJgZ!d%&jDF*9u*Ts=Xu25Bbd2}Ttc9W5K z*Iyg_K=Jf+5o)^b@J+eRIB0faP?Yc#+7ea~VM8yqW+0#;KRC(ljgH!&m_Mx7Cz5$) zn*y{V^g!L!bp}B%8{Bgp_Y_-jvgz$GqKf+AsV)s3a44~yiTX=LrZy9JB@uw_>`WDW zBHMU+{)rG6MAEsBttJV|cBkm7Y(Ou25Dx5MiPSq0+xLI$tpMlWY5Aw!?x|Lq>rmc%)1jT*VHV#j?L-rVJII)<(rQn5koQLQqV zx>{Iecaz*u=bZ+4MZtLb`Aw(-@stZXU7HgyWT&^QIqlHKrPW;z{SR2`f9dS(yZ|T! zhvGT5{j#SOykB%Us4xQj?1qPq*{Nya)3Cn;ys#ka>$I-2L9d+LSIZA$VPasu%%1=a zCMX+Vf2IAP4ywl@<;~JRe$@5C7n$WX^k<{sprS-{9@(x?-9u`jE5A zk)X_VI=-%3GC?=ef7io5?Fduv-vwxy(K}|2aKiWu{)WbSiHUzjIetiM)BIbG!^ z$P2@fMkjD=2}4tmQPuG5DBp)_igW6HPX$!FQcc&sS!IXh$@g|yjR`-$Hh z4k`&XHk`_@*z@Q+y|t9Q{Sz- z+INxqF9cN58NOi1E*twHE}!N0!vyfE%TVXcSFi~l^aV;%QaQiNZ}c*c^I6}#%lPO&;FTM7iL1>6&L1Y1I%wYNx$U2hAD!7d~RVw5SaJak1!AapsPPi zRO{~nu0Y*}w_&=vx(8o;P8-A2O*-@Mkh`$bd!B1_boBR^Ni8!4ip)1paT@c{|KMEB zl{*n~LdoY&S4;xW?$I+)i9+bK<*t|I6&1fpqX-JEsl?(snh?tqhSag>8kD%Q4;m4T0oySna$hAzjwX_#sk!sq!-(h;V_~ zL?Tz$Y5rL}iQz%RWtZkJcRYv&k5b#BtucOUio7SMNbo+L_tQtG%{L0-=&wo)`U#FU zt;mY*)nTS7#udv~XK>=)hQCoftet3%)VBSwTr?cr;x!yR$T*mH6f}MKIp^nn32(#_ z24>im@G0S)ND}okMldD1m383Z@bh?YLYlwbQQgL%2EEhC;^TA$myEbO-324pt{w-| zcrXX(PAUb1W@oV(c0!Mt&>Jo-fz8de`>v(dQ2RTJ)C~}`|G14YKuSnLyfj?wSfWiE z!C_`R6^co}zzPwL9!2$6$5x_e8+vTORAQHlP`m6_t*MCZcRi@WArLkS4G804#)?v( zTRR=vRN+y5Igc1`2y!^1%sRyx;ijuW>=vzi%@tqA5QiTknyb5axq&>O{x#5@!qlxO z#O1aYZ4;J1n<{b%E?p`Td%Y>avq_KLqAqJISh0k4kt{MaV6s_fpzL=sS?NGSWIo1L^l?VzePNK z1)p(%+pQT5*0J6#rFK0qR2X$V&-;^QyBfgAc;c`^;VzEPD`D58bgp7+gY z9(3_EXMD8^v%eGdI@r=QRbPZh({4~fVGwzS7Nxw17DxTa_5Z?&nfLzu28u~|g`aWI zYYnNsI_w>_@-(x&3LMZdolwfpxRj_3%ko})Gp$}KuD8(o>3vPxhr$#!4#H~3&Q5J> zK9FwS#vh@rPt}Kb0>K)}B?w9Nnow*iu z%8EpP0%j4^XpaK!UF*n1=IWVJ9GV7fEE2;B8HZLiewRd(Zl-=CfDC`gxx_1Dj zjip>|GirYue&^><_>e$VUlaZ>_VSq@k>^{dcxHPDgK76Dj=m-^#oNDl7LxCx=jZ|D zNc8^E-2DA@Be6MA?}11b)7u2TPOEo~sa|TAwlx;kc$h9R)+Fv|X|BBGV>-z0L#Ioet`BYp8FcLm7D5>lZtcrYO|nVINuhfD?WExPl^E4ggfYH=N~@i%I~ zupq#tcrZw_M{vy#O?~07|4}x}`-age^X#OB zFdT2}3=aueJ9JbIHuro+Qmee+Q}DH;PmvmC$wLH%qgYa{S^CNm2xC)S!{#DB#|~*G^$ge%>Z?Gph@jVCtz)c%+g@7m ze#};Ijxg7tb`dLt#O0{LP261T_7MJDqkB&ix61^wqm6G}<0GFyu8W#D@l-{9C$zFm znJJ@a=or2l;0z^yxAD%vCI0bt`$C*jghpL<5bn`Xvd3e{8>G> zR=0?1gDv=vCf5&p%K^@eYewmsF#RXg>Vk1DeWRn>J@mZ8fm{$@-YxvH zlpTevdbb^g!rJ{Gsjn~3kXeAs*UWill~m977VpZDe5|xiVpqUbVV4fbC zHb&O_3g$gY+>FsJgma+=;VUGJv3HFe3Xn&%j~f(jXcxxL!ldq|GR)CB_lAbp76~_$ zB5DkMKdG~8$BFFh6-I2#Q-ua|IiG*KJG6FAbPd`co9kM8-Jc1`p)*nx>a3$xMS8!~ z-D_Xl@!&FUHHMMLjAtn(>TIKo>%->wD@ItPHFBzN$>yfzPsyz}5C4xm7W2@le<9z7kVkQ@p44 zr9%RMN98x0Jt(@vk_>&Zn8?@PJRet7Tr#$k4O~1xbTWh-J=Zj`S*psl6eivq@W0z1 zZpny?#vJC%?S4nM3TWmo?mrIPc(=3hDtwk0<;-+Yx#pR@ zyHzK;m4wuJd(}hC{qTq{CkHtER4?6ISVHldYdPsPx8P*O(VN}96!_e9s2mNF#vV> z-Gi>LuFiout1&=fBk%*grYUf zb=O(pdS|-qT3k8%D_0Vtz&tChn(P=l1|8N=vim7e#CA&i*)p#k(LTDGZNRon{o?6* zm_xM@M}V@fp?B52SOOOz=tX|mBPo}5+E%O0s62e`b>7TOT8;Mpy zj?k4XBoFs$CxLOFklSq*iPWk!L7Cx+FH!FO3DsVDnXsv{G#aYnS@RL{MoH0c8`UuV z;#tY~hns*2HR%vf4ZPKE>yAFwbi66n>hAA$W|K?uj|C%BT%;P3|rh!_#n*EK1{3> zR}G78%*+zqzVAuK&@~e(`IBi}b^+ z2*VMrTN77o0^oO}uRLvQ&xLJ_w&*Baz28{Lp)RKL04mMJCa)43m^3cYkm=6$J^!OK z+jmcN1))+C)TZLatm*xJbE)%(&vj8i(__5_cc0bOGRXS?zY!8p9T@7VHvYiCm5Yuc zuD5UA-xg{z;nTmX!Bf52Y->zoCVRXlg|~fA;|revYpB=&;Nw?~f{ouzafGa0mA>|J zW^74u+c9uX0tH9hqimF1reEvK)gbQNALzeONz-uS?cB6ikl>J=asz>;KPM8V|zy_q_pU{;1%G}CfpvI1tEmcT7rps3QkgnB@d;Qno6 zEl0R_U)k1qOUseBE!ykh=*oMygkqY8xg~?Xx)+Ll$WM#C=WsT$G1Q{3;~X71-Yzwb zVm)0}vR$m~@swu@Om!NnSR`pRd+q6eMXQtcrZH+{UY5F@>2Cb_W#$;2XM}3L?YISM z`oNp6t4I61_a{ny*35}MN6!b*cXE^L0@c;{7DkcY2wZEQPiL)tjk>dR^C4YPp1Hw4 zg0@zhMrcSMZ)Ffsu6;%hsfm6|`Y?5{#u*cHy)7W4BB)~qe@2EjHJvm^0URL20+ZFo z8zv_44%y*W=xe5y)^W6Yvp2;ME>mx19JHf{@-ooK5v`h&@y(!$`K$@Uonj2mM(q^L zI{SL(3ZcsVs>!8y4tS-!c5spk1AhX;5mO|D--jxx$UY`CmX4V7Cj>r302u zcOjGdQllgfGf90RU$f-G#rONF;Hylp{45-Wtd3Xafr-pN<2?0q?cBW%OI#8JI)YYU zB-p&}8xLb@@UyIJ5{86+39x6`6<;KHK}Lz|?G9b$C)X?+w<7pZW7LSfv) z+S5WsuEE}{Fos;^n`}92VfDDL`GV%Brw(d)qLPT9tUDVcve10Cd)Bk}<7@(o85I>N z7Q-!kIZ|t~WAx{*-Rjda64B6%`ZNxV9*1Gs^Fi+V ztHK<^qa22boL+}Z5#GVAMY6qPiz2NR2aefX+UGOVvTaod$DWT|@Tk47KYo^zw*|+h9P@IscG%^!Gdj8bshofF)MvM& zZXHYK0(Ts>MSg_+~#J~l47{(OZHm1Yi2D%vwo$| z)@-HM@5rD3G}*U&vnP|&=3$jMD{p@q6FGY)yGV?GbYnI_oHRabwtnfby>@`TxR{7@ zXRMWe;?}LR)m5BN#!=B}swTyHBoLeJ;!jUaw6vwp%WWkNhoF&bPcwy(IXKK#R1v|bp<ty(q*ToFp<~Cxgy7wi}u&X;TI07%u+`ij3KQ?ME&l$ z9*>85eQ_MXu`DN~&{abBo#adwZ?F9O{-v^RV)?4$Q5?InNJM!di`|D@&OjUTiCtuFQ3|p#dW~2Fq;QirH(4!8h$`RN1UliM$MOd9F&Bt%ud{&wfg&ko()CL;VflD+IyTbETPd@a_ziscDXc*zEE zJuMDQ-I8p;7?$PivvU{|W53h(NWHrODoB|V@w{~0MEEr^Zv@sR?xVA=uw003Ykk!? z(@w7A((R+inz=dI>Ak%qx!VprDtXN_Nwno=&3Wm4lxJ$kBFO144VWj{aS2rwIGi6# z-6m+MI{4`q8f|?pahmulg3FYHXvB$;S>kRt`Yo6gc!z~; zZGdbq&ux*w6fdvG8yl%v4v zQN3h>TR4SM{A@%6Gn2}%t}zIr;Fe^%hK)X5Q?e+ln!t}W#dS!f+4*n=*Ma`+hh54i z*Yl}gi;{RB{Bfqtj;`yexMY$tzN>l4^fq6}p|3}d^ap;WO@8mZ+|5jcold5+v(aerbMTP^ zj5}`UD6OQQ!!*IwsbGBjVsp-vt7XNyMWOUg1p?hR&QP&Z?1;Ek=JF$$^aAQ?V@u$m zKLhH<`Zr_iP7x#Xp4chrOV=Px3mO9+$HZidUS`x%nxwAT@WILNu~oY$iMtau_RiF@ zy(P$;EJ`N%EDwlR!9hBCnEvQdS?KDOjJfDwd-r>v!;mj!A6u8PcPj~T?HrYkk3_d# z#KplTmNEOzgk)u@*gw7+Rel8YIV&+J#^W+}42)sQO(Z{3+cE4NILFZC*2tAx(;-lI zIYY^^s$!!z-`Gg1QPYF6rfRV%Thh2qS*_n>ReNNnNt;I9huMd7#y`DxVtTVP-N0vwIc+f-xRl zRQFpJmF{A#{a(lYmMTK4vwZTJs#Y8uhcvXWU$I%l<)(FhuX%z&JGH}xo9DMjTddz& zv)1Wu)~h-Lpt37iKCh%?%r_Qij9^xcd9%Y^txMJ@%qn-%m zbJpILuE6u8zvDEUS@t7w>wq@ilN0ZQQn`~J0V+|9~pk^jCW zbMU8Z_!C^dp~INO&YjBs*o%0<@)*BqGsX$BYQU7e0UJNeH3oE=3JF+Ks8~ZEO%ES$ zPkAe)z3;5)_RvdJD??2ruDz@slt?^{LL~XL%&fZRnhha;rhu^N@&K}G`dcbbX1qcS z_dT9aVc;0&ui%u-)(o*NaR=tsdrzP=g-6KuGboK9JZrvvz~@O2KJF=@s&jv3Xdkmd zDxWB?CcYy%<1j_iLX(CYa@?9!XO@tZ$OXAUXy3d#r(XRLV~sZ_^ow)-LhArO$7Ovz znhSKV9A8)IpzYLp_yl&TOU-Qb42tox;BPU5*-Y<4^W6lKO z^4r~Q@`fOv>F|I^rc&>@>ig=DfSb=Ma2<|4o41c%8`?kG z5GEVZSEtCzO}i-)pIJu45J+YCMOxHrZcn<6?-l~z%+vE}JlxIiqM4P%3Gl&DKq;FH+sZj!bjZ8g48tx4n5 z+{7blYK6Evsbi?rAl>p5iPKf`sePMgbKbw;EG10zIJ*56-?O_Ms)vQN=<=DBkec<2 zW;gVKG>OTB})w7 zPq58z4SX<>n4r$o?q+)r00S=ajtHL&tv%Ar# zsJ0`4`(JL6z0Av+n&`SpWWIl}4b-yXPx@*cy3gP}p0VsDl%pN*SXKh9}7!`*jYx|!*xzP>{?I3jsH`A-&` z51l3;S-Cfzyd;6|xwL!VnWd};Jw}R zv2S^%Izm)22<+@^xM)TTwuN;TSRal;G@S`WG(5;Hu+ z9U8|MT+E`P?Wj#JS&j){Va)q%&+5Mam{uR)eB8A=sOJeMM7Wwl99hIr&xyY4Txs~K zoBnqA-d}vs%%6t0*m?PosEF)&*z)TeO@VRd-iQj7suvUak$`YcO0xiw}JC>Z8o`Ke)(NBB%AWJHrJZ zzFQ2W2?)Jt(OFVG7F@-GUDt?JSMYFYUkv<+ZS@9DsAR4CQy5An* zW2530%+l*s??oaM()is-Y5e$DZPuq{U4r$m)%N3XPT-go6URs&&QLX{zxk2umsYV; zd#LZ--RL5#*%FK`gG8@@$iH0IVK?IKb(RYngW+qOXJa)T>1(Z4uBim<8W;0P<{&Cp@=Gk1S`v3yt!^;Uh=}!< z=%Kqg)sIj>eF^K=8&ZyuBKe|7C2X}i`y3t6S&w0?;xaB&MuwEn^A)`gKc=S-)9DPO zzJJx40M`P8a5!XhjpX)@T0q0wlh~ldkIQwe@iNiO*(_RbGc2DNu5{}kJXqXK&NvVM zt#$PUw$_Klm01k~llp~F<$&+aU;e2?odj@9K*w>IwG$DGIx=k&`+gw&kc2TH)G1as zPI>g;I}b5fuaR!f64mh@%g$q=%{rUjJ`jiL7>PtaB6+gG46`c1dwvFgYB5UuWVuxKs6t5MKm*-F2uI8UJ)$T7vPQABf@N_> znozv!?E$Tq%`o(QzfCXakHjpAg|c@>aRr?iR>OoXefGX&w!!K_#3+8f%-116%L(yY`MEP<9rllbP*Dj`ifbW|o)a}Y z6Z;5jx!oMq9j%+K8ao(8-7S?CWR|q?Vuu==G$Q47Hr);$;SmiR{Q^!1i(BR|f%c#% z+CWjpM5B=iUja5ztBrW^*>DhY`(U*$K>Q=oT)l6IW{qi$kEgbfBqPXY8-$NCRA5zx z`w=ns2gW9+LwS2GSKJ0{4}5!2!^!3L^i~j+9liBE1OqVWU1rY5;Xjup{Y4Q_*$5Y3 zt1SNUiT8U0f3lFEL?$-z;(i1_>eg0p@U@7GQNZV#Gk3}4c2hskS<_pRkKFDpS)~@~ zDm#oiF7cH1mKV8K(TNDeXHMm4Z0gLGh;TO2+=m0ds1*rBS!Jn%AW?>kH&Cm+5M8=SC`sXxXRG;ST#HfAbLneDf z8t;0IP3f$(vT^QurkX!c+4;(?+4v!eLz&^!+bdz%o53}xt~2Dp%zD4Uq^t0Th>-&a z>aAs30kC9ZhIbE}R^iK2fE_Ubte z^Dkq}P&F*by-h48`o#tf^MJ;|ZEEj(@ZN|F>{8d+te}=QXJciiyp8-MED*3wXYluF-s_;~EI{f?_>-KrV;+KUo2GN<&) zT=KN@*sl=3@zNKTW#ZgwtB1qa&!i(N)_r@pjC>X7=3f9mXQs-ftp0mjrcD0rBIeM@16`+Il?8KsR8K)>P5$U0FeY%_X zzM6HUw9i>e*a9&Ut;2(CDA%t*9BG2^k;}*^I*6%zH4Sm4NE&<|aQEJ;gv| zFa}+C_(S!zmiSz+xz!C}`%9Odf&#d+dK-@S4s584XZzf}`8=snG>?l%1TPwnQ6EQZ z4hrv9{Mw9La&K2{?fWt|ZmzmC!BL&+wFZNRp_UrTRBTBOgMS^ScEmin*FYw6#Q8c= z8^_{7`ia2ukqoeOCXonAl8#KH93rw*^}Iwv@!qG2sZ;Fk{>r3T81T3ad~w(IZJyjG zVIJI~uSmTRNOxnWw;S=SkeWoq!dbP9A~j7YMzvT#Qk^7pe=jwaL7v7_$PK7E0-3xN z$rWjD??EO9+QcgD$Ef-0`Zo?0$qlQbWi{ynuSFdNFa9J(-k`Gg++Hn=roBo`1H+^# zxF5Lp_b3~Pa5gYyo}KI9pw)}QZ<5L5wW1C{al$8-Tbgn6`7w?tf%Fo}Mwvh>sHz-2 z7iC0Q0Nt!f+nm;!srfj3>%{GP`ltQD_+hKA1HRKzcq<BL;eb(4M)A`~eFNsQ~U!fk@V`=n^ zrf{c3+vRZM%F7h|o`%Eb|F-CAi|jK?VV_@_tDL)RzrV%{GEatTRZ{VP_80Q^WKuS; zYYk*kiiu9a#5H+z2AhVSB=nOs*nEM~d0w}&gPxfz>#e9(A1(u|Tgah3JJ>P1IPAu3LAAElsI8Qi zqJ!9@tt}FJ6WSVWDQc_Tnu$b>B#70jy+;HIYS-Q~#`mW0Prdd1``tf09*LWKU-P`q zd7kGvXOs^hhOJna0goiM!EjR zk1J?_YS~M8A?SkrvmUN0Fz5o{p0+g7q>CQsfAg~ZtxaBe(X};)1-36jjtC`_2PtFx zwF0%@c;K2@Q+YgGePBhc?=1#p7M~O?@=-qHkwf)~b{|XkGavG-NQUjb$JFX4uEmS! zK8r5h$S1r9L(vP%d)~9WvTUYuYyJu3532AM=%oEc#{REA>=D()pmXb?Pv$P%0^xSXxnQNxhmf~?^WshXvp{I&+CRU zLDO6lblcxE3?#f3SI3C`eR577Elmuu@ zp#B86YzbpQWAPsYZ*xKt)+Gd@5>mPZll5{~lUzHWUOq1D>JYpj?O+SC)8pn~(Drwn zK^ilB$I1aqJ&Ka4(wC^60rg52W`waq@;icly}C(?u?7U+k6pnIvhjf z${X8d#tW`dHbr?oyBR4vi!qg6JDK<_fHJ4*I=HmkAb^{VDBJ4~91B1TatfBOsus-G zxHRwz=82Eco=^J(Xf`UYeWrC|fW6(vSH>8b`KU zR1$Cs^G18!;49k|AVQdIKk&FeTXMq}ped{|gKP2kKf4TeG+c>vMXtIWWg!Q$+;C>z zEu+AJ+|0YisTlcDrnKr|ckc&QP(Vw*DYcP%qeIX~(X~U+!C-^5-B?z!hTC9Jc~nv< zTG8KXHF^Xq-QO+DH}aWncLOl^e6cMQ)|%+kKDRQ1Ej^aHDOeYGdZ?Yrv$fvsZNk>Q zg-~BL29bwKvt_)xI!d~G>4H~2u{3|YYCi;DY(HfH8CW5cTBUAEt&s-h)^}y(7NW}5 zx4{kl%sn>+QC`<1wm3o`otD|7@*T5w!e6FTZ2-8xfB3+QguFT**nF}4{0cbvi80Kh zobpeIAkQfdY13uEt9DBot|qSO|2l88p(H07bE9{+CMTBl>Sv9s*t=Rz#W$S)&szvQ z5h=FxYbj?#(B?j9B0GkiF{dj%z?pjcfC8+PWegOFrHx|rE_WLqiJ9F8M3v=PKhj@b zBJhZIu`iww?z!WauKZOxfiJDt07I^viySXv{v@d-oOk9;=s{E|;HD(Txpuzh?`wN+ za!-0~k6~s==!E>h-=72gXB_@H4OMEfu`$_ZdiTQV%dv?7*qAv_rYPC#Nn+Prh@Tl} zPMv;wfM(q)>b$wnDq#~P0Ax)#8za5xJb^KlmE(^mBPG=P7ARVvrI9dipW{qN4sk)( zzVbWu^aR!cXen?3-mij2AXcZSlEc_X=g!)1pSy4KDQ*cv+-AgBhY24-+7*CMkCo@C zXs)XPRw<_h;HGQ<@PYjNY8 z;*rv=4azo51YGhB{zvN2W+`Bu+{g3Vdtb%?8m|!5srQs11IYts^+iJ+9Rf~{>;x=P zCG={VWdv}JMXG%+uw0%J^tsL==YcgN3KPdl!zgTD>6HY01He+vE0FUmJJiW`vFo?U zcnN|wEYyA;7Nq`&0*e%^03>H%6P7ws7`5?jL%;wv^8Z2o_i6}#{Ct!FZ79X({eF>p z`){X#Zdg4&*9vNg8HVF<2HY3xPyD65)_{0wkm)xl9X)Yium-VEqAP&!ZWSXjeb2cs z9`p_PuIlW}Jiv;lJ(&7Aq}ImWM)Pt?JQDxGVL7K>N|B)b2T7DJhJ{l$bkRXpkz2)% zda@MsJn$g0%{eiGa?dTHNh7APzfLgV3wbts+NhC(SSgz6ZB4i7-92~U%zAo?i&=c? z)?f3reeaGY24LBH0%U2bz=P;0;KQNN49chf2Ic7?U%X!tb*!;n#*H?KZ=38-npD)O4k*w|3(M+k)mCw!w;zc zne(IL=)9W%+99k5ph69efII*IDUBW^ObH;w%gg=k6P4cwfcdVowa~jH#YK@W6k*T+ zuRQ9sP_{?S4h$xX^6&q{qo}Sn0YH;B&k6;Y;|@x;_d5-QZeRQx5+?sTT9qq_s_21M z3xFx;QJAvaCk1dSK~JqH6zx6$&u(bN*`)wZo!@Sgn=Y|KxvU~o{5t^}%+3d?Ppu4z zJ1l5QL{q9Yg~(5F{DELhjT!Z)0d5@+wIP+&kjb44mtc#(nyTN()V5}<234S%zhjsT zq%;)ZwpTv=n@g9Kuv}1NSGkte!j>i}aLV9sM1;sHYh>nZd`L=}f#YIGL-amW$|B)& zSc=R>@fZNYaL#B~z5)jL()vNwZmNikGcuZVYcQ8qbOUpi@n_Q7u2KWh4%+O!12Ee) zDt3?(lBcPza%Y^&P~Y3_Z}RQFO?$xnp|Z93ZZ6K{6h5|( zSe995l#I*8fP(7YIcFNGaNfUGOm^5&KA~BPl47>?6>$gK7U%O0h|GGS``1I~w;km| zEp%CCscN|y2x|z%-v^F$@WCE(4t#dw;Y}44YLirnd86WcTip_OpJOTRUc(JEC8**vqjzf)x*l3dv$Z7Z8xDPbL@VQAhSF2LV%!-GPbml2oM%^4w5{H&`u2&K8*u5!CS zIRM|Hmq`J1jhEkU2+&Zq;j9nCC2LW3Y~rg$f=~)We`g*Dk)Q->s1MbWHfOi${Q2l;_{AD#HKly^)tAEw3AJDmggPpKoYMSyaR{V-rZ}VH8`-HkZvRlKO zCTQcFj0v#xvnsH;zb2=c+te~QihO}{;#Bqk<&0V$`!e3}CYbB+@$y{Ct1BK0QfRtfO*vYzkK&1%O4ikdU8udCci|^KsBYaDko*U z+ak;c`v`c^yc;iMp`EB*S+PL_7w?g!zs&cHeL!*WU2Y;?DZE7O9FCH6nesnUSqYtueTUb`nKU*MM#yoznWd5+ruuN zH07(S6wPoJ2wJ!=BiGMj>eRqssq-TnNq=@@e(15?PSAa__gotD*L` z{^|yz3m-1ke)Mpl(9Mya&LFLpkA#n-$5QJty^bf77Mb%i_O87`p`6 zW^cU_+5u~2tENxJ*>{G%44a7s#yA!ac#b6v$>sf`kvK#4}eicPXKe%#=o?k`ii zC#H~gP7;F2mNqN`+;p6wPu=fMxV!^inF&gB^2^LMH-LT$>4SxYZU&3CA=Q&%HZ_@U zrJE|l2Obq5U9_xo`;~ZNj|{eAo)9eb^5|2rhsPYE0bulNBzx}kQM48JjlJyF(xI0Z zB6c&MJgQYEiQe731akYTFk4ob2UbmaFy2$~l9bINfX-2UH1OB{3bFK=i!uWkkLj{vJU?3{7k&pGLHQ`PW9`O!05eH; zYh7-4bHE;KS3dOksQQ@%kEavh6#LrYh6@{l9M0|NN}$uO>+{4DlY6^dcOxAlUDbV( zPK?8*rrWpxXC=0qVB_4XF5@}W4WR_~(0!>Ty8|j&{BDw{?+=EiJhk%u(k469R@t6+ zrX|Xp_9r=kkY-mb78)Ivaz}JU^s7Rlyued4obQVbvjhl6C1!s<=jNVg)RNcp6kOB5 zc=udJ$WV!L$SufnZ|BW00lR{<)%na$9QpQ|bfw*eSOKHYJ2_sa1#_+o!V>iV)n06W zzB`w&gUfyFck^8pSo^9F32>hr+tGhUEkYBhN8vk^xc7)2ft8;yr5r+{Z-dX-&l%BT zo;^dm3|U_gD_QtIUu~CPvM<1;<;6ey8eyaFwQuON9z}_&gX16_XV5>2*NX1GDPc|& zskHEuRA>;Edv$8rd45Mzd?w+mmlHaR+HF|pyA8|(A~>!F18({1a6mL-TC0(pp`FGh@5mnj$1xv;P`e8$&ZjAf-xxHE~?tp5MR zgrC|oBQeCb?Yq>MGWQ7-Aidds;e}%GwKu`O-g7Nunv*;GvjcQdmo0r3c6~u>Vq`0e z^bUc(0zQvO2F!^^FRoU&_J-)$+WYmM4nJ826U>uP={>JV!_DlzBw=4Y%yrpOLX6Wd zHu2;=i~Ls#RCy7$ZSL4ItNfVGiWXU;wROz_nXUmi90f;RQQz>E`(oI%(yfVq5^M1i zw%ul)RU|=8xTN@%Ew3zlR@9%ageiw7ho@|c(HR8c`Nfi{kAPdvFuR62rqq;x%H}~b z94{Bp{WIC87#F-<^SpOQu{Fl;#Wn0IYJKKG;hP+G+t0=v@L+AwyUJyN21HF#1q&EA z9Ot28Sa@@?Ei(W8v%aO}&>VSNYfxXO$+0g#zVQ?xSoHO*u)RapT`p}VSHCdw;`=dH zT;F?h_Day^<3y42>&6DjB!0QPFAbt`;8?7+=h7OZ@zutm8j} zUi|!}A;_qwEv#ZaxN3C3y$Ov1$wvDS&nTZBWg6IO@iMRJS8`l3pG@w|RQSsCI|p9T z0~fit6_g^wRPqWTY1aU!O@3|3=*Muuakt8HaDv5k&~vCu6chuRT<4#6O(Ndf(4TXO zf^%idM8-@e%ZRr@28^A;b(8k(hPKa?>`k~OcgCo3CpC7R8N6F{oS%x}alkX3#C*eo z_4Lam->bgz(WU%HL7;kV@zsbu{l1bf;F5i7jk7wm`X5O!G4MEV&qO3jV-vKd!ufH> zLB_;Gr%5#1x9=V`zO|Y_hmC%o)t%#$Xf@b*+K)WhT(9zpK?n zGv3hPIw6Z6+qyQeG;3^$8lv8@2#8cre_LQkhgGSF(!K%;BYauXhST#KnbpZ_#At0Vx3sIUk1*WR8=w& z&r$27yT!;p=$4x~U2s>4_Eov`R@KRTL&cW4KwiO!LDJ5G$CTeJ%%M_xHTb)3iZ#`} zf&PA?ne(d$+e~f^gQU9B2aVwm?hNPRCf!u;Kpt5>c?h*`f^erJ3zdxfEE-uR1wWNb zso(vi`T>QQ-kc&4X!sph>xDG~j18ppZ3l!LXNoRl%Xn_~8Z(wbAT7O~jo+SJmb5;@ zkVG=&JSFu>RaXVAaTB@TD#jZxG8_3-QR;3^RCGOmj#{H?R+lyp!ER{&t(3mO^O#Q> zeaM_5Nhq6jwXFTGs`a9=y|HyckGg(RX;Z7&1ATq{&D4RPe>Gpq7^^=prKft3{v(P< z%cFJst~9St%=2q)LiZcoyvLrmO(UPkenU>sf635NdX7~^0sDw$CUIb?#S45zu^hU# zUCz@6r?LnS2b+WXo^K58y4&V$VfQgggHEI7D2QE!g-^?CQs=ikdK=#vO}WsuzU)}k z;5ti*#tkj{V}6f@>Y}vD)UoMfa~xi8OD2Dz)bnP0&Ebt`Bs+`8M2=-M-9UIpy1>Sc zMd9s00k;8{ps72Fa|H_+UB<_lSMjIpa~)6N%m5Cn$e|(zK(9pZt$}9;V9`G1*{Ne2 z`}0|8Zz5&{<=P78dIa~Sd&uMs-@PPo6$sP)6+JDu6#vq z8KQu9b)WYyDk_c)AR$XVsyFi$|Eq_8S$e>`t*)1T52K>)Zo|~MHBJt$g{ARU8@tYN zcwpvW4!%b7c;0ZF8UD@ZI_;OwK)1y-1m)1g!nqv=%dKRub%eG%rhN4$Z+_dHc8bt) zJTu?NaaNv3m))M?l6UqrvVlB`gO2ErC&7&<%!S$1#w2-;8ljpmYRu}628G~OB zX&v_Wp6shs*tcMB1aQXY>HY3oA3Gx0J)V4KUSitQ+t^p9#gs!htOiyomAr;Blk#nl z9&#cxxp`q^ur6M+8`C=M?j4O4x~Qd}yF}Lch4=9F+3_`$C z^c>MOH(pojm4SI>Bketz_KP(Gh|NUEOrL#lxvN` zvJ4_LZaHE=CO+l~Q++*y1Jhpf3Mpr8du?j(XP0O)z8jcF^p_uFbfX=K7g{7w`V5@} zO>I)7i{`ElZRq|=YYPL2_7c_fhD=M&Q1_{n%MPDy*dmECXbrS*9((U0-il|W6^ zS7vmqUBz%~kL4nPr87n@L&$GV2ggV?c|pt6YL#y$erUp(kQTIDwDWv0G6_^q?Mh{L zeLlit4D^J>mG4($F?C|UfI@PAM}?}L)3$M(#;FHlvge_Gts-y0Cz8(uSC5`6-yf}P zkTcvbuQ#onpJQG=hW|v*?3H7A6`QOf^4o`ZXdjo-SXbfr@j@Ac!kQ+?lH5hJf&6>EadOalLqqk{O*!P83tsLEvv2r4lchiqHHRrdohkr-G3f=*j;Of)k%(ZBv(Bm@4j`}7aTAis& z&dyjNI;vMrli~|&xtVYt_rb*gL|i(HknA-3NaDxu7J~e9Qxf|dQ@9jdm-q|z0Q%n* zleJA_UI~@;Ln>72iil0-z|T>0L{Wj~`52jXNGw>})GJpw=pbwh80*h;a>tIH?HJu( zOSB|zH?^6*@jI)PL1G(Plrx|4c|tJc$40=D$=tq}`xW_9c^P&M(l^=UH9J&y24)JYA1+2F)tR z9?q=+kW!KaYCmPm-+_h6m)hVUYaubdysHrORTNQlmuHDa^YA{RqN)RQtCL$JVRG~R znQuzLf)a|!1Iv!KgapD+O?vFp=y&BmB^Df>-hVC#UluMap(UDZte-TWnuh7+yME%+ zL(BI&tq|w$)@5i_R_Gdb(}iglw&PT+pE9k{TIp-_qf7+t2AH{!4yV4n`0w4+_lK7d zYZPR~$%tx+ZF6@edAM>#JomKB;P-)t-b8XtGos&8;3-g^JZOV`MaIq6?1w1Hu&t`l zq&N1dm9*Ao`6WN!CKtBx#!C0Ec8ufL!9~xBEAn05VWynU=nsVoD1)omB7JE4hmz~V z@ZZbo#LHiR+Hn89Qhx(er>1d*-4&uq-Nsg75Be<(!W#+38oCNZCKoP~YLX$w3lBTa zbxD0gz%y&r1G3A1RN#M9zf%S&?2Vv@mXd~)K=9u*Rko&_A)29}ov+n4!@5nD`G}$t zTBq_*P@uy=_w)PA>W3<;P_?UVE(!WwlE%8=EQtYj_oP#Q-UmNBKi08xtprTn4KL_j7!twykqui319D90^Ia@=EYs$`Ny6*0_Ax)K9K|vR- zgJ=hw7FsRfS`T~4GhXVWQ|o5oboMXG_ovrSCjd=>R0tVvtY`=6r1;tfSrV5;PqIN_ zT8j>IT$Vp2Cw912q>0Jizi5Y?7AnaOZJ4`)x~$}x$`_;4j}}C2HfCdD%_j@JWQaqK z1Ijn)H)e7uZ@G=@_7g4#LHItP3D&@&<(Ok-U)LkHeuXLB~ zP9NVOCzFB2=eYd)8yM(8@T(MqJYjq}e8Us>Z@q`2E?^^-+(cqn$c9|JkX2n%Qs!Wnb7<4o|oRvMxL{AqQ9zYk37ftPO&! zoQG96J`@6HCP$N~)~`FWmmhfSo+0hJrwZ@Q8SD$+SeX%z8S*0ClJx9XNO9U(44-je zG&J#QV96gcwY0-63>i>aT`Wa;U_6dGa{I*CTqE7WyA05j9K>R-f8v43q0fIQjT<-b1E!cD#t8k0a74oO$(aZO4wED;$%lnaS?0Hd!2`ETu_n4* zmjGo8xw2h8zX50naxq)G2;b6*2?C;au~f$e;&SHWtD*I`s5+foql=z=l|rk)x$H8# zQQ`fOEVE7foBD@O3^akwPw7TV!iU`#f zlhT#i-g$$7FXhP#SsbwUXY{F915s=hbC4wdX|{w0s>l4%P6%39@HJxNT%#Yf4{KJ2 zbJ{GipyX5g&*fK}Zhbwbrp=4Gn-F=%cEy%>_Rc%_o8W{6pUy&~08NnlGg@#pPoRSr zlWPfvf*X(k8{9O7gE3Sqjf6GC3U_B}yt zSg(qGDT!k8BSjg)M5rRF4&)~`>y@(^(4u2fB)#lpv?aS4@WpPwHgC(1HuZHyY=?$~ z#U*8H+_p0Jqj#=%9&l7v7)LukMvRvNMPA{#aRwz5Y*>lI8P(eTLj1pTQpKIy-)pN} zvDF-|LB}SZvnjLN$3KxqyyxL5+l)?u-O;kwS}Ug<)-1I$WeahC@DDL=o3hTu4Ek|n z-xaBGJ199Ap7t1zf+xcFjH5O1y+gYsqfhg5F{Bx-jY%b1@LQ7Qk}=2x$h-h(X-{KQ zoyrF`B7=YmKD!8PAj;E_-`05BFoVq#B==>_ zQU_fL*{jl70iDskoBd)DQ|EebV+T-h2JF7c?fbPs*0j zRMwD5TO?zTkv+(AiW^iQfhcZLXe`iMtRIu7HzpDIB{|r)c+X3H!;l$qWq*lm?9@p9 z{V|Sw`M=kG=-C9|$K9+Ce3SZPXn0d=s2jr_w zIOeB(M?zwXXnbN!LwSqocGXhjRisXP&vNfE!^1L@imKvDF>qjnr_n>;XD#EZ5Yq^S zuf9$*50iLs##(;Q0v_U@v%nY>Kp%E{vS5aq#rR-)Yq(clu0H%nBAT?4=esH2!f1)# zfo(XsNv1u|lSfLT1~t)TfLf|xq8Ol8eJtNHfx`z-+WQuKf4YReDGMWGIHH~y?X4A< z+GtcbPkv1HHThtQ2uJE0`{EHco($7hMsoK~QDp_26Eztf8GT9>pt|?rcH~xGVBukP%U{-wGCYc7>#(bSmA#dUumEaf=^ z=JywI)O+c9z;KcApr||)Ge&~Z0i5xsdSh?qt*A~sgDS06P-s{^QO-NZQndf-#?Edf zIp@NckCCiTXd~s;v4%6n7;y!OWt8$V$wS(?IBb8EH_U7G6bA_?WY3LZo1I-A(Dnzdm%u_Q%LrHkwDrWPaz;1b69l(k_pC+f!@FF+C@?hVwpgCztcN=TU~ds zckh>@CNa=38EM3uCYxukR~U4RIRV7&!{vT$S6LjvqxHlHjn(P#K9C}zsS?>Cf`3^c zz`Sy%GbRwizjS)GpSt#kA=$O8sQd1pJ#N*xe?)$idl~p3ztlAP0aB?X$QRfYk*&*& z4c>iB@T_sq*ht$VrR43eMB?O}_aSY*R>lNrJ)ueyrZvHc(Yhz~-;W$0ui8^=-L4=0 zS~g0>8bKdMfhJV;KNwH_hRSep=Df*$*lg-J^7|XG_ZocUJaj4A{p`llM|Iyh)^;sw zJg}Ty2u|BE&5;zaN@C?rMknqYg3r*fY~ig}XyZ!QTwFd+1#|;zhNqb_An~tk<22~r z!wFdv>lxg}pMqe*y0Ilmb8Ulq%mPktCSah1-Q**JJc$T6V_RGK82}h`*$Xxe3)857 zJ@9a>;kfZt|C6ax&d#onhIWkOD^s6rlP4b&$^<0r7yaVM>MX2s*HSip^R}u-?lKv& zIJis6C+Gm#_H1XE>lq}OCj4HVjy=SfkdJ)6e=m$i2GIWL{lsieXo1p`TB6M?$-AQD zLY>@W3{*}7i|ya6R=kqxZF&kazaX@sUa!0rG%mA0$MvxaygY8ZfkfY6UU$CHE1-fpnuW%kc2WLT;f4 z><`LIshbMoD9n@8?>Y1(O*#V6p{?tB?shdFrO4W)W`0f z7rUKP(VS|CH%0o_v@i(b2X}4_B9~pndmVJu%YE zJky}{0&Ac08K!E8P5(K+nxj1r>((!4asgY+ueq+{GbFzmDM}6LUOW4j90a`g&((Y< zJ|-mB5UrqGt87MSHPXDMhb(%9bb93U2D7D#?V77u%+)^E=yI}OBTUpqh@&6Ba@&A$ z5byL+`A2wzt(Y7t+tsMZ(4dqnS}ya+@qozqbSI7L)??L`JW~lcAY9~YYlV}vTSdPH zHq(6LWM<(||EEt&9S)z|-+psdn>^PVz4&mlYcy#F%r!%)&f{lvg{oaP929o6PWu2G$ z_{t2KNCR%J=-VbYxw%bLu$&NdQZuJ(=;@CtUX}?EP8S^dt5R*?L)W4rY`@LU4RY8d zDvMb9Dcl+C`0#r4H&DHp8y`o7`WUl%>|9{lkKz)qE+yq4Zcg#!MCm(aGLg8j+0EY5 zIli0G_WZ97!k>YrTPgTE0aNQ&Yw>%#+x4MNkeRu{gy2++kJM?2`+Ys@Ma~;;Dhpo( zre>{UQKW*6@gotocbnC~s``@|8|uJ56v~T##Lbzc(qH{mk?c6xpX1yp>p8oaYz8IQ zKm->wFqwt#o72%QD_?Qvr$Sts_)S2sdu?m(Lauc7N<|Oow zMMfFg7cm`)%h)b0TA~|lx%0cs1n*m%+q@Wd!MpFW27By~+>U0~BbN0!>=2Zxv|nJR zGehK20>56Yz;g$bR>%}~&gG1}=HY!wd1#ewmi2PupwZjd%JBkU2WtjacjT!lZK#e^ z+k#;peTl!LF!yh@|3q9+?*DTYHjRy$g+uTED7x=KYeRih{?Ne<+`#+?lL9C->)$Lz zIKaoHnOyi%rw&+0z#Udkl{;~Jp@2)5>%fevpUESP=xkg#ncf!;s{$@6%+(5akPV~|7 zKEgJ(L(HQMajGVHOAmJ5R=}d&UuPah=P9@P>6tm+F~Foe;!H$mPC>5`ZPJL(Uv8_` z%brgaY%e;0XgJ%wd3y0V=${$AFA&n{>z*}vq@?eIX4#JtV@AgT03@Py;a@_* z9)k>150#z%&+jbgDowo8*aGPrEXp-p`qt?IlgObQK3WQDqWx!b+JA|3{O5F|`&|la z6u$8(Y>Vrzim>wlfA|bzI8vL7kOu%7w{#3^X(yx)%grOKYzbxnSDVW3=2z>iJyTrg zjn62=BG~XXX+$>~C|(Exz-`nF;aD@>As4FOO;bIl{~YGm6vf|Y*CS6gdGbRU9r+#d zQUOic1$XnMVYAAiU;OD%9PLf+C%fvGTvf_IUFdI&j*kh(cst%B#nD7)v{Q{aN8CZ? zTFU(&H2{?sXqiRU%;!sin%CSqGfHBfLd_R@1m8VA!Mu2wvPrq$Pfxzfa1U+Na81#T zrbI7RbB?EuhnKhwYC`{%`Zgn8LGYn+Iy}g!uS@o-fJ#bK@|w#z;Rag#B5a&d21umi z<(vYB|LrhwXBMapMP+sG^FCqyy_tfuk>>FN*wAVBSsd~$pYeCYN-&Mn0ZkIPGxff@ zh8b6U;^31@$0)Uzs6^mY`8^5&q}11jmG;oy7pOUhD}EyzV~6)*Z$Tg5e+Kq-M@N3a zZsQOvZORj<-x5tWrY73lH^K^2j~y09(u92b=XTD*$5)?JkY)_iA)y@{9%2jh6;E z4bWhr!^Er6jh4sy%`FQi<4dZymqhU*J*x7y@zNWN*$k^1o8rSqWgV$&l`Ki3fN zcp1rBwY2pA2%O&TJPd!9FlGBy@nw0y`cMtMzvE{6OAI1%()o0|#qnQe^o51krVRpt z8N|-F{&dyMR+z71#wYJJmYA!IaKOXzrd&(<9KM z1Ds|Rjw8R>>A5QT=^&(A$jqRNCa;DsGme0W6_aZDW9`F=onjp~8?+V6#jx}kd@pqv z@m$-He@O~JFF{sa);&PQaUNZ`7*c_&-#c8J7om%Y9@pii!32D7s?O2i6yvDnKL$ll zEux^mHOn(sO1X|~AN6QLX`U~2aXmQ-)_e&>o$+{_>oT>e0Z-`O4xHnU0r0Lht_1J73 zGa_X62iK_{DfAqUgAf_hh*R=l;d@fi!T6%7r`G1TuyNY_N1^!4XnyTtd}G^fhF&J) zAo`YmZ5UFD7?ZC5yu`;SLPc@aU!YIram18Ary~(i4V}TN>lNPefYS2`@NnE4?t9Rf zBgq?>_Ly9zZ7GG1h>F1!T?hfy8T8+2b&tnH0q*s@3n#QkbJjkfPdb4W*XJa^@x}|y znj@GS=3_S=gCEv<7)`0Eas_jBeNO%yrUvdTX=87jZ7F93Kb&X0C&&}8GBzQxp}O|N zD`RSFL&@2IJ)yZgnZ!FFuoU?6t9BdhKZDTD_n{I_n6MlN2BT%y#l(ZQ_XqRqu4vQ8 zZ}SkYLdlkIq6GC8#?3O_EX(^bM>$oC(f9kT!kfWta*l z!_;r=jff9rGxm75U}^_;UxL3c7y))>*g34fy$-@SnHsThANiVw#%5wzHKv}7U{HQ9WAJ9~OigI7c3-PF z%l~H^yb!x}41%7TMt{~U(N2J?CgeRuFw=bN@79M0Kp)efH5sjgU+aanBQ-sGn7AJx zvf+6=K*82R<+N#Ap2#TFplcs?CAG+pJ(7L=j>s zF})lI3cVun3d302zt;)nevqKX=JAqBt3+@jUiI$!?G@`CCq~ zfE&prh{aKRKp`VzX5>|LEyaz>ka8hv&2uDlABsYb1zN;%$q5Z?~Wo!>E0N$H#X zMo2ZlDy-tuIaMZk-+<^^kiT`+R>ca#c`D(|kBPU~=jTiL=L|4{8EK^DcH~9Wcu|f$ z1X!hj6QUa4SitktYh>}8Q*I%4Ku@bmtScs_+AHh>r>*ANU47@fU7sW9z@*D89F7=# zNl@4okrc0q+jmPOZ~OL^;=Nx~0u4VWDI%57d!>%_1`Q=ccM-IXmERpwb)|j3NeUPx067k2l8F^S}xs_&4yh2*oEF)qQR^UH-_=mt$9rmbZ$;YjqQT%C!pr|Dc0MHrCvHsD5JbMDc1_y`GU}fi6N-i zLg|cv)9Fed*N{mvs5F|Vu57y(ggT!3{ZP~q&>AWsZgo%|8X|nkXF86)1^yu2_|niGa@C&|opc68m; z|8XabUHZ0iu!SnrOGL`nbpzA%De_?pq)oF4o1R{nrG9!| zhKGFsSzxb}qS=Qj7dM4}z`kc{A+0T6(R{8~h`z!9@X2N26yFK!mB~tv=CT=-6swFC zxGl|#p8@X)YC+!!p-ugM7##lm4vqoBi-dHt!*jRWw0>z5G#I*>HZs21S!wL#ODFPj zO^%bZ<>Gsy%=$YcRJqf=U|E-?yq~xF4(OH4ofdZE5Hgs|Xh{w*DsbCR{*Gy7>chI_ zd8Cuy#X}@+b8I)KoLN5I!UO%@*SLPQ?u}vHOexjpONTUc%6t@R=Qkq#vtM|rUfPKA zK_eAP0yXj4{1-+e?*POc78X{gA6RxDq(!Ns_*xM}!)A1%p~G~d0}|BiyW8R$=SC7X zWrWZbzcf8Afg}Sv~(Bm7)2ax2rbq8KTXIRs|Z; zz|KoIpdDzxwtN+O-TGY;IwRx8=uzmC%U2>oD_r$3r6vH_*aX4G8TqgmjApRERmMRu zZs-P%`Tgo&Vf!;sU>nZEx$KF}FI9033quG=NF05Mag(8kGL`%P7)w{RHSqe36)rr3 z(~QIVx3z$t+lwxoMZxV8)F{Y+3RoxDjJu#q?r5Dx9EC7Z&JCIOHlKWPCn*XU zCUeIVm>8*SBFD6Wh?22A|vku>L3Q#6i&?U`FLHJgfY|Lcs;I+jFzJm+#czGM;>R~X=HFK_ zZ~4j{8b>r?5s`BmuzYhA$~JuR2JU_xw8*1KCKRMyjAZIYYO^p`{VyJ9<*Hu;tG|?X zp{!+BSPM;zIE&ON)+Velcc0u%g7JhT5L=5f(-C>qbjzrFmhVFt!c;a!P8ULq8!vyB zmhJ5$2%M2!t@_0*yN*R`0eJ0w72JE{$N{PiC~j8A-~kCSag2qn>heD*<_n&SK)Dhj zCB%|5MDhiKeu0h7XBvFE?JP8n2Gu1;$aB{KPH^Xzh49&QF5Vu22qnwr*sl*m9ZL)wdxDV@5mV2eiRG0`IpO zHxsQ++KChYSZs|NW=3Ibbg-i*sHzg5Ic#6IOgXZ-D*d=q_) z+};$=86odDd+T~`iZi@42^MB}DZ*yHirRT78YASJ@ibs zIEwtua>-@(LsnO^(gMhQzcCzXatXT{w;3WF*>>Dd@7+S}VJOD0Pc8W62}WR%XL%wo z6!B}J`L#!nRUh#rMa8Tag(O~%2Dl|LfQF|(Y2M6eDHt_r?Cz>r zD#{jzVp)!!`HQLUTbiEF6q_JDP`S&5R}rX z<*sdR-Qu5kzhwG$;AHtB(Mp5ms=-ov)s@lzVz1&Ad+SVBos;Tn1f5TedyY%o9g3-%G$X` zd@?7c%)K2+-FN!#m*ek<+j&_1n&YT&wm)X^J$ZQLOEQOLFCMirQ)szFN|}FAWO55D z@@@t*$Jof=Wasbt`sP1ai|#nxl{IiSP_et(d-^n9C%_Uv>3Jh9_PDK)Lh*-BLYeD$ z*Xub=WqTSbnGprcWi=5=-^}(t2&~lizE&>}E*<+Gbmhtp@r)$M&T{$W2hV`#qnEJB zue&_Upi-InBNgJr@djBVCos;IC;%vj?z9f&G4bxTRLu(i$~r&K_AhI^Cx=Rp+PSDB zU9#>0mWW1fUat-sTa=LjsB;lH{<%iJfvbE|B6#*GdpurrH>TOT!9;*hx!GukZTYPSdrdys4XCq+d6 z*%DnM6TtNMEvZQ8n@l>DXrJn1;w9OPza+gnf$goUUqA>!!4H)^nOs!>J#-w*^tdg; zb!DtQ+}gbM7GLL zHm3cXQBVciI4j0OdVtY)cN;7`Xxh6`#j6WIEe!fxu}=kr9{zjOZ@Y8@B@-<~wJP}o zZL$=xCC%wzxUSUgA(H?dq}tZyjmjL21#e;D{Wlc zRa0wWl4+dB8p0Xap;$+DxA05yNB#l%QbXsNZURBD#a6>)3B29O<624vglVk)wRhmC zB9>C;4Rq63Iu}6Ue!|ysCpM+BO4{3Y{}+(Fey17YYA3Un?F^C87H=yy0F~})8p-CQpTuFvwB4^Da%(6zp~WKp6cyEvb_Hid zHVjO}T&Unjz!2&|5YS@J6hIm{r5JHr@j3r(7Pc#~I^|oJr;>-RJ?;?@a+`%&Yg#@@ zFx=~Df?cZSEinCUTGz{T)6b?(#3IUJ?$Z2*^D)O6mNGQhd(ehu2vK>nqZ$cw8o{`p zBm(~RxBd>)&BBM)rk}+ZVE~>zx<$$cNu<8P@Mv0ch5*OLr#wG|KHfF|I_eWKhE$5f z8UajjySfpB9!=m*|2=H@kMN9Yci#;Xf}~+dGW@X z(}o*^h+{V@BJ^oOTu+VSZ*UsSl-%bb)t(z<@M^hd?ADzMY$HmO_)QVO>xF|qW2n+RFU?$u1pN@ z9XZZ}wE;!K)ydYoyStzJ7>AGTN);o=_KUbhq*2{^F%MFiA-spxo`LlZ8eHbOq#Gq~ zpSZ$kHk-Ym*FE~IZE5-|t@lTC2+R0_VYn*B__bjkPYKn(N>$`HzF-vqF~pu=v`?Bv zYU|Hwx9LU&9XK4b7}^z3QWgrJ@zyMSf?!PY{CYU+{ZMNO1J7Kf{x4XRy+wp z!q{~1#9|~Zq*~UxJJ2KgBsiMEVbpjn8 zV|SU({V1tQJnT)ddVy(aBU4kU^I6f76u9wuy1UwfIrav6OPHdT9KQtOym9;OxdHwH z@0RP9Apt;6yBN{04Mt?}*iJd%0)?xO>W-f1>p!=^T@QSz z3XS@JaqxGjz8vgW)-&0IFgocDZJ)$A+DeVYK}U(_fgWEmW*0{xv3=PhX=c z=5a%GLP}%WeofJRJzJE7a-Y%P6(i&UT0H=%=zYt5c)ny;2|-r-TI~uSf(|aX1EOWW zPY7@K^(gz?CGs(b!34G~r(`N46Q0+H9kQzpN(ZLj8gCTb-|S#&Wxw(@;kbZLTgveq zm;pFIJr8zYF&2GP;jO>!+*uzmJEF)WYN@<636e$<^0Dy{v++?LMX4Gz^{!pvp6w~K8rgA1`^O5{+EonwINT3CF8HNSJZ!)dpT z{1wz$39pm3_ioGd*fmdWs+ORbf4uha)z_5#vc=U_%8q;FMVCR3eN+;v(Iwh7&tc5 z{Q^WvdLn)C3X^kV|C(iEy3ETfY*OE>o39LR49?{BUi>9cee`O1|5t6LkLTBmxV$g9 zWzv+~JvSIlwQ`m-9IWG!R~>S0tS?`2{e36a*k^jc?PeW(>9E$v4GSmk%pwz_RG@ z&-P0&$q9$Z`XiX(LpI6{t|~$Vy77q^v(9kT7JIA5j94=NNu9O0i4K{BD_$cVub-4H z{J*}wJRZvZ{d>|$RA^WBRz;Q;Tej3GrH~k6Fd@k@V>h-z5uFI9Y-LMAX3UIrW~_q= z*<~A<1&PTzm}bU4&t2zR&-wnI=k>e)F}D{pbALXcYkObU^}dD;QqfI^AI8~CT)1`O zF5&E#9ktiAG~Ak~npY|vhUbJ>k=M)HnjEr~v_G(|ZZ=I8Z@lFu1b2Bz=ug+QEM|Zn z`ut0=MF?I{R}X3{iE>aq3yN6X0oh^&CJppolqC*`9H>(ANVTX3w+#H%>UVjs@Rcei zp}n+B+=%rSZXEz8Rl1MF8z<3^8VdW#-m;42~D z3fphsmxEjtBHV9TRS)C~5Ld=g*$&@c0Q&!WAqZaZ{mkr(0dY*?RdjHNOLq8!zVj-2 zXT8Ybq{?#$I3O&Zgc*e1e;`n4cDZtIPUpR(F*Y}oFiRoK<-Oxft6qt`BHV*?;&E0+EME3KB& z-zL`;UMBwa>4tUn<}NL!nu`&u)P!9L7^CmsV@<`@p|UlDXaRWtZCH;l8J;>Hg9(Pr z=`<~A5=t@Ux*Z%E_iE#lU{gatCzFZZIw}rXlwxFK*7@|voPd4weOqin*nfi0@AF zbhH+ld3B@<5r7hrd`FKTlD`#Lp5j(sA?QPn2HL2`Eg>;eP>j;7EoF7n=qXdt=)`2- zr-Fm$t<4CZb`!Vl7XFtg15S12<(+r7AgT=YBHYD+jak5y9csFSJ=wH?88&%m0n#{8 z=y%zY6r6X)R;}A(%IH;0{G4oPFx7l3&~)335rESMJR_s@BQ2^q5;&WCYPaMlbFTwF zxCcLp+dzF8-UD??ToGo6J^gd%_~23oQJNAuZ{-#mFn+JQw?tykfcKUU@&DyCTsq&| zX35AjDU5*ZsaM+p_NutNjrIcnZpSD-|3vbQwji9{31s`lP5^hkP*v1`Nr1@^=ZAq_ zLU@t_!M-II@QN(FmEeXVMZnl_rPAZU*9S$HgWuAuq#n`aSkR;&y8Xak%d=6^R!8+% z-p`?8+%whUVM>2QSpW5}FVa)*;RX=cJPX}Qd_9xDuO0v(cIED_8(4CHD9QGBTGeG@ zqtODySKPRF=WkSwa$MSLnxrTH4Cv_BE{lZ7BJYoGu+}`Bx6y!xNFsV9T6oZMX5WeZ zl6ljxq-kQ{%y}5-ii1P)o#-yms>Br#`>;dN-t9D9+yk5Z*Hmo?~K@+ zJwbwAYTfiukktp(XUU$NXKjSnz8yfzj?h@w4C_S-H>oIWz{r)=p7yHioz^QU8QSW% zlt-o{Uf)*m{JC3spWdt)D3)Kt_{~(rOFYG#=#UJ6fomR+Zeu9!fA41Ah|t1u&kU*Q zoHt8YdoD}4yLW6DfYJY5r1fyG`h?GxH$j!+!~>LI;(;x;E}5sIJSx^5j~iVf1lOIz zrie{(zawryT&{Hm5A1mLF+N>7_D27u>xNm(52s_ zhW|0m4|2^FM&0T*_RB}01qjW4L-@N>>az8nF`ltwwpX@!iTmGhF|E!BYPj?2qe+@{ z?90e0W%7C#f=>$ZB+-ROuL+w83Ohv?)=Uq!C_a=_CrTK~5eBCT4qd58o- z5`m!b1|k3c=izOWi2;7*{AYSW6E*b zt9g+E+ZJ;XUV+pe4RJLL)obL6P~~rtg5wPW#s7yx8QFW``3+D+^oE>0{)Orm+otQ^ zR@?}ATWoV{j$%<^05q8AWRC_EZOSc(Q3}@Xp6HCBI!7g4#WQgH+JXA#caRs{I1n6O z?h)}JBhW?7uGaM+BlU%lYFJ-Z51g4tJ_4r*?^mc%tbV&wG8IzXp)5%X*h(bkr2j$^iLBiqTu5@x`+Lz z0aWJRzm$7~U_W)lIxNDm5~NxU1cQae7#P)rLk*pvPPq|G7A)Iid}5E-9&>p5cYj_r zfvm-^@Px?Q-03)?RazK+73VQjoMQvXD{KH&60Iwff2YXm`XCM`onu@Q+OHfOneB?$gZZyr(;{4^&f?sP3xivDl!5cO8GmK+MIk9&V46up`2 z{v-l}ZN%RZ8a?=!aALr7ptaTFa<9^j!?Ldue?+3z0o=<|86$4cMDGER z%KwTfF3X#Wo)re|-mYX5E+3(&a35_9tVlop@1C8HY%xXWuzy2_nH8;Hm){j3J74uy zzw4WY4mio^dEfJDcY+9F!}(yqy`Hh&z<&>{@PbuTK-0k!HE$Y*R0q5wEr}v`7S%gu zuo*z;F%lgFb$3PQ={wkgF7^Gp^z1_9Wsry8eTx86so}|H`LunY_haL(Lt(F9)>p6_ zY{+Rls8!oM!PhBXsIlo@UDB0a%<0N|2A|=h$I@2i3X9lFeEvHg|P1lNsurSJ=eW=0l8zhR^9_GGf43Se{5(!3pCqcP7U%U6pii)~27MlCaiaX}>g z=wh@Nx>m!0!9Ue~tF{@y?z{fQvIx3x3UgfU!8}!kx3Q}KYCp(pBjRu^Y4xr<^-Gi| zPz%z9xAZ=PFaeOXTaas$O5c+H>`gr3zSwqE%;rw{CTt>n)bxbS^v5$ z1Ql}y4gMfvzKHkJzO^ujQ<~P=`z0`uBEMJpA;f)v`U)E$$&mth=>A>N^U!NMS2l^6 z6=r|uRn&cXr4ksVoF;qo#K(TV$C4UoQV7%RTOP`RRAfltJGa9#)pK>y+>iU+IJvL) zGj%dl%D#H@mMhCR{V$Wlw-ARXk3nP)2ad?&6h%g_iCC;YxkwiDjGZZdL{lArp*aO5reGAQ{84mXMrpS=)Y7+z|sd{t>ERf`!;t>KmeQu zL;ESc=(I7ZxYph#Tb6VpVM?s9{P2AI$Kw5D`TWP=0RdoJ`SCo=`C}=%V^Q#ymXjaw z_Z8yYlcRmX%lKlu!#zs)!Z+B9hQ49?+JIn`Sw!u|=8Kz_U)2EMYs~G%0MzQ7UlY~w ziEY7NI5s@Q3VlfUie*OGT}uo^A(Kt*aLEdB>+3BOZzU(_XnJk@5CEUg#anKYoE%W) z*Q~b-k1M2@R$CF(J)9wsw=s{&HFa;;@_Tq>DKxj{gE!D6{{B4Re*d~IZC#z@uR_!H z79Q!ViSv{oh}lu$S5l>`;%B}=dCTFtikY=@K7M>}Ee{#QM{KPjHKkhSw21gS!_4%7pgzhkm^rD*reVoVCu6kMYu2-sa3K&t@& zuTyE1lRHy5ZO?qg+e?nMbasR~sSYSlk|8pOmp=}$4)5}kG;4fiaG3yaiL|JDzPDMV z_n`Vc_if)KC+#2C=;8DXn3Xo^ln@9;sYBjeZxP_b6oSSq;cR}UN7A4kI$3%Z! zsBE6puN{!|!? z3K-CL1jcZ;^$zTG-duv0g?OX2PF{(G;PrI8*drse2kJ1~2IcEQWj5J1=utt8+>8|m zzqC#SUWnZJFH*P20!}|VjX04^;yy7yH>MPvK9iDhWMVjrPDC$2?#Q{nuybzd=K-F-!Y3X zce!sL9--~I zeJd!^pAS?kgf3L+Ll9pU62Ie>?@~y92I1G-?Fi$qbRFk)j;rXF+?-UJO*uAs_OPUc z_|0u_`2zGe)SuXiDDR1++t_{Y6fs5arrU!tMY>?S)OuwQlizsT0m9kR*OOu4SW=4F zSLLrTW)kD0i2foWOtwaF%Ui#-nrZpc&rLxYitK}kv`jX{m_5p9Fa&mSp-CmgvQ7zT z!SbbwN$wTdYlE?cD7Q2U`k*-n{yO+A8MNVMeY1W%jCzOcjZ@ca*aGT#_y2pulZlX~ z>Ji`x-J#WW;bB(c{L&|igN05`@+M=37-gIX>QF`TV7zepyY~ z@C40W{V}eA+&{roSCEE|d&t3NrPUOLQEZWDWAgI~uer$w!~pm6p<@`UM#g*?ab; z)&^?_?U+MG#6skqmiq?F2SLgQeqsc~pJCSM@{G6Z%7v|!)~=PII^Y@c-r5jeG?f}M zHZoEh;!>(F3|(2GuymFe9Ehbp&VjJ;$;?ll`og3T7H_OcJ*-B7)(t1TDGp7^t0bNf+*3667& z&(4=UQh1RgN^jDAbgx{;g{7;EZEgiwg#Z0h3r4j6jA`RZGN~!mf& zx?e`BiJ1e!Geo6^Eza6Cvib!=p0V;2YcVCO&Wc7?C$x|$r1jy2#RAhtLsH0Yz0FaB zLoCz$0e?dFY;NG1V!eXM_H8jX`skoThTJON| zIfuZBSe2+570)=!!Lm;*{ngP;KtL8u`QuC;e_x?igyMxK2Df>l zht1K0T`BTMu#WHnZa#`|x@GA5Ynwe9c+=Fik;%hbK<_tu|A}u?V}1ZbKZQTrQVtPT zw}P~iw(9ft9bFqCX|FSQn{x{om0C4gFmYdaFE?q=cZ)nGO%UD-|tiGrif8kWk z_hHP!_g0hTWj<0OOK({8W$W=-*7JfRjBaqR(n)1-cPDy~?0uK_@FP>8whvW3R*by; z$D;!2CkU-h(l#lipT!dxv$3o%%=&ax$lHx?tR34E=I>417eYAupD4oMqJbr8d@hbP zPK6@bc?-j-&>guW;pc)K0?*%<4B^QuuI0*yBRafoj~9)>0rE$bmnF3k9h}yESY(@Sr?#F(`=Om6+oL~SIEy~H%t~oddDNVyv;Qn`DKhLc`&!2PtL*2f$+YrnozA#J3GEe zJog4-eM2LvJ0|odl57TMtZ=LY5ra4(<1T@kBSMQlOE2Zpky26*VC1hro0E8c=7{~7 zq70!ybf;gdOacicU|LunBnZri9=$7oefLc+c+Qtq?< z*8P?g8Q*NGMaSG)O5%2 z)cI1Eb&Uhbeg?XP`{{X(?)?F6M2zEF@+Oil&95(o?k2d^N;OL-alLJFY)QMmkIvJp z$&2%vHS8{JGOli8V61Bp9>{(UFf@G6?QU$l54-z^FU3loRkPY8P96u2RzY~+{%0^T z(Xge~`w|Rkmgx`6IW!_^y0xZn_uQkSA3~P3A@+yyc2fPiwwl;?kZBDxRx%#FWWr^u z%JyV-+8tMk9nZ){Efn2h-Ey5cw_(m+#0^+;s?o$lpUvim&*)UEPb|!qCC-|W|AILv zUkLFF7mRFJtP?vZShi`nc4(KV)w8<3h&i(gs$-Bp?1$(+;h?P=E7H^ZnDeVUDUA!A z;^aF`kgNinav8Ek74 zFZ|UK+-iq$RkUjDRItC&LG zr7v+Jkn}!ETTAp)^y}#=V`>4eh3fK%o|t-`u(B9@dQ_X@9Ojh9=P{?g6g``vrG3%S zBj6Zed?j6cnPY?DmT%U1pRJRJb~pZYY1ZTM?1z`(hu(^;EEfD3&~Nz%+9hYG`*}K8 zF>8i@raYt^*C3~}vtM*lfu`p!DFtq~Yt3idSwk}|%k8R5FT$WBHG8oPnviVxLW>t? z^#PI7##xZ(Pon#Z=L)iQq%iPkGvc|!b0z`TfcXXm{Do{54hj*|Ums&O;@gSRD|_)8 zPgI>A=NKFGCf$bD-SYsiy~~GEFTv?y@**vVe8U_X{9`L8jj4_-*O6{%&?P=Jbej(l zK8`N^P!j)~?fy&f5?k@+OqK@U9Q#7@GT|OP;2I?^s{=J3#_X;;zrIQ#>79A;Dnz?_ zEIBoX3?ab95LvTN+|#XMv`rD@8+PO^h-!knDTyJr@2`&MDHkJFmp6e(`T#IQ`2#oL?) zq#*Og@}veyoyPbqrZN)d8tA_x@CjzuE_^|Yz8sF*`_c+^{%iYI&v!R>L~uMvOuZq`gCq_ z6@Krt(OD{jks;^?OwwGGuw;K~hZ3c^&DFUO6{r{~h>yq(b@udgW*ZF=gHPxzkIU!s zHYaM$_VjM7=x>C6AD86^CI!B3-?ioI&FPo&+(LA}1l6h*lP5l(LT(9tze1BYK z)H13zc2X!u%OgV~z@!pqmu0?195ibCb5upd&0luXsz_zE5EWnDyHFN<0q-tHFxJ$- zhX;sawOzh4=pp2zx3pyv$lBqHT?>*U%gx0?Qzm3w$eP3Q6H3fgFnuF(4p+C-RxAXB z7p$10p!Hs~iYZ}(TPxNW=y^_LeO@~5bP6wkS8yPdCuYx!UEDs`SJJd(0NFDu&635M zGF9xw2GN_9Rnt~OXbp7}4`OMFIx^ETQ#ZKr0nED4bd114Y9f(~73mH$V|}i7113h9 z7|+^0S#VfPg(BL4Gg>gzy*iovBQP8KOqa2%uJrDyQx_SUPvBjf(HJBT56jKYdL&pr zJG;HTiQAGO8~<#@($Y#4kBdssTOq$E3X(QEafVGtHot7D4FBOyZ8HsG^!GS3u4Jd} zz@0?`$28xl0yuWjzUJr=lcQZ|H;+Efb=RA<;dZNAK^Y;@8cbjf&qte*Ks^yUk0U`YIagahG>u&-z98KDIA>QUULw$+N z$oACizK!z2fZ=`_$(rYf%@25BB&@^(l#t*DsHx_-zeFZ2JEcR4N+^X`3|xzAj|c+BtYjsqEE;Ojz^Ola zDS=Dj0RL^ulcr=bX81{8q)YqD-q6^`B=*`XPWnjrY)N#F-n-YylUgFyVmzjfjCd-K z{pIMKKC4GwEfGS|SHCCeHaOF)w#`%g`3>Re{J7RDp?QpaFL;OhEGOPhU!_|cRA2dP z(o4PboddRZ`_CxESeTQEB?Ez1rqpml2up97LI-;BJ#5uV=|`+rdInoP`}#g`Kz+Lm6{r0j7!(=zU%ku zJJp*kS~JB)Q=l%sBA0FD5RA869|-sfHL2MBVAXaM>N2@NX=bV}`@oioSR}t|I*l!} zS}y#x8QWq}p2_dPxQqE_SH@1d@94)1_cV7{`|G?+v>#K?cUySteyEQz$=C|o{W~=+ zs)RaT{r=*3=&3V`N&t~PwXNOyEAeUz7>klrz^78FmK2d3=9ZNUaK)IIq0(p!b9pexk%V2?xPH;L-U=h2-s7|+)}tMV!@ zo;iL#59bo{X?du}`POv}APXN9l5T{931D76twRdBuL)7}Evh>qdir`mUen~&uS$T7 z3$k%;JI14nH8U;>aU5v*J1QrFoD`-8m11toHrx3rmyA)XM%^i1Q?5@CYkDbqSy#F! z%tq^um%N@V#9dbIG;Dx-W9odsry;BX6-#~1JrEp-fnck-h256(Y(daHfcx#AYI|bG z1B1_1b7d6kK#x1qWv7ZS%6{v-ymko=evfxoqYrVC&K80L*gfII3gZbzQPcT8W@v%8 z-8a@ISJ#xf+u5V|9LpOr0`_drPDTFVEHAPKy+Ap>q;se1{N(BfT5Q@}VK-14dh=J# zw%+-Itc>0MK|}(6eHiFW^V6C<2fKXoAB$&-q=(= z8$S~YsS$1T1~>V<(KrFbL7}P|QRO}G*`eK^Wy=>K5mHtX4yJpX-JO$+R6i0Jc!W7G!Qkrjo?BT_Mb+kKt3kKNCsf5xLO!5=P4PzU=-g`Rf& zd>9y+-be)dMt#(}OeS9C=|0fuZV3rJ>_oNr05g}aaMeAz{@F#1maq2`*m%rq6}2J= z0omIZbO9FYiVHDGIo!VuG@A7Lkhb=CfDa++pbiJSGNYQ3z0s&~lgSj9F-FpExcO7O zu|GXgHT-Fs{_!|r;c=(cNs*1E9$Pv$XxGF8@zD(ggZDQgO}pZ<8^b3)P3|Fm2>*zN z-$EU#ypw94kTWl3j&thJ?MhvU+XC_u{q><?#ra01+YQyMZe;O z$C{(O&6|~n8P2z+rH(jYhd5RE{6x6@`MUL@a=JakD!l}jHOF4g(pK^19&UzBQ}M6e zj1CcCLKWS&;X(lIH+~JiV4rwOI-tt(yZOIM8VmG`2I zfWoJe`!b9VS3e9t+YVFw$~9Bd2#6mVH*!UX9BgwMwqRz;rrW*X4O(}8HhfrWd|l(j zt?KutZQL5Nd+KfYDWnWn`XlV(q&nr~B+#bGu4!=*1x4)q-4rz46!rbJK!v{n5U?sz zxqAkUGhIF{K6$!gj&I?5+IX596K;}*U}vdR?(~N|@~f6hI}){g$eR z={M>H{OOM2lSx$n>?3cXZ91@d?`hxTp*umpISP|HtXeRr4DFFDt8(6+8j&2n0x@SI zv~caUC+pnFeyN+&8K-Cbee=5ZRcH4&dQ3~5E|p>EBkRQ1hM-10=S-#2&l%duX;cV! zq#IS8HTb+#(iGpiZO8J{x};r*oMm}P zV`B5WwJ`yfofI;{4T5P?T&Hr+xlT)U-#kUYVvJ7=t2;2NHkxEYC~LjtO3)=X;4e6& zkiowubbaZx(!rp!AlOg{&}2ay>~}E()0gySQql)g_pBO=upj7V^_5;G`Zo-pIfIR> zdFbI5p;2Kf>y)ynH=XNANqms{42_KPaT;EG|7ZH0(;8eU_Ccf*exQP>`vY<4QT)ks zGkR`)%TE%YZxd*L^6FcB71z0w6t^&S4)y7Qt_+l(fwcNy*PkNMJa=axz}kV{hc7ZB z8dF~j3|0U(3A0nSjfPj;U#rv$jBp_UiXp7VE?Io)f+)VfTB1}FjhU!$}xq49jF#xQ>jdzT`qVY65?<8mCVITj(8STV$-Vpx1X`gq6@a$kkLG(ia3Cz#(q=fWw!nT6y zm%>Z_d4FJUQ{JB5pK_HOTZn>Gbl2pY4t~)=p=Q;=Lv!cfQ2pzM^z6tLB?eUWF=~J1 z<(4|;7;^8L%nkaWp+C(hB)!L-j#r+8DRS}Frj^l11_CgDsXqs&MYJz$2mM(8(T=)! z1dV|Yr-mV8E}L&fBQ4%ysHTHU7e8c-pW9kt9pf^2p{3(%0gYh%@%+gSNl76S;gx2= z2kewJBjK<4wtegSS;kagb{(h-7-1Waf5y<7?w#`ZE9|()fFH z;e_kH%k2`AttsUrpJ~Q9)n`hOn`ur01ml+8ll!Ut8i4K98&Q8WJQVV(;!xk!!KKPs zwpLswuG^?4=+6=S7D`&(%8SXVnY-q=5GeA;TmO^f1*%Ais?>0-y-y>))=S z3KBekNmrQ(0!Rwa&k&V7HF5oNUi6CAV3|Hdc2XEp7rJt|R%~@wT-LQjwF%p$tOOv9 z(TrjUfG&yrQdGpy6l-V1;g%u89`!uaX`-HDe->q7t~3i%$DBWZZ`egM;8o6NJ#xGC zZs0sdSpM>#~D7-P%Fl`X1$0hkR^(5_hTR3pdoM|6DyDK|EZ?ZEruxRD5 zjAxiA7Vw8}^V%)4)|5qo4e#EN1(kMO1zwp@j_^ z??+QtlN{hr?oO&m8*179V!4Xw+YiaX&)FiSodTjMxwsi$OQxR zbpk-Ey)LR}Pw2en_(@G@m44Vz9v{w#S!37edLmi!qP9Wq!)qj)!eI@?$(^YSgby zy;OTOr)@Svs^uyvJ{}mmNnH5-9_^>}bG53X1Iv7am6Y3bs~<9fo-f<~OPeR&Qu_Ga z=WRLYfvYVPl^|9(e98$ykfWEGYM2HXrJM$$)tNiOI^H zs{C_wjL&Pq<+{THsdKXZz67GQ0k+DEPq~tZYPRt$t%)?-wT`U)EvTW?lP z-Cn(?yNPvqV&0?J+num9wUdsFm&sOn_<40V7%Rb#zjuR7_SXB<&0Evu`j?;@$^ZHB z2Aoel&NKZOomQdeaCY7m4ko(An{Q=&~bnDkSRRcH}DG3#9DjZHJD))r>BxOhj%*TxOUP#0QgG|>Acof~BG zf1Yx`;ipHjjopL#@QYeLW;ZN%9os7bH}~|@|5Ys-?m6}uWd#|ExH|%ftsL$>rIV;Mr}N5q z_XqNxbK~(9@WVc2dNHT>9=y!G^R@IoINe9_F>xz2J~)rZjtbJZK}dx!1;(tO@rjLK6yFcOHz5r(A?>DhYUvncn$7oEDR_b6QHz&CMW8Y178R_qu(h72qxESz=Ab z)$xVfYNnrf(>M7dORf9$ObboQMZF8Vd=(71(<$69_;8{^_U=rvD=SoqdrLpncpknf zEl!^zRh+Ec!|PclcbR!xd!Qx8U?+3zWv0v*&XgIV3F*96Z_2$>)N6R!B8{KP_7t?o z{Uc*9VvtqUJX6%NcT?hN$X-+4^V1VK+xYa04#<3AbC11*JN96_0iqB7qX4QNB`9$U z_np=Mcyr7}C2OaJ91N7oi{mbIzD8SN^JTcwQ$F-~H=~{u4$mpS##quVcOD5qHk^<| zC&^i$567&S`a%5TF4D#9PUp#i?7!8t*<|VyqFV2^rR{y*RU#&+M*ZiY_t`hzTDb=^pOCG2{s4_hz{u*`oSIY~G_nm5|OND$@W?p7dUqfErNzSe;s}aO;ho z#qZu>1Ud5e4N?L{3te9ym>v)pGF z?)N9(St<5bzi&@*b*C4SX~@8dnB`l)CJwd>O5SsyD7Tz^pO#2;-|xjKasF7U*TFV& zP3R*}LX zrpIAR_BXIe*2?$0b;|*-}5?b!Zo(UX? z#Ad93f>05C;@NsF_i~j`_4^TN7E~o5}$AMzD9>3tGgk; zsuH;^Sxz1B8Y7qSzJ@Rusp?}$F zcPtE@(jU+%Eyum{bqP26=wY<9bxhFINgLJF8!#f@+#-cToxpbRb49Oqjqp7_tX0OX zo?_zZ{m0!4z10+6O(624ClD+)ds_+ zSR66@zANWC!Soa(Gjew#R-dbFLJWrwy^mqRX?zT&4;`h4rF`rt+O#J#i+PWhW^ZW- zy$U#qGNIXlXxe_@Y2rl~*0kUV4SBJQq`w{UH|AlE_&X8mQ*989kH4Ih`=CY4p5L?1 z&lU7OKS9|6Shk)XOYDje#qVQ&5_KGLxhK(1<_0$(NIY2@ll^iJ#$x0~jqQ*MO0Nva zOxX{65%wnNe42gTlId~VY!kv4!IIt-(ev>!A+SdH;$wv>>G9E%7h?XWy|L58d1Zw> zDu%`L@uICYy;Q>(Ym=ok$2a|DHeRyc4*Q{YbHu3AuJQ@`!lIS7>~j7Kb~4`0ieG8T zwP0UE|6>K+3$X&EW6n3EW1Ci3UXJoKjs6LdwN;5n`8_6iR)(vuAVEa33TamulyPEZj?qaOsA?xGw2=C2r&;8qihM_vWXkY!EMd5K98 zf38EV+%%=2o}OaH8LMD?;lj#gZU*Lwr&N%Uc8^g&+)n8O`5U4oPQtpC%3H=Vy*PK( zw8t`H;+Bj(iMZ4D=39qaNO_wf737t!>@Us@tHW+rmBZJ(kSfjC*ef?HK)Q$?CIwm; zBCA30iy1ElUfwt#-@cptvMmtRRT+|JGP4rzx4pC1slabCfcm1m#*!MTg%=6`Fitl3 zo8D%#tLe)(DlDFh^JoWkDuoSk>Wrs!m|YL&!DktyU#ItF z*;x*;q_vD`Lfr;AvrwqxV%$(*nL1JdHO__R4@>KMGgeU?gx#~()4Sf*!SGlBHELzp zu;=bIAJ@a#t}Zo?xC%dOV)@`D6TrAPh-7&U7t=!>I5|YnJJkB!polPipg&{&ri#%m zHGptHDu_M+@p0r~0&?18fcC(?RZvwthlH)jxqm@KOP3zfgp=P*B^46 z0zP2>Q)&V<%I-5^4pE8t7jYI;%8~bo+Rd2O;ta@{tdU*cf3xDOF!whm8+i21sPj;G zz+rm8aRzLBc`h^G8ml=}D6%#9_lBNF3x04RMoBbH^5Xkhr>7XxlUO4c??sz-hZbd# z%V^A^{&8dapi^N=X-2+sbv%O?t<^6W*Eh$th3+w9+O0VBxplnb`40*NumGrOPuskiThTL zlELqaC^t!ycaQcla=z$26q89w!HHI%00fn00wqJ;N$pmCvCC@2eaC-fh*0pCGjWtf zejc(YWhGpx1X=UAE89uOm%PIXGX=2Zlx`Jn@B&$IFRm>8cdx`5Z2tUvw;!$iWH&~X z(GM@GVmn(C(psz<5 z5FWydl1Z8y!OoAoGo0UK-1WkodCbkUqV~kF%#_VnOP`y^xpLF`{OpoB7a>BQ9g;bV z75?aTjqF=H&gCd>k=nf)iSTomp%MDk0kz5G@au6irJdN}8~sw~k(J6t1M2ViN-Ghk zZkK+@C#fHY?PGWCwul}1->nLK>3wkVD`&YBU(%6>BTVn7M#k8EA*F3WO=6;C?oaW|mV5rp%cy6_wf*V9Z?XVJJ5hK=m0S6JlkZdSmh8OF=~*>XUs}Ee zqt7o`cI*fLei5EAF!u?MLTE|ha&j+*vh2L4)gz3)@m%1^cxKpd*(#^4-1iaQK1fow zSnUVUcXATrI8#nWuAU2qxDH9tFX|C=E6X$(UDi8ak{qu5QptMrhjbS~ zaEQtGu^wSvSuU93Yq%H>FAz&@Mr6c|{#*52bOHAmrx)0Q0dr?u_> zVs{_rB!!po6arO#oc;Qn<_^7!lPx2nhqx&I2lSmwv5>2HQB#w43-%6JZOcX}a zg0=Xz$@Mx5QaKsEFyzWvZbch<@-!~<3k#sP)Ue`IZZZx}L3zb~&yl?AerghlyX1-_ z@HSPmSO_8v8P`0fch+t^VyrB+5U!*)si08u=C&nn<;9vMgHY4aKdUg=SP(#RPr+#; zX)+ro4=IPX;75SD;rp-)RwJZtQCIPgITF%_peDCM)+V@r09_z}r+Z(3v+AgPp4Agfu=QM&f`lSKSo^CM6MC@OP$54B zdD!+s`$1KETe4bM6o#HMVkQdQJh4IdF9Ua`P45qcywUb`I1) z>lsTrxgH|@q=4P4vzKn49|sjr-mj7IMrlNtqtpt(>+?DlJB5b|bFbnAcyHNqT(-_3 z>b*Uch3LJ&yZUZTQ6l`i&spH(0gvG((R-zZR)Q*|m`q;SmZ%RoN zs1v>|4t&3jnhX`=9{A8;e#L-7l$38q~u) zr2+^Ue96x|bA9Z$0?!CDZ+(#$UP=_KUs%*J(rWJeI8zV8-LDZr~3E{Gg z>YY9G9~ui2Heb<+qb^<{igS|SmDzr6_F1!9N&~)jCJJMKy6UIN`OU!T-JoX#IPLbc z&gNE&PCxdIEvV$<22rOKclt`aT@5~rxV@oh#YA|-R;ZX{3R-eTBi)7no$f?BKI2f~ zNxkk{b@-PNnULyI$P2s0GaSi`^XZNFZa6Dy`J(ckW+~N6El&mx^CP}yknMa*Gp`D; zf%WH=-B?jM8LgP5Xe<3v^@Oc0dIQ<*8849mx8D~eLt4Yb&4zvQY+P`|kIk-UAK<}WMY7xp?y6Jqwt)@P`ne?vm$ z!5cb>_;bmihIc}A8edP0BC?A1Xj_Y$t3iPs;7Cc}lA|fzOt9RgLt1_OJHLbWGSd+g z2aM!{0Tx;4SG)x5TVFWRgJXU%va|>}UHc(6Sv9n!pl1}_e_lo*>*^+Ja)NGLD!z~Af}-p;lj z=M27QYjV3>Sx&ycbowpnyK;@IZyG3IB1<^x;4{z}`_#j5wW&Q3$zrsn&)hT~P(`-iOCuQ5E+!dx{p#|8~N4}h8OYEyJZqEzZBgXf$fb;box*yIbg@>*{nJI`gaJqOXpaxEVDR{2(9 z;K80h972feWZDvW(>F*LdAa2bjl)5Ha9N=zO*y*Vvrc@;hp@NuwiT<8sP+qj*dmIX zjuSq|#e!BAi@G7_XUwsO@xUzL7}dE3bjTpQFIC7fy!;EU9g387t11IJ48$_7+{ES~ zrHl+L=T_Oci>0GKq(70ExTIm@68{)S&%l13*|>+NtN6No3~#A?{o_}myd`4Xnt}3P z^?A*dlIn-K?F-=#=Nza)kJCb(?RA{HUz@Z3g&?H?ed=Szrks4XR-m$9knAemasxf$ z^fdnt^9ewT^FJ)m5O}+m@OO4By$MpDK-LO%e1AiDpyf%^;h{I6HcMZT+a~~2b_@U| zQl8)h08~DPamT+25L#KJj*6HJr@I8TP8~^WU5d^T??Pv>4(bHfQJe%L24KxYQHH_s zUQO<)(Wg1RosQMgFo<^+Oy!Pwr~FR3{U*fOTiNY;JeT1CM@q~WbfXf6f%*m?PS6u~ zk|jEy>q2^5ak3T@73*bnYGdgP)X*9*e5o<8Zkfmr{T>xM2qtMoFZ6a<|AW>h(HM&w zvv!gnwtJpCV=tvzqbFkQLy0b3SVm0WiV&A5NqTSa$}#%d-o+*0j``5EkN`i3aw&gQ z(AS^C1Z3zxZFs)uGJQahL2>jY^5SZ{ol(}=oLbR>NmJL&771PD#RFP16DD^Bsbgjd zR!rsRzETMA<>AAp*MetR4MZBK)*Z(OWl9CHpTy-1TcO6g@4Th95F0YBaO2|c(*;ia zhq=?&b}enRiy#UrMeOKXF3Sy!%a&0RfO~W=)P=)fMBXVQ6ei%W{ecmwDV7ktOFLyd zzY+pI(Wyta2i9KA0D`E_C<D}C9Gy3sx+&p(iW+^WXtg)in2Tx07>i)O)eu#5(&GW6OD2jbC^=2R@$c<3 zlJ!MzKR*on!o404OF%udE41=sZK<|8Zr+)sF2~2FdX?}&+;x||-$^Y$yTeU>aA;L5 zqd9fC^#2A$eAj7Tp~>3h*E)LDcGn;r907`Grbqh=+-gVVm-rO|BP(*OO>QEKW*pvr zH!R6Wh(1a0YfN9NkCyuEss$?hw+3$zT+rY5u1i?31Bd=3G1a^ZA$tPvLtnlWHL{Zo z8h;&TX-5bKE*o^Chd<5%V}XQohy1eTH)4|^dEkhLxa6SRYJz$I*%;ZdRN^ml3eR1F zJ)Z_~chPxl7&%!*WLxs`X_H*G5-FV2RXw34N3T6p-fr>l> zN-C_UDDk-`_7rAvCS8&Jk*^rQWfM2MIoEc66*@?EHb=!+%RR2sm9|EPYKE8WFhnL|HwDtYSGai8qDKyd6FDBL@iq75>A zN&RTV((;i%4&obtrVz17yTu^OmfVum^iW78C8v##RCPfaH!~lmh3AUMKde9Dyqz1h zTwoeJLcHY)R1-XTJGP+E{smj2vjSh6#PiYg^t8U2WrfQV?%q(HAQjtK(Bo$xSTF*{ z@Jc&6`%qV8%`ZX5Cryas4)sBfINbnK8K-f0)tM^)l^+{b{7c{;c)1drGHk)TrE&+=BFX5`7d50E-Z>_|OsMP)@hlz=gk!AFt3|y1?qGmD4AE zz+hp{C^?&&fh%1wv&9^|&H}q%JQiK+JaJz8ksohK(80M^$m&UnptN~gxtG)7uwEt; zByo7?-$fomr`phvnNRxDAp2o{DNv6mYGsPhYw2{a{_Ohb7eAcX*JL(h5W+B`D<1;D z&rG^D-1M8=b4$4{I9PO6{i^TfJZW;5>>bKAzdMa)2Sa2UF0UQH+qL@wpA`iHhi?PR zivg%n4eRJOYsXq|u1WDjh^tw&JQ6dd&Drt$AtilPWBT`tr=;NythCP=2)P8;$5qc@ zZ65WJuHw`)z`aklsrhCOqCQ8U+@$;-(d8_VlA)38AKK+2@HllXhY%e^`|N}zGT=(8 z9z$a+Bxgc8_73O1>_Q`?-e-|25|KK#E4xw6rD?glnH$4|7u95#TeRY=LJ0z%BeOlQ z190Xlq<#hhmLQgTXf(ZRnH<{)4M~6JoO?if_o~k)>zzM+3+S}x-T9Y13$H=}(qi|C zmrC!_&JTZvF|-(aF*1wo$^riB5Fxb3!k6=OSGzhjwdmeuZ>cTWDETheX$jZZi|~2J znUO$@LI*t<@ky8U15X0FNuPZY-}V@{<+j&+ag|M-YgcIR5S6&- z((!CiF7lPbI~RYLtw0?sazFkY^yizEe8ZcOig*bB&&NX` zM~ot5?fO^zgf%hFL`EQ@qknMxr)#rGwfXV}fUw*+ssXwOKY!qWpP?=Hb3Z%plPGQ#ma*r!SPzcLx*62*E+y-zba_RMT&yHmRyrge5ZJ-_%U{6ZCH@r8NgR z8r47ya+OnbFAX2rp(hyD0=Odeog1F?c=c&@NwGwO_A@_Vnepui6jmP5^-rJLLaA@F3;=$#udlC;7~%pzyGp>6bp zM>qe~hPECBA&T~XXfZ_IxA$JPXA;%qWcIEiUzQrFRgiSKMwV{D=20xq=l7jw1J%(_l-^D!{iY5%!Wj(9wZ|6o5@jXHrq29k0%3_+!%UEZLL!{zRi%t#ts7{XBp1VO;Vf>b@wt+JR+?P(n3HfCLYz02EVu} z5e5jN;zYF>NCn<^At+|&W@^1m=2p3^B&q{D(Uw%bx=?z(&=kkz>{#X?pBJ~w!5kB-IN2|_Ah&WngpgCKsY3%p?()F!;?6WDGEK2HNMXh`hZ?CtjK22z`%Gt^& zfypv`a{EQi!ql5w{_|E*ELG~*KQq0p$e)@1Zb&|KoFY_o`1Hp_kB|whZN8HWL6Fq9 zztp6`Onp!oy4Nz5|AI;OV5cUu4t+vo?va?XdwYSF_wrKkcs*(Qqli7bgTw(~tlvoV zvQO=)twjUlF1>wGr{P+Z+?lJ(rDTM&E5`rGKukE2C_&=w5XZp13R(-wEh!4t{S|Jr zI31NnJqzK(^!JgufwIUA1b9oeS);#s6d?#AI0*fj`ZBjDtW!AEU)=Es{GB2?>K34c z{Gr9TiyL9~t|LC#`pSe!ZhX}XMJmyHNil(|?T3P!(Lxx9jagsn(%XBCj5?x3UnsgG znLz)UG6|14a0r{+)Ey2A55`8JJ&Q*#NXwy(7OFJcCBdIeRZ#o`;D0^~UH;v$Ytf*9 z8nuoGoHST)g3R1LK_%4b?3s>jJV=nZK%4hFrj_6I!f4EQh7j=##I{e~#+$Zx_}2#v z5v8IyeP@NV;89kJTPFmZW@kAQOd}SnZ3&0!TC1;Xgv(^K%Ah^Q+0Hb%_LX z4q(jTCi3sQ-#4^@xK2qxDT_M~RY>$}pI=ot1;-e2u+GVtIy^y=i^(EAAXR@IT*c>h zqm2`{sba8HWnx=+<s3_&I^pnCOJ(9oX&}_WXy%bn^ z1>zKSi;1ss*ole%mzlbP9RrN`E^n?8`L^}*c&L2dFj zL{rUdiQI+RAT_E=o5;}Hl@+T}72qw2XDk{u$WkWJ8ZW*OyE>VC?s30tn^xWrBfs1* zmTnfuKv(+UlsBsQWHLQ66t{=|wuTnXyOqCI>kwhFAH3|Rm5VU{&q#!&=Cby)>@RDH zf-&`o@e6*?MXvqQi8SgZ(@7K7V*Dv)1yfa$7d4C~9-D)QCx~-mL~3i{z}QQXOJKBl zv4qYKf+8}5Y5a$|Od|(fc zq$Yy;-(32iuhIbc^Qd*ofyviOx8SJ0sGO6CwCUJ`CzCX&#d&j}5duCF??AL^iJO*^ zw#S&_^-8*mI>63rcY0Kaxy~)wZ{L;l+$34#)aR6%6u~(i=qo2-#sy8I|yb2hAtP?)@fg^mGFc~4*%G=I51f7V`zpSMq{q}_IVMHp58^7TD z{<)v6;(WAr>hu-I6W@ba1$3KjfVC>KoJhb@IYg&3*QV8jR<N)Kj8I#y+#8F#vLCTIUs!# znNt>7D;c(Q;#31H@7IJLLf%Y=2Smm=gJZ-Eun(@NWF~6%D%pKWG;N21DIUyhJH>Yn;d(D1pL5;&JUSn0q<82O&#tR0r&*aO^!J8O}|U1hnqxv2t| z%Sh6#e_*Gxw6O7e+bg}2raC6T+aJPSa>4ub=kNhYm<(sA*>VtNZ2m z4W&~H#)Pp~doSBalg8vyabfm?jE0G!-bPhTl);&#z8?vrY9KMPl|AHK2ee6;K@uwa z%%9)%C57&5@zBGNK+mIDE}78)c$S=?gkm^=6Bo@0wLkhX{tmPv#q$r~6CUHJkI&cz z{i=Twt$oFjEC-Kzk5u%1R~!QsitImy>2`NZDwaX{{`UthN|QReR8;0cXm4=+3@D;f zCgK`7VlBu;@Qe3bzc?>cNQH~ToEaM}JS_&UN(jivV_s;)lT@Xfp>9Z$SB&cIK zHHA$Fnj{sYrhK};Wus>0BPmr$T3#PFXCI8=Q>bk;xs_{MFx#uD*hbcLPqBvDn#b3q zdsB%%qH2Of>=IwLOrXN7h^4d;U@!vQ{ye@f@7EgD@U?9JwflX}*dcyJM9qh9)w9U| z9Y*_Oo3B1SiB~XiIRvDD2Y^v)37L7yZ_yBN-GJB^tAh4NB99+*CBL%Y57x4m(^m}z zBv=4wiCg_7m-8tM4cA*6FCu?#TMP2yxbh$RZL8R~EBjJqy>CgjPa2=5YRo87=jfa-j}dgn7ArZ%Pm z-iKNG|6wv@S1aw`fIfayotx4;QK=yJ*+Li0e2u%byDt&-_2|;UfSKJq>582aa3x=* zn1VTXxdBl{`53rPpg3GrIBle>fzqbfJ1MYpP%0D8E5b3)t?^->)nc?9d6ynBeLNHBndThTi zXnR3o*X9Uyp|YO$*6sdjnWm=lCx5p872go79tZttoeuls2NR%Pv8Y`FC-B|8p7*=?Y@IgmfSL@ric_&0f zMB$7%vRDJ~v+vM+z!sW;3vK4cs(ANo$?47pW(%QH$I7jdcUD|<`A=P~^+3wTh{Z1W zf_lJ14e;9#!oM7EuNcTV0XsOsJZ5v^ z+8(HNpyE{{i07TYqOmnfyvJiFN*`ac$0=iOE`WGDU79Q!W>QHM0wJ-d6!I0frHX7z z;ddyk8uu~&spsE|kkoA&bnc#}J&hRnPxa?jAUR{YXMLNn#3WOC*(IRd&ITU=%yeJriY*0;{IoLdL|o%n7K<8 zU20_XCe3S42v;9~`J*~136$px`?%FjXO0QWwEMzz7IX2PvPOPu(s^#& zcQsUbJo$cxQhGks6Hsdsy0KUq5Suh1ygnH9jo(O}g4Su~VRCe`8UbXVYAH*egXNVb z4V2q~S0&&L#f*9L@p95t~w|S_5!ncpg*7_7yu8v5c3k!N^VgvDQ7b5I%Wd zCv%th$zn#*zapfXly>AoC5}4B>0A_0eLps51KA4U*W$fI6g# z%6v>QBV=sz>ZVy2ntLWO^Euc07H9e*V{72KFpp-4 z%cF(Zu$#FZ3|7jd8MoKF&YZ0J<7+ggK54E?fKH$|%h1jMZ*3}BLoak9+-dQRr`|Fp z$OD%`1b_bRnE$E16T*SBMA*8A#anpsEiTAU!>mQz$#J7^8V=uQs~!e-MH{+VjO2~A zxZ2sUjjC9)NZj&`^8DOll?bjl=peNm45bvfRA9uq5@Kzxks9CI62 zOV7@>KzuJZi>+0Qr|OwiM}U(V`Ig&4+?zuLRP(YO1gK&SK_j;9Kp3la5gNviBD<2k zkxavWL;ZJvE1)y06)3;SVP&1eMlwVw)h(E~RQrBN`n>y0Xy$d4wDm2hat_AfHEd8D zB{b1~6C=vtX@xq~6sy@3leTbbYJGi%D#xy9M1r)Q`^<*zd=ULzfU~;7qW|^b68J0cKLN{0i<*SMQnVw6S@yCutF9%xTO6T zWMpKi^mkioTJ>1{i7<_9P|56RuU{hD)9O6U>X8}S3v^*uk5f= zxLv*IW`)GnA->DV)176r=43(S z=0hNlTj#x^*@uo-3Y7PSB5K#12~<{A+Bh5Qc;OQltLIa0aS^a$F28MB-U+EUk30dZ z7&IG8g1J@S1H#RxBFVY*vNJhY)WyJuB5_AqMt5~u;B-`4x=j=zn-_%+aIMjbW~g=# zZDYrwUs3B`QFQ$E>>H+g#WR1QxDYW5e!n~ShBVi4PKf+Qu%)(-0>anrtzsw6?nYAH z?v}(v`Y@49~vrI+}~RaNfRmCche?lJ)QbsgJH=iSC|oJ{;{P_)T^ zjHj6}qebGC`lpeaM2>eXW!MV~Qy5W)QpWVqEv*~=5sAxqA34J~P{_8xm=nq)G1Bm& zI$7hxD8Gu;_oWb@dh7>0a`_J)H3;^lO^&PfO+LMtXoS=k(>7CCht^KuUem7hf#bCFGie_!GSXln;UJ>oty7)b8yqdXOoTqn*Z zTF|;Q4j4R2*;u_Wf#8xXxsvu)-ncZuOqOB+J_)#$>w;mJb|+9* z{0-TdH?<$-n>JF_!vN_M>g51w*d6)F=~v)!))ACSl|s?uv~Gt(pP%X_zCUA1UgCOR zJA&PS;7fpYdVj7J1?@v$sf0c>MP_zj1bZvmM;?L$^Aalr(9nhuN_7CpGB7b?et!JP zXw>}HUz)O2Itp>1KdM|ipLri{l5D9%s(uEDc_w}Bz>CUR%I$0FB&Ir<0lnsU*E8|i zuY5B`GUC>l2WKKZ8i;tnyjfsC=)TtqH$KGlgLx)Xr^X5;4gZ}B3xg$>dj3Bl>+q~q z{%RVx(1UtO0(LWw%!A>(n4_i)WU3KEXLA^YKl1l=YCzVb_^+DSieXIYG#sO5(jLcs zTUZ=}awE@Jhcq5b0UqiIizHj%x0e&~tN5HssxR;BJmjnkK90I)RT8$ypnjXl#WjgW zEoa7wxaoP+k?-YuO5MI7_MFcomP4p4&v^iuQ8kbJvJFhce-*3}24vI$tMmOQQFZxr)kp_wyj3RD6&SB^p zlJhk5;pGzHPp?RPW)PonAlLmV`js8$R21h+wPLZx{s6*;1H$L%xX_COg5KWVtOlRI z$dyMq#dTu)8c(Z+#Cls7;QdBzy`YVlg{>U!#K{0J;7vMj8oRhI7%mv~&xA zTtNQg;J@-8&_Y9p%j6e-bB@o6!f#JR?P;{K0sYgl7!}wmG<%(-seNOuXXo1>e14u1 z&MnEgJ)N3bEh-FXK!TOkhWdv+XTTj0X%Xhs%vO!D^UO%`_}#yk;&~VP2xJY^C&tP* z8EeqYiI@?OX~hLTY;fg32plO+Hu|UvFaFY`=6LdnW7c-Go5-|HVLl#PaD5I7AxX|Z zHxvqEu(iS9xen!hfE;ZfUOG^hUtqvyxp`-;E;z(i(QtRQPUq9#q zHN#dhQ2aBw7U+@b&eAu(cd?DeQCZp|}MP8W5lMS10U|LY^_qjpJHfWZWmAE~_k`~nTd|8Y#w zi&TpiK%v&i8N;!bvh}Umm}Ctt-VZCDr+VgLvBM5!ql^PjgTP9i_z)M48u9~J@NAO@ zKb%~#Cn1a*2%c$Ec)ALlx6DxsXKZ1#h0hxA117nDl-hqu(?lPdy^JW6ZVg;^|2r;n zHthC288>VR!nJt1hpF>tlT@%W`nDc;8OIAbcx<&+`7{UI7{e^qb(Z<1_199>x}lnv z^4UuAd)tGuW>TD^tIC&!h=Mx$U(}|2A6-5qu1n>d4$e!iFh=KyA|FuW6`I1RUMn2p z7$b@SQA1My9c@mB+$buyX|`Fg#~Pa{sk+Z$A7^J_1`?2 zZ~4=SxoH|8AN7w)`3y>-0%TYbVQV7UgVb7p9n)M~3!CB~e)%Mc0aFnlX6Xgu0V{?= z!&{mCwtg@ia2&7qb!2F-nUFD7#0nuf!DuUQXg@cu^b4(glbqZ75j|C_cAk6lsb_ph zXFGW@=_|7DPRW@8+HWO2N8IGpj3t#qRAeLAP z$d#PHWnFy~7}U>*_>o&k2J8j^aD|r<%81=}8`ny#lLE~)ko?Ai27Mu^e=N?y0z^kl zweWQC>V}fjvr9XPyK~Z30{qcYV>iBVznK#cj9Pgw=6r`r9V-^W4Cbr)w|9uhX5@K? zQ(E6_+YFwe@@2vetqm5xlq3n#*$pICGc9LYBjg%N&jq=4#C@zKF{yZ^J_8TtZ_z!` z(?-)uF}BCk+V8LOyua1$@sJAxVP9jU8ScdzJS5f%{s!M+h*f@$1dEo0ws4^}WgNr? ze%r6OZ?)9+1EM7mwujuS3901$mGQmA!M9hyVj`Gb8&#s3V zI7A~#PvT7a9B2T+%n^>Cun4b(3x{+S{&%L^6OIU$#{YFKOsteeE_J~~l5?8(o<7!C zVc>e8>quN4CU?0(nN=7)bVz@f+l1RJPm!bvYNg&p0oxKH5fh(2hGCqD12>@>{`(Mv z?nIn}QAJBXms0W=*;)AA{z7Un+|Oq{#`l)%&8khM6qH(1PJ}6d#3;ssI4*o({EwaX z93>+U@DMJI%@Ml2;iyngIB*ozFU3f$xw+ASH5(bXm9HrMzWSbtfAo#_^1|`xCho{Q zTNd4utPu(_5*55yL^$->Pfh;K=WM^AuQeu}9o~f$6DU zz!Sld0d48Ds%X`UPm0R7iWcieY?%I|Xirfqj5f7vmjCoSx^721)pkL~bZ0ubbZz&t zxL3N?_|EW{wBc3@X3|S?T7@Jvh+ko;UOtniNfvo&BkxJg4b25GYa`$rQ-pz}`TeE_ z@}DLTIJ3x`86lYbl)mMcmA;E&?_Jv`qo*OkZ7VPY|5ff2p+9fUw z`*6?9!?aQib(WQ>JBU!U-BxJ{O5E38LKdsGdLw^Ad|Gg8+r~&>*`OfY?j@CZCiw?j z`Q*S_x|xqKX!!icgq*M`U@HSram0F!95|2{o)&Sp@n83Y8Bhk_&qz2>^2YB1x=0BS zQvrUZ2IR%Z_dt1$leC@U9}ydX@ub9J<7eN8G@=|E&JspxH9Vlvcb%8~#{U);%qYFv zBxQp+s+4flVw@H+gzD|Y1eU^^nazYNY8^bS zHWoBq#4!}-%r|)V;qJ(zH`I4hKlGuibrxm2fgHJ`C%Ye<1dX>t6>_>FIQawDRaJzs z+r+uV9JT%vWI>kQcxjz+YhIXcEiO&~Y)t4W!AD~EjUTwSyE$fE3O0(%N~o91Unr>RzdqxK8X0c=nSZM{J^ z6(ftwyZ-f?=HUAb0p6bo|5qR-H;$b~Z4-V5wMQAA-Q5UtjFGAjWet5;n^Lzs-iQL$ zc8h`GaUZtnS;z@2B7$n-YP-5WHPV)Mx_y}=&d5mmqO{BlbD%N%nj0YNAmDZ+S=qw! zrFiUzU;Tl!Ry;N#srNJosKDq_P+G5)R=f9(@=_zZ@!kHIU$T8}5t^R?Egkvg72I=R zME4cA#-joZ$~O_j2HEv^|4fxnqw^7y{8_Xy-upk_p^|8a*VF^0G?lgwOPbI5 z>0Oki44iG_#6pjXgT`OBn*eMK%<+V=do68V;)Lml^ukZ%(HkXTyzIcV7DbQJV1F82 zIh=H*7EgZ&@xtQi^w?G_PAxVOJ^`$B zhSZTun>WTVE2$XBdmTDpUFb2ge*cFMbh{sK!~mN?Qn0;vU^nQ{0p?kUT+o9n4z`sb z0mb5vK9#&~b3dl|vniO*1QsWuGSG}5#x%14S?l5{fUI{Si`k@Y>#XvnPRTK5V3O}Q z%Iwx#@6n>e$^7i;HSNI*RH;hVHpW~8|H=-s^)e|ibiCw_#8 zUN`26Mc7ueL~KQ}+~Ts8_-h8iu8i&$AkGT+;T`omQqstqS-sU$&sL?5`YKtbT<9Dz z4RoXHPbeVkI9a>FQI|%OqR;NbMe!b#NY!|sN1s_H$?)Ug6{?O_{b_DJ25=~!96!rI zZx3`F&i)mR_C?6YK8cHj#6PdP1=!*Aut6=8u=TVlCx2`R6cR>&?kW(>+ev=T1W#*= z%XS*PXzN#gm*fxoPeX8g1yI6wlvJCRpG~Ajr+CQG0?~r06POWIO%MDxA_#x8c_370 z3lq$T8GQ6Z0M%FQwF%XY^dZQlG9nE0JhkkxGk5lvZ*)0+4C{di{Ii4lo0EZb!K*hQ zFIOEoMjcvRPiJQ7U*{z`c&}%xB7w=KE1!n_T^G@xcQ%9n>bp(AZR%jR*$Ylz9b(@& z1Ra3IE$1NEGo4-W{XeSCGN7uh-NFhIf|OFyrNkygLAp}`N$KtmrBfOK=~n5K?oA^h zozh*BQqmxB=R(gp-~F@wtFAfcTVp(LYL8EdbEOx&9(&gBzX$N?3X5w9rV<;A7no0R zd$_!sMH~C0dH*{6SM&bS`POYclhodeE`tPrJE-K$I1!wx&2(f<2c@o-kl(e7_}9+s z!6J%X`t{531NEln*aiWdWnX)GJM)QukRByh>4JcuHz-a?~2UB*)31#OtP+R(Qq)9mJtz98Gy%kG~{-jJg zJg2>LeG}bNy%iShIfcnvGiyuGo2awZdCsRN^x354q07${b19 zU=m{KR-X05Z%Lj%Vm@UK4tEROmPdw^|9m4>s%!VBUKCERAJM|;59B}zswWd0r>arN z^t^r$!);0iNcucB)VektVqI<=Hhu;BYb_rM#&BNZrh|CkZ#tD+8GwM7uA_pjm6nTL zxQ&{HYN+M_My)>>U<6-+dvxV^Gn*!pr_uvLd$qHnr?T%A>n zCl&1;DqneF2(A$?c=0UFJ`@VxGuC@!F>m?;`LAi= z6e54HLFA9N#XqBSs(HeIf8IMt-@0pU_?kmg7(;Pp=}x@Kbn8)j7{jL5b&j?7V7p9* z?}r2J19Z}bH(u0d+kesuLVA~j?*IHz$xiHT02J~SAeVp|*oP{4FDf;?0s4mhPq_)d+9vw^WfX`$-?4o{S^g-CY#x1j)D|`%7*z;W}*jc?wC5 zXxusJBfK|lE?0{X1!(LQgTTM|J9Ey8Nv&Tc7SwLv9){#ws1+ejti zl}>U8a3=ORA<182xl#O`5Txtw)98Dr?$N}4yr55BNv+Mev&|^PBmLV563!xQ3l3Q< z(pMywk*}2(6)UVR>0hz@4$6&=iKEpk4QAR-9VON*>|z4hI+DPUhlGtQIZwPZ+s_38 zvOSMN4v-CEK{S_H~6hBE@XfdK?Y^o=r!HA??3Gc#mI>55uxOju2*$~MqkC;YY-<~ zFyV&a5!JG*PQLTF_WC{k1L~6MRNA47$l+f!jB$O#n9AP03-^sFH47(4t$p+GFY$X5 z6t^a_8)y-EqA2MHfD6nEZ| zE<82k*NiJJsjqsS|Es~8gM;I!vN&P?k+SEY1jf!w^1r>WE{Ur%Y8gAk@W((OnYQ+{#MAKdU%l*4Ge9lCd2?wlrpKx!~=LO zhDMCGnCkwETJ67l#7W>$Bp!Bo+5!6Y@&?O-6BOoBY(t= zBBKbd6rZUjbQ2_H=_9ULr$Mile7lIEzkJo5{ah-%)s%f38~Dt>;WG6B4YG zuv&$2WpmgbN7R6G`t6TkvL6U07jFcUa8PS69qIiQOx~LhRByc~5?6L;eKb;3On%fJ zT->DCnhR4Y>LrjI6%kMo`7+xfN&!CQ)On`qebEpc^4AeiwmM*e2CgWO#sbX<%-Xg$ z54_KYLj1k|VagN&M8-HIseefriI*KAlB)fB!Bsp{l&^RVhp-^IDf) z@Dn;<|8dFx;=TLc@u%(UtHKMFhwE(ABzGm4*ZE$UIfFjq#4x6U_mfIj16Xh2*n+t) zyv!P|kKX%5s_F6=$TDL}P6w2~?vBn)?3;T*@|`~l@H{ZiZR3u{zU-$10`MTdf59w} z0Q~Zg06Z0$X6|QLY{uFbZ$(NfZ!4-8pvwNs~ zn2;Lak`;bqEWFpcLVeAvbYr#G_`G?o;wNvX7}77 z-4K}G(qHaQR*IRHhsmuB_;ZXCq~}q`G-4NGEa6WiA8mmmt;YI=MD$(x(-8vHMnn3! z=rH;MncLY#i0Zxlf=8G<{}qf`!S(Bxa&L9&`Phg&nyxXVe7pq#@kK~sSPW^vS+_Hs zV94S4Hi>i{Zb9#5m%%#vyx-oVNA&w72sd(OFasQ?Yq$PO z>0`o=+17#1V(^t&_XLTe=V_%fL7mkrly619N&9GbB;>Q#=ahhA4_fj0~a3!~NPF6gq3Wo+>X<0%Juz6LpH@Qt3R2yQNso159&`xs;{_8X5Z zrIDC5JXMT0P#us@^?CO8Tcn)d+A0A*h|l z683TSyW49d$~-8v3~M2x==Y;>c`q4ew<#KrxqTE(Se`4bF1Lhtf^_(Y?R{Ux5JI>< z#ny+yv6*0ml=Uj=XEnHO9*2_7y)D$txA)vY`UFzqR1OsCrAv9pS~?Q&EK<{nVafc1 zP}^2($w_ya|;#=+llxywqQ%vSC?Vh!Nw`HhS8 zEox=4yML+fSUo|Zv@U`%Kgxa!A*T|%hz4GH&K6MPy4YJu&{^F~5736vsg=C9)s~~4 zf?ygdn9^=iLUmuV63n2R82q#mJ?|j`3jxX;IZikO(tJ|E6k&U7++2o~yw7 z3EpMaujqT6sB~T<{feS(HqAcUap@=PHp|%2&cVTR#zHg05xt0JTd`xz;%uN1YTwQd zevbtB+>U?VcU-61{4f&;AYl~iK98EEYcosEXhv+`PRkDDk~TW4VE}ytqI_EdhZ5C=*YLWLHTHM;Ayx0eMpE3qn=CmR>ZGeD+Fp z1K3tTK091#MNwvFsXfHva~Ll!K1T;qBfFbkNB#)LjdLsnh$th+obfR|*l=#Rd41j! zm;Z6|{s>e12%7u89yMsIavfNJtaoArM;VzfY|BZi^w(&3mL7WGvZG1CI)@qtPLFmt zQ;^(Fu(#skxf1c&!C#TlS?9+bbHp07|0gGF19CEb#lB=z;`&?TuRhBT^mnIY#)4Eg zE55fHOo046hYAX)V`}A;g@CPzGRX(76yzx;RL2LyOGmf&OXA)N8G5UEp9%K8S|j*a zsh*Zp*;W8G^aO$E)vI=3^JD1jGe-8R z(ag(rK!Q1?K_pGXpeLNs<_F>i_a*w!@+mk^QFN6muM^l$x5BlpGF>8;7AgVFuXR;To zx229Isp*;e=ZzxURRZDb3^3VS*p5=^>?JQ?cGREbPVb#JjXdDdA$|w6eSH9~Re5iVM@CIH}^8zue-J83&*1ZZ0)J8g1Ip`9mAdhoC(~PB50b?p zYH)!^1qP7K;_-ZxZI&M(-QXy@USS69aVZw+U1s;XvEm-kZPl_kBn2%88R!ReUqNR) zojL|}ncHD&tWat~XcHCBXNb8eZ+apa;Ytl@YBi2q*x~dyqxNQl>>SSj^v8u&!4Q1i z>h6+y@ErTOU)nN($$mSg?({>!vy5P$EMi6PQka*-_x%eT61N@r)0224ySs%P^e@1i zZx5&jv#PZ7=JEVCV?f8DA_ND08jr?_bqTAdK_KPS0D-$-sy&=C4k;+p3m20f-j0|t zdn?E8g>&YpF_086iW~kjQBqGKwZut`BRW5jK%fkm@%{h&NJ$d_k zGm+jQ1T4d^NdLaI*!K|?!Xp!7{cXkcWXap`K0Chgh0{~Yqhqlg`0v6R{vi6e2mzuG z(zQui@uGM2gP8&(+9&>kY*)=U_wXZ`Inr(&5&n8WKGsq#|HvKdZ3%<+VIygRw-o~L@ z+E~v6onne=IZ- zzp#krlcou0gnx5PA@-*f(DpI$F`A~kkGF@&a$Cv=2ncl)d8~)<;WIe@&epLq(w!i% zjqOXK>_U{W>|5RB?9%5s!X-}=QzXQ8&F-GITs~2F+OIIALEQGpkAPA~f#~UhU|D;R zc%6?a0d=<{5)RaDN^1{V@ydl25w&Ht2YIuu$$Kdg0zxJ+Wqj;|xD0eO&kpa&?ivfe z6WrvTvW_LM!~ZRD(0UMrE?<$pRzGhw(|jskgrNNG_Fc$7O^pU9g|AYw(;!}h^P#(! z5&x@X(Ot2M5>-sf?NnUf*Eafvcb63OWC=CoXL`0P%ALP1snZHCx6ny0X!zDH{)07B zr5S~MNqm2VbobNPQS?u)T`5x4Q7qw2T*}uup57Ei&)Z5ipPRr(HqhhM&=(dL(*lf) zzRJ4^Q;x*WGyC^kPrVeu#}o=#RLvsE`FXmHft0c_Q%v|A5oTc@M?N5fiDWylo5Ma( z71C1oV!kk%pT8BCfG9&eJ*8`>HDOsYij;hLVo?7cb(i(PjHc;Y8I)GZ6-_-lxj`O6 z&}aOQ=EtI@*DQNm`_DEe)zomo*iRKtMIDR9y?(AP+6J_XtTs@yFqRY~=zvy!x*Rkw zn0Q3ABpBbfcBJGiU+7X?*+|{iIU^UnL@EdhI1j1dUXJ<&t~K`O2W>z8$9prC?sP>_ zbl_+Bul1(FKAB2>=pwK|@Pdo})Y*|HDoi^mr}whY2QK>J<*wHuyEJ!I3qExe3YdUx zIKe7ls7&IZPX(sNATSfR;a$$g2#ZW(mie`qQ9Y7DQ(OeC&F`v;49=mdmwDpir( zDWa$+{0Be-zo~n2XY-b0uNK#9_wL8tfxR^|(!cy@Wd30uxMXiZU?{6>@de$fEbxdI z9noZMfLxg>|H*@Vrd2hdt0B~Ih~049l_7oRYfxIg;cV$yL+jY^To7aF+i2puR$#%b z1SPFICz-rWxL{|PJJWoZpPx>SO zb9cpz z72H{DI}YZ?A5e;ixjaQK5%u$wup^)qeov36v!Rd-NCXV;t|(jh9t}8t4a;7Rs5O@Y zg5;vN0EUpi)ZN)?aamVI9Ru8D_Vu^fHp50S26AkmBydsYzd+ zqGXMVBB^fp+LiQ9z@`1e!pDKst9xP$u8JOm1$#0vF%<)8kkRn{c~+GpJ#Pfi9_oZj zf_fF7x-m;I1ShM`r(l|-;?2quCr}q43IyKHi~F9aVqUXKx%UezN7Gl6RZo)m*Mp(7H1(b)awW-mPGBQ~}Yjz3>T*+a~ zm#lI~>JK2fnev39FTBfp5gm)^Sh;S|`i38kA+&;$VK?Yf2H=ogE@(iN@4NR`@V9*< z_=Eiw{GIv0N7Z$W#_ep+jJT8w)n7Br+8PbMts5hzz)*?7gW1^m^pqrKk-fr~i`V34 z>1n#cFTy}E_~G#(vqNoe-{nijR96*^Sh(x}wVP)EJp;+NN`Ww%$$i!^j6l1GLfRDZ zo#dSkH*jjUcjLZLGK~k4>A>shOC0tew3?g|z24vp>%ZJx27)!HyBvanmwqHPLyLP8 zwL!p^r&PCxRBJfj957M&Nv7@H>A-yc_Ez{Ug13zw>+#0Z&%BEr5g@c4U_-t2fxGyd z?x6lNntT)jVgVQ#uoTbf@gxm&H~(uo(#ow$LC$tj9OA*}_oj_ZNRZ?g0;MiNlazYP zHMTldCdLxD%qVt8>^`kr%`Ag^fRAx1r}ECW9;OQnXlUPz7$o&5Pdy ziZ9~3?fL$>4XI8X@3+2UpQKSUF&!Ky1ozJz-aaB37xIj zrC|x<%X{^ipX&Z_JW5r9+=2W-@NYW-a6DeLAqbT!c8J`_WF#GSe&1j`Y-geF2x^fG zLI86^DA_@JgzGP~?U6L_=x9XxYIilKTNo*C}X^*#NHvGSHf`!vK8qx}vexXm;nf0#&PRx4-f@UW&L(W=-xQiSB&0YqH z{8%51nx*(;-xz#N70uCdm>f71(8&PNoiwciKp7~xtEop!Qdo#82VqDMHa@?w`AUaL zLn6}jqw;{L?h+A%OHi^XZwLNbg7g|xty`GO%DmukKDoD?K={6iJn@(B%?r`!4EHCW zyP&~D^y>bGmDbE}MCQe0;{IKFgdJ_Ye4UNEKd8B@eEd+%M%WprP=Madj4xtO2s{&7 zp}D)ku+2DqRw^Vrvztc(jHGTNzZEuz6Knc>RRb)LF-WY~pSF|=fzz1F$~=fm`OHF$ z4TwC*N5Ci^G*2{m<-)EP+k?VnQU<6>j8%}SqM7sF?n$Z8Cu_?cKJ#frZ#!%<4*2UCs(UW+ec4J*xi{`)C4df!84OSfYiQC%%iTjt6AeI01? zXKkZDJ*GZx7@D~5*1f|&jjlny&+(rl{044BaCR zuc)ZV_R@$;Q+t~M<8=&C>}GS;cS82xn?Y+q2rbMZje%Q=Rx2Gkm?h7Hq!uR+F0k^d z%rcDFpnBFQJ;RIhO~LeJ;y|RBp#q^vNE~cJ(I#4phj4o zX|(En=pYSB{9l4fbu?Hs8lkyB&UVMH5==3RQ?)|Z>z((Ph8ihzhHN$OtXiI;;EWW( zB-ng)Qjnz;`MHz&c*8n)EUWL>`J;623)B-1m6~!tClq2`yXRXywmDb|+x(<`Oma_= z?8yb6sQenA@zq$|$z2!y#0eP4c47!B(C;uM`>l2XBZ`P`SKj6;(&WH*E1w3OhSR*f zZ4kYmKYPHs`H{1YCOQ2xwIKb8dm$iK>$Mb z3m{F{qyBAvsN{Py7+arOj!^RYLevIT5pDH6XrSi`>^lEXAX>=pm;XzFmQklx8pFQZ zCpqjL(f#DBN18THaRCf35#vp!^hPAP7(>^)+k-gtOGQ))k z{4>k9_N`phC?(IffOe;eylA;~2t^)ZC13+qLjJ-N>vms|%C>SM;7Xy_zn3(7!n$#whmq=r7$*3QYH%CGLHoFOvhkhb;ycrVHO z1-}8@rA3j7xy;P06M=K}?8dM>olrX7!DTeaiU$Q4&~ncX!NL1f9YFHlirbnTQY+r> zVA5EN>WBSoyu~=QkEdC5pcLd-FzlAc+R&1MTSy}ZS4>ZgM6V~7{D=z{NYDVv zl-CfP451kg6p1uoIvM@UeGGfBCGduS-s|-qH|pW_G0AyvI6jX<5K&MhEj@-#i~f&j z&s+Chml=BVdz*u;xu-@m^(_d{7K697zE~Y-jxUZ>*;-zjaw2H&{I7oNhQeq=v?M?n zhzO9EAmX(DjX0`qvIg+^CBSoyMYhA!JeTnf3=CwO*^ta7HT#GWi_DIBf=gDR3|pze%e0WSXw1RI1sLE4ICGs21&}&0-J7a(fa~U7kOWRUa=-BO3Q%kCVy5Apk zFmFXp#_4lxB((h9#4%tZFUk2v@6T8c2q!9zzC}eHbM-=04!}bJGdQ%RVSQ2c3PyZt z^SY&AiXuzabfPw`CN5K>rh$whr>=(up$JbIb7U}{O3-@-^{);7@LHT*EOmw(g+X<# z3u}67NiPRR)3uOF(Tb?hd=g*P%ajy75**BBs1y6hdkEnx&<9E!Bt8U|g_752Xx#A! zlds(Hes)6}K?t_9B@8s2A8(IP-UK8t+X1Ny3MJ*ULiOb@T4G;j$A)u>i)tIBmWoRJ zOUt!NHqNZUTn#$aE`kvK(p}%(&Wojy4sHnrtamSUZw6U zb>A8PL1nnPw1g0!;u&C(FFUgA=#tK^Ik%2HUhSr96tZZ$!F8MYfWV-gLqNa1OlM@8 z0Pcl(c4f6Opjx_u0(U>d&x{M<_@81GKkJw`mF+23X1?DE{Ab zMe@G>tn_(=1`1dn1EF-m#w8%fu4tL+nAZCaYrqD4N5g$7{wxWRHG?yn*}y-&G5c%#MEAEo4KQN^7J)w4DR=v?QLM6$9Zq5@>aPnd^iGv~k zrM~D|aicn~>vnRq=@aJrDd$(dbTX5xF)dTn%`26H(PkZTKpq59F{rs|9t~lPOXjfr zE^=ImB}HlFBrIyjx6FEw%B=#;d{}rN5>>>>iR;pS`h4%%Nv{T8SXD!(!}gcuh^(tp##|;+0T@ z8qQFS+JqO5ZrSdX==IT1-h*_u)^#I6R;yhpy1^Ib-jq^c4Ml~o*t2P#1zg7XThSg=4Q62jpD_x%^4?pPyg9=Gr7UGgK8@xL3!l?i*AHgd88J|(%DkK2@Q;_{^2QWL z@Q3uL_7tH03=!DM?rpCG4N@u90)^PIT=StMY<$zULz|YYxq8ynLSI36fwY za!es$w7@?7M&UP3p&p1X@h6e=hgaBaH>3Wi@qMl^pMUvu$dp=Xj@~ zimie{#zs_tENhhZN+O`8G;1g?E;&%Rwk(C~slBzbvPC3|;Zo2k@8}R4u9VgTqmyzJ zfB$ziJl5?kjFS1WYLbILS$lUn2n`;CeHOp`BYz%wEwsxpY*fDq~0#>*xB?yUG}kG!2-& zK%AOQdaV)UsJ%r1FYB0*Jk)kZ1AVHlYxTzBPWtxWNQ@!3Ad}2_bQqzd-x8Jm;-CL! zdUS9mu|c)Wx||CpAxL$yugx~XfzXe23{e#itL-wHfR695ItxI&&N`kr3$eB6KLwU? zkD-rrFW#>Wx=}28`JvormzmTT9g>r*BaGz5hRUUznrVp`t%6W~%lj9T_zXcJ{AhVH zl5lU93*Mp5y%-hqJwUP@^%58Jp87G$93k%eZl>RiWRk>fMp!G@z@VJ9$2jYlXp_Xo zCV4Fms)s?VLL7(A!bt-Q?+$%J37l&;>wSEfin{L?F$-mXy-|W~FmPd*yL<2j19&Fu+pH+jsXIKd zn#M15!Tw6@-^X&`h`bkZ$e}3Qhhh`x!36+w6mWX9{C}rM>O0`{Am_B*;8fqf14Fle z`h$R7@V9;k!ua%1YEiW@!-inN5dH=YnjL6}&wK)zs7g>PJS*f+dMm#4gjsQHrSJ2R z_YC*Vwzq4uccZwSg~MnTU_(j=JJ$~-mkOP|HN9g88 zH~B3UB;nj1E4cYHXP`-wZL{Np8N|bTHh%eGFuys4YhGmoEkF9*i@CT$HFArlJ_Wxx zN580RpRlghWU(jEK&BKQBqX2+^62G!JVjxxeL{~G)X2jqKHIQV=g~X|YcA$8I4fxR zLI^>y?UV7|XXF$i!vH|$5Z~YC<~W!EE!aFRSx^KB7OoVPX%Rjk57~qAlU9nI-z@lH zS9%^qL}4KRQK5|~bXL)& zsns>_{Cl4E@laCX`KeQ>`TghkZr(s{C=tUYz@JG16EzUCMH|iOVan5b^r9djqK{ zA2rUiIC9{WPz3!~$WdJ=G@7KOr}P2M(RkLjond%}V#fzerAgJQX&Lp~?w>YHh+r%Q zfQ}n0`3H$N0QzIWhK^z(E7;4Ef&ELt>!+yOMR?AAsfG#f~nbeRs;Y@XEZ>91sZC+ z+CTBAK;YmJR)bo&ph75XrYmUEoAH6({rwW$dZXE#P8A}xX8ZBi^%`ug0;#9LTbJd8o+ zPW%ee-`~a7Boxvz&KnO2d*Rr)KEG~aPh4C0ll3Jccg_;0(VCLmr>TxBOP9fq%<5h4mIVhU-NXEJX7Re>B~9Ndh>a~5rAU= zv|9T=E6v2_;obXs ze$qi2vVGyg2C7z}?N4I2HSZ(6X)Q*ar`IupAW`ApXjUEky6J^O!sJNWD#`v77DnDf zC!k(M4{i#7C?QgXQ84B4<%cm_ii74h|Bu)^bY6SmMugOdXnQWV20i=rq_rHe@6sdH z%5H?rslODS>KJ#WXn^4PRw|keC{NWvJq=2tk9CBs=Y#w3SI?*b5ivydvn~*erwcN> zq>{HXlC2j~4w=IRx4fNM)0YK5Tl5(Yyt4$oIcdb2!}6s7&xhH(Hzis^a7b_bV0tA0 zo%;fiP>TwWx7HdHI^v5a`a6cVmS?X7mrF0O<7~C-1P42#OH>~*7jofsN`I06`pR-K zoxR}P8g7ow;o#IZ6(m1@1E$?K7r4{JhYP0hEr4+y0mL&=p#4@fMhJmvpCsWTj+C`*14?rmR0{RiyaC=q(MpCu$b8#npDA9 zZF@`Hsxqf{3U?-Ywd*435+uBNCzs>yP=!85cfx;Mi{-!Yl3Gq?Kxn|Ihb!x1@F?|d zKHjC5M%d?XA(13zj6+9h78*q3IdCXNl@P6uKV0s`pS*b6Y}z~Q_R`VKm8op6R(Wdr zV*_n4EW=<#VdM#O1HY>do*1qqvkj$F_WDX+Ar#2E-De(>L4gd5%@+*yA*L&6 z@)NE*&R%h?Q4IFcfW||V(EVGRvfM2iQ-Mv zxhjXpcKBD1M<=Qe3&5%FRjYuwvq9w?87SbetM9?-) zD@hM(aX!X$+)O*rmFiSvaSe^ShppH=MAnfPUpUJw1q-#XI8|jKI(amCIZ1YNfLh{o zb1KsZZo9cF<2?$M8ZhaDf1k_Y^|#wNnk+jN3@WO;Vom%Q^83J2iw=SSUn`R5Ur*oB z#;SVfRQY^jPnhGU83*1P^#ce3JpOw1ni0Q;HS_2cc!$QOw>S8A9P&atpADbX6Pw5Vns5`8Q~} zE8_oK`PhL7cr@J%tvxF~#*zTLQ6T;5T21|qB5kZoz3kJyt^t)n`x*Y9Qk(=pPYZ-y zP||aEBSmD_8x>T>m;Dqih4H| zW_n#R2i)Y8_n^nz#fN=C9{5#SrUO}OS5Y%pq$m>3!>ow&H|UA(Naeb8Tu?t41iK@6@_G;(Dw~P;RUvZ6gRpx{aIz(`=iO@vBPY*Wettb3gr}KT4PQ zy7Y|_ahnI*^CyP(wF6|QO`}*E=Ep)1$kQ7BmljM?#Diy7`Hc#q1w%%2{xep0Sarb3 z><2XaRwiX^j=^7V8{;8j~B=n~5Tl%9?y%n|pIm zyo+Aj`FtJ=@+m#!EnBO`w`heQ@{S=lSDwIF^fcX=1nK(MP!v5oKiX{7t#E(cjss+& za>{zpGzME1zOKDLp7=HN1Q-evJ&)EmCWEnbOI3|n8U_fiw3|AWo!vZe)a%$`VA=>8 ztx2PsVRBnekJ}wTx!lT#)A4t@ACY*V^+w3MDq0vkJN;*YhW_@7^T zojaY^P-}1fdM@66mc1NB%JO-Qg)b`Wq!Pcj37)L}-r~hter5~PnBa0OKg?)6l%|My zHlXEcSqB}gVmv%d5$4MD$iwqPqu08NQFS%P;klXnkli5HliC0pJAPBfVJ`YS3$x6R z+ZPG+O@vm67piqurWccDy)&o}_is|c2 z?x>XJ5s(V}DHe@;M8Qx5FrjWHsbkULQ=|PEjz=+xEAb6p!3|2Svi%HB%NU($)$6g| zdr}j8aX<2?##+BdH~Frmvk5o)1J(?^uh*N0EF01JaZL)tvAB7z~P^+wYz|%_$T940*12 zJWf7!FlQS1`D5waX&OJ*wdk9hxHy($5BjKT6AaW3LuOAQy|5~fokBKL7hpr>9YoM} zVx#-ZLmhm_UhwnT!+hn!C}iHmU*1I7*>Xn@3bV#1BA=l1%}UQAh1}OI7dyTuuh3jc z`_TR}BIy@EsQO$ZcrcwBmmn>~U!E{{C3lfLV<|yC?SqdYZYo1?ZmQNuvw<4! z*AKy0{(LEsmNlzS6Y&@}xDF}R3c+z5_6T=Q*Yh@MG1p+^UWP&3Y+Q16$yP2N z(!&tfFnStu+|Zc!{W@m;Z#G=ke`{QvSEi4P?#jAp^JEOzWt_Z~FD8HgEs$w#+*ET? z1T4Zv#t~#LT2~)-saUIIiyEplOc-u6C05YEffLDkv)E*u}8&l}9DzMM z?Za4z6UB~KRjWkO^gMsa%*;HTO1pfT ztG6liJ#&0KGIb$3F_>809=G7Gv;3_n?wMh$%9E_Og4fnECNge*@r8Hc!=;07H;S=H zdHk^oH4v`&HzyhD24exjyFBllr`r`(#X4%cnCZu~mXb&k z_TL6dB++nZ)2X z{TmKb)JhWR9i=J>-{m`UABuMrG?9KdNcS_WOyB?F#mmR`Dl{zX$Pb-H zxD<>#@R(Z}+=0o98qV=>r4fImDs3qX8aMuD>l52{+lOUq@MlpOp5)K)?n-^tuur)^ z-K=cA7+4)BoSQh9C6?5=Tn~u8?!&Tbl_rIUbp4>2#4EM0 z{=0MSf%UQAk6TI65A)dgJC5G!pEu^TzkI~U!7vbnq+E6u{PUOtosB%x1?R)VM1hP_ zku|?>RxX4B#=CqP^-)8=W3RLvFP12Z{0Rfa2W0LG5RA7cqqhX3lS--Wz~u?;lQ-&z z>^i^kUJ{e?kW$Yo9}_<6>N`$0Oo$RAZtFXEgxglgcaDvGd5EHE@XndFR9Uo%^~^>u8c9@J|=Mz-zAs&6&u~Q~x|zbu-}7 z{n?95QUCz^z$^lI5mYrhN|nUcrxqgEhwe5vJEi$Yh=5mwVGyI5#s|*OeNbS@hd{Qo zb91NQ%sRK@JJh?2ixGux(>^ov_4^Uq(h`ju9OJ)ds9Ns9JuB|0W087bg>Rd+mTmF4 zu9(bK#^2v4|XgoTIINgte(MpPvw{`+413@`#*7Z zs%VX)W*ZsPN=@*cnKvu%%SF_el-g{aJ|!xrS~q{5O@Bvvxod3gaj4R#ju8b_LKQFV z!b@;}^p773hf~*)zkM6!^(t8)V$1Q*2C2Wr_yR!0An+6VBqa8HFIRYK4CD6(YcA_U ze>XOw%JAzryB9W9J3_ZwA5;ff4nEuzD+Os(e$wZ{ALZpLbJNqKj_vxMpx4BT%1a!(E7eEN zDu>)ek0JKqxo=?Wbk~#*Jzm;R(t?bR@+{r_j>wK&9B^$KWbAxeg>lh___Og{!zY%L zrk35;(+tWT?-7U@ueGX&f`hng;-)E}ARjjQCt^g)e|qO6Zy0W8LL+g>Z_I#3e6QNu zqqfHy8g%nxl=w-+=G8Hr%jg1b^yC3@QW#c8SZ6s{O$eM8LcnQ3`4T{CSiiWaZ+Vlc zl#C$`^;4YTQ!{X)kOKgLzA&LUb5rn9;O!yu>ssN?*9#wYQ%|a!mOks1a*;`T^F@e= z9Pm=dep}=8z#7ubg6loaa6tlvuLi3tSwnaUa>iR5`#Cdf!Gnj-Hg*l3V=>-Mkr=Fu z>55y+7?%z=SylNUdLZ$O>G+;PQiD$LX2;JnRllM7p}10d5x-`u8hlrI=kIajrhY>g z!#^8D1z^D)sRyd+X`1Jn6+d{tUo_D0X5mY?$v%}nqqs&8DrCu<+0$A#Nl%rcCBV1oFVvo4qZ(z|Y{mHz2i`pxCumrch%GX5&7Q5=h3?tkyFhM`VYkMM&U>y^>6pD_HGh+4dC zeEFl+gG&pRO?HN#mujEH?n|Fh+gKOvMrcSR4)A=vtOCqe2-{=*{>E{c#8+B8U~+mf z&@^0LUY?fFD@92fa`+FguL}7Lr0WF`RP`q*C^Lb-%EeoMb!; zJ%oVhd3T&{!MWe*TQM3+* zv~oa3j&+z!NIq>T86a1twp}b;^)Khm(r>iAV09;<@R#Ko&Slf@TQ-5 zBdCSJD44?>Z)8UssGF;tDIA2T+$bcznOeUptHz>x(fd2}=W&((A+IaB9)|du_VK0J z_KcvHK!z@3US?4-<1Oj0e3Mpvsb}x`d{XS^ezMcDx;3dTqf|~Dl%i&w(Ofsl-#-(y}yv$ z!!;ZeDTb;q8yR)y9;f~o;VhVPCCSUntH|)*qY-cPYcH#-K$O16T}U~aq)=`RclBjJ za~O3zN3w@wI}m=IU2TSpr8oGLle=I8bo(OMg$8oA`}`!~og4wwD-h~miQ`noEW`mq z{aXRl|BM3q((1ynHH~tS=3N2;0<-n+k!p?ZT%Kn?;`N2XDcvk3zKxFJ<;Pv!izoV= zH9j)*1f7Lz>G_$MKX(XG9;bJGi;qs#CmytRqOLKDqSTTI8~Fjm27YR_=^B;rNv_Ht zgdco9&}g*yKVpwVMYH*C5%Zo*!!f1o&s7n>y|$zcV=~@_O>U#Nn)WIL#kOR+PTp7G zXqC*u`8L{kV$~pSpYm&uU;ib5i`sk8jo;m=9uEYo+DcY|*&N`hw^DY4wU}s^q-~|o z1vspsK3x8a;mX;Om?=OI-=tzne$18@$_&B;6G;xMGsO~p8i{_!(aU>z^8%a{aRsp8 zYm`6hIGK!1)`JJpxWr87k}6LL@iZjE&ZRsu5aQ@69wM>R^NNdMS+V+~DIeM#mbV0# zDGlPBJo6!&maM{k)%Rp`)ldefU$RQ`ZDNK0%kq{=X@5Lv$koCcWu4PBb~vHLSe<=K z=aby$KX)e4Q@kU?%liDd%B{fvg;zn@8UgA1iZ$P>=_E{Hd-th}NiaNL;8wzq^X6dq7-I^9@g#XA?a6O9I{ZXfuH z_uOj=EK#8uO{|eDjcVq)^!~K336}|*4u}_QP25=zqiwjKSUkA#H-J3X6KjMm2gdA1 z5$M;*5-K_`QFg&eC4PVw_2=?c^}Y}7Z@9Ynp5*d5;@I;}AMAr@cwUo-9jhyUQbw0G zi|;B8+dye`a9u>`6St;8kjJpLB!`O;_UVK?)5)pHtTY%TU17C&}wcf^TbH_XE}UOA$WbeY~b8XB`-TXXHCa zyMZc@ZH%C$3(lOz#t zJaz)IPFTO|E!F0h<9uz4K7J(DJm0oCWaSG4dAYZ% zqISZ}@l%<)E1&Zew`15UE=)*@VVn^m5x)@QOEK;+3NIB+AT7?YKVk#T0we#)8pc<- zT3A|6)RVuG*}1JH099+(jLN)pz7?}QxnW8PNI<{v~ z9ggiuj}TX4fpW=rJLjOvnD3mWgq}13>}$O|WJ}(ur8Tio*1}2R5uW@%vc58`sz%#d zM7q06I;A$8_n!Ox5uZo@ES@#j z9AnHm$3UnvEpK00V*>hD$ruA`&AZy}bXCfwJ~jb}J_O~TOKQ4EMXNzG>Di-p`-ze2t}f?XEZy7A7UBi@*5H|F zqjFvB1WNTqtpN7zyRn98vFzxsDzI}@%U9c?q=tUx+|J^;bpm>Wyxwh*v5uc^69Ek4 zk5GnGiK`+r?nKb~G;+cEbZpF;s!pDMCe@rD@Bym}_UCA+1`(GE#C_*%G-LLRvNvHz zaQwknQ+>V=cNkT7JoVP(R#(FJ9n&LV%H28eyCZ*f8ynDT0}Rq`)s;W_eryNw#2DzA z56-Z=;87lF(bjftv!*?BwFw5`t%G5vT&9O3)a^bAW zZ+dkH7`wOcbcC-GhT#sFg;IJ?8s%o9&4)!aqeQ8qIGaZrN7O2HORQdvgHkAh8;E0s z4}2o}fR;ZhQPmakhM1K7*S6%?kdXM-7`F;mXc>#CKy!(1& zaxs5;owTUE`|xRC9Oa%g{Q=js6NQI`r|{+}Z=#CrX~lP~w_!wv{$nWSpXdJ7z`6$w zaO~@P0IW;#6IjPUXlh630LOjcP!Q4dDR}kZWMtMUz{T_apF=@k)_8*ZgBZoLRp1~j z1yTG5DNd*1mm2GCxsZ^Mk{-%%xl2tm7n4d3%k2J#nwrIa!-KL#uLLJ|WUn(w9#U5r7G5Gu}bMEra zRm>b%M5yoWP?9~cv&OfhBLEp#5t?)Cnx%nxAyH)S8;LAv^hc`Is1y5=_b+?DS=r5= zUR(1*E=IxCqc4EBcZL|s5UsyBie10asr~XEt-`N@ z9kAkzXcOIBtN!Kx_oQ5k2ylFCKVLT9ybb-80(8bIexUNa9e1HmMF%uXhvDX@GwvT1 zOwoU?QCmNk&g^6!MMRtWsJ zvS)_~-4G{%U59Q?3_kb2s#uZVGNy{oT_B=gDHRuMv%`oYbl*ScX^z=%hm6_sp)oJu z5_7Vq?{(Mnx<`61Lbhg;ud+I~VfGk8R$OQnvjwWkagOJ6l8+oMaUkOFY8`QD8Du~` zB?m$0{aA`u?g3i}o0;hyvS&FOzeO{6-tJJ~xD!0t0Ey8P{$ddqaoaVO{_AXrN|j%! zi2I}}PkU3Bd8K<%&y$3RV7vADsY!YQ0-hq}HU&c4)9s9~dsr2DI}_njyFlzw@aYIe z1jL<#tCO+naSd?&RxL^j5Ce=X5y4m+v&6&2@|S-em@%T;bKZPiScnwef|L7oJAX8q z?_Mw|)}C9qDZ_1kCYv5G=ulo<dl*Kftznf1Q>-*^I8_$(%eSp?nze%_ql*)LNqeH3dV2Wi7-&)*kLMdeO#uxSubAy zG6UHRkiXQaP)&VB_q|Uf2JD>qb%sGBbM*N1INO}~wcMtnRki_;1@@GRE%@-^F{1UR z3nO$Ts*|nPls^MM=0dVKKHWQL^YDh#!TK6U3n9T>73Ew`!%&FjSwtUkb)3OsvjD!%W#YX%@wv>cy| z&UGzIknbMy-|qO$Z9c`OUsLy4J#XGKHUy`gfYRFoNI(F&u(!tVc}+cO{jWj+m*f)@ z6Y-g;As{28-CAUFn#>lPDHd348f!-^X1Ln1;sE8h!LMCx@v;;Qz!C$&!R4;E?n3C# z3f3yo7QyT}f~2z&1Pl8uT_4Bc>VCFVgU_*Pko6X(JdwIu^P~8RIj#j4@>vDlf$3-T zZCBeo(a&>Tv$jRGaF@&vNbcD8dD1i{RlU_X6DnsURKUQ1r!6PiTu~yu$!kD7?$s>) z%-&h?dDH~+1sVRdI6Z}0NdHJPYY1_ z$jbV4@3aj7M#m(zwTIkbVOg>_7Fzq1fxfIm+74oKWfW>x=VAYRtrYO;x}RuswZ&h9Y@|_0H|P zci+@~-fn~DxW$IV`t8{Fccm-z=DahX*SSc=vA4vL$WLkw|l~m#e-}%Gl-u(!6iFB`kVM;DdOvb zB$QSwL1&rO7V6xq{GY^4beN?iDVspr7hq3_?e={lz5=lfFu2^5mJ<%fpMqBdHhklo ziEGVL91OSH7M<(_AQf$aPQx>YwE=+`uk#Qy^@j#kMaHxMQ4!y^%j6O{D~S$r#xi$c z-}EOXjc)+yeWuLl>zSVPBL|)w?M%T>lwUtY*ZKLe$_0B&GFv0b>jk%|hGwKujot(WS4G4;H(L#tpfSJUJAyY< z66~msh9IDOojSfSI^cxa$zb)? zq@)2!51A+}UJ~uaMYfFR3%Do?q8+5<=@3*}7S;i4X;?mOl@1L{w6#Ovp}fveSC6Cb zihdmtU&kVvq$7r8&uxJdaBce!GCiS+?tailqTOy<26oq#u^NJ|vM|tq5$PGV11783 zZd4LSRq{xA0=Cr~X|VRL|6ZdF0bhl2^+#|(hd)KYy{yHLuWG;q$p7|&R7(01TnXhj zNOF-j^!~x}d2e?&l0cjzc<*UKHHO2?_Q#_7nU=1}blcSYSZPCQ=xgRXmX^UZ1~Nv8fS|yoHS{=PGLs8G<=QU_tba5du^v5;sBPBb zVAvUhz!mQgzMcDyw4+xQfA>yb*3YJ2SRkl{@GYhP$FAz0Yc;ib6EW!3Z-V2*M>xPx zK|RUZ@5daYYFl^goh*=8krFlL-V4;$lP!SyU*Ux1?RGThu86Jur>Tmw1a<^|(XUeK zYEr3x@utkoK(?eror$zsR6h51IslzbAzs7<-l)P5ed+d)@vZ1arZ@fews6T+ar>f@ zUw?~a5RBN9U~v!i8K_CmLvq%oT&tp77F~^L=SUp@5bo1j9Akd;?6VqpY5GWocJ9U# z-Ha?b$m7A@#P8(ELkmQQ`fm@d-?m~rmeG{jnPow-M&1qYMJedTtt$(z}^fjbu*H~nm@)2?Dy47x(;mB1t zl$ib8&m@>Zn*edOOgD~r#Vn_sAKf^=88y}j0B`O^xx5|fs%jLensX++SWGu$eC@5m z9c}jVj6OrPsflWt*!9`J?b8PrBqxd9G6Tl~@EyW&BXuu7`QNZyp>`_fEAY>3NmdvTdz6 zFTSNpB*Q{%QNZH^l69CmHa>9);>Q$reFi^K`iOY~=(<%!g~n@t42pO_X^Eu_;_0r? zuWS>Jeh1Z})%_Vd!?v%BnzTWHw>v3)~eAH52}DFgA!5!df`Hn+ICg zxOiA}UmEDhPZVO7tTAEMDSz3F2mvpW&D0fL)gk~}N1>kr{HrlG^rQeoDc%qN0h0CX zd~J((l7^P6ajY{Fbv$(?&-zSjD^jL!(H^U@)=_`Ga_`Iwg#t%k70CCkU5cn0AzvzW zOOfr{L3>~AW|z(v2wuC1Fnf=w-dgV%)U!t zvB6P{(;W|#>7C9e3^gYvn5bk9O4j%k!HEhcr0=w((~soiR^w9gd59!?!Mk_&E)!Eo zZ%Akb|DyGC7*|>Ue(H`_q)YZrdniD1HALlP-|CAw4vmDeBlywoyA4hI#x9ViPMOvZ zbWYn^x-K>v@UY7TqLcQ2T_8g8=|BWJ(A*GbR5s0&s^lZJ#VCU1N@iR9cM94zvMT4am|^?V+< z1wNIiW{pPz7Bwc}5%y=H?^jZ|wwqSyl0QD%NmegrIWhh*LOnUPcmD~+6IRqg>JP!v z@XyOlZpas;8J0W{>|o-6oT2`0OTY5ue%+swa~o@A9%<6Pl4GeF#T#hFx@MlUZ%Cye z8xD>Xrs72vnO`G_t|BQdIYROgBLr_CL~`>D-^I1{pqV zOFOoKU+}tWb+47wH`hYhvCW^{Wk28!C^2EksYNGNq7ujo+J}*Y70T`P>uS5_+D?%7 zIVs>?U3F#iBR=ID+hAV-0bKI-0`O1L2oOU0*B}iDA$ zNU~i#VuaBO_H8vd83z3*rRTaIs!QUm>GV;5hL*xYsdeED2aH0Mf>3SbSaz@3Uzuq{ z0ho7PBm<#r$MWkfK0@8giv3HuRDzMH+qt5CHUZVoS4!ZV^-J#@;w&?Lcy_sd`?xcu zt+Pif9k8@-{T=*FIdcZ}P|5U%jmD8~E3_>5pi}`4_a$34cI#knm`Ril;y9DwnA7 z8*mqxT9hYAW!*oOG~vDhyqH2Na!--V?%6>={tEc9JQ(MX-77mE zAaYrB78P*1M}{hBIK4sw*1-Y$x<7Vm5g(nIVa>kRuV(8<$ljcs3PYLz^kg-6_-=S~|yi=|6mJs)`=~|BnZs-iV;JYKYd#OVE|)*U*3w22`aQXS(iC5Sey(7ln9#?t z?vz^&_}15nj?~SqtIyEP`9%il;uyL6&<+XF5pDU|hNuNLGR@S~j5_!IMnHUC)dXg4dgWuVrK8`Sr1Y1f|89(UK8RDZ7<`06vTP=Q%r zCLKk{7LS`P!^zNRc>q>`p}>;u(;^cxEmonu3|%_5+JX9{C}6cN92`!~ae#gr1eE4H z$p#3amIwK1yMswY)j`|f>O*jCJE9Mmh&iLR(v%en>=;q_^L-c%a z>cdF=s=Onkf)5&MGI{*z8Dr#y0(oEaP57$gmzK5m1+h5O3%0j%E>Vlqygsgd^o!Zd z4;|hbs>%@E!jVIxk0SNu&1fM46gFNu%$m;U1rRDI?8o=Rp}MH`srG7X{@{)i%&aN0wYUMGnG`-5Qr=EyP&dH7ZfxTA ze9UK+*)_-K84_E&%m#Ig2+B9pIkp1{TzI8a6|jT_1F(%sPg}-5VBNB=p)V33S&2te z3-<9D3N;=!n!VNw*!Qu70qcFG|KoWxsZU#T^c%p5t{yKm4nAC5fx34eCxaIrlM=D3 z2)7=bTwD?nrJ|yue!Tbef|+i`npFJqA})s(=HFJB00!@5_Qi*ix7MUzkn)2+JZ}ow z{8bONFCK&JI$St!vWb6S&m##JFuy~C`0SlWsO!|tm-jqxvJvo}d*$Q@E4@n>2ggltXE_vbl% z{iI;SmPWy!MKVCM>EH;i zz5_lU$Z!{44M%{Pp0NKN<$Zlw&j#E>fNY@-OU?T+!g1cT(wsi`7;a<>XoA1c`Ux7d zKQ=GfXLuE#7{r-yNTqO3!ViaMWgD|`GnlOkPD@-MPr1>O6sG1lgo09B*o=T zV3(!gA%H%UxdJ{i(v{B(&JCl18{=jq zF?;zTRKr!eYHfi}9qm+BmLlVP(e>@NsNz-88KheFy#-Z!{wLsa1YWF+#qTk|5PH98=yBlZv9vai z#=_^FWF-5Eq3voJ=LLPphnFBa8We0H6uNpkI+_?&saGg%@<_7SMH|;S9t@0`1|w~0 zX^U@Yj&A3U%A70@hXl8l1xNjI&axXu{UZnZNlnJ@HE~Wez6v5Pnp*VGKm5eb%gfVK zFDZWUVn|LEXf79Ml5y4AW&_ccCFA0x4M=?gN{umgAxdpj7y4l;uPgesX%;vcx#4H3 z7g$l9ReZA#F*u2~V?@2=s{z}>kU%imq5VnDI5Ox%5q;z;tru$RTPp9pCn z^Q~F>eDX~OwOJEIo^TFtOkk8jSFuv2mghP)U#gS3z@Ww0`wnbfDB z+$c|ar7Tlgh`Ze|X@)oTecda*g7wL>)RuL3+?#yrYgA5V%s;+^DxL-1kbW)o%n%Np zQ-wxPT9G$3WvTQTOd@X@)4<7-E{u}qNgu{3a)^Z1vl)*p2oD)Lkjn=gzm9OYR0yYr z3Zt~G@ygLdas)d*K987clk;e8No_y~Ew^{Ds2Di%`++Vz-@7X+LV~8X-SxAP>vnP3 z#?}!`m~F5J0egsZN8=cF0l@%qQ!!G*pZdof{Rs&Vk+|#n&6BB>ht^+*!GjPTf*o}b zW3vU67di)QSetZHVbNz+EewJga6gz z%Kg*~SWwp4vvRLobQS-UO3t5N_}QcfL!0?t7qv-{uP!vXJ$77a!p+}en_7BCu3iqg zs;OlayldI(O1v(Zx=;b9q|H{0E|N%V%@2<>)#={q83Ng{3?kSOLEi zC?Rf1YN+9ra`|o6p{EL%ha-{7VGk~b<|_L=GJ&`0a!xtT{_4EW9}T~djtN|S#Np1g z&slZ@zgL_-PSriTCa12pQMJLnIeHF4QI<1MkV?c!Nf;}`;h&kVC@r-PT)JyqU4MmT zddFg-eYvbwkMH{PRp&mt#Fe1L6b+IinX@2@VeUqf-HF@=e}qLcdBGUP5i@?9C4R{1sM6wx~LHq75Dd}46Q_j;y|4q2Ly&$Asao6c^@)W%Xn8SNbjmq`QA z*L&iR-Rau8PfTK*J|EN}9a!Eye;hVFd?>Hm#qWK~MRCmm_s4gF+4WSpKRcL6E~=@6 zYgM_#OQCBaFI#b!It@$HC2zMXw=YXl9$rn;fP0P91962miC4H^U;X6d@7dMqP z1@rk+tx_JX#j}D~HR(w2Jk1=yQ*X0L3y15?jP7k9Jq0yB9P(pVJZMWNLKQbdOQUvM zJ~)u(l9Ca%;l6yvQIv{4H%W~Y_u`mJvGQ`EK?0G|HGT5xHy@cv1>7PG=$PD4exolR zX2xRj1oWai-{xip`3iZ<-zhpZtEbf8z2|AP%)}yeab`8_`nKv!-1|jFxt%1mn03m@ zB^u^$=BGfVmz7EW_+4J6b&Pz^$Ue9S+G6qp$*-n(%_I!RV+QHI_IkKV-Zzgu|M4UZ zD5r!D-w>~k%6PMO_E-i3q|r&qP95(xJZ8u9AtjdfkHFBq=GGdf)rvg_x20 zFArJbauc2^pHu`AA-8_KP>a3>8(QtM1wGB`VHL8()oHdx5Um~wnc;o3EIaCgk`>T$ zqDWnpy%s){e>~*T0r#g4V?n?(O>@yd@QL2{lj;e#Mv8H>v7vG@G|uTp{d*~0;S&)tZS_9NgE+M`$>THt(k`DW!gbA*4XWK zS5`RfG?UqFk zdkN>JY!PCD(7<50Z6gn|^%H5LhdV%j35s{H#O7X0{vqHga=*SxHV!$p9wJni^n%jz zoMD~>{CxMp{b%*+eRhkdWjrn-$(Nxrws{=$!QrDIP`Otq@I|V1p)>*Iq@9vRNps?SXTu~L!vQ^ORw8fKgk;u=> z-^OSdHHla_embG^Py6`b0L2_65?S!1NdJ@BKVuu{W|`S?pf*;$S+;JP8TJqvDauC; zUPz-g#rma8pgSdQ*eUyAM3!O&Lj`K{3#fvPvQ-ILB+QNE1y=~bi5{@%f- zcg@0${){BOjR|P3l83og2(@V)#^5z^ z1f0l&f`c0%svgML@i-pGe`KwML`X4E$HQ$4A&*w|5AWgIbzx*g9P|30P6s~GhDSxY z5Wi1MNT_i*&v}1OP&*;Y$0}6pG=+k3KgjMf|OR zs|Q+phnpS^^ROEh;(u@HebN4A8_yL%k^7mh;#xiR;Y&_`isPLSG|y5ug;<=F#4!XF zNe2D>{M-aH2nvSBLT}kbnebG(YlM#qo-$Dqz! zy|$C{&@}njzj>8(lFA3Q;N^$kVQ?qnug9w22c`C789L!<-h2Tc&KJzK`CJ9`EdEM8 z*K$KqQ_cGkwR@TeLBlOVLJg5K2ty?0nTBpnS|F)4{347t{1ke?@93D< zqJ8({PE?}fS|aq})(d#c(eEGR&8m{DfBek7x~NxhkQ`>+&qUH0hG!PBk7}(^+`@rG z37m1`>a#zbPiIE9XXwIg5TRy=9JOa{$Ts|j_#5O?6#u;9D)SSlhOo1=;h@8S=5@5l zHE(5ZCGh$r{h$NIXGZL^jn_8SG7WiQW5Vaj1vUMWTvfj*k9>OY2Q5LWma`nuIW1I3 zaoJUDo9l9hFB?#h!WO{z4Iyuxb`u=Sjz3R1P0?jmeB9$)gU~r%EQv87<5WZCCZpJK zjLYyQmiHnKEN<5&l5l3#9k3hQm*Bs@g7)78fcncA$!OQ|gphCjipbCGok6QYFev(S zz4O;rRwdIfb}`}L9#Rj)$wd3vUkB6djn^QPIMZK*_2iFq64#R_ei-PX{j>U26zgR` z>pA>8^>^{{@hcVa8L8nRFi$q4dgMCD@I+%u%TO8*65R0Z-feBTsl^~0+j@c~%oMfm z=It_Xz3$Ts4@-AODIb0NaS@)zw!WH2s?VrA5{93BPS)1PX5iNWOk?aB>QR?YWZ}w6 z_N~VRzVOYgMmA|*c~#Vy4Q(RT)$A?W^;tyHLP5df@%o70u0FeHe9wAJ*+uq&5fX}N zQvEP?2#gVBSl93sB6}~Wpa(k@p?*bMl^()C%R!&V{O#?VZ6buf8a5w1(sV(*~f&YH`Qya<+?M+|fE|Wo0 z??QlL072aPw~!1~TXtfH(SUN`VUm1%^_CSrhGI1W4AgitCW%}x%c`N5Dnm2kqRcU- zN%4EzMb?KU5BB4e6r^L>6-qis(K3csl(ciLv!oDc@Cf)zu&bQGgk%{`%4sg3g{eQE zCy_CXmzOhelQd-x1n5H;BJO8n%7AT+YX=nK_HD#`72)#LcVnApTw6dK@rRG=Z`Y}m zP1)QL$FE3SuB1AY3rY5Qw64Dh1j77gT-dmosls$C;|%U4rlYBQ7RS=szc_CQ1`<(HaD00#fukK7`ataa*Mik z&&T{0Q32Rf4eBDKCq;KlfA6ER9BzL*YVm9NlqiGWQO?)5wL6+MkEIDXAZaX;; z;}@HP4@@HVNJ7QBup5d>DUZ9QSk3L&S9XhBYes_p(_GV51`~fK+j20=p4$^PuUGz8 zIj}Ze1b_SNqoNyfSM_r9!I)qupoW1^ObzSD!wmkO&1Jtz{|I@z>mPjj2>}5GsZ>!S z)f^-p&ESML+r-~B}G5|M{mXrjPKeF14M>3PR>A8~4Oa+^cKLl`C$BQ)~DNN`N+D_OCXfyZujL&}zWV zEFcv1Xz>g$<#3b&u75I8fwU(KAOW!$|m7d&B6ux@+0E>ym!9XQZx*KVzE!M#Y;7XC*?J$ZyyZGmQJvPPB@5U@&=Ub_rw9 z>^Map<5@vvxmx_tLt$w!PEStG5k}5iHo%Lj%*^K&!H=6Y5w6&!&ak3!a@`X-cScH~ zoBUylpxLbVF&%tQcJN6L075AgAMTUF%mR98W>5T$?R+co)*cs7ZL=MM!o&7VS06QH z2ih!L(ww5|a6Cp_FgO<+QJ=%ZH*BhCqX1OeLmeI%Rwwm#g_pmxR7KZ|e*595mEzBZ z+=CXxKj75-t%U(WSwf55&by(;Z}Ey#&i8=o)M*B)_tTrCE-2KDA6L2(ax^8VO6@}J zj#k_ht)rGMI|Rvq)0`{IyqnEr49>6QF!2hYK|{^WXU)$q8gyYom=*u22&Dmy3~kll z`pqMYBxgcHQXUlq?$L91CWP);8N)Co=dH$APOb0kQ7gYbzuu-|HCu+K0)H!TtNB9} zQ`_vzPp(Jo@~1d)3#Q<3g06X${>@pqM0C;;-sZU;$Iujg-cltZJrn|B$os+TxZL`E z4Ti_`OB7DJ%U^aw&60pA(k!T9OOGuJEw=TqP$<)vu1T$s;x31%sy|@o#pZe9;KB+hyK#w;C4+wZdk0&@CvTZ zCkAK_Q;z2z%`?QzHmf!ZsQ@E5`~y5zv)NhKf|-;Q+RLFnVEX%)5V#wLp|8tmdkv-? zKWP8Fuv&AWT-SnEV+@p@Gds>Vxj@PF7}IS1#Z1YHt3rqr2pYm&M#!6*boqW( z-lPV4#p05`8zeIou84;F$U#lZ!7fkt^v7p8gY^+=K~i~Dho00E(f-k;Fw)>gv%4}j z)g82^(8I$FiIP9TVlIJLK1c2LJxOS|y6{|H5*^Iv`YYd$(pofe&}@vrTOyq{l-s*+ z>9S3W&I~H)6gDLdVWuqgLIL2A@_WnvMMKjkN<5RsXr_*|6F{0W>9M?+)}1)2uR0^1 zhoXB_YbHhUZim;z8|aUu!l#xXg$OLYKWLh>1`pDZk=rU~ly7 zoYm_i4L@oszZ+`~S?54?TN#r`2+}4q04=>m1)?{53;qW}2Z4^a=qGtyZRQtth zzG{$?Dt#;OQ%%&Ea&T1gv88xl!p^S+DZ$t#Zgwl(Y$`DZ=RuVsXFD_grIL}$H+g7dkTfELBDR#{AuR_z??4N6~jE-K1 zy%&2k%EPdp$lo}zgN@DZu1MS)h?h6d13Or&j}~5rXllMj<=)#h+ET9QB2d=>r#kQW z4R;Mb)6#($l#fw3hCkOZH#!L`;&WA zJH#6zeED*H7)+8w+(nSERY8E#%BL0lE(X?2=Q@Xxf%OGSTsNnNF&IEwBkW^5tr+wt zs&nH-?i5r!PotPUw(<*%RAbdFsVBGNXWN&W6ZiK@rpc3M8zNfz1e;0JeC4puIR}V< zek8_^CfpYX^g1Yfxp`H&pD}rV$$xi-sSrCgH0_1H3VUXtogmeXQDhJ;Q{uhQB>fTh zJy0wPQ=4VKS?Ev$*vs0B2P0c{348ozPEQoqW5fl?kxL$p=_4;7?T=Ch;Ad1nH?DeC zcA?U*opKEWc8G3j5MOeLE=4MTh`u%^F`N#% zrF(fo$KtBeQ&OZGF6^kTNF-S3g*!S2AxQgy##JXu@(-)Lu z-UthQjMX&O*NJC_j&xeRkcF(wzdD`X@?LE9!qew-oF;u=#O%>~>SV9q9Mv6v`)%vy zf!$O`^9_As(IIF#XvkS>HIjK~@c1{oOKnob;Tn*!JcFIx&d~vANyKjb8In1_Z00DbG1xp?Ig%fs%+s1j!9S2x$lL3$I5qD!n3_MOEGO~eYv2!rv4xbS zD83_JP!uB?BXOSEg424!P~xw0>CS%u(rcx|u)-Uw{^^RJcSO--0)C97F(W zZ)+oA^s{&6f3n^nc_YGWhLQJlgR})=U>|K%0X*edkwE;^3Gn%r6=F%a6nDMeQ}Rf& zBWS)IZ<8}kUZGD+JM`4%eA1fO_KC%{@`RT$D-xQjF8!Rz3m`djRkt7J+WM;aYIpgy z@xB88++Jexe^8Z2G|b#89|6;~!|iI>#vN0;KPysq){TNYTFG-uBYW_zr??j5gj#Kb zZ72KC{0qBQRQU|!8<2_K%dyQ2p6yL2hA{VNDTTf9Sr!{Q%XlE8^DcZv53{+Av0StGOfYF5?4 z*YY)?g=``^?(5K@?5exz-$ncysQ)yRST7TQ&OLa&)&k+>@WTu9`AG`f9y?6q)c;*X zXFRXnF7z6BM6O$VWwmwuMuK3Ql}uGLblvzOO);?dpQzdOZm%p)tTsJR@XP{XXq`#> zwQOIekj0T*Gu%j~ZoZiAwV$1sa&Wjss3kf%!N|*C8VFxlxUF+{a2;$w22H2x49oJa zgOxhj@+wLPZk(>{S}A)U2>`-z;pi%1vqK4tC!TSaq4&3=O4n4nIu^Fiqntcihk{i2 zC3~dZYK|Yv7S%AIvt-T@{kAVn23?;t)|l)nY+_Eb#11s6@=t29kudYJN@1oxu+6=v zC;5C_ME^$90#2IKiv{jiRuM`9k&auAuTxIQj!%%c_5e!Kt^!VXwZ)3=V|rv4aQeJU z-bC~(;8ApKZLJ<+@RFGeXZ1%it;EkShZ257D`yx%GR8KyFl1-GP`+2(ad!@Y6}%RN z7gbvcYz_mVIcjEHoM&n!MYLIv*X?C`kx(vSaIel=C)9V(T0wRTYPvZM7Ha@<8!Bm} z>3qA%=A`DvGHpp(R%I^n3I)b|!kdBD z-_)~S`%;uGgB+0Vn+`o`A!qSj=u2C?rj|K#OOFuy-5v5N8{Z9rdXwmpa@y)94vKr{x$GZE7cwl znJ5XUnwbbeUQ_m6pKVz~F#*z!Di!Cnh>#blz|2+z)8L9!%EFle)LO&)>y0_Tumt{# zoJfM|#;)`fecC(?OFQq5l?#Sl2@)RoF=r(@8%)=9%NAv&-kP+G8jDdugC=+Q zj=T5pP>1izwnMav?PX~2lC)ETZe9yVHwpc$;4c*x zK+K7Wmfns1dCr_gH603bT78bYw%#CTfTB5I*yzf9cYlATnKnBfW{*U>0{va@XQ)xb zZTT*K=N&+EOe}1Q0P-)_pBf4+8`dLHKjXGf4{g!3F$@)p(}m5?Xdyaqw|**39+BP@ zwsA4MFc6A;h`q_|%RLmi{$@iCXD%^tbaJcZl*LNYtXtD@-%N#Z)uGQDtq49dQyP;-#?xW6wsSBOQ@waRC+nIGz zfcuQ2YF?F*&XhPtyh1SVOA0|7U@H^zRckn3BDV3t(Hcc88J@J)-AVhZ zL;}bgQI%1%WUC_1g|5kp{Hk*O>~vr_{=cZutg|wHKbOsa%VaF4wzKC9T4q|nG=URs zsn%f2miWbTkmd)m$QcR(;6HAqTw7dO_FeD{M|Xc2x2B!aKp2KL!C zkyV`PiiEH1yh$`HuKKp*mDXLgV7{^Kzwuw~f8)Oz0RPn-9x2zJjw9;aNMH=LRr|)m zT{&>C3H>>C8A_vwe}!kYVi({_1|_Gui2Aldl2Oa{z{K%jWyCy|2y;IWTI0)-QPp6$ z38=$qK$I!)hs$_hs^C}vuGOh$fY%OaB=qI3GQ20z=XaEpk_ws*XQh!o1P1P@T=vcV zev;K0>r@{)q3Juf&B%E?ii6bZOqv;!Z6gj<SXzCq|F?Ys zQd-#mNNK=O=Cs|7uIbY#ly~I)2S4ZGk#2bbILi#j===1?30F; z8+{*&22YiF?21>QFLr^=ZVUb7QK8RU>V>y{VkQ-cMT%1DASMN=mUkE|{oySlEHv?r z751Ah=!vEd+QBb>XZRwd*5Yi7+#)U?HQ~iMfl6M6Y2pSyyuC{A>KoZe1&XQdF0;SF zJ4UxizmBEy8uTeGl+n+D&^?-}TqYSh^hs+bq?}>VcLiw^Hmj4Y|e-B{jEDtC2d#py9>{2ghTw zurd)P0zShh$Gol?7qrQcXWVtt`a2BakE!@b^{IEX3U2f1bv($giFC|?B0oQ67Y)2pS75^ zgG?{)MVpc%qpJQ(JHP~bO_Tib?`h`Prn5rNErayUN&J+rE2*{~+5RY?nx8>p51LHo^EwLg3O!MONCXTGA@oo#gEJMOGdw05!**r@y3GZqLDW;r`SZEK8%cxDZXDGFMiy~ol_m+7J zsl8S_93*@1R93=%)F;ojI3IRt?h82K_~$K*S;?c5qC0D?+m~>S%_|4zJ$D|V`N_Z9 z&pJ~l{z=x{0{qzS2TU1%raRG__Z6WwyFiBfhIV*F_%=qK<}ShgG{;xJFZ_&TYRV4f z)v%|W&&tLWSId~AqZ1%t=(nWhQMQ4?a-Wz;O_0eh5zs|~lTPLdem10yS5glJ9h!vI zewy!QYt?Lm{ku?HTKM~zV&MP3Rs(g>4SAb#&%(q2D~{+7@_x5Y)hk&?TQVsV;6OKNwbgd>mBpI^!b-g`%)@=7He95Hn za4oy-ZXEPVagJ6e69w3Onj~|ALOTDg4ikgNQsLw8 zFzHx?2&v1Bo<=eWRiQCabAHb6N+emzC+(unC;7{cpfe4`L8elHpFT&ZOvm;U` z8v;QKU(|KA0v&xna$s5R84;^%c^saf%&N7%NMjlZvDbb~&H9mOTl$aM@Fr*BjdL3V z$(P)*gK0_NDrZ+NZ)6*fxE?uNV0Y0%sxP^`v&4d*qQz~<&<8&)E$wr6e0oobqJRLK zG$RvzSq(4GngU)`1u4M&K+e~HJ~OK;}+P6g+2aYx;1+x&-dg9ERc=zHil`Zr3-NibY028BZ57 z{1z~+6rJ{!m=@yD`1 zGsWI(#m#(`zQAauo-J@6{Xo28|8Ocd0gt7p!vF>;^Tp3Dfbv%6)v=vkzt6z7rJ=;6k_zItIx83)oJ50 zn*BUIopU8=wt!N>cP-beT_eF^)rKu{n$7~KjD-*M!-{$-yd3nZ%+4(3u)$r~kQ@oi z9?d3(R5n%Rrm|&@DzL8>bq*djpkVun#cMw`7=R@uPvv$^QwnG{Tp^xgwS6QAgG=+z zHx5ia>r7GW>|Y;Uz1}1P6gr$W`_HT%ayDNxAk zjtfVJyJAnwKw@o417EqhV0yJB0ZY%{kZF(|{Ct_RBm{5E#d~)|AfA zc0?mQAX8!N1m=p0D_aRVLyB**5pEGoBrpA$bYJ*ggr{C7^l>P>FMThxOA30@vZS&k z!GCrKnhTcBKU;ogiyl8caX`CFrAk2i<%xjk4qwcdo1#Bx$dc;KVge{)+Q;`ks74Df zeW7xuzqoSxe&)Te?j#QDq_mdEm3)30_@+-tcLdq+!H@O76B9t$rD-)6*!A`elzstY zvEaN@%MzQLxAwelPh)encF?z#=UQKA8vZOTMAe%zmEM+oyF}KIU7fBUtD9LbUBu=muhk zpGEM(DD%!Z4sR>P_*y66Nq)}~A7nk?vQU)A7GO?yEZq(55WYK+r(rvt1tEQ1Z(5sL zU8M*J=$vaYxjY~+UTRJY!HbaLq~{>3yRDE6`c|b+Q=U0ZL>P4J&or0f&331;yAk#| zB`z^BpZ5nbm88?J>aEnx4b(@y8sU8ku8mtvqOhDhmc6^S@VJz!C`dC{Q~45(i?kUV zoZeN&oIZIy-rA>8rU(J2GnNE`_2z7QY8TX3lbFA2TS)+HLIl*>qum8`kr2`SxB?)^(cgz0TDfu{BS=FHr)-EhvYH^KYq7teocZL&_2H{+OZANC#x zF)*$v2};tp7GT7G08#QJePGibV@Wai|Gp8NcZot%VoTFPyp75!T zWMq;0V1_lnpn!^sO2WQ__jTX0_cyn-9qvxE0chPv<6wj^%1Z5tVkg^>B&NhJl2CCF zn_V5Wh4?tN>&#x*1HL6H9p3C$EvVxFBry-Fc2X-@VXm5*vk6;Uz$?2QAn7yldRn)K z1VBBUi@sgn?T*Z!*pWBS>Y44NUc%Mn^kO$}EQbL5Qn`(K<)*1P5?^P5;NRc4wnbFQ zP{~W8rBwLeZ2FMJueGoLOjGiaL3!v=dq?F_Io*~h3jjG(MY-WGwu#sUiL?cFQi-&g z?Bhhv<&Ct2R5{nlm=2m`#?z7yW&7OE0Tx`8A#MyQ3Yx=+tn~E9Q44*@re~xCfmg(I zqOs!j^|#LAhZsk_1|}}*2Ye1^en1z6&x|q9=-Bf_C}5YqkuYQ6gbX;lLbM>*!Z#wZ zS{bF%2FusA2SVw85nMEd(U}TcvyK?MMTl%Ua)8c{YKy>*n5_)8o~P|mrm++VGwo3}QL1V8LRn>bfK5_8 zWtHJubvxC5WP{WBUwOayFkU4td*T|rxf@x5bw_RtL3y~|zyeB#nj=FJukST^>8gaz zN0aguNkC$pN~9x_hB(KGS^J#JJR_tE8#GVN;l)y@@8{LBJ-^cN7t?`lbrz>UTp)h@ z#C_(M8t*3`;XNL30GOg3riXh)J@lkNi)xr)#ipe>#<|q__B&Q&t@xfWOD5Fk`S>Bs{PYY-79e=$fIAcP*fx6 zMmtx*pMW2hyf|w0;ej#!x;=wN+uZLx$gObiCvhMIP>+0NcO(oJYZaWC>=Wn%S{dav<<@=gXBoB z#R$y594IzQL~HUSCMkzZdJ<2U-xf30mjB`1FoMelf4}iUAhPkOa3Lr?%?UlO)1DKs z66tifkB`s>JRy}tDNGTYGpq=bPm3g16L`p-8*i|PCMs%nS?m@&uZ(;V@~d{cL+0 zbJN#KVpYLQxH~nkR2VM?(LQ)1iLb-i zNkx#TMs+bfP1$m*FbrxMun;P?n8xqd z3&lPV#UJI`N^hmCDkQdm?;E_sb9`7gFPK_IDZ!!oNQL{w%MJ!}OhL~B*%g;W&jSv- zFM-oEq`fcmKWWB4mtkN8Y)nmE8cq$lk;7l@8V{1C`0mYC)d0Nmd~NJwXzJ_&)lH_8 z>|-VSl{RT$lzeyPMr)g_Pb(^)@an%Io%pWbmMdDLR|{4O5^y!UlU%zuQ@|cS`K58x zu-K#(kCYhr@xyb4S&G*U5lqDbl*H&^`{;Ey1>bU3atMEgo#0rHxMmqf__bU$I`q*M z3my-JDzu1$iI1vno^3%PS^yMj>W%iY zHJ~qYtDPE>Y^^cI&iGlWvt?-h)5{h)M|VdB=HMKNzlJ;MG6=H(ppygcMsYq9Go7;jxcY3VO(NsX3hQ7i-G zp7P91m&2J_u9E%+Fn^@}A4>y5RG|G|KJs_&qb$2{I4rM`0Ew(gh9_au-T47>k6%{k zq7@dBu?sb;!m;xc2@8T5=_GZK-K7n@UQyc6P)4&-Yz~a6C%*Ql?>bBi@YT*?o6{mV znB)%Zhd)|9Y82ve8nJzBzy0`*{cXOSUPgv$b4UL%G>ysu8$rW z-6)0mKNTh-G@78ZK2Qe2rt^$C*+TxiVlvw3FSEl9$xI3<`?7OPfARmVFDz^M*%iE8_oOZCSSE{;Rgkw7vHSZ%fs@E|8zrFxW0Fi)lu_zndvmJ zt*EjIdpZNU@Q7XR9b#>Am`#V{FO<^ZRM|E^G*(gHxAh_b{VK3By>vn3dKk4-$^krT zUbd~-ydlzQ*R~~>G0zJ$tQvtj5QFU0p6BDwi|Z9d1NHaa_qK?hS82-+&NE@)7$sn- zmQ7Lo5zv6xm%IYbLZS3{vIPSI(9(mtSH=lw8zL8<;V3{@0sMjvuQN(?PK~hRT;b!` zTDbK(?lZ;jn09^+4)8cE_+;TD%PYN|2E=epuTf<11WY%deR(^{$OyG-bPXv|tdyf+ zi%vNLp()eM` zL2tiX4VCj!5_3}z#AOJveQo)XOq3$4Ebp3H*dI%Q*&cyI7HVjot&2rS7(Q>JDE`BF z*tY+*S{DRjfyU+BWKfl$XbEm>=Un2=-_mNG!I5+_mNvW5l|85Dr+&bw=>f9EkRvsRD1-`y zd(%2DRfL~|Z2?N;vQ=MJO`OQHz7LWZq^&JONJnjn(52&h+V@_xP&F5KV zFOtzzW0m@pW?s{>Y$TznKq#!tcC4+B{l7{t39+b%7}|&AooSwozl1A%zUZ{XmRY?; zVCwpE+_%dG?RqsjGp%SbvPo=@i<{d?B19Qej?BUekU`L*5)eH(5%~MyBPx(&5sADI z2J0wY{9ene4zu%r3pqhnTz*zOT*w!3l~FfX5;SzRd|+b_)K+z6y3n|DC?I|jxBi(Z z@%h2Mg7YnJQMEm}1=KhTf`0TBahssDDV!A5s{j2$n-!`6li`t<*EiApHfl*)KMF7O z(7%ON_}P#w!^$k>SgmTZGV5!_Q=Q#3W^SxNbnQKy*<%28#Cy~lsX!H8-5@~zZT^eP z6e?#OkBI_`%DAWDc(>x=JI#)Vnj1@w<>oR;%SDlEhaDKyjRmqv9O$H$%E$e}RRTzx zlS+l;G>LH>V()H#C5hIX8Mw+5n3TP5qMK=(L?Bt&j~b!4=*x-S))iIvl9ABSq3QhRfsmY1>b$RB;ctn zxnjbVSiCE5?w@XHrZFTk;mg{K6g7gSi8Q8yb zS}g~F*=s7zUse;Pm_;?yH&CS@-8f1?9yGLqMf6GjgC5meDqQ#+$JXpq*woHqx_`&r zre0L?Y&eXkhM{sZ3VJxCnpT7~1p>{Qj}P zexT7pGPH~sm&oP34B_%JI6}lqiu84XG0CYGZQRSk4KAomY)1+i0s<@Se(b}_sW@v2 zmJax}#mpQaCocI`@jI z+`mkrj#&D#{h=L>P{L2`4OTH}H5w~N<+T{1?td4dwqK#p3SJo~Xdde2j=@rsfacXt zW`^&%qLS7^mN2BjOQQ;!!ms^(jM66eY@H3(wch0d|HT)Ki_{04eKf`1(2FTeZ(y`c zx|OxVaSjuXeFJ^nw^RZOvKZCer<9qXh5_WQg1f7*z;p%>YluLu&k548ZrrPt*@~U7 zS~997Ug_o%>)ZAX9^(=cJ!(Z5Aij$i7qS3=Xb%=3BG#l}4pZu54djg|d{>V>-EKP`_;5g!@FQQg**9)TTU`vm67I#w@INe8CgCg(I& z@fTzy|C6Nrf`zu@O=g5r142q@Q#7`a!vNzUYg6wUn%Z$s1EqhxVkxwX%JAm2-&QmfW_h^n6`IK>mx)D|E0)x9KavvyF?9vT~qNq?ipF^XJrYSK!x5b-A(ks|KM%xXqMtKITXhb1StVTuWflE1Bx=C6Q38$DL$!=yX@O9 z7v!Kf;U1^Pw^};Xg5I(Oi87GM6sqP0q>d`Bc0xFcrTy;)oFdgXEz8`uh;z(~qoZe8 zm+y+RciR9Vz6OQD6d)@15&Jol>Va5#sJO6_{x4o7`8kU*g};IYtjM+Z+g!#rX{j}=EIL8Vx4Lu&k)Ruf_CZb^P6eAekF4+Y zulPf?s{4%~f26c6{jqwv(OsF$xzcA`GkDUlvs#CLHG%#-|JiA+$x)jjE?tSp9(Tm@Y)xdTv>}Shs3pGVDo}<=OVWmQXVYTo zJvpbd)_^&-a-A?P&4^{In)0fQu!5>R_d~lT;5?MjXJn^gTRT!6qq|IF_^JZM+z8i$nAFwSCCp8peG3}=d3l}4J~fCG#3Kp+ZVV`Z7~aIi#6Wl zmsoWHY-a|nQ+7_aJGshTWte+o9{mTEe;3F0^Ux|=-ae0hpU5QRZ$AO{-l@53|9pY- zcm&L%h(0%TEL8qxwmN2!**c2j+n%2VQZbUqOOkElp^4HtX~DtR}% zBXiBy4wb2&NqFTX4zOdW$@fj;iec3wWi#V=h+VWKm~_0h30*J`=R{n__&;N5HH&Ds zPNTRud%jul5vj^sdS(HjPmwJIswed6UGN-0pRj+?=S*MjAN1LfPv}A>tlC=+0x?e& zsmR!=b2%;N=FWS`d~N^9-DdC|H9E8}cjX6Rc?qAGYRJ;3q)}cBez1v*yldnl)CF*) zz948JpK8n4FOCuF>__x(!y(g(^mwqKWn@IEc_^g(ktTS{sn$bTlg3ggArv@DGva84 zCwp!#>(={b&vwqTCn?qMV@nrXLJ|MsH1qEF=CQnWC36}g>{cS4ER-SNJq#(PGcN59 zZkz$9ANWg?kDMqzxIvmx()#!Ayot3Rx~vRC2bG-46BhsB8QZY89|{D!$V);1p0Ojc zVS$>P5v7PPzlLgdB~CDn=O2*Cwfg~P`a-4?Kf!?JZ#N1$hQgu;p;wW`6SVX#5 zecZhEy+Q+4>{P~79vcWV8hc-Kz}H=01`B{p+p;eNQqcQ^)y>pWz}&bc+8gl%hKcl zUvt1Nwh;(6sL453TirKKA>fIL%1#-zOuoOeSV{|7zSh`2rnN@ZmFY4l5vJST)~xav zcx!s>B!17%u-ImCq3FHsn6?TBz6jVVhf~$IuW;2jXL5RO(U- zmc)Rik%lRupM)qjYA#Dh$~9GMXg7H;jrA8@^qQ|SFf?3uMyBY$U1o8N`=w3baFc_1 zrAZnHVeYPaGIp>*(E(;s3L+*ZxoM7GbrC?EdfgI<)K(On{;no%Ij2QN%jMzW0SlWn zN`qnK<8Gvz!>Sj?GDE?W3zmlz#6R-^wpFJbW+D|Q3C3di&28a`Q-({#=B5Q;_dY3( z5;E(8>lb6Vz3p18ThBWw7#-%}ZH9rRV&LLK%f&tMqQs5pt9{6s#fq)<)-b47&;7PnUT;aH(Jxk` zyn->ZsQU2Egm6v1`sLq-wLkAoo>w*e@=$(34$_6wouc>t%-B0#2R8e*51Nm!m0fN3 zc<+E`@PGXMAN}pJ+9h^)#G0bhL{ zwn+X}gRz<^1I%SKA{)Y5S(9|%wH()h7A94!A1<207G^gsk;w0X%Z{zPM>**Q!e}

jr7+v~%}=1Odto z-A0q8qUwGYDNy63vhMR~iY5Y@=U1kW6H~Ra=sMKY5XyypSRDyq>6 z`i>$ty&->MKH8^pznd-m{crA`wiR-wf)=V)MX|&3S8#VM7`<25x0FYhqq4tFc69F` z47#W9jAVG1##a+PQk@m50pB16^V=%|91iPI(sHvY6i_5dtCP_c>-urjxtO7(>ZU&r zA@OGf$+vae`YI(tj0m6eFxPhj(0cm&?a>>&<6jV9iiwGZ5zQJ&I&q}A`1l2Mh-r_< zMCYOq!5PipE@x8aeN7uww9c*Rj*~tyONmc}ST?)O!PhmVRY8_>+7gn&&V#gg4R6b) z>ERw)BKf0AwXOOCIrtXl#im79$W?9%7~$($j=71yaXQcX4IdJ7`Fz}<4*Jd*&UwI` zMeJIB3oOUb%tsv`@;EnFbjaNvD^Rw@G;vTVo|J%gfpyRiG&GcFKP$w3_h`AEQ>b$% zh$dSZPPR=(DTJ!Y$7o|ukU8t2)oyOAKjSv5Z>hyL*PJEOe6E*qsBMA|V z@4gSr<1gCe220jZ;QB8LjiFrf)?apCL}+Y7o;n)4sd*M~%m1Wpa>CD|-#_mvdxYlL zy-7^vqHicxDQDIj%IQgJfy!z9FAK?OkBXvm%wpB}A$roq!f+y5Kz<;ju7a4y3Od^y z3H3AlM~w>>KeEJ|c51d4U^nEHobXWY-|GuIfr?b2bJP&&NfO1bT*8^N%zEf)H3U}?SFDiDswjZZCbF4e?68A`Bca@4t&TwtfpiwLy;eW-1NLq+k zS-UwOQ3k?UJmL)FYzl)&QL*8-cEF>;T1`6G2qWzw9_!jHXvr%I*Y#APiy^?FZ?N&Z(>M%WuTTY>YL3@nTbEsd>U}C$o*iF3_$o+WK6i{OpQG zf%*$v2w4Co-=?-Qu!$G`C0-HW-#wJ%U1xJUB$SXgT#yL#oIZGUAZS$xlhIp1#d^~3 z4C7Y+EVIa{XJ>mzd2nIO_{ajU^51Fp=A~ijl!w~$tPinjXF(Jf zIbCLZ;KO}O$+X)q1lCs%!)vcUytQr$05)=WENBw9LL%{Ju83uiI;ds-)tt#UH$?eI;hGJ6k`0C2 zr?L!wPu79Ta#a&`D@zh*uHtC0`8nS@!0WXpwlx$Ls_e70EQ}0=`%qd$U-5#)lce{! zu{AwX6n)&m-*3ZiUtjyfwWjFJLCLW{h^e4wUy$wHEtn-<@kuc)@oKA6cz-}wTh)&y z;!Y@G$ewt4NL~XLpDk!{w7Sd$f`B+?HfLTpp*MA2Crj?0u$cW`wKMIc(WGmDpb=3t+ej9eF4et$reiD zI9I8vt>t1oSls% zAmqVA;odc%sgb2R!rZ-S)hd4IbwM*gc{v2*F54kxTO!bBvF*rH}XsS*M*^E&JLx@O1Kf|C@lay+d3_ZN?%&0 zpOx2R#vZj-pOx{sft`leZRUcm^?u?thS7Uh)``2c|87J;>HHz3M@k#Z`{W8Id4M#i zcPrh3u!Uoa{-ZN#vWIR^2@Fh^OaBWewTS~EL)}#e zLBHqjt@vr%#_>5v#|?6xJ$t;6dn2Lw_zNvQmbYUP(asdmF>a?ie{Mnc8a)}J+5Ih# z^gag#_E8%>02Af+A`;9Pf0u(q2Wm9dPjwtt3A_cfD_M#nswpKJHVLbxErn#k6KpzK zu;ByVRLZebIn06TYCUt4OYyWh9>T{O6cP=bx=;g_fv6VGOX6R*fOil?mBPF|I@BF^ zuzN>T!%;Mh1ea`ANXEhwL%P9~(eZIc=7&kCAkwXdCFG`EKGn@c;E0fwaiB~JfrYCy zenQTAoUVrIfs9CZ@Yw-qFHSM7?`J5L(gQ}b-S@NeDb5hHa1E;G9BIab#USplYIno+ zg;zCGKWr^=^ZBM*`!H-ExL=#SbH3#9KFFd!DTC^G?7;hzhD(pZ(!L zo@D|piww1vP0P3^Wh!Tq( zih2H8DA7nf+;}IJ?@3?oz_X!_M`PPpKdWCzm=#z+%#ArWX5jMX z{qOi!Q=jv0tL+Ox;y8pQVqZ?RdKTJKO7yQ1Mlo_bCj1;_25n#A*d$I^v^rAR(T;V4 z2QpM15}A&RlZw6$I_Y_X4BK0GMR(|7>tXlaf~ZbRFHTnbU`7~7WwMzTckKE%;(2Mq8Hp&^hkEY~{(;QO?x>{M6Yf1ikYGuA_+Cqb|F@Hh455ka z!JB$E;WUyDKIFSh-h09*DiA+!3BMEh@uof9JmjyxGkz~6aUKr(hW#a2xQ#YP=khtT zbRMVb#E)cVKdWJmf1JuTINGNci=DqNy4G2p!i%f{4-7w3I+EyD^%?YeLA5AYajJYR zdFgSiN(z<>t$GejM-@sSOrfZ63IV-o9q~XR#{=>;4_sBh4((r&H`fz5MNp|gX(j44 zMl&|4jqy2+KBCP7p=9uf^PUCyVG1HRtdd ze+3~w!?VJ?Bd&RPAVW|HWS$KT4Yfl?MwT!&&6&vo$X)Bvo~q|z)y_C{EL|Hhxl^-) z#X^kI=3tN5zV3~mYVCFJTQ9ky?w!yl)tC4;ox)YbWyMv&`;C)vLW5&tW?yG6zoA6q z5#uyhaaoUk{mQw;apKQU1{0KN&Q^Is2zN;w{X@B%v#9qOoZr%-*$On;2>5TybcqjC zENI?13RWz&k|>m0wkHfVBP?umHJ~6uYtp2<=HKGHegv7Wn22=+_V1exx+zr_x~d#z z6Z!vI2%%__2j5X$a_?<@hctS?MZ<>xJ<25u&iS(%_E);j!5_bCru{ZYg|Iuf-UAV;t6P&8I+av%XNodrzBJ?6FirhF#HoRKb<^4ge-K zG7o85d`I76xy953e;CBub!yc=0;I&^`L^Qgeq8h1Dlrc%NE5H-C0 z6g?H50%SlcDAd#EgJY)C5`92+3`Q=fF+a%0E6y4|Kga^em6WjP;hmBYc*3dOxv}5g zUZWE>zX->h;_>zpWDOUDiHd;RkG>)Q`1oo;ZSS+k3v+4XZ4PI+5zc|yf;-{k*X=%@ zkUGn8pOW^1=ARZ$x-ZVfRo+=*ywx!w`gUDcbK<@>c=d?=muAU0X%XT(YV)5~jsBLe z2I=~hc9z?CfT9BdWd)zEY#~cM00QLuyjl9ElpG+yCg=PxyNB)FncqUWq0-+fdT`!(OGt`ZbKV3fB1!$@8^_{gtyY5$YTnU|l6dC>> zCmvWF?_L7<(R}5*cdC#VxLcTrl=P58LEbfup0`k;B^3uZn8LrZ9Yw|^;%T4$sU$LjpY(@L6G2=47md_zlbr`SMG%fMiMnk(g%>f(mhlt3?_xX|qH zj^|+*A7K!~Py8{M=WKHBE4K$d>;i@~5a?G2+&vTyVKz?>$%J~9Q%;q$HDWV#bD+63 zxEio*@ogahhGnYu((oHVT>==E`?`wuY3`GfWe*-$M`@2NB*8vZ9z1(ilSBE@T2JH& zGswyiInDJBX}4xLOzMnC!k8*Hp?D1EOkVt;-Vzw=npqD%!nqn~r+q54Qz&IXshT-y}k9<`l9|ZeLdLx2~;{%?lO=#*|D{> zB6gd`_lyzvFTG#J0AQ(>$#x6%pF9F8R){QlQP8<5z)Ska|L=vimas%!*QK0aNe-RA|pj8#GY=R_}5S%OT(9g0~6l5WwYc5^y`7RTLgfxUWn362bRG zM%4L!dA&fp%`@)NhsiiaM}E+-QYEXpkA)Y5jc>Q3@U0jp>M6@%M()%G$l8-Fyon|= zxIO$$Gf1NE8?p6xhX%x|etwEoJpf`=8`f2USk)cGhsyuPsuEFC*ngt?SP}rNwNwA* zs#5RX^da5bRd*lmIwq8}C}xY2WlT7=`?I<=FY z)MECNI3}CVB|>H86ve-M4qfW$dDGM1YX%rpG0w|p;tqDg(zvZ`?xvgu$_|RZFP)>p zJv3E&Dso3Lpvw_jV2EvQlxku2Dt$M;ACKjGatWN>04xH8cyXZWt)aVrw%wYGq}(AXv)?0IwqW zW%vt`U7@B)iha($9b`aZxpxD2*30WH{iMVlZ-BW~5t> z(61kT$2XSz3*7@8kSyVzdc*RR{Ra43Rk6nb4xSrLBV5(PK%P=PS2JZZ_YH9xL_l@_3= zY-nF3Au%}!{`FYjwO}nO(bMfwwfox+sj0yMh|Fswc6pvvw#Bioj;Ee^TE&sd>qdWd zNPjaTQDu9rS4)Z$+e}XAs>SWJhp~pS;s6|T@qf#OO%S`8|E3&fR#sgd8`c`JLq>ya zHXs)Bo?hAgA``6A3Zn%<-+hG}@Ubk1Y!PjP&B|&ikf#ejWUPY&t(zmH)A2#GuhUV( zNlzwe2^bc7@7w+Vq)UAH$k(?Yxm-16y|PwX#P(jDZdTq}zT7qxNZ1a(U7kLX&Caal zwzZlZNYpI|W~Ngs3B;n4FGb2Hx{edK4rOH~eNl@wem&vm#XId8=O_Vu$K8>4zt>wP z{o%iP)`@Y(1*DhM%=@nIt<>m2n6mvn9vyw9^9dqYLhuS0&z^|yq)x=2HkqCd1y#N+abR~yS5 zQ|eDoLqs-Oa_M%ZgdMOYeNo-5r5Vo{|CSR7=fsV1#Vf*%jfv#DOW?b6dgLNx zS+$9VvVV*TR?n>5Yc-zJ^QYuu#_V4Kycm~9r;26SqiYUq}G= z5^BxAnk{ugkN^+P3d!M(r^^+Q8)AkFQK(t!mkvi(OCW8_h0s+p1S8{m=U>UBb^+1r z*LRw}&84A+d85;|iq5%N6_l!VJek>l-sWI_^q{W1oF>->u=E7*H#`OED6%{KTyCGJ zgk-?2AJku)vp($9J5W)47`_!~Pz?>14;ND^VrdP>gv{=%pE}JNUU;Cz886WUT84dM z*Y2pQn{LnO6{=5frhyrO=KOh)W`unTo64TULmE8nA5YIMp4eoX*fV`Sc}N6@@IRw0&zeo_x3tc&EA6o~}|X|e)ISxrLWWs#-Z>T*xdav@E+ zJQ5&kdDiVb;&OcDZ#x}Fq@ATxh*AK3&i$@~Xc+kd1!H2Q5M2xRa za4yAONhZ0LIPQIz(Sjt+3TdenTvZ!95oGu4_9!kRep7?(koTMfPh&JG9qqI-gFCeviWCdZlkvMba|q{8 zPFBsGscV;YUgdpzHq|Y(UiL!^3y>sD0L+dO(pzS8HxgnFA8J^zO>BTx!{0k3b6`Gb zBHHzRRcio9lD4K{<7~0A4h{_!RE&Olj^b8JTBX_oC;0d-`-ga(@y)>(emhkjs{#)5 zKKMcyNG`4y*!~Z6KG|a}FTua>S+?I;<{ak`@=Oytd+b6QF(kpC(3(7M-7aJ zK!ENg$ITh7zo}QgCf<-wQyUbQkC+4nu3PmbIpApG3?Rx&M~x8_ zKU%h^t`344_iNy8NIR=ib#fHMr|Qdq^vwoV7Of!Wl-e!TTWb>s>HZReAMIEJjay%L zjBtS{e%}-{_pg_zE4!8RRq)`vCw>N~u|ET?_`p1@ww&kG*ZZnwwPM~g!caDN;IM|L zMM~ySuJ^s3>2!5Q@r*MIJ!CaDk3qTApaWYyTUJCK_f7GR25%fFNQ*2VpMNMx1rNvp zl_tB0{N#xk|J3n8fb+nq$+o7ujd;7AgyN(33vP|CNx_!m$CPGwpUB-l4FzHTh+kmA zBcnAX>v`%*Xx)k8uC)=8*^CSM%CvT|f-!1X;=izd1iR@Uh0k$!3>5GO^UX&Il*X9q zSkWKZQ1M2j^Q+at${-`xO>K$CJ@013h4!S4hAWivThe8at~H8yXjDLQ7|VQH$a0Mx zBL1dJJvHX`JYpxS0<*a*C+EMpom2nhcJ7<50k>jYo#zed4Ko4aOO-7W?x779RtOUq zk38u6ySf0!=VF8NSewyijN4Ad+u!?&5TwHIOE?$e4Z@5Ts?Gr(}|I z?xDlR#^$h}c^S5*4LFp)p)_$95kyh(zj{R&02Q+B7wB&6&TZ!(Y8yI^A^`|N@F3FB z!6D!eWdp{UfTtg}u=t&UIT4U6-~og>-xY!WrkYO(>fXop=^BAqFxbLH@25_=o0*$H zeYB3YilXu&dJ^xZgM$L$P`6QEEB(Za8rfEO-U?5q_)Ae7L4#}yzLvE(7(18wqLudI z0jVTOjwYcgk@>qib`o|`B4asQF@p^?qZ2U6m0y8r*k4fZ*sR>I zBMUDtWId}eBOmw!_9DbfBUa6O4wq$DJgcLhx^x62$t5u^jtra|`GyJCvP-etm2w^^Ir7K@j?e{d`FzHy^X+z(bdx$Xj=J&y-OzMd&$;pNVk;%5p+ zSa*hQWk7UO@DY z^*cA6cQ+_W*+sm=K+8K432R&Tfnu+!IX(~mm@#0)T;CDG;x1IWZl+4;aqQ}H7jRg5I7%sbT+a?$ zS22uf0sC82ACjsVI9lpM_UCJQv^1kHE$Kw`ZET3@0yBy8gdK`?^^WzWFG#e@#4#dq zwCxp9jd$z#M=ni2xn^~G@&XtQCBYf|U9>DOl2z0gRAnS(tH*1mPTNlZPNzGa=!6nSc?QmQ$N0aqsI1Ebrrz7i%nuke& z?8z|51kY~1MuA?l0@r|y(zj&A#irgHjn z===KsAKAm(&!1jCyv8d|rg(M>X^N}{+N9&YoIb8B00Jnu`k8obB|=#Qv?pH!goakH zmPgzYSx+&5O4*Ju-hzVQwr1!p9q!)u02h~<&OKi>j27h7MVzKQYrpKU#$gwzUx4mY z8Yd3?^Vwu{U$AI02j9zQXom3-wPVat($Caxki$Q4?-Pz&_F)$DQo@&JF1+DgC-#t& zu*ZpcjZ{~IEP#|Rp4g>@7Y-mGkSPs(URmf}<5+Q3LA%Oo%4;q3l*b09|5v7wjMP%* z$u$rF-u$-vae?yoPo&YU?md9c9+aAZNXzB7Jsv-8(0_f@tA#Xb;-!GTu6$2x9g7VY zL1fEWP2>rys&7M0GL2Tfocj=DPRc`!A13{LmWsztY|=Bkcm7v*0chSQ!sy(li|gZ%taSAeVkBT!EyeJbEAQ7ex|F(>Fu@Y3{m(0yJY2a<^}`zimiZuKL) zcCuYiF@eF`2NJTlTPI8hcA;lPTA?(6!rFml8MUOs^Y#5leY24%r58Yo@XPyl(9`hD zhI4FW-a|)T9xyKji4p=D=9}`UH`>YPC4IMv<~9QKD{AmM);yPqf46<-`c;VSy=|{+Cc5`@^vHSX6ZX1x{`1x`A?ekO+xn^1!f}@7#!nBg~c?aGo zB)P|iIKNAMkGy=Rwqm%qA zm7nU>3x1~zSflK(8=J%GI}J1AjE|wZBikI+m)&t=lA(-_ zeClw|*(f`BU(t^ttnNeiUo`m4g}x*bP4OVBf38PeX3OKky$$@V`%=NzK9@CyeO2 zp3l3?33upnG0gZ|$6!coh~UMRY7#1 zSNQ={YVf&wyoPljqMMU8af&9d>72>GJssn2RI z#r8E=Iw319GoNf~iBiI0Rtw)wfi)V>+&n#N34xqy{wj`JN>QS!-xwRNL7kk%;}gxy z;28CzuG0?(TklIRxxO!YGOfILd-lu`I|@K*QA71hD! znm49QF=}|J?lX3HK9ih+dUd=zjg|-<4x1Kd?tY0R5FEwe<|SUZ#01MVqrN`h*r+3_ z@$Tgzo+|9EUO@V%LYLRbHlWB-AV|tlj|_R2yf+IA~l(hbtx z4Fb~L-Q5i$Dbn3t64D@>66ux}q!mFa38hPrj_=v(%)IAZ*B<{k`h)#=$GTVew7W`m z5YK%hMWZ!A+|a%YrgU!cK%1BC=ePX0eA0-(`kgZYmqc z01Gtgd{*e-_R}n6ku02m4p=?qElE(XpO?*%zD4PRt+NcV=V+7rju|?C@-Cd{+eZ|_ zBgqc~;Qx8H{r~kzL2@941Yo(K_vaF_v(#|TB0)X`onaGq|Y)t)YT!))Yxa#Y6jzPD0so@m;dMyGN`$k%4evezcCl@YB6dHk)MCM1w>5c2hs9 zq(9-W$ON_k;@^=e()oBR^C9Cs2!m-3gX4U@=3BGqlRjnVWN_;;g%A z`{{J9i#DiAMX`m~)1!oZ`Yh zNEZKYp2~T`-jADNs$-SDZj2ySO`GpA`L`+Br{TWa-h0j`vqx-xbhG<OP@Po6kZrJgfqQZ-L5Z#g|7^IuGI^*X5N!_JdsRjqr>ehw{+*7AawO?6%aB9 zBH1@koq{%b;%!ExrO~#jd_WUW$$rFvW=0$#?VA6W8S&5K0C_+IUwA68+jl4(eVV_jRBt zu_Zx8tcyqxn!Ra5plOyiA-aaMYzQ1i^Zt&m0yo%Yf-U@qR^~2W=sbtKg?OPeU6b%z?S2*$Hr>LocI1Hm{buhh8d61 z6XSUM5u3=12!uVAvzY^N(95GtJZYkn8pjEpA4WE{I&8kQ9@P*6V1&>vjJ!?xl`K3S zjHYw1!=8B~y?pGhnKTl|tx+Mr^ywb}z5EVu@b$4;Zs|mQ!W|-^zkB)MCoiNIY2s=rOQ4Sw4EQjxKOI6}! z7ehbOK8nC|l*^5g1YU@aeHj@}rP$}kOuzz!!>lvC(`M?Sbmt6?lbJ&Tdf6Wfkg7h) zf6U`Q7%iooY6=gC&OOvf66gbbD5$R+^#!@&V&((Tn4(`onf6?6s+@`BA`zKZIArDe zB^u3?AW6py_=Nt_BjtSF%WiyeoVB-LIGu!BQCqk>M>=IL&$@#VJDuYwQl@>4Z$B-7 zg&XjMXB|g$ec0-&_BAuK@h~C3Pgj!t0uTlpGl#Rm!F{Bsl-B43w_Pb`i@z)U)=15q zHgr`x9HqKw!RI_z)8RTV%E`W#HW>>#)~a?8A&J7I5dB;thsmv?shI-FO^taQY91hzxOOL-}`nU{3a zs*S?TNw!6t2eo=xUCsHDQTRUqK{(ZyeR*HugjR~PA5RsoBuOI?s#_OqIMm^qfVNzycyf!#pF1U1D9a8a5kdI!9;wm z$N93YiIo#0X~Ji0SjLply3@?0=06)W&`}|*|)BcTu}T9X^(Sv3zgC!>%g>4VT@_L9jYw5yDPpI z%?nXq@i&ZcM9g=cz;w~K*}YK|W?x>^roM06`JSf*ZXeQ>eh=Svx?RhO}@ou9S9N^`79vzKPHK@=Rt%ooWvf?#K$ ztWV?g*T6Gn9|NaLl<76}Hk;#%17ai@^2eiCdw-aP2rfV+5`!RMY1LwxEd1{iX%zNW zpZK;N=`^)f#dG0^{>BhFwPd2Q$!adfYpn+<{4UlD-!B2TU*bit3hUWXqp^1z{xJd>d&c5xnRZVo5U?)0> ztpwKvJyC2jjr4Km-soPUf~D|!mBcZuIxyg$?T!*fH5ZB62K+_-Jb%|+feI=;9Qj2p z0+^uJ5AJ)khsL5H7GH5^kC%c#u4tz@X? zp>Kf`*eF}Vmo(FIr6=vzX0luS-;|sAOM+_g@6X2(3&$I)e9Kgr$*Wg+*Z$j;Q4t%g z&$ZA$7cOTXa#245*46WJ7@F9PW@|ZV@7_J{Dg5JI9eT1k`H|p_W1mshDSapL&U4Q; zJ-$OQX{NhnbR>-$SJ6x|7eZQt2$Qk12pC3XVn7U(j(b8!*oOAttzX{&c}Pl>Mw=Rm z|J(y3nSP*r#(Nps)*(a64(}M`4x9AJbQ_?0GBN)x$}t{A<`aoz=`0|xFv_V${JR9w zl-NV$@(dVO0L)U~^ONDym^KP2kr(#wth4yRUkNR{ci#^_REH^ClK=Kn86sCX%^QB`^c6 zC$qf!0&N-te@V2h42i5r+!mXp6n?z3h3s;XPPU^7nwlK8Jl9AW3w&v!NS z5?aHd2e_P|jOThy4^r!yYsXrIp4Eg_z)zyyF@X%HeXO6M;wI^gRcjC-Mmr5l-@YO( z9X|$(Z;PafY#u>lu3`}O&NE(4S9JBDy>s7#v|s;@2mN4iZBys88&1r@_N_Y6Z7evh zlFBVb5uyG*g3_BBAU;Pd_U)sF!@T>qzDMBS_OcR>378{6>4zYvOR6&+ zi^FquW-D91*4)KTzlKK%b7+1vdCLb@kj{KK?eC72dW7%p(>aIaQ0F7jcT!V-@I|eD zEyYj&w89aJ#2M2s;y4V@#pV(F5Fn};hk~%~CUF0hy``#$o@`x)XwAKLxbp5pG^=G; z*zb>Mpiz{moiIg8md9VFGJLxdfCmY=TMPPd^7P8Q)exP(|4$vNEFk6iJq5+nw!C5q zdvL4e88JW-M$cN*&ahAo?(?ICs(_5huD5vcB9sc z{2d5n@I$e!f*FNF0V4Ioe+&aix?|x}gFIb_73<|VeF&$-_6VSqRR+>(ZxZ(=6#Jzx z!9Vw^NQ<9QjsxQW59?48`l@8>pg-J0e|T})QTy|Ia&*v1Cf8i!0?9A{rG`H&Ms z_k}-$@3UlEBYdwSy8U2ofQ{5&aPYlZt4Gv7IakBFUCE4o(MHDKIg5Z&)?qoA>%w_n zR-S!U;CHceILmoMk-@dP&hEQEs|Wrz{dySyI~dCvOSH*MBdO}_cfs6B)mdHkE}-13 zhi0tZ57i)wk_Qn?3ak{?!4Liq1Ej4=wQ}TOQ#1kp*mz*aJj2SM)6f~;iX zr;mg*GiHn!nrOBR^x7I5Rq`+b^2LDVJD=P)JnOJ;UGZy~1Xx(mUYs9{bFJfyD8$Gs z%ZpF-5osUdhiJNFuDb}Rw7E5#B%0!WHvjs`;pn)2GF~Z}%IB)l!IkviFWTe0B*%>o zf|7;YR`HPFzETKGlN3$`w|FQ3#`rWRZ1v$q*PEIfAOjYAFn#FRw>D?kcYi5+^r9BA z`({$^qWOA?2Yu%gDZA$noREp|5l&{5(9f{IH){Rc$m!&;i^PK4B&D;!)5k_>DO3Wh zNbiDpfPNs->P2OglMO>*Lqcm_uP!fK>mquEG<{k z{j%L;KXB&`_z-w@Z+I2;2cDC7n{ zbg_$Q2(x6ufM*x^H)B=CV8dJc%~Jv3rh(9S>4?^BXL=zyHdxaLLbY*ZR~ZJ)fbA3$ zyn{|T5XIoKyQKY$rmP^T6$i#CL_*C<#8VAwg9&kZYB4neL?2$c#YU*{iOQ*H&7qG`EwA07Ad3ZVZxy0vv^ zpts`8hAYiJ-Mnjlk}0Z=3+4yOJ&*C^3r%6?z$#&H|0&E4K=;pldy93gYByy$Avh^8 zBye9H5v+D?K2ch^5Z+u(XU_=ek?R=1Yc@WQ>$wIZXug;|M3l#x&6Kz)foRB!sHYeR zf2>Kzbx>me0}MqzL9{+R@^G)f_CXNcYD3GnTX|Rdm=XxEY`R}0QJUjUIp1(KlD8lj zo#zv?{U&*39nqsw$G7SC>Cmu$Hi*dj?+x%7j)oRKO;57#ROTwlOt* z_;Dey3m*Uv{WG`kWb94^o2OLT){N6HF4I|jOZsh}=!bbu?aRbqkPXD){Gmu>&EI&EA~mDn$=@WaKlk)V)N>wTm2P8C^-X*=PWE>UPeMwErp%kJo) z3N&g{mx$++0wMQt3HAQL95(?yFX>LLWnci@*mAi}ak%o?ZSRTp*30PCxRBRY69YVh z61|$oK{PbMepae$6e`7R%o6VZvy+*5#l{zb=o^^^1+mAeOVgXd4HFKXG}~SF9GvC{ z9E=Ne~)Sf z-&!||uNmcd>v!1%;uVjZ&fC{q_QKsJn0wu;&SI$3{>WcoPG6#FQ+P`^`h#&DZ42-dC{e%v~?gwoZ@)-qe*r02jDFNT~4z*FmmbEH^Fq*4NsYklJaq-3lPd_VW8o_RW1V0=otSF zc}(VG5LFR_AikYM(U8>-Au`18U^aQl)4L29=zjs8rp~oXUurAvqquwJZxi})0Hnyvri}8ki|2lO(pkYq$n&tJ zESYbmLNA4by;okz$Q9Jg2c6Ck{?5GnL=Rz4d5ZT@U04G@ur~YYcSmJFJBgqKn~ft# zO3rFlNU7ohu_g$bM5FtficL;S?W%pDM+Up3=>2aAb1bGmqGO%OyNq2cd4(_P!9b(g ziQK;=vzYU^h5+6Wt0QJ~?>mQFte#)APgy=ZKR?yH@x0^)^}i9^Bdv#26u$;r_eO^M zj^%Y=zy*{{UGK`rXTK#`#okRxWldD@BrnL@TN-U;2Jg$Z^EI&B{f$ZdIFOvR|6BWk zP9M-gaW&LXmco}3P`Upv)j=N0=}!IYQ=KP?dm9ekpUJu(4_Q~Ig86hM=@r$xQ*Fxc%#;m$Ms;vnYay~F zJe=k`7_@G}Uu4H_fr3iemo#m8`Qfi8;W=p;&kam;j9-T7piyaH)3)JOj&*1r)4cSc zOJF^z0bc;X8hKpX0+13bpeS^Hxry`z%r}4U>*>4Xn5>YO4&oo&*w>r99lpfj$SeTg zj?a>R+P`v4U!{sC8p8dp!6VU=4)~tO=C=_G!rnKu;8yX_#23z{ou10?Bh%Ma`x;Yaab0yu%*xJ?GNX6zHOJM;}aizr`YAEd%ycu4Za2KXAi zfhZHQ1~yX>JkcdQxi^IKxYz%l$lRtXb>N~^%TDaCr@1lKdPj87@Bke#Ed;DCQoBpy zUEsPXz(`_-m__sUt{XPELfQt`R@Y1DDoQ7SdwoQ2MG5D`|hhkp*HQ%)BAmaE;v}=LW6ps zE}tc%Pn|gyD3}h<#P>+aur4jpSYMoYlwOYyPYg8Hg`1Ybm-4R9c;`Zhv&ikY;yXW+R%d=P2g=FlmFLLK4*$4w>!2^M1k!{ebBNYOmV;N|*m@}0dDtOVdU+~~S)x&bj<8@pvO{#}Gw z0>;-c@V>a%VBV|mOzh!|eL;+xZUY`9zKs|hiq?OMLUtaR@T04ZGf5CARwrGPGR)~u zjMYr|_(z_uF!iO}w>TRCjhcH~Wg~B_&B@KZ`65T$65Vf%wibKhF&d}eZTk2?kg^Qr z%co^npeZOkoFQOprH_BuTlKc z($ZEP;yJR^)YLcLGI;dYD$H0swHqBwT8-BywsWyV~rshUDwXk3wj zoy8cfJ}H;|-P%S}mn~ZQxxT?e1p>)bnPlsO3{=XIP8NKz8DjTJYS%A-@^_k+JS(SB zB$rxJ^EsM7y<;mjNM=C8e2@9t`tjzGa!C_L7|g$4wj#f3z#1>K1zZ4lDbeItI}(h< z_PdGP32+%KrV#*-2gcEi*{7gt;YC0=wOf>!78*g$3fD;%!e9V5><2T)MBvIS_um>I1I+;S(H-f^ zznP_rIV6b%-#Oek9n3wJ}ef_Hf?v^2-^>c4rP3A-d2L~HlMg0Tq43g@EDQM%m9*Nj+ zo_GJ$KbycD@hfKZ-`u|>Wp<0WWH(nZygO0vdLD8Mv2_h%@o*%|3q7MD+Z zAFD>a`q%78Er5R_*S#AbClDPkYS7I&yk~*lPGrfA9qg0&pG$#4Q2g_axW}3AkA^j6i+=2TFd`+|cEzY$A7BM2?j3}!Y zU+(1DmdJKjwu0XSkB9FI`)_=Pp5-a77)fkN%v6EukCW0q+KP_gJjB*^!>G@?MRj33 zB{`*iR1eC+(!>(d!?WBLIGtJm+rh?K=~fjc;3Pm z=Qj}!i~GIB(*x1X@{)GFM1oOp2mbdN#ALJK`2%*+j=wuBO+Oe>#mg?sl6nU8MR-x0;wWpxRf zOPx=_n*%8;ozG8>e$AQfqBkrL4I`y7T=km8;~V^k^bTU`IQ_E?q>2TFXC(29pNi#B zA4l*5-wwUKn?ee1W^^fNhToM11#Q<7{&Zc_;AoZ+_0Fy8d3b#SQc?vdu54Ku?-_x=8%wi+RGw=nwy4 z1_^;h->kf-0Z-lZ^kGOz>oECXG)pOpZJBKmFrf9vZbcd~O3K-vr}7F7|MM{N=hHxs zK+)3$+hO*QV=L`lDYihJW2^OmPSq;JsPuhot1YxX2#}JLW{BNgtWOqaRU@nJ3t_L; zH4YS4kW%lZe9b=3+5xV|gL`0PVM5Ql3^tRPRieZkIxHf`6yNrh;CId0RrEQ*df8~+q=)i!waLM{L9ZFMPH zUZds%0maMApYGNk17Qo`b#OPFFj>=^1QA?V600|@5QGmt>W{(QWJkP#gY+?OBA@~sgx^RK>P`h=l9_zKS-fEzW@Rkhvevc~J)jG8yZ zRjVX`91yF_y$001u@XRQ^*K6M1;6+#3O{%M)GW|XrHowv=3G|)$k$}--UvPXu3NL2 zYEGZ(yqPL%iY`5lOy*Pkf{kZue>#MxiXT7=S5nVDzT22zQ(fv^>p)NJZ7p<}Z{N&2 z!EnZz3%nzCAQhk%6*YA#Y>N9Mou;z)elV0oQ714;fF~-Ny|ugh`acX|EeukHT!NAX zS&h6c!l5Rwjcc0p552e#Ol+JJvbyf*s;|2-2fkYSHrF&wo<7we4OF-16KYD?g4Ig= zQU9j5Z7O{_RTHa&zQYh*f?|7mBjf&nq)^(aHJ=1ouV2VS>&T+WBV1){b^OK5P=Zj~ zP&I_NIP5Qy&KOJIQ~#$B;S!4K}^~(mE=kH-FOQT9v5O;}}p+e@__p5!WBth|ax|Ej{3-~52OApFjABf)l zd~l`wC9$B^lnfw{&*?g1LXm&@YkmY@h+_(En^Gm{H2$pkGR4N=m((`>(S9)d86YbF zVV_6c_f$>Iuq&0NkjZY**e{j9jpeLFo-kp%2W5-oDemF%dXWIx4+@W0lmdj4}U zx~Xc^yLTptuQ!xo2b!jseGRUOmnLBRlmbFargQHZ{VaWURrn`Y*f-F<1I(Z_{{2%^ z=E^lZoU&L6x>h(-4wBqLYVwi{1+s;ARd-Y8bv#Rw1$Lj{^vFNw6vy)kqiOK` z&QtmkVn7S_HHO*1*>i``vV{+X$^cTJ)y|}p8QhAGj91y7x7?`-z z8nX27IVxSFDSZQj<{;pE{RRgG)z5mw=(}M%dH*7GV8|VsPjM<`3v`7X^FJjhXuFpX zphg4lvy4Jd7r!(vMY->j5IfH%8)ka`E=cKlv;m5K>AZ{%s*3!nfj9EvKa{vFQ>oG( z<}AT4@tqQ?zttUI>`@#0|tEN_b88G9c6qK^sPo@0%vR zvBNtT%BR|W_@4+qJ>qsAcsF7ptkG@sM3(ImKSeGNXf0wpI9SjuuHSN63PMH3PnMq6 z@LW1q!w-(w{RO~|aoQnTtG;h!;g|PXi3`-)LKTiDP-_W6@fwErXn_;4HIt1XkBMIL zAJz97W&NUpC;i?-L4?Jlp_a&&cR8)Pt{BWQ}!BfvNy6a1u2h-yPubDB|mm$~Ym< zWXjt`V(Y1EZTO5MAgS~TIlM`Ef&$i7Nh8QX`yNonJHZn}(i8I6iGa#14We)#$r?8> zx3$xH)UU4YWZw>kQ`-!oV}ZE)X!`#ANJB{Yg1P#`A^1`nYaRMC>%9I!iohW?G2_8O zC9(C5FIDm@XCff9^IbJQadxvaCZe)})DnzO7FQNCf)@Tap*7)zSNVzAjcKj^mxRL! zmmAaTiH=P|C)G=(voQHHRfch^IW&?-aY=X)AhW+lfS1n9J>YYDh|*|$A1s1 zihvrlTy5sieE*Iyf90*V$0UsPQb*QYZIDX-MI8fGKZOI>6#Z85F{9OnE2)FRo+~sHSI9m^E22)Hz>tVT90_h9A3!6*M z%I;F|pH@y*9>$Qsa@*;db$U;3p9@t>Vct_sZ$Be-pM_{m@|s40NDEta>~OF--q=>xC!40NUL`^6kM0=?VF*0#2@uFMAtGY zzLoakC-<5tJ15WD4D%Qv{4*uIHk`EhR$1)Vt_jpCt(V+ukWV*-l5t%YPO5b^UrE75 zCKy~~fH}gfI50(|xe)m7ZWpn*5NRx#^^|=F{@&pa7oGrLMh&@n=td$8X z+CBb4cr3phh&mV8eb9;9hPBCVI{2e&Gx_Za@68WaIUqGjL~ZzmIQ)35&DwdE*fb8! z3u&Bnu1rzw766y$G%l=;60Xh>MwQIT0Q$TswQ((33l>ghC3!wH;@qaV-ZHi{Q zu%($>(tAQf%AZ|{@AGiIE@qbdOOeJUcMNCV0`JxKj8kSh1|}v2zjT7InKiYUoKhAA z0bSf=;xtODazz!~(v*+LI{F}RQH{(R6^JR#$sh*v4@=zjbAm@+D-9WQzvd@w#PesT zEO8AMw{vDwbtZU-&5JJ&SIfJixuDUZX{NrS(UXdudnK|dDDfkNX5nj4ek4KnFel3| z`m>dGV2E*-o)Izd!5}*o*%Q4pW@f4RB(wVO+thlu;e5X%?+xgliPk>j$lApIShqjm zPRkGDG*W!C(eGAY*V zP{7Dfe<`JL@hUvM@YRa5TpS7mRwK&ejHN(4qgptCQIpx4`q&pm8KC_=29LP}Sn4xg zXovA7Muck5TeZDa=Tv%gM$2j4%LdJQStV6{1SNO!Guf;3t(K_^YvTKZH{bSirWHN5 zLe|)!F9TK`2+3rO^HIQE5MsOdM5Ps0v03o-y~a2JcHkXV70c$>;7HTXg>Ttq4mD6>AOHyBZDm?UrVIEzK7ghhE6TQ6_!U4$ia$tVx5hv%4vo zsnLzv6%u-O)m~A+XT%xj5T7tBSYxGH@(ad?Dff50%BO68w#N4)`HlY;$4A<5wFCA8 z`7g|#v)*ZWNsE4dFnwQaL~5aVI0a zs(ouGx#;Wm%u`kegPFQgBZazD)iP9xnPjCHc|MfNgQ4Obb(&HoFZmis@s4guAYbv0 z0lt!nQ}Dxb90ykV6Q-ByBk_ueCfq+#4KkG5*x;?-=d(=_8^;L=AT&P9gWRNEX2uU& zzZ?JH&$6J??Ec+?X6Wn{Q8VG}l}qmh__y=o2f^F7Zy)Vph3~*->oOL#ku**c6+j37it|{;mr$mmwm_UpJ zK}OOq_cBr3__j@wseVv<)5 za$fT6koTe*QS&vPtM?;3RvdIeFekkDxE(11f|LEmeA6`itFzP#)ms=Hm zyAgR82o*>zxWTRr*%aMHi(Ggg!|W{|>N5h4s*Z`~)YtI-AIbS!wcmJL!%~5%KdRVQ zj0l{9AvO(Q@`x(VhYg{BVk7yH)xDCQQ72wu^pP&Y7^cFmFanEWQ*W^ysbz187w2I} z64uWJ@C^0r-m?vrFM`8AP<$9_Ia^@keM?Hg-CV8uM%L=RFMH@IFN zxE=)=AT)l>!#JcNsAuQP7RyV(`-mX!r-|NL{@DkFRo^O;$53ywSwGg{ES}H3c4vmw z35ml)>F6L!t&$&D@3NCg0S(>zDN=HB^a2B?X-8k$WoObvA7R$v)??h&Dy{(n`jxZ?z9dw$e+rg(kewJ!&62JMf%owsD zNCNxbmZ3VZ5+8ctb}0!v0wQ^u2v?6^t6`s-H78ROGiKc>aMhbAXDUlIzI*4Fs(lCF zNTD`W7esPIiLBH?M}CEbs;f#8MV+iPM&~`FGophXeo2wOqy5aNwJe<#GqKJ{qhjQu zEi5E?mt*RsNgVSWf)m0L{He+7s~S)my)3z@Kc1J_!JICA=YhX`LY1Y_u2CYZBBe_q zdFgsg#Cwm}hY1Wco3YQMlQUKUTS~gOKIe92eC@fC?%(N=Nj)#-U~!>Gs7kf#;yE{H z@4*p$&SWyvK`FJP_cE97hfRV^D)28) zPotw@XA`}x3nnNW^{?h4bQR8MzH-l(2aOj$xbHr) zhBRUQz1`XWQg}>Wjh(2O-(0wK>Xe-c>)eSdkFvYl}xigeY=in01NV-tvKV4mFT!WDrT?c4RJ)xku_~CMFSJz~k2-sAs>%A<~j@o$b2?i+l&!_c?iQ~e<(KD+JI>r6$jcZxXEt-v$UNsN7hs&(@ekA8B*TipnT|eF<2#lU3 z?b!0_g{G2^++r?S{m%#jeVuYN z4EA`DXRe19God?h(VdbzMwLzqlc||y2xT+L*XiO*-D#;AjS&pnx+rY)I#eQ6VK{lR z_6$Tcr4c%>g;FqPKFG?8ky4$!LEU!3cc9Jm%k|{ncAA;C)}~u$eyJ~p&r66$$OD#Z zJ=Cwr?}Lrx#1XCXFLgzglJOHz9Mm(Xcp_1EQ_ozg1Q?0QdW4e@IvSp`#_`9)vZH=B zd*E*sqN^3yM@q&otlKQiEMdb?@ZUo{W^dm&b5On0Ut;`3^8BGx=7SUOm0BU0hRchS zcdZ%XO@T((oma?-uO6!yz8{S?0!6guNl#90hV5eK&$n;Iao8T~c)TrjQRq*_pi5Bj zn+Ac%BmLx$pPK8~t$6w$oQp`#gy2rl52*B(n|Q9kG^p~p(b8_@< zj`B06PkquE;Nt-sHW)77Lev1&i-)In+TTgqsZXcUtU)#Iy+be6E-7aJ+s$0dX{}#S zCxhQ{wl}rFzF}Ht#EU-9D`uN|q|1i$`XmGy1LHG^6&m{em-q7(1Y2j8);6o7lLBux zzajV&Cnvh5X_7_G<=mE#4H@TCHFH+ZyU;1Nm<2{*&&gLdulkmZKLhL^V$nU|17*^u zQS>65?t8oJOo&RMK6oujgmYhGU^(+FAE`>omxpP0& z@%1q5FwL#(Dh9r0MN#aL&CS&kR zqG-^RW_YQuX(PRiNJ##yTNGXu%ZryLs84UM5R`U6uVNx4j{i)Iz@I*wZtA639I75X z8oc(Po^DUsp}3(b-^yt0yHjHcT{PVSKKW;_1ZipM$B7@i2#bp{dO2_fghm{6puAp9eb!0%E8#IZh8rv)8q&60T3DcjI z?Ne!=e4|kuYwX69oK?@yeL>p^Q)s#c?i|W(T1^BaH#~5`u}}(O4#W7iYRIDh&sZ5B zBMKnutg45i(J*MiWk?}#6An!@&3CBEu_Ka879CtHYglI#UaWY$j<}V-lPBgMIm$tb zCmAnFiS=5pQsY~n{VKx?NDrr-mP3(r7|@9*0H)k}mJnNGJrw{UFA9$}*S;0ZM=EzIiwRun`CB|OLU4~OpG@7)eUncI3;Fz>y?u<`Ip1%?P

+a>4$% z;;ZsAPK4?o-S^`QkvsRXQo&tIz2L$A}eO$MhJPft_hmL(}S9f){)6Z07%7n}n&eb+B(QfkqGaX=S96f2=xF z)>WQ?fLDTENi8>d*VYv(ZTzQ=s8X!`R^GVyVtitYvTN;ol`T@1)Xz5&daytF$%!_t zOgNOQ~z8M2`AI>qxg$Ug@5Hf0+_V64wdvYY&k>x8-6*UfuT! z`U-L9J?4$f=@*XcgrcT-n`!#uH?U-;0}SgtB&ewYVn+=?FO|ARWi*my&#k3mlIixV z_gqp&uIFpOLr1O93j!ycFrP0+~Q`L)#?H%bd&psg`*M@5#ihz_LAtEB6ARw`6MCnFiQ_@}1jeydz3F$@}HZ35H(hU-u zl92B1KI_5v{l4>!amM*6{!qqP&s=le^S-aCeH{BTcD?1fIs*ZX?&Z(vAb5phL1 zDNUdY={pS7^(y4c8}Y%y;$o1>k`;B?DsdROyv$$6laytPluc?x9F~6nq2Z^uO{?e) zpj9Cu!_*7kCsbNAuuNj&q58pN(&AvKP#DT#WTLh9vgL$?darELK3Uh%J(pM7n~1gW zZH}I!h*7h~sh^ryWgZ@s=6QK#;+G`r*fgblI%9=OrBNTS9@1t@uu?tS5yZ&5OMp=9 zh~^m)m=r;s=bx>ptsyECZ)LJ4J98-w9P*AuEB{Ol_>r+v5UmF&mxBYW&#L`4MFw#~ zbX@Sm;M*wIv8QXa;H9P(a`0V`YdB9tUFJ)8D+nYu!msOlsz^4xYVh$7$xu4bPo*vv zM9oyZ=yBJIw=Rh9o_amYqK{Tg2j!R|?+!KRngM?2YQ8{b{oNglX2R~STk=1xLuPUh zFK+>;MZAa8V+}9IxuG#8Q8GP`8j*@5_Ztbv08jSjG55gAALO8XJpBC1kLvV+E5wqaj-T+W?lA;GcZoSO3hfe!BW=)4Dw#dTV1^jKJ$zRSM{8u@VOrJ~g zzKon1>CW};wfFR7YWngo6Xe>wN8U3~WbX8g6wd7p>tYoGeYxg$A2j4xSY9vjLMu6m z4Jr~6@r}a3%{HDne;W0YQs|RMZ@^ zvar{d!-;u|szt1p$xUHAAgS&5l7sDe^NvvhyZKvrUHmEXikq^I{v)K?7dKh{zL{oz zQdD31IM`K0rx~1VHtX;m+v8DxGh6@xd|BW^d7c$GZl)anB4BrjGi$a}XfYT~LPS~r z)!;`npCatgDVAktGkzg(t|L87;ZssA)a{>);rfijb*;)OlL^#1Si?F7KeBeSP6p^G zN0ZKmqDW#kg)Juq!O=cgtTX1IY#8)52Mx=A_ys`0kG=xrflCW}{spy_h zhh-}NK5nvwI45~8-$T7P6n;blIg+hw|4?95D(cTlzEXg)u*uMAC&FyxArlyOldxc` zL}iF$2sjJHaF*Y991ds$FsFW(agKYF=+E6Silg|awP)UZvz!-Jbm6!|#@Z`C8;N89 z#24$R(_|#gt|E?H%3#!!v|>t>f8J{9XDE1(p zkvWqdu}}SFn>9TM+Z+eVPbA}c2SRd`glCdDX#9frvKHyX)Kj_7`X^~5O{R8#;aYek zSk-SZBV7PK_{R}SUW%JsD{VWGj<>X{7P7|U+w$T_T&kWUedYMM=u zBFuOt(bEX^+EQ{bKG7uR&X-jawR6e94k$=TD-0IGrv2782!Alpw!{_b4nR&k2T{=Yr z=CBcMGQScVIjGdEMJ`mc}=30bN&q92lOY5yxn=;KmUqxwTQ!_ilrtM zVP4tDEc-*Xxc9ldb&K`CdY4zFOJ9%(*e~=RSQ)e)EW#KH`(DHi+84ci#g*QOdH6}s z`ILl!)#5}1VD=3O7&B)WPd{Qq)S%(3|4(X=+s)fwPb4UwznLU4qc90BXR;SDyb85? z0f60t{6J!-;glx`DF2>l;tr zB(UdF8s1x6P*H8$v&kQF8YZzW%6d!v{K=F?f%1J9AGalykSNk##U*U^#M?CHx5nM} z$)9|z(TLUq$uO%g(3}+=1iJ-@5mR5 zf#a0mjmY3w{|-YnH?PTCvmPb3n{YqF81UkTL0BLg|Fdz7}7*#tFGcjl1P<6;aoZ?)x_^_VL^%lFer8LN(J=D&((6B z^CdensWpatlews4g!18#muI89Qps1Hu)um)nJq_&)%a*g7^EqKTLyk|w9Njj|Kj6O z7(6;XVwEv3Lie)j(y$%7rslz-Y^*1+@YDqi2X!a#Jcyk9RiL}lfb4&!MgV3sB+#f~somt(6Sh0;(Eh2K?67_SM-++G(!bjD z^+JtbzjpL?Ldv>7EVQiE*R;-x)6mUbT}Ux3l`Lnb4beE{tclhp zAQPb?4Z87Bg3HPaaOM z@bn#Ee$!sc^kl+FcW}o+XaQ8m6h8t3GemnyQ*<^m39sULSq3sdk*_(v9W-@k3Hg3b zQMj5X5oMffl$!?OP)EJd++4Pg@W07=n7VKr@qo|n*rq|8jc)1DQ}ai^8P-K>2W%-e zkul$vDd$}LuaCVh3_X($gTO#8q^Qljxwv16m%61XSyG7?~}Y0Sf>&4fQog z!LJu^6gUa;l8wFo6YYeO?T>vYUid+2Cf9z8kh1YdJdgPJVx;QJ znA+Y1yD6`KzjbpmI(>?#WSQff3UO|ApGGRyyMvMdS6+Zdolt@>`9etH!u}O?q>!`e zV}%mdug-tM;EL(AGiGy{lk%6ziAFVht1Aa|(jz&~2Xy$S65-nqMjnAX;>Qu8!$?3N z7P6lE?xr@}t_O^B(HsobEor;QHJD_JA~=o~9@sJFcSc0&G0#Qw4>5D;vClG|OT(|n zK~*)(?EL#gKlsOihO+kMHsM|F0V^Cu5>JhyL*d<0jgpxi2mdQAdi}$*d$jTnKtj2- z@*G5=xC8eeO4|WPfhlR>n7^4(`L*93Fb$G|jX+M6 zEg3|K3Y)-~?Tj=}gdVO#)>QwC4whTowk*kNVXad>U%*y$CzUr9j8qsd)KV>YHJ6jU zWJ;N4(%Fn=A9}3yD|DXld|_n$`8MhD&sXQ=ThuZo^<{(6E$~%WWV{$k&~y}cjZ&rs z1$yd@2rnNMoH1!Btb5ql8!)ql>jnxmyc&T|xOIxVIpe%y)ZZn|&|bR&EVemV3!$=( z+EKZ9m8o-G*b6!n&>X5!TV6?71KteKy*xvz91vhPMT!L zLZ)UR`zaPkxBIHwN?7QG+myGeYK4D?F`v$V7ZSZc40uaI>OQ9`P9Mmd&#Ot(+~Fh~ zq&AYTsgI^y?j>*&07`?)Tz=>`?}_&c0*rzyrIZbk0%qFh93;A~KRF1bT}0=4>idm< zQxO%}se~AD)2QDiv)5XdGSr~$BP*U6u60|Gk^Eihh$!hJW?LiJ5L--Q>vy^mCm`S2 z;zS=TiF!^+NqKLD<1rowd`PQH{yNKHvM!|$63VFhtYW7o#2R#>@wby>S8Gjr>7_^f zv9gsGR{Ay=9ngDcWzx&fPO93)#7%OOV`+i{lR73+5HSuT1Ap37!JJ2H;>aP(@$|u9 zorqtobr%luBpO)8(h(&iv(u^Umo(Edh+ z?f75z(wW4gbpTQkeef9AWNw@8_csg2|GFOWWJZbRyaPLydcfP!NJ&J!TovhxoB9mS zEm3F4OnE%k;C})AysQut03HfO9}Ma9FV`eKC29X6hcai14<1V5N4>_LpXN{2$J}g zb`(e^o*H!tK`Nr&2v6IF5oSHb|G}|#5%eXpwO-~k7sOAtz>!bB4+&>>Ch(e$zy?&BpXdQZU7Tt7I7WU6~ytDhB-nmNlCW)o+JW z$79R)fy)3q(uu8vu7nIHmi$A)J;{uU9)>e~GSO$~xz_mx)QjYtzW+_KpWU%rk}6BF z#v2^`JXCa3v(k&@yWY_)zD2iSwTmBAdRIn^9iB*bxv$}LCGvOjRLfT5oedQj`)H`~ z^4Je^Or(1F@Jp3I*`8O3ahVaJAc0KBudK!*^RniN*n!gvO1gNNmU|s`t2n%&HpYs+ zOeZ0_I>3Hao6ZQOuKKT(?_BD(CtVrJLiQKz(t1Ni5*tB*GGBF8eMF}B`0u|v#QYY| zPO;DKY54UBSIpQxw&Pf4W5Z%_6-l$szBgq2$ZOo@TwtFl#c9dn+o)gMA5I<~L% zo7vE0Gu&jX))S-cs6I-=gog*!J*9Gh?(q^tl% zgm8+tD07AMjI(tw*Nx)}FVIbn^-k;cRIO-kABg!yX>@orXZ77Fg_isoUd zm_uyp@xR2R-?E6>kTROkNvx+DQm!xzXn=?_*iGk#`>wsoe?VikTme=a<&f>#JmHk( z8c5ccfm)f;OX?*s5>L-NRZn^ax*O5^Lk$zGHD0aykV^_T>GosBd(SgkZD$|-iqwB< z+&SX(qlxvokLQ$N9RsI7Mw@ zGc1V28v)&kZd$r>Tx{Z#ezVmlXwuwX+fq-Jxk78)Z!MAnZg(ODG)8@&s_FTkBb_CG zeWZf}OuCC)rN#elz!^FNiM9`~r!=p)g9RdnH$T?iv<%@3#R1#3LT;Z2JGE$cISZ!e z-vpWcUyah)#^1k<-=2FDph_<$9_6&t)6Ve{Q>7*=*%Sn#LBl;_-hRLa4QLiKUl-li zxGjrar37JghDXrY?_&j~5Iw0gTYlWkKS?CHX@;oeS-loH4u@C$tGRA)#M>0b-L%WP zX^DSwBy#V}7;M;REHhNq65QgkoZQpuRsBk*V6bjI4+qufyF}%Qt$Ep{GEfZyTl)o4y&#sW} zoH|!`w$<8%s1h1O%pB?QR_Rzoms$VRjfu%oo#x3)V_JRw5rVsP4+J!O{*wq9e*`5$ zeA~t;FTYlNg&7ltJl{~)F}|s6QaMBn9*1BK2b)j(&86EZ8*eh z7&R{}sDOeSY*fvpnlPxZ3Xhq7E$+}dQE3gm=Aj8)HFi7QHvNTenA;ff&n@&*hU1o! zd_|vXFhQ63LTAj|Ws?sAdM?+qMm*NdgMV4xyS>f1d6GZ5Nhg6@$;|D+H`h_7*a(dE zdbI7;qJ4b}7yREg6XInjuQ6S1`N=*aE_%2J^O*x?=??fd*zndUA3U6e3#j1i&`|=d z?*P~D?#lje)a86eSO=fiqbI@#Z+Mt>$cqJ4_t#<@!qb19?fhEXB5%_|*t(}bVZr4C zQxy{7?n+=YiW1bcC7rRRjo2Ug`JfDj9Ve$Vmpj0W)%=xLy2MB&D+S zbZS7@(2ic)AwOw75t-S3Yxw_SC76HaI(Si5R7zFh{mk_| zxoCSzLnC4q$sp4nMn+1ysw7ZI?-`&iF<^hW`m0RZ#OQQ?B^F*#2h8C-*XHn-G6Zo^ zJ6(fEC9FI|3$Yu~?zDm#n=mD(y;>Jrt-=?buOH-ykuKV8av!>R6kZ`ZUwv@QxAw6GO?|5OS4BKwxjnZ2+QKD}b*%L=fGPBYE- zY4%Kb^fT!ez$Ju6A{ud4C_h|p#g$hFr1(g~5fgh0-cpj7gQ{^ScBVE7`jPGDs_;;t zmOUVUGFm3Q=Zw)NSFX%GrG;*OfmW%$tr2ThJaoMD>G=M)4sY3=w-G(33o7KnMka3n zJaPHoV-8HvY9G?+X-1dT##^uO<}CU25?qmARKRo3fWbR|#@uEt+THE@oJ`v)VZ(2{?y7R+v@Cx^FWo0tlGn1e<+6O*; zT-+2VV@Fi-OJdv$D)wai!UqBeRSh(P6v5N?(4;TWuS}y}xq!%o4d|XQ{VLiv4TLcx zi8N^LdD8Eb`m}bIeb;PL<<~ak4m-Ih*SvjUCP4olV%x6bNQn-o%7R9#vJgiJe_TkS z(;$~4E0E5(s=rPA1(Oksv?0@^`tz{;Qx?x*-8hA49(EImg@WuG2}oQo(sFAb z0Q+_M&ilt2#gzPv?CkBtM-iK;7y)d|Uuj;*?}f&H&iKlS4c2u4?I1pIpAd$-0Sewb z)1w=nU+I!sMr2XTNEr?@yJ{^vQ0w}Z-RH!=11Uk(FG1nkt>Ns)lNvQzbS~Xz=v|?= zXiW-Uq`zSvb($J;vVfh?L+~5NA?xcwhUnahy$LTkccajR-mPb>ub#>2h%8Sj<@tu$ z{oAmh+|=s5ze^#$d6Q=@@;)C2P6Y>JdYP!-^t%r1;3{>Mxu{hi5rBJJyL^9bn$+?a z8L+qE<$dhzSBc_cFzt8Sw9qXDzj<>)3O&>$ zu20E=)snR(L)xa|8=YxXKj z_0xkw7mOVC-MMSfz}|HOuyUK{z6h6HGxd5Ya1lP#<@1$~dvc^1e)(T$x0BTGOxXsJFqC&N=y(R1%hUTnY4AG>CDE(N#LyJO<{n``K6XVL~Mg~`w>@LKU?x*=Otcj?ZW-l z2V-7PK5Tx}dEkZ8X~uK5z{tq977qG!f=Z=ee*9|Fz0hVx4gdvHC#qY;Qj`dI25O#` zEg0%zrUz=X%!lI+XU>0rIYKT7%*v9GS=sRXc<17%TiwB3ub^J#^er&=!znN=i@ai| z6>A#8)-V+;Mm-XqK6@r$=Febqef`p5R54n`M*D>bjcy@Li%Nd#LKd9(SvD{WKuA`y z^vkC)#M$(m(cWfc*t3Z7?SiW)#B=oJfs6FMRvZ`_-HR4(k38F1eAULcvXOSCa+FM` z+ggWb>0Ve{#pGD*$`7iZ><}{>XzMV*%7F8lc>ki`xX>-z?Ds*hEkdLC-!1D85XTh* zH-Jz|@F8W@8y1SD~pj1XJ}~kTE*%& zD07^PuQorHU7ohG0!+l5DlS?BHKg#yyw@8-zDR{1kt)BpwZF37GULsoV=z=7FDk;W zG+hY+YU)79_iMmn3hwaweHSsdufUl`MmnMf7bkvU@;w3G|D1Eu?7r8}0@E2L z5FLHMO?&zMR^ZcnEx`)uR&<4`>2}F`REvhUY8bhcnu`)d5u6oqI0Y3)8O}C<@nVTxa^pk7PmkM@%bn4hz1$!n^Gonyksczb{G?mpzbJK zq7b~RNo^pC#0-mCsk!y<9K*?P(gcf^6H_L)uK7%x7XChtL&ED@rVyXWzq(^QERU7c zsqy?K#c=^iOf0KWNRv68uez&%m*8uvZ^4J8XY~Km?^X0vN_9o!|CRXbfO6%g*9bXTq7y-D(dYNp3NKGl%_ew+`cl9s`KS z?s+kMg)Ul`e-~{P#4AP}71!u`Wc&omeDX4Q_Lhs-bbW2t_zwH&adnx&CpNPD?_L#? zZYpP)UB$Onjfg9cSM3sy+MHc$A5lilddv9jNx~GwDHjGKh~BBDF1qfUxUsFleaG_ z@kG=GjHNuRtv-gT+bql602iYS0b|Uj3J5&)s87!?Hoqi|xk_(Q(o4J~d82aoRTpdh zPt5we%N^rjEA8iHik$%-aevtk4yFsFX>a&IoI||-Sp+Xv|Fs4`Fs?~R zxK@kZRg+0H`sqzWvbYsj@lQ@Wp3b@cO=km$vaOwUo|?ytx7y}~u8W(XajiL=TIbvT z!p`v?uxo*V-x1+^@SoC5q<5Uik$YnNour3W^OtwjF_6Hw`{21OD|CF0A(Ful~xB{LyezKd>rz=u7*Tm z6eXY-16c=T%F|gF@zv(?i;PK$iOUQfr0jZ^@8!GKQ$zn3#j4Iu|}%woA{P2A(s|kH2=_)%QLm@jax0g?+aafPe^16rhS{f4HbPS`wI_8Q~64tReoxa{}DSL)dka%y zE?Jnv{KG^TvSq@CS0wFY(cF{7T?&Gs_}1bhVfB95fx|UnEv7kFva-DQUKOa>ma+kz9DEzZf zQKn(x17-LqO#!ODZfrkuKEIJD(>$*4&Rht|TSs1S>jC|^iaglDC<0p2gVG8HAX)9- zx=(dEtcw5ge5L~^Ss=?`uKujR!84Qn`>W*BYMiQx%m6jDoFR1WR>K8`-egqW?Z^c# zvIP`ZkBh%cNQmZK4i3%XlQ&y8OmR9JA{l;d2Hm0U&uKz0lMwrP=Pl}sXc4dq+oWCV zF(eM8Y0t4D9SCl9upwQ8>6e$bkKhb}e-Izkpt(@$v6bmV&8oS0k*ahVUWix)mPs?8 zCFR*$8Gz}P#s#J+_C#>b0j)LN6))J!Nt-WMX(=yHDlE}SpE=de-QU$XGJ!iEmt!c% z2uoDGr$7*&;Pu?s*^rJYL0sA#oYQJ`M0|MHtuc@vVx4CJh*iWe?;8DTy&ARgbZyiU z$H+!#CJwqTz-yOmJ4kdC`~w^`#@SF=6nJh=rQ;G1q{Dul66)ymdQbe-W}a8WHBU_V z{ri2lO98BrZR8Kd|0piCA6qj=oL$E}#wjvoR;T(1YMnLfs+g1?E|7jr9V)ad!dp+> zlWDbLVXZ+j9nPB^y&I*@b(wQNBGPTO#{mwKRpK}xaKFTM+yP5GfVtbevM3H*zjGah zqkHlcj|*8IR>4HHWixNKJC)r1@dkxqcKOI#y8QH+nWBoj;&S&>y>ppyA4JF^n>zcf zJXM$-F6}G;y6lJ3im1CUKgD^{X_z|_`P$5Cc*=0Hz|=xxF3z5vBiUpi4?cH-%t|Kw zVZ8pE>#W~t9#3lOmcHB4`BaT=@!6xNEO(d5Zx6X_9mA+L?SqYOU%xpjuQfnw{dFLJ zhOcVswGvPi}vCcjHWExmG>?L|7P zlnIbL-UETx_w^cp&Tg9)T`Y57u{1i|F6PH1KTK zX4-W2DnI$v-19c*FVpt>!JbpNfDjb+4EbiA2aodpG9WYPgyfPKL=v?av@(3WmcZ3H zVfV9Vzl-F)=XkePZwguf(DB`??^qASV^TXDY#%U;_uEo%D_szFIp(jjwtQa7o=%7KTQZ z!KNeFYTUeR+;wKJmEH{84+7V8CC?h=;Sua#oGpWOo?99`kUgO+o2fTio$2xS{2q`? zoO-fhnmhuQAjzi8fPf629C5KzG1%;QoYlq?Zn3C>*|pBo52&g9strVCMyaY^0>L-M zj|J?>C?E?WKIE#FM)x!-rMw07SmOGJ{`?OmukHDdN}0k|@6xW`*hJ#}CL-fvL|F>AkK6oDw=Uy~h9GVBq5Xq3Cv)s|-Z z49q~;@Q$7UpTL8gEJgT@ZX%LEqzQA}UBAvB?}fZFDo#Wdu%u{P_5~<`O~b##%g;E2rqzNSgV)EFdycR+8|iH{EAdv{GE9 zmSVuPkTkMMe=iN)#?_JP_#I$FH$dSj*uWdqi3JOjAU`U@gJB;A#MGG%o6^rwlAx`R z-jy}0dXQIdu>yr>U&=^*6hHRXNTM?2bn+UYRCmg%+g|QBVBJJvobz+h-S_{k&m`dm zPkBj|>x)qdl4Sa<4%nLToYvGXWB=$ndqiZJJThPxoUbXnu%X8g`n&FP=4N|3GZIBlArHXVsZ_Sl?qLD-w7$b z%@^A{)6OX*=9dp+lhMoWU*OByjZ#9!4m74~O~yx~G>){jdL*{QtXZMoomV>jd*f=| z{XZGyrZ*myuSjB>nYR8Rq?UBn#VT&P#v8srwPL(*(Tg|(H1>WgyEnc?Xhe^191?!o zc)vXaShB^`F><9^G||+HbLS_RLu7gz9pmX4_Sr~36@ro{HZZP!(r#yioySDP zrK?6mq{Wy)KazEVbvJ{fBH6!&@0#Rtu&3YGA!>T%uln#qoQ>*Z+otzP1)a}Sq0kH5 zUR+wDW5ECh@6RW-Df%GO`WYyJAn6;Hm-e5|GUr3C+V4w$)KUc-v3Dj8nr=TIw2hDZ zpE(+o#%iO^B#KeY{{DWoro5l5u7|JuC>T@W5 zginq`;ynrTj}~Sv2R*A^Pud0_#4IKzIlk`ORO0 zvzgH;5?4fT_7QHBK-LEmwd0U!PF%7yIcy)C|vIBFsM0bDC1q3#NtNcmvRK3Rj3sDQGhHCqh-dI6%%aYKlR7{C5>f~|5o@Lx z%BK5kn#wBq5)kM*6SIcKkx&mYML*7E*jI(6{_=R;=;~hE=w$&$_G_y}%?$mNkCuoF zRS)F20tz&b`F@Jh`kP$4^FsE*GMlWsbd*DS^Kee*C|veg@P~ZA!i2=pG~v9(po+wI zQOUW)B@a~`TXTJKmbDU5*#;w<&xV6n;sW%^Q^hx)?_a>TBr0M zfXtkfi3X~11nepVH%0FGN65nb2|TU0z27Z$lFJ0|N))**Ke@y-Bz4g*N|mcLzEeNS z_x4Z6(r++DOuU%?BiHJb==yANDmGFvjtP#)ON;d>k$Ic|MtQ&y$~*s@LQ_croX&yx z39+Hf`KhPhFt^#LM|u&G#=)iaX>uFY@47@}0%!=jIz^{}Vo0WompOmAV-J#8nZF>0 zBXn7(dwTh9MXRwgGMg<*iMONP8csN0IV*VdTtNN2)_~Js*y4T5SnIly(Ai%JODOPG z5ti#?B1tRgOu<)?WYsq>r>l0a9>H}GS%C)2S_;JZSmm3afqYp3~jv0^EqatATq76fT%A!GePSck~;{{g8|BjB25(aCBeDHQzlS zdw^T|S3_okBdMMZ3rwCWRB8KZIu*&2+>SO8^>}SD?6&}k48f@&mxMS-lYsSV-@Z_= z=bQ$G(Ya=7YQgnNf6y#z>Sz?m*iiFH2OA9xOgI^m_t5v`mKSh@yo zy54;wbpwdX+iA{2p8l+tmfQH>`tMTASq5{6T?;)y*Krc<;r0?`*?zj^Ik~ zik{N?*K^epEe8&QV=?bQ8JJ?21Sqas zRp>WwuVY+j`vnvqKqeD_qEc&Ab7@D?>YvMt>>6fW$tXjxtA6JC<|J$=*jT=1sGT5X zW@c7P&-;mwhxcW4RHe;&uxPJoQLi)dr6%*jz#9QUL1t(HMgsfBYLUJL>f=_Q_oU`t z>)JJ`76iQ$eA$$pn#3UBvm`!rYdZwL$W&3@U#i{+x=$S{k53=x)*&R;Rz2S^D?30V zNKcL#r@6u_k6&QHW2p^yFqGm+FXK=MD!_M|6fa~9GE}eLs&nQaDF03;Ta+GaeL(@7 zo7a*z-LuW%RTXaf_6zt~#JMaZEIDSfchj8v^5>gEkc8h*JXm`Vf=u=&P^Ts^${n6&B?>)?f_ zd|gR>ARPDEtr|sjXbWriC^fY+&qY+RY1yM6;%k^-D20rs?V7I+nzX5|-hhC{DjZc5 zra$gTw|aQujNHV?{xabyHerc{FLMLX5JU?uN&F|Bb~BhamF;t6yoiiSh*;JrOKHGn z4MS-mH(^cZ!CHxXMU}a$APq8)PPN&6Vm*i6JK>k5xBHsDg)_8wa5={feb4bGU;5`& zFPowQ{Mp}v=n#_g#nLDVENJlUim7KR5Bm53u+tZThTiSEX8PGKJP=IbvZyJ{VMa#hr=6a{#%HRu zkv-T#z=oL?2L-exdxVJk79-VBVP;X`0QsCWhGd;r%bd3nC>)E;W1YoUYsxP&c@M7h zhFJS0j{2#)k`!3YX<%s}v=akF-Y}B?*(suRy@BGX{=DA<1;#j|F)_(2KIh%}ys-Xg4_S{k!w;U92~riQ zUZT)K1Lgv24k_34pt+I1%ySabx0o)lB3yBr&ZiaYFV)UoUTd5?S(H75!Z4R{@;tyc zX#Q7|eK@)+BhgIZ^(x<|S7SRK=KY!a^Si2q<*6&HwNeXGJrgIwMD_YR;PY|U%(H0= zQzPoBRGebt`Jf?4C%eS~sxuQXuYtWBko`bK7ZIU6B}YLPJ&=cD3%-KTP2K zFmcEvsLmHHPeykYL3aE3y|vp@!oAI-ARKP%iP+%)gb6lvmUjc*0^p1rJ~bg503^h( zY@tyYF=XEs?_#YAqKhEcqfSWk;^Pn4IFeD~1%?;-?8)LBHKx34b~e9u6ezYfIp2_N zWF?9!{$PC<6i9j;c>~6Qxy-qCxAwPNg`V@v>*u}GBS>@lsLs%|y2+BRBpm!<@=*8- zX`>P(I57e3FIXR0*^^yX^zwe$e&IE!GSyBSHJ?>-0+}B^b3T1`ms3T%Ia7iIeQ$2$ z!V^F`^(-2#*ZIO_-I#_`4YAem4Tc3jNg<)0RZfH2o0c}*eJP5)C(qkzYa3`!YGua# zpAM0FIRj=qA_Z23_`3=X&Ka}foD^ZZ~>4(>>dqv1_#`Pqam!dqk1GK z@(@_r06(Rs-mbpZq?!6tY8N2W-s#2gk_oo?xDZmaO8ZSW<@Pekin^+9%5J$!v$hf` z?!!dOPevPp61`)Gtxgm0P$>!IM5N0c>v`(?JEe5-J%F=8sjMOIJLsk&lm`~EYx*Vx zJ2-}C^>c=QMhmZ-WC!SHR~z5L?f|o61_t;TXay!sx5T+gRXHa-{%Ae*1Rry zoB3=f>%n5}@B4dZjt%)DlgzB!8d8@11PWfK+P*tyandf@7L$yzX9ItfD^f002)a+S zo-R%*-2M9Ve&r^gv6lWkDo*PHn}xWq5JfV>0k7RO+ExZ`89+9Z7L2D4G~F-zkUXiJ z)z&!Mv!@nch^J%Jz8}330WMAWN#k*zmsFOLaI5~LS)k|SiM>Hu8EcKp+$U9%5{)?T zxbLQ|2TI(9lNT~68k1)0FHERvzKQKnvpB3dz{tOg+h?u=Lt5Y~cKE^G8OnyC7=@Yz0a5?E=M|6?noDea+bCR-e3% zrC@n2Z;;(RqLiJEYAw~c6*=x?NX5vJtV%oB3@_j54yaTn>uVB`S%$GMz6N6DyKS1M zdo`X+T=S^;9i_ApvB$BpN*|g1Vu>N*g1Ch&4%txaL!UEC7;qUL>>*8X2y^OCGIx$2%9?Wbt@4K zU4v*c4XH?MRMjJ1##{>twgMJ9(p6xkQqdT3DVvK&`?LJKQNnBO;QqnmmsQLl-@L2^ z7s&_@&x0+nZ+Jo2zMI1-_Yzni;a!=3^1^5$#N#00-|C6Nb+;AvzCec09fe#Co0|oc zgsxZ~SwCN0#VWqMl{t$p8|zrDuvhg#@l}D!N@(N*W z*ehhEcq8V(RgbxP8y&779yKXn#Husghjd^kvtD_Ueilqy98d6#*Mj$&;5uIz=9lNA8}UVumTZVq(;%qIdQfh`p9BOlivg}EWeRzY8|)MF^Dx_ zA^&0}eD>9_fVT`z35~pKKz_iee;26Lu{a0V;Ayu?vWtvgyg`wi=wu%ihCn3Y)n#wK z3o4;~?Qz#?!kLs@ID+8OW3;K@N>8w?L_HyK`9JLm?&IH1W5~d+w9i)7aU&53<31-d8y^H<+gg%Zeuo@ao?*`O=IM(oK%c7&tFoVkB5Q9;S}ZTKK@$D!{?}4it%;be4+kPy-?)^X zWg&blLdsD8Mur<}^~K437yi86eHAd5S9a<`NVXc&r@w;B#ca^(J<~ADvl%&GVOSq9 zUEvLrgCB9rmask@Oj!eRd+)Yd*r*XCWu1y%tz%lN4ah1IverIPmT z#QGkQSZrt8#54@No{{Sc4q(J3(fI<-nV0h{-lt4eDv$L8*cJvOh3kNZW5_Clh72ol0GNa=fGml%K_^J9x=Cw$p}(VV?L$BbC}@KOwFhKKUeo!X z)b-0>I?X6jn=NFp|5Q4;?}WeqJ#QZ$6X_D_o8+?1-nstAW_$&d>6~#FQkdQ{vEG0G zY8R0F$N-5M`)#?k`dE(-*c&DPF$i2Y&!7sAXIc{dXm=86YYn3e`!+{sK3@1AXNqN< zHAW4ZG93#IQS0_nr~ii`w1Gwe8mqiC*ZiE3PE?=tQU0dA;W}2Gq7SpgAL`q#x(LQK zLv_$ZyN(ZUp34&+PJKUnV}In19~ff#%K&Viz4Nosa{<~sdsG|1fK%rKb<~AMu7BUQ ze1UfJ+|9#!H%#vqwyVxz{;8H+>7s(r0XsQ3-AvwrRL>Oj(CEor*vhb3U`QVGUkd@Y z`Ql$VkGjR8CTGp^2fM(5jt}fQjV&)h1_2p(MJM^2sadnMjC80I2ix7Aw&Y*=Y}#7y zMowtGx+Qz>8csHOyaV2&5RwfJ_T(7JYehp6!bPPCv`W{AuoA+2O?W2P>_@4IolC_f zxAaEJvgp7xVm0x(p-0-}6!|(<-<0|CAaga{uL9?zh-O|VH?dZh`O3z}~H z6mJ8lc#y>h0wq>yifPEU7Rkta#|d`?KOqUdeOt~f)DPDh?Asaa?mNhRrzIKWWnOdv z)3a8y=1La4fvN+2XSea;UNH$nxGW-M%6kext7_8r8rR{7zO470z!;;$J|j=Mnf4)1?<8eS z7fLtn%se&s$R}|4`QLOC-YD7YdpugJK9Nh+x|6_$y67V_O7Yn5_88Y-ur(-cxnHug zX5?){2OQeZK`SYq{hl=p5RdeD!67e;0Q$#Xxsv^NWGKk-McoiSO071LI`H2lq7MxsyIM^&Z`k z@Ue;dCIKf-&q)#=CeSM)EW@c;Fsg#a94vSbTcpfm))gN{6b0sqyouQ?zuw?Pb3`{G zNBg9&He$ipCUkn44UtTLj7VWuaewG!)Ou%#EG(q_&t7iFN5HU_Nb7cK&kyJZmO!B) zS~gjkdAL9&M|+-;&HGSQ9F3&J*!but{e1cyYSNs+%ags&)eFt%Qc7bl-d3FO^9dXY2IuJ*H6kF366WGyUGDu1zIsIGNA;jMPTTFm>BqE$s5^}^8Y+Khl4iagcn$1t;P>hFx~ z>as@mh!XvQ4EY@kBF`}`fkhwCyr7JBQQ-D1JLnxbqM=YY%(f;;s+db+r@u11XQs6l zn27^xxK3(UjJ)fH{8@`PgvLQ!`@Dp^G5+A)@p_eiVBkQ!eh?N>cNnt}VM+Lz;XHCg9*t7QE zE1gne!oF`=2nWt`Xx^XlU691FX^?2FoIY#?=z!&m4XILfJDKGrYK8pGiSUl7%a9+| z2et}?i%UNwcQeyc1RbT1N7YFRF!d0Sl6T6J*GG84MWP8$=f6n4L?F5g1A9wc9{YTm z>MC639y~bQSG#|hgRTx7Fv0b?&!9O;v$Cg90ORVOcV9SJ8XVvXCIVHWuK`w zb-|Zk$R1iNT-8fr1Y;7UU+#{%%;(*VolhEc7N2%IY>SShuY+;gOuypXhPYLY&Zjx` zjz`UB@9+-LY?$8q7ef8y2X$>&`iTaU3G@t4eW1sj_$+YdmDu*1zGLfXl8-5H^Y-JDWw_%u^!#NO!hmlFO|k!f<3 z+5@Zy^9yoC-6^D#$S1l<=9`2_H-Y5D_S{PFPGGA6&2(~N&If9tq(oxe$E4$C;{&{k zYjwBhMsDyhX-YnNV^RESgo~?W$8X8X(F-O+#V9ND>bD>ZmmDtI3@IBB475mIm^@zJ zAY_#|LlQZ(jy0}^d@qK^$5V~D3KlAm*9M8j>v?JYcKxQ&=w0RB&|gCz-$wLT9lu`1 z{f;vq(I<0iC@(Mk;-E=j+pqmqSx>Miy2mTpLJ9b%C(z;O-q+U;X0E)QrLT|;e% zb;+|-f&t_1o=5Qvb`}DEVKFdPDbK43E049~G#vCCU?-{WKyyIsR2uE#q?VQkBJ&Tx&S;QRH}b82^Rum(N_C z5AqnSe?wkQM$jR~#sbrxBv_<)!u}WC0@mF;GTXucOYF-U4@G%&Mr`@4u9w&ofANC* zK3$7?0~})5p%qQ5wByfCHu~Eq!|Df#StFGGvZ)W?4YgBgG=M(Y1>~Fto@NM(MS$YV z7D#JSx%>WIXMT`z?#g4B6%vXS^2p*dEgN%McUtfu$VkHsXzLl z4C8`WC$85Jv<%yW^*0x{ZgKb2XNZ5U9(E$40(;T^AFjSSDhh6k7YsraP^43ll8_#0 zBozciQc^&=JBI;58bl<7k(TamkdW@~ZWxe`A>J9j@80{~W3gEJkFw^Rz0Zzce0E0R zj`EYF=y~*+J_L|;=EudE4IEcPfw871B8Y6YdaUZRCl$aXTuo(v&;c{Mc-wNuP+b86 zj!SJl@}=r!#u{#>8Da2}i{z)v#loi@mlW;SIqs`3zqOn>k!|#!%0#rj^jvhC@A)Rp z&U?-dsZycM|L{FpA`3;N_N|gO0ax~w(5i}hLDq&+}VM z;UW8P1%?LpaTlr|h1e#%3tRwQ8JY8)fD)*0F`$xha#690>y+pl1F(irX>57uqa$ww!G;9y;aHXaok_JckY`mG8(9d zenEOA95lQN{uVo4bUnmqz_McvD(LKCLL76#E1Hd#a%LsA7n0&la3#Br@U91MKuV5_ zu;@%{{l!P8rd>QF$fe4&9EZ{$Rr!}3U^+Txp+QCsH8Z?7T0cn$#?=4gT9@-bz1B^; z#qzeQ;tq{ql2B8tg6*$mKOip+*r_!9{A7CGb)~H#5k^;*JnU7wHg6LIKLC`^-A_$) zTsx7%%^bT6Qn*TmJL59sSIUMXA+k)NJHNi17i*E)p)&Lm&)~xIz_LQgv8K8A0v!RH zmIrB7>s;?hnsZ34$?Z1Q*tTt>RDkL#nAzn+LM!iR7o?E1J0c%jN$|{Z8WC6x%Mli} zlk`PAbVf;EoZ6WCKZLCPnf+G+_vN6CGa!`$n%JeGeLef468&q;yKc=e$|N8Vzklh*5eIb6=XK{JBK;DTaOh)M}T~b zx!_lnqWG^b((lYa;)+4g1=w!I;MAucld z7;5n-3YjLoSBfql1HE6Y1;FOWd>^%{8gGgV)Q*kZ_~}~g!FIV_9cjQzp&sQb0xAbu zv&qMhDm6a(j=Et3JpR5jbTAX+USjsLd@UVX(0(T1g`)rG48*qcyJ&xhA7!DgY!Q{d zTuYmDTlVIYgrBeD0vH&;9$Jv^n;Nzv14FjA;OYoRfxP^5#1EnYPc0%1%tXm$wk3he zc|jeHcFrs8fOhoRSR}#oW4@1ZKN+Qf-t-;j+}0IkNm6)D{~aM_%a3f6>Fo3a#f8~l zq7s-o9T^cf2r`F!c@pltY1=tCIsVHX0+cH-L3dz z9qSF>8cUzX7y;7@?N|p-AeL5ixGPr(M2Z4xzQ4CKf4Zp_r3YwP#_egkV3=IkD#QWX zm&W~`+bg&w*M2H+eHnfD{Jai}2eHJxI7lEpb%gsMwBHA>i%qHGvH&YYGO^{9rpR!wH}uTy>`Z6^WPbAi1UvwYFA#ES_%#YdZQ*iBR=4`f9;3 z_ez%5!mW_*{nZd|?7#YOucMM*zK4<=E0YDF^x-TO9Gl|6EjCY09v3lpy-{!B5KbSa z;N%#*BWyN5;494e5(R?1OKO|7ARX5n&kY=jyU3(Z*uB5q+-WDWaY|qcpq=2=DW#=` z{myKu>U~!kihf}W{wsA(&fsLy0DRGNhk*?y}U9g?cmz6}p9 zPdj%fP18CS%gipfZ2 z$w~nA39`KrM6_s6BQ5?(_NzC72f|{Fzky*UmT%SxkZL$of4aqYqi-5oR&6L3iiRc)aB-<2S#?Li8} zM0W}IlUS+&P5bm4KT)?AYUzrc`5VX509J`2y#lCI%##CSJteUXM<*#0n9uzm4lp7f z!l)f-Yq*VyNy8T&yzh;}c!JhN`X+0 zA~4P{ZaI4PV5~C$h(KoJMm!fu({cX1iwQDzT+9xuyw_ry`p6x|(W;+llAwh4N@*=| zEzaUY&mJ5NshzP7?Q9X?5^k%dM5}mXQhpxY=hZKf)C0VZ^iL?-9#ux5(E)iakH}Ao zO3`F9)l1J=IClqK(9o_A-$=YtPIxBls$u3RCPI9I|CH4WP zs;T;HJ!l(Uh_xplhj#2*RT3S|ii9S&iVy?))vCLRrZRSN)j;?2=te7GzB2V?6fD6_ zIa`y&H=hGiRf9lxNDq#OYPZgu^0CQfy(fDZlg{T8=KeSg3i|jkFu@U*o z-MXlHE&*ccqXx{MYZ`wpeC^Kp%by-X*73wD|1pmLUGY zZcYKz`c+|b@3xeY#*BHbcTP+H;HP^>(xa-|tL)hk=f7vU*0)L@nZ*uTquw$ufM(&gV#l)3^v^Ij3p6MM<-iXF;ac;xYTp0_1VC#U%a~t51K;!pa>4e6cnm+S&R3fLY zy9%;+)zPqJD0xqeo=N|7YKrE=XCDAo-xNzJ!jbpg(hM@ zt@s7evF(iK7Wz@(0q_>K+zjL2%N#zTag(|XasALbektuGvcT86DvGiw>y7+hpIf?|(~CxFa-hSIzshy`UxvcUA5{oygEGqn}~wBwd?^^W~?nD+oX zZ)yzsyzV43Ptc7h)JlMz%?)8GO8SY+Q@1hen8Co=a*sF>6PJmm&!qS8(H{zC}dr z+hyI-B3v-yu;N`QW?V}%Q~#j}z#BsmaXZ5vYmr(B99>LRpv99RC{-flRUmZogkCqNT(No!RL!_ziFhJr)gmLhD$5y;7je{sW>r_FyW{}}Lm z;lS!7qOl}%2}U>>Q^7D``>pj|XrXHB2hP&$wq@-6L8vw%T)*d3zll!GHW!5zHU@5t z5P6c?oGY_o3O9xG;D8)VU;9T z{Y8w%uX~b9j2rBYsPH zzcM$HlHA1$Y(_yc7v1N6r~C)A4jI9Bv`14`0`4hv`EiU?CIJDex7lH{g3|A;)YX5C znrsFA{cGdf6X)}n*azQJ>Ce_%va7e_yE#uvyF_nlghEG5&INuQ5hE5Om0hnhLNn7j zS^R15_fPV&E8p|wMO!g^FSK$;T}WU?qC8wg_pe+E5QDuc;vKz2iNWrb(>{P8&k|m~ zGsV9_sz3JulA6{iq&hj3dGLrrS@W?xfsKv$<~@UMSpz89fhG_+ei)-VnuL)EsKjnQ zZzFyQ0a^SUdIr5wzV|CR-DA2LwknnY7{P-cqy}BUPXE+GN6RAvX!E{gq` z+29GvRk4m(+cz&<45ka3K~@ISj=v+>L|+Ctv>b#Sks|bLmmhBXAqlMA4)%GTjk;o!%M&abTD&d=bA>mR2P_%@2-h{K1%a2N zajq1Tj&+9T#Mxaog>==Zi8`7r>C zfnE$($@0^uU!ykWm}y&nj-I>xK2oMnwylrwFBV+u_fMZyZ#i4JGI(!R?k=oIWfqWw8)l#CS!Ln_Z0-JP9K2B ziB9{~xfsu4#MMVGwyj5_OsaVJSXuiYJT4t4N2eWD-=qUV7T5(dscPSP3}EUt5f8_n zqd%WtFDj{lH#FRS)p!6v*rV}&wN})s@5DG*31lCbXwxQ;9Urb8o;ck9 z^UZ_>TxPu(UKOYf+c_&*%JHq%YnzF)GOxEw=8P`1{f9n+Awe$#fH-jG^{=5Ux-^B6 z6FOzfPook5Tr@pLEB6Tuw&GsL{{*{QyTY(kSjFz&jT!6u81Jwlkv|vlzm4y%eY+x* z0llEeByMTqnUKy-6&_e;JDWWn31E(UjpD2S0c1d1SH+&}9Z~+@W+T`N!N;laPbOtB z>s&KMbwINrjbXe|TAQbmkGEU$ZES$d1w}v6)nBClSW39;Nh~jbinSR zH9d~gA^r!1ond+NZIu~+emuvGv8E(Sj>V2BZ?2?BRfGjrd6#Hr2H)0s6ijE$P?G|j zw^eT9JC3bEnmIJNX41Z2v2EkbXWn*%1_b=Rcr%2*7sEe>DB$K;Itu$C=vqAGr!~pO z&HZ?2mejXOfp=&}3ICo?)Ii?L(84R5`(R|l0CJ+s{VcnG1Xi+mRj<>44(0G86gC~) z!p3?v{9TRsSs08y3qGq?emqA#J-W+d1kQP=Qbjf zLF7!RN`RX6N^EAwRCfffQYG;74Gh$f^BIX1yutYjtlovfIs%dTXsy>2j_brU$7uZ! zqD=nzcAkIV+`lA1J=oQbELN$*OY@OYH-PTmjn#G}c!KBzD&$F9qEm#ek(z_3S<}a_ zBfhU>{^SX5|Kjkh|7_^`JMeQK-N;qf?@As~!2Dr%9Z+0e)1~?PQ^fQ!Q|U8PggA1ll60G zB(D|r@6u=?$~P6CI>8EdAkL=4OBP1Wzc1eHnMK&-six8(@`~}9lN1E#CeF{7rrq6j zfd-PQ;okxB0oEw_0H8!>l^yVx=0y%H1no8Eu9)}lQ#(TpfEzt=e@$8&!x@c_+}eB z@~g(68CE=I-cWIrB%ZpHSuy8X^FeH~EpwXouK1FtL$}OYbfc+H=$iL{xz}&o#Cf3h zcqCgSgWC7sTon)BUf|*aKiAz-{zusHwt3&JwV%x{9(sksbFsWfGBMAdS@dO;G7Xaa zf~c3oIX+j^GW67S=Kf}7_q4#pbX0;O+W>5Vzyg;*8!?f`%dJQ#PEglyL2Q9MjC&Z< z%S7iIs`G%G0!oC(JCQpkfdYEt-}!>NA!$7k$+2O5QQo7JT=_Dl+9>D=Fnv;sXaC^^ zq=zL@vKUuvA1n5Fni7v`MbHnN(c;r#K?zF7^ZkK+C<|Ye#K>Q$c7U_<0(}{e9>+Xp_1-l*e|&@q>cm2SVQ#SC6@n zbIxpT4jo=jqVV=20i+ckDPe@9Bfhfl$aeG%YDsmIpYYDkQM|df3I=KCPeRQ3yv@p! z_B;*>zsPYZ0(g2}LmR0ji)17!=+z`}<9v z=Ju~R6d)D+`6R_a;!5oj<K=vQWZlI6zNN5c8eoAGsoLYH3IVEp=?|t(#vdK#G6-*GzjvK8uw7Dpf1Tss%gbG z(-uOxXIQBBmnKs8erU=76Spa1Av(~-y>kp}_MQb7#^@ZM|7aLm_^E;DS639t22mX) z@XuK9jtt@E^K28fF9Ldo?IU0*_#`Ig^3yAY9=DPwF-rcK6Irqybl!bTRbxED586Yv z-pBx!pR5U3nxvx`Rc}g&tfsZB(W0+wZl0tYg)ouYuuNSQHujZj)AqWor%k$+!I`{1 z9I)YMz9-jc4||YLbES+WF3M()rlKD{g=ybCpfV5oYF64No#$pSnWXq*z!1x5cr(ED zWOSrn3cvPG1m^8{T537%`qSHw;GzBXy_)K2i|+|zNY(N0TmzZD6+Fj~cAzm5=~uJ5 z(>i_u(8`zA?f^SCmvi||6H0=sLK(EJhJ1=R+ZjJsX2^BT<%yUh`_f!QzK=ZFRai0y z1Ex^^I2%BpGFt@cUt!SZ%o|;VyI<(#yKm3u{+xJ&yHTw&k_+}IGjJ!_qJ3XQ$Kp(o zFiZrEjg0*8ewN{Rr`mH^Aqcmxu#;+ob?+B@-f42a4Tv23(rB{y z_f69m0lae(HzSg65EK)UT}E10Dm*AtkqXm~LrFaL`l)z5>S3pV=)0#&u6N^jnP~oG zbriUS1JEWfQx!j#l*<>56}E@Gi_vJlb02UXHWZ{^x&ual?sf+=$+Yv~@5g<&OC^HrYe${T&v%Z@TPma3U=cUzu!^0kDq9pmuX42h0Q;SHj|Q)1 zj4iH;d)iX-osV4%tuJ%u-Fe4ot{zk1^^k@1w%soOzaOI7uR{S{rb@krx@wEP{Ch4y zbFeh_IF#1X?7;Z9TCbj*xoyMgGZVuNZ?f2{1lnbRc9_|;l_0yX*==C}!T`nKE zINRZd#h=*$6EQV+bGkgmU%!5_bY3(*>lRD+Q~ROcK2<4RuS?dexDo;p0vcRq9$+xa z7Z}hYobfQL#JWK9UYjU@ixJrMq-!;>FL65R<~?#?v}!(Up>Mu1?l?_=6#hL1)M4!h z5;LEy+vyxy?*r~=aQsB*)>f)efk+klw2MGV0JAk+865jt0juwSn z2|a;G?>9{8|D%+3!|)ALr4EBeVLk!uonG!~;6sft*S2LhLrk=HZ~>((WwKPz&x4s# z>pAyoMv+J?)f=35C0|Ru0e1%;dr{~`P0}uYn<-}z>Ag!(q6(I(RU2<7mE#$~T59Hf z?k`E#GNO?HckNrl*?Im>V>>ZHR0s7bxF1n}i{1)Dib={IxF(LqLut_>yNJ-`cYh#n?LMHzRF@`>E3FNMk~YI5o@XbUOE33u8-J!5f?Q# zlpE*(71*4p8k9iY&6Z0(-0lH6`P%HjN6xDVtAhnLhs1-s03RMQw8p3*xl-gNP$ZK0=YJMElN8YlZ|(eAE-T$1S@19p>lx{7bAy)%#<<<`MaF*1;}{e6 zm$%&ygfp;xrU|~)$3;da#+>=Q`RgBjw{CKM8KXL?62w0PKF~-9p&twd;MN<_f?A18 z;CgYt3b;(gMQ()w327A6HFeU_C%T@RtnMhZQT=Rv3V6kdqa>t>E^b)4RWx*C-~ln} zB;?AciG1e7RA%-qFgn6Pp+Lr#WFfcPCelL|CY@DX%39YNg&q@JK7vpJCyx>y7e>KD z;5G)Kd$gpsW79JvnpAE$S=U=$@d}RrwNwVY+8P~1@bFqSUr1#RwYd-L0}MUu;m!Eg z@yOPd;gAx}#rFrj&mW8dFBIszBw-dBhib4hsH1iui`roxO%qg9w&WiYl5vYvvsmaz zu6>+i2FBRQxgyrDy)??{ITjHE0t04?rf+8#wSta<&_l=nk>t}}1&)Aq$9&Pz5ozlG zsTxjg$ZYv6J16FySdbbo&_^&RCCAQ0XzlRA4}yn$WgYuZq3cFT6aH=N9<%5ceZq!@ zK$pn;O(cl;p1kADmx9vTOunI&zXDzE%I@?iKF`ql^kNTD%^IKa^O@tFZdpD z{t)cN-6U=iA}QESpDx7((Er;gbv~)a_TiSVuUXLGra0i3)xDd`zoBLLnRx~0z9Gk(^{JoSwg&^*o;IKn|6wu{*eRN?kdwcMgSoPaz4vp6?!L^H4se+_B>yl zSAMF4>rbBY?8=oMK#>5)8bp4NpH>6!N>*+YtVSIb(QFS7t`B2_(rh-Kog_VOTa2l z4ka{!`u_Vc`{BuCaRERIw;jwlr8aj{v$GPuzPfjs{*fZlIAn>|8682NC|>dq7;0^g zMe?GIrmB4zd*9E+eD!zyHkremOP>->F(~mkyqQ_Gm{d(Wi!;e|h^Pl*m>_*LI|Y23 z!i|2)<`1cPMKO3SFnd?i%JW48ND=_Qrkg}#+Vs&|zN)5?OnK8Ct1iVWQwXg}{=VyC z<`4##l2=7*ViS-Sa&1b=xdMS6NgZ>pXQ=Gm_jHcsaOBxj-sR%?HHoK>E&U`!_|lB z-d3zo_9L;o+t^?Oc``;UiCtZ70DO5ao`PczL?OoMrx|a{G|OfF#Xz+J9oMG+wgSjS z8vrZ-#&dShkEPFXcKL^Fu8DmCKDT+`3;98+a2&y>5OGIS6hbe~nY;0yNFLjHf=)|k z$W{+gmg{sI&XshOGcI8LQ_Z<|TGhErZ}9iC?CY1ddET(rk4vueK4qdq*olh+2v$2UhlA846T!^_k-os=WX=*gT|BAVcok*T~kR+bOUX+1+P=gj4mswQ??3 zFYnOYHu}6CRBLT!JAEJW9yi4W9M&_$t(%eb`VBYp$w_@mR%oeEk9C$K7%12v_71lc z&FRox*l>0V{7-z|`7UouX8R!iy)j|Jdf{zWdT3Zyhv?>*7spShVLl%^f3IG!0fz4) zeh+-t{U8UtA09I?Wxap5>92apKIA{eay&wxS;JH%NT9~EY-bQTSUHS|ZqdF%XE%&_ z3k))~WvsH^v|FMKYl{blQY!A^HV45fS|X5Sv^R#eOIrc;Y4=jBQX;i7o}9!1+uH7a z(wC?J{bYkYXZ*ksl)?DT+47Ioqydl!^PmN1=l>7dfBZTpgbwCHX};r0pm}vggfh0* z?yC<5Zm>2#Z17YmgHTQ;oAxslrZ-7AFVuhW_va&l&?1J6g}Bhl$RFa&8sn%}c&yjA z3lD4giMO(z%t&fB(NXC}w`@`I>@V!3?9pfOZwN$GLS07!;0aI<=jO(Zb@n5{lwxn7 z)0U%4zI{sdBkmSz@RzU^7kcmL5e3&&)dq`f5rDMa#DaB^#_>`9d5)s__?!D0_gMt7 zNUm$*c%wiy?!@zVwY`~y)1CU5sv{%e+vKv*gB&xp^p`SFkx_{|z=Nj;Y->y%OX#0k z_QeG_Gyqx3T{)1BdA`vSI$uVY2IM!^4A@<~c{_ta!Tj>8GG7Clo}c_C(7MpsD8qC9 z-yzG!?~g%77eYCx4U}&co^$`TZLB;mezj=)J0MLo? z-$bRn7pV<-emWwRSw#wn+kntI=!2$1Dea@txJ6ET{IC64$ya5|=XXK{(FQq>_^wzRk_F0qiVzi)IA76z*tz<3Mfz)xN*@-mLbI11(3MAr9x;+tG0_pEap zu%W|>?+uUOjB$fyqU0bT@xTUQCM$h$|IWM7xJ@$_hq>>q+yzZ3a$a$KB39FXT`~KC z5L$>f^e)ioBtKQVZx=Erv5Z!i>fL#Xr^~fCnx0ebMPXnnw7x`}4pg}3nP>g_ER zTB}<+h%#z~vB%d50q>AqbOXlSOdsINe(aPq;ydKx?m%CR2jiS1L6(HA%*Mz!5CIJ- z^R&R%KK3HLxq+FOZOJeBC@5FRlNJ+bvWyD z$oBdDV@3QlI$vMhC&^zT@E^U$!cO+pN%b{q3o5BU67jzq40qoxQLsDC8aq0OJE6pk zfF8ScYV=(;j1ly}&d`z+86gVKpWm(uO0Z7N1zjLbPIkUy}a&Eh; zPF-!~WwD7fBdah&ks9ki;{5cBy~x(r@T)YT?exAK69SQ{GVPiss^fk-2rGsC`3KtC z-r?2?qaho6e6^z*qQiaeX{^QQC)1O+j07n%vEPZeN#*TYl&(|M8L{x^^o0PQz;RXB z2R4555@Xf?9Arj+=uHXn1mq;a%3pUM#=DWFM)a53!*t**fVq2AS3%Da!bES3loiU_Q^;fJLY_Af^E z;`r0X>UYk9=cYE1GiDXNuxby4d5Lg2gz>s}nwUq!UkNrVqwtHT;zG5P#7k)_P=CGW z9qi3C@>KOLt9tu5t3cheD z&7qxyvl$^3eLF9w$}bkI5v8U^Lv@8=M}EfBw$5m_50AzGse1BJ_1(4fuhb*0X$ zJ7^f_XTNX{#J!C0ZrRbO;hehB;MdqMsqhtvS18gzL}=d8KomMuXw>lT>5o~xTD@zV_KbUlCgyk8fUa!D; zHyxY#n<@)%SDY{)X6SgRk8V4070pT=!}i7L8X+R$T4N^P6Dj4igjrr{nmCnE^ebSNy721le99pk29~-qx!IO$WU$qbl`_M(%{{NCfB2EV(qf$)`CQ58 zo5SA_MPrrsH5`p+pX2=&1b)}nF?W^p=9N_awu9uDY%y{xHkaxRi~diR$p)LV{Uo5d)0~C(6l}1 z-+du+jCW$4y+j;KX`3~nf!S9w^a3_c#Ofx$C8qtw*8RJxdx{1=7@#gcd08||^lDl| zL3!rqIxgG>!MbJzyPzPqUHtCUYf;j6A#i`^Or#_c39Hz8ab=}@oUpzE`O;7D1RU%l zez{&^@q%Od=tG6^A~m@7r7V}V9RF#Kd+PNIe;t$Z-d81v%_+~bA7hJE(o9GKY&4$$ z54$#OUE%xTJz`aRA4P-D_iRLiFVE1u)9wB=nbz_%P(5CcN{RcV?4D+ElnpF}%aY?F@_a$MI3g?jp=FOS}?DkeG> zMTNkXLH^7q(k9BIYU}YY*X2RlMZ^3~h#KCa4(i!SBbJhqo)1n6n(W&&?jNIQw-X5Q z%42nBr_wzJi)p41_JA`1!o`rmxsOSKfQk%B^*mtjt!v zta{UFWLNvHtvOB%=Lz1UBvRX-!{^=W90w`(7N^SAq)ln`x-(mB?pyo>{KWAFw;um{ z*p}t?lgek4YInud1m``c+)F3;?0Z)0PdlHDA#0Pa2jq;Jzqfdtd+sk zf~Sii9Wd*i;1q`EW7B3r-`tSu#!7S4<`!=B;qEC?Z~_6hl-)#!&e_xg_i5Eh=X6TP ziC|u&!VBoPUfP{Mct0o|iY7Mwh4rnqo%PEYHa(PHBToELSMMcB-U*YnhIwtC!@Li# zUGBu)6F2L{qf*}cL1(ii7k{Nn(2-sx2Q=1S@ls2<_WU&Ie*DDF(s%DS4*V_(^fS0cBLL^3+3hciooYe zwK_v6{BX9%auek652zf@R`GS_q(^-FDhjWpYL3KosG-z<=5T`2qKToRd`oR|imG0} zv#F@zr8RQ_t%~%TY31Z;`j@InfCpaXcmVlaS%z=r>{IzDNlIAC4(J9L?y#B%_YNpX zy&w(l-K0H8DdBaDCg(S}HQWVV+M5$G-LbpwH%rM)Es`6%1Sox4O7yK-v*R*o6V&{iIPyJaum@(I!YLib^LJBMmuAnO9moMf@6-Pv^j2SD4&|ab9 zyuRrELMLZ{dt*bcNz7$moYT=1q!=z-m?no@#&tpx9~ZjU?@_v&fFQ4r!Y!L>s4kGx zc2WaDj@Zstur^TQ6&WPb@*H9*pj3h6c&bvyXDmd&nzkd`iMV5HUUy5BYriN0**UGW zD!FD6&0i2pDY)$56#QhWEQV#}b=I2K{pPt2(Uj1(uci2@Oc9O?&KAgvA+7#aFjW z%?wQ7V9V`RA4rxY_Ha*abT>Hp-h2FcXFTb(f-mY~iK|;mHTx{i*JvoqKsSbyeaIQ$6Cow;WwS6zY$0Z+R6H z^B#`LE1rh;3?ic79d58v4$g6vu}T%SvJ|r_d1u8MLayplf^ZnD?2;C-IlfbKo+B_N zd2hMiQJWmu%45;pkf)zISNJ*p|Ai_yN5Z^{bJYfyGTQcc13qN??SM^_zXj6 z*;z%eV9(Yc!3PjbTSC?0Ulf*J%oz*Mr%9e@jck_DSXG&j?terhikVhu-HUYZ*tuhC zFz}%bYO!o_rjlE-Cc^97EN(Q8E8^MOTQ{@4(7UF8jOo0&+bv%+!tYf0qGpSdvfy`5 zaPQu8Rib$CYd?HAWnk&8$x~%^z=I1L#;xqP=oT`%qITb-%ebE1_RZ<>qlPwwUTk>4 zVX!uH-LCrbZA15(#2%RSq2%6~o$m0u+!Kyv`Ua+FZYdNktaFd|;}Tw5-#h!G@^!Kk z*;8&%aN$3*H`cqW$T;t@05zK1+jWidp>|7S2zn6o;z**F=??0*@Q;p%W2oT8Ks)!5 ztm~PHD$*kBN2Rk(8FE(kb-ltHZY2-GD#vj74tCZ-gg!cUvc83O>2(oK6A~<@BN2*; zu_EqM>jNQDKKe_ela(qt;*u9eq`Kso3eNT|eCJ#0tNhZF`{gsZqV2LUv5S;!F2!R zyLDmkZb0Ev!(XjI0a{}&jek-PimQ`6haWwc=U2R!vNcnoi4%?Vo@VCo(#iVcc3(~6 zFutwnhdK;?<1`ZCeSrMoesrH0)PrBBvFd;}DQmixnTL(u!OzZ^?g( zX`M3l`5pD;9j*DRP95h7wuV!9JV*0(IdS*Z@Q2o^r5(_+Ozk7TP7z7>6bn$h{pwuHw48*av;AY3P-tK% zpWf9pWvrD!(13bkKl&Ul#_#s@{3)s^rFiai%v5B`e*U=b)nbnO+{m63cHIa4W8Lnn z*$*012l=z29E&YqD50H*6Jcn`*y75hrtT3vTL0H};?EbqX+*dKFfsT3(xfl1Vpq9& zy#ucA18cr?;B9oU6q9YPV%@T=|UnYu*--i23oeNu5?2AF)`zVAQ;k%PjT^5$a z4esJM1y?sL*DUqgRgzqi2KCq$>HfHRZ0qKA>rFud)^Iu!@SBpOo*qnxnPI|9wiBHC zAoW8W4^IA@elMHyo$AsTJkO_i9b1Zyf2&k$0x?Lj;#kK!)U1j)8a06;{0E zdDeOBDs^Y&>kmr4SqmRf8w+3LF|qK|qFR#U?6SK%y<_!kbqGt|i_;7Q@_To_=BL%` zjd{|OL1fP{{}x{PW_`uv;aOi~0kj8dd01LEGq&1Lp{V=V+|;#F4rGi6c>{212JxQF^ zGm@@MGVsyg3A}KY_%|_2?<(@UMfD2Pr7vbHoXxL7CelS*dgUu;Ee40;(Y5x7PvRK5 zrNXXq@)n_;!veZP8HbKvLHq`IJP9vDoo$kqdZ<5EQ7S~N>P$}z0I)>!i8SnKDkdVQ zDcXB*3WPZ5Du~*nM&>O9>h>b`QmM%t^W-$3BL6(E75V1G7h{{et8;2a2UiU%x}2DH z*ef@mRy3a%a~FPo`a;+xY_61ft~6i!WJk_&U%I@AG;wxfm9?UPmBi_tG`{oI{#+5L zp}Xi|R>n0}v6hyLb^;SZBGuzNaeQms1(<-YNw11u^wTe=Fom}=D__-1@fA4La?S@3 z5iFBKcF|i7{!&nb!{8pGc-jC>HhyXRiX6$c7@x|W!j2NExSGkUiU}(bWN2v3)OJjK z-yeRWzt$e3+sp8ta^a&BN}Nk;jqm@)>}=`4trLOKhE`RfWj%pI&JtOwZ4X3_&RMo; zKExG30#=O7sXa2{H?P~i1Sbrg%a_!bzX)ik*$xHy*uqCY74k&_9|BTxgB<6H1f}&o zzT?X8$5#uIc;jT4y(QGMCcM{wdUxLouIktnOtcpnF;kxYW_~sOzo)hz9A;fz^OnI# zhio3-tSX6X1FDz?HMP+8(cyJfc7gGA$2M~8N1projME|C$>b#-NEI1qXb%1B3$Fx4 z1N^a8ZkdyIf-*_)h>?n=<#P@dTgzc8MLVmmbR0GJ^4;-^dkLUy$^lPq06Y)Fcxt7Z zIgewpF~{lyx9j(2Lh6*u2g#ansQE(wx~MGTm9fJ*0Jj=h`h ztYE~lNfT1|W_PM7-P1z=epxlc|G5$`*Fn9Fd%8+@ZY~{a>s+(PB{1HiU}*`-ya7=3QpG-=ZtN=N7$foRdMyOSGUYQN?kPSFSKk$Q`#{=<76swpEeVaMAt6)eVJ}l#<@tN4|z4KZxTGa@75`ZF^YPcI+0lkfYdNrxY^cW{zO-cz>?a zF%4iG$Ug|9n#2PK|#t;tlbHuWEIWWS5qyv*j<^p^6^)8oH4X##P9d7EQXP&TOgHc^i1oJA55&>-T`q7DSp3B~npDN)g$9v33t zKT%}TeD7*B6-`uxo(*@8CfVahze#c#08ZT$H4)`HWcFNb3OjWXI~8rkOpMZdtWNP-*6dEi$H-Stn>PqPP&+Ez)W1tmX3Lts z@H{|Mz8NI&5!1>&nj{Y_8gwFmBdEURK-JHy;gJ;kL+_Ood(sx|D7r z7B;h;`^&k`ZvO$*7UfVPTkYKTylnR<|GusJbvmT@-?k`+SAAZ`zLvFSivoFU3M-|S z=ct+3I@NWK-aF0}Sd}k{hn@e-gZ+J5vz5G-;eycJvbMKocK^P=8&;pGsGvNR^keSv zBkKr@!}M?s{1Y(C=#IM{pFYB??>Rm_+vT5qoC5I;5UCovHgTHdF0q82e`c+lu`C~s z+XO2}g0tO#tV+~p_cF2@Dq}%5eBRh5HEpK(^Uz#i52FO0z=gClHk~P&Kx9kj85~UU zWA>JI*b`?d1YSLJLv_DsnU9DAD{Wf7Jfrex5rd_^%co**X)+i5)L!r`RMbk)A^;3E z!Q8{YmPAutsQg$11=v@7<7K?CeJ^~GAVkL|Qz z1aSe=o{*}`-}9X=Bx1a2jPhBxo`3MOk#6vGB}ZPX7XLSOcm9*Q|A5r}l~sM=qq|L1 zGop6|uaLA0VF-a)G1Q!Yr`-kv5MvxqHy|u*HTX(rHwrb#tQg>)mU=afwIGELF+19S zA}WZ5rv8ZR$iM1ENCLa{U|NVlI2yqdPivueaMKrI!DU86|A4f;y0EV(+Aq4ir1|e zl0xMDePmnuMf9Vk4E(17ODCgSwqqiTvtg!9C#TLN1^snnLf2L$&_0N!-ZJ#~_-M=e zUNVCiDv*;u87J;fRyeQsxS3O3{h)Ma`2p=i#yH}}S~G;Y|3;10 zVoN6ZwRVWn(6X0tzI5XeEiQ<8{(gr82G@RqbPysvgQpQh`b$T@9=4D8_`6VkCHjP# zbXd*X$ylj*Pg8W}-L*#whA@w5JBB{Q)8?`qh-3{bmKCnd(mp*tvIH}(QjY7Q>`=Gn zd!wZ7i2Gn*X{U?5GWwbBCYGluen04<**UW&F^WMw;|qD@;}8C?OfHbVAY3@8=QJnd zKS}xjYAuASI`mSt9eVX{x*FAhF#e)Wv?rq4cRQAi+&io z&4PPI5`-x`KrnjVIE|By7b3Yf9+`FZ;&bJUwu8=9m^*c1&Bg+kW!q3fS&4D1(D<2F zx96_>!S&wv4I_c8?H9*sGpm#EvHEQLfwMH4|I9HFM=LZ|MZfbvQPwbbi=3~Vi_uNZ zm~@WA)U1`d$I~WnV$y%w5c!k8Z>Q2YdDJSU&vJO_nEq@xs^>hV_7#U)N-ghbJmkyr z&4ALPXhan*->}7}XXyn+S}gbq&j}iW-XXtUL*<@1X)k!b1iB zB&x#M|gP0%fJ9osGu z4XyvtS<^Ra_7-tJm;QH}zC8rr7L&!RZoj-$1zM){+(dyIY!*ztENEbZEonIQ{8MswroX651#`{5Fq$2o911<0 zde?yeLV>`e_yT$?Uu&(UgTUJ z@|Kvw*blB9{{C_weOvO7LD&>d#nDB?c7DlNaM`6(F}ikh)_bmIP{sQ>fsijIax9p( znyyN(`NHXW8J%+7wM7u#RpziY-l?OIx$!?Z{I@F?6?XC(xCD-fN-RAuFp<8qkBigY zQq*`E_tWuFr%vGpdaAMtXOI1!{elzv+ zRZKd;5Y6D*XzRRXm=A2f1!Cfs{TaWQe}z-L_xH)}oiOY-eBtnnWht&s(8)oxT8 ze?F{^v*5%KfK&KunTq}Vx7|S1bO_-fYTOmn^wK9w&T&<%rG%f}ri zFN`h!2xUwPuU!n}yAE!rvE&P_=$xsq9cF~qSF{UPPV^jYDE!-Mm3OGUuyMw)1yjtJ z*&W`gi(hL9->shfOBLfwwySlWt0Y(G_2)dt-*4fZCmU_G$6s|SJ|s>})mfc6uhnO2 z5p-?ot=Pm}q=%Ep5RgCaf_xbst@VpPKCo@0{yTJ5K5;@-Gz6-|u`?AXi+8nCl#Uq_ zv#H(DbGtgI@%ejv2ruK{KkJJA{gn#mUo`of%g&Y#@p;hU?@p(LMrwj)#}d+pGaaRK zag^?96K?*qro?aErco)qs(4+=Oz0k(XhjF{x5~nn+x{-=;l!T~ZU?BM0z98es-^T7 z*7Byegr$rXX?st>Hj{W2U$`bbV(LY6rJauou(Vr~9Gl?-J+9M+KW`b%92izZm*RL= zMO4cat<@KJl0k2lcUJ*5{PM5A0bruX;r{a$|mxpe7rVS7Fv_rvXez1^QRX2kwS z-gn0<>^7Y}g&zQ^w>hO?=kT;;w6=1l&X`fWwcj~}CdeCaq3ykqOlGc5C!5E`q5JF7&5U z`7x;~n&bcB%-B`^QS!*te!+5@H=Ejw z!p3Nt14V6{d0Y~wFJ&SzS+iiV74buad8n%eqQTwBV|$muD{DV*|Vwq z=DxoJi9bWthPSRDyC+u$rC}E5aCo~_W~2xGE|j)KfUigv6r7=C_lnPK8zyPIy?Jt7 zEm0Nqs$LJ?o_z^u`yb~7gLp<#AlyS8{pgvILx>?^BmzOPbC7lu&-Z!OPZ<6I;ho|2 z#VXG__9_vvk%De=0Pjf_t>419oDNl2%0A_h{p-Q*;nQ!kw_NHW?l@JaN|yo8Ij_Qs z<(m#n^{X9Ay@v&R?t6F4$MA@gD^2#`QBU>tT#!Mggj8Mx)jGPtnxh zA{2w3Gtq>-rX(Ncjjpy5`vvt@zIh{`Dc|@~epmhlAEqu%Mb~!yu|qIYWe(ei&*8^| zY~UPCShTO89pz2vWuny<1${d7l{FodPXt9_5ZO?2$vv*0Gr3qF#E{qW#P%|79%dOh zJM7mo@wn6C8Ga8)EA}DgpIG^pGo619vHmS=Vw4$P^V_r`j?>M$wvdy;%rg87k28K{6t=>U1sa+pjoUp)6VFQMAAXJ> zpdMXtyn1!%c3GXo?!lZtvAyV`J;1K|L5STRz*)jH_=Z^=$b_RMTDuI{o9g*pQ`eL_0 z8VVS)Ar}@32$_*995avZnf(n)ild}`4Il7VcL@K?I~RKOFNS-KP4+5#O7ZJ+AZx8N z6xJN2B{Ou123b@g^i__r@mtQwJp6w`djQP`K{ZP4?@&O2(7rsD>@m>jBo(E>TH0%0 zpbrp(+-b`m9JudK%P#D)c%t7^9efxL1{f0F>1}Ph(AcT?4L4s$rCS&D{oyr zk>+Cb@;UHQY6mvB^}XCsT_$|b+e}{>?dp%5-%P8RP-*B*IRP4=Jd4n2}S3ZR$6fk$Bj`y-_ z^mZ6YMAXu@jn-AawybF_fJBB%UVh742#bi%+v0Qljg1&6wabbQC&99$^9so?Pr1G! zpz7d?G-vsNmUE%?TnN)hc;|uGjjG-OumUhG`E2`B*eqW1Yu!lywsSaYCF{U!r@+2i zfdtbd4DknxY;+2V{c9^)8viTK1x?|Uj|B|ZQk1tkVW^8ns{zG1^aTT6l>|W#=^i)C ziM!WuC$fB+Y`xxy0p)Dp&y1n)fSBmqOXRfrGd#j1Bds7JGH!ZmVQaHci%IRS?#a|4 zRwnu^dNE@eE+R$@0Lz!!ZaWt(k(hs+#y9I&pO` zuKJw1%}j&hED>{SdMA*2Yok(5LQay=f7P9^_WuRaz?Ls>f0&4x!OJy<4&@ z1X0g5Jp0Y=c4f6oE7~@(aMCnQu>tvX^M*;2rifd%p$mGis83-^Z>7agEeyl1WZwxo zDra8P_CV{~uWN86Vam2){u6bod@sO?n8TZWa-UEF2;h%>Q#LN;WH87I6Z2SgtpXCb z>v6&#*bLCpaO=^XmffqK`rbzDD|jLIvE2~gWyt@=SJI2^XQ&4Rgc7^Own)afc;q)) z+(099d3d1YexEM;_i4jEyE8J6aHOJAqm|Wj0sWnWCG$XJ50v5hVuBlcvVvifU0w$u z-NQ+c_ilQLPhaM^LWR{^ZiuD-JQz%#`2PN`oN0L}w7XYr$MEUUeC_;?YhQd%aMg)J z|3FOZ(tHR0Enl_cXk7@*b#kTE)oVYhN_Y@}o=~~Ki_zpqyJQWzlq|Lj+#M*ss0;j4 zlF8eL!Dl#jtfVTvPK5xDVvnd&U|Yiy}w7wKhLT4BWJSGj7`Kkg$*xy$$^kw#(3o^xeCE=_G5=AP2`L`e35ja6K(@HCQRWpsWrw?-*T%eB3cC<&&3S+qb+;wqicovy0yy- zs!InG%co`77hcd-(q_xM3t%`|F*%l&+Dx=fpEBNC)3dS%a|+s(3Xm~fx`k1#*6O4L zhr5=*gSCc@(>Mhe2#kyau1dcL8BsuD`F;s!CLY{3Kj8R|}laKQq)3PWN@ez<6MyzYG-0Mt$_JO@YiOzH_u*BAgk~ zG;ore=Auil)HOkxZ1z^WuRtzZpvg6VEt7>>j1&;Z=*eiWaM%i8aW*f}CE5@5L3U`o zd_X2yt=^*)=TKZQt2Q`L$u>(ycHGq3E4^PBZM;u%7czBwYLvHln<-WaS*EZ#ZRh%1 z=P}D)D5l97{-WwSP62(jE>M~CG=*D&55Y?I?2{d-Oa7^wHt0QDNIMP%w>s>#a3l$o z7GKuyW9#`DENc`ajK$J}-hQ^L9XmGHT(A<{xNVgDvy8713)pjLWZ7tgd?d*&ER6Bm z815!TLTX8K#_^1&0_#=-LD&CZ7!Udz#_j)ri=81LzAy@QOq-U2;#PSQR6*UbJJRa>P> zH>bpDE2TO&lXIfp$Di3?USKe*RL6&spRyY2&2ZZJR(mY!Lvd5a)_!fe^vN!JHNIN} zwglL{i0!l{-hgm$A4uSOs}NtAiM1J*jquSrE@_lMBdI0gunUP(#==wklIR|G!_+<= z?KtCBLV49r;pD3kfQ-GCx*H5ILi;?b7S}w$H{1nJAWmK=;1hNXH<6BU)9BK8s#I-= zId0eM3->bDglKjy)zF1R=`FWCIDG7t3X1xY>xN2v(!cR~mrrSyBZ zUvsW*(#|O0No+VcT%&(|Jp91Q6MfVplNUZtQiXE%qo=?Sb1&hQ8tklOpzje20(c_? zy!@B+6MEkR8B-sd#J7LRA@}XqXkz0>C|k6j~7FVZNrbCh4_LT4%hehBg&ObBM0 zAk(bYtWol{v%>F4q(kQW2j^{p-7};IPJj;#s1@Wp^^$y@2rGKWXG@#|ipm|RG|8Qs z4RY43Z3JlF6UfXN1TD6G&ZGAnA4Zr~q4m+z+e#?$4(Oy_yS>7Djc)*iUBZi8@Sci1 zck7-~>rbEy_XYCl=p$zOk9H#zc+9Vy&TzameG%{p_a{2hE#Mo6#s@vqw0P2h|L3mp(TZ zn0U@*V|!R;=uI1b>7p!;jvW1u@k1Z5B(n-p;Rl6s=^JXS?eil`SM@%>?6Z@JAQo0z zibEXZz3rEfD`wg7%|3*r_q4NbZFV)W6 zGfI>h57dzXhL}IEu(Q;$z)}J_g!1!3R;t?186~ApKpe-L+>)+yJe+^+mGv{zU9@Rc zdiFbCU->u|e)Ht11@9iS!MLz8kZ1u4*yT9#@G}1tcbgl&`E!$tqA zzZ39AVbtQx((98-h(TiAY?4Ew7XPlD5 zLY7YS>o~7sq;shS_IOEBO-8i1PM)!Cq%z@xf>7V5~ zm*D184?pNFsEF3`8+l`8@1%wivb;TC@or_<&EDw-QR5_!KQ}jqybiV1ugY|~$bklT zT&{XyRv%nh`;Vx%e^d?aW>fFCxUN+D0h!C8T}lvH^o%l$B{JUkE&X3@~)|I4c#{O9@$~@CV%ASo}N`%f>1T#*HdPAl6I|aQVe?1JlBNH&|t;j%9 zGsG!W(LpzzGO|ZhQd)da191|C6H&fs!+L8tD=Tf=1y0!i0=C->W-HzsCPZOG>JlSu z?vH0IHMj5xlvC;nSY(4;z;GXrkrFO-T9lk^ynW*aZfvOT4ygErg-xDHKnp!LX7R~= zI^mjl;iR-?NNbBB?0(aMF}9q2#Kh4gL>7^0E! zVr#CuGzEaY@9?zzk?=kO1m>_G|8HQH3gP?K-ks^g&rxd>&_PfFED@|lk7t)4!et+d zV?)48cW19+SYt%k!bD&RRENa?Vz`hCqe#F37nbu^=?+Vfq~F5;v1HqDPL!EeZUrRV ztN93=(idJHwe^vdbE+iKn%U*I3Z7t^dIah0fNf{bQr2WOc&NKE8WTh1XJ&(Q8A5#i z1cz9pXD66rMYN#2!YFZBt95Y{Cd9_QwQY-QrjC%6KE{rUR4^h2j!1h5Iqj&j&e;V+ zA^5jiO z^-3lk6xrAHoEEm$`dGf-!_Cv?lDNKqM3S6Qz1gheI1&$X+c|E3r5eM}@8w9mUo z|H5IyftI(k+Ibqh*AA7jSKQveIjvcT^xSS?Es~KInCIyfZ{1wC3WSeoR`r{8Fl_fd z-wo<#!^+Yfsw(YPQ*$Y1o>qej#6Vxdm=lef*UofVtSWKJ&tnvVkGF43m9XMi>3yynsk+*AP1;IaT;*>WqSaZAdWFWmBZ*;U)76en4{vs*8rb=bl+!{v z0kp|U9;1cUBI&0sfvX~@*q_&Q$`sOI1f>5QVODA8)?`ou`A`iK1ZlCqd_JR4;M(FYw(6P7rP2#sF$7GTekX0$yz1^jviRu{#M@KR;E+s%f+IJ?^Y) za-ZGOjl$+AL3isFATXD%%#t8P{U9AGm4tL{8T25Axza{8Q&26?dF#~oh%Fl)qx4Bv zpU>Y(XWu`*X-7!eJH_+*CoRM;H=QbXK4Nk7RnTt}AccbQRm*;Hou=f5$W7(=JMfe! zTEWwD={yjXo1+C&lczB9Zt~BL?pC`%)ZhTK0JiNUEyBte+Y-V11bcnTPG(CNTs zZAo@_eH^f--a-a}C!Gx`y7)4;^$ikeRt~4hQ}NZ5apCr&^g)dUf+Ev@ zp-j{xQe=WUFVULGZ<`fpq()G*m|HkW$cbyX9&tpmQ(=|Uk8%zE*R}Jzg>B5<_!dy# z7Tih-S)^J}qyjNeTI!l2ZyxJXx=NnqBs+)J`_UK26JUYUT_s#p7vr-cTD=x3pl%AJ zh;kq+b8SQu&|nQ+7~5J~q}*9?uT=e{ocAn;qut0$QxpH_s%ShN3WNW7oZCA+&8j#f zzw`^rJNCEQyR;cr>~=>)Yh8T*b4)0{BeHRM%=>K)Ew?M%G|0zMp;LP7KO+&boE$7= z%zopBPYyBi?$74`oRIU1ji_=yqAnNk?-6x-k^QELOTUhb`an&A$4W`+h0}lV%8U4& zW4rsV=2xOxGScO*%pJy*(W3%72#{~yo>ujBB=7$>T(>#>CxkqAAAugFw;f@s&t5C= z%(r!yC9v%3v z32I|jaQ~Mi6MVXR18`B9g`JMguDB;%*W^|P3>VUB> zBg_3<57Lh9Rv1;*nvv&hf~r4V%|(I;cj&XKqj~n{%Bcxq`4VnJV!%qQqMF<3kYQ^b zx)joDY4Ab%z)4Wk%{w7abB}3BJSx^T!62NJPLn?a(36`M-LDNcRI}Buhq`fs*UK;0wu=OQLBUQz z&`+(vC<<9o(D_1MqdFyo9atZvlmejV# zJKzm>0f-RwP-|Nw;l0y;%v=RXdD2^26PPHUFLl`Lv(E3XLk9;y)f12Mk|6wH%us~> zxxdf>;CG`>2?vsw9_MZGR$giEnawH9^NblFlpFE;N`xgdWwn6m$tm!&1RNk!-GI6z zESOO)qL@F8dm(F}FM8^$a8@RenZ4IuxmMK{Hkkw3eNO-jfo?afEb>}e$1g)u2MBxL zC-sxO!pZ71QE2gR0PZ>-f4F2D0Xp6`yXaO~;B}x)iyBk2HCyBup$cTs9z4XFW+lM_ zxv3iV)j5qe03Ncp_i`!xD^aW8`=w%>6jIOa?K>Q?Rxn_$PM5SsH5yi5Bve zM=AV2X`+m^a7_gxePepI6ce^En9Ku>Z!Ps+-pvnS;{5Uz{-l=POaJW3tp_~aT09@M zgn_Xza!_IsqUjh1)Q)<_(-oHpd+s^G^Z@8{jI(U&HxIYZg(3{ge)k~v68}2kjG&mU zI^QTp!uFfSQB3Ur^M+CYS|T1!bKV=rH{{on%6t6?jC|K(w{KOfQyVr!7?FY+sntG9{=6z*nM@?qXk@s03@s3sAmyz(X**-cB0N!o?19+*v zb&(|JnhOCGLrCfW$Np9TPZzl9OZV(;P|6xzrvYo$TzCJ~sEY(v&Fh}Gu655F^~d;G zLRLSYB{KU1xMdLLSNh5Lv+WD zTy{EldF_|VT#4H5kFGkE9Uf8UNe+(82$zXA6`E@?MZIcK2wJM;-~asgA&bu@K*rQo zY{=zJq>}djk{K&>X=>|5%!(qes`6g_nOGifioEx9|Mi&66jbY%uan`;DP^UN=s=2e zZN)tcI?1 zN-A5qVsM~@SrgAoi~3rYJO4kTpdv@EO;|M>VYZ5sYG&VyIviR%>O#C9@UzDyH|nF4 zYZSUh^4x5nYTqE3MLe!maH#yb`u(_ENKIID&~nGgSZQ%xkar8O%M{!Oa3AZ=7eE3E z$q{Ms>)_w9&xE|6%MV+tUF{{!H>B(?aP#GD?@Lq_Mc6G2fSD60o(nx~tJ?&nAFwKK zfCjRT@Hz@EW)9ged*=3ixQT`K5}^{9)puA}T~=U8a5KY6>;)*B^L)x$<=L{Bl`*2n z!bCt3R2v^@$D(-Bo~GKn1m3C`Q!R)9MblARr8Hn?%u&Hlk{=1jON1Rmajl`-e%)Ru zG@l{*fEPQNm;bgUy)e@ zRRdU{-14QA&(lUGs!BhwQ(R&u&Ls`w(Mz?FA;YA!52WjSWS-tvfie$RD$E>W!^(og z9Cto`h0nCug-Z0FTU-z3efloyweeFy5f3G#l4MmnJiDg8aAY)zq>@vqE( zIffn5$M@ItT#YW6y*wD8Iis&R!)|*b|0A7gg=;BU{UK38*{cF$YZ=Qk@Ihywfg3i6 z#Ff3R-ICAV@FjE`h`r-LuR3xU10JKnu)l7|rF{iEPfJBD>bG(o)`l0!FE z`?#h$(pEq2{saYdBv+|^TKTWDDgKIDPO@S=8~$WqNlSo=h62c7#eb9W+=@=Fy^E&} z&SEta`J71JCkS((8dsoEjtrSYJ$*3_7X|J@0Mx z2KQN^-vw!cI-br=yZDlq!^#kqUm2qhg|`+1Of=Nc;S1{exZ#%qUxEd9TN3aA`_2%ED$=YUNLR4zT- z)cS*d@#PuexJffKY?py8qOGh$-81N=9lKCzHZ2f-|NkJ~Nwjr`0g?G(J1EQ7K>}r2 z7I%#C|G{>5uVcF@o}u+})??cUuC-ya>;fjVH1vUmkj7^;8GE?l*qW_!sYuS*f+s+$ zl58n9Ib&Q6S~W9=oVI&JtMz1TLNHLWfsUTI>e-pyewvqSAl9~`mZxFiqto+kK^AeLRxX>>)46 z4`)<;2N=k+D2qSjpQ7u3fF4CKud%|IaezT(SDwiRlv98^L~B5(Khx$~Nr(@W)4cW) zlio*NzkQovtWxbQ8$Q){=wnrNcAk=d87o!?u4(vj{PU4MY+m?3Li{K8(P3*q>$Z(q zUXSX{o&J2|RwJ?}OhWx+J55RGY>24R^@ zo=hJ$IvxqSm83PlpRW|>SR*&(ia)TE-RkX}AuM&5`I77{%tI>n-^|3VeqCUEb*ONc zu;EWY1@t?3HeVITc2zB6&jt2UQzIf=89Z1xz6$Zpk{2u*hEK&4$ZPbJ5;n(i&YDMD z|G(h>pN+!nNb{=jgBf{zToJpSoX01Geb;J7kTZj11+=z{19HBG?P|24VpoqbWG2N< zTq{-4NFQy>u0!fmq{ara$x>5RS5eaGbdn@_<(j@Cq_|?>j+9%EoPQ^duwcRxXMFF=; z92xD`W!Y(+sDYg{K5I8ewaRIR9Qgsz&7fmD*Es??ES}bMno+>+h9w(dl1;mW3}_kiKj@pF&;>?BKKCaZfMV*nbyqW@%Nl@U7VDsx*%Kje zQ?vH_0Lb8hND#R13pub4;zACr>MsZ8T2lHdl}c3zbrVJ0r?WudJ_G`{Y!3o>-fC5p z(m-XlL(W|fLw=O#*d3)euQ$Gh@;nwYiz)$@N>l|ZYP+zL zFQ7q6PJ~PKFV#5NbAYPx0jYlm`7UH_GQ#mR9IO1=KjYxiJ`kHnKwYN+IayK7teAUM z4wXIMAHbt{GJpvS)xY9T6=QY-EKg-<3$H0HPD&S?&iX1KiEJ< z)vY~bs3^a}SEZNcA?0QdK?eiRkk|6^^Z1u$a?oweR%v1V4Y=O(G3$>t=z8a*?v0f3 z{hINhGj<9znfh8}( zaEuL@Jq`S-BRb0xepgwPE(!+!6KY?xA8xFZp2(Rpv|a7`SPAhw%!6&gDYPMdi?AzQ zDhbHwy-A2YxPn9V>m%L4`jxRF6^%#2t5`mgrbNoEU(! zza?ssCbww1EIo~~$QKHi$A-UqO((Ypob@sm5GmU&Fj)UT$wKKDw#FC3Gxs8WD8~&w zJ26O~HBDz`ggX%o2xomR2sGK2iWZ_LBDKaK8IbFh)EAzby1M3$ZRpq_vv*pM9T{ z8;SRp?l|vJSH5I8chAPl{G}G;{CMv-fbimvFuzqtan}Y6Q;^ZvfbX&a3;*EG$fJIc zbjG!LgKGJcYJI%GLGHBH5 z?P-lDytiCVAfr-#crY|AZJ||RC%`tIdsrDKf4*;k^Vo#-U8s(YN_~ktcegvb%`sP} z;K|C|EXanridX?DzJ%v(yK@*KHe}Ex z7m1)$hHpUXYHuA`p3U)mopOqs;q$`^dAIV$KLf|!tDlVnLRj#Rl{8FB@c~Xn&u(Ia zN3V+fH;zY;SrxlqT9un+UDfJDyu#_r6TGh>i9P*C10LG5VNp&?-!R9!jdUr3w=Vo8y?I6j+u9 z=HN}hjC3|ckUNp(G(ouWE*nKqNB)7Kk_ zaqODVSxo3%18v4qBT^qMH&F)(#oBYft}RPH#9&XDo#U=k+_WH@>kP*0>4;+c{m72y z8GT=7hzHZ1XI!dg6lzNTb>~yY}TsY%vEL zz^SfE9L5KwYoFM>;h@iG#QlR(4co5P)S8OlN!sG$WaxYOgt~%u?KNNExUC)EHX0{x z4m$M}ydHi#NC-+I<^9{on%sj*WOvJJht>!;*l0ONq|Y`v8}teD!8z2NLBVoLo&B(Y zlT^Uvh$#op{i!1r!0TP7^FLHcdtbNIl#lyPy=;XKxGiO_<5^4f&v0Q>EFEUG?@~Kc zRbRVccaxcm7DPbDTyKq6rMn^-7kZ})2f7#NU#)nY_pG_kNb`1VZD(}Eujs-B*L?n! z`8oS(0Y^CC6w+n{0r_$~VwVJ%U|-FAUbJo4eg4+aPnjCKk8WkHN$fqJlut%i)7AB> z?wz|d0lx7Y!9U8`hsi;R>-Js%N3l@4R6r8=+3>$>GMq3DUGL@lSEqZIr_lxigpZhD z?!CP7YJ-b~`ce=2oFfQ{Lo{1nI(Mg>vdWT2r%Uv@m`q?Wp3h2!#0F_zE$#~Q41G)AJE8CP1(r7zdF zr7UMF*)Dw~t0%FVkos74_im}FLsy@9FW#er?s2F0E7EnSKHfj=LHzB6P$nv?wNxnz zo#&MHr;Lz-Q})no94KiE%3CJm3uG>mkp1&WcLuKjlpCNapXjlt4AJ<4LDRZaib`B+ zsTy=pzaYCx(@Kz-v_ehI@Q0%9bIEI!pWPTC-@ceff2b{9<3UHEXi^0pU0TeZdw?zt zxKiTISccYe=VOqJiBLQqZAf0Tk~x|0|4S9K`jN6XJ^@=fx05g&=Rh4X*1`J!Z20g2 z`Fit)4T?IK-gytb3D=60`?9_q%W2wl_b3GOp0{0HGG$Td3rDujgxeRbi%eh#mLf12 zf`T-76g7D0GOrIO)gQc6PL{q+nQiF3gv^p(O2DzT@rECXgKk=BKlQZ6R_CIo_kx&b zp2xR(u!6|vtMq#__qy)7G$FHudoit9&J%Uw4M;f5=Z~~I9MeP@8*{oV!w2 zkgDauupVe37*~FBuTQnGoq!Ie<{@2+*ecBn?bu*J;s}EtgSvaWI`RlSyOE2=}E{`8p{5#C&Y2qQl zPQ%@9Ds6{WVl-ik$KldmaO7-D$)(k|Zgv$vbV~y)K`TRBCeWN21b93~20}E<nzF=^16O2Vo`XhOI&@ly_ zZ}ZP2dvs`Yajs4;zJR|oa`lcF3BCMGu8_?cd2hqZkFTL#xPxO`*+YXp$XMAK|7PDz zI3MTNP7PE!*wb#!|@X4Uc1#-+2FcBYLV;GO77${xzw+O_5W^^Ij*whBu(4HQc@3*eY)0cvNE! zWxsZUuwyhpG1g{RYf0CTw8!~Pg^Kh?d{!wyvQsyL|OMHER4yke>pLi3O)?~%0exH4=rc$mbBvw;`4n%lsZ8GDaI`cN1c znf8DN>+KKbF?t7_!)3`-vTHmgge{2mODHStM(5 zhoLA`Ti*@Wk80zYPEnduLr6n8#~~(9Mm3x6+%DoUl8=yG8XgdpVXYoDO!gB5qP^-` zs|BXq63Fs1ITW zCHINgI%2Q4OQtEmR!f_V02@hIu%lgbK@XV=1f!C%fQs6bO7Yvj%Kfbw<2_0jN?4{R@uJTbm<@05Jr zC@_oX*ZlO|?Bg_lSwYurqqVqo(^dGbXPqMP2|LWdrnG|NU{@w^8j6%-UjQ-Ls%GQp zH1Q#0&fwpg6Q$;<4Yt*>YPUTM?(W*pdOLl*=SEKa7s>p4dSB!28f9?*>rz*HZmJgV zuH5q=#OcX&kxWe_*m`DpU>#oEqPAtX8PDw<)(U`&jro!Xa2t?DG7;rEofpogE5A;; zUXMC^X+r(Q=oVL&u0}zHwO3nL>S5TmH_)pj?S=)e34shI|GV`^66>s)R3?{M$CPB2 zFwZfynYzrq%uT(21iW0{C&ULt4k3$>pF3xgzw#dX&!Wl~12W3+C8H$ogRiVC-=B#! z3(J*kN8;W6u@?UtV~zZ+yI!KKiGCiBBDFOjxH<#!DkO0-xp`M!xoZ@uyx=77*dd}x zxjhhsoxEg1FPIINc1t`B)-KiZmYokTsA+;*` zL1h+KIMemi;lvU7uNquxeMqecD#W!Q==Y&T0?;2Gjq9$>oz2J3Wyns;Tp97vNeTI3 zdM@;nO^VvkyAunbRh?8*#uR|f)MgELx++8A{6t%N$m=2Skz(cki{gI zvlVHyko5PE+|EZhyDX3<*lbp;?|CPDJ)?|Y4rdRa-j;p!6U5-FT$f`4r&ve3tfyEb(xg)9pBKe7A#ce~-Dj@i0aW)2_>LKuz*foG zGrqg>lB`%bNCj-N&fo{u4kk%&Bvxa4M(kD;IazS4=w5A!V{D@Ht~2SRNbL-(f=-XF z`+5A@4Jijn5>Qm(K$iUp&Z)vSDdg)sp~UoSi}#P6i`5^3zVDNw2K~B==zA}fHuB^q z*zp0}XJXb;0^mJVe-UJt3zr=Ga#Cx#Gc3XK3tX}(GW_CL*dZ%I;d8w7(c!BQb=$~1 zJ_1N5a!{6`CHZW5%2&04j!?sG7XEitf9It7NXP+*!qe?|tmLjmFu8f7ua~bbJqir5 z6+k`C1%{t{d1|x!K2`lP)7eja8x<(a83Rd4TO-hKH!$a?Z<$C~jg|V?ESF`4HYG$g zQ1PNdc0b2e&iYN%`FzPrb>C8-KrfCLCs5qq*b5p#?Xy%`9vrcsN|`)Om)Y2FeLeou zIra-Y*ODBY#G(!QZGY`~B4Tp_g+lI&OH6+WLTl1U+GDKhWRN~^G(um3j zmVR)IW1iU5a02Jtz|7*mWP6&|Y}rjT^N# zf#o~8q(?92AD@s+9nrmc#iLQ&*71UdTt&@OKVhf$@6?mnYjPEn_3%lsh9_%uy3WKV zJAaE0M(bmv_@kc-TNR<|>kxEGkvY1d==Lk_3HKzrUwmZX?&0yRSLR+sZmC|kdjKEy zuJUWo-J6=h6VQ6TM|z8Qy33ox7dJ(kIK=rYUPT{`YNU(l>+I(nryt30iwQdOk}Io4 zf35!X-vSBb?es0K$@S%>Us-Bn{%HY9jpTe?Ae-scR!$O2a;HqC%Xf^p|FAL5V*7}D ziTkz(LL(@BTFsB)xa}3rS3kYO4=OtzZ%!)9`|Mi)9KkmDVB8JU9EMZpJr561IWKjN zfid}K9&b}1j&wa$y+90{fIQJLqu0T**9XlgQd62(mOfWjbtb~c^WGZCnNcRZ9AfDy zX8oYVX7vxjJ@(Pt%vwXsa;+=OodSDx$`lFCL_6M_mwkjdJT%=tgIq9be?rvT>7X%K zq>}XSfT|^ls0Tf4O?$~AF_%v5+pxje>!p%gr}{As?!k_))S3Y z##aCL^}~GmITh+5`(S(M-DZ0NZ7h(lAlnBf$nH}oyfb-9>S#$TUggU^d#Hczn+gc$ zG+s@Yb^1bV)~wkvU@Non4;)a_j)VeGjoxC3GF zl_#-c-d7$sMs!_{%@qqSKVvPP;ppmj-?ST+9&nDwm@M~A#rnUP#5LbAEo{VpRL$TzAg?ODloq37*}uwlroLelehh3>0z(d@>kSZ>SP#x$-j6c)H_BIL(m*zs zYR-R|ISij1Px;q#rmva^me;pv4b9O<=ssOG3>A)Rxx)Q`BXZ*0mW=XzC0?wh)Y;z6 zc)5h$O*RzOgHUwv25?n8_SZ0!!BT?npN=`)8@Yy&${g8v3-+V}IN8oERs61hiidBS zuSg5JB=N+yU)8bH@5+}Bz4QI|lZ+Z8zyFsGwh)M_KVTTFi|i6)_h{SH?j**eGN{-y z>$2DSKZ{n{y1bm!JyeGPLOG?iLn2NryyI?OX=mRLLz(r8ogJm zPpgxUx3Q_L8&KI)VNs@7MkCzZ*M^mqy0nb#X>R2*e7rTe9$1}!!MemRU;F6Ri0WJE zTbOjcc)qX0uWaQUmI2qwk)K8XVo6f^chDqoKysg!3C=%xA<#y1EBLKEYPMlB>R(fD zbzj4>9REPyXm7zVd3q$pFDJJu)%s8&IsrGVkpmMJYSx_9e zS9tg>ZRR4hPjI$_FckMT)Fe{${Fq)s&>qus_u@a>+O;_Suoh2u?9c$tLXo6CC0SD+ ze_VrD-`<8+ai|}z(KMr}c6Qr0)sP^Gag1Fnb=N*{0Se#YLyp;yk6oPJ-*eWadi1&O zS8GFmVZ5||Azip#)HTXZVA?n=_)qhHmw#+#PZ7v@j- zR)OGO{`;f4be%zU-@}9aTOQ}T%cV@cow%m3ALX-ll8SGn$@%)iWYFU?j}Wma2s1lq zAvQ=L@CZ9bPA^;8e5)gIqM5dwiyQ=e_aymR#b*ET6nur{xV_CdijaFGpDc6ODCsrG z0^|;h(!({Nu;#RvD+`bQV4iYk`)5}Xa5HDL3ds`H7D+69ywU4OZdyJ#?-zu5INpGG zh}d8aQgG61Y5q%y=(Le6Rc5)&CO3>Wgkuh!Q@h|emM;fiNt}}yd-Awolr z3bd_Eup+u)*NB1zA|VWX^uCz!iuAl2J~2uF=~tx-fwcW%Al$^SH#578a|-W4)skM= zFkb^q7&d?Y@M6*Bf}Utl{Je{9r;m(onV|O;7yYJBs^tZrh99bnOv$kIYeU}5CH}`4 zk`vnZRVCvObaroAu7ICKL3i}*&bJrU?9}Sk8pJA@I|+)duEuY#&}+6fItxVxcK3Do zPM`=ohjZZ3N8rptvk61A9Y*zoR9TPCzdHScQe}&S4l|KWAjPt3{v6P<09(ciNfII! zjqrS_a0Boc)3#$h%%kc|u4Al@!Q%6RDEeG12yJ5psOt#kB z?TcZFmSyn$O_5t>!93(v?Ca;V+eXL3A=Hk~>zj+h)q{WDyYjt5q}U)PbD{bpRYX=e zkPbMEH&pF=(0!`#TZ+^u=_JUo5eo{nK9PnxzB_GS;giAC z0IS?&>h0_BWl%2=9O^mr`DWI(@TW2peY<(XWv?|Z{w#wMru88{PEMa7?-|o6lWYCh zo)X5AalW=*D4E*ckt&;=DvfAg3ke+!fnX4EMGhU@C(~n<5X=1Sbs?XGc<(`xV8?^T zE9@v>rlo_Gk5@5`;?I7rdMU{L8Vy$kj6GP1-oL@!)Q9!kK>ZC^GNZ6hBJ(gx;+F}EcvDNKkhNvW0r@02trj4&IP{N?CgG>{WEe6?0!>(-~(!?O3t4 z3kSeZvHl*Nj_c0U@jp-(seK|}0zY%ZHd+|a;AaDBj|JUI&oQdgsv*{6mF|svhlu)B z%}o1$Z+%)G{JA(0@3fmowr)KOB?e+AqSh}#uX%zhKyATlo{F3*u;qR-x5ueXMhD9(LQajdFm#C??&pO-drfulC-6G6 zPo;}mHMe3mmHJgNn6u20wN7l$HwHT^-+hQl{{FJ;VH_*31sUP~yU1b+EC$J;03)iU z0GeU3al>Q#H1^}n(CZT7?oHsl3s-YhY#+S}KkG4Zs=VS=jo!yT6In5OumxUjeDcM9 zV11d4x�Jk@e=`P^juPst!8DU6{%1kEA3?V{EvYrwmds$`} zNfR?;DMXPqL&;FYjBS){LiD?*^Z8!a?|shvaW2>8oHLK-dG6QizF+t9P`=2Djtujj z^&a>$jf>`4N=mW~G5>yO;=aF$x|EOVxzS5{0ktXM!kmP5v2tNex0Bn-I-s+KA_n*W zN)viB<^95Liz*=+V2`!&X0^|t2>F`O;ScH&&&xNrvry6yG(Yx-xyV5Q^H=&lg0 zNt$Pi{nZ-|b+R=9{C@Py&6oOSAC>`lhvG{M53P*XvU6#lB_C#N_cY)FO>vcT!@EhX ziP-cgzx@68hCJ4geeGso<+Yju>^uS69f1Z2;M72@{E>I1bi#B%Eivbrp=Th<%^a#O zR;?(GMPd7ZQ|05_o^}8{AL-_VY1bMl zc$B+#L~bl=%I(|WgdwZ;3;2$H-4W#nleR-A zH#x*q$}|~2grpNYW;oD((eww6l<5h_zxt*~Od*a|AbpMb5zs5I^4QeyTIXuC3(@Lx zvF1~s=_dODb`SaPM{IBKqvwbijrxAL;?i+$`|ivY$t4z7d6jjy6ue&R1+?FEa@Ioo zz3A29T6OgqM^Sjy zZdG|H3>NL|;G4gUYQFl3W#-D6doo`u$v0P$});(+J!%JD`2XSwX+(E*4~V~O~aNqOAYg0Rv{OARwD)^ zEw0%wS_G-?U(TzBbBN9|YV5a$mOG6M@Z(D@>tY9lN5hI1S4uNoZnd%9T($`00Tp0E zR({^|gtudaXoTNy?ffeJ0&(;Zeb5^^0zwEx?;5eD_zuSBA<2vGpX3u3iqNgK`+`#j z%8J|)!uD-gD0)fqk+N5ngMqAN_XTFb6J^<&LY(C}YoVheKiDJprExd_lwJg0|9wmp z8yf4(GCz7C!9E%?Nd?@wLrr|wcWBYNukY&F))X)9m(y}sA2%A9_-R08m{>~RN*TN> zwO6Ybo~g)(jKs|suf)r8V(!2g$R<7ypFcy=uhi#@sY!0O;@!YE>IWpna=}fd3b%I^ zCV$ALN;lDUkc$d_vTs*Ua04p$EvfeGA?@wowB`FJ0?XEuoVNGjlvVZ1W}5y|wr-~X zMKEBjx>~^^OM%Ah|!i6l|37Vs!XZ~i?mQdVBbu_uyJ{wh5leXgzl za9r%=^H$6?T5m{m{Y%uM{|H+3F40X-v%2Y0-}RBx^L-QhAQo?_ee$qYsn?&{|76E4 zdlZ+MlcNj2sbl6%DV!KAgl+F+u5i@{t9+5rKy2qpksF4*in&?S|f zq}J~D`jGtavEU@QT0prHG{~F+RzXu-v=?>b_}B9)VUru^D#WFPvQ9to^g8?6noK}8DZayEil9G>c01vU@AoLH*<;jj?K?>BeQ9R`3J1kCq&U1Jm#vaM#BMNpy>mS20q z$S%KDX%JP!6bmX56(1%2+=5S_03vq)$uMxW zZe=tx`r^acyzB^!$oSX+s+SEXnr*?h=kTV6vpauOk|IA{rs+B!`{3rDS1$B-H4Az6b!$`1|A8p8g!(r(y9B*@o;x*P>Ak&wYWFc%pGP$5g}49uIc z?AW)xNwx3F>@u_mKi_}P@I>9wRl`=#I(?(zUoh}=N|f+2))+l6ovusloZNuPx<{*9 zk*;*qd-?eRlAaHk{OlPZreBGKgv{M@`!C!imt4+oZ(BV*uS&W6ZuOK-$?=7NosDf7 z8(Q7=fnPljSN*9N3tvV!PT?N(lPYPc-94^e z`KkW8{&ucPdX?^a{H?3!H;Y&PyVcb;Sl*JQAw8kcO^$9zh_Dy6s3?8&?D^OB2f-Hw zt_H%RJN+UTcAb-J_Da0J^59Zzd+BXI{9uZ3hu81iNn^HA3)*s;$}Jx(&1gV6^M8n} zka(-H`IPWC=cK`p4oVyslH#ax8ZDFPODaHE7$eG(9Zm$QA-3UKlQ5^dAL=~GC>(E* zr=;f)PZAQVZU&%*$FzUmXmT*-s34kSOuv?EyBvC(V)^Qri{4l?)yn`mS(ndo40Stn z73yN#2EZxVyvduJSVT^iwGL8^K&nvg^O?tvGh@FVC_l69mfgkp0^1!3^ii)JS{$<< zG;pzGhRAcqO_U>P@B4TfUn@83ET+^1m5k5aCos2PiFY&e7|<6-tVRXj+leW)yjp2D zuo-$E7d}B)XBJ7$zLukt7A7$j`Z;JSdEx4(4hsXc6{*7 z|Ag7c?YVuvgy{(f3wktry?ym0jG4=N@(E^sH~GvLh-7w9eqZScN$!j7$FKK0`6Qqr zcUQAc%0$}TH>HAs-nse(jt7!yFKJoC^%Gy&illmqOO*>%h&4fe9&bve(a1?8MR$u6 zhz~doS&f2m%M)6W)L>+(BI``xMwW=GcxUFs+5r7WUXrihMV2B+FYt%Y5UuMULA~om7>ZGjmJ;8ab=sd}LawqC4wZle! zCXBdSIzbgdxzWyC-SyMkhhx>*1kzxmSjJk<*(=KIN0?HHtCbzJiOVm<4uj^wt}1jFsEC2< zAMAtAG@%eSxKtETX9i)#b#rVX=)Rak1sjGaa@XMg`mzP{ctzOCt65(1r;0H9Jx|Na?QP74ga#Op{M4RyVjYPZRO*6#k0%3 zs^Nx5V)Qw`uN|VnEjA>KRQVP;(NHN6S2sFPca9e%Ly@V6zFNX$K}rK97jr!pJ)kZo z@LZA?t}i$k+eb1M-YTcmT5R~@xg^<428Z;5)AfD! zb1P!Ds@>ou+roL{h~@9xx$-XDK=scOY>n;E-(}){ZRS%Ou{`Vjp0)TTw7riglUeS* zm?rV@g`jLK(>V>)ZHZ!y!>5GDonQ3MyQ&tUBS{j^HAYXxP6khxm{LdgBG==|tU;A0 z#FNxEQ)+qvF&vXsKulsEU~6+6xtuiXjVRl(_J}xQ(R`V5-NlY+{4yYGlOh(WiWQYx zt&H13n!qm%wn4&nCPAyyysp&ErREk?xvhCOs0b5k;fOBXc zrp&Jo50me*j%PdU9uO4h4Xcg7{0c+;)@pRT`seg0?y-giQ!cZ?@aCI?9HE!k6Ir#c zoEzawypx<&H~Mx!e!j6G%SkX1g8Ms@miHwaN4}ngfLWjaT#v37uOu#8=T7u z9S$rWIh4?WF2?zhP&ob!{M@+1Ve#fw;%Q!S5n78KSh)ktpGx>9&Yv_gr704Q# ztkRKjTGyerO3wWLM3HK@zLg=s_zcIzy2&*yK~g3 ziS%v9Yqsw8#7EDw?phe_)HosXg>a@g%GXo*EM-@buF~0tcx0JQT!y3o_Jgd3Q`+Rw z@Yg2{o4jOJD5CFT+jXP&#JL>OPmLIO&b%9zPjpitiBk<(Hjn{w*bzo2+k{py`FuHbC^?x@%dX$Ap2~UR+SMB|BIzvsyg5Mo*7e; zX|?*sIrFjV%8#Pg`Jx@WUFmG0zcq!1Q(`}tFOj)XYrog;uI#tj2RY{8`PEk~FD)1( zdkpwL$gBO}6cQt+#4-F466dL!@LJn)ZUI`P%MW6ol`_WK6uOQU9q)9}>=C_^pEVIi zUncaq`=T{m^j4#ZYsR55!Qu;QV)gO97j_ED#EC3si-t7sGeGzQiLD*vXm!;U1terW zmFfTB022ztOVN!lYcDpOBG@oBHOw2NhSOlegg= z?|>8kRVW|Xpr<&ev=_#dTUN-%-s-{~Z*$OO92->s_|D+&`_K~@ppZ{WAAeAgR? zRyJpT?z;BPP=O=mS9%xCeeLOGhv3+#jg!dt(Qqe`J8w+WCB9z#YM^-P;RC!Ufh6%w zyf;3FO~9xYxnuzPkqY3zXz|h}4EQN!8=fqvCf;N4rUtwU!-=h(vbrENyfgSj|B*j( zOl|qnNcG*QFX?0~u`Vsd?@`DPFfp^Lt`M|!E_eZM1E6=herXRqesk~5T99>a`*}XN zIB!0BA^Ev{H%B_u<`ajd-O}tVb8|^b|6|-Mh?^jYSZNv5U7Y8bC*}<9s;?rH+OMEJ zvj)?0sczD2HXcnrPpkPzzig|P2ijY{AzEaENYvaz^wz}}vDniVq0%X#2zGhiP1~8R z1|ZCk-O^SbLP>Y#o;wSWZoej@vXUIp2|CcLi}%&OA2Is=ZYhlKk*m6pTTA-ixyee|+`+YaQ(dZr#!-GZ(cpLZAgw=etq>>P6CVSdc2K;xZ5v*^=iy)kWiR^4#UtP+Paecj&`ptvlvtpUjlHhP(^4nKxKQzB&A1Dm|mDW*y^*Z-n-a zQSIj33o^_u;UWQ>Y550!4xiB@nS*z8si7}ih_Cyn6-diM3(`Ux(Q`S=+d~H}J&b`1 z-soIwS=O8wd|r7kOEEb0`Q?~}`hl{>S6Pr8a10jb;n{Kfn{cS>uZCaW_X9MVc=TdX5r6R z)a7DT6-^$-c642C*XrrVsL5rXUo_Hcaha7F~wNp z^Zd;%QOkl;z4cUb4#p>)WJ(PlEmidKj;Px-j!K7U%V&GHgE8U(PQ1JA0}guvvG!_T zj@~f{wR929;R(BCE6UX$w=pe)27B7e0-TBYUOoM7!QY?%c0{_@#wbd>Brk4>{R|Bt zkW|RZuj?*SLy`C2TS&FMwkgI80EbH9q4$|uhbDJ`t>5@YgGy<{3`hOFEnf$0w5qP^m$asc&TbJP$h1~z`@g?%Rwpg->GP~4TXfOd zmF=(M3v^AZym++KHW1{L8{nyXJpGDQc&=&Cl-8tP9#d&09<)$O-CG08$G=B4_Mo11 z3ySOt@DfS?V@7^{)9mv6o3(%Iuu>bsy{c3s`d)MvSZJ$uzuErSsk$%nx{gETb;AGa9teG=@8a}aHwSt#( zibEqM?1y8z;+iFJBzr%3?nG~U%^R}g@zx?T+TeQW?*#AG~Y`}z3}u~kdT zPnl553OR-4*a6SRC3m;|!^_;k)vKQc7rZ>nRq8K!+-`6AeqN>8`|ugzKyoKWh21=P z4cI4!8r)VQ(Wfzfsw|Vf{m^>6#_FlECI`U_8i=xj_#EIN%op$;l#6H&L7%`dQR$>e zYI+G>sVJnH*f*n`vy!$FSSca&>UANvnxeT%H*33kM{|gwG|?eENx z?*ljcBCFbhXD%58-Yg_?>l$bKt>E<`*3G=3cXga9w=qw}ICVa#`n-Ag+AiD8Wy?s7 zklTI^sYHoBOC6tt57LUL1v^?zADwAam$PPK5EUFJC~Wz&Z1L!x;o;Ay%`Uw)UUl}9 z9`=Y-1FQLiostKrH3;K!1IZrri6e zAFmF{DUJS?^~-TKOtPFJ$rydK6KV1+F4@=OY_@Qm@)L20XRN?^!8$+c)s<&+7cZn` zOsTxG$q$fwJAh3V?x6H_QV@$fK)>j6PwtDD)fFS}0R9(I@yxgOR>_GH6M1j)LY>ds z`EhIPuXu2v4V0fq+u=R)F!}$`KCy4C=@_!cP|K9s#&rY0Z__D)Ek6~74+IXOZ%3}j zHB&3A5@|QFXb)bQ8-p`$Y`N))>)nT?n}cLl{0@Da%MTEVBF~WyVl!nI0!x3l8(gng zqk#pmYw}Z-LgLoWtd&sY2@B>FZ~*SFgNls`~z-+W3xB5bsWSi$#eIxajrdt$s zxsSU=BwC}pz`?IbA)B8E40;=TGl*ARjc=@p`tZ%GfxlXxzvSC7k<2t_AN4O2Gq9ZB zS-L1msZ=UkH;UggaTr1xnU9v=%Py%9EYwx&y>)UN@ASOz?NcftZZW=%Z_UA+{-An` z>W&we=p>>&?_+M`G_1AGb~|u|94-IWBz6k?8;mAM82s_OG%PsUfpHKE@#CUXgjjB4 za^wH(bFj>BKf`ZW^Ax7d^y7o7lUH|YTrU+!G}I6N?);l^YD?vm>IR{uqkYS{&*8;$ z*F5=q;18R0aT;e7-340F7rbi~;ZiI|fQ%)zHL*qPj(k116|RTfqe zmKGlMNMG^HUXB+0($rzQvNQUA&(4pSxx*=wpRe}Rd(0bBvSZfvmC2?USXG2QeR(Dg zeRCruIMZeeY(kW_i@w5P4@kD+=VAoRN9%(s-pqAhKOrglVD@){wvDR1slp+W%<+#R z0-rSqj_&5uxw?C$#;+8hH{*}d|719&rby{md02b1C7<_RHZS{oCC;B$H#k=NX2ya9 z8GS2mQkHwK-4wPsNyYkjT`84tec)XEq26uh$2Jd!z5^omM|#}DTM%?iJfx<7d&(1G zN_7tu-+R}a8gw6+IDMX+kgYBU%(O38Ql|P!9nAur0z4lJ|h~0bD6<2CIe_ z4aB=1xGE>y>G4>2=~q#v(UI)SWM`L`-M5%)dcoiQZD~_9v_YkeQgXJ-SgjId0%BUi zil(52>fT^s^_m8?_hAzm(jnz)s*~5~3F*-hd*}QS_JQ3^FQ%?@tADli=_pSD+>(RKdeH@i8;;{(?4-b!< z;?S<)0x{93;ny}xzDjai9*V|1!JI3`yEfdh9&&-MRxgEu>A4Wi(|Ixo^P=0`++D23VqUUs`QEJVmOgU&kEG3z z%n_*6*_#&s#rYub%j&m%N>4KOPkIun-5x_RYe{?NtW4~(Zr@ig zh|#}09lR^2k6L5Z|U`UQl80P$BEXu(4lklja(sI_%P#iw~VEhntuEK-L zlk6h0gXi%b2#psLm*_3Tsuh|VmF!%Yx%QeqrU+t%*jfC|+rA5w)?gvAkPhd}gIEI@ zyuZ`p5z5V&TG&$ZLj8017+rZDo}AsIX1VG{GRpE>-k9ZC#xgzhaj^m?G)69Q>Fnb@ za$npi zQ^t5ab_n~o@nM`l#zxf%ikkasnevmLfz8wT!YTkAy6ODS$|ys=3QwdT;55WbHjOv! zWyo}|_F947Azis?oINEso#20sn@hySg|n}4j1kSL2}9KvWSJ(0T2I*9HZTN*fb*nH?pjajOX`vFgrL!NI$Rf zT=QA6gk#Oh!Ai#uFFxnH(x-$3i7yeQWgP^!UD0bOBZWPSBnrEYTppKBney}>+KS%N zRq+k#9iY1Boq;e^@R-fs%6)dj*xqoj(8!%+`5j&(8zjaAPX72k(^9n)HetB)nWHGq z>pV7D<7AJrE$ueBz&{TR@4b-op)y z#3m;Oigw0g+f1+Nd`VfiKBybP&y8PAsWVuGC&U=)VQbCq2PtK0?M1-1>P9& z&Yr;JpM*R_69}icN}PCSyf2rr-WhQ7LlRuQ^e`WlNl`#Xy#m8NoGnSlCw#*el`!%p z)k1)qkc%R>qJABHxN1`>dCyRZV@j?qsCJB6N{<4ol7Fx90>u;@A!s_PmPk3_%QW-7 z*Y)p)l#h31o!OY}lc7?`#94CDqa|JLetfnJE$Mf{mrr=mU&Fh?#Z|#} zw2dvk1dXceksoHbgdWw_Qj>_j~JoT7OEo$4I=U{apP>B#I-vT6tIhT9m{ zF@=en)(r==6DYlV%Nnu^o1mOqnhiiGWG%JUG}b4+;R5PL7fayN3l^!BWt zCu-I@bmC1!faiU-6x*4t3k=bEk_u@ny{h9BCe7}TNNYq3th!u9qv*EdPB#w+ssuDI zZCkkUDT7&STvLA`e=6#)wMXbsoBY8-BD%x)ShT_x0U{KfxKGD>9_?!+L^&KR8gnQm zE-yBaP#@Foh1_x>>h(`QWFJS;`w6cd9uUtUrb)VPMgmNK^sIr0yG!qT4-yf3?cC!2 zBYl&U1OXl%r;D@kPmc|S{}psgXwGbJ9tMQrj)+VgXDq2pAqCS zFoSvHOpllP?r5eK*LrRq3ogFu_C40(mDAohi&dHawg`sIACblFisnf~?uMw1D4;}! z8pS<8JWHjJ6|g^tM#)%5b)g8cFc7Wi^@F|maqUH&k6K8hQH5?zR<*|t`PF_)hf@2} z%Sr1p`#ZM3>|Uoq&3ao^z^!>bj%_14BQ!`T7kUN3b7+R(wpvZB)MIVlL|)Eg7)}!m zdzrTJnYXHz2gDAQuEsf~>aJfoB^yGf>h$$Iw>^8mls*GEVs(0YgPrqW^7ExJxMXn4 zdM6${bL>mzGwwK-p=f8#-*cTa#a)(DVT~?bPE{XaD3HZ}v`%UG4egCF@4)GlTx=mv%H> zuU2Wv;S1%CX}e##B!qMd)<-bM= zswbQLxzIA(dmNI!lyd#W@8Y`|X*nQ{@@?@l=6qmZW~fyKBcDY+aQD+FEqNG@Io;L9 z%joCEM}hu{cr{<~P9&?BZ>#oCAnLP>Or$JYw{~tg=oRM%N5L5D0hr3v+nFI?!k{Z$2()53r>8SB3A3}4e(bqSXPX_s`fAaNAA&dLDg4DQ8*p>{3~|Q8 z0fzzlfW`oMpnp4bHsvR=MKJuhLdt2-gDs6Y&1_AQ+xg4}wNbv{phNWFji0iMLTj%s z9gSM*=jKd?+BB|;j3~3D>|o$6YFpYw%Lv2SrxPRZN8V|@@C@}Ay>0n1p?raYUJ%$L zaurPuC_N+!Lelc>erxV?T;+AbJfUZ&2Y~O)WhQzh1Y0c{W&D$LiikWW{CMdooV0Zp zeKJU6r^?wb`ip0YRioRH)}0O){LdrGB-fs=IDo9m=~qauV0Q`pHLGK%SGk}^~(E^g%-zn?=0VbDIlSnDXuXH)RHTkIi% z7?Vm~38fi)aIhwJJn4rQ$_$HVIbvf1mGL^^Zm6@-*wr3uue12$WxN zaz1p*GAYOQMCGUL;J2gBrI`w)Un&SE6+|DX+QN&p-fs8I)UMrdYJ%J#bp8hDn4F^| zK1p}qI@Scf5tQbj!1bIAb_<&TK7;BL$g5Typnj(5Q zU>i;gmjMgwG8mMdRQ`YEY<2^7uCm*NqD60Sq>}4k7$y{Fa9ZFYhfDU*GM1}(wOFL5 zNrfIfCMq`hNaXhCn^-N5 z0Q7F=ClI`w*2`}11aDc8HMWsD6R2@ux&d==8?J8nrLGAA?m{Q1*xLX$9JB+ER{qoV z(L6-eqKd&Us%^Ek_;lkVBw{;m?8SSwm7Kv~f55Y{`aBaGQ)7PcYW{X1ZZ-vabH zKvPpCNI7T_QRf+RBXS)Evj4L>=tH_ID4%Tk)5dbw;b<&vTc-~`68d*EGjfQ=&8ZA9 zngDU`N`a%ez?1@r%+Ju4+*7@+w|zG-!s|FT-gf^)*iL|%x#?ROK~ppty2P zFZ8uTXi>18M$yDMI$^n*TE+~~{@3>#CyGVf?v~MiAJJ&Zi;Tibug7T|_VMGR1_9r7 z#&4vS^5gpa`}_d?hxX;f#+O)k#)o5MR+etOWuBbYzYqVrb(vL#7OF+*XYpAmS|u%5 zI8xIwv{!b_aJZKZGuf^nvMulhsI&AZ1iO(nSq}PND+qVnS1+k?ecyQ*326iY zCSHK0WHeC78>vD}?($#$Oj;2`JoqRD+i6nyXW2ly@ro?=aMm}s;X$_HOmF>e?Vt9> z926&nlpq@QrgbCrNPF~+te$oSSZ1eumx1zxK4a3pp%`OVTF_=k6_`-n&`PCI;A}%K z>#f$TXduXW6URdh>5t%S<(VsL|5~PTokHYh4J=Q&1i)DyK;J`H9`|km8GcQ2RAgBi zSAGI3;I3HVF}JF88p}54Xd{~M@{Q;`b`c(H>8GsYuBFr9z=SrV)xOMI;o-y)pOo$m z2k0(@@_EI`!hwE+=L|U(sv$+wuNY&mTD*KNTW1IjRQErh4V%QSzlANkt=r;@(J|5D zqaFrRW9XY80HeI@v;$8nvQYP3D#HKyWqJ-R0(_JD)bu1NUWO&t7`-Cdowk4ei{|`< zAKHVEUmC+c36MJpW-z#mt!G=AGop8MmR7F0(E!hyd*T~N}0uoRs_=SK9)5#(JFwmK=FTs(ozn+PSu;x>opyr~~w~{XI|K zy U(HvHvq+4en&$h}wn{Ahk$kt=SgY*CUxs@)Xya~&5*fd708$2+XZus)wqXAku zpRY!;nGF9(w$^|L`yR=yt@<7U8zTPtSt|SG%ZBKQs?}#wpx%-W?HX;Q)X%mFU*7dldVdYo37fzn#$ILE5kpDp2txrWdvFGakL%;3{*!5f@4#6M9L?)J=kql9 z)WQRlBK>4=ML23V-RJ?MKeUA5Hm1D2#M+TCX+KlE_965LJ9c2@f47c@M`(}C{Wji4 z!F^*%7=ApE3~0}=g!j2{n&VCU$f#XI)3tpLEVDANwP!BEP~zb#0zt2jrb(b`pe*+; z0_X$wOGjZfOaj$7#{qcfToqX&vRII&ViVe&wY5M6nA-rsxft~9!iOBO?dbs z=43{Sy@2X;SeF5`v6c0gvZJ%{czOHjf{sF|v)QS;4*hGf#=_rhJTwKiC?qRkwGq4H z*>|vj0b=bwUXi58J%ANlYDBu8b9n?Z2f!`2iUjcMSeL=B2_=S={lQ|*a|TbOPG}@f z$j~*Z%wN5wjEw$L&Hcq9cA*97*7(PUW$eJEL0Iemei(ZrCE@g(HsHLnvOa@aUv|Y2 zSn&_3`S8!xMa0FeQ16=i=?Htz2*w|E{zS$cSXB3_J19RXg*a5& zQwEIv4@7g)16J-5mrrV>OdJA8y|P^GH#0Fl^PkNV+H>_>`mJa&%ee47Fn{s(hokcY zS%R#WM@$0OSMKMdu22f82pZQ77p0_91gPn+22^q~I>gTFCBmh-41MgMgI4L;xkfI1 zA&hnQ%p#JlYX10d0>VDO=#Z`TkNuSa?%suJ)MeVxG~wmBny0Uxp^h@jW&;6<|MwGW z&aeGk>_$xZDUor@E1*>AJOO+Hv6UBDbLKpp=c8B%0uEUnG2x&w+>>)6jiR&7bj0hM~+d*E5~W8#l((TO~gX7Vg3ZEN=@}0Ow0e*$KdpBol{t) zf=x~4Cl1$BM&a-t!)nD9-@!lBV>VLLfAuDC(H{aEz>?iaMb^ca5}owJZo;e zRxH~``kT^zcX#Bq zO@5cLoBa&3rce!MYTI9)T3eY99PdCF3hn zh_&Be9M;Xro4Mi_hWYnWS(nXu_7X3g*pb^P*!#`bI-!D&< z{wn$R3e|aHE}YQhix#`FF=IUry&HUN<)p1}7w?4-0VY6k*kvuk3eYe?l+|GHTntIi z0pf!4eD2wEc5yawoH=0#J2ompTIL4o;_P~oX+P8}eRbW*G&MYqVkW`F&bUU6Gkr!# zNhlu;sjIIH@=TB!?IlqVRYIjHeO*#ZGj@zzXS17$nyXjxJEDhB73vt#n`KZ1B$CH&=)9dTo%oon;dO^i70q$B^#iSBvae%=8SZFukOVY9<}` zV*CU?!LSguCzSoG;@{rYt1Wx$6`l&E{H2hzgZGV~3fu@js+Tq*B3%%)ZG-ja_q>0w zjvBmx<;Q7+vhy(&fac#+&lp!~ay_y1Jg)EO69}_2)P>Q^`>?};jT%;cN0F1b#6AP) zvZh`;m_%41v*|N|+5YIh?x`SBJ(-Mtx)zAE!pA$P=JuN`M6Mm8^Apw?GD%+y*}ZGO z0zzI8v(HP%zW8)PBLTwn3d4|JD*xVYNCV{V-06`n*!foQK#L%^hlUL4woV6@#+ z1UH+^oPJ~J05H{=^G)=c(8n$-*w54Uh+I$lKB2vnE1jIJCIeN2|AFHd=C^Urb!@if zrmI76-R{s?a9$hnfV1cEXF5M}y{93I>wiSfOHG0+)&^?GG*AZYz5rYui0y(=k!+YYwHem;h>P8UwBw@EM!=gpW7#Tb?uhSX;LXVofVV&(_p zzj%o3wLDS2XSX4)L1 zY19tXNUSD}wN`AcN<~b_1*N;t7Rh;}#KJ17;>1js0W#M;%AK5R$+^Nv-Csq%S;s&P z*PsOH;>%Z;;|Nx`=>)V!pXa|XGt0q0Nj-z>8%)J;^)Ar5fGI4wsQ38+H*(<$zuxV6v4NLW+vpWKXswC@uNYSW?Y- zjwj=mC=UJm3~iN6jMpW|&d*IsmG+yF1x;N4vyxPBE%_tr1^2c%bM-h#U7t5bL}d5F zMZ~#eLU2B2jV8i$m!AG6Ro1+xcMz@h2;%leMFpLB#L(ux zbN}AU9pB9b72kgaEvrSQ2QJ*>ywA{I0T=F1Jb_!7xN7~*&iFVq%}7lrR;6$M$n}gZ zxNZbjn$Q$tHqFD7JD&kFq_u6$yU+n>@fH^U`en9*q-YDVTJxg>=8?36a}?Vwt*tyc zd)ZH+5I@wGW8!mWDVb=^OHK90#;_3(^rPwbf9?-7{V}wVA|yF!NQ&1XthbkENx^Kc zs;qw-49_N^mJ7MuWp95c^B&Tg;LB@le)b6<2>aQ<1YsxO83_yq*$rsEVplR625dL+}O%8@y{iVv z38C{+QzmGg8pqt#{&UP5RCP|kF*gV*SQ^70T={UEBE*EFwwv4jk?Zz7L2Te^B;e|O ztLdPT|4cK3j4b!2LYxhf9TUTbOzl_hnO_F?h95Ulm54Rr#{MF_uf7~-Qc1j2LzY`n zNH!baeovO!mb9A78_z9?KyfxDC4kjLXw_qUG+vn zOcY;kJ>{?o2T4-g3R3B69Jp&3B5*=C^yMzH53_e5Jlgg%oS(tkAgjG!k#&lPCEuvC z)5DcfhD+==ILU!_jaF)dE5qnT@yOxIfSMgA4*BBU>34ScBy(XG9V+0bI^z7lVmzE$ z=Y~Bm?4{sd?`?5318LZY$Q5&Hvcf{2sBtgcNSBr2XicO&KI4^`IcsKN`+3GKTt}DU7KYu6cV-#7xWvwa%}6G?FFfMgMiM)Nnmuuu-chph zjO5_wGc3jbzjqb3Alm#{@i75Wg}9GOInuis&H&)Q_WY5~fQ^Bu!OsW7{zudPL(g2T z01!wE+B%1?F{BxPB>%g|jVsTC_zIzCX9cUeJ4g}^2aUVdwQ9~0SwC4fJmHpu{{0#= zeM4TU-ERR}Z$EStuPFbQ_QHA1MZ_(6K<;Uj>2}aoHl;E)vOwH~NF)^(Nh;V!ngmWh zY>*m$sO1vq1LI@Z-PsCUj=S)#Gw8{j6*G%{lv;LWD~&BJ?}vBq480(Z=v%U5^ivGB z+;}ZJHgWkw=sC_A###L4?vCuTqyOFzp3aV#XJ@@dJw2&+3nBKPnw|QkB1e5fh*N`D~wLa$x zaO0p2q7VtP{C~7|ORhYo@R;_L_8=ruuO0Ga-jx#1>R(^x$DIwpyIzUJAmAxOE|*E= zW6haopqo3pGt?wQ1IPGXy|Ni0t%{qjeN&oQvC7B*rJdS0zE&8L7v{D);HUaE_&>K> zUGQB*{Z$e9mOms0AozNK4dKCsVz|+}K191hWzU%MuB8L8Xk;%arCj^#wEBNO;YILZ z^{CB%{A;)ec>N~Go-9hQ$D^6HkQDFI$$=%_XNytyv*dEnwWJ@^f=MZowRpezk8l?~ zqm_!fz`8M1MGV`I${BYn%0Ay0cO(8khaSG$^!6Q;X=S9%X zPNO9Lp({vgaTK_~z}4{n5f!gKfvR%a5Eg%|Gfn^K(s09XcZaS_2Qy9|zbhS|W)OKX(=tLHUu;(lE=5Z%KN@k%nXDnr zq~9TpGy83RcykW2PmxIE6&iUCopb#uakB!oaC{&U8>+O%{?CQEu<`BdihpvCn!@8? z?&-Q9bPf$qEPN5`46TH4{Sr|63{biVR-@RKxBUN=0i@;7YGLq_<)5hj|Fm?J^YA=b@E%GLUFexF+-{R|Dr%eFJBOIQ#bnV^#~sv9*?!FeW%se0T4+x#zA^yo3QxZ ztKb*$1F%-oxmW?$831D&F3?Y07kW14FseOKw>r4eJ4QBJx5;JWcyD|DmgR(BAxdT5 zOM%6ciDAsq8GrR{Lou}i$Ob&4cY}~mTBn9np9|6*Z$Mv|xIlKXz%ZZt(t#-3`rQ4%nTsJd%CS*4Vd^?H>lc?7%}BZVv83{f!r+DL|)17ZD$NnUi@v{mUji_if^HFN_-_NIKzD+vj`Q z-l55LY<2UUtIi%j%Y`-B7Fd>R39=IX(S?^N3RvusnsnC;WMJsSPmO_qrAkf6zyK6?Yi&QSuC|2&0NaI69zWSubjey>s%rpZG z6zbp$9r8897(hii42O<+K{tKe#Ou={KBs3S%}pF?X!dheDANEg?wZZ+Hk&__Cl)>8<$r zpmL-3kOleYiOJU2V;6J((ow2yNj9GXo+$;MN6p8-K*uOBdcWGmp%qZMV@D~$N-YC8 zlA4&l6Hv){{1c^?0#wsgbDToJXL+7UPcy}a)(HeUp*d%FF^VOEb=@9xhU!Z}{i@@| zB-X14-27P7a)2Nrji}u3Yl_heR7cYX4Gzg0Cb7y<+hU5!#z$Z>UsHb0tHt(+|Fyti z>dObxOPMY?o{T+H%}1FfJSq!10l16%C~1hp%R2x<@qmCzY16n_`7e??8U%eXR=Bv! z$RNJ`ZLREbuNl6&+aqN_DaLmXTpNe~DOb4>sIXeSq>=W97yBYw0LsTS=&sg?Vh6fhzxgeM$_-6u@wB55PVdpYtd>h@NzhO)lzPi4u$> z7jguG&+WcqP;Qs3u>)KZ!wl@=k*7TcIH9_eP=Zg2sioD?(E3T2j>_n>&`?0VEZ;n% z*f_K)YaG<`mo%xyPt)AF$$GrwxZb@}6nK7|5=ws4Q2?$}0yC73CO|kHK*6QuJzzV^ zYoH&2hBB)Oh5(g@fx*F}U*nDa1lfQ*T~m6LV7|!t-QE1cXDFpjpYA!^cY#leQN7S^ z$@=O&LwNTHEPElLsROMx=U<*%_-wr1#}(UXOt6Aru#Z*({?6$vZwY%^$WkhxfTd#t z=Uv%%Y#h|mKyVft+vK41D=eUZt=}-D9*?4Q>&#UFtNFNzia6RESK*yspV`BSujq!R zlqp^IHLSy$_nMj7`v%P=D-9P1+81xbU=W46%Dp|()2+zuFX-+T*xCgM=B(RsV@s>H zXGmEza<{9Pw5xrEghWiuk4#_@ZGTJAO^D`hj-n5@keU@U;KwRCyStA1kTK?8e{}&g zz*MEHu{n;k^95xpu``y;;P}TaXedyxOK6-lW(oxz(>+TEd>qw`T<|Y{x~}njR~fD< zAegErbgQPgCK?tuRCf!dC?r%>Eaz6I;^)VDum*@zYH30BY?i}-gwH>W{>2|SU_OZu zt=y13e5wSdj-OZNJ6Qi0{RrNTC)8w~!=@G)oEDjWi*?=)G;mLUJ`ScZfc0RfC`Ff7 zVjQsxATl<2i&sV>WnyQ!vi}C+2_lLT-BG2SEL|(d_IyGSdO<)Gn*GUF{Lh&)_PWP!(CZ)HfYREj*>za zQ>t=HAZe-{uEmlfY?w@xJ4IqVHngaK(lT2WVZk z>21+X9|*>TUlzR~1~=s9`b(kH4RqR(xlPt=hYopbR4P+aC3C@Rzng51@1z%EzK9!R z?t+ax9cQ6vGbO195C;r!On2dU0jWTdx9NL0?aE;)Knf~2Zc z=_7UaD^jq!nGeoHdrx0z zudjw_nG*_JeI-rIRGt8o15O8H5-2coC}W`n`5A4opxoK^ckPI({L#U2$CEW2KQz9B zNY5ej(~z=O(6S(}xv9VO68H*A9q24&-tZ&%1tS_95kc{~atvCF90@AgZGp+DkAGT!K2Ez-rUsLW|*FIV)f71p-n?hE? z`noST<&*A(wpcA4gkTzaP-sJ!RTMHOk-KQ2xK5PcRO#b(=Q7)0;=j?(HdWkzaPG6U z2AD}@3Xx};qm(n=MLPn5UYV{-Z5j;!o~O9J&T9YK`rPMYU-BVeOO}wJu?Jk$`bv({ zmPo-F7b}y~1HuDRK#^k>WH`QXT@8ik9ngo7%va%knf_P(0=6$LhoFN%HoaEbkeA%{ zUcx~6tC?Pb_eP|B$Rm|iXYr{U5x)f_p@wz1AsAMGjV8#i3yll9eN#r2V!$mT>KKj9 zn=k|<>F}ED!bqNUDKbjwjt^-tmjS@KuAxoc|D;}NM>LU%zzH=Z7d@tgO27z&d2^gL zy$H!@2AK_JLji2J_m&&r`JwjoKGmSr>mvw8pq*8YQu_z}P1;M?G3%$S3<;pCDF&RH zQY!AjIc+rY_zPl9pL(9RHa@JInxCN5%27IazR0*rYg*}afbwmB;C|%P%6>AhZGxe> zw96Pq=+R^S0Ht`_W(1^s8U^;_D7fRgxq}S41nrb#w8SU^G|C?-h`exN);clo`+UGc zC-#3gXo3SQ*9)sHWxH_b{e`)dPQo%>}0q_5HFs&+@&vs<|a8Bu%A~J4gOtnCW8)Ut6&=NSxt7 zB8LqBGI&Sh#M)g5{-#H`3eGyiHKZGnvYZ%OOt8Yf>V_CZ4e7Y1AV8yfkD77vBAC&? zRT<6V#@V}O56uH5S@~;8tUiGQURkbb$j966J}HCpW#_a8{+4?$gN|{LTvL?{sIT|C zIce;RTDmf%a4v_*K9lvAaQso^&CUZbR)zcZTPARX2i$E3&Jz}ss%gY%bvR1WBe z^3MRj$iFD#>@}B`W}q-S@^j??)`FWQ0J_TSS%w!3O0>&pLOnbcRqI6PcH zzt3GmyQA0YO=y)2gEwfzryBuj!hT5*KrQKHnqUAEN+JNOS{(^OE`Gnjb5s>XWI${N z?{}jwviG*s8Ji~gE=_CPHDW`gcH5^^ZU^`n&Z`V6=1mr86^WyjoP4AP)f^D3y5No# zd>N45Y52s@`gaFpkQ5Z+lhT(#92BooQr`garKJABlS1bvrJnUFUzXmU^o7u%RO^Efb#I=gs0AxHMs+>#ui6t8 zRZaMD3+9vUoWo6^oddL=1E9?j?~3^cQJYiVzwp%^bXBUfKIFiUzC40=rCb&|r((JS z#lPt0Ge{hMn32A{IX>dF;40vI_`W=&O&ZJ!l14g;42s^YLR-wDGt!JQ5TqjX1f^Z! zMI9|P&wuqlAW^E>3v4&Uqk?U|nu2opFTm8ik^=4dAc1OOoJCH7QWK!M4)}mLS{+c% zm(h2zo-^U1g74BCe1MokxPp)EPUu0~d;9J#JP=qMR)g3RDf<2@z;|h0W!Pz0agPmx zN3c%KgY}qTjzJv~AA2TD2mB2)sqQi>PIF$OG6b0i=+2Pl5*oh)7F2x?3@~K(_!;&N ziSNoQnmuZv)Z)Oc+OsbHVAy7f81ZLFtS zX#?WTp;A9l9GE(>QGyI&r0 zC%Hv!SSS-cZ2P>Ql-TP{3*dPJV+tW(VK5NiA7iglI?O@#;jIA+*yIL^WrVH}6wZWy z89M(qG`m!}Suu}r6$pzjV5o|xMmsLF46-);K% zi7)Fy@-VU3_(OLf=^9#U7C#`bt?tVDU1|viCLsU!(_8YHx=LCLUCP-Hu3Vvkf%(=; zdK8DyZ+_Q^TF0O-5|Cg0Lt$Nqt0*IIpk5X94X7Lh)bw}FZ4Ee}pP-%KlmRkVRE6oo z7&a-F^38#^y7N0uFdKz#<`mI!A&_M#>}MH8NC*2iboAm)WVAhhNyOL)ewJm~6XpZ* zQTRYrp7XHMIp1h8jj=Ofg=y!sP{eAczg-&@D3(hnL}@_77^|7^Qr$pwl%8PFLjcI( z@4I0;XCWC4fbK2nI!8;1cVgL;4q^75`@YxkvCiVn#4Lgi{&6=g|7PN`Vw`o`hmaYi zOTH4rdrN*h`2p#L-g-yhCHQiLW2*8%@iC{{1Z2(#U$up?;hrpSd-WtFpgG?l@@90`)<1tnDjVFCnoNzqxg#bK?Oix1$#L&rvCf~`+> z#~g1pU$NEn=C4jvE4)(9^l2WogS6RE4j8FNXMv0in0NFnypNdmzPekIZc4rpf=}^Kuj-oiblN zdty1-*9j0Fpr{Tz3_BUg+ZK2wnVFKOEW8;$UzA=L-PeO=`h@&G&#gRKObS$;iCFSo zBKJ%nG_H8%I*)jU)Xc?uD2Bb*%$;E|JQx;sgyx}$NU|rpOnX3>$blx)3CBAR^-au= znd?rezC_E)`{Urh~ zv%H0?MsJrSTHX>_@#=b%_e880acssr?lDA-i#Ue!j+*g^udQ^|TgK60UEiPS#>Z}S+FYKtAXF^MG zoURT*ip(k%r+2=T(vJ(zb}a(GaxdcWA(w@Vn1uZNahXL8Vx}24wNe6CBRu?qmrTop z+m&v0;Q7^Kdd_mzJ{+1^mdoDM3s=8elXp`ORq4E<*o{|Vp5G-jsPjpb5_(w3$3Luf ztK07qTGayz!U}^7|8IGNeUu7@f6cq4hqzV)+V;d}SD$A9sq0=c@8vH(Z=r3ii8C|&u%mO@k&Z$XjEu1h-#?!H>p9&(ZSy~L+gVl)15 z+Bpdia&7q9_OlhN+_3A)!-plUi@fj?_Jxh?N@>e4!(5BPT;n{4(v1H5^5hCu!1AK6 zsoY1J_paZk8&3jyc9X+r97rxisswx>(IHaI=nodXkJFQCUpuc5omA~vcoKS)%7BHT$aMc0=TLv#v5 z*ljsIt>hAx3K2Z`fBu*@Hsk5l;5flD*9QiGUrI5*G!&oZ4Uvj?CNW!@{pM*pINE^1 zOETb3-oB*#rdr1#>x(n8S1N!c)103%yuZiLH39G}9Uy!a6U^WrZlM z8=B)fw?4Ltkl&Wys+l50*(der1_`Jc5mkxDe-OUKdRiGi35)nIs}p?4Ykth^^94#p$3aHkqw*&PALxb7T+{9iyr#|Jlhz+=(F-l2)>Kg5g0OHFM|ns0$f}h* zkpB@Ow`Du!9oj?3Sw^%(WDC{C^VMN)yiIuQ0VLN*TrU}(+~h?zE_dS3dC=;kYEp02~oeatYY1)%0zOML7QJqoSj#$5o=wvgCsg{htn-B2uGFre_u+S1``&whH32rQjGvn9;!76{L4kPLpDzG`Z%z zzGW0M?Po$8xqdB9AAR?Wi)lVnRB1UOK%*TPcc}~Md!*8;5&ejYE6Jc zOMn>qvil5y*Q{a)Pt1hfD5twnfHp2nfV`S;gP6g81)l z@-oY9eSq6qeRn*Y1i{P@ZldVZ#NiVw51aAF(j4G*zld#k;k1M!UjKD%pC6dLFlmWO z@4Sx`n;j`mO}Yve)H@Sr{)%nizxD)b;#i_+qTG1v`-9W@_$G{MO03=oYJ_ft0f_XzO_+W?&Vu{c5z)a%&is=OgUhu+eh+hd+4fw}GQ>#Q;#{a50v6=$r z!E(kew&vaDke(0&kGm2W;}%mv0z&?(yxPDPmX|u}3U5JJr|^0lFZ>Yk&FU{lo}^Q@YFt}2 z(jvBM2*K~de|-9_Gz2+;jNTQ1!S(BzH=gb;R3cJ1c5|~o9Su6Pak@ny5hmJ&{kTX7 zQ+HQSJl6lqkbVwzs#AS&S89Q{o;w`5n$}S*(}W#dYCqH8qmxVAL27^89UrE3*4$PW z9oHM3;ixa3Kk-_Rtor#vc3PR4V2Z5aZa!(V#Wl#ZbclAE+|w@7U!}kuySI~es6Qb4 zC060*HNJjq#5=8R4=b@3djjI-dUyjVArh&H*X@{1ZoA1&+HA(cPJEx@`W>5I z<`C`4+t>uM1LC%tAW8jBrXJZ|>?R3eF5XYBysAeQaMj%=TZ_+=d;A}lBkr@!ZJ{;i zYjK+MC8o~?ALj7RC2#W1IbHI%t3`lF3DAL+OEC1R;xY~B%w%vATtJ-!9OYK_W_TrlMxZif2A77yT zfNp*MQnm-J&D@*%lxT~OeN)dZlq@H%?dT`n^|(U2c(x!5`nY1y-q@g)k9M%E(P(@@ z{GGR(q8kbQdc=bBI)N+comb1H0-L(j0`W?a9%aBhHTqPhJrieb(v{DuD_Tw~iqM_5nQ zT}n7`muj3@bZ|3 zNiCJlmzo!i`X8-*(+E15n)XXD*~w1G?Hm=md$<1F!?&3W^Z2>Sy~Q&$zg<-6#Tv`Y zc;B+jAG9XqWoH68jrPG;LR$o?_*-y!nprkJcu;VWtohVu?=WXG?xjn4;P9PJQ`+)y z=f2dVQ&(JA2eJtV(n8^ARTsFWkMkgCSdJ$tX)b6araq>jYDx2xM zYgxCOPnxN~nK+z}u_E4FIE;9D0lIp`4Ru?lxPDsGI`6}emsiSNzUpk>|9ZgM>lbP5 zvo3Bnl)0_9nrq^+hn?r)+MvDhwRs|}FDftDJ;xJk3feay8j3qGA?_KrWVA-^sEl5(_ff*Mi)m)lwHpzi5@7vI@{z?FMj zWp!O_tI-OGxh72d60)nKqCPI1Y-4xQO_s{yyQ+E)hWlE2=;b2^J~z$EEDiPaJsM3g z-jQAu;Kr-HG?yd)GfPuZQ_`JFz=sb7-6eMsJSTKWkX#Qt!vI(SLVh zI;pBQ)SecwBDlvdEVQdCBvkw4(6TbuikjaepL;JgC+@_aZT9Ye?y1JBSK=HVQ$-6m zyeOEW?f#;YK_p^*Od4UY=J%sb#Aw<4objgbxy*w)`w-~!D%eUz&%mQmt^hRwX%fPD zi)=81$Xg-Dgfo)s3kK@tzx2@g=`11`XWr=PmAIaUkNup)%>?_vahemSW6yk7WM`hL zc@aC&^LCbSisu?WN^)dJMtvZtq>npSGixvTEbU+lL3${)ID=&E-L0)O#M|h7+Eg&o zK5IUi;obGD@5xupf-cCuxGI0OJ1F?M{PXTqjmNx6J?OLxsq(4AY4Xv-sq*o4YTk#6 zRlMbjFB0swrz5N9LS>h-VL|@Nk~?#5Yx71yhUduBoJtP$@nqvHL>gOHVrtPw}f$*~BJQ}w&t`q`QT&nDgjtU1;U!>m`IhXFC=y#XKt4#B! zRDQ6z97;PHHA1{8n5HZ<|1jaoblQh4HZtpb?X3U}Eq{T4t+M7|^%DK;z&MFjzfd2+ z)F&2U-p0EAP+52+|D<;V^<45ZhKEVPkgqA{ezdiy<^E{Pi&yhm0rBP=PrO&PN0Jf4 zvj5{C(q!9U(1e2-tbCS90R<{(#`d2p_3aA!{QRncceLO~iPn zY&Y7sno0>ZI{rq=;J8_*YB~<|3;IoYha=a!&b z%oDxQSI*aVhD*smH=b>ChpIw)GM3xwLxqp*OR)Py1t zU;cAC$$9RILjU(y$UGce`N> zVAs*HAKN6qV;{S-?M3Sgj5rw`xJhoA_TgJ2Ib9lQdnde2svx~&dD_;=-;ck>ITz@Y z?Pf&RAE1wa%Q3fWe#A*vtf|hJt+G=)d-KbkY=;}$bpyW+WvNXtDLpu#87mPjhTFTi z?!Aq1x^R7A?yyOP$G?hnlZk5?0S?$Wxe%#? zTbB+`Lh^Yh)d~jl51KAjCv-Huc6q(ElyNIc7&~s3{^2u>t9Wz#iv5mzUR>SitSq)? zP8(~m7QIaG{|TmA`@K3obuCKn$~$5cV_k+^KTIi#0M#SFA^kfeLBy{xS;@_Dt+XBY zp-qgKTYYh#CB9l48?*4K9%NU6ojY$f6_#OY^zdt2TPq)AqWJ~%7rf%TDZR*oroSEK zs-@!?S+PE3Z)JtaMaeO9gNu0gA0|=ov~sv=F*$%;S8yM_v`;d2qDGe=IBT?$(#}2p zLEH5Pe5+tdO|Ap*&ABZO%Wf90bLR6hv$bZ(h>T6+cgyZ#tK+&!fv|a*ITx(kTGcXs z?b-4j{~j2vBmsI^KM>P<5leUaihKg`?ecB(5R6rIi7z8?!*$L8yT10Zb*GNc_X^R} z4O_G_u4TXNKD2=;MnA2#aL~4FmUmVbiy5&X=7a0p!BX#ej#n1_GsTmIAMENPx z?1BUPTjV+L;`SKg;eCEm%VLQs>DkfDyd7 zJD@b7{FvywJPJB@hip0TKg_YUJCy)wpBeI6?uE3Gn!x1CI%X5D&@Y2sM@I&vEMI%| zK2d+S85XifJiQa%CyX^;LoX|lyz6rs3uy^KTY@#hOL=uRcOQR5SZurJnAeT^uqABr zMWB*=-@QF$YsaW?U>V!%f?{J!VEl~wfjhIP)vb|i?MdcPo=scqmD7)WrM*Ku&P1)H7&-)U^-5qJ!H%r` zwL{fi^%`pJ$UgROP^FxB3rXY^SSV zJ+H8Th=_MK3xj-ee1PEFu~R+K??oYlOX>Fg?k^|3-1i+QGO``@1o_rz(MctfG}8^S zZb!_8{?sP5o!p~lq-P!`Sm^qzP<;bHr$DcVT5wzspUdA*&_+oA1# zYd2fZH_k_h`bFtK_IU)xwzFe~6Tz{5VF;h@fm4y~sJ}&fMO(i(!CcBbhdLh~+u4*a zf(!ay4fGrOv-)}XcKDmH;l@^Co$0I}wo2}kLWtcj=uuA3k}QQl%)sarhbLCxh^I%t zx;isT+=qIT)B4@wEAu*=byC@d8s4ST*p!=$n^Mpw$@5oGo3o|fcjd?KGA6u;=Axn> zCbY25RZ;2b;f;j#N?7R68Mes}HujV+PLf&qRYC-xa(_5jb~8U=cT|8pBP+^NN%-k( zw#etOefXbQk>K6%b0hcE9NBOGp&vYiyJ(7@@*`w+N7cy-PKGk>ctwhRYKX0f=gYWf zEK7|{R%_e;ii03#l&0rWsHn(mS9CPZhHh9HJKkKsg4KKVRf&7++42GO1dLO4y7~?0 zHuC!P=?@iz%eJFFT!S{sw8?{>j59`JE&N$++W#Xylz*Q1zWK3F%hxcA4?5+Mo zyT{tEa1eKwbqXVQ@Kuhnf3ov2-T6HSA-~ ztO)wfNztwF{+zlriceV!S(foP7&p!bU?onLMuq)gtu^DskM!v_vlx5||ODiBsZe8lVj+O72uM{H2 zLpCZpDr>eEoks8uQ(t2}qJ})I>Y|E*#FkEZ-uCun-&!^cgm?lptzd&xL zTzM79HK2u!L!bGwDp?Y=6EB4gx2O-aAN7lWroJ(r-B~$5Un$N(^ozPw4iA7FB3=-l zMIT&(dG(l~IT4+@X#9N)YWJZ?z$;z`xm-yhx1D^HQA-t+V>MEp^p*%a#oT z9WCR{t!~V4I9lC@ey_H+e{8W+t-P2#tsE^yAceIOrP9CEbuw7g$xqwZku2gU0yifP zTaw}-yYd$G(2|3w-6|X#MN`X64DG z!{n_ht5%jcw-2{%kGcQZL##SCnKdl(H#PiSY5rb=l0fX81Mb;2AMi%6$$M>xJry<{ zE&@KwBJS-?^basK=x_2aI6 zx$$npFAXF|vac^@b0;UCA+K*DcD3TX$Zk@%DaO42-1!-yv42e9q~b4j(P#5K5}7I> zJhGIf`LF}~gdpu8c4=g!sHn09v`@(2wv9Kox;A5e%gSzM=r+&;o#ibgM)&LaI)Xt{ z5#}G=ISc~kEv)%-IG;5szVcJ7$HR4-i3@gB5Gas3LH>X(=W}hEC4OMWk1pxd)ka)B zMzmn}9B;3TEJpwd1vfqoWH?N*!Y~I&`4ze(lhP|KiPq66w}@rGD#9K`{?kPv$hn~_ z_>a@nAN&@qBw$Qu>u~8td!+><#{JUdXWNDbF&r;}x*Y|M)%wtj@{Tr{B~|q64)K;! zRELZ>Gg4sNy&sYh*aee>E+`L(^qlUzQiq#m!Wzv5VIRwl!id4}Y6%JK>dtCG&9ZWP z<*%Zk&edW_Ay%eejZ&MZSKi=P*443#@Q>L{CGrP`=4u*7{`BtQx1Z})?%t2zjV7Ix+ z=y6HQv{5~2G%hg9{=#Pz!rw*p--<)~mFp2F&*r;|KYRI%v2>zsg*Uum(<4xuH$*vI zi0xHr=tv79Z;BVoNcAuX;=oH&UC!S&+HF9yI?F-P z*~=?_SqI$*<1|=@YDEM>m{%9qGvS5Epw7`!F^Nee&k@h%_Z*&9Vt(S2G6fF`g%>Gv zpn{kW%adI)OX}jk&tg^R7pEI2bxD3japUeU9(pXx5vgv2i2AHfTE`ZJ{7Zov7ieMKiU5n!L&C}BRK(MC)$@!T{%2ioa3Enhl#<|o4c(gUIe51olj!F&&TqjBagf= zZX&0%SfYBBsa&F^uA~!%>65K9IsJJ!`c+_CA4gqU{{gJ-TITY7e@Wo-WuO3Nad~3b z$J6Vjm{9^m_e>*+)nfE^u?Ti`zE)y_(`wpg@6a=_S-l+!7;IPgsl4?xvh&ZTP7PB| zsz?}VUHAZXu@H9E6|wJx0QqqWZ?l_ z*ZmPfS*1lC?BWr{66n%hmpCu0{MrfFaBy${MZG@5E~w5|hjH#8hi66=e25$9_wWEx zFnlLt`SiA>b{z0mqjAr{2C$`+4}T%7Oo1m*wSB*%^L}|!2q%2-W!eW$H$!3M_*InO zDLyU-i9s2>4XS~T%Q}dE(gU%+04#%oJ1EaZa1JA#DDrz8-?2x)(;f_&*1y%o0FH7T zt^rN{BsSKnEbugu!IC&yzujdGAQb{1{)3kC4Fr9;?~6qg7DT!hMRu0{ypQeLzWPyO zcmlV>W3U0ec8-V~Y_ZXHo!;7yQGk>ZkrLX!PLlD#*-931Or zIF6^GSKoV5Zw);9{>c=Ue(88A&Rh~6*;zQaT2N8*TvETH1}({4B{8;IP`N8ke!IWg z$KyuFi1BHnpDTCK5?KEa+r?sISM}0(C<6Te>|Ihuijv!}iuh41!pcK6hjTyReI2A( zWM}^5#y!=bhuf^*nL&J|qWstUPw>$V-5WXpvX068a}us1YzZ%Z&`RJ6n0+lFpX52` zjJal4ZmCI2b4hQFA4XJB@5etbZEMF5agLC9`-i&Lb{X-IBF9JZkFDcftw0v(ZiRL{ zpMdCDl|+zaBjBCvCAA><5r<n;hc7%^mEC@*ZVT#TV+8WCz z{%tA_YUxt_H&YIChZJ)W9(6`y$v+b6M-KdvczNkh&?!(OBiUKnI*+O;kYxU7zZHaJ zu9Wz}D~?^oWDj{@p3vEX%3lBrb%HL|l155|f)E4=Ut#-b`E$wFIJf=+l>74wxT~;t zw{cog5i&pSKNdfL^!a4ZPtv9ScVI9Cf#IK+u+S_kV7#2@Br$liD7=$EjWc{W57$Ux z;TA525FUvKks|897ImOh1cE6We5V^{V-@0fHvSZ-{V~H~^M&6^W2;+XNm8Q)?;k8Y zh8I4sG+dQD8Mr^p^dROpNQm8iUU5(M`Gu@|Wt?t675po}4fsft_dGeg3AZ6<>t!I! zwzzQegXwB5is%0QB)>mLLos3?$CsE7-3&!CNFPj1noB-dWAsCb?*KArH&t{q4Dx8M z5*~R3Ssmnot+1*1(hRYt8LlhTYed1ihu&O{f;o?=+UL!s9*I&K!N~J2C6;863RLT+ zx)ldKca9g-?2Qq_cLqh`JMT#%-17WyS%cQu8Q)R3iClF{LzB?xra=t7Y(r|CZxQ81iZ4Imq@ho z7UFodq#`OLzLmc2Y;p_h?Wk;>ulxmo<93}`{{>3e6C?qh72@Hdq~1h!;L7aQyB(8! z&21OVmutk3UM+Tx{H`~DM54Zv|( z+QI)I2=c(RL2`u>Uzq;``MIAMVxS^8oGBem~w2y?mHovH~z4Dmaj5 zIcK_W`M99w9=g=b=#H!o29(#nkKeYbepm1Pq`NyM!1u$(h&yY)_u@hu}M z)tjbdWFT( z4YFjvUR_K}Fvg*D(b+bz#WJ(NZtd@Q8mi_?aW}1A%ZJ%=y0Dy0aI|T)T;~+WQsh(> z^^f^nt&u_c4^@kO=hdZne{%p~@40ySMLbTcp5h8P9H;r8qHt_Yw0W~Rp0*WAh&1;q zCQysAC2-A212+n?2Wnpc{%jj2xfr5fYqlB)G!C3LUMN?1hZ`CyUnCg}V*86DDxSoY z-VV5C|IKgtQ7_X+^s(yA;JW9y%sde{kx~wQ zRDWUR;^Mzd3ZK(#LBN%c#+tGDR#l{_uvbd&gQ zt$!iQtlAv+QF?c0lpm%2eRP~b%#3HVhtTow2uML#T7TeG3C^N5?guT`-LG8?59Dou zAem6V5wR>a$3wOE%Qxt5j}0CO< z6tcm8v8d!~XTO_XjlA>$+c*)OF=|H03omoV%9s|LvZvLxm1!S0*GwxrHu%dW50T&6 z>)WS50+x~8C+3UXvoKzUG6v6)#}aJcfsyO|eZA!&txT%%}s zsldM^Q5ac>d@dg61|(to5lAIwa5A$CEsQiNe@B;OjpS+hmclyb*ruSoX>RQ}h6sYQ z+#Zw2-5z8#Q@BMhKekFEKOqlsP?H}cvCB`$rtvNZK1-C_g5+wF6E^}EG2zvC6B3k= z|Es%d(6bFV#wo>uT2C=LBW`iv7=J(9|1)rW{fzP>P{(`q485O_H%d92FO2-4ciH6! zZNOo(0-2>Wd|V$Q=$7Q|F_F8dA6D~ks*};`XEULJ0kiENme;2DzM5kAq3)MX_4^L^~^-WxB6k%gi@@m^jN_8@0u-He{AUsCqec_L7DIkcn{ z+u}HZ3>+LCx;!3dFj!Rzd?>V}Y{qR7qhMjWFg7#j*(t%4DyQb-diGBHU9ajtV6-YG zknL`~m&t+O(NFY4H~sbV0yo$aAQaAQqKjeUXGut8((y)9QDc&$QSWe7T3__MWO-hI zC_m{3m(TRqb9a{?ecHZ?q8DO>STVvhnpv)({9)>XxRD4{cj43$r;csBgE^yu#P>vz zu~@_l;wyqDtv_X279o}tde4%k~)1c0a_YBB~?8qY0B2=VE8$Xrh8r*}R zi}D{m7P6Lx-3G_|byMWs2KOA#%B!u&3}IJkhQ_y!o2PBQ-}*+`19+;Q1hP?L@68d2 zAu8ozxWuI^Hr)=!z{L+&LIxl90 z>92`xc@lGP)-p}l);U{tDD3SuIF#dmxq7jo^h5Qlid!lM(LY^X>{b+qu=Q_3M5B+Y zEBqGcjTMJ~d);$c-SlJaz|l?~XHg(fuSZiLW+ICvo(6e`_RCaC01XLe4_@)eUY7+W zq!999&|p80#TWDeec=y97^PY6zQ`vQp)MMJQ{iJ1Ou% z+<0*g%i!9!O978!XozSG*XAGMo*4X32z?49WWlp3!m=Ql-`zi1y6D8~SDAjj#9!h0 zg}U|EX60596(3k5UtJum7Uw>NQ={flutLcd)PFzgf_9K{+er`JPO1jOaI7Ph19}1nhlcd|*B1xv ztc?uL1zoGasOifms9bu4Ykj)&hl`g+{SUO8VB$mzm`l5&PtIzB#m`-#`PzUH5SwaE zJp8nb`iC)jN$~dA*FmUC)JGK}coEci!8v53_|%Du@Ov6faXPkvr)+b`7$+)PZz|np z{x@_YXu->O&qtqO!^qJd?4iCUOBHp3OW0k(fx}B%2D#{hIA`#u&R50 z$jDNw(R7I`=FbRHRpkE^B49WSTU8;S&WvW;7(??K3%~PLrrl@v8VWIx7?5ifAM+p* z9su(uIRIA8;AJbHlSy0VIp>{(nes}6z`lQ)>^&byXB*C}SOFhkzG%aUse?xx^SDmr zl$yLYlVsM=a&GDp6H3jLy3JlTwXI|vQ=g!;@X?r%K3+f6c7kuluZ5jbD(bSx5vulBTE;BS*lCBP;_x(xB}gz ziW_C|cO}Nr-!+U7^0&vD-zhq<%iEHV`$`a>ZzrMe!muZx4Kr~bRj*~4P>R-veE!f&93uM zu!$4Z_VI=q?#p*sd&Rq{zp%R>Vp9OsE9nT7%}8~=fm71n$gXwqP}ktfVD+(@Et6jt ze=j;#e?Ke0%>Jfs3QamMw7T*@#72w6DX_OfCux$i9rervF=M*TgbF+r>0af%BeAK@8FsQ&rdYSD^25^FFh;seXbYMM^vdK-4%bAwT)NL zocxSy!TrACLqqBYwlT?ZOkM0ZYk2>x%ePh$VH~gH=nU_0sX?4qRHr+Bi=%@(9mhT_gDaufJj5oyoJw97dr%vu??CNTcPh@dp{0i3 z92FK(7|eHOYMMrBO^sB3s`pygvPXL2LTaOA-fz=szxD6J!n7mcRK>oZ7RIf@Ctacz zn@#hf|b!>kLt&?lY?5WUeVDGtS2oD@5vs)vUBOTt$6%LA_Aa zxUI?RNH5q$O@D`agZaLt6P0oi@HD>zT^H58A5^NtiouTOSpz9wq*WHIgQr42Eo?{i z2}_lPiG$WUH@2-Rety+KTkFdeuM%F8!@R!lSFFLrlC%SMzo;pqo*C~JDS}Ha@Itp5 z$q$w;(nLkb7s*H^xGA`dWlouWv~sk~yXBU7G}g<(RAJt0M9G70(RnU63%mD{^#mz? zLqI9!(S^)Ojy-sJQ~=YrLu35W{JCweYHtwonMXjk?N5b{Y3KlZ+1U_Ez)qHzV$k)VhiC?`#Ap zd2S^gg3_Ji@O=Bivuh@)lJ0o@oyv_m$(#x^^#$#My>Fk6U38CpKq&}Qp1GE~gL0iH z1pGeBpX$!4(EL4(IIqQ}WKqfCn_n1`Z&MO*!1l;-Nyp-8Ye^O1kvj~5AEI|(c<~{V zt|&9juT^8uOHA=LC(`QZjI~P$PALXEbKa0;=#}oGmSaz$eRGEz$%UH*i0OMWZTTn# zq+%{LSG1$Lif!IiITr5ixf$5Jn=7t3HmMlm3IFX!xbOYrN64CUzkP}RZ(oA(pQ&Ew zGy_!w20&p*d?&UG#`_vd}Tm)G+Cv`JR^ z&7GmT(H6D%6QeUTVS*%qzxRryLW8F1Yhiui@Xy}6Yb){@@omYc!;g2OaeDu2hHA?$ zCPs0kW(Z?IYXvBEBTaZ*@eN0uJuJe;SJb{q*FI$+Bi zeUui+Hghl*OT3DHHWG^ti~+{HsZC zN>^`!v`J(^5T?ve_{v1)V|U*oo?m{QR{kbjuXCG|9qaD*+IvT%2vlXqw}EVFer=wV zlCbJ80wbFnFru;(3E86)!dKnamCl}%HkS1{`V)S=56n-*Tfs_C9+RwUw6_U`c>Wvf z(szo2u6tHkj5r7i7ZsR`JZA^-pB70L)Kb%wjrFG_TK2tY+Vk?Z(T;+}L22M2JDgP6X|b3H1gr20i0~>pATZ?HUW_C+Tm@s#BTWfXL1t zeU?+?0Ez>!P&fhQ{MMCi#Wt3K+;O5I;60-Q);T-R+X?NPv+`K&hkKOP=Cvy7H>$jx z^lE9|InqMwOsH?zZSk5?I`9oYp+a-aMJ-0>jjSze@r~T#Nz4zP%k9y#N6Z;MQJXxZ1B<~)2WFRTn7XRU=K_gWbX@< zDy&?@50|FA_F5UNwM7^3VAJP=nP(3kb`sS&5zU?ABxQiZMEy$cpy`RB8AUds`}{TL zPB!e2;q?GF+M_=jf&XXrC4Ai|q#cw15;VU>Wa#2=$}Af-<;(98+xpI58t6d8i=sO7*e5KbaOLUS54hm2UQR?-Oz%61fb%of zFmDu$ri^=ET=Mm0=9H)sWzA&4d%FogEe3yK*W10H!+ z=Cw9YQ12WIp!Ikco!S@bH|&Td9mOk^h^_f?#_BiH{CYy=@Gh(hASnkoH#|JnDlRhZ zaNT=@DD~C;3pr`0g6UmwY$)r4&`$vW|GI-l-eA6VtqnlxErQ?%L^IpC5_0hTj(?vc z#UrBD^NPkur4-V1FfJ~hujRv)CxS#sgp?*d7fWV1MRXlB_~e|O#80e=GNt@n$WJE| z{xbkNO~#Drp&1{Fw1R4y7oZ1Ss#J+95pHHjrxX$P@9-dHaXo#{X_9-^%OTQ-areWe zVarmG@rH2x!w)pjhruqWUz-7|D~)zQsG<3^1n~oNu6lM>m-=K^Xvtn8nZl3fyjr$D zp|ugn9oKL#;(ry!76TS&B4zgYXHft4?Dq=Xg2KJ6`A1bJiKMQK@;MRhiz>V{&q9R{ z$Do2xb}40AAMF1;EE%5r^P@~VtzQunzANjqFpu9Gn4AAGMIn26!QN(L?otYgj(A9k4%s0 z66k_#KuRO(7NPiL6j3im`YDcd)sT7o7yY*J=FYBcvhXMUw$Ju8s!%AMeZGChI?j0D z^XGTQ!=|^}g$vW8U!>?co#p2eu#oSu8CR&O4vAO5D(C05W@lu-G|o%N$gE$NsE*s?mTgRiU{-ANWTr* z%r_wP_j>N=d+%S;&#!v42GQ1Orx8`cZj*@1?s15Fm-xq1k@hk??tU@&Gdh3U%YWfV zvna*<3J+z!4f%Tpjk^3oIvwb6s&7qBW?XJoC7&-r3I%>XpZE*3(w9DY2tNA7wM!SW z*u_m|rcpKNq(QIC(Nyxfbv(wkGlUV}Nno@Rz#=ox^e<9Mve2VsxNv+T@RHyPL2mF% zfzYV2GWO>QgZfhbkxj(z?toR^6}O>!96_2!_)$CcFOHDKMS_S$lKLcvLUj2MOuMdO5F4-EEzh#xjX15i|MvlZi zuePA*B!hJjf8>H!K^pq9sYB7^yW&1owR#S1n4=v-icDZyAqWZ&d+$>KQ%;-sno&|? z$4t0VagmM`ttd6(7#l(ZqNQKQZb$=t3kD%L7efKpFl&QJ^->CEpgbFH&qDT6`%LHY z2&T9T+MxR^uIkS8n>$UWf9adP>|+0$LSsVgt0Hj6>2n|&!-Q}H9mMZg6n7a4_D*p^ z7=&s#97q)kD$;_=1MGWc=PuczJvsW!BqIaBj@S9nk5ijPXDgSl=2q>gA77O@9WVZzOl?jcf04!IkT1 z#yD}yDO=ZfrK`Mmt3Tjphrek5R;Af5Z>p7;53a>DW9kcw^F4!vmOi7~p2FV+vqd{9 z8S-H7+P-2yps4aj<9T2?UQT=?o8GK^v)S7nQrnE1-R{TI5y$_XeBcLrg)<`a;d<`! z*ETJ&BR{%I@cAtvXfSxmlYaV6j15L3_s(;QPzO8z`Pq2m9B3^73fT?-NuqtZ8VLsz z=%=VMFPNg1cFpatJr~~Bz8Y)jRG5~!FFIlTQ8TzTQO$rM(SZJNxPv#fPis z-`_loU_6GHrAv41Lgjr=%7-yNJ?zF6*Y6L14YGoLcz%%3lr%j8y0N&UY{Pa=I=(!H zxu@%fgGvUoXhRyUNQo95K%XMp*fA&%{7pth2S&(^H$rSWDd$N|PZPmC#JCSYbpk|j8J z;l8I(`=;kigk#@weojsjYe2ic+`~Apf}{IL1p6z99w?)%y!|6XXi~kq9VIEGisoJCucA3sjat@ zpt$@#ZJ*iJS+dS}%|2@d<*%X~>9ak&)6fozASC^UsqBexHl?qTO?vk{+ecU;OEzLP z{fjx$N67SY=Bs0}eL61pF78X)?p6lJLt}KDAkV99;ZQdfQ`7JE_)ltRlQeD^imSkx zu~MgQX=BSJcgk0NA7(0bbeeu*7XJzUf^-`E`h|ISmqSgKcO_TBA%wI83r26B;uN9y zC3TJBWING!u7bUQ^BqopKOUT)lp+Guklt|ee23Yru^xEfUW$DRN$DF4-PY~50~F%G z`3k4L442d;6+ZPjqwO&JCS3%nSE%r1UI<$J;%f5=wyTaCuqE%Kv9RR?Xby~;_NKCa z5;`;P%W2W}Aeo)g^&TMYMO7QuFh+5YHn{>231E`wQ|jp5wf#lAm6gp-0&`HlsbQPA z&MU6z6=!?9;|KIa^twhSW%9M?Tw&h;+a}@Efgtm=ZDxhcrc_&7`?=mwQ8RIrw;gJI ziq@L4exEHNQ(#GV?xSr9OMF&I5*qWg`jfN%7(U&U=qH69=~ zI)+LnHCHlTc2VbSR|Z{e$@@Y3GjGg@RsJCZS*LfbE!-!Wb;wL3%slE|WX&6CY0t+R zo~|XqdG{F+6Br$pQ1mQhF+bl_e`P@ZW5iK~P$U7z!o&i-`i}^t9w3-fm&f)eydA7d zktV)-P9?58LIAihv?RAUJ#}6&h0IU|#!TQ=2nTebd7+}pBeeRLD!!A0UV-gXv%0Jem;!p+}WVD=UpL<(gH$BFU2DtUm53XBz&y7Qkmi zh*>s-7iePajf6l=c&dQ^Wyo(vT*&NbQ^^?h#m~u!(QDd3zmiqR*SERDdwXta1?6LU zM@zd>Y0b6$jDl-{juT!~UvkYQ*V84#$I25EeYZ-@4*okHpblTCs^g4}WwIyN3a|K? z9LMfy<|9Q^$_oEqI9Hf(7#GL(=joH_ENhS^-UBBFMjbMgZdbq3t}FdcT=~v1X_9F7 z29qBO^&~CY=z?CmJ6&iBb;IqoFwva((!%TWN+$iJRbZwK5KAnGhwyg}9b~Zdz)+*wxK`9O$=xj1 ztaY^9KpA^xa)lQ#8*iICVJfo})@WIN68vc{K}-(N%(w+T(xS z)oRB-BGeEF0NV+0vHC=Us)hyynYl5CaR&77>uwa!uB(hVt=60V6)%CT2Xw=QEA`B&nY+K3j$3Kdd*J>(Ut1t#RPJva9Wc`aTM#O-9pt z^NtudfB-nvd3tw@sb%3PQ7Fd$RS#YOuo1ZkoRx6Tw+*0O*OeM*m>o#LzkxP{F(9WRIF;zr_ zUFv$2Td{7mR7|w6m?HHm*L+()g>>;xtr>VNA(}YJV{hqeD$!Pu0&lha(Vv*9t$v=u z()aa%jDXfXy#@g1@o1!{Ir>SPE{iLMZEoh5t1rFa= zTfB^pMTG&@&+Ha3{l$^xB!azSTaa9N3RL>jMkzX-_VEmT=tx#{bbjwIESv#BaRPRj zbZobp%<~Ge(`v&yzbzaOOav_kP+9su{(Wqn1k|N8n;$ZPeD+SPksgV0dwUWod@Qo!as`Cm4y8@hKr@A`YE2i$*t0ehY%OS*Jk%4Rs2vYyk zm7BLMenZCOut%>KFnBTRxH{Is@lG*22 z4+@Qs-DMmr8O&6Pzwa#hm1`u>iX+18H1+>#?rENQI$UCxUr(|jACaZF_Xu!vem_nr zrjVZcPJ&AyRenSSDxO040d{}%5moZm`%M;x598@~O2#MY#D+wjA{#2WLQR)w1*^N{ zLdo4Q{)-z9jyS9`|a?9q6R~=4%|# z$Z_-(+ylJnH_z|Q7D)cp^ErU*6@k#x9AkH~>73syS*X2_k@6E7nJxA^s|JuDKUs?D znduKrOB%A~G_LKxMW+W)J}UhJJ1VgY)3%c|uN>0Qvo6ma&fidlRzGU)x>Dc$>h$NJg4OMxHDtZi=E!V0S*PJFPqBz zjcNgb5fC`H5j67K|6q=RDpBI5kLl3|*99gAg-9PV0Bl6a5(wny(55OG04BMcx&LfM z_ho6l-_JFWe)>mdB?LXX+-}eimgg7x&haNn2dqvi6uoxkbEq6S~X${)v&%4i{tvulU@hjw)BF~WUAQ{6B2oZCO?~eK|Yi)@irAxJo|3;P-o3yUug?-d1=zNtt zw`MoQ)X{Hng3q=d!N_W=9?FP!x`pO;#tZl`jj->ZY0`1TlH~HAx~JD;(9ckSV3a+m zZYtc{Dr5fVJZ>=h2OvEUD*n!gYlQhwaBO`L#hqt`&6Jt!{tB=w!#bK*sM+&=H62{@ zKea=%w=1vW$~DW&*n1NL0dF3xH%0i5WN#s57=}bh7a)r_?lgo=@wxe&qOLU=9##XyKd%pM zgml1^_Jm7>C^504*sYqV!qO{(I=ilq$SGwXXHHtc((=qmp2ZgMfXUTqg zGda9V>+L=isqa&_S5)`}RVRWEn9zsztBaRvUFU(7dgT>5WXxI*N0}cD?tZe()hE4P zSJ&*hytTyEfENPm%x7}NnqW6vROv7H5 z=pP-bvlOe1GKt)rr!USKOA}w$_eC@47;IC)g8##n!|MNmDh1->D{@gLYDI`BPUIla@m8@&|W#M7b$4FtqN}-Y8x_y zMR#U&g?^aLX0%Oh{HW?7Et!5PIa7aMSa;?XtyO&MkFK+Bt1h|J5;Oecs>)ao6Z)90 z3()b)2f;S~)Qo1(kpm7iJiOp9!y~VfL<7Lio&JZzooFPREaJTVPDwEBg}n}0icdl< zA3BKyoQRmIpDMQ#Yf?WAEcb=f;b$;82dxWzKx&JV$O>??#D2YsYkG^|p@;fkNVA_x z(*D_##Vmh$UMVRdIc=bu)tmP8TZ9#TzoIYpUBx5A{L?tR^* z;Tp9VM4lb%VXp%z3@FUE%go)nP~qWy^vIWiYv~^k0KoSm&K#jK5pp8%y(sOTA$HF- z73l^kKb5*Lfd=|GQuJHLd{Lr1b$FVum>(iLXAquxDkVrZIXVmStYEwEq<>D2V~DrE z3k+yM+wmVZf;yQtF6pgpisa_oA>KLi$A&~8O}6H3mk%scH;s=zgWEsyVM6Hwm83TM z@=(U5=IS$`eQzo?BU89n*XYW)OKV4b8AetZg5Dc&+L7_d*(#D$;xD4Y%#(qKtp?)~ z8Y^=v79Rfm(QT~R1|zQP30B*|vu4tuU9C>Zr#Iq4d~pwQX?ueVsu-2A!ALf~;myt{ z$UuLgm#&xG@o_Nja4kx0?@KuS1DDGNANGAD##xnjgTj4)R79CY(uQ7Amipc#(T6@q z*Y5QpLMxWGz9FeQvUwf1o=GJsQc&Sebg7->RN^C&?(?;Z@ubC10}Ayheafwq_alb zWi9_TLxBfRrBCBdTS{BuQQ=oi2IT2q#)u%7d#Vng3Knx~vnFsoE%7O>Hz>&$%9hw^ccRFUI7Lg2({{W-TA|O7M0sV!?@B5Uj4}BF?0R94 zeD$;x!gt%j?X|6Kf)-Z+q|T~U+;AX2cK_w3^#2tsQkTZ|dsYiwST;ubRzBi|Q z@d|EYC42=JM_B_2yf=`RoL9#BACjUB1qmdtp$&NZxy*sNMCz*i!S9U;`eiw4FA|#SOv~SS?nIV?O-7x1jG?GH`BRBvuX7cQwE-j>5}0@Y zjbqrdR*Xw1$#{)h?ykqtXB@xyKVH&hk=Z9iA_dL*DN=FIo^A9bdkc(}r;x^46H7P| z(e#|+w7p3i_9?J!aco<9CwqQi_4|pBH@>0gCy9|_)Yly2Db<{ao|{T9%lZ{1P&C9- zo-8Ih15Er5C-HIxo&^NIdPlj!9^k}t`>WIA<9SsY!qm_&gH6mhdTY$fGOv_O2Tiyf zeXK>+|6~q4K*x3_o1g`iUDi^rD;;{-sUGXEsnk23ZK~D^97&c89-88z%v(@Qs=*50?7M1@2mwXi-o3%1|)`AX0RjN_YvX?R= z1Sd>t^s6aF3Y-AJPIiG0ySXE0TBYy1^W-Sw*$IL4+lqdAn30P@By*mKUW|h` zD9gF7shCW5F4mglE*Cslp0(8Ca@Er{ew>fsfu+)8T8oqDkifQg*R5_YL;G|aSFLcz zs*4ex!@|!)n7NlZ2{U&hGB3uS$iNM#id385l za^e-7#l9Hu71|y$b~JtCbZo6**hBR|iE`=TU;IefaNz(;qoU|8=anyQ6@;1nB>D z0iFUQyKt32Htyz)z9h&mGQq^)xp33=z)^H7s0EXt&PAZt+R*$%xC#<^-SWo6YTcOQ z7D?Q-9U}bGSW<58(fGr5nr}qpJ|)WJ`P69>`CsXs{ONd2 z=3Hb#h`XOVA>*D(XYo@{UGY2n3e8#%+N+azrz*r&YWCjjh4m|tCj$M}CxFv=WTRj2 zH*SI@j_xot{dViBpEFxx9gij41jT3sLN0am<&;hTYq=5`V1^$v>QO zWjnEK92pu$gOcRJ!58|Hd%85%Q0+{p>q$U5+S_>|af)PFpq8^MPSI8cmK5{sN0_$c zTXPxL{GGDpM!M|s@-Bl0!M+i9;!eulv`5Nv$MC8!m?W&bH&6-84SodHUI?)Eu{W=d zt@k^8lV)+9`|RSpxL6bsEOY2wm?RPEGSMLj(V1L!%3bdPyGjFIlj7Sq^s9nk{uq1u zqYR;Updi&cWZ-VEQ&Tw-Zv-ec-afc>qiq9azld2(aoeeq$Rp-Y!w-u$fzL5qcMKlMj|8 z)OQlKhu7lJ=KNDWn*NI3%5{Azpc%6x2!^jFtW|IR{er+;`*$D1aSaVBk= z+SBpGu~S4J$fOdjkEY1?U1yAFT>bDetIgt?hFoy-@>ebB?(>Q&@ucT&w38-UlPsUF zt+nA8kv$VJMMS>TNqS0?3m!{P?b?%;235tI9H{8!JW-01zkKdA!iDfnq95x+`gA6= zMAMRwTt$8{|4DxJliCWqBR%XeHVgap92)2kc_V;qvfE;+W@J35&a-EOm|uf{9DP3u zF&F|0#iIzr8HpMdxeRC-x8U>c%RlHqWpyvE{+nNM1eHE0@A?u6~E~?KR{+(x`QUa#DvfMcIM}+ z9n=#DJw*R!Fa!J!rCvs1vWfeO6Ylt3hP&D(e5RTJ&=9 z%Up_mbfWu|BF`6hKf!^G!sOBy2D^W9viD5(N2PPKfj$;kVcsABgK-%CerNwJ>DBCL z0fx+nT9cMoPxI90LE*0$K!-3H1{%0Im;Mr+_QswDd(F!pUF&?q0k)1GgYBXn``!w& zemP2bp^{GDe%^*weTr%g4;Q-2Z(Xg_*B6!=NC^L$sk;2-_^iL-rYH{}Xw^3K@N4%o z$0qGBAO<2LMGE9EwD=(b#4Wln<;O+|jUztwUJWfh=w0Hp;bR-WU5>Vot2JxV>Z&_G zFjnA^6I9??6j_iU*mZw&IDt%1m8*0~=JHAuyimQa?;aaA< z;#myExuVB(RdP?^z59YmdlwdLpY8|g5P_zYUG0h5=cBJnmAlE?3 z#PP#zfkfJEJmCgGh8m+rnA&QTJgdrFe})obQYGQym~oo~BRCujV880DDw&>zrmfpg zc&|ABE~~5@5WtDFLKZ=f^sn1@cpTE-(0>88-^W$3A0-3iN*zRET%vwJg(gNCF-bJp zc;nWe(}WohvpK?#E3+a2=1lO_UUiZR^$*$oWKSV<0=i#wghrZwf7 zrWo>Xpy|=QHuUXcY4IS7!$D@!b*u^N@I}WKB&n zAA*|iFhfL4fqMA2F(8O^!Rdc~NYREanj`{N2L>miyg*FG*Wm?QeCl?B^(#y?CD{0+ zFZjL4WMN;}+#}Ykd`k{t@^+$KgSp#9*m;_NLS2+tc#@c&i))@|rNrEYMbg6xo2y}c z&&n$4PJ^I@9G=dAa%d7vKOiwEnGvXdH}-U? zZ(EJPd#XJq{m;Q|jS0i%6vz7)#^s)=j3nz6|0Np3LBssqj3E9mYeCDkoA%Z?6|S7G zZ4WpP2CYaWW>At7C$hVZPY5{s{p}VJ5LGV=_#xuKvK&gsjZTsIU6UbZR3r5e+x4J= zSd7*sX1t~wN3B}1-${CUSFrjG9m-_3;?cXVANGI+B>{MRhJw5F$Eyk=I2it=;3gcy zYRNObgL!XW%KkPJ9bn5K-;>$US*e^L1fw;gPK)8?OgkBMG=I@6X zZr~#!*aH8?Ll(fG6W<{=%%v`awt1>mWZ;XZuO){?5}9&4DFci?Mn@U;a@ekIR)p#l zyCB?z_gd#kFj)EbXmb99aeh91JJ$;KXmrh?JA)cX=3GUIn*?yPBJ%-09=Hzev@#Wd z2lL}ZRQ`rSd~n~9{Hh-S&6es`% z%{+Tk2gg+#!oV%53wskP@my_G;+E$D>UKxyKn-Jf)!nG=R&*{QgMV@UyX!*n57)gY zL=D>x)3FEOsoddI4myfGc~CsB6iF!tFu?oE%-DSj%OF-~&%F&3DG;Lo^Ebtf&J!P9 zTQq`@CeP~J${*al9M;RcOWxXZTtMI=FTI_YZGWEymHOG>ouiWeJu4Mp zH#oYYPyahM0xe-ibzx^65bqp*5?bc+FcTg8dk(xf+q}5|IE@G^*inC+o~p$ou3|EQ zcsTQ%zL$wq4*#-Z z^+S^rW>m*&SAy)5&?wWmc4m1~yaoUSQ049kaQ;kM;wmOm0?Y(D>Hg;4Ky|As%LeDS z6{02^-qUtM7EFj9o-qR&7A2H|nbM{DyfF{aGxsKmS-}y%MY#T0^{fdVVv0ua8#V#! zZX*zYt2J1)wg%`U>Wg(ck0$?Gjej4(qs3PAhCpW8Ms+f~$ox7x6X4OuXwN!4BZCD% zzq$rd-4Gfovnwp_8&(#tziIJqp6z$Pf<|rvx zv6_)>Pc;~j+W~y`mN0C{8iGJ;A)@op=cq98tjo&~i(?+!Lg+`mu$zAFJ8 zD8o4-!bAzp%7gmWlohsJ1(s?AMufQYWPw}b-6kzB4$fEToMig!?_VZNSu^ajBt`vO zWNTw7V`nl)sdr{xBn*cQyw26>$w^IBedkC`y#>X0k}>MLuj&2YU!Qlw5>~w|*DeBg zRXMY^FkpQNY)q_QQ?6sALJw6B_Ewj@B?10a@U_7}eG~@|7#(K#2SV<~t8Hkm%<-6% zE5jab)+LE)2n+yhBZ>h3zYLZ5yOD(3;2(gFAZ{hEL3%nceM7r;WSDxc&lMAaS=l;? z^f6FqBd<{eME}{B7Ty*8S)RuOY!t9sBup@H2!}Tw}m}1kK-@4?_A7EF9 zGkw215BAd%Ul5IEyJ+FcK5rUo(7^s%rxKsXQ=o#ym zYb7EDMs-@5&JV}C?KeU0`98^{FMu)TfdLg`Yb)#Vx8__Z;wRZK+a~#I^0|I=!F$cb z!pb1xbD_`N_(oqs>!Y}_udnTv+9y@%yLNhk2kkEacDEBx#sMZb*dp4Y{ZD#Z42OCs za%UD&_@kxK^BX@sG>Jm_VTNsq6mJl6ZKv_hM-$NzF+pL%RnChP>~yyS$=yw9OIS_QyPf`?EB0)a^az%z?l5SR_cEd6@Nkd)Jk^3W zphsnY3Q*S|)pxHK{d>zeQ-ZVpV`u<@7yGlnIuj66SAaR?!TAp?ewP{Gmy1oU^HjBm z;kI5lc0`4UzfqHTC+T-lVt3lp7d<#m-=89yi9qDNM1J76cKH!ZCer|r{7&Lii2#u` zY7l>PVu3b=y;P7VR6e7d!S`LD$@>on?n+l7uqEZ*m7@!=81Htx@9_a}da$el0PDhz z$QWQ$23H<;RzC;*K7%6*m=q6H>jEHY4{wTNenNE?dv_Y`+fFPCWkiVuV|`7J?>K!PF&{EXGgwoyt|!>IeRjK)bUJjg1if)d|(yayQ%F!{tz5c)X1J zA4wVop*b>W!WY`Lsk5NgXRRN5S{KT*skt#(Fe28Z6dyBzJn!jD+3%OqW1t@??iA31 zC&pqRK_FT_aeI)?9Mw6eFhx2>vb@?yED>!ED?xH zARQD31V9psXW=1-N5Sd(3ZOFo1DFVoag^KH0H9S;PFrr!ySL(D_??C*fGjdPVj^p( zl2dxjhE>J;Ej#(L;a0GXjD*90DDbcbEx7p`L>fR6zdX@HK+9?RD}7fU?u}Twi+XdG^#Xr0VdC(Z51f7Ich+<>wJzM-@;iEhq0j|JoWpguzjdYxLPU zXT1t?h0N{LKZfrwie0)fa*Y5H(2pA_1_uYWA&t?ILY_ROq5-Lqm%EaBNX4Gg4@(J) z1KxsZJ~gPR;4Nw@G;G^+MV}IC?G#sSczdam?s%t*Ux`KkQA=bF+@Pl{VRR=sBwv>K znBA(_;5dI8p~V0VHpX@@N{}=LU-6E5w)ofa;R$;=F+69y~a%O!aXA!PW3wRf`BPTr#4=}5DyNu zMDYLp+y$?aF<;F}^SvXNR(!jJLXnKHyUFjX;zzE<1&%E)KyxXzar|9%WlLx%TF^Bq zO)LJvNYCl`EtV*RU17ovvtD{Kth=QcLla`R6>oY;DoI%`gqZ|)Q^dHtmA<8YR(Iwrmw6JN9K`4aY} zqoT+Fy7bbT^u+~lEr_)?_~1v$CWkYb7Q6$`H~b$vKhT~6HiO&}n>pj4Q&`P6U+^gy zb3qUXk8!xoSm8$<<@k(Xj_LU_89`b?vn|ZVv@A64nzn%zvr3b^7w!nuH8*g{Z6Vrh-bKe@Dff`OU$*B~S!kMN+ar zX~4dXOUb8EG=7@EX+`k=awc;v?kp`R9`82lKeXIr`i*?s(A!~dBy8`pB0n8ZdgG9Y z9|vAB9@w1*`{8n}EKdw=Zc3#-w#+%T75&Ct@namoeXaqEzNRu*veafaq}@4G98fJk zSM<08nG#cIrtT_hrUmVoPk%G;?6N3bgf&UDyIFPQ1KTUE{*^^N1GKhOhUD|YL; z4BB-hRUJbCu`o_&d7LeC>gYft)c>o9-#($8q=>uK94l zznbdagxRiRpB3QrAPjSXlf;uoirSX6rvb$AHn`%2&2VPT-L`E$s^q6NAmDCABPKvD zJLC|rcb@2lAdH&&Mw@LG(nQof@j9W2zr=|OePo_~XuZo?WDx||HNs?*NIMa5d~oB7P37A z6I}B_28M_FS$F-z>X3oxT=4#pu2~X3p@NcN^oQmA5-~-_hf}xZ=(ul#<~Q+RW#NGO zmQV}pA#iu@)W5bUrviiTcmXou)s`Pg=qG|szNez+MIgUm%f)u$L>}x()9q8K@YXq8 zSq617J#4>~_$fcG6|hIsaftD6>pWQ0CXS%(}uvg#?-q={2^Dbnwz&%tx#N*ian#29(KSatNYCXRiOFS38mZ+mu zx0+Dpwnk=G;L!3S5a@M+fUSq2b23cSn!L3^f>@+uQ7Sb15?J6{9i}RznG!6cxw9WE zm9)D5i8-|_$E*7RIF*pMj!Mw#n4U};p6$M+pHu$hEleyi^|#=2!IvBGCpeQ73ES7M zol{Hyr%xg{pHF!J_B=_L4gj0W9pq3#2Ws zMX1qly0TN;J6?p9cSzm>MI=xiTU(u3Tg9uZgB6g(iQL#SLGq;S9kHt7Xp-hIdX#XV zvL(!&>GUmvLIhBi#QlnI9cX|)3jig_q}dG$XMmUD4FqxduHohRp6;TR9P}p<*)u2a zpcCpAZNI1pS8Dj5NwYp0d5O{)2(L^S_XJ%hU@ouc3;W)Yaa{ny;UWhWo+yV_TQuoJ z!b*O2*~Xvr=on}SChD#}OFupYeaCbUsKo}?H7{xTWJmDI!Oo9<;EJDC`|yf_SCq_o z=S-=XE@tx0fTufJgav?K-k!=m5#RBZlfeqNFd>2Fs z{fIm86X!1GqTmL&y`pD9n_fiSK-W#kZ2oScwRp+zs>iEvga{Y(BNF4%@sK5fE?Z1~ zm2d6Ia8Bn5SSJZ^mft?y%Y+o$|c&06&IDFd9EAl}2aqB@D zCNd!Y+?gymJ4sG)iTY1}@sp*q_|65tFt}(bn6I$+CVS6lEs`R8a}WZ0wvSvwom3L} zSJPYR4H=KLdFdDaIl^yuSR^B@Oz@1_dagUq28JqnCT!8VTa)Vs`hz;quTB@CPHUos zl%dq*Qo#ksWtgP9Rp@)BXqXQeMkZ`T-oQ!Mc0`+3y3ie=5sSxG70n!AQ*n`)#6N`y8Pa-A=@66cGpt$r_=@ zX@sV3rqg#O0qt=*&8&Zym0CWu+v@=GxCgMiIaq$i90f`c(EJh-wlmwOs^LHn$N87^nfi<@Gr z_3sOhsXGxxDO-~~cT<7ki(=a6Q=!5pSLWMV@9X7Q*y}tdgN1@d$M9x?JPfp6nhYsN z=}Iy8CPA-XefyC0xcYv6`EpKPaZs84@cm1;^^;r$lBiUi!is0F!hSTU!=Op0f)3Pg%R_n{}|S(g&cPVD2~b^cw;r+s`ZKrq%@ zG9o%VSR`Xy=Mqb5NCxBOpoG2{PD5Bxl658vz#sAf?D3!A7&kf`e09a?0F6d@g=>D- zj8(kiIe@|Wwn|sTY|UxewNyeC`k2S=@xa*e8)O586O!NZW{z27+JD01(Y;nQM#J{A zag&wtu%Q-!!sAt7zz^ZT4I>pA-t-jof0WCyAB(onY1(4a*UU9&V6TMM(2W(^6s|R8 zP&arR%kGf!3DU%a2DlMhSND{!!l7VOc7!JG9fBnbBH+FTn~@?)2UyVaa6_Hmxh z<;C=+-m>z}N=dl9;b?gv3Qj4^@ITjeJ3~R+i3D z;S5?C^D-~RE<^Hm`EEc;irG8IKqn_V;oU;q!^cW% z9q+ERUL%x>@UK5AFjrJ6>y_bmBtk!dTGp(cE%%DsqiqN6an+_MYRRT!+NYg!EyKil ziI*9Uv;ncW0jsQXT#>=;3)Jkh@LjpmDSRgEHU}ZNq)ciuT%>(#+StVWi?Dt&U3{iJ%>}?cVhAr zV2^_$yk|Kc>Z^FmKYna zKZ3J(OwuO;3fpvXGs#St9i=fOqHGVjSL{dwF@n4kCS8!uL z1y{UJ$wZoJMJY8YFLaJI-CO!BoSprtn|t)>R%YmzfkH;;_h286#dqM06mF+2SccpAeVsZU< zK5wh})WX5cwD~M1J_i!wp5SZxBhw+ML}9CQ*Co0fyhmazqyJS547`VY7w2uA7}~ur zS~rzZbYV+sMqZKzxe|#|k(La@k2hyG`*+gWZ5A(2jW)aQxg%3}e7r06TFoVWd_+ot z%km4|-?tL!_5QAXAB8~0^wUVQ#N_xcLS~1`lu~GZb&vq<#@zYZ`%HlHJ=`o)L0bc@ zhw_}Q>^37=BfvJU3vaEHDbNX&ivlCv%rY~tD&*4wB6&l0Ugw~fDftY)yrQCNU1Ra% z8(SV+mhdfo#V1sM{FE#?{waR`$b?$~S$E&BL#%pxP;J~eVDUC;Si>3U?^^q`1H*8H zIfmjVUV{N1r~<7s$)O3XoG$jZBLZ>}kxpaZyC^Zp5oOSh4$ZRSJK|5GgGBr##-laDw-u2EK0s)yxwsJ`=O0h|HS3rPiK4lMAY(?F{(8R+ZZ zAzLT}!izHvQzQ=lNIPv=@Nx$KZ-Hd$b9TJcHIKLg9)4W3+yBJHS)IjvBPkMIkBR** zuT=`(R78VePf%8dF=y&clm;(0rscm2+LP1@V2>S0nR`I4$w&oR4s&rv}sLJU%F9gIVx2C#6V_HE+eq| z#>So8bJD6|L-ZC4cy8CpXS^nhSoDB}&tfQ~ubDq4{5HBgB3zPK(SA4PDS{ zCx##(qlOPJ7u_4u1%@;4CN^JD9AB$RIwGvt%_so*yo?nXHgpJ6>MI*q3ak9q5 z*-acuxDR2-wzp=Ld7}e7U48fR-M(nuUGj+19)b%SI71?*<+U=9bEUy;h0S?PSt6BH zW>o1pvbU@DJ)a-ER)28~2?2Wz%>EB|`z&>qu7(bci_1cAGTEu`#C63)J?A;s!GTr< z+Wq+PD|2t4K%oZlyZ$OG!LHqQgJF8(bn`EZ}=zM*{3-Y!YYZ@^H%^iNL!u4*{0nFaN!z z6ZC6e!Pc;~L7H9+N(NZ@j4K*a+UA;C}G&&IhFFKrG zpfI6~)_U$ArFLCIR;yn{%3=@~)L3qhfIdx;XI*pT zGxNaA%d9zZ*6F6pc{W|*8Z)6Q$*JvGvRCHW`1dbv==|QJ&UVvdu^)ml(Ie^^=3jzo ze{h8=#l5F^jPxnn{N*pjW3&;%>oH7MM>ryDng`j2eb>in!1qSg9zfc!`zI`WPZ|?IhNe-Bj=Z0r7gLlR` z|NkOCl??X$zLU}-KD!|Cx4P)O@!iJD@|^RMO}@)+eDQnoVDOJ6XkqxT7Nn*!5B)#3 z&N{3Kw*C8vVt^=(h@hf?j8eKwK|%)7A)vqrk-_K&5l}+O5mJhDO>(0fq@_eU225JI z;l0KkkI(aa{p-GugX7qC<$0aw_xm|-dtcWQI#15Si4{?Bm2|o5#-hkUHwe8u7ZHk1 zOnZne(TSLi_}=;QQ(&9lp%+|B9`-s`Nj_R}z?yFowNbi`d&j)JzLPfi?t-8li#L}^ z`~a?e47H{hniYmflwkE1A3yq*EUpEbT$=bSBPuF!82$T-( z^O{mE7nDXOcOS@kPCT0238Fsc=yh!!X&YIcGnYpmfUYTqsZ3vI`!D>X%toDt)4WeQ zVJd2mzam9+ziG-ovwZsD9^IfTO)Z8T5w{;?vWnm11LmgjQ^#W}h}Q}OWZJbhy*Jaf_WZJT5;aw)Tg+ib zs#7@ieazH{u!?e>sucCzvcv0ZPG9kR>6^{JF*XY;Y;>EKv9+x*Z-4r6R#joRNQK)S zihPB}<#k)xXZCAmQ8tI{!L_9E+4p{}5oBlx1s2Jm?h9FW zfHp1i_qWzf>P3(>DPHD)lnmU$)}6 z*K~x2TN3p+3d&#X^#D27uN!PD6mePHB zwBw9eq%FM+MSkGE*7BBURzYzPTv^mzTaM#tG}td|CPNWL4c zX5;iMmL4|o?F0yB{Yq7sq1_G){QMQBj_`J-}7 z^-l#sv8PJiM~9wz8+}<1v-9*Ahf2Du;6nbTW}ilq4CRZGq@> z<fOH z-sk^frfT)VQT`igH(`o){d-Syu@P4(lj0EI_jTODM+?B*tx@sWm+%WN@+5T^cVUiB zI)(R)++SPnRyPsX6pr&(#)}O%i^gCEzU6A}`NXNBte3xHGdMmJ zbkk8Cc3HEAfqAEcW<5d{2(BsOcsl&jvR2IOAZ{l-iIN+dlk;zg%#(^GQ z)Y@@e|+)IxuW zY96%c*wdix$bpimh3k{l4K)i>IS@Vjgqxo^AJ}eLnX3?!CMT`i|?QebmYD<7h^X~4n1 zh^A|Ow~FCR9WYnPKy@War?EBy)DgBtbx)ahYd!DlS0=S;Hn5yLH!kF4PES9c86>c* zg9^=p7Z72_&W!CP7IE&e#$hNlCCBgjA(;tG2hH=@fC71A`70&0tC2#ebG_vW%eour zRaa3ij;=h_(~DTg$IL!Rc6SQYmN%0g=6aT`*o`3ZHmhiKKNiiqn6Tt@T_|xUFgM~d zxGDZT5qryc;Gp$J-Tj+n!dswa!a-K`ySKMz^l${1x(TmOQz9;8TK_Oa8Ju`-mGfjX zqJ0Qyn^v+-+W%726J3+%J+r(Br1RfoJGjEhhYzkeCy)RgrF^XHGos__QUluVAvyJo z+zf7sp+{-5v&BPZ`~a8YZ14d2A&z}To8Vdo5usYRshi%UxD#l!3uY4lqK z$~9Y5F;-{Ury)#m5gXZo(GJvr^uTJ~=UP~6-nDC-*pDQF_IL>mXw{?ztjKcFwsd%H zfNpu`a!Sut+P<6^?sV=hM9suuhNP6N{rH!9Ut-8lju@N$opF6xWQ-W3`n>#2sB!G( zuIclh4ok-;cZR+~xUj`GLV@{}mQ9w)m~ge_nJ42C^J}fo(JB<=)UF4qF3ct)d5i}Q zK|Z@K)ZC!s!Un5hoMzLCV#;JrRWBj}pZ}ZumTK;l3kXRcZiy!6{#55YU=IxP0G^l2>tlL%^m-yoqMn>Pz`wj4 zj8UKTzj{yT)yL|pUfjjbi`(fAjQ8(Tey{f0OR(OYY*gO-8LP=>y|i#|cM;1%+Y94% z8kR3x18jl3ccM};$BRuHZoitF^ykNrni|Ezd}l%K&Xcj0#NMOyLmS-Fa5RJ9{@Odt z=mk66y{+6s{^O*0-E(g%M7S#?!-W37ll5YO(F-{|B9c{g$Dzc%oEcaknpX!@pQ_Zw zNHCwoT~&Mj>l&gW5r9NNhdaEl68K$I%ge%S>Fit0nAOV5IL8C5R)syL7|UOpk-T@e zrR1dNPi})^k`HCb=Wp8GL{1zrQG4z3gS^|2;hAo9)^O#LeRd@Q`?T3vX#FQpotY$T zzgL|AKgwsJmU)pPv`l}+n`_>6t^VK}7raS>CUMWvCEoSs`Z07ndY{5+0HeSTm@J>J6XT&M}5PoG;U>({uJ znwL0Y04^>ZK~IrSIq<0D0n;Kd;(sI?;0M&Jgn$4}4Rzheb-)WenN&uFG5u(H0Ah8^ zD`e8(D*DFzI(&F>{C<(YRx*F$;c&s6p#<^rB3|!M4}>XE2%|pvBqCc>^5hdA1nYDF z#sx~7DCtiB{^Nx7YF_TA&iEj}I~Sv!^cNQ3)`cQ*lCOqC2{MHo?O$TdLvSl<|3jcy0ka;2*!H5~v0#|HXq1hJ7J6e;O?>*a)R$8%PH7!yaBSs(Q;=t1+M zruni~+l*owjw%A~5S+g}U zSFBUW;Qr*+gp$~~uSx<(m1jZwqCfAn1bsTe7*KX_0r}fqz?|xGt98P7i_`vyyVsh!cj=dypccsrxdfliQN!zV0cdV)Di_DhoCD6nwFqB zYlOEx5zbQ;XV9J1oYN#IHT_f8jRPE&VgE_21L#vU8DL1h)KiBVjO?GslV{^!UK(@* z?>0RpCDs9We(GdpD4Xqg1Jw=4gp(prv^r{+Kfo8HknrI_+GXM*^}VWkU$5&D6AI11 zIlM+?Q<_FE`PjXC@g^#L(8l$B5UyHp@QU_Ndl6M_v z9303&11rZ%gP@`k@MtuEtd8sq>9Ir&nrjK3{b?Xs6R7qozAc}I@bW;idZz@p(S|Wf z-ixigYOUkZnZpMW<9(NO;Xb14-1#usQL;pb<0US)xufe4E{-pq$@yu8i^=J=VL$C@ z!)ks%skQt}{6Ra|rBTmwu-%_Y%J~1z1HQm&RL(Kah6->XO)u+y74H9BX9>5ZOF&f(Z>htKWtTIc|gJPpEx+6He6;T(7R zp6NO=|0Co2udWuWUsqm>g4tM1vQ8l%b`Sk-*uYL61H?^lxXNeJ3_$J*(m4wP=4+z2;e8cKuo23{ULV0uoALo^4wDs34dgh(7mo z4N*7R4?esYiqjVOZA`yx_@?`k=w6IXGK)Ct2x9nZFLrs-fd7XP%js+3Tol8RF{2 zf@Ft}gAZO2*nS1k$weJ!%!fEGF2OV0I!BGOhJ=xL9O3>OAURexi*s66JZiEVXF z!yo7IT2CG)eIPuQ^zI1h#zUDs055|3#S9=zU()&j4;CeV!epq%7$%bp% zQBoqXkg;OParM4-!<)0`Ar+o9pl_qeaLg^yZ&4vu@|Yoy zw6ebHaK_}zP+7`V_R}2$m(|WV`pAj?6{_9rNP!SGRBE0#{t9|+o-9w#RnAbyEl+P( zexR+8epq^XV$o+^d?n(_^moZ%oqyrgEpj^NSfKlQf*3xRow$CTUsK>$&dhKZ;ij;Z zaS_3yA|?We_HDn&KJ)$r%@9#lGNR@8hy7D7e`Q8^_AV=yXZB%BpLHnFFN)UrYT&c7ksQ5WH`+4fw#BG|Bw$tM(MoTxN2GKc-*p z;0OFMz6Jf*M35pI-WnXQ|MY=dT}Bo3Yf7~5O`A`(zxJpw4(A6hGbmeigRVf$@84lS zN1?1&>fym?aNpVWls3b9N`Xad^Vcs;K4WQbFnrOr%it2>8oA7r7Oz)%wA5tHH}zg_ z81q>^#?}=!>e~q`wj83>aIFJXSl^{vz(4+6mzgh-hYNexKD`Lki=%?M&mI@;dsbkO zG>L7{`L(#(tlc6nsDwZPJgpftwTo1?{cL^1N=|$*Vf)Sg^#b`4m;Htysa@(XCgO$^ z(3bAb4a&OtRa&ZJ0s?fS{y8TDQ4-l(r;Sw0Zs2{I+RbBwBdBk9bUG!S;FGO)^BOzN z+Gm{yNiLNEFstR2`}av~W6w5%2mtg?Ix`5FehESnCcNiFHGGZ$(zD@n@iw_OD4|GS zIl6Y0fkAI`+OJ?n5+d72iD$S3%S``n@e}2Ih zd+8Afw+<89&8*Wxxf0kIO$aW#KqskIx>Iq?B+fQa1CQ)+S|O|^Exyyc%cXy7b2F(S zBd*)U3HL^_xjmv5By~`zu#w*3`Okhi_`XMGccv7Z=)Dt@8&+@L%S&I-uK9#AI`oy} z8dhdAAQybXq+NCJHstgCj;8`}l@^EF(t-5STFwM_?=^vpH#FQk>I%|q*26k7vZ0kS znvwuv01Xp21`Ki4rb*aMN~X_W@Pq0$a9$fg&ksUjOh9%cQfw_eBK^k4U-u zs!BP**DZGm4~BgHQN#n&!>}RxYjCxTGo_{nCO}c*`>rh~(xW&)QBwDDlMy^UrG!~S zM@IpP~~TUVi1lW=pXV^#;BUWs<>u{12L8r)S4I< z5~R%>@ZFnSr`NYIX^OV(nFG~jP(;P`a`xz}QYZ3-uf*v=8%l5$)Cllc;(ZqdcWN3T zDysOE&a7|InUk!(x1|z1a=tKBgE#})dz0idD47Ootk4H)v|>0!*V|IzX+4jyPV~$5 z$wqD-EVhv2kZ!urckNTjZyj=7+9dTkGTfMTM`Yb>M0f2+n1_&si9zl(U1_+?-`$T( znd3liPRi>w6B%BQP1Xoz0r12hXEIj!T-Tyf8;Q>Up6i1n^nGXbk*FU7ybHK9pM`xu z&XfYNC<7#8$eL*1oLhEoX8O7vi~KB1 z8q#-FKVXcx;&taBg z4MRBDUuC~L?KSUeSm&A6cUT`xbnZOKp{{rC*yo*MCtl)}k9+Qi*SuaqwnNofxy2=@ zf4kPDZ=?xz=l+Fll^ufH41~ zM`FZxunx zuPN=A;0nv8@|O_Ktp2o-X(k#QQb@{OyoMvu*O!c07Pi^Du2*gg1<9an045*@4G2pH z%eGsu4|}w|Sw|4LzE=-zHBR2VfkG@`_uPB!HF9NA$WiX_iXDa0hchdDaeHTOJ{%8l znNjlc$c}i@($Vd>fJ&@Ca^P9zeBs=Y)>7!#elVcGrQOiNIleq=&zv-Lc2!BfjKJsF znSW;izpp$OJs#7c&A$CiU?1^qu}Yp#+S8~hhyXieK82AKSLQLo)0peNb=RGbb%{de4UHwMpd(rfN)+Vf%ma8s%7 zLX2udMto*TN#ynG!<%J3A|w~_=!7%d!FG?#&XAuPpU*kap`~NV<^SD(Bp65oILJzZ z(LF(199S(s?b`R?T4R3prruXg5B)h|#Rb-0y8vpoQcZBiS{*aO7aG7&`)#1~q@Y4F zE&H>{j0y2N#mbq)X*s_w!i?%(Wwga$o%@*mNR>(ogE3^^beu*or%|L+DuNU|>%|i% z?Q1Oy-n!JIu$ntI&K-H7*yOZFp=t5Syb|e7BNXhTdmFwFdI3PR_Br9dQw%nmj4w|7 z5x+X%UoWtDB1hBbwnOm6aGJ~gy$ehk`l_z(TL-@Z5oBva)MD1YJ!^dkow+pRoViry zoVDcoerQ#FzL#2Ky+;qCr!ND@G1(U<(zA0p9CEUKQy|w5Rx6rDun(woF7OnfSNUqP3-zri^9lJE_;)r#YqE^EU8AnNG6zQj*%BwuI<0Y`;^N1O5AiyGF21L>7X~StA=g z^E&1bxHq`w2>!m_-m&4$Z}2M(!5SJ967kuR<5G@wEH7UTrv#T}0SH@M+jU|M&Bu5L zbnUI`IG?uPfG+vUFq8}HRmvsLe3l7B!01n(LWl)odd%KO)T`+gR|aq;jpU(p*t^eO z%ZMYm({YyXF1hyOgYisV{a@@H<7cQ6L}Z{$YOs`_j#Yy;#bo6;FzJ zvdH;J6aSsK;ZUVUk?q#I;~N38J*H-CYP(yNLf*?C%J#2GM7P3g`f{0ubR)^fq4Qg3 z2%dlaGlIXs=5@T4@HTU<>1tMWZZvoe%4#)JKYG@emw7(lOJ$CDx120`y%TU|ZvRVH z>4DKt_%7_np!*=p;%6&KH65pVQPB{{ONX^mpdJTxVq>7ZPTrrfk~Ap&q{Kaxa%#B* z*P`7TO@+h3WIe7COHxRZvHsA_qf#gket6YYP+Q47=&wn{rRxM|+;}k*0khzeF{U=v zS{iS#ZZ)MvDYco}irA$6mMB3tk82wazLn|9)Gzp`v9Uv20TqPWSqHY0R__R zEMpMn1y>R}aV74V)bVW{23o(bl%&F=MT*@D)T80{&TWZb`V~Z8>B|md$emgw^jMp3?adJ-hW>Oye^=t z*1CSP<`hq!Ti4@$jS-p7PW`OU4;&V=K;MTKm$darL6ct=?aG34^q@Rq`V24h%5^ZI z+bM4vD>i1B@Xc1MA<|r{<;=X1?=yHmNRY-Z`S8*1-<$)l~%lT%akuy^BA3jKv`MA*^4njP*^PeQqV0lEXJUci!HKF z;d_+v&d_q#Z5p+-mJ0v0ex0d}*AtSuYlB?9CS$d-Nn=5jhIhx2ZxcT_3M58?TKfNl zF%!E(RK%l#$-b-kpNBuPczUT$d{6JbJPkVOKQ&Gt>Qf_LF!VMej^FCyekMg-O5QCTY%G!%q>;^LwZ}t+c7o2r{s~)ke z+!tt|vf`Lwu_G~hq!=1wdnefr)fO5#cVYDN`p)iyf;lp=tA+Z0O_p;JuSUCAN0&$> zuI?dTqPvm3Lsyp$v=jbh>%q{#@8*DunW^zA!a)RByH;wZn4C2S9E8 z0`#$lfN7arvJ>yw5I?FNbm{IFa+fs=*=SL&O?-5BRy~ve#`r*&&Q9$TmIsJ85E-H z!!@ln5Q|4B=`}q%T3sf>d0UxECy&- ze|xb!hgtavkNj$$_ZoJ<2RLV4ALdevW67WJzQ@mMxAl$$d`B}^BCe^=#q7eNTS4lu z3+tKlB--jKjFUWSe$7UzH#=I2JR8zOF;F|q0P!a}Iru5{3J=6$*F^oo}6#@VW z0F?=z{bHeCAR(UyfAkC{drIP(P$X8GZwj@VXF3YnG1Y2dFe${8V+Gc*;VoW9d zTMLCL5%feVnlbreL0i(Jv__4{51wC)wZGaXY(LG_RIB0=UMlTdMifWh-vjpo?`!q7 z43;_IOS!ZZ?HxFW3Tv2 zfg$}aCn;qiQ0d#rzG4*)S9XSbq0Wx0nTITMV(n`0U^r)h>^xHwbo^R{XgGF!Bc+ zDiizF9tl$8WI63nGyWb2lfg*V;e+89VE>6Kg`%hVaPsL&W`5(6zq1w)SrL$8yp69KaVkf9Ky5668(ZUP?M3BU(*R zuA`36N-zBIQNJ`Gbu^WERDR8jbAr%=1b?_A|CVZ)aSlu9)A!p*&%*gf0c{P`tt z+kZtfFAJbQ@%*lKsL(mMd^OaNjqza^L#mR{EK>v5klSLG11QA!rt~2@otiGUEKY|O z1drHtTDqsTm=gkK(nw*Sf?Oy%%)yQG!-%zA@F0-|N4U`V@9q%V^#b(-uWhhr`tT_a zqn&?JPjH-uKByz zEnp@hL$EUe08|stikT>#;9i^$@(i6bXmJ30V19;Ux-g-A-P+Pp)%$R+`^VF%cq6qn zUK_QhZ}S?C&5zuEzbJMrcyT(^yb9hs4S~(4t}ZiW(0x3EG-4LWWfDZeGx6C>VhH>O)nT>I(YPCmbOIp#JH0oI5xJVqO5^?7wh z7xG7k(Ax-`@5GgfMKapF?Q0`ntB$5m$Ty8)T=k0#>z-w*q4ky+*M4?R$xcM_LrqIs zVhk?GpsY1eJN7)tkx~?0Oz{2dJswsGPQY)LbTKD2S2teItQlWJ(bIR zUWeDS#o({{1zsQC`q8ux@(85m&GOmwO=|evw8VLLyz`DHAz`IqyY;Y=WkTasPP>*vT}{)?o5@xY`8b zKxY6p+oLDMm6g7SM4B257N45aoj`5xogY29?U*8_IWKdUMk9xK!4k6!96XRv!#{x6pB?kvl{+83=PazZ>o&T2{y&_ zc`2vfw}X6|-s^zkOd7neuib|OlzNxxr&8>>urpxZ~e0Rty(w={O`^)@Vg+!VX z&89lUj4o7;<9YfmbBnHtDoky zVYQ*$sak8x2surrFsAz73~}LKL@dOP-C(EANRBjpq}yy+M}4QY%W`Rs*zn{P0fCgr zzsegtfpO(2z7O~TXcwH4a6kHRr}IngXy~^ZW8Q%urK$!7!PR>CUXJdcBorF~pXU0D z(*|G@L2Y4(S$);NRnue!#r`(ZpoOF~jCHyVox=0z*)gwD`Qgu?UPZm~lz@QlF`DWH zai(birh8WYphq^I+J3EBX64W-x~+xSl!~=X#m$39NFnywE&1-&yPzy-W!axaWe<6o zQ2Jopw}q5rcep7pq+K?_pt7207{nr)2|<$R2OrG+2{I_SdY0|#p||GbL(vWJ z3iX1{z{yQ#bx5ic0l{zLKT2Y+@qIyXN>g|_RL6Z&K1~DAL*sp-3R2zZ&Pm9i+LfqukP%T9BF7i{ep^Z|C-RQmY?WnrK(AniV_%U#X$Yz?dMr&t%E`; zKrxs{n}RDC?ID^S5#e*Zm|h}V>^jQ=ae)aVf#O*6O0wLJxZV?xjS!Is)y1jk$${13 zjeM8v55&-*Mu}_iGLr@ZoKy1 z-rL=9MScq+2U(W$|Md*#lBctRy8Fp-4kt#$N%<{{+$kQcIxeHp^X$5eC$IImSATl3 zad3~B_w^Yna>2_r6CLyupw==Y06j_{OmxpKIN&h!zJeckHZbs&)dxm}LXPXb*s+LT zOU&d6D|{^*#Ph-wP)Sz9S4Dk`8^l1nHGNyNg@S;9=a0eHqeH74Tu=q|lPK#jMC2P( zsf6VXB6z&4X3=;?c8s>_Y__py+A|vaoHwL1JA-jr-(ckE1lTBXG-8ng>=xkY;2P0s zULF8D#p8W)5Q!%FAl`|Dq|yd1#xP<50b?56M_n-FG+WVEJ>{a=FQkxPkT2sj+-#cq z^ioD|5M}p)aA1<5!jMx_Ogv9(7Kfr)&9En&Mq=z;ER;EJbNA7dHG%>s+`Do2ywcj7 zMwFW)H2Wum5_cPvK77JyC^66D(EPP7I`k2v%8TJKCdy&i4Kn!xK+TeX%Xf(Mfu zRy;?)VFJg)xhYdq9y{sf3H$(4vqW=os<9{~Z|uR&%lNW4rAj;-SKrj}P=cJk;2$x? zGqU*4Us}D7@66O3>#k3%i)nUxyoE&D0LDMH##0?xYM69(cJ`O&U&CMK&|4}i@EWW~ zfJOmj4w1p77dbi#Lk{)=u4mu7`m4~|5+u8WAQl?|6c8PCd7>PWEL%_r+y73HjhWKT z#w;jgiNaSQ(kWjJJ> zP>iG~6qZ0f?@CcwvmBwE!+rNoQ;U*_sRKy<|L=^1s)GX|-rvu3)POAx(1rkYkcw_6 zcYeC`E=f1B+1RE4seWw{VD_Cm$K~>RNQSm+IlW*9MU5tz;c|+&-C`BUKY%})B;SIo zWj->|4gNu!RbEjKrr1*PCi<8>?#b4N95oZ7mN+T{|F=PU;M9`puc=y>BmOvtm+ zEDZY?*TZ0A3{F$naAleN zz6oW+GRqXF-pCUMXqoz2p0COM*oaV8zqX2`_F`O(R1H{A1 zv{tLMaThQ#2$Rlp8ZvkmMAc*yr$Y}35RL^W(Sp%u`9Gr{4$PRgDsf984eSXbuJdbf z+mCCh3-PMjJ9#}3|f@IO)tT)%HPqd%=@I$%?l%gpo~r_{mp zx2LXIS^NZ<;~qjT>=8K12a9o>m<4J?ywpAdawoOL{dJ^NTOjk@bf7H$!txXmC7Ce> z$-04FPma77|EgdL^dM_IFodcxc_&WjyBTsM!K! z!rYkObNboZBZry6ZX|lo?e4Bg2!t7OYueH+I8?Lhe_vk%N7Y`D5+3s<`lpccd`U=! z$r5`QqUhSgX64o=QsfALTD+4dvG@R?UuoP$+HUc)l99)Z2xPyR*Fee7#c@=W5t7<= zdyQL&@I32(jp5@$7 zTz+3c$BZyw<_7*JM=Hz?=vZ{Yg`5vDk$<1pphQkjYdt8@_avuVUb(0A7;sJ_Xwg@w zUTGNvh{|Ewh(CaBDEAQ-uN1#+1S_#gK?upXN)2Uxr|mCO2$XbI)5uMoefx;@X>#_m zyG2SoYV0vgS`We}+M#!qQy(FQTPnS$4fv6gIf+l`x;4kLxPlW>2X&H%<}0UGnISWZ zIV*}ryi8RA3{VP0$`rQ4JM`M`vc}(QfjgB?5&IoCxYQ|!S_&RLL%|=MC-}yl5LA0} z#p59dq4(m%hrb^tf3;pCQ9Iv#QBLlZ+Zhfp9N}?3km+>w<~$)d#~7dZrwIk_S$r>;|uPIPTskvY9^VjIB}Y>KZ8P*YgIr zoK{;a>as$W(;qt3Th2{w$1=Njn7ly0H%zR^NZzuI#9bcB7^en$uw_0shf$B4%3P_2#t3Wgzk;W~B=cW(2k_5c|u+E_!z=zivn# zgI?pWCyLp8cF9X6V-UOAbl}!IFmfouK{ZS*9SF9%zmC`lqf$yp#{DOcbxqMXP4Ygp zA2hI4N@9<4op8L~6I?$A17&luSjXK}@?$z^s>b^gy>m6CBbw21I+7c$^8H}zgMLE0 zxH8ygON;iGzqkL*Q&@m+)aP~#i6%hfUbqk3M@?ds_xqF^N(SZMhO~23c|0)SLjkt1 zyh{QVnF;^YzLXx}miA*wBt27$9f-LJn}Qvu;D% z@rausSw#pa1!cA-Gk}0u?f~GM2Lt%tY9Q70vl1TsE`A|rVq|_=*SdK6*|*1W%~{vN z7+0B{*mLcs$;Z_E`>J0cx}f=3o&_N0jC|J8L`ACsoz5cXx;wCJ`-Z+Jd?NlPE0O_- zTN#a(;j~y+Cs{JdiT!f;J7!AzUGcqyuQVRbPNIoQ2`=5NUIrEN2i)Wlu2(a#rhYf? zEb~fm?``cJmWtlobGe2?8Bnn4k0oRnzLiv}#Iblg2};ONB5*2RFmNcADSro*bQ20JQ(TD%y<1~)zwvC-*9Ri-U;-pP)>U5 z(qkjCH4DPSNh;v#nA{W|9cSpwF@e7wE1MiBTP(i13#zF2#OHr6=gV}198<%sy+BIb3>cDQ~r>Y1jz>N&uyQZEj(Q1n1Njs}SF0O*r3>EoN7OM1V(hMPA7Ib-|3oV!m+CDq+Sf(7@ zM&h#6r^T8NBk`82BEpjHh4^aCCthcN{vP z`?HeE=MR~}(!^Sg1D1WlM(#^#-2y!=lJ0t=Tw$VzWY~P8H(BgT#Ut-&LBTjR6nB)I z&6tGdjawPbiUcW=^BJcC{O+mk(ckN_Nv5a0qW=D7hd&h1>7UFqO-@ug;hg z{&4j{etjp(-iViYcH#3$y++cAXT4+ekNklZ_7oX@0h0HFhiy37~M%cCV@v z3j|U{!MUBj4}@OG+V#5x!sdRHoly9PO&1gb;u(Pyjci)3o+5le#}+~K&810>HK9~A z>9=`dP~7E-bt7WQ@%^7JYcKiLq9r2P9D8+XhCB@g4Pk&;)B&I z-!QRPO{2euJU1si#k#^-o-+fzSPN}OYOu@H6;H>}&372`+vrFd%qRb)i<0=0hq zw6z!$mkB_HL&k@Jc*uZnE59S(=VSNJqc8Dy#K)}?j-Pe~qQ9<1xa^QBd94wX@D%Y?ER_fP*B=APX!tTXuB^jGUlWz0~;%x{u^n6+mjVY8ZMRi z%PQ6|+?$&d`r_>v&UPfe98`-jSCOEGFq&cC-G*vyxz%$;L%FggVqyZwI{!M;YH{HP zyJDbz&OFc}Hq<3a18s?@VHF1?(n9KgckHQVUG8l=AcN60b%M+t-fpE`o_3JE1K=)F zwB2(#V|1W1_=U6)5YzT%(EsY&NTNcM_&j-`EpMCJLJyYDC)9NaHOnFYm!C>+Ejm`~ zR$;F~i+k^RCk8*Dxr1e+?|Y4Klvw4p^e%L1HNu%7tw)kB8835793MJjZ#?n8m_Myi zp0@6?W^S*i8B@b8-p#qTWbXAWdxsY|aS@v5x}?ctpX>Z^H82T3X2lC>r7OSPe@}XS zv?+rLs5x0dVoPG3&UBRH?gKhO9?Ez8wD%t*!$t#&ff#5VxPr-x^a9O^);iA_cM>fD z9dn*TU4k{=(e_o){cWVT^mSdR`f5^#|7KwAQ6j$_nl`5<#!dQ)w*km4AD#?VT(wnb z<2gDRT(NOJSvarlOnR;E^4!JqQja1`$?hsq-3?B;w*a{Z@wL=uW)p7cs3kKGNZ|cO z_BMg;ob>sCXD2v`O_J4qF--$a1BUE>Z1OMeSS2~$TpV_0!xCChn*H_*L#T+oqHM!t8ie!YOTHorx;lE^ zpn1S{F_L{HzS6QU@;qqTb$MtUv(`VeVf0gU=;VZReq8YRweGb6nWC}Rf;xQkG(i*ApZB^kaul3zA7e5yh> zlR~09+sl+TnLA`|;NSc_mRBp(@FwzAu!rLFI6FtlHjHj}VlV25W3^nZ$Ihy1X0Z<+Fqnmg&s9qB9g9-;+@t>FhtIz%7 zWEXs1ydcxD>SZ4F;o-XNN2X>ZLnoM75k+rA|0yK6noYa8vx4!~h9TuemLN<#lmUPz zXi5u1x2Yui(J@_R~rRk*91*UfQWpBdJ*bOs=~<2(J!3u9N7MyC(i z)>{sB{aee;Lv_0czP4cs;K{1#R7X*TUQvjxKp)+CZMNbMBdLH;{N)Xu*lp8M%Bv%( z)UeSOK~Ka_IXY)Pjf0C2Hp6;Sjb;N=1|*o^@T1ncYpiGtwfZ*qH2`H1Sl8Y98f}WSJ==!yBa@N$RER;m zDOW55T}j(8zv6A**VbGiWA|2;GK5TDDGRAMk>rZYE&q9P*QW4b(co&BA?i}95~glZ zlW_dGTH%&x_1w51UotUT_i33unRiFB_Qy&$^x3i1K+=?u9Nca8FRIPddH3VBzj5xf z!CZ-;tBb+kDw@?Dki&(1CtZp?M;`$;G~~*Et?3fL$a{!ZdxP%OY-Tw8WIagqLutHv z3eg%bAbgt*tZV_7#pA(Mn^Du3h0QHBxN+|1-|t}w2VkV5=XL!U{0|5Sj-muFR(_Oz zj&@+5Iv<6&blWd%KSHya)QuCrl=YrACzeD=2#4~lWDafc=P;AN?G4wrQOR-GkeEtq z_97V0+lZ%O>j$cJGiIoCyriz6wcAK^mnYxCag=CKT*P&QCPO*O&V=OE^@RQbdcn0P zj#V#AgdezK%`)z;>SAkW1X0h%t86R;sD(Dv9QX&a*Chs&n$%X^d-n}2sKl@8X63}{ zzO6ja-Q4^2m`>0pURJ3dHiOJ)=TQ5M>mUL1bWQBP#-uFtQv~Dj{#doQj`vpeChfN3 zc&fDS6jQ!-^?T~WMdyQ$=zRA_>qXkA1uz_8_~FNo_WIcfMv^lq*?A{zFKyws9?f#CjS*oD{X6E!_TR|(sr|6TKJdd;M5(RNs?vr&jM z&l_huuOfM7n|R9e+Hyb-3M0KATVP8hx#sLZWP{=$d`49xuPKdkbS)*7x^#sRVJw@A?uy2##Eqo<*Y5S>;d)8ihVj}H_|X6&UHoQZ&+*uA;r1GhQm;qq zfzD`^ zpP#ivyjqYL}1}tDLu&_g>dKmcOR>jgwQ*%&J>a_tLfby_{tD{K%gjcwT`X`M?v*?N_3w@_lagM$Z*Dq3!wwsYdNj#R1}bCa5F-S`FXpb=N6-puS*%yzoT2nirxLP$3A zNA8P1V%8(g+N$o8;`*tG?25&}KBjp|CI5_RW^8{3*={8KH1*Mc?`nyWT${sXzV zbomFotFCz_ul;W2h-GJHE_#M$#Iy`6kK2F7jUFU1ZSJnm^=WQ{I|`f!e=f-P+}QET z-cS$+)rOgp-lbYyJhNNwc{p+l;CE3s&Ce5jN&kN9dl##|Ve|4IV^|Kx@ZK!f^LqR( zNAUgD81ehtA9?)SgFfF1FPn(H+dY;10tI)-e^`?Uko0hNWb~c&O zU`z=f%F)qgs`OCX9fX$$L=oJ738q&cv>I0G#~T+c^#k zvT4emp5;GjB{Y>bYT-G{0UDf7&bz`isQH7bJT(_K6&u`c=r%Q{@OJ0=TD>EV)olA# zZZsCu1#AE2df)@k8I*ye=}MA5O6Fn~_YoKNJY@E`**OHYZ*WYibS>6cubfFWTI9~2Jquw_T&IdCpO-qfCtL0tIHLWHTpMy1k5CqAOD<0qL6BE4+_ zkA*VGj!Ny6bv44ea*a*mjMGasQ>FB^-E^&WayGXk;N40!$-#!f82o7b_t+48k}eK< z9WZd6;N?$NSuL82Mmeh_Is7go7kmWRMJ`slcN+1Pg^1?`u#)kge?J+V#{a-+|6*AX#!~ppGg5FznY}5dZ z+%P%#c)s+w%~*62`#)?B>i0d|1tL70ZpB4+%UDRS{Js8hzo72ECG!Q%5(t=074!4t0_3pW9Z7viNm0VB zY8BJ8N_d%rR7N?wLKw*0t=zTA!*-YCmygm6eUV>&KX?DN&kvkr8Y3sd&WOfk+rMsb zsL&noakP>wdCU6ekeU6tOlM}Z&YU{D@M`pBz+cH$N`k%lu`~Oty7O0Lf8`v+wo6K? z;?>ew1-* zx^7!=d31@!=9v}mUUmU_?%$$pV=*azf3GRozWtY8%>1G&BU-!aO`4P7;r_(2uddUC9&%16y2lDj0_vVh_Eu11t{)e`pk3DS3Hc3sWkfI@_ zN4{?eGCZlucKiD0$`219B0@fkxbAuF1C-zEyt_niYUc?BKpWsPO795NAmKN3@sGO1O z&vTxq)v7|YY-VqZz}J|`VGsCFZdD`iw_W?)^oaTN2&;+jlsKc5_OnVk|HOn>cuB2ybEMi^P&zEF9%*6jRY9T z3U2%_ztSCzIi%PH+Bwo5EVix4S0n!WtAB1eS%YS+G)CTEHCnwLF zg6q4b4BZr#PwUpIh!`3tL|&@E8TNLg3eUxDc0t&lUpybXe?N2NVxjh+idF6Ghb$ED zdP>Vxc#hSV>zZ&1>N?ZG>B(_PeWBPyp-9TG8Qng0h`TW{#eHn=8&QbV`Fs#E2wb*A z!yrnjZfs;r{dTVp%|DjRQ?j`|Yl^{mxq3*0^4;Z(r82%)4~BIS;T7IrSx#<@Ocg*L_T{G}e{fZDik=iE3>2h|HG{*y2sO4hhr zrnZ^4=jsVXj?1_B0j>(i z(vYE7J`8Lxw#%nBNZ+5Ny+V<5x*=&YK1U1ZTzJfJDuL(!-6Icpej&U-?{PF3v5J@M zZa2f`AAN6c#^WD(%V8%hqFj|ZZDpF&^r3<94I0V-Q=zAp`-pWdOu=RGX^p{Y{ z#rH3@na!qPuTCD*!7%#a;z8S}SY0gB!$?jxwf|A5)31TNOgC7<=!QX8l@cU`%tS5T za8ge5X-}FH8!LueSIKx&Q%I(ldXGdBNukdEhbR#Qs<)}{)j4J-Q!~*Y3JB13sd{&`vRzNt#|ed-}fr?RZ6_I7>z>;WG5Oua6_NUm-z*Qj%>9 zMjZi?;?0~d3K1by6E^YL19u=5Uh4;E;O<5w#13nU;wjEj=M%CIe2QP{v3KXVpZE-0D9`R(wIY~_Jea*fH3Yn^2mH!m_QiO|N(#R8`Ba;0?g@+1hKj+}F_s?hCO zl>njIl?5vT%VqDcpWa(+RbI^yxw+f}u?~>MKmzr!<856aUF1AztdeKYHO+RZ!4n zC36aTZ9AtHm9S3c^6R-ReMO%^;~x0OVDu@!!I3HUe7xRdZ06d%zN&b===b>NA4pNF z^zv>A{WuWsJ-qk<*KG1km1O1JR-teDEaz*^S^An;9tI06z z!u`7vjjxf)g}!7$Hx4`*!a4Z<-fAbgd9w zf?~)SbGX@!XYFVwb#u{Z-K}3cpLNI2in`zF$> zNp5S5IQTa-0jsbUVxQiBmX(BNkzt@YQUqEmwMWiSPV+FK+w!l&`bePougfC$*(}b^ z2acaxxz`YyN1>iFBfpkLa?L8AZ@>dX&4G$WJIe22W6uM8-Md@OM-{((zqSB114wQIKoU;A>eO`ECGSaGlc|}rH}h<7deMLu!INGmdb7V@F3-D}$0`wO8p-&}qq(&YC_ntM`bhGs5mkkQs` zjd?pwYIrm3|HhrxIfY%;yoLDfpm%4Vt??aPWoy+>@@;$fb@@0dq^nY2zhUgy_&PGM zZ(Y@AqWu;DzRmyUG9!=I$T8SEcHm)%SJde3xQNX5o)(%}?W=>i+%3}P{dph7e2 zQ`Dhm0I$al_CPY&bsxyBc9)AoG7a`?GBPNjkT9gS$>p7o zx$dr=mrHrgM&_&asC>S`1XXi!n`rHxi9`45Y2-8BpJQpqaz$M~S0zQ&9z~p4v9K^s zfiHCT7F5Y@Yn~jr+nHS$vSZL_P20foFoBOsBx!kM7%2`flwMVd;!}U-RxR3O=Ban` zBI-;RpUhm)`t;rA9nl!SQqpiO=2+vL%dl4BtWgrH0%-VtQ$TD8U&;amKW6~+`2}3w z$<=f2Ljp^m`4rJe)3hiF9GbeRoqnn@)v`YOn%U7>Cm%aO(ZpvY?qvl%KW}r`OZ%$r zkJNrgT8iRtb~UNZ?K>@wZ+epzAC!CZUOo*KL@4dvcczfPZI?g`6^|eEOETK=ZCObK z?kjEkoe9T$m&9 zFMERX)bDd={HVeY>dpO_Biv1^!;MGV{7+BFJ@yW2)EWMm*xBm3q3ywajpMd$o4@uNU>~}z z4Cwi#eS-kv&z8CUi&o;q&fC8{dYGTgnZmsi39Sj>bW zQbIr8#TV$*NWA4w4U`*{z?{FdjCM`oVBQqwk;` zHpC%jL|tFo_sPnA#)!{+-Q;5Xa{Ky?CSZph1!d7Tg%N}fjCvhTzs==x-{*QQR|{1} zZM?R{Un51%4dhsi^hBu1?~zW9uJ;P=urREaszJU(C6(r<1P%VB15V^Fb?xcGsf_G|5N_?GfhR zAcz)UcPcRG-uyKQDw0S3iQF)9q}qAwI)QeI2RB}uQzI|Z1cpt)p{D0Ip$vb3{vQX0 z5$<&JH+y~~#WC^$udOnR9*cRsgbFzvp_V3h>DYqQVzwpro??qR`Eh+|fK8~hTznT6GA%|?V zkR!=&W!?SOx?hD(&bR#_j!SR2KY%cAP5Uz+_hD{}LU&2~_m4IrXZGW4TzpJSPTK!E z^Sy6#!&0quyVNKxV1PJQP=|yvnrWIN+Ha zIuYObMKh-*$!&?+DbJ2!2(D(0k zUTZ{LvvBxXGbz7m>M<^*8muVwb7*AWWc}sTUor&&^mSYq@;#krJ@g)}>C3D8lFmc% zHtXLnyMzSqJbbOyvj}G7FGITNF0AqNiQ%{u`EEV&V*EY7y*?|Lva?Bx(Dvb{YEAD> zM4}Z|<$~P?@dq}G^VUBj4s?k53y-$FR^xQn+*5Cx(&Pyuv{bVmRd(r;Cb0SH596Jt zX_eHGOv~5LWWw@!M8T-R1qx|H(8L@08XPmEml$a_iDMTf@A6u2`m}jZ+oA%xkJc&u z_rs~&DrW8GHv%i7k=Eysi=jEfkc&(gv0}~(N{^;ilVuIitVPYO2`IISS_4NudtXj3 zV*3)_6%T)>9gkOz_i4UX1yM*nn2xR;&rap&^wO#w#fF7(4nt3nhNHuUAWVQ46Px7Bj0qzG^2|xOinu{N4gL= zGNH|?WGzRtHVwa8x=P=@yLQTPXfmJSH-)CgU!?g2MLrHwMzc;C(c}Xne>@+CLX4~U z{I4NFIk+>fZUS=Bm+i0b72)`Oea||aZErZ!tAjlAj9)2l54v8Fo$)lY@`Rm|ouJyJ zX*h#vQ-@M-6ZoZaxAYZPhbK$3Q?yJ{>>0N#u`Q0wzOmqQ28_65sCN6+_vPYWsr-Zu z4{JmxlS0tPD;1;$>}H{bH?K7=0PdTJ^*Saed*%Qkx9lrxILYeSki|~^5Px!K{Lt0g ztN}u>@3@-q_ei#{9alT63mh(n}+*Zn9>?= zdTnNoL}cFF=;8Z|7}M2n^rjkKNBWgzks53&bRkB^7M)PdS1;8l2FGr4CzMgb8#AAJ zXImAczjw2MQytdX^xHEElVNEmCwOc^G|!zHyjta~knGBomsZ4@Qa2a(hE7GZeCP&M zOBr$cWr&5u%431Q!%h|OJdA3OiPl-aCX&pP;WN{sd$ZCn{MGwT-GsjGqE#ns#N=qCUj5ZAqU%h_eKX;_uA>58oW zrW>eS`fYnx$KRC=nk<$zYLo^rQga`#Ryy;HrXJ}@Yc9tB#q-&?wJV!@IFqw4?$@;L zCv_nWj6O$)pGd|(X>N2TDi2MJs9e+1`|dn#o;X8}_2{whecP?(dS5SlzwFk>lH$8w zsfMhkU^U`h&@- z05OfGhBB%E^A;+UveX{TER_#guE=8n#9*ldwsp-Y z-ct475no+Z(B*G@C+M{@Bxx?59icWS%Q)ZiwOy@Mn?>Dg1%pzicY#KC?zxvFBYR8U zTBh;-8;WO;!v36w;`JAX8bJ8*{%p*VMK=D`6ql!wUj=1u$McdC$Zs;;e@5HBt}!91 zq^?or^y2uS(~b3Lr-fTSFz_ z+Z3W9zH)*;%)OwVe&(o3lkF{A*~Egc6Fdz{opI7chETZ}(0{hannoguw>ZS&`{Mo)58!nzXuLOVUvQ$`Z4 ztDv?!I(#(r8|Iy3^JQ9@ot555W9OiDmS~w(!NUR)J8#0Kf_kBS)wVEFo5w=x~ zs&Fo%n_ZqG_2n<9%J4+isTjhVwMSAC{dS6_uX$QjIYsM2y)5j@>&X#9Bv+d9c>abd z@Kp)y9e>~aWoJ1t-L|xmregU^qefQl-GtFZ#h&Jjh+pBAlJY?{^`uq$W1i(-MzShw zRtMgGrRUhShyK5W6)M2HBbMB^`OsJS{s-j*n<`Ub(iczSUs@n}av1s|4R0?6^Tx^? zoe(CTr?Dsv>f$$vrNutdbR&7M6q}FR&zt}NqiEd5&7^#|Ke4zfS~|8pUDr7DG~+@Irf+=L(CNJ?YQj_2qvxhg69KBHtQw zLd+??)?hFehike3X8S z=4;WSh?2><7|eM#2Aho@o_M>qWj(T?q0VEaTgW~cwN5byBX3)X}0@L%uUiYyZp+1WJy%J?1E z9>nZ>b_eB2G;oT4K7`eBR7r`)ZS3*%S^3bq0^g}l^7o_$*V^+dc^ZVZKsIk((%yS1 zEnpLMY6aGjdi-&L@tsM&411tF3w#-%FIe1F+e5kc>*L06P^h22VTtwQ^wXKBfIc9s z51n%j@Zj1jZrYeo>JejOBqtbmOU^0CGP?ZANTcUcrW1mqu?N0ORSR9Y*Go>2x0P1D z`7XrcTRhBXfWF@eEA7&jIoz<7t}#*H^|a)yu4a#=dt=K*($IyLyz?${&6J$1w91fZ zoofel6^vt`Ng~9t@UQjfe`IA_EB(sN(a5&BOXVy5+P6;;_ih#r;i__6YJt@7;T3ol zL{Zt-W>)E6o!8BB!#Jj2JD9&L1D+*S&}W0^(?gG##Xz1 zc-3g@T#Jf8@qEnn8e5D9HwbEpWVnvN!jb(XYMYnibBM#M%S4N?j?WLd6#K%~7zq3$#o}ud-}~^~&ui+Q#cPn5})qKS4lf zxo@9WObhCIUG{==6POW8|0ee+8ER3R!1^9(fyYMJxO3Wp#HcCi6h(lyIZHL7M_Ugs z;ro@+@|LuqZNJt8g+dWv$C2?}-yrS%<)8zih65^`UiEe*&Xeo(5T}x%H@f+3kH*Jz zWvUI|9B}LsyM?yJ#TV}cG9U6ZggHtu-0{xCy5cVHz^{L}vj;{`zels8^r$v&OUs8L z;h`|I4#n66g|kv%&r;W%Xk^>=-<|f#thJM^9yZsHlGORbHjYokXt!Hz*HQ~&_9)QF zT|L}`Eg9SS9)xUg5&%ZuqSPoCJPc@=6gA=49%7~Y5{DrQM|Un;06h^aKQw`Ct#hu> zJ#`Q0ybIRK*8c~ecRd{}JK@REA!>gQ+d8Se21H9+E0 zH-|3d$6?~3XeTC^115K4Z)lXRR{HUBpXqozGBfL%EmtKW3;iq$?SxMuQC)N~{6k5O zig9u(p_ObG+McusVW&tM>sjoi)-s6YjRo!eg37fGRZR#PXh)a`+9XRI1HB3wuyDuD z)cTU5Y(WnyxgH8RzH(UFDz-$#lw&Yly#Y@`Ht_7y<&&)X=qpK^VnvwC_JI@kXcXoG zLuYY>)`t+KR~{5cXb7$H;)k5eT5lU{R%e^E`B*($*=p(%Xi3NoYUe0fR;XI-AMMOp z(TB&Y4=rICaBurTn}BU^j?b7Cx3uPF{n$eF)y{!&fCyRK{SOW7K(NPs z*OikUSL~}{+iuML#w$y5REqnRVDSu~D813IXQ}{Gh^D~CT;??*|D@v2hG34i=W&E% z;bfLLx9}K41d3v&L(9M35nn8@;1%`W70CA52X+rCuszBFXL8#Z5JpKV$V0RGLhuFf zUmxI209)I&EGks_fOQrOZ(q%Tw4Ec_A~BuA#Rh9u<)ZYvdRx&Ii#YwoPsI%NyU$H# zD>T-0GFq<X97$uPO$1pL0?p6722_ zjP9$sZ*y49(z>SAt55A1;Vv)j%kV=#eJJDn7YOKR+k$@*p^eLNwWu&4==#??Cs}25 z6c1$Vx)1hKb)TCkdNhQU?};h_=7(JEpE|hW`r=|3~S&iAk=Na zQfSrz?MeN(loNYS(QlSLOdKlCi9(>q=hCi!m#g0oFKWYee1s$~L_ZP|Zxir@$=sAp zo^pbS#YG98=g-BnE6OE6N`nzgnnjaf*(M2n4K5IF4zx6ERY>NS12rGy<4?B*4mv)6U~D zCm=J|XR=+02=4zmHNm%xGQJPWjO@y_fV^g%?***_J)3CX)aQxlm%v;B2|+P{nNIa~ zZQ~7>GetqCf9$xaMh$tgSvx~#`dvOxr0foY@?vilPy|o6&4p43oRy;pbi+I`4P%EB z62|?hoo%o`tT%0?y=_}ozQff9VRC^d%(XH&YTj1%A<`XHLbI=%;^564U^lX5PR2Z8 zDyk5^v2qqC3j%KXC8;9?Uc~6obP>*bAE3#9#$c{4{L=N?q>*ZRNQkyzXLqJ`g^0-k z6}b#KKc8h>%<}6P=Z#I|`~)wiihR&k+~{3=x>>{;7`=EG%|fbXTuMSp6~FyGKH>l{ zuD7HYGmok`SBRXSf9D7PpJMJ$syFvg<7^sk+Oy5J2>*#i&=v#*1WvU;cf$$WE)=h~ z9as;KD8S#4Tk3fi$O{h-YzBLLu=U}$R)nILQMCg)9iiV3HXhz~m3@BH0(!@W!XEgs zxTOKEu8U$k^E>c(WYwj@_e5aZXWCb(*l=??m_(t2%s-aa4F$Z+0!2w-VEN@AMfe`@`w? z6b-==JzvsL>dqCado$D=E0X*^De?R#GH*+A7jLMm`0{$rcV6d08NuBi6wodAIf0@p z#TFNG#E?!u;;IkGVS&3OW%vr#>KE!1LR*#>p%OS)rl$%ok#v9g{Ep2CU6#5Va!S8W-mNB&;jWPWYbj!qK#$$$-Ck*S=!USX$sxL$_Cv@4xeOLG zH~uwT#3phN<+*&Hb|hYdA0j(GmnzAgo&L>`CAC zQ?Vd~dNph_2M|j>=;l!ss5tFxVw&j}0_Vu1IBA>h3i+PWuYcg$tFwUa+*jR>MFjJI zW;kT6C9&f6verqZiK^4D8yMV*C_%7Had(~j;BND_BH?K8kv3zZ!PsM$l&Dg^yzLM@ z%U+n>ffwySv+dy27Annyc90G#%#DY)MpW@PSJHjq+H2s!5Y$qvim%UNwJ(7EzM0q! z0rx|f3Xc!+2>}9HHXY3>4Ef|Ky&wBOBJ2tKy^R;M?E?WAFKORpJTcA+$n!MsDctMO zDID(fptv$_cE(`Bqcw1Nvmt23L@3{*RsSyPEWZrY17A?Glrypp)%b`&2sPwGKY%ZP zraE0yn-g7qD9(uwXJ<%_z|PE*dB(qJZ)k4Y zz{{Ef>E_=#;0@wnY`xVEzuY*!rIO-{||+dl3CDt|F>zJ0b(I7EAalc zPRO~qvE`9-;pvSZ#NtF6Lugj0YmrZQmruibTMVfMITkP7{*hX&rhXeIJO<>iF&)K2 zLi?xiKPx_;`TWqK!lOezJ|Hp`3BC^GTCXTDo!Y!ZnUhO}qy%9?MjZMlttOW&i48>4 zLt^*#z2|ecsrHRUyM(72l<6b#Hm-FC_@1i;?WOp)!iiJ#5+dM-%Pgms>CIm4hze3b z97nTmom!7}DqsS@{YY#jc5}f>q}ohG2?WPyq0XT%W$3qq$=}D@=#In( za4OByV;^T11Xw1OFL8U%@aB@EA)GEGC52o(4XLxYwja+Rze6_`IUkh`j#8zHp(~Gw z8JJtn#LXD@qqbXebDw;M&Yb#|C-NdJUubv$IhuV~29Na$n#FZS9dv4TWn1?4ho6Ju zjlL6-$Ju!&R87RWh9o??rrYP?etO53*%3k zjvc9WI@8=)kcK^C<}l(OZ#LE69HpIpmiWUxS^o2A05sN?{@dI@6j19Bs0sGsh8l>m zTip)g@yzLNJVSBq8=qCx;eyc%)HUYA%LvgAN7pG*V=v%DQz0(Z1ZDpCP+7=>Je~^3 z^S^T2-FXqX)|ZvXE6Pv6kVIpk8JAJ0&k(8RRi(3#L``I2eRia%*~?UsqX+05Vo=3A zQWxU0;4cIu|4_bOET()=stw9*y>O}75bk`;mxwh_zfodiAzvOCv8tz&cZK@-ayMBs zmeW!i>P58A(ox!u%CcULXd9?l=kp?21K)iC2;_fBM(rPH(m@VFV-wTo3tS4CS~Q~o;^w3|-w05RA$KIx z$#6XN7CpndB1u?4$b-PE4qn@}u@KpJ&ygoH`(kWaIrkw0g>nRjOQ}ZR z7i}0R(xgN7z~9Te1Y&@OUKaWH;5Nlps@~ibL5IyvwlQ?3&T=XM-t1qTZyJgZNL5yaL#@n6Q2uOQSyQcR463b|Y6ft%~@dQoy#fqus7oILWBJ&akq4s8nm&TWv0X^St) zRzup^{~9Gntld*RQ_&bN;A_>YMpq|U-N1GL2`bl?obyXgY>x*~wvvWRx;5k)1DGA% z$0vn%>2UyWU)Qf#M?|}^L&ZG*5C5dfF#JSYF91Q0qXf>rDwQ82J3a2!g$V z2-oH5Wexs$&GzSrpf`Y^LuFpF*2s|I-XupgaX7<1XVc6JJnUB8)!{+d4q4o%|A^@U zew)0mnGW2mPmsFUT-~GYC+mcZv8%|T?08Uk@$V_BU^E$&*xq`o4b_L#B&XR0}k?P+UVJo=6b;XkG%K?mKwOlN;26XXx zUkKD+s{!VxQm7U{mvZzyX$`Q^0s=`4kwAT#$p#HT^kr27f;}Y%e>#Q5QQtGll?RJ# z)}WnEejS1~KV;I#N|gVcsv`-F%8RVSU+|2-A#${d-tM5)Z&+TP9c_>CUkSfj#$HL0+HYG0VWmbx#(ck=lZm4f=WSg0eY#-OBmS6I(R+Fi;KJ#Ew}+u$ z%z%^@5&nGVh0mkf>BqZ#CMiu2hOLIVE4qMFn0M=SP8WKUBmm$FV-Sd;H&kgqSV6CH zqHDouTav1+c_Ye`)VM5fXe8C=K9Fzzpww7cgN1`6*#CoZ97bA~E%9!H(U|;qC&slw z8scuMQNT#raIQL~ z<(;MK84z8MG~qWCTIyZ#SDDA|7Q@$}%k8&D)|3EFXay?W``aYd!^RIm+KZg@z)qdO zCS3avjpFI1J2fEKD>#2xFEx=;^Q2bTYp(6srwZBX5X*|;TV$yQF1!Gw0d_)rbOAWK zRLcsg&xd_Tu(K1*Lefg_Vx3`u0&Bnq(^f&HGN>N0;%MgI921}@N}4?kUjo#0-wq~| zD5u)^!Q!bd;qOZ|RnR8MkZT&ZDL?mH9bI@kJKDLWu$KEfAJc5J*+$Me%~u^gb`unW zNZ@o2l&iU#n&dJ+v|7!c&XV4qtB$&{X}tDN1nM=sFk@LHrY z0+vgCV!{Q{W|hzr_-Wg!oZJyumgr-?mZMS%#5aX-_Etdr7aWx>5!-(1C=%ZxVxW-H zhon-LVy-AiQ1G2lET2G00sft~BVm&l1r4zHLgKr*BJJi`#v;^8hUvj*z3#I1uxN}; zVs?=36Xxi88D%QJ8kGUUXI|Zxc07rsd?_X-sxR1Vgq$CiXB=;HN;l|I;L`OmZ26(F z_AH`Bo6qs0&V*41yTGLH9%cOpbK}4^TIg#ie-*O6hE`IT8~p$Rs9LH{W-9kZ*bs8M z*FKT)qYkXFv_e>N*y1PWv~1|t-Eu~+)nc2Y04^_?rk<^!w_`}!#;{m(o|T;7uO7+D z(;J5GT}1B&?eC%XAuG>i4`0S67&s47@!F2Ps%=HpV$%=Az?>Nq5DO+?H|%5YRU@QW zV0i+!vmr|x;I7)3t05rGEY{bGjTbK&AP=36w zxfur_vV1}5x?8X1n3)Vj*q7|7M@Yz1J3;aDq&kSZmAW5NN|-CmzJ0CGjR_h4;4X)) zFmC5v$_%nTInb#4sCqE$bjeYH`E{#y3>s13OxfErnXg9*9~Mg z*Bh9NLPf&Tp;Jd8FC0w# zQifIeRV66rb=lpJ{t4{EDlAiegf$XGB{1=g_~Y>!qTnz7Hh;@PysbhP7wOK z^{Kl}glSXSU9B5Yyw`RN2&7^=7PB zdIkWkm!FUuRg%uzL6ZW*k7U|{J*LoxD0oS?|;PS*|5$&|3T?2i*2mNXAZUY>tzNXI0MK`{PWmbh$_fdV1tnSlX zLe31m8fIXNro7F*ec8qn;1E+lc?0fmRW&(1*wbBrw`%$=w7Afxuj|RnMTZo=PtXp!bK zN%2HOVKzw4M&)+KOx}1Nu-}2iedc)YZ{r~QCywz&aU+%^(IL7D$~U_Q zXnu#cwrUyo7*xNu`B0rjJwO!HFtmw`>)Kr3w7tOALL_J+cZ~3 z=nsF3s^XB^Q*?Y=makIr%!+t+I)5sZtx&fvIUq7ELd*8(#&fyT&V^Uw=qaYAfJ!47 zrd)#NW2R+pdoS>u2&et?k z9?j5N(jp2mD;V<7fAWiW65-`o>Rp5))Zi_TQ}x9$f4K5w-axVi%hMXaOSo^L#95*2 zaJ3P)0e#zD&TbR+@kC`yb3D-D9}k4XxNc94sD?K=ey;&+2l!`JssC}0r zI(dDJ#pnt8>LsIv6UimE`!_)*UT6SY-~Ov zB$SzhLm}A($y*n@wiQV|Qk)%whs?W3FFhx7!(;9Gi7(?83^Fh<^m+~gPkK)+crK)) zM0L3ybahU>!3T^~Xal+b1h9$e{Y!}hmjZof*8tooC2=#hqnu0ai2+JdsPZQMpcseJ zkx;|849}3l-(zjU=*p|JtTQc7l|0BqrIy(dqQ-ni>n&C$FVeNuJx6?+9ZKXLb!{g8 z!3C~(&~}G?wvjc=o3BD1P3IE(n$Pf`G2M4(i}tXHM!Cgl$BSE-3#C?<0}TawT_tr3 z@}cR`@ZVf*H{L|?3Tb;;R6cbrw8=o%+^N&YcYI;(8)wDwUiXI+`zD#EGbs_chV^zw zAxV8w+hhc7+^#FotkY_(-F8Vi%M{YpiU;0^6ca``$PAwy0m!fmJlbo9@O~3c$-!nO z7~K(6`fJ*gP(EJQkb$_CE8Qn&r366jf;TbxI*)vMwSzAB0D~tzju=2DjdY(SI$9Tio`MWNK$yjBq0=HdS^Y!hQYu2G&KXk=9Unh6%pUVF zs`)b6e7eU@&aRgEE&b@wtEEYf>yl=kQoB>e^~k2Zg5KJui4?#;q7d@RJ0JP5U>&=} zZ#V)H-EETS>fOK@Hu4v3`qQM>ccrAJM~)soU`?)xv#S^_+a$HaWxl;oP0hP!d^a_^ z2#NqDBNLr~hhFBpCn<8uE`4~_r+}23-Ks~sGjGb9)J_Zu*i0%WMJb7>92*jgK?7sZ z*t0eCBDcx#H>8|6dc#Hw=pN8hL-{;?hkxn0ew|P_X&TzyHiiIq<5{N%i!8*s=-MBU zGTWc;qQ14h006thaL3D^4b^zUU zApLivGS9674TR&~6O4WyFcV8ks454$j|O`@0wCW2irOzSQX`nbkxo7)T$=>ViO!w> zy%O)6v~$-x0m|D_%xwqEf<*;HewIS5s zyT@!g;h3m%4G-T3XkwXo3<=WQ8Cf%QGl2ah2IYphF6I2Tu`_Y}JaaB3Ofq#$2qX;k zVi+YQ7A%}asJIUSdRP=Rr!d~$5JPsYc`!VZ6Cn&!_bp33u_O*7d!lf7V>#4wG~+^s zr|&Ds2atW1Hll=2;#V>Eb$hs%kbb6&{@pLLvGjj!1nh13a)7zl`b1+A2BOPJJ*B6I zjheTX^1qXcke#!cH{vkJAiC&5>2QT~{3+qBUpd#f)94POZFP2{u)$T{bSkLabk&cI z@iZ;1VrazrJzahHHuTXDdF?KyS+ST%q_a2BRn&8M(2~%q=UX+p>igtkY2AmVpkJ#Z zof$7*+p!Z_+M>Kp2xyN5pPevpZC8Oh0?(l4>fg=T&r2(qA8HPE^5i+r5oJK@xUecxPTjgbP`Et%(tqTH%W;d;JTmW z2+WX~2)7zfQJII9mkLa+0wUA5iQAkTrze$)r~3)_-MH@t`X7fRm-30L4z(j3{If$s zO<&TYlci|rM>}!(`x#49iP%Eudi-2S@W#VDq94$#ZmqEa*JSdISQ+QvMqm#5JUxas z5%kA}(LPYE+l8^jcT{Scn7R6=|1{y=oSE`bC%*LU!d3EzLO;^f`$G7e0Zkn9(M^Ew=JDPLg+7kvrR@r;rBiQ|NjJ-YMJ-s6 z`swfK6P~9F{X|X=k>K=bxJUf4y!P)SgW1Ns=I{4MNT8LsI*?b5P$Go;>f2Gg(=hGg z$16V@!JuF^OgC7Sg7OE1S#u}$_H=@Ak%QFd7KJ=nVL)hPLQL)h!n{?TQ8D;`^RMVY>0fw}1Ywi!NJwFei)_s?GyCB6 zSVy>Z#q6zTI=IZB>hv3+YEn|i4S?r00o>%3N5Ej-#T)}NQw;nA9yZh08JYZ=<^`+Ca&TfBX-J0$=>{)BL01 zs+GWsPA&sz3t8=Fox3yJd{|N*g&#=i{?CnpKH`s|&dHLmSBRraFXFYPKq~TCCdDN-QL~cH_ zf_Dc#!E=dOEZZT;I6p#%KvX>b>RZ;l(Yd#`bCQEze1^T+DVYyt1A`kSm60RiGsy`& z`m&=S76M9SXdyxkN_|rI%ZS~ZWd%YH>UKp#;JK{o`ISr^R0n=^!-PeBKi7GH89IR zPaqpCwe0Y`r+gZNW+@S!ub*1~{?{25ikUstg1r*V4}Nncd2YB6u#cdFsjOWr$S{>F zT6wk$?*e9?6lBhh^Z_Y=a0R*XqZmo%tT#gpI0Ih?#(Q$mCySX)|6%@J#7870<&X(7 zDd`k(NSr5?^UtS7l~abr&j`@5|Mzww#o`3H+bG@>CNdEP{>U&1sgCFrJJXT^S~e$- z^PlM<6$O)qkRR;7@$YrtR^uf9{dM8YLf+1QI>~2JIo9ae60xe;O!z}WNGI@j$a>yk z&U|)04H#v-0Pm?&f78s=vb%(T?bUwwYI2kd^%v+wg1?he^B*c_I|p?M z-smMI_5VwhkuN@qfk|BwdiK+D2@;5WJo0p&?9M#Md*go}!a8uzfwb3>BYm-WZr&3J zM*x~-_s}pJ^5shifeiVx8$a-A+l<7|IuZEzUlM;|PF1Ds;p}!29Xyi{e2VhdJ37P9 z0BbNaA8)^Tsks0A?OqrLeblF#%%7RE`L=ucY+GUkqW!^8?aIirIMX07%0t3YKz7QMf3$Ku}++YqnN1GYhxllu<9 z1Nd7jH5UQe=0;Tiy&U=Q)A9w8AzgVAr-{m)cN%}rO97B?K8pE&`7q>L4pr-a=*Ayz zQj$L_@tw9aSQh--`}uFFK)!s%_VoYNuK<~%bZ#Fn@0?xMJe`_L0%v#YzUE?`G1oY^ z8OLo3`T>IihS$s-#_P_SPmyBpm@27{Adhi=tJkbTotbYL=KS+I`wHqevemP4w9`g1 z1Tn~uPS1}s_Mlk`q=3P>aa!Bwb{gqNn|RY5k7gYux&Yk>`DsLP-nAE2`fnsIG6&IN zxN3CAGm zo0)t2NWoxcaG4o6~t?%g7!FYX~Sa@WNv z``SzhwPsc+5hIZ@V}{>0d8`azWa;BBtPE(m-#+_$#I?5m^DrefpWvChka$`ZCMHC| zAWWF&idEz!4=03NFz~|%PDTz?hFXpqO`@{x($L6^(9s(5?++bG=nuYaxC$SXB6ZXO#=N zS|N;Jm~yw75nib|;Y9*|=0*J^AeOyymlHqt3o;BFEA_qQWwvYqKMAw%pOEb;l946@ z&ATWoSGv@xqVb=Zv-2%Ha!uhy97vdM=;xXlJ%r78x9*1u`FjR4_8JCL%-QQX4W5kw zZp{SCNTLM#g%iF};8LAt#>F5zw(yVtkFGC)hkE_~r>-})ot17OJ6Xxm1j{;K=vVNt~mEV`5mq5WkM(*aH^+5ei13HAa9 zWmxapY*Jn5rAx1EPV&jx+KjEPOz@o-$9y)ar5i*oA;@4g?gz&M{%h>(3-e~n6NqN! zwk^47Zk~4S()2p83H-wBpb}%M0MT7}K(0WExyCMG`0pop`hO2?Pb$tH&s_Zu`URkI zx<3F32GZD|ieQ%WKgY*F19i&gU1-nTj)gmKF_Yh*$AbxGP-|s^+U~|tJ%F|UvC0)C zG$Gng3E08kLxvy;yhy0u-3^`2dbDvy3Y_BKIGv><;{8Rh3L4l0{ZP0>np36HvSH_$ z|C!QOS`dAP=0VEa^r%U@!-K+FEA#`ve2ERa&H#2j4d!^9Bvxw9S!1Ol)*7B{fuUww z<_DA(N~C|93x@kvG1QtCE zrV&F+y`>F)z147bt6`7){2!_Z1v`?Uo9(~b&Nl3~=$Xb&6OjRH5qfjL)y>Fi6Gy;? zaPgqz{~ikW7JBG^Otl6tNlSFI&iG&md9b?%(4!PY`!zfvZF#q(c#Xd)`&%ev-J;9K z{u#K8gPQ%{o5)7vo(P@-<02_vT>83&kU(cHB)Ec-nC^yZd2ft4$RUXl@q z2OAj%Ha1s5@xMF7lD6{f;1#={W^LNVdob+o@{zU*(<@p7pfiWiD7(d&_WesFAh$89 zc2n=`b_=F&jzLm^Ov19c=HZqzy|5YKr-HFs11W?g;Xkehtn2q#>fZ#BYB%mG8f`3Q?wVyPVO$8!aoOmj-kyg$r0+0%s%FG+GRBOeA z-20g}yCIdOt%uzHTqC3l40LIS7Lx@n1|oM*o6@EXHq-uMTM?ZT6w%3%Gs-7bx8UX> zP=1KXlOF@`28C%TqT+0b)68&L^fdDpv?{hz0C5oa`fj#-7bESqbk_pXU4)4D(s#lyv*tyN=^xNvSOCGa#GN#->30BuA@Xl{ z%{ug?S+k{|+!l&J1(g(#X~?k<8DNO-fqu;>ZpC5lwW5piruIV+1oa+&dUh9_Yo!Sd z7CVU~63`p5)#hpYoyim5&ym|8Av)WOm=fq=V6D{>&}+T0+K>XcPS{#AS-0#x=2 zdi8Kaj5|Fu&}@xM``xjL?PO@$(=<3VNBL{xn=D_q^U*$S6%b!=HrQldam$Ih z$Dm{&csumqqn7OBG}d#k&6wfN1{Q#@2(JTthTA$zl1@Jd{ouKEFt;9Px1ua$6;+C} zRGd}MuGy#!$^JOKmPv@Wm>+SL+7WDc|2=F=&-H;qBDcaaRMXG`goi(H-#FlNKsg*ujY$BhFYI&9^7T5h9c3>q$sMgFQaK>9sgP1 z&H^Iqs!--Lq^&}<-4wJk@i|Fx4)SlfBer?5#Yj0RH902JXGid{nsw|yK?1bCyFKQE z#$wNp;HnAqemf%1ketkX8FAo+PcP2tAcdhpq(2{X7U~$QY1Z)>l&K#?;_!na-b9-6 zPGW$_F`|d!F8oB+PLz4gybEV`n;#zyJvfIZnTMAfJbOw{%Ud^JC762sl&L*sy*YEr z84?wkIaMZPt?AtAH(?1HPX3y%=A{36K3UH=$OisWR|%TL&zn+?+CS#ZpI<*n`1NCW ze|Vc;x^9?vpn?{q5{O{X^IP0ZQlO=*&!h~&ek)#r$|(qN#`azY9lR2FyMX}{d-Y-2TBVY;%$E9gWqh#$3f1)pP9c# z#S&LrT}o)eyUNyKsmm0irq-<%CL{5QIdUjwD}M=jD8Q5e{rUd#*a`dx;HJ(XhlV@3 zetVy3XH*x{Nwh}NU<{pkt`E(4AVO3P&YNGNVyG^#I#)EM#|m8@EF>6E+-p6+Pn=o$ z=C)3i1Qs0s1@bgdXzvHSFEc>&*hRc=*aJq~*o4PV?1XnH`4R&&5ZFn17-(HA%)pd} z(pSGU4z{>|V;*lE9H5~oi6@ARlYNZ==doy)9 zh8QBL6+Uh4!Aht8GYMPu#b1jNilTHLItIVm#A=0b628%?L~%*t0}A%1SxH>cFhWcwu0g zYlybxYb34r_=&t7RQ1cIQvNaiTDt zp4798IPE;{6Zq9nBETYPVtGHMJbhjBN=wZHFo!NQ9tlYoL}14VsD__OYDHF`z;uoA z)8hslHQ(M}@9sfal-a#`pj`WY_-WRQ(&YL>$QGLQdm+?`A@ZQs>F6%Rpl860Vn+4CgIK?| zluw^^RJSAtHQ96nKYUp9r~_ufiN=(@@!1$>JtldPAQ3_faQ{4weBfivBd~`O*I>hN z{prZ?*6=v!AW8J|xPfOxa1j;uG^|wq7>+wXH>*$bq4crO#bpmy#<9y2{R&KpGYjoL zS_`dyIP?%BL=Vr@!Q&RKl%~eY)E@+cumVg7NCegt1JbG1Eb~vv*nlpoWdz-8#&hYr zmY6g}^W(x;?Y9yU>+e2?@Poxq>1zvZ;IR9v2YtU4cvI-7RTAi@oAC7hH|gNq2+tX( z4$45YALe_#->hyheU(3zzP1=e&v4#O@d5u-8r$#zHYPqeO8$I?(?av$v9rYK5vohJ zkVDa1CwDNMaucREeK^$Gnw=_jok)0zddz2~s6L9Bd3d_#p!G@3cc0F71y7O;=4xw| zohNjzYrXZcZY(#3QQm(3RNXO;pUB=tbXL*+>dh(5WF2oCl!~Nf^eN)WPWyb~ib(i@ zY-fB+Orj6tHo=Dueso%^72gsxLS5>&@+sd(TZ%f2cjil_FTe741#_~2xM`5 z+f1Z)X;MF52=Ta@{^jY^MT3J}RNHOM!E{Z>y%h8{HHyy#CVs%%0?imcB{jt-)&lALX~1Ozn@~!tSs03(d*(X_<{VZMCwW4D6(6t*LBjozb{<)xz^_(CT1Z& z6CLuie#+q>ni^fQ?*A!yVr{Coq*LQZq=)QRN~?$55d9ZT?)!wCkkx8LvXJ!>LsX9N z%UjLbtpkOs@g2vZ7;RpJDq58&y^67#8t6kZC})iZ-z;DEUpnc%_WR}F?053Wnc0;o z(rgv|Sln>H`fMDD@xx`lk;%_oMwQI6s0{)m!KL05m%ky_gd{6L;2v9{+7iclCuugwpk z*A|A*Q)2f95+>CG2~)>V)&+xn4i@N+MJ3r~eb*T-hjy~ub$biZYWw+xWK+YG2g6|( z(_BHD7mV5cSxfA!cQ0kvrGnE-LIhakJ`AhnqTKNMG6CJ?cQbL;<4PBP=F4SV$uZ0f zE)~NnQ+k!IMf={@RXr>BD&3E%@+!ll0r4u$tMA*zba_T7li$GCYd-j*X6}p+{epc4 z+TIXvd((Iz-T%S)3El)cKG%mrvzedGZefTFC=)TsErUXw#{<@D26Ex3^_c{^@T&9p zPZ86W;#Bu$#D~RWX+F6_uJt!f+s}?K$P}M>@O^9mrp8pP9H|gVB%;?u5{J%CMMpUp zXwtIG^U}OVijJiP1P?tJRi9{^x!$EgiGA96h92BjtVRFOhB`Gdl3adudC;poQ`~Rv z$+T2^?ZRrwZF;(oPO+bZ1?GAB;2!NuG7v9*ycv4eUAmOn_NbHUSu51J?kSt^p`9-J zOU%tJo2DbE;<@X!$EUa?{uG^dzvxbNui2ITB|*mQe@^6`zSv(`(0S8qwxIrDr=8bT ztcQ6zIkHu91iw*;3dJV@+GX1Y8gZJ_^9ns<6)lM*_;{O%4M?NoXf^f@I=1mC&68f2qZs==g-uTq-A+*|o& z#FU5n6d2U}cX=nCwH2|+^SXUf*q`VcCE%*2L{M@_C5Yf|eDfr!l1-Xp=n-#VIZ+kU zsYZ>=5FaAC%Tg{wnWRW%QfKAZcq6@ue?s{i-J{eGMjK@za4^E_4LC9ak&u~vnJri7tm=;m&RnU{D9NG-dPEv$6-bfdW8{V)2e( zxciCQn;}H#!ZENon?$!tP4EB$i9)tk>}oah&K7kDc8{%n!}s1v9d=yspYq}9%BH8O zS^8@A)b8Q_Hg$M*zrD9o3%cuOdWI4~g-Vkn+Oh>)sWA`Dex_ z$&vJsjSR0mny7AmB5g32Gx#(oFLreQaq_#(fd0}tXi$>A-rP~88E@KbU=0JG3sStV zvDHmJ(vMWY`HKp<*38e?k9&{br>T(zkG4E&eF4t`17g(#+!`V)zRP`4oK6N?SM1Y{ z?lL8aIo1c+?z~Z5RG4vU<}C)3o;WifXwiZm0Sz#%94k zeBzs*Wy%R+gtmw&BXTKDF4e0;*WRO~#HSnGb)9e*W+3EN)3Tk7Io|Q3K}-|09Qq`8 zc0pTl3APW$o7<^4dlBjc0B^!_Q~!G*($|`29&B795gkzxBrIcIXW8)EahIxTvO~0~ ze`DKKHRqG$Ji6q}nePszg#3rqvERBKo9@i0l^>v}9}p<|S{QJqmP90P3&PCX&+WCJ z(@z5PqP9}gIZu~wNi*T(@VKnr^H!XULPeL|m|M_F*iw!MWW4gw!bOYnZ}Zxa}YFlw@Ie3Ru8~(i3nP$hb z$3HppPUF_X*@%HUzm60*5w{?W@a(VMhcvJv-M?MyQmjU#DLE#J2(~o@paz|`y-l~Mq_DO>72j(H)^B;m%tt#21k)>2K@{ynwb@kz(5r0B~AuDcrgFcdiS>P z51C@*Af}jeBWCzM{y|4Sg>EHE8azF~)2m|vfu91{g33Ec5z~nmH$i0%Tw(+z{3V(| zK>Dz)VsC53s`#|ELAl~=^_6nN&L|vzsMGe5)pOsR{zx;m+5H_IyCcVLW@3c&swwOf zT5{;kHkTV5Y67kUitDyg$%8Sbj(@6~CoQX7COj|@(8>UJr(kjd91Ti}zkQs1o9Td` zu)AS@U}l19J9qF%P-0B0pX5+PUJa^-A=>qWtnQ!m;T4#OY2D{zo~&5h$wL_0}i3y#=1HOfhvN$m{sz{(Q9|4 zN5T&mb3Xx>fFSe{^$2!vTbigx-byO9H8Q`;PD<9_7l-O=WMnRtS43lPZ42Acl;BF9c2|gCmw= zrT0Y=H-pKCnakce;L3P{A-Id9n{pf6#zRq_YB~)LcQR)uiejPe>q$bzp``u5;t;M4 z+(3WJ;g>Mq*5cHOLoWE+hgWTj)dwfbxN(_uUo`{t3D8F&SXC*Fm8~H?NFWG!4jNu1NrY z2&VCn?(J7T@E(k=m;xZet|{P7R&+V*$y3kI3vJZ7lAJC|y$={NSaI6h1en|tBBX^= z|MAej9tB?fg=}W3fxYe<;M4}w@-%;({PGw9uKF^W5cIkY-`OnlBYdxm^bbAXMRP%3 zeihRc0DXV{8Q8AaA|hyn2>;@gJ0OeCAZm6ikGyRJ<39;ticV2&nk*iKR*cuYNiv@t4t@!yWL>B@gK?Y?lFU^fKIrmXbVZFzSvrf^i6*x7Xr1GTl zRBz#;8v>eocr9b^O^lZxkE;bU5*nz>U zjDGADaKp~@_SN(&1Dx;nPj@e}7roEnskw=TzB+Q?{3`vE@p^zzM>8u-m7C$UJJGXV z3o9&){LO1O^yYxe4K7oiA-)b&4AO>~O4W;)jJwz#HqKU3c5|Tcu1WM4CxOU{5wE4C zusp6fojCnC!zNb^qDuQ|aJt9I{tOND{!a6E%#I6<>ykAR8|Kqi-g3oZPvZLWM|_-d z#{Q&GhEg;G@l&;C#Sbs6>x-~R$0a0xnD#fC2s^Fy+2^(|3z}G{eHy6$DBmDnaW*g+ zsBWO-OTzPqT9I&+*HGb0^WD~^8;Lk&{Z%nJjXxGxhqe6AKHn6N*79c<=2zNv2&Vcg z9fkj3MR0|jW5F{ae9o~LB|WaE7*H44nO0*7ZZ*@}ZQjN%ubz`8=b5(f4eWRaF8B+Y z?UhV3vWN_ucSf?ChFwfR*?DCr=pIWw6Jsj>XW&_96Df@kzwbVfw^mC{=4=0Muaf% z!Gxwl0)~IPn)qbRH5cFI{h=^1$V`I9A9hXmZm*jgSU!ER-AvF_XIHxIz1{gBru1tD z+LGFAXYs$paC3mO^wz}+%@?GmNDJ7`D6de%E}j8Sywi3nC6-8e&K4w;%X8}G51~+P z+p34yZN>RPqR6`bi!9jvVpV|OS01t|+S2Tn)Xc`b97>+{IAt9!j(laths4(3^ZJU2 z20{tj&Cv2$fqdfu~3YV1#xA`REKS%gxuswao7b)@j>x*^P$a z8bI%WL;k*2#Kqt@r(M1*23N$VTD>_k&UE2oBTHMpd+fRAn5;s$;HidRSvJ5~bIt`!jH@!@?z25gvyb4Ba*xs|#+i=y+~_z2vd+9&dx}!^N$AFCStDPT^VK zkKqGe0XJvPcn35D(hZhe>S71L&+Oj$@@Vc#o3Nqb4#SSS<38k?T@6`?xQ6L3&j)zx z94}?+`zWCoOIzE2Y(Qr^eQM2cV(SS`Pa&K8TLQvuQlB3hIByE$DF|@|-h2c{0-{)* z_7<-zJMAJ|F(r4hzWbyGnx~<>)ac7enY9<}-=nukj$o#+?b_V;INbSKdczE_ZJ>VU zK$u5uMQAF^$v^!}bKqkbvZ=q){_M`rm5yKjTNY7Lv)|N9}1FDI&U zgx<11NjxW*=9m4be(2DpM3>QPE>#ajkqroTQytwR_-cR$zOn%=d48d#Z(P?S>)T*H z8ryGys2%>0f2As>2VP+|gOC|1a4gtctk>t1+8<-p@aAx_73s~pdlq%`OWApk=-x9V z-?W$U*cL*Hv4m+?OvbT<=jAHCnuz%7Shh3KMoMtN6C4HF2%W8xStXM;zZBoQ5RwAZCN?t}WrY!+6 zJ$iqxqPypeO@MBB{rIBuS>ClTtUoTv=%WEYadgDoZ27~6o;i1ap`|TUriIcp0CI0X zw@DQnW7anSs#6`Y(5;@|spEAu<=`K`hCmD9#=)(XoVE&p%>Ds~fa8wK@^nKIQm4F2 z3#YeFahzGGw*HbO4lETLL^58T(4KQw;0LCEP>)={Ix@?WLb~! zZv*}<`Th*P?D-;OEn)?Ui;K*GlkRa0;Zpcw^zy6~oJ7Fy9rzuoi#;&y#fL4p2iwWe zv8cTlf+h`+Ka=~(U&y9Fs*jM|Up#UroO!afi;?@05@4DV_9yG(Z~I-U*-Hm2nkT8H z)Wz-cI7~)cPFM0#jSzkiY6mtcEqm@!D~wEqjMQ)<;HJ{De4qoU=t_t{nrf}qXlFsm z&L4#!tbESR#7#m?!;>dO%`$#56t;gjC$NGIu6 z1vrh*4c#YY$C?2Q%!M2_T#exF*8M#p%=vr5QEACJ=dIzP{g@rQ+zFF(XWt3$ku^El z5fJUHsbGK!vkqH_)Byl(I3&-C^4|)1`mdKpi|(JEd=PLhYzRNS9kj1eR)gpa$#{qE ziR`Xtf=6(fU`t$_O}G(M zBu9@ybY!_r|DYH6VD?R=(7zfSKlJd)&U$TSo^bU7yISF2qTCg3?D~xOa-51KS}t@Q zC@te$m(JJq26&~lDqIEovv9(a!?8x{OsZuxcQ1U5mFe>pjhlKiWK#+Y9Z;Oh*vHls zz3P`g$-w_61BA7MINW|@BcBo)g|ImJ@Z|<+MW5&0AgYJK0Kl{N`*rEFpIg>rc`&)85BM&5JZ`fm2`kz456%!)bjTWF4#oV3RU2P;q2 z?0PD{_7oT|AA3W~?cAt}DTEuD@G%as-@~$-HNg1WARq;Z02~rv&BgraFc5~EBTNg{ zX#QYYaorJVRu||t_$p^Rm32kBJKuGmUWAPo!ALV&zXI+(>maKJ5A_|>T!_$n+8528 zZnlDKGEdM%;F&4kh8+6`aR&rZ18VSx#m*-C5hL!1l6O4?#c-mmg9*I9wOn5$;R<=a z$SQD#)5fmRsGXZ(_!Wm|;$Dxo2(Z-grV9sqJYHUVmvJN^AyL6svnBzC9W^~!_#b=X!JL`b(20|A7W`` z3%7+|J`{x%IKXBHOfy~9Nr4yY{{W#XB=LRXSNZ~(83!w-vhsJe6YEYEK1n@T752gW z1?-Qv^6|7rA=lvdx3yYM-O{>f-gK-wD1y1&C)|toHRD0w1bSphE{#8&{nlFI@|47_ zWyceOXGbMo(1ljO(OK78sM~J0_F5<@v0h~x&{qTsF~<8kUx!o(AAz@pZo4WilGj#Yqhe8%w0b>z?__?_ojx{8;p?N2)am^Fv)bBM%=}&*Y_-B{IY^4FM9n&I%^FdSUWt%IP?uX*LScbDun^ zfMkXMVRs5P@M>yif^OR0%l@uc_y;`|lz0cVCDfj|^)7k~Q#;e{O2zROa zdO$M^z8@o;6BboQ<=^$9=xdk4uCHA^_P+#(s4N;cb9MP>LekHcRdh5l>z?W8xoESFQPi=N(|-AkY?YUp!-hzZHRL ziQ=g|zY4*K?GL7GBvqx5cJ$ExrG^_{V1oG;`?$k^&P0aUG#Lu=AjHlN4c)`{9$Y0K zSLzdUdZ1=5TI7ozEkf1|H#TC4#kMAR%RWFc4(CUf%Lo^tv4ZA^z5Tz6Y|6|9QRIG? z3sb7UdEBN{Et?~w5W(e!s>bCl`&fQx>#52fkKA|fGA?T1%n+w)^ok>UeP`<7m1mOE zJ7mW%j+>EZcp9>_i)U?D%a$_s;U7+L4l7Ru2+TV4Fs9SxIH)U#BmziLcoFy8&z;WX z0eF2#7X&?3(W2uNsJGzg5$cB?(f2-qOkxoLk@vDM!mqgq9^`PjX#Cd-b3Ck+Ql8gp=C(-xbkY$PaoK|*~CNP{Q4 zDWM@u+XdqIiwl0%{?6dS=sJeD;v7bZBj|h-kL=z^xv3}7t;%jb@|KN!l0$s$l#bl- zyX1t0ZU9z&?WpM1aLf|cj3-6WQqb6RFCdxVkYF1!_m874H#& zje**iJ~VQ+9Bz0&H$buZ@tnnj7B8%MX>QTV*EFQel;1fD+x?&Dy5lRsn1jJvAUsaZ z`{nF6;lEeN)vI`eOyq0L^IkX?pp2|~I9(K(shOv|A`p)~_{f5&ve6a8Fm$#+_U-vd0r!F<+VOPJ_ z)5GZL85cBO`C={{_g2Ur7>m-y-Mk@b+VrcV{ki>_>;dcCq4W-)=0WT5sR^my`w*Ep zw>sKi?^2d9aKAus*wwXD5M(L#7MBa_uD$jgMmB-N6FVh1o~qn$gW`f9mHSca+pL82 zE=ZVOP!q4~3n`cP=hs&mV#uM&w z0p#39tffbMVNqj(ZZ(9Dn@zL3ubreW1}|?ot_AK&kZ1x$0zkhg-a1rFdE@eNk6Ccl z&2R7X(xsvA^rc%aS@16CRhaET$haT8?V?~s-NmFnTZvNdbu2SZP`E%v%Iw8Cn0&Tq z1LixLhcvP5arEl9Gw^K!l0_`9J?n826+$5@VofXhS-bVhZ%UfuqRhuV!2~bB9pE3GRl{$4S`R-k7=hqqztp!4sTZh+O@jtHlN}p%quaUKGa4jxyLr!ZI4@K8?FlYa` zlIYg3auV`FJC8q~V_aW7aK1uwH+Llzh;G{KG`Rk|cVH);B)Fa8eT6OGT)Lo9`;p`` z3++9+y*hP9je>#-h&4u0<=3;$_$={NGScJ8x4!!>wf9Ql1;8Q~A2^rf-5d@bo#EC6 zR+?A!>@twp?B@b3oOqApONA$P;H=e@s(^Ff*muvHt%DQzfPFNcE>m>iua$m}gTx5m zfCaOuGV`H)BS26WQ*gGWT8=t*ik@Jz)|Pa0hmN$W4y+!X7!tDMB z^f+ye6Oi9nhb_29S=3h|#*WC<2VUg1r!=wnzDeund#~X{%!g3mRj$QEm7Ce92%!2v zW~S9ydMNyfbJYov#1}_vNInev!G-C!;WOd%!VFZ+4quIh)zE9jR{9AAWqQTj1K&AI z4fE503-8C26n*=!_9@yd7*o}Q5u#iGjZ!Y?gGR6NW(-GI`zuK|X>_1+$c9DxIUCl& zPIj{TSB;&*jVf#^C(l>f)5gjl!zl(lD&>TRuysc!?b zVP9Vvy)r&^Rj`tuT6yb~7HdEI}%tz<@TJ6 zd)3}QZbTC=3GRt3e~GRRzuD2)G-wx%yoivvE|ZJ-f|em->Ox1IeRBsZJVhhlyM0rY z{WB~;M)n*BvG$v82pT^Eto9V%d+|V6g8QOx!42l|?A|iHuQmx5GfFlIL%3w4R%VP( zFF3XR#^UzEjnRNszpKq$UF^R;FVMkIq__zR2#(|<;vD8|cERlDsM^AS18PKU#GitD zVag442Al(UZ5NBy{$MkZ5V36M1Ch{j#76Y~Vx@N?U?feRmsLL}$II3*CwGu7FCu6J zuguHdz_xV~^%Ck)VB8ZRqt)-{fLEQ~7L1AD2{cLY4mej&i6Bzq*^CgIf&uKSqbUL%!v zVSnDUzR_BEtCUpeT>4~QN|%FC)UG;yY+Qjn6W5^FmM?#h;zXpevt6^_0ZVjk&=$7Y zk*OA8n5hI}=Hv0pbt1C%4?tvm%|#k|cNQHLfugd>J`6kr0U2A$$$-vdRP~qW2EqcH zJTH3<`>m?zw%r@O@j1SrWpQsYU+4zjL+Z1=KyiTc=vwR~QGQHX7P!gm2tRp_a^Tw>wcLF(}%TJSSA&+lD64;yz$W}z~ zD=p*I{a4c-1HcN-;m-ipCS29DT@Ck4l%H5Xck*CeZWwIaxu;EpZZ_v8kf+ekOxwn+ z$Aq634zo4$FBZyN52H0Krzxae1YS~jONS0_%i|2*s1oM*kCI*;UCR)}P`C$n)`xuq z9%nEO8jAT8vvW{Q;lL>QFHpLE2EGaS{L(SOYOfRBwRF2| z?OD?fdr-mP^eCY&k!_M~O%BD<4Jj*Z^0lM1LJ&rEHuTcGxh7nxV#HJeCvoL4IH|Rb zy6eT>U2jI}L>oiOUE_B(lrOU#gnhOhdBLx2yqYNVA_l}q4}Oz`cPyRZZFm!y*D?__ zlG(6wdw1sbaQBO+CZfA8(EceCy?Tn(25AB*lykc=bXrcJ!=Kf>46#2t1eQ{7NIwsK zcUd~?^|Sqed$cBv9GONmnz+$K?Vlt&5O z40D4^<`7tmSz8xntCxICg#nAZtosj?%~l?Gl|(*jE4LXlPms`Z+OGt^h#9(*fGVrH ziv$T#LTfo_qxpSis@K^!leVO;hF6-(t`gAA$4Or3 zHW=Mrk;6Z?VG4~CF;leG$X(jXY&MD|c`)c!A{5<6(xYWF!Dv_cpm)>b;(fK6m7Za8)5r!iGN1! zw3Vavwb$m76uPKjU6~=~gJWPn3(G`XmOTE}=$J6{x_NLt0tzt5zq{Dx(Gw0+9u+PS z6_HSp60@+K+Wsaq#3No4?Z=6Rp0jRQFH=p=-)bt|&vzn!6Yc`3nDxj&t*F4jeH8Dr z6z}tFywtK!Rcgn@Xvzkv?85>3rXp(> zTg%N}nv4yGfvX0A$p`i5<-rZ}qRNN$%6)SGM3Mevgbth$GcV0_%;duUEcjZ)G?0;X z(pt;!(JZL1ShAk!GVAvNyaasnpmT;Ak#YORlA7;*swPF_7+Z6yH%5x8ZsCuaNMGNh zy>rTTbi0ecd@O(GUFvx;#{-naJujR$EtxGIl|Y(3~iDD=szJ9|dP$A+8~!2M5{}t&VSKsLd|C9}f%__g zSLO6<42ad~I2NrJ3sdxwA=wxCisH~9xFPpCSNSIqDUE|#BTjuD`w!}$8V8ILLas8x z>*b=u%Z%uyK0}crVqt);?I1VeA`4}r>L_VWlGf!;Ay4G6pJ{} z?#4DM9<-ejl-|OS*icPJIm(cHls8cXDv^f9e`sc;pP0iWwv94lcfJtUR+ro<`N@T2 zXo0%|ey3nJeV@lmpH{S_@;%UWa^sBHc*e?&f_T7^f0e@`-vv(GF62i zmPKi=JUCtwx>C3TEgz-^Q*c{Z8rB^f$(g3%*uCP9*kbHoM|)bzZqsxv|PBYio4QDq()6uSu`~>_(0aE%PD)=8zsb;ke zVPBAT;doggH8t;iqeIz>30f@sFV>UM2inTUeIWvT3hKgmF>38*#!*QPtTR)uGk*#N^6zDq|_L?rr7hAm|2fC)_ev(+l&r4Jla0Wl;1GVXwFR~ zucczN{*d>7`9>1-TFQ61vfwC2VwV)2*n@? zmc9O+`L~vj)7)r#vPVl>BPc3XD@bg3ZRg|>CXlP|@ZzeImeETESwJLDHkn61dD9if zR1k3YI(uEhGG zZ=n7EdKYk|s_?Pwt0s;i&lO~teu5mrj0a09_)%G1S$EbBe@%FmEag$SQhT$b&=DyQ z=LJDf+< z`+XSP-qpW!DSL|c*W~vwF3ado*SxO+m0=k})E!k7p#zkf(!m^>KpGYlIlizdd2ro?n8lWPJa zrUs>$#El^qkOpq3;eXyed1~~YTbm23w}ONX)Pju#exrv6Vm2;IppPWrY%TJq1<`SF zFgHf?wDs7zA`CXJcRgn%sYfpZCcm1*1Plx`_8|%VP6ba!MBAs^14WA53kS?`)lf-i zxV793H0pNk=?x8Ks))hL;+z6aS1c$THEJd%0}Nftks|3LdJ;DU{___zAMx5Nnm267 zpuMNr&yc?lWq|IQ*M#l{{Lga#^I5!!_FFg*ppkr=45`2~Z$1}!4k2<~ChJ~U|8NJ# z_;IpebvH~c*|viogB&*bhT_-<)tUlKFjfAHJ=s}54(npkVDtM?h{K-&YLniro|K>+ z`%M@@PYJpU$-7C=_vwaN)Erx6S@b)G4SB^trW2^xB}xgC=cO992!UIh0hjFsdhtHwxmzVaAA6mzLTSF$cF1~~~t#Ump4$70I8#X+^C0g^xW)#mJK&s_UBEG|?0z@$|h7=KH@(Z_xT6N&`DM^-PxfTB?&q~)@p+0Q^yMi8L+ zWE%7`3^zoZNznbXZU0<5c5O;}t!V7-yDjM(GDJf81gQQo`F{pOE_^G4M0GB?9;!M~<208j!~Rx8=oL zmA(K;QqN{;)Y+mIVSJ@YKcPt*pq;9V(*~3`YXc}(YA5Q#ZsI`HOaT5+FgsB>Q^{u0 zJm4quVn;+YH-@5Q##~CbKcC%y3XukGT;*LR>B@M8Z!5O)6Lc+;^OX6~%s~1Q_Gve( zj|A+7`7LVpGV~}4H4|1S5F;?I+xgUZBR=*QeDTe6YMSL1LHFG0f77W4Bf?(KfXD8%hN&+2K#q`-?_6dF#b##(|~;1kaz8U>dB|0+;SfnF`3K=OXiw zVA;M!_C@sa)+LB^#aAa(enYn;*!T=hvYK0X|34`3sL@WAi{tX;L=x%Z-NR#iYpaqICt7e8PNUqO0e+3g7WMpx0MyT1FR+`A6@x0CPDfe0ru}E+wfohT?$- zUy%AA^V{*n2pK7Ok{I3(V(ToRuby{xOp4xAZF={5fnRiRrMsAOtrJoS-hC3a*#WMZ z!V0n9lYKY?NeGDWsrJG46eOdRacVl;6*sY@@BsZ@hPXryfs0b+>Oa7^PJyti;0y3b z0hzKt?=Ak869Fj3xgY-1#ZguDdW`p#19_P#3va{!eTnxBrKQ8%k=;c>*wNWAEQu{R5ZYjRf7K=uHp0{=c$*4NS-0d%0r z1mFnC7ns(#4v^?aaf&IGB?Y3TWBB#@w^o#IZ-C1ufkoEfK)X~E^0Kvz{j_kFHX&9H zzKV^nF6IgwIuhd@eISn{DxNw@=Kqfj|4Ru>^rR&K?N@vzb%FZ+(#q0FT^OP^F4+#h zR{(TjS2j*ol3EMzo5c1(KC<8h-6uQYMA_=hZC#zJxMcoR{-m%Ny$2LUp5$_onmn^T zG`?{!-LSL&WB|z87@i6u=HgBfOg%$kjklX|gK}5!H<$vjVg>RXq9&gQ+{pX#%q8gj zpc7HNI(+ODKw#*Sm;Y;6Ij-8@;Ift+K*6{xrsj*dZ^EtaahN11lpQWW-WVRXxRs%3 zHN~~)*Ew`2R+XdzuPXv9ukC;!`MIKgQU&DhwQiRdj2+g6sc!&se`F#6Ujv{{Tq0ee zbjRi7-2nYr{4zhA!P-nc(|WqLi-#apK#R{$ms_>>Fm}2#4vj0iT5Y4Y0{^_Y-aFWgmphN{`-0vf=JvZ{)b?;KRM`oP6h7)*0nQl3suxB`wQM7ru90D%aIJ$ecf zU@9<0iW&vzZB5?^N0ZuslH=EELGj0DY;b|4yYnux-cM~Ut(##%31D97RydEfbt=0L z(nR9}Z*{<0y*pcN1 z&1P&6#Buwx`}z3gOQKEf0Y<4LCIz%3r9f!%t2|R}YJR3ATCdOSt-B5FV0QhGwk`lz z6+SGfw$m|JKVe#%9h5mu>-ZSFSkm5JRw&(V`P)l+P3(4nLx8uq6OiA(yq)ON#k$Km zn0y2s67izQkIW2_GVR$IU2JGei^BiiZm{T&!cqbc|Ef5eEIZP?8DHNin0zhBD<|J| z0EZ7<)o^f8y_iZ#>5t*ASpDiPI9Tgw;%;6)d1M5NncP4Oa4Mk{xMY|lpj6v*n<{}4 zyerf5@|{7v>8p*GCEd&98XH7s>QPXk@k^3;LPOUcah_h8pZ9c}#chc;o@+gNL#I`z z_&Gd>%)aHvGXzU&0oS_dL7>KlG-NTd1u|q4N zOY+53zMZwlXYF0JeXri}`)=trHwgdztwG@A*!1bmY7sXI2Kswzx_}QTx?1_dnB5ds zeUQ6i-Py{iK){u}*Tt7`BsBVBy`NPJySS)lVfWh$Eqj=}#-FTP#01^T4wPf^0Gz(l z4I5H{LZ>_Ll~&2yDHW$q#ECNBUhu~s`B!BqJ@HaZK+pKRG%1g#0!n1cB2un#UAMbZ zbUS}^g5CZ(RqrxX2H0B?_pLQQXGyXI-xJxWFDm$TzgngOi1F;ojcV-{&9y%s+8eul zWCFC`nYJ8d1_yChp2oZ$D$p)wb%TzZ0VQBbcZ*esZ{0yO*B=la7xJ&mi4T_&$OIdI zGiSrk+vRJtbBy04C&U{OCfW_g9ch*&RX2Nph-#$Fm=BI;*MD~a(I@lSN`-OqOo%Rw z$+Du!W+xmYxd2mo>XY5m(iqW?S~QzhF+G2k5oB7+$6+yZaU(bZSQ8pb)?QZ6v3(RP zclyg@MK(D;R^RNUc}pR`sCbvBe;-V=F>L6K_N@K5B3WE3LPzU}nhMno6m0$rOgI1A z8z0(hD1Cu+@#avQ~bM4J~E#G!#N4CJx+ela(0I- zI1n*EGY`_viHdG3s(=(WmFh$zV?eAzk%t%6^gHT&QcD>~tq8*YW&U`Z3ph;`AS3Yc zHt0ihs;3@Z3}7#R8!vYxJ;qF`2{g0;N< z0l^MUXRzz^RC+QVWYe7h&R3vC0TRO^>DUF$i#sKlmrgZ@W;#rP1v#9qy_<^?XOwbR z#73_e8%r4A zUUOHV^M1qG|{iLG`rs#1tx)Z zlhq^Po=~_d=pJaFp-80q+~`z0ZQs&j`ES;weTk1NEDds~3dd!C_<~3U{kr~1WRlq) zubU+iAgSYo*WUdeP6HN{y?u@ z>AFAHb-l0m^}eqAzTt7X6U~P~r8Eqz0@)qn2{1kda1cL45CU~wTbn%&J=>nw(d)MUrWAGZK>PX4SGQdQIQUB`QNGTm0= zraEYgR^p0`r5d`%?o;)`dO%maUPJ@b1osw7<;DHrse<@`?kV8qpxYNV!=GQFtfZdu z@??6<3a{du05uG62V##~(!M|V)Tk#KKow2Qx}U-Se{I8_?pcRRS$8v~2Xz9h)k@XH zmw=`pgl`%@H>r?5_rg{LOF;g=>Irz(SoWDKM+o{yUmO=7)kXrAe6%F3NR|ZT{2zCK zobS+#u+`HII@q+aWz<%0ol(fRus=PIO}Z$aTw<$ndrtkHRQmy4!HMFhp#Ytd2Ztg6 zXfjd)Jk92=6+HxZHw2smF3wP|T1*9}THtxjb5@vw?>+TCKIB>9=Xd9W-om=rSN+8E zpCt-A&%NIBUSc)!*{dP<*_Fe$umY`h8?9Gdxhqh!IhcC*$XacTk_@EDWUKt*nr(Nt zx$NBHj~^__^AsJ=P`x-`e#3GkwtS99_Zz;En_F8F7h4nfAQr(JoGxq%tcj~BmBf^M z=klf_mr`|g$LONDgoUBaf}jnigpC9~>HM0Mmug+rP2`yAkfk=THX|L8S7x2A@>Zwq z@4COu28`;m28n@MA}8BFH+~4?Tc#!lKSVWpa&!WwLmIvEv;+Kw*I5$;NMczIw!+>= zTZ~27_&GZw%$0>he4@~s*~pI`;qS_P$UDL3sC}JG4_o9*y*WSoM)GA!WIQ*EO>*G# zK24EL4dXFMH~4okltY?xEqM8DJy+7y1dQ>|a^V5{hr3y%WbZF_`Vabb`6kowg@@4o za}_e{58(Yuz%Sp)Bu~h|nPk}PZvQ{zjG+PxnE0_ENy}mD8YVxC0P*&^g3Sp7Ps!jQtm+C*d8@>zElDN)r`sq{k_l!jY@GpCg~(OZON17w+d$ugW$}#J%DxN7JinPI7t_-Px#t)#wS=a$G zByfm?Wu>z1LkqAMfoBaxOxL`B{*5| z8rGXJNow;C81%}v6;xP`#atO)UblxQY$3wBEo7-iPT(^12=j3FFWLH8Nw+<*Tj2BM zi3^V#{&k?c9?9yM6P{crhX_NEh!$apO%5d18w7=z$2y8?crRfJoC)o^&d!Xbjj{2y zuHh0?ihJ9Xsm>9{g*M#$V{jr&+8H&G^LsicSMJll@--KQJL5P#cv$v6u6 zLE<|a$U17#AdF5LrJ>@Br_ij}c-0SKQOMA2?6;CVv!-_kNSTz-@G{iWQ>EGgvHo=r zAzy9lChnu++hUOBc+uW2QS^M?Vy;?uAN%Os`D<-#H5uP3!E8)d29y2<{T{iLDh!ME zJOY`gRouj~`YVkv^1HrV;qD?j486>y+cSb64ZGP|CqAiTm#8Z=RX!iGc}1}Aevpaj_GP+lEHcEqk41(-CYG^Cq$uZ6I&tF2b-plzRistnTzHeK zON}$8ow4X5_Ul4Rz95u+ti5qzaHmibRwj4|L@@v#d>B9!d|2KC9wShbNj5*UqlsKB zHNLKq{yc`~y*iw)nRYZ&l?XxvCl9~m$T+y!$lf+nwQ}GO7LiCtW=%Sz_f`;K-Q*g2 zj)EBWontr|RXIBGPp8J)@uY_0Pu#S;~vM{(6S=UxIb0Nzfjjz zRA&@(aFl|wae?p{ZkYZl(<_gM2q1w0DDAGdHts2TPJqo`dM?;S6c&QOyoD+RxVSDN zS#>07&4oeX(49r0axy35N74IC3~{pwmalLLHlBY%tV4e|_w?W~j{KJyq&XGq(85ef znjnKvoY3yCY#o}?&^G(t^OcCj*#Z1A{{|AOw!W!pM>=wg<&{hABQS6qM^r@k8tVO40C`qVcIrvVNT+jZH8hKX3Y@7GwQBU3X1 zCl+Z=5g_=|FUC}NiNfRjU|reNFsOdoiX>qd`}AnYz}Rw`lQoU>4{iJ_Q*gvw zea39k4|)F`(}zL$s#}M8zJo}zJ9v$-zlK>Iy7d+@z9843MBbsS$-wl}YR?+SN`_09 zYlq$IK(wue<8l5)$`bZNoq)X|H)niUtr2n=hZ+3l3G-iXc4WOE|JAJ#*}%z>zh7DC^}qJd>vtX77E=VvBo*G#ik*PZ*$_T_Ose5eIdl`Dp{> zU@hqVG#U50`Ifm-2;Qgm3O8%}!>;EpzJn>)0-v;-*aCmhXEzn= z@w6(*1L^GaR{MHcSauLbRl@GbW?VBU)e6X)33)mm_sj>`H`~93{y$Y!{t*7~Q*#3L zD^yME1@5cP{ua#Ha^zgX(+z|R7Sa$B&k4{hOCrQgXWbB!jU3aYOSJZp9G#uS09XeX^R@heKc0?-3^vixay2mD$@T ze9Kd53JgjOn~CwxgKf{K?o z{8iw`dP8(DcvTNmmatk8M$JsOiS{DhrOc+C5G~$Keal4Rd_Fb-Jy-v`(MszlwrBye zgJ&%|ZAmk5q$k80`;#)X<`M2I516TsICo{&X~uYlvrzz14U|8G1rWaCSr)UG22n_5 zY(;I?HszZiYFMOwN;FS9fTt{J zovDeys7ZP$hx!6ot^CPdI&#eF=e*y!h0<1Y#;d-yTKjQS2HE*A<9-{7rs9(~1DKH9 z%U?{0eaQB_Yerbq;ZJ;y1)v%~%CfQN;vi;C;~Y$)X7s7;%8(K=BPI$OjF@q|#~dW-l(~ z-GlMytI-FH6YaVbf5%B*bwP)=tkLJ7RmO)FIFNnUEzh8vZ|+O-1Z6Btkphx2&Qa8c z+I-Pgc3m8G2mx2V*?NLCb$G;)02#A+QRQSz8?H5=wGgG$SA<}aL%KsqR<3RAQ*tu< zRAZ8EW;posjuvcCl@xc_9ekzofy4JFkbck{jUUjM*Q_g@pU6@Jb>_9*zdSU|nkQk; zjkod30n~J(kqvye+o^RvlK9i3BgEo&SNXy@K>~|}iSm4^&I1>O$*gt&MNaOPW-h)X zuoJb^66Sc}Icg~dRIOyyznqb9d_@cX-F9bsi2Q|!6pqo0)r(|E@-g!e$?c#_a4F!6 z;;qIx14GkuE5j8I+h)f3kGip16E9WHL>fWWrH552T;B{PD*2(b~&bF5Izd3-Rcr#c)pO{@JE0y%>)9{$>((`U(o^ zGYf*bJ37^(={p)(08;7s}o434RPcmG)xK{-Wp#=nI^Pro#L5 zkk?1Q3b@FVq(1N%HQ5-e^^(GPi}jL{j;N+Y{RcJ7gF5K<_CJ>J&2%O+CbmS;QES2j zUe1sKx(fZ36)iRwV$)Ci^ENBC+F;^*N0W3NM9QBi7~RRi$?o3(>LMxVn9J&eP?_eN zXHDm#madP{430mTv}RGZUX0{;%Vkt#Uf<9uTo|+(8?CML`e3{&!~uEOQY%Ipixa+A z`D4;pobqJ$ThNZ~?csD1K+&n-;2*zh1ML{VfJNoE0ov}r9|#AIOflYII&VbT7f~t{z#9uT12b7Ft%#Q7}!&PxcIm9k{IF6{Tle)BzbSHa2MSJEtsOwR*L9XKF1_Nw)ONqX`D*JlHI27bXh(c&7OMKdHv8Zb5=OD86l++e5iNJm z10KSP>MAXdI?Ay3XIN9;hgK5@wV}JyQez;zass$M&HH{moEa)$G>c?To-biqiKBHV z&s8R+&w8ox8n0~wCFI}^7%VXzRQbxJGFd8mYb%7s0hDmkf4U2$rZ{tVH1OVTT8Jio z_2}Hf)1d!x(#4dZeK#B42c@X`+}7B75D8DOc$abK?*`VW3X_ z!-p_8CsRi{*bsduLssejWEHhlM#kY6tE8 zwv?$i5ZiSeB!4&UzVf-XDC6}#V&&=~@D|K}Ki}lqE@(cvPJuYv>{NmHA$P}x8((Q) zYdLi9n<^39XDkt$oE|fM^B!gLqJ{J4hOf4dVlIqAS#;;DYABOG%aRa;8{aXtMM%bO zS||6wgx?+M2D}LvrsK>EQkYS z=es^gMx`}E=ikc#KRA$LcS6$VAV`~?N{jp&Qy`mccSC%hYpnOA7wR8e@>!KYT&o}m zaqYB?+1nek5dZ~Z*0kqM$8~XO4s;wlQ0n6_7xlDi$SiiAG-E$HEl_63#cR@V9lBja zQX?5C2@Bu{DDN{=d{;maFP8P32w7cLh)qpoA1c3vrKKxsTEb#j~?oDnwC$ z#QgVY^IhSppdEfpMd+Kd4z?Pu*+8077WyIeB|u2n^k|xcO1aVY=bw6l{yYE;c%6uN z4}}Y30*>4TXd`yZuKjOaiE!`@S-nrwzcpwJ1m@p}ohRsDTdd93o2vyr z89LIb{yBQi{LT|58RF3gT0Q~>77%^`8Cq*B7O`3{bw}4(#rTY-Es%Pkm+UVD7W%~1 z2N)x=W2T2Tu^fr2+5wup8rE|{u$G$xqly;o46cnX4_J{~u-$z``;_Ut*Q+FrlEpGR z9}5z^CMY{5iIqHT!dcqidU$xiyejcq0MAn)T;zD-D$pC~4q5mWI;{K_2R>lrpoX}$@GA{d-)Aw90OPYuA0!>h(!8w0b~Jph1g8&|2xp$o_HZzUAmAHw zVCPI8WF;5?iK?~w>o48%p{~dYWIral+8LZZV3!T3rB=bZ0V+OA`(d-@{&#K@gyOK= zMAal`Bpnphoujmh*eADv&{qMX$1s^?J*>kbd1@%OHddbSM6F*RE^+`+e0DUF<)h=k zTtP&6u2tl;z!n}p`cI-bU}D$aJirAtc0ZT2RK?F9xx&(1xjSI{nzLhtsK!m^HlE1Q z;PPB3t7EzODrL}IZ7+GK6?WM0M(TM77H9w+ZD-*Ll8lPxrCJp z`dD(Yg$39Oy0@wcmFq z^C3jZ_Po*`=a7qVJJD?@j_`6E+te`;PySM$+dDvmlmHn=)scaBdS0HP3x z%ONQk`yci|E~hO-S8(rt(M4M2hFfTEn>mK=xG?@;88o+Ri!#jFrdKLDppbER(QZV) zvwih43dFyC$xkI~V(j?*k3}-cIf4Y#4|oJ%Z(lk@j6^e#DQtW~H1b)+aw=N?$ZDxr zyg+yG+B$!ksi(>Jj#e%_xAq_JoU~bPXptXa^Tn4Y4&qzo2bZo&xfKF^Lh6vPiW^A8c zjEAjYkc|cWpSL3XwDnK9V^?pe72BRA(Kk`{T+^p*GNZko&q8fqN-9mdsb+`G^KosP z+AKEdYtLx_43QE1RycHz0P$xGW;_mtm~*AA;lT3?7IQi=!NxuPO8`abG*SMmYJ zUBnfbf_BT4Rx|yXHC1Q(XzYnVg+=;4gGI#`2BdL`M94`igz`uvaxY$lKuCn{+m=y; zpI3lfn_J}uI;4i1qGEA}!6Y3(R6tdS8}r((N{x*4pdQVBsT2n&Xr0q>u-Qjkul z)sBd-4G6ClL=YyVeXkdg=t7V!ac7LXK430=2g8h6)7ecj$;EbEWCjAR(a?n00|*Mt z@dt;$KM%|vY-Y@CG3S7fh701|jdcW!%Fb>UDBsL2UT_*@i^l(C%d)#FW`dK?H}o(z zyvL{jZ}YSq(&xuuI$3=$(B;B?iL2Y%2|mt=j^?zGyhK%)-O?ghf{8zW-YKh4&u&D6 zXl3tRWC2z7(eo+*f8FB5nwseyAj8C=&rnGHuANkGW6gXMB2esZ)nUT;dQXaS&!>gS z=EUb&<%!4KH-cCGW!JG=m{FBQ_=HP88Um8ki9-S4_Ov;(2Uz|Uxo|$IJBDROdt)7n z>|k3DKWEM7>2J=v*e25DPc@-`7gXdM@Aw@^p+L-R)x^%M)|d0~mI&qUefZ4|f_@J$ z!4R9I0D|uATo?~Xl|~+x1Qe`(!hDXtCH$v?WjmwhhqR>O2FQD*ZA|3!&@?NO0O_>Z zroLY2KRxuC^{3|&_4))Gl;M+RqjPYLv9=74fFuoO8CriWb2&`g3a?u2$bcPG z3#c=rh8g4cu5nV&s(aJe6 z;D*_JFmee;KIiPFx)}FxB8kD;4j_Im;0GAO&$xGcm}KD`St@cJoAqq7iU73nq~|EY zTw@6su$V2!q@zcL!9d#TKCb5W@hW$gX#Of8PRc*{*@i028gT~$_Ino`aCbWja~9^j zDV+j)*(RqE5HzGgC~lf_0i%pYLfeHq(-vb9tD$#*jB^es2?(6rE`QKcs`xmneQ=}a z%#5H0L=oe2Ffmau!P-R-PP_w3iQIZ%Fuij-HNp77C(yzGSv2>vnX(V8-aC8v!^~OeQ1dvUeZV`Z{IfMCL)s>L+Q=k|@)hQYw0coTyj+HX>AgQFtxLAX!=a=4t z;@!2CiG!L;;Q&l!ny=Mm7;WY=u34bDU}AR+^7l5wm??gD?8qD%97f>8O1ECodLI~jO$(U?8}mP7$R z8Th;MfSPk-<-ysWXQWmQrU9(U3Lo5K7FZ-mWRdW3Cr8T`FkLUQNtIA(Fe+U4TL>s! zQPZ-iQ?lNlf`ja_#i;%jyao*=VFw;K_)WJ*5qU_)Ep98@{J*{o+w)^Hf$i8gK+e@yy&FP6bDzZ-8y?zY4p4Yt>T!A@p_zH&w^Q}qSF&jT8uXak zI5^S|_RvNgt2kI&!EtV@`>DEqffDiku!Hwa3q$2am*Ta@LIEJ~^>U+-jEj_oNPr(^ zj8h_s!kpBF+1smiA9};%_qGp^&B1)(u?#pBY+C%xTBaiU352PEwphp1Mc1uk8lkOS zJbgDXEzqkrC~9vmoH_pVqJG=)Boa0xGo#`+^Y&?kM;}>(dJQmqFWo1Pj5`nxgWUTv~-Xdd?Q1rHs#1LGD&D)j^eadW{qL`Y4IK3$Aj z+9_QKpoiqedw}HXuigPxNd6S?Q{$0pOii@k5#&HdK(<*{YI=H)|2+eOFhmCZWPA)Y zKq(mnI}Af#&3>DNCnE%3w_v}*Zcre02vg;5RElh=4)o8uZQC0Q^pl8n+R7tCi&&P@ zsU+=+xj#|5r~%X)(kgOdcmWETmcCCLp$BrL7tAIljRHOq9N8mnL;yr8l&(?v3Q`uF zUHr|Abbf~x{`e@0YgV0_j_c{UN5ZNy9bneg7voJ<0PT#kRpaV!noaWJwy#^RFfm(7 zeVD3?PJ<+=t}}K&^(c@mZI6u?r@QHh4ufDbI)pG%_NmPWIC!jzG*^8NY-BKQ3DkH9 zCPJ4M9{exr5-0hzS=&S{fOHB0v8RHr8olQ0a0%W+H)CfUi^8rz5u@2_0)h|GX{&< zgm!7|Ti~`{#J+A;{F6S)Z|o#_rMc-N;3;R@L&|==ABeDt-TqfAv>npNJZq%Q#pqqZ zW#B8L!^64Ug@zS{jO6Hmb8sZIfnb*I(SR{H%swV_%2bwOeu?F02e@1EHBF5q0Wcyl zH6TY0U6hGs&6jHPJGS9(m)mFI={oQC68#t6rtwcm?-0DZqtau0eytFdatm_87Nz|D zbP5HweZmfqREz8^k?zPswt*cQsUQoRosOw+jB>TpmiPUBZ=HiAl~ z^LWnnY1I~Xljxtth(hjOYTW2GmKtyP7WPgo2W3L*G^6^3*9*R|qUk`d+`)>TcRMWA z{`*mx1LTRR6Uo4)EKM;*>jtGQEFF`c(c^y~WHwy3Zmatq!@P?;0(OX)G4P)$GAFZ+ z9k`0o3V_vb0EhSY6X2^P$E;0!YV=Rvq3Y})Nai>|(^{=4r{T=_P~!)@(A!)KWuJ#? zi&)dFso37=3@FXZ1gvxc>ONH+G8*Cv`i?Lu+-I#5D`{(JFwu@`gN>EWDHJhBvxl`N3HaVFWPz$HFZ4Y5 zYdUDmB>!sSz{!AiLTK_@Rjb{RAyEOktph_c19oQUxN~97hY?$q-?QSu+DqUu(43x3 z69nA;E<~?E^P{)z=bCw^@gJHM?%5-z6N~xJd;QgJFe;1q7XKa6i>LRt@5ZE3AU(Dz z%3DK`hj6~2Ar3E?dcFZ0GXIlPOSGWz(SG1;q^kHoN~MPu7V8(GBRf=y`1+)YEL1TdnyH>l;xZhy!#j3g7;30R*EGY2A=|EIbe3V6FWqSVpnw znN6=afb5&DmbrkD!sZ48IA2w@Ft?eR^4|f;Aa|SZ#9SLyQ?`+&-Q4$1H5D6-Dy;uG=(G0P zg{7<#X;&Ol&*ts|K@!UHBCs8XNnAs5K5!gJf1Eu7bgpq7Mzj_%3+nOMF5R|?_byo! zI;VeJYSIpIG%#rt7M?;uKiR-^67PR*_9-p>?i|d0PoYP7VP-Qk4KM#&6s>nK*}3f+ z1rmrb&(Tc`$*Qw-KXtzU?2L3_aVm(niy+a8a%S9r4n)6)f=TIQ`33*J3;k-wPk+`DOUv&h&+Z%E#=u~ZTezvC9P&LE~Ci; zbpY43K+Z!gw8m^FMpaKFfqj?}_dLkBi(C!DTiq^Mb)mtFR|nfJ2LMLeYXL`1>1qI* zT<1Pv9_sR6KAh6IGPUVyD@=W!Ip48InMuH_{(dm_c=>Qlo^DUyIUlf`qEk6{;Az#1 zx74^KRW zL?Oa<=Q?5-KLN~!`3dT0MnmKPD5_!jh4D|+n1{uA(4MIscyiB_p5gU0z9346UN~dL zYOUmjPuAQ2UekPgUdea2QMNcwr=8uEG!)uc03_S}@1;=GZca)<{v;%zrh$dGt<1@v zrA@jb<_QYzRkab;ch=M?0g$Y^Dy$cCTgN%E$sTDJqzI%cjyCtH%F4LSkJiJ}d#*g1 zx^$(5C>&ZQ3|TJG;t^)zN83SX)Ez!XW?@J`lKCyH3v`*cE0w%gO3TlmyTHy!P3+lG z1yE1+aAtpP55{Tv+~S&0L7xFOMltYe`_LS)mjj7vta=VqxAEs-1V(iN^0CZ|tIXyJ zC6PVrp)Qnx3)6eV0Ku%N=rxqbwTcNJEfI)_^SAXk?=qBCaO&eb|7OM>N4!A>J%*@3jNhf%#o&84CJL14?m zn16C)RA*2EfP|`x?|^n?gVtmY<2#LJMYA>KQtbnT>ZXpgjZ$jVjEl$K3g7}gk=cy4 zKBiVw2CfL$DtamKmX3|Hq`m&@G^L40D9`&FT_cim^fx;@l|+FJr~iTSf?^e~zB?f3 zK?OS2CWm$dgtiS#Y*xylIXJ*67qkf2vJer$JE(h<;Tmw}HCLg*a zY#pCMu2Ias(L1O{s;+hgGEtYR_Mnd;3{@-Ivj#Zi*XJTW=+N49p1BStd6!O!?N{Xw zCrYjVxIb%%Jks zcGFtALriEUVkul)6a+j90*ulR?YW70PKaBEUZr^XoTukT#Zw2tc7bnGrLX6$=fTGK z^?c4c@BC)JP-Ju24XT|EFL&nrXb~t!@5lnEBuaZ$M(=qh|K9?Q5_%G&{92BU=^KM>HKip*$qw0$@ag>31xa>qr0C0jEwPH-RDf_r6#_Zx%h{W@y!z2J_@ z+K&ggq?%K!(E+i8mLQwN;p1bhT||hz0PL>iSz0OkSk)yM)6&fLr^^|dIxuXiFgyMC zeEA|x{=aO&5Mf2Iuu#APgvYe2R*h$Rkh~TAVp}^kpWc9qc>MypmnOcuC)$wqc?*85 zhqEU9ma1Yv(?R#Pop8KrfPbjxtBp)zOi-v=ps8aEF3bj0`{CMJ!$U@@Dn{sdktx6{1>q#RVG(hwn8|xLTIp3 z7_w4WwsPVz)%=s#|E;$>N%$CWITn*g zKMa5Qp7d#B`qX@`zQHY{sH7sSnWn6C9&Q7H9kkg9akD{H9yP8WAQC|f8bGY9=k$QZ z)ikh7Ad_X-#(xSHbeQ37+u(R{I7#YYbd+cQMrJCy?qqJRDzE%VL2m7FfPjgv5fP+X zpV4HL+6RsNCr&N1LB{w%2PQRrXa!4+zo+XrPwShP+}tN^*}vJYUF%w-xfqjL&eX1* zd|oXdlCs+T1z@?5vDebkNDl`T898GqE~$3|(DXfbGvmW(rN{QyI6mEM4VM4cQE*fl zAmnIXex%3LHZyWaP-r7H%qek)m<$FU!~Rp9sPnb)tA1;xUJ$l27n!emK@eK?fWNsQA0KR6I1Iu3rrrNj|u;4q%H0~5SY ztL{NZDE{Y@R)0p4!*#V~g0)*TlQ9RNn{d&)H%&u#;MR%=sB_l&&t_wdonHX{R<@i{ z3_7{jXIDyDiOfafG`e$(Uua>jD)S~tGtaLZnct<~EfifN_>_c>$5f-k;Qv(AEp?3$ zIjCo1%|u@TMu#2l%A7ejIuB;24gAr1R(#!$4yB)FfUgZ>WS-<1dt5aYVM;N14wF}`Rrw08JSJ=-h6ZRCSnS66NK)uKVK1o7(n z{xG`7xvlxD=UDSI#IEPr2{obtg|7FK<{R{Pk{@=%!=3THig88r-?C$i=sOb55Xhbr zx4X)cV%WFHUInw?^&RFD4Q~~*1-$vci_DXYL)!Z+;R%7h^hAz=WEz)NoFvP6GGFWc z#ptvH6FMgJh??0pw`LI_QcAmt-?8nqvEpU3!w`I;C z@4zarZN4N8we+cvlVRgWZW36MRs4^J`X%`A}okQyY%qyD^>N+6wXU#5Y1KNiRkU-gS^j=>2{|zW<&;qV0-A{@bud* zucQgwlw^s_i}2zN{eAo3J=_N@Y6vQFT(|QReY8&_5$8J% zWQ8refDR@bXSDqJ_*7(IeTH`WNbiNL!v04F^>1C=xd>Kki0t$6=q2tQG-jyyK^Lrh zQ=kan)$^pwC68ViB{&l}xrQUC>e{MGFOT|at2;57G#MNx37snGLJVqfIKiFJxY~+{ zvti6O(Ll&dRsZCPq?y=yT}02hdMgR>M%JcR+4X}KF&`ce#WrUJI*0UkbTLD3SI3QR ze5UrE_g9a^;>oW0)#V=u<%_E6Mroo-^vL9$+)cKd|_Fm|8jgyo`93ANmE_xR?aH?W>X!Z#| zHm)3fapYjBMi(dK`GMHlC$YXGF{MA+IRiOHgF{o;?8)k+X#}f2&ch-kyQ{{z%t_tP1%Ih)fOp?bAAssCwP$lhSdM)JW+!xj8y zMenY-c1U|FP$;&!u8w#%v5$N%C=?$do0FTz=T3j*I)YtHvQr<3KkcHTW&mf0`gW2L z(u}>K#miJ{`^b%^3BQb){zu>XY)u%m-&kakq2+A~j;gQq9 z`CLxa#QHcR_o3(Y^=@&IVHL+S28U>`VfBiLu~%L4h3K;*VrQ#IO3Jq8}k+w=5rU$5YvZWfL7Ov3geiEnNW`(}J!d z!-jqEYF=V+{+{PJ2Tqaaa3OUtF0Q?9&QRKzU3JBUH@IA*g5qAPdm|^eHtuOi(6BYj z!bIf7+Dn`#3o@P@tqep;G#Q{KM%vk{{+U=O2nLixtTrI_ih z_5GH!FS?xcM&KI-!+*BY>W7LZTQ|B4M?AdCjU`EZ^J^zuFZo=$JbcDEmZp?_{%^tN zE|bVrPzKn(@jli7UVhluXGT`nrieNnfC_G?wIRZ=}fwkHa$Cgf0 zFx7N!Nw5a;87a5c4ctf&88kcxe$KPh7H6|YwCA0}KUGGyBq15W>FqnffAG)e1$TQB zMZ;2v@5-sARVdYFqKFC%%0nk6MR&rxW_m?^!ihM?k)~2w3Aum#B3IFJ>`_-J+blk4 z|FEI6Rdnp(;YF^*@TgPUnN*{^TvFbW&LPcrUXTGA1=d<1*e4pu@N~dBY>IC?5jK?Y zZOWq&%v7<3M@b-@9!OaNfbvg#F0lEi6zd83BY^fr_z*y7J%bGPovR7d4m&jG8vY4A zStTU>Cx9lecvvH2dXzraM5oqn;M2zL48~T(ygk_T?V6TDpA!7ad*u&kw~PS_vqCOh zbh5XjYnW{j8+16-h6>v*TE;d*9VDr)k0{FKb2kzrd`$J;6{JNFcjNBO169O9^Frw5&ON#lG0Qt6UOZ zvM;li9mEt(dJnbL*Plo@9mYQHE!=mj_Vs&kzz<(?1J&PiA`j*RE*!YLM(;uYTe*uO z1E+T_mxu2=zDwwOEnAK$l*YA_I%RU8-ZhGL@gP=`6G7KzEYrbAM(9ax&WVHgF1r!x zV-YTC%Fl3IzS9L$|83rq? zrkYfjiyZjE+_*6BbqpSu-E$06iVh{Y-FQAON-Y00Z{V(90T_w=_Z#$hexv&rw~q#$ zVJ96pk;l5GhK#Un?0C^|<*6?k*w?LzV0kw&mg_Bf&fe?x4^$*Wj$#88zrBiF z2w%OPm6yI~m3>z8A7>-?gf6ARwu*{N0gSSO6l{SL;V-%MCoId?^{ekPF(IpbLzr1c zUAp5@aHsaeVFlZo;(a3O`nBK6=P4l%s>_tJ;}b^yUd>*|U%VdKNKs4}e%iu&(=lrvAbCpj$W2lFnUw>pzme0I)e0%&K&-(_jn{22LJWaF zoO^w{m3=1qsCe$pUv;?LW==V)&XHpF`UD11X}wd(ESA;gY1Bkhm$ z!%Dk1xAPIc!Z8z{hgLU=MUf|qa;vS|ayWHC;>b@1h!OEA@!pOz1L6zO4n^7L2S$=k z&izQ~<+;SuB?I+gkyj%ohe9sCP5d`Sl@YBAkD=LGTtEuCXfOp-x}<+?S2$;U&a~e)VsLH&)clv**XGK3v*kjdjpb;C#jT zd-`5^%%IdJd~NJHF|wyl^vx}FSGb0xq#p@D@tzNLqKY%F?kYOoD|zP8C#q#lsa1); z2HtNO9a$5YP<|bjuqjV})(QW%HSj@EG211tmwn9Y4V#P-?%KEs;XGDZW$-1Ry19CD z$LOTe?cNYGpL7mgep6S!_|&vMDlkz;y=un$v|UxbJljOya?X?c_e{3P`|r8-e?=f) zoALCp^uNxJIx|n3FzTlxeMsP1E4x28$z0cxMIXGi7usCLr0!bMIe94R%$-^{?RTBf z#hu5OD_rF0d_%15cXF1(P@vPhG6q%N(i&c9cizF;FuN99`qRfu%8i7+D_tkD)!xUw zdY?zovcL3tf}P|(@>P|+{ukeSVexo5w+~AgRT*S;G{2yTE2BO99vNnY!M5E8Rh^Xm+06?shFQ?+6DeiSX^M(th{%ZxV zf!`Xh@AI|OfnJrbViw;F`pu-3Oc(bk&4I1LtX zjP>hzkvFK$c@s>259Nz{+@yD8du71qRYHx)FJTlsBaM z?QQ;@z0h}Fma;V!?jQHTo!@QNdY8b>ygUq@|5546*;eg-PC|Hd5N5dZ^X?`}T*8m> zt{q|AdQiQz>52Xl$)WQMeHrc(EoM|Tzv9Waz_qP*yMRP;ta z4QR@**j~H!7zy9>s<$oQsbx<{AGn9-od8|H&kyu2jpVr+T}r&*00{*Xm+Q|mo=iP* z5#P?E&-Ol05>2pck-$d#y--G(hg`&s^a!SvH5@ySw@ObIi3cXpyy&{A&B8doxG@6T zuU-MAziqv=HTx<^!}A~6r#FGXvnTv0`48$=w;dFK6=x=8;v6Le5^4!vQqH8qr}No-Q?!JVWN`+M z=8G|CmMq9hXmRYC52y+5nICi0?R4*Y6~6jp4*6{wdVc1%ha$jHEmqU`&5A_)ZvlU< zvSv4gZ1D2u{h85|XcG-9pAnjH&Si2`>fV?tmU{-Y5ENMGXt$_^x1}+tn(A z(=^+I?mawtsBl&B4Nx=EjODgt?_go}g66epu%3 zNznSd;=klh`kwx&ZCP*iTC#fg3Ei#}_c*#pNh1Pr?#M`ukQSHg&)wzyw>LPA)JwLv zJR+0#kr4~^yYP<3>WgDbJJklR|BPrL8v!oL+i_q7Pk3@Z^`*wo!CTw$Lut3A{7T zP!U99-D6uy+Zd^4Vl1}=jo-B?Y4TZ78R!5KI`pdbe}?7be;v~290{qV`4$}DVlFg% z-~G!N)kQ-e2zqUvF(o8nUMXaiK3NV|LiXJ2X<%F-)5rAD{3kX zkndV-ljCNVKtgLAxipoYzQ+{50r5{LGy?NOMAG&qa@$zW(RkHl1-S6~SIINvi6l{h=-<5O$E@akP%n~t_82ngeliZ8bRChdXNs>}k#ih#;J zn{Man^z^NTJHN!qkyXB)Xy6r6EWMg2V zSW}wFo}d8z!$Ezczr#W!A$yHHnf{Ub`u%G~@1=`EySZ}cvEAJ7OSy6vO1p=?vrHa% zJ?nXPT^OMuX-z0r65U;b&;h{&0p+!95A;FCa<@BV|g`b+ODdi>5mUhn_;;u(i{l z<5CyAbnIUbHMpjs$7~+gVG0z>rEVf=WXJC}UeIn!wIWi$l1S-$aIgEsj&dukD4{#f zCj%HGJKqazDvCu0x_ncsRjfx#CUzR!5l`SWuLy0)~H5_c%@_|8V zvN#%2hrT~nipt2y-=oLy8hT<0vd})<{@;cr@!2P=uIa%3!jM7!1bnyzEK@xdOv%(_7ZM+oRRs_$FFQ6F2ZwTRmEO>+vpn)#hY5qMeQHP&JHE=>=T)tbVZ-7w$_=Q2Ktll z&ZR}zz>OG^Oxe#ppM4smh{u^hYCYhV`*PDH*yZf|{fGrUYG4&T`^Qq!A#d;!p`ZUNkT;|XK;FFlJXlI=M3V4~+(2ZJWeIZ6;% zh_>VvvLzoR+0C?CrEuybbK_p73zDE=QhU zNmHRs3-iKZS^$GmekKlYIMT)tS?5q7>`x@@k7{b(ZM8q2KtgQ11TDmO$A))0XMH!0 zLkgWCi)!70e;H#8MbUA1EYGH2^)b8iW@&5wWx42P^cvr>b7oa%RN$~eI2F#(?PcoC zgM8NWXk1%^BKHwqp8qP^sgkM?Qkx?R{(m6&=ijP7J~C+%ycw60S9y$?5lPh+y~yfI zo=EB1of*0G4|b`t3~L&F+bPw%d3lm1><~?`Now7G^S`EKcH(ZnTaEbaHLCwATr3j1o|)~q+zwBM7L7M0jYR)B3M8-j zMq z^4?mu9b`rDU+aJQuNA?@{!=VUOWmaf!#r79XN7OEG|&Z=QLrM6_&qNZAGQrBww1xb#5u>qc|tco%b&V3WG*cpN@^ zDWeIcB~=Ju4bBE^22)@Zp&aMXpX=5(mEel`B~V-+s&uRuEupPK)9)cl`YRBSITlqh zygSKJHf4U>GeG&~ucx|}vo(Ds9N(o+nrf7`Z(qwAk)UgvH%;`!T?uZ=wi|l@)^Pn1 zgg+`DP7=c;%}#S%rw5!2ZFnUtA@{WX>{Lq&RLzo>GIp$Pv*2T-70dPMUY~DcuyGHfLQ@&`3>5%B5FJO6ae6_-Z*yb$+#c z3Fm{cg0NF5cDEy`V!7@>dboVR*Ya>#kJoRP>wSA6d^Lah?z6M|rwy&R6jsQhx~2%c zW&2>NDBx7%m|x8uZSNZj5gRGo+G<`E6TQgVqIn+^L>8SrOQ>)g$xE#5vE=qbN85|L zpW@Xd(OfBa{c}cylIo_s)kqfJIQZ~q+^R&Oxs;)){?O9lVBhg)zILIkt?rXwtuOfV zjLUab^kL2!h74~jn5GXJ4!HK_KeI0$wgF--FzJUEyie-$hrq}QjfNV9Uc(=*NsbbH zgrE;L^0;&E8swhr^|-WaHZhm_KMeLX;?UM{+C9l-8IH`QPQYZ$c4vv>USsVK%{Q>+ zm9^2#(2+4l$hWx6!H`2k6N7d3dKB8(wuvF<%+T?^E>|Dw+3UkjDg$0$qEK3Ur9@lV z2l=%8SiRL_G%hWQh(Ror3NCDU5L!e_OZdZe1Gts9A};L)^bU{*y9;fam;r~`j6I6< z_K{cnkV5wiD*T*7y!#zr0p@418#=Bp3Mup*z2JV2QtcK}S2)bt8ADPisnXu^gypLy zPa9ldh2}cd2@^$C!oQ08m%RxZXI52<=2j%c9fYnn`CKK{(#&Avsnn>F(>pAykakm? zkdc7Lx)?YeUZFeiG|BE5WW}Jt-nn!rPGm2b7h~|OkgpnLD@vz&I@b564&U!5X=A7P zg^h-~yZyf|bjrO%7fQWmll82jH{786H$;aiq^vAzItp4R1I@{au7r3?^W2noR(NZ~ z9!-(obMg{VPWE9$)u%>_+!64)&&(dN&;4{3ttmRyI@QB?sJM}4`^Uk=$HrK%*q;k- zb7Y2ZoYk9rea?npLyD4FjaRCyU5y7BQ=_PaxKoHef}();dlr@HIWo=bbuWQewp3e) zy%MWR*B@=>wdes;04sCLr&UuSupN4AFHP#}P9IG(d z$N5P-wOZE1;bD zd4s8?6;)Nq=duFcw>d?K0YQWlX&ZgPn_YA&YwF92mg$CIevUWCy8PL=lY0raUB-}K zG?rUFGqudntLeB*89z*c*>xuA40&>ad#K=qd-><9*p6=*TKar%r#}Dj6-4%*#aaPF1SSO0}8yh!3$N?@HwNJ z{W4bd^@#SCO7of4Cn$dDA`G+9$KP@&Vp+Y~!i_*$$TE)-0>}Ex|AZBDwuO#_k!H@u zK;O(R(+ZsmE_+M6)V`JF|JK;a{{zQRuY&4c(>U7~zcyrAhBE$qbho!9wdWNOtG6g3 z<26|S=+n<0%~IbV*AQ{30A8?>Pc1~#^<&QJSxe+vLRxxg){RNie%(-T8l1Q`--_81}Xi73zh^{?lgxtM!8 z=7Q;oeQlE{2`=2%GWi}zw%Y!odqA|7zdTiS{~A~}YzuwCx-62kd1}cq3{yJzYnPZX zhV*c6wirj9pRf?Kq3v3El#qXkYne-6^tfl*k+B40?adG3g}J z<*V9zB7Dk?u9YZOni~Lr6u&_`1X7*SnCHVR&-*a9m~c`bzaKJ~Rl zj{b2=(p6P}qdJ9pPXg5V}b zOI;k;wsRkrZsP1vB-wc)^K)}%NAp8QMlzZEaM3q(BNQZRiTgwVh9D?TWr<*(>=kHi zZ1QFvFTib;YT_mB$yr$V@M%c-=uP!@e){v}v!7cbpex+VFP$I=o?5$|nlr3841Y1b z)9~w9)Dp|aL`9~{Wt$c5{p+!@&ZY*radCMQ*Ggvk%0u6vxyLh^XeGM7ccv*)@#B@Y zJ2EGl=b_aSH#NQYS((kz;c38O3eSuyP|y@qkVsF-0|R}wOogZtKk4bkUE2<~>|<^Z zr;Z(ht_$u^GyfZ_@%W5H%ks~wGlP$ALVit_=4iWhPaj9!JNufK zt8|WFIcaiRDmQ!S$FT)H4ZE1hS7o4bxm>a#I4?EGiQ97Ac9I;|&Wnz~v-~HXi#I=$;Lxdz2dGvgljy8qzK3nM#(^a3=_XZ9Eq6IAEMB z&|UG=SF;^e59|A8kt&YWpYH=^ZNH6%B{?;Fiz3rm0ng^(Y=;Ic%Y6?(9;%fFWK6>M zEEVtY;knA7dgS!$Tsqa?K}UT%>>r^2bzk6Gnsv;&DCdOwCq-|5$<-Nj$w70~L<>IR zCxXQJl8@3T$Li1A`<2-@X-501x#+oh&wFz18tH8zosFcEq0r#9!swu}{*$>VE&lp5 zL##57ZuR##W|va8^c~QFBI3#g&J$rX_qI7(=S}<0u!OdlHVyZ(o-MO_kiYvu zN8<5%+}L!wWM_}(-GCqnMY_KQQKFT+mUFPx*gja;B!lGX4b|?IR9BJ!lGyiZv~iC! zxs+efoBRFj!`YV? z0VTIkd#?AF9+X?p#UzX&Pp*}~EeGIk6XV*FOSMpF!CoqJ?-;AdLh%Q~?RF~B%P!Hf z#hU~jR7;B^GcMJKf|6be5EmGoehHj+AJ%}>E8W-}!y{?3nVV#!w;FsYQwSPT=5&lo zgJYywm*ad0fuh#iLvpUu+PV=qvZks5P-928_=m&rk=4>6~B|?luT;eUbJ_exw6BJ-& z_H<^g%CVq^^VYWHUMLw43oy*%9aK?2%${^}zrFk=CFgm5&+L zk$Q~zpe=RJGeST(2cQdKdSrn8rY_UUD(Wp9n?2)EkjI)7+KasmQhxM)#1>n|JQKxU zwOH%PLh9ISP2l+XPIYp$YjX{pqL$zW)aWfh=)e~~1zkNFlt(9LS>BZC=61uBC=vVt)|#T= z2WkfR;Qdkf{DYu(o|-ff{`v|8#+g92fej%!X+KMqXgEReOx;6>UR|+U{oY8ebg4g4 zmRTX(9R3OaqZ=NAV3Ep+N)M&&5vEq#|MB1-%j3_o1 zCC6)XmP*Z*s?vkSs{?2q*jJYXukwCW*IxBH6))jn;2XJ;BKZYqdlxfeSldK%+;r$7 zbY1u>>Rh;}qfFTOExCedoc%2A&#w(2+sdm?e$wwERH%DMe-Ja_7+3FVV z@1U#h!U59gLbalg+0Cfy{U?JEs!{i@N~e)%<*LXl(w{Rv23fr9tT#b(!|gpqBM*;j zh@C#}V+Pf&67O9kwP~?d9USJq4!0|=Ys|ezSh|cC>cp;Jh^~un_G@38#}Hv2?GPpU zne2`9vgx}1lA-tkU~(R_TstUFAbnzxr%FUES#g$o~Yu+xG21 z2WP|V@ku+m$5SR{tiZiP7-o-9Y8$FWo&=<%TEm?wCoR}IO_htL#D`nIT&@* zr>!qE9RKCZpLFdHr&Y?h|D?jOEJscMsK}ocf9BR-fwh{neJ3jNDEiQ5@ar!+ zQfb+M08KQn!#aJ9Y>7;q8tf81Z3wtvqdyfzB?TCjt*fBHth4rr5WGK^7Gh6FgIt*?TMF`{hGBhwDMAIg}cOw;%nIAj(*nqd&{a_KO6fidlD_f9=vX z2{wIK*2zjW^Q!h;r+}3P`s|yJU>*WOX(8485O2C&5)7mB^oD&zalJTrJH5<^5Pkh0 z;7^MXnvr)0up}9o|3LZ#fj)k)cny1R#nVwIhZMnW=I1+k{@qJY0B;HmBhJ4@;(uHj zQgOCbM&D9~Ha#ZKFJ{5u$#=2W2Ts0-t?GqOUW}(4JOKy7AdfX$R6U60*)s-@anMyZ)7Q8w{aj4OuGf`%in&s3u!bVp z**u@Q<_Z?-iMSs^TBlXe4mMPU`ESMk%3du#B1$YcR) zddxY{RtJjF$Tfzz80~UoTKN?3hfT@YhHxmMX$aZoJ`#a&qCK98(^z@9zuxLn_B?J> zvgTUO&f~B@ZjB@-%I?wE`}k47wo>FYmFU4Aj%SL}r}3k?N^tb73tpf=6U1c;$L&LC zjp{Sw*1EG(q}gu&*=e4=;VdVVKg%5{P?#0whVm*%gX2Q?*{=s!r9&lwOu?PJp|SK5 zZmVG2ruvXQ+o@Ct@jO{nw(^f;f@xf&C22H+Ft652&>0 z^Ub9tb2@s;8RdfhMjtV1YLsQ$O^jp%b1$vnUxt!q!|CHOl$M(8J2Z}Qj5(nkcRT^u zCHy=G5w)Hc0Ar1;WS_Q)#JI;W)*z2MZPEMsK5SgOKOw0eB5LA;mADU?8?~KP-M)rB z)1^D>$A9iVYde(J5zM&VQpV%$EFGwH4Hz;MvddPadhZ*0=w5_>Gcgp8FL~TjI<~Vw zKCi2(*9Y6fIl-Uu4KDYcO1p#N0~|r>=Nh)-l^S5A2r}z&$(fyr!04@K_))gWN_$l8oMlT={cn^H1edQ!&h?D~cccR&8JTs#erQ2qZwch#l`H!)x!k5 zp-1Povi^Fw{P=ZD@!EX(J8AsDxS~UIdGIV0AK;Sj!4Maq_C`;Fpz@ps{ftJD(X(A^ zC5SUnsRmR!=hCHN%OsUOI__#^htoJu)5{U z-l3~W!t+Bny;+C<*pXNq{)B&{qejASBp7TRnp;CEzR96XlA(Ub9j`HnOdz-ZjWaL z(IBvKQmey@z2HlxfiQ~_GD5esLv?(sk?BYjRxTq^HOYpviao2HFojis`T=>;RstNDnjzjPVkr13254 z(mf*>vLBQq&0ZXupy`F)FbQps7Kf6KCQ0UcM$IAudkWh!MC1b+vQxcVk{Cp>GU`1dW*wV1qp zZmgW=ovJms6A&+U2a=v&&n2$6#G>CQTOPDZ2r^qqA$$dzh)p?{fUrZkQ&C7DWbyui z`J8Vy2j$yB+x<8HSsbY;uo7=$@OcY)Kd7-mnbL=w#g25gA#@>1LdLf|!&w31Vm_ECM9PGs-` z7cnOiJNCtP6ei>bc9@EzRI{4ODCeMl?DSK!WOsn~7did=HX9TI*Zh(0uJ+UXmka6C zYUWIChnhkNcBo$TQ6u#B@5xD$E&t7WZY*(m$@%vHBv>aZS|6|2_Gy%3Zm@NlI5b_6 zB#JIKKEtNb=t;rS1Fyedvfw{8rl9bOyXpe z+U5oO8Hyh127n5L^2Z3#M~=kcOf6Eign6@Lv}R}^DMbU1I(F6t9YMcdY%1Y4R^Lyt zzo;O*hZVo;9H+8%MO5^gnt%wKdsl7ZaQza4q?WD1Qxg#(qQ0jUWPGfU&(9s1-R8pS z3$i_)8RckhpVLrN-~`@A>fs;25vi^4B$NmRa3=aYm$3RBp{mQ-wDD5^YDD5=byDzp zUhpx)(CIKJeVHLF+=YvDP z`4e1wIZe$~+iIQp1umz^SgaLJDfqQ5%F^Xq&HSm`3c)=0p&F$BFE3lkPP6`= zmk?p&pY+tf9&@%I&;EiHGBW~Vcba6g{v5eU6EbMQ&5(S0TG3n*%_H0K_8wSFH%uMH z%SbjeiEe4S-X{{-AW)_p(P2Ifegm^p%bbbA^=Ep+Srfh1VlO;O(9J(qZx0U|^Ss-q zZLXh^L#+3|pl4C2jw!`qDX|KYSzN`4hfn3t(SbGU9Q;}hGrR4(|@6Cdla*D1#kk9 zr-cnk<%M<{bp6gAiYREcD_~G&{R6*TUh)7@1wO@m&{4NAju5YjVIKE+nY+}FIF!qjXZIW!D7};_osGe3XLJH=GKzqH8IenhuxW8jgiozA zsp<3Su&J^<;e>%GffB_P?KFXL#$+C@sSjir&?$&m@*~(3&L57p$)9>Kxbn%KWvojT zfu}J{!_e*%Rhz<~NWIgy!ylFUb~5+~ApT%K^mZU%Hp^%Rkmr&kp0Yn3pPypp|`3RD+WV z2GhGmouvmE*l}wXwY}*3y{GTdKpq03u}pYlh3D<{-nzqZ{p3GgR`J>h@HGcc)4jzs z*B&3XzWtl7z3_t;RCSCNGRZ!q=2S&Z%>-82GtmX1FqK~A*qNP-LS&PK%RX(?&rfT1 z&#tXh2^qjBF#dt(!XV?w_kaV0O5%5jPFabZE%xY{Prz0;MIHstP%01eQb+0`0E25( zOH&x*ujlsF$bO+CqPH7X64;T}HCirsHh@ljY`y6^7?f#-cz(}6NReKL#w`N&a5811 z%?dp4`ZeekMclXQvlubW5kjZj(3^a-C66hZ?bSdA5v1^Ck+XQBALVO(uY6+hysJJS zF9SBA5(uc6>pila21-D4U{---2kyy;xMX^3Pl$Hy9vG4I4%TIRy{(^303@HT+L3_=3rhbQ1gZT{$_l#hhDi{h%a z>li^W{kD?Yo(>{Nj96F}vslaCEVtGwECs z?Yb#V&W;9BB}dK08p8zX6Yv)wbfk!+yP!02-9WnYB%JF1E5Hy>x03T!IltrDEyW#$ zB-|m=;W?M{L`b&g&=szHdLn%$^(-ZQg`$oT+Q%7$^PI;pjP}!6z`kU7u;xV`kk&_ z|5y2Bt$WAc+vvePGGgej=K0eY+Ycg~*Kyd3WVz^1`Imt-m08cd0jINx8-VnJY!`>6 zq>dMP<^zTDbuVJeA{ajTq#cbQ)}MOJ>bg~bY6Pqiy_i>I>WwJylwRcAAmc4Sk-Ds( zK3VsdNJ}N&yt$(+$+A;b)X9E3o^=`BD@*Ux<_wdny*^tVt2@27T2vonj>XF$I-lkE zY!N*k1wnI80;?Rp$B{Yhod#K2ZOt7 zg$U!P%r4FRU}dR4w%~itf`FLGfSEXwD48yV63}_fRf^?1TYw;T1IHAzeU-5b`T?F# zA)1tCHY4C-N#ma(!f2Kd&fvlCn@8bw%|SoI*}THsD8hz@sOJpOAf20J=y^oIT}qyQ z#C>hMNj3BXH_YkUmJd}@y&7*&TKu9n~omQQrkVyzr}v?jXr4CK&k|-h&D3G+NLh?qhhZ93+7g5 zJ|iQ>H^+k7UF|;AfdKVlH9`o(up@*$vdD?NCRWFmd`m?mzO&_trUK zU+}Gx@)vUUf^|!o!_V`upoZHH>HrKBkjEfY2L6%_94IowYBdNw3=Cz3shX&8J-Y~4 z@hxeFynvf-%+W-~V-!O|3jpvU9EyHD33BBw7sOPBCKMNS6xw|KZ# zAxGZ(;}Lb|XuP#ypt`80?wC`Lm@UUfGZ7*>cv}_KAFpe9_YK&@g_Cs@A}0C+B%yU* z68AFBEF6v|(S`z{VS$6#A`x5ByBs=IA)s~}P$1D&RMWd;-fda7W@@(H#-gLobk=Bv zB7~i|Q+6MHExoE4!vKzPd!6&b@d%~ZPoPXypL$}3wdOLTIRK>@w(I@JMPp0foZ!_E54 zMRaO@vi?DWO%&Gtef?cDcl4i~q8-hIL>Vty?u`G)tr}w$UeOz58&1?8H-VO9(!{Ky zR(d6<*x{fH>)R2HI@i<4~i&i4{RWJqLe0>C%CljzH0!&~>2( zQcChwn`Q3Vc&zQ=lNxo-r}e+y4_kgxf*o>Flw(_eM(5wox8Tf6j@qTXdrv|KT{Y;n zOBo=Y2MLQ21yT^iP-_N?lCUc^6A~h#kSsbnvbKioc?YU%oi(IK1A91T1m8b4lM!dM z!faO+)yB@_nka+Kp@6FwPj|`hqQ^K}g@HX`%vt~gAUIh09?d-vZmSPYUcILUWM0NN zFN+_DY#rOqzjM%$iF@yrwxb2*TYJvHx^;UI9=`ir9%RpxCNL32@E!7+%U7`tMvgOn zU`~)In|C~;{eU`OSDHsNc`-2jF0b22-&RE~8RzBJ2OSq#!U$2CaDXakf6%L!F3E=b z3x4P@gD!YH2URE(Zc_u@qC-1K+2B%~%?xEv0&-N-Gx>_%=gae#gJK0vq#O`^+9{Z- zB>s4A^5T0^MaFXMW@!pf@wvz%nBxS-p?h^!iu78JY6YE2RH2wPtILAo6Rbga0fP$l z`A~~+_~9?2ng%KfzA(Gs$GGvYaOcxqX_f>T_*$|UylFzlsZbO=Y60*K zF0vCvLl^wFk_uCqKDf}FquPYhB4t8b7L@iZVB{3s?%%J%e(=&f0cK&xm~e4&?$H>e zAOrFanrY|*iYxS~=!GHbz5}Zoa1k#}e*$m_%%UqTZ?x z&Gn2&uc54CgT%cq!Ywn0RPxRPgpRshQ6&bV(sJ%0a3Yp-RaLFA@O66`AO;A|s_-Du zO#KiVr?s|6?|eC&mDtjns2$9947a zWk5K<8*QUQdKu&0IgyR#=7!?0iY!tvAj9sM6B-r2vXv?-0gh~HiD*eO7^ZI|K52)i zw&mJU89kt;L4U15hZL9&pCbzVfy_AvkzIJEE5ys={dapL5mwNty}&y#)-2Swyz5G^ z(MN0(mXi60SMJD25^efDw4Al@kA57d*Z``1jrvwN&?bfeX1|1~d8oId_+*)K(5l$^ zy+1DYqod$=@R_|{1VMx~_RM!Y1D6P@&#`)`7i6QErf_!6r(h18Ix;Put>mamuww`H z#2yZ;(GQ1kST9v1y^$W=vR*-i?%)~bI-zL|;J==C|1$x^f1OtJ1)?e7v$4nqDRBB+ z_LGnZDQc2@s-dO$^!$F2DV^p<|H|Ry1KjY9V(S&cJ2gPFo{Hi(w<08d zsh!9xRbi71T2i&Q(1maFLYn80qC}fik?vY{N6?HfsM?`QL8do@*6I+$KT7nHtABDL zvO2WaBBk3oBJz|;-fi&a{zVqz#yqhW%>_M<*wTMhBTIsFYhNRMBkx^5pkhCTc-e4mdfB&bYs)IC zR#`VZFWr(;Zv_scpBs`YdNHdWl&{Sku<#eXTeqY3MS_eht->ZcE`KF`NL~`1i}Jk< z4y?8Y(q1EfC0p$XY=UTre$KET&BgoLDgHo+Iwlqwc9$ph^JZ-`%oOsBfH+W&AfuZTKzk5ECjVR95+UGM8- zI06TvY`aK&{T8FOT|ucZ19GQLof$?;y_#qbQ>3q9$AbE)Cf(7B5IB6RB^sZk2Ad6p z)&-8j22tq-Vp?q1?b==;kZ0ajc|g~Asdq_>q=HjQTEVO!BUErU0$)Xa2t#C#tWEU6 z4e$}p1iV-fG&1ie?s-3n#FO+}sGx>aj#E|j+RR~H&Q+8(LDvMfKPl?_-bUcnr<0;HOn>fk-mdR38kDvXV zMlzpmar?ds@SK*iua0PL1F{%6%O)BNrfgaigAdcNV3bXumO4yx_dpt`Q-)UQ6j18* zMFSUq?Ad$#ci(IUejHrWCbOOnS3GH%uzhbwaJ;*14D^Mx3rhd7ZV9%>QSg(%$<&rL z3Yhh!QyoOH7d|XNGHGI}9NP{?Rl(y#JGD9Y-4E^y%>vsLbcfwn8Io*z{k@Eah4$sc zi~@PrkDBHj=${>tX|ft9g+x08F}v2$)~5{)1JEY;_R{by0!x3BBlANm(xklona=*^ zMKc|3)e@m2xA`_DV9hu*V`ADu1x-U4p$s!M{Vzb!JVV~i0`iC`IlvUfgFDaB*5bBj zBtC3DD>PsjPw$O&*L9hqthj;l_0oibRr3r<8$UK^E^WL`p#4ej{shfjMFfr*v57o& z^5JNTkfkNGxv=UAZrYXrRlEl70-z*#%^<~5KA52k1N{|-xVOONs-5SoV|Prp@Yg_i z(1%i%{(me8M%U#lK!~D030fBEcc7X}a-SX_CB5s(WKB*Is@J7U+)j+(tTwd&isDbm zb+nay(f2je&m+xFBw5iOsve6qj3ZT#M{;y?FBV1O;SgFG8_(9La&^6TdfI+gFiV{B zcY8<;X6B9hMR#wrZr?e^>>Fy|O>W&zciL#M6A3^o2HH(=Rxd3uNRz$ubbwiW!o%;Y zLa{rhmZQ~lhirjioF)mP<91rij`6!OTyV4Rj*wGLt#1FR)BCzGQ+x8JktD4B$XlJ=U;o%?3MAY$<>lnK`8GaO zft@m2fMskAY2M#E?x{gGt)yV<-4Ayb6o35nV*JAb;8cXsY7%TUq@=Avb6ZIP?(S^L zfI7WGge9uOE9?;1s4acTFtg(aD zMVb1CEbLWKv!heJ$|YPP{oXC!XG-(T)kL#UTI9h^uimeE`1^H8(?*M#aa9q(Qep$- zcpGPOlW&_^q`{z#kte)|070l3pd}NH&feBBB-`ymINpu38pNU5&P?R(kSt<3+kBS^ zz9NqJ?{*!OX3tdpOT4bLR}@_OuB^9EAucV7T&G0EK3MlU_DzQ0vvv8gTj(*D@wQja z-8r)Vo%uTzznCRCY~>DC!%$i@H1%QEs4w?cQ-^2bl*V&MAo-{MnUt~}2uiXrSCvln zoo&+EdP!YhRGGT}X_I8b5e{xnqZ6BxUM-V8tZP!qi$WDHL36*lAw<;qAMqkiXfRT5 z<&|%PnBRTz<0q-*^lSA~gW(#TFB^uU46{3MvS@C)itWzvzn;AbQt8q}n-OFf`kl4c z6(6t~c&Lwi3@BI$Z0dCae$ldP#(PRL(>Z@VBR0c@%65`$HGg<1;5p3e^v{Acd0=p8 z75fJ?}1Ex`s`6%2dc7bd;f!2`xuL z37^LE2Rr?jtvbAd=l^FB9EcE=ZfHod$W>JA%YNF-j4zTJXF6G-`a;G9kIw>2X|~!; zbD(;k{hXGG8y`_~!I082(mP2LKGoDG1>8oV9aqC45uxM9#p^ih>ga=vy>({|{yw+b zGx%M|m5XjfhYSVd+f1nqD|iOy1;IFChnW;ImSt#jSB zayS%bW6?ZYbndK(wTkVrXFyux1eWNdLsHFbjZiYZUG5Tk8+1;X1Fuisv(S-d4-+4J zoZvMCFU*gGDj?yksZaUyYFmSFp+-j|`LNd~EMvTAo4Ivt3yN_*d6V}sG_KKexnsOX zuR++lJlDT7tP^bY05-r3*z`8^MO`T0M&5Esw#S13X|`SPP;F!A4q~3Lo$sXAya^k% z9`0nRmj+K^7q$l`vHaUVy2i11;j^Bzqwc|%C*Tg8VIK7ivwU?jwy7~rN8_DBi z%N`R^P6U}axuHZ5om8AHb>53z`NerG-^jUfe}^nZ&5IyIQ-9U$5OK*X zW!R<3kJdA#hp{2?@2-$k$csEeOY`fHSk%Jq*%QH0xHZ11!U_652W%XkKQ}yZ??g5Bd#naC4vp3bN#Nw1bWPheC&%8b;!9$&FA%luvU@V$;%q#9K*R`jpn zPPUFJ)t~!xu&~#^h28n7hbOd+RitAB2ovw>`IE=Xkm_YP;$}ioX$3M%)B%i%rb#Q= z9*VGEHzX1?B^s?k{C6D=gy_YEP?i|2WgBg18=vCr)w9sE>*W((kuQ6#bS!BKYgUH; zN9V~azshNpT2p@Ax~$7+i(XLPxc%q;aHYXZm}MW#xt^RfXkn5!6QQCvyai2Y?w0Dk=KB z)rOPB*pno^)8{`u+C|9gQJs`cpJ%wg5M0;!sQjR&CrWkMdN*i(W{|5L(VAvi%|Psfio__quusjGyg+I zI#Ir0+fneflEa$jv&&2@hTVZ|knIfUFR;gUdni zr>^rE)%+jnD_d-gJu_sdYSZ@iWWrSqaV zItMSFP94>Kf*mr==q;iTxd-HGU%)yVpt*m-_m_N);YiUk*EOA>;F%dQlR?X&%ML&O z1CN*?Z~`c6INS@O_N6`BK~FvI=9v6B&$$gZoz^f|p+=`Vtge81B*K95QmIyy0N|Qb)-AS+S)Zf%jIp-EeuFf`Qh5>H; zKfI|MUX*dI1%XUeg2L8aH9JErd&j^0Q$?+)d}!{qjV{+S31zAxXdxrzHp*9Zw(L*s z$w77Y>XK4U=XjwMJd16(2NAVXGzJMGs(p$M%L`#{=IrxXM(1Iw6#& z=p6A`i6N5pFWhnH81ge1F1?59(GJg#F&0A07B73^2VnULGLunS(-eCR^{Mu6X}VE- z)wQb~Oe@(*IMNz+6rOmI_(+cc709$I1I3S5GE}3VDTZ$R0O9Q+Z-A$a4b2XFn~Kfj z6hiH2gS#D>P)!W-^6YQQd~t#|Bb(>QX}T;E=(oJve#O-+3wFC++bueQoo~u_1`&t{ zc>lj(n+UTy03E`b80@vFyP#$t&Kli4%t>cBCBY#XJYJ9DHa*l=PfWfhYSnev&s$Vv z)Q=H#-;v!sp~-3*v<)qDwDs^f1A)(*?`={7I89MjvV* z6D&oRvJrfZIGY>SbfJ-#*6##u z=>N4r8Sf#96ifW0iGO>XFF9nT@t|VWFg2ZFeFm^c8fO2khre4APewt6j>RCk|KjS0 z1iVtLT6>5=tS&v~weC!LC1-{zJ3T3Pak_AL3^hWGAf}Da1h@7CN^pl#>BOE z9Db8wXQh|d5PSojL4&&GV9L*8xa;714Jtm32VO1utq>chL8>>aA=g*gK5+TJ>Jx}L z0n}atjXlQ1ZM8&RBG*bou|@pKa=rwadI#n_+#SG|MwgjVr{nG&p;Ot5Eg%zsa>nXL z_1e!T;5N2)7}U5kW&r^Eew{|{lZbirU>!Sm3K{(m`~wFEDk2PsD4!^|UNob#0X_oT z7=m$hhu3V=#FJI^as$T7v@BTxnrMHD7s&z3P=jR4Q2uqr$UTlr<8AgQpL9mj|3+vD zsPhIc00UD!iPVOJsD$ID{F+3rOz4SXY&&p4!zn~^&F)jbgJkt@^DCpfPsM`WW$hj< z*4i11-RA+tdafN_zM4(0x+8&3YLDEFOmh8yjZ$WwQ zW=hRK6~{(l!WsrSu2$dllIpL+t*B2yDp8aK-%|Rc=ePJyrV$^|8?dJ2D&lZKL-4DN ztYR!bO9v*b%CG8FZW35F9ygbiM9Z;_B6LZIUf@{`t}6ujOc1u;(A`R#9aOmB#&|3= zD8UmOcP@4s$C}Zp&D_!j+*3 zvlXo1$-D00d(jUUI|Ik{U$q0Fq6mNG?e8UTR62`&fPFKF#9yyX?FM-Wi{gi|c+RR$ zqm^qvd_xfYH(sr#Ft&<-{3V?im%K~4q;5=GtBmtjm7Z!EA;Z`b;_Jroi!+I{-qAr^ z1@{jN5Iz-A9!hTwim+7ueTx@H~S1n>QV(*o=m~{@DQtD$j)3MQNm>q7t z2E6B3M%DPHb``h4T8Ujr+?@)HjD;)KvB~Bwau=dT{vPdy&I3c=c-4@a{2&ruG{YAK_6BN64)2wq-Ml%^87cQ9btSNauT~X&%UV z3%g5HOpSc6t2k6tN%1Dm;0PGT&Hv~|U^s)l)orW%MpNH{w$cY_;`&!CTxP*>aU&_W zg>W3N<(U6bjBT^)r>1!_oG|YX!{p(=5(XFOmLoE>BGmbtyyvPeTieMs5sQcsy=h|% zEpslxFpov9fnYIb{JGjN?kvTNRn#_GBDIB%U1}Z{u`k>ow=oGuP2>K{6c>`-a%kpg zHSMDBmWDaWdXj-X;ceulPXGg4Tvi&Yx98y+Z+`+k?s03W(AGj_r6KWgH?NIZ>19OGQ$KMb?rH%^Tknv2Zl%N-}k zG}DK6kA@E ze&*GWro#Y@`=mMPRZWpQUTR79Voek@VEZjxz)6@@R320l4<_uYy5XFz-zxWWeYq1)11D*6CKa`(&x zqD_c1^0A`Wu&$&EY6*B2{!=wn+a##AFiwov3?_N(G`OCAUM1C?z}VHU89}(GQp11*)yDmAtCMl~sTU(;ocK%IE`2SobwH`6F|uWe6~8?Y5?)XuugBtz z^MyT~BEs@v{e=b$QxoY0B>0->|Jgq+y8bs|rX>rbiM7JfW}`_KEEnZrzjQ{+8g|`3 z(P&)nxG7wU`rr5s8JVO3r8nUgwa%0>=)@RpOeVLDj!jmWErRN(YbMLMz#uP41pO=g zXFWNq=B)-@uG$kjr7J~X^KaRn^dtm+m{C~G_6Y}zAiPVR7JXUh@DMGnyv5D&SDbL% zHH9n~wRBn)XGOy%oB<3$;}!R^wu>l(X#NslIWqr${3&b#$h7uRr9X@i%0P%T^O|e4 zlDoivHsk)J%f(==@L_m2nfRsIVp3JqoC4^wv0btB^ zaX&eQ%x)#n@_<_$A+L?p1y}D8ZW&OZ2y>! z`D2HwKX?{7>$QXn)FA87snniiMYz_W1Vm5>_5Q=2pQNHr%x{!q`FtED)%~+;52f}9 zG$4UQl=W7ffg!i0`=Lo^Na>20kf8#}|LtZ(L#>Z!-0p)Y)c$`?7SH|(%*8Us)sGIp zwmyanv0pj@7joI3Fe^8u4c!lA(etqf)t-EZMo?8;oCZ}P;c>*Byg-( z;Mu;y8A@pKjQ!42NJS8MiJIb;de8At){~W5Grm^4bif~I&L8s6nDG0Z^l-sMx>IiN zWE3Q~E#e872#mr)X8MPS>U*P~7W8U{P8jm*1D=E+g&{B{dEBPBK8Wy%9O+VM`^@?A zrS0!D2RPlnc3Q%(1#6-8SsKC7S?0eU#%ll7Du_%D0)RU`ze>5YB>{MEwanMVRroOnb(t96!$xX9zqLb6rBHK;nZ_sr~S}zLyu7hOgc)zDa!0 zGaYo#V0C``<2Zn247}`1XNFS|EI+?};gXLSU88BaBfeuZ!*CZgBV!AvrDN1rNuD;9 zyrF~x@7nY)f&{u7p)y6YDz#$&KM0z6(0F7~E_xX`a!-i0&9@*x1=2%12@)SP54?E^ ztKQ9O(X(cIqU!Yx7D+T2{U(nz`tXG&@o*FJ50SH&0uF3`+aaC-LbIYPtt9WJq*w=( z?sL`Mf81EI!?e-O_(0`jVMx90uWfEXRzL9zVJq6X(^xy-37STWJ7J?eQI zy28qiKlio+Ld)NFLf-3l_sVQ@f=9f&4Po6oq|02W_hyiY4d8lCJ^`KVf3djjpa2_@ zN2^u$!0i2LZ@!Z3*7gv!SRMMZYKbn8I6hS!cw&?t)>gUQVQBYN=9H^TK)qvw>zGg2 zrz(_|tnp2duNRnqRN=-CB>o3&0&={4?!{+8j6^5eF#{{J$>JUivX715DaTLFxv&`( zi%$`g`;Rp#GnBv4eYUh`o@02XzGd&atMZnN2JmbfF(^Y`Q17`U^#2AFvQ7ksq+iG+ z-Cf$Ex^ZypbY{{4@4Z@1gMZBmv&xY4T6BuhE8e)dAbc<2huVpYZ#K_1pVlWuP_smeYd*Ao-d;I)yACInOUdvgZ z=XuUcJIM`#nTIzLqipj&aW~X#p7}ql!9y7R74vl4rJQc3caTAzHxiS_!J8{FFc;l| zp5zCxnHJKWAV&>c&r{s;KJsT0wyTgwy4j}ol&;krhf@y0|1v3PabN|->7-`oVgauHksPVq!c>{r6m&yT>@0p0lhT}%SZ zyc@j&^}1dqgxSR(?ux3dSoHQ&k^1w~(II;^M+^7-Osb|zw1jE1G-Fa4e~M-~V-t#~ zFM}GU7!_KCdb5j;77k~>K*1=i0~*Ou+v#@mtfm)#qbH9Vg=NHJ)&h+ ztuF$YkS%-j0zg|2j@T4C+!cQv>9EUx!gHw3@9u$ZAhxC*7=y_=)V(1;x8f5PcBj=GUa5PcA@gOXP*eCgN!n z?gb7(B!Z;;#k<>rTGSv`p~SUNIRF}UY!O|U$uf(HUD`=jC56FAuOFUxC$^r;Q$4a; z$uN>_9__4rDw5qbevZqPg92ZnF|oFS8%3`i@BK?Fs=@yj?_$pSEBXIxxPbdDmiT%4 zERsV^NVHjGVF6KZqQ2aSKv!KXkM4t2eE(kSdYt7sUy#=$83HBR^sZ-XwKr6GXPexW zKT43BOc+2p^k~+w_X=Hv8+0&plhA*2lRg1Ase0x>+2b2_mI&H_x&`pA5upVqSAR6QiYB3 z&?>ail~91fm*F1zxXi;H#7Ne344CczRbOG=?@i;0xO&1K6%hpkVj*Y(Qx(QS@Hfso zZ~slc^0&57*xcnZapyJbKSERyqAfWd)uSoq=pI`{%^uyL{7_A|Q?#1S7k9&0(^cFJ zAGL%yLu(k826|f`IFj`xT@mp$NbeTu!Sv&z8`>;G^`ZZyseC!|rE8SpyURi(`7YTfe@xEJCAU zX10)`CL$u+o(EnTyh8)UX^({u1adRapCv&8HsSM1wyoF$ETyQV)H|x z@MF+2-P8Fdnw|&IJN%|UJSVd7OQOoGh;c7s3yUN`)IIs{G#NgyaQm0QPiO~{|DD;x z2LtPL5l@1D46(r#b54HU{tpZME)X^#0EzIuBZR>B1tY*ka~OZTF#6@;(|?sqMf7kW z!>Emjvv3ijR81(Yre6Xo(H#Ur7gk3ck|XDE82~@nU)| z{im*d!%hBsB@4C|DxSg>!{|(2(cJ2MM@B-KH|fi~fk(4TiYiGX{^#D>^sek#7=yvk| z%be%SvVwcB!5|Cfqp#dk_ z1juU{ml{|>Mvo`>&1R4!!q{d3!JE!bSj~S{Z<=?l>06{O--UsO>71ZU1j*+AGW0-# zlTjzz5>P;I-b8tVi2V&X`NDYbgbjf*L5W@`@;oY3JMP2MFGBfBXxTZ?{n&WdQ<@cJ z4RD}vW1rIFMTSWD6&}p5(&0&R-vsjRUV!{x|2E{lf{Xf;m-o!)l21J?dVX( zp|kLp?g&>D7>HeS3k(101wXRj@}P2n5Y%5qdmvkxa?` z(~JorM2F7`NDlDr?`(jI^__^vUy!5!@PMGzh3w6sJrQElWQ5-jQ2+k^>>Y1k2K?=q zMSpe%$VQ8!`0wOHCq;12&aW2hyhttObA?+KGNF-+zas?Kgl3Muk*4Fp`;>Zbw&^(T<2Thj;Eh&QQEz>lRIfZ7xCx)ky z5j>c+vEbVqj(`2kx%qbf$hM+qCkh5^{YFt2snF_m#N~^Mao7cMNxS z@S8KAnKONhlby4j3!3fHi)YUGPIQ(gcZOQ00sZXFpL`Q&?TkStF>Ca=PHI2YN;&*qE7C7JjuFGzdXr_K8#WD>-@||3ao%vZNs- zV^&EUi3!|HHK^Dvpoz_u@@1ZEtsu9UiE~2cszUs_ys?f|8z-MukncYkO4ZPyGaCS?Uj4P^? zzcnV%fgLYSG%{byvV2pL{IebrEzUpf$T)F&+W!QG5U7E~Se)@mI7Gw@J;3?%pG`B9 zi?-qmPI|_zW36MU1-ls=Gmnl5LTs!CXvs&1#=^o%H-EVwm`O4Jcr1e952JIJcb*{7 zQ!2<|)@j?ru&A!lt&DcOXUkUHen*EB1e@b3`leeI1RtL`2Va4anPO)HtI>$kOipRlamjU{dFUGUy5^yiZ=m^8tgSgf_y0 z6iGNT=2BDW65+n+s(Zu3S$%#X)THM#(^-wxR<*m)3>CPzIfS%0(Hx#b{USX5`e%Y~ z)1$E?a>anJ{wDeHX+xD`l~4GJHxf51zt0QkN8s^JRHyJ3$0v2EdOV6}84aJQLu7@w zy)QB=Nxzj#I&>&eyYi37zoPgJFAo&QaivrGiFO;G#a&Q9ZG)k_urR@KeX0OvPkh|}VgzIEGg-;?XzOmJ)66oQ-j5Pmh3oFf&YY_b zx0BqXwf;xxgAQ(IyDy7y2X_I@_AD0w{!*7VwH!qy$W_X+V zW10q&R;6G-u-PcdOgr^l4wbf(T~_jvuQ73CB-*Yld>w1e5P~OXCEqD%!59e*f#CR; zco4>)%pLwHT_iy8<{nqy#Gcerci*v&I*}HRkklxQusr-u37L~qejCP{&+Vts?1hP0D1F8*&} z{r&jSU2cfHpch7R#G4AiaPa|esmnmmg9v8cE%pbdSJtzKexntg_3%JVJdZi}DpR0-gW zPh9I-iYvjCmqjU2GO1-IaRCow58mdcR6hx`)2naxZ67|C$StXIxy_{yATwAD9O8h%Mt@NR77PthhL~e*OaiIw|(Rq*~Q}Pukp?|a-X9mU-y}fBW0frs_mGx zc$mmTG|<+f))3c2->vpK7H;=_pf*>MQS~}k5u_{N)jo~V!Ac#CzSvTvu0A}sO1F`Z zj?I0x=oi2xn1168zIr+CYc2dvoRMdij#lWQyi0!XmHO<`UHUe6NPen(!9}d>m#{8e zx4jSsMNd|*)K9?M_Ez2u-yj!h&c!WnSyMqoAL5qPT}X8|cQEY~nD2RTFS9DfVK!*m&oe^pZ%=kJMHVZnn=5{jD7asjrNdQ$qsXKrSToz+Sf5x^>T6@ zs$R|%p)L1PTc%HK$gVnoa36d)!1%=SXJ>1pn@uPqP9c%lt?EVTIF8R6G_t%ix5~J* z>Zn5ov&=Vna5A+1@XR?MI%*WBYzda+i^W^eOh6za)AbG!Y_9m9kJXbxrDSM#_%M(l zO;PzFN`AdL7E7?KOUz`Mqp}ACMD&=E8Fa`8VO&0r-U@G+0IwF5RGjN$8-Agj&Aq}f zR7n5ZC4&+42X9{-@;%k8L<*I2RmtlkNw&no#I&8B^-hHD) zUNi5C!j2hhWs(E?);4LP|G!NtB+oPN^1&$lYTwrCy7S!i%wwnSiSzCkEp@ji$OX%X zd!uP)%_YB|zK6w(y)HLoRg`cU10Keq&n7VF0b(w)?d^<>Lm^^_l zwIHlul@BJtpHXGROl#v^;nbI~$pL$27}vt=S|PP9=PG?kmBC7fgH^ydGA7S$GTf1n zf>JGHZSFi=fO1vQY2nM={CxT#8j%u%rE@tX%hdf{&G?45MP_efQwZL-NpCzlJ&cyU z4qu0k^{kXI_`aotYi0RC#n)lm{uYy*;x0L+pv}k(p6?^9)s!S?%YIDHIr?(ls)S7T zA>Azy$qj9KgYX-zNM6gr>4C1-H6pA+j2db%WgBy62ND%%5n&S(XvRpb zqQT$M_NnuW@h@sGwU$0z(0*#yg#o8t1LgA5WTy&PPhNwo)RC>wRQ&fAo+&(%DWUXZll&LFQj+?#8 ztTJkci|phHG^rj{tk>x+a+j=7{R@E4CHXP2YxOFTHOE#@3X<7zTeB+w}tq zMkdf#pP?M4MqO+zNwko=*$`eqcKYGwN{mfA-b1b_N`9yLANGy>jgs6L$+hp#3|U(m zwLi<0H;$-y0NXM2vm9P+eg;WZ-BDx0yb-Av`_yI6fbrSBB7-51o7f%4QS9xd3M>WO zh!bQ&Z%delk_X|V&J2gir1nqHBCdyif5^bQxX!x9<#q-pLg_=m%XON4l^F(ysv9I~ zspNgq6F9vBZsv=|=sd}10~-d>$nm+7+^%wYgP~@AnLd?laL85{t|3l7$62LQO=HTVvYB`GwzZDB z(a62rdTj$J9`E+Msya9tcgO+KoXB{dK$f!KaqDr&T{`xfeu8EW3U9SCb@-^tk&}&Y z>k9nS4r%L;8D&=YhI*|S2{$Y)3qLU!8fTF5_Q5_i0}WbSN;`toNz0CwF7iCh-Ze6V zrrpg8=atq_=0Ss~d1yw!#vIO#6!sC`@zM-Z9N)OFk{nQS?RL?eLoaTyt%QBZ?6<1l zj(jTtrVx}TAV{S+7$9c2fga}1e(W*}jz@KelF9I%9geY{EhV{G_P@sY*;kh-`r41T z{l#uBvRooVv2}Q`Ps{*av;RFIzIqqz)>h~&^Qpg34R)F?L>WM4owpFTS1?Gafml2j zu^Ttta3*N0L`OjY|0T;QJcWeZqfT|-GG^3hM6emzJX`R_eTclDTX+80(9}JPk`X63 zL+grxrkbK0zr=9ggqt>8sN|%zpo<#m*~fGYG`i%%mi~`t5(Q<1R<-aST((QtQq{Vi z3B^|+qm}lS^EA(%fV$juv5_T9RL31}88$If|DnYryfKGQG&ja4OP1E3W;ZsN{N=R2 z?7eVTj66)POlspuy99tJGr=Yh7ddW~ff0cvW9{b%sGgr38Ec-7afK<7hy5PfKy`jP zE@5Y}#sydB=G~4)=C|#_+ddAqXCiaztU68dvn#Iqi>I0nwSC!MiTrt+y|jI5BSlZ+ z=ac3ulSUH z_E01}Ti(I^;G%#Lv z-{AZ5k_UymbCEp^y#}tF_T*kvX_@XM~jodiLpwmUNpKsPvkw=#wFfpbNF}8C=yRcf(=!zp!NYM(&O;e=J$NnxSZUw zNA^Y!QtT_}7hR7!4$D3RwLTkjP#M{mJU<@GNezFjV@1oYA~<&DIkp9)Wt<~Gbi0G< z(mNL$Fc)FgYSNThWt~b|PgLJT&E5naWE-{geESg4iul=V05=#VznJdfdX1g#K1cBD z4ABk%>Ah?lQ_(-{?{$XQXwV?MuU6{~;&)$1*sQx-Ujhuz~I?-Usl8kMTmcd&d+G|-cj`oDK z=*p;zB)o6J7)17E<^P-$ibOD}A_E&XZ2@F7F3Apbc>BXOjeQ|8ogtT*EqG5{tY zPCLYMuHt?u2GB%1tuah%L`?D=KI$DEe|BTQ5Te554uW*&OmNa2X%+`p-41s6RY~k! zT3rzlJrLKiz2NpEvIE$OlAj8-bgmaT z@S7hCpDk`MjqHuT^^3;rPh24#gce0$5y)LMQL4X}wl zZuU>IUG#BAH33LWKIQU_G|rpdZ+t7}2GXw&8UGy?G?;D+yd9WO6Lk}NRNiYj5)(0L zF%|FZz)UM?C^&ZP7=hmOtdiUz$R{b;rb3*dvTB|tHs&x;cvj-K!s0isD;ya*#Ol5{ z($#DQX<_mg)X6%I4H(j?Fu4nNbq{8pBq01C-4D_7j5TU>=}lv*q3;!VJGH0vP%hwp z8m<6n0@c%B@>zRv4}Hvep|Z&!F`bwKCxh%h?VNoj{CMrO+uVoJEG_=grAYI7huR-I z!j}Fs<8F^&fI!rgt#IHDWzmli=o^Ui?O75m6&-h}WzUNp99ts-edF4Ox2M#dr}Ug> z=3MYQYkZI(w-whOFfe!gaTU7JJG=U0C^>tmFrtkvyoWsYcKP)z1*D%25~IIcz0S=i z-DnsmlR9K)U7c6+dtQ?xqlDfRm8i$P@~-V8zax*;o|mhB0cbU6vF^%gnEY+B^L@I7 zvNxL|5LXe>#Ii5c0I-OH8vxw#k(_8Xd^})ET*sGXE4J_lv_3Aw81xjDOuc-*me@jX zOXy3CE(>t4bl+5gACWH4V&d=~kw?Nie64QSc_6O@brU(Pv~v71)#*2 z=lxq||GvkPV|k6cUWl7-Gl>8rKZ1*uRO%b#OK+oqhZtY)&i ztNA2H2Pzp^(3F3rI)%d4@=`m!mPNg3R~WXUvU&}6;_@~wHo7h0s|8#hhSd4GgvHHlUrk~S~+w{~(-7n9_C`x7h3s`1jPLU9gwBVpi| z>2ao%5E7np+s*#NSC zoue@IjkOKcJrz;ZGd^;u_7yfq46c;QILZ>~cbx4B?MD3%9Dk`KTNI5rp~~hO=A-}} z|9BXxF(`+B!!uSpt)XY$5HdPrgNG^dqt^BhGs&trBNr%mhL4^e_x&KNF;WtP*FX1L zMtx@N=Xw;|KROpzVpQ(fiYS&RR`WuO^~b{G*MHeb8YcI9CT>4QJnJ_Ip=T)?P?Na} z1uF?wXF1Lc3g1JW)vYk#q(<&Ifi6~xZ<*yJm&m35vKvRplvg`EAa4$?{froMOXUq@ z#1BbC`rR)(dQ?HSC>{aixC81lVo=E%3WBGg6~5J(YhdSvI%5)vl{8Olz(f(z=a7;o zS1fx0C|jU1^}as}jXQTMmc+Ug$3qV=(j95=w>%A)Tet7qPQ5=O=<#Ec+|l8B*P&_! z+M<<~bmO%hCbZLPeD4aP{>i^@A(-{-4JBlTdVJVRlr_ipA1`J447ML5OwW~PXDtgX zR=t|D7Zrd&xsLA) z^{hN0N_?Cr#Lg@vchGb4!(Ac_%l%Q)G5-2#xDPFWQJOYJ=}a=Un<9!0^ph3zXM&se zHsQ^DNPUL2fqK7CJ!-)@QH^xVea=S3$=5Dn126uZ2`|WS{&dz6o*h zy&c$O~hy;7d9HR}s~zd{pT_0n-*@UN(cFzBp= zYtt%t(9y0VnVq%`2G^bH@2U%{3zye<(roS}lXKNXNMIZg2^C&wnR}Wi}M_PrpN{J29d& zt8O}Ww*j!?whqE5H~Uj+1EKda3>@-VJQ}%sQdnnzsdZO<@i=2(lEPJ z27bH3!0)-LV<#*1Hn%CqE^7G*N_84x_Er{Un1*{O>12@Ve?H4homxvtrW2K)DWH%( z^OXQOPUu>+a*xM-=dl>}P@hW|3)8VRy?;ZRj40qfM6lNr9% zX0;c$4zG+&t3hcO=Uh1a`hs7S@$hby_hGgX*T^Yv+3zW8!pqj^)0OTIs*JiBS6u2; z`DUpm^?s&xN5kG$+NKFz=fbi5H?1WX!?VU-cF{vq(W-ZrF)+wI< z(1TMDX zZeJ)lCC)p^Pk&&}WzXAMN~Axf=L9}ye|)5^Z)rFBB=7J5|M{^;&#D~lueH|{t<07# z)%FtjKlYaCTJB$e7C_^(eZDP1W#7)N^T_YtdnEdBrhKZe$+*9dL%|IB(2()s_AAIs zX(jR}R3DwJBxIK`@b*5msMyAO`Z67;rlM3KiZiAIP#&O`6$CkM1$nmt>WZ__E)LGE zl1pXYLRVe;Kh0kW!dNjvzKPx%AwEG&LHP|7kENU+Yo;yK}RW0K}-x?-W>Q&6K(K5knU;6L4Mu z6=a?`Yt1I^Ap^WotXYE$x4SJV z$VDjD_Yv9?_#Nk_J0s(Gh%-;*P+PVLEhm38!q1dSrbnTYzNwxa0-y~g#nRg~F5}1A zF1DT(^DA_-$4M8oc=`M=PQ05?^GGDK_tZn%A4AgMw_lgxFJj|n4+m(kT z`b!ms_~46^J)E09Yn?20P*fiiJgUA{C5?n?oEEjrG-6)^8Zgs{{Zj7@qem}{XjF9G z`l{@gS~#Tb5=hsh)riO+a7gZz8VIbAo@{Gz)Ruaa2%#cA*~-*a3IHX;55sejUk+x( zO+9eAqn$&zp`P^rxD(*4@MaJ^z|3&g_Yqc7ktPXG@2|B=yK=IT6J|`ZyNyO&^tsV| zZ@5HJu2f8tQ#e?1@u(Ty_>7r*_-Cz;?Fr&(hk7pf9d4n~-}~3nk(VD;kx%m?6ddpe zv+D1L4UdgygFqjHvNzM+IuUkA#ttVV!J(Yy!wW+DD2ZRsnB~)j}xt{_vt?d>lv_fkL=6q1BLernp_6> zTO?0utrs7hjG55=kUF@NOYCsJb&^0KPT=0O@Sc?^;O7TtrwgxImb2GZ$9$El7pm*d z&Xml14yMqW!u(N1Dk%i{rVRhvj{q0lk3z!2yPx88qU6obRF?RoU~A~Zu(gEk@567x zkVCGL2QxXF`evWr2)5DX2b2H0B8cZbe}VbPB?whXNnCjNj|r=5C35b|zr`IQxT)N0 zqP5kmiQi{fHEHRd{%d~RHmmcF?I<6uK%4M~`OWBp`y(22`jAC_(U!^zVL>7e`9TFAoEC&#Dj3n!Q$uS$A zTRxl8$pY&SkIVj-|BskBv!n>uC|9rzDJ9sh(!?)7Kf!JEpqb<*J}bMh47YDNvEj^Z zA)jbZ{z|igO+N_ZJQl(+7?5_Nk;R_zES!F7F)A<-zNG_@OFza7F>(Q(>yM znJORFw=8gDBnKC_TfNt9^E$$CNjyo;ZD`-vP&2}+uadCBPVzN1>SQK=UrDl$ZYEz1 zCohbB5;`vG7|I}tJ2j{+!;Qly8f&IoKMpc)5LpAqg`59xv=j#YcbNBq(^2aA{j{08 z%5zTSgLB{chUfXE8M+&MDMP418E2r$Xw?I+u{(jqxtdW|$_#tVLSGQW8ZqACp92Qk z-yw5qA~qQ`CPqRHVrNgYAST=ZOe!V$%L;(S82Jq-Y`?NGfdVdXh`l?S#{=B?21!@#1rOwifx|jIYT8X z)ieA8+BWo-KkD%cCN13SO|BiuVZ>Bd>gCluHJU47N7m&oejmR4Nu8%zbrjagzTdUq zmWm-k?wMX!@YuWa{oemhvkawx(jqP{jykq17a2U$qn;Y;d1J;F8HOd^6$*A_4Gf0T)2nG2u&F=_O~tyUU!1Iv><=@Porz zHqj+~l05i%Bc|H9)mWhX{X5C{4JuL6;^M@sMwR4Jnb)}29tWOp1wPTm-;z$lP}zQe zTPr?|HK;u$vd$IAn_bws%4k_sBxlkl6k!!3(>t>t8%YvEIuKg(P@dDUV55WOLOen-7qoLoe@_YJp9uJd#!pPlALC5l*CDG#s$9*$2#5T z@E<@phnHlX&^6(f(c~V(=tGeZ|09AASM%}vEi}uTB{&ccm zm9Rn}yLtmSsQ49`a*^u3_NN_82lT@23NtLoBjzUdUZ!u@+9Pwui8r9M)n3CoWDlYlrY!5~Nue?QesZ6A--cL(?6UsRl0C@#updbN2UpBC61MW0V`JOD9>)hTP7M4N*y z*u{bmW^5C7!%?%e6w5?j+5TjUvJu~4$xLdU=dn1VZ&nBE5D#Xv7UuA!FbASnkvvZkJ{;=X)2i9rak#N4tThag|$K3Bk=W{ zz4gbDZ@IgsBJQr5lF}NVf~6SoIbZ`fJ9ZRAbY@f*Wx80Rx&~O)&gIq-crNbG)s4PY zIqS0qFWN-m*qmL+8R9el85sN7i&pHHVJVmp=#QbMbBGWT24553R(M6UOX!L+3A`mb zn#piol-=#^^SXw*7$MHN=jrU3KcD=tRM+puam;HZ5BOVJ-(1N*uGv3= zp;-6aoq%G!JSwzP*jGhClM$TykeQQyTj=%@-LBfUp|6PaD}uxN(6Z6vgc&1>jZa;U zwr+iG9pM6>Q&JfgpB@zW1m#p+Gc=spPB$mX7IZfCww9$bKhb}{pgIzX!!1nQd>|!@ z88?PPw}uQoAL`O1X;&5Je_W$mdWrWA)7wpgjvO`rFE=|Rje*w|0#|-xT@2pY0Kw7# zZapL1tBYSbQk>sDcItONCt;)|M}N|vI4?sbpWIT)*`g2_q8eXt3YV&*WxnxwXO7r; zzYT+R?O5AbRHQdM9u@5{;_ns9Ar*v}USf}QJjD-PVQ%@&gzhEYz$+RRP@QYi=BfS3HB2#6C=w=*L$ruDS2b8H-Ygx z%$xUA*hgaqPJFM;xj~{F-`e#tElDpQH+{p?mVtT`CU&_P~rX?@Yh{MO=7k{&CG?B+W; zuZd}ywPNHgPYMZXNzE-Q$2FP;^Y2>BPti$9^T{KnWi!rhA)_<%_VAW5Ey;m0HNkeU zpKSHc)e}q(g#=AA&z4WU%e^2NgP~BL2a^TdDPG9*pHo7%I4fj+t~?3~iF5T+`hwB< zhod3$<017^gY$wxnfVEa`Em`$e0}0*ddM{Qk^cOr+^cglwDL7GA@d{itG()0&kQEd z6S%O*z`)IP=j?NHLrbG;L)>TXMkGHB5EN+Jdktoj?1QM8&Km;j_OdtN zyF;ZF;v!jlE;P59q2Jc-)=X<|JB>Dq)YOlij;k?sa^3k1nMqBPO?7?#44FmEk$vO3 zbEO~xa`v56X7FD(2jTGxOU5a{+bADl8lP}!Qi2A5ltGun5rY?#h3jWK9zeXX&_V=u zT*YM3f{TmOoe?axq^Y~BksLoyFEFu>D$mQ+Uvzh7?T?(^Guec=lv|^_+pnIn*&J=) zX!|xbw{JV&Sr}s~DOtWUwJo{9pOsv0$ZAz7o_MMFBa$QbjaI1~aZm-Qdf{hxQSEkr znwWs(?uOJ2}7e)smq{(AyzSD~&?9up2 zofq)}7DY9=6u}DCy^D}0h?+%&0#1h(UrJX%6l(mB^Nr+!48>V)2G5_MD1k_lV&1qzg{Xn@rfno=s#}g4RL}+1%r87tll6$n+Ja07S ziuKA1syP#^w&>*Y!Rx8 z2`0T`hgf>rzd7)Dag#^^pL_VnqI$96v6Y&=wE{Pck~+N$@BIGfZYQ-1VGB=0uKy@MxQ}4mjGn-240d+z>2#^2`NZ=?%jo zb=$&Z>1vMo%HJd_f-!IP?AKB@UKw8Tt5}A?3y1feb8lWOO%2}5-4Uy3%gwUdU>lg+ ziSrMmH*ZiA^L60P&U}8upye_?Xy?pgc=R_6?c99~53NHA-CBzN*Z7kesrjU%#luwS zdtdCWT(acU#xIUEtW6L2?wt{_(0Ud5>4{uINpf4fz`i6G1aRSe2A)Mw)3KW z*GqSO#8~TPNxh2-7`mYC)M!^u`ILFKoO1rt((=IG`yc0nx}H@9&rVhEun!#DT3-f< zk$s3$do*o-;Y@a{qQ8KdtXDF$wZ1-NpujoTzb{)lO@BV0mL?d|9x=f~{91djYi=%i z>pWLcUxzOiGQ(=0XV1?i=g+}Z^T8Uix$!@P=f~1R+DGa`1cQ&t=gQ}`-|p4!Hw_Uq z!9%-)4%z~@3nE*s{Pl#!*MB26-hNcwlurmhevO9)={-C?SqnLo!@JqjpqxUk54`gO z6$Ch!wr81%SV;))=PqlH+;_r!dY|sxrNN(bQw*6Mb=zv3yl<#jE|)SiwLV(E`-!=! z;Jns_>Vz!!xFY|wJ{5=RS+Bk=amn?~ZRY3((+k1-&Aso7IlDfe(ccZe4iWR^shTBA zUM)!hg%sw#VC3@c34CzNHUznqSj{>54)18A$dxuQYjYV;hv!a$HI!lnJNJM-3xC{W z7j%!{7^9fJ_+{}~F8kAoiTcjl$8LOEDrgY01cEW`S&axk>P6_m6dK$@7kffrOSiTS z!7ZXgmK}=BpYR2->$C&1L67yKR-^2l_o{LiRG(9pb4Zee)~}fS2t=1 zYj^M!<1VrXeU^^42>|GSZGSspE+R{c%pCq4A#nI-F(6pZMUjKUvXGAs+0rkbV7)Pf z2c5uItT7T*bs+#e;+`8!;0umc0X#xVzMK*`J7Hmfww)JS{*BjowEdgQRHc@3DsBKY zt^E+0E5$0C88<*_kG>ZM?P5K5L^ z-;qNuY-+ZQv-u4ZGd)pbh_;Qi5gwgWt@-%W03X4_EEuCau(xPM1*QfyG3YdcbuP>; z$f7FQ(#8E~Mj=*=OE4>T(t>p& zQeCsI`La0+dgcB&DZ`a8=u9MPsEINW$4}sA8o7p;ml~YENJ%tX16DC~1PMl=YBX4H z@$F|WciQRY2T+Wlw|zmrHrwo?7W|~W3hQxWyG>hb4w>%cT7#g9^rcUFw|?wd&p#mj z2?1*h^feF&$3WOyYF}hOyabjU`DY1&M!hUMay-yNtkz+V-$hMoOWVD_qorSeH-|3=XPC@Y3=XN8t#0vp>bvXb-Tcsfbzn_W6p_J znYi`AE+|&V6lNZzRCBIL=M?K;t<(E3tft{N@i*d?5Kd^{tUdwo;lo)dj0w;9xUjdN zKGvgJF?TO+dIL1>r?p#$AY;j-Iqs$EdMtm-A3 z%R35I<_uqR1KW_VTG2vo6vLK3{4^5IZ#PoKgs9{nBebb4=JSjjtB z3453g$1heqc;_5}4*^=EZKW7ilXG_kR#WPw9b9y?jv33K*1?@KR%=viGix>W0zpg8 z{ni{#2>ahaxW(!4bXzr#vR#Iy=ilXh?!y|EP2|r{6}vG>nTb!`57Nc3Z|t!8iJ7rM zg3D=#Y;72=2n)0Yh>_{vVg&s0$ZRi1Tl#7%v>sjDiuFo&x4;fNu|hGP=EBI>OXyRt ztsu|Y0v7kh1^&9kOxSy}kd|a3{MsJLOgP%=mlZ6rLLZK}q-l93EDM`jT9YO9QZtDF zist7!8wU*QN)Nas#RbzpKW!ifk2UID20T(Ig+EIXu$ry;VEpv;D<=FZTe9%|(JM8R z8>h@z$0E0C*ETDPWA0@7N7%nR>@D>->1Ij)LC7zlCki-i!dxUKa+rYfn;HO1^SQOh zM*md{=CoAzbyQEsmBK@|s;+J~wny&uu(AcIzLZ8y&-}WkMdh@L!1Bn$3EWWD7<<6OfjuAImKx^q&n>GR94%{~0~vzG{MAS75j7bDedc>6Da zO7_mNF3_Xe`OsWdFS*_Bcx@8_x^9K)b{*PQAeSSR2L_RPU)BMf2jygYN+C7neAu8m zhA$N2DW0n6ij*)<92uU*`&);D2lwj2bhry^CeXGkFR8w6!H{LeTy0%YJ($=`J1oRO z;Fq6J@5DE`sG+?PmE`U$e``Vluj=X-30ksi$rlVx$&tSwoq#Mta_;hUbC+Qve^xCK z>HVmFWPm4&?gtpnHIp%yA9NbO}&(x7CaTe?|$61lNjjHRo=%Zv> z9T~@U(TuxNCZO5+ukLq%a36xhAAO9gD1aNF)@n?gP%PY$LyggjCQe5P#2?q%42k_@ z?k)9oiHIc?Qbjw2Nq4XDVtn+u#)AroQ=QzXErJCb?#@>1I`{kF$Tc@{OlK6i`()`1 z%BcNyp?*~8+>MZVORq&>u+1JKKdtUSkoe{G8%{@Ho%ib=^_Hw8NqunLYMZ&%iqfr8 z(V_!ZM7#P-m>efOiCKJKU>3&nkCI zW-+z9g!2u$F$y!kj^loT*5kqnM@FRv&E*dp&`XSJiKgnS)yj-ZM{OhbN_M->UR>EB zd$)BZcJsLYET8ljlC$Qnsge*o17Ic`TfTSh0gR-$xpK=jWX@|F`Z6n(*Km;9Qa!G# zV9B{tkFigwv0x==(Cj=YMLo-%Y{?`NCwd8Zi_G5&I2QQdN3<01Jbmr zDJCFct+;sLo2J4IcAKazQw`Aziz|Q&XFhQk2g3ydIeysIrlIxneaOE)bd?KsQstrK z2w|%A68Uo(}=(S|GGTNgLxl<&yt(}eq-ue#RFsO(dn zyZraX{?pAInE5Ve z__{EF{;?qOY4}k1j>q%eUF8cRLB35y@a`GheS@Gydy+G?uDO?88z#msZ#`LJVy-AN34M!HVb+e*!q*<;z zT}Frdn63mDRQLN_XH2}zO6HpsO8@H4PR;qL;Inp2jOL6|B!OfEe$&bdPHink$=7-?riUH_qgD*8J%g#Ym2L z1-Z>0wV5h;B*NMW{9D$b6QA*7BUN6gY%_mmD>6@nlG3O#{^B{*$7$uam?C+Z5 zX)ao)-gLEgH{knpUx%kl?{hV+%zWIsvp+2-JJdB#jh>8?JsGTL&U#;e0X$)?hr8bT zIplfwxvxpa!U5d3?X@TV3I?x`d4^zPc_8C}8L}y`e9Dfe$xe-(jy$-C!J;)X8xqjSZxJtsCejQqbAp1`_Cl;J$UG%6|FCCaT*pB@O+0G0>`A38OPggGDG-DW5c)Olo^>eQA6F=&>Uaw zL_wIGe{VK)Y7?_%A~1N>R}<1Xg37^D2%RZj;AT-&4u#2^SmGJ}72dpuooY=aQvnpX zbBrZDoFvDpv&}!?Eva8D3Ij6jE=hKupsyy`hq-YT6WCK+nUD?N$o^0Bu~*^h*Pt0s z%{w&!_qfLE^}LMmJ4ahN z1t&yq{?;nkFtiujAppAivcth3__rMXql{e%GR#&8H~C4-XXn zz)O{CWjk26p}>H#=uzSFLxdsxSvKf3MiJTl<&+S1v#A7JjDtP)P4&8pfZ_+c*HREYQpj#^BwIa z=Ke|3{AHKDSN!)$V(K{;80my%Lj8{GDmKU}+qIgn2t`MdVx z!wkLw%?0~r4%0WOQ28=_J?0oXs~>LrPPNR}FKLlG&#gSMwH|w4jE|OD`7668)&vez zVy2x?Y(PsiiN4HFbuTwZiYf(l(D)}#i5h8P6#uxXDg*xhQ#K_u3hR{VD@MrlZ;bQH zV?D2(I=_K6f(whD^nSOqMPp(_G%Db6ud~(HYvSdq*OHHyewIeyM3c#8Md|g8izE>i zrHGd?z36n{E4wFwD`kq-%m$?fRT!leaBLoC*&)%|&v*lO?aves;Aj;o@}2wvl@8q6 z3I(SF)VA&Tw@(WA(k4=t@D%h~(ng|G0*jTgA2#6Uh-AwCd=9U~Y}6e8X>}*(BXmci z)Nr-bap>SYLt?IRBd(@V`O88ML4k1%zaeuf!tnCFu!SfOAcQ(la_7xP`8C(-(hiNE znV+3hV86TLifc1pN(~F|Zj-Jl`WX6NKT|CsYGp;ou-Q$U;Wsqe9$Af?6zsCMv?PNJ zVJm{UIkP?hcIN@Q+28T8(v)*dRXA;sTDXrgm*XVse^Q1bKh$qaksrQzt8hC1Q~lB% zi>B$O(mh|d*oGgM-8R{;^!>vc>f*2;rG0EpCKkC8v4BGkl6hh?)b0(%MkfA^0en!H zNSkVdDoot%%42I!7Rpq{cv(kId76lCu{cj3OhJ2!k|W|ayDenahtD$xYv$_*7J2=Vq1?!}@Tp93ebrRmT>aj9VUPcw$j{<> zo29=qCBXv!LD6Wr#R5;Qb*Wx5U+N{AD~&YM43mf@UtVPjB%SrkJ`#v!+Js(HEJ-bX zP)HA(3R)BnN?ef^u_(L#n}J&|Jd09a& zMWLV06NU^QmD4<&&I#~=G1_~`*%ovyjT;G)-ge~kYtrWLq_*9|ty`p)0hBJs0yGYM zz*;fG8H;0Ih!aOA10j59HjrnKI(1z`KEvPo^!7Fmlo`9+*(oUbee}6MonkR3WBs*X zR<2`?*hJizXv=(E^}qs``2SmS$m1qA%8k*y@xOTIePfj+wT3nVNvx2TNjzAgDp^#M zxWpr#}geN1z)-8v~s zUOqLICr2Koqg+xJ5qH#dLlugS^me{l7k)G7yq|R73x2p z^LEmGC*o#GYUQWt@z#@9V0Ea=3zk&sW*Ou|$5pKF#lRun)Yr_~K?dL=`Xi92Bd($@ z2BT)wEnXUlV2Mr=VRbNH`(ig%$4Q!B|E_b58H;Tbx8Cyp_Rrqv0?L87Ei4ZN(wW!Q z|9g@5K0|Hw4UYiBwEpL`yUrUeYk2FmwZGF|V<}ZL7O=KcBhm*$1Ho-dsYz_Ij4mmh z+^4jb1f8US*MCBy8Zn|_0!0E*5BKYq9ZXhm84#MbH`jgc|9?`}!K68yFw?gVcw+$X)AGbzEF z$)A$deYw(K9~WWB+GG*Pk2jL=--kn4l#GYp@0S*XIo7bw#MnQEk^Xg8Tw2AIl)bnw zt*`eggQ=;|<-Fa#!*O7Py`3HUR$O+*u-}(`(U1;KG{R{*dQ&&1ta_l#M<5nxD{6Vk@%cvq&`Z|&A!cE5g*v;)dP52ro;j#)-ke(5SJKPU|(S-L|2Sm$FJe% z3oyLF$gmF8%7jn6eBJ)eaOf9u6ry-!b9#D}=O0k#Dce{%W?bQVYoaaP=IhER{=HCt z;A{Ax0$zx8#^j^t$uCs0o@KfGDwjhy$8U`V3)I=>r!7A^xP_%q%cAxf6T%0w5aLIL?-Lp8gVJDn_O}(j>UFrIzER+s6ur z_nAE!HOUo6ys6_uchtjwZI$kZL}B;xaBd&VrdBlUA!M49eiPsxG;g}_%2QZ(6s4%e>USQ&Dkk!TYcr?md-!mZgUQHX-r6J%7IH-tlCbizn(;r3Q{#JSld z>zp%}?rm|{RdBOShFl!@55FqLQ0}#SRlMh)v{1bgjKhX-XKK|F`GTb9V=OFq>Dzcz z&+c6%<_WEr6}4DZA^_IC4}WXeFV|~9+B!j_R1e0mzf)f}KOSEH@DEAI(FsmdwOinT zdjcw)ffL70Di${{G^rbdak?|&K$FP(O$@YS2=&l*rlTX`3b8I)^f`sZ)rW6G%?iFp z+}?cHw-L+PoSdy2+|~2O2sciH*L20Uzrj6UYM;qf;fRDVd*eP#vkm zcH=qH&TcsOT?sjjaF892YTSw`pBxOOF1}Ic$mhggbBZ^w7EJNz*9XxS{I!@n(@j(! zJz`MWZiPtrMR7ijoF_x66D!Jn{RB_eigmZl$rThivT zU0wFz{LEm%LlO?jlrGgU_}3p-^X==C&L-^0xz|+Lh0Jw*$eLWVekjkiHN%jopqhef z50x2g2Deyh!F2bg6zGqzJ@oiY10$Wzg-O|z%;sgAJQ_u*jpok2dS=HHyMNmMVa?lX z|9K6m7A*Sm$9l1n8HDUorKx@#R@XVa95HuyKObRdI~I?k;^$SIGIfOa(unTy%JpNLOg!G&;F}FLS5uj$BO|rdEoQS{?CLKp^#s(v)tO04%gC5X z3(Ii&oVK>dd^+upt84YhJ%>!!nT3hM9@E910Mw(}nb$=MgW&=8#yT@=Sf*&qhlzyW zj(t^;tP1^G^39q0OI^CEP?C!`7r>_UD}*RTV_l1^zVb%v8QiAsQJ+08&i$Qy*y8Bc zD^i>ZkWm=sF(~D`T0woGh-dN}J;Q@)L$dsH$Y2k(<#-KkDz$8h#Ri4z1-7OxI%n}> zuyzTrJk^+aH(A@O`BqbQze4Lp+Wz*A3;XhRuUaM{$S~@?2W+Y@}O)IFe`dTvrVd%pflA)d`nN~%7> ze5_KNQTM){w+lzD?0iwz+B?m&A3ZU85~0+D;i^fNrz+egq|w=^4cUdPd)?Xj z@Kpbpo*vST>^(Yv->hWr(ClJR267B}HmUQYa2$JcO#?*eksssW@qE*=3)2jG1BSKA zN6L$B>O%X>Ut7sj>3kl*H0w(+aqyBrKVE5K0@Gj(u38YNV(EuUgcJQ9zI5DwQ>a=vJoEJ2N1)XvwpO5UCtJp6$p5%FJ@ z*3I>hBLwA{XhHL!SdiA2{7xL*KB8OfJCnIv-}-ANbt4K&z<^@zJe6@WE*5Pdw^XUL zrKfyAr-aaWFVsi8z4*IW{UE2b@2%|gFcevTgFgz36sn8^>Z9(xI8{!zBXLR41-|^O zNO&qCy?4$KiEwu|!`T(N%v#MRTXh9Jy@Yr6>tUy36Kag$L}fsuBEN-aKxR}Z;>)2; zR{s!`fJ!iPquk>VG{oX!tqw#JlC#O~>~k;oDSf}oZv61}=f;0x(!OE#&KaY| zL5N?xv|R8~Kg#_q2VX1aG%onaxwAhI5mf(B#jL5F7wcj_?o4~_r(WaMZ#jUDE11cf zNy4)xvaVKlzV@C}gFl&dav_Vln6j3WqiZ30_1whudO&N8%qi{bo}X$9-L8u>@-st1 zm(d1Org*_*pO+h!CZ}Yu7*@JANcg@}2Rd~t(@hWOOU>`fK;|)3y`kvNqr^^2* zJon?{>e}pk0r&e)+K&ZPTtj#aRLKzrA`5;rX3N-TmUkaVRH*1-#t(xLkC7a@$$OSa z_+K%^cwh$^K{uQ0vWtXJP4Etyb1_)_TX@8a^~rC3qTd!vEkWQ62@T~(!Hiz0t~G5x zpMaIiF;*Um8Z*uaoR1zG_37$jDn}Goi$XvK8)N8nC~~eVXq4y6Ugtq?&~wi!GXKsJ>Z}^4^Mb$pX;t(LL2w;4Z1b+adOY!%a#Lt`8&S|Ko7A`~{ z1OXNNH@skh5KcWVz-FioN6kDs9ogcT_w^B2wUH~if2RIr5qtN%vaZ+=ros6){noMW zJL1+b1NwQ#6opnL!lZGUg623_)Km55?u!ZE6@b&hYE4&i$Y}08p)vbpPkvE4Pza4N zv)E*X#-$1*lUdWILcPA#ZYVTmFjL-tBH$BhA9woB8rHJnyz%_-eUk=72P9Byl#o6} zl_&GmxY7nE#UgXD&&J*PnG~o94h8=d>5i=Vv8->EJvE$EhV+in$Gz45fjd5dxnjaL zeK*kOFit#U9J=!%@dPIBK%lnLa16v#%2gajyVKxIuVf<#mK+9a%t7DbtWTelTy1w} zcRBw&cLxgn&~}6StiJbguF1Dwm&038k`xDF$sQ;e9*Emc(08}6j94#}S`%a~DcK!K z1E*a4cTh=7BfP)+kM}~y>iiafS)Q5T9d!CBxRoX6Flq)=D)GeHPckAa+zUqRUmML- zkxe9D1h~&4B6pMi7yCjcOz>)PQ{!gf`hA)_kSc_n3QDnFBHcbBj_ToAt2l3$LVAft zoP>ia_n-G}WWP>}I?l#SE|av4M^YBnSVHPF{`jHXu#(4jRUSO!oyS%O6(Y7Ytvkl- z3g41r2e*Sx|JLL?6-x_N4_A~SCAP5c7Ct*YW)f>0ruQjvmjV*c{i_dK)lP)+D77q8mZl6^uv65!k!Hu^7qi4LWZG@J`3oa1VTmt)f zatN@f?f}8LD1>@?+Rrmn))&vX_hjesSrE&)C&(UiJC%b_n?MyQd?bBw zJOY;fL`Oq0Z1G1bTZOPT3}I-XMFlF!t39-pOyIcd>BzEA%RsQQ{|6WV zaMLAwC2IG^#}y_UC0MyLAMjQ0#c5gQTrMqmqZd>g8fnnssnHu3UgEjCxn}0l8Q+{9 z*>vUF^s<2<4L(7|p-oW`)O6F`lEPq%lX=nDnQw;evprH298H9dN8p%+&DPw5W-)ID zv^V93183taw6+oBX~)A!%r%A z{=S^-<@)5J;Ztq(F?3@M2OYEt+4QD{RlvCj;DhHlYuhuk#QO@R5J_J3hC8N4cw|iY zOeI0N(H^$X;*%Yi{>>vG1@ku-c7QNA#Vcd6)~{$AKZfd(M|V=f`z+_ucs0@llk~Ef z=rVw@Tb2InicF%{DbL#rQhk$|>@za=iQKazyf1xz(I_cR_S>9-OLlJM@PK;PzNsAJ zzx1pXK2Q9sa+0Ni9D6)5v94oNZE<5!mULxsruMf~5qVo@aQi)_p-D};RF`(sX_>AB z_s}t3BGBzb7OH-G=-rfre;Z`0H10@b8Sk1XQIKD|Ox3_Pd?!nD??> z^h#{9{(^(mJ`j(UYt4JZx_405w;MoO6}|)E7iR+mG@h|tCbhdM=O!z3pP~Jh3X=iOZ;uRh4`3&e3X5Vwc z&Kx~jTi@bxsv#Xkuxhi@C^38&tpz-Zebrn)Ka&eN9h}&ime_J-j*3ZC$)JVWQe;ZP z#&T(F6`?gFwCgD5pOSgEq^gZQ@4zaEN z^H_;CNfc70{ac8Z3s-01##)e{>pHWWfhs_IBt>#baVJ25U;moFl$e zcjtl^qz!>i+b?Q<{<)oo11Uv}2!sId)y$@JD1YBnFC)gomhkpZgPyu8|2%aVbPBIY z^_mz8ywQ*4$w)n&SXTSng#<=~bSgzKbU#S6?H-L0F-v;@Z!Ev~k(OmnxOF3Do!vu~ zZ4*oGhDy1hH)~$M%Z}`@og=prGqt$b%_;si4cru~gx@Y~Hru4kVNjmIk+FLyTCmcB zO+R1FU4}s65B#Q9Fdn??Vq4D06R05AFjAe71fPaW7Mn%~z|PnG(O&vFG7A*R$p_?I z9&O#?i*MZ?`kP1!PUP_Ge!?M+g(2uJP#Wi>1{Gx(MC6r$MYKblrk&JEg`fSB1q|iM zFCP7^iVoAEh;L@4;)P1q$>dm%=Zg3Ru?dts1_JGkBR<7r*KSt5?r7XYr1{;Z^t*r% zjZk0r$VZlycE#7h8N^_F4E(W9NHckIR_C-@8hoHbxE~1LWrQG}!%YQSMjAiB|69(G zPeusY;fU{Ka{IYoT%@o=o~f2nmF`4GYjmXv(BY35xx0D8NGQDP7Q%{(4azb(f;U~s zzDX_T;*{&|Tf@FE&BvxNo&P8BvqVglC7t?pWm;(Uz?bghC|Kq{%NsoVV$mIG!k zcn*v6ddr8W1|n(?I!SkytS8GKC_IjF6L~T^go4#jB=?8(Fwnbw%NTiVB5{g*I4*pY#c_A9GJ?CFW`q>-P(*+;G zA>P0Vm1N=wlUk_O@DQJQBR?A|&f+8u>f!YT6W&dj^23|=kEiF94fkeiY_jb*zMN)F z#Xmq>$E8)e4me{ok=a<91>7W!Ig3 z??&ImZe{I=B>`Tb4n|?99p2*ZYnc)$t26pP8r{bI1UMaogfhJ9 zrjzOA_V7YKxi}W!n>5x-j1Kqk_4=QnjF7tw60$b7u^mJ*lOB=BDL#24I)b&gLVr%U z+IsZAH{Lh!(?vRT6>K{iT4FH;W55$Sts9nUU9KBD=s@%?6yV|tId|+n$RvehBW6@J z*V_UpWz$ndro*W1d?k?D-FE!Jhv6Q-S}3@ifnK3-8#i9n>>_s$Z%;0<2SWJ2id}Lm zl8e)G4OKgDlIWhKXT{U0pe>R{*xap=YMUxSjNYdR}P^UH<{s^C$*UqOBC#+g#;{MUIsnki$MHu!$LVCrv68RTK zBWI%vryW2n5!(-iclpY!2U1I_99PxM|68cD`?@{xK7eylB6jXmS~c$(r#Tbt;`*ra z1Ue_Lm9Q@~0zkOSOAw?cu5?~d8u6G|+_enhm-qcuno6nITNw-5XJ zSc1dNVPF+0< zC%FeDA6-2tFBrqdff|sfcR@+XoWIZAS&Igxt6MRv?7CQq0J1^U3FJik>D|ox+39Cc zN=R2WPR_N#?Fv5{lm zxf!BITKDqL0$)`kBwrT)jfA$ZU>j)zFH8VyGhepIXiN|3$UWN7tCxPszljn;{Xthc ztwymx_>(0ddt*GVgRFm8<7OMejlLk|wk9O&%X3@R7M&9m=cAM{?FWBf4T7!rgBu;V zWpEiNQE$ig7r5j(vZHLJ85K;Tz{8L1*zWP|t&n}sAO~oyajYoa7g~4rl_zyKvnJXg zNNx6fTwy@+Q7j&wv+c#^8L_=3iVov-8tQMrQ0<%V``THn6O=SQTo`qha%@@AVOI&= zp5+0ZZ@MeID5amb@?*fq;2oeK*}P7q2$KDjf7{`|c>E(C6-3p_adk39?(;_eaYs1- zhXj6Cx{}2^h=c9sODQ2^e|Esj&hukp3PPwVqqiG?4@XFwuiZa8-HVOhe~NQ0@F#kB z9gL`L)+SHhCj?bURo#Vp$+!pagKfamEQ=MXNTaR|`NYR?BB#?K;eAc|cI?;XCTS-z ze*e35>tl4#|zl)7cTe`lxlH~_@7|S;Q7=6{YIX^Fe)3mGr2ALOi`i&gO5B4cE zpO#t=)l~ZaZMVi;CBKckO>t`j1^C>Z+o^56rgYbih6F5nV7Tr7dCRUrNdkuXLd3cYt{3WF6KkISNHVI7<%tMtfL4*+n{f2kaoQCO3cIQ1u@h_o{QLE8szQ z|6V5mgs>JXQaJWA!;BgiH{p9|yd1eAWd|QRe&&O?JN&-8G=xv^v3GG>&uJqf-J#;( zRhS_6>)-#*U4lq)UP(mme5R)n(gwX?OaoR&(6pH%$?Oi31gK?#) z&1bco6~&&k>Q;2)fbMr_LBQ;J=}d{4juKWnUVInZY!p<&nyZrg=zGTpYCgu~(o{9k z<7mq`NFm<8zI!^Q4koo88fTE_6`qLoN zxw>CzqbXA-G)MS`&>>CWp5tzJSDkSzO7~MHL_kA>H|7+$ws$uvG-7rxcb{0*9&Fk06&E>Z1JO(5+05aK9UERD_Z?d#gVU}0gTKf9^c1v#ic99-^t{X!- zY%OhT@Nf^ej+GtLF-8HWjJ`hzI>fIlRX~RO=?+CH$>;i`emUmIfsp@1r7PzbIIW2B zb_4{Z+vWOc-VQgC$gJl#;nvzeGwfHf+R(Ugl%Re?uOUQmGmqPV2{0v#ic)r!-As@TRU4QUkGlN!S9*!FDl_9?~{w7 z5M_9$Z`d|Q#(^*!n##6zrwVA4eC-TqQlj-NQ&wLdI5BQgzQ)T{>-jo8oK1c&OAiCb zr@0RLLZen=#2Gt2(GtSfHElm0H1{w6W zCl9983KL-}jaGH6q5=yOqrc{;i$jd(u&vC^kjD5=+wE3vcWFJ!uEGEZc~~s}eX9G9 zz{H)aH2@W26?KcS1!CRV&@D5|T|b8b+7A?mmf-&IF##!EH)S#)rGG2amDd1gL9unj zKy13l*#F=6{MiPvu1VnzZr#IptTikFw9z53z#Tywer}0fr`$&*WrW=GQYV83S@R<2 z?zvrF7e*dGzF$xfa>1xhepO7viqiX5BEyZE!y`xAs@K zFooa@x_m=9_9}WcYd70*C2VhqEE2RS;wR5YgUJ2wHms{W=B3K0*%_glUX$kK5C6_l z7wS`bydF%`igu~n(7fqA*vv~#yMt>YsKh3FfhrSvtZ?!XLrZXPUY0rz^dqgM zF9>8Qk7gv#+D8uj_w-*_cEf-oY|msY#B9qbPlXPt1e~8^V#Q?o{*^`!K;@9h$Kj{; ziO%T(cBs|gb^G%Pl<}Kx>|t|D14J2s&(aihOt!W4$Y%LVCI1vFhHUnnxL2>YFN2a& z^Ss&L<)iJpuKGFB#Gpg<17o!_!rr$|absUt>g@f4s#UMFsXXy~ffM1mh&7P$sJ6H& zsBu!1?{C(ho~nYsD6o$|JQ)vJcdTw5#nQOvd#;mo%g|7uk?d5PS$%G`M9&Gt7l-L8 zkZ9+oW>4NY;J?>a3VzH8p*|bWT|_no0z{WPZu<1}tsMw@3!OfBcM@ZhJnsFSA93Tt?*R#=$wqeD`g zEH>?Kln3k={h*9gQN%l0hEs@h+8qCm=S^?F)&oxxD-*g0GC$oemv7O)75iNF(~ei+ z*$#SEAdpU$FLKJr{}cA^uLs-Z&tx?_p`?$M5ac!Wf;c*Pu*8!$i13iKnljlT*LlcL z>cFIEl&4?UJSmxws04TKGJ&CogP{}Jgi`m_7>YMqmI<1KJd1$`t00MNf$OOZ8;1Z} z56eBKY|ZPM1LqLg#?@&&P;2*x&(Z_GoS4YJ$-qti@?3bpvQ}s^)yr~VB&c@Atjs*% zDdz|e13Vu@0gd*++zegL9s590L3D`v0d7Gk?`4+r7)6NTbZW9;( z)kFW{@j0^U!dt0{X>#KV&8frNfcjb^h9PTpyM#QZQ&sIeu&MlL76!O+U~%mY&w4{S zeia6&SSB95>^0fDTL(hU`O3!qp@>`^2i*(|&V&n0yXFXI%|{G`!%-%yMW-qhDspXO zGsa36xZg3GDmfsG^)>0YtK-OZl_YqRRnLbN-Vn^9v+F^rT{lci^KH-PcRrQbgI*2hPlgTG2&gTY95sgy6{86_a z>VSTK^t(MX)~+)`#xnQ((*0Sj{%drg0%f*?Cp)}ZvLK=^5QIX zmX{m{L|LqnOa+nCRH4GgSWkTF97EP+V|WI@jiNK0YU^DO6dkNcdC@gF0TXSwhjA7? zcB472-a3I8IcLqs@wYpc9s`QbPWQ81F?+M9<3LF<&yiK@ghuCI)GbNO_vgsB{wT||GO#XGm0@&e5h3Z3g z^3*1b>yT=Fc&?K%syOY?mySu1EZbmn-3NP%FVDj;L#Nnw^A=N&%wF^qM=Z$Avym3K zHm|9$p}Qs#Gp~nDB4-|STSypOvc*hV)0E?4TJF5Xd|H0Q?6QB^#3JKMA1ZQY_OU|5 z%#4GC=|2!QWkw)s)fl0(4tE`8_kKhA_L-8HOTPa<&1r@D%g*@c`&0XN*dxa2?ZAol zKhKHa*jknxwpf2rnbTnc1AK&!$)OQvsktPsG&%!8)D!5Nmt=e2E{jQ&D>o@SaaDbU z=gd(a-6Twk3>dJ*bn00{U*c4V`!y)wDL6;&Wjo#yPPahEj)6TJu;XjMxUv(cr|`(w_1OklxH_OB=YMe_d3>ANM zB;@+tJH+lVJ|)#_?+&twbRLyGZMod^LUjsG%5${|E}h9)mSTOsru~0kcehVv1bfu<_gk%)9&`fCd06gYLpQ! zUZTE$_h0Ie#Rnl62i5((oTZ+>5y-B0v#pLffB*H{p56iBz<;Fia?81=w*as_dc8vI z>XXFNWh?SMo0KD%lwBnkuH0c;b?~&1dwXo7u}-y;vk7|XnPsX9`)9-LV0OLF z5~6>J$n$~MU530K-S+t#76DgUEJK3(@|uHg3H&b?M0XFapqO_W!Pwa6pQ>Cf3B-TI z`#<9y4`cMr0}5(j0;6QgVx&^uaIOxm;lB-IQoPhcy3KH`vLIdaxut4ac}9q^kEUBE zdQjchI28WI`iGIqB*7; zc6quf^D#leaG;%X47r713A&BmUy%v(EnCan*Efku{YwpvV7q zNIIT1ft_5IL#u%j^Z_GXx||2h6)Yhg9rA!0#lYeE5b}BQE}YG~?cmKbE>A0dJ-gi_ zs@-#dOC96NG@Hm**}s({h@`Ne0!4>_T^271;LTayC%6+c^tee)lJfOqu1b6*`REBA z5rE2ACz(stO+;O!bBY3kREEgE`Nkf}T$g~zYOP+Ti$n*%r=Q*>{nojDcB*Y8Ga zYX)O*3Llcww{YLt-(-W!cpRk_mgMY`SwfC$3f^TBt4MV|a;hbMa35(SuCkctElk&| zbU|yA%<%cx2|Te<#ZRucXXR@@;QV#Oj^nY`rj+MgsN!p_YScgwzCu^N6vP}W#do$+ znm7jI9sR8pr`jT3)mAU7%)?Zr9y0^U?I1Xap9P%>rLM#UVs3!FmXp!w&>gkfh%b$A z8%nE2Qis;}xmyU=G)({L!<8i%eGsQWP9oJ;u{8o>r4*Fr3dMQZ6!>PQPZb?x+b&+U z)i!LBPgd?$EByF<``~A_!6nycY*ShSwmxj|1q7NpCeXHz%}vR6nRa*md%qGvcLvv_ zJ@K=s(h2QrJ!qBF1&Y^$z%J}S#-{e4KW`Ws25pNS30qyPW32GBM5##PWVklLYQ$6H zY!8xHr1FpfLR7M_-z0Cc&1lQ{WM6+ocm4FhqfhyFCO_I<(EnMUdr|6S)Ot-|BrG4g z&v>wm&HPsc^XwveH2Xo0E2R zSjFWJ9suz}m=+)9+phPRVMjIQ$BIuChhaJrn6;m0QU0aD%YAa2Td(`IW-p!?DT?r9 zJeHA_ceX%(sTgWf!8_lhkj}uTt03M6`2dhwh_UnoP}=`Ld<|GJq&zSiLhQ1liGNn# z>;BV`JA0n55^a=B7f&US*S}a-7>vm#Xu|PsMsKz za^c@TKH($HT0-D+P0%`vC*Mo4wB@gSVg{hY2ih~Y69X`Rr>y8WkQejX=b;1k2S%|> zKq8J++E@g(#`BMj3T7LO@E0Wl^{pn=sxE?>boQu@@`t+l_Gbs^8zCN_33NV^LvAyc6|(j$*y?sle`6A!)+f%Zs%opc=y_Lz&IJ#b)3o3 zwy@<-NCN*SmFKL-^T|H5dX7QJArxXmPPgaej<_M6FaF?k; z2;^&x>Vp?oV+Nht=7GtvCPn`5yxjm95FI+}m+|kxJPp}1?thVi*G?}KT)XTXNy_thk|>%~+) zjOHtPdx|0#;1;N>C3;((Ti#RTq#sF(u}siPFZZR5AKKPryEB4g#N3!5nnb_+>=owk z&0P;Yar#cs#OvLq?+Lr&TLi2R))gSu>$T>kfGyk(tO^slhlQ~WqRfc?w_{Ta3G=_V z{_o)MgZ1WqSk6wN*u6rlE?p-$mqLoV-+D}m{-3YGS1kG~92F5U_9WF!u{u*Y zoGYvX)yMRE5oZslM;zWK=ATGXIW43NMELan!B;b_cb<9D-&A*f@rco!xYRk~>OAYu zYO{mmc@C=MB$fF!ptY~54EgJV;p>x(2mii|8Xya6g}fcWB@?GIPQ}GKo`DMBS*xS{ z)e)$MdQ=CP);oA)Y7VQ|WHKYKTsHm2osBBM~W`ig|;pbT@Wl! zixUl*^&SP8oy7U1VuJcn?Z%DZT8b&ud+VA4;xxK3e7*9N%vRueP21FJ74p9Ih;1W{ z`N_7dYCj0A9thW`0439Q0SmC=N0=B~Q)~z#N5eZ#(E!v+JiI&UGbR_rq3fM z!k4NcL(5uq_TE#;Vk|gw<|4wyic8mVX`+euk~wiG*};(7SyV8yE%tW!EY`AP$$6-% zTR2M$Wo9)mWRlO=&DsMzgCb9yv1hV|85=`Ht&BynVFW}rF zQH}R7v6F+~7^q+Y)UGn2uO9#S^RX44ohtC`5T_2l;^{4JCy#d7aa`?A1xNvRJOj}N z^3<#W=M^(^YE#wFb^I7Xfs*6DV>rGl$eZzJsYU68$i(^Y_$rTQ0IhSUQRF$`rw5lj zBNjX}USE~tt7c`F-LAv&mkyVyf!@^)5=f$muK|hCv7x>iyQ+Umhx)1V$WM9tn z+qyNi-s1a*AhS3hi!QAd^lO%7CJwbR#d!qv>kV5R;G7=(3Ako0WyfF&ad)ycQjPG3 z7F~1&crcZ>y&{P_Rw?Cwnb}UG%$t%AC~^6w+zrq-gZ^;5!UQe-a`44pUA#1K+OjhB z#ghjB{XEXKY-omY*-_-29dZFZu?L;9x?woOSTRg$xceGftX>ER@3#*dE2oiJj)trv z;=9$6<-ZcSn6%P}HQAGTteJDMoGCdo_Q;ZHx2-2^pH|DNk* z=>%AFuHQundQNce;$1#{*Oq=U_VSzrY#@Oqre@8Ys-??#+VTX4p*hl{>O{6Mm=g8r znohI!y1LD=_6|DFu%JK{Hr0B5hB-j>eAT~Ls^vue+|*_&`HBIjO(Z7V0nTaxSK2bcP5ATqf9|KB{IQXxtp-c-p_=+>y) zIA`H%u)&{9d6)jM>P#S2q=*-6LUIlvWDp!a5gS;Tj>!kw?Z`2vR?ub}$BJFm;a5IA z9<{eH@#_EJ)6X$pGSD|z?(0{p#NP5(rm`lvGM3?)Y){rJMjTU?!`S}vBoi3Ac(!-8GOM$8l~~x z&&Zf?riZI-303K0t7hWF!~QembiImp?u%`>Mgpyzpd{-Tj^683K(QzC_V!GcQ$VGr84+<#s&TY zqU6oMd~N@xiZI(lmGW(_b7LFuZ`lR>ch;D|&ZL2)aNV|m8CRE)krJ0OOkY}CDK%)3 z9Yoem7xpA%gv=IKozis{kCmTDYICdpY%S}cCF&?M(wvH%y({w|$-FY~J%KzB_)2A- z9W=0Jv+31V+Oa#T*FGjX`1+NFjF=eIKUz#|(e;SfH4~7cw5?BVv+v_8k-t16K9E@7 z(yuH;|1Rri*S~XLml|{NKc7}}+3m)7QqB^sAfigjT?_{dqu?&*3|gy(bKIh)m_~N! z{)YX4ymQEwlZU7gwRZE1ROnr}YBR5VBEQCEuU|A~KKa9UQyhcpbO^IC!@uFHQ`FV4 zZKezN!_eJM%GoTVHb#nhP^cU48p0n&zt<`K-~l1;j>Cc5^*Z18>rTgP218{O!5 z1$EI+m<5J7A#ny@KqFmdg$yOBHPf25g|qh&N*-k4aZYHx#QWq26lmgb(O5wscR1u26?TSMjea@pSx*G z3oa9w$k2i6l;+X;+DTfs=7{!%172@qJOb>CE*N=@ObSagMSnk@D9t#CTc|+gZIldP z2N669Hy%+O=J$8P&&yRd2i>M6S5I^0gbhasNcYm=>5nZZ^(`_B7T>9|4>2<&n$~!#Z@~7y|>(wJXd-=u6DQVpS25?U3txpGRJnS{UFfaI zd&Ma+=*n_lzD|F*sDvanRce#ETS@XPUlS);H0mBtP8s(?G!oswd6biYb@IR%j5v}f zo<8uUG9#woI^P6QP4u5!vqnTV+Hd{zC?-@Kmx=;!i*h=r=XgAsmn z4>VOTEG<0tD70@034E2qJoVT#WMSU;+sfiG=~pDsRh0genr!x2y3!gzoET}iX~_=; z6o}5{F&yB|IqD1$A`ykO72Rrg>g(sbvHBS3cmTaA=&FJS-Gptb_5Y&6K$8i5CDs!C zHER;B4FbWZ2$vxqE{BscSXGT`a=J~X#^Fa<@#OXX^BKcBW|yj!L%KGYEOt>*RE|#A zrDCU<1=K{3PS_leCJp1=KN;|1Fg!2cl#A?(dB)#)TPYvw>fG%NZE65TNj<9B(z$)lp3>g*SWp57=C*HuU+oc5FxhI8f#R-}= zJ;+>@S2(R_+U{DUM3+}Q+e)$;B9fUw?QizC-HQzv9S6h30XfS z$Ox@wN%{lW^B9$JL9=R-l%wle64GKO?l+j=yUx9-Zi3$(HdKD9IGMU|@6cwQ2*1|a z0DgVMWaD(D3n~Fo_wc20+tuYuQ32Wngx>&UE+M7ELz1B%EZ0LHALzNsdKK1zWnJ+Kg1<(21+xEd+f2T$Akn;&{{MCUUpeS#E z>2R1{xH8gY03gD&(go@;AgLlZ^u&E#-&JemB}utUw_z&CZb22ONnfM|?bwJpM&+^| znAB^`yes*Pn>fRdgL9!`C+pvKKA1YOFgL`bg`L73`|e~w65oPD5WPZU-oM3HNjoSb z&gI^mnOIk+d=-BM9p_*dLHYjWkVo$$#EAvkV~=u0H9DOKQngPwy)-r&IekA#d5TI-CD z2d1^536i$cWOR`>!FSa2=M;G)lmuUWiwt;_q{fP}V1+ew)i6f%jr}`%pB{(INJAC= zsG6rxm1~@9a`ssFbrla>nvT415wIx=84Xqu$>(AZHe zQDrpRcX^j|jWHBW%tBeI64U$owpc9B!%dW)w+x(D=Ns4lckx8RADhmPdWN%}8pOid z##xdxtFO+_Avj_ee4u8-m_VAU@vaJsw^~z*OU-+vVLN_oqXMNiFMWirUELs!%}vl9 zEkOzOBwtQLo0cnf9$7xBb+PVBYxlOM&GjSIs8Ey_OIp)VOl#^}em7z$uCWY|7jloJ z!AWDa6b3KM$fcDZaQj!QvF{#;RbXHwr(iQ^7zEqyV)e#7T`0FgK$M2W+R(x0ui7cI@^eo$P3JFUpC{ls#dOwXaE^*xIsTMo{did98bQ zOm{%usdN}IAwKG>*}vPbyuYn8J4(;bM%Gyr*;Mhl^1OEHM#Sq}RxKH+M)+r{CP>-7)> zx5P_}!-r($wJ73LR8JFWsI5o*%wlS0<7j~K)O*Lq5k0YHi1%c+UL1`g&`<>lQR(ny zy%Ipr#wkZpS{%Oa(pA4pf&UPoDS$BE%|6}VrfSS&_w?$uM6@+!w1O;X7g(lKu zDX}c#+E7tiC;|dfQZPa&A;AKu0nt@N1%iNzh=8;tv;;vwX%T?{DTE?~8iWu^Lc({$ z?*H9=XTF(TM`vet@ZR4&=Q+k%xcfR+O~1-Dd`RMOd7cB%1MJJ%O|` z+cLVs>uz;f=>CbgMD!;DWidsn$DN$5LDHX1$=XQ&to`w~jkW>rgKIE=TYz5OtSumB z^51LqAb+5k8Zi{}(u5R1@y#!kmjN;_S;8jHqSI)hwsYO5XS1y-?&`mNMtrMmn}Dg9 ze~lE~KMulu%<$}I);UT&FDM%5*(a5KIqg$+A%WZPlNWxK%gKV~g;toCRSL?+MkmmK z;habi3t>ETURLRg=7K;OcoCxd+i)M}xa9Cn3Ftgeu-uqejr*?%&5D=5g8{nKxFFjI zxo%Vj(EdKJ@c?CWqm}|x$}Y#7(rPJq~`?XYqB0 zA7SEK6qYn}M9xrTzP(Evx)=o`BZ@)4ZDZPwDh^H8{*lASM|Pbh8UC zBAMO;Qxp5JVw23ydJ0)Mu}}_Pw|=+peT_rcUL@lhTm=ubhf2dbEeDwvGFDl%nl8y) zVuL~5U9?z3SiPY9R-^*8w_`DA7B!!l#UD)GSeF<`KQKEzSKFEw+@Qg2c45@TS=jBd@d1HZ)E8s)cY)`3K4Mg-dC zkJL>UYmWYV`uye9zZN*}I&N29P2HQD06x44T)Ai;wvOyjUPQ~B4{<^8*}`%xt@2vJ zAIKjx5cmN6k=y3vS{ z?#}FV$u77*0leCX69-?r2GL1=KvR4_*h2z|+ZYet_&&8I$=gCOYZw6SSQhe?ONHzO zLD30v4`uovin-_~lxQ}S4+v`(?NO@fe|s2gMSh&O@0<98cM)gakV+F>!=3=ATApD$+s6eg{fbDwhPX-ieN76Ow(s!Z?mIOfb*{b%AZ6t16|J` zO+$W3MQ_QZEwRtY%6Td~!Tho@zI%t=_PmLMqC_B%J_~@7T_zO6V{L(!I%~7#zRTx4hB?t|xAQpnea%1U#fmD11OtT88S)jQedTo$9fP=)XB zJc1-7_-zroKNV|C)~Vzm{me zp7{Ga?($%=rL%C?kO{nbA$gSmOb+yf^4TDhe{rqg@4|ke*>S&0-;^5g=pAzW4iA-_ zn(Hr2TkNC3`4)xYgQKxUX-f4zczxkBpje&o`O;kp7tHeEfspj~h8@KGz8&xK=`XkV zr{`{tA-}0D0so{opCE@_$VIh2V;*zjIjRRZYbIw+xFlyqmxTH2cpji7I#Y0gB?YE3>GLYBVMQ`MJot-frYz zMG|+k-c45X{<&})yZ~35*)3dBGfZGu=z;B#1i4lmdwpjD5Mg&2(f`zN0&*dey{Wt5 zL_h1`yF}|-&d;IWSW7i0nQ^rRZxjpn>!!qKKeHDvoy)HExAWQnB(%2_?W^vXA54Dk zaW}^r!S*#!hH9_ECp5n>buV5>Z(cHDw5eNTjGN1i=-(D?gj<@u zz)pcNHXE$TzJFz4_rJaaD-d#z6rj5V3o`*Z*%RgLJI59Q!DJvu`#cM23?fZ)hoEUP zF35NCU`r~TEhTHyjoh(O{{?Rq~Q#?{8vMt>!a9xOX!dlLBRojq4bs}i6bhtHj zTIu=PAbJ}31?X4Wk6~uGx$G0#7OXdmSh|>nBHQtUnsuSeJ=i;QyC%Nk=XnA0KJ7dKy~`6xiXM zJs_e(K|}|OyVyOXBcL0a0M;FgkhtUp(=qPPyiwkL6f7t`ga&?(_qf)XM{%bu_Bw~M zOU5SpkXdW?Qgu&k9gMLu;+}QGQQ$LxMA$|M>Ao*#dY&5vU(~56NpsH~Rw`^BWt80C z((+}CaY~JGz~MQdG={NGR$`^t3eDp$8~LOU1ty$FQW z<;w^YzAmnG{Jmu$-31;StjeA}EXh zJ3SeUA-NX|zBt%dR$c?hZeY(@urr=3UG%q4HXIybWKGW;@3uhbJW@`m8(;eeO65&bgQ_YugrrR1zZ%RO+b-zq`(Ss@=!WilDm>~dN$Qr8ND|x zJSiE=1#+LR+OmVbLlyNTTz__#fC41JSr4f7K49qu4ER5w9s)iuM_G{g8f#vAKZ5%3 zK#gL1_{Uspa&rth>=DB4%2<6#p_>alI}qx)!M+J(EIR6!ht4`_j*Wo7wlfs5jb+zSg~_dPk~q{w2h!Zq90S-MlJ;!in# zT^Rx@dIcmFtx;ryi*Uo@B91!XBoyf6h?Sun%WS_5>VlZ535t!@#O(8s7>Nu~!*QC6 z4>r|{yu!V$z0G~9=|u--2J=Z$>Iu6&?rXPRHwAG?;`A&FmetU9j1?Y(DSU?4N%lP) zo0HW%wWT9%1H{0@w>T`Lc@0AK8s@j=4kJ(ng2qpCfKgJb)`n5FH6s6Qvo?23P*Z%J zf0uvZ@>*K%GxGFmCO`{xF7A#wA_rW7e6+l%ri)b06Ij+RyEw`Pe?MpXP=Vv(kQ-by zt2NYPxYWAd;lZ-%p(* zZbj@YKpZF(tzsW6jIS-hU(%>6u|DRk?AyGf@4a;at>7SYW>xq3`2C}PM-e3Fm$My> z)Kki6u+RaPd!oUrJE*gPjX-1|c0cgc0PT&|Si_oV1cai{0Cog{LhJ9JMxAhT>>D@< zwq!oUeQqILBD#yB)2wKgTp%M?ik$wloGY^JnUk0`LM?FKI8H8`Qv>7 ze;qnP@6zv*g``6e)(eyR`+mZ_XCA+6Y-wr3AzGduGD$k^hp9Lr;@`23Yu*fOPguCG zLlIl(*GO+b;d5~d`QwC&zDZGnm`7J%_(7|8U-x z%$xkud!nB$QV>9Pa!24;MXE0&A-yHYaWy1{qLMmBiWsjK z@bj1QVLGlAn+c5fdZG=NBIP#sXRcNs#uT>@H?!2tAQ?v_Y;)Ed}EL%r5{2 z0gJ7jei!7KH}bD=bJua5#u~IPP5QQhLp z)l$HQ3Ow#c7Sim$sW{j-Sc%G?{OzMFRk8~^E?l{}=N-~rQS?5puR8(+;S**@9h13oCwFa)=#C&rJJ*H7d*~0jI zusYHCbBl6NjWq&7R%nnn`(bsKGo;gUcOLUkdGloRDp3ZUw+(O*^dbrRO+VY#x}Qy; zF1}>7$ZPy|guH?h-r2wj@k+oP*LorF$qidn!#L=R>uYUw!$QaB3%m-`)MiJwyFloTe_Z#?x^=gm3HZSP7+eI(z;?0o84bgfqG+LsJJCZp z!w)r(hPjhW_Ud>ZM$Pc=o0x))1EE#3(CBIFvpV2~@Z5+#g{>_yi>rJQ3q!Te|KV>@ zoANK3MgCBLYwPDs)OKJF(p2q~_pBrp&+u?;kr zc&c1NnOwfybg=ljAX}1#J?)#jAkDCOYJn5IW$h@kE`~70;ztOQhkP{=k_%j9GD`5< zx)`ePI5LoaHkyS-N^3dj0+W*YE%3vl+w6nnTqtLh|N1$U^Tv~Hzk^*tWv+DQ?J&sI z`W(X~UOle+LN^2Q((V9NBpLw5KZyV|fi+f}{n-ZR!8VZYCvOjpmo9(1!;NbSL+F=7 z*&;G{AE>=^eL`%IR{0gvxi4~BYgFQUS}p}H@!e+*LeloQw-ZR|bj;@}w>|9{P00BTAyHjINvy!A#)Un|Mr+ zR>c0;p%5=lH(4?PmSz;oZErv)%(~b0{7vcH0F;g_NSRwPM!K%8Md;IV(1Dx5BCMGG zh55&viGCA2gPMWBtbH)rI%v*Wspf}TfB4H;Xd>d#VMwo-SX!XSMk|=OSd{ddxEv8d zFEoS6)wJi?T_!4s#&CuY7XE+I zCI~TIN16cBO4D;{4ClkBp^3Sk6iX%eVNgTJBo|rUi0!|xF~nnGKBPr%}>3Siz3X{+pRdSDx16P?ZqjV$H0gV zuxZ-MR7RIqv)2J^Lz@7X1Od zpQKCz)6<7aS*1WC3WKq?k_l}{jz7A76 z)3}GK>17s|{yF0Xb`=rL83o`D0mcjfBoE+vFh=eK8l;7dL;TPE`Nv&oNB3Nd5n3lh zS(@iD7Rd}hw>NUC)I=T_|7D=JVp#6IzLglHr7l(hAEl}aaWyp=8`c2HO?T#7-foj$`_tVwB(aRr{&4SuNzS za<<79mdP(&L(wIo43?uKd>5&M`s{?C#YMN_I*m+ zvLSjq(*G!Y0l*?=YcK73?ML~bAcm(IL}klWgL7JWm<=Rq8@Kqztd`)#T$NXni&cBSd~I}4 z?NEsZlDZRY*}srnqYW&9*W=UWvR5U@O98CC2c+kY#FBmfD#`-)P(?f8&!OEWzjT6% zY{aIBCd0L)b=J=C!(}P?cTM!;{4ll8`W9P<;_<+0BCdHU@IltpgCY2f)7?0mf$j0c zz-)f;VZw z`S9}LU`qJZX_%|DX*9Nw@1$4^;SE_A`^@9vfe%J(C~qw366J5?eF)-L^8EWWZSpgn z6320URX8qyNb|r2C{qd)S?DQamy^xP$eLlMC)*LNK?Kku5yAq7HrC`rkS^!*0U#v4 zt}XIWZw5S!qa;+lrmpx1`GW2n-HcoC2ykIw^ikI>K;`@7o=qpHeV%0f6;Ez2MPB|} z@x14xJk+ngj1E8nev8zX%lQ(yPX!$S>V_O31I+cIRSag+4k5r=y6ih4Q(ENL~X7qO*DM>!p=Qc86$Xf4lp#>)O%{;4p^9; zNIYs}JIy~LcJhEZ1on7gNC&G#{3F)Y>>a?HsoP`&OMEjI#(xLxV!1S>JqA5v@)zyXxqxfE}&%AZ+h~L`tK% zjyH1Byk?mYcQ55^>)UW?+zj-BT>+x|MF*c7TKhlh)vMEgVI*^~IKVP1LSfjS_;YtKT7JT9(ldqgOiy^S z(sP;C?wCGA=0}7&s{xFO33Cp9Ft)piQ17VgXN7Oi#Xprm*7!SFvC zdzZ{@mAy4O)cnV?qes3T1P+#_E)}!8s}+a0E>7m-Hw=*Gnt+4F-MeOD1!N`YL;wV$ zWrgycyQhrBq?LuL&0&+qUBQ(JpD!H*WU_pS+P!@G{G7ZUkEjQ-^Tr}0Y)7Uc=T=gh ztY)hkckc6t^$u~3BuYsU;tZja{narFTp6$#67C`3zccOys_xRICC2|wfv{LE`{NMO zUh<s~cj>A|OU>fKGbjDL4hDv|V|y+v$xwRG#7Mcu5TrCZ00zR-`0RKT+a=1p z+qIB!2|FTdVW0B|x zgYHfe9}#4xf&_k3Nlxo(;P7j}kaR?U8{4x$SG68;QyT52J03%%%8ntZKWpf{6BFN% zuN>F}*ofR(GWo8vJzArVj7Mv%CX> zJK&$ChKQ7caOkyO@CZC5vl!t%Lf*!fd({gMi+fE}P||sF;xJPUg*fLex2j`lHV!$F zZzI&ZSrv^#Zr1&*OXmYH#pt}DF{L8eqHaok?M$X4fs~X5Q+l7(y#DNx)C3e~39^dT zG;KMLftRJU4EdOt7M8}t((X08|C7gFt^=2r`+dh8JYTjGfDn83cU7u}4OK&t%AQj} z>-XenS5=Nj1pvC#ZD8meykE`~mAxiDWta)51LvAarZxPoA7PzKbU#KLge6w~>~SSP zx#11{!}ypIg_Nlo7fgi~&ei_V?C#XRP}w-Vbo6u#|P8nywRoM)CnxVC$tnn8l!E_+WzQ z17=g^3i6oPIaBFS8g?H@qTBxV2+%JEUqk5etEqg1W-tDGMJmXEA#_k^Vvf%SyHjt# z=3aX!QNgas2MO!Pajq#CB4T^CKN5V<(7#cmMf(_!pC97s<2)8%c`haX_*u?-G}FNV zH~^B<`+@*F8DrkZ(lTZ-RFjW)bG{6nGBI7tw}J4$_MJ`{NYlE-A}@Hd&FfomX_Jxg z7TfWfMoT5mE*g}&IQ+~ zmem2fvtU7bz|*oc3rSnBvX=89i4tu7uUxEJ+LBpihu7oKQ7r=L1tpTGUx8N``2(I?W zmoMyscIh{-ekIq%2HNgYkx`X9YtT=jJ8FgG5^!PvW_FDdk#Fm#VrgaEoNf9%g zj@G|ezIF2URLVhG{A5(l{OnHt1Onq^tYC~5IwBKj#cUm>h1Y&O zSI$FP^`Bhs8@HOO1%X-eF#*n}XHv^?{_A4SiG+&ZBCN=0`i>CkN8}t8u*TbAU)Nj~Xi>Gb%}WVTtSklWXV4e@KSwsX4VFN}$CHsG z)q_O|FxmX$BEAjmm9doXwzNcZ-Zi^45eta&G5ufJn2Mgd5X@TW6YwzH&oddSBa@u= zlQ<2%mF$%t=wAbr%lmd9saG`gs$-Pjf#D=j&K#sB0$f52L=+getNAw{d?hN0GI^uh z`vwe`ohY8~Si){*?Z6bV`fq@BnT=~#fHe+M+uSRfuP8E~zthrpWFaqe*(2%T0_d6k zuK5u86FTAqRkV_m;KN+WVF6@MWvFfaZc;kFVs5Ze?K+^SJ^`zh8V;Bp4v9Ex$z7fj z{CXWH6MJpZVBalEx^CE zYX+JiRlEvtduqz4BBg+vT>XOyNvKiuBBXb@Z=8kRl-BalH%(odL{ManBC9JSAn;>* zTrD~GKNJy&fqutzUpBWv0*Tj%Wx4+A1Ks_J-$XO@C(~Da#V<~pMcR%^92h&pW#5FF za$Y0WUjcbT$wi-Lyond1Ab{#|8IdD}tNhJ-@re0!L9#<+r<`pPRE@O+*K-cFpC$B@ zcs#2~Sy)cz`{zlPd@vt<@YTAK4@|W{@A;*JWyT^G6bw33R6XQjQeU|61Yb9wzp;O* zAY&=^ei-4Udb0k)$K2-R>059R2Q3bueAy?Cvv=Ig9lBCb`mDKr%RT=ZG;=0XPI9!V zd4ZW2+77X>dWV0{@RGT)9JI?8!BzBC=%xq{#{L8ShIjuxNRT>o&l+3BtuU`@E?xmt z$m*$J+iDW5CoRToMFS5%FkjI3$($>f?dZWzLC5U#LqqJbQ2~rB@(+zRPdI!dnF3z@ z3kZjmQLtG6c-hYdTT`y8b67jB@9fLP*LB?rqMjVDr^q}%=*q;zN?AXW3fSD@c->E8 z;%i`=srSNU3r7sOhtz!+KcfG+uJ|zdEu@hAj=qoMAofZ-p%~Ruv((czmq$82gL}n4 zY^gL_S_obSP(KEiq5!8CxNin6Uz;e6duUj=+$Ad*R8xldD0A>G5*yV*mZ@8-{-5Sj z3+ll>NkEeHGq-5^5f4TkeiVBmo*sU6)*>0&8M8k3447nCnoH}P@QsoN{uqEKV-_$u zKh)Ia?<4GSb87XxJ?3@$ISPa`WK99khls4{B`0>-WAxgF++>T|DuL3!FGU*mB44Xc zjG;V{rRcqG7J-(N2GdSxy~OL|7^LhKV?Lshd`9_V!IOX1WTQ-gw=Nkdh5!iL#m`GX zX{ezY955I+t2*Eh%x9}a;9-Cr%49(PA-ms0Ife-pRHVo-z{i&nA*)7F=RrmQ-m7IL z(Vm2Yt~1e;?0FN;1Tz6C1+~-fssrryb7wt5$Mk=eC|56E$51q-&l4HgXF~pYO#ew8 zxJ@H4&IUSu9_KaM-0z8MQ*RZ&c130EQf1bpt7Ye~*%?M`IB9%7Y%O>b zv%bProV=faqq3cXfUnPGAP#|pU&hv2_-Aa~_eV%cP<^@U9@2Lt+>D_sn|jBC6<_^$ zo3|vJV>FQ9(q4eXB6Z)$+gtCAYxvlR77Cvr)j8-T)FS zCN%au3~Oo|ikn?R3)GYM#t7+MoF=W)fBZK*t+-|=)At4v0)RB)tH9;-!vrW+I+dty zIF0{MvpQFD3;@Cb>^Wj%uUqhZJaRf4Tb{+Q7$$)}e3`L!nq3qewZ6;!r`dQ=TAmD4 zuI=*-0&$gCPmT&C*2@HEMb&_K?dFN(xAMcpWuIydoN%-Ya_cqyhX$~61$hLtomL|J zgE|tBuj!%w%5SqlJhMA4tuk@Bc6LO+YRHdRV3qGkpWB*|03-D*%2j*$Bi)pgH9g0EMJpFmPnuIU5O>Ob`moZVj+ zvIF7oVT|fCafnY^@nhSG#Te#vps6SmT)keb3F`~l-??1`+1J_G# zFPQfVo^TZAyrAQt6~Bc1;U*|b8lRw{NAQBvHLBom;7%_LP~xQSN$Gu1G4hM)SZ%E! zkr0mI-WnwGKap%Ly%-<+FvXVG)5)j1G36@!OQPl4l5Z!oI3*Uob;N1N`aA;#m-NAD zp9^b6JO{ZVzq*ULgWXlpXlkrfv=n<2aoALu?@Q}*Y3@v;09Nk0NQECBuim0Owz*|f zbC-nyN^dwJ{U2|@75{hWpl7+Bjm%UKP;9_tb7>i*msEKh+AC+As>A{ij!M6{ADM+d zkXjEM1Q_@}@eYOjvz#j>(z0v0?cm$rfe7?4E^*ufH(Iw2df~X#y5oe1Q0H)T#R{#Z zg`*6=@N?}#AMc^R%_G+t2pTpEmaV1N7i8vY^sb%)%eA~xaH`{GXB7m#ATtZtTYIlIKEYYp>8znzO19#6kOulZ3+U%lK&Q2~uYDz& zI-KmxIjh?{r2B~p*C~nqcAn5zOzO+Vae&sr*i8^z6~1Zb>`#Gp zYaW-8xyzQMrH*f5rl&WzbmOE8@SSx- z;mzPfCvIt3A6XNYHdBB0AA92!GlyjQexgRW^r8cOrbC}3IvpVGFVBRQ1{er{xa8fg zjOA9(+^duobM2^v>sbinvIr#(;4*u`IN#~HG(p|cj}R>X$AaL|=0>j2wo=SItzYp3 z+RN%MpkEtjp9J)By{H;)>B|UuSYVhZ4UFh7a_=X;NkmT zZxg;eA0aq90upMNoxkA83sX>M^9ISo6<>-=?RHM(!cd10vhT4J>kM|6MT1HvyFKNA zG3Ass1;Tz&uwehTneHk4aGu}>0V5vAYQmCHhhw$<57&bkr*mC*`xXzjYwi8lw(k+G z{-tVrdQ*o!PNeK5{pL(>XX@9APR~4W{f-}aodz~jJTY}EInKCb$|}KUmMRte+^OX& zImEJ6oJQ4Wf;!xiJ$CM{4Tn|lj@7r44p7`87do7}g^BcMz;)uY>{ubm^ep`M2fDl1 zJAl>fd;S%|_HJJ3mjskoc~3)o%h_yKl+-oZQ@LKIcNT;x`bkZ8{C?EY!{nb*D8tE= zw{TP+dAQo2dh$iqk|EV~<%&z2mP*eso`*lkZMOj8LnO&Ez1WrI3^Ykm5du7W&<6Z) zwk}}70D8CpoLwDuS%(VJ zDwwY+D76o48Dvm!(ozS1)gg_RdR$GZ)3w760d;7%PH2p<_K8e=|HgkZsrct5C|Mkx zhhNBXKQ@-c6?;?hH+x!_!KP!^CjrG(0r@izM3=oFbn4p3@y*X`&_FS%JmULM7Sr;# zu_-4YtKh8O`v&sNj@S_1V>CALeIvVezsnhrUeO9>B@uQ`Q;5KVF85vMqA6j-j|JAf z6^gtHMeYt_LEnyRXO{T>-78n9>;i7rmh{mu>c!#FCRkATzl>4(D)lC1~2 zJcFo*HT8a~hukLqPU*XaqJ{=cDnq@F*I0jhB4czEDy~pJInN-3<2x_~qEpV3Y3!s4$5d#c^4k2hK!LlBjeb{Ihk^Yfwc5&Y3zRcx|8p_yVntxiB@(0Xz z(adf%0U`y#9J>}<0j%beVbSu5oq}PeN(~!*ZV+_no4`yCqXZ`na|jgdmM%EFg+W2c zu5~s@$qz1+b!Bb-S6)n*BKYOFFOEVx#I+QBSkLGV3gjq@_BmG_`@NO&J|QSAWpTBE zUjGrwqpfH#&N8$!0FWby{1AW)1F=!&>0thg8i9?9=ru-irYNNWj7pv^bzme|nXgAO zme53iG3^Z`Hp_Nks9(qR55^Lk3X<%=U>@k>n)gDwrA)}5(%SDQLgxdI+Dw4S#x8w73>%Av-e5Yh$vQ(!j2UrUYe?mfI*MEv&)e|uP_A1ONRFWF7Se+1_& z=g($I>n8E$-%?Y;Sj@F(U}{C4R7GP)dK9pXzqbQHTTd<#+N>#h3lHtQ4;WCFLlNKZ zWY-k((<(skC$I&Mo`t^fA~uoVj_d1;l^Uy{i2{5wl-Ce$ez<$(_109BoKrhI3nkV> z_xnJig^*iP#hz!g7=}BjLY69Y>{hI}I{|DvBKqX z_CNm~q0=+JQkHD&_XsY|^zGEe&tyBbWu421_KKBT;`K~G|E;g(9QniI5^A!U_x>H@ z{UkprEA|HV&z7%$l$js*J#^dPp73Y>r?>mooYLIT|Nhs*w?6NC9Jh&Y7UjHqWy8x~ zS4KzG8T^seCJLcTEjlI8cEVI-z=WML1S^P)$xvU*dKBYsMA!R zaU(_;3&yCt1ogD)Ljv$kR%XRT*yT4;pL$QwXDQ%{|L}dv;D()BSajvvoA=r)aOsePLA_{|EfWw0HqGk_#5Wm$T2ruOPKDdV1c$DfJJOpk1!+*afSDsci5 zp4)Fi6TYkzsBKZ?B-_5QLt1*fZ6<_gMn&+=hz*gMc)KB2=?$m3&$H86SXnt?VARyj zr7YBMuOdh12D8ekk>Xs{@nQ4aS>3)JF38JO-XGp8a;OsBmEO9%V=7OAp?lXo-n{F$ z)5G`Mud6&P`f*sB=YLZ3cE688kjl+;^&iYX(jscMgP&h%b!BJ2EIvYdcY1$!3srBx z`Kj?nzlB-C=>>A?Nnn!T0NL{xa6y_gVYOo=18B?KBXchEIk#DG!J%rjutN- znrc!4!w-Cyg{xuHJxPr%##)JUsm1TYFA~6oE-$m zxi>L_siW2g8O3qb-mG=~G(egEg3{#w$I1@}dS$&g3kEY{>yk#sw6qxl+-riA z+*z*WQaIdmQ<50|>pn=3q1NyEm-w;8QA7!1D7IffnfX0<5U$%xKEN}PT;E|$xWixF zNXezWQg5V)t*u3;n=R}NC)=A~C1aTxu^AayaKfv#_JJSmUva@kQ+)KW6}nz&X6J$L z%tHdh0n^L16_tv#^FNAo#(rGNnbtL?Za@M|QdMFlC~s>F<|SW1&VPJ=ePF7nQFm|i zehTTg{5V)7{yDmC@p?T74d2uBa!yfgIhF4M-Aap=N|H>mjAZGr$M}x4Xx18%@eL%l zes4^38GA!}%Q@Tbe1~{*3%{xqPy+t(LG!rxx<5DX@!ejy`m@R-FSJVVmMzB(G+Vx( z?^O4CpmU{p$5524~ zC*D-laNl)IY#PYpSfWv7A-&r!^KTB{-X}Ubb4-W#O|8VPsx}hZ&_HS3(2X`OSt(1Y=VYsLS zwb|G$*E3IsoNSByqS1voK1w(Ii9?p2n4AEF|z zFMPVw){wPF_7(?zk_IpePg!i_@{{zrlE>4i%L>>_WgMZo}^(hqxDHcn!F|tky z>YgH}X;pT+vNi0L+uKB~4CsCQTM%wX?iEh!UUHyCw?n~cPo;cbyimSvzj)WX%TweQ z{iDqm8#Y?nU79%;{Ea_)^Wp#JlxxCp4-?cR>wi+&{oQKVo5Q0^`LxYRmi7}kvyt~o zjT12E^LtXP=;DqU3h5AqgZq|py=_fV;WQWr``K4%ih{Jx@1WX;zL^mgN_!D*21kufITzLaHhWmlk^7H#Vqk zQ-|Y=CThP)%R9xq&;SY1!NnC`6)&@~d>Fo+qXiG!E>5?1KheGtX;16W-vwR*Gc3c0 z_BId4_UFUJuj~ieAw){^;-BHW4~Tak2!C}(+@z`Zzj5Qu@tNBp@^4jStA`&HiS9>WzICjRqTtTOt${7K+uXbHY`cZK^w zQe?K~luaXadi@ukDst!=I=%Sm*|x^4y{S%C5&Z5!Wo)X0OhnR3(zliQEi^nyd+PPZ z)%jdXgtu9k%y_V1Yfb|hMrSV#!P({cG_k*K@5NT-)>YP8mmI2IYx#F7Pc_~hjc!*< z$K@!xaI!?o_nzTTP_N6oE1)yGPIQutXt?(RdlvCqu2prS0s^XaRdhOQcJp_y}1)1`L0prEG^H&iyA z%y!#nh?iX}<=^^nTaYb$cU_>nmyvy+FyArPb#sIHaDQiCrsnXiJnxQu+TF~N~w!-84!7>1LA!z$l(sliYefp{a9-W-Dawo-4EuK=HO(-0eR-`vvRY92t{ z*G_!qoTFCI6*)d2WIae%-uQ%5E{u2Eb)^q}#jyy%5a9R<+To?N(OvS{Jrswc|G%hHx^hiErNH^2!5* z?|OPjdFvu8^&`)dUKGBuFp||4_Bt@0nlqdnC&>41fowYz1+GP&T}@Me94YOKEov0$ z3~w8|l^48GTf5t&jWmro-iepU{Gp@oaFUwmgLNBxl9Fx1U;Yw8Peq^b;*1c?^VvvlB%yA@sq}a%P3FK8rGc3-7dQQ_;Kdr#(JcA=>Z;iNQMo*lZOL9 zn!#VLk~Tb1ZtQ&H=0Xcwdc6#U*lsBfZa994j5lM^CIvF^8BsY_CpSrdu6!s?FI%Zs zalUA!p7i|8v7al?&wBs95nZ|p$&o_v`yl9n7D_Yjg6o1wH~^sDQ%|?ulby8uMS5Z8 zdM3;x%(mpV;DKmz z7J)}%ol5584=u5>8dGveI#^Qq+XIT8zUMan=fXE@r=QD*3ttl5U#rENhn%>4aB-0G z`jz>7miN~64fn~g-<2^GGxAbHQgP>}ZuUeTNpR z^9rYLuJh(=PtGk(r7n%L7e|x1M5rFg0?qArOTX`daaBkHkqvgqRe_=hs)4wwQlyg0 z>Xx#B4cN$rm3(!R<7JH-o=o705g#DvbRPx7M#^!364(Bjt^RAyj9KO(5aeE@GgK^W ze^hL~U={7n8GyPJ*>0XQSCe_Btwb7nzlJpys#XGtC@-kXQ}mo}f6Om}+`WnP(!p2L zY6G^p4V1JOH+&YxxB4bAc)`epq=*)M_mo8d3GDQA-06f%X84xG!RlC~w$Rklj>Mw9 zTN-R0E9YArPH;bYN&k0m(p{^QmFII->IsP8*(n!9DYq(T1DpV&LB&G|I>;6&kL2_x zKNWZw%-5q-kz<$g|A9bTUx&{?(M?}>ZMILl60O= zH)S@Kn^-KJm=v7VnyD-i*GzL}92zU3I=YyAd>JQL&=26Ma?aKp7j}G7E!#KT?=U*x zFvh!4Jzl3*277in@kYU85$6veazf5bq3+ldxj zRdNBBQ?@nj*L5k|b$jc$B%^B&Kz-c!cy+Tg?X|j|@5jQJ#?+VwgM$F8eai!X-)BC< zhN~Da*7NNO4+)ZdU0h_NZw8i*72IK;ax(i`_W&e6NhyLeE0k0?g`a)b zRGW7K^&j^;FsF*k39rDD`-T?pI+f-p4;BBuubuyqMrkR0y!lh<`f1JC|Hs#Rhc%gX zeWRmPB_Iq)m8Rp+dy_6rQ5@+dR0RVfy?2l*f`A1ANN>`+5PB8RBqV?o=?DX%B}k3* zv*Yu==bLA~bDirFh8gD{_Py@4er@f*X26~OiJWq72WK@=QTm3oaDjvsc z%Z7{qhlVm!%(MbQrusp1O|Z*)-*TE`0jgQYmEW(Utx4%@9JM@n?q3`>pxD|%Mc_=o z5&^KcN=emoju5>pmPHnZi~xY{7d!3)U=I4EhZyE^Q`TlEM~MC`0pb7W5XabIfkM(~ zsjh)mQt}s-FaP!2cf>&(RK3|nxr=Kf~ zI7r1>^O)#x!XiGxbD%jMnML+KVA2kD)__g+N!o|+>kz4~UtQ7S+tdKh*k@m&_ zmV;pz4&Fh-!OKk=m$HZsq{rwX23xpB)6_ISPBG}iyQ_D(2~YmzDD&xE&??dHxmaeU zq?q2~Yi}h9#Fdl$;I%m#Wak`shp>J*rYd2$X7Fm=Y7Mp@NnbWZoRI>#{Vo1ys>|GJ;4Z!!23C-ga54#rro$k zOG$qna`$tHW~#@Av_1NphnGDzqwZvlrA6i2>G7Ou*bkc!MVo-m^Mqx$)On15!-Mv} z^XgV(mX|x?Tae1CP;-1?{NiGi6m#-+F;)zbHTCT;mex31zhRD~9IIcF!6}i-Z$ufu z$1%ST#zoq2uWbk8v8U!QkaP}376{<{b`dqj~#J9tMp04*= zUxG*EX;7Rv={N*`e&@%Z33Y3eR?B$W&aJSZ>Er47(2XoYQ4k72uY*XY#ON{KLR`+W zz@HR$*E74zxU1*^Rdb+N*nQk8n^jio$#_;ao#q9WxbQk;cP(hG8r`J#wEflbCyR1a z>29@10avU+*|tFR$iox(n&M0%*e(Es_94)Y1&h zLtmjqutdDahi2e|IRIp98&qNlVNiZ^bbbHMdi>P(9lbqG{r`~4f6(X^{yQ3E;A z&7)_iAJP}{SgNh|yymz-dyymR7PU{Eq^SB0@_W>9+t12>=N`K=`;Az&KXWnNa%wHl z0(Y)|olctd&dF)51%Ner=Ldckc7)|F^<~WRKIrLpZOJPPLf!K!ivS~&b4H&<>&r%B z#xVaz=mgBFyt#>4uS4rQv!ZytchIbdRJn|g9Y^0ZiMrdLFTNyEk~*)!yUSM;kB{U! zXIev!;fNL%jLnSmghdGy^jHjZHIo8s-ZdBjnlZyI1c$=XT>lUoQQ_CW2`)&wj}OTc z4nWmIGCj76-d}a!h*)WPEl>I7wF-?SiMmp8gwTD5jwR~KS0I~)N`?#iE3I2woW3ef z2c^1&6}ioF2ca6Ub2j~cV*IMszFzV$K;WjohM9Eu&i5rm5dNk?vTPlC9HzEntC7t) zt-F~!=`RyF!3X<&-|LPb2rRq3XYzhwfGMh5%!eg-293;=BbRk&tXzZ7!gn??rbjk& zZ5=@ekwL(@TYiy$#XwB+iYAQ0GBB@+%vE@vEB2yjp|$p@9vI3NA-wt|XpCkYzS6Lx zh4;UqouiiZFN}Lvf}Nem{n6)yu6$7-_lfqfL`hIP04Bx2%B!iK8r#2#`-ML z+E07fc8MbE*-8#ui7k9h6+zPFQ_H>!ZPs4sQBORA$m}}6Ic-K2q=Tp@CcC=H2N1f< z-&^$O$X1)13eU|2b=OG-Z8E~v{t`l!^=0S~BmRP+;@yZu*O{@_dOy=7CO0Vw(p=7C zRdDF8hr4A^U?E^Oj}JlpLev+Ol84wx7^{g&7LZ7HR|l#Yv#!A&d&)s}Sp=i_m77mw zK|iOHIkN1LidUh)b}Hm}eoOI?N??~-xL|EHz26_C7??9(+u?S$fraz=R*9ObN;Oy> z?j`R;QuV{P9-JSlP*^2o{@4rD zyJ=Hm=MDkhftZ^ddq%VK(^3CHZ^F|S3kLY_{QTsFIr?tj;#s2F)L5oE3PhHkB&fB1}s9 zjJhF5GECv}rYcZE^CQRR;{hFHVLi9=W{D8Yick`?`|^rWAF98qrM^t^&->}dV8X90 zo6cuhr^wb?tji3{sG5y%3j5J9`&vyYL!$CUFntU1YTud9+ZD&Jww z-Je;@F93L+&pO;)H=QrYJWlzdI$Iw}U?Hfh5i@rt^@dKri2&}zHlxg2~W}Ms1Sa+IhOb(FfDhG_6OQhww@;yH5+u-w9(1d2>HU=HDRQo?BY`HhuSN zj>nW2>7uwG&30@o7a;0vlzxW*Y6{O z_9x`B%&xj^I}`*@e>-HJ7;xarYS%qvhWWwWbkn?G@=M(|DT*c{f-4I$sV=6kP7NWyEFFlj*FtTwqK{Q7&*5QE_xx7XGV2;pQIKa=J|qo zWYXa>z~Zx>z#oDs`B%${iK3*Vz5yD}=i5!;HDtWhJq+Z3LfKfpLr_iBUi1W>JvHj6 z+te5Ig_o{7tN-})DDJUb-;kmqq=#tg_(Rzsx{mNxOXov{bwi^Qs^3L9!+L7&cnUe! zv9Ig0b?%M|gS&`zSeRfY&ERt%^Fc#u-dU*55i%4DX%gIgn4IOKKU(QM)mHW`V58KF zN~hJUY}S~g4}0el6HJfUPoEwZKvWRelD*vawam(|S`C`IY$dR1a_*}82EluVc*E0{ zqg);GquuD7_B?bUr<`bwS8DU)vtV*ApLM26{F*)MOiXrmNXei~6pI`FHpUEdycR}q zj=%0>=QrKmgYRnYr9%+Uo;apUtPD#M*Nc%i7+X;^UUGDqL?Uv1zHPWOWWV*)t)r!$ zMT^i}zoJVppBk(1E}wYvCvCdS(+^X$nKItvzl7%>*MOg}`;HQTpFZWXuNOtb@XweP z99mUsgQs1A66951(+vH5jSQx}wNXg|_1CIacQ0e*j+m5gY_}OMwQ%F=Us#r6V=N-U{F+d(e_U%=D= z0y5Cg{dj-!1o9s7!omMJOw+gHvI3-aE#1*7v55bXQ2xnhf7PfUtLKf)+dqe0*;v#b zT7d#(=qVK5wAb$I$`~=o6{P%rTrT~$ih+zh`VrL6r=X(Mr?+aZvfPi@-Wcp~uDEgD zuH>oOpw3cNVZz+I`$I@oB@%Fnut64`s-2h^8`?6KC zw*H@eRh2_S>a2uy|ZZ3p0-^nzFglcBM@f?$jLbV*HWw7T0mIGja1NhfZTcKAsaN zT!w7?U(ZU(efizkVe|RO3zP<biaD|Rt@ zOcXIWg{=~MywQL3+i%(x_cYavQmm7V6xHfu2H9^7{71?%@4)}z?P}7+iKJ@+WZGkb zj}qIYD(Rirs?rC@HjY)n2_zJ}An!|Ar40jZg*gd0oC;wv?RnVpbL@ERVGHr;Jz~X9dWi2xA6Q9~KCr5}RLx)8c2~0A5zK)U}|k7WX_G@n(Ew`PP#D8@3G z@^K{-*>0X7ZCjF2ZN+iV4xx&$tZWtbb3wOVQSQ8oc%}7x1`&dv4pE#48R|S9Q%#mL zX)_!@vv&$`Jt|)wR-JW`iuFF9xj zm|ku}7`JZ8#U*rb^3qqj(3kp*my0SLYSSPRh+`#7EhPLz#y-$$-o0?cA-|i z_8?p+n;+#0g|1kidIy|T8845$K%`WPwONdNw?kzszfE>77iEQHOza)FTDF%`Db94% zt)#$qahRN7@VQQB&laxr?`K$Xlx->$?7c6Peo{sAUd9=75ogvF4cIe>Usqo{1=2Sp z4ybqg0?h8s8}Hz5iUJG$Rynq-GtVZ99|ApH*f8+C>K%AaQU=2~Hn4~+;P1N#RY;Z; zjdQAf72ix=f7zZDEu9%8e#OH+4#*#vuP@^JUvWyg9<<3DwwMyV@n@$&?HqH{<1c{h zwH8wP3j8Xb$P*{zDu~rA;Vkum>2Y&;!|?9aO~@4gn)ML>+FVHJA+8lu9`}l0I`r9M z5>oZyEjxFX**j`1t!pG3h5hF2GgE`)8@nTaq@)NdrZ6koegCTPab)+SDsr4|oEf>m zKQB9OQ{W%ZnXM|dRODq6=yW)0Ma z?Pq?bn;%>EK3s(j?{|vOgzh`1`y4L)N6h%%j*BQ-t^!V`Uv}i%^{yP8XqoTdSy5I2 z*eMGFtUFbGc>kd6hk{wC)>^}nAI$-i9S3Zolj(eG4~IW(j#PD6$l3OL$nH-|?_1vI z)Uw+aKH-Py@g#ORb!;upCp#8!i+WWBmIc~eNepTfX7is%xdwD7$prkhf5u`>v-D5vY}ne)s_jrO8jhU%o+4)j0SC%huf1? z5FpcVfV;6NfP}&^<1G$AeC}R9s_2z^4d}69s>h3xTAgbR6VOoTZ`rj4_3fa@8*6oyxW!Eh=t0FPVW8d%xQO_!aH{tKf8uqrs zWukrdlMp!!zHQ1|V!myCQ)7$xb|-ksi^jI0^VW0Xl~XY{>v_PBQbnz%zF-h~D=*fS z-W>4;=C4Kr92*Mk%xy&YDhtEfi%}}IA0YKZLQxC=KEy6h+f!KXYaD5PGV3x{)fCfI zEzB+f@an2E15E5+;%M(%027!>g_i8q1XwK%RI%TmvBjNHajj6QdWZ5 zrn60uLN)j}KBcB!EEFSUI01Lq;vV{FiUi0M5P4zI>aC>R~?c=Ghim0g{PB5l*isxm#KII$2(tUj&26iHww=S&jWF33>ZH5XbsQWp z_8zuj4K>Bvwz_{`{1W-yt?}V|0gK|wWUCuSz6onS)Q&?l!p;O~ch|-Z#*4V74aP_u zC`(fRWsG!~$@uuZ9Jnl3fj>6u*6JWbsz1d+#WxnIxXk5#JK#1Q!FLJCe2VZ;E8SXYTkbU2GD5CNeW=l{T7=RBHx&3 z%eTLXG?AbO6B4~h{&o2;+5hV|W8#6-l;B3Afyt&4EAn#L4QR0Lb_gA!&WqY3)#5}7 zbDEvyN;OV3e#y60>k9|Wt>R{dKt*MRf6yY({GvOXE2s7ky9co;DXkMk4gR@~2wBwt$F%~ZmD-lnJ73 zk?7{g^lndCOpB>cCHv5k>4e|+&QiV0{g`_FZ)<)wBJU*~fXx@rEb_k2d9qI6XHfmb zsQP3eYh0brdx2KUTz~whjdJ6z3SOzm6?@X-ZkaX|p6{P^lkr}u(ye`t8iGbTfKg48 z?K8ngj;ZtwdDciK+Ph*8lCa>LmttN$7&czgJ-A0JhEpO->nxNRDIOBop?4*?u9HuP zf*9B&+E4S@Xxi|SxT2lhtZ_R>P|nnj!F+kxrpQEfnsI2`=8ET-6fq^od)6TIN0%7V z&*7{sIApy<89a2@jxH*7t35Y(JG(!zB?#4mOUBX?%Hpjas)huaj4L-!UA-DT+u2S5 zn`JEDu`kc^F^0;IvU9-(6w3r>Oj>7TG4u0}Q>UjN3UG6Wt#>u6R4U;3pB2<3EFRz} z$NO+wQ{dx9d~MHmo-n(KiO#2Q*L!ZFCB_mF6G~DICp*oKu(O!rW7AGVQP|iA9{|_^ zX{}pwG1}999r#BHXBd;R{+`w_V;?7QX4OEt2u}i_>cdoOz!gH%j2-4`;G^^Z#n$P9 z=%4ZY7p0QRB`8mL`Y4zbzaL91vg7Kk&qVC?@3ccx??Dl@r80yiQ_V3Wc0KyUSKBM>Z)s}-c?sD_slYL^mLBN z#`kjIEp>PR_-FA|Ok@DtT$ia>V`rPb^(Shq8DK-l@&m|C{zGMI?aUr#csRQjFi zl%f62(T$_)f%#~b?M*@;$%YO&f4TVgU2*<`F)!XcmJ^NtXd0X7LGb!(4I(dXluCy?=ByJxK zZQQM{WEIt@4Mx>KHC9MjqafRFKv}aSI+>E7Nmd?M2#7j1w7S4TtYKByplgDzR`g8^ zyK~)Ng~*$ce>)IZ>2ggbMbzw#8h-}tRI?WV=Gd0i95X}W8> z;i?{V?xJP0E?Y`|HSY0VKG~b@$6w3bkN1!7q`1wfmI*%1k#i^L2K|`w9Q$gBMAIgv zvdo9Iw;jC5I^8-ab`q73k@3nL2p2+ntGmj5L|f?MKI_;^RRg!ev)DOpkZ!uO2V9@) zgisw-^0ickyiHVWQ`qp8?=&xKpL4X+1C(CI0#f7V9SOfwJyHZFAL=hf35oFwm!g%T z^r?&J4R~wfiY#M!SuTpvcJsv889}f-v=c@WQSotkR*J};&OGhj0H-HHik)~t3%m5X zeVslZ?&>Snih))VAQ_8x($}yTSpWvSc~?TX6jH46qQe<-3^=wIMLT|@55o&;kT3#2 z4RCdjm^2(foD&H9b2+)`B*7JJ4ax*p0?H)5;O2mSJ7g% zuXH-Q;4L+<|$0KjRl^<`Phc`h9tO)6k^aYIc8*2J2HfTU$yz(vMW%m;$Y zX5DdL&;i^}pHAzZx2~h#V)`-M&ut#jHqD=z-=>pga8+ObZ!Lia{S{8(y_kzzHYak2 zoos}Bu`v6h?oO&Ov9nNS$L;x_TR*1C4e(vZC3D#4KUDOq`hrFy@IZZ}N-{RCYhTLj zwsOIi`!@8|_DS?__j^ptx^$Z0-4)A#ql6XAl01LE^RCJQIfk7v6%7KEbD&HM_T34) zU%hEHf$%&n%N|s0JV3uc@A|veH1Tw->*#Y;HGjKkfx`CPy*tAt0!t2dc8ZbZKaK0;ug?uO6z)x(oJe!YhjR>#a zc^XMi6;9VnaQ3sLoHPFn`;p)tN1*~gGDAmy%tYCW_UXN{HM`R%{#T@|G34)D)+v2x zmuayuzq2Wn+ATo|hHFf(^I=M4?J9afJ_ZBHWK$R*C9`|&jTO5=23U&Z_1KFYz4}!D zG5xNiN&j*xMZKix3dhlvK-xfRj9FT%w2}t%IpHyX zwPUv|=ZW9Ov(MN#xP(Zgh}i{debonR?HO{|P1ebus_Nm_`~!f=j})C1zLQ`#X>|t= z0#_5obj*HKQDD7e$JK7YN`zp`XG&O)Q{`pS6QX4f1o1q0fY4vg$$`y6ZpKe5M>k)){+bl^97L z+`F&0@@`$}cU7C%Gk%aZ(K>mc5%T6JZ`(Ip&3pVUWSV#F!GLG)RC7(jVXdOlFI2V zdAn@CTq#a;c$mRB2cRUYk>>pig83sTjJF=+F)1U0YOhq@BZ_6z787pn!Z=)-mk zuxVbx&%(U=U+xceW=1py^2=Pjv+$tda+ci?M205)KhstIs12n7}(7@i?U&U z!p2fhWzT@-PqPs3eN@$5q0yGO3 z9lF~D3>|cHB4&MTruOb*%N6B_RsME=ZFx;k9Jri4b(mjKB@pI+6lcMfTdPx|-A)>3 z_IE}+2c-;AeOGi@hkklu-fo~K7~9|!zFuI2B1Wl#7UkOet^1%=Y9N_Jol-J%ZGNC6*WXN+FYOdWcUE0) ztd~=Pnw+?51gy;to+i0%tc5vFIEC=v@2rE_VH>R!1FeJb4X}6?v22orXZvE>dDdXE zfg#1p>9zH{|J0adl4cG-LCOZg3yX8ZNS5!`1t1cU|BwcxpVWGnqdx|h13CmyQ9Qy( zN{oE%wDsYCcP5Fu!VpdROmQQ%&-noK`VP!`KtF56M%})2fzdBd{bzEDC!4jzknLJh zpQQ*+9n#18-q2k1$@kYIum9?m(~gvn4Yx94Ca6K_OOQRi3a|@Lijffy%cWog4U90H ztYM>doeX8)euphyOMv!&YHF~1_jj!6(YuGprjz_fCjEWEk?AkEB30Ct zFNQqFI89no!Mq-Sa6Y>hH}bYD#cA`~odA|re3eaSM|qHs?!=Kx1~^y;CpYZ44`^Cu z^TgE;ETkDXeEvBx73nq)wc!feSRQHEkFI;P>$OZ;osz*m6aoE9xB2fkFPBe>Ov6eA*be>%ol=+uD*Tjzf}gbjlX`C)C(eYwc>-PEPrG zNZ3-?*4Szp(@Eu8m;jS~QkMLO;4ADW&GR`ShuL9C1`@uMDo)$`u+d&dWLo${bXXGj z>To?o|H?(oOypF}&Eu7?z>lp1N-7Rd$DgrSY$~-KoXQ;s`MPXQ?_my}$xZKD$n96m z*K{~_=W7{OH7&+@eE(+eRL=>Uh!Je<-%}`jfA~S6a}>!p%*s$jc=o3i{2p_YT937c$NMpV!DBgfPI6`HPSh$YO>upe@bizEG_}Iiu$xwtPw6#e?vu%h2&=PW z)F5~x_VrTRpDZa9F+RwP0}qp<(_Y+%E+{a;RF5C=D|X-o6%ha^y{(ksuexhhZ8;#J z7b9(CUxRjsR`bQ6*u^KJ(d^P1!t;yl4&Pomag~7^l}$FlHu9xP_(c4r1%WI>JbkYelO`Z98rdD z4a85C4Yju6qRU2G?RSsLzP0+|R_3xRIm%`OY-XDCwkBQ5kGZC2W?#JB0I|k(n-)i{ z^ZbeIjWFBkvNJwJ^}0>1lht|L?8ebV8=^?CTRr1E#P6IVY-+aC|EpIDs9TlXtEWk> z_$p*wl3PgW`L>G~{*X=aSY1Y-RKS2 z8UL|CKC}B63kX*kc145T?2E25fVH$d1OrWPCHf~6s~1eq6r%g*KM@c}7Lv*aVq*I( zp@#AT-9^qQMe1OB5WP_skIJRa(-;0*^5hP6^lwUVPqs&n5-epxI0JmLmoa3TwXR$` z&8}8o<0n7uArI|udBT67lPO-62`4)j3IDCcguFPF$A3IYr7>AsY3NHZnrtp!oErAI zI+0cNmv-+HL7EgcVL6&qnMaAdASmTA`)mkO8yxS{HanYLN7}ie%_40HJCK899f&xv zDoB9@9W)Z>tL|`LW91i;L!X7?1hU(Qa{$$DzXv*wb3_0|J&ip(S}rX>oNQQUNUB6E zwqDht(YXq>(&g;?3TZ!Vf?QcSH8$67Nc4v}J?2M_JAT+?f4kE?r!^AqTc22$#72wYc-!`OJ;AjC^hq;XfsTa z*{vrv4}Ay-%j5-P@zk_gq4d@-09HvR4}GhI~qpp=aHCzRnxTS&GKK zguEtuo~q)e6>04cwz&}4vV}DZ*tlh0m=>Au&y@$;GlI@{4jWwuiXV~zw^Pa=Y`tsX zOv3Bu&P!PN9e(kWa5Aj9(!1@7{`!nFa%_+iQG(`?Y!~|Z;RPv*Fej=Ndi2dSeR0I2 z#BS$EC{_KH72d#0N71X7yw7lG_@M9PwY0%R{Yl~X0vRb80zwZ6Np;tYWjvF!zWSzA zRzH|*NkCRz;I~%XK0+$JJNonJX5gQ{_N=)s5hGTUB;5*^E%vp3XwshoPkja~IBBVp zllCmij@4~}txn4BD>INng9^H%r7Zt~?-DXR4~7?RQqBR^N8nji``OD`vVOT4B*u_1 z>ckN)KO{^70hLdsu%diSPt(HmpFfeZ{LJ3G%&fd{c9}Li*6O@qCXL(o$$B2J|5;|c zN-go~)diRo?1BRyGUDr-!cFCdf=x5~I9x0eBamDf{yzuKL-~biLYNG8UjqhrEv*QS z-zcvN=FqUW1Z$9}TqsCt6YMUSf}Ph3EWoD&dIF2W1h}_hp(4-A>L;YHOP*xc+0k9| zA74yI<77@RwO_Koh`w}^&trcX&7P(zp7aA1o@OKd^%16fCQ_bSilLn>BqHzv`jN-@ zz_rxDAP-Tr{b%R1sJZ}IK_OLHLzA)@ZWx8G)8G7x#elxr06J10x1nOq9eBFhkOFqz zp-I! z1)*M<-P?M5;E&R;w)~Ig@qiX$#M;4={P+bT{F8ivI*a}` zZ>+j_^z+MV#wKW(eCjW(BD`9sL|vOX{ZK7cP4N>C-N^MDG%fVKim~C@F}sjeV+cio zbXT#oQK7W=s}c9Q6x*7~Qd>QRk>vJb-(*hIgUQ42Ixlu?kR?Y;sO|Fyj<3<;@{~wu z$u+Q7DO$gYdEPAgq+f;|ur6m1q6S$E+izgt01wp`oIWX%dDWdw2|NsoXbih>Icd~* zt#;L?VV@l_!aXFYK=HTb0%4xY9#sB`Ess4L=q5hm=a0C0oHgffC*9`G^$N?}uZOB& zq9-BggE@M#*s?lXJ0TeCOCGGu01@Hv#*7ds{*Dq(-9pmE1o?c(j#uB1AVxyUg@BNp2^V$T8Q;J5Qu@8ABbg~B zAx^CRPP{C<^cQ)_HL2t1uSuNTDT#W0i9#uAp*A@_SCHAOAv5EucS9j+k>^u{Xd%UH z9^9L)#}KNY%FC@0c$Ms!pO%)F@({9HApIO&s228t)w$6Cawka>wxuYj2siTO%H2F! zJB;3&8EDAc;G_Kfx=M}qT^=j{0LV=&3tQTMSEfWmKU=a$OF1VlTg>9YB!{~}+g#+l z6M=69ihLUm))+=||EJD5{h4>u6C9cY8IOJsy+`jwu|kXHI`QOLxr!D~a}Zy8w9*YJ zjJ8BS+@svPpm00@4ddSp&J?MKG9g#KReYm{!9FX%C{VsBDGHTuiZ^EffKAM=^GUD# z-h>I@{Io$nk!Wo(e79leul3Y*B-ns_57tE7zz%EWu4WTA%tqT8EZ~7VHPrVseyCNp zfpCMtmBRmz^MzcXwWLRie;gj-=)Tg+L#_$wZ05KcaWiItf6;@F6|`-m+O+cJ8GBMo zF~^KWh<@@EZRn)1(vDAptTbFJ{m%VKPdqMW1um#z6%0v&B)uZn%i{|l9j^q`T;_TMExT@ppuRze8X=*?F zZlguh?8GM?jfW$;u0=Idd;Q*iF(mxxx2#j2@rm?ouN+Lc!j1J4RvgNiYtVkOVul)~ z1&&z@>6@G){UX2O+B2UIn@zrDo7X1(i-+zV#b)0R0c-H-4hEg06~P?JZ$sr7Ms`F_ z8C0ut#d<<+9$gP5l$I`#L-#>(yNnPn+HN9T? z7vJe3-6++mU$TbQzm9i*S!5ZdE4+N2{_d@4z0AHDUsN;b9@5mcg{Yxd6dF;E;D>zC zUb&Lld{--I>dkwU`+_kC>~rO;e?CjY-Uc)DUP{bKy7V{ao3xrQbR@j-nv>XRZrGN* zq3^X)|C6PFkzMLF`Ef7q3Cf9ARmH4-NIm!?*Qdc(8U_`HQ~Ew~-!$r^?3m$%Le+{iRSf`dz9{ z*4O}wU7BBQ#83QqNMlH7h~ue1YJFHH(Wh}DKo@sAi$Pw|ezypd=MkE)>mhv00Lu0| zGVWbjMKH9uVsx^!&a-qZy>4mhWt|sL1jHuUBNqclWy&|86D`(c!!~O^g(~;k-;qY^ z(TCNP)zgBz0Q>FTJ?hguy7BY+sjcmv=24O6Ojtg5*{&u&nD-4}p05M*z8`4(E8O#n z^c;qVV)Eo7xGCpHnxrMs>Y>e2Z+`4DDiqfvKe~-;SlQDuJq*>a@`7v_R%r z+v*ExBuebM--HL7jKb6mA_KKG)F_GUb5dQ!tfB_&s{?vAMHf0_P6TP?r{7Q(_THp@ zG;Ms~b#QkwXpkw%MyY=?AQq>CEy{LKK5r3~R*Lbqa(w;3!|GWsS}*6(r`bQ2`nZ0~46NjRh0|jnd`_XhsOr}Cozq~Bw zi@A59E!*2)kHH;0hMLKjb+)T{1}2`IadkN%;>n!zzA0JL4<-Y@jI%OL6jYg7p@zL+ zTso&ld-}tQ!(ziy!*aty;Gf5GyZ36Jm!D~eFtjre1bnjjLwO~3HBQv8D}z_VSalRh zqo%Q~{xAN&@>{|8S26OC0Q!@f*EB%OeiZfFCAHsmnrF5tzBB4HQ-3g<(l8sVAoY3Z z2u!@+Q?xIFSEt2%RBH%+)raBp*i|3Wf7f-qm#U`R(5Yn=+kK<&wn5PaRgKUT$}@fT zGr4!nWCwTIdm0Ni9lY~5+n>Y@+~n%@f3+kZi@S%-%eKk(vZAr%X6Mp?ytZ3o{&j7R zWhW%rt^{050H1*JEn83y8r63-gOo9JVa9Q_Vk8LqORrq{5rcJBSt{V`hJ-gqs6?HS z?OtACK})5%h;KaQWs&;*^uph)LUyLHT5 z#448ZrZ_R%=&F z_X6{ikSC1oj3F)HtthGp)~RMv{+)1Tn7dRgU#=%4I>)JmFQ0qSfp?h3@zCV-^-->Z z*c0x5L3yc*U)0%S6d<9jp-#VLU-jfA*Mmy1JR`jWfC#Os3$Lo1kHGX(FL00%?E!iA zp(hJ?))dzQjpgpsQ>8q9&8%WKr0bY_&+)?TqQ_5@N#||O|Mc!8c2#pSC~xr?n`o?* zy`8pkIOJ7?dyPvCmniD?fF$wKzGk~FrEO2TsK~MtdI-O{?~6nT_eeb&2aSIal3}+k zONoJii#w#imUAN%T)5OcJ0#!gp!G{FeiDgmRymhoarez-$-9!b)rF2=yF=5wN4Ix5 zEkpe7Fb!xwQem09K8;xWqg%aRF@HO=Ip}8nwX|6#CF%eZQRx5uiSRvj^ZY1V(&=N2 zV0{=9Br>1M0@~~omVC-dW&RIN*YZ6u&WUbh#AVOR5;YvAl~Z(fUpWQfoxIh7wT#tS z56-3c<6vn!C+hg3^6w{a0t?X`rF_qfyNbZAE7U}heT}x9QtoHV(fPP9|2ls=I$r2= zGKn9L=|4TEe$3EwBL*yg0dUVVSCPg+ngyOz4*{@=a8#3ndqYQIY2y`zG_|=IDc*Tx z`lCgxe@LPoa&;xXC4E;Zq!?m7&|rUN068!CNKIeV_xyo5)2%e5b-ZAZm{IWgWNqAl zVNydjmGa#{g1<^YA{(oeG$z6>?z;pH*w_1#Oo@b~H1{|7qaLv>?vH?bIW$11KJhWQ zLS=@mqy_LQhdEu_)r!YnM!q>^zvkN=S^w;fYqwSNt)sZ2vLjV)Fng}Cm?8VFX>oT= z=Io|nj-c{#n0*Dt^=s9;e>gnIQkBo>pEP!`#PpbZk6!$vP|He?nXjQFLjW#bT2XTk zyaNibqTz?hSB>tzts{Ife_-~5f43oVUP^iP z6LF>y`pgjnQ4Nn619LP?FOetSc1;Yt0p>%MLTi!_zD9^@_)%`X2E#xwlrJH>GD8!3Io%zCq#+TN=NJir14~2NfLI5j{U}O6ZOtXjy>bkB7vDZVWLFk*#iG(^WBt z9*q;t)(+}fOG_u1W<|a-~tz>hV~1bgsK!p=G50G^RF0UizX;eQv%CY3s!5T=95$0 z@+yMMtpx%LSCc+Irzw>)u+h}jwE2aOR$fkRYpsVE{p;ZEqv#{KXd|Wh)%^?een~j3xf4e8)^h7hN||h@4|&nh#TYxP41q zsXy>!zim~1Dd6wsX#b98%BDZ1l@c#_Lf!y7WCMw?oVMH&E&=eMCAWE&~#Vo547^dHMtoKV~x;FVE9eenEmnlSO-`5d2Q#f^ueMRfMsMh2YaW)e%RoqqD>j|TPFI$Stj{w1}l+VDXP$d>{0)u(Re}$3k?(j(L4ZBl! zGicnTT!i$=uoi#(RNQA7`<*%dc`_(?I2Bt}ePOwll?WIJYm(0$92sm`b!&5VByx+* zM#s9cZTU+sbijSsuGb~Ak%h!{cTk=rQ=YztYsmaGl~^^ZrKj(E{_&wO-8Dg2^}UpK zKK_n#|5uA1qjnVoHrV)VDcZPz>{9z83(C(eRjk(s7QtQ%EDe1-9sDv7AfJuzhyW2K z1`PqhVS8|05H2rfaGUGbB^s}WC!ceX=bz_pEwrh-sd1}eZznx(z8CTvE-dSKse&69 zl(kk5wRZ5!lJJqmWg_KG9IQoF$5Xs5u7XX`kulE?%yP!iFYl0Xd1Vz3%!@110{;*Q z!U8O+4a4y$I=s%dP{w&!eOeS5E%OI+RQ5>r{~Y`9U9I!NxqBgodpdi^<{idBRlC>D zV2n!`Wzo`2KFnKvna>ij$7M>oHRqqj??q0pk;{6`5#&2wUSQG*gnTYF!;Fn^_lgR_ zy=8dpo>JCk>ePbmqI+^e>z*&JG5bJ$pWMd2&Q??IThP@Ay3EVl_gjwbYpi&VZNR(k zjyRYusq$Zd&fh>zUsUwlRkD!>;IyB?suTXF^6zZ3u1l=cI*3EIEhYZ=AT1nYwh-Gb z@yRDrrf}oF#uLGqFOcL0Zxo~m{;K|7XPiX7rYAGD_)2_KcOmV!(5{PM%{-N1L7d!}>6oq%hf$UGHAmynbTvLEDgDL(u zLHI=@h<1S)>n+RV_B;GRAb&VuN4DM6w}iCA=%saw7vU0chP}4;HS8z{e2OecFlc}W z+WSOgR=wrSZku`0=aZ98wY+sa*kr4F%{Jm>wMA97IrrvQWa!WQ`Unh5rrN5+t}vITeXmB! z#!_feZbO!MnK^hV{q(HVQp1%~uKF~%e+i2L>^HX>9Dd&jU+?{^@%hQjzwwBq83AtTOx$pOzIw_D#0+fdm=wjA&ryAYbkL7BrMSXgd=THFrVTK}H5!8oC#5#SF0XXn;SK1(x-e*k8x*(_Lq+ z6PU0jQ!-)S=DXBTd9K*XH~OpUKXBH`t2;1gpOUwewO>?@2#mOOzJac;51oC*?GTtn z;}e=B6_h#b!;G^;$(zx%2(Q&`-pT~fQfR}#d~Vc$uP|DdpIMz(z(-%24Po!VgDS-`NGhb*`?{a`F9O+M$z2c*#!ow04s);D*4;$D2AJ?^FzE#A%@s|t=93iO>E+n?ICt89^> zF{ex#=d5RUYazKs&-q0zNxy?z{r?>GXD?Ju+T#0M@7dMBMfRnsa+h@fJ~D5f4aN&wqboIHw; zBq_v&d#qIl7DzEe3l5SlL|v&YFy@BOAh!#Mmf0>fp&s%z5;R6CfgsII;yW4{)PPX< z!fa3jCRUDbe&wKKmk;s=^Zs^kK!Y%#5zGez?u{G1*PTSD))iOAhmBfziRB$&U+=tb zbl9id{N9miV-)T#H=-BwQhm?{&}9=YfwfA{8s*E%(X$RMF=;00zd-46%oMm{RZa+q z+1rZs-t+YSP1gU-Pv3mw<7^#KV|4q7!3SK;+=Yl4c>#;t?hwaAEs_jC;1K`&NdL(F zaAdaF{0Aq)#H{BN583Ubog0faYfiT2NUKfOxtgu>Z7k!oXzCVL8@J>>ugeX-K;}C6 zj%@ixSDxP0-xT-c{-F~%#E0XGtz&bBXXkf*z?aBPw<_MpNwa0miq~3$v-_i8Ko!sHC>*<<$uWJ@>+VdhqsN` z-{}{&+L%Xw<;$Bj(q+NB8x_y-5vP{RH&$t!nyjE`R7kX%19m2Rl4P0kBb5+o*5QDk zBVK>w&+eFk>VlE}pp}D%E-mW+Q##tHD8X0IvtDMln^JYu(4&-C%ONhUTL|5XrSzoM z0!I!_I+E*0`(8+YM&=un{c7$f{={!76HP5H+&J69$g@62SCG-_g$Yk&%6+oF*l-;+ zG5l+H!BBqr8=oJAs;orxxX-Y_=F|4;+rf0E>eBbAg2a-9mGJbEzGKE}M0v60W7x>m z8htVnZJ3_!dVg5|ce%+}Wb)QK_qU$>M6#R}p*$e* znAOcK1rFr>Uk)7EJmm0VLO9l|$-mE;HI)AxpAk(`v4UC~6*A2XSSrvaW~8gCbZE2V znR6j2{>aV35;k#cR^01s*);`A?PVy>E0TrTHEEiqqauamVmL=3&+Kqnn*p*Fq$^1* zhwIUrsIUt!+Z&a!!C_13_i)IApsaGCnF(v}crxU^C?vUrE*KBRB<&)p|44tc)x0EO z`D*iUr;mvtV}+0S`&MInqlR+jzf{IA%eb=ef4%7cRJaB6dqsz5UH>JUF7hCscBmvF zn>2Y~zJLa7x3*gql=N)@WhO;p+lUg|6D21139M5)S)sdG`wdwe=CX1Otvjj_V}53@ zD{Mt4OhR`6@=5*{cRttG!eI9=d?ey$61WILdY35BwlG@Pn9CAkWc@3<&KJ2lUC${> zlAdm07B@(r|D2)0NyCE&)#KkVR10~*N2k&~+kRmr&%XcFa-$E&6n=Pi9I`)?vgx5~ z;d=-a60P>t8cW!LkE>K%y?B$z--bAKsNu|5{86&FFeAJo}=)Ey0Nhg7MPk;5G@Y1cS+&V{WU(^VaK0#>- z9%DQ>Dt@Yr-s!{-`2my~Z%S3R-BSPb_XemZfs^xezN{&5Yn&VSsq{`G*Nyy>Kak9n zV*157EaGm~T#>SPAw8#BxqlJ;l^bA+ls_$2{iBo*>}v{kjv^61XE?J>eU{BAbmUmcn|ZaB0A|XS$B1(HQZI6g1r+iB?O)t+|d;rtOkE~ ze*YE-bT7>^guhfKARZJ9;Z@_+A(-FME!Pq{8P_ZlzY9?rRVTT90h_<@)5S&Z$Ritl zkrJ^j5Je|n^0+kY_;Wsqty zs9VvFNOjzCsQ=QXrKqCY2}S*hZ9V!tAPovEP}5FAq`sY%Jv%4=>x!+8_4Ha)1I4w~9G|wW*aOAMdNWh)&GC*I-kozXei*QaCX!WV_EAA+( zq^or&hN6lH1}|5oN5_K_`yxU-s<*Y+$uygq6awwF`_lp0-Q~s+VQL~THC|%b>&seb zB1{g$vD!?8H;?f2ay#!F!!5~}k!OoqF%Nz+i{Ek(M|-H;XHG8%hMQX4a0Zi6=VtRPVzj60)~3_zZD9{Ip*-JTt|S;}Dq zqKmfb;wn7fKGMDD#TMgj;wA^=wqtvd3}boY1d1@t!X!;=#d3NJ8U%T zx|j93m@>n(xqo z2PH8ElUkZghy2qrlAXU8x|#_O;8BVcwbo>?!~TM^^G2Defhc6GpkaYb zi7nOSf5tyePoU`YuyhDNJuQYWm`M!)3fJqvq|+SuRvVW$yP&F+aBM9}odits3bb%M zng?wpmB;jLo3w|SaF1z)DtKVSV6WtLo*~<%G1-+!Q$av{_c<%!YEAsAlEm4xNbM^X|j$L&WSj{ zbdcB%pi@%tlE&Co!M;I}aafn2ay4xL-zA-cYB~vNu;?c4nXl+C5F*m%QHwV%pVaM! zMKr;;I)PwJPsh~SE{C%ij<8}+S$Ep z{qCN#(p=QhW(ydtaVS_3H`Q%6%?r(KXWn4K%-!gMgW}5Wx$@uE8X?Z{a#7-d+U^u9 zAz>E^9E=y@bjJP44fEx6F*=v%M`dk9W14h_Vl6re5byfM2_0h%zXh}c?BcsQdt|c) z-_|qVNJS1xiaX4VHidh(@`7&$xid8Q^C6h&56c9n-HT$aD4I%oJMJ;>0-^;g zfqpANW4wK+YS8)XDTPwj^Z70~u;x?p_hJ}?ZeV6JkSSgd7r{>sUV{3~_?Iwf$5u&9%XWq) z7Bw9N{AG&6s|X=@8bvWXsn#-Y>OG*_mIFEIe6cR|2bF6t*86Zj+AyLod#f9de|0Xt zT<3x$Xz`2vC`>R|7Q4Qpas$2)_NbiW3(koZqgBR-MlVSa% ze}BP(4b;;(U&^|=cYD+|S^wx4>og1M#6x`ZKYx)I&DP0h``C~F5$XOi%hZmZJnnXG pdL;bo^ZySYxV||0q59KG`M2Meg*_YHr29uWcY^nJsY__e{{XWvng;*? literal 0 HcmV?d00001 From 07812db94ee80342fb2a2f6c329655162237ae94 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 12 May 2020 21:06:19 -0500 Subject: [PATCH 058/132] Updated all vignettes and built vignettes --- doc/data-modeling.Rmd | 57 ++++++++++------ doc/output-report-data.Rmd | 26 ++++---- doc/overview-epidemiar.R | 2 +- doc/overview-epidemiar.Rmd | 100 +++++++++++----------------- vignettes/data-modeling.Rmd | 20 +++--- vignettes/output-report-data.Rmd | 26 ++++---- vignettes/overview-epidemiar.Rmd | 22 +++--- vignettes/validation-assessment.Rmd | 4 +- 8 files changed, 130 insertions(+), 127 deletions(-) diff --git a/doc/data-modeling.Rmd b/doc/data-modeling.Rmd index 6e8f685..feccd20 100644 --- a/doc/data-modeling.Rmd +++ b/doc/data-modeling.Rmd @@ -1,7 +1,7 @@ --- title: "Modeling Data and Parameters" author: | - | Dawn Nekorchuk, Michael Wimberly, and EPIDEMIA Team Members + | Dawn M. Nekorchuk, Michael C. Wimberly, and EPIDEMIA Team Members | Department of Geography and Environmental Sustainability, University of Oklahoma | dawn.nekorchuk@ou.edu; mcwimberly@ou.edu date: "Updated `r format(Sys.time(), '%B %d, %Y')`" @@ -53,17 +53,19 @@ When calling the epidemiar function: * `casefield`: Give the field name for the case counts. * `populationfield`: Give the population field to give population numbers over time. It is used to calculated incidence, and also optionally used in Farrington method for populationOffset. * `groupfield`: Give the field name for districts or area divisions of epidemiological AND environmental data. If there are no groupings (all one area), user should give a field with the same value throughout the entire datasets. -* `inc_per`: At what rate should incidence be calculated for? Default is "1000", meaning x cases per 1000 population. -* `week_type`: For the `obs_date` in `epi_data`, you need to specify if you are using "CDC" epiweeks, or ISO-8601 ("ISO") standard weeks of the year (what WHO uses), the default assumption is ISO. The date should be the _last_ day of the epidemiological week. + +In the `report_settings` there is an additional parameters for epidemiological settings: +* `report_settings$epi_date_type`: For the `obs_date` in `epi_data`, you need to specify if you are using "weekCDC" epiweeks, or ISO-8601 ("weekISO") standard weeks of the year (what WHO uses). The default setting is "weekISO". The date should be the _last_ day of the epidemiological week. + #### Missing Data There should be a line for each week and geographic grouping, even for missing data (i.e. explicit missing data). -Any missing data will be filled in by linear interpolation inside of the epidemiar modeling functions. +Any missing data has the option of being filled in by linear interpolation inside of the epidemiar modeling function by using `report_settings$epi_interpolate = TRUE` (default is FALSE). ### Environmental Data, `env_data` -For the environmental data, daily data is expected for each environmental variable for each geographic unit. Based on the lag length chosen, you must have at least that number of days _before_ the first epidemiology data date. +For the environmental data, daily data is expected for each environmental variable for each geographic unit. Based on the lag length (`report_settings$env_lag_length`, default 180 days) chosen, you must have at least that number of days _before_ the first epidemiology data date. When calling the epidemiar function: @@ -87,7 +89,7 @@ The environmental reference / climate data should contain a reference value (col * `ref_value`: Historical mean, or other reference value, for that week of the year for that `groupfield` for that `obsfield`. * `ref_*`: You can have other field(s) in here that begin with `ref_`. These fields will propogate through to the `environ_timeseries` dataset in the ouput, which you can then use for plotting or other uses. -If you have `env_data`, but do not yet have a reference/climatology built from it, you can use the `env_daily_to_ref()` function to create one in the format accepted by `run_epidemiar()` for `env_ref_data`. Because of processing time (especially for long histories), it is recommended that you run this infrequently to generate a reference dataset that is then saved to be read in later, rather than regenerated each time. The `week_type` defaults to "ISO" for ISO8601/WHO standard week of year. This function also requires the `env_info` data, see below. +If you have `env_data`, but do not yet have a reference/climatology built from it, you can use the `env_daily_to_ref()` function to create one in the format accepted by `run_epidemiar()` for `env_ref_data`. Because of processing time (especially for long histories), it is recommended that you run this infrequently to generate a reference dataset that is then saved to be read in later, rather than regenerated each time. The `week_type` of this function defaults to "ISO" for ISO8601/WHO standard week of year. This function also requires the `env_info` data, see below. ### Reference Data @@ -104,36 +106,49 @@ In order to create summaries from Google Earth Engine, you will need to upload a If you are creating a formatted report later and wish to have maps of the results, you may need shapefiles for this. +## Setting up the Report and Model -## Setting up the Report and Model +### Report level settings + +Many of the settings are bundled into the named list `report_settings` argument. These all have defaults, but they are not likely the correct defaults for your dataset and modeling. + +* `report_settings$report_period`: Total number of weeks for the report to include, including the number of future forecast weeks, `report_settings$fc_future_period`, see forecasting section below. Default for total report period is 26 weeks. +* `report_settings$report_value_type`: How to report the results, either in terms of "cases" (default) or "incidence". If 'incidence', population data must be supplied in the `epi_data` under `{populationfield}`. +* `report_settings$report_inc_per`: If reporting incidence, what should be denominator be? Default is per 1000 persons, and ignored if `report_settings$report_value_type = "cases"`. ### Setting up for Forecasting -* `report_period`: Total number of weeks for the report to include, including the number of future forecast weeks, `forecast_future`. -* `forecast_future`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks. +*`fc_model_family`: The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). This is required, with no default. + +Besides `fc_model_family`, the rest of the forecasting controls (along with other settings) are bundled into the named list `report_settings`: -The rest of the forecasting controls are bundled into a named list `fc_control`: +* `report_settings$fc_start_date`: Option to set a custom date for when forecasting (i.e. `report_settings$fc_future_period`) begins. Default is one week past the last known/observed epidemiological data date. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section if the `report_settings$fc_start_date` is more than `report_settings$ed_summary_period` weeks after known/observed epidemiological data. +* `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks. +* `report_settings$fc_clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. The default is a global model (one cluster), which is the equivalent to `fc_clusters` having each entry for the geographic group contains the same "cluster_id" value. If you only have one geographic group, this would contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). Neither global model or individual model are recommended for large numbers of geographic groups, or for geographic groups in different environmental contexts. See overview vignette for more discussion. +* `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE (no cyclicals). +* `report_settings$fc_nthreads`: For the number of threads argument for parallel processing in modelling. Either 1 or 2, if multiple cores are present. -* `fc_control$env_vars`: Environmental variables. This informs the modeling system which environmental variables to actually use. (You can therefore have extra variables or data in the environmental dataset.) This is just a simple 1 column tibble with the variable names to use - `obsfield` - same field name as in the environmental data and environmental reference datasets, with entries for which variables to use in the modeling. -* `fc_control$clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. If you only have one cluster (global model), each entry for the geographic group should contain the same "cluster_id" value. If you only have one geographic group, this should contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). -* `fc_control$lag_length`: The number of days of past environmental data to include for the lagged effects. -* `fc_control$fit_freq`: When fitting the model, either fit "once" (highly recommended) or per every "week". Per "week" will increase the processing time by the number of weeks in the model. It is recommended to only use "once" unless you are doing detailed analyses on the difference. -* `fc_control$ncores`: For the number of threads argument for model processing, the number of cores to use. If unset, it will default to the number of physical cores available minus one. -* `fc_control$anom_env`: Boolean argument indicating if the environmental variables should be replaced with their anomalies. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group. Default is true, that anomalies will be calculated and used. +Environmental data-related forecasting settings: + +* `report_settings$env_var`: Environmental variables. This informs the modeling system which environmental variables to actually use. (You can therefore have extra variables or data in the environmental dataset.) This is just a simple 1 column tibble with the variable names to use - `obsfield` - same field name as in the environmental data and environmental reference datasets, with entries for which variables to use in the modeling. The default will be all the environmental variables that are present in all three environmental-related input data: `env_data`, `env_info`, and `env_ref`. +* `report_settings$env_lag_length`: The number of days of past environmental data to include for the lagged effects, default is 180 days. +* `report_settings$env_anomalies`: Boolean argument indicating if the environmental variables should be replaced with their anomalies. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group. Default is FALSE (no anomalization). ### Setting up for Event Detection -* `ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. In the demo, we have both displayed the results as a map and listed in tables. -* `ed_method`: At the moment, the only choices are "Farrington" for the Farrington improved algorithm or "None". -* `ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "Farrington" option. It is unused for the "None" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. +The event detection settings are also bundled into the named list `report_settings`: + +* `report_settings$ed_method`: At the moment, the only choices are "farrington" for the Farrington improved algorithm as implemented in the `surveillance` package, or "none". +* `report_settings$ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `report_settings$ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. Default is 4 weeks. +* `report_settings$ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. If the other parameters are not set, the defaults from the surveillance package will be used. ## Setting up Model Input (Optional) -* `model_run`: This is a boolean indicating if it should ONLY generate and return the regression object (`model_obj`) and metadata (`model_info`) on the model. -* `model_obj`: Once a model has been generated, it can be fed into `run_epidemiar()` using this argument. This will skip the model building portion of forecasting, and will continue start into generating predictions. +* `report_settings$model_run`: This is a boolean indicating if it should ONLY generate and return the regression object (`model_obj`) and metadata (`model_info`) on the model. (Default is FALSE) +* `report_settings$model_cached`: Once a model (and metadata) has been generated, it can be fed into `run_epidemiar()` using this argument. This should be the exact object that was returned by a `report_settings$model_run = TRUE`. This will skip the model building portion of forecasting, and will continue start into generating predictions. Using a prebuilt model saves on processing time, but will need to be updated periodically. If using a cached model, also set `fc_model_family = "cached"`. Pre-generating a model can save substantial processing time, and users can expect faster report data generation time. The trade-off of potential hits to model accuracy in the age of the model versus the time range of the requested predictions should be examined, which would vary depending on the situation/datasets. diff --git a/doc/output-report-data.Rmd b/doc/output-report-data.Rmd index 1c08f55..0605742 100644 --- a/doc/output-report-data.Rmd +++ b/doc/output-report-data.Rmd @@ -55,21 +55,21 @@ Early detection and early warning alerts levels for each geographic group. Early Mean disease incidence per geographic group during the early detection period. * `{groupfield}`: The user-given geographic grouping field -* `mean_inc`: The mean disease incidence per geographic group summarized over the early detection period +* `mean_epi`: The mean disease incidence (or cases, depending on the setting in `report_settings$report_value_type`) per geographic group summarized over the early detection period ## `modeling_results_data` These are multiple timeseries values for observed, forecast, and alert thresholds of disease incidence, over the report period, for each geographic unit. These data can be used in creating the individual geographic unit control charts. * `{groupfield}`: The user-given geographic grouping field -* `obs_date`: The last day of the epidemiological week (ISO/CDC, by `week_type`), Date object +* `obs_date`: The last day of the epidemiological week, Date object * `series`: "obs" = observed disease incidence, "fc" = modeled/forecast incidence values, "thresh" = event detection threshold values, "ed" = early detection alert (binary), "ew" = early warning alert (binary) * `value`: Value of the `series` for that geographic group for that week * `lab`: Labels for the series ("Observed", "Forecast Trend", "Alert Threshold", "Early Detection Alert", "Early Warning Alert") * `upper`: Unused * `lower`: Unused -* `week_epidemiar`: ISO/CDC week number, based on user given `week_type` argument -* `year_epidemiar`: ISO/CDC year, based on user given `week_type` argument +* `week_epidemiar`: ISO/CDC week number, based on user given `report_settings$epi_date_type` argument +* `year_epidemiar`: ISO/CDC year, based on user given `report_settings$epi_date_type` argument ## `environ_timeseries` @@ -77,9 +77,9 @@ These are multiple timeseries for the used environmental variables during the re * `{groupfield}`: The user-given geographic grouping field * `{obsfield}`: The user-given field for the environmental variable name/ID -* `year_epidemiar`: ISO/CDC year, based on user given `week_type` argument -* `week_epidemiar`: ISO/CDC week number, based on user given `week_type` argument -* `obs_date`: The last day of the epidemiological week (ISO/CDC, by `week_type`), Date object +* `year_epidemiar`: ISO/CDC year, based on user given `report_settings$epi_date_type` argument +* `week_epidemiar`: ISO/CDC week number, based on user given `report_settings$epi_date_type` argument +* `obs_date`: The last day of the epidemiological week (ISO/CDC, by `report_settings$epi_date_type`), Date object * `val_epidemiar`: Value of the environmental variable for that geographic group for that week. Values are a combination of observed, or interpolated (for missing) or extended (future estimated) values. * `reference_method`: Method for creating a weekly summary from daily data (e.g. "sum" for rainfall, or "mean" for NDWI) * `data_source`: "Observed", "Interpolated", or "Extended". Missing environmental data is handled in three different ways, depending on time period. For missing values in the middle of series, the value is a linear approximation of surrounding values ("Interpolated"). For missing values at the end of the series, up to the future forecast portion, values are carried forward in a persistence approach (also marked "Interpolated" at the moment). For the forecast future portion, values are a blending of the last known values and the climatic historical mean, with a gradual weighting scheme shifting from more weight from last known to historical mean ("Extended"). @@ -92,25 +92,25 @@ These data are the recent (during the early detection period) differences (anoma * `{groupfield}`: The user-given geographic grouping field * `{obsfield}`: The user-given field for the environmental variable name/ID -* `anom_ed_mean`: The mean of the anomalies per environmental variable per geographic group summarized during the early detection period. The anomalies are calculated as the difference from the observed value to the historical mean for that week of the year. +* `anom_ed_mean`: The mean of the anomalies per environmental variable per geographic group summarized during the early detection period. The anomalies here are calculated as the difference from the observed value to the historical mean for that week of the year. (Not to be confused with environmental anomalies option in modeling.) ## `params_meta` -This lists dates, settings, and parameters that `run_epidemiar()` was called with. +This lists dates, settings, and parameters that `run_epidemiar()` was called with and defaults that were used if the user did not set values for those parameters. ## `regression_object` -This is the regression object from the general additive model (bam()) regression. This is generally only for additional statistical investigation of the model, and is usually not saved (large object). +This is the regression object from the general additive model (`mgvc::bam()`) regression. This is generally only for additional statistical investigation of the model, and is usually not saved (large object). # Epidemiar Output Dataset - Model Only Run -The results of `run_epidemiar(..., model_run = TRUE)` is a cached model: the regression object plus some metadata information about what was used to generate the model. -Once a model has been generated, it can be fed back into `run_epidemiar(..., model_cached = {cached model object})` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. +The results of `run_epidemiar(..., report_settings$model_run = TRUE)` is a cached model: the regression object plus some metadata information about what was used to generate the model. +Once a model has been generated, it can be fed back into `run_epidemiar(..., report_settings$model_cached = {cached model object})` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. 1. `model_obj` 2. `model_info` ## `model_obj` -The output regression object from the `bam()` general additive model regression call. +The output regression object from the `mgcv::bam()` general additive model regression call. ## `model_info` A list of dates, settings, and relevant parameters that `run_epidemiar()` was called with. Very similar to `params_meta` of a full run. diff --git a/doc/overview-epidemiar.R b/doc/overview-epidemiar.R index 5fb3985..ca7599e 100644 --- a/doc/overview-epidemiar.R +++ b/doc/overview-epidemiar.R @@ -5,5 +5,5 @@ knitr::opts_chunk$set( ) ## ----echo = FALSE, out.width = "75%", `fig.cap = "System diagram of the EPIDEMIA Forecasting System."`---- -knitr::include_graphics("EPIDEMIA_overview.png") +knitr::include_graphics("EPIDEMIA_system_v2.png") diff --git a/doc/overview-epidemiar.Rmd b/doc/overview-epidemiar.Rmd index 17a97a5..4fe58f6 100644 --- a/doc/overview-epidemiar.Rmd +++ b/doc/overview-epidemiar.Rmd @@ -1,21 +1,21 @@ --- title: "Overview of epidemiar Package" author: | - | Dawn Nekorchuk, Michael Wimberly, and EPIDEMIA Team Members + | Dawn M. Nekorchuk, Michael C. Wimberly, and EPIDEMIA Team Members | Department of Geography and Environmental Sustainability, University of Oklahoma | dawn.nekorchuk@ou.edu; mcwimberly@ou.edu date: "Updated `r format(Sys.time(), '%B %d, %Y')`" output: rmarkdown::html_vignette: fig_caption: yes - pdf_document: - number_sections: yes - toc: yes - toc_depth: 2 html_document: df_print: paged toc: yes toc_depth: '2' + pdf_document: + number_sections: yes + toc: yes + toc_depth: 2 vignette: | %\VignetteIndexEntry{Overview} %\VignetteEncoding{UTF-8} @@ -49,55 +49,34 @@ In addition, we designed workflows and wrote customized code for our Ethiopian c The full system can be thought of have 3 (three) main parts: ```{r echo = FALSE, out.width = "75%", `fig.cap = "System diagram of the EPIDEMIA Forecasting System."`} -knitr::include_graphics("EPIDEMIA_overview.png") +knitr::include_graphics("EPIDEMIA_system_v2.png") ``` -1. R package `epidemiar`: This package - a library of flexible functions for modeling and forecasting -2. Google Earth Engine script: Script to gather the environmental data summaries -3. Custom R Project: Contains the surveillance and environmental data, user parameters on the model and outbreak detection algorithm, and script to produce a finalized report. +1. R package `epidemiar`: This package - a library of flexible functions for modeling, forecasting, and model validation +2. Google Earth Engine script: A GEE script to gather the environmental data summaries +3. Custom R Project: Contains the surveillance and environmental data, user parameters on the model and outbreak detection algorithm, and script to produce a finalized report (or validation report if validation functions were run). This package can be used for modelling and forecasting for a variety of environmentally-mediated disease. For example GEE scripts and R project, see the `epidemiar-demo` repository at https://github.com/EcoGRAPH/epidemiar-demo. The main requirements for using this package are: -* surveillance / disease case counts per week per geographic group -* daily environmental data per geographic group with enough lead time for lagged effects (user set) -* pre-identified model: which environmental covariates to include, any clustering of geographic groups. +* Surveillance / disease case counts: per week per geographic group (if present) +* Daily environmental data: per geographic group with enough lead time for lagged effects (user set time period) +* Pre-identified model: which environmental covariates to include, any clustering of geographic groups, etc. # Modeling Overview -There are two models currently implemented in epidemiar. The first, `model_choice = poisson-bam`, is based on a general additive model (GAM) regression of multiple factors, including the geographic group, long terms trends, seasonality, lagged environmental drivers and clustering of geographic groups. - - +The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality,and clustering of geographic groups. + +The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). + +## Timeframes -$log(cases) \sim ~geo + bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo + \\ -~~~~~~~~~~~~~~~~~~~~s(doy, bs = "cc", by = geo) + \\ -~~~~~~~~~~~~~~~~~~~~(env_1 sum_1 * cl + env_1 sum_2 * cl + env_1 sum_3 * cl + \\ -~~~~~~~~~~~~~~~~~~~~~~~~~~~~env_1 sum_4 * cl + env_1 sum_5 * cl)~ + \cdots \\ -~~~~~~~~~~~~~~~~~~~~(env_n sum_1 * cl + env_n sum_2 * cl + env_n sum_3 * cl + \\ -~~~~~~~~~~~~~~~~~~~~~~~~~~~~env_n sum_4 * cl + env_n sum_5 * cl) + \\ -~~~~~~~~~~~~~~~~~~~~~~~~~~~~env_n sum_6 * cl + env_n sum_7 * cl)$ +The timeframes of the modeling results/report are by default based around the date of last known/observed epidemiological data. This last known date drives when the forecast (future) period begins. The function will forecast `report_settings$fc_future_period` weeks beyond the last known date. The entire report will be a length of `report_settings$report_period` weeks, with the last `report_settings$fc_future_period` weeks as the forecast, and therefore showing the last `(report_settings$report_period - report_settings$fc_future_period)` weeks of known data before the start of the forecast. + +However, it is also possible to specify a custom forecast start date (the equivalent date of one week past the last known epidemiological data) using the parameter `report_settings$fc_start_date`, irrespective of when epidemiological data exists. All other time periods will adjust as above around this forecasting start date instead. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section. -where $geo$ is the geographic group, $bs_1$ ... $bs_5$ are modified basis functions, $doy$ is the day of the year, $env$ are the environmental variables (1, 2 ... n) and the 7 summary ($sum$) statistics from the lagged basis functions, and $cl$ is the cluster identification of that geographic group. The regression is done with `family=poisson()` for a log link function to the case count. See the following sections for more details. ## Geographic group, long term trends, and seasonality @@ -111,16 +90,23 @@ The modified basis splines are created within the function as follows: - the last basis spline function is reverse, and - the second to last basis spline function is removed. -To account for seasonality in each geographic group, a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ + + +There is a an option to explicitly include a cyclical for account for seasonality. If `report_settings$fc_cyclical` is set to TRUE (default is FALSE), a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ ## Environmental Variables The rates of environmentally-mediated infectious diseases can be influenced by the environmental factors via a range of potential mechanisms, e.g. affecting the abundance and life cycle of disease vectors. The influences on disease generally lags behind the changes in the environmental covariates. -In our modeling, the **anomalies** of the environmental covariates are used as factors (by default - this can be changed by setting `fc_control$anom_env = FALSE`) . We are looking at the influence of deviation from normal in the environmental factors to help explain deviations from normal in the human cases. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group: $geo + s(doy, bs="cc", by=geo)$ +In the modeling controls, the user selects the maximum number of days in the past (`report_settings$env_lag_length`, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. + + + +In our modeling options, it is possible to specify that the _anomalies_ of the environmental covariates are used as factors (`fc_control$env_anomalies = TRUE`, the default is false to run with raw actual values). In some case, you may want to look at the influence of deviation from normal in the environmental factors to help explain deviations from normal in the disease cases. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group: $geo + s(doy, bs="cc", by=geo)$ -In the modeling controls, the user selects the maximum number of days in the past (lag length, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. ## Clusters @@ -131,41 +117,35 @@ If you were working with areas not likely or shown not to have spatial non-stati On the other extreme, you could run separate models for each geographic group (each geographic group as its own cluster). However, especially with noisy data or short time-series, this could lead to overfitting. -We allow the user to identify their own clusters of geographic units. The clustering determination can be done prior however the user chooses - for example, global model, individual models, clustering by ecological zones, or by identifying similar temporal disease patterns. +We allow the user to identify their own clusters of geographic units with `report_settings$fc_clusters`, a table of geographic unit and a cluster id (see data vignette for full format details). The clustering determination can be done prior however the user chooses - for example, global model, individual models, clustering by ecological zones, or by identifying similar temporal disease patterns. By default, without information in `fc_clusters`, the model will run as a global model (one cluster). -## Second Model Choice - -There is also an option to use a negative binomial model (`model_choice = negbin`) instead. This is a glm with `family = MASS::negative.binomial(theta)`. If theta is not specified in `fc_control$theta`, then the call uses the `MASS::glm.nb()` function instead. - -In this model, the environmental data is *not* anomalized, but rather the raw values are used (by default, however this can be changed by setting `fc_control$anom_env = TRUE`). - -There is also *no* forced cyclical factor for seasonality, with the idea that the environmental variables are capturing this information. - -The long term trend and lagged basis functions are the same as in the main model. This model was added for comparison, but is not actively used in the EPIDEMIA-Ethiopia forecasting. + ## Model Caching Option -The results of `run_epidemiar(..., model_run = TRUE)` is a cached model: the regression object plus some metadata information about what was used to generate the model. -Once a model has been generated, it can be fed back into `run_epidemiar(..., model_cached = {cached model object})` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. +The results of `run_epidemiar()` with `report_settings$model_run = TRUE` is a cached model: the regression object plus some metadata information about what was used to generate the model. +Once a model has been generated, it can be fed back into `run_epidemiar()` with `report_settings$model_cached = {cached model object}` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. # Event Detection Overview The central idea behind outbreak detection is to identify when the case volume exceeds a baseline threshold, and to use this information in a prospective (not retrospective) manner to identify epidemics in their early stages. -Currently, epidemiar supports the Farrington improved algorithm for event detection, using `surveillance::Farringtonflexible()`. +Currently, epidemiar supports the Farrington improved algorithm for event detection, using `surveillance::Farringtonflexible()` by setting `report_settings$ed_method = "farrington"`. This family of methods developed by Farrington and later, Noufaily, have been implemented at several European infectious disease control centers. Farrington methods are based on quasi-Poisson regression and can take advantage of historical information while accounting for seasonality, long-term trends, and previous outbreaks. -The Farrington improved method offer parameters to control various model settings, such as the number of time points to include in the historical window through a specified number of years, the number of knots in the splines to account for seasonality, and the number of weeks to exclude at the beginning of the evaluation period (for events that may already be in progress). However, this method does generally require several years of historical data. +The Farrington improved method offer parameters to control various model settings, such as the number of time points to include in the historical window through a specified number of years, the number of knots in the splines to account for seasonality, and the number of weeks to exclude at the beginning of the evaluation period (for events that may already be in progress). These can be set using `report_settings$ed_control`, though `surveillance` package defaults will generally be used if not set. See the data & modeling vignette for more details. Note, the Farrington method does generally require several years of historical data. Alerts are generated by the Farrington algorithm run over the entire time length of the report on the number of cases, observed or future forecast (optionally adjusted for population). -**Early Detection** alerts are alerts that are triggered during the early detection period, a user set number of week of the most recently known epidemiological data (case counts). +**Early Detection** alerts are alerts that are triggered during the early detection period, a user set number of week of the most recently known epidemiological data (case counts) via `report_settings$ed_summary_period`. -**Early Warning** alerts are alerts that are triggered in the future forecast estimates (early warning period). These early warning alerts indicate that the environmental conditions are favorable (or unfavorable) for abnormally high case counts, based on past trends. +**Early Warning** alerts are alerts that are triggered in the future forecast (`report_settings$fc_future_period`) estimates (early warning period). These early warning alerts indicate that the environmental conditions are favorable (or unfavorable) for abnormally high case counts, based on past trends. Alerts per week per geographic group are recorded. As the algorithm runs over the entire length of the report, historical alerts (weeks included in the report that are prior to the early detection period) are also marked. diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index 75a583f..feccd20 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -108,6 +108,7 @@ If you are creating a formatted report later and wish to have maps of the result ## Setting up the Report and Model + ### Report level settings Many of the settings are bundled into the named list `report_settings` argument. These all have defaults, but they are not likely the correct defaults for your dataset and modeling. @@ -123,30 +124,31 @@ Many of the settings are bundled into the named list `report_settings` argument. Besides `fc_model_family`, the rest of the forecasting controls (along with other settings) are bundled into the named list `report_settings`: +* `report_settings$fc_start_date`: Option to set a custom date for when forecasting (i.e. `report_settings$fc_future_period`) begins. Default is one week past the last known/observed epidemiological data date. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section if the `report_settings$fc_start_date` is more than `report_settings$ed_summary_period` weeks after known/observed epidemiological data. * `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks. * `report_settings$fc_clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. The default is a global model (one cluster), which is the equivalent to `fc_clusters` having each entry for the geographic group contains the same "cluster_id" value. If you only have one geographic group, this would contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). Neither global model or individual model are recommended for large numbers of geographic groups, or for geographic groups in different environmental contexts. See overview vignette for more discussion. -* `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE. -* `report_settings$nthreads`: For the number of threads argument for parallel processing in modelling. Either 1 or 2, if multiple cores are present. +* `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE (no cyclicals). +* `report_settings$fc_nthreads`: For the number of threads argument for parallel processing in modelling. Either 1 or 2, if multiple cores are present. Environmental data-related forecasting settings: -* `report_settings$env_var`: Environmental variables. This informs the modeling system which environmental variables to actually use. (You can therefore have extra variables or data in the environmental dataset.) This is just a simple 1 column tibble with the variable names to use - `obsfield` - same field name as in the environmental data and environmental reference datasets, with entries for which variables to use in the modeling. -* `report_settings$env_lag_length`: The number of days of past environmental data to include for the lagged effects. -* `report_settings$env_anomalies`: Boolean argument indicating if the environmental variables should be replaced with their anomalies. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group. Default is false. +* `report_settings$env_var`: Environmental variables. This informs the modeling system which environmental variables to actually use. (You can therefore have extra variables or data in the environmental dataset.) This is just a simple 1 column tibble with the variable names to use - `obsfield` - same field name as in the environmental data and environmental reference datasets, with entries for which variables to use in the modeling. The default will be all the environmental variables that are present in all three environmental-related input data: `env_data`, `env_info`, and `env_ref`. +* `report_settings$env_lag_length`: The number of days of past environmental data to include for the lagged effects, default is 180 days. +* `report_settings$env_anomalies`: Boolean argument indicating if the environmental variables should be replaced with their anomalies. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group. Default is FALSE (no anomalization). ### Setting up for Event Detection The event detection settings are also bundled into the named list `report_settings`: -* `report_settings$ed_method`: At the moment, the only choices are "farrington" for the Farrington improved algorithm or "none". -* `report_settings$ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `report_settings$ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. In the demo, we have both displayed the results as a map and listed in tables. -* `report_settings$ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. +* `report_settings$ed_method`: At the moment, the only choices are "farrington" for the Farrington improved algorithm as implemented in the `surveillance` package, or "none". +* `report_settings$ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `report_settings$ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. Default is 4 weeks. +* `report_settings$ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. If the other parameters are not set, the defaults from the surveillance package will be used. ## Setting up Model Input (Optional) -* `report_settings$model_run`: This is a boolean indicating if it should ONLY generate and return the regression object (`model_obj`) and metadata (`model_info`) on the model. +* `report_settings$model_run`: This is a boolean indicating if it should ONLY generate and return the regression object (`model_obj`) and metadata (`model_info`) on the model. (Default is FALSE) * `report_settings$model_cached`: Once a model (and metadata) has been generated, it can be fed into `run_epidemiar()` using this argument. This should be the exact object that was returned by a `report_settings$model_run = TRUE`. This will skip the model building portion of forecasting, and will continue start into generating predictions. Using a prebuilt model saves on processing time, but will need to be updated periodically. If using a cached model, also set `fc_model_family = "cached"`. Pre-generating a model can save substantial processing time, and users can expect faster report data generation time. The trade-off of potential hits to model accuracy in the age of the model versus the time range of the requested predictions should be examined, which would vary depending on the situation/datasets. diff --git a/vignettes/output-report-data.Rmd b/vignettes/output-report-data.Rmd index 1c08f55..0605742 100644 --- a/vignettes/output-report-data.Rmd +++ b/vignettes/output-report-data.Rmd @@ -55,21 +55,21 @@ Early detection and early warning alerts levels for each geographic group. Early Mean disease incidence per geographic group during the early detection period. * `{groupfield}`: The user-given geographic grouping field -* `mean_inc`: The mean disease incidence per geographic group summarized over the early detection period +* `mean_epi`: The mean disease incidence (or cases, depending on the setting in `report_settings$report_value_type`) per geographic group summarized over the early detection period ## `modeling_results_data` These are multiple timeseries values for observed, forecast, and alert thresholds of disease incidence, over the report period, for each geographic unit. These data can be used in creating the individual geographic unit control charts. * `{groupfield}`: The user-given geographic grouping field -* `obs_date`: The last day of the epidemiological week (ISO/CDC, by `week_type`), Date object +* `obs_date`: The last day of the epidemiological week, Date object * `series`: "obs" = observed disease incidence, "fc" = modeled/forecast incidence values, "thresh" = event detection threshold values, "ed" = early detection alert (binary), "ew" = early warning alert (binary) * `value`: Value of the `series` for that geographic group for that week * `lab`: Labels for the series ("Observed", "Forecast Trend", "Alert Threshold", "Early Detection Alert", "Early Warning Alert") * `upper`: Unused * `lower`: Unused -* `week_epidemiar`: ISO/CDC week number, based on user given `week_type` argument -* `year_epidemiar`: ISO/CDC year, based on user given `week_type` argument +* `week_epidemiar`: ISO/CDC week number, based on user given `report_settings$epi_date_type` argument +* `year_epidemiar`: ISO/CDC year, based on user given `report_settings$epi_date_type` argument ## `environ_timeseries` @@ -77,9 +77,9 @@ These are multiple timeseries for the used environmental variables during the re * `{groupfield}`: The user-given geographic grouping field * `{obsfield}`: The user-given field for the environmental variable name/ID -* `year_epidemiar`: ISO/CDC year, based on user given `week_type` argument -* `week_epidemiar`: ISO/CDC week number, based on user given `week_type` argument -* `obs_date`: The last day of the epidemiological week (ISO/CDC, by `week_type`), Date object +* `year_epidemiar`: ISO/CDC year, based on user given `report_settings$epi_date_type` argument +* `week_epidemiar`: ISO/CDC week number, based on user given `report_settings$epi_date_type` argument +* `obs_date`: The last day of the epidemiological week (ISO/CDC, by `report_settings$epi_date_type`), Date object * `val_epidemiar`: Value of the environmental variable for that geographic group for that week. Values are a combination of observed, or interpolated (for missing) or extended (future estimated) values. * `reference_method`: Method for creating a weekly summary from daily data (e.g. "sum" for rainfall, or "mean" for NDWI) * `data_source`: "Observed", "Interpolated", or "Extended". Missing environmental data is handled in three different ways, depending on time period. For missing values in the middle of series, the value is a linear approximation of surrounding values ("Interpolated"). For missing values at the end of the series, up to the future forecast portion, values are carried forward in a persistence approach (also marked "Interpolated" at the moment). For the forecast future portion, values are a blending of the last known values and the climatic historical mean, with a gradual weighting scheme shifting from more weight from last known to historical mean ("Extended"). @@ -92,25 +92,25 @@ These data are the recent (during the early detection period) differences (anoma * `{groupfield}`: The user-given geographic grouping field * `{obsfield}`: The user-given field for the environmental variable name/ID -* `anom_ed_mean`: The mean of the anomalies per environmental variable per geographic group summarized during the early detection period. The anomalies are calculated as the difference from the observed value to the historical mean for that week of the year. +* `anom_ed_mean`: The mean of the anomalies per environmental variable per geographic group summarized during the early detection period. The anomalies here are calculated as the difference from the observed value to the historical mean for that week of the year. (Not to be confused with environmental anomalies option in modeling.) ## `params_meta` -This lists dates, settings, and parameters that `run_epidemiar()` was called with. +This lists dates, settings, and parameters that `run_epidemiar()` was called with and defaults that were used if the user did not set values for those parameters. ## `regression_object` -This is the regression object from the general additive model (bam()) regression. This is generally only for additional statistical investigation of the model, and is usually not saved (large object). +This is the regression object from the general additive model (`mgvc::bam()`) regression. This is generally only for additional statistical investigation of the model, and is usually not saved (large object). # Epidemiar Output Dataset - Model Only Run -The results of `run_epidemiar(..., model_run = TRUE)` is a cached model: the regression object plus some metadata information about what was used to generate the model. -Once a model has been generated, it can be fed back into `run_epidemiar(..., model_cached = {cached model object})` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. +The results of `run_epidemiar(..., report_settings$model_run = TRUE)` is a cached model: the regression object plus some metadata information about what was used to generate the model. +Once a model has been generated, it can be fed back into `run_epidemiar(..., report_settings$model_cached = {cached model object})` for faster predictions rather than regenerating the model on each run. Determining the balance on how old of a model is still useful is heavily dependent on the specific dataset. 1. `model_obj` 2. `model_info` ## `model_obj` -The output regression object from the `bam()` general additive model regression call. +The output regression object from the `mgcv::bam()` general additive model regression call. ## `model_info` A list of dates, settings, and relevant parameters that `run_epidemiar()` was called with. Very similar to `params_meta` of a full run. diff --git a/vignettes/overview-epidemiar.Rmd b/vignettes/overview-epidemiar.Rmd index ecce850..4fe58f6 100644 --- a/vignettes/overview-epidemiar.Rmd +++ b/vignettes/overview-epidemiar.Rmd @@ -8,14 +8,14 @@ date: "Updated `r format(Sys.time(), '%B %d, %Y')`" output: rmarkdown::html_vignette: fig_caption: yes - pdf_document: - number_sections: yes - toc: yes - toc_depth: 2 html_document: df_print: paged toc: yes toc_depth: '2' + pdf_document: + number_sections: yes + toc: yes + toc_depth: 2 vignette: | %\VignetteIndexEntry{Overview} %\VignetteEncoding{UTF-8} @@ -49,12 +49,12 @@ In addition, we designed workflows and wrote customized code for our Ethiopian c The full system can be thought of have 3 (three) main parts: ```{r echo = FALSE, out.width = "75%", `fig.cap = "System diagram of the EPIDEMIA Forecasting System."`} -knitr::include_graphics("EPIDEMIA_overview.png") +knitr::include_graphics("EPIDEMIA_system_v2.png") ``` -1. R package `epidemiar`: This package - a library of flexible functions for modeling and forecasting -2. Google Earth Engine script: Script to gather the environmental data summaries -3. Custom R Project: Contains the surveillance and environmental data, user parameters on the model and outbreak detection algorithm, and script to produce a finalized report. +1. R package `epidemiar`: This package - a library of flexible functions for modeling, forecasting, and model validation +2. Google Earth Engine script: A GEE script to gather the environmental data summaries +3. Custom R Project: Contains the surveillance and environmental data, user parameters on the model and outbreak detection algorithm, and script to produce a finalized report (or validation report if validation functions were run). This package can be used for modelling and forecasting for a variety of environmentally-mediated disease. For example GEE scripts and R project, see the `epidemiar-demo` repository at https://github.com/EcoGRAPH/epidemiar-demo. @@ -71,6 +71,12 @@ The epidemiar package is flexible on many aspects of modeling. It is all based o The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). +## Timeframes + +The timeframes of the modeling results/report are by default based around the date of last known/observed epidemiological data. This last known date drives when the forecast (future) period begins. The function will forecast `report_settings$fc_future_period` weeks beyond the last known date. The entire report will be a length of `report_settings$report_period` weeks, with the last `report_settings$fc_future_period` weeks as the forecast, and therefore showing the last `(report_settings$report_period - report_settings$fc_future_period)` weeks of known data before the start of the forecast. + +However, it is also possible to specify a custom forecast start date (the equivalent date of one week past the last known epidemiological data) using the parameter `report_settings$fc_start_date`, irrespective of when epidemiological data exists. All other time periods will adjust as above around this forecasting start date instead. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section. + ## Geographic group, long term trends, and seasonality diff --git a/vignettes/validation-assessment.Rmd b/vignettes/validation-assessment.Rmd index 204dc28..2facb33 100644 --- a/vignettes/validation-assessment.Rmd +++ b/vignettes/validation-assessment.Rmd @@ -42,7 +42,7 @@ With on-demand implementation and time-range flexibility, one can also investiga ## Specific Arguments -The `run_validation()` function takes 4 arguments, plus all the `run_epidemia()` arguments. +The `run_validation()` function takes 5 arguments, plus all the `run_epidemia()` arguments. * `date_start`: The week to begin validation, can be built with `epidemiar::make_date_yw()` and isoyear and isoweek numbers (or epiweeks, with appropriate settings). * `total_timesteps`: The number of weeks from `week_start` to run the validation. @@ -55,7 +55,7 @@ The `run_validation()` function takes 4 arguments, plus all the `run_epidemia()` The `run_validation()` function will call `run_epidemia()`, so it will also take all the arguments for that function. The user does not need to modify any of these arguments (e.g. event detection settings, `fc_future_period`), as `run_validation()` will automatically handle all of thse adjustments. -It is envisioned that users can take their usual script for running EPIDEMIA forecasts, and simply sub in the validation function with those five validation settings for doing model assessments. +It is envisioned that users can take their usual script for running EPIDEMIA forecasts, and simply sub in the validation function with those validation settings for doing model assessments. # Validation Output From c17d2fb149685f69debb80c3e88da59b19ccfbfb Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 13 May 2020 22:33:40 -0500 Subject: [PATCH 059/132] Environmental data is now filled in with one method, so collapsing old 'Extended' and 'Interpolated' into just 'Imputed'. --- R/forecasting_helpers.R | 2 +- R/run_epidemia.R | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 043bff2..377fc4d 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -123,7 +123,7 @@ extend_env_future <- function(env_data, #bind with existing data (NAs for everything else) env_future <- dplyr::bind_rows(env_trim, env_future_missing) %>% #mark which are about to be filled in - dplyr::mutate(data_source = ifelse(is.na(.data$val_epidemiar), "Extended", .data$data_source)) + dplyr::mutate(data_source = ifelse(is.na(.data$val_epidemiar), "Imputed", "Observed")) #Optimizing for speed for validation runs with naive models, skip unneeded diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 6a6552d..161070b 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -529,12 +529,14 @@ run_epidemia <- function(epi_data = NULL, } - #Note: val_epidemiar is field name returned (env) - #interpolation is no longer necessary with new extend_env_future() + #Note: val_epidemiar is field name returned (env) + ##interpolation is no longer necessary with new extend_env_future() #env_data <- env_NA_interpolate(env_data, quo_obsfield, quo_valuefield, quo_groupfield) %>% + ##first, mark which ones during known time range were observed versus (will be) interpolated + #dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% + + #prep environmental data, filling in of missing data will happen in extend_env_future() env_data <- env_data %>% - #first, mark which ones during known time range were observed versus (will be) interpolated - dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% #copy over value dplyr::mutate(val_epidemiar = !!quo_valuefield) %>% #and sort by alphabetical groupfield From f151a4bb59268bbced2f62f1d4c9bca584f8d797 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 13 May 2020 22:34:33 -0500 Subject: [PATCH 060/132] Removed old commented out code. --- R/run_epidemia.R | 35 ----------------------------------- 1 file changed, 35 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 161070b..82bb6ec 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -344,15 +344,6 @@ run_epidemia <- function(epi_data = NULL, #update report_settings with checked, cleaned, or newly added default values report_settings <- check_results$clean_settings - # report_settings <- set_report_defaults(raw_settings = report_settings, - # epi_data, - # env_info, - # env_ref_data, - # env_variables, - # quo_obsfield, - # groupings, - # quo_groupfield) - # switch epi_date_type to week_type needed for add_datefields() week_type <- dplyr::case_when( report_settings[["epi_date_type"]] == "weekISO" ~ "ISO", @@ -448,32 +439,6 @@ run_epidemia <- function(epi_data = NULL, report_dates$prev$seq <- report_dates$prev %>% {seq.Date(.$min, .$max, "week")} - # #full report - # report_dates <- list(full = list(min = max(epi_data$obs_date, na.rm = TRUE) - - # lubridate::as.difftime((report_settings[["report_period"]] - - # report_settings[["fc_future_period"]] - 1), - # unit = "weeks"), - # max = max(epi_data$obs_date, na.rm = TRUE) + - # lubridate::as.difftime(report_settings[["fc_future_period"]], - # units = "weeks"))) - # report_dates$full$seq <- report_dates$full %>% {seq.Date(.$min, .$max, "week")} - # #dates with known epidemological data - # report_dates$known <- list(min = report_dates$full$min, - # max = max(epi_data$obs_date, na.rm = TRUE)) - # report_dates$known$seq <- report_dates$known %>% {seq.Date(.$min, .$max, "week")} - # #forecast period - # report_dates$forecast <- list(min = report_dates$known$max + - # lubridate::as.difftime(1, units = "weeks"), - # #could calculate from forecast_future, but already done so in $full - # max = report_dates$full$max) - # report_dates$forecast$seq <- report_dates$forecast %>% {seq.Date(.$min, .$max, "week")} - # #early detection summary period (ED runs over full report, this is for summary in defined ED period) - # report_dates$ed_sum <- list(min = report_dates$known$max - - # lubridate::as.difftime(report_settings[["ed_summary_period"]] - 1, units = "weeks"), - # max = report_dates$known$max) - # report_dates$ed_sum$seq <- report_dates$ed_sum %>% {seq.Date(.$min, .$max, "week")} - - # Preparing: data checks for implicit missing, NA and interpolation --------------------- From 1bb5bef94925c1afe8e35559161afabe9cde7b5f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 15 May 2020 17:27:26 -0500 Subject: [PATCH 061/132] Corrected all critical element input existing checking --- R/run_epidemia.R | 61 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 41 insertions(+), 20 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 82bb6ec..dc8bf88 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -273,34 +273,55 @@ run_epidemia <- function(epi_data = NULL, #NSE is a little tricky: can't test directly on fields-to-be-enquo'd because #it'll try to evaluate them, and complain that the object (actually field - #name) doesn't exist. Renaming the quosures AS the input fields to create more - #meaningful error messages if the items are missing. + #name) doesn't exist. - #note: population can be missing (case based reports, not incidence) - nec_nse <- list(casefield = quo_casefield, - groupfield = quo_groupfield, - obsfield = quo_obsfield, - valuefield = quo_valuefield) - necessary <- create_named_list(epi_data, env_data, env_ref_data, env_info, fc_model_family) + #looping along lists gets difficult/impossible when things might be missing, + # so testing each individually. #initialize missing info msgs & flag missing_msgs <- "" missing_flag <- FALSE - #loop through all necessary fields, checking if argument exists, collecting list of missing - for (nse in seq_along(nec_nse)){ - #testing if quosure was created on NULL object. - if(rlang::quo_is_null(nec_nse[[nse]])){ - missing_flag <- TRUE - missing_msgs <- paste0(missing_msgs, names(nec_nse[nse]), sep = "\n") - } + + #NSE fields + if (rlang::quo_is_null(quo_casefield)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "casefield", sep = "\n") + } + if (rlang::quo_is_null(quo_groupfield)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "groupfield", sep = "\n") } - for (arg in seq_along(necessary)){ - if (is.null(necessary[[arg]])){ - missing_flag <- TRUE - missing_msgs <- paste0(missing_msgs, names(necessary[arg]), sep = "\n") - } + if (rlang::quo_is_null(quo_obsfield)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "obsfield", sep = "\n") } + if (rlang::quo_is_null(quo_valuefield)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "valuefield", sep = "\n") + } + #note: population can be missing (case based reports, not incidence) + #data & model form + if (is.null(epi_data)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "epi_data", sep = "\n") + } + if (is.null(env_data)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "env_data", sep = "\n") + } + if (is.null(env_ref_data)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "env_ref_data", sep = "\n") + } + if (is.null(env_info)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "env_info", sep = "\n") + } + if (is.null(fc_model_family)){ + missing_flag <- TRUE + missing_msgs <- paste0(missing_msgs, "fc_model_family", sep = "\n") + } #if missing, stop and give error message if (missing_flag){ stop("Missing critical argument(s). Please make sure the following is/are included:\n", missing_msgs) From 7306941443e4b11c9e78694d30a630d2c9e94f82 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 20 May 2020 17:46:11 -0500 Subject: [PATCH 062/132] Re-added data_source field in environmental data prep - needed if data is complete (otherwise field won't exist because it did not go through the missing data section). --- R/run_epidemia.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index dc8bf88..2340308 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -523,6 +523,9 @@ run_epidemia <- function(epi_data = NULL, #prep environmental data, filling in of missing data will happen in extend_env_future() env_data <- env_data %>% + #first, mark which ones during known time range were observed versus (will be) interpolated + #need to keep here, in case all data was observed in report period, so that field will exist + dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% #copy over value dplyr::mutate(val_epidemiar = !!quo_valuefield) %>% #and sort by alphabetical groupfield From 69222e10efaf8e7771a45a6bde62e3d49243214a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 20 May 2020 18:23:21 -0500 Subject: [PATCH 063/132] Fixed testing of missing environmental data to include possibility of data existing through the end of the forecast period, BUT the presence of other gaps in the env data in the report period. --- R/forecasting_helpers.R | 162 +++++++++++++++++++--------------------- 1 file changed, 78 insertions(+), 84 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 377fc4d..482dc59 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -77,53 +77,43 @@ extend_env_future <- function(env_data, env_trim <- env_data %>% dplyr::filter(.data$obs_date <= report_dates$forecast$max) - #Calculate the earliest of the latest known data dates - # per env var, per geographic grouping - earliest_end_known <- env_trim %>% - #per geographic grouping, per environmental variable - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - #the last known date for each - dplyr::summarize(max_dates = max(.data$obs_date, na.rm = TRUE)) %>% - #the earliest of the last known - dplyr::pull(.data$max_dates) %>% min() - - - #If earliest_end_known is end of forecast period, then no missing data - if (earliest_end_known >= report_dates$forecast$max){ - - env_extended_final <- env_trim - - } else { - #Some amount of missing data exists - - #Calculate full/complete data table - #combination of all groups, env vars, and dates (DAILY) - #from earliest_end_known through the end of the forecast period - env_future_complete <- tidyr::crossing(obs_date = seq.Date(earliest_end_known + 1, - report_dates$forecast$max, 1), - group_temp = groupings, - obs_temp = env_variables_used) - #and fix names with NSE - env_future_complete <- env_future_complete %>% - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp, - !!rlang::quo_name(quo_obsfield) := .data$obs_temp) - - #could have ragged env data per variable per grouping - #so, antijoin with env_known_fill first to get the actually missing rows - env_future_missing <- env_future_complete %>% - dplyr::anti_join(env_trim, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), - "obs_date"), - c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), - "obs_date"))) + + #Possible situations: + #Missing data in 'past/known' period, or future unknown data, + # or both, or neither + # NOT handling implicit missing in pre-report period + + #Calculate full/complete data table + #combination of all groups, env vars, and dates (DAILY) + #from beginning of report through the end of the forecast period + env_complete <- tidyr::crossing(obs_date = seq.Date(report_dates$forecast$min, + report_dates$forecast$max, 1), + group_temp = groupings, + obs_temp = env_variables_used) + #and fix names with NSE + env_complete <- env_complete %>% + dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp, + !!rlang::quo_name(quo_obsfield) := .data$obs_temp) + + #could have ragged env data per variable per grouping + #so, antijoin with env_known_fill first to get the actually missing rows + env_missing <- env_complete %>% + dplyr::anti_join(env_trim, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + rlang::quo_name(quo_obsfield), + "obs_date"), + c(rlang::quo_name(quo_groupfield), + rlang::quo_name(quo_obsfield), + "obs_date"))) + if (nrow(env_missing > 1)){ + #some amount of missing data #bind with existing data (NAs for everything else) - env_future <- dplyr::bind_rows(env_trim, env_future_missing) %>% + # (env_future name ~ env plus future period, hold over from when this only did future portion) + env_future <- dplyr::bind_rows(env_trim, env_missing) %>% #mark which are about to be filled in - dplyr::mutate(data_source = ifelse(is.na(.data$val_epidemiar), "Imputed", "Observed")) + dplyr::mutate(data_source = ifelse(is.na(.data$val_epidemiar), "Imputed", .data$data_source)) #Optimizing for speed for validation runs with naive models, skip unneeded @@ -143,7 +133,7 @@ extend_env_future <- function(env_data, # returns the number of rows in the run get_rle_na_info <- function(x){ x_na_rle <- rle(is.na(x)) - run_id = rep(seq_along(x_na_rle$lengths), times = x_na_rle$lengths) + run_id <- rep(seq_along(x_na_rle$lengths), times = x_na_rle$lengths) run_tot <- rep(x_na_rle$lengths, times = x_na_rle$lengths) dplyr::as_tibble(create_named_list(run_id, run_tot)) } @@ -170,16 +160,16 @@ extend_env_future <- function(env_data, dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% #create a 1 day lag variable since need previous 7 days not including current dplyr::mutate(val_lag1 = dplyr::lag(.data$val_epidemiar, n = 1), - #ifelse to find the first NA - val_epidemiar = ifelse(is.na(.data$val_epidemiar) & .data$id_in_run == 1, - #zoo:rollapply to calculate mean of last 7 days (week) on lagged var - zoo::rollapply(data = .data$val_lag1, - width = 7, - FUN = mean, - align = "right", - na.rm = TRUE), - #if not first NA, then contine with original val_epidemiar value - .data$val_epidemiar)) %>% + #ifelse to find the first NA + val_epidemiar = ifelse(is.na(.data$val_epidemiar) & .data$id_in_run == 1, + #zoo:rollapply to calculate mean of last 7 days (week) on lagged var + zoo::rollapply(data = .data$val_lag1, + width = 7, + FUN = mean, + align = "right", + na.rm = TRUE), + #if not first NA, then contine with original val_epidemiar value + .data$val_epidemiar)) %>% #drop unneeded lag column dplyr::select(-.data$val_lag1) @@ -222,45 +212,49 @@ extend_env_future <- function(env_data, #calculate parts (for all, will only use when needed) # with progressive blending based on id_in_run and run_tot dplyr::mutate(recent_modifier = (.data$run_tot - .data$id_in_run - 1) / .data$run_tot, - recent_part = .data$recent_modifier * .data$last_known, - historical_modifier = (.data$id_in_run - 1) / .data$run_tot, - #historical is by week, so get pseudo-daily value depending on reference method, - # i.e. how to summarize a week of data - historical_value = dplyr::case_when( - .data$reference_method == "mean" ~ .data$ref_value, - .data$reference_method == "sum" ~ .data$ref_value / 7, - #default as if mean - TRUE ~ .data$ref_value), - historical_part = .data$historical_modifier * .data$historical_value, - #testing - val_orig = .data$val_epidemiar, - #only fill NA values - val_epidemiar = ifelse(is.na(.data$val_epidemiar), - #persist if <15 days, blend if greater - ifelse(.data$run_tot < 15, - .data$last_known, - .data$recent_part + .data$historical_part), - #if notNA, then use existing val_epidemiar value - .data$val_epidemiar)) + recent_part = .data$recent_modifier * .data$last_known, + historical_modifier = (.data$id_in_run - 1) / .data$run_tot, + #historical is by week, so get pseudo-daily value depending on reference method, + # i.e. how to summarize a week of data + historical_value = dplyr::case_when( + .data$reference_method == "mean" ~ .data$ref_value, + .data$reference_method == "sum" ~ .data$ref_value / 7, + #default as if mean + TRUE ~ .data$ref_value), + historical_part = .data$historical_modifier * .data$historical_value, + #testing + val_orig = .data$val_epidemiar, + #only fill NA values + val_epidemiar = ifelse(is.na(.data$val_epidemiar), + #persist if <15 days, blend if greater + ifelse(.data$run_tot < 15, + .data$last_known, + .data$recent_part + .data$historical_part), + #if notNA, then use existing val_epidemiar value + .data$val_epidemiar)) #clean up env_extended_final <- env_filled %>% #remove all added columns to match original format dplyr::select(-c(.data$run_id, .data$run_tot, .data$id_in_run, - .data$week_epidemiar, .data$year_epidemiar, - .data$last_known, - .data$reference_method, .data$ref_value, - .data$recent_modifier, .data$recent_part, - .data$historical_modifier, .data$historical_value, .data$historical_part, - .data$val_orig)) %>% + .data$week_epidemiar, .data$year_epidemiar, + .data$last_known, + .data$reference_method, .data$ref_value, + .data$recent_modifier, .data$recent_part, + .data$historical_modifier, .data$historical_value, .data$historical_part, + .data$val_orig)) %>% #fill everything except original value field #for any other column that got vanished during crossing, etc. - tidyr::fill(dplyr::everything(), -!!quo_valuefield, -!!quo_groupfield, -!!quo_obsfield, .direction = "down") %>% + tidyr::fill(dplyr::everything(), + -!!quo_valuefield, -!!quo_groupfield, -!!quo_obsfield, + .direction = "down") %>% #ungroup to end dplyr::ungroup() - } #end else, meaning some missing data - + } else { #else on if missing rows + #no missing data, just use trimmed environmental data set as given + env_extended_final <- env_trim + } } #end else on valid run & naive models @@ -517,8 +511,8 @@ lag_environ_to_epi <- function(epi_fc, alpha <- 1/4 distlagfunc <- splines::bs(x=seq(from=1, to=lag_len, by=1), intercept=TRUE, knots=stats::quantile(seq(from=1, to=lag_len, by=1), - probs=seq(from=alpha, to=1-alpha, by=alpha), - na.rm=TRUE)) + probs=seq(from=alpha, to=1-alpha, by=alpha), + na.rm=TRUE)) dlagdeg <- ncol(distlagfunc) From 841ccf6e5b9b083f8ffee662a1ffe1d0fde36b0c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 21 May 2020 00:56:48 -0500 Subject: [PATCH 064/132] Expanded ability to handle implicit missing data to all epidemiological data date range (not just during report) --- R/run_epidemia.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 2340308..c85f176 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -463,9 +463,12 @@ run_epidemia <- function(epi_data = NULL, # Preparing: data checks for implicit missing, NA and interpolation --------------------- - #Implicit missing, or gaps introduced by user start parameter, may exist - #all weeks in report period NOT in forecast period ("previous" to forecast) - epi_full <- tidyr::crossing(obs_date = report_dates$prev$seq, + # Implicit missing, or gaps introduced by user start parameter, may exist + # implicit missing may also exist in historical/known time ranges + # NOT in forecast period, as that will be handled by 'future' extension + epi_all_dates <- seq.Date(from = report_dates$known$min, to = report_dates$prev$max, by = "week") + + epi_full <- tidyr::crossing(obs_date = epi_all_dates, #report_dates$prev$seq, group_temp = groupings) #and fix names with NSE epi_full <- epi_full %>% From 4039d8fdce426dad70219f61fe7c6a367248526e Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 21 May 2020 16:15:19 -0500 Subject: [PATCH 065/132] Removed incorrectly added data_source field in prep (happens later in extend_env_data()). --- R/run_epidemia.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index c85f176..6598d2e 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -526,9 +526,6 @@ run_epidemia <- function(epi_data = NULL, #prep environmental data, filling in of missing data will happen in extend_env_future() env_data <- env_data %>% - #first, mark which ones during known time range were observed versus (will be) interpolated - #need to keep here, in case all data was observed in report period, so that field will exist - dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% #copy over value dplyr::mutate(val_epidemiar = !!quo_valuefield) %>% #and sort by alphabetical groupfield From aac13a155438bb2e7f893cb1cfb4ec411489ce71 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 21 May 2020 16:46:42 -0500 Subject: [PATCH 066/132] Added input test for implicit missing rows from environmental data in the PRE-report period. --- R/input_checks.R | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/R/input_checks.R b/R/input_checks.R index 74f415f..9248e35 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -441,6 +441,36 @@ input_check <- function(epi_data, } } #end err_flag + #env_data: test for missing rows pre-report period + # in report period (incl. 'future'), missing implicit/explicit will be handled by env filler/extender + if (!err_flag){ + report_start_date <- new_settings[["fc_start_date"]] - + lubridate::as.difftime((new_settings[["report_period"]] - + new_settings[["fc_future_period"]]), + unit = "weeks") + pre_env_check <- env_data %>% + #only pre-report data check + dplyr::filter(.data$obs_date < report_start_date) %>% + #field for error message + dplyr::mutate(group_obs = paste0(!!quo_groupfield, "-", !!quo_obsfield)) %>% + #calc number of rows, should be the same for all if no missing rows + dplyr::group_by(.data$group_obs) %>% + dplyr::summarize(rowcount = dplyr::n()) + not_max_env_rows <- pre_env_check %>% + dplyr::filter(.data$rowcount < max(pre_env_check$rowcount)) + if (nrow(not_max_env_rows) > 1) { + #some implicit missing rows + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "Missing rows detected in environmental data prior to report start date. ", + "Implicit missing data is not allowed, please add rows with NA values. ", + "Please check the following: ", + paste(unlist(dplyr::pull(not_max_env_rows, .data$group_obs)), collapse = " "), + ".\n") + } #end if nrow > 1 + } #end if err_flag + + + #nthreads #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) From 71092ab2927370dadc000929d211eb7345659c4d Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 21 May 2020 16:48:27 -0500 Subject: [PATCH 067/132] Corrected environmental data implicit missing check during ENTIRE report period; added missing explicit missing data check before data imputation. --- R/forecasting_helpers.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 482dc59..b67c752 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -81,13 +81,12 @@ extend_env_future <- function(env_data, #Possible situations: #Missing data in 'past/known' period, or future unknown data, # or both, or neither - # NOT handling implicit missing in pre-report period #Calculate full/complete data table #combination of all groups, env vars, and dates (DAILY) - #from beginning of report through the end of the forecast period - env_complete <- tidyr::crossing(obs_date = seq.Date(report_dates$forecast$min, - report_dates$forecast$max, 1), + env_complete <- tidyr::crossing(obs_date = seq.Date(from = min(env_trim$obs_date), + to = report_dates$forecast$max, + by = "day"), group_temp = groupings, obs_temp = env_variables_used) #and fix names with NSE @@ -106,14 +105,15 @@ extend_env_future <- function(env_data, "obs_date"))) - if (nrow(env_missing > 1)){ + if (nrow(env_missing) > 1 | any(is.na(env_trim$val_epidemiar))){ #some amount of missing data + #first test is implicit (missing row), second is explicit (row exists, but value NA) #bind with existing data (NAs for everything else) # (env_future name ~ env plus future period, hold over from when this only did future portion) env_future <- dplyr::bind_rows(env_trim, env_missing) %>% #mark which are about to be filled in - dplyr::mutate(data_source = ifelse(is.na(.data$val_epidemiar), "Imputed", .data$data_source)) + dplyr::mutate(data_source = ifelse(is.na(.data$val_epidemiar), "Imputed", "Observed")) #Optimizing for speed for validation runs with naive models, skip unneeded @@ -251,13 +251,14 @@ extend_env_future <- function(env_data, #ungroup to end dplyr::ungroup() + } #end else on valid run & naive models + } else { #else on if missing rows #no missing data, just use trimmed environmental data set as given - env_extended_final <- env_trim + env_extended_final <- env_trim %>% + dplyr::mutate(data_source = "Observed") } - } #end else on valid run & naive models - #several paths to get to an env_extended_final return(env_extended_final) From 670af9ab3b48ba3510df60692c40ec4afb6e7849 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 21 May 2020 16:50:48 -0500 Subject: [PATCH 068/132] Needed internal forecast results epi data fc_epi to include ALL forecast values, not just during report period (that is the report output result fc_res dataset); this allows Farrington event detection to use forecast values to sub in for observed values to force a continuous threshold calculation in the pre-early warning period. --- R/forecasting_main.R | 18 ++++++++++++------ R/run_epidemia.R | 28 ++++++++++++++++++++++++---- 2 files changed, 36 insertions(+), 10 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 25224e7..2ba4d98 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -195,18 +195,22 @@ run_forecast <- function(epi_data, fc_cases_upr = .data$fit+1.96*sqrt(.data$fit), fc_cases_lwr = .data$fit-1.96*sqrt(.data$fit)) + #Trim fc report results ONLY (not full epi dataset) to report period + preds_catch_trim <- preds_catch %>% + dplyr::filter(.data$obs_date >= report_dates$full$min) + # extract fc series into report format # if else off of report_value_type of reporting in terms of cases or incidence # using full if else blocks to do all 3 at once, rather than if_elses in each variable if (report_settings[["report_value_type"]] == "cases"){ - fc_res <- preds_catch %>% + fc_res <- preds_catch_trim %>% dplyr::mutate(series = "fc", lab = "Forecast Trend", value = .data$fc_cases, upper = .data$fc_cases_upr, lower = .data$fc_cases_lwr) } else if (report_settings[["report_value_type"]] == "incidence"){ - fc_res <- preds_catch %>% + fc_res <- preds_catch_trim %>% dplyr::mutate(series = "fc", lab = "Forecast Trend", value = .data$fc_cases / !!quo_popfield * report_settings[["report_inc_per"]], @@ -214,7 +218,7 @@ run_forecast <- function(epi_data, lower = .data$fc_cases_lwr / !!quo_popfield * report_settings[["report_inc_per"]]) } else { #shouldn't happen - fc_res <- preds_catch %>% + fc_res <- preds_catch_trim %>% dplyr::mutate(series = "fc", lab = "Forecast Trend", value = NA_real_, @@ -408,14 +412,16 @@ forecast_regression <- function(epi_lag, dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) if (report_settings[["dev_fc_fit_freq"]] == "once"){ - #for single model fit, this has all the data we need, just trim to report dates - date_preds <- epi_preds %>% - dplyr::filter(.data$obs_date >= report_dates$full$min) + #for single model fit, this has all the data we need, + # trimming to report dates will happen later AFTER event detection + date_preds <- epi_preds + #%>% dplyr::filter(.data$obs_date >= report_dates$full$min) } else if (report_settings[["dev_fc_fit_freq"]] == "week"){ #prediction of interest are last ones (equiv to req_date) per groupfield date_preds <- epi_preds %>% dplyr::group_by(!!quo_groupfield) %>% dplyr::filter(.data$obs_date == req_date) + #note 'week' fits are limit to report period only, and workaround for farrington spin up will not work } forecast_reg_results <- create_named_list(date_preds, diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 6598d2e..ab6d35e 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -618,15 +618,35 @@ run_epidemia <- function(epi_data = NULL, if (report_settings[["ed_method"]] == "farrington") { - #existing data before report start (i.e. before we have any modelled values from forecasting) + #need to include farrington spin up period (from limit54 parameter, default 4 time units), + # add buffer before prev period starts + # Get user values from limit54 control + if (is.null(report_settings[["ed_control"]][["limit54"]])){ + #default is limit54 = c(5,4): 4 time units + far_buffer <- 4 + 1 + } else { + #get user value + far_buffer <- report_settings[["ed_control"]][["limit54"]][[2]] + 1 + } + + #note dev_fc_fit_freq 'week' fits are report period only, and will not have this buffer period (NA) + far_buffer_start_date <- report_dates$prev$min - lubridate::as.difftime(far_buffer, + units = "weeks") + + #existing data before report start + buffer + # (i.e. before we have any modelled values from forecasting) epi_to_fc <- epi_data %>% - dplyr::filter(.data$obs_date < report_dates$prev$min) + dplyr::filter(.data$obs_date < far_buffer_start_date) + #dates that we need to blend obs/fc + far_blend_dates <- seq.Date(from = far_buffer_start_date, + to = report_dates$prev$max, + by = "week") #observed OR modeled values in report period before forecasting ('previous') report_prev_values <- fc_res_all$fc_epi %>% - #get results ONLY from prev period - dplyr::filter(.data$obs_date %in% report_dates$prev$seq) %>% + #get results ONLY from prev period + buffer + dplyr::filter(.data$obs_date %in% far_blend_dates) %>% #flag dates that will need to be censored later dplyr::mutate(censor_flag = rlang::are_na(.data$cases_epidemiar), #and fill in NA values for modelled values for continuous non-NA values From b1bf13ae7776810a9b20d0384af6fca60b413ce3 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 22 May 2020 02:13:53 -0500 Subject: [PATCH 069/132] Added skip to environmental variable anomalizing IF it was a naive model run (from validation), as naive models don't use environmental data --- R/forecasting_main.R | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 2ba4d98..d4816d1 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -94,16 +94,19 @@ run_forecast <- function(epi_data, fc_clusters = report_settings[["fc_clusters"]]) # anomalizing the environ data, if requested. + # AND not a naive model run + if (!fc_model_family == "naive-persistence" & !fc_model_family == "naive-averageweek"){ + if (report_settings[["env_anomalies"]]){ + message("Anomalizing the environmental variables...") + env_fc <- anomalize_env(env_fc, + quo_groupfield, + nthreads = report_settings[["fc_nthreads"]], + #calculated/internal + env_variables_used) + } + } #end not if naive model run - if (report_settings[["env_anomalies"]]){ - message("Anomalizing the environmental variables...") - env_fc <- anomalize_env(env_fc, - quo_groupfield, - nthreads = report_settings[["fc_nthreads"]], - #calculated/internal - env_variables_used) - } # create the lags epi_lag <- lag_environ_to_epi(epi_fc, From 342e00e2ae14d2c91d34fe747e73f0e0ea292b4f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 26 May 2020 12:55:31 -0500 Subject: [PATCH 070/132] For environmental data missing imputation, changed first fill value from last 7 days for both sum and mean type variables to 14 days for sum (precipitation-like) variables to prevent a high rainfall week the week prior from heavily skewing the gap filling. --- R/forecasting_helpers.R | 82 ++++++++++++++++++++++++++--------------- 1 file changed, 52 insertions(+), 30 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index b67c752..26cc3fa 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -148,40 +148,17 @@ extend_env_future <- function(env_data, #add a groupby with the new run ID dplyr::group_by(!!quo_groupfield, !!quo_obsfield, .data$run_id) %>% #creates an index of where that row is in the run - dplyr::mutate(id_in_run = seq_along(.data$val_epidemiar)) - - #find 1st NA, then take mean of previous week, input for that day - #first NA now can be found with is.na(val_epidemiar) & id_in_run == 1 - #use zoo::rollapply for mean - - #Fill in first NA of a run with the mean of previous week - env_na1fill <- env_na_rle %>% - #confirm proper grouping - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - #create a 1 day lag variable since need previous 7 days not including current - dplyr::mutate(val_lag1 = dplyr::lag(.data$val_epidemiar, n = 1), - #ifelse to find the first NA - val_epidemiar = ifelse(is.na(.data$val_epidemiar) & .data$id_in_run == 1, - #zoo:rollapply to calculate mean of last 7 days (week) on lagged var - zoo::rollapply(data = .data$val_lag1, - width = 7, - FUN = mean, - align = "right", - na.rm = TRUE), - #if not first NA, then contine with original val_epidemiar value - .data$val_epidemiar)) %>% - #drop unneeded lag column - dplyr::select(-.data$val_lag1) - - ##Prep for blending previous week mean & historical averages for other missing + dplyr::mutate(id_in_run = seq_along(.data$val_epidemiar)) %>% + #ungroup to end set + ungroup() + ##Get env info and ref data #Prep ref data - get only used vars env_ref_varused <- env_ref_data %>% dplyr::filter(!!quo_obsfield %in% env_variables_used) - #joins for ref summary type, and summary for week - env_join_ref <- env_na1fill %>% + env_join_ref <- env_na_rle %>% #add week, year fields epidemiar::add_datefields(week_type) %>% #get reference/summarizing method from user supplied env_info @@ -191,7 +168,8 @@ extend_env_future <- function(env_data, rlang::quo_name(quo_obsfield))) %>% #get weekly ref value dplyr::left_join(env_ref_varused %>% - dplyr::select(!!quo_obsfield, !!quo_groupfield, .data$week_epidemiar, .data$ref_value), + dplyr::select(!!quo_obsfield, !!quo_groupfield, + .data$week_epidemiar, .data$ref_value), #NSE fun by = rlang::set_names(c(rlang::quo_name(quo_groupfield), rlang::quo_name(quo_obsfield), @@ -200,8 +178,52 @@ extend_env_future <- function(env_data, rlang::quo_name(quo_obsfield), "week_epidemiar"))) + + #find 1st NA, then take mean of previous week, input for that day + #first NA now can be found with is.na(val_epidemiar) & id_in_run == 1 + #use zoo::rollapply for mean + # for 'mean' type, last 7 days + # for 'sum' type (e.g. highly variable precip), last 14 days + + #Fill in first NA of a run with the mean of previous + env_na1fill <- env_join_ref %>% + #confirm proper grouping + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + # confirm proper sorting + dplyr::arrange(!!quo_groupfield, !!quo_obsfield, obs_date) %>% + #create a 1 day lag variable since need previous days not including current + dplyr::mutate(val_lag1 = dplyr::lag(.data$val_epidemiar, n = 1), + #zoo:rollapply to calculate mean of last 7 days (week) on lagged var + mean_for_mean_type_lag1 = zoo::rollapply(data = .data$val_lag1, + width = 7, + FUN = mean, + align = "right", + na.rm = TRUE, + #fill important to align properly with mutate + fill = NA), + mean_for_sum_type_lag1 = zoo::rollapply(data = .data$val_lag1, + width = 14, + FUN = mean, + align = "right", + na.rm = TRUE, + #fill important to align properly with mutate + fill = NA), + #ifelse to find the first NA + val_epidemiar = ifelse(is.na(.data$val_epidemiar) & .data$id_in_run == 1, + dplyr::case_when( + #for mean type, for sum type + .data$reference_method == "mean" ~ .data$mean_for_mean_type_lag1, + .data$reference_method == "sum" ~ .data$mean_for_sum_type_lag1, + #default (nothing currently using) + TRUE ~ .data$mean_for_mean_type_lag1), + #if not first NA, then use original val_epidemiar value + .data$val_epidemiar)) %>% + #drop unneeded lag column + dplyr::select(-c(.data$val_lag1, .data$mean_for_mean_type_lag1, .data$mean_for_sum_type_lag1)) + + #calculate NA missing values using carry|blend - env_filled <- env_join_ref %>% + env_filled <- env_na1fill %>% #order very important for filling next step dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) %>% dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% From 6f5959711de217fc47be1eda76ac4439c58daef0 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 26 May 2020 12:58:43 -0500 Subject: [PATCH 071/132] Correction to fc_future_period warning regarding far future forecasts and environmental data --- vignettes/data-modeling.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index feccd20..83e5d50 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -125,7 +125,7 @@ Many of the settings are bundled into the named list `report_settings` argument. Besides `fc_model_family`, the rest of the forecasting controls (along with other settings) are bundled into the named list `report_settings`: * `report_settings$fc_start_date`: Option to set a custom date for when forecasting (i.e. `report_settings$fc_future_period`) begins. Default is one week past the last known/observed epidemiological data date. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section if the `report_settings$fc_start_date` is more than `report_settings$ed_summary_period` weeks after known/observed epidemiological data. -* `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks. +* `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks without known environmental data. * `report_settings$fc_clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. The default is a global model (one cluster), which is the equivalent to `fc_clusters` having each entry for the geographic group contains the same "cluster_id" value. If you only have one geographic group, this would contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). Neither global model or individual model are recommended for large numbers of geographic groups, or for geographic groups in different environmental contexts. See overview vignette for more discussion. * `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE (no cyclicals). * `report_settings$fc_nthreads`: For the number of threads argument for parallel processing in modelling. Either 1 or 2, if multiple cores are present. From b52dc0e0d78dd4373cc8ce74d148e54cb29ea129 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 26 May 2020 13:06:06 -0500 Subject: [PATCH 072/132] Adjust to a more user-intuitive total timesteps count (to include the starting time point in the count, e.g. 52 weeks could be W1 through W52.) --- R/model_validation.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/model_validation.R b/R/model_validation.R index 8a1ae7b..810e543 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -12,8 +12,8 @@ #'geographic grouping (if present). #' #'@param date_start Date to start testing for model validation. -#'@param total_timesteps Number of weeks from `week_start` to run validation -#' tests. +#'@param total_timesteps Number of weeks from (but including) `week_start` to +#' run validation tests. #'@param timesteps_ahead Number of weeks for testing the n-week ahead forecasts. #' Results will be generated from 1-week ahead through `weeks_ahead` number of #' weeks. @@ -93,6 +93,11 @@ run_validation <- function(date_start = NULL, # Adjust parameters for validation runs ----------------------------------- + #for a user intuitive timestep count, subtract starting time point from 'count' + total_timesteps <- total_timesteps - 1 + #e.g. total_timesteps = 52 for weekly data will be weeks 1 through 52. + #(and not week 1 of the following year) + #Assumed that run_epidemia() parameters just copied and pasted, so adjust for validation #new lengths report_settings[["fc_future_period"]] <- timesteps_ahead + reporting_lag From 8f6917c9d43027228ea02ea710b65652e3cf147f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 26 May 2020 13:06:23 -0500 Subject: [PATCH 073/132] Add epidemiar settings to validation metadata output --- R/model_validation.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/model_validation.R b/R/model_validation.R index 810e543..c01602b 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -125,7 +125,9 @@ run_validation <- function(date_start = NULL, reporting_lag, per_timesteps, skill_test, - casefield = rlang::quo_name(quo_casefield)) + casefield = rlang::quo_name(quo_casefield), + fc_model_family, + report_settings) # All loop prep ------------------------------------------------------ From 47c1a632773b5d244cd22c779fc7b06df6ee9526 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 26 May 2020 13:31:05 -0500 Subject: [PATCH 074/132] Added package and .data references for bindings --- R/forecasting_helpers.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 26cc3fa..2c681b8 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -150,7 +150,7 @@ extend_env_future <- function(env_data, #creates an index of where that row is in the run dplyr::mutate(id_in_run = seq_along(.data$val_epidemiar)) %>% #ungroup to end set - ungroup() + dplyr::ungroup() ##Get env info and ref data #Prep ref data - get only used vars @@ -190,7 +190,7 @@ extend_env_future <- function(env_data, #confirm proper grouping dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% # confirm proper sorting - dplyr::arrange(!!quo_groupfield, !!quo_obsfield, obs_date) %>% + dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) %>% #create a 1 day lag variable since need previous days not including current dplyr::mutate(val_lag1 = dplyr::lag(.data$val_epidemiar, n = 1), #zoo:rollapply to calculate mean of last 7 days (week) on lagged var From 2a5c4285f0d862f6b4304ce690fc0f4eb693bb9a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 26 May 2020 13:31:21 -0500 Subject: [PATCH 075/132] Automatic documentation update --- man/run_validation.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 8cc97b7..86c5187 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -15,8 +15,8 @@ run_validation(date_start = NULL, total_timesteps = 26, \arguments{ \item{date_start}{Date to start testing for model validation.} -\item{total_timesteps}{Number of weeks from `week_start` to run validation -tests.} +\item{total_timesteps}{Number of weeks from (but including) `week_start` to +run validation tests.} \item{timesteps_ahead}{Number of weeks for testing the n-week ahead forecasts. Results will be generated from 1-week ahead through `weeks_ahead` number of From 90ab3caa1bb30297ca5016b408b3f7a241bf5475 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 28 May 2020 00:59:55 -0500 Subject: [PATCH 076/132] Change out interpolation to be done by zoo::rollapply with rule 2:1 (fill leading NAs with closest known value, and leave NAs for trailing edge). Old epidemiar::na_approx() could not fill leading edges, leading to occassional issues if an implicit missing row or explicit NA was at the beginning of the report period. --- NAMESPACE | 1 - R/cleaners_helpers.R | 70 ++++++++++++++++++++++++-------------------- R/na_approx.R | 46 ++++++++++++++--------------- R/run_epidemia.R | 2 -- 4 files changed, 61 insertions(+), 58 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 29772fc..0be5131 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,7 +10,6 @@ export(epiwday) export(get_group_validations) export(get_overall_validations) export(make_date_yw) -export(na_approx) export(run_epidemia) export(run_validation) export(save_geog_validations) diff --git a/R/cleaners_helpers.R b/R/cleaners_helpers.R index 4e547b3..c3d2085 100644 --- a/R/cleaners_helpers.R +++ b/R/cleaners_helpers.R @@ -17,42 +17,48 @@ epi_NA_interpolate <- function(epi_data, quo_casefield, quo_groupfield){ epi_data %>% dplyr::group_by(!!quo_groupfield) %>% - #confirm date sorting - dplyr::arrange(.data$obs_date) %>% - #interpolate - dplyr::mutate(cases_epidemiar = epidemiar::na_approx(!!quo_casefield)) %>% + #confirm geogroup-date sorting + dplyr::arrange(!!quo_groupfield, .data$obs_date) %>% + #interpolate, but not on trailing edge + #dplyr::mutate(cases_epidemiar = epidemiar::na_approx(!!quo_casefield)) %>% + dplyr::mutate(cases_epidemiar = zoo::na.approx(!!quo_casefield, rule=2:1, na.rm = FALSE)) %>% + #force into integer after interpolating (could cause problems with modeling otherwise) + dplyr::mutate(cases_epidemiar = floor(.data$cases_epidemiar)) %>% #finish by ungrouping dplyr::ungroup() } -#' Interpolates missing environmental data. -#' -#' @param quo_obsfield Quosure of the user given field that holds the -#' environmental variable identifiers/names/IDs. -#' @param quo_valuefield Quosure of the user given field that holds the -#' environmental variable observation value. -#' @param quo_groupfield Quosure of the user given geographic grouping field to -#' run_epidemia(). -#' -#'@inheritParams run_epidemia -#' -#' @return Same data as env_data, with new interpolated field, val_epidemiar, of -#' the environmental variable data. -#' -env_NA_interpolate <- function(env_data, quo_obsfield, quo_valuefield, quo_groupfield){ - env_data %>% - #first, mark which ones are observed versus (will be) interpolated - dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% - #two levels of group_by - dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% - #confirm date sorting - dplyr::arrange(.data$obs_date) %>% - #interpolate - dplyr::mutate(val_epidemiar = !!quo_valuefield, - val_epidemiar = epidemiar::na_approx(.data$val_epidemiar)) %>% - #finish by ungrouping - dplyr::ungroup() -} + +#' #' Interpolates missing environmental data. +#' #' Deprecated, no longer used as extend_env_data() will fill any gaps. +#' #' +#' #' @param quo_obsfield Quosure of the user given field that holds the +#' #' environmental variable identifiers/names/IDs. +#' #' @param quo_valuefield Quosure of the user given field that holds the +#' #' environmental variable observation value. +#' #' @param quo_groupfield Quosure of the user given geographic grouping field to +#' #' run_epidemia(). +#' #' +#' #'@inheritParams run_epidemia +#' #' +#' #' @return Same data as env_data, with new interpolated field, val_epidemiar, of +#' #' the environmental variable data. +#' #' +#' env_NA_interpolate <- function(env_data, quo_obsfield, quo_valuefield, quo_groupfield){ +#' env_data %>% +#' #first, mark which ones are observed versus (will be) interpolated +#' dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% +#' #two levels of group_by +#' dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% +#' #confirm date sorting +#' dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) %>% +#' #interpolate +#' #dplyr::mutate(val_epidemiar = !!quo_valuefield, +#' # val_epidemiar = epidemiar::na_approx(.data$val_epidemiar)) %>% +#' dplyr::mutate(val_epidemiar = zoo::na.approx(!!quo_valuefield, rule = 2:1, na.rm = FALSE)) %>% +#' #finish by ungrouping +#' dplyr::ungroup() +#' } diff --git a/R/na_approx.R b/R/na_approx.R index 19452bf..e377bc7 100644 --- a/R/na_approx.R +++ b/R/na_approx.R @@ -1,23 +1,23 @@ -#' Replace NA by interpolation in a numeric vector -#' -#' Fill in missing values in a numeric vector by approximat them through linear -#' interpolation. -#' -#' @param x A numeric vector. -#' @param order.by An index vector with unique entries by which the observations -#' in `x`` are ordered. -#' -#' @details Leading and trailing `NA`s are left as is. -#' -#' @return A numeric vector of the same length as `x`. -#' @export -#' -#' @examples -#' na_approx(c(NA, .31, 4, NA, NA, 10, NA)) -na_approx <- function(x, order.by = zoo::index(x)) { - n_non_NAs <- sum(!is.na(x)) # number of non-NA values in x - if(n_non_NAs < 2) return(x) - zoo::zoo(x, order.by) %>% - zoo::na.approx(na.rm = FALSE) %>% - zoo::coredata() -} +#' #' Replace NA by interpolation in a numeric vector +#' #' +#' #' Fill in missing values in a numeric vector by approximat them through linear +#' #' interpolation. +#' #' +#' #' @param x A numeric vector. +#' #' @param order.by An index vector with unique entries by which the observations +#' #' in `x`` are ordered. +#' #' +#' #' @details Leading and trailing `NA`s are left as is. +#' #' +#' #' @return A numeric vector of the same length as `x`. +#' #' export +#' #' +#' #' @examples +#' #' na_approx(c(NA, .31, 4, NA, NA, 10, NA)) +#' na_approx <- function(x, order.by = zoo::index(x)) { +#' n_non_NAs <- sum(!is.na(x)) # number of non-NA values in x +#' if(n_non_NAs < 2) return(x) +#' zoo::zoo(x, order.by) %>% +#' zoo::na.approx(na.rm = FALSE) %>% +#' zoo::coredata() +#' } diff --git a/R/run_epidemia.R b/R/run_epidemia.R index ab6d35e..a64fb1a 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -503,8 +503,6 @@ run_epidemia <- function(epi_data = NULL, if (report_settings[["epi_interpolate"]] == TRUE){ #Note: cases_epidemiar is field name returned (epi) epi_data <- epi_NA_interpolate(epi_data, quo_casefield, quo_groupfield) %>% - #force into integer after interpolating (would cause problems with modeling otherwise) - dplyr::mutate(cases_epidemiar = floor(.data$cases_epidemiar)) %>% #and sort by alphabetical groupfield (dates should already be sorted from interpolate function) dplyr::arrange(!!quo_groupfield, .data$obs_date) } else { From 412f605e76dd030ac1cd68a9e94f091ed8462280 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 28 May 2020 01:00:15 -0500 Subject: [PATCH 077/132] Automatic documentation updates --- man/create_named_list.Rd | 32 +++++++++++++++++++++++++++++++- man/env_NA_interpolate.Rd | 32 -------------------------------- man/na_approx.Rd | 27 --------------------------- 3 files changed, 31 insertions(+), 60 deletions(-) delete mode 100644 man/env_NA_interpolate.Rd delete mode 100644 man/na_approx.Rd diff --git a/man/create_named_list.Rd b/man/create_named_list.Rd index 05128bc..202b3d0 100644 --- a/man/create_named_list.Rd +++ b/man/create_named_list.Rd @@ -2,7 +2,37 @@ % Please edit documentation in R/cleaners_helpers.R \name{create_named_list} \alias{create_named_list} -\title{Create a named list.} +\title{#' Interpolates missing environmental data. +#' Deprecated, no longer used as extend_env_data() will fill any gaps. +#' +#' @param quo_obsfield Quosure of the user given field that holds the +#' environmental variable identifiers/names/IDs. +#' @param quo_valuefield Quosure of the user given field that holds the +#' environmental variable observation value. +#' @param quo_groupfield Quosure of the user given geographic grouping field to +#' run_epidemia(). +#' +#'@inheritParams run_epidemia +#' +#' @return Same data as env_data, with new interpolated field, val_epidemiar, of +#' the environmental variable data. +#' +env_NA_interpolate <- function(env_data, quo_obsfield, quo_valuefield, quo_groupfield){ + env_data %>% + #first, mark which ones are observed versus (will be) interpolated + dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% + #two levels of group_by + dplyr::group_by(!!quo_groupfield, !!quo_obsfield) %>% + #confirm date sorting + dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) %>% + #interpolate + #dplyr::mutate(val_epidemiar = !!quo_valuefield, + # val_epidemiar = epidemiar::na_approx(.data$val_epidemiar)) %>% + dplyr::mutate(val_epidemiar = zoo::na.approx(!!quo_valuefield, rule = 2:1, na.rm = FALSE)) %>% + #finish by ungrouping + dplyr::ungroup() +} +Create a named list.} \usage{ create_named_list(...) } diff --git a/man/env_NA_interpolate.Rd b/man/env_NA_interpolate.Rd deleted file mode 100644 index 815e21c..0000000 --- a/man/env_NA_interpolate.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cleaners_helpers.R -\name{env_NA_interpolate} -\alias{env_NA_interpolate} -\title{Interpolates missing environmental data.} -\usage{ -env_NA_interpolate(env_data, quo_obsfield, quo_valuefield, quo_groupfield) -} -\arguments{ -\item{env_data}{Daily environmental data for the same groupfields and date -range as the epidemiological data. It may contain extra data (other -districts or date ranges). The data must be in long format (one row for each -date and environmental variable combination), and must start at absolutel -minimum \code{report_settings$env_lag_length} days (default 180) before -epi_data for forecasting.} - -\item{quo_obsfield}{Quosure of the user given field that holds the -environmental variable identifiers/names/IDs.} - -\item{quo_valuefield}{Quosure of the user given field that holds the -environmental variable observation value.} - -\item{quo_groupfield}{Quosure of the user given geographic grouping field to -run_epidemia().} -} -\value{ -Same data as env_data, with new interpolated field, val_epidemiar, of - the environmental variable data. -} -\description{ -Interpolates missing environmental data. -} diff --git a/man/na_approx.Rd b/man/na_approx.Rd deleted file mode 100644 index 881067e..0000000 --- a/man/na_approx.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/na_approx.R -\name{na_approx} -\alias{na_approx} -\title{Replace NA by interpolation in a numeric vector} -\usage{ -na_approx(x, order.by = zoo::index(x)) -} -\arguments{ -\item{x}{A numeric vector.} - -\item{order.by}{An index vector with unique entries by which the observations -in `x`` are ordered.} -} -\value{ -A numeric vector of the same length as `x`. -} -\description{ -Fill in missing values in a numeric vector by approximat them through linear -interpolation. -} -\details{ -Leading and trailing `NA`s are left as is. -} -\examples{ -na_approx(c(NA, .31, 4, NA, NA, 10, NA)) -} From 52a107c150c398177d20f7fbbfc27b6be95b8d1f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 28 May 2020 01:07:15 -0500 Subject: [PATCH 078/132] Added missing na.rm = TRUE so that missing observed values don't cause the overall R2 to be NaN/-Inf skill scores. --- R/model_validation.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/model_validation.R b/R/model_validation.R index c01602b..fb48f1e 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -360,7 +360,7 @@ calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ validation_overall <- fc_stats %>% dplyr::group_by(.data$timestep_ahead) %>% #Now calc TSS part of R2 - dplyr::mutate(meanobs = mean(.data$obs), + dplyr::mutate(meanobs = mean(.data$obs, na.rm = TRUE), total_squares = (.data$obs - .data$meanobs)^2) %>% #stat calc dplyr::summarize(MAE = mean(.data$absdiff, na.rm = TRUE), @@ -380,7 +380,7 @@ calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ validation_grouping <- fc_stats %>% dplyr::group_by(!!quo_groupfield, .data$timestep_ahead) %>% #Now calc TSS part of R2 - dplyr::mutate(meanobs = mean(.data$obs), + dplyr::mutate(meanobs = mean(.data$obs, na.rm = TRUE), total_squares = (.data$obs - .data$meanobs)^2) %>% #stat calc dplyr::summarize(MAE = mean(.data$absdiff, na.rm = TRUE), From 898546ededf29f38cde028c18a44440b2c7f6a1a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 28 May 2020 01:07:39 -0500 Subject: [PATCH 079/132] Added comment regarding how implicit missing data is being handled --- R/model_validation.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/model_validation.R b/R/model_validation.R index fb48f1e..c965002 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -139,6 +139,7 @@ run_validation <- function(date_start = NULL, #Pull obs from original # Will have extra dates, but will be trimmed back to user requested dates later + # May have implicit missing data, but left_joining below, so that'll create the NAs obs_only <- epi_data_orig %>% dplyr::select(!!quo_groupfield, .data$obs_date, !!quo_casefield) %>% #rename observation From f181ecebaa4f75d962fe106f0b29f80b68ced25b Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 28 May 2020 01:08:18 -0500 Subject: [PATCH 080/132] Correction to timestep count, offset issue was in Rnw header calculation --- R/model_validation.R | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/R/model_validation.R b/R/model_validation.R index c965002..a2c3eac 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -93,11 +93,6 @@ run_validation <- function(date_start = NULL, # Adjust parameters for validation runs ----------------------------------- - #for a user intuitive timestep count, subtract starting time point from 'count' - total_timesteps <- total_timesteps - 1 - #e.g. total_timesteps = 52 for weekly data will be weeks 1 through 52. - #(and not week 1 of the following year) - #Assumed that run_epidemia() parameters just copied and pasted, so adjust for validation #new lengths report_settings[["fc_future_period"]] <- timesteps_ahead + reporting_lag @@ -185,6 +180,8 @@ run_validation <- function(date_start = NULL, #Create list of dates #the start of calculations will be date_start minus timesteps_ahead # of weeks + # to total_timesteps - 1 to not count current week + # (e.g. so total_timesteps = 52 covers 52 weeks / 1 year). date_list <- date_start + lubridate::weeks(-this_timesteps_ahead:(total_timesteps-1)) #output will be list of dataframes (forecasts) until we collapse later From 1cbcd60212add8ba4af7f37c2b6f505ddc12c01b Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 1 Jun 2020 15:09:22 -0500 Subject: [PATCH 081/132] Switched to zoo::na.approx; added fix for group sorting, needs testing --- R/data_to_daily.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/data_to_daily.R b/R/data_to_daily.R index 359a106..03cc99e 100644 --- a/R/data_to_daily.R +++ b/R/data_to_daily.R @@ -28,15 +28,22 @@ data_to_daily <- function(data_notdaily, valuefield, interpolate = TRUE){ #should handle all grouping/categories dplyr::group_by_at(dplyr::vars(-.data$obs_date, -!!quo_valuefield)) %>% #all explicit missing data - line for every Date for all groupings (above) - tidyr::complete(obs_date = tidyr::full_seq(c(min(data_notdaily$obs_date), max(data_notdaily$obs_date)), 1)) %>% + tidyr::complete(obs_date = tidyr::full_seq(c(min(data_notdaily$obs_date), + max(data_notdaily$obs_date)), 1)) %>% dplyr::ungroup() if (interpolate){ data_1day <- data_1day %>% #should handle all grouping/categories + #Likely does not, actually, need to add ... for grouping variables dplyr::group_by_at(dplyr::vars(-.data$obs_date, -!!quo_valuefield)) %>% + #confirm sorting + #check if group_vars will handle grouping sorting issue + dplyr::arrange(dplyr::group_vars(), .data$obs_date) %>% #will not extrapolate beyond last known value, that will happen inside run_epidemia() - dplyr::mutate(!!rlang::quo_name(quo_valuefield) := epidemiar::na_approx(!!quo_valuefield)) %>% + #dplyr::mutate(!!rlang::quo_name(quo_valuefield) := epidemiar::na_approx(!!quo_valuefield)) %>% + dplyr::mutate(!!rlang::quo_name(quo_valuefield) := zoo::na.approx(!!quo_valuefield, + rule = 2:1, na.rm = FALSE)) %>% #finish by ungrouping dplyr::ungroup() } From 7c359c557a84d7fb7ced5f379a8d268d9af0bf1d Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 1 Jun 2020 15:11:12 -0500 Subject: [PATCH 082/132] Added necessary antijoin in extending epidemiological data table into the future/forecast, as existing data may now be present due to new fc_start_date feature. --- R/forecasting_helpers.R | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 2c681b8..3707514 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -307,14 +307,24 @@ extend_epi_future <- function(epi_data, #extended epi data into future dates #for use in modeling later (results will be put elsewhere), this is for env and lags and modeling dataset + + #get future/forecast dates epi_future <- tidyr::crossing(obs_date = report_dates$forecast$seq, group_temp = groupings) #and fix names with NSE epi_future <- epi_future %>% dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + #with fc_start_date, there MAY be observed data in future/forecast period + #so antijoin and bind actual needed rows to avoid duplication + epi_future_missing <- epi_future %>% + dplyr::anti_join(epi_data, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + "obs_date"), + c(rlang::quo_name(quo_groupfield), + "obs_date"))) + #bind with exisiting data (NAs for everything else in epi_future) - extended_epi <- dplyr::bind_rows(epi_data, epi_future) %>% + extended_epi <- dplyr::bind_rows(epi_data, epi_future_missing) %>% dplyr::arrange(!!quo_groupfield, .data$obs_date) #fill population down (if pop field given) From b2eac0665dcf80adf744d965af5adf4c36d97364 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 1 Jun 2020 15:48:22 -0500 Subject: [PATCH 083/132] Updated documentation regarding how fc_future_period and fc_start_date are related. --- R/run_epidemia.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index a64fb1a..84a0b68 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -119,7 +119,9 @@ #' observation in /code{epi_data}. #' #' \item \code{fc_future_period} = 8: Number of future weeks from the end of -#' the \code{epi_data} to produce forecasts. Default is 8 weeks. +#' the \code{epi_data} to produce forecasts, or if fc_start_date is set, the +#' number of weeks from and including the start date to create forecasts. +#' Synonymous with early warning period. Default is 8 weeks. #' #' \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster #' id. This clusters, or groups, certain geographic locations together, to From 227f1d6141f8775272751c9510330b57480d3777 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 3 Jun 2020 03:04:39 -0500 Subject: [PATCH 084/132] Initial structure changes for switch between modified b-splines (epidemiar internal) and thin plate splines (in epidemiar-associated clusterapply package) for long-term trends and lagged environmental effects. This commit covers 1) input check and defaults, 2) switch in lag_environ_to_epi(), 3) build_model() changes with 4) new build_equation() function. Modbs option tested and passed initial checks. --- R/forecasting_helpers.R | 142 +++++++++------ R/forecasting_main.R | 365 +++++++++++++++++++++++-------------- R/formatters_calculators.R | 1 - R/input_checks.R | 306 +++++-------------------------- R/run_epidemia.R | 10 +- 5 files changed, 368 insertions(+), 456 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 3707514..e3307a5 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -27,7 +27,7 @@ pull_model_envvars <- function(env_data, #' #'@param epi_date_type Extract from `report_settings$epi_date_type` #'@param env_variables_used List of environmental variables that were used in -#' the modeling (in `report_settings$env_var` & found in env_data) +#' the modeling (in `report_settings$env_var` & found in env_data and env_info) #' #'@inheritParams run_epidemia #'@inheritParams run_forecast @@ -475,9 +475,6 @@ anomalize_env <- function(env_fc, #'@param env_variables_used List of environmental variables that were used in #' the modeling, created by `pull_model_envvars()`, from list in #' `report_settings$env_var` & found in `env_data` -#'@param lag_len Extract from `report_settings$env_lag_length`. The maximum -#' number of days in the past to consider interactions between the -#' environmental variable anomalies and the disease case counts. #' #'@inheritParams run_forecast #' @@ -488,17 +485,17 @@ anomalize_env <- function(env_fc, lag_environ_to_epi <- function(epi_fc, env_fc, quo_groupfield, - lag_len, + report_settings, #calculated/internal groupings, env_variables_used){ + lag_len <- report_settings[["env_lag_length"]] + #create lag frame datalagger <- tidyr::crossing(group_temp = groupings, obs_date = unique(epi_fc$obs_date), lag = seq(from = 0, to = lag_len - 1, by = 1)) %>% - # #same order from originally written expand.grid - # arrange(lag, Date, group_temp) %>% #add lagging date dplyr::mutate(laggeddate = .data$obs_date - as.difftime(.data$lag, units = "days")) @@ -530,62 +527,53 @@ lag_environ_to_epi <- function(epi_fc, c(rlang::quo_name(quo_groupfield), "obs_date"))) } #end pivot loop - # # set up distributed lag basis functions (creates 5 basis functions) - # lagframe <- data.frame(x = seq(from = 1, to = laglen, by = 1)) - # alpha <- 1/4 - # distlagfunc <- splines::ns(lagframe$x, intercept = TRUE, - # knots = quantile(lagframe$x, - # probs=seq(from = alpha, to = 1 - alpha, - # by = alpha), - # na.rm = TRUE)) - # dlagdeg <- pracma::size(distlagfunc)[2] - - # set up distributed lag basis functions (creates 7 basis functions) - alpha <- 1/4 - distlagfunc <- splines::bs(x=seq(from=1, to=lag_len, by=1), intercept=TRUE, - knots=stats::quantile(seq(from=1, to=lag_len, by=1), - probs=seq(from=alpha, to=1-alpha, by=alpha), - na.rm=TRUE)) - dlagdeg <- ncol(distlagfunc) - - - # create actual distributed lag summaries - for (curvar in env_variables_used){ - bandsum <- matrix(data = rep(0, nrow(epi_lagged) * dlagdeg), - nrow = nrow(epi_lagged), ncol = dlagdeg) - #first column of that variable (0 lag) - mindex <- which(colnames(epi_lagged) == paste0(curvar, "_0")) - #temp working matrix - bandtemp <- as.matrix(epi_lagged[, (mindex:(mindex+lag_len-1))]) - #distributed lag summaries - for (j in 1:dlagdeg){ - bandsum[, j] <- bandtemp %*% distlagfunc[,j] - } - bandsum <- data.frame(bandsum) - names(bandsum) <- paste0("bandsum_", curvar, "_", 1:dlagdeg) + #if using modified b-splines, do the basis functions and calcs here + if (report_settings[["fc_splines"]] == "modbs"){ + # set up distributed lag basis functions (creates 7 basis functions) + alpha <- 1/4 + distlagfunc <- splines::bs(x=seq(from=1, to=lag_len, by=1), intercept=TRUE, + knots=stats::quantile(seq(from=1, to=lag_len, by=1), + probs=seq(from=alpha, to=1-alpha, by=alpha), + na.rm=TRUE)) + dlagdeg <- ncol(distlagfunc) + + + # create actual distributed lag summaries + for (curvar in env_variables_used){ + bandsum <- matrix(data = rep(0, nrow(epi_lagged) * dlagdeg), + nrow = nrow(epi_lagged), ncol = dlagdeg) + #first column of that variable (0 lag) + mindex <- which(colnames(epi_lagged) == paste0(curvar, "_0")) + #temp working matrix + bandtemp <- as.matrix(epi_lagged[, (mindex:(mindex+lag_len-1))]) + #distributed lag summaries + for (j in 1:dlagdeg){ + bandsum[, j] <- bandtemp %*% distlagfunc[,j] + } + bandsum <- data.frame(bandsum) + names(bandsum) <- paste0("bandsum_", curvar, "_", 1:dlagdeg) - # we used to do a submatrix here so that the regression formulae would - # be more easily written, but this was incompatible with dplyr - epi_lagged <- dplyr::bind_cols(epi_lagged, bandsum) + # we used to do a submatrix here so that the regression formulae would + # be more easily written, but this was incompatible with dplyr + epi_lagged <- dplyr::bind_cols(epi_lagged, bandsum) - #created summary value for each basis function (5) per env variable per group per week (based on epidemiological data time unit) + #created summary value for each basis function (5) per env variable per group per week (based on epidemiological data time unit) - } #end distr lag summary loop + } #end distr lag summary loop - #only keep bandsummaries (daily lags can be removed to free up a lot of space) - # note: ^ matches beginning of string, otherwise we'd get the bandsummaries too, which we want to keep - for (cvar in env_variables_used){ - epi_lagged[, which(grepl(paste0("^", cvar, "_"), colnames(epi_lagged)))] <- NULL + #only keep bandsummaries (daily lags can be removed to free up a lot of space) + # note: ^ matches beginning of string, otherwise we'd get the bandsummaries too, which we want to keep + for (cvar in env_variables_used){ + epi_lagged[, which(grepl(paste0("^", cvar, "_"), colnames(epi_lagged)))] <- NULL + } } + #return epi_lagged } - -# this creates a modified b-spline basis (which is a piecewise polynomial) - -#' Truncates poly. Creates a modified b-spline basis. +#' Creates a modified b-spline basis (piecewise polynomial). #' #' The modified basis splines are used to capture any long term trends per #' geographic group. @@ -653,6 +641,54 @@ truncpoly <- function(x = NULL, degree = 6, maxobs = NULL, minobs = NULL){ } +#'Formats the environmental data lagged to epidemiology data the way that the +#'clusterapply package wants. +#' +#'@param tbl The tibble with all the lagged variables wide and flat. +#'@param env_variables_used Vector of the names of the environmental variables +#' that are being used in the model. +#' +#'@return A dataframe with sub-matrices for each of the lagged environmental +#' variable data. +#' +format_lag_ca <- function(tbl, env_variables_used){ + + #initialize + #vector to collect all lagged environmental column names + all_lag_cols <- vector() + #dataframe to collect the lagged environmental variables as sub matrices + collecting_df <- as.data.frame(matrix(nrow = nrow(tbl), ncol = length(env_variables_used))) + + #loop for each environmental variable used in modeling + for (v in seq_along(env_variables_used)){ + cur_var <- env_variables_used[[v]] + #column names are {env_var}_n, where n is the lag day + var_allcol <- grep(paste(cur_var,"*"), colnames(tbl), value = TRUE) + #append column names to master list + all_lag_cols <- c(all_lag_cols, var_allcol) + + #create a matrix of just that environmental variable + var_mat <- tbl %>% + dplyr::select(var_allcol) %>% + as.matrix() + #put into collecting dataframe + collecting_df[,v] <- var_mat + #name column as the variable + names(collecting_df)[v] <- cur_var + } + + #get columns that are NOT lagged environmental variables + front_df <- tbl %>% + dplyr::select(-all_lag_cols) %>% + as.data.frame() + + #column bind the non-lagged with the submatrix-filled dataframe + dfm <- cbind(front_df, collecting_df) + + #return + dfm +} + diff --git a/R/forecasting_main.R b/R/forecasting_main.R index d4816d1..8b65c25 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -24,8 +24,8 @@ #'env_data_extd: Data set of the environmental data variables extended into the #' unknown/future. #'env_variables_used: list of environmental variables that were used in the -#' modeling (had to be both listed in model variables input file and present the -#' env_data dataset) +#' modeling (had to be listed in model variables input file and present the +#' env_data and env_info datasets) #'env_dt_ranges: Date ranges of the input environmental data. #'reg_obj: The regression object from modeling. #'Unless model_run is TRUE, in which case only the regression object is returned. @@ -94,6 +94,7 @@ run_forecast <- function(epi_data, fc_clusters = report_settings[["fc_clusters"]]) # anomalizing the environ data, if requested. + # note: brittle on format from env_format_fc(), edit with caution # AND not a naive model run if (!fc_model_family == "naive-persistence" & !fc_model_family == "naive-averageweek"){ @@ -112,7 +113,7 @@ run_forecast <- function(epi_data, epi_lag <- lag_environ_to_epi(epi_fc, env_fc, quo_groupfield, - lag_len = report_settings[["env_lag_length"]], + report_settings, #calculated/internal groupings, env_variables_used) @@ -310,67 +311,42 @@ forecast_regression <- function(epi_lag, ## Set up data - #mark within prior known range or not, to be used as input to create model + #mark within prior known range or not epi_lag <- epi_lag %>% dplyr::mutate(input = ifelse(.data$obs_date <= last_known_date, 1, 0)) # ensure that quo_name(quo_groupfield) is a factor - gam/bam will fail if given a character, # which is unusual among regression functions, which typically just coerce into factors. epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::quo_name(quo_groupfield) := factor(!!quo_groupfield)) - #number of geographic area groupings - n_groupings <- epi_lag %>% dplyr::pull(!!quo_groupfield) %>% nlevels() - #number of clusters - n_clusters <- nlevels(epi_lag$cluster_id) - # create a doy field so that we can use a cyclical spline - epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(.data$obs_date, "%j"))) + if (report_settings[["fc_cyclicals"]] == TRUE){ + # create a doy field so that we can use a cyclical spline + epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(.data$obs_date, "%j"))) + } - # create modified bspline basis in epi_lag file to model longterm trends - epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, - degree=6, - maxobs=max(epi_lag$obs_date[epi_lag$input==1], na.rm=TRUE))) + if (report_settings[["fc_splines"]] == "modbs"){ + # create modified bspline basis in epi_lag file to model longterm trends + epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, + degree=6, + maxobs=max(epi_lag$obs_date[epi_lag$input==1], na.rm=TRUE))) + } + #filter to input data for model building + epi_input <- epi_lag %>% dplyr::filter(.data$input == 1) ## If model_cached is NOT given, then create model / run regression if (is.null(report_settings[["model_cached"]])){ - #create variable bandsummaries equation piece - # e.g. 'bandsummaries_{var1} * cluster_id' for however many env var bandsummaries there are - bandsums_list <- grep("bandsum_*", colnames(epi_lag), value = TRUE) - bandsums_cl_list <- paste(bandsums_list, ": cluster_id") - #need variant without known multiplication if <= 1 clusters - if (n_clusters > 1) { - bandsums_eq <- glue::glue_collapse(bandsums_cl_list, sep =" + ") - } else { - bandsums_eq <- glue::glue_collapse(bandsums_list, sep = " + ") - } - - # get list of modbspline reserved variables and format for inclusion into model - modb_list <- grep("modbs_reserved_*", colnames(epi_lag), value = TRUE) - # variant depending on >1 geographic area groupings - if (n_groupings > 1){ - modb_list_grp <- paste(modb_list, ":", rlang::quo_name(quo_groupfield)) - modb_eq <- glue::glue_collapse(modb_list_grp, sep = " + ") - } else { - modb_eq <- glue::glue_collapse(modb_list, sep = " + ") - } - - #filter to input data - epi_input <- epi_lag %>% dplyr::filter(.data$input == 1) - - # Model building switching point regress <- build_model(fc_model_family, quo_groupfield, - epi_input, + epi_lag, report_settings, #calc/internal - n_groupings, - modb_eq, - bandsums_eq) + env_variables_used) } else { #if model_cached given, then use that as regress instead of building a new one (above) @@ -398,22 +374,14 @@ forecast_regression <- function(epi_lag, req_date) - ## Clean up - #remove distributed lag summaries and bspline basis, which are no longer helpful - band_names <- grep("bandsum_*", colnames(epi_lag), value = TRUE) - bspl_names <- grep("modbs_reserved_*", colnames(epi_lag), value = TRUE) - #remove - epi_lag_trim <- dplyr::select(epi_lag, -dplyr::one_of(band_names)) - epi_lag_trim <- dplyr::select(epi_lag_trim, -dplyr::one_of(bspl_names)) - - #now cbind to get ready to return - epi_preds <- cbind(epi_lag_trim %>% + epi_preds <- cbind(epi_lag %>% dplyr::filter(.data$obs_date <= req_date), as.data.frame(preds)) %>% #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) + if (report_settings[["dev_fc_fit_freq"]] == "once"){ #for single model fit, this has all the data we need, # trimming to report dates will happen later AFTER event detection @@ -437,12 +405,9 @@ forecast_regression <- function(epi_lag, #'@param epi_input Epidemiological dataset with basis spline summaries of the #' lagged environmental data (or anomalies), with column marking if "known" #' data and groupings converted to factors. -#'@param n_groupings Count of the number of geographic groupings in the model. -#'@param modb_eq Pieces of the regression formula that include the modified -#' basis functions to account for long term trend (with or without groupings, -#' as appropriate). -#'@param bandsums_eq Pieces of the regression formula that include the b-spline -#' bandsummaries of the environmental factors. +#'@param env_variables_used a list of environmental variables that will be used in the +#' modeling (had to be listed in model variables input file and present the +#' env_data and env_info datasets) #' #'@inheritParams run_epidemia #'@inheritParams run_forecast @@ -455,19 +420,18 @@ build_model <- function(fc_model_family, epi_input, report_settings, #calc/internal - n_groupings, - modb_eq, - bandsums_eq){ + env_variables_used){ #1. check and handle naive models # else is the user supplied model family - #2. check on fc_cyclicals, b/c need different bam call if s() used or not - #3. within each cyclical if/else section, use formula override if given, - #4. else build model: - # still within each cyclical if/elese section, - # check for number of geo graphic groupings (one or more than one) - # and build appropriate regression equations, - # and run appropriate bam call + #2. call build_equation to handle all the different equation pieces + #3. call mgcv::bam or batchapply::bam_batch() as relevant + + #number of geographic area groupings + n_groupings <- epi_input %>% dplyr::pull(!!quo_groupfield) %>% nlevels() + #number of clusters + n_clusters <- nlevels(epi_input$cluster_id) + if (fc_model_family == "naive-persistence"){ @@ -482,11 +446,7 @@ build_model <- function(fc_model_family, dplyr::group_by(!!quo_groupfield) %>% #prediction is 1 lag (previous week) #fit is name of value from regression models - dplyr::mutate(fit = dplyr::lag(.data$cases_epidemiar, n = 1)) %>% - #cleaning up as not needed, and for bug hunting - dplyr::select(-dplyr::starts_with("band")) %>% - dplyr::select(-dplyr::starts_with("modbs")) - + dplyr::mutate(fit = dplyr::lag(.data$cases_epidemiar, n = 1)) } else if (fc_model_family == "naive-averageweek"){ @@ -504,96 +464,225 @@ build_model <- function(fc_model_family, } else { #user supplied model family - #note, if using formula override AND cyclicals, - # dev users should put fc_cyclicals = TRUE, else message about discrete ignored. + #Formula override: developer mode + if (!is.null(report_settings[["dev_fc_formula"]])){ + message("DEVELOPER: Using user-supplied formula: ", report_settings[["dev_fc_formula"]]) + reg_eq <- report_settings[["dev_fc_formula"]] + #note, if using formula override AND cyclicals, + # dev users should put fc_cyclicals = TRUE, else message about discrete ignored. + # dev users also need to set fc_splines appropriately - #cyclical or not - if (report_settings[["fc_cyclicals"]]) { - #TRUE, include cyclicals - - message("Including seasonal cyclicals into model...") - - #Formula override: report_settings[["dev_fc_formula"]] - if (!is.null(report_settings[["dev_fc_formula"]])){ - - message("DEVELOPER: Using user-supplied formula: ", report_settings[["dev_fc_formula"]]) + } else { + #build equation + reg_eq <- build_equation(quo_groupfield, + epi_input, + report_settings, + n_groupings, + n_clusters, + env_variables_used) + } + } #end else user supplied family - reg_eq <- report_settings[["dev_fc_formula"]] - } else { - #build equation - - #need different formulas if 1+ or only 1 geographic grouping - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), - " + s(doy, bs=\"cc\", by=", - rlang::quo_name(quo_groupfield), - ") + ", - modb_eq, " + ", - bandsums_eq)) - } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - "s(doy, bs=\"cc\") + ", - modb_eq, " + ", - bandsums_eq)) - } - - } #end else on dev_fc_formula override - - - # run bam + #run the regression + if (report_settings[["fc_splines"]] == "modbs"){ + if (report_settings[["fc_cyclicals"]]) { + #yes cyclicals regress <- mgcv::bam(reg_eq, data = epi_input, family = fc_model_family, control = mgcv::gam.control(trace=FALSE), discrete = TRUE, nthreads = report_settings[["fc_nthreads"]]) + } else { + #no cyclicals + regress <- mgcv::bam(reg_eq, + data = epi_input, + family = fc_model_family, + control = mgcv::gam.control(trace=FALSE)) + } + #end modbs + } else if (report_settings[["fc_splines"]] == "tp"){ + + #tibble to dataframe, and turn all env wide data into each own sub matrix + epi_input_tp <- format_lag_ca(epi_input, + env_variables_used) + + # create a cluster for all the functions below to use + mycluster <- parallel::makeCluster(min(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) + + regress <- clusterapply::batch_bam(data = epi_input_tp, + bamargs=list("formula" = reg_eq, + "family" = fc_model_family, + "discrete" = TRUE), + batchvar="cluster_id", + cluster=mycluster) + + } #end thin plate + + +} # end build_model() + + +#'Create the appropriate regression equation. +#' +#'@param epi_input Epidemiological dataset with basis spline summaries of the +#' lagged environmental data (or anomalies), with groupings as a factor, +#' trimmed to data being used to create the model +#'@param n_groupings Count of the number of geographic groups (groupfield) in +#' total. +#'@param n_clusters Count of the number of clusters in total +#'@param env_variables_used a list of environmental variables that will be used in the +#' modeling (had to be listed in model variables input file and present the +#' env_data and env_info datasets) +#' +#'@inheritParams run_epidemia +#'@inheritParams run_forecast +#' +#'@return A formula to be used in the regression call, built based on settings +#' for cyclicals, spline type, and the number of geographic groupings present. +#' +#' +build_equation <- function(quo_groupfield, + epi_input, + report_settings, + n_groupings, + n_clusters, + env_variables_used){ + #switch split between modbs and tp spline options + # equation depends on spline choice, cyclical choice, # (>1 or not) geogroups, # (>1 or not) clusters + if (report_settings[["fc_splines"]] == "modbs"){ + #message("Creating equation for modified b-splines....") + + #create variable bandsummaries equation piece + # e.g. 'bandsummaries_{var1} * cluster_id' for however many env var bandsummaries there are + bandsums_list <- grep("bandsum_*", colnames(epi_input), value = TRUE) + bandsums_cl_list <- paste(bandsums_list, ": cluster_id") + #need variant without known multiplication if <= 1 clusters + if (n_clusters > 1) { + bandsums_eq <- glue::glue_collapse(bandsums_cl_list, sep =" + ") + } else { + bandsums_eq <- glue::glue_collapse(bandsums_list, sep = " + ") + } + + # get list of modbspline reserved variables and format for inclusion into model + modb_list <- grep("modbs_reserved_*", colnames(epi_input), value = TRUE) + # variant depending on >1 geographic area groupings + if (n_groupings > 1){ + modb_list_grp <- paste(modb_list, ":", rlang::quo_name(quo_groupfield)) + modb_eq <- glue::glue_collapse(modb_list_grp, sep = " + ") + } else { + modb_eq <- glue::glue_collapse(modb_list, sep = " + ") + } + + #cyclical or not + if (report_settings[["fc_cyclicals"]]) { + #TRUE, include cyclicals + + message("Including seasonal cyclicals into model...") + + #build equation + + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), + " + s(doy, bs=\"cc\", by=", + rlang::quo_name(quo_groupfield), + ") + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + "s(doy, bs=\"cc\") + ", + modb_eq, " + ", + bandsums_eq)) + } } else { # FALSE, no cyclicals + #build equation + + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), " + ", + modb_eq, " + ", + bandsums_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + modb_eq, " + ", + bandsums_eq)) + } + } #end cyclicals if else + + #end if modbs + } else if (report_settings[["fc_splines"]] == "tp"){ + + message("Creating equation using thin plate splines.") - #Formula override: report_settings[["dev_fc_formula"]] - if (!is.null(report_settings[["dev_fc_formula"]])){ + #create s(lag, by = <>, bs = 'tp') - message("DEVELOPER: Using user-supplied formula: ", report_settings[["dev_fc_formula"]]) + #for geogroup + tp_geo_eq <- paste0("s(lag, by = ", rlang::quo_name(quo_groupfield), ", bs = \'tp\')") - reg_eq <- report_settings[["dev_fc_formula"]] + #for each env var + tp_env_eq_list <- paste0("s(lag, by = ", env_variables_used, ", bs = \'tp\')") + tp_env_eq <- glue::glue_collapse(tp_env_eq_list, sep = " + ") + + if (report_settings[["fc_cyclicals"]]) { + #TRUE, include cyclicals + + message("Including seasonal cyclicals into model...") + + #build equation + + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), + #cyclical + " + s(doy, bs=\"cc\", by=", + rlang::quo_name(quo_groupfield), + ") + ", + #tp + tp_geo_eq, " + ", + tp_env_eq)) } else { - #build equation - - #need different formulas if 1+ or only 1 geographic grouping - if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), " + ", - modb_eq, " + ", - bandsums_eq)) - } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - modb_eq, " + ", - bandsums_eq)) - } - } #end else for override - - - # run bam - regress <- mgcv::bam(reg_eq, - data = epi_input, - family = fc_model_family, - control = mgcv::gam.control(trace=FALSE)) + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + "s(doy, bs=\"cc\") + ", + tp_geo_eq, " + ", + tp_env_eq)) + } + } else { + # FALSE, no cyclicals + #build equation - } #end cyclicals if else + #need different formulas if 1+ or only 1 geographic grouping + if (n_groupings > 1){ + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + rlang::quo_name(quo_groupfield), " + ", + tp_geo_eq, " + ", + tp_env_eq)) + } else { + reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + tp_geo_eq, " + ", + tp_env_eq)) + } + } #end else cyclicals - } #end else, user supplied family + } #end splines tp -} # end build_model() + #return + reg_eq +} #end build_equation #'Create the appropriate predictions/forecasts. diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index 2d0104e..f320ca7 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -309,7 +309,6 @@ format_report_settings <- function(rpt_settings){ #remove dev IF no dev settings were changed from default #so if dev settings all default, then remove if (rpt_settings[["dev_fc_fit_freq"]] == "once" & - rpt_settings[["dev_fc_modbsplines"]] == FALSE & is.null(rpt_settings[["dev_fc_formula"]])){ clean_settings <- clean_settings[!grepl("^dev", names(clean_settings))] } diff --git a/R/input_checks.R b/R/input_checks.R index 9248e35..86678fe 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -470,18 +470,59 @@ input_check <- function(epi_data, } #end if err_flag + #fc_splines + #is batchapply installed & available? + batchbam_ok <- if (requireNamespace("clusterapply", quietly = TRUE)) {TRUE} else {FALSE} + #if batchapply is installed then default is thin plate + default_splines <- if (batchbam_ok) {'tp'} else {'modbs'} + + #check input + if (!is.null(raw_settings[["fc_splines"]])) { + #prep user input for matching + new_settings[["fc_splines"]] <- tolower(raw_settings[["fc_splines"]]) + } else { + #no user input, use default + new_settings[["fc_splines"]] <- default_splines + } + #try match + new_settings[["fc_splines"]] <- tryCatch({ + match.arg(new_settings[["fc_splines"]], c("modbs", "tp")) + }, error = function(e){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "Given 'fc_splines'", + raw_settings[["fc_splines"]], + "does not match 'modbs' or 'tp', running as ", + default_splines, ".\n") + default_splines + }) + #override tp if batchapply is not installed/available + if (new_settings[["fc_splines"]] == "tp" & !batchbam_ok){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "User requested thin plate splines (fc_splines = 'tp'),", + "but package clusterapply is not installed/available. ", + "Running with modified b-splines ('modbs').\n") + new_settings[["fc_splines"]] <- "modbs" + } + #ncores + if (!is.null(raw_settings[["fc_ncores"]])) { + new_settings[["fc_ncores"]] <- raw_settings[["fc_ncores"]] + } else { + #calc default + #detectCores can return NA, so catch + new_settings[["fc_ncores"]] <- min(parallel::detectCores(logical=FALSE), + 1, + na.rm = TRUE) + } #nthreads #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) - #if user-supplied, use that cap at 2, otherwise create a default number - #used to decide if run anomalize_env() prior to forecasting if (!is.null(raw_settings[["fc_nthreads"]])) { # nthreads above 2 is not actually helpful new_settings[["fc_nthreads"]] <- ifelse(raw_settings[["fc_nthreads"]] > 1, 2, 1) } else { #calc default - new_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) + new_settings[["fc_nthreads"]] <- ifelse(new_settings[["fc_ncores"]] > 1, 2, 1) } @@ -489,9 +530,6 @@ input_check <- function(epi_data, if (is.null(raw_settings[["dev_fc_fit_freq"]])){ new_settings[["dev_fc_fit_freq"]] <- "once" } - if (is.null(raw_settings[["dev_fc_modbsplines"]])){ - new_settings[["dev_fc_modbsplines"]] <- FALSE - } if (is.null(raw_settings[["dev_fc_formula"]])){ new_settings[["dev_fc_formula"]] <- NULL } @@ -565,9 +603,6 @@ input_check <- function(epi_data, raw_settings[["report_value_type"]], "does not match 'cases' or 'incidence', running as 'cases'.\n") "cases" - }, finally = { - #failsafe default - "cases" }) # epi_date_type @@ -594,9 +629,6 @@ input_check <- function(epi_data, warn_msgs <- paste0(warn_msgs, "Given 'epi_date_type'", raw_settings[["epi_date_type"]], "does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).\n") "weekISO" - }, finally = { - #failsafe default - "weekISO" }) @@ -625,9 +657,6 @@ input_check <- function(epi_data, warn_msgs <- paste0(warn_msgs,"Given 'ed_method' ", raw_settings[["ed_method"]], " does not match 'none' or 'farrington', running as 'none'.\n") "none" - }, finally = { - #failsafe default to no event detection - "none" }) #ed_control @@ -716,250 +745,3 @@ input_check <- function(epi_data, } #end input_check() - - - - -# #'Set defaults of any missing report_settings parameters -# #' -# #'Function sets defaults to report_settings parameters. -# #' -# #'@param raw_settings The report_settings object as given by the user. -# #'@param env_variables List of all unique environmental variables in env_data. -# #'@param quo_obsfield Quosure of user given field name of the environmental data -# #' variables. -# #'@param groupings List of all unique geographical groupings in epi_data. -# #'@param quo_groupfield Quosure of the user given geographic grouping field to -# #' run_epidemia(). -# #' -# #'@inheritParams run_epidemia -# #' -# #'@return Returns a full report_settings object, using user supplied values or -# #' defaults is option was missing, or overrides in certain cases. -# #' -# -# set_report_defaults <- function(raw_settings, -# epi_data, -# env_info, -# env_ref_data, -# env_variables, -# quo_obsfield, -# groupings, -# quo_groupfield){ -# -# #set up list in case no report_settings were given -# if (is.null(raw_settings)){ -# new_settings <- list() -# } else { -# #copy over to begin before editing/updating below -# new_settings <- raw_settings -# } -# -# if (is.null(raw_settings[["report_period"]])){ -# new_settings[["report_period"]] <- 26 -# } -# -# if (is.null(raw_settings[["report_inc_per"]])){ -# new_settings[["report_inc_per"]] <- 1000 -# #okay if not used, if report_value_type is cases instead of incidence -# } -# -# if (is.null(raw_settings[["epi_interpolate"]])){ -# new_settings[["epi_interpolate"]] <- FALSE -# } -# -# if (is.null(raw_settings[["ed_summary_period"]])){ -# new_settings[["ed_summary_period"]] <- 4 -# } -# -# if (is.null(raw_settings[["model_run"]])){ -# new_settings[["model_run"]] <- FALSE -# } -# -# if (is.null(raw_settings[["model_cached"]])){ -# new_settings[["model_cached"]] <- NULL -# } -# -# if (is.null(raw_settings[["env_lag_length"]])){ -# #maybe make default based on data length, but for now -# new_settings[["env_lag_length"]] <- 180 -# } -# -# if (is.null(raw_settings[["fc_cyclicals"]])){ -# new_settings[["fc_cyclicals"]] <- FALSE -# } -# -# if (is.null(raw_settings[["fc_future_period"]])){ -# new_settings[["fc_future_period"]] <- 8 -# } -# -# #default false, with explicit false for naive models -# if (is.null(raw_settings[["env_anomalies"]])){ -# new_settings[["env_anomalies"]] <- dplyr::case_when( -# fc_model_family == "naive-persistence" ~ FALSE, -# fc_model_family == "naive-weekaverage" ~ FALSE, -# #default to FALSE -# TRUE ~ FALSE) -# } -# -# -# # For things that are being string matched: -# # tolower to capture upper and lower case user-input variations since match.arg is case sensitive -# # but must only try function if ed_method is not null (i.e. was given) -# -# #report_value_type -# # if provided, prepare for matching -# if (!is.null(raw_settings[["report_value_type"]])){ -# new_settings[["report_value_type"]] <- tolower(raw_settings[["report_value_type"]]) -# } else { -# #if not provided/missing/null -# message("Note: 'report_value_type' was not provided, returning results in case counts ('cases').") -# new_settings[["report_value_type"]] <- "cases" -# } -# #try match -# new_settings[["report_value_type"]] <- tryCatch({ -# match.arg(new_settings[["report_value_type"]], c("cases", "incidence")) -# }, error = function(e){ -# message("Warning: Given 'report_value_type' does not match 'cases' or 'incidence', running as 'cases'.") -# "cases" -# }, finally = { -# #failsafe default -# "cases" -# }) -# -# # epi_date_type -# # if provided, prepare for matching -# if (!is.null(raw_settings[["epi_date_type"]])){ -# #want to keep ISO and CDC capitalized, but drop 'Week' to 'week' if had been entered that way -# first_char <- substr(raw_settings[["epi_date_type"]], 1, 1) %>% -# tolower() -# #remainder of user entry -# rest_char <- substr(raw_settings[["epi_date_type"]], 2, nchar(raw_settings[["epi_date_type"]])) -# #paste back together -# new_settings[["epi_date_type"]] <- paste0(first_char, rest_char) -# } else { -# #if not provided/missing/null -# message("Note: 'epi_date_type' was not provided, running as weekly, ISO/WHO standard ('weekISO').") -# new_settings[["epi_date_type"]] <- "weekISO" -# } -# #try match -# new_settings[["epi_date_type"]] <- tryCatch({ -# match.arg(new_settings[["epi_date_type"]], c("weekISO", "weekCDC")) #"monthly" reserved for future -# }, error = function(e){ -# message("Warning: Given 'epi_date_type' does not match 'weekISO' or 'weekCDC', running as 'weekISO' (weekly, ISO/WHO standard).") -# "weekISO" -# }, finally = { -# #failsafe default -# "weekISO" -# }) -# -# -# # ed_method -# # if provided, prepare for matching -# if (!is.null(raw_settings[["ed_method"]])){ -# new_settings[["ed_method"]] <- tolower(raw_settings[["ed_method"]]) -# } else { -# #if not provided/missing/null -# message("Note: 'ed_method' was not provided, running as 'none'.") -# new_settings[["ed_method"]] <- "none" -# } -# #try match -# new_settings[["ed_method"]] <- tryCatch({ -# match.arg(new_settings[["ed_method"]], c("none", "farrington")) -# }, error = function(e){ -# message("Warning: Given 'ed_method' does not match 'none' or 'farrington', running as 'none'.") -# "none" -# }, finally = { -# #failsafe default to no event detection -# "none" -# }) -# -# -# # For other or more complicated defaults -# -# #report lengths structure: -# # full report length must be at least 1 time unit longer than forecast period + any ed summary period -# # (will also handle: ed summary period must be <= time points than 'prev' period (report length - forecast length)) -# if (new_settings[["report_period"]] < new_settings[["fc_future_period"]] + min(1, new_settings[["ed_summary_period"]])) { -# #make report period make sense with forecast period and (possible) ed summary period -# new_settings[["report_period"]] <- new_settings[["fc_future_period"]] + min(1, new_settings[["ed_summary_period"]]) -# message("Warning: With forecast period ", new_settings[["fc_future_period"]], -# " and event detection summary period ", new_settings[["ed_summary_period"]], -# ", the report length has been adjusted to ", new_settings[["report_period"]], ".") -# } -# -# #fc_start_date: date when to start forecasting -# if (is.null(raw_settings[["fc_start_date"]])){ -# # defaults to last known epidemiological data date + one week -# last_known <- max(epi_data[["obs_date"]], na.rm = TRUE) -# new_settings[["fc_start_date"]] <- last_known + lubridate::as.difftime(1, units = "weeks") -# } else { -# #other checks will come later, for now, copy user entry as is over -# new_settings[["fc_start_date"]] <- raw_settings[["fc_start_date"]] -# } -# -# #env_var -- what is listed in env_data, env_ref_data, & env_info -# if (is.null(raw_settings[["env_var"]])){ -# -# #create list of all environmental variables in env_info -# env_info_variables <- dplyr::pull(env_info, !!quo_obsfield) %>% unique() -# -# #create list of all environmental variables in env_ref_data -# env_ref_variables <- dplyr::pull(env_ref_data, !!quo_obsfield) %>% unique() -# -# #env_variables already gen list of env_data -# -# #Two sets of intersection to create list that are present in all three -# env_data_info <- dplyr::intersect(env_variables, env_info_variables) -# default_env_var <- dplyr::intersect(env_data_info, env_ref_variables) -# new_settings[["env_var"]] <- dplyr::tibble(obs_temp = default_env_var) %>% -# #rename NSE fun -# dplyr::rename(!!rlang::quo_name(quo_obsfield) := .data$obs_temp) -# -# #message result -# message("No user supplied list of environmetal variables to use. Using: ", paste(default_env_var, ""), -# " based on presence in env_data, env_ref_data, and env_info.\n") -# } -# -# #nthreads -# #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) -# #if user-supplied, use that cap at 2, otherwise create a default number -# #used to decide if run anomalize_env() prior to forecasting -# if (!is.null(raw_settings[["fc_nthreads"]])) { -# # nthreads above 2 is not actually helpful -# new_settings[["fc_nthreads"]] <- ifelse(raw_settings[["fc_nthreads"]] > 1, 2, 1) -# } else { -# #no value fed in, so test and determine -# new_settings[["fc_nthreads"]] <- ifelse(parallel::detectCores(logical=FALSE) > 1, 2, 1) -# } #end else for ncores not given -# -# -# #fc_clusters -# #default is one cluster, probably not what you actually want for any type of large system -# if (is.null(raw_settings[["fc_clusters"]])){ -# #create tbl of only one cluster -# #groupings already exist as list of geographic groups -# cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% -# #and fix names with NSE -# dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) -# #assign -# new_settings[["fc_clusters"]] <- cluster_tbl -# } -# -# -# # Developer options -# if (is.null(raw_settings[["dev_fc_fit_freq"]])){ -# new_settings[["dev_fc_fit_freq"]] <- "once" -# } -# if (is.null(raw_settings[["dev_fc_modbsplines"]])){ -# new_settings[["dev_fc_modbsplines"]] <- FALSE -# } -# if (is.null(raw_settings[["dev_fc_formula"]])){ -# new_settings[["dev_fc_formula"]] <- NULL -# } -# -# -# new_settings -# -# } -# diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 84a0b68..cfad336 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -134,8 +134,14 @@ #' smooth term based on day of year in the modelling (as one way of accounting #' for seasonality). #' -#' \item \code{fc_nthreads}: The number of parallel threads that can be used by -#' `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. +#' \item \code{fc_splines}: The type of splines that will be used to handle +#' long-term trends and lagged environmental variables. If supplemental package +#' `batchapply` is not installed, the default (and only choice) uses modified +#' b-splines ('modbs'). If the package is installed, then 'tp' becomes an +#' option and the default which uses thin plate splines instead. +#' +#' \item \code{fc_ncores}: The number of physical CPU cores to use for parallel +#' processing for modelling. Only relevant when `fc_splines == 'tp'`. #' #' \item \code{ed_summary_period} = 4: The number of weeks that will be #' considered the "early detection period". It will count back from the week of From 1d5e973056c48196d58777d6aa5d85c801fbcb2c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 3 Jun 2020 03:05:10 -0500 Subject: [PATCH 085/132] Automatic documentation updates --- man/build_equation.Rd | 142 +++++++++++++++++++++++++++++++++++++ man/build_model.Rd | 27 +++---- man/extend_env_future.Rd | 2 +- man/forecast_regression.Rd | 14 +++- man/format_lag_ca.Rd | 23 ++++++ man/lag_environ_to_epi.Rd | 115 ++++++++++++++++++++++++++++-- man/run_epidemia.Rd | 14 +++- man/run_forecast.Rd | 18 +++-- man/run_validation.Rd | 14 +++- man/truncpoly.Rd | 2 +- 10 files changed, 338 insertions(+), 33 deletions(-) create mode 100644 man/build_equation.Rd create mode 100644 man/format_lag_ca.Rd diff --git a/man/build_equation.Rd b/man/build_equation.Rd new file mode 100644 index 0000000..0f78229 --- /dev/null +++ b/man/build_equation.Rd @@ -0,0 +1,142 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/forecasting_main.R +\name{build_equation} +\alias{build_equation} +\title{Create the appropriate regression equation.} +\usage{ +build_equation(quo_groupfield, epi_input, report_settings, n_groupings, + n_clusters, env_variables_used) +} +\arguments{ +\item{quo_groupfield}{Quosure of the user given geographic grouping field to +run_epidemia().} + +\item{epi_input}{Epidemiological dataset with basis spline summaries of the +lagged environmental data (or anomalies), with groupings as a factor, +trimmed to data being used to create the model} + +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. If using a cached model, also set `fc_model_family = + "cached"`. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + variables that are present in all three of env_data, env_ref_data, and + env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. + + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} + +\item{n_groupings}{Count of the number of geographic groups (groupfield) in +total.} + +\item{n_clusters}{Count of the number of clusters in total} + +\item{env_variables_used}{a list of environmental variables that will be used in the +modeling (had to be listed in model variables input file and present the +env_data and env_info datasets)} +} +\value{ +A formula to be used in the regression call, built based on settings + for cyclicals, spline type, and the number of geographic groupings present. +} +\description{ +Create the appropriate regression equation. +} diff --git a/man/build_model.Rd b/man/build_model.Rd index f7098d7..032ed52 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -5,7 +5,7 @@ \title{Build the appropriate model} \usage{ build_model(fc_model_family, quo_groupfield, epi_input, report_settings, - n_groupings, modb_eq, bandsums_eq) + env_variables_used) } \arguments{ \item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to @@ -88,7 +88,9 @@ data and groupings converted to factors.} observation in /code{epi_data}. \item \code{fc_future_period} = 8: Number of future weeks from the end of - the \code{epi_data} to produce forecasts. Default is 8 weeks. + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster id. This clusters, or groups, certain geographic locations together, to @@ -101,8 +103,14 @@ data and groupings converted to factors.} smooth term based on day of year in the modelling (as one way of accounting for seasonality). - \item \code{fc_nthreads}: The number of parallel threads that can be used by - `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of @@ -124,14 +132,9 @@ data and groupings converted to factors.} }} -\item{n_groupings}{Count of the number of geographic groupings in the model.} - -\item{modb_eq}{Pieces of the regression formula that include the modified -basis functions to account for long term trend (with or without groupings, -as appropriate).} - -\item{bandsums_eq}{Pieces of the regression formula that include the b-spline -bandsummaries of the environmental factors.} +\item{env_variables_used}{a list of environmental variables that will be used in the +modeling (had to be listed in model variables input file and present the +env_data and env_info datasets)} } \value{ Regression object diff --git a/man/extend_env_future.Rd b/man/extend_env_future.Rd index 24c1d46..5855a4b 100644 --- a/man/extend_env_future.Rd +++ b/man/extend_env_future.Rd @@ -48,7 +48,7 @@ input "poisson()". If a cached model is being used, set the parameter to \item{groupings}{A unique list of the geographic groupings (from groupfield).} \item{env_variables_used}{List of environmental variables that were used in -the modeling (in `report_settings$env_var` & found in env_data)} +the modeling (in `report_settings$env_var` & found in env_data and env_info)} \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index db397d5..a6f64ef 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -87,7 +87,9 @@ input "poisson()". If a cached model is being used, set the parameter to observation in /code{epi_data}. \item \code{fc_future_period} = 8: Number of future weeks from the end of - the \code{epi_data} to produce forecasts. Default is 8 weeks. + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster id. This clusters, or groups, certain geographic locations together, to @@ -100,8 +102,14 @@ input "poisson()". If a cached model is being used, set the parameter to smooth term based on day of year in the modelling (as one way of accounting for seasonality). - \item \code{fc_nthreads}: The number of parallel threads that can be used by - `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/format_lag_ca.Rd b/man/format_lag_ca.Rd new file mode 100644 index 0000000..d0aa7c2 --- /dev/null +++ b/man/format_lag_ca.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/forecasting_helpers.R +\name{format_lag_ca} +\alias{format_lag_ca} +\title{Formats the environmental data lagged to epidemiology data the way that the +clusterapply package wants.} +\usage{ +format_lag_ca(tbl, env_variables_used) +} +\arguments{ +\item{tbl}{The tibble with all the lagged variables wide and flat.} + +\item{env_variables_used}{Vector of the names of the environmental variables +that are being used in the model.} +} +\value{ +A dataframe with sub-matrices for each of the lagged environmental + variable data. +} +\description{ +Formats the environmental data lagged to epidemiology data the way that the +clusterapply package wants. +} diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index bdaffa2..9bf6959 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -4,8 +4,8 @@ \alias{lag_environ_to_epi} \title{Lag the environmental data.} \usage{ -lag_environ_to_epi(epi_fc, env_fc, quo_groupfield, lag_len, groupings, - env_variables_used) +lag_environ_to_epi(epi_fc, env_fc, quo_groupfield, report_settings, + groupings, env_variables_used) } \arguments{ \item{epi_fc}{An epidemiological dataset extended into the future/forecast @@ -17,9 +17,114 @@ forecasting by epi_format_fc().} \item{quo_groupfield}{Quosure of the user given geographic grouping field to run_epidemia().} -\item{lag_len}{Extract from `report_settings$env_lag_length`. The maximum -number of days in the past to consider interactions between the -environmental variable anomalies and the disease case counts.} +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. If using a cached model, also set `fc_model_family = + "cached"`. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + variables that are present in all three of env_data, env_ref_data, and + env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. + + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} \item{groupings}{A unique list of the geographic groupings (from groupfield).} diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index 07e661a..205925e 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -120,7 +120,9 @@ input "poisson()". If a cached model is being used, set the parameter to observation in /code{epi_data}. \item \code{fc_future_period} = 8: Number of future weeks from the end of - the \code{epi_data} to produce forecasts. Default is 8 weeks. + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster id. This clusters, or groups, certain geographic locations together, to @@ -133,8 +135,14 @@ input "poisson()". If a cached model is being used, set the parameter to smooth term based on day of year in the modelling (as one way of accounting for seasonality). - \item \code{fc_nthreads}: The number of parallel threads that can be used by - `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index a8d4e85..414f960 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -111,7 +111,9 @@ input "poisson()". If a cached model is being used, set the parameter to observation in /code{epi_data}. \item \code{fc_future_period} = 8: Number of future weeks from the end of - the \code{epi_data} to produce forecasts. Default is 8 weeks. + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster id. This clusters, or groups, certain geographic locations together, to @@ -124,8 +126,14 @@ input "poisson()". If a cached model is being used, set the parameter to smooth term based on day of year in the modelling (as one way of accounting for seasonality). - \item \code{fc_nthreads}: The number of parallel threads that can be used by - `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of @@ -164,8 +172,8 @@ fc_res: The forecasted series in report format. env_data_extd: Data set of the environmental data variables extended into the unknown/future. env_variables_used: list of environmental variables that were used in the - modeling (had to be both listed in model variables input file and present the - env_data dataset) + modeling (had to be listed in model variables input file and present the + env_data and env_info datasets) env_dt_ranges: Date ranges of the input environmental data. reg_obj: The regression object from modeling. Unless model_run is TRUE, in which case only the regression object is returned. diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 86c5187..eb3616f 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -149,7 +149,9 @@ input "poisson()". If a cached model is being used, set the parameter to observation in /code{epi_data}. \item \code{fc_future_period} = 8: Number of future weeks from the end of - the \code{epi_data} to produce forecasts. Default is 8 weeks. + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster id. This clusters, or groups, certain geographic locations together, to @@ -162,8 +164,14 @@ input "poisson()". If a cached model is being used, set the parameter to smooth term based on day of year in the modelling (as one way of accounting for seasonality). - \item \code{fc_nthreads}: The number of parallel threads that can be used by - `mgcv::bam()`. Default is 1 for computers with 1 physical core, else 2. + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/truncpoly.Rd b/man/truncpoly.Rd index 17e6f9d..15972e4 100644 --- a/man/truncpoly.Rd +++ b/man/truncpoly.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/forecasting_helpers.R \name{truncpoly} \alias{truncpoly} -\title{Truncates poly. Creates a modified b-spline basis.} +\title{Creates a modified b-spline basis (piecewise polynomial).} \usage{ truncpoly(x = NULL, degree = 6, maxobs = NULL, minobs = NULL) } From a2c2b89ac7cfb0a5be03acfd43b1db437f9d68e8 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 3 Jun 2020 03:05:44 -0500 Subject: [PATCH 086/132] Version bump for clusterapply / thin plate option --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 78c429f..7291015 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: epidemiar Type: Package Title: epidemiar: Create EPIDEMIA Environmentally-Mediated Disease Forecasts -Version: 3.0.0001 +Version: 3.1.0001 Authors@R: c( person(given = c("Dawn", "M"), family = "Nekorchuk", email = "dawn.nekorchuk@ou.edu", role = c("aut", "cre")), @@ -34,6 +34,7 @@ Imports: dplyr (>= 0.8.3), tidyr (>= 0.8.3), zoo (>= 1.8-6) Suggests: + clusterapply, knitr, rmarkdown VignetteBuilder: From 39341ed4110168bbeabf612743ae3ea195af5e93 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 3 Jun 2020 19:03:08 -0500 Subject: [PATCH 087/132] Added spline switch to predict section of modeling. modbs option verified. --- R/forecasting_main.R | 62 ++++++++++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 22 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 8b65c25..55833e9 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -368,7 +368,7 @@ forecast_regression <- function(epi_lag, ## Creating predictions switching point on model choice preds <- create_predictions(fc_model_family, - nthreads = report_settings[["fc_nthreads"]], + report_settings, regress, epi_lag, req_date) @@ -508,15 +508,19 @@ build_model <- function(fc_model_family, epi_input_tp <- format_lag_ca(epi_input, env_variables_used) - # create a cluster for all the functions below to use + # create a cluster for clusterapply to use mycluster <- parallel::makeCluster(min(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) regress <- clusterapply::batch_bam(data = epi_input_tp, - bamargs=list("formula" = reg_eq, - "family" = fc_model_family, - "discrete" = TRUE), - batchvar="cluster_id", - cluster=mycluster) + bamargs = list("formula" = reg_eq, + "family" = fc_model_family, + "discrete" = TRUE), + over = "cluster_id", + cluster = mycluster) + + #stop the cluster (if model run, won't use again, + # so starts and ends for modeling building or predictions) + parallel::stopCluster(mycluster) } #end thin plate @@ -687,7 +691,6 @@ build_equation <- function(quo_groupfield, #'Create the appropriate predictions/forecasts. #' -#'@param nthreads Extract of `report_settings$fc_nthreads` #'@param regress The regression object, either the user-supplied one from #' `report_settings$model_cached`, or the one just generated. #'@param epi_lag Epidemiological dataset with basis spline summaries of the @@ -704,7 +707,7 @@ build_equation <- function(quo_groupfield, #' #' create_predictions <- function(fc_model_family, - nthreads, + report_settings, regress, epi_lag, req_date){ @@ -719,11 +722,6 @@ create_predictions <- function(fc_model_family, #the important part is the forecast / trailing end part #manipulating to be in quasi-same format as the other models return - #cleaning up as not needed, and for bug hunting - epi_lag <- epi_lag %>% - dplyr::select(-dplyr::starts_with("band")) %>% - dplyr::select(-dplyr::starts_with("modbs")) - #regress is a tibble not regression object here # has a variable fit with lag of 1 on known data #epi_lag has the newer rows @@ -769,15 +767,35 @@ create_predictions <- function(fc_model_family, message("Creating predictions...") - #output prediction (through req_date) - preds <- mgcv::predict.bam(regress, - newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), - se.fit = TRUE, # included for backwards compatibility - type="response", - discrete = TRUE, - n.threads = nthreads) + if (report_settings[["fc_splines"]] == "modbs"){ + #output prediction (through req_date) + preds <- mgcv::predict.bam(regress, + newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), + se.fit = TRUE, # included for backwards compatibility + type = "response", + discrete = TRUE, + n.threads = report_settings[["fc_nthreads"]]) + } else if (report_settings[["fc_splines"]] == "tp"){ - } + # create a cluster for clusterapply to use + mycluster <- parallel::makeCluster(min(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) + + preds <- clusterapply::predict.batch_bam(models = regress, + predictargs = list("type"="response"), + over = "cluster_id", + newdata = epi_lag %>% + dplyr::filter(.data$obs_date <= req_date), + cluster = mycluster) + + #stop the cluster + parallel::stopCluster(mycluster) + + + } #end else if fc_splines + + + + } #end else user supplied fc_family } #end create_predictions() From f953d43cab2febd22966195c335ed033162efd0a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 3 Jun 2020 19:03:54 -0500 Subject: [PATCH 088/132] automatically updated documentation --- man/create_predictions.Rd | 112 +++++++++++++++++++++++++++++++++++++- 1 file changed, 110 insertions(+), 2 deletions(-) diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index 25c828b..880c415 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -4,7 +4,8 @@ \alias{create_predictions} \title{Create the appropriate predictions/forecasts.} \usage{ -create_predictions(fc_model_family, nthreads, regress, epi_lag, req_date) +create_predictions(fc_model_family, report_settings, regress, epi_lag, + req_date) } \arguments{ \item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to @@ -15,7 +16,114 @@ link to use in model fitting. E.g. for a Poisson regression, the user would input "poisson()". If a cached model is being used, set the parameter to `"cached"`.} -\item{nthreads}{Extract of `report_settings$fc_nthreads`} +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. If using a cached model, also set `fc_model_family = + "cached"`. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + variables that are present in all three of env_data, env_ref_data, and + env_info. + + \item \code{env_lag_length} = 180: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 180 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. + + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} \item{regress}{The regression object, either the user-supplied one from `report_settings$model_cached`, or the one just generated.} From 4f731fbe50eae57bfe7dd9f0dd40822bd94f3e9b Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 02:56:19 -0500 Subject: [PATCH 089/132] Adjusted default env_lag_length to be consistent with the other defaults based on the Amhara project --- R/input_checks.R | 2 +- R/run_epidemia.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index 86678fe..3845e49 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -409,7 +409,7 @@ input_check <- function(epi_data, } else { #default #maybe make default based on data length, but for now - new_settings[["env_lag_length"]] <- 180 + new_settings[["env_lag_length"]] <- 181 warn_flag <- TRUE warn_msgs <- paste0(warn_msgs, "'report_settings$env_lag_length' was not provided, running with default ", new_settings[["env_lag_length"]], ".\n") diff --git a/R/run_epidemia.R b/R/run_epidemia.R index cfad336..b1d4b8d 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -102,9 +102,9 @@ #' variables that are present in all three of env_data, env_ref_data, and #' env_info. #' -#' \item \code{env_lag_length} = 180: The number of days of past environmental +#' \item \code{env_lag_length} = 181: The number of days of past environmental #' data to include for the lagged effects. The distributed lags are summarized -#' using a thin plate basis function. Default is 180 days. +#' using a thin plate basis function. Default is 181 days. #' #' \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the #' environmental variables should be replaced with their anomalies. The From d67c7ccd437674a5f9baba9d551b939a7d77a4c0 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 02:57:08 -0500 Subject: [PATCH 090/132] Errors/stops now if requested thin plate but clusterapply not installed/available rather than a warning and run with modbs. This should be a hard stop. --- R/input_checks.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index 3845e49..beb9ff5 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -495,13 +495,12 @@ input_check <- function(epi_data, default_splines, ".\n") default_splines }) - #override tp if batchapply is not installed/available + #stop/error if requested tp if batchapply is not installed/available if (new_settings[["fc_splines"]] == "tp" & !batchbam_ok){ - warn_flag <- TRUE - warn_msgs <- paste0(warn_msgs, "User requested thin plate splines (fc_splines = 'tp'),", + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "User requested thin plate splines (fc_splines = 'tp'),", "but package clusterapply is not installed/available. ", - "Running with modified b-splines ('modbs').\n") - new_settings[["fc_splines"]] <- "modbs" + "Try running with modified b-splines ('modbs') instead.\n") } From 1370616bc211272709c5b9000e1a91949eb3605e Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 02:57:45 -0500 Subject: [PATCH 091/132] Added missing lag column-matrix to dataframe being given to clusterapply::batch_bam. --- R/forecasting_helpers.R | 17 ++++++++++++++++- R/forecasting_main.R | 3 ++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index e3307a5..67d50a5 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -648,10 +648,14 @@ truncpoly <- function(x = NULL, degree = 6, maxobs = NULL, minobs = NULL){ #'@param env_variables_used Vector of the names of the environmental variables #' that are being used in the model. #' +#'@inheritParams run_forecast +#' #'@return A dataframe with sub-matrices for each of the lagged environmental #' variable data. #' -format_lag_ca <- function(tbl, env_variables_used){ +format_lag_ca <- function(tbl, + env_variables_used, + report_settings){ #initialize #vector to collect all lagged environmental column names @@ -682,6 +686,17 @@ format_lag_ca <- function(tbl, env_variables_used){ dplyr::select(-all_lag_cols) %>% as.data.frame() + #create lag matrix (days of lag) + #next column after vars + index_lag <- length(env_variables_used) + 1 + collecting_df[,index_lag] <- matrix(data = rep(0:(report_settings[["env_lag_length"]]-1), + times = nrow(tbl)), + nrow = nrow(tbl), + ncol = report_settings[["env_lag_length"]], + byrow = TRUE) + colnames(collecting_df[,index_lag]) <- 0:(report_settings[["env_lag_length"]] - 1) + names(collecting_df)[index_lag] <- "lag" + #column bind the non-lagged with the submatrix-filled dataframe dfm <- cbind(front_df, collecting_df) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 55833e9..21bda2f 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -506,7 +506,8 @@ build_model <- function(fc_model_family, #tibble to dataframe, and turn all env wide data into each own sub matrix epi_input_tp <- format_lag_ca(epi_input, - env_variables_used) + env_variables_used, + report_settings) # create a cluster for clusterapply to use mycluster <- parallel::makeCluster(min(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) From 3959582c6cc1fb7c6a646287df816996e0f55f88 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 02:58:08 -0500 Subject: [PATCH 092/132] Autogenerated documentation updates --- man/build_equation.Rd | 4 +- man/build_model.Rd | 4 +- man/create_predictions.Rd | 4 +- man/forecast_regression.Rd | 4 +- man/format_lag_ca.Rd | 111 ++++++++++++++++++++++++++++++++++++- man/lag_environ_to_epi.Rd | 4 +- man/run_epidemia.Rd | 4 +- man/run_forecast.Rd | 4 +- man/run_validation.Rd | 4 +- 9 files changed, 126 insertions(+), 17 deletions(-) diff --git a/man/build_equation.Rd b/man/build_equation.Rd index 0f78229..3dec26e 100644 --- a/man/build_equation.Rd +++ b/man/build_equation.Rd @@ -63,9 +63,9 @@ trimmed to data being used to create the model} variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The diff --git a/man/build_model.Rd b/man/build_model.Rd index 032ed52..49f0a55 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -71,9 +71,9 @@ data and groupings converted to factors.} variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index 880c415..8625df6 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -64,9 +64,9 @@ input "poisson()". If a cached model is being used, set the parameter to variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index a6f64ef..40ff7ee 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -70,9 +70,9 @@ input "poisson()". If a cached model is being used, set the parameter to variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The diff --git a/man/format_lag_ca.Rd b/man/format_lag_ca.Rd index d0aa7c2..c5ca450 100644 --- a/man/format_lag_ca.Rd +++ b/man/format_lag_ca.Rd @@ -5,13 +5,122 @@ \title{Formats the environmental data lagged to epidemiology data the way that the clusterapply package wants.} \usage{ -format_lag_ca(tbl, env_variables_used) +format_lag_ca(tbl, env_variables_used, report_settings) } \arguments{ \item{tbl}{The tibble with all the lagged variables wide and flat.} \item{env_variables_used}{Vector of the names of the environmental variables that are being used in the model.} + +\item{report_settings}{This is a named list of all the report, forecasting, + event detection and other settings. All of these have defaults, but they are + not likely the defaults needed for your system, so each of these should be + reviewed: + + \itemize{ + + \item \code{report_period} = 26: The number of weeks that the entire report + will cover. The \code{report_period} minus \code{fc_future_period} is the + number of weeks of past (known) data that will be included. Default is 26 + weeks. + + \item \code{report_value_type} = "cases": How to report the results, either + in terms of "cases" (default) or "incidence". + + \item \code{report_inc_per} = 1000: If reporting incidence, what should be + denominator be? Default is per 1000 persons. + + \item \code{epi_date_type} = "weekISO": String indicating the standard (WHO + ISO-8601 or CDC epi weeks) that the weeks of the year in epidemiological and + environmental reference data use ("weekISO" or "weekCDC"). Required: + epidemiological observation dates listed are LAST day of week. + + \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given + epidemiological data be linearly interpolated for any explicitly missing + values before modeling? Note: epidemiological data cannot have implicit + missing data (missing row as opposed to a row with NA). + + \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate + the model regression object plus metadata. This model can be cached and used + later on its own, skipping a large portion of the slow calculations for + future runs. + + \item \code{model_cached} = NULL: The output of a previous model_run = TRUE + run of run_epidemia() that produces a model (regression object) and + metadata. The metadata will be used for input checking and validation. Using + a prebuilt model saves on processing time, but will need to be updated + periodically. If using a cached model, also set `fc_model_family = + "cached"`. + + \item \code{env_var}: List environmental variables to actually use in the + modelling. (You can therefore have extra variables or data in the + environmental dataset.) Input should be a one column tibble, header row as + `obsfield` and each row with entries of the variables (must match what is in + env_data, env_ref-data, and env_info). Default is to use all environmental + variables that are present in all three of env_data, env_ref_data, and + env_info. + + \item \code{env_lag_length} = 181: The number of days of past environmental + data to include for the lagged effects. The distributed lags are summarized + using a thin plate basis function. Default is 181 days. + + \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the + environmental variables should be replaced with their anomalies. The + variables were transformed by taking the residuals from a GAM with + geographic unit and cyclical cubic regression spline on day of year per + geographic group. + + \item \code{fc_start_date}: The date to start the forecasting, also the + start of the early warning period. Epidemiological data does not have to + exist just before the start date, though higher accuracy will be obtained + with more recent data. The default is the week following the last known + observation in /code{epi_data}. + + \item \code{fc_future_period} = 8: Number of future weeks from the end of + the \code{epi_data} to produce forecasts, or if fc_start_date is set, the + number of weeks from and including the start date to create forecasts. + Synonymous with early warning period. Default is 8 weeks. + + \item \code{fc_clusters}: Dataframe/tible of geographic units and a cluster + id. This clusters, or groups, certain geographic locations together, to + better model when spatial non-stationarity in the relationship between + environmental variables and cases. See the overview and data & mdoeling + vignettes for more discussion. Default is a global model, all geographic + units in one cluster. + + \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a + smooth term based on day of year in the modelling (as one way of accounting + for seasonality). + + \item \code{fc_splines}: The type of splines that will be used to handle + long-term trends and lagged environmental variables. If supplemental package + `batchapply` is not installed, the default (and only choice) uses modified + b-splines ('modbs'). If the package is installed, then 'tp' becomes an + option and the default which uses thin plate splines instead. + + \item \code{fc_ncores}: The number of physical CPU cores to use for parallel + processing for modelling. Only relevant when `fc_splines == 'tp'`. + + \item \code{ed_summary_period} = 4: The number of weeks that will be + considered the "early detection period". It will count back from the week of + last known epidemiological data. Default is 4 weeks. + + \item \code{ed_method} = 'none': Which method for early detection should be + used ("farrington" is only current option, or "none"). + + \item \code{ed_control} = Controls passed along to the event detection + method. E.g. for `ed_method = 'farrington'`, these are passed to + \code{\link[surveillance:farringtonFlexible]{surveillance::farringtonFlexible()}}. + Currently, these parameters are supported for Farrington: `b`, `w`, + `reweight`, `weightsThreshold`, `trend`, `pThresholdTrend`, + `populationOffset`, `noPeriods`, `pastWeeksNotIncluded`, `thresholdMethod`. + Any control not included will use surveillance package defaults, with the + exception of `b`, the number of past years to include: epidemiar default is + to use as many years are available in the data. + + + }} } \value{ A dataframe with sub-matrices for each of the lagged environmental diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index 9bf6959..ac0af12 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -65,9 +65,9 @@ run_epidemia().} variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index 205925e..b6efbd8 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -103,9 +103,9 @@ input "poisson()". If a cached model is being used, set the parameter to variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index 414f960..1fc3e16 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -94,9 +94,9 @@ input "poisson()". If a cached model is being used, set the parameter to variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The diff --git a/man/run_validation.Rd b/man/run_validation.Rd index eb3616f..332aa3f 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -132,9 +132,9 @@ input "poisson()". If a cached model is being used, set the parameter to variables that are present in all three of env_data, env_ref_data, and env_info. - \item \code{env_lag_length} = 180: The number of days of past environmental + \item \code{env_lag_length} = 181: The number of days of past environmental data to include for the lagged effects. The distributed lags are summarized - using a thin plate basis function. Default is 180 days. + using a thin plate basis function. Default is 181 days. \item \code{env_anomalies} = FALSE: TRUE/FALSE indicating if the environmental variables should be replaced with their anomalies. The From 9b4c69905e0859edaa46595b5f192f35d3135dc6 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 14:05:50 -0500 Subject: [PATCH 093/132] Fix for makeCluster settings and separated out cluster names for clarity --- R/forecasting_main.R | 12 ++++++------ R/input_checks.R | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 21bda2f..15d1f10 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -510,18 +510,18 @@ build_model <- function(fc_model_family, report_settings) # create a cluster for clusterapply to use - mycluster <- parallel::makeCluster(min(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) + bb_cluster <- parallel::makeCluster(max(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) regress <- clusterapply::batch_bam(data = epi_input_tp, bamargs = list("formula" = reg_eq, "family" = fc_model_family, "discrete" = TRUE), over = "cluster_id", - cluster = mycluster) + cluster = bb_cluster) #stop the cluster (if model run, won't use again, # so starts and ends for modeling building or predictions) - parallel::stopCluster(mycluster) + parallel::stopCluster(bb_cluster) } #end thin plate @@ -780,17 +780,17 @@ create_predictions <- function(fc_model_family, } else if (report_settings[["fc_splines"]] == "tp"){ # create a cluster for clusterapply to use - mycluster <- parallel::makeCluster(min(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) + pred_cluster <- parallel::makeCluster(max(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) preds <- clusterapply::predict.batch_bam(models = regress, predictargs = list("type"="response"), over = "cluster_id", newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), - cluster = mycluster) + cluster = pred_cluster) #stop the cluster - parallel::stopCluster(mycluster) + parallel::stopCluster(pred_cluster) } #end else if fc_splines diff --git a/R/input_checks.R b/R/input_checks.R index beb9ff5..62a0d5a 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -510,7 +510,7 @@ input_check <- function(epi_data, } else { #calc default #detectCores can return NA, so catch - new_settings[["fc_ncores"]] <- min(parallel::detectCores(logical=FALSE), + new_settings[["fc_ncores"]] <- max(parallel::detectCores(logical=FALSE), 1, na.rm = TRUE) } From 41fdf62a6bcbc3ecf53a6dafda6c5e6a9b07d7f8 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 14:06:11 -0500 Subject: [PATCH 094/132] Need latest mgcv for clusterapply to work properly. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7291015..abe249a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ Imports: dplyr (>= 0.8.3), lubridate (>= 1.7.4), MASS, magrittr (>= 1.5), - mgcv (>= 1.8-28), + mgcv (>= 1.8-31), parallel (>= 3.6.1), pracma (>= 2.2.5), readr (>= 1.3.1), From b47608707558f27f17c8878e8bf3833b9a5e7344 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 14:26:06 -0500 Subject: [PATCH 095/132] Removed unused inheritParams. --- R/make_date_yw.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/make_date_yw.R b/R/make_date_yw.R index c98576b..55b09e6 100644 --- a/R/make_date_yw.R +++ b/R/make_date_yw.R @@ -15,9 +15,6 @@ #' reference data use ["ISO" or "CDC"]. (Required: epidemiological observation #' dates listed are LAST day of week).#' #' -#' @inheritParams lubridate::isoweek -#' @inheritParams lubridate::epiweek -#' #' @inherit lubridate::isoweek references #' @inherit lubridate::epiweek references #' From 8c2f3f37b0c330939d2a77ea20a84bf316d58286 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 4 Jun 2020 14:37:42 -0500 Subject: [PATCH 096/132] Updated roxygen version; automatic documentation updates --- DESCRIPTION | 2 +- man/build_equation.Rd | 10 ++++++++-- man/build_model.Rd | 9 +++++++-- man/create_predictions.Rd | 9 +++++++-- man/env_daily_to_ref.Rd | 10 ++++++++-- man/environ_report_format.Rd | 12 ++++++++++-- man/extend_env_future.Rd | 17 ++++++++++++++--- man/extend_epi_future.Rd | 9 +++++++-- man/forecast_regression.Rd | 12 ++++++++++-- man/input_check.Rd | 18 +++++++++++++++--- man/lag_environ_to_epi.Rd | 10 ++++++++-- man/run_epidemia.Rd | 17 +++++++++++++---- man/run_event_detection.Rd | 13 +++++++++++-- man/run_farrington.Rd | 12 ++++++++++-- man/run_forecast.Rd | 19 ++++++++++++++++--- man/run_validation.Rd | 27 ++++++++++++++++++++------- man/stss_res_to_output_data.Rd | 12 ++++++++++-- 17 files changed, 175 insertions(+), 43 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index abe249a..95a69cb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,7 @@ Description: The Epidemic Prognosis Incorporating Disease and Environmental Moni License: MIT + file LICENSE Encoding: UTF-8 LazyData: true -RoxygenNote: 6.1.1 +RoxygenNote: 7.1.0 Imports: dplyr (>= 0.8.3), glue (>= 1.3.1), lubridate (>= 1.7.4), diff --git a/man/build_equation.Rd b/man/build_equation.Rd index 3dec26e..7802367 100644 --- a/man/build_equation.Rd +++ b/man/build_equation.Rd @@ -4,8 +4,14 @@ \alias{build_equation} \title{Create the appropriate regression equation.} \usage{ -build_equation(quo_groupfield, epi_input, report_settings, n_groupings, - n_clusters, env_variables_used) +build_equation( + quo_groupfield, + epi_input, + report_settings, + n_groupings, + n_clusters, + env_variables_used +) } \arguments{ \item{quo_groupfield}{Quosure of the user given geographic grouping field to diff --git a/man/build_model.Rd b/man/build_model.Rd index 49f0a55..9958371 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -4,8 +4,13 @@ \alias{build_model} \title{Build the appropriate model} \usage{ -build_model(fc_model_family, quo_groupfield, epi_input, report_settings, - env_variables_used) +build_model( + fc_model_family, + quo_groupfield, + epi_input, + report_settings, + env_variables_used +) } \arguments{ \item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index 8625df6..e6ddd1c 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -4,8 +4,13 @@ \alias{create_predictions} \title{Create the appropriate predictions/forecasts.} \usage{ -create_predictions(fc_model_family, report_settings, regress, epi_lag, - req_date) +create_predictions( + fc_model_family, + report_settings, + regress, + epi_lag, + req_date +) } \arguments{ \item{fc_model_family}{The \code{\link[stats]{family}} parameter passsed to diff --git a/man/env_daily_to_ref.Rd b/man/env_daily_to_ref.Rd index 764cfc4..4160123 100644 --- a/man/env_daily_to_ref.Rd +++ b/man/env_daily_to_ref.Rd @@ -4,8 +4,14 @@ \alias{env_daily_to_ref} \title{Create historical reference data from daily environmental datasets.} \usage{ -env_daily_to_ref(daily_env_data, groupfield, obsfield, valuefield, - week_type = c("ISO", "CDC"), env_info) +env_daily_to_ref( + daily_env_data, + groupfield, + obsfield, + valuefield, + week_type = c("ISO", "CDC"), + env_info +) } \arguments{ \item{daily_env_data}{Daily environmental data. Must be in long format - one diff --git a/man/environ_report_format.Rd b/man/environ_report_format.Rd index e437e15..177f8a2 100644 --- a/man/environ_report_format.Rd +++ b/man/environ_report_format.Rd @@ -4,8 +4,16 @@ \alias{environ_report_format} \title{Formats environmental data for report timeseries.} \usage{ -environ_report_format(env_ext_data, env_ref_data, quo_groupfield, - quo_obsfield, env_used, env_info, epi_date_type, report_dates) +environ_report_format( + env_ext_data, + env_ref_data, + quo_groupfield, + quo_obsfield, + env_used, + env_info, + epi_date_type, + report_dates +) } \arguments{ \item{env_ext_data}{An environmental dataset extended into the diff --git a/man/extend_env_future.Rd b/man/extend_env_future.Rd index 5855a4b..e0bb6d9 100644 --- a/man/extend_env_future.Rd +++ b/man/extend_env_future.Rd @@ -4,9 +4,20 @@ \alias{extend_env_future} \title{Extend environmental data into the future.} \usage{ -extend_env_future(env_data, quo_groupfield, quo_obsfield, quo_valuefield, - env_ref_data, env_info, fc_model_family, epi_date_type, valid_run, - groupings, env_variables_used, report_dates) +extend_env_future( + env_data, + quo_groupfield, + quo_obsfield, + quo_valuefield, + env_ref_data, + env_info, + fc_model_family, + epi_date_type, + valid_run, + groupings, + env_variables_used, + report_dates +) } \arguments{ \item{env_data}{Daily environmental data for the same groupfields and date diff --git a/man/extend_epi_future.Rd b/man/extend_epi_future.Rd index e575358..4343579 100644 --- a/man/extend_epi_future.Rd +++ b/man/extend_epi_future.Rd @@ -4,8 +4,13 @@ \alias{extend_epi_future} \title{Extend epidemiology dataframe into future.} \usage{ -extend_epi_future(epi_data, quo_popfield, quo_groupfield, groupings, - report_dates) +extend_epi_future( + epi_data, + quo_popfield, + quo_groupfield, + groupings, + report_dates +) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index 40ff7ee..85ba982 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -4,8 +4,16 @@ \alias{forecast_regression} \title{Run forecast regression} \usage{ -forecast_regression(epi_lag, quo_groupfield, fc_model_family, - report_settings, groupings, env_variables_used, report_dates, req_date) +forecast_regression( + epi_lag, + quo_groupfield, + fc_model_family, + report_settings, + groupings, + env_variables_used, + report_dates, + req_date +) } \arguments{ \item{epi_lag}{Epidemiological dataset with basis spline summaries of the diff --git a/man/input_check.Rd b/man/input_check.Rd index f67abef..0e40439 100644 --- a/man/input_check.Rd +++ b/man/input_check.Rd @@ -4,9 +4,21 @@ \alias{input_check} \title{Functions to check input to epidemiar and set report settings defaults.} \usage{ -input_check(epi_data, env_data, env_ref_data, env_info, quo_casefield, - quo_popfield, quo_groupfield, quo_obsfield, quo_valuefield, - fc_model_family, raw_settings, groupings, env_variables) +input_check( + epi_data, + env_data, + env_ref_data, + env_info, + quo_casefield, + quo_popfield, + quo_groupfield, + quo_obsfield, + quo_valuefield, + fc_model_family, + raw_settings, + groupings, + env_variables +) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index ac0af12..d0bcd8e 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -4,8 +4,14 @@ \alias{lag_environ_to_epi} \title{Lag the environmental data.} \usage{ -lag_environ_to_epi(epi_fc, env_fc, quo_groupfield, report_settings, - groupings, env_variables_used) +lag_environ_to_epi( + epi_fc, + env_fc, + quo_groupfield, + report_settings, + groupings, + env_variables_used +) } \arguments{ \item{epi_fc}{An epidemiological dataset extended into the future/forecast diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index b6efbd8..5fff12d 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -4,10 +4,19 @@ \alias{run_epidemia} \title{Run EPIDEMIA forecast models and early detection algorithm.} \usage{ -run_epidemia(epi_data = NULL, env_data = NULL, env_ref_data = NULL, - env_info = NULL, casefield = NULL, groupfield = NULL, - populationfield = NULL, obsfield = NULL, valuefield = NULL, - fc_model_family = NULL, report_settings = NULL) +run_epidemia( + epi_data = NULL, + env_data = NULL, + env_ref_data = NULL, + env_info = NULL, + casefield = NULL, + groupfield = NULL, + populationfield = NULL, + obsfield = NULL, + valuefield = NULL, + fc_model_family = NULL, + report_settings = NULL +) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date diff --git a/man/run_event_detection.Rd b/man/run_event_detection.Rd index 483b117..f295c5e 100644 --- a/man/run_event_detection.Rd +++ b/man/run_event_detection.Rd @@ -4,8 +4,17 @@ \alias{run_event_detection} \title{Main subfunction for running event detection algorithm.} \usage{ -run_event_detection(epi_fc_data, quo_groupfield, quo_popfield, ed_method, - ed_control, val_type, inc_per, groupings, report_dates) +run_event_detection( + epi_fc_data, + quo_groupfield, + quo_popfield, + ed_method, + ed_control, + val_type, + inc_per, + groupings, + report_dates +) } \arguments{ \item{epi_fc_data}{Internal pass of epidemiological data complete with future diff --git a/man/run_farrington.Rd b/man/run_farrington.Rd index 6c2d185..5d32b9d 100644 --- a/man/run_farrington.Rd +++ b/man/run_farrington.Rd @@ -4,8 +4,16 @@ \alias{run_farrington} \title{Run the Farrington early detection algorithm} \usage{ -run_farrington(epi_fc_data, quo_groupfield, quo_popfield, ed_control, - val_type, inc_per, groupings, report_dates) +run_farrington( + epi_fc_data, + quo_groupfield, + quo_popfield, + ed_control, + val_type, + inc_per, + groupings, + report_dates +) } \arguments{ \item{epi_fc_data}{Internal pass of epidemiological data complete with future diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index 1fc3e16..4f7f2a1 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -4,9 +4,22 @@ \alias{run_forecast} \title{Runs the forecast modeling} \usage{ -run_forecast(epi_data, quo_popfield, quo_groupfield, env_data, - quo_obsfield, quo_valuefield, env_ref_data, env_info, fc_model_family, - report_settings, valid_run, groupings, env_variables, report_dates) +run_forecast( + epi_data, + quo_popfield, + quo_groupfield, + env_data, + quo_obsfield, + quo_valuefield, + env_ref_data, + env_info, + fc_model_family, + report_settings, + valid_run, + groupings, + env_variables, + report_dates +) } \arguments{ \item{epi_data}{Epidemiological data with case numbers per week, with date diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 332aa3f..430c5f1 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -4,13 +4,26 @@ \alias{run_validation} \title{Run EPIDEMIA model validation statistics} \usage{ -run_validation(date_start = NULL, total_timesteps = 26, - timesteps_ahead = 2, reporting_lag = 0, per_timesteps = 12, - skill_test = TRUE, epi_data = NULL, env_data = NULL, - env_ref_data = NULL, env_info = NULL, casefield = NULL, - groupfield = NULL, populationfield = NULL, obsfield = NULL, - valuefield = NULL, fc_model_family = NULL, report_settings = NULL, - ...) +run_validation( + date_start = NULL, + total_timesteps = 26, + timesteps_ahead = 2, + reporting_lag = 0, + per_timesteps = 12, + skill_test = TRUE, + epi_data = NULL, + env_data = NULL, + env_ref_data = NULL, + env_info = NULL, + casefield = NULL, + groupfield = NULL, + populationfield = NULL, + obsfield = NULL, + valuefield = NULL, + fc_model_family = NULL, + report_settings = NULL, + ... +) } \arguments{ \item{date_start}{Date to start testing for model validation.} diff --git a/man/stss_res_to_output_data.Rd b/man/stss_res_to_output_data.Rd index 26197b2..beace3c 100644 --- a/man/stss_res_to_output_data.Rd +++ b/man/stss_res_to_output_data.Rd @@ -4,8 +4,16 @@ \alias{stss_res_to_output_data} \title{Formats output data from sts result objects} \usage{ -stss_res_to_output_data(stss_res_list, epi_fc_data, quo_groupfield, - quo_popfield, val_type, inc_per, groupings, report_dates) +stss_res_to_output_data( + stss_res_list, + epi_fc_data, + quo_groupfield, + quo_popfield, + val_type, + inc_per, + groupings, + report_dates +) } \arguments{ \item{stss_res_list}{List of sts output object from Farrington algorithm.} From 23f6fa3bf7e6e61e24e074b93995e2c36d8ad20b Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 8 Jun 2020 13:38:40 -0500 Subject: [PATCH 097/132] Corrected environmental data missing row input check to only be between date needed for environmental lag length and the start of the report. (I.e. earlier data doesn't matter.) --- R/input_checks.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index 62a0d5a..aa56ba1 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -426,16 +426,16 @@ input_check <- function(epi_data, #get earliest dates available env_start_dts <- env_model_data %>% dplyr::group_by(!!quo_obsfield) %>% dplyr::summarize(start_dt = min(.data$obs_date)) #date needed by laglength and first epidemiological data date - need_dt <- min(epi_data$obs_date) - as.difftime(new_settings[["env_lag_length"]], units = "days") + lag_need_dt <- min(epi_data$obs_date) - as.difftime(new_settings[["env_lag_length"]], units = "days") #all env dates equal or before needed date? - if (!all(env_start_dts$start_dt <= need_dt)){ + if (!all(env_start_dts$start_dt <= lag_need_dt)){ err_flag <- TRUE err_msgs <- paste0(err_msgs, "Not enough environmental data for a lag length of ", new_settings[["env_lag_length"]], "days.\n Epidemiological start is", min(epi_data$obs_date), - "therefore environmental data is needed starting", need_dt, + "therefore environmental data is needed starting", lag_need_dt, "for variables:", - env_start_dts[which(!env_start_dts$start_dt <= need_dt),1], + env_start_dts[which(!env_start_dts$start_dt <= lag_need_dt),1], ".\n") } @@ -451,6 +451,8 @@ input_check <- function(epi_data, pre_env_check <- env_data %>% #only pre-report data check dplyr::filter(.data$obs_date < report_start_date) %>% + #and only after needed date for lag length (earlier entries don't matter) + dplyr::filter(.data$obs_date >= lag_need_dt) %>% #field for error message dplyr::mutate(group_obs = paste0(!!quo_groupfield, "-", !!quo_obsfield)) %>% #calc number of rows, should be the same for all if no missing rows From fd7c24a28dfd1a0ab510e5641429cbdb7c1db2d3 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 8 Jun 2020 13:39:32 -0500 Subject: [PATCH 098/132] Added explicit na.pass statement in the predict.bam function call, as it is assumed we get the same number of rows returned (i.e. we do a column bind). --- R/forecasting_main.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 15d1f10..557c2ab 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -775,7 +775,11 @@ create_predictions <- function(fc_model_family, se.fit = TRUE, # included for backwards compatibility type = "response", discrete = TRUE, - n.threads = report_settings[["fc_nthreads"]]) + n.threads = report_settings[["fc_nthreads"]], + #default, and environmental predictors should not be NA + #but setting explicit since it is assumed to return + # the same number of rows as in newdata + na.action = stats::na.pass) } else if (report_settings[["fc_splines"]] == "tp"){ From aa54ec139bab6f522e1c5d75853e7502122568a0 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Mon, 8 Jun 2020 18:53:01 -0500 Subject: [PATCH 099/132] Documentation and vignette updates for thin plate splines --- R/forecasting_main.R | 4 ++-- R/run_epidemia.R | 2 +- doc/data-modeling.Rmd | 8 +++++--- doc/overview-epidemiar.Rmd | 30 ++++++++++++------------------ vignettes/data-modeling.Rmd | 6 ++++-- vignettes/overview-epidemiar.Rmd | 30 ++++++++++++------------------ 6 files changed, 36 insertions(+), 44 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 557c2ab..0d03781 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -481,8 +481,6 @@ build_model <- function(fc_model_family, n_clusters, env_variables_used) } - } #end else user supplied family - #run the regression if (report_settings[["fc_splines"]] == "modbs"){ @@ -525,6 +523,8 @@ build_model <- function(fc_model_family, } #end thin plate + } #end else user supplied family + } # end build_model() diff --git a/R/run_epidemia.R b/R/run_epidemia.R index b1d4b8d..475f34a 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -141,7 +141,7 @@ #' option and the default which uses thin plate splines instead. #' #' \item \code{fc_ncores}: The number of physical CPU cores to use for parallel -#' processing for modelling. Only relevant when `fc_splines == 'tp'`. +#' processing for modelling (default use is ncores - 1). #' #' \item \code{ed_summary_period} = 4: The number of weeks that will be #' considered the "early detection period". It will count back from the week of diff --git a/doc/data-modeling.Rmd b/doc/data-modeling.Rmd index feccd20..389d3b9 100644 --- a/doc/data-modeling.Rmd +++ b/doc/data-modeling.Rmd @@ -55,6 +55,7 @@ When calling the epidemiar function: * `groupfield`: Give the field name for districts or area divisions of epidemiological AND environmental data. If there are no groupings (all one area), user should give a field with the same value throughout the entire datasets. In the `report_settings` there is an additional parameters for epidemiological settings: + * `report_settings$epi_date_type`: For the `obs_date` in `epi_data`, you need to specify if you are using "weekCDC" epiweeks, or ISO-8601 ("weekISO") standard weeks of the year (what WHO uses). The default setting is "weekISO". The date should be the _last_ day of the epidemiological week. @@ -125,10 +126,11 @@ Many of the settings are bundled into the named list `report_settings` argument. Besides `fc_model_family`, the rest of the forecasting controls (along with other settings) are bundled into the named list `report_settings`: * `report_settings$fc_start_date`: Option to set a custom date for when forecasting (i.e. `report_settings$fc_future_period`) begins. Default is one week past the last known/observed epidemiological data date. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section if the `report_settings$fc_start_date` is more than `report_settings$ed_summary_period` weeks after known/observed epidemiological data. -* `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks. +* `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks without known environmental data. * `report_settings$fc_clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. The default is a global model (one cluster), which is the equivalent to `fc_clusters` having each entry for the geographic group contains the same "cluster_id" value. If you only have one geographic group, this would contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). Neither global model or individual model are recommended for large numbers of geographic groups, or for geographic groups in different environmental contexts. See overview vignette for more discussion. +* `report_settings$fc_splines`: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package `batchapply` is installed, the default 'tp' uses thin plate splines. If the package is not installed, then it uses modified b-splines ('modbs'). * `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE (no cyclicals). -* `report_settings$fc_nthreads`: For the number of threads argument for parallel processing in modelling. Either 1 or 2, if multiple cores are present. +* `report_settings$fc_ncores`: The number of physical CPU cores on the machine. Default is to use this number minus 1 as available to use for parallel processing for modelling. If not set, it will attempt to detect this on its own. Environmental data-related forecasting settings: @@ -143,7 +145,7 @@ The event detection settings are also bundled into the named list `report_settin * `report_settings$ed_method`: At the moment, the only choices are "farrington" for the Farrington improved algorithm as implemented in the `surveillance` package, or "none". * `report_settings$ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `report_settings$ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. Default is 4 weeks. -* `report_settings$ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. If the other parameters are not set, the defaults from the surveillance package will be used. +* `report_settings$ed_control`: This is a list of parameters that are handed to the `farringtonFlexible()` function from the `surveillance` package as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. If the other parameters are not set, the defaults from the surveillance package will be used. ## Setting up Model Input (Optional) diff --git a/doc/overview-epidemiar.Rmd b/doc/overview-epidemiar.Rmd index 4fe58f6..f9c1a5a 100644 --- a/doc/overview-epidemiar.Rmd +++ b/doc/overview-epidemiar.Rmd @@ -67,7 +67,7 @@ The main requirements for using this package are: # Modeling Overview -The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality,and clustering of geographic groups. +The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality, and clustering of geographic groups. The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). @@ -82,16 +82,12 @@ However, it is also possible to specify a custom forecast start date (the equiva Each geographic group, $geo$, identified in the `groupfield` column is included as a factor. -To capture any long term trends per geographic group, $geo$ is multipled by each of 5 modified basis splines: $bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo$. -The modified basis splines are created within the function as follows: +Each geographic group also has a long term trend component. The long-term trend (and the lagged environmental data, see below) has two options. -1. First, `splines::bs()` is used to create basis splines over the range of observations with degree 6. -2. To reduce the edge effects of using splines, the following modifications are performed: - - the last basis spline function is reverse, and - - the second to last basis spline function is removed. +Option 1) With the installation of a companion package (`batchapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `batchapply` is installed). - +Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), where $geo$ is multipled by each of 5 modified basis splines: $bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo$. +The modified basis splines are created by first using `splines::bs()` to create basis splines over the range of observations with degree 6. Then to reduce the edge effects of using splines, the following modifications are performed: the last basis spline function is reverse, and the second to last basis spline function is removed. There is a an option to explicitly include a cyclical for account for seasonality. If `report_settings$fc_cyclical` is set to TRUE (default is FALSE), a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ @@ -100,15 +96,11 @@ There is a an option to explicitly include a cyclical for account for seasonalit The rates of environmentally-mediated infectious diseases can be influenced by the environmental factors via a range of potential mechanisms, e.g. affecting the abundance and life cycle of disease vectors. The influences on disease generally lags behind the changes in the environmental covariates. -In the modeling controls, the user selects the maximum number of days in the past (`report_settings$env_lag_length`, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. - - +In the modeling controls, the user selects the maximum number of days in the past (`report_settings$env_lag_length`, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. These are then used in modeling per cluster, see next section for details. In our modeling options, it is possible to specify that the _anomalies_ of the environmental covariates are used as factors (`fc_control$env_anomalies = TRUE`, the default is false to run with raw actual values). In some case, you may want to look at the influence of deviation from normal in the environmental factors to help explain deviations from normal in the disease cases. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group: $geo + s(doy, bs="cc", by=geo)$ - ## Clusters The relationship between environmental drivers and the case burden of the environmentally-mediated disease can vary with geographically, due to ecological, social or other geographic factors. This potential spatial non-stationarity could be handled in a number of ways. @@ -119,10 +111,12 @@ On the other extreme, you could run separate models for each geographic group (e We allow the user to identify their own clusters of geographic units with `report_settings$fc_clusters`, a table of geographic unit and a cluster id (see data vignette for full format details). The clustering determination can be done prior however the user chooses - for example, global model, individual models, clustering by ecological zones, or by identifying similar temporal disease patterns. By default, without information in `fc_clusters`, the model will run as a global model (one cluster). +For modeling the lagged environmental drivers by cluster, there are two options: + +Option 1) With the installation of a companion package (`batchapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `batchapply` is installed). The `batchapply` package is our wrapper over some of the mgcv functions so that we can use thin plate splines for each lagged environmental variable by cluster. + +Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), a distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of lag length, for every combination of group, week, and environmental anomaly covariate. - ## Model Caching Option @@ -135,7 +129,7 @@ Once a model has been generated, it can be fed back into `run_epidemiar()` with The central idea behind outbreak detection is to identify when the case volume exceeds a baseline threshold, and to use this information in a prospective (not retrospective) manner to identify epidemics in their early stages. -Currently, epidemiar supports the Farrington improved algorithm for event detection, using `surveillance::Farringtonflexible()` by setting `report_settings$ed_method = "farrington"`. +Currently, epidemiar supports the Farrington improved algorithm for event detection, using `Farringtonflexible()` from the `surveillance` package by setting `report_settings$ed_method = "farrington"`. This family of methods developed by Farrington and later, Noufaily, have been implemented at several European infectious disease control centers. Farrington methods are based on quasi-Poisson regression and can take advantage of historical information while accounting for seasonality, long-term trends, and previous outbreaks. diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index 83e5d50..389d3b9 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -55,6 +55,7 @@ When calling the epidemiar function: * `groupfield`: Give the field name for districts or area divisions of epidemiological AND environmental data. If there are no groupings (all one area), user should give a field with the same value throughout the entire datasets. In the `report_settings` there is an additional parameters for epidemiological settings: + * `report_settings$epi_date_type`: For the `obs_date` in `epi_data`, you need to specify if you are using "weekCDC" epiweeks, or ISO-8601 ("weekISO") standard weeks of the year (what WHO uses). The default setting is "weekISO". The date should be the _last_ day of the epidemiological week. @@ -127,8 +128,9 @@ Besides `fc_model_family`, the rest of the forecasting controls (along with othe * `report_settings$fc_start_date`: Option to set a custom date for when forecasting (i.e. `report_settings$fc_future_period`) begins. Default is one week past the last known/observed epidemiological data date. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section if the `report_settings$fc_start_date` is more than `report_settings$ed_summary_period` weeks after known/observed epidemiological data. * `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks without known environmental data. * `report_settings$fc_clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. The default is a global model (one cluster), which is the equivalent to `fc_clusters` having each entry for the geographic group contains the same "cluster_id" value. If you only have one geographic group, this would contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). Neither global model or individual model are recommended for large numbers of geographic groups, or for geographic groups in different environmental contexts. See overview vignette for more discussion. +* `report_settings$fc_splines`: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package `batchapply` is installed, the default 'tp' uses thin plate splines. If the package is not installed, then it uses modified b-splines ('modbs'). * `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE (no cyclicals). -* `report_settings$fc_nthreads`: For the number of threads argument for parallel processing in modelling. Either 1 or 2, if multiple cores are present. +* `report_settings$fc_ncores`: The number of physical CPU cores on the machine. Default is to use this number minus 1 as available to use for parallel processing for modelling. If not set, it will attempt to detect this on its own. Environmental data-related forecasting settings: @@ -143,7 +145,7 @@ The event detection settings are also bundled into the named list `report_settin * `report_settings$ed_method`: At the moment, the only choices are "farrington" for the Farrington improved algorithm as implemented in the `surveillance` package, or "none". * `report_settings$ed_summary_period`: The last n weeks of known epidemiological data that will be considered the early detection period for alert summaries. The algorithm will run over the entire report length for each geographic group and mark alerts for all weeks, but it will create the early detection summary alerts only during the `report_settings$ed_summary_period` weeks. The early detection summary alerts are recorded in the `summary_data` item in the output. Default is 4 weeks. -* `report_settings$ed_control`: This is a list of parameters that are handed to the `surveillance::farringtonFlexible()` function as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. If the other parameters are not set, the defaults from the surveillance package will be used. +* `report_settings$ed_control`: This is a list of parameters that are handed to the `farringtonFlexible()` function from the `surveillance` package as the `control` argument for "farrington" option. It is unused for the "none" option. See the help for `surveillance::farringtonFlexible()` for more details. In our use of the function, the user can leave `b`, the number of past years to include in the creation of the thresholds, as NULL (not set) and epidemiar will calculate the maximum possible value to use, based on what data is available in `epi_data`. If the other parameters are not set, the defaults from the surveillance package will be used. ## Setting up Model Input (Optional) diff --git a/vignettes/overview-epidemiar.Rmd b/vignettes/overview-epidemiar.Rmd index 4fe58f6..f9c1a5a 100644 --- a/vignettes/overview-epidemiar.Rmd +++ b/vignettes/overview-epidemiar.Rmd @@ -67,7 +67,7 @@ The main requirements for using this package are: # Modeling Overview -The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality,and clustering of geographic groups. +The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality, and clustering of geographic groups. The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). @@ -82,16 +82,12 @@ However, it is also possible to specify a custom forecast start date (the equiva Each geographic group, $geo$, identified in the `groupfield` column is included as a factor. -To capture any long term trends per geographic group, $geo$ is multipled by each of 5 modified basis splines: $bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo$. -The modified basis splines are created within the function as follows: +Each geographic group also has a long term trend component. The long-term trend (and the lagged environmental data, see below) has two options. -1. First, `splines::bs()` is used to create basis splines over the range of observations with degree 6. -2. To reduce the edge effects of using splines, the following modifications are performed: - - the last basis spline function is reverse, and - - the second to last basis spline function is removed. +Option 1) With the installation of a companion package (`batchapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `batchapply` is installed). - +Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), where $geo$ is multipled by each of 5 modified basis splines: $bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo$. +The modified basis splines are created by first using `splines::bs()` to create basis splines over the range of observations with degree 6. Then to reduce the edge effects of using splines, the following modifications are performed: the last basis spline function is reverse, and the second to last basis spline function is removed. There is a an option to explicitly include a cyclical for account for seasonality. If `report_settings$fc_cyclical` is set to TRUE (default is FALSE), a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ @@ -100,15 +96,11 @@ There is a an option to explicitly include a cyclical for account for seasonalit The rates of environmentally-mediated infectious diseases can be influenced by the environmental factors via a range of potential mechanisms, e.g. affecting the abundance and life cycle of disease vectors. The influences on disease generally lags behind the changes in the environmental covariates. -In the modeling controls, the user selects the maximum number of days in the past (`report_settings$env_lag_length`, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. A distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of _l_, for every combination of group, week, and environmental anomaly covariate. - - +In the modeling controls, the user selects the maximum number of days in the past (`report_settings$env_lag_length`, _l_) to consider interactions. Each geographic group and week is associated with environmental anomaly values on the day the week began, up to the lag length, _l_, so that each group-week has a _l_-day history. These are then used in modeling per cluster, see next section for details. In our modeling options, it is possible to specify that the _anomalies_ of the environmental covariates are used as factors (`fc_control$env_anomalies = TRUE`, the default is false to run with raw actual values). In some case, you may want to look at the influence of deviation from normal in the environmental factors to help explain deviations from normal in the disease cases. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group: $geo + s(doy, bs="cc", by=geo)$ - ## Clusters The relationship between environmental drivers and the case burden of the environmentally-mediated disease can vary with geographically, due to ecological, social or other geographic factors. This potential spatial non-stationarity could be handled in a number of ways. @@ -119,10 +111,12 @@ On the other extreme, you could run separate models for each geographic group (e We allow the user to identify their own clusters of geographic units with `report_settings$fc_clusters`, a table of geographic unit and a cluster id (see data vignette for full format details). The clustering determination can be done prior however the user chooses - for example, global model, individual models, clustering by ecological zones, or by identifying similar temporal disease patterns. By default, without information in `fc_clusters`, the model will run as a global model (one cluster). +For modeling the lagged environmental drivers by cluster, there are two options: + +Option 1) With the installation of a companion package (`batchapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `batchapply` is installed). The `batchapply` package is our wrapper over some of the mgcv functions so that we can use thin plate splines for each lagged environmental variable by cluster. + +Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), a distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of lag length, for every combination of group, week, and environmental anomaly covariate. - ## Model Caching Option @@ -135,7 +129,7 @@ Once a model has been generated, it can be fed back into `run_epidemiar()` with The central idea behind outbreak detection is to identify when the case volume exceeds a baseline threshold, and to use this information in a prospective (not retrospective) manner to identify epidemics in their early stages. -Currently, epidemiar supports the Farrington improved algorithm for event detection, using `surveillance::Farringtonflexible()` by setting `report_settings$ed_method = "farrington"`. +Currently, epidemiar supports the Farrington improved algorithm for event detection, using `Farringtonflexible()` from the `surveillance` package by setting `report_settings$ed_method = "farrington"`. This family of methods developed by Farrington and later, Noufaily, have been implemented at several European infectious disease control centers. Farrington methods are based on quasi-Poisson regression and can take advantage of historical information while accounting for seasonality, long-term trends, and previous outbreaks. From 11952f6604642f16196c3652f86be4bb81194174 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 12 Jun 2020 15:38:30 -0500 Subject: [PATCH 100/132] Redo formatting of input and output regression data to match other model streams, and consolidate formatting --- R/forecasting_helpers.R | 2 ++ R/forecasting_main.R | 77 ++++++++++++++++++++++++++--------------- 2 files changed, 52 insertions(+), 27 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 67d50a5..77a2709 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -389,6 +389,8 @@ epi_format_fc <- function(epi_data_extd, rlang::quo_name(quo_groupfield))) %>% #set cluster id as factor, must be for regression later dplyr::mutate(cluster_id = as.factor(.data$cluster_id), + #doy for cyclical regression + doy = as.numeric(format(.data$obs_date, "%j")), #need numeric date for regression numericdate = as.numeric(.data$obs_date)) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 0d03781..ef198ac 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -150,7 +150,6 @@ run_forecast <- function(epi_data, #Split regression call depending on {once|week} model fit frequency if (report_settings[["dev_fc_fit_freq"]] == "once"){ - message("Generating forecasts...") #for single fit, call with last week (and subfunction has switch to return all) forereg_return <- forecast_regression(epi_lag, quo_groupfield, @@ -195,9 +194,9 @@ run_forecast <- function(epi_data, # Interval calculation preds_catch <- preds_catch %>% - dplyr::mutate(fc_cases = .data$fit, - fc_cases_upr = .data$fit+1.96*sqrt(.data$fit), - fc_cases_lwr = .data$fit-1.96*sqrt(.data$fit)) + dplyr::mutate(fc_cases = .data$preds, + fc_cases_upr = .data$preds+1.96*sqrt(.data$preds), + fc_cases_lwr = .data$preds-1.96*sqrt(.data$preds)) #Trim fc report results ONLY (not full epi dataset) to report period preds_catch_trim <- preds_catch %>% @@ -320,10 +319,10 @@ forecast_regression <- function(epi_lag, epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::quo_name(quo_groupfield) := factor(!!quo_groupfield)) - if (report_settings[["fc_cyclicals"]] == TRUE){ - # create a doy field so that we can use a cyclical spline - epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(.data$obs_date, "%j"))) - } + # if (report_settings[["fc_cyclicals"]] == TRUE){ + # # create a doy field so that we can use a cyclical spline + # epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(.data$obs_date, "%j"))) + # } if (report_settings[["fc_splines"]] == "modbs"){ # create modified bspline basis in epi_lag file to model longterm trends @@ -366,20 +365,30 @@ forecast_regression <- function(epi_lag, return(regress) } + # ## Error check all model results if using batch_bam/tp + # if (report_settings[["fc_splines"]] == "tp"){ + # check_bb_models(regress) + # } + + ## Creating predictions switching point on model choice preds <- create_predictions(fc_model_family, report_settings, regress, epi_lag, + env_variables_used, req_date) #now cbind to get ready to return epi_preds <- cbind(epi_lag %>% dplyr::filter(.data$obs_date <= req_date), + #column will be named preds as.data.frame(preds)) %>% #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) - dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) + dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) %>% + #remake into tibble + tibble::as_tibble() if (report_settings[["dev_fc_fit_freq"]] == "once"){ @@ -445,8 +454,8 @@ build_model <- function(fc_model_family, #grouping by geographical unit dplyr::group_by(!!quo_groupfield) %>% #prediction is 1 lag (previous week) - #fit is name of value from regression models - dplyr::mutate(fit = dplyr::lag(.data$cases_epidemiar, n = 1)) + #preds is name of value from regression models + dplyr::mutate(preds = dplyr::lag(.data$cases_epidemiar, n = 1)) } else if (fc_model_family == "naive-averageweek"){ @@ -458,7 +467,7 @@ build_model <- function(fc_model_family, regress <- epi_input %>% #calculate averages per geographic group per week of year dplyr::group_by(!!quo_groupfield, .data$week_epidemiar) %>% - dplyr::summarize(fit = mean(.data$cases_epidemiar, na.rm = TRUE)) + dplyr::summarize(preds = mean(.data$cases_epidemiar, na.rm = TRUE)) } else { @@ -483,6 +492,8 @@ build_model <- function(fc_model_family, } #run the regression + message("Creating regression model...") + if (report_settings[["fc_splines"]] == "modbs"){ if (report_settings[["fc_cyclicals"]]) { #yes cyclicals @@ -523,8 +534,9 @@ build_model <- function(fc_model_family, } #end thin plate - } #end else user supplied family + } #end else user supplied family +return(regress) } # end build_model() @@ -696,6 +708,9 @@ build_equation <- function(quo_groupfield, #' `report_settings$model_cached`, or the one just generated. #'@param epi_lag Epidemiological dataset with basis spline summaries of the #' lagged environmental data (or anomalies), with groupings as a factor. +#'@param env_variables_used a list of environmental variables that will be used in the +#' modeling (had to be listed in model variables input file and present the +#' env_data and env_info datasets) #'@param req_date The end date of requested forecast regression. When fit_freq #' == "once", this is the last date of the full report, the end date of the #' forecast period. @@ -711,6 +726,7 @@ create_predictions <- function(fc_model_family, report_settings, regress, epi_lag, + env_variables_used, req_date){ @@ -724,18 +740,18 @@ create_predictions <- function(fc_model_family, #manipulating to be in quasi-same format as the other models return #regress is a tibble not regression object here - # has a variable fit with lag of 1 on known data + # has a variable preds with lag of 1 on known data #epi_lag has the newer rows preds <- epi_lag %>% #filter to requested date dplyr::filter(.data$obs_date <= req_date) %>% - #join to get "fit" values from "model" - #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming - dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% + #join to get "preds" values from "model" + #join on all shared columns (i.e. everything in regress not "preds") to prevent renaming + dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("preds")]) %>% #important at end/fc section, when we fill down - tidyr::fill(.data$fit, .direction = "down") %>% + tidyr::fill(.data$preds, .direction = "down") %>% #format into nominal regression predict output - dplyr::select(.data$fit) %>% + dplyr::select(.data$preds) %>% as.data.frame() } else if (fc_model_family == "naive-averageweek"){ @@ -755,11 +771,11 @@ create_predictions <- function(fc_model_family, #join back preds <- epi_lag %>% #join to get average values - #join on all shared columns (i.e. everything in regress not "fit") to prevent renaming + #join on all shared columns (i.e. everything in regress not "preds") to prevent renaming # and so don't need column names not passed into this function - dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("fit")]) %>% + dplyr::left_join(regress, by = names(regress)[!names(regress) %in% c("preds")]) %>% #format into nominal regression output - dplyr::select(.data$fit) %>% + dplyr::select(.data$preds) %>% as.data.frame() @@ -772,7 +788,6 @@ create_predictions <- function(fc_model_family, #output prediction (through req_date) preds <- mgcv::predict.bam(regress, newdata = epi_lag %>% dplyr::filter(.data$obs_date <= req_date), - se.fit = TRUE, # included for backwards compatibility type = "response", discrete = TRUE, n.threads = report_settings[["fc_nthreads"]], @@ -783,14 +798,22 @@ create_predictions <- function(fc_model_family, } else if (report_settings[["fc_splines"]] == "tp"){ + pred_input <- epi_lag %>% + dplyr::filter(.data$obs_date <= req_date) + + #tibble to dataframe, and turn all env wide data into each own sub matrix + pred_input_tp <- format_lag_ca(pred_input, + env_variables_used, + report_settings) + + # create a cluster for clusterapply to use pred_cluster <- parallel::makeCluster(max(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) preds <- clusterapply::predict.batch_bam(models = regress, predictargs = list("type"="response"), over = "cluster_id", - newdata = epi_lag %>% - dplyr::filter(.data$obs_date <= req_date), + newdata = pred_input_tp, cluster = pred_cluster) #stop the cluster @@ -799,8 +822,8 @@ create_predictions <- function(fc_model_family, } #end else if fc_splines - - } #end else user supplied fc_family + return(preds) + } #end create_predictions() From b5552ee9a8346d6e53143b6b90ff4ccdfdaec253 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 12 Jun 2020 15:40:35 -0500 Subject: [PATCH 101/132] Corrected thin plate spline equation forming: correct column for long-term, and adding ids per smooth --- R/forecasting_main.R | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index ef198ac..603cc00 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -639,15 +639,29 @@ build_equation <- function(quo_groupfield, #end if modbs } else if (report_settings[["fc_splines"]] == "tp"){ - message("Creating equation using thin plate splines.") + message("Creating equation using thin plate splines...") - #create s(lag, by = <>, bs = 'tp') + #create s({}, by = {}, bs = 'tp', id = {unique}) + # numericdate column for long-term trend + # lag column-matrix for environmental variables + # ids need to be unique for each, but do not have to be sequential + # id = 1 reserved for cyclicals which may or may not be present + # id = 2 reserved for long-term trend + # id = 3+ for each of the environmental variables #for geogroup - tp_geo_eq <- paste0("s(lag, by = ", rlang::quo_name(quo_groupfield), ", bs = \'tp\')") + #need different formulas if 1+ or only 1 geographic grouping + tp_geo_eq <- if (n_groupings > 1){ + paste0("s(numericdate, by = ", rlang::quo_name(quo_groupfield), + ", bs = \'tp\', id = 2)") + } else { + paste0("s(numericdate, ", "bs = \'tp\', id = 2)") + } #for each env var - tp_env_eq_list <- paste0("s(lag, by = ", env_variables_used, ", bs = \'tp\')") + idn_var <- seq(from = 3, to = (3-1+length(env_variables_used))) + tp_env_eq_list <- paste0("s(lag, by = ", env_variables_used, + ", bs = \'tp\', id = ", idn_var, ")") tp_env_eq <- glue::glue_collapse(tp_env_eq_list, sep = " + ") @@ -656,7 +670,7 @@ build_equation <- function(quo_groupfield, message("Including seasonal cyclicals into model...") - #build equation + #build formula #need different formulas if 1+ or only 1 geographic grouping if (n_groupings > 1){ @@ -665,20 +679,20 @@ build_equation <- function(quo_groupfield, #cyclical " + s(doy, bs=\"cc\", by=", rlang::quo_name(quo_groupfield), - ") + ", + ", id = 1) + ", #tp tp_geo_eq, " + ", tp_env_eq)) } else { reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - "s(doy, bs=\"cc\") + ", + "s(doy, bs=\"cc\", id = 1) + ", tp_geo_eq, " + ", tp_env_eq)) } } else { # FALSE, no cyclicals - #build equation + #build formula #need different formulas if 1+ or only 1 geographic grouping if (n_groupings > 1){ From 9cb6bf16b1dbc8b9b0ec13aa55b71d0b08c8c995 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 12 Jun 2020 15:40:56 -0500 Subject: [PATCH 102/132] Corrected input checking of developer options --- R/input_checks.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index aa56ba1..bcae4df 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -528,10 +528,16 @@ input_check <- function(epi_data, # Developer options - if (is.null(raw_settings[["dev_fc_fit_freq"]])){ + if (!is.null(raw_settings[["dev_fc_fit_freq"]])){ + new_settings[["dev_fc_fit_freq"]] <- raw_settings[["dev_fc_fit_freq"]] + } else { + #default new_settings[["dev_fc_fit_freq"]] <- "once" } - if (is.null(raw_settings[["dev_fc_formula"]])){ + if (!is.null(raw_settings[["dev_fc_formula"]])){ + new_settings[["dev_fc_formula"]] <- raw_settings[["dev_fc_formula"]] + } else { + #default new_settings[["dev_fc_formula"]] <- NULL } From 2b3a457b2bb19874505d49ce77627ded1671d5e9 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 12 Jun 2020 15:41:40 -0500 Subject: [PATCH 103/132] Autogenerated documentation updates --- man/build_equation.Rd | 2 +- man/build_model.Rd | 2 +- man/create_predictions.Rd | 7 ++++++- man/forecast_regression.Rd | 2 +- man/format_lag_ca.Rd | 2 +- man/lag_environ_to_epi.Rd | 2 +- man/run_epidemia.Rd | 2 +- man/run_forecast.Rd | 2 +- man/run_validation.Rd | 2 +- 9 files changed, 14 insertions(+), 9 deletions(-) diff --git a/man/build_equation.Rd b/man/build_equation.Rd index 7802367..375b6ef 100644 --- a/man/build_equation.Rd +++ b/man/build_equation.Rd @@ -108,7 +108,7 @@ trimmed to data being used to create the model} option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/build_model.Rd b/man/build_model.Rd index 9958371..fba566f 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -115,7 +115,7 @@ data and groupings converted to factors.} option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index e6ddd1c..d09d938 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -9,6 +9,7 @@ create_predictions( report_settings, regress, epi_lag, + env_variables_used, req_date ) } @@ -108,7 +109,7 @@ input "poisson()". If a cached model is being used, set the parameter to option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of @@ -136,6 +137,10 @@ input "poisson()". If a cached model is being used, set the parameter to \item{epi_lag}{Epidemiological dataset with basis spline summaries of the lagged environmental data (or anomalies), with groupings as a factor.} +\item{env_variables_used}{a list of environmental variables that will be used in the +modeling (had to be listed in model variables input file and present the +env_data and env_info datasets)} + \item{req_date}{The end date of requested forecast regression. When fit_freq == "once", this is the last date of the full report, the end date of the forecast period.} diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index 85ba982..500ba5f 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -117,7 +117,7 @@ input "poisson()". If a cached model is being used, set the parameter to option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/format_lag_ca.Rd b/man/format_lag_ca.Rd index c5ca450..69bf5c4 100644 --- a/man/format_lag_ca.Rd +++ b/man/format_lag_ca.Rd @@ -100,7 +100,7 @@ that are being used in the model.} option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index d0bcd8e..09e57d3 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -110,7 +110,7 @@ run_epidemia().} option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index 5fff12d..7c10886 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -151,7 +151,7 @@ input "poisson()". If a cached model is being used, set the parameter to option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index 4f7f2a1..53f95ce 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -146,7 +146,7 @@ input "poisson()". If a cached model is being used, set the parameter to option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 430c5f1..0bae5d3 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -184,7 +184,7 @@ input "poisson()". If a cached model is being used, set the parameter to option and the default which uses thin plate splines instead. \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling. Only relevant when `fc_splines == 'tp'`. + processing for modelling (default use is ncores - 1). \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of From 7b9279a8ea77dbdf4e56d2961ccf4760ddbe0073 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 12 Jun 2020 15:42:13 -0500 Subject: [PATCH 104/132] Added missing epidemiological setting descriptions in set up --- vignettes/data-modeling.Rmd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index 389d3b9..2d856f0 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -110,13 +110,15 @@ If you are creating a formatted report later and wish to have maps of the result ## Setting up the Report and Model -### Report level settings +### Report level and epidemiological settings Many of the settings are bundled into the named list `report_settings` argument. These all have defaults, but they are not likely the correct defaults for your dataset and modeling. * `report_settings$report_period`: Total number of weeks for the report to include, including the number of future forecast weeks, `report_settings$fc_future_period`, see forecasting section below. Default for total report period is 26 weeks. * `report_settings$report_value_type`: How to report the results, either in terms of "cases" (default) or "incidence". If 'incidence', population data must be supplied in the `epi_data` under `{populationfield}`. * `report_settings$report_inc_per`: If reporting incidence, what should be denominator be? Default is per 1000 persons, and ignored if `report_settings$report_value_type = "cases"`. +* `report_settings$epi_date_type`: What type of weekly dates are the epidemiological data (and environmental reference data) in? This would be a string indicating the standard used: "weekISO" for WHO ISO-8601 weeks (default), or "weekCDC" for CDC epi weeks. Required: epidemiological observation dates listed are LAST day of the given week. +* `report_settings$epi_date_type`: Should the epidemiological data be linearly interpolated for any missing values? Boolean value, default is FALSE. ### Setting up for Forecasting From 5d2a0f360a3a07a5e7facb32ab5ac0d977633c33 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 16 Jun 2020 19:53:31 -0500 Subject: [PATCH 105/132] Switch all quo_name to recommended as_name from rlang. --- R/data_to_daily.R | 4 ++-- R/environmental_reference.R | 4 ++-- R/event_detection.R | 12 +++++----- R/forecasting_helpers.R | 44 +++++++++++++++++----------------- R/forecasting_main.R | 20 ++++++++-------- R/formatters_calculators.R | 16 ++++++------- R/input_checks.R | 48 ++++++++++++++++++------------------- R/model_validation.R | 16 ++++++------- R/run_epidemia.R | 26 ++++++++++---------- 9 files changed, 95 insertions(+), 95 deletions(-) diff --git a/R/data_to_daily.R b/R/data_to_daily.R index 03cc99e..2da6867 100644 --- a/R/data_to_daily.R +++ b/R/data_to_daily.R @@ -41,8 +41,8 @@ data_to_daily <- function(data_notdaily, valuefield, interpolate = TRUE){ #check if group_vars will handle grouping sorting issue dplyr::arrange(dplyr::group_vars(), .data$obs_date) %>% #will not extrapolate beyond last known value, that will happen inside run_epidemia() - #dplyr::mutate(!!rlang::quo_name(quo_valuefield) := epidemiar::na_approx(!!quo_valuefield)) %>% - dplyr::mutate(!!rlang::quo_name(quo_valuefield) := zoo::na.approx(!!quo_valuefield, + #dplyr::mutate(!!rlang::as_name(quo_valuefield) := epidemiar::na_approx(!!quo_valuefield)) %>% + dplyr::mutate(!!rlang::as_name(quo_valuefield) := zoo::na.approx(!!quo_valuefield, rule = 2:1, na.rm = FALSE)) %>% #finish by ungrouping dplyr::ungroup() diff --git a/R/environmental_reference.R b/R/environmental_reference.R index 8295287..d570785 100644 --- a/R/environmental_reference.R +++ b/R/environmental_reference.R @@ -73,8 +73,8 @@ env_daily_to_ref <- function(daily_env_data, #get reference/summarizing method from user supplied env_info dplyr::inner_join(env_info %>% dplyr::select(!!quo_obsfield, .data$reference_method), - by = rlang::set_names(rlang::quo_name(quo_obsfield), - rlang::quo_name(quo_obsfield))) %>% + by = rlang::set_names(rlang::as_name(quo_obsfield), + rlang::as_name(quo_obsfield))) %>% #add week, year fields epidemiar::add_datefields(week_type) %>% #group by grouping, env var, and date week diff --git a/R/event_detection.R b/R/event_detection.R index dc2224d..0503fec 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -311,9 +311,9 @@ stss_res_to_output_data <- function(stss_res_list, #flatten out of list (now that we have the grouping labels) stss_res_flat <- do.call(rbind, stss_res_grp) %>% #fix group name field with dplyr programming - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) %>% + dplyr::rename(!!rlang::as_name(quo_groupfield) := .data$group_temp) %>% #and convert to character for joining - dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) + dplyr::mutate(!!rlang::as_name(quo_groupfield) := as.character(!!quo_groupfield)) #recover population (for incidence calculations), not present if popoffset was FALSE #only if optional population field was given @@ -321,9 +321,9 @@ stss_res_to_output_data <- function(stss_res_list, stss_res_flat <- stss_res_flat %>% dplyr::left_join(epi_fc_data %>% dplyr::select(!!quo_groupfield, !!quo_popfield, .data$obs_date), - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + by = rlang::set_names(c(rlang::as_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), + c(rlang::as_name(quo_groupfield), "epoch"))) } @@ -332,9 +332,9 @@ stss_res_to_output_data <- function(stss_res_list, stss_res_flat <- stss_res_flat %>% dplyr::left_join(epi_fc_data %>% dplyr::select(!!quo_groupfield, .data$obs_date, .data$censor_flag), - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + by = rlang::set_names(c(rlang::as_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), + c(rlang::as_name(quo_groupfield), "epoch"))) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 77a2709..7f4ef1d 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -91,17 +91,17 @@ extend_env_future <- function(env_data, obs_temp = env_variables_used) #and fix names with NSE env_complete <- env_complete %>% - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp, - !!rlang::quo_name(quo_obsfield) := .data$obs_temp) + dplyr::rename(!!rlang::as_name(quo_groupfield) := .data$group_temp, + !!rlang::as_name(quo_obsfield) := .data$obs_temp) #could have ragged env data per variable per grouping #so, antijoin with env_known_fill first to get the actually missing rows env_missing <- env_complete %>% - dplyr::anti_join(env_trim, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), + dplyr::anti_join(env_trim, by = rlang::set_names(c(rlang::as_name(quo_groupfield), + rlang::as_name(quo_obsfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), + c(rlang::as_name(quo_groupfield), + rlang::as_name(quo_obsfield), "obs_date"))) @@ -164,18 +164,18 @@ extend_env_future <- function(env_data, #get reference/summarizing method from user supplied env_info dplyr::left_join(env_info %>% dplyr::select(!!quo_obsfield, .data$reference_method), - by = rlang::set_names(rlang::quo_name(quo_obsfield), - rlang::quo_name(quo_obsfield))) %>% + by = rlang::set_names(rlang::as_name(quo_obsfield), + rlang::as_name(quo_obsfield))) %>% #get weekly ref value dplyr::left_join(env_ref_varused %>% dplyr::select(!!quo_obsfield, !!quo_groupfield, .data$week_epidemiar, .data$ref_value), #NSE fun - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), + by = rlang::set_names(c(rlang::as_name(quo_groupfield), + rlang::as_name(quo_obsfield), "week_epidemiar"), - c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), + c(rlang::as_name(quo_groupfield), + rlang::as_name(quo_obsfield), "week_epidemiar"))) @@ -313,14 +313,14 @@ extend_epi_future <- function(epi_data, group_temp = groupings) #and fix names with NSE epi_future <- epi_future %>% - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + dplyr::rename(!!rlang::as_name(quo_groupfield) := .data$group_temp) #with fc_start_date, there MAY be observed data in future/forecast period #so antijoin and bind actual needed rows to avoid duplication epi_future_missing <- epi_future %>% - dplyr::anti_join(epi_data, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + dplyr::anti_join(epi_data, by = rlang::set_names(c(rlang::as_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), + c(rlang::as_name(quo_groupfield), "obs_date"))) #bind with exisiting data (NAs for everything else in epi_future) @@ -385,8 +385,8 @@ epi_format_fc <- function(epi_data_extd, #join with cluster info dplyr::left_join(fc_clusters, #NSE - by = rlang::set_names(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_groupfield))) %>% + by = rlang::set_names(rlang::as_name(quo_groupfield), + rlang::as_name(quo_groupfield))) %>% #set cluster id as factor, must be for regression later dplyr::mutate(cluster_id = as.factor(.data$cluster_id), #doy for cyclical regression @@ -503,13 +503,13 @@ lag_environ_to_epi <- function(epi_fc, #and fix names with NSE datalagger <- datalagger %>% - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + dplyr::rename(!!rlang::as_name(quo_groupfield) := .data$group_temp) #add env data datalagger <- dplyr::left_join(datalagger, env_fc, #because dplyr NSE, notice flip order - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), "laggeddate"))) + by = rlang::set_names(c(rlang::as_name(quo_groupfield), "obs_date"), + c(rlang::as_name(quo_groupfield), "laggeddate"))) # pivot lagged environmental data to epi data epi_lagged <- epi_fc #to more easily debug and rerun @@ -525,8 +525,8 @@ lag_environ_to_epi <- function(epi_fc, #join cur var wide data to epi data epi_lagged <- dplyr::left_join(epi_lagged, meandat, #dplyr NSE - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), "obs_date"))) + by = rlang::set_names(c(rlang::as_name(quo_groupfield), "obs_date"), + c(rlang::as_name(quo_groupfield), "obs_date"))) } #end pivot loop #if using modified b-splines, do the basis functions and calcs here diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 603cc00..513327a 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -314,9 +314,9 @@ forecast_regression <- function(epi_lag, epi_lag <- epi_lag %>% dplyr::mutate(input = ifelse(.data$obs_date <= last_known_date, 1, 0)) - # ensure that quo_name(quo_groupfield) is a factor - gam/bam will fail if given a character, + # ensure that as_name(quo_groupfield) is a factor - gam/bam will fail if given a character, # which is unusual among regression functions, which typically just coerce into factors. - epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::quo_name(quo_groupfield) := factor(!!quo_groupfield)) + epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::as_name(quo_groupfield) := factor(!!quo_groupfield)) # if (report_settings[["fc_cyclicals"]] == TRUE){ @@ -386,7 +386,7 @@ forecast_regression <- function(epi_lag, #column will be named preds as.data.frame(preds)) %>% #and convert factor back to character for the groupings (originally converted b/c of bam/gam requirements) - dplyr::mutate(!!rlang::quo_name(quo_groupfield) := as.character(!!quo_groupfield)) %>% + dplyr::mutate(!!rlang::as_name(quo_groupfield) := as.character(!!quo_groupfield)) %>% #remake into tibble tibble::as_tibble() @@ -589,7 +589,7 @@ build_equation <- function(quo_groupfield, modb_list <- grep("modbs_reserved_*", colnames(epi_input), value = TRUE) # variant depending on >1 geographic area groupings if (n_groupings > 1){ - modb_list_grp <- paste(modb_list, ":", rlang::quo_name(quo_groupfield)) + modb_list_grp <- paste(modb_list, ":", rlang::as_name(quo_groupfield)) modb_eq <- glue::glue_collapse(modb_list_grp, sep = " + ") } else { modb_eq <- glue::glue_collapse(modb_list, sep = " + ") @@ -606,9 +606,9 @@ build_equation <- function(quo_groupfield, #need different formulas if 1+ or only 1 geographic grouping if (n_groupings > 1){ reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), + rlang::as_name(quo_groupfield), " + s(doy, bs=\"cc\", by=", - rlang::quo_name(quo_groupfield), + rlang::as_name(quo_groupfield), ") + ", modb_eq, " + ", bandsums_eq)) @@ -626,7 +626,7 @@ build_equation <- function(quo_groupfield, #need different formulas if 1+ or only 1 geographic grouping if (n_groupings > 1){ reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), " + ", + rlang::as_name(quo_groupfield), " + ", modb_eq, " + ", bandsums_eq)) } else { @@ -675,10 +675,10 @@ build_equation <- function(quo_groupfield, #need different formulas if 1+ or only 1 geographic grouping if (n_groupings > 1){ reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), + rlang::as_name(quo_groupfield), #cyclical " + s(doy, bs=\"cc\", by=", - rlang::quo_name(quo_groupfield), + rlang::as_name(quo_groupfield), ", id = 1) + ", #tp tp_geo_eq, " + ", @@ -697,7 +697,7 @@ build_equation <- function(quo_groupfield, #need different formulas if 1+ or only 1 geographic grouping if (n_groupings > 1){ reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", - rlang::quo_name(quo_groupfield), " + ", + rlang::as_name(quo_groupfield), " + ", tp_geo_eq, " + ", tp_env_eq)) } else { diff --git a/R/formatters_calculators.R b/R/formatters_calculators.R index f320ca7..ffb8a76 100644 --- a/R/formatters_calculators.R +++ b/R/formatters_calculators.R @@ -58,8 +58,8 @@ environ_report_format <- function(env_ext_data, #get reference/summarizing method from user supplied env_info dplyr::left_join(env_info %>% dplyr::select(!!quo_obsfield, .data$reference_method), - by = rlang::set_names(rlang::quo_name(quo_obsfield), - rlang::quo_name(quo_obsfield))) %>% + by = rlang::set_names(rlang::as_name(quo_obsfield), + rlang::as_name(quo_obsfield))) %>% #add date fields epidemiar::add_datefields(week_type) %>% #trim dates to reduce processing (dates are rough, technically just need week prior to start. 8 is not magical) @@ -99,11 +99,11 @@ environ_report_format <- function(env_ext_data, .data$week_epidemiar, .data$ref_value, dplyr::starts_with("ref_")), #NSE fun - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), + by = rlang::set_names(c(rlang::as_name(quo_groupfield), + rlang::as_name(quo_obsfield), "week_epidemiar"), - c(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_obsfield), + c(rlang::as_name(quo_groupfield), + rlang::as_name(quo_obsfield), "week_epidemiar"))) } @@ -190,8 +190,8 @@ create_summary_data <- function(ed_res, #join results summary_data <- dplyr::inner_join(ed_summary, ew_summary, - by = rlang::set_names(rlang::quo_name(quo_groupfield), - rlang::quo_name(quo_groupfield))) + by = rlang::set_names(rlang::as_name(quo_groupfield), + rlang::as_name(quo_groupfield))) summary_data } diff --git a/R/input_checks.R b/R/input_checks.R index bcae4df..c69f780 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -76,21 +76,21 @@ input_check <- function(epi_data, err_msgs <- paste0(err_msgs, "The 'obs_date' field in the epidemiological dataset, 'epi_data', must be type Date.\n") } # has casefield - if (!rlang::quo_name(quo_casefield) %in% colnames(epi_data)){ + if (!rlang::as_name(quo_casefield) %in% colnames(epi_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_casefield), ", in the epidemiological dataset, 'epi_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_casefield), ", in the epidemiological dataset, 'epi_data'.\n") } # has groupfield - if(!rlang::quo_name(quo_groupfield) %in% colnames(epi_data)){ + if(!rlang::as_name(quo_groupfield) %in% colnames(epi_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the epidemiological dataset, 'epi_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_groupfield), ", in the epidemiological dataset, 'epi_data'.\n") } # has populationfield, but only if given as it is optional #testing if quosure was created on NULL object. if(!rlang::quo_is_null(quo_popfield)){ - if(!rlang::quo_name(quo_popfield) %in% colnames(epi_data)){ + if(!rlang::as_name(quo_popfield) %in% colnames(epi_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "The specified column ", rlang::quo_name(quo_popfield), ", for population must be in the in the epidemiological dataset, 'epi_data'.\n") + err_msgs <- paste0(err_msgs, "The specified column ", rlang::as_name(quo_popfield), ", for population must be in the in the epidemiological dataset, 'epi_data'.\n") } } @@ -106,32 +106,32 @@ input_check <- function(epi_data, err_msgs <- paste0(err_msgs, "The 'obs_date' field in the environmental dataset, 'env_data', must be type Date.\n") } # has groupfield - if(!rlang::quo_name(quo_groupfield) %in% colnames(env_data)){ + if(!rlang::as_name(quo_groupfield) %in% colnames(env_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the environmental dataset, 'env_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_groupfield), ", in the environmental dataset, 'env_data'.\n") } # has obsfield - if(!rlang::quo_name(quo_obsfield) %in% colnames(env_data)){ + if(!rlang::as_name(quo_obsfield) %in% colnames(env_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental dataset, 'env_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_obsfield), ", in the environmental dataset, 'env_data'.\n") } # has valuefield - if(!rlang::quo_name(quo_valuefield) %in% colnames(env_data)){ + if(!rlang::as_name(quo_valuefield) %in% colnames(env_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_valuefield), ", in the environmental dataset, 'env_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_valuefield), ", in the environmental dataset, 'env_data'.\n") } # env_ref tests # has groupfield - if(!rlang::quo_name(quo_groupfield) %in% colnames(env_ref_data)){ + if(!rlang::as_name(quo_groupfield) %in% colnames(env_ref_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), ", in the environmental reference dataset, 'env_ref_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_groupfield), ", in the environmental reference dataset, 'env_ref_data'.\n") } # has obsfield - if(!rlang::quo_name(quo_obsfield) %in% colnames(env_ref_data)){ + if(!rlang::as_name(quo_obsfield) %in% colnames(env_ref_data)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental reference dataset, 'env_ref_data'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_obsfield), ", in the environmental reference dataset, 'env_ref_data'.\n") } #has week_epidemiar if(!"week_epidemiar" %in% colnames(env_ref_data)){ @@ -150,9 +150,9 @@ input_check <- function(epi_data, # env_info # has obsfield - if(!rlang::quo_name(quo_obsfield) %in% colnames(env_info)){ + if(!rlang::as_name(quo_obsfield) %in% colnames(env_info)){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_obsfield), ", in the environmental metadata file, 'env_info'.\n") + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_obsfield), ", in the environmental metadata file, 'env_info'.\n") } # has reference_method if(!"reference_method" %in% colnames(env_info)){ @@ -290,9 +290,9 @@ input_check <- function(epi_data, if (!is.null(raw_settings[["env_var"]])){ # given env_var # check has obsfield - if(!rlang::quo_name(quo_obsfield) %in% colnames(raw_settings[["env_var"]])){ + if(!rlang::as_name(quo_obsfield) %in% colnames(raw_settings[["env_var"]])){ err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column", rlang::quo_name(quo_obsfield), + err_msgs <- paste0(err_msgs, "There must be a column", rlang::as_name(quo_obsfield), ", to indicate the list of model environmental variables in 'report_settings$env_vars'.\n") } else { #does have obsfield, @@ -333,7 +333,7 @@ input_check <- function(epi_data, default_env_var <- dplyr::intersect(env_data_info, env_ref_variables) new_settings[["env_var"]] <- dplyr::tibble(obs_temp = default_env_var) %>% #rename NSE fun - dplyr::rename(!!rlang::quo_name(quo_obsfield) := .data$obs_temp) + dplyr::rename(!!rlang::as_name(quo_obsfield) := .data$obs_temp) #message result warn_flag <- TRUE warn_msgs <- paste0(warn_msgs, "No user supplied list of environmetal variables to use. Using: ", @@ -347,10 +347,10 @@ input_check <- function(epi_data, # special cluster flag cluster_flag <- FALSE # has groupfield - if(!rlang::quo_name(quo_groupfield) %in% colnames(raw_settings[["fc_clusters"]])){ + if(!rlang::as_name(quo_groupfield) %in% colnames(raw_settings[["fc_clusters"]])){ cluster_flag <- TRUE err_flag <- TRUE - err_msgs <- paste0(err_msgs, "There must be a column ", rlang::quo_name(quo_groupfield), + err_msgs <- paste0(err_msgs, "There must be a column ", rlang::as_name(quo_groupfield), ", in 'report_settings$clusters'.\n") } # has cluster_id @@ -388,7 +388,7 @@ input_check <- function(epi_data, #groupings already exist as list of geographic groups cluster_tbl <- tibble::tibble(group_temp = groupings, cluster_id = 1) %>% #and fix names with NSE - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + dplyr::rename(!!rlang::as_name(quo_groupfield) := .data$group_temp) #assign new_settings[["fc_clusters"]] <- cluster_tbl warn_flag <- TRUE diff --git a/R/model_validation.R b/R/model_validation.R index a2c3eac..2ab8ba5 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -120,7 +120,7 @@ run_validation <- function(date_start = NULL, reporting_lag, per_timesteps, skill_test, - casefield = rlang::quo_name(quo_casefield), + casefield = rlang::as_name(quo_casefield), fc_model_family, report_settings) @@ -138,7 +138,7 @@ run_validation <- function(date_start = NULL, obs_only <- epi_data_orig %>% dplyr::select(!!quo_groupfield, .data$obs_date, !!quo_casefield) %>% #rename observation - dplyr::rename(obs = !!rlang::quo_name(quo_casefield)) + dplyr::rename(obs = !!rlang::as_name(quo_casefield)) #Skill test loop set up @@ -244,9 +244,9 @@ run_validation <- function(date_start = NULL, fc_join <- fcs_only %>% dplyr::left_join(obs_only, #NSE fun - by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + by = rlang::set_names(c(rlang::as_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), + c(rlang::as_name(quo_groupfield), "obs_date"))) #make all the reporting_lag adjustments @@ -556,14 +556,14 @@ calc_skill <- function(val_list, grp = NULL){ #join with persistence dplyr::left_join(val_np, #NSE fun - by = rlang::set_names(c(rlang::quo_name(grp), + by = rlang::set_names(c(rlang::as_name(grp), "timestep_ahead"), - c(rlang::quo_name(grp), + c(rlang::as_name(grp), "timestep_ahead"))) %>% #join with average week (1 value to all timesteps ahead) dplyr::left_join(val_naw, - by = rlang::set_names(rlang::quo_name(grp), - rlang::quo_name(grp))) + by = rlang::set_names(rlang::as_name(grp), + rlang::as_name(grp))) } #end joinings #perfect skill metrics diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 475f34a..bc9a8b2 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -480,13 +480,13 @@ run_epidemia <- function(epi_data = NULL, group_temp = groupings) #and fix names with NSE epi_full <- epi_full %>% - dplyr::rename(!!rlang::quo_name(quo_groupfield) := .data$group_temp) + dplyr::rename(!!rlang::as_name(quo_groupfield) := .data$group_temp) #antijoin with existing data to find rows are implicitly missing epi_implicit <- epi_full %>% - dplyr::anti_join(epi_data, by = rlang::set_names(c(rlang::quo_name(quo_groupfield), + dplyr::anti_join(epi_data, by = rlang::set_names(c(rlang::as_name(quo_groupfield), "obs_date"), - c(rlang::quo_name(quo_groupfield), + c(rlang::as_name(quo_groupfield), "obs_date"))) #bind missing epi_data <- epi_data %>% @@ -586,11 +586,11 @@ run_epidemia <- function(epi_data = NULL, if (report_settings[["model_run"]]){ message("Model run only, returning regression object and model information.") - fieldnames <- list(casefield = rlang::quo_name(quo_casefield), - populationfield = rlang::quo_name(quo_popfield), - groupfield = rlang::quo_name(quo_groupfield), - obsfield = rlang::quo_name(quo_obsfield), - valuefield = rlang::quo_name(quo_valuefield)) + fieldnames <- list(casefield = rlang::as_name(quo_casefield), + populationfield = rlang::as_name(quo_popfield), + groupfield = rlang::as_name(quo_groupfield), + obsfield = rlang::as_name(quo_obsfield), + valuefield = rlang::as_name(quo_valuefield)) model_meta <- create_named_list(date_created = Sys.Date(), @@ -754,11 +754,11 @@ run_epidemia <- function(epi_data = NULL, ## Parameters and metadata that might be useful in report generation # all of these may not be needed - fieldnames <- list(casefield = rlang::quo_name(quo_casefield), - populationfield = rlang::quo_name(quo_popfield), - groupfield = rlang::quo_name(quo_groupfield), - obsfield = rlang::quo_name(quo_obsfield), - valuefield = rlang::quo_name(quo_valuefield)) + fieldnames <- list(casefield = rlang::as_name(quo_casefield), + populationfield = rlang::as_name(quo_popfield), + groupfield = rlang::as_name(quo_groupfield), + obsfield = rlang::as_name(quo_obsfield), + valuefield = rlang::as_name(quo_valuefield)) params_meta <- create_named_list(date_created = Sys.Date(), fieldnames, From dfd46abb4a471edee699ca466fe4818fe51d092e Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 16 Jun 2020 19:54:10 -0500 Subject: [PATCH 106/132] Optimizing, removing sort step here that is not needed, will be sorted in extension/gap filling function --- R/run_epidemia.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index bc9a8b2..e5ed922 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -533,9 +533,12 @@ run_epidemia <- function(epi_data = NULL, #prep environmental data, filling in of missing data will happen in extend_env_future() env_data <- env_data %>% #copy over value - dplyr::mutate(val_epidemiar = !!quo_valuefield) %>% - #and sort by alphabetical groupfield - dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) + dplyr::mutate(val_epidemiar = !!quo_valuefield) + + #not needed, cut for speed. Will be sorted in extend_env_future + # %>% + # #and sort by alphabetical groupfield + # dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) From 49f11ed1a845f37acc256e77c49f03ee7b0bba5e Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 16 Jun 2020 19:55:02 -0500 Subject: [PATCH 107/132] Since bam call is with discrete=TRUE, one of the smooths must have fx=TRUE, set for long term trend --- R/forecasting_main.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 513327a..612f332 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -652,10 +652,11 @@ build_equation <- function(quo_groupfield, #for geogroup #need different formulas if 1+ or only 1 geographic grouping tp_geo_eq <- if (n_groupings > 1){ - paste0("s(numericdate, by = ", rlang::quo_name(quo_groupfield), - ", bs = \'tp\', id = 2)") + #we are using discrete = TRUE, so one of the smooths must be fx = TRUE + paste0("s(numericdate, by = ", rlang::as_name(quo_groupfield), + ", bs = \'tp\', fx = TRUE, id = 2)") } else { - paste0("s(numericdate, ", "bs = \'tp\', id = 2)") + paste0("s(numericdate, ", "bs = \'tp\', fx = TRUE, id = 2)") } #for each env var From de2e567d568273a1a7931b2f1af6d4af7fabb623 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 17 Jun 2020 15:19:45 -0500 Subject: [PATCH 108/132] methods package used in batch_bam regression objects check --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 95a69cb..a8ada84 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,6 +23,7 @@ Imports: dplyr (>= 0.8.3), lubridate (>= 1.7.4), MASS, magrittr (>= 1.5), + methods, mgcv (>= 1.8-31), parallel (>= 3.6.1), pracma (>= 2.2.5), From e24560bad05a6f70ee2a776691d03b84b8b41219 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 17 Jun 2020 15:20:36 -0500 Subject: [PATCH 109/132] Added model checks to regression models returned by batch_bam --- R/forecasting_helpers.R | 29 +++++++++++++++++++++++++++++ R/forecasting_main.R | 9 ++++----- 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index 7f4ef1d..d7fd882 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -706,6 +706,35 @@ format_lag_ca <- function(tbl, dfm } +#'Checks that all models successfully built when using batch_bam. +#' +#'@param reg_bb The regression model(s) returned by batch_bam. +#' +#'@return None. Will stop will informative error message if +#'problems are found. +#' +check_bb_models <- function(reg_bb){ + + #check if each is a bam model + is_bam <- lapply(reg_bb, methods::is, "bam") + + #if ALL are not bam models, then stop and return error messages(s) from modeling + if (!all(unlist(is_bam))){ + + #get which failed + fails <- names(is_bam[sapply(is_bam, function(x) x[1]==FALSE)]) + + #quick data frame for failure model names and messages + fails_msg_df <- data.frame(Model = unlist(names(reg_bb[fails])), + Error_message = unlist(lapply(reg_bb[fails], + function(x) conditionMessage(x)))) + + #stop and message + stop(paste("Model(s) failed, please review: \n", + paste0(utils::capture.output(fails_msg_df), collapse = "\n"))) + + } +} diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 612f332..71ec427 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -365,11 +365,10 @@ forecast_regression <- function(epi_lag, return(regress) } - # ## Error check all model results if using batch_bam/tp - # if (report_settings[["fc_splines"]] == "tp"){ - # check_bb_models(regress) - # } - + ## Error check all model results if using batch_bam/tp + if (report_settings[["fc_splines"]] == "tp"){ + check_bb_models(regress) + } ## Creating predictions switching point on model choice preds <- create_predictions(fc_model_family, From ee80b834299c39720c593666c863bdf51ece5fdc Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 17 Jun 2020 15:22:25 -0500 Subject: [PATCH 110/132] Removed clusters (parallel) from clusterapply calls, as clusterapply is now serial; added n.threads argument to be passed to bam --- R/forecasting_main.R | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 71ec427..7867ac3 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -517,19 +517,21 @@ build_model <- function(fc_model_family, env_variables_used, report_settings) - # create a cluster for clusterapply to use - bb_cluster <- parallel::makeCluster(max(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) + # # create a cluster for clusterapply to use + # bb_cluster <- parallel::makeCluster(max(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) + #create list of models, run SERIAL (no cluster), per geographic cluster ("cluster_id") regress <- clusterapply::batch_bam(data = epi_input_tp, bamargs = list("formula" = reg_eq, "family" = fc_model_family, - "discrete" = TRUE), - over = "cluster_id", - cluster = bb_cluster) + "discrete" = TRUE, + "nthreads" = report_settings[["fc_nthreads"]]), + over = "cluster_id") + #cluster = bb_cluster) - #stop the cluster (if model run, won't use again, - # so starts and ends for modeling building or predictions) - parallel::stopCluster(bb_cluster) + # #stop the cluster (if model run, won't use again, + # # so starts and ends for modeling building or predictions) + # parallel::stopCluster(bb_cluster) } #end thin plate @@ -821,17 +823,20 @@ create_predictions <- function(fc_model_family, report_settings) - # create a cluster for clusterapply to use - pred_cluster <- parallel::makeCluster(max(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) + # # create a cluster for clusterapply to use + # pred_cluster <- parallel::makeCluster(max(1, (report_settings[["ncores"]]-1), na.rm = TRUE)) preds <- clusterapply::predict.batch_bam(models = regress, - predictargs = list("type"="response"), + predictargs = list("type" = "response", + "discrete" = TRUE, + "n.threads" = report_settings[["fc_nthreads"]], + "na.action" = stats::na.pass), over = "cluster_id", - newdata = pred_input_tp, - cluster = pred_cluster) + newdata = pred_input_tp) + #cluster = pred_cluster) - #stop the cluster - parallel::stopCluster(pred_cluster) + # #stop the cluster + # parallel::stopCluster(pred_cluster) } #end else if fc_splines From 31336b313231b856c8a6eada68aee21f879b5930 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 17 Jun 2020 16:03:33 -0500 Subject: [PATCH 111/132] Added fallback equation for thin plates version to pass to batch_bam. batch_bam will use fallback equation if model fails with first equation --- R/forecasting_main.R | 71 +++++++++++++++++++++++++++++++++----------- 1 file changed, 54 insertions(+), 17 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 7867ac3..94637b7 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -481,7 +481,8 @@ build_model <- function(fc_model_family, # dev users also need to set fc_splines appropriately } else { - #build equation + #build equation(s) + # if fc_splines = "tp" this will also build a fallback equation as well reg_eq <- build_equation(quo_groupfield, epi_input, report_settings, @@ -503,7 +504,7 @@ build_model <- function(fc_model_family, discrete = TRUE, nthreads = report_settings[["fc_nthreads"]]) } else { - #no cyclicals + #no cyclicals (i.e. no smooths, so discrete cannot be TRUE) regress <- mgcv::bam(reg_eq, data = epi_input, family = fc_model_family, @@ -522,10 +523,14 @@ build_model <- function(fc_model_family, #create list of models, run SERIAL (no cluster), per geographic cluster ("cluster_id") regress <- clusterapply::batch_bam(data = epi_input_tp, - bamargs = list("formula" = reg_eq, + bamargs = list("formula" = reg_eq$reg_eq, "family" = fc_model_family, "discrete" = TRUE, "nthreads" = report_settings[["fc_nthreads"]]), + bamargs_fallback = list("formula" = reg_eq$req_eq_fallback, + "family" = fc_model_family, + "discrete" = TRUE, + "nthreads" = report_settings[["fc_nthreads"]]), over = "cluster_id") #cluster = bb_cluster) @@ -559,6 +564,7 @@ return(regress) #' #'@return A formula to be used in the regression call, built based on settings #' for cyclicals, spline type, and the number of geographic groupings present. +#' For thin plate splines, this will be a list of primary and fallback equations. #' #' build_equation <- function(quo_groupfield, @@ -650,33 +656,53 @@ build_equation <- function(quo_groupfield, # id = 2 reserved for long-term trend # id = 3+ for each of the environmental variables - #for geogroup - #need different formulas if 1+ or only 1 geographic grouping + #a fall-back equation is built using the conditions for only 1 geogroup + # because clusters are not guaranteed to always have multiple geogroups + # will be used inside of clusterapply in case of model failure + + ## Long term trend + + #fallback / single geo group + tp_geo_eq_fallback <- paste0("s(numericdate, ", "bs = \'tp\', id = 2)") + + #need different formulas if 1+ or only 1 geographic grouping (over all dataset) tp_geo_eq <- if (n_groupings > 1){ - #we are using discrete = TRUE, so one of the smooths must be fx = TRUE paste0("s(numericdate, by = ", rlang::as_name(quo_groupfield), - ", bs = \'tp\', fx = TRUE, id = 2)") + ", bs = \'tp\', id = 2)") } else { - paste0("s(numericdate, ", "bs = \'tp\', fx = TRUE, id = 2)") + tp_geo_eq_fallback } - #for each env var + ## Environmental + #build list for penalization ids idn_var <- seq(from = 3, to = (3-1+length(env_variables_used))) + #create list of pieces tp_env_eq_list <- paste0("s(lag, by = ", env_variables_used, ", bs = \'tp\', id = ", idn_var, ")") + #collapse list into formula form tp_env_eq <- glue::glue_collapse(tp_env_eq_list, sep = " + ") if (report_settings[["fc_cyclicals"]]) { - #TRUE, include cyclicals + #TRUE, include cyclical message("Including seasonal cyclicals into model...") #build formula - #need different formulas if 1+ or only 1 geographic grouping + #fall-back equation (used per model, if failure, e.g. only 1 geo group in ONE cluster) + reg_fallback <- stats::as.formula(paste("cases_epidemiar ~ ", + #cyclical + "s(doy, bs=\"cc\", id = 1) + ", + #long-term trend (fallback form) + tp_geo_eq_fallback, " + ", + #lagged environmental variables + tp_env_eq)) + + + #need different formulas if 1+ or only 1 geographic grouping (over all of dataset) if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + reg_eq_tp <- stats::as.formula(paste("cases_epidemiar ~ ", rlang::as_name(quo_groupfield), #cyclical " + s(doy, bs=\"cc\", by=", @@ -686,29 +712,40 @@ build_equation <- function(quo_groupfield, tp_geo_eq, " + ", tp_env_eq)) } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + reg_eq_tp <- stats::as.formula(paste("cases_epidemiar ~ ", + #cyclical "s(doy, bs=\"cc\", id = 1) + ", + #long-term trend tp_geo_eq, " + ", + #lagged environmental variables tp_env_eq)) } } else { - # FALSE, no cyclicals + # FALSE, no cyclical #build formula + #fall-back equation (used per model, if failure, e.g. only 1 geo group in ONE cluster) + reg_fallback <- stats::as.formula(paste("cases_epidemiar ~ ", + tp_geo_eq_fallback, " + ", + tp_env_eq)) + #need different formulas if 1+ or only 1 geographic grouping if (n_groupings > 1){ - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + reg_eq_tp <- stats::as.formula(paste("cases_epidemiar ~ ", rlang::as_name(quo_groupfield), " + ", tp_geo_eq, " + ", tp_env_eq)) } else { - reg_eq <- stats::as.formula(paste("cases_epidemiar ~ ", + reg_eq_tp <- stats::as.formula(paste("cases_epidemiar ~ ", tp_geo_eq, " + ", tp_env_eq)) } - } #end else cyclicals + } #end else cyclical + #for splines tp, return is a named list of primary equation and fallback equation + reg_eq <- list("reg_eq" = reg_eq_tp, + "req_eq_fallback" = reg_fallback) } #end splines tp From 77a02977062c8745f0dbe2fc4372441f26368b7c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 17 Jun 2020 16:03:58 -0500 Subject: [PATCH 112/132] updated function documentation --- R/run_epidemia.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/run_epidemia.R b/R/run_epidemia.R index e5ed922..6ef6224 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -131,17 +131,18 @@ #' units in one cluster. #' #' \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a -#' smooth term based on day of year in the modelling (as one way of accounting +#' smooth term based on day of year in the modeling (as one way of accounting #' for seasonality). #' #' \item \code{fc_splines}: The type of splines that will be used to handle #' long-term trends and lagged environmental variables. If supplemental package -#' `batchapply` is not installed, the default (and only choice) uses modified +#' `clusterapply` is not installed, the default (and only choice) uses modified #' b-splines ('modbs'). If the package is installed, then 'tp' becomes an #' option and the default which uses thin plate splines instead. #' -#' \item \code{fc_ncores}: The number of physical CPU cores to use for parallel -#' processing for modelling (default use is ncores - 1). +#' \item \code{fc_ncores}: The number of physical CPU cores available. Will be +#' used to determine the multi-threading (or not) for use in modeling and +#' predicting. #' #' \item \code{ed_summary_period} = 4: The number of weeks that will be #' considered the "early detection period". It will count back from the week of From 186416a61cee58bcf44acd15204043077b7b62c4 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 17 Jun 2020 16:04:44 -0500 Subject: [PATCH 113/132] Autogenerated documentation update --- man/build_equation.Rd | 10 ++++++---- man/build_model.Rd | 9 +++++---- man/check_bb_models.Rd | 18 ++++++++++++++++++ man/create_predictions.Rd | 9 +++++---- man/epiwday.Rd | 4 ++-- man/forecast_regression.Rd | 9 +++++---- man/format_lag_ca.Rd | 9 +++++---- man/lag_environ_to_epi.Rd | 9 +++++---- man/make_date_yw.Rd | 4 ++-- man/run_epidemia.Rd | 9 +++++---- man/run_forecast.Rd | 9 +++++---- man/run_validation.Rd | 9 +++++---- 12 files changed, 68 insertions(+), 40 deletions(-) create mode 100644 man/check_bb_models.Rd diff --git a/man/build_equation.Rd b/man/build_equation.Rd index 375b6ef..0023246 100644 --- a/man/build_equation.Rd +++ b/man/build_equation.Rd @@ -98,17 +98,18 @@ trimmed to data being used to create the model} units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of @@ -142,6 +143,7 @@ env_data and env_info datasets)} \value{ A formula to be used in the regression call, built based on settings for cyclicals, spline type, and the number of geographic groupings present. + For thin plate splines, this will be a list of primary and fallback equations. } \description{ Create the appropriate regression equation. diff --git a/man/build_model.Rd b/man/build_model.Rd index fba566f..4bcb6a5 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -105,17 +105,18 @@ data and groupings converted to factors.} units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/check_bb_models.Rd b/man/check_bb_models.Rd new file mode 100644 index 0000000..0d6a80b --- /dev/null +++ b/man/check_bb_models.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/forecasting_helpers.R +\name{check_bb_models} +\alias{check_bb_models} +\title{Checks that all models successfully built when using batch_bam.} +\usage{ +check_bb_models(reg_bb) +} +\arguments{ +\item{reg_bb}{The regression model(s) returned by batch_bam.} +} +\value{ +None. Will stop will informative error message if +problems are found. +} +\description{ +Checks that all models successfully built when using batch_bam. +} diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index d09d938..377ef89 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -99,17 +99,18 @@ input "poisson()". If a cached model is being used, set the parameter to units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/epiwday.Rd b/man/epiwday.Rd index 07dd2d8..67bfdc5 100644 --- a/man/epiwday.Rd +++ b/man/epiwday.Rd @@ -34,6 +34,6 @@ epiwday(as.Date("2005-01-01"), system = "CDC") # 7 } \references{ -\url{http://en.wikipedia.org/wiki/ISO_week_date} -\url{http://www.cmmcp.org/epiweek.htm} +\url{https://en.wikipedia.org/wiki/ISO_week_date} +\url{https://www.cmmcp.org/sites/cmmcp/files/uploads/spring_skeeter_06.pdf} } diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index 500ba5f..e8159ea 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -107,17 +107,18 @@ input "poisson()". If a cached model is being used, set the parameter to units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/format_lag_ca.Rd b/man/format_lag_ca.Rd index 69bf5c4..845ef06 100644 --- a/man/format_lag_ca.Rd +++ b/man/format_lag_ca.Rd @@ -90,17 +90,18 @@ that are being used in the model.} units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index 09e57d3..a569d20 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -100,17 +100,18 @@ run_epidemia().} units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/make_date_yw.Rd b/man/make_date_yw.Rd index f42a0e6..8816b7f 100644 --- a/man/make_date_yw.Rd +++ b/man/make_date_yw.Rd @@ -43,6 +43,6 @@ make_date_yw(2010:2017, 1) } \references{ -\url{http://en.wikipedia.org/wiki/ISO_week_date} -\url{http://www.cmmcp.org/epiweek.htm} +\url{https://en.wikipedia.org/wiki/ISO_week_date} +\url{https://www.cmmcp.org/sites/cmmcp/files/uploads/spring_skeeter_06.pdf} } diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index 7c10886..bec5f36 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -141,17 +141,18 @@ input "poisson()". If a cached model is being used, set the parameter to units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index 53f95ce..2cdb845 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -136,17 +136,18 @@ input "poisson()". If a cached model is being used, set the parameter to units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of diff --git a/man/run_validation.Rd b/man/run_validation.Rd index 0bae5d3..0496f97 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -174,17 +174,18 @@ input "poisson()". If a cached model is being used, set the parameter to units in one cluster. \item \code{fc_cyclicals} = FALSE: TRUE/FALSE flag on whether to include a - smooth term based on day of year in the modelling (as one way of accounting + smooth term based on day of year in the modeling (as one way of accounting for seasonality). \item \code{fc_splines}: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package - `batchapply` is not installed, the default (and only choice) uses modified + `clusterapply` is not installed, the default (and only choice) uses modified b-splines ('modbs'). If the package is installed, then 'tp' becomes an option and the default which uses thin plate splines instead. - \item \code{fc_ncores}: The number of physical CPU cores to use for parallel - processing for modelling (default use is ncores - 1). + \item \code{fc_ncores}: The number of physical CPU cores available. Will be + used to determine the multi-threading (or not) for use in modeling and + predicting. \item \code{ed_summary_period} = 4: The number of weeks that will be considered the "early detection period". It will count back from the week of From d956a4bc585c914dae315a7fe35c31d2c0f24c06 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:41:06 -0500 Subject: [PATCH 114/132] Updated minimum package versions to current --- DESCRIPTION | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a8ada84..40a1342 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,22 +18,22 @@ License: MIT + file LICENSE Encoding: UTF-8 LazyData: true RoxygenNote: 7.1.0 -Imports: dplyr (>= 0.8.3), - glue (>= 1.3.1), - lubridate (>= 1.7.4), +Imports: dplyr (>= 1.0.0), + glue (>= 1.4.1), + lubridate (>= 1.7.9), MASS, magrittr (>= 1.5), methods, mgcv (>= 1.8-31), - parallel (>= 3.6.1), - pracma (>= 2.2.5), + parallel (>= 4.0.1), + pracma (>= 2.2.9), readr (>= 1.3.1), - rlang (>= 0.4.0), - surveillance (>= 1.17.0), - splines (>= 3.6.1), - tibble (>= 2.1.3), - tidyr (>= 0.8.3), - zoo (>= 1.8-6) + rlang (>= 0.4.6), + surveillance (>= 1.18.0), + splines (>= 4.0.1), + tibble (>= 3.0.1), + tidyr (>= 1.1.0), + zoo (>= 1.8-8) Suggests: clusterapply, knitr, From 4a726fd83ddce83ae6f102e0bec95d9712f4fe4d Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:41:38 -0500 Subject: [PATCH 115/132] Updated comment for new definition of recent value when progressive blending for missing environmental data --- R/forecasting_helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/forecasting_helpers.R b/R/forecasting_helpers.R index d7fd882..3761f27 100644 --- a/R/forecasting_helpers.R +++ b/R/forecasting_helpers.R @@ -62,7 +62,7 @@ extend_env_future <- function(env_data, # but only if missing run is larger than 2 weeks * 7 = 14 days # if less than, just use persistence/carry forward/last known value # E.g. if 20 missing in a run: - # 1 was filled in with previous week mean (recent value) + # 1 was filled in with previous week mean (recent value) for 'mean' type, 14 days for 'sum' type # 2: 19/20 recent + 1/20 historical, 3: 18/20 recent + 2/20 historical, ... 20: 1/20 recent + 19/20 historical. # Will ALWAYS include part of recent known data (relevant if recent patterns are departure from climate averages) From 0460cf1d3f639d99275a3ba80f00c1e5e971f2ce Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:42:47 -0500 Subject: [PATCH 116/132] Skip creating modified b-splines when running naive models (when forecast model uses modbs) --- R/forecasting_main.R | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 94637b7..39dd555 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -324,13 +324,16 @@ forecast_regression <- function(epi_lag, # epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(.data$obs_date, "%j"))) # } - if (report_settings[["fc_splines"]] == "modbs"){ - # create modified bspline basis in epi_lag file to model longterm trends - epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, - degree=6, - maxobs=max(epi_lag$obs_date[epi_lag$input==1], na.rm=TRUE))) + if (!fc_model_family == "naive-persistence" & !fc_model_family == "naive-averageweek"){ + if (report_settings[["fc_splines"]] == "modbs"){ + # create modified bspline basis in epi_lag file to model longterm trends + epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, + degree=6, + maxobs=max(epi_lag$obs_date[epi_lag$input==1], na.rm=TRUE))) + } } + #filter to input data for model building epi_input <- epi_lag %>% dplyr::filter(.data$input == 1) From 8b2c988d6afc25b8be62cae7f2f15035f7042e4c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:43:32 -0500 Subject: [PATCH 117/132] Skip batch bam model checking when running a naive model from validation (when forecast model uses thin plates) --- R/forecasting_main.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 39dd555..fd8b2ab 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -363,15 +363,18 @@ forecast_regression <- function(epi_lag, regress <- model_cached$model_obj } + ## Error check all model results if using batch_bam/tp + if (!fc_model_family == "naive-persistence" & !fc_model_family == "naive-averageweek"){ + if (report_settings[["fc_splines"]] == "tp"){ + check_bb_models(regress) + } + } + ## If model run, return regression object to run_forecast() at this point if (report_settings[["model_run"]]){ return(regress) } - ## Error check all model results if using batch_bam/tp - if (report_settings[["fc_splines"]] == "tp"){ - check_bb_models(regress) - } ## Creating predictions switching point on model choice preds <- create_predictions(fc_model_family, From 92d3c21508808f36e5b316855b2ca3b980e97c0c Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:54:04 -0500 Subject: [PATCH 118/132] Update to fc_nthreads input checking as threads>2 do seem to have an effect now; --- R/input_checks.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index c69f780..215ba8b 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -517,13 +517,12 @@ input_check <- function(epi_data, na.rm = TRUE) } #nthreads - #default value is 1 for 1 core machines, 2 for multi-core (testing shows no additional value past 2) if (!is.null(raw_settings[["fc_nthreads"]])) { - # nthreads above 2 is not actually helpful - new_settings[["fc_nthreads"]] <- ifelse(raw_settings[["fc_nthreads"]] > 1, 2, 1) + # allow override + new_settings[["fc_nthreads"]] <- raw_settings[["fc_nthreads"]] } else { - #calc default - new_settings[["fc_nthreads"]] <- ifelse(new_settings[["fc_ncores"]] > 1, 2, 1) + #calc default: number of physical cores + new_settings[["fc_nthreads"]] <- new_settings[["fc_ncores"]] } @@ -534,6 +533,8 @@ input_check <- function(epi_data, #default new_settings[["dev_fc_fit_freq"]] <- "once" } + # for dev formula: dev must also set fc_splines and fc_cyclicals (if modbs) correctly, + # otherwise it will not know which function to call if (!is.null(raw_settings[["dev_fc_formula"]])){ new_settings[["dev_fc_formula"]] <- raw_settings[["dev_fc_formula"]] } else { @@ -542,7 +543,6 @@ input_check <- function(epi_data, } - # 4. Report settings ----------------------------------------------------------------- #epi_interpolate From 119c7a62937064e7b7f0bc01a52e09deec15ba7b Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:55:22 -0500 Subject: [PATCH 119/132] Changed cached model input checking with batch bam models and figured out how to better override and warn on conflicting model choices. --- R/input_checks.R | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/R/input_checks.R b/R/input_checks.R index 215ba8b..33ab13c 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -703,22 +703,42 @@ input_check <- function(epi_data, #if model looks okay so far, then check further - #make sure given model (if given) is a regression object (using basic "lm" as test) - #model_cached$model_obj - classes <- class(raw_settings[["model_cached"]][["model_obj"]]) - if (!"lm" %in% classes){ - err_flag <- TRUE - err_msgs <- paste0(err_msgs, "The object in 'report_settings$model_cached$model_obj' is not a regression object, found classes are: ", classes, ".\n") - } #end lm check + #Removed: batch_bam returns list of models, will need to reconsider how to test + # #make sure given model (if given) is a regression object (using basic "lm" as test) + # #model_cached$model_obj + # classes <- class(raw_settings[["model_cached"]][["model_obj"]]) + # if (!"lm" %in% classes){ + # err_flag <- TRUE + # err_msgs <- paste0(err_msgs, "The object in 'report_settings$model_cached$model_obj' is not a regression object, found classes are: ", classes, ".\n") + # } #end lm check #if using a cached model, the model family from the cached model will be used #warn about overriding any user input family - if (fc_model_family != "cached"){ + if ((fc_model_family != "cached") & + (raw_settings$model_cached$model_info$fc_model_family != fc_model_family)){ warn_flag <- TRUE warn_msgs <- paste0(warn_msgs, "The cached model family ", raw_settings$model_cached$model_info$fc_model_family, ", will override any user input. ", "Found 'fc_model_family' set to ", fc_model_family, " instead of 'cached'.\n") } + #use metadata to override fc_splines if needed. This MUST match for the correct function to be called. + if (raw_settings$model_cached$model_info$report_settings$fc_splines != new_settings$fc_splines){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "The cached model fc_splines ", + raw_settings$model_cached$model_info$report_settings$fc_splines, + ", will override report_settings$fc_splines: ", + new_settings$fc_splines) + new_settings$fc_splines <- raw_settings$model_cached$model_info$report_settings$fc_splines + #and repeat test that batch_bam is ok + #stop/error if requested tp if batchapply is not installed/available + if (new_settings[["fc_splines"]] == "tp" & !batchbam_ok){ + err_flag <- TRUE + err_msgs <- paste0(err_msgs, "Cached model uses thin plate splines (fc_splines = 'tp'),", + "but package clusterapply is not installed/available. \n") + } + + } + #end if names } else { err_flag <- TRUE From 778030dc36b2fa0fe9fbddffc0c61ccabbe68e7f Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:56:07 -0500 Subject: [PATCH 120/132] ed_summary_period can now be zero, so removed older workaround --- R/model_validation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/model_validation.R b/R/model_validation.R index 2ab8ba5..30f9138 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -98,7 +98,7 @@ run_validation <- function(date_start = NULL, report_settings[["fc_future_period"]] <- timesteps_ahead + reporting_lag report_settings[["report_period"]] <- report_settings[["fc_future_period"]] + 1 #no event detection - report_settings[["ed_summary_period"]] <- 1 # 0 throws an error. with method = "none", no ED takes place + report_settings[["ed_summary_period"]] <- 0 #method is 0, nothing happens report_settings[["ed_method"]] <- "none" #report out in CASES for validation report_settings[["report_value_type"]] <- "cases" From e5711fe747d0998edc91d17f3c11694c60a7aeac Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 18:57:09 -0500 Subject: [PATCH 121/132] In validation, per week stats are now always returned --- R/model_validation.R | 51 +++++++++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 20 deletions(-) diff --git a/R/model_validation.R b/R/model_validation.R index 30f9138..c8edcf8 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -42,10 +42,10 @@ #' first object is `skill_scores`, which contains `skill_overall` and #' `skill_grouping`. The second list is `validations`, which contains lists per #' model run (the forecast model and then optionally the naive models). Within -#' each, `validation_overall` is the results overall, and `validation_grouping` -#' is the results per geographic grouping. Lastly, a `metadata` list contains -#' the important parameter settings used to run validation and when the results -#' where generated. +#' each, `validation_overall` is the results overall, `validation_grouping` is +#' the results per geographic grouping, and `validation_perweek` is the raw +#' stats per week. Lastly, a `metadata` list contains the important parameter +#' settings used to run validation and when the results where generated. #' #'@export #' @@ -176,6 +176,11 @@ run_validation <- function(date_start = NULL, } + #if a naive model, drop any cached models to avoid conflicts + if (this_model == "naive-persistence" | this_model == "naive-averageweek"){ + this_report_settings[["model_cached"]] <- NULL + } + # Week loop --------------------------------------------------------------- #Create list of dates @@ -335,7 +340,7 @@ run_validation <- function(date_start = NULL, #' testing. #' #'@return A named list of validation statistic results: validation_overall, -#' validation_grouping, validation_timeseries +#' validation_grouping, validation_timeseries, validation_perweek #' calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ # MAE: mean(|obs - pred|) @@ -437,21 +442,27 @@ calc_val_stats <- function(fc_trim, quo_groupfield, per_timesteps, dots){ #return all - # and raw data with hidden option - #possibly make "time series" version for clean full data table - if (!is.null(dots[['raw_data']])){ - if (dots[['raw_data']] == TRUE){ - val_stats <- create_named_list(validation_overall, - validation_grouping, - validation_timeseries, - raw_stats = fc_stats) - } #end raw data TRUE - } else { - #normal return with just results - val_stats <- create_named_list(validation_overall, - validation_grouping, - validation_timeseries) - } + val_stats <- create_named_list(validation_overall, + validation_grouping, + validation_timeseries, + validation_perweek = fc_stats) + + # # and raw data with hidden option + # #possibly make "time series" version for clean full data table + # if (!is.null(dots[['raw_data']])){ + # if (dots[['raw_data']] == TRUE){ + # val_stats <- create_named_list(validation_overall, + # validation_grouping, + # validation_timeseries, + # raw_stats = fc_stats) + # } #end raw data TRUE + # } else { + # #normal return with just results + # val_stats <- create_named_list(validation_overall, + # validation_grouping, + # validation_timeseries) + # } + } #end calc_val_stats() From b28987a2b2ad1de5b150d9d623af0f8c612b4be7 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 20:20:04 -0500 Subject: [PATCH 122/132] Updated vignettes to current version --- vignettes/data-modeling.Rmd | 6 +++--- vignettes/output-report-data.Rmd | 6 +++--- vignettes/overview-epidemiar.Rmd | 6 +++--- vignettes/validation-assessment.Rmd | 5 +++-- 4 files changed, 12 insertions(+), 11 deletions(-) diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index 2d856f0..fde2f6e 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -130,14 +130,14 @@ Besides `fc_model_family`, the rest of the forecasting controls (along with othe * `report_settings$fc_start_date`: Option to set a custom date for when forecasting (i.e. `report_settings$fc_future_period`) begins. Default is one week past the last known/observed epidemiological data date. Note that model accuracy decreases without recent epidemiological data, and that there may be no known data (and therefore results) for 'early detection' in the event detection section if the `report_settings$fc_start_date` is more than `report_settings$ed_summary_period` weeks after known/observed epidemiological data. * `report_settings$fc_future_period`: The number of weeks to forecast into the future. As the future values of the environmental variables are being imputed based on recent and historical values, it is not recommended to extend the forecast very far into the future, probably no longer than 12 weeks without known environmental data. * `report_settings$fc_clusters`: Geographic grouping clusters. This is a two-column list matching the geographic group to its cluster number. There must be an entry for each geographic group included in the epidemiological data. The fields are: the geographic group field, `groupfield`, and "cluster_id", the numeric ID number for each geographic group. The default is a global model (one cluster), which is the equivalent to `fc_clusters` having each entry for the geographic group contains the same "cluster_id" value. If you only have one geographic group, this would contain one row for that geographic group with a "cluster_id" (1, for example). If you want each geographic group to be in its own cluster (individual model), then each entry should contain a unique value (e.g. 1 to the number of geographic groups). Neither global model or individual model are recommended for large numbers of geographic groups, or for geographic groups in different environmental contexts. See overview vignette for more discussion. -* `report_settings$fc_splines`: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package `batchapply` is installed, the default 'tp' uses thin plate splines. If the package is not installed, then it uses modified b-splines ('modbs'). +* `report_settings$fc_splines`: The type of splines that will be used to handle long-term trends and lagged environmental variables. If supplemental package `clusterapply` is installed, the default 'tp' uses thin plate splines. This creates a model per `cluster_id`, so may be slower depending on the number of clusters in your model. If the package is not installed, or if the user sets `fc_splines` to "modbs", then it uses modified b-splines. * `report_settings$fc_cyclicals`: Boolean on whether to include a cyclical cubic regression spline smooth term based on day of year per geographic group. Defaults to FALSE (no cyclicals). * `report_settings$fc_ncores`: The number of physical CPU cores on the machine. Default is to use this number minus 1 as available to use for parallel processing for modelling. If not set, it will attempt to detect this on its own. Environmental data-related forecasting settings: * `report_settings$env_var`: Environmental variables. This informs the modeling system which environmental variables to actually use. (You can therefore have extra variables or data in the environmental dataset.) This is just a simple 1 column tibble with the variable names to use - `obsfield` - same field name as in the environmental data and environmental reference datasets, with entries for which variables to use in the modeling. The default will be all the environmental variables that are present in all three environmental-related input data: `env_data`, `env_info`, and `env_ref`. -* `report_settings$env_lag_length`: The number of days of past environmental data to include for the lagged effects, default is 180 days. +* `report_settings$env_lag_length`: The number of days of past environmental data to include for the lagged effects, default is 181 days. * `report_settings$env_anomalies`: Boolean argument indicating if the environmental variables should be replaced with their anomalies. The variables were transformed by taking the residuals from a GAM with geographic unit and cyclical cubic regression spline on day of year per geographic group. Default is FALSE (no anomalization). @@ -153,6 +153,6 @@ The event detection settings are also bundled into the named list `report_settin ## Setting up Model Input (Optional) * `report_settings$model_run`: This is a boolean indicating if it should ONLY generate and return the regression object (`model_obj`) and metadata (`model_info`) on the model. (Default is FALSE) -* `report_settings$model_cached`: Once a model (and metadata) has been generated, it can be fed into `run_epidemiar()` using this argument. This should be the exact object that was returned by a `report_settings$model_run = TRUE`. This will skip the model building portion of forecasting, and will continue start into generating predictions. Using a prebuilt model saves on processing time, but will need to be updated periodically. If using a cached model, also set `fc_model_family = "cached"`. +* `report_settings$model_cached`: Once a model (and metadata) has been generated, it can be fed into `run_epidemiar()` using this argument. This should be the exact object that was returned by a `report_settings$model_run = TRUE`. This will skip the model building portion of forecasting, and will continue start into generating predictions. Using a prebuilt model saves on processing time, but will need to be updated periodically. If using a cached model, also set `fc_model_family = "cached"`, though it will override as necessary. The cached model will also override the `fc_splines` setting. Pre-generating a model can save substantial processing time, and users can expect faster report data generation time. The trade-off of potential hits to model accuracy in the age of the model versus the time range of the requested predictions should be examined, which would vary depending on the situation/datasets. diff --git a/vignettes/output-report-data.Rmd b/vignettes/output-report-data.Rmd index 0605742..78c1ae2 100644 --- a/vignettes/output-report-data.Rmd +++ b/vignettes/output-report-data.Rmd @@ -82,9 +82,9 @@ These are multiple timeseries for the used environmental variables during the re * `obs_date`: The last day of the epidemiological week (ISO/CDC, by `report_settings$epi_date_type`), Date object * `val_epidemiar`: Value of the environmental variable for that geographic group for that week. Values are a combination of observed, or interpolated (for missing) or extended (future estimated) values. * `reference_method`: Method for creating a weekly summary from daily data (e.g. "sum" for rainfall, or "mean" for NDWI) -* `data_source`: "Observed", "Interpolated", or "Extended". Missing environmental data is handled in three different ways, depending on time period. For missing values in the middle of series, the value is a linear approximation of surrounding values ("Interpolated"). For missing values at the end of the series, up to the future forecast portion, values are carried forward in a persistence approach (also marked "Interpolated" at the moment). For the forecast future portion, values are a blending of the last known values and the climatic historical mean, with a gradual weighting scheme shifting from more weight from last known to historical mean ("Extended"). +* `data_source`: "Observed" or "Imputed". Environment data was either observed, or if it was NA/missing, it was filled in (imputed). For gaps less than 2 weeks, the values are filled in with a persistence method (carry-forward). The recent values are calculated as the average of the past 7 days for 'mean' type variables (as defined in the user's `environ_info` metadata, e.g. for NDWI, LST), or the past 14 known days for 'sum' type variables (as defined in the user's `environ_info` metadata, e.g. for precipitation-like measures). For periods longer than 2 weeks, daily values were imputed using a progressive blend of the recent values (as above) with the climatology/historical averages for that week of the year (from `environ_ref_data`). * `ref_value`: From `env_ref_data`. -* `ref_*`: Fields from `env_ref_data` that begin with `ref_` have been propogating through to here. (Potentially useful for plotting, for example.) +* `ref_*`: Fields from `env_ref_data` that begin with `ref_` have been propagating through to here. (Potentially useful for plotting, for example.) ## `environ_anomalies` @@ -110,7 +110,7 @@ Once a model has been generated, it can be fed back into `run_epidemiar(..., rep 2. `model_info` ## `model_obj` -The output regression object from the `mgcv::bam()` general additive model regression call. +The output regression object from the `mgcv::bam()` general additive model regression call, or a list of models per cluster from `clusterapply` depending on the model settings. ## `model_info` A list of dates, settings, and relevant parameters that `run_epidemiar()` was called with. Very similar to `params_meta` of a full run. diff --git a/vignettes/overview-epidemiar.Rmd b/vignettes/overview-epidemiar.Rmd index f9c1a5a..27389d8 100644 --- a/vignettes/overview-epidemiar.Rmd +++ b/vignettes/overview-epidemiar.Rmd @@ -84,9 +84,9 @@ Each geographic group, $geo$, identified in the `groupfield` column is included Each geographic group also has a long term trend component. The long-term trend (and the lagged environmental data, see below) has two options. -Option 1) With the installation of a companion package (`batchapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `batchapply` is installed). +Option 1) With the installation of a companion package (`clusterapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `clusterapply` is installed). -Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), where $geo$ is multipled by each of 5 modified basis splines: $bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo$. +Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), where $geo$ is multiplied by each of 5 modified basis splines: $bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo$. The modified basis splines are created by first using `splines::bs()` to create basis splines over the range of observations with degree 6. Then to reduce the edge effects of using splines, the following modifications are performed: the last basis spline function is reverse, and the second to last basis spline function is removed. There is a an option to explicitly include a cyclical for account for seasonality. If `report_settings$fc_cyclical` is set to TRUE (default is FALSE), a cyclical cubic regression spline smooth is added based on day of year per geographic group: $s(doy, bs = "cc", by = geo)$ @@ -113,7 +113,7 @@ We allow the user to identify their own clusters of geographic units with `repor For modeling the lagged environmental drivers by cluster, there are two options: -Option 1) With the installation of a companion package (`batchapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `batchapply` is installed). The `batchapply` package is our wrapper over some of the mgcv functions so that we can use thin plate splines for each lagged environmental variable by cluster. +Option 1) With the installation of a companion package (`clusterapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `clusterapply` is installed). The `clusterapply` package is our wrapper over some of the mgcv functions so that we can use thin plate splines for each lagged environmental variable by cluster. Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), a distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of lag length, for every combination of group, week, and environmental anomaly covariate. diff --git a/vignettes/validation-assessment.Rmd b/vignettes/validation-assessment.Rmd index 2facb33..5c2587e 100644 --- a/vignettes/validation-assessment.Rmd +++ b/vignettes/validation-assessment.Rmd @@ -53,7 +53,7 @@ The `run_validation()` function takes 5 arguments, plus all the `run_epidemia()` ## Other Arguments & Adjustments -The `run_validation()` function will call `run_epidemia()`, so it will also take all the arguments for that function. The user does not need to modify any of these arguments (e.g. event detection settings, `fc_future_period`), as `run_validation()` will automatically handle all of thse adjustments. +The `run_validation()` function will call `run_epidemia()`, so it will also take all the arguments for that function. The user does not need to modify any of these arguments (e.g. event detection settings, `fc_future_period`), as `run_validation()` will automatically handle all of these adjustments for settings that are irrelevant for validation runs. It is envisioned that users can take their usual script for running EPIDEMIA forecasts, and simply sub in the validation function with those validation settings for doing model assessments. @@ -92,10 +92,11 @@ models if run with skill test comparison). Each model entry will have three item + `validation_overall`: Overall model accuracy statistics per timestep_ahead (week in the future) + `validation_grouping`: Accuracy statistics per geographic grouping per timestep_ahead + `validation_timeseries`: In beta-testing. Early version of a rolling validation results over time + + `validation_perweek`: Validation results per week entry (per geographic group per timestep_ahead) 3. `metadata`: Metadata on the parameters used to run validation and the date it was run. ## Results Display -For a formatted validation report, please look at the accompanying R project `epidemiar-demo` and the `run_validation_amhara.R` script in the validation folder, using the `epidemia_validation.Rnw` Sweave formatting script. +For a formatted validation report, please look at the accompanying R project `epidemiar-demo` and the `run_validation_amhara.R` script in the validation folder, using the `epidemia_validation.Rnw` formatting script. From 907e2452d3bba1fe419994d4fb2ed010109019e8 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 20:20:34 -0500 Subject: [PATCH 123/132] Automatic and vignette building documentation updates --- Meta/vignette.rds | Bin 324 -> 325 bytes doc/data-modeling.R | 2 +- doc/data-modeling.Rmd | 10 ++++++---- doc/output-report-data.R | 2 +- doc/output-report-data.Rmd | 6 +++--- doc/overview-epidemiar.R | 2 +- doc/overview-epidemiar.Rmd | 6 +++--- man/calc_val_stats.Rd | 2 +- man/run_validation.Rd | 8 ++++---- 9 files changed, 20 insertions(+), 18 deletions(-) diff --git a/Meta/vignette.rds b/Meta/vignette.rds index bb873aaae0c03ce6c449a621bfd2e56ca719238f..12cc76034202aa42da4d5caf08b09cb84f832fac 100644 GIT binary patch literal 325 zcmV-L0lNMliwFP!0000028~i}OT#b_PS-lOiTE;66v6(1?mq}+Uqm)U#IM1g8fco5 zW-Wg6hl}+ZuVtxKq~wyj=jlCnmpslGVPAt5uC;HqEV zl5iMf{*Y%$xaOKmFrW+K?5%7emO-J(iqy%!vT4GHPSs|*?v#6~$8OKBMy7H1b3HtIb2I_2LtH+7Q{0adu6dLd38W%_ zS=?m_0jI@Amm3{PC=02hmexZnkd=Tsf>I=q2`;zL^NObe{}4qUaiu`1403G Date: Tue, 23 Jun 2020 20:21:03 -0500 Subject: [PATCH 124/132] Version update to 3.1.0 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 40a1342..f07b098 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: epidemiar Type: Package Title: epidemiar: Create EPIDEMIA Environmentally-Mediated Disease Forecasts -Version: 3.1.0001 +Version: 3.1.0 Authors@R: c( person(given = c("Dawn", "M"), family = "Nekorchuk", email = "dawn.nekorchuk@ou.edu", role = c("aut", "cre")), From 1edf497a4e370ba70de61ff1cf3f644a555ab3d3 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Tue, 23 Jun 2020 23:22:46 -0500 Subject: [PATCH 125/132] Minor edits to vignettes --- Meta/vignette.rds | Bin 325 -> 337 bytes doc/overview-epidemiar.Rmd | 7 ++++--- vignettes/overview-epidemiar.Rmd | 7 ++++--- vignettes/validation-assessment.Rmd | 3 ++- 4 files changed, 10 insertions(+), 7 deletions(-) diff --git a/Meta/vignette.rds b/Meta/vignette.rds index 12cc76034202aa42da4d5caf08b09cb84f832fac..49f172af0d037c5f98352197cbf4efee073ca47a 100644 GIT binary patch literal 337 zcmV-X0j~ZZiwFP!0000028~kNO2a@9-CSC2MZ8oLMKM2+{(}(uBGMuvzAnwQE+*Nq z*(UhrhfCvRorESvk+8QpXXl*E?8}%jW;2&r%yw|=OmG_FIL6`PH^TKKWfiq=ANP`QA@hg5_R3$Aw1%bZ67ZwQ(AJj)=bR=j8lJXaPdwy9ECT=l(8i_p literal 325 zcmV-L0lNMliwFP!0000028~i}OT#b_PS-lOiTE;66v6(1?mq}+Uqm)U#IM1g8fco5 zW-Wg6hl}+ZuVtxKq~wyj=jlCnmpslGVPAt5uC;HqEV zl5iMf{*Y%$xaOKmFrW+K?5%7emO-J(iqy%!vT4GHPSs|*?v#6~$8OKBMy7 Date: Wed, 24 Jun 2020 12:29:02 -0500 Subject: [PATCH 126/132] Adding epi_transform option for a log+1 transformation for modeling --- R/forecasting_main.R | 18 ++++++++++++++++++ R/input_checks.R | 19 +++++++++++++++++++ R/run_epidemia.R | 16 ++++++++-------- vignettes/data-modeling.Rmd | 3 ++- 4 files changed, 47 insertions(+), 9 deletions(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index fd8b2ab..6ff04c2 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -395,6 +395,16 @@ forecast_regression <- function(epi_lag, #remake into tibble tibble::as_tibble() + #was transform requested, such that we need to back-transform now? + if (report_settings[["epi_transform"]] == "log_plus_one"){ + #log transform had been requested + #back-transform predictions, was transformed just before regression + epi_preds <- epi_preds %>% + #max used in case of very small predicted values (which would give strange results after subtracting 1) + #NAs intentionally propagate + dplyr::mutate(preds = pmax((exp(.data$preds) - 1), 0, na.rm = FALSE)) + } + if (report_settings[["dev_fc_fit_freq"]] == "once"){ #for single model fit, this has all the data we need, @@ -478,6 +488,14 @@ build_model <- function(fc_model_family, } else { #user supplied model family + #transform requested? + if (report_settings[["epi_transform"]] == "log_plus_one"){ + #log transform requested + #transforming here just before regression, will back-transform predictions + epi_input <- epi_input %>% + dplyr::mutate(cases_epidemiar = log(.data$cases_epidemiar + 1)) + } + #Formula override: developer mode if (!is.null(report_settings[["dev_fc_formula"]])){ message("DEVELOPER: Using user-supplied formula: ", report_settings[["dev_fc_formula"]]) diff --git a/R/input_checks.R b/R/input_checks.R index 33ab13c..c83b58d 100644 --- a/R/input_checks.R +++ b/R/input_checks.R @@ -638,6 +638,25 @@ input_check <- function(epi_data, "weekISO" }) + #epi_transform + # if provided, prepare for matching + if (!is.null(raw_settings[["epi_transform"]])){ + new_settings[["epi_transform"]] <- tolower(raw_settings[["epi_transform"]]) + } else { + #if not provided/missing/null + #nothing checks in case it in "none", but set for clarity, esp. in metadata + new_settings[["epi_transform"]] <- "none" + } + #try match + new_settings[["epi_transform"]] <- tryCatch({ + match.arg(new_settings[["epi_transform"]], c("none", "log_plus_one")) + }, error = function(e){ + warn_flag <- TRUE + warn_msgs <- paste0(warn_msgs, "Given 'epi_transform'", raw_settings[["epi_transform"]], + "does not match 'none' or 'log_plus_one', running as 'none'.\n") + "none" + }) + # 5. Early Detection settings -------------------------------------------------------- diff --git a/R/run_epidemia.R b/R/run_epidemia.R index 6ef6224..d355be4 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -79,8 +79,14 @@ #' #' \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given #' epidemiological data be linearly interpolated for any explicitly missing -#' values before modeling? Note: epidemiological data cannot have implicit -#' missing data (missing row as opposed to a row with NA). +#' values before modeling? +#' +#' \item \code{epi_transform} = "none" (default if not set): Should the case +#' counts be transformed just before regression modeling and backtransformed +#' directly after prediction/forecast creation? The current only supported +#' transformation is "log_plus_one", where log(cases + 1) is modeled and +#' back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in +#' case of small predicted values). #' #' \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate #' the model regression object plus metadata. This model can be cached and used @@ -536,12 +542,6 @@ run_epidemia <- function(epi_data = NULL, #copy over value dplyr::mutate(val_epidemiar = !!quo_valuefield) - #not needed, cut for speed. Will be sorted in extend_env_future - # %>% - # #and sort by alphabetical groupfield - # dplyr::arrange(!!quo_groupfield, !!quo_obsfield, .data$obs_date) - - # Set up output report data format ---------------------------------------- diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index fde2f6e..c82a646 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -118,7 +118,8 @@ Many of the settings are bundled into the named list `report_settings` argument. * `report_settings$report_value_type`: How to report the results, either in terms of "cases" (default) or "incidence". If 'incidence', population data must be supplied in the `epi_data` under `{populationfield}`. * `report_settings$report_inc_per`: If reporting incidence, what should be denominator be? Default is per 1000 persons, and ignored if `report_settings$report_value_type = "cases"`. * `report_settings$epi_date_type`: What type of weekly dates are the epidemiological data (and environmental reference data) in? This would be a string indicating the standard used: "weekISO" for WHO ISO-8601 weeks (default), or "weekCDC" for CDC epi weeks. Required: epidemiological observation dates listed are LAST day of the given week. -* `report_settings$epi_date_type`: Should the epidemiological data be linearly interpolated for any missing values? Boolean value, default is FALSE. +* `report_settings$epi_interpolate`: Should the epidemiological data be linearly interpolated for any missing values? Boolean value, default is FALSE. +* `report_settings$epi_transform`: Should the case counts be transformed before creating the regression model and then back-transformed after predicting? Default is "none". Current option is for "log_plus_one": where log(cases + 1) is modeled and back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in case of small predicted values). ### Setting up for Forecasting From 44b82a7ba3856f29bec928173b14981fe67e0723 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 24 Jun 2020 12:29:27 -0500 Subject: [PATCH 127/132] Automatically generated documentation updates --- doc/data-modeling.Rmd | 3 ++- man/build_equation.Rd | 10 ++++++++-- man/build_model.Rd | 10 ++++++++-- man/create_predictions.Rd | 10 ++++++++-- man/forecast_regression.Rd | 10 ++++++++-- man/format_lag_ca.Rd | 10 ++++++++-- man/lag_environ_to_epi.Rd | 10 ++++++++-- man/run_epidemia.Rd | 10 ++++++++-- man/run_forecast.Rd | 10 ++++++++-- man/run_validation.Rd | 10 ++++++++-- 10 files changed, 74 insertions(+), 19 deletions(-) diff --git a/doc/data-modeling.Rmd b/doc/data-modeling.Rmd index fde2f6e..c82a646 100644 --- a/doc/data-modeling.Rmd +++ b/doc/data-modeling.Rmd @@ -118,7 +118,8 @@ Many of the settings are bundled into the named list `report_settings` argument. * `report_settings$report_value_type`: How to report the results, either in terms of "cases" (default) or "incidence". If 'incidence', population data must be supplied in the `epi_data` under `{populationfield}`. * `report_settings$report_inc_per`: If reporting incidence, what should be denominator be? Default is per 1000 persons, and ignored if `report_settings$report_value_type = "cases"`. * `report_settings$epi_date_type`: What type of weekly dates are the epidemiological data (and environmental reference data) in? This would be a string indicating the standard used: "weekISO" for WHO ISO-8601 weeks (default), or "weekCDC" for CDC epi weeks. Required: epidemiological observation dates listed are LAST day of the given week. -* `report_settings$epi_date_type`: Should the epidemiological data be linearly interpolated for any missing values? Boolean value, default is FALSE. +* `report_settings$epi_interpolate`: Should the epidemiological data be linearly interpolated for any missing values? Boolean value, default is FALSE. +* `report_settings$epi_transform`: Should the case counts be transformed before creating the regression model and then back-transformed after predicting? Default is "none". Current option is for "log_plus_one": where log(cases + 1) is modeled and back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in case of small predicted values). ### Setting up for Forecasting diff --git a/man/build_equation.Rd b/man/build_equation.Rd index 0023246..f107e98 100644 --- a/man/build_equation.Rd +++ b/man/build_equation.Rd @@ -46,8 +46,14 @@ trimmed to data being used to create the model} \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/build_model.Rd b/man/build_model.Rd index 4bcb6a5..818824a 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -53,8 +53,14 @@ data and groupings converted to factors.} \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/create_predictions.Rd b/man/create_predictions.Rd index 377ef89..fa5e333 100644 --- a/man/create_predictions.Rd +++ b/man/create_predictions.Rd @@ -47,8 +47,14 @@ input "poisson()". If a cached model is being used, set the parameter to \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index e8159ea..72ad635 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -55,8 +55,14 @@ input "poisson()". If a cached model is being used, set the parameter to \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/format_lag_ca.Rd b/man/format_lag_ca.Rd index 845ef06..4ed69c2 100644 --- a/man/format_lag_ca.Rd +++ b/man/format_lag_ca.Rd @@ -38,8 +38,14 @@ that are being used in the model.} \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/lag_environ_to_epi.Rd b/man/lag_environ_to_epi.Rd index a569d20..bd904c6 100644 --- a/man/lag_environ_to_epi.Rd +++ b/man/lag_environ_to_epi.Rd @@ -48,8 +48,14 @@ run_epidemia().} \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/run_epidemia.Rd b/man/run_epidemia.Rd index bec5f36..f659b42 100644 --- a/man/run_epidemia.Rd +++ b/man/run_epidemia.Rd @@ -89,8 +89,14 @@ input "poisson()". If a cached model is being used, set the parameter to \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index 2cdb845..faa878f 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -84,8 +84,14 @@ input "poisson()". If a cached model is being used, set the parameter to \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used diff --git a/man/run_validation.Rd b/man/run_validation.Rd index b479264..0991d1e 100644 --- a/man/run_validation.Rd +++ b/man/run_validation.Rd @@ -122,8 +122,14 @@ input "poisson()". If a cached model is being used, set the parameter to \item \code{epi_interpolate} = FALSE: TRUE/FALSE flag for if the given epidemiological data be linearly interpolated for any explicitly missing - values before modeling? Note: epidemiological data cannot have implicit - missing data (missing row as opposed to a row with NA). + values before modeling? + + \item \code{epi_transform} = "none" (default if not set): Should the case + counts be transformed just before regression modeling and backtransformed + directly after prediction/forecast creation? The current only supported + transformation is "log_plus_one", where log(cases + 1) is modeled and + back-transformed by exp(pred) - 1 (though pmax(exp(pred) - 1, 0) is used in + case of small predicted values). \item \code{model_run} = FALSE: TRUE/FALSE flag for whether to only generate the model regression object plus metadata. This model can be cached and used From 65a40cf9efcae4790528184eb72a553787fe5af4 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Wed, 24 Jun 2020 17:26:03 -0500 Subject: [PATCH 128/132] Backing down base R minimum to 4.0.0 (base-level packages) --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f07b098..ebdab35 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,12 +25,12 @@ Imports: dplyr (>= 1.0.0), magrittr (>= 1.5), methods, mgcv (>= 1.8-31), - parallel (>= 4.0.1), + parallel (>= 4.0.0), pracma (>= 2.2.9), readr (>= 1.3.1), rlang (>= 0.4.6), surveillance (>= 1.18.0), - splines (>= 4.0.1), + splines (>= 4.0.0), tibble (>= 3.0.1), tidyr (>= 1.1.0), zoo (>= 1.8-8) From d7aa8bcf97f91b9a5dc9b06665bd268c585eecdc Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 25 Jun 2020 16:37:18 -0500 Subject: [PATCH 129/132] Reworked messaging for during a validation run to reduce messages to console --- R/event_detection.R | 10 +++++--- R/forecasting_main.R | 58 +++++++++++++++++++++++++++++--------------- R/model_validation.R | 2 +- R/run_epidemia.R | 12 +++------ 4 files changed, 51 insertions(+), 31 deletions(-) diff --git a/R/event_detection.R b/R/event_detection.R index 0503fec..c817dff 100644 --- a/R/event_detection.R +++ b/R/event_detection.R @@ -23,7 +23,8 @@ #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#' +#'@param valid_run Internal TRUE/FALSE for whether this is part of a validation +#' run. #' #'@return Returns a list of three generated series: "ed" : early detection #' alerts (ed period of most recent epi data) "ew" : early warning alerts @@ -39,7 +40,8 @@ run_event_detection <- function(epi_fc_data, inc_per, #internal/calc groupings, - report_dates){ + report_dates, + valid_run){ #message("Running early detection...") #only supporting Farrington Improved method from Surveillance right now, @@ -61,7 +63,9 @@ run_event_detection <- function(epi_fc_data, } else if (ed_method == "none") { - message("Skipping early detection...") + if(!valid_run){ + message("Skipping early detection...") + } ed_far_res <- run_no_detection(epi_fc_data, quo_groupfield, report_dates) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 6ff04c2..0441950 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -14,7 +14,8 @@ #'@param report_dates Internally generated set of report date information: min, #' max, list of dates for full report, known epidemiological data period, #' forecast period, and early detection period. -#'@param valid_run Internal TRUE/FALSE for whether this is part of a validation run. +#'@param valid_run Internal TRUE/FALSE for whether this is part of a validation +#' run. #' #'@inheritParams run_epidemia #' @@ -47,8 +48,15 @@ run_forecast <- function(epi_data, env_variables, report_dates){ - message("Preparing for forecasting...") + #flag for naive models in validation runs + naive <- ifelse((fc_model_family == "naive-persistence" | + fc_model_family == "naive-averageweek"), + TRUE, + FALSE) + if(!valid_run){ + message("Preparing for forecasting...") + } # trim to the needed env variables as dictated by the model env_data <- pull_model_envvars(env_data = env_data, @@ -97,7 +105,7 @@ run_forecast <- function(epi_data, # note: brittle on format from env_format_fc(), edit with caution # AND not a naive model run - if (!fc_model_family == "naive-persistence" & !fc_model_family == "naive-averageweek"){ + if (!naive){ if (report_settings[["env_anomalies"]]){ message("Anomalizing the environmental variables...") env_fc <- anomalize_env(env_fc, @@ -138,7 +146,9 @@ run_forecast <- function(epi_data, groupings, env_variables_used, report_dates, - req_date = report_dates$full$max) + req_date = report_dates$full$max, + valid_run, + naive) model_run_only <- create_named_list(env_variables_used, env_dt_ranges, @@ -159,7 +169,9 @@ run_forecast <- function(epi_data, groupings, env_variables_used, report_dates, - req_date = report_dates$full$max) + req_date = report_dates$full$max, + valid_run, + naive) preds_catch <- forereg_return$date_preds reg_obj <- forereg_return$regress @@ -180,7 +192,9 @@ run_forecast <- function(epi_data, groupings, env_variables_used, report_dates, - req_date = dt) + req_date = dt, + valid_run, + naive) dt_preds <- forereg_return$date_preds preds_catch <- rbind(preds_catch, as.data.frame(dt_preds)) @@ -279,6 +293,7 @@ run_forecast <- function(epi_data, #'@param req_date The end date of requested forecast regression. When fit_freq #' == "once", this is the last date of the full report, the end date of the #' forecast period. +#'@param naive Internal TRUE/FALSE flag on if this is a naive-model run. #' #'@inheritParams run_epidemia #'@inheritParams run_forecast @@ -297,7 +312,9 @@ forecast_regression <- function(epi_lag, groupings, env_variables_used, report_dates, - req_date){ + req_date, + valid_run, + naive){ if (report_settings[["dev_fc_fit_freq"]] == "once"){ @@ -319,17 +336,13 @@ forecast_regression <- function(epi_lag, epi_lag <- epi_lag %>% dplyr::mutate(!!rlang::as_name(quo_groupfield) := factor(!!quo_groupfield)) - # if (report_settings[["fc_cyclicals"]] == TRUE){ - # # create a doy field so that we can use a cyclical spline - # epi_lag <- dplyr::mutate(epi_lag, doy = as.numeric(format(.data$obs_date, "%j"))) - # } - if (!fc_model_family == "naive-persistence" & !fc_model_family == "naive-averageweek"){ if (report_settings[["fc_splines"]] == "modbs"){ # create modified bspline basis in epi_lag file to model longterm trends epi_lag <- cbind(epi_lag, truncpoly(x=epi_lag$obs_date, degree=6, - maxobs=max(epi_lag$obs_date[epi_lag$input==1], na.rm=TRUE))) + maxobs=max(epi_lag$obs_date[epi_lag$input==1], + na.rm=TRUE))) } } @@ -348,7 +361,9 @@ forecast_regression <- function(epi_lag, epi_lag, report_settings, #calc/internal - env_variables_used) + env_variables_used, + valid_run, + naive) } else { #if model_cached given, then use that as regress instead of building a new one (above) @@ -356,15 +371,16 @@ forecast_regression <- function(epi_lag, model_cached <- report_settings[["model_cached"]] #message with model input - message("Using given cached ", model_cached$model_info$fc_model_family, " model, created ", - model_cached$model_info$date_created, ", with epidemiological data up through ", + message("Using given cached ", model_cached$model_info$fc_model_family, + " model, created ", model_cached$model_info$date_created, + ", with epidemiological data up through ", model_cached$model_info$known_epi_range$max, ".") regress <- model_cached$model_obj } ## Error check all model results if using batch_bam/tp - if (!fc_model_family == "naive-persistence" & !fc_model_family == "naive-averageweek"){ + if (!naive){ if (report_settings[["fc_splines"]] == "tp"){ check_bb_models(regress) } @@ -435,6 +451,7 @@ forecast_regression <- function(epi_lag, #' #'@inheritParams run_epidemia #'@inheritParams run_forecast +#'@inheritParams forecast_regression #' #'@return Regression object #' @@ -444,7 +461,9 @@ build_model <- function(fc_model_family, epi_input, report_settings, #calc/internal - env_variables_used){ + env_variables_used, + valid_run, + naive){ #1. check and handle naive models # else is the user supplied model family @@ -498,7 +517,8 @@ build_model <- function(fc_model_family, #Formula override: developer mode if (!is.null(report_settings[["dev_fc_formula"]])){ - message("DEVELOPER: Using user-supplied formula: ", report_settings[["dev_fc_formula"]]) + message("DEVELOPER: Using user-supplied formula: ", + report_settings[["dev_fc_formula"]]) reg_eq <- report_settings[["dev_fc_formula"]] #note, if using formula override AND cyclicals, # dev users should put fc_cyclicals = TRUE, else message about discrete ignored. diff --git a/R/model_validation.R b/R/model_validation.R index c8edcf8..b054399 100644 --- a/R/model_validation.R +++ b/R/model_validation.R @@ -198,7 +198,7 @@ run_validation <- function(date_start = NULL, this_fc_start <- this_dt + lubridate::weeks(1) this_report_settings$fc_start_date <- this_fc_start - message("Validation run - date: ", this_dt) + message("Validation run: ", this_dt) #set up data #censoring as appropriate diff --git a/R/run_epidemia.R b/R/run_epidemia.R index d355be4..34ac7de 100644 --- a/R/run_epidemia.R +++ b/R/run_epidemia.R @@ -256,7 +256,7 @@ run_epidemia <- function(epi_data = NULL, } else {calling_function <- "directly"} if(calling_function == "run_validation" | calling_function == "epidemiar::run_validation"){ valid_run <- TRUE - message("Running model validation...") + #message("Running model validation...") #rename already enquo'd variables quo_casefield <- casefield quo_popfield <- populationfield @@ -531,12 +531,7 @@ run_epidemia <- function(epi_data = NULL, } - #Note: val_epidemiar is field name returned (env) - ##interpolation is no longer necessary with new extend_env_future() - #env_data <- env_NA_interpolate(env_data, quo_obsfield, quo_valuefield, quo_groupfield) %>% - ##first, mark which ones during known time range were observed versus (will be) interpolated - #dplyr::mutate(data_source = ifelse(!is.na(!!quo_valuefield), "Observed", "Interpolated")) %>% - + #Note: val_epidemiar is field name (env) #prep environmental data, filling in of missing data will happen in extend_env_future() env_data <- env_data %>% #copy over value @@ -713,7 +708,8 @@ run_epidemia <- function(epi_data = NULL, val_type = report_settings[["report_value_type"]], inc_per = report_settings[["report_inc_per"]], groupings, - report_dates) + report_dates, + valid_run) # Combining forecast and event detection results -------------------------- From 257efce0b734419361172c6b60189b7391a96881 Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 25 Jun 2020 16:37:34 -0500 Subject: [PATCH 130/132] Automatic documentation updates --- man/build_model.Rd | 9 ++++++++- man/extend_env_future.Rd | 3 ++- man/forecast_regression.Rd | 9 ++++++++- man/run_event_detection.Rd | 6 +++++- man/run_forecast.Rd | 3 ++- 5 files changed, 25 insertions(+), 5 deletions(-) diff --git a/man/build_model.Rd b/man/build_model.Rd index 818824a..82a3772 100644 --- a/man/build_model.Rd +++ b/man/build_model.Rd @@ -9,7 +9,9 @@ build_model( quo_groupfield, epi_input, report_settings, - env_variables_used + env_variables_used, + valid_run, + naive ) } \arguments{ @@ -147,6 +149,11 @@ data and groupings converted to factors.} \item{env_variables_used}{a list of environmental variables that will be used in the modeling (had to be listed in model variables input file and present the env_data and env_info datasets)} + +\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation +run.} + +\item{naive}{Internal TRUE/FALSE flag on if this is a naive-model run.} } \value{ Regression object diff --git a/man/extend_env_future.Rd b/man/extend_env_future.Rd index e0bb6d9..af77b11 100644 --- a/man/extend_env_future.Rd +++ b/man/extend_env_future.Rd @@ -54,7 +54,8 @@ input "poisson()". If a cached model is being used, set the parameter to \item{epi_date_type}{Extract from `report_settings$epi_date_type`} -\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation run.} +\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation +run.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} diff --git a/man/forecast_regression.Rd b/man/forecast_regression.Rd index 72ad635..0479cf6 100644 --- a/man/forecast_regression.Rd +++ b/man/forecast_regression.Rd @@ -12,7 +12,9 @@ forecast_regression( groupings, env_variables_used, report_dates, - req_date + req_date, + valid_run, + naive ) } \arguments{ @@ -158,6 +160,11 @@ forecast period, and early detection period.} \item{req_date}{The end date of requested forecast regression. When fit_freq == "once", this is the last date of the full report, the end date of the forecast period.} + +\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation +run.} + +\item{naive}{Internal TRUE/FALSE flag on if this is a naive-model run.} } \value{ Named list containing: diff --git a/man/run_event_detection.Rd b/man/run_event_detection.Rd index f295c5e..8f45bab 100644 --- a/man/run_event_detection.Rd +++ b/man/run_event_detection.Rd @@ -13,7 +13,8 @@ run_event_detection( val_type, inc_per, groupings, - report_dates + report_dates, + valid_run ) } \arguments{ @@ -46,6 +47,9 @@ report_settings$report_value_type is 'cases'.} \item{report_dates}{Internally generated set of report date information: min, max, list of dates for full report, known epidemiological data period, forecast period, and early detection period.} + +\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation +run.} } \value{ Returns a list of three generated series: "ed" : early detection diff --git a/man/run_forecast.Rd b/man/run_forecast.Rd index faa878f..ace3292 100644 --- a/man/run_forecast.Rd +++ b/man/run_forecast.Rd @@ -175,7 +175,8 @@ input "poisson()". If a cached model is being used, set the parameter to }} -\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation run.} +\item{valid_run}{Internal TRUE/FALSE for whether this is part of a validation +run.} \item{groupings}{A unique list of the geographic groupings (from groupfield).} From 3df11873c0b3b0633e729a18a3b0f3c0f3464e9d Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Thu, 25 Jun 2020 18:02:48 -0500 Subject: [PATCH 131/132] Escaped backtransformation for naive models during validation run --- R/forecasting_main.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/forecasting_main.R b/R/forecasting_main.R index 0441950..36f825d 100644 --- a/R/forecasting_main.R +++ b/R/forecasting_main.R @@ -70,6 +70,7 @@ run_forecast <- function(epi_data, dplyr::summarize(start_dt = min(.data$obs_date), end_dt = max(.data$obs_date)) # extend data into future, for future forecast portion + # also gap fills any missing data env_data_extd <- extend_env_future(env_data, quo_groupfield, quo_obsfield, @@ -412,7 +413,9 @@ forecast_regression <- function(epi_lag, tibble::as_tibble() #was transform requested, such that we need to back-transform now? - if (report_settings[["epi_transform"]] == "log_plus_one"){ + #Note: Not for naive models in validation runs + if (!naive & + report_settings[["epi_transform"]] == "log_plus_one"){ #log transform had been requested #back-transform predictions, was transformed just before regression epi_preds <- epi_preds %>% From 1586ea8fdb483fbadc0972ba4a0ffe54036e926a Mon Sep 17 00:00:00 2001 From: michdn <28901045+michdn@users.noreply.github.com> Date: Fri, 26 Jun 2020 10:57:12 -0500 Subject: [PATCH 132/132] Minor corrections to vignettes --- vignettes/data-modeling.Rmd | 14 +++++++------- vignettes/overview-epidemiar.Rmd | 8 ++++---- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/vignettes/data-modeling.Rmd b/vignettes/data-modeling.Rmd index c82a646..69563d1 100644 --- a/vignettes/data-modeling.Rmd +++ b/vignettes/data-modeling.Rmd @@ -6,16 +6,16 @@ author: | | dawn.nekorchuk@ou.edu; mcwimberly@ou.edu date: "Updated `r format(Sys.time(), '%B %d, %Y')`" output: - rmarkdown::html_vignette: - fig_caption: yes - html_document: - df_print: paged - toc: yes - toc_depth: '2' pdf_document: number_sections: yes toc: yes toc_depth: 2 + html_document: + df_print: paged + toc: yes + toc_depth: '2' + rmarkdown::html_vignette: + fig_caption: yes vignette: | %\VignetteIndexEntry{Modeling Data and Parameters} %\VignetteEncoding{UTF-8} @@ -124,7 +124,7 @@ Many of the settings are bundled into the named list `report_settings` argument. ### Setting up for Forecasting -*`fc_model_family`: The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). This is required, with no default. +*`fc_model_family`: The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`) or Gaussian (`fc_model_family = "gaussian()"` and note that you may also want to set `epi_transform = "log_plus_one`). This is required, with no default. Besides `fc_model_family`, the rest of the forecasting controls (along with other settings) are bundled into the named list `report_settings`: diff --git a/vignettes/overview-epidemiar.Rmd b/vignettes/overview-epidemiar.Rmd index 7e0e1d2..15f4946 100644 --- a/vignettes/overview-epidemiar.Rmd +++ b/vignettes/overview-epidemiar.Rmd @@ -69,7 +69,7 @@ The main requirements for using this package are: The epidemiar package is flexible on many aspects of modeling. It is all based on general additive model (GAM) regression of multiple factors, including lagged environmental drivers, long term trends, and potentially several other factors such as geographic group, seasonality, and clustering of geographic groups. -The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`). +The modeling utilizes `mgcv::bam()`, so the model form can be any accepted by it - any quadractically penalized GLM with the extended families in family.mgcv also being available. This is user set with the `fc_model_family` parameter. For example, you can run regression with a Poisson distribution (`fc_model_family = "poisson()"`) or a Gaussian (`fc_model_family = "gaussian()`). For a Gaussian or other relevant models, there is also a log(cases)+1 transformation (and corresponding back-transformation of predicted values) with `epi_transform = "log_plus_one`. ## Timeframes @@ -84,7 +84,7 @@ Each geographic group, $geo$, identified in the `groupfield` column is included Each geographic group also has a long term trend component. The long-term trend (and the lagged environmental data, see below) has two options. -Option 1) With the installation of a companion package (`clusterapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `clusterapply` is installed). A smooth term is created for length of history for that geogroup: $s(numericdate, bs = "tp", by = geo)$ +Option 1) This is the recommended option. With the installation of a companion package (`clusterapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `clusterapply` is installed). A smooth term is created for length of history for that geogroup: $s(numericdate, bs = "tp", by = geo)$ Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), where $geo$ is multiplied by each of 5 modified basis splines: $bs_1 * geo + bs_2 * geo + bs_3 * geo + bs_4 * geo + bs_5 * geo$. The modified basis splines are created by first using `splines::bs()` to create basis splines over the range of observations with degree 6. Then to reduce the edge effects of using splines, the following modifications are performed: the last basis spline function is reverse, and the second to last basis spline function is removed. @@ -114,9 +114,9 @@ We allow the user to identify their own clusters of geographic units with `repor For modeling the lagged environmental drivers by cluster, there are two options: -Option 1) With the installation of a companion package (`clusterapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `clusterapply` is installed). The `clusterapply` package is our wrapper over some of the mgcv functions so that we can use thin plate splines for each lagged environmental variable by cluster. Thin plate splines are more effective at capturing complex, non-linear relationships and our preliminary analyses show that using thin plate splines produce better predictions without overfitting. To allow for clusters that may have only one geogroup in that cluster, a fall-back equation without geogroup as a factor is also constructed and tried in case of model failure. +Option 1) This is the recommended option. With the installation of a companion package (`clusterapply`), thin plate splines are used instead (`report_settings$fc_splines = "tp"` and the default when `clusterapply` is installed). The `clusterapply` package is our wrapper over some of the mgcv functions so that we can use thin plate splines for each lagged environmental variable by cluster. Thin plate splines are more effective at capturing complex, non-linear relationships and our preliminary analyses show that using thin plate splines produce better predictions without over-fitting. To allow for clusters that may have only one geogroup in that cluster, a fall-back equation without geogroup as a factor is also constructed and tried in case of model failure. -Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), a distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of lag length, for every combination of group, week, and environmental anomaly covariate. +Option 2) Using modified b-splines (`report_settings$fc_splines = "modbs"`), a distributed lag basis is created with the natural cubic splines function (ns, splines library), including intercept, with knots at 25%, 50%, and 75% of the lag length. The 5 basis functions that result are multiplied by each group's history, so that there are just 5 summary statistics, instead of lag length, for every combination of group, week, and environmental anomaly co-variate.

aumetu^)ug%xz z%-n#Lh5Lovp48+B6NZ-Sk^~pneLLp+ahkL*FF?ao`-JJ85r_G6%5dLLulYkN1u6V z*BmZ1{7{FZsV`Q*&}z69>&EwHj8HP``=&%V#G|Y`V?>!Rg~^MJjt2$8E}c9vD}ka0 z8t`}_d?m)rl+gP})nTX2#Mbn>Ddm>j7+RW{54%do71GiO7?xCoavs*8BWRQPl#APi zvN^M(NWz~IZ=Yx)7|-mV8VA3^pK5@+0;$Czg_~%ndA-s8KMF;C7!P+h=R9-=B>sAZ zup}Y}WY^#_U3SXftZc~_p1of8Ek72z&8$w`;Q3d|I24!{q zkf*Lu5K3t*7#jip`koYQ@6!iU>@~`Pj4kJVN|XtK&zAP3YYZ3`%1cs@Z0vB?s?C2f zL656rhe$UkY5HhvrMm)ur-e3Bu4x87nj_UL;4S)`j7I?0C=kX~u;TM$cI0JL&ul;P zf`EDyqq7376SJX5M8hUnwXvdldS;5#av6b)Ul{bvM-`ud4y}8GvT>F&6Ypd*&@>xf zrCH%zMnL>wT}^IoD{63(zwa-h8T%?~6uJA5opa-^p4!%jXzg{fFi1CnhljTZNMA%x zj~D@)F?g`Gj}PS|@G2(E20sUEa=MMf@DewZCq&iB0k#WRJKcs#{dvJ>1x1QQU7;Ttfu3)_wWB4yo%aJyo9!#a{h04MIzsr|jZj5F`@1BZJUB z>eb87AR3y-8^|fHnSqrxu%)k27Ax)iNCs8fZN#zFxBL4*B42C_B;J-@#w%!EQcA8V z%I8-(8uL{u#HlE(&xC5tv~l-3grB;Zs%w5iotd;vCZ0!i!23)!-Y;9~uCFqc%A`l~ zOd&39ncm7NpqC-^Icz?0^P9&UM})js@^I`TgoSnpr;EX_sHPg=xxdbw7uh|8r^}fQ znpvrgH1>jddiiFy<73sig5+c{i+(HN44ghWL6ln^&OZiicU*tFe zLpAE2ES%q==MVroO5LCU`f3KY9uQ(LT2%i^zvA0%)aUnhl)qu1so#sR)xYo+84G$% z@Z+|PL^4nh8%nDKhR3iA_$% zLbCprk({EJ^ZdkVE1$~>QI)L1>w^q9+;$|U*>PBTe&avQZ6_X=8!VFT@p>)73H3x& zX}l~uK6=bcLJ}6cRD6_(gzvt;R^z>DFZ`Y&jUln8|IseHb@{K86A$t7uOn#;n@9UC zD?eiT;}@KWY%?7pWW#@1XT60WEDyv{b^@D+Vlf?PZ!AYbSRLV1bGDT2QR@?4g8>*0WCu9CI@;lB;LZcW+KsW}MW<7709d)khj z(?{UVl3;?5^w-JY!>_C$d(Zqnz=fx&S?41#@aNMq> z?l!=5_8+Dn%7AjgR4v(T6xq8Lsw*rYc)$bQ>& z9O;vd-S5gF-l>Ets#)xn*}bPoT8@oA zHy%4kOJ9cGO`%_FEwfRW&PkyvO_YI6m87E?kP6<6w?@J9VmPA8&ndyxRtG96 zSo^&ak2JcvY5bN|DBTc#w`l*KPdB7^!^1#P^qTFxc$sJ}mjyc33woo|n0dNvmOHn3 z?!vFhQofz8+6NmA|L>v3vH1E7bo7sBbtWyhL1z#(qXt^5 zJ+-fiUS+CAID-a4E~8gzzbMsyeEMbWP^M{m8?MXD7e!MEjx?AiEsF0U8x5})X%G(C z5H)+?*#*^#XnLJoL^*BIr>HN`p3Hlm%;HN*qoIUSB7@I&!V1wZHdyg4_mj0pzjVh`Vw(< zvM1rPB#ca(-CaMjeMjoih$LF~Ekqt6={Ps*0bi<+JzFHPfH*(}RU;cFo7`e5}Tv zU!afOzK|O0s3Q2WVv3s*1PR$%(UropSX64iR>p#t0G}fYa4;(2S<@sr*y$j#_z1_A z{IkG&{!&|DFQAM9Lys($W;TkdV&;Jy$w4NAu;n;SO?}z&gGbrTr=ONTjR{3AQ+I8T z#v7$0;o9z3g;50iqJ93n96k}#F(pVVqPCeq(ptL8BodR;R5}fY*&plz_eGA|tx^^WiP@y{AdQ-rL zOZK5B(FAjVbp5Ph!s1Ccr@q%iqUH;`&KWusmeh%T?&(*7)nW$g-~rAI zc(2NLYF5@#R2h|>BGR}nk2G{F1hxXXkMX-TxObH-6CU!Bi~B3ET4^EP6ea^&`P}Yu zWHXY8#Sy=Mu2|vE;+sUjL}pT%na>cI=ToV+P9Ej=jz0O;C6lF5Z-k>;mRA%Ly11#) zgtCiU$*rxsmV{8q!o$uMC24EyxK-J}scS_cXy{qgTVibzkBbC=Xv8=uH^#Z z%x7lLp1o&=a;(0N*>Lk>M#9;NM`l?Oi!b1@!!2%YEk>37{=-u?;eDbdlftfPRqqT- zwHb^?7I1$%Gr3Om->+Y|1OTzDrj%z;BJdT>6{J|tQwZ8GYe*K+PJNa89vg!F{)1&K zQ1E3a-IeN(Ol8ZR zxTqosBcriYys2bz{7t19hPlFu=}J2sG^)h))C2Y>wt3}|FzZjdby~{dX7hUbR zhMao_=~|@!ew^=i_DnAx-udZ}9am0`0B%Y-qu*Etl1$$gxFTFtYFVPPt4ZCw1v&Qm z$OdYZqjvRGWlN5v=B)cQOT|^Lfs0dCX9H_ra{w=8KlYUKo~o22`XM!SEdi%NUkYNo zhx}?ltH_O!2Uc}7rF|r~IYu4&LDPnr%9$_z?N3833eozQe?k3S0nPphTd!d|jlV>J zxqE`9==Yif`6l}}ut6M=Dx|3^1Th)ayB0aTDXaVb5>FyK`iFM9#C`J&vK7sn zRhI3zyJ^NSqpy&!ZwF0vWdS3SK!vX>u9Kv5Y?MTzcjqeS2r2+$CjJHI` zGpTFPQlUjPr`*2Y-MUt(+o1vGe^bN3P$K7{|*}+!gGLS7u5*0 zj#RI%la+J%&wPH4zZJAtFSCRM@;?JI@I1E_x(s$^iT$BfgAE3x+hgvW%*s9MQPl+2 zF~Rv`q&zH>6RHVk$}6Tiu2Qo@1q5@q;KReeN_kj^w{aZXg+xvu@=W>hw+E?j2uu$( z-|}(hz_F&<9i~F@Y3B@ez<|;Sp4nLUm9|rTNZZWNt@|q2zpAY)-0q!y**MUN(DsB~ z?u7HA{6i*ljnJLBX%zpi!U^)3(HM%h+5FuHJE_0GoO$*+yvV^pNSQSd9 zLyFbDzA~+1v2e9fJX`L_QoiX=Mg%do<`hg)_|(wd#V|RGeaOw7Lxsl;7)4t@aIyYN zQNuW;{F<8xrv{W~^zApfo_9EbX3+4(LkbG+aCJ(V4`5FTv@xGQryq@ZZHwd)fFyMk zqzX$OE~sv*gX`zZM*jBTtoGv!27TgCGaYK_3<`JK@y2~cWQft>db+`+KB2+psWXP7 zm9ywmse?al(_cad%53Yf>grDwn{zk-2o!cPO}b1kMVXmj*XxN@);Bt@VXo%eHy+V$ zC9C*iD>9o^Rt0E~PrE*2TV|hwImbN0_akoIAZ`L4=juFFeK|4C5*o>&naj#7%b#Dc zsbwb8Y)-#{x1zE`HRU;`*RZJ~1rpEh0=I-Be7Tn-Z84 z_6iDKxH3Qn|7{{+%{~imue$2pEETZ_KYThVVShuweAD%>>g89|G;A6Wr?mWa+B%Ai zMCB73;(xY;Fw*xEW{=TiYIDzn*GufBN0+wPx1X)6hx}xl!7qpIZ$P0Xnlf-Y+|(Q! zO2(-&y-wwHS7uiu{^~oM`)DpD&Fa}aFdSBk47R^4RE{&FZj+(41?-vnrNqz&lZau1 ztKJYsj154`a_}UjPH|=zyk-2K^0qdxc(A9UW9zi8Nkb~{vf`gZt54}hU%iL&JJk_C zIvN%C4EjM_udhruzQ)v(pYf&CQc}0B?Q{5gyg?*{PeYfEslxJ)8FZSAWLm1SeF?gB zNwXzc(pCIYNW+wHl*$V9m+=!H&k-i4^e3t$61YE^MHqOfN*!?2G*C8$-r+RdC(Wfn zZb29!xU7|t<`l0`0s|)Z@3(gT&7tq?YCiR+Eu({Ied}4wu!X@_SzVEpiuOF zQ_{J}cRxhbf#nxMN{-^=Ca9JARn*?c1m*CU>d<2rQ_nOvsDJ@Yeg#TPDQ#09;1)3m z5Er5s*%LiK;DRk9wTtY({pl~}I{W41-0JsMwt!Q6`Dh7vl(wy}% z+NPo5;LtF{b=~Lq?;IWF^)GpW_b(#^AE*k9dJ9Dv!S=|n7)FM;n4Eb_Ee<#WK1IV97#PBHkjF5$ z^-4zIOv1a9k%g#T>10DAiiqaEouPQlCD+eAcBRGbG*X1VbgLJL{Q>w-Fx{Q8B=T`5fP2)|Q)Vt|_Z!*iXV%`QRt){aHw&g=y}Nn+@<^xn}y0Noc?GVb`#m zfcUM2Q*TWF%(XotXMgZ6?OpyE4RM)2 zOa8HDxNb0HxS`YC$()UE&HilnR~%5SGGCZ4JFO^wNgMy4ny8TRIoY?pX7Z^CLi8Jw z63t?i$ku+{?1+D!qS16{Y;aS%_k-#wWO;%J7Yh_GFxbeG{<#h zym;Z3{H(Nd$?&_2B?a`P@c$qVF3}=+^NhdAa8?SwI|LCLh~-1@4ppBAW>re`-)_%C zRo#yFlqS?IWT#7azb}^^X=f^7)iR|Rd_Tbe<8JZpGC~GGUx-4Ne?IO(@WX{HqqveJ zSUwePAEC6Und*pJrCo!xlOSKnvf7c3>0El_;Me-LJPD1uv#lrr*tNmForc=7+m+y{ zEEWhlh&nhhuUMSJ0l+&B8+-PF4@9usNKL`(039s5?3X*usrO}`<@h&*NBXx^TY(!;IC-ai3c8Vy)$*j; z`prQGIB>Fyp||`FXWIdX$JK_$@28rI@WI?slpqjJ*m9%c+!wY__FJN_|Cij{+>|F% z^rxo{_&eppDEW`1eFroM&yil@`Xb`dLs8k+(^pS-4+jMB$;{8>>x$pU0jquBVj$7i zh;zKB#@61@w#^Pxi3fEe6W$9n2fdR>k+%W%<$I4&>?&YlnKd`Da~ii=oF|0r z$ODeiL4>VgX(1+X1*Y$1&%lydVCF?Ywxc}KyhcBFca~;v5!^VYpp8Em*fy1u`ZoRB z5V7<)w0UjiqM!6QmU#n7>z9LjC{X&L`h%UvTo?VtL`_*q^B!VX>t5Zqd+*kr4W{n* zx=G6|i;+b%lNW>uwpub2)(-fd+LC*({+jw3eegX4f-u1Vp7TxJd2I3vBUYV&(8`{& z`DHiSsVDMl;Gmi1rvp(uchFI$2UUv3{ez!H@QR;&Kl!__Tf}fH%xf)={6Y$WR}87< zdraUFU)h?9-@65GD?C<#-GNPhj^tPtpE9}=|QwKB1scrs-F`G)s>4sA4~C7%)XWy z#h89wVkEG@4a_Rst|gcsODF@4Jfy+RTEg#o)n9r2Sjljw$;2jH^S`0NndDzfbrveS2XN;1w3jJ88jRt zoFyucKYW^X++H0y!q=>=((%scNy9N5<4Pbn4WjENM@y91X`_I?V=i*wa@8fjcjTOf z5oh5l%yChjPHG@C8__A{0a5QfJ^0EyJ2ngWo>Z$Rd$&8rpKkTJP{JOoh=aj|_7!T> zRE(nS>S)5XT8RnNVrpv*FD7!Ax30MZKkcenZjqMBEJ@E$%?HFX zml!d0ba4w6r`dCnB#$(oAqWEp+6uPQ%*^#<%UM3r>?{#DjEVy}HRT%QA4v$?FOL{L zM#xKaA>Y^^_XzYKy4RSGk7=RzvLMmbcYZ|54ppFb=h2HPxdrVfq|7KD*EL=So$4+_ zBdXqyPf}sEo-X?v;o|}Ww|JedK6Uq+x~)!#`rh|cQN-LQ5*bv`OawnvFRctI^3QHg zO9sDTOLfRfOV6H#=Nhm4w7@Qu$N%-rMQM8 z;wwR&l|R1vRt7ZqqV~=C{){}0b`idDbu|9~*omd>WBCc<0c{P)QOd z8DYM}vn3M{4p}#=DBD}a716U*p1p;o*lpEVUrx1`H1q6@cnlH(cN4*Z_a)brDO0Wl zQokOyya7d)xXVDaI>-(*p;oc4bo_G#j769P%q9v1Tb8}hG?HD8baq|iS;+Tj%K5x2 z{N-sC()nS#F%}%}(G49~iQbmRn1Xt)uTT5^N>j z>S-zFIN$rULLV#87!zV+F@;KW7$KQm8BQA$z-nUfk|Qj_IGl&L9;B@OX1nrO4S}UH z=oKaYO#m$mFx^pK>Ujg?Lx}03?_c_X=Yav@9>C;kv91rm$dAjP)lZxCvL`;@X9ZhL ze!J3)ka;sl^zv>JMyL`z?vEZRP_<}B(|Ga#)6!B@l59A;9Y?qQl?p*OOxQ9-iBdi} zN;*=_GEOl*GAP$_kjl`UW5>ZVGLxd|Q=v|UVdH0f0T=6+e8aLDrW~FmUX0LYr0bfE z@dnJtHp0->u#x6D+LpjdMLjJ<&jZwvbZ+R)%}uS|3i`d#%<$Q=Es|hGj_9}+5O6R( zm50@y_Z)vLnl4qBGHT~+%YaLR+3MEkg$fWWllp_1DIe9PASq=~<94qrEk}sA4 zB=Sx|W8vQ4ivM8j%zBY|(xZw(!ue`W563hfC9Fc8hkWdqT)vv3eR9G)6t2678%Y8j zOoUPFhw=5)7IGZh4El-s{=gr4fZ;2f`FCBA-_^->n|9=| z=zcW6hzduHdUZJ?fkS*JR3U+Wi|*c2pxOFj5Yjc)zdGEK^C3KKd1}T*c+bT0>YVqk zCI3P`2GQ?Xrm3AAL0Ge|bW#>FvD7Q~S*<#B^;~E2JN+#Ffcz4|jISM;DZ_ZLzw!MH zvlA${?q5iH5trK>-hGA%yQ<=X31d$OmKX7X1gb~v1NxbI@WwqI}iF}DwJqvgu z-lo0_(pD%!Q6q*9W@!K3N-4LwCVrf$6-qUyxbnPBqFZ(Od}BQ4iMXWZmT`*5olCKiS<^UiJz7`eGg| z=E^C$l6j5sxC}&K0qY4$ORK571$FuHH&JnM%hAR&3<6C53hhQ6vq7qb1Zj(w#Woki z^|kgv0cS$MCywp&d~c@H;?RG8y1)Cdo2*a#__Dcm``P;>aNB#xPkKOTK$%dcdF1AF zxyG_z3dTyN@r>2^NJYkOmT2<@FQ@(a`Md66Bi?Inh!Y%X{$2$Dzlg<9qRX;34EImR zp`CRU90ChiB`-G7BSme->t#=|+TNeh)IHHX=}-liE>~;r!_YLI%&n|FFZp&DSJOJJ zFSeRc_(UO+tO})YGQbl0}K z)~+~;B-!RG6u*eNS6u_&~zM%-c2+1u|?VZI>w8&zfd!<5mo^JYtac$sV>&dTw6 zK6Bnbq1%QUN6B5|u}2UnO^iTRNl82cIV!68B~fxy z9pK|de-OXby~ZY%tkB)phs>Ce58)5!)7?dZ#cxMca%Kak-5kx~(8wOW>RE1Fzlh)_ zNA28h8E+UXMK*)I0pvF&x?%@}TrgQlyV|7`*plvS_SsT=Y-m+B*euuePV56QJil|6 z@R!=(bI4tNvVv{VOk2Jc%3p&pgfOIV`Yj;4Tau1O!#F_7`}O%6Q63jOfksIAUqinX z)=1_ZViAlh$pSYc@b2&9@6_%dZ$UES5#2g@!l_$t@m!ipY9y(|_*$%BAlmGUwONA* z&8!DiiA*zedVfijBDPpgMM*Zu)4wu4mQJIyjo|R$bAsPsfw3{&hr>uIJ~k~f1Bg`#5YD_RrRs3Ik@vYQ+Zjth4IH>i6`Kk4y@Xb#HM>e6y?XXo zZX9DFbhNWbfaYNF`(lKZEx#jD!jf0vEvNkNikWiFU#0*PE0m~baX{vbs4eiegW-;U zv>l2;01id_?N63H22vk-#dR+i_N;=}MrE;A{|8o~(}21ju=E0$Xc3i(-_r4}@k3Wo z`v$RC`Ki)WrAmwwF>t~BNVAT~ zFbSEXgs09fW-BgC)s;QaHIeK~HdO%isWV@@A>aY-mP0QZLYC!t5bq2T5UL-B!Mi4b zRKi)_j(_taBQ&;my$Vy|qP@6LqDTS)&3^uS1ba6`I7GTIO56znz*o&yFKV}nR|T*xDD zl&jG>9+L`pwCM*!)6+7(1Eyi)t-dg={0bi6T;EpyocHzo>iEA(>?xzYjv(ZeO)^tVHMM{$iqPxOTo6r;e-xC7-E;)ldQu`rnUq8jWd2GluQf$=W zK&;u=acoarQ^?9aq_ev)25_P@5~YkbjZg%{!h!oG^W$yRWt$T;r027;-cC4k>N|35 zOgZldvvrTZbBklB|SxQ;Dgu3>wR#s(0%yOR+E;XEfYe8q5 zmfCSV8&BcpJVk`Nt8ZQrMIKOS<}UecbtR%xMA+e9;w z%EU0gXPy5_web8wA{7a-^jfZ&OigUn) z;A@5w!ze5qQ^$9$Ub&4kIIE2RN;QVO%#1$IYn_5v66mPp$0=Xlo&0L~NGxv!w^CGqZ(6ThHzn z^7slKs@HlY#imcjr~KQ-#Ty9CkN?9U8vEe*75KiM=C$=XU<5x`@v&wfMm<&C3`|<~ zek(pw*ij+$tKV-kp2jAreyEvSSTaY5s*o8b`}~dkkdO(0@;abdO_9A*prq}jldD`8CjVaTUV>_-S@rv`%dTQ_*^@acdsh+401jW=ktX)db zDNcN;CW~IO^XXNf^vXl-={jgO-WGK;2&hPKaz{`1a*-9*a`C7ybZz=(qvC>wg&t>+ z)|`KOs?n1P+R+8d+sJ?3gRD#csA`Tq8(2aBq(TS~hInvN;dv$>TuXlvIsp9_g7CfA z`axmf936C2jygL=2hoCI#5UIi=#j?YFE{zOE5$1o$iuSZSR*Ioxl*aBn&i2ML zT`t?!5mdCBQJ!rOhFm|0$ll#(Yj##Vp6${_{W$Tvk79E5&AZ=X-CSUO3!|+-S;1qA z^(_IrqCq5z@8k(mf4d{3#b~Q{S7WSHTWw&0CgxRYF!X&)l}BxJjQhfEFOvZ{ZOvzD z4L{Z4B8LU$w!?^rcFMlQIl5VoB6$>uWQA-!=gEWrf@i|3ki>AqkIH4ss8m$CHB>~H zIA>;@(#wRW1e0IA>2(zIRWdF9{{BK%reDPNBT&BdIFi)tbU;Ge@=0<3mf#xsXp<;% z!jmgW4ymF7eM*a78iLgnkz#Btkj~lyLxK#aA(2rg>X}0-)ijJC*u%r+8n?+UpuC3t z>u)QfmaI;r{|l{eiJ`y#C$x+pI6uQmsqpJCInU-SHSD!@%iEd|8=u$^mdTC-Pxd{x z3<`u^C$^7t=)!xy+GDS*fldD9j96KgAqhDwgNt$8s}rAR@UQwpr5`4TL(BM!t35RS zLA@I%(!-UhmcmQ<`M^qSkRu?NUZd94{pATyJkpaRB3zC&)7p zt~zgDSSRZqd^&z#NDWOi2EG2yi#dxOVH}EE?geGmvxtIf-z$#g#_Xw>qfJ_hr}TV? zJ0d#ru?*}z>M>~D2a=chP%%m$HHAb04w=CbE{-1NQ~C1ZByFT6dOJZ}kH!@~sN1#q zeW#KhP7@+9z|Kj0>su$UI5Ze8SjBhu0>x&P~H@ z6!WD{%fR^gj=oiu$9!tZ+s;;Sqgnp?^}aTGO*rL=;J8R@czav^&$T^$EBjQ6$VCeZoZBmp4u2)cqd^O$8UQ!=|t@7 zA>Up{afiStZmtN}*Z~MoaxLXg5H(ZCa2^z6a;*Sb&s5S93&>g#31DbRbSl zTewV}gLj>&bvU%98w&PeoNPuXvK_Ym#-?N_|uwD`0*W}%KP-~{Rj#>U=uBrCK41Q6xrm+_~;r7im?0T5V zpsv;5fx+FbsfD=PXTQKaBx=`L0$$0 zpOd0_{w}4rc#ac0p5u*YV#_CYxbWyVPq@$D(?p^-nKUUxF#?q$m`9pTEw3dVPQt0t zT1)>}4>r)PHUiAVbC_doj_qvJQNZOV@-c$nHS+iSBom+#1{ zJZhT)nyRsIJD9p}JLwRh6*031Mj|s#AkG;e;(q=_3YU}{`YI%e%Au;Fm$|9wx0qnX zvD0cbJey|fEt$XM9MA|8VkcuGfcA^bHmd)Y!vWucmWuNsX*jf1(rnN<&B1x}Mya>V zhQw4Wb8=31FsAL3%Ui4_8xcidKd{Q`PY?l7(+5gJ8!WXCAB=kUK3KCpTVKurUJEKp zzEKO)(S@uZrxqnq^M^P4%wU26>4CHkK3Hw+_{eMvBJL=i0JQ*I;~97g1hlzy>s1Qi zlr06Eqn>p^C&cH+>jyU)WB)oK;lyuc(*N6iVMb;*CTvuPxitSk$j!l;Flm1fXWPkh zS+ad@PBg0`EfC#uu%DY9)Tpgpv+R7neSUWddY{CLfACqH8;zTko5>Nlfju6B*Pc6* z>C5JXKFN36pT#@CS4`i*d6+?*(O56)W7_ zO?jJ4IMHAx6UJs0Zb`N1mmePLOx+h;%Fg={w$E%7Sbf1Zmh_C@qppxWYz8+CZAfWl z00Zzv$hU)GtUky(@%PR^{u2gl1rB3gxc*_Bn#gR3*N?b=DB6GTyy zw_lLw>I=lClsn)Gi@20?=x+Ev(kcL{+Ui8Asl5ph5MF+Foy1F3cCMl?+u5D&RNzed zmrKeHu!@=|bv^G8zvT1WyfOHT4lCjg_J#!{+%qJ#@XAR$M(3Dc@|P0&Yv5Suq^ zS${yJwu#{El!FQ3ybwS<=li2K;#bVjoF!JK7TDRTiuqV0@joou3!HlJsm*bmjoNQD z&7VGzPDy-g;zIwsvtFw!%rD^lrh zfy1%$r(6yzex`4GkC0~dn^YxtuQE)bKhy zvwG(l0192WCDk6BRp~oZKF-p z7L#IGx$cxjBE^O;ym}sHIC^S_wMcI>lkh0+RqGksqiyxq0wXd_-cJ*7>*5gEj+*j6*ez9^ zJ)Kl@SE*!Wh1WVo;(IV>UMyzjWvBb_ulhV;b};j`knZI@#`x^@tb}K69D4Wm4-_pI z0SDBk5@*{bsa5GkXcJe>`i>mMb`Q9cr6mArqp^P~; z#aC4@k)NxO)K=8ctC1U z7ZyF~To`l(Rwq8qV0<9?GAd+=l@{4NBk_Sm!XqZKxf09%UMOg_7fE>d$w+ow)_{B6 z3H6|L!uh?doK^-k|9LO5LS4W$WojP9osF!gg5z2J;qj@i!F8Sj?_F{F2#+0N*@ zuiPcBOTqG5db8Fa=dK9i)8pay0K$XG^)i&opfh)h$GqLmdYt%rCLbm4y0zbx47(lz zAKCr)vFP{Qpv+F@a~$F7-cUxV55t*J#qdDRjq)MBCU%LpiX*yeX38LaUBLi!~r0|bwm63S| zllx9F15llLjZh@hw%Di3Tj*=6QRLUE{-Yp&b2`PtT1+iH$#Uc#296WQFE)DZWvqyc zA^go!@UVLcCv+~7gl*JRq-ZtJwtX|kjkgqL8b4E+ zwk;kKmlf2N0=Nff+7@6$H`;6pw6e77z}50eLNjm4RrNC1Q(~_3zex|!H9P)-46Q{J z01<bSs=}y5bQ#Qk>kJ@~qa%oY6gA#zmR(Bz$?dzo}xS+rSwbbQALcZHC=Gv`x zRqE%21&-cH`F;zakaT)XbX!_Dn;oN9?3|Z!BB;X+D75X$89HXMUh zQF>p2lxjjNoBSMw<=p=EH2UV)4V@LLh}zg^L>wi%@hx>f6`i%S!NPMD-~Bo10W^zN~v1{ zL#ZP+sR7*t&z|Y=;;P}Z6{N33szjemDS<&OPEFqgUP5r&#q*xTgDX)8rtA1GZ~Nw9 z1>y>R;#Xey0boF`Um1{2a_izLX!yN~;pjAOw!sNTOF||PqD3AR!N*mWtvEfWfl#aK z>hCcQop%|N?qElm{fx@Dy4bDaPNRcYr5x^((bMOL+>To;Hecowo%q_5BI>;uEwY_Z z@45dtLS4K2Ka6x)_o*u9xNR{34JS);Jk+i^Kd04V?c!F2*>8`ROgB50>U(0r#c*{L zIedVuh=}O?E>4!!D>B-2q@43_I>FTgbex{pT4%GBVX|L**(66b z33v7d%682mzcEA4;?!_~IUw`Kta6s_d5CbFIZy+E<#=#iYxdr2j60Aef?{or-V@o6 zVq>?MmCDKN=#{t!VPvJ?|K4og(97>Z&-3VH2(*Pm`&M492%+uk5fRKz(O0lhIBUQW zu1rt)s3if=PhyfO_J9WPq1;}aECr0mfKgciKz@vJSVENs>)5tVM#yvQl+v~^a5xw0ugr|;yZX;$Q_bC)xQ3f23B%p?acD;YAoBy(euB~+oKf9<&3vw-5YUlDQvAov z0VC01WMsq*@OF$n>8MARL-)DM`;ZBtD{<;i9Ww_r+J+6cyoWayZ|E`)4;G075Y_!s5vCn!`x zB9*gNq;dQK;el&w`28CGW!krq9s^swH53S_bHH&ZDgf9`7s~ZV_;Da~mgL>EKCl6~ zvIA^CFDh=@p7+7i0f)n4?nhpl{OOORsQLCHo`k^3as4XHcs9BfnqUk46yX8sbr&E(vbSb@`J|^(* z{j^IYm(kD1a1^b_s}&s&Q|rj}6dX%D8pKz4JmLGu<#?(oB)t0waFH|z+*!~jrvkCl zCr?0!bS%xl{+zo1uGkL6e9vQ$Bj@zW?n0#~6P8wio(fh9Xk{V+M10GUfd5s!Lt>!7 zTgf;pDVhqqTveDEG;w%-OZGBc)6N|4A-xnKE$+Wq_J{cV%Yd*(D)NEX z6IOu7KhU6(d%BKvF6P?7U(-fo7y>~qVAr{Js8%0nKN<2V*bS17XgU+$-{Tbz3=oRW zA27+C7I)AbYn){tc@(vVg%KO|waVyHh;p(hngIhq6?fIC3rEl+*g#?h$C?ZN-5^Cs zjr;0A7yPkbQg`+?&{bVwV~YW%5ryHLi!#-F4+dGp78fyN)Bk($S9$3S&BK#CZZ)20 zts{?!j%@xU>pai`#RrmeKT&d=zwtw@{}MbaVSY7|oP}##H-W*nAFtskG-PUXK8(n6 zfG&awZ5WtlO^Jvc+#8FQ{^l1Ff!tdz#Eqsi;>rjeX4#1|DUz{XImXdFz$KqN0o0+P zxkRhHp^@5~T~`3balQ(4syE~tFrHq4+#)}f`h3Q%SDRKJJP>>GSfQUwVEwB9ES9 z3su{Eciu9G9pg?Cf^|Nz2wCiy-D2!pSjt18%k?2QT1jvK-u9NJ(tKzP(nXcr_n`sBM`+NsWG2-giTtbls4|WfZ9Z4CM0N>E+as*9% zt?q&DxUK0eZosiM<$2-w_Bz#%hE^dFw`v8K#c9lko!AG1EyB05w$ssvY)YhdM7rxI zL(cKvU;hM%7R_@2*`$;M5KZT=?1sL<*WiLbYS8Ivy(S$E(p3&c2iNu4J@^XVszH2T z>Ju1Jb5F-Q+r%EpjVsT*0f<(aE1!`kek;v)lV|n;BgrOWl^N>FMpk?(<5yQgh2U{a z9mMrsZzt>Fb^geCEK%pfAcs11KERz672+IQ8sdbF4GbYK`$Ul#lzM-R&s&_2XHuvqzlM7@%Z7MH+K=8s9bgby zN-$rA(&9|7iabn=?c)P9n;H)WLgfV$VODzM7iC&?=*^e6>B=jh=9Zqf#j}ZJMFOY zt3?-3(39CKWlYq9)ujxm98(wT#o>4#9M!28^T1s*QpZ#2rH(;HD=c19H3w0Nl{mTrtx=UD5R)AheQl*?slI~jfQYp#07Vsb zBvn#nLUZF)p2?Ty=}@{>BK!KxZ0{I@v%AmI-tAp(4@XF!pGrQ|b*9)K5+D6|&Z-RX z@R{{oQ=Qxo);A0K4^|=npDev6ZoM<=wO{`Stkj84yh`bBey-q!l%a^(MgrSw?cYr4 zpZGJ%JNKo%z#2N9`V5ki#gko6W{`^{R|73A;UQ?sCL^tskQ3N%cqlOC53FVdIiwL4 z9|a)Q!6njZT>uzsMAmTXWCcadnOmrH-%4U$9;BE~#&FTF?TvkO`4*@M*~k-*6Hh(V z20o-+v_YYvH)AzFR^7T%M_vfevD1-JObS zZ@mRNl%M(X8Sj-3C~cbZPp{5DaUn`@KrZy(c@=q?Vzj{@Tuqvpvzx#x-TDYe+R~F~ zDlNsX#XFamhHIe51}k|Ml)pX;iynG;8I^z^BiPu0Lr?-8HiDQfcfKq2QNi^$smvCsa#e`-2HnIbpYqnC9&km!Z^#6!h=!ANLWXPP0M=#!C^E04u7XUsp{DX|UX{3(; z70W3{c@`NDOFttkc)Cdgppj~ZaeR4t<71Nbx7%}X8sJPQ9abgv8Uh~Qo7yO00UFJB zi5~gI#Zc2L-;_~Xc(ADz- z`QZfM-KZ*8j)nd*m#ymnE3U!`{es9u%bnwX4>VgczE~$T1gsS`8_^9I-qJXttD=QE zMHKVa!?U21rz9FJa_c3Tz>pBD|6WgYq3l5EE~otCu9MK3A} zdjGRby$J+FWW^U0(cDcb(3KHFcu-|X+x@?<$5aHL;AD{3bS)Z<_1#kH^~!2An!30c zx9zN-6>KW(sZ7aP%Bs`5qJJ1ksH%ycyYnmyy)~;c>7E8V|E!@uXw|vseO(F9EtLpF zM*Y^quo83i)@43(ZQAB=dqBT`$?zN?ZmO1RSh)Aq2_Q(q;vanln)4@5D_NM$4u?&jCFA`uLwYz+EE%}Vw4B4)Bb=p3TxZgd?~=$z4zo0y-aH%^Egk;54^OjG zTBrjenNMUghbiO}|>6zi^Z%dI|f-LS;`)IwvbZfE?}7QCHznd=$JvyhsGe95-F zdLGom3x3p3Ev&`#X!G{+@xa#Ic)rAfOB+X_t8H0 z=jYX>CgXW05#MiwOsSM5w1XDS)_qh@g@v1OKywiezE)u?0@@5RrGvEMz=Yc$%!K&z1aptId-beVUk70XEW1(jN=R^v3F~r{1ujfQla@`K|LBLXnns z>?Ny=uA@C2bgrY#F8d41Vx!g;Cdl8rbaWqPCl5N3K3~7uI~)gDuJjT5PT*@3TA&CZ z20kZ8^lrv?LV--&KTe?UXFBVqXsB{2RBiePjOR2;Nw>nn%0qZlQ;LJJYA|n0Nx2g| zxr?shH4j)Xks0{iY>eLXrOH0S0sG&6vfW~3oit;+&cud=0lYKg>+E+TWu=riwaW~W zt=90HhK0r9E&9S>z9q^+-_7(0wvw*mY z@mDP69%0YHmCJ*{D@>{rr78W?$a0wnDzYuWal4D5q0c}82qq3w08u3qIWmZsa21WA zs46=w##qS>QHfMCQO##09J`w859mqHvo>Dl~u{A`uZK~PB2`E!Oe)KMw>@u@9S5Sm6sOMSiyyH3LikuyxNbcC^ zCh6>$WroTh2qqMG6s@Rf{1gZSZ*1D`ieaxT_T)@2_P>E&$OM00;xE&0jjvkv2~Lb2 znjnz|B7pO-SdQ`|h=m6?`CtCuwCOGSv3h|^MO*)I!o9Y%XDyko9=+^OpPy|LnN;6w zJA|Yh%YpCyFA(RW!75A4tMIK)%_8<*;8P%F7!Rp0<(O+1<0Z)l`ziXb^FDfgzkpJ^ao zeInP&*t6R`Z%qPwcVS>v3!vq9<5IKaUoI4kd@xWN7pl9-o$Df&VST8C%LVn_D1u}kQuTfd1(T)OCtjz>gK^r}Uzv_4l15cP$|X4ND@pb^5!&YxFcRmk ze$w_6DT*Q-Sx0;wEk8gvQ66s;DMA*qK~%@@<^WgIk1`GA#X|}}a9I@6j4p+($CUv1 zQY2ny)$N8xTPuV8+ri^JeqEC-DX}QTbf31ACY4)1ioA11enfoxght?D-XM-1hWRRe ziUjbgZo&4HhSn`N&tDr=WM7u;hviosl)zt3jl8Dn3p(oXCG1suLmvg*GQ8mNI4}5H zeB=6AGj!R35RXZRTs~Jby;w^~s&t}YO+qa%p2*$>7)YZIzgGbPvke7~-9IA=fZ&0S zDjB84vhJ)@kTIt?Sf@g>@w2%~lh8z3s^TP%ha8Z#c#HtVLs2Qr$8cxND7vl$tH>Gq ze>{_S=eB@*9GfJpnOoV$Fh^xY(s+RKZps})IyT@hCSQqEnq7E z>qn`+`T!FgUjv=FhRv~tt7jMKY}{El%S7-lD)d{>^J&`Mm1B#i zkLm$$E9E}Xu}p>s_|&By;hA`w6AF-E>?3t>GU1mG!UjWhA%K6i z+GP1K9jjd5sr76h0FRnhIw<9kBgoE294L@P)wC-cNE4^WE~ z3d{(_ncy3J4*|8~J=_IEAgotiM<`(OzFFW~ey_o|08%W*4+z4v1NtM)fvYLY(-#~z z`Z~L3rMOf!5Gvj6=zkf0sT#=eTIWv(m~R8m;auoW^+d7^Oz9@PPVBEz;sVHg|Jo<8 zkj`JXs8o=G`X$u6bFaVwjJLV9NuQApwIMZ-=N!M_4h5jeTu&szHPNxU%mvD