From cbaa858adbca47d354b2264dd7edf6b6bb8c3c76 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 19:25:40 +0100 Subject: [PATCH 01/17] Clean up available_forecasts() a bit, add another test --- R/available_forecasts.R | 15 +++++++------ man/avail_forecasts.Rd | 11 +++++----- man/available_forecasts.Rd | 13 ++++++------ tests/testthat/test-available_forecasts.R | 26 +++++++++++++---------- 4 files changed, 36 insertions(+), 29 deletions(-) diff --git a/R/available_forecasts.R b/R/available_forecasts.R index b8c15c216..17418b0a6 100644 --- a/R/available_forecasts.R +++ b/R/available_forecasts.R @@ -13,11 +13,13 @@ #' all available columns (apart from a few "protected" columns such as #' 'predicted' and 'observed') plus "quantile" or "sample_id" where present). #' -#' @param collapse character vector (default is `c("quantile", "sample"`) with -#' names of categories for which the number of rows should be collapsed to one -#' when counting. For example, a single forecast is usually represented by a +#' @param collapse character vector (default is `c("quantile", "sample_id"`) +#' with names of categories for which the number of rows should be collapsed to +#' one when counting. For example, a single forecast is usually represented by a #' set of several quantiles or samples and collapsing these to one makes sure -#' that a single forecast only gets counted once. +#' that a single forecast only gets counted once. Setting `collapse = c()` +#' would mean that all quantiles / samples would be counted as individual +#' forecasts. #' #' @return A data.table with columns as specified in `by` and an additional #' column "count" with the number of forecasts. @@ -30,12 +32,11 @@ #' data.table::setDTthreads(1) # only needed to avoid issues on CRAN #' #' available_forecasts(example_quantile, -#' collapse = c("quantile"), #' by = c("model", "target_type") #' ) available_forecasts <- function(data, by = NULL, - collapse = c("quantile", "sample")) { + collapse = c("quantile", "sample_id")) { data <- validate(data) forecast_unit <- attr(data, "forecast_unit") @@ -48,7 +49,7 @@ available_forecasts <- function(data, # collapse several rows to 1, e.g. treat a set of 10 quantiles as one, # because they all belong to one single forecast that should be counted once collapse_by <- setdiff( - c(forecast_unit, "quantile", "sample"), + c(forecast_unit, "quantile", "sample_id"), collapse ) # filter out "quantile" or "sample" if present in collapse_by, but not data diff --git a/man/avail_forecasts.Rd b/man/avail_forecasts.Rd index a95fb8c57..498b79bb3 100644 --- a/man/avail_forecasts.Rd +++ b/man/avail_forecasts.Rd @@ -30,11 +30,13 @@ By default (\code{by = NULL}) this will be the unit of a single forecast (i.e. all available columns (apart from a few "protected" columns such as 'predicted' and 'observed') plus "quantile" or "sample_id" where present).} -\item{collapse}{character vector (default is \verb{c("quantile", "sample"}) with -names of categories for which the number of rows should be collapsed to one -when counting. For example, a single forecast is usually represented by a +\item{collapse}{character vector (default is \verb{c("quantile", "sample_id"}) +with names of categories for which the number of rows should be collapsed to +one when counting. For example, a single forecast is usually represented by a set of several quantiles or samples and collapsing these to one makes sure -that a single forecast only gets counted once.} +that a single forecast only gets counted once. Setting \code{collapse = c()} +would mean that all quantiles / samples would be counted as individual +forecasts.} } \value{ A data.table with columns as specified in \code{by} and an additional @@ -54,7 +56,6 @@ This is useful to determine whether there are any missing forecasts. data.table::setDTthreads(1) # only needed to avoid issues on CRAN available_forecasts(example_quantile, - collapse = c("quantile"), by = c("model", "target_type") ) } diff --git a/man/available_forecasts.Rd b/man/available_forecasts.Rd index 89278f879..da64eaacc 100644 --- a/man/available_forecasts.Rd +++ b/man/available_forecasts.Rd @@ -4,7 +4,7 @@ \alias{available_forecasts} \title{Count Number of Available Forecasts} \usage{ -available_forecasts(data, by = NULL, collapse = c("quantile", "sample")) +available_forecasts(data, by = NULL, collapse = c("quantile", "sample_id")) } \arguments{ \item{data}{A data.frame or data.table with the following columns: @@ -30,11 +30,13 @@ By default (\code{by = NULL}) this will be the unit of a single forecast (i.e. all available columns (apart from a few "protected" columns such as 'predicted' and 'observed') plus "quantile" or "sample_id" where present).} -\item{collapse}{character vector (default is \verb{c("quantile", "sample"}) with -names of categories for which the number of rows should be collapsed to one -when counting. For example, a single forecast is usually represented by a +\item{collapse}{character vector (default is \verb{c("quantile", "sample_id"}) +with names of categories for which the number of rows should be collapsed to +one when counting. For example, a single forecast is usually represented by a set of several quantiles or samples and collapsing these to one makes sure -that a single forecast only gets counted once.} +that a single forecast only gets counted once. Setting \code{collapse = c()} +would mean that all quantiles / samples would be counted as individual +forecasts.} } \value{ A data.table with columns as specified in \code{by} and an additional @@ -50,7 +52,6 @@ This is useful to determine whether there are any missing forecasts. data.table::setDTthreads(1) # only needed to avoid issues on CRAN available_forecasts(example_quantile, - collapse = c("quantile"), by = c("model", "target_type") ) } diff --git a/tests/testthat/test-available_forecasts.R b/tests/testthat/test-available_forecasts.R index bb7abf4f1..f8e0ad0c7 100644 --- a/tests/testthat/test-available_forecasts.R +++ b/tests/testthat/test-available_forecasts.R @@ -8,22 +8,26 @@ test_that("available_forecasts() works as expected", { expect_type(af$target_type, "character") expect_type(af$`count`, "integer") expect_equal(nrow(af[is.na(`count`)]), 0) - af <- suppressMessages( - available_forecasts(example_quantile, - by = "model" - ) - ) + af <- available_forecasts(example_quantile, by = "model") expect_equal(nrow(af), 4) expect_equal(af$`count`, c(256, 256, 128, 247)) - af <- suppressMessages( - available_forecasts(example_quantile, + + # Setting `collapse = c()` means that all quantiles and samples are counted + af <- available_forecasts( + example_quantile, by = "model", collapse = c() - ) ) expect_equal(nrow(af), 4) expect_equal(af$`count`, c(5888, 5888, 2944, 5681)) - af <- suppressMessages( - available_forecasts(example_quantile) - ) + + # setting by = NULL, the default, results in by equal to forecast unit + af <- available_forecasts(example_quantile) expect_equal(nrow(af), 50688) + + # check whether collapsing also works for model-based forecasts + af <- available_forecasts(example_integer, by = "model") + expect_equal(nrow(af), 4) + + af <- available_forecasts(example_integer, by = "model", collapse = c()) + expect_equal(af$count, c(10240, 10240, 5120, 9880)) }) From 6dd2b40e3bd50b335369a8cd5b3e57f379fb5657 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 19:32:29 +0100 Subject: [PATCH 02/17] Remove `check_metrics()` function (and add some hacky code to quantile_score() to make up for that. You win some, you lose some... --- R/check-input-helpers.R | 30 ------------------------------ R/correlations.R | 4 +--- R/score.R | 5 ++++- man/check_metrics.Rd | 20 -------------------- 4 files changed, 5 insertions(+), 54 deletions(-) delete mode 100644 man/check_metrics.Rd diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index d1fa62edc..9c87c05a2 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -21,36 +21,6 @@ check_numeric_vector <- function(x, ...) { } -#' @title Check whether the desired metrics are available in scoringutils -#' -#' @description Helper function to check whether desired metrics are -#' available. If the input is `NULL`, all metrics will be returned. -#' -#' @param metrics character vector with desired metrics -#' -#' @return A character vector with metrics that can be used for downstream -#' computation -#' -#' @keywords internal - -check_metrics <- function(metrics) { - # use all available metrics if none are given - if (is.null(metrics)) { - metrics <- available_metrics() - } - - # check desired metrics are actually available in scoringutils - available_metrics <- available_metrics() - if (!all(metrics %in% available_metrics)) { - msg <- paste( - "The following metrics are not available:", - toString(setdiff(metrics, available_metrics)) - ) - warning(msg) - } - return(metrics) -} - #' Check that quantiles are valid #' #' @description diff --git a/R/correlations.R b/R/correlations.R index 5b8233576..8036b49e3 100644 --- a/R/correlations.R +++ b/R/correlations.R @@ -18,10 +18,8 @@ #' correlation(scores) correlation <- function(scores, metrics = NULL) { - metrics <- check_metrics(metrics) - # check metrics are present - metrics <- names(scores)[names(scores) %in% metrics] + metrics <- get_metrics(scores) # if quantile column is present, throw a warning if ("quantile" %in% names(scores)) { diff --git a/R/score.R b/R/score.R index 3e631de1c..de0e4b821 100644 --- a/R/score.R +++ b/R/score.R @@ -201,7 +201,10 @@ score.scoringutils_quantile <- function(data, metrics = NULL, ...) { data <- remove_na_observed_predicted(data) forecast_unit <- attr(data, "forecast_unit") - metrics <- check_metrics(metrics) + if (is.null(metrics)) { + metrics <- available_metrics() + } + metrics <- metrics[metrics %in% available_metrics()] scores <- score_quantile( data = data, forecast_unit = forecast_unit, diff --git a/man/check_metrics.Rd b/man/check_metrics.Rd deleted file mode 100644 index dbfe3d58d..000000000 --- a/man/check_metrics.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/check-input-helpers.R -\name{check_metrics} -\alias{check_metrics} -\title{Check whether the desired metrics are available in scoringutils} -\usage{ -check_metrics(metrics) -} -\arguments{ -\item{metrics}{character vector with desired metrics} -} -\value{ -A character vector with metrics that can be used for downstream -computation -} -\description{ -Helper function to check whether desired metrics are -available. If the input is \code{NULL}, all metrics will be returned. -} -\keyword{internal} From 10bfa7d6108cb0c99c3c6bc1a22c7e19926dcc37 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 20:55:01 +0100 Subject: [PATCH 03/17] Replace `get_predictiion_type()` and `get_target_type()` by a single `get_type()` function. Fix `plot_predictions()` --- R/get_-functions.R | 53 +- R/metrics-sample.R | 2 +- R/plot.R | 14 +- data/metrics_binary.rda | Bin 4757 -> 45076 bytes data/metrics_sample.rda | Bin 11116 -> 46691 bytes man/get_target_type.Rd | 36 -- man/get_type.Rd | 22 + .../plot_predictions/many-quantiles.svg | 571 ++++++++++-------- .../_snaps/plot_predictions/no-median.svg | 411 +++++++------ .../plot_predictions/point-forecasts.svg | 8 + tests/testthat/test-get_-functions.R | 72 +++ tests/testthat/test-utils.R | 71 --- 12 files changed, 670 insertions(+), 590 deletions(-) delete mode 100644 man/get_target_type.Rd create mode 100644 man/get_type.Rd create mode 100644 tests/testthat/test-get_-functions.R diff --git a/R/get_-functions.R b/R/get_-functions.R index 095a77e48..74475fbd0 100644 --- a/R/get_-functions.R +++ b/R/get_-functions.R @@ -13,7 +13,6 @@ #' "sample" or "point". #' #' @keywords internal - get_forecast_type <- function(data) { if (test_forecast_type_is_binary(data)) { return("binary") @@ -82,43 +81,32 @@ test_forecast_type_is_quantile <- function(data) { } - - -# need to think about whether we want or keep this function -get_prediction_type <- function(data) { - if (is.data.frame(data)) { - data <- data$predicted - } - if ( - isTRUE(all.equal(as.vector(data), as.integer(data))) && - !all(is.na(as.integer(data))) - ) { - return("discrete") - } else if (suppressWarnings(!all(is.na(as.numeric(data))))) { - return("continuous") - } else { - stop("Input is not numeric and cannot be coerced to numeric") - } -} - -#' @title Get type of the target true values of a forecast +#' @title Get type of a vector or matrix of observed values or predictions #' -#' @description Internal helper function to get the type of the target -#' true values of a forecast. That is inferred based on the type and the -#' content of the `observed` column. +#' @description Internal helper function to get the type of a vector (usually +#' of observed or predicted values). The function checks whether the input is +#' a factor, or else whether it is integer (or can be coerced to integer) or +#' whether it's continuous. #' -#' @inheritParams validate +#' @param x Input used to get the type. #' -#' @return Character vector of length one with either "binary", "integer", or -#' "continuous" +#' @return Character vector of length one with either "classification", +#' "integer", or "continuous" #' #' @keywords internal - -get_target_type <- function(data) { - if (is.factor(data$observed)) { +get_type <- function(x) { + if (is.factor(x)) { return("classification") } - if (isTRUE(all.equal(data$observed, as.integer(data$observed)))) { + assert_numeric(as.vector(x)) + if (all(is.na(as.vector(x)))) { + stop("Can't get type: all values of are NA") + } + if (is.integer(x)) { + return("integer") + } + if (isTRUE(all.equal(as.vector(x), as.integer(x))) && + !all(is.na(as.integer(x)))) { return("integer") } else { return("continuous") @@ -149,9 +137,6 @@ get_metrics <- function(scores) { } - - - #' @title Get unit of a single forecast #' #' @description Helper function to get the unit of a single forecast, i.e. diff --git a/R/metrics-sample.R b/R/metrics-sample.R index 47ba90313..f4bd32dc3 100644 --- a/R/metrics-sample.R +++ b/R/metrics-sample.R @@ -57,7 +57,7 @@ bias_sample <- function(observed, predicted) { assert_input_sample(observed, predicted) - prediction_type <- get_prediction_type(predicted) + prediction_type <- get_type(predicted) # empirical cdf n_pred <- ncol(predicted) diff --git a/R/plot.R b/R/plot.R index b3e1a9539..0a1366906 100644 --- a/R/plot.R +++ b/R/plot.R @@ -411,14 +411,16 @@ plot_predictions <- function(data, # find out what type of predictions we have. convert sample based to # range data - prediction_type <- get_prediction_type(data) - if (prediction_type %in% c("integer", "continuous")) { - forecasts <- sample_to_range_long(forecasts, - range = range, + + if (test_forecast_type_is_quantile(data)) { + forecasts <- quantile_to_range_long( + forecasts, keep_quantile_col = FALSE ) - } else if (prediction_type == "quantile") { - forecasts <- quantile_to_range_long(forecasts, + } else if (test_forecast_type_is_sample(data)) { + forecasts <- sample_to_range_long( + forecasts, + range = range, keep_quantile_col = FALSE ) } diff --git a/data/metrics_binary.rda b/data/metrics_binary.rda index abb9bd8fbd0d7cf1fb642baf94f5924508ae5626..9a37a5dda6ef74ab7f54a00ae382ef5b72f92700 100644 GIT binary patch literal 45076 zcmV(>K-j-RT4*^jL0KkKS)FavMgY=4|NsC0|NsC0|NsC0|NsC0|NlS$0ssL75d<6n z0A}z2Tq)r3e)?6Q2ghmI+`a?8(09G>K04HB(Lz$H2~sFjDMG#V3Mc>o00NQ+000I- zKmcC@neLvxo^2jo+@6}F*LEleLoZzb-!S9=`jS8j_?h4rn>7& z3UtsKplDIopy5!V&?`cK00HCx1p`M{pEtacMIHCPbUEGEz&Zc`06o+@?akSy+haD+ zp=^2-LMrS9Xhlcfz&hW3>)z}NpO$<$S9%e0WVutwMdet&EdDc zj(zf~#q*Bin0waupveYpd)DQ=Wm8=0n`YA0V|&RrdlgYO?bj7)ZC6=z+Q59cS@>C zsv*rXz&M*r01azq>ubAeN?@~X-4k|eYf9DEwsm_A)=sS3E^goe?%b`_!#8BO+ih6c zVx8$lBp?X|DG>nkYIq)dyV~z3lS6L{axQs53PDnhZR5l{sq4pzd!2j09V@lBg!S)e z+d=Nf4TkNycQ~(h>!${ncbB`J?`=2V4Gfa8&TySq#*p1^o<$-{ZRBwfB*mh0uqrC0Eo$w zW>ndvr=jifU%3l)xHB)D18bZ73p0M9=~NO#nd2G6H%} zB=QP9G{hq{Pt?+8nx3bV3N&p^r1F_P5C8x)Y0Ro1f2c$Ai0XDH#qa8m^?y{pi0D-!T6NbnX5~{*RkIGu8eq3@h_z{?;kQAKAm{$MoX%t_$-0Zs7Iz zf}O&Gp7G`&y`*>#A?+QZ(tThw=lh}iXWn07{$T$({)Fv1fexirBqAq&`g%^p=`#0w ztHAnB>nfRv-kOaK*`7fmKmY)YGuY6M(Ft*l=p^5l9z`k+2swlhf*?}JAqxk4`3!+x zlG$oCfZT*pzzh$(W9RJEm#OyrXM6c@qH=BJ*~siRd&Xv^RhK@4>lZ+HmM0m};FIFx znu>Pjxa(8zLmxK3D4qU0tEc3atQMT+iigOZ#akoIY<%8bh0sHa8}hEtmja27Cd6O2 z1U_#yaUqUpUx>S;kLmu;dw3#W>ixfU#U8(d-SOiJClcnbA&d$qSp9>e&E+v(gMEF< zJjMW8)X;~D4=#9Z2Kkoh7e!K zML_$9UCSc0K^OG{^#a!d;)78Ig?uLah@O8x?G;p60ea#h=K&QzFIG?>;AB9?GJ%iV zPA>&`V*vLe0tY*jpoo%4j=t`|{$K9?Vf}&+$@sIr;za!XuF>a6YMnZ2Px1%)%*4bm z&VN~kfl;c4*B|fu-$PL!r3OIy^Zj`F>>Os9Kq=W9%M$RsKI$q9_@Dp}CO{uRo4Rja zj_Rt{O&uxUH% zo6fZRiMablt$Tn4cR>+CATU%9e5xHMG63Y+6gt@i4iW+}Dg_FQKnp+sB7M0)1Tp~- zf80K~KXU(Em{b%WvzQCJ_9wgkspzVjd1kSk5w`oF(ux*T_eZ%W`_|ZM_l(^i_`ssW}X!W6e^H$Brw?L9l7xd5plvDGJIo-^r6~{!Km&ZW2hF{kB%we8&wkjmeJELbk~MpR6c~(3?YHBOnq2$N+Bjowog| z0@D!ZVaVUUvE4Kg-dsr*I+W;_|B+qhQwT|tUH|xa^`HH`-ZnZ4G*2wgsvggOnR4;Q zF*Mu$#5_&s*`(PTWJ-^D%sFDs=`y!oXd`8h^xjhctnS!b|B!a#N!oe6BGdkAr6NUC zsegm1J{gk>+rM3;OK~<6Y?9QxY4#rsSEU>&3LK?pPR)l}nX9`}Dp}h?3(3V2VHZ&j z*H>!IM2DZrwCKqA|4IE;c8ktpqmOM~?3$I{fyi*k=U zhYn>p+i{~ex@!|bp`VXaOg-#ZA#~@n1Mc-4N;SiJ=UC%o!V1Zf0z(HaqSdk_LJh6I?=akfS}E%|6pr~=z%F9gLP5!u9&T1Kon zWTDOt86!drr&<7!V@gqcu8_z=bUmI9eXh0Xn|R`;=>YW`w00S6?`&>-OLmXHW(WmE#{V)xc#2f z)kmGkq%tmY|I5wOB$8r!bUbvNSUNCqzWg*4o>@$ZnEbf6H57K}yR;uu`0tGkgyOdK zGNMNnK6)f8Pm;E?OhYTK({VeUX8DnKqWb15+9OPo1-Ri#5304 zk1+>mb7cQ6YtgRfv9`$xZs{?~bruu!);NQBp0bhVCORtfPKQn92jM#RtF~tX6ZGH` zMw%_(Q+P zjVf*2X&@o3)IFk#0oYJQ%0&r48*%eO{pC0X9e`XZ*Gqa`@zp+;e7<=)^&o~n*5jrQ zGWxh?9<}vfEMP*>$qILr3p(81SHpeswL)4NlLml-C;oQktrs05^}1^YFD}?6*SAI6 z0!M5ATm`CsS7WxEs@mq?v=8`unMK#k{o0ep=cK#v%s~uMS67hGsq@s#~ra$H>IZ?}GG zK&LnNxfZpt=KOSqi?PD<$6ajKk-yiwG>GM!ryO9d*SFoy`rl8=P!NPX;b^dw6(&qh za4V9iTRlrqP`HIc2NF;hvE(&gTE!_SpK?UTP*oMggruTMr=jmBTYp7skfH*kmw-(% z)UG`}t+(^9EZoB44>{Qx;^UJx@4nahBYMA-&zFsrY+M$vLZ=B}Bu_b^0351^#--A0 zrLjENtL7%9WMCxsJ*UL}k#iln*>m1nJh4#MK25c{1Bh2W6{B{4BxikX8;ozHaH%=B zPvzRV{yS!Q)bGm<;k4%%2VJ@(xQ1;&l`Kz8uMq;|Oi|QQ2M5|i&>$9~bpXuYJ<3>V)_kXns15>$Y-qQfq6VxC$GWBou0a?c}D?WGUdt!6Fcf1~Zu09GX#~RNIG&cQL|C1e2Bu&lS1^E(kLcX+c;}vi8e@-E~k9 zBNrnRimJO51sR?Q&xW@<+OdR$nlHIl+t<0TC9mYNGj*3rUWki1*PVm}@Fm+n`2XGcfv=2VZ@rzq*sTNGAr z#msJ2R6ywriDz4;3=+?S%BtwvmwVY;M33m9%O|D)V8U1+1Cwq9M zIrHh_8>1jzEz{Si9jB5bmE-#S6IoVW^W(+1N81$*lvNdQrB}l0Wmx8{lX1#)6au>| z0zx7(m8eWCfuK~=qXbHR(7^HVd{O+)6Xx>2z_?43w(w5<4xDzZGA**4@=Ew^yxV_>2yL}y^!bORSQnbxjk0~2W@A! zSAJ*hec_iqF6_LG10Xm^YP74wgLflyXHMe}Dg*xBkH->vV z>l2GAMZ9Mte}ott{nB6n58_b;2$evg5GYYXl?a4HXcQ5NQ3PmI7=Z){l>wjv0a0EI zsz1&RH3*Qbf&(HDfhbClkct$j6e_|f|LrTBuW%%L{X##VgyK<0U}zaC}ct) zhEzzFih@c~D1k~UD3NFgs3HU?Dv)H98L1Y5nW{u;l%PqHidqyQs8S(H1fZFsluC*! z0)Prti6}yWplFDoBBF*N3QAC_q9UnAnnHz$qLB)v2&f7g27#u4C<+j&0*WXkfRYMS zpr)EBYJn-FNG7NTlA1!ON*RzSBBWwenuTU4p;D;=f|_YkAPJ@dAWEcW5vHmpfQbmG zp&~|vB3clkqzQ&436_9}5+ag?W<;e*5(#OgDrJaT5`thRpaOy-f?#B#B3i0QsY!}b zf`y2rD5YiqssbQNQXwcQqLnC8gosilNsyR{8U=|;1|lS6gefSfgqaE&T3CpMqLifw zl%yJorXXShm6<3)At`7=s0JkpL7<2hl%yI^r3N8dS%`)uN<=D10wo#}Wl97o2$51` z5TT-yltP4}iiia&fmtaEDri}NX#$E0P+rnd(H0OODHNp`6bML4h=xQw!W01JNGJ%F zRf!ZRKtDVxswt5FOa_pu{W;cDX;h^KBn^PXs{lkqB+T4kpaX<2Aetlq#0gX{`!J$r z1W#*ufnK`G(i9y53OON11fqMOFrDE<=#e-~KrRk|${ZyG;ZGAPp^@0?MR;=}hFWMd zjzEEe6?hKHftH&}35r4$NQkWhf(!i(KfCMT`Uhu!5BGjg-+S|Y-rwOb?bqU+Sw82X z|G)U*OnoM(74?4X@>3MwpJ;&r`pAIVFQCDFPf-qUFXA%##PI^<`J*Z~E`>Cw@(>fNo&vM!eIJ%LX*({{A2} ztV+-AgQs5Csk%24V@FRy6}fC!_%l`u1Q9KUEuM|TeH=KFbQn*p}Q zu4x_ibdNaT;D<%Qy!G&x4JqpYVz7q5jl0B{Xh_Twd|#H}=GRZ}^dp>gj_p};yI9Sl z=*C0Md0vV$Zr}HI7x^gU(k}7-Ur(HNVo>JbPd_jS!*ToEqo9XlFX+Yycdx^Dg3}RU z@k7>IzNmCN9k{uNFEgP>FS^Fw%ZtF0r-zEd{D1&V32p`PG#EjGG$4rJ^JwAV(~HB; z%k~ZIoTm7(FM%fb{h0Ce`}=46{~R`?hL7*`<$cO{tmSJsX4$10Q& zb;*g;&=K8t%{IRXarg85ndD^@$!o?Pt9YQiDqPRqMow6{#ph`jHM7Chfpd2SO0pob zvD@NQd4}!GxN^cIsD((ehWSsVbQt(?6ROUBp9B~)8H@~Sn~ULRpn1O&J^mjjPTx1n z$+LIW@%GmuxN!N#_OK1x-U2Nvl$ALb2Z7oj7}cTkP}wjvZY--(K&f;rrq4N$7nt;RF&QRT-k- z1VTY0reQ)FMxS@}kCWujt@l31_H*IW_I^nR0Ok!&#lVsAPreqiZrJ6M$GHLyvym|b zoN98WXSK%KvC$rXi z$3ni;UAQ|h^tFB#`76xJTpm_?@iU9JvsYImIDP$z7`g3r>)}tn^-HJGY4^Bo@O+fX zt6km4{Rcx{bZ|v8z1k|)`C|2UyV!p=zWUcYwm>#Y}Wx4Jh-zK}*_Q5g{+$TJh=`$>iSr`9tcd*8&}wDv$@DfT^>is(S11U8Ue<}m!| z4Ec;dw7q!7-%#1%@96oW>>UONP}kiH2hZICZC3=sNh`C?(d{~qUz@W}jmiGjE{{Iz zyixLYON+F5{y%R1cKW+M9)XL`)+L|Exc%1MaU9$`of>zqjp5F~Ectu*uUfaGy1^89 zNTLHZgW#_gKUKrbq4u$RA7^)J)}B9mN(P{S-0QuYqcB-}$Q|RY?l`2(fIh>;rs=iKbdp1;HPk0U$C(^YP-}bSn5opLt^ktsDLn&Y^_; zogTgX8E$3Kxj?6=ir)rsk=Pm9WJU7vrFa2%Nb80cD=*(lTjbJ{)bFt3{-4V{P>;z1KMW0=Kk{@RlXiEyz=!C7@BOw- zVkm=BfZ|4;x)MA~2Z%k)y3aI;jI6^hd6z`TEt!{DY?Oai2F*iS%#Gn1eGC*sEI{G! zZ#ZUiaX8U1+@yq5r3ZPbiy}-;YkT*a(@Yyf+!E5qJ~&T0i0zAk;jOh(o-NEKq?oU}?R)~$>Uv3R8W&OBs$QZ}1UY?;)93poQk>oD~6-j_k&lhEFJ-B%t<5fem> zwhUm_vx7Kw6A9?ZL{Ui4p+geVNfaqbe7?8xCSRLjv&IGzLz0mc&`?oH-@F!(#KC?w z4oV}f#^@oOOc@ZI5`U_m4)rd+YH8gePsdGJh--_Sz(0?FWAVeCv{e44bL9Z|Gijjc z9+9`zv(Ej{-9OcjoXmf#&#H&xqVXBAo-r1CRw9LkZe#n*LG&4$_COz0!S&AjNws}& zgm{4K{qx9V{&_+p{%u0K<$v511d`yrnwY~xM?grZLSTso7WIYx-i*&-BZlaH>qK4x z!}OQ1ud>#qzMOI9>jsM-PP88^JUJ8r)I(8~9xlob{By9Kr5XoW(b|p6l99KRe&SmCib! zNHbMfP`o-#HQVqPC@}&C>}BhdC2}$(I+HHYs03@cw%X!iR48MM)VEaPYyHoUo^PAD z%ge<1EviCB1cZ$>Qym5?LX;wd-H+M9&ZL&DNHfdW!i|8@%}OpX`dLKJ9~u;58KrC} z%m!(4q+~E@DYlNf?C2p$lo{@onLNd=xN2AxN4Q2Q+$DIe4|F?fnbI~<^to9I3(e$APzlJn44md5a=4}=p@LaG% zgZ%aXayV8rGz?9phbblaO$RisGa9B$A-J3xQDjVP4mb@40uSKJ1rMOHv=M`tGRw*E z(Ud`kGsLqLh*%X}*Jrc4IGqrR@tvHW+-M*&wZ~{V*~%|be?hh$)Sfph*67-8dcz9o zgVj^Mik!|Ok)E#~?5F)T3NM%+8hRxfbean|@_`JNOIaA~g7~)a;Nwk%!{F=spNj}Y z6)xGR$9qMY$3{nZaggodGkK#V=WF0rK`M|!V_oL1<-hN1Z1KBVF7K9D@^+?8=W}>} zKAD@hZ|h8x2}hR-%QxPv{P z;YP@820weSM^%T8ChLUVZ4BOsC9Ag0q@aV2>FdNX5sWkyB?${AB97@$B%utE2oRf= z!cyP^OP&sNd>C$}!-RuvxW#)k8#7B;Y%Ay)xcOq)76J4b#W3Lw+0pF(&rPwMjDrx3 z%5D4`wvKnhS-v`e5^~=BO0A9CPf!+mLtRhuamP?xb_0My5@aHX3G(=A^nlUtBHo~l zXN3)+v^=}(S{u|UHRgESZPvs@1g3kvMP0*(-fw!XtYT^m9WGfL564r?Y)A2nrh3SHof~1?mJh zeq=ThURc!@Hlo(9&jyP{VYk^crJG>B{;-rYT>0qbZ$YvR@Fd71ZI^nBHG(qJnVd-W z%k-FUK1i!l4e;crWbSPxMC-V^26$m4=u~S+*=t2JfOAe%0$&K zmx!w}_H6!5^&PBy4u{;4*ujy@G6F^Lu1?Qp!DJ%qt123#JweClBe;lR7qN*acqpDX zGin23+JGM|h5A^TX4nn87pC}2Q5UBW++vS6aNf?WV8OFOhMsyr|0#2b-tcY(`3Lz@8O3{^s#Sd>JbPZpDbZ|mTRFU@AWgmB#MV< zC6O{feqMt+WTe7clI`Gu&i+=pqw#=_n;m*~H$LAn@@(fQhVsd%Id|PJ-@H=D@A6@1 zF_H=hVT0Ra&@vf#rU4+a1z;cDsOeLJ=KFqYd}D4A36fmp!nO^Y zk_8EZ!$XP^x;;)wiPh;Is|rVk?FDood5eDW<|gu3R6{+>typ~Bu^Isbq z?J@m5VT~Pbt*$r-^oG1Kl4!LqN4IOuq{XrH>|%|M*drUe+dA7%a&Icneo<`7LL&up zrkbJ*7pvoX>pMSP}{muovy}~Cq9H`IeQaixN{o;f_dUgAh*%MJG#rX z@`)#fF(iJ+G<4Q2(;e4b7X;6>%3WQ#I$kc0wYFO_wQbt7eXlUjd(>j%%4pNhFQ?N| zTraZHk%n8QgLl6~{P8xL;o}o+=BnrlSWhF2ZkqCQh%*+pkSOFP;4Ma238fI;zXH4j68w%M_3X1>WB@UTArmMVZw$DjpRu zkUF>wDeaj;vyn~<2ntkaOalX6g*^&OFrmFMpc5?w9Fe{Pc-UOS*YI&0pAQ1(laDL% zbDR39@{%a&1aI0!*o+0~{@8zf?k1jyNExW{C+#lq|I<0cCS% zhicl#Sn2v}r`ONftzCSDw)vnw+}DYr8$|l^QPOzeom0(@Py1h_+X2+}eybI^47dA|&m4X|_s(x7J?)8<^y&v44eGZ;A5_$S zEB1l(g9p=96%!J~UI@1_S)d$;K~4zs4*pHuOQzkSVtwfjjEMdJ!kPx*&nRAOc`%Sk z(9*hSHG&PTdD_q-KDotB`JX!5?=km&DGtVKbfP0P?E)9oUwgg(nSEwYzPs)F!YC5@ zF&BKFq{r_N>Z~1p!SY~)g$huT6A*}G#`fCui+Q~@esAj5G!rLJr1!tSzYtQDb@R&} z5Z#`7CU2Kdq!crw>BW3hSie7O`15?`Zf_V_UTG-Q8yvEx(i1SaQ%Mm>2pef?YtDj5 zjSor%#Z5O}d^|H{s zmso|Sf*QRL(T`x&VWVy8%|leyu!boc!ZDgk{43Qi*xheiN$wh&A!bLZThxZcofPM^ zmQi~}o#KM&;O*BV=`Y8=%^1_^7x>SaD5y7@K;@pDhXlR~6j+$+G%kC)Q$TYBh-bMI z4yGU+?*>-U6=4$F2_~MbwbCFk_Ds95ygm?=fpV|#7g!lsZNQfz3fE$5Nz`Bz#z96d zn_#HoKb|2`q$Q{r|Xu6JasQED*H$27;m1|zWG1Q+ic$Bq8;Kl*LmFj3`N3a%m315y?b{V z{WJM;LGh)gh*p10TJy&lfbrM)l8(|UwUYOAkFws6v$Eb)-^Shzc+z61Dg?ZMZL#27 zD8BFs(WR==#~OFJ-M2YJOqDIT@l!4O3w&|Q_{pqnWj2>iHRU(+Vc``?S4Y^bCOGP2 z)i)ReJUp7Vdns+!!CzK!Gl_>nBM$C1o2iWN&>)(&aFqu{k$wd3<7IZ$LOD*msyo^v z_V{&>a7pVs)oJ4n+W2{>&u(^>-yWPqyt>$Uh>2E-=AwlAc{S+kjLf(0Su*!wa|dpe z2owbffM))ofaWUzX(!php)yb|8CeoehS6w+(1lV+8$$9=uVj=nG@NzR;~VL zs&tYQD=RlABjO#9hDjmUxrgs0`C_)Dw#hIj)^jGsPA3l0f?`qdg2i+rq;0V=yKVer ztcBs7azA1>Kxq{IYP_Jgu8U!k8+2ILlEX;k5qbNag4smKujF{|Grurl9g_{Da%IpX z%*(NrW1f+I_wKrMWMB*WbQq448@|GHcQd?U7EJ5O--Z}FfNj!4Zm#};ZVy&%pe$#9 z;|HF3hkA}UutX~C=I01!=Fh`j{+qi8K7r^aEQuyL;kfB-)mU<2=p}Mt_Cr9-nkw^} zVH#(yZ;av2^-;ip+yt=87rHTE@V z*@HTN4s2JjoF2pW4;9r}w?uH+FmBvC2HQM7-?4(DoWkm#53Tlb(?-T$^}#Cq(p-n1 zBe$)nvi>=?<=ELKCSz=wtEbGqBE)clI_Sk9uT{M*ihY$dwcHm8L{WvFmK%Ht{QVMRK0g; zWrM~1fanFOGa6(9yZb}3lS`uX4F1aNk|2*{6+3aCUoF?Cv zeA@T&)it!Xt}tfH?-!HWo(`|&KR9RH3*+Yl_x-UY_fBQSx_m(Ph_B|TixBFj^!b0k z+V)fpW@X}jAx%MxXoTu5Jriu4N3*}GJkt`l!1+cIn%3S|EZ9a+3dBPs?=io39TL6U zmihd|&@ln>2zF$@ROiyqo;mCE-MaOz&s|+u?=ZU=J{I_S9Qo#$rR&SzV6=3njt*_X z1GehQ)_t|oD{tTBtd~!H2=i{ys=q4u+R|QlynT^~G0<)b8%Kf7CP}#bAv{q`XSsD; zb8?XBrNoXO0}y!k@r{;l7k3OiYACX*YU`$-h>Yg~8|=@PilgE0>T=ca8ZXn?`fTSy zoPv(^Cu5sHguYm4ZRVPp#n9acD6OYmX;ZT%0OJ87WP(mpZ+*5iUmsU7H4*I2 zO4v6)Rlw(`c58ks`(vn^yDbIr5J7*<;s`jbV)#w6)~Lx2y>@uJ;z6 zUjK{6WmAtHfw=sKM#ngxDGYSh16_6l#s46LZau-+ImG4$qm<3j23Fag-B7*HiyQfq zsN1C03zS(TL?H%1kd(mAl1YF_C&Av`XXlFki)&5Ybn#)ZcQ8bK6{CDe_jB!sQ}O)F z2LaP!%6Z0YhlfbtemcZ-Z!`BHoqJ-;o!e1&gnBN9>HaF9{mK$S^4HJ(uR}unuZ-?T z4g89F0OELtqk}Q)QEO4b|9Gf}m_G3z8Y>=;ZZ=r9#Ye|633SXO`x>(@iS9O=64rQz z`|XZznqN!XDgVR=(1UrslkW;OCW(KnjsJt=7_T1)Y%Qqx^Rh)Z72h8^)K^zlrk9E> z9<;^0EqJI&w8~fQrhNU4AGDZTBl+y-Hy>odGZFJ$esjeBN2UN;vY;g46`LD zn;h}y@mcw<#k!acg6XzFJT)(yiQwPE>_7cL^qQmHepqs9PMLD)c$jsRmyX!Bn_l{m z#Jg9|;<8?QJ1Y71;Cspae<+LT&)?2Ib9N2i${Qe*7R~CZV5t0LC^$jY71w=>J#U2U zfy=0#*TSmqo({f}e%IXWqw<0equ?>=9iP%7&F-sD()e0^olE*6fj4~nnkRt#K9<4m zdU>#FgFa$^zfQJ!gC@NtpbdpAm_9sfrZ)$HEa_Cyg|y5?7QA#w5OKUbTAPgE3*f)c zx%`sV*_-m^mgYL1m+h?H^y|WJjKe|?M{snY;kEgxsZ~}tmflRB-au2A4y!ghO%6eM zZ!^ncE*)5JGVPHZ9me)pVf^+-^eBC*I-sC&f=4)+LKik_TofgJ6bgx`XhDQfAkwJZ z#gWWWy*%>(@lDV!Azv+&csu`?ms}wrg9L1~tdht~!y*1>1G){{#$KZoHFPTT0QtPjW74&o!&M!hM5H)$LqxcbrN_&&Ph4X5Ee&zP+$x zL9}&>AtBIV1%7PZTUgTa1LJE+2ucu;gd|f1Nf#|c38(^$RS2;B^H;e>cEPz+V8^G! zp(Npa5$?S&a1suOfhN2Yuax_7w~vYC#@bNtG4SAXX{K|n`a(=`<%xBA65n57*G%*2 zv0ibf=1W}1Qu~4AeJZ@d1^nYnLHu#hsuMpxpDAGbTgnT+y4Ye>-SKOsf6<$a{tF8z zXK6Yzc7;yCTPDlc|V5YdI#0mdo2c5wu; zqDVpsC{iOkFx?C9LAowBYRoC0nSY!eqkBk^YjNS473$pbJBP`>w)pMd?b;oK-=nZn z@)af$JwKPXHH8#>yoWH#7ksGnmWW>~Q5{>We}q?Gybz890$1at9TBpah+A~k&gq)w z1i&X>wZQSF+1!t35=ny$jp2Lw$rR9D)$m0BUK^8<353k(<&5=ga&~uaUCsVo+~`wc zJ)o>UOP}rD;Gq4sYz&d*i!UlI4vZ_tuFZtZ&qKSv)#@!$rdNmSN)K)uG>LJ93+v~2 zbTH+T^8KA?R^Ecvs6u*z6D#hWn#q`|WbcJ-XH}bBW12%dt4l)^S|!K>ZQz+N>$<8; z8zru`m%IAyGrwakRadfvY1pAUgx5oKi;He=dycY=IeHY&L=H#j;BJ_MXAtZ=gRTj- z)1hAIjh#s_S}Do(^XlimKMb5Mzu(zye4Xy31jsH_I& z6XcOw3K?1w09@f2_m&PocTixF$~zuXz)cjU%t92PqGtGC>4(RiqWA;enqN_4`>VzY zfOt+9b_A{6>YX?qYCb8Cm+(0D>sQe+hxYmnJ`)`qx;78)7dGoX2IP3}<|=IL+Z(vz zq?hH_9A8S^+?fkkKYSZ(qw!fjyIGg;0Vt@xK2-I!L zE07^}Cq-uKl)w~s5rE))fTkr@BPAKu#hz>?{)ustR$kd{H_eIm^pSZMTcg};k^82a#b!y85e=-mI5@W{<0;PyG+`aSySY-f->x@nHMAVHn) zC^|ZnP6uTb)X;o+yZxLzrMN-_-@6lKvhQeh< zwvM=-m&PL{3Vn}fbz63sA;&+;e)*`Rg{O9x z&a%Z~3$;-L(;+?m^8a#&2qV^wbwu;M$Wpi}1A{eX zxfN%5&{__6Iy0Fw!pqi#Y zFhpb(GE_-H2hcmm-pQivs||8aUtW>4lRhY9Vae&1zIah%^D8>Jxd7Cmkv7f z*J(Uo^yt?4_~OIhanY1Q5SX1&-fTZ>wzpZf5=0?6+|@oy*~_b^vz=Bp%$Hy>B2G-u zTgk_(jTaD2J7#F98-^z_ID4!0sL{EBFpb-&n!3k3@g5<`uzDssb5>wY!%$hbY!9(# zk3jKoIXzD;Lbm?f>PbV7>v+5zM%G2u_@5KLx&I*~i(NeAnRn-YnClMx zEcjgc%6yAZP?Di(YJ!;N5^1Sam~ucS5P8b#5JnDBJr^ZAnRh_E-DJ4j<-E0#%r%gc zz7CqR1E$gaMYi&wBkJ6I|F-w;k`k<8KRwuV&Lmm^(24hMZ3j-d_~Xd=aQ+pu(cJ}* z&LhG&hw;S}&Bwcgu9Gw%KhIXV-N^nUn!*4BuxA*{8RX83p(p;&1H1xUYP^(~fX zf`FtMZO#yM8KGLy5*WpSNt360Lm>r>->1saV(GIyCKcD!dvC`#Y_{WlT-_3H!IY4W zl7}7FYiRb7(b{oz?}YwEgm-s`4eu?`p~n}()GWoK8eyBtWdwP2jt({_kim>YU3xs) zvHOiZtry9`r@gcMA1tv(3qMWYV)4XhHmC@fL|j&v!xoa7+e)@osy2}kWnyO6q0Wl5i;ZH4g|@u*G%sDCyFo6H zji+WPK&)@a8QR=zX>nI2JDqhlHtEv) zEuYCn`ne)wNwlo@G+pBNV+EKo4bTb6c*LD;&K$TDxN|th`q5~`gH3e)ZuC|j`|5?q zQ9Era`;v{Iw>Y;OUM^#are=;K`noFobD8a@!+P4hxn|o5rifKrO`y>4_&wnwOIoYQ zf%-&0jvZz4D35~FTfJ3<-|N@XjP1|Qjrp`Qar4h^&Xuck?7MJa_q5&je=0ip$!yi7 z{#?ghZ2{kiK_ctS2FZ(gS-#z3E2j?i6H@f<-j3vwlsKBmN{?C|aeGs&*TQ2C8Lgw4 zzEK@LZ5!tmRRl(S_F`C#x;=YMGg!33^Qd!%eslUkb&dD&zBVy@LR;jBt*qpFrg*Em znFvl|&R9*CuC6|ebcxWGGwpcWsp_T?^wnFRBfafF=%&XL(n*U@)+&{{$#k-v43*&X zc!eTAf?1t?18V;z!4?jc0VMLvC(X!ND1@=aq@=nB${QL$L)O=EIO9rhrSJq#7(mBo5d^)RjoO$)w&h*;{ zR3+0HZM@InW!!qu&jwv7Hp=A@!XKsJ-<19m7m{KzEeKMb3MJuP!&S8!fRnCKNqC2Z zfJbjQ(QZ7w=kv=u3AXHc0ff!p#`s;(>$frU_9=o7GiBlCZK48AG>g?6s z&P90j^OHBu-l@8m=w5FGt`!Go^6rm*T9DKHSah6uUk zbI}R`+pdnR)jzoSUC2xwx93=U_NVm8(!ePA6yyvtCVvn<7d7hrc15aVi)l%XhWeKz zFu{I^az0N3b-TCS`)n*NzOi=skH?_f#Yu^k!qPhzL#m6zguFcA$dYPc934C;d5GKB z%Dr8rWXu?^%6ji?&UWU1DIR?=izjShxcYk+S?2kH&YI~g-l(8bqG>E* zs<r*k@u)C=_AqSCDi|)=y!U zCSD!>U8Ez>yCQXau2hD!Ke{$7eX!vd{|9JhAS~D!3f8Ac{Cme+d6YPQ6)_^arYeg= zD&gOYn{<_^-QVH^oJkQO7C>K;1E3;G29P4qXc|;0Uw$w|2PAZbBUI9{1uYBwp}q<1 zd@>?*gCI}=Lks|Spuj$Z!#|&hqv2h@%+r{xmbhW7mS7r&NKzFTMV8;ctCu_d645`lZU{xf5e%q@#NYU*5&0;y+HgXs@8>=ut4Q2S_bWpL2xsmxW4A zo=biT%-5G1=mz(y1z8X^eMt-bw1B0>au)>Mjm<{-&V|+x@Ps#SBP(3>q}owD!-C)p zrqn*Dp==6lLh`^#hzM#MP+WQ}rvPZr1%v{)?bkcKTyDC;NVcL41(e*m+!Y z#^=)3)S8$-l>U5cyX@Tecoz==nrT-Ho9JoJ2@^;^0RiRE{C>ZGb*Z)E7EptVE3ein z(fZpc-wi^KTqk)NAMxO(J-oNSa@KzBuXzo#v`kiS4rrz&dXA^QjB1M2+$c#gDv@4@j*7K>ndp;LnoWou^vi$^Z#1;eLJ7m`toi!XI<7q*|ovQI@gD54B98`?{__# zXvM!j>FfV5v(?uwYIXl+ZhW|d>$J};&EYLRutnlcaNHU6nd0RJHZRe~r_cQ#9uL!R zQl4cXo-m)9BQrK#SS7U66DPh37s}LetRA#bp1P=*^c#9bCG` zF1o8aFfXs1Koi;L{c6>I|DX>F+fDShqj6&ckDJxGb(>rdAu0R`_z-~fkO0fD5tYfu zp&APYW7)sY#nZ#frH5Bg-1{xTOg;G${n z%^bldu$nkv36Eq`ZX+!)M6dd*?fZyq-y!b+P~jl9n1>j$n$cEjg070%{R;Nsk0@>E zF68lJ0Ccp0J7S;)wkyklS<6AGz9rkH7>AhyZ=N#rh)&6zogDFDr_VKyHm?hKJ2UWg;gc3#K6z`|E-T8lYjqLg=90!+ z9@%1|&gVKmK5d;6@eSPk8wZJWKX53#YzGw?__PZ_@b&b1nNmtvrgm96dReoo&o<;) zxx=i-)y;%e-kf-?VNWRGwPSCmB*Eoo+$W7L2ZT8NbkViKe7hmUJuYeSoN^2HsYzUZ zImOXL`W(k`a$?DGgM*jUHVd1o-5k@5cf0$py4=aZc_c`*%n38n(UDD9!@-98I$?N+ zRH&8rf)J(%X7JWrnmXid_#~ZFs$)*x;6!&~qB>L1)Okzh=lTP*e1I3ZL`>xn;oA|? zB$H6^^jz%Yr(d`HJ`nEq{XaZDVVAl42k;qI@iKB!r}$Gv-!A8#it z-n_hh*VS*`Pq!A`^SU@Ve8Ww+$ppPz2Xdt2EnG-vh_2 z3wR>egh&e8y`T=7_}xbz!p)o78SaD58WHQo$);lA=sh+e>(|1Z-?aLQ<=vK*f0S;k ze;>I;wX&EqbA-D9#wS2bY1Bn~%tL+HH!u!-p{uLEMk*}o2pGbvvju6|)!k~Y?VY=g z+N(AJ;t&XBAija#T$Z?ww1<8gtdNeBN^Ew{m z+>}@s{KCkDaH5P9__SgeWEmm5$;SPqxb9~~UC?0Y(~EPoUxRWjtHZu!S)6hrr7N7zAA9t_W7!FQQ}svrzo_s? zKXgB+e_fYw{;FT(WEMGvjBMMNQWmOF6@txYzbs=v2(rn=z{RdW=tm{># z$4~cOGR9%sFJ?-k!}~Hl49U3u{-rQ~9z?iklWly@-JE9iuNjm47N1i2A^ceObo*x7 zRZuHld*-=U={d{O;x0bVF=eXSY(d2Y{uBD-IjEa|%ywFxH5%e>w&^A>#@56yX=+L9 z1>ie))P2VsG4`=w^Li*oFYtka8&G(C&2L)P^tFmut3~WdSChJI z#+#0oC4nSQ?n){dI7plB!}e;Yk$q36%GOm)k?ngr>Tss97_;HhI6D(nls=(K#X6n++OiS{Y6y%7(FFgP3gpiv#>rvbreAiIVD#Ua1gcW=KPH~Q~m zX6r(`PUfz-et*_Qj;fBQHJeG#&JXq#l6T(PscDQY`az@=l-=I-d0aKPh7VaA+lR|( z5Hp%LiA442!)+e1iL@|gs2aeHiV_-`LFb#>)76r>WR8z2zIZ(lw6;zY-i7Y#goqVf z6{TEfv&S=bDZE+Gz&5tzK6DWs zj@YK_7i2J3TPs{#3EdyA77qv7)>bjd*KaQ;uHBaenolHUdJSC(voSnSax1r zwl6J?`!XjBvnEJ?7h!08UaA{|0_a61W0V5d(GR%k3i~FpDi}Wr-DSK+95G=0{CQayr|K($2P5kT-|5Fl!W=|lxP8^4@2$jwO`!_uZM_JlBrTUso} z#mV&3t`8HkE%2io;?X+bGTkUF92_b)=YEwxefT;p`8095S2z0fZrgRgL(gt_!{R!o zo}BL~>z;QXj4Dz)mL1rmn@n+gQ0X&;9D8f?>2e+~PVZKZ!1@dbR+7TTky)kSUIi3b zi$%(NB}0x5(n50MPEg*be=P8v*>z|v$TGdt2dd+$)#aMqwyusn5Urj|SlPt&*x2KJ z$G5+FI0UvoHg@%q`|LLRvvCPD(G@$hK@OV9r>50N>MGR@mO4DJ-J(v61%bQxFy^dd zqMWLP@QGu22`PvY1dzLN_wK#r5SH2!gnZm(Nk-!7G> zj9}Jase57wLc8@tt`ld*pEwTA|AH=*I#0wp-8{pRr4KYH8YD@fDR79FL@;_gQXzD) zCH1;FmgpQ$vXo5CR?KG*yK`bEIs5y;x+ebcBQx@)r9bF+#gVV&_PwufA3FT!OJAKo zFCx>klB0~2d{ooiqupYEn7m<2CA0l6Jn)>`qqXC_HWPYn=zGt>9oN5A7{&2)`?z=tXi#E@qiOcl9E(N8+^M1WNwf>deWe36AuIyu zNjeyjaiVJvcm`_1n9`!AN#k3f3$)Wn7?dDt+J`j7#Lmx|_%@y-fG#Fc4rWyh6%dAc zY*3+X&YC!o_R(De6yrD*L=@NoP+q1~g$doa)!ePI=I31Z+6T4!&-psNw=E5_*FB*& zI`OQBH?1prS3?uE@K4EepGCh#OnPI>hvEntnDwQ8_v`q=^Jux0UIlmW#kKFhmbu9n z>jAB!^~N#2v{9_AM1q)GB9sG|#e^<4U~LUlGZ=?iNud#~p^}=_8tpnJl>-5%wvTmh zAR&)_ljcMancoK49}fNY_v-jP5R`L+9Hn=f znSZ53kcwvLS{sPz405|!&i|J2`>^K;w*|5t8&^VGHMhmvqVb2@1RVL#Hf<|l|FE-J z-sQ?{%$w}wp>}4T|F{7)I^L&I#8rI&Xi9A^f7Hx4yeK9P?c&*=dCnDQl}O)8$pR>gA7b_ z$?Ca%bAP|9aP{u4OK78aYrOTh)PEvOa!s~>p6p>aX}{E29dTaVj(CJ@MZI(hqn2GU z8=pQfhEq{70L)8?mW74AxnF;VZI{~*L>8K55tXjbDItpNBUpG zt$cOcS?i}SP+3YkA-c$OYM^FxcSAE8@>BA~{l_cD1ews|xNI+RJPw2&dSLbA?)1ky zK=}qRA(ueVP&flkAPhht4rL4OHP$o4j+-AntYa1l6*6WQ)!Jb>?V6ty!09ZgyNr_a ztIl6hY-9M6*sHM)f)A+e2@CI0#Ekj08$&F7{8JEL*jSTgGTE_}1sSLWw?%UQEqd1&p@=0BfC7lQsZkE+QRbZOnwA>TAOME{L4DGgn_CZd$e zMsI|wcZ1F)x?@(W6P)*}$yHV}FpIu_Tz19Z0xVA14^5_}PoH+Lgo9m}=>}Ry zPCQ~XGZ2P`A`Yn9rXK?vL6Y5Am$)+@#ki(yxAGH++nW46kzZ3_*4%Ke~zp}>u%IiD}i zdGC|YlTz8Fw|(Kqsh<7xLX-EzVZ(IA@Z(qX>VCi9?|ib(MgOm%t7(&EY`wGjZZ^xd4%aUfSiz&W9h(CJbK0A^ z@#%B%Ylbu_BIiGiI_W&ePS&vG28VM{u?uK`S+RVGMqCiq84Pxib`dd1q^+e8X@Voy zpYeKqOLsiF(WdUs6vFC_$2y=(qtpe653)md#05k#K!=4*L?jl#i7vg}3n&^T2{0iJ z5rHQnU*nUl|3598o-Jpo_+jLou@s%Bl4X;V)H|jbzoiF+GhFcTUOCA_E<9wJ*w<0Y zo>tuBBwMD>zAMpP(WExlv#Wv(&ut$6q;bbhg&PubOy;!PUBCMde-8y2&O4*$v)Wm0 zESJk{nZ>K~!`t6k%IbPV68FVbHVcA6hbkKeT?&*?SVb2=q|QPp)Efwvb6k=?_ZGwZ zH;eFz)NrV$WNl$|I`r+1H~g4l59&Wyqke8VuHbH&{NJmNd~x!@4vLxvlte)+NfJ_# z2?Z215d@P3O2G%N2TcGmBQgL|fDr-|6fq!0RD`m%Ldj54tT03o0VE={tU#O)xD9|e z!jLUgN7V37xJJRt^+UvbtK+9j0P8a+O{Y=e-`k#KAWVP^yGjGlj9!n3AGkL7dp%Ez zGXUeRZ0Xu~FvKyBT}fNSeVaWaaDQNIzpV?nAEz6m$FrY`(t-awPT!s{GlAHyeI7EJ z%B}oe*n=YKrhK=NJiigP`H#EXTE4a5Nu;?a>Wb_ATjZVk<|}QVSpLztjw$7^bA7Hu zS>1Ay5H{7Qs3@B43X#uPK%pToTnI1>2PSiowTwKC*697e3W;rb^AX#q^Usvo7@Cn! zYL6qmGT&@ltG|5NVz^>@kAfkdAn1c4+oHtCyLauKqUnggH$#)15}S)0YN4yHd_u#O=5VS zHl#r`rHn#-LC*$Bb3+s*W0i=~VW>gC*rf0s0c>1E#Xb|nffa;8Fb-gr`3PF4N`f^J zAl!jTgsT(OmKq96;qFp4UI~j%F?vB z-6Q(?{yhcRZmKA~|EKPG506~~BVPCrY)}}AeefbaX&i*eY@b2&Ucd%&SNX9;8l{5N zPz0c`hA=5MX8w+-p6!Q- zYkYstYY6%Nw&mFnKJL-m?-AnZ{$DH5I4Gg}Lsw|52-pa30-CV&P>mU}<<&*$2hl~c zhnbrl622kFydMX7_;_8yC&7m+fmjIqF}rU2d_{L?5BJUjn)MqeyIoa5B<_j2Shhtg zEr_?Nto1f1v{>pG$cO%CP#DPKV+xrgt1>NYVoFWL!P*lyR5$TW40Xw^jWAH;FD4`v zFA(VkTuUsxegAA8;ZXxSd{@ZzXyz17T=LQQ=GAh4LmiMZn8MLF7EOkC;PsGEQVk+EEewq0r3P4udF&# z_gj{@6r?|6*75@WP|}T;3LBqkqQG1V>5ZvAQONYRT!-2X%=W+o)Mws*qWnB6wn~x` z-m};~fd3)bhD7K8w&LMQYN9>o%e(%KYMAChk)zeldn=T{Rz@35xq*lZx-Ow69Y4rM zQ)!V}L_;3M4yD6Pej}eNC%Oaz5P(eIfDULmupas7Ik^4n1_x--7hDTN&^~eV9>Mj2 z4c2*`K4YYNT!YA0I0^ZWG4R+&vv%W`Nw6M+F5*BL)Da@GK)4=bJ|}T!sMcrQb1k56 zbRaJd+EwAdBDK)#_M0vCam*nXynQ8(1+=(>&Yp>o$encQL9K-OjrGXl`W^J zxVc2sQ0^wPfwL>QFsJs1e-BD{%ADg@5U&&AuVxQlg!*tfYxm1&eGJEa7y zp!(rkhk;0jJy{GC8wOM3^NI)1IwkwF=gUtO4a7ua(-2*Xd{G)i{j8#bVgvSEhM_m_ zpXEF;>7CP>T0o^Kn21(+WG$SK#FGkG%KtdnXT`(TQ%=OtzRslCj8-V_i0)(M^HXLjTI=iP$#Or@RlnX$2 zn$c1IkRqrt2mt=?f8!4@hFwUn_Ha0XC6Y7+l*WI6&+ZfOpg&v>zHLC&4>G@L8W%tm zl)pIbf=5I2r^~T@uvY2#jp3D?@kil^Hh>s`i~zsgEWc_)Z^MG*8+PD5hs0Q+nQToK z_md1ENf>vOnE~^_SSRUSzK=J}r@!~QwD zL?GZ)0aTR)QBf4EF-aS+Hkft%f5dDylu5C7Nc&Knq(1yWqB&s?q6nT#s%(Irf#mcV zTr9`ZlB>b_F9wjHLhTVFwCXc{xV;b<2oVs1pE+D?DpCEQI?6x39|#V-%~)5Ifk+(! z5Mc>Iez+K5G^YM2(5u{Z5X67yC@1im0sEk6q!6G$0*>@h-WgSGN?)#>m$sY8+u#AsE(1*f6FT!^Ap5K%YFAf5KU-@;Y2T^cLbW(q3=+QXe z1yNN9P<#NS4B-f%XapOCLemq&0RRb4kVkkQ?EW+EA2{`HdiN*5pgIZ40O2D4Xh?z6 zJcpxu^Be4U`=*&Uwx$r~iR1>NAvGT*K5`v|2a-aHN9jO4(hq7*>Ot-YH$Ze`jC11X zIvKKLUH<52I>`hAeD;E0;u4+36r?}}AutpuV6*^|W(8{Vs1JH5d%>0f?h%8L@9zWq zg~zClPzt4eMyt8TSLe>ZG4DpCdHgl?Yj^7W57B5NP4w-J#A&wXG|KUQ z{+pgXMK(jMEl?jCEkRTc@aXc6j@%&q+tejw-=~zvhd4Y; zEwv2*KX-Ip1H8_(a4Fi6@ms_`-Li(+7+dz)3%>BRmWj2V(G z4KVC-sZ*HoDIL(17pCpIoe_BC!5sXQKIT7{QCx|muHMa;$eHpbRz;;(3MH{)@@oV5 zPW-uUu_ARg0?2wC8uIt1SquD&^`DLUH0OVqc!PMk-YmvBFSzM_!Lf9qH6D`bpu5#wlI&Q0NVtpSG;|F3)#IU^4n^ar!;J6G(*%Rj6 z2HRQpJPpNez&Q4FU|tWB_)8OsJsx0!9*xc2q)%UWfl=PUcpqzcfdIpGjI|c7ahbTj7(i@1+k?G@NWV~K5V9L zsv!9;Q;Z$PL3MjRSBcfsw3m6%Op~H1`uIDocqKB~vJSARY&yBgO0UI2Rvx#^~4mr37tJ-jW z_or0#u~ghD%Uq*wo+Wr05VrEHeDaaN^z;*;4aG=75pQ-UIr08t`jgw`*~?9@<=tri z07PnL@QuV9?mC#BEhyk|@R3SMd3AI{fO1Y(WEwdQ8 zEqQbn$fG;E14KlQ;q0=TlJcVQPaqdMTsem#fHeh(Ll6kkK%j(JN1*bGdJmUvIMtt) z#lJ;i{V>FzhwBD$xt_?FaR~k=VZ(gl7wqsD-|vr}*DhOm!L)58Xx|s{N}v}k1yVtIft1|UH00dj~XMNqgf1z|>Gz<*eMqmY7R1WzFb!=Rgp zf$=x*72m?DDcyX(4I#W{{MH{^T{e>v6a-|MAjyc(7_UqZIe>AGcE=D*fLLVFz?TAa z^RJo(Lgydf?0MnJ0oU|2F8vqaA=Crd9x(f-NIH*&GSq6F4RucoTE)dJWZ|p$qW;M& zbH>p0MHUXw2gD(4)+W9DRE!7}C_dc=73+uf!A{7H#0=d?bQkc*`fWA|Urx$!yy*F5 z$cOM#SHW7sXhAiT%zCulsU@MUt(s}5R!#k`&oQ7LP=k#863BFi&o8GdkyK$(U|>sc zgC$_8cm~cLI8ROnm7~Fr&G-ke!r(uYqSk`gO#L?dvO@MLvPzU8JxF}a5<;hci~KA{ zWT(pd-B9cUsG>t7%5EQLaw7J11nfF z8`wGBhoy?9Yvk<_164}I(kmI!%YIe@*2NcW8h{TGhu9(lRCz>Pf+#k8hDpudFA>~i zI-4pN4_iQ#wUD6DQqUZ~x8?OG?P{D8ncOmIM=;hWJ|ii#n$0XQK~<~>RAc7|aDb*E7K*HG43Ia54Q_N}H)@PiU}wFd$4{4gHyntU9DvdVf$OSkm+%8 zIUbPE@&I&DW>SFUDNCS?`~k_sbb z(hURO5ZoHg2vINxRZ&rD6f;@BM3%8pO76}0P6X6BS$427EC@p$90PSM5X3|gUjE5= zjYwB2ZP+USp&F?0N@og=TS)QNhK1T(R5NV=MZ#|32)nQ`^)U z-r2TFGg3kj@a#a@9Ko4!CYqaOI1fgK6H`*_deg`@n3z*DS(BQv%y8TxWy6NG$C@)F z+cGxW)eOX3k!f>0sAQN7%(a#ks+0o?j>S0sW7R#6pbx7^Or6A$LHV)ta*R=m@>%D( zr3fQJ+oIwS2NZahsQMtT)c+8l0-gqiK-1eTWeT5?ssy(3($4ws=Rw9Cd{N~TERqT1 z)zl54@CmczpDI!H@!|5y7u^dUs~#;K-ium0Q4=WM`Gv}Sdue|IY>PbZeia|t&)02{dCSHBaF(%;8*XSX> zUZhlz$?8kS*^{4Ci2WRPbm#L=^8U&E_xw56KDvINq(|OyXosU4VAtd@oRO&Dqd*78 z@Jak&xSmKMssD@gevWjIc4J!9m9Rsr+YxqDo80E5t4dRd@{Pu{+_)JruD)lcEA*lK^+FMOQNq8yF~hA z(?U5Ym{AHigaIV*0A^}z{Mlcz){>Htf&z67eZV~d=u%%v2B*v%+v`*44-=fsPLYT) zwFV=|hB|S?T2m!{xLTsNfi0~FCO|)gZl8ZdycP9!S%(A~43ZiLrs-hy50tC(Xfk<7 zh+#@lrM z;=O!|VwwD?X#afv#W? v5L2@fU=X?q)Mgyyv_rXzuK0LT(pTn zF!Dw!M4oJb;>n0G=v+-Gv;jyYNDxCS2%J=X=AfbqVTfUw0%n*7T>zMZQK}h5WvXC^ zq=KrNr6}PErlwi~W|CPGNE5-XqX8_M#6UzyM1WE;B>)f=B#}*2&{0`@Bs~H&G5*Ph2hoqLlL`DbOJtBol2Xe(rJuqbBhtL#ss9 zB*iP)u*?*plRbwDbwD%)1sIJXClKZ?0g5dh$&wk44MHdt@fvy=sg=|Tvoh42Cva*= z;g?sk>Ny=4IlwhF1V!nxattzfj>&l>jVsAbD0Q>vz6UQubB0EhShV1RW`XFR1Tig8 z8<;q_X#k>sy%1t^At7e!rju029MMqO= zwPQ#V2_5Q42QW+6BpfhvigpkuZ9tTT6@PT5&VzHc&_}TDJqMy@3J%(uN{W+A%B2q1 zOVIm0k*sV0-6|&S*bxnc8XW}`G$E`_DM>>~6IFK`kgky10#N3S0Da5$WY$qOgdMY$ z697>V6ctK&a1$VU$=re59-$wPt?atR2B@Da(E&Vx;ixGKUIq^TtM|a<_)2V8hQR26 zzzrk`u^b*Rcsizqh@}b&NW1!q5^*(Fvi?4976!(K2xMPeUt1Jy&}xBx>?#XqZ^(z_ zQc)Nn)KmlNA_eiwz3{=#znRcxdjLGcC}B@WBmDau2_`rd#ro*vcfL?2rq%+$%M?Ux za$|-2h>5;}22|*xHiB~M5%lY_Jh_=^!EYqza;n9g^M1crs%ugT0@)9Z$}Wtg=EWUQ zIrHo_=~N}i9T6>7vxYG*MkTUM(1fU)_|R^fLO-^VQ&MY1s&%X#AiaS=+*3F{Qgtpv zKvzgob@Y{kyrRb5oCOxxp>`;@BhbOVE)>WRhU5zb92oxpztJzG^2`_pFhCxoAV7`I zgS2-R{^S!v3CoYNkIgM5S7|C)W$xd1ki?5y{Oi8&cc-#@uz}C`KdeC8W;L;#<7})9 z=9wl+{|OoZwV&NxG6j{g9`G5|MVxr6Mjm##NxBsG<5P^>dzWg~a798EmL$4`7f$mT zk`-Ob+0D?eM=tX!@H!mBy(tZr=;kjZ?1IG?#9#dqqRgdQ%`Tc|bvCMu&4{|=YTTUQ zxt$f4TMxR;mg8fc;sniZcEGPs0u__75fc}giY}-IbAuz5bjU?;(Fn+K>h;yQ)Pr8d_H2z?0agI?#qj}jrwr zs`=zdN&=vJS<2LGiJXw(3$En{agqlDnB|p@!)#{Q2n`Q?Ioyio#Pt;wi%iQzQaUD^ zk9r&(5q&7MSc*ZBYn#Y~+@{J_O4!wNW^~*gH5OG(dKV=uEB3V0=$Jfi?PS%5!U6Wc zf>dzYS4k!u3b|y2WQe&V*o5Hwn&#L{yBh1EJLt?l+Zj47_IoqGVjBW$#ilJlMO^Jh*x~Ws8Hh^_Sd(sF1D8m%tyhqNfu|{ax+6)WhSuT z@vADgM{J@N=w`BjCq*mo8QV3wY(_b%9t`JEmTXpOgKG}V;BF+NAUM+9w3E6)J*L}d zjK}N4NOAz^3?@oo(pZ+tmQ5**(x~Q@Fh3hzV(i8PQF~cos?)i1!^Op`4K} z!xyJr==TZQ;e6Lr(#st$HPzCUWyA2Mzj|om(i5uv~5$ zI3D}*X;GTa>@BslTTXJJf+KA+LyY5aBIs=G3X|8A*HL(8-q%lvqSF__g>TE%X-HiW z9msg@l_P0zWP|iPLNOTAILL90hZx#rA$2nHqfAc%2YQvPWo@+=HV}CHLr13dxEi$a zd~m~01Q^m96h?OmuLzqwk8I&l4e|DP+#5MMEa03y(+po>=Op3DA{nqF8O-%FtUD)?t}z`+M)t7g>l(b?3icXHeN(BVakA{t5 zgmJdyjyOUDWClLu_s06q4^9$YzEf@!dZ#zK5$?5kh@?5=LA+$N#M!+AboptgwWcna z=rr0n3FACTs}|baF@qX+Bi$rueY8ex{Vd)^xD}i-6~xfB&SK3DC?Tb`bcxW+^Pz@` z)o>mVVsWDI_uyflOpimbc}#Fr5iGm+~GV zIc$?*P}k7#&uXh^+R83A`-_h6jJV!Tt7Fw5J?BVH@ z?GF`8v8`icjf_oWdpSFtrfph|GsBMOnfGJ~2uW?tj&jaPB)CbSIBqGM{lUYH+%-)= zxZf!{fYdzTfk}CYgB{+$ZlZtB4yrF zu;E;Uj=u8dGi>E#bQfWnn!mtcX~pdfy86{ny`9$Z5S$!a>dZ6X{rk<6aZvinLE}nq zuPI{#8i|G=DA69wX!Uq*BP$*|$;9D%`}=k-vL-1iKp`Y2eX?|Mh)En+HsYML4POeZ zd%4RtxU0U1!a@;r%PxdMi0KeR!@lplvox}sW^59+#$v95lU=6Thia=bfNX;oE43a> zqxnL?< zIq7{p>tf(o$Z$J0@;YYSPb9b!7ZnLLO%bJ7kRujz)!`>zd7wOkADCmZ1Q^&@L`Eo- zTbtb999s1H3KzI`;QU}xror;k$rRMUP}eHN6qKi?OvM2`6|j0s;&}xFGvYUYA6|!~ zmQQ5)80@pJ9aLy-p~#`LqMn$D+D+;t3IU_39MjCk*Nf(xZS{q|z;%w;+vvoqMuDW7)JBHh zWz*>;v2Jv9Oi6eR8(ea4*yAdo2TZHoya6etTkCyHu zWpnW57#z*v4T$ECf}!8KM14mKJ6zy~9~>I_R=FL%PcG-uMvC{lY;45dDKX@)FSzZqvF_YHo`!XD|Z)dnq(r< z(FX=N<8MSzZ4M5oYg{zq*yn-bIW{>pgkfIl3_{if<$}c!CvA!trje-7GY4#vOePPw z%3ddD5CVa!D2X8X=yfw#11TKT_IX7%5ihVP1T(iCKn_3_1<8r1Mkpt5!X_NaB$7!a zFTiwqgRFwE7<{Kfb!JWWsM*dIEpmi;o;wl^Rw9Up@j02!8aqN{SHPl-l~xF%Q8l30 zvM`5ErW~_Ze}8BD{3YWPD3ehQ2_&qUqaU1QX9g~US*jovje5YF_%p_DQM=B9N41PQ3H zZ^HXFl;J0NG!Ibq={f1zWqXP{>9RDKOnEWKuqFp-Jju2?gKT3e+#3+|Ofyw$AlfW6 zokXywc%aa0O(I3nDQDjtdXu>hO%?gXXnfUf&she#f}9~Y?>M!n9=~nS@1)!C>P`q|4b%`pMND_sLC1UrQ{sidLkQS6+tHayhP{EIz^4eF5mN|d z++|@R*&T-33hJ&G8-#=Y_`>js#(^dnAk?3@Z$0lfKmg-(ZNS^}S0Ee`T*>`>j~+={ zXrc*X*4vy15Lfq`z6-uYAYhct0>BvfiS!G{Kzy>9#ff4E=aZ(*Bw>mU@@@oUqWk2~ z@;ETOl>mrPp=b&bf&|t!AW1r%o=_^d@vLq@SFj+FieQb&`^1lrnf3$gHoal`Qk`Mv z)KG(CSBh>+Bh<0%z|6^1!1qI}$wRlm5AK>h()>5r!qfUM3lt-d1!@8|$l-FoN{Np~ z9(Lr0e~smd>L^QsLf`s9bOd|{%9f|z{`r3NCq zvJTX2SX@SdFR8#{AFGl?pO1$)2WLQZ59e4Dr1>=@M9dIIOo-Yw%=%|!?7&~nR%yVD z0Esj%$6BlofQ(UcI#BWgaWNz>D@Tm`B@!3b902%cZkpL^R^9<$kB{fENd%ac1Fh>U zYXK676o~GZ31F4%W$p>a4`TD;m?Cw-Bn8Sa7x7df+~n+g8m(X2x%@)8=TCM8BGx+1QbzAOd3r|2MLH9pg8rbO8|5=rx25#zwZ)V$9?I0&Ych)2o+0&jJW z`1J@HhVXijU-|rK_yE%&9dRmlx}iT4H7>@kqS*@$VBDfhobB^^$riJHPQm!^cyv#C z!Ans0e5>yXBsyF%k+LFOecTQpkOJy&52MKsR$&wnheAOFIROa3L&F%9p@}KElSEA8 zIi%rWpyV#bP|;Krg$o*R6pRpsP?&_q+2LveVqpi4GX~jnh5X_Nv$L>-=^hX0uyX&z zHirQAeQCth1J)b4gg!uE5`_kWkSPKxbpSg#!$n`UDAFwfQ4Cc`B@03{ zlnF>sAxIRE5RF7DKv1MfGYL|JOh^R?fkQwf)j$bC6w;weiApj_5H72>3wZGfCT2m%Y(phgnwrUOmXP#fsEz@*VM zc-*a@oB@P<-BAb31Sf@0K#*|sWf0hK2YcwNzDRF3fwXp}Z-SPpX=$38A*p4cf)i%r zc6hn*IvL_W7-v6F|6#2T!+V@8j5Tk7U-4bQmmR@A;P~|eVFvfdK@lZ10oS9sbV?`~ zl*L~OC~BkT>flh@zwiU?_`%+wcYNF*4IN<%n(3nlmt={yjcoFTiLaI-8Lew~1vElG_gZ`%l+|q;|&GEG=im>jRM^jjaB9aSVXde(= z`1ssSUSi#{nxwJ5hj4;Cs$Z}2{;OvSb zN+?P_%ODC`LV}8+p$ced3ZN;iYJjGKK!O3&0B$;yLH6BGW}=<~4-nMxC|g5G4%Y~8 z2KS5@(s`IgifyNjPRb;pveQ7C2DEt}o>J~f*_a2IP2vZLplw6E>_6a#GypjfP#QV_ z&bHhTe&Ig+D0S-B>!u15X+-SKp)BOjF>XTQ8A1{tq0j6GLF+(7%9K!obL|GuPUi;L z?J5?BiXGICCr}t4Nl-9(x1Vs)UZ_31Dlk8i5#k@B?1j)LB{iY^W#R<-C#dC#r2AvU zaHvJ4d<1uM=`06ZU$_eBnOaFG0{;(O3q^Jz?SM$CU^6dFf!26=j}^Gsd$aID=sUI) zQ79Ka8Lbnbxp1k9;*T8g_vc-1S2`Y+;KafHID^t2x55~y3aEGYSFZN7>B>UJUsLsR zSHI-{AHLQdNdI$FhrtZsi*DR)s`X;lRXK#yGjcNXBVV0gd}XzUz1%k1JE^tb;O6va zd+kQuFhID2Yome5*)C)pSaxyIVHQkmnaaEgR*Q0(E0Q5ozA|-rm}-HWc{;`DOHFzp z$Ftukv82rK1S*3WYqHXh(iqTLJ`9Fh5`Cx5UCKf-zoC~K^Q1#J+YAcU#B9-&@U08&f@k-$$skUqf2Dj}4RT3Qga6`~s8 z{4%3^{!1T@2k(0FLdHJTeDF2E)=2`l6al#^96Jz8xd8^14in!wy+&FHcFROU4Kx%q zQZxz_v{JOILVbf`LXspX0HGSBS|}2l5CRBFR4G-Z04YM52?vaOdDuR2-LN%PPZUEx zPoL#|34VI+7PO=+me!tRp#bK4E@>!7+K^0|5~YF}swh$tN@#&1m|&TRLf~Ny0Sr)3 zgNR%)G4!d?(DFW$2k6f%vjO*hrg<84ve82k7jpu9x3oPbpvvWkbI5Q5*1<_#MS?Aw z>BR-&Arwjpc!dxSuCzLwiP(;L1$`(1I4SicI3wIw^^L*Uld@3B29pAB8;>ZUp0G6! zy|qjb(E3kuBfLEROrw;!RSb}vbPPH=w0rTew(ZL>G{7<9I)jRJv4W)YgG~fIL79kR z3ZSkQj;-1JL$Sc8T@xaJghGyxEq&vA>OQh7j52M zh_I8fK{^B0Y7TrIbcEVEtzjwwLOpV4Tyts4!`cfHw5WTs-CxK4G4Od>;v_D zItM@r^PNA#;!{0!@cNYYx_Q^q1jq|lM~k$WLS(~SbS*G3UTGJm0MLMvScE&~P!Dq_ z!W8*~%M}p_P(dPMJGPmJRw2>M1=E$n&v^V_Z&3KF7PQ<%+`n)|H|_5V-YDgCX?9iwHkAmVqy))+CiW>BgrVWg0+arvSK)C+Z%yZ9IQoH(x_vy)a(}?F@%8|O`8KmC=A2fgvG#O z@=L(tU<`H=7^V>HX9`RS(mY8#3}Mghep#COIDTkR2|ieUZqst3W$SneoxKP0-LjLD z?GC3PBDg~6Iswp28b_JdA^o_oNGDMtu<+@i#FV5#P(Y7x{)}D+5gm^NkshGZAL`&9 z)8dz=#u>py8KW^{^>MjHkbte}&RCk{(I~>x?WRA(=nRhmp|}eMkVgd2LOawL3Q(ms z@r=pSpAv9qlNml7G8aftg$Bb*-IKg|gL6YP5My?{pvSW(M>fgVCkCC6xJ=v2gCz(A zZG(;NqDK>8Mmj0vQ1PIiJjV`dfQg6>E-{d{X~^a(vh$d{T}YZ9h@jAY#Pv)amYo}C zRZ|s2Q$*1Lc;Sv%^kHT~AqnRx+FXE|@=9&qj*Bis#LnLtn^Nlgz%aSsib1g9=ZHT4@2Mu#NewEg(S(HMh9o4jfy z?J!c1ZgpJ?j$17AMWuf9Q=$lS4S%x3Lp`}8@zNMXeo&!Sj1v%psXLENg!|zGrv{?h zttae&((knwic%0?O();`dv%`#>Q33a;3%+d^@Gqk0o9Bd8=6u@@$rQZGO*y=V6?M{ z8j$Nk0SGR*fwYHwcvPAUN<|-i(B#WQR8Y{wtrQRuI}Qk|PUK;!C+j1Z0%BsIkkJrr z1SJ7lGZIS>?IyxyWR*KX$TSR%GGZuDcf>sjA4wpI`KzXhcDFR1C_S?sZ3g9{0Cdq>z>s0Y{t1tCZPMM0{ekDcB1RERB*L5ucG%3qw^&q{fuR?Nh(nw|gbMOA z3LA|fCq;M{{sy&RMzelwEU#@x#8f^79(8+DeKH|+uhvC|~G&pM& zjBuH-lPeJ1Xv~Eyj5R+6G}&2@q_devw}yd0qeH?kz{juG%rwV0Ii`ceOb+>i{~<-L zjO)Ob3xY{hg=k4gR|Y}bSz@+i2+;M+o!EqW<~ct&N@^e|q9Gp9^wCNOfb;>lOLxIse%*QIe|C(oSBA(P z3CH9g*OH6CJ44XgBwpn_dyzwB=nT*@fU*H$(`!%PQ|zyIR2;x~5F}iU7(9l8izGho zqsGU<6+E6rA|PxP?}dtjz0z9-j*Cjn2UlDkaOJ8>2&I6cfeKTQkVhGMdebU#V2YLM z<~EKj1P;$qZJ%T95DMY~V4_@|wHijdp zId3yzqTr`dhbNn$h>Cc@iZKT^36zyk1#Cdyek-{qqJir-o#_TK1D#9RN`eDoBH-P! zk=7Qc&nna(LK&f*aUB#5kb+!d+0viJYXfunmS5yfombKhQ79m4iMM1VeYqFU)BN>f z@%n#?u1P1_r;=_S4ja2v+hpnsiJ3Ck&>zS8D)1A`0qc0*hu4DkJ){*wKcc~Z9Av>K z8}joQF-=@9v!Wj=9`=r>hC5K7(ES4tIEG%JUom3ky*mQe2;{JNNwS+84=Bg%F0l5_ zdyx}?s7gggaj$U#B!7AbM^i$a!Ah-p6A!poP7yBhjgVyc!yLE3O zOQoKKT|>MmxG)3s5lRY6C?_K(22l#*g>;MGLVa);j^cqkgYO4Mm(Ow80ukH|vw@Nn zlp2HQ3J~QmtIUH8Fc8c$1q(djQSnDS9Lx^Ke)EH{fXO19idt14BslX>>rmSue97E*Vs7_f)}9YT(8$NFWhF8;vNY3oK@uY7FUW#-})C66_ftXs9_asXbF`vl^QU^qIYBf@5L@>-y@|q7Peem{2B%s}5 zo)Q;%Y$H<|&*6a{pCW93iK(2`#Q=hMtbA`t$tn8_Ad?Ef~Amh>s9v z>v4^@N}XM9Phrj}$)sr{V}pBzMhtGcQ^QHqy)AViy;$O=U3J~q;yTfcT9`V{an~s6 z=_WXtGbCY-O{y%(Fm-}&G7X6_mrywaq|roN)wQn9bCSF_JHu{}HqtTi_{vjHTvVo0 zFu;iE3Ib49E0OumBHL8q^XGYArk;y zjiNl~Bg;&D*a#Je69iEvn2l8kT&OnDeHuZH$|}c664MJ9M72IQ(Uj>tbvD?wlsp(r zcnoSww94uK=;kJ4g z`6U*o6Uo^^d4@1yrN*LQ3~9itd2;BLDqbPgpVe(}H6C&k5Vrp6Pkt*eLSzf@%Z}I$ zrqhjE6V_Gj@ry?0I!2>SjBDMgx2}v#V9O5_75a{r$!zMtCr|PO({bz!fqH3%L~ybP`W~sNNcEQ4HOQv zJBHFHC76jr!)S3j2zeFJ2Qp|AA%!yWIPp%%{GuHr@GLO+JP%9RJML#t<47f|PWNsG^bzP&BAx zASn_7l?q9f@Q9Ego1F3*#v!1OpbW!-!7{a-5(;LBULdZl>lD zFxW~-yk60O+=0|cN}4D18v!8;S^^tjK1gaFh+C6-ltKfubgl9IQ-Qr#t&&2e7L0k5 znx;P4y*-ge+ML@PTV&OHBF-p?z|l;f6Tr69SCcd&&u5g6F!IdXyt ziYX>yp05&cxz&S#Y#J)4COXNAnwX@BI@pMkiVJNl6G9SHL@Wd_JAnI`72O8|pVa68 z_eCMto`Cq`6h#daCaVxlww!MebIt>tF$E1co+2q^*wC=zIzk1ut>*{{MSVelsyl2~r6Sq-;67MxWZspHO~I zyNDvGYr)c2(e!=aNaryb{fG9lBIZu7Oip| zZKGs{*lb}F*QjLE$PeGyeA~~SG^J937|X^T+}0-8*wjJVPB<7CL>F>-$mrR_)E@jJ zdHD{}e5egIiJS(7s**==@Sym_gGB3T3_#MU{tU%sfQH9SD{7X7yu%BY^h4`FxQpIM zbt&fyr(d?2#KG*GLFoo5dNvvmW(YL{GT;HdT^;kuSH5+!t)(ZMM(cZU^xIC#(+A6C^E9pTWA%K=W?{yZjoFySp(Hg(yg{ zVvIgoLaPp^_JS)9;Nfw>=gt<*M5;q{)Dt-Ir4uBiZiK>L4h??$EMa!O)eUFz>$}K+;Mq+z{ zDFAWt-mJ#c@HCDAKxGp@$uXmRX36qRtHcAoKGkkCu;29Gz&553~?X|?Sl&b9>`5Y zBkZ0W(x^!wNeIuWs)LH9%>%*X0C^21qJ(#u&vQKcOiT5@_mZfX7M*rI4?K7a!sUxF z=_^E3n_~n~iNUww>Gl0h%zb=xD1eP(0owME!~{!78mMKlyr*swOE?B z>^|DL!5v3-Pd$^}nw!uuBxrg~G*tJYc6e4}qEtr8bemBEgWxp~rT5}(+3sv;Y6oB< z2d~g4WQ6`2f&+FzjbEN5QwB8>FSRU+6k(!*DT+@QN;4DL0m>o-!V?CL0Nc;|jg{z+ z))W&?)lV6AGVURc; zxefvNl_y;|K>7$U@%Ty?2s~Q)5Afd7Nb1}nqrnR*8x5-R1Aa_onhvX+A!qk?Qt;?) z!r@DGs81TMQSpy`nmdeAe$aBH=6AVNt{%_zJxQ?=mg zKAZu`@y3azK@1TgbYOG=pzXiCcl459m!H$p=wbfT{EYp+;toSs{GU_X>v+Gi3V<){Btr6XbsF(&VP@d>gzbkjn=Yc+vBF}nfv2KC*l zR7!Zsw=;u)5|qTz56}Kb?{PX}pd6b}XPX-OwFPi~1wjt?Bvbk|4Cd$RUKkh)xw zH<~bkrlgQLff`2=lFWhM(vF?0h3K8$1t^-}kATJ9G9k7R#YbfVY&*@}`_kVyB>`j~ zU>3o#5j(LzdsAK+8t{C)+Lj|pMHH_k3`hqASW}+=fo)sj)4;x@a1?hM(I|RC08k^) z8QHL=DRd-+9|~kBO-5EdHG#6?2$~QY*aZfG&>vO~$qtVni*u5=(oDs^$1EW7(5wyv z593%f0fLR-5-&%Ceu`nv>88G6rx6+~K^s4FnX_|ACH75vg6y;}MWR|TFmE{@nS_Dd zh;$BQ5c~HbJMKY3Q4>K`;jkd`Mlejf8mOp-f{2Df2nZqw3txo6puug7LBKH;K`?OP z#4Z?^NJ&C~rlO`I`!Rr~Ib@=UV4I_2VUVI8XG&{DDMCY94Mc+uAkhKVG#uDyAfiei zdmv$isF0w6pokd~NRfpoy9~Ick|Mf*#w?KqEd&%qGR#3$35g9sMFAs2F|rtlX=x}( znV2{P1|pas1}PSr1SrHOIia8#XlKB<&I~$Awl+e+Q4zKdqlqTGb*q;kIRH`=?LaF+ zZQ~?jDukp6Ei4QOu_F)<5%n8?7@tv^=Ai2+{8M31$cDgB#qe{WxZF}WTtZG0&j6Gv zP!S3g0#Ga)K|>b#d+vg!y&>3Il^!Fuu+Xl#FONgr{5pGEPeHean5RSml_mD1Lc!C_ zP9ljXY*jk_Tb?YMgkW*a2TXJ6;J8S2AGDA$6vP02xCb(S2umHx^*y|4(jixMP}wiE z&iL7Y_1&N__zkw(80lhti=EOV?1A|~mo|(hUNpa0192WN7;zu<>8Qv~`c;u#aU? zv{V<~122F;CD z2-tT(kYVLw&V3-~156b=7`yxl{Lica?x9K&l9G|~f$p1&f@Wwb2SzFh#gw6Fi6W#a z0^gk~ayY5y9_Z+%ju0df2!xP;T6niFU<1xert!Y0?^~j!K}bYs5@L{`AQ&PEq-hAI zfGMF89+Zp~6N9o2Z*&hrJ2+gbuY%h+>Eg_Vb`g9tptPvk2}%)AfdDU~dN&S*RFp$} z0Gq%cR=Od;bX2VrAp(!}4FwHuMz5oHN#l&H*lI$>WD>K9&ziJw_!VJ4=cW=4b`FD0lv;d>eWfcyk1eh{7t?L zo!XY)PO(=So25l$@e1#3@>Lto-72IVjmcA|UesOjUGG;?LUd$6>r~|lA*RXXdC@x} zUZA<_H=bS8*)^5_FMBh_=|(u^TPL5+-PkV=$qw}F>O;`_2L$wLOiAEVE7^v%1>2objNd4XLpjc(a4cAxDXM#X3bf zh;&-hxA;Ys!x*cbv6_3L>@Y;`E1c%%3GU#QL0nrV!^AU8u2eObOvLG}HrnQXm=6ZQby6*T}JLnJFfEV(C>p5 zr&3lKu?{yiKIw9r1kB=B{(gbafI$|JN6mhVtj~%utRL@R)Kxeu)zA+s! zN9IW&Hn4cb1}(BQ%6hECd1UgU4#eoU%i3mc5d&)ju#+%gSWE|XfiT%a3gp!Aw`66k z?2t+wbX!_2B-652P@9aovND3@Co=AAn=s{(pQiS(nQvxv5stwI)DvfzyQ?wC--_gJ zwEZxix;$Ce$~@|}y<8ZMrs^PgQ4_8bm3Eb@HOWG`j(K9^I`MVQCB}%-c`FFTv5QPJ zGvHFyt9fCJ)9Q*Q2V8?|c_WkMC2I@K%aqbRO%oV)oMPKH%@)zJu!Ui38nYTZ!X7f~ zD{sutjF8m2XlfVV#NHcaWU@AzZ^t!A?8l~Ib#mrN?oy{&mHc|ealN|F5c*Cf(7~oQ zAZ;<6ah#Bg0!WE+2oy3-mkkMI-=3Rt5zIyx)+05MQzR>q2Dt)nFdZSPjEbh1)%P2y zdWTQ3ObMC8V?ik-fY~!_9JpgePuanqCVH7qq0LUNK_0CmJi~N#ybN|EG6HC4A%o^@ zSddJcTL>|Nhf~Vh4?4mRQnIvdCHH<_t2eT1THz(hD{;u&-et?KE;S-Yp;8r3s@MLqsz`&vOOC<4@B*JrC|%!_|Y51yDRtkm3ZM z-nsgL9A9lY?S{Ng=1smzrU*VM&5U5?rM;6typC~v`sh&A0Z3+J{TT1lB|=kl1{Wly zp`bY$eF;NQ-^9%W_Bwv=-u=wj?AqfMB?l;&GlmPv<1RmQt^%DWu#pKt?B$yqgc<^a zn<+pY$YDDDMAs5EujIxp^yfolhD!A`Ui?G8;0J^O=#oIQt9gIvx_!bS#4NT6FNceV zQV;KW=sv>}3k43`Fw!$Hj(y#!=3D|)OvLuRT2el%@c1!(-X{Nqg}{`_#`}SKlFRVg zZ(|k;su_iCm}&V)rniK;*zv2AM1zSOD62CVl1@~~GZ%PM0|D^x;~5m!o}#3E#R@Fw zX>0+wzG)P9b2ZoQZLGg0MrtL^$**jiTm;t?R!ciI(9 z2cL3D1Rtbh0pqwV_SL0>P$BkuI-z7PbpQt9B?0}SdS>&wl&KheoCM}0qJUUXLqaGz z>%n$ufJPj2>CjF802Ij<@~T=~g@PX%A9oH~nDtCT_c_crYhk>XfE$ve#U=&q z*;g-JLQ5w)5XvHS5c<5lEv_k=I`*&#K-NE5#`-;*(lIV}d0$h`NMZo_{aWXIa9H|x zQ`AEN;aFni3V9JKNQ5$~LvU+!1_vzmL`^j&;j#n4f#yc$DJl`M#p)Ku zPz=;IFkOTNDmD)h!_r>p8(@;@VG4zS-wTKk+(G)hw0|S&|I_M<;vL7D4$8tYsf!ZF zKBZ`AJTt&7D8d&L>wqyQ?Su;GFrbV@RfzXSB*17;Df}iND3f^5oZR|uE?<^l-hsG{ zfJ}D*Od*XCAa5Kjz#StpsDiy^yUY=BjpEf#nD!Y28fpP&pt;20iL9%#R4Gw)TwWAH2-H0d%CpzME`rP zyVZwD(n{mSYNkg+mo_y84|pbd+F)8tUixOL_H4BnzAa`Xqz(}`Qk6!WbRz67g~fY# z@-`Dw8E>>lO0kVN`{?T%4Gj}{z%{E@0X2?!Wu|1v1i!dN8WpKtS{kr8!XBev6-wrN_K%xZ)gq{H_3o7giB{4R@lC+Z#B_2y!+x=g?z5KWZ7n)2x?we8OqQ`U+c+B5 zA&DOjBK#1=F4PA%fxXSSxD-TU-0C#cK8wbXjLn?1GXHV|y?u8Xa4imisy^#>b!HF-P>I$K_n85C{n zea?o_rm}o34+XjCcM6{2l=ES+k3g9}lWzvPEHW$dz4-Z8*GG`3)kF z=^g8|5W7Bm?~r-2AcaMJ**8SgBAKnW-c%GMG?}p%H?r#ICi$}?d{QGW?Wkd44l2ym zg?gOTS=h|9A?k~zyPb6joj!+;IRl(}uMqD|Yl;ib{W`|P&#RSey_x(0?mqH{-S!K( zQ4N!k?485X~#J5 zA(Ew5;fbAI>NtQB4_&PpCX%6qgR-jICn}}-{AFg{(Zo}g z8#YC%VQsS`THidV429PM!4}L#ycDRa$&?V;j76}3Yg+;tFbJAMN)>NHDX1`?UbxO5 z67ob63I`$_nHUQx5|#=Jxs?&pwF2->Lxe!M66Hcn1OsSs;6)Tkb4D>o7>Z1calML;E&UX==nWY^4eOV^N7pt=2s4q3J~Ilu@|8oPZ9O}NguOs-H)f8 z9K@N>XF!~WB+t_F<|KIz2+1a#EQXXKQE3ivIOMFHAYO*S!9BnU`mmrL#esX0DwKif zN+3c;Oi4x7Km+%PT`C}Suz>ufK5+dNIeW@v6W{Cj{lZaD^H_;>n??z8W0a+68$n(p z%K=ddrQat<_c&kAXwW|ytg;Tcv_Wo#Bfv`oXZ8T3d2a}jffgmi3r?Wc1|sT#M15DV z*N4!%pJ;<>ZG}gng(*~-B0vXR5Of{F3mXTZV(pXa^#@t9xEi*FuPac(c@uDwaTUBg zaSCHAl93XT3U)Mg4D3WrR8BFbxfmg$ zeDUOi&E~`q_$?F^$r0hT!zKzm;ly1KZD=5?L2MBg&H{>dGZeA41|gJ|L)0O9yWgsS zoVKRUIOIeTPG%6Y)O2UJr9mO0E7;Yg%Ju&2!<8{=a5Xmh$ppuu8QD0XXAi2goKH> zo>v*xalz>9jGlFQpbd}#n5?DN00|F>%H@@^MC7T#7VU(>6$7MU)bFF(-K&Eh1MflC z)t77^elM0a4|cBm&RWJX7mgEH+T&QAhqE?}J99UIV4u4aWN+f2>nBziF*1;BZuVhH z^$p@M$@6sFOBq(xYF5^|-A_7ZOfNiIHgwS%0Osc08d$)LEs1u)W<)*3#u15{fvAe8 zu+VWVh$u8zc)>MA&}2a8Lx$zi9rabel!z3FB{KpP33nuk)rBv9=a6$f{6$*tSq)4kk0pC|w#;AVsz+j$edEs~hPwNDq;3wPEH2RD08N_x+ zw2nr!+{jZwisoI5XjxJs3Ri@hS^ao23CRS2k)@#uQ!qXA^IpI)kU$6)LW7|nIkgW! z51tg7kprFm;(&V1`==2J-f);=NFbGNYXq`VK@z^9BZzQ7f1Dlx$5t8=iAbH(P&?1=+6exu>4|Gw{Jif0pqumXL8^S}# zK~I>estO9rY~amGlD~vu($H9u3SJ<6svHlhA;kr>KEMW;124$}FGEe_gbIV;2j>W_ z_L0X5K+sQ~lK7?kv+%|Cp9=Georj?t7ab~^7K0>*&38T_*orQKz^BXX23@<&hW0$9 zEeP>_F+fBG0tU~rq2!5(NQwy0&C&OHy_U8DD`Pqa*f9iSDW*x9wK|Ngo4h7V8-TxN9 zC(Zb?>T9??P;>}<t=}(#Ap5ABx9hZGdPiwS_+f3&;))<(+a$ zJY5A4zQLXY$MZjGC_&>ZtSE2HC+ZNa0omBnpuS#x4q(_C6VP_ZocO+*%Z3;@OPOII ztx+;ECy zNYCl8-Y6j;n}&YW+P!?+21hPjI%&g(0td9+4ZTWWfGOCUS>yfK zxU&={I!Pn<6W43%)uy=GV`67GJvKB17=HxucG{N(DVflDLj#=1_<)UOKH4afMEz9r z^dagQMQ9Fpp-+UWB{W@Q^-n|1+zrWv45EM$h`kuZ+;Ge_9`pL283;_}qv}5QdnAt( z^^6bFNHmHR6aHL;>h41_2tZAN<+AsA>(4O*=84P9LXhbw*HUBiVc~;hMGQ2 z2cc$fSKaF-ny$1(>QPZ~ubbhETEebgW)+jzo%A#5F_m;WxUk0zNBHhGA**Hc9N&2@ zW*O5QLt^X2uJlB0)37gx;RV5Z$XC3I2Dagu)2l8V#8XgwUbGx1HWY!g;s2W8A=L^L zKgW@zUrXme)dTgdr&!oJ%tH z9nr(4P-Ws|Xc@jk_V=NM5@coM=Fz>S^B05D@Fn-R_{aO@?uX_3r#C%-oilu3LP5TU zqn(4#DTIl|kz`qllcT{9bYDQcbY6)u{V{57pKhXUi0@!BGcne0%x-2rVWB9n5ED`F z6TqeRr}Gu#MUvM4-0UCrAIbjT|G(OuKcMe->GS<4Jdf%E=lF;Q3_n$&Afo)I@k$J3 zh$0XN?EY@&?F{_C@%|nQFNy+_@GyYX8IK|&Au)~sr9y-u!S7h8+5X5ekiX%&MSuSn Maz!{$kezMRMk}DR4gdfE literal 4757 zcmX|Fc{J1y`~4Vewk%^;S!Tx2BxB2#1`~!6Gl&T_m>6r8gy@?z2GdwZvX%^ku@xe_ z?Adohh3u5H(yF)jeSg3A`QthF-gBRG?tk~3$MgbOA8A5>*%Pi>Jl_Ho4R8MW?;I@t zKR8(2$ocbMcJt5gpXE!E=~9sT9& zEYQQ!TiX4nwZGcJ6oy4>a)`JsS-~Xf$?4M;G;M&>1^~za2Q!t^BwzD-iY-1;dqRdi z!4+_L8aQpTCC(E|1QEIVV~HF*0Kg>;0Ol}p5D@@C+U@4qNNLz#Q3=TfJ)J(T4G3{C z8O+qbNyY$<{Qm{|4-f(X$P~*&Ha>mqw;jNV;xv!>YfmKuq%m3Te>-?`cwzv6(=C z;ygyJCJF#Fwg2W2RNztI$szXv0LPXrdF*KMX?u$TvIoEs69aHepb{RCxL{Wetn6&Z zMXh31nK*7Mj-@paKvCo~70CwKqF=X+JuE1da3n{v0^jkDqo&$S<#t}m3h{aj+*5!S zeV!Ek;rgZPq$;hHSPrN;Y9+a*4M$eABxWUZ`A1f;tqDZ5$k? z0z*If;@RZOj@agYkV?v8UPA5k5zv?2ZOPKIa`Cv5Jocl<(_eID2W4OT3)2Qh-F*B4 z9?$w;JHIay82B{Gy1}t(uRhoB<=bEKih3@pO(>KT>bRQIkGFgVS-R&l-qj2u-c7CN ztuLVrJq^$IQ|nY4ruZG6P0L-^I~7)y$u2EDrP%2wSKIXT*_(?-Fn>En_D5ajucI(Y zcigyZkNi-=MhPoXR?dJQUMQ+A(qNCHO1oEuzmUtac2ak34EY-Vd;eD1WZAIQ&Hfvb z{BJ4uzyvghG_!@zRJ0gS(B*@0gpGRntUn}gEwmX=c-(YyUNU%W&?sh5`|65AdLaG0 zm|K>%`qiIZXRr4rvx+Y%qrQ>HD8Q4AkQ}C5hrDy}trTHxWFxTBl`4$ZfN>}&r7{v( z-mUV_n0<%Mj*WWWJ&&=!=(t&^W)7zZcP`~L1bonJeV^^%bHP{e^Qe0Bc9*Jfps^FI zMdSNo!K4de40R^_Ny~Tey|dGtb`+Zn**-s(3v#IWiVgQvL#p1??Yo8@zgThIQ*O8Z ziu0sV&<~;Y%JmCL&Z;W>-+sIKt@H*@K)})s^joE%Q%zK;O7Lz7v7iO%Xm3G<3j)#zSVm>IQaL`=kB%0={+=TKI z7)l0cYb{ODh+Sl`zuzq`Ay2`XE1c&)Ad^I`;x;%i8R;$~Y(+rBEes(R4bGO(P}Gs$ z&Ys^dD{=eWaYHtHbzm>EXe){3ULG&F<8P^yo=Q7UI?j!mymX@+xH=qLV5yMCM}b{- z!99@X5@T>!qhxy*3h(R0z!UJQrhN%$w58vRmo*uJT>KNs5;7CcgDA`9dFfl!D;!#* z){(sbEO)n20#8fud00>x($bGklGYk_#I2K+7ppy177rO~QZ(3q%FDfmz39)lVewY; z#|y5`hUm=PA@%fYCLs0I&Wm*q1=>0tIjx=M0G!D{NDKit9>k8MyXKdyc-= zgEZg>)mz}0pAH~D8y5+(Q=s3a^ozv^hvNH7QPjt$peLJqE~mzHe>n^1zEZRwapw^b z)M@?CL2i_Im3tMRH{pz!(%TqW;sk1c?|O^Bs~3SoaBlUQ-rGlj&mE(%3=Z@2JgH4- zXd6ehX?&%l+C7JIN2@xAx+&*bQhn_PcGAf5`ck*dNy%P`he<(t)k%aHcT~W?Y-?g%QA6dit9!wZ#`h1at zvguTBo&NBASf2wTT?Dj02SuR=1(nl$ zKkC1jmD;Y0%UlSom!_Kyto5wlobwlKlS<)I02GByn0%bcu_#j>Eo#ud$z?mwCsHU= zw|F-6bm^aCdtmrj1so$IX5*N zcFt8rxaVoJBq^li;zHANv6*LuUE=&2tB${f1CiY|fm#MlFm)lC*@;bv+`39bN=Trk%OGeTBneF5<`NY(k%4fC zFwmq!q9$}xBsifE!jLZLL!?4kAh?(W7lo-nhp3@Q6k5IjNJLPtPb}IeE)8@+N%lC9 z-Y+nLCMb2{0RaWK8V*Yo0U&@=@ut7>d`^oG9>l*icAEQqcR;6=H)7{O+|i4Ne;#>$ z!}jpK46pHTv2UH34TYeDXY`Mf)-=h*(i3m0myO+T2Zwask-jEU%x~X&N`qwRCk<{Q zXk5Y5@VRt6F�U&1@+Y*PdMn(#?PeY3axFz#IGK#|u3Px%azgooBrI>(-A37rJ;W zGD3l&G1i~)it1RbE4c6LrSFA0a)-5f#e)GL;+Ij>l9D5p56x908x z%WLxIZbQbgu6@kt@-m~HQy!X}f*8u0F>A)zjFWnMD|sk(tV zhN~DGnw@ISZ||NBtB7b`b%=8)OLRP>d+Zv#ur`7QQ(PB|F8O$=z#JQ)6m{2VxXK!^Kx#u)AJgfFK(bF9bU-y@+Kjj z+RH0$cH4d6>zqKkzL2#vVtlaV#KAp6k7Y;TG1%zMbMeN3?u&4y#SaTrN>&y|S&aFn z7<$xRb<_LJLzC1lL2H@-9$j{8Ux%+waR(D?dn262`sPrb5Ud>7MK~V?pOg!=cHi ziSVcp%n~Gdq9A_s=%DnqgWRTV{g1(=D9PMSgQ5*75(U=dB zlN`DV#uk=eN7um$g*$7jt2&r7WZD_M>vxJ*8i;eEF&_tRXqkrmN{qEG-K(Y^!T$fB|js>wiCfMfVd18B^Rtyu~^M?d(O6IfkG}9Q$w|MHZu(4!NL;~&kos8kHc4q zh`-Y9;ih*578g?c)-^0YugMMICSKn9$EvHS! z7=3=+*3I_I|9Fbof>K;NNFRJ0>*lTb!AwlWY|8avFOgnz9~CKb{(@JH@`9=r&Xi_l z2WQHhhJ;BMf;?Ext&$;|(3h(nUeJzXN3zl6lt$%TA zLH|$-uGAP*5a{cx+GiiT*)lVAT5m@ZrYdO5*RT$S6!Gi7_c!l?zDhJK8tKI_(SA~) z9}HG0@8$J{o12kl6$=4i=V}wr?(j$~zYsO87y5qLmq-xL9P4JR$tsVMz8napKpy>R z_@X{@pIw$SVsaK7m#pG}Ykr_rx)552C`uBZYzRQo(N(>W*70(#k3aR)Jq4X4U59mE zI3lsh__ewF*t5{V3|AebM@?Es{CT95G0)+i`XtfPB|mL(O(vt`V%)NODH|U*$SR0} zKCnltChqT232WCNp#{kW@yNsG7U#P6J!UYLPpa3lAmJDL*ha9H!V6x?OGmg!`Hffs zlD5$u7{4SOQB|WJgiIjP7-u!Kj$G-^mQL3)85s*O%FDbTdBoelogCIWcTGSEOVtQd zohb+;NkXp5d60D@YRr7h>cyhS6-JJ+Z*_#&zkL%Gwlr91-R?bV*=69*G@WYT@< z;o5G+l|s*h2479k%8O2rKL1g68Lo_F_fHVP(N5Z7-B#zg<;2Z&QfOZdCu~Y-Y3aEF zmgCUz9M`;$UbXvIP7Zw^v2fIBw!o~Y`>AjYA)3rBi_HTO%j35b^SmHBtU}$(%i$v{ z3bS6(i<;zcehWQ*IQ&)dD&E`Zb?;u6(k`6Y&B9?!?_Llt7c~?royf|`rRjq`#kq(U zciXR%BHxV&LwPu}I$DM_)frDMx1|i{jsz_jsi190aQ`e`v4jbw5QrOm-plaWpKmXn zWsf>4E^BvzqsJ2sn!PMv<9NQUlm;@rkyoA7GvJRhEMSFh4~4v5Xl=Z7Lp-D-BE2dl z9JR^*{_BD-JIBdSo!#8nJv6o0SOq$bzpSjFfFI#pF0n&(kZ>gS^(TlF#U@nrOtIC< zs!&ArdJ`0z#@|PG{99l--%keP`*YXFY(6wTf}*6&r3e~`oxbLFiXIh3-8*Re!yDSTX5ICyqpfcC z;wu8a9q-LA#Ed>Urk#;$`zq!h_;>UYDuClRC8#fzGeH=FMQbE*j9jrZp*9=0c2O-~ aW@l#noSynM`}^RJRLEI9yVQTbq5cKl^lU2OMw@-RI;^gC!d_Eq&5Xwg7TX$b_O00FrA6rcbA z005}~JOBU<2S5N{0q48D^-JGp*S35-0$mbauV;-115_^wquf8}8-+^Z)<= zUBy1{u}}O!eQ0N4xD50i+qrG4SUv1+FQCB>8@H{3OG(K0pyIMZI_UOsmA5Var zZ48AQeRHXI-%fk7tApxO-s9Js%DwB}f#vM!$vHK)=~U_5O|uOsUhz+I3cX~phU>d9 z?sdX7fY9k61E8+euHGDp9_Ds-=O`_KBbYz!1QOF$ZVX(}zrpp@~ z<9By-=_{uVRTL2pbluP?(L+E1Sh;({)Rn+nCyZ;F+ZwjIP~D4WwT+stIN$-wo80e4 z-p4YNY$jPv=aN-WfJCJ!5P|P{_m20Cw)FFJk4D>5!tSMalqgjtQV&^!($7xz&QC@) z*}$dMt+-9yoOWb1!qpvdn{a#B)^rSevmD**_iw9&q7VQO0$?V9001UIpacO4;*6O# zqiHrEnwc>)@{dzM^#B?Hk%^(FrjXOpXeBfdAb^4a0%#I>G)*QoO+8OdM%2-v>KjlD zhK&KHjWh?S00001pa1}901^oZgqmp+BSaKG6nazA15Gky00xZ>4K&d7o}dAs13&-_ zfB*mh0006Mh=kBWX_Zs|KuFq@ey8fE`c!|aPts}WLHbZXRQ*Y{JtN5s)bfX@8V8~= z27^Fo000004^RNm1Su#4nqZnWFic9G$*O*-=Bcr$PbvD7{ZW+D^&|C9)iN|14@RRC zCWeNdpwrT6pa1{>0000Cf+U1M5E@KIfC-3bDVj7Io+4vWiKa}LjRA>~M~ZnFMvq8n z00000003#~Kl8~{K>WlVkO}#}VqeZ6Z{gSq?O&VZ6!p)Xe|*Uk?nDpl<3F)*F1)f` zYsyQOV;~hp{2Vf=e;!YKMx1I<#FR~>Y+-A zo2q-BW+Jba9Y(Y6GySa?C*q3P0sLC4^m>;e^ZmA8@HK4vnfp5rxI+FClz*bW4@!#q zL& zP46C{Z=xaTM}tR~*XMtS)^ef7+P4uIy<{qQKuCl{C3r+9_$&Axc=)`G<@-Nm^S?_%sm*Uwbxj1WoRsy$frv?`{75L|yEn12-s_AA+VBB%sJkgKo8smaMsBcjjf-01*1hmM|5Gyy$(tA)p8*e_ozx}(|;^Yk~iN(Fy$|yhRddon8_kA_%!^U@c z?=AKsrc8O|HaxknI?4BckNS1*QX(LpGP~6nAYo{LL=orSG9aRN&Xm{mZ^hEbkK6OZ z_GA3{puAhYkTz5fpT73~hN;NbNUukC+OUiG1NFo12ip$shrjl=fN4~Hb6qN*bmsdC zXEQK@_j}dZjJ$=!Nw?`&n5lFZpM;jM3-})nudr`$sD1O|{i$-UB7J}8l7SDM@%*1B zz}nXO7ji&<2x|%e4}d5rL7jAnzTZ6R>5|}w-EwFJz-APnQ%wMkG|;U-I4rgS3m*rf ztcph_Ah=qHB31U6)_Z41ux*ggaL_Qq$xntC+44=I2uSy*@mXEUJ8H?M9`n) zdjCUWKgNQfaG#eSvtaYhBWQz8$lh5AoHyWUe!41);rViT0tg~K8x;k3N~%3dz$l(U zQe z|GPe`i@nqDpg<#kfB3&I@O}UJ*Y5iFH~+RPE#&;anOh`r#|QoY>;H*nnmFT*iKm{5 zD|zbwSg%zf2%+C zGwI~h&8?@SQ(IeI185LMQ~@`DPIWuEe7yffN5nzh-!gq~&#>4&@>Ky(yZ|&RFhot! zP(PCcN}|5k)!Xfd?T5JVeaG#->%sSN=RMQ(&jHkK{SSNPKi2Y|*{niO65MAuvdU2W z$a9|AwrC%Rq2}}l;trGPoCoWV!>EE3Qtq(O4i9`B$IuhKcAe11qpcH@w3LsF3B?yCzq8PvmVU8d;V~Qvg2t)wp7@$&#Laa(9D3kzFfk1@{ z6adhI2z*ki02vC1r~Sw8WbVJ+CKUw-EWlo$$eu6Sot0BgtZNK#BQri|GGv(69AEg_ zjn$c%TP;?PZM}Z9@mo&T{-m3FkNx+Vl=Q;&BUttLADjM5>n7a)BOsmh%7w^Bkjrv=Zf(612J}^r2dOy>q+`uejmM5F%0aMc-+7F{ z$0-WRG~dyaZ2d+X|6^KjAkPkN5x3KvBsU2pP5$APwqG&BOrvsRw2-Z`Kd$>XaMK^Io+>+0M)iS^fo!=>)^5@yttAqbt%y={w;TzOd%#ocmHwc+duF5a``>S z8Yh-#+Ygi9`OBA%F^Q(%`;hTBpNg3w(;_8D!gCH-vwF;}*P;m7WBnV-Uz@vOZ~jQ_ z#FMo1dPS%H+NB~zRH=W9sXjTA3*Wz8q)Tx&6Ks;yylM6y3|FljDGD5=XHLzBTA8c6 zQYu;7LJP^o5@8on4%b&|%|wT%%xyX{K0lrPmUfHIVxy0JUhJBc-sC#s?#2+?dq#+j zW+6pU#AT}_h_@Qimf_BE>&6Dja-fd6qC-R(BSDg6c_z7t^mBisH)a}1--I+*a@21j zB%Rp){LVqk?r!9+-p?`JH;E3u2Wd$sOiir?OC|~t{8aRVtUE-x6rZ94+pywMt{C^x z;?G0>YVBKFX0~@l5x;Wncj}IK-qLT@m$v$=^i_j>+BLwv(Rl0oIA>m$eBHVqLNzQS z3T!uz_!j*q;dA=QYMG*==h@yvvwgKg4<;g_b^4xk*M=cjCtp-ILHqM+Nkm3gLV&E)!a_B@FyKT9d3Q6Qu9rm zSgE!^B@F8lNIxa?X)<9Oh=P?QuJvq5YFgN#YSUQMuuZVG+Y8J_Uu+|ONSH?S4TAON zvglqEKrY&~ZEk{sEo`|?ZM79ir<}jlN_f}VLwe{ zh&PGrDIS7jqOU~gblxEQ=U)oDW^f@tP5~}ZhxdmN(fVPXLE9ajdD-Hu-_Q3RPJY*a zuD#9+&`?Z7l@qXNj8t|%zh(Dh9~E!TqCZUxFXyStCKwAWXy_(N$@u*}i6lUZp_jpY zGj7`L^!kE27oD-dye0@-ipM+In~Ax z;lR1|_S(zE|BDBT>1#|z#@gz%+bEC6H44NqR4{HB_8~hl$pea#rNpSq^~iS1;i3x9 zC)ZKkF+Rc)WSGupQ2!@;a2wVAzGi?wt@}(2jVWUp2w^2&RHsJ7KB3~Z7<~BDQJW(_MHXv& zqX#XqH=7*~+kueMtkUn7&nI4_5Xb&rI$+~3tA=6gUuE;g1beP?AJCDsJsccz#fDlS zaYb-7MPS59e6VTSW%%cpemZTawkm{k7VQgEBB@jyEeGCqs}QO-4?QFVn++M3@e+_O z6IwSGcRgj_hGGa}j|=ct{CLJV$JKiElA1R?eq*;05vFe!wDa)%D6GF8O!x7BALPe8 zw*oia=M;wZzxC}W3$8RQdCGpRxh^hqH`~88AXA(CE=8?udOsZ@qU>R4k29iR*l*GBRlJ8++%$sg-Ol2e;;b+_idTyQ@<=bhSQv29=;v<_`Sb8 zMA6&FP0fb>jBUr3!K*YT{3-D{mA%fvXoSM#dp-ugI5uWA3U|G;($ILvt4i!qyd#d>(OWww)7z*Wr;;O;=lOh-Syo;1 z=gqiB-HL|FZ!PJVpP^oD=kM$2(ec#l9me@|u>XWLp#14IGY`oeH`U{>etQs8jn9-y)o;@ zqk1&7Q`hx2_8ZO77gvcF+p!T!Q5`+rj#r?ti?TRn>wBHt!T-(2Tyj02+B^uh4dWf~ zdfsb4pGnETOQI6(?uS15s9JVi$?CW;J8M0t!<8Oi1zr*QVe4}q3@6R)& zN$AUYSZ#Sb`O!x$vGCg;y0-6>aIdRpUGuY9Rcg_F8B9YiZ8}HmB7%Hz06;%kMHDCz z3K2#nQh^aE1SwG{L_{E!5GYXwgcMp81|UHKWk6^Eg;5mb$N+yd8frx$SW!kqAp%g9 zAs|3#6ev}MkU@!56{Q6R7$p)QLV#JBAp#jlAW{h$L=uo10bxZGXfhA!tim$T0#JkZ zq`5NC!BWi=0E|II)D=`v2|@(OAcm)Mgrf>CFBy#$Nlx*iNm;2-m8OD0Pq6@Ol_*4{ zHj1!~N&w5uD!kGoB8pUtLkTjHAW)#vu!a%Lu)--qAacLnV$e`2%z&fHkw8%qNGj+E zJ%v?K6;v$+6vRX|5VQ>flp{?s4JkrUr8JbpB?QYuRD}Rl0Ywcn0#Y?Zz|{j1&=d^~ zRV5`QEJ{StNYKO-pj9y-(4#=0tq7|U0>sb>64fz7A`t{I3PiM25>k;wC=^stBG3^~ zM2JvTAjv2*QY`~BREX6nK$9gDv?xPRq(YPlK{G`tl@wG302HedP=y0P(GfsJMGQg| zl%Z8bMN*A4g$ofyA{9yzP!u!`15E%>6d_av6i`V4BowJZO*B%~0#itkO;8ObG=)%< zGayh!NW`f%3d~VLrBVe2G}5F%6HEj^l}OAZO;k+*5)n~CM2!eUv>`)C6AVfdEddZD zMI{Q%iAt0t64Odl%Mi3B1i(!|1q4L|z{x~JwN#N(lN6-|3lT_BO3VRN1VEIeLQqph zDo~{f5Tr_zAu$p(3lfwJL`ca9Qc+O}G88nlu@MVJDM}G3NHr5oK*R+rGEjs z>LLc>eI*m=%H%pdUxd%-Dv(ZZeq^t9Z`1w6U5|A4dGy*Z=X{^vBR))?>A4bcL8qM= zheemO@khUgsWbdP325zm>zWQfp?{S`xnttjPAy--;QvqPq#3jy$Dc#5tebbNaq9I$ zterV>l=jc7nkWrtX5Q})Rr+!Mrk=h2{=C;J#r$@DH+IS5P4fl#4{pfl(^*oSj?6%&oM>`#} zc(?37uZr3XqTCsHFqufUC-QN0@6D^(y|uHs2OV_cSS{=F&mY?8JO=LUTDQ%)UfxaX z4eA3Wwm}OvG?B4Z(@bjceVgYl{g1igXED@vYv<1%`KPOZ%7=eR-YWF=u=;w_^XuZ) zFmU~!AAsw~N<=f*q(CdE=u2BxxygOUBUuC&ui>Wrek!r`5^qi+3EO9fB z({E#v``DV6H@Gdm=Kv`Y=*0F_iZMi1F%ehEsrWbpVn{?WIajb)P~+pSq<^JUA? z>hD$X`&jPJ6@SU&&n^2L7c;>B4AuJmq(nQ&T=tPWdS2^{>x0H{^P$S_j3*7OCkH+H zAhc=f5XL;Bo+vLwVet2#h_mIvsCnYI&u%_S$jiFD>ZYO28G<&+9g4#;rF=(R6ohe)#ZGVL=r9Gu3Kdd0o>{4v@K`&g{H;SI-*_i|U?Hm~Q$o+5iF zS!KL>bBjuCS!suoNM4Ql-hYta>xzof)AVxpty1+-I!S49uN=Enz)$43?l!qw zZDhyd@4g#KhD6G!j1&|V1Q4n-OMnpx1dg)`5Y%h$ zKG^m8^X@)R7h^aZ>g`r6Cn*DY9)+j0-&9aPPkL%6?(AU?QqI{1tj>+pzvMULJ@Z z@ZRFJrv2UDJwt#&3CJRdA_YHFIe$imrHu~@3Ufkef%3T`|Dg1 zt$VUlAE#E%{Ip5r??>iebAPte)knz*$-x(skA3N&zOH4bJE7idHssspk6KJReR<^D z=h{U2LMozbiqt}>K9}hw6Yw7iRQo=vO!7SN3L>8$o{&UFiX?&>j84@t`^+Er6qmf7 zT&BlK$>H^L`;v8>>K!KkWKW*=WG%aD8cFB1bD9ItwpV|@*R9=tuVW`agK9qJdp&ey z?;a0p-NT{}Ctt6`WbkzqRo&RWo6+BAF80qpw%!wL=6o)B{ahMXZ))~iM4K8Ufv0VE zZDh;jzPfHbjGk$3ZE9WC;q^d}z{Cxntt~!%G350ixKq(RQhGMoI*aSN#WTZ(?!P^( zcdeRtEv~!$CYw6*RM%?gw{CcDJ#uR-W-cgoKb7k{*fgNtvtn9zX~D6rc1UqmeBMdj z9wD?F9R4gBtJ}w1*bbe2$53$J@DkTNtDR}qxxKAufS(o~-ToF*@xn=OuUAmr)}MQE zD$7EqjhNDXHV4{Vua{2gze7Jn%)Sw(+n=v2}qeU0FsHGkQIHC3{%wx zP6lSTXT8HAEA2W<^|^JsHQ%+1TTaK0nHHBy!x9~E_R&V`-sW!b{9sj7+Kr`NL&M*a zO7vxbmTe~IzD1)sY4>X|^&%nxPhB`pUS^cD)Pf$qwCz5j_I|Iy)ZtpFJOx?i6J-?@ z6%#`SqdKCA_hMF?!!CK3M8_?emsxC-e{KfNLt4y@;TnAm6hkaP;qPxa zW^-{k(J(=y?VXhq$nK8PnNsMDnjS0zt zh6Y(J^6EE4|n3{g>_G&e|$}YdQ3QQlsdq z6a}`)jUt{})Ji^9;d7hv&v9DGs9PtRh7^&3ed^jFbYT!%EL~Dk0m_6clPy_P z2w~5HohZljibj@dVo>G9wu9wh$e7xH5zNKDHfFz$uovGYsD>4J8La?AcrnIem5PKg zJ%9D{2DQ~=oo*iD+h59(d-+ce2gsHx6{Khf??)<3)CcMzbkD|xO!m7CEd*=OiDoD{ z{z82ZlXyX9E(oV~*~j(Z_D$tyE8iwPc#TihK0k(Y+b%14!oFhxh4#cidekKEg?1jl%P z6(;LpRTWW#V{J849R@2xlp=%OkL2LzQcG5(8RhI@M!;z1r56}|Y@%n6iWFiQ-10+! zC*BdX*`v1=?RcMW)G{M*-({T%>|5R&EDEFSBNX#27Ii)2*j?If`H2>gSw3Es!sK16zZb)?{q2?(e#=M7Xc z#cM52cR9@$3qmf8S+T>59Blqf_;j2jk1JUSC+hl8gI~8A8V4K}*mE|E4|pzEA;Iv+ z_S-VPYQPyFu=>!Amm0BYq6Jf4mc&7lG6a(|W_*osodd6nEEGP1#?VF%V9PHLhK!;N zF`gxuq(Z=|?z=sm*~I9CSDftR_TxbTm99HM&dyPIVm|bca|7zn3atW6lW^pappjKm zzKWsWS4{8cFZ|AaUlrbWN!N*^8R9mnxJ+QiOC_v~c0qhL@!;c4gu~|R`(KL)T5BTj zSFfh-)FV42uuO~VX?^B)PIkTpWD=C-cI z?fj{dVJPv#4U+4)V23s@F0Fkox(UR@krx-N@ix5gm|r>9{&*f|YE1V>1R3oA8a6{< zG5XztI;=c#H(Vy`XlC_52n_~77HxeEL`Rmr1fFEwajg~ zy0Lh|4O0}r%Z&Tde5KOk5MG8_cX&RTjaJW86{b3A?B85M0*1Af@Yst1dVvk!nGJ-O zjB1M;QEOLcgGHjS+w7Ur&9Gm8Xi6EbeKc~npxFla5@Zp!%e_UK!5L}H&Ln$f`b;;c zBvq*f_;ORScQ%rub=+M8JTQ`UDmA2RwW688Jzd?bgYV7gNg5G_v^8GRq+9GkPSy0s>><&Lc9mGQjy^Kja!9?-7n@}4T z)ByQxFV4ivHo$Gzy*I{Mh`l(5;}m)*lGZT}fdWMg^q;yS%!120?4ggS*PSUxvV)r&NVcBUj8?kXkLTO zy#51LYnc*2%)ugPqAI)mPgj95eEW^v&q!-fXMeL8Ud5W|Nqj!WcqEZf?F6zWNDs@@ zXKa+1OHy6DkU8JQu4w#VBc{h*osG}C=sr!HeN7 z!E$c$?ZZCCO&fdTeBQ$>I~rgT3lLTT{tZV;oEJCS^eyp?xI`vNbC(L(Hf~51CJPM? zC`#z|IVL7sxZV?qFxtEf%>o9gZiMnYPqM zDj_V{W#QoTyuJuOPU#?Y`Ym3eXKnR;SIGS#Y6dwh z=`uJ03wZ{P-u-Aq%O%|od_U(DJn6^H>j8U=M1Y>u5XIp9RP32kd$}O2lL}0FT(^Nr% z^?Yw#XKBrg9=+#-4{1_r8+S@Gwb;_c=hTeHFJf$$4r5?2PdrIv7W%j+cUg9xQ6%uD zB#+p0M@?egG2L~+a7_DLrPbS$rQ+!8TV=B=R^6*N+Vc$ey+$rPrj0z}`h7Je!uyt# zj56Ic8@>7`=ZUn}4;Y(oHCI4V!g(BHbk~!dL72SeDFi&z@b|3NRqCFp*rYr>esxM( z?E}=0=YJ!Kaqx^-NF5QDXwhh6pDAn-*wFkkU46(vwg=Wek&RJWbkaUdD;DLw(v-*A z(YHQ@i1#t$ZoM@8zIXK5z*hNa>Z>l)IE((e>9;s6SI_q+`P|(oJ-bg|yT0W0IW_5o zPWS64qULl^fVvY-nQcB)}#1rY!=ONox4=qjg)=$ zoMYY}?k5lCf6Dyk*bb+=^;oUQWxwD{JaPE<-#NUP_*)Yx>C_H78`*A#KFO&3SL}iG zg9q1D6%!J~UI@1_S)d$;K~4zt4*naumrc7u#QZ4^jEMbzwweav&k(&B@WMeSLrUqO z)(AGW=W9TS`)3t5=6x$~!ej7$DGtVKbfP0P?E)9sUwgg(iG8L|!(I0MVH62{Sc|?- z&SUk6byg0)aD3PyAwrZSgv25lF}=3EBHoWpU!nb)#)4$&^`7_md^m!XtFNY5@`mj5 z(KCGdePE%TA6_fuqQ&|9ujkS8nYp}To9A|wCHU#mJ>EK>7VFN<$ilyi$EWCagNNQ6 z_|IOwdGhehb$#}RlZ_tuM6%(yU$dMal)k&M*VTO8*OM-Hmn*#p5@8PP=t8k7nqsAf z(?Jbhh-k;KYOv9^^=6@}Ygj`Rjo}#0C4P14muzmgt)%x2O%Ssq)TvXsVJAg7?afe%sePMyK>i-j_Jh3nV60bqcLuBE%C=M=O(eSl-gZ5*NMNQ4+yGCx<18eF~?IL z$+*B7;pEk`*-LJ=3i~sOoJ=|q7$?D} zyBStF=@;*Q>!(IW0Kcz6i0LuA>?cQaJH`=Y&b&MD!v}B;x=3x+-_$L^?9H?VjPLuP z^v^KwQO6btgR>{3E-N^z684;8tsOwYAM%4Dgy6 z4C(y2v0mbEdk@$=*HvcS5yND`yKw9qZ1DSj!v#kF7UXybkF759tbobSk+pAsn)vmqU?xFueI=4QN(!$Q0emzIBx@d#e z3cH^kwu=LyLzhKH5V?<3_j^hW<%$I*He&nA;x zK2s5B2MBzgo}E0PJuTTus@e@BWHxUd-*U&bLYY_SA*2qb%gJstvaYr5ZpIyJMtH`1 zPo9ylC*^k=4~&tnQ);WqrU z=GVWCQ(H@F;|6TM2)v&3@O6I^^oD)FzCMsYf7yvIx^pfq)8YrTMSm4UScg?Nr_25y zb?m4b%*)LDf|`RC(FxRAdM4R8k9U7$dL|`rf%1$aHLbi{vtb!PD-jHnyvF_9bV~Rn z>4ylY(FTT)HHeD3s>2iPifQS^DpO0amCP>2PmR7l4t+CBQugKVuv$7(#|Jjx zf!lRuYd+fP6}Rj0td~!H2=s2zs=q4u+R|QlynV>T80a?z4Wr2BlO)`I@SZ59Gu*na zIk`x5(&9%Cfrvc(JmY1Xh26ss8j38cn!4$y*)o2)ivFy164bN8>kf~7+o|f?Ch(cY$oQUhoRGpm7b$!7_0snD>D`+k zgG@CH-s5|9c-}GD5!!h8=JDpRF7aK3T00LLdCq)Cdu*}o$VRZnj9OaqV%ydPn%8@a zPcMJP<1(qok5JrxL!)DyPl*h4)&pI31I_;+gl;{-*g3@J2BVbD_!?%s&qjz|=bsz7 z3C?WOH3H=pNf8J^k_3rN4Cy481cH2>?bd#nuitHHyRM#WHV)$ca z?wq%B4Zu#ySWM}}N~(6MbmRW9Q4cVF5g#fm9}3S(ilj8%>F8 zJVSmPW1Hre*7nMO@PPV|Z#S}i;YOsgv?e z@kOKBn75U$H3>GEO8uH=&)jJJl3{F*=vmHgKFNY+Bj~#QCyD%zTmZFYKuN>L=MOz? zA1~X)%_PS9f0wS(qF$G)SH2&!u)%T}Y;2UzyAVoj^!3XrYxies-zxS}J0(Qx6*P_0 zH{^d7Ipfphv-Dkybub$R(`YL9~au;kR9RFcG|DYQEhn{>?! zcKEtQDQBDh$YNLM_N(XLf$t~s{NgXCKVLZdP1rYo5ZMHvwr^ES1xMo{LBbBGuDk46 z>wG6<4qZg{z76Nlq_!0traVZ@fhiY zE+^qH7VRKL@I`1=W}=ta=rU{8TLtqL>Tk#2UO3UXbnO$@g07La-^1_k$m@;COSJH; zAp|5CYd4i+fe|$4MU;k;+!aR@5In`Qse#RH1BFmJXgBPA>S|S0jm5VUC$+`}IdA8) zW8BHuCR@<)u@?@kH=%aOjt=8{tT6tYBloC%syd*da5Mi*>n3%6zBEbGe*Moacev<& z=08;Nt5Ytm#_8vn2a0ZiaSHitqsia-((8mI5MYg#wUSv0m}EcD;CDf~bJ_eOYwQ~S zuKf;E@IO3oGFiw5<m$3yMw{YmoVJ-K3p}i2M!2_o@Ee&mm`F5H8hsCkxSUcM$+cE6x zvP3w}zV&TapGa+=&0fWiBR1>8YfEWbH|g*q=A86eyR0YJG~Hg+#|L@Dq-^|m>4t6C z;j8W21~eN-SfUag1`t>1X6o9;mw?}k-JRjy2Y5VV%pV_oj=rC^y%0mQ zW?+Wh`Ueh$Z>f20!2k-OL1a}(8ah2EU7K$|BgY$QL%hewfz76w&bR3aF~^KctI(GE z`-5FG&#uLKI%TuGLU~Zl=o6C_wtOhlj!;JKr?abhUW9K!^=|{?=>8lB)BOHCMzUP{YvL{s zA1{|<9XNh+J44DNJ22e~??JjQHfqc%pP_%G9iw|lk!x|~nicBY@;iskzSj9|-tF2Q zgW=KGDR>no59%(x-Nce$!y|ZK4@n}L3);RYpXI}Hav?C8ogA^At&UF4?aR5p z&%2!pY)8BmhsksMx40-jX3c?;JYvhm7KcU^<5yemn85_s7>XhIdw$hA6a4kOteq zGGEuap_u|iwbs)2e{H6B>}9H|_E3#G6em!c=x&j5ZO!j-)={S~LYe4+$o$+5(-3Up z9fxpr!8Y1-E8P*ZsU{0WIX>Q1uOnInyg#OTTL@enVp`AmXwS*o_2)9RJd)dAVk~I*fS0NY;KwcV^zCadgm1=a z-hJQL1)=xHSXNqnBBBAHJy6XXZwolM7@{+b>y;>lAS^fAV=(QrH^%>5K0PfLz#j@} zeMOJyFE}Ov;W%B`61R7%bl`d@`6fPpwBz5cUqr?q-|95^OmuGO*gu%Lw^`^nBgcP1 zQ)gz_-NzLqzb?NxXEgR)poU48Dn%Sb9(d5WQ%mprty=51@$@p)r{`I1Zm^nXL8MGp z2OAMwuxBk!G3#|Q(#L+pBbNIyEHcg~R-Z$LlRDV5&4k~+Tx6A(zFST7XAe}z^C?K! zS!;?(m<$IlnoX(-S$TuvHroNKEtl~jj$)`#k+6m&pNWk{B6&;fe4bs~)W#$+P6di1 zLYPL15p2%zH`0_%=S3CH(0cj1ynFi#Z-fcEeCWkqO}8!|Ex6ayHc#WXsZ;G>H*DQA z3D>yTOsKZe*M`oG{9cI*#fT9Z7BhoIE< z%|#?FJG8!amMa$|@woVIf(Pr*NoYZI3C%vzC}Qc5dN|^m6K8&Q^H^FAU*=g-XxM+c zV@i~(1Q+U!Z;kK@rD4DdDR?I}EJrkg&9P{m^2};rs`rNtu%UNu)YqwE7g&UkBC#6c z+SG9|DTP=>sQg6n>tC>0y3DGMm|T^y``wMI3uhI!(zf;ON>KX9xD~=tf@p0lrHrx0 zTporo{e1W2w7OBlbdEk|XjF+wu|sHi&_0$XfqVsXruIF2QatuJ&(;0lS<`rVg;$T3 z)Ey}&;63^9ByIF^A}jYv{XfgYS57*(o%!c5&bf1-j@=^{@4m(lL>>Mwo`&)3A5V6( zSHHA#if)`xg!a825$8|UmQvPLd}!`rcTW4uYnITVb!KzQ+m&ePz{tAg#gBWlrdhP(@T>Ckvf?-rge+;ee4T)GOc2oj3S zVIK-1wqJh#1amt=eY=&s?m7o&9lo$Tc@jJy9^|ppw&u<8;@FEZ(sJjhRid=L5uoq% z)Ub^SaO1B{c9YHjK8)`Y&zHgy35*%l=ARuG!f+*J$vfSHq-?Or#jj)KcuY4y=P-$y=^8rVFnl?hH@NekUX$03*l8BJdPy?x z&iygg9r{`Dx%BA2qf$xFlisHuIO=oyyw8Mc0j$RBrn|c#bUSzW^gEe%K)oGgxZLHu zYa^IzAt!ttHD(7*qxlPM;((8{arFMJ@7*LNSi*jLu<4vgv;(0N@NR7fPPzGG!Smt# zt7oIS3n83GlyMK|iYcE_h(~L^wuWcj{FHKZCn4(n@cFH+5ncwe)?J(9$*=r!S;JvgTiM{_J%?W8NW}RqQ%o@cuXs=viIMPZrN?d`#HKK z--9V39VHGsuGZ1-Bcrt9>E8~0M#g<4usw4ZxuOt%cJw~(?O9U#vlw3;BZG~JXUYpo<~7%Pm7= zb4D{Zo}6Pmo8}sm>-GK`>5FA*D~O!1&WPQ@3%N~;K%ws&XL+mN7Fe53Yc^PH1ek_u zj+Lz27RzZ(XRQ~4(`K|b$cu{7_+rviTWMCxwMNn+EUZl0^f}R1k#Ve15VqH*#)a*) z7icBY5wz^f3A>!IdPVHuOV=@kWPS z*dCD+TTMi78X8(_XbO0Zh|D?Uv;*DFR_O%@i_c>xJ9EAD0rNvy7?se4I z+owzHwtosQ)yWeYO{HhKqVE^G7%ahvZh%fp#w6=*aOJ?I!~tvxy88J@pBwaGc<7@$4O8`{<5mTj<_XoXd@+6@l>d)^Wx zwW_=jKS+o3!>qnV5%F4!cdD?v{kri@M5-z;JY?!x;H{I4Ex^VANH7`!>>h4L6*fnG&N3{<)zEtZq^O(bi zYiQOv*OMHDY3-#l48^~iluI{T`Z?V zC3rm^E5Xm1%3N#4?{#R+4^HH_cI`Q>toufThV!ia#$2moh;kv{9K9yMtdJ3K3#n4JEdY9b8@y02+fB)Sf1IAIyCe<5K-_p9DyA)6k7IcCiF$m z8S#mKzdU%`uHAamsOs?(Zrd3^wC4yBd~oIzAas&pA-mv+Jr%mgeAizts@-QEopv+5 zHo?^ibjDk6L-yHs9<(#Tmr6~txkPY>>3BEgKa_>xF&LJFDNcnF@UG#i+KoU-*C?dC z!@@u#x1?yd9zGNLGS0$nyB+|-X7A^GF6edJnEHE^!3UwT^7A&)0VbL~NKL&qkdkBX z_H$B^%l`C9L}n@pXN4$E@&uw7 zBIk>qs89~wbaiH_{YS>`LSXH`I>XsxJ-_@biZvNvVKvbnv0( zBX4gN?Cm2aV8wn@*L!Ajw=?-j^Xqx(TgV)9dZKJuJ7W#U*W9|#H_Q%E9S%gesSBMX z2=S85sAYZlnJd~kAGZ4dGeFG0?6_RQKUx^&Zfo!CdU{*4`co3UbbH~Qi7=p1+QVLD z4-R>|(+O2G#1Cm5H1^`U)rDu)DnaQnNl-vaCUX`{Jq46AqfC!k!D2{zLk8dpIA}FuE^A$|>wwLV> z3=FS1w`B%pI@0iCQyBa-~0BQ#bmbOhQ_5(7Yc|{ z6&OX9ya2!(_weN9zt5J#9Nenv?QJVG#xlWMUu~U+UX6s$im&aly{4>Xw@Vj}F^`6~ z$0KDr$m{W{phl@kq$-S6P-5J5Pd?SYf+a80Bd>e83Dwa^CBF}N3tsUF2p zD)jt!gVrOv+lYmW$I%(9$5-*_TEDZkTcxaTKCoFE3vV{Oj(%K9(!emfrc?c2q-mjS?h zd|0vBV1H;;s}eda)(Ir=4}v`J@tYZgeYoC5I9OvnZ!pcVjv<>O2sN(}xTow_NZqaa zOa5!1Sa$m3I4Al3q(OX;+1PnpbH?Y^*3_DqKaPJ#8t(fyJ#;O54-k^l&-5d7Foe<| z`$Pk|WAXXDS<9JA!M%csO*Y54S;6jPK$XgJ1y>(3>4p9!4#~aya^KR9r`zFZ`w)a< z?h~hlYw#L&@$yjQ1PM^6$;S&`_M$CD^OBH5X|~W-n)&;Hd8y(xI zLm^>>-aTO&(9CyKsKzn2M;gbbg)$<$<9I&${0ag0vd+`p?|i(DLa(85s0Av&I)U#% z!N{lVFUXxs;w+C0#A=A2p&sPFQ#3|Dc$D^bxic&jn8P)XqxSyteZ7jc z==Q=r{hq&^E>h?1MecV$55K#EsA6lgsVrDL=5GI$;%wGCbbZIT{Chuh?`GM9ldA*q zb?R>M9ZzG_$4;$XeX;Xgv0hEezJ9N#=JIt>r(=Ka>GNmEOKR)>eVww49#IpyAdJ~G zYbxa96y$rw!>!=@{?_l$d)fB-H)eheHJkol9Pj*pueU~nWDXz%=$DGxZ1oo(1DZ zJl=QqU7PurS5H2!J$^m&CsmtEUMIS_h(`7JJIsaG`hdX6SdNLgW*R&uJ?{?H)NF7( zVpH&^!iaq|2>kJnR~hlwmF)3OP0nr(jqW{eSXWt`{M2knqO(ptkz3|SvMIqQ031Ge zyNj9ZU!C&nspM^nVDO!g@hlPCwCH0aebHILg^%Mb$sZ{iTG*YhQ)Z^+ZEv$31WbBL zp@$Y&qW-k=;mU>m$ZMvo6wOH0cx`*ojhm86c3GapGCTR*?)p&V+(Xm_ag&#uA;Mg3 zrdiXnI{|75bzSJkHgXLpaAxj(@Q#ZCR1#JYK_-*XyFzNKpzcogv{D`R8yx*86>xcX zGxb6E#O(HP@bYSJ=;JeLKXZ;9KR-?>BiZHA$CowS)ARF5j>m$Vef@t8>|J^{da=)w zKMyq)xhTn`>$i59HcnaX=eOvhO73j)Gv(9d=c9ny(YwfZCp^0&le*a&SEGYex=R;V zKau+_N+hN{^YnB-$vC*26RJnR3%GkxmM!s7W z>TfR}Bv}s}a4!nYIfm_qrTKEyU@NOuH{;;q$(sA-?;nulFYP;M<*3W0+u4FU)VCIs zQ5kjoO;y%_%;+95?&HG$L{gD!(8?v!7{@+EPltUtwR)$63^Ua04y9YMvNCKES2c$7 zz|TD${%?GbSJ?#gxe@*{EPDjj3Fp^5J}dovHaGnr&+Ch8z4U$PyXJoltZGD?XPU;g z_S5a$ndrMMbm-TK{k|Q&E-1YmTy*(!@b+PK?@fu}Qy-oJ-OA0O+;D9eh5!mo&9s^uypF8Rf~v ztx9imuC=(jxA&W;`wP;S@N!*t9y4j%nSCxzPD>E!^9_#?l&OPeZn`FyeGSO*Y~ney zkUeL&S0#5f#u-Oixecc3YxZ5U*~#A7gHq0(Be-CObROqBQ;P2dcp~cX9z8y8zW0}> z8Ps!5KiggddG3w~wYAHJ-E8POWbT*I%(zXEk3j5xt&2|?xivAZNNQ`GyhwX`3|%;e zSHs=dc=aOG^`^;2{3>u)t)kB+=52fRKvJR00czy8czk$0UbqWnkoIn9;h%>ehF)wt z{T&(id3y58gkb7RrytzpHv1%DE|qGO7DbKaYC9 zlL3&KXb}8gG4!z!+~0v}4XCCZe;*7GIop5%ZM*_e{ol6`3?3jNV3PqbMkoXE{|ZF| zf)B)%AH|VDLp&di_}c{Q=COZ!2gXY5lz6;lRl_i7 zJbyb{QR_K90swqF`e`|VPbg44pcU`46jSAeO-hC4dw*s~h7QcYR@gHK34e_JwK&TH zLu`S%CM^Rve`xI29Pc7>p)=?S{84-X13i%4#&g=Sy47j1)BA^vv6y*f@?@$!KYJt4 z%$9ZeQ^6wfcV@Xmy_0}#!`I?*GNlVc`bb*p>+eE9g#di|mTy+(tR!9^2#?s&Y66Bf6az0as(Tp9 z(ZsO?NN31wOh@5kzhUCqE=MGZD8>qqXJ4W`F#w%mVzPd%_T7E?pnaDD@477?JVhUU zo8*1PHaDUn@WuxNe}V-O-fD0h7J>`7U<^_l`;P7Sanpac_BL*`E41!v>xbw3bXe-B z>T_ANoc$pF;<8Tr+f^+wg}+ENf}5MW-mfc$w-CYWBYSZAZ6XG9M)4?~y)fHHv|?=x z8L9@bBVvSxrcig+dw4nWS1ggz@zwLe--V^JaGpqB?x;wCPtjUc#(O+-H)5O3tX}4H*UOQ}FTOIafP8ViOkp6DM z(D=PnHwFdJicH5S1+S|oqBcHxYi2rzn<#w0B~;fXTGz3hi|{=eS`fMo|I=s9v-{Q?a}HLtKp1k-R-BV((}}2$i*>%xqkrT{__NJ0jm2F}^Jm zt^+O7g2BPUqkebkQ}}Pe(QnD4jncWl+oN{dt@<9DbH*PL)im_yc~4yPxcp&Kk=(HE z#T?pWi`s`toHTLmuhFH*c)dHlS~~;kFdsMi6}tLb8S;x`gvZqX0c~Y(Jn%n=0b}y z5x8ZyK*b=9^3uVG$K88)ylE`e`#n4BV+D_XE7$MSLbq=5%57m6jia2&969gjR`OoU z@zhez@oDEV-<&=BRgU@5wbrW|Gfw(UEXe{oPUO@2Mlrg*ZGVnkD^D1~tie+D#1Msd z>W5q=&z(MS9i9IKT_|*)h;_PohdM*nv&jh)4a>?U$X%&1cI|klHG8s<~8uZH6w~fUx23E zvVv3gjv`yfJ-Dr4uY0Hux=dcK`noqo;b-o;>cbb`htwfND zX6RZQi0KS+yIIcvmht+q=Lxq3vK<>&LR&Sr$=jmyhuZ`k`cF1(D`5W>X0yG^l-Zd# z*~voe`unlBe|t@@rXAD7i1)xU=siGhvp9EZSsl zQ*uU)vn>stW)(iDTT&Wjk}1Z?0#6{la@@##AYP`%BCw`7Mvk=iINNLHVo;W16RS*o zEd7tQoX+pBfVg*`fyG;!UU^X5OYFE$Y{w|Qs;9WQHAU`Gm1lXao$EM-w~SeBPv+OICW@Gr(rl`&ntBffmkW7qVni0RWGZLO`_dHDS+ zulee?4_^gxTSXhYUFWU7!}uh}B->~DZpIQ+=rNBX+LKFWYNRH8m$&OFnu;}~SmmoI z$Lv{0*eaA{f86!0@0Iv`b8NoYe?N1q`7J$p0(jR>lc=A*>^}}Q-Og+{Ss&qk-nH`A zZD+2Wy+LIt=!WYd&8mT!(cKKpYr>zNFYp|%I1*<=j^VJr0(cz=IrSl?&dn5C!h2bQ z9D#Cy3R-~35(9u4I6B7^Qa~Uc#tZk(LledT&rVW0_Pz^P#w-#nVw1m3?I`Ngi}1n@ zlFEy?$uDZW<@FZEKY1;RyAbFg`^RWVUzJA^Gv?5346*k0rXat>Sd(Qk*|C)c9|X`t ztDMY9aT{$dQtdk+Pz8_e5o_prL=ijWo+|3(wntbg&o?^35$4&oiV9z$q1##18oK3mW zMVOqZ4u-F5b%^nQ+_gID{M_$(Yc^|d8as5kkKLmS$$vV>-m*pA8h3Qacg+qFKkTEK zd)LF+OLR@npY(3#l20+rzrXT$)%@D?x9OQy>Fp=BAH#Ph_$c@$_A@Y6yTfp)e-;h% zI8pPcZ=Vm&hri5ozu0DHP3!$j1hHB)Se%p1UAn5VnS@=_`eT$QI1rSbaSr^o#FKrm zE$$$ic7zV07*3@OP>DeZG(a&B$^t-vRqj^m&DGjEtmU7q*GDX;x4VBO)3w|i&VvV; zegO4#^zwtN&{$yE7DQQ?I(5LvZz;t(JVYzr8QeZ_#QPEt^J$GHs3jgd9-J7l&T1WZ z9}EM{4%|rs#7jcZ5^M=6QNA@J+)sGGee|-Hh|3rgQidAlvFJuSFwBV_u zDGmf}G0gb=6VH5}oSK%+CA;qqJxurSq7T7xN8?vFqTR`{ztSo`)`lL|^&38n&4>R?FW%mg8)@VC{18MT{CdaoM{9 z60?ssXFch=pDvd_7Jwm)R}FxlJIq=gJ7}r*$k;$f&0EA!R|#_76hdU(iqQO1U1Hm1 zDLb0<2_XWAg~|Uy-ZA>i6ud^2qXFa>RBk!d0$m=UEI@tGU-uYp`P&bc zhFp2cGqJ9tl{~Gv#z?nKpL|!UyQ4^LuV+^T8J^lcADnT=O@$j0a!ls5+g-o>4u0Py z8O}SS>9g8dWO6F$Nf8t;y`mOBdN`t5OL7gCSuEJLo3o@@*#tTDT|rxYj{hL=mn_^# ze4RTg=bisiY(KkszX+X23W|0_kBdP~6+<+-Xdu&o)oaADNXI}3wek#4)#qRg=Tq)r zhf10aQ4s{OBuPp{Bot84L=sFDD+C;{9GU=PMq~h`03rk^C}Kd0sR?Cjg_5A9SYU`E z0!T$^Sb;PlupIz;Mj%?KkBQ<>mPWzJ?}uRbSF=w$0O&I(J*NY=*VCS4AWVP^x@Zpq zF?oFe{IR#6qr~+UHsVi`glV5~(pD;Dgb`!vIufIIqIY+O>&(OC} zKk2mb`f+)j4#jo%c*<)kxAD8N21VUW`fnn6ej{!3ACuc!zP0Kk(p;1EqPqV_e3QRi z#ci|e9!BCgr+*!V^9`B><4W3tB-hsELZ z&pYDzYhqy9epaHlf%5+_0cCw-mO+=dAB|>Q3N+^}F&<$;;`9@Z;k!hTlnEuZbXNIA zbn?Ae;i_0y?-8}C@l=wUv#}sbCL&&dAlRTW6!<`h_oQ+Y zA+mh)=ia~ucQNqW1`Sx646tAV@G>Bp33FQYb#*VQtvi%n6>5)m6$>qPAq7J6FjY(n z7`g~fQ8GZWjLw4&5m3e(AY=xyx`7qm>U&@i!Gz>Rek{zx+KBOHXRao}@`FNe&pkI> zi&7=eUK9#!Hy>Mj3%{3e6zL6{jUsbzwxHNT4*f=8EAowF8+6IFjD~FKU5ti+_hQgQ z1b<_eBm~U1P-3Us1hLk7`wqa?_J2jJBj5ISDXt^)b`H-e9yd?&_g-PaMGxo=U81lf zU?I2)YQxJyG-k(-g%_kB1s2L3=4*7NdIt*mL)Pj(J@;^l>tV{^RsueF-M3Y}1$5~L z@EgTEba{WS@g!m!{0$z?mt;vhrj|*p_BJTASn3$ahx@LeF_FZ^6*5TnnZ5PZ%tvlv zO``EZ_G4t?(rVUfLj@Lfmr%02L!=dPEVA+V8Kwgo2Kogid|H$KD6uKg9&pj-5`N}X z>(%nX3&%ug)vXm(QB+h#8q_+^ab0FR%mYI^wsv)hX(M3aE1sigoDNn6n4j6-pfqoU=aWj3j?N}AGE;g>&Q2B(Gq%Ia59?am=+*+@&gLUcX4?^#HRByKXob7&w4tRNwAsPq%Q)ciBVkm0Zv^# zL_3G!@0nyX0hwU8P!JC|K-l<$nLguk*8-G>$>MmxzhG&jUBZUv=rmXhfn3qGC#Z5f z4VNMG0yu(I05gzZKVj5hV#?m0%rTbb3x8P zc~1GrP3s3Gbxn(YuvlT1})kP^X{ zNgxd82$5MJTn_1<5z<-bH5v5W%U~On(m-APs#V{+BDGNJ^cwB%V~`;isC)&D<;pn* z2F;#9+)%|h*eL^LvbN^{mahI%yIKiwS8)iX3Izg6ky4x$Nd;4CSsReoG3Z_e8=y(D z40;@!4JY_0*n!WaJbcEL4H}IGTD--ypE;QIW?yZGI)S(n@duI>y7n8zA{gYzP)HR)N^x@v z2hJTye!Tg4H1nu#A|tYd=YTH7JrNp2y$XPmBSZpyuW`gRLTBoquIR(IIky^GK&2^| zh*ouC7GsGFNid~`E6JENu8KDg8aD=@;x{g}4i6bvuM#-x43Q}i%rFEsG$|_pg)B>k zUdLkSYdNg8ctlZiDnrr^j8%dHsjNO72M7bc5XA*u=`49o*j0@Xn>6u9GK zqKuFN5V~6)GrI7ymaKs`$s2(E(E@~}=+<#q5_9yx5oy5xa$Gm7^}R2Lu$N?yUtz>&y& zNz>K1d*DL*(5^}GoI#?_oKf*a8$b*|xMBdmtXY3bA(yv8)C{tqdJoVgC{;`)mU}5h z5K=}RWhOzqARhb$f_>%N;O~3dyTbMH8wJ!P0l@&(9e#lQN< z#&C#1pr`_=DhQ&YDOh5XI^c3)?)?AY92}HM!t{~wgxe7KVg(V)2z>Y=cP^=}0(OJB z;Wg)gyB`WgS6lisqR>zvxd1ThIa<+rUML4_EC>{cK%xqK;@p-MDEeS@G=2c|0PD=r zg?B^=5IBJX1rSLD{SYv~X-?tVMulHTLK*CZ{!E~sz+4O4@PQP81p)vTI?+RZga+sZ z!Qpe~Sq+g50;$H)_F~=_hw6~D_>FeD|Eb|o*X?KSpD`sMnD(I z@uC1)90)yOh00v&`x(-W@&00~cQM{pnB{Kwcl51Tie zH1^a6!fk*WqA%4J5F1x)@9utKy2n?qH00je7)M$slpK)@f%aJX2=I^|Sqdp1f&tiAi8Lt%SeUDwl}1$I8!1m%%+1=S7_q4 zoHGJDM$~-|t0uzOA{xk%4|YF{=RT(Vjoc4YWDy|;welqCvqE^JmY}K!fOK|iqaJuZ zUwdw=bo+gqBg>o~W)|9pfFHZME`j$;(f@qw^}qTm+|T#1c|R<*x6pNGPu^;Y4Fpfv zfyE2MXL6k|b;Cs2(Oi+c?CG|+YmGyq2DlE~sJ4RE#AHP0&W}d@y|QQ>m}$?n4^77n z_Yv1S{jt-D`}-I(Bw89_*xfNPMviO9azaZP;p5px_+B|MM?T#TrH|?0e!|OYKStAG zU$C9*LU-umii7;-fd5>4{#WnJ5+?@0Sq}SyUS3I-LjG0iJ02ApYxazwR#NH?CPK8m z7?+@s8IeZDi5p7+fYW;~tex0`s{)ql+#@CvEzEN*c1ATCc-)f0dc4Ot90@ZL z!{0=5=y~s8^ax1V6Xx6o+gbK_8;Q*TRig+AQE&sZ=c1Y42hm*mQcP1YK*c1%0-`X?|cU{2K zF^XY&B!Y{gOO_l62Bt>m!>ucY76o zLKVE2%(d3*GTcaCK^Q|`%AYKft7~hVPXLnd>L`dx(iz&4)DlZatz`4xrcZX4c91}!F z*a^Xd0wsy;JmQ`6z2gPdOpa^LUCqtck!^mL>yr2j`bW06^!CH|WGU|VSAH(|o3NoZ ziwjnMGt&iETaxtHAW~P)uk#V{J~4s%Jv(T8;0}be8+C(2s8S#=pMX%(ridtY4oa~C zeBQO{tp)~WF%(a73i)+}@DvS?8K9hzJ#agL+1*Sykam3|CWv~FZCEHMK!OCITlV-4 z2z0>0TY-Z_1nEG@8WMsDMB#%Wf@Ng}d*EcyQA!dP?Cvx&hk|r~Farn>IDlSc6C$Ww z7y_`PG2TBweFKn!WCTvx2E(LHq(Jkx>J{C-swvZazA8eprg-HKYb~}(goObZlO!0J zMnGWSP!+HR2zrpH5fB4{Z?&Nxw$K&N%U?1DLgydi?L4@0fOLHJh2N!pVjKW_LD>(Q zbAzDsrdkaXnXVJJYgo9YtefMy2y&O}$oMTaiC+f4wpqz}X!hm^hwf8X!CJyFKBPp&>s?u zT1Bv#_-*gW3)rT~Do}*+A@f)yf~G!y)WSG10)SwOOG=(-_bd6_Ju@|!HIM~bFv!09 zY`?0rj9r{yXfgAE!KBS-P^;s|G_LfH-yX2oGK_7ksS?Z*q@hw+KvcqUW@}@E8xu{f z+&ml5PEb@Gqb9mt2JM-I=tJ_&j;PSR4z7ewhv`i%Ag7*#1nDK?WF16MIZI}{HEis~ z5&=sz!8Sp>sVkW{EVl%ousM9Lvcp4$;Rs}c`{NkG2ZsJ1yS|F$$3|A{Rnib_gf2~~ zm$@`7^+^!cLGF+~ytMUvZ5+sP5FTyw@6jfZpf>CPebRzN0_p7+(sY=Br-?l3aO~LC zHCA6H3$0NYMjq@V;zlA7QVF6hC7GFRB!N|!8Ct=Z-e7Bs2Wu5f*Qv~ifvT!jCZ%Th zy?%V?4Qq@x=sJKOILF{51j*xwxdc#b_RN!!+%FLAG93+-3x|ooN?OQJXenq8f4uX1 ziTb^X$vC^lPB?XkAv*d^=o?XAx#{qgl%`GU1wr0%SAx=d2inTUoQ_)qo#qS~q%aHR z!`bxk%)o9qv{;{$-LYwsYuOto@I>y*B!LjcAoe`!afO7YK@Exy;8i^Uq$$+sA7%ll zCQxVt;`d;NpoPGRaO7$C$C!JBLvNrarh3T7F3lXEp}Zd?K!n}RQA9QXCiE%$2Z=o$ zA(%lONzT4osA?>nbk4+mD`}SCgA#m>Lx6ewlZ%*PvLdLRBPKCeMvJ(gltDu;yu-#C zeDKJK-I~+y-h|m~nKLB7okoFTG~ziF5E8l~v_e#b?!Js)r6vNQ(R}+W?5r3!uJ8_{ z-($`ZOv+_V@h~L<8-Owu(&_`q^^$CP1GE|k+f@vSq&u?EpTdtD@!5Fi@b&$C8inD< z0wDUZ;6iNpaOhEa;1GAB7nl+vIuq00pDcV*R6BvdsSUWenvSs0>Hu;mF_fS+3R2_| zENXBvLs61ENv-X5fhc5hoEf#5F*!bzfGGqhQiOs8M4?1$skdOP0)%R#!6}?7 zIc+1yS{fH=acE1;0`N1CD>)D&^ba0<_J^}`Iv|BXQ5RE6miEoEQJRtvhlgSY$mR^o zjj5@&V}SH%VKp@_x2-&bX^Dk1HJLf99LEj97F;-MTzR81O|v6yy->Z<TB$%VsOwXw-Oq*gzp!ryK>WnDDytaEc8A1rrZqniq2Qoax?jJxE z*q^v3nNG7wP&E2wtf5ons(~%Iw6nT-bD-jf7jYgqp=6Lw=RY_$hnP)%sqG~m-a7rM zLi%B2!(--N6ytDg`Ul5Tvkk=^t2da5N&Bhqn(?VuziCLO_C$BnET$3io7m%2uR#$37Y#|A29x`fOa?ox*g$AsuqRg zV#<_{@?8Gw2g*b(AfkElN4ZsqpCrFMnMOWOPJqRY)mtW5^M8#y22bss;`h0;rt z$u#RuyBS+!&OH>8iU|~gi4O)Qr36e}drUDVXlKR1LxjCZsUefpmvd%LddQD+9lbgA z=kh)?_!Ik=(Vq(*O_ZO}DZxg_NdiBFxmndlr42*?^!Lg5Leg{~hNt{5x9!%_4h%BO zDKof-*X~8}Aywy*3M7Q$@{kOlo=w3=5SVO?OtM2ol_qnoEodo-seuo_7*sw{rAY-N zqB2iHPjs%y;n(2NxZt=%uIK`h$RnWH6uMRBTgWHCO*A8tiG>iOgdhnf-~$<{vFgQq z?pY-yh(Lfw;eS9K;O{9HzCgM9VW&iwJtC;KCN&xp7(zzE4B&zop-`GrC4E6^irNIW zq#&69{3CSuG^OCLXEA0R2r>*w41wEiVC){LSF0ez-jS##7pfDk6w{(Ge@6)+`d29G zmDvhC*+=m9T0Ohi`F}F1blRTBAAd6cMnA<3Q~Oz(4E~M_&olvg#p;9@okf$tcZS{I zUM6_WCY%aYh{;1L0jh~WVM$VfG6c|dFU^JKJa3qeJwF#_N#lcB!=irj0}rYW@vo$5 zSc3>Bz`c+kZ`Dg)vP1gfxGCe)gPxA`c6& z#l3>=B>IciPiD4Tb163udQ%|=A)zu15&z$zd%F| zl@YGk2YX6;<^JzSG@O_7B5j0-jEbZpseVT@fNEFm3nNynktik|NX1B#ti%Tk69_PJ z7YU^nfGGrt0tjVc6H1SvloUZsF$^;xOw$0%kO_nmjZn%fEmH(VB$U-PN>QQ{CZ<{f zW|CPGBni;g;{cXSu!snW2#^X!B%lHUq>?GBnhGl~z(d9(k74B0owgjXH5&AhDQS{@ zNR_6qY^wY4oQ-jUWHn6?Kx~f-P*T^!10;$?fq``;3KXXKdb;2lD6N)eC>Tir10^hx zB)uWVN(jH4%M%ITI(4j_=(G++DaMA{QqQb zH~{G?Cr+3V4TKpEK}8J+WrWg{lr)hwR}q?pazir#C~>184{d!InvcQkxbbusu*10jUCP zM+dv?4{Xq}6rn*$7aszIoF=Nv7wFb#)(0ezBxCT$;SN=xodK^F8beymuSpL{Nkm{l zlvD%6L<`dwJfVYI{no=7-~j0ip@N-SNBCtH2$LJi;(f$&I^O6LLu&zGWr`$pbu+bp zREV4?AZ1R9BXFQ|_6Ybdh<7TgTYBC}$#Sa2ob!Fo0t2Z?f(xWQ_jJ5l6RnhZLD$#f zIdRMrVFzTI&1vD8H-{FvPbiBd^YvhPULilGlBR^zi&W}ZI$*s4K-^O}J%s06hJdbM zq~Xj~4x)=2Ij|I4T7}r6+>a{;__$LbLeAha3myH(uxj`^`_gx>#G$AYQD8bo1PE?9 z&Y|90?Ljn0G4u>%BN<(G3Ig80VAhAX97ynXJS(K|;rPEB#rqxlIu@_uzTa%m@ zGorHVVfR_G+-!5aK+@mK&qL;=81~{Vxp|p%ap(mPW3n3JWFoj|gk--O395J9-+HyB zh{J`Q$P*-jwmfY%PPt207K+~8%z-4DH{^=YXvNI_zpkyuvW&nw_x0N;OxJo`@XE0* zaqm98ENjmKgBL?GiN8x;^$cQ(sEb4%Fqw9I3{#+7!^4S#sOZL2T{zJ8gO!=Q&o`-z z_1{iPECV3>?d#SZ_cEpc-CK~kp{qY z=mjeG!X2|gBpP13?UgRPQ!ph?=W=ID8AH*-sk_%9kXi`4W{#nh2iro~{fpRCFN2Zv z=ccs%^%3o|HVqV|IVM8E#v|0jR=eTX4F^cGn&*qfS(@YCSn8Rii!<-J8KJGRlUQ(g z)sMH{_}c3iW-uCy+RF`Aoz2@x5sewfN_z2H+g^OC zm$a=RR%E>xmYI*QCDo1K9!(JBGa{5(Gb5|Eswks@ShpE%t*>fND{|Cy_CTO$WoVn* z;mj|O;UkoJ)SYkDFF#!Nf!z3Z#>302|gp&R+`rjB=NUBrWpv|?pT zwxuU#Ns?gdCb@oE#u3(OIPOV}p3wGEU8c+?QVEK+=$2@i%gmr0H|k<_Y@#~BakyyU zd+*7mMr%8;w${;YIm(6zjkL{RpuL81i@!C}dvcoUFAUq->G2d=V)?MG`FgD>3!)>r z4;|8^Z7vLuevc50Ml{Yc9Aja|Hkn9WOuVSm6TpGqrE3{mZAHz59zPJ#>w4S`T6n%V zVW)x&X$=Y^JA~JSO`b=#aHxj(`#f$9oShbMPR=wVo=KgV)G)O!hIQY1V_rI1LNgAH zKRm;+Vc#Du@*-~oDpKxkEM#_e&UU0U;>41-H!xnpDeZ}CYPvyV7v9T@5lG1~*jNg_ zBw5ZiR&50gk*wcEqSX(>BW0XDC^mDGJH?|JlN;Qj`Mu<}K%+RB(nFL%(n*rL_}b9x zoZZ*Yxsqe5xI=EkoTG%$5a(@^z?fyo;hL4_&VT5tE zH(1Y`z2 zauddQlU6OYxMK!1?nk;v(EDhN+xpqOi*PGAWGjiGYn;WJ98g0`Z0QrBndd_d6RO}m zAjIQE;mKVH^wVh#N;rqb(lqo#5H=#2hW949F5XAFq!}3pDK_S!uD!OOD`PdxnZm8K zeQ@hBF8YbcL3?(oPTMmxkB`&g-sQTkojcq*lDD8|h6OQ^K3db5;n1KxFH2P+M*0~%2-r0lxRaozZLvW5yw z;A9cJGTI&x2_RBA>7(L9u%3ay^f)IRB%*}rl>wy~G>3GR-BnREROH|@!FgXFBPE-PCcnOXK@O$?Ir%rPt47!l>P^Ax4Hl+p=gcLYy2XLCyD@$iJC^iK; zbsR3RxtxS}jkFp7{qf};B421xi3AQd8eNzihU9%nwqg%rzy?4uCZP0}bT)$BzLZ5~j)GsIKQ@xa3NKd1#sxtv4u&++oJN9; z+6fEttuUrlG_A^knkwVtG!67j@}^yVs;FM>>v#xG4lU{)N$R?0Y(1TzJ;#8zE_2tq z?gMj-7(h{x9vEbHbY_v2j(Eh3u!x zV&GWFa62~gI%eHZB)Ae66$v#>5v5p=BNlUoBfd7h0kAN(a#fHZ#=^oPF+`%=-sbq? z*RQCddxv%xhQmgh3#PPdGa0FXp{-Sf6qKi2Ok#kYm6#o6=5+-FCbr41e(+d^lShWQ zG1+HcI;hawLy<#gMLl98X*Z~lC!LZmJ-xbG|Dru>Sre-fiIaA<56d)ZCL2yxYJEefi3>^9(IkBkFLDUE0 zf}Lx*b{Ma5G;Zou{4)SYu)dktg%FYyRLaF-hnO^}z;z)A9gD~**cKCDAz_MEJC4yi zPlkt)!0cC17`)50ZeXKrlA}RQcg;nYJcObUjQAOXsmwV=7RFOVo`}v}4FEe*3hG`x zYHU@_2MM6KA+<^qYuzN2kwg*8?&ai7!e?80Xq;nQ&zkjJBD20SIbQ~ zV#BkYr^_pNrwDRklVG;!AV_FAl z@I`vidmg3`?3JNu$UybwhiD7KZ95xvkEJ}5lLk-6Upit|H5->_1OBB6_ zZ!iHs)f7aK`Y?DmAO^&9Q^(jTtciVLN`alYv;a8(SQjQI0U1F%z0o$i%BrfPXF&0L zL&8F^7<)%5bLLIfsM*dIEjGa&CcGpItRjeq>p7X;4LgElSIA+8wS-GVHsxQY~5>^sbcQiS_hI4S0XUP*00DJI)=^fR^vQ*^}IUhoU~eY&DggT zY+sFKu7M&@^7{}H*z7kGH#%|wa(bMV}cs#TCl4(*qwXwi&+YE;e6Qw1k_kJ zw7f{tDABA;f!sUmIPJ`tULuY**o`I$4iKwAG{H#G#)%<}HpVio!LbiS!!=g24Wh$I z)JqC#4TNDFZ6ZaoQpd_P?oK2%oEp3BI4+!Oc6&%Q)D+ ztePl-ShCE`XdED~(atn3bdZ68DU5=^7<38RFE)YmN@p_?#1FPkw(3S0pz2NFjBGCf zG&+q8E~P*s6ewB+34{xf=z^}-o6ZJjPfl&;Kv%>NNX0NAnts_4>eBha^BFwB=!$a( zcR@l8jUB|=mPegq(Sezgse$Q-10+DxGXV8O_e=6$k%g!9ZwnM7j|FN1HpWrb|7ehu zXkgn7BpCbp=(SQADzd=?`a}(fq#9JvNWOLLQ``|w<>}}3SYZWVw!V5uVRumH%fQJNOG*LveK_syX>I`7aGkU-pq@hg`!I6no zL_$PUNG1>_Wq`!21fxLG0fB}zp+zMUL}p~AL5;SVHNwFRVXvD4t&rdJBE(S?7xyFe z$Hn381L=~!_(=3&g(36og2=%%3i!vMZQSJOj}oV*xui*@i3Nf+MDgf)vsVEG3Y?&k zOv&L`AvEnzinRPJ<*rj71+n#R$2)eGHX{$GSQ{cDx8#f7+{+5mx= z1OUWG@(chrrHEcZFb~XPG%aH01ywK@t3*Cf$E5%K3_8l&lw9EWxd6hsum z)XbC^isHl^$}=L`nm&lx`5Su3n zM@sUZ0B{hdl!!;@0D(HYk8t}$4Tn&D$S?T4lzPBv$OlwPoi2z^jhYu*S5a(*hcIqY zCC*!W-ZDk3-xI8Ti{2cw%V4Fbac!KUNe)Yc7_EqjY4Ol$1b`Q3Q2ZP|NPX>L6cC4^ zK?FGg2*5+53?(RHN^N3fM9vuFNut1@)GlF)85KcDP_dJMQZPalLSYGpW;!gOCMF0r zXr={KEi^BrK-Gf*1iCgKI|rBb!N_+Lcxq{8R;i$RKhVx5z&+64#6#8$0#KmPQUxGI zPQVX$h-p{yN;Hc=R6`X~2}00~B?3|u2vP+k1S3%j&=e^WOu|&56A}SJAW+Z=HBbUj zg*2#AqEd{KL<_a%3#j)ACT2;PdNmgs}l1Scw;LP5dViXp+^4+qg#VIjca z2I1V9!U|fcrKW0VhNYH*2u?a3GvVWj=+ANfU^AZa{f4AE4bE_~FwwdJe~#`1xa|q@ z$Ex6PLDl&vA|$4OJ-T`>l8Oc;DOa>b3#j&T>LeMT-vjFP1EE0T=uXZjuT!icb6qrG z?tyEBgdrh0&r9hCKZXDwo#vDA!9v za^>`tL(2VN`i6}O?Pdm{5iJPnK?S20D{q!ny2$pe5UP{YkhKl>EOqxd1O09bxupm` z?y<^M6=CW*9h-<^DImA^K`#T7mHk0PAb@%p1*yOeNe?+-5Sc|$P3#^XXb#QLQO-(y zv7X~)$3_v6h8SUaPbB+0`vcz;M3hjJYRCeXkf5TdXhNDA0;mdWET{@-NFf0Bz&jqP z*mS4W(8tU{^bU`qg6cZa?|4JV9qwVAPoarrJLA5m3M8Pi(?FU-QanfMN?oZqW&zkH z;RCiP8xZL@AIAIlhERlu zwa4ELfyRJ|l_;SE@#GsqdH6REB|^~iA<~iL>;nVnDh3Z82gqq&$UUqoFg;-#q3yPi zxdLiaEQicnpibG@8nBvAqB)Hf2(+&u99s7l0ldrc0=<)+RbU4G_qq*A_g}68g-!!9 zcj5;z+R}8)%pSabP+JaoBqSn%Hc^>mPC;tXQx&BhIOy`nE#|9R8?C{KgYrZkVDUY0 z#Yj~{tERkHwWl^x7A^KaHzj;OC;5IGSal=*2B!~#8Nn9axZ73i#jL7x38rS`W#&e| zI==YJYYlt2ZM1h&Yrnhmzw12*z?i_n&u^n)JHe4@saGr$n43}vp%Ng30q_%%T^|-6I0%5;{6T zLxBJnynCbtIMbt^YNw#RD4kw4qwyW`z?&04YM4K#+UK z)t=${N2dXGRPG`f_&eUq-%IjpxLVSXvRhJjQiKE8eRpXnNAAcbO$k!L4Am4V2_-Z@ zkxVd5#35)fLm(lF3J`FG!HJJ@n>IR+ae?;Zs}^8Bua_N0PD?EmF%dB^C(ON};4}tT zEIVE?zz+rrO6M#QY}Ym@FA)f$P)o!pfOGIeoyeUC=a5P6zy#E%%ZO@6a=$>#I3#ft zDj?EeP4YPTMFjgm*nanwFhfV?zHuEx-ty%f^5s-ALUU*^=JVt=z-s+?#!O?38PzoS2jO=tKw~RHS4ahpa)Dvh< zWY`1Zb^y?ag?+Go4_iobfS&oy`~AY1;;&o6r=io{UjP#zHC^QB_B@2b6DAvR(Q5-0 zeeRP z!Ze#3QR$$qj>tJ}Qq&c$6cPq9R8%_Bd2Gfc3YmhKB8Vy=qKz=+8Mj)_FT1`b>8WgL zp^nQ_uv~b?5(I5FYz+{gG7CxwgP@rBG^kWS2xufQrV!v~1ttXAI!QSg!N=b5Mlx{X z`tYI>dr}x|3 zQjrBg0zLEdF?qX~c1gtX*phn{p;YvM4eS%qMig!DQrSW0h3JQ54ZMKwRj}Rfkp905sCDmkAuhmXw9 zmDYYKpBim9Kv~=LIDuGqz>^OInh#N7)nJR z2O-48p{gioVpfU>2%N#din4Q2gHlhxjamtbih@HTAk2aifUJySNn#wyGX%wCl{i7f z8U{w0Fp3m40HA|p7TihXH9Vkv6zul~h_Ej^{giP}XAk7IL^FczA%)8p;9pfPkba00^iyDjrUTJi*BiJ^{;V$IlvsJ4Eio5QKh| zs1k9;vMQbr4M3X#c?5eHr(tU{a><~_*19xnQ8G<56;>P;6=oP)vOetN8-rwPg0mFa zj%I=9)){Ob=LZtc-e!HMDPk0%$e~S%_9bNS7YJMP;${;ABAtpCqG=>ld9BgY%QV1k|v?O57vm#nEHcbKg z@n*m*6a)b%x_XU0kA&_P`_xi_+#YZ@32xjK$LiN4&*ssU>hRYCnK=DJ^<<*(4v_FR zi5IC(&ZJP+dIK~Jpe%q`bnI#PRQe0!?T2^|K?N^X^OFt^1{z5EJP$sPc2x6ul#v6N zSH~JM3hzl~21dfkS%BTW4zy~@l7cBG zW`#T^9WOUo5ft;miZKT)6Dca73gH8_`xmNBq6h7cr?x?v1LMnfQlNm?h`2WEq;&{0j6bLTy!qc+K^QY{ObbvMobAgt^_ep z&kB=N<~PCaA?mYpwGOl+=JOPR#2I+Od!>t(@M{ZPBa*@6lU+77or527bqB9GHlim% zz)VF)oaN3zB>v70&esJvg(|h>Og`+cydqu&8(_)thB z!WbddZB^of3@{MPGX)Dh;5o7|`#ktS(U5Y0@m!yCgRp?fBArDoDvzlSo@yQH7{W9$ zp93pI8Ag_@MwzDuo~D7VJRXOkk&jx+N@Q(hX{PRiBt^~1tOhoA;$t|}eBPBY2^iC3>rE{)n;t@Gih8j%OuY*R6NKq8%CN1(MC>cooKzGb14f8%#1N zp_Q{1A*NJh%#nsUHmI{C!PW`9$TlR#T|lf9XpC%QvAG<2Ev+RUrb$x~ z*n~^~xEmrmV~Fa>k6r-+u;O5fB-0V9p$nA;+ApS%V{(eI(nPev#t|(~i|LfW z6JWntE<0d0n@%-sPgz&X;w>AP=^BlqC(?79j;7dxHHU?r!y*c&VWJzrqHL44S8y8x zpbv99zE148@q%U;rkpIoKCv0i>|FPO+#I5ayIR~FzyCX}IaeNek3+%8B` zWQJRYfXJY7$a6+yiK%8HQ0UnX6Ocowt&nRIAWTCAF?5=Arv!aKfwXz$AY6GC7Q`}q-@O?DI_JZs8^VQKV(a(1)u_iSH!PnT`u8Q!$>F^Auw** zjh&&i@Db#Q9QZa65QM&mkc1){M4)I0k)fuah8UzsHA)dJ0zHG@DfJ|dNTmmwEk^6W zV)lb!1G~5mpW4uk-MNUH=|V+=6oJWvY~0aZ(Jce zP()2vD5B-h0zNmhLB}pXS%*PB!4!q>@?=QlBR)7}YbwMgfWU(#J&j{llN{+ar9sjM zP%^4BQVBIHN|Y=TAnwKJl_h44lu6@K(2@ZL z+AwGoBtyiCMJasK(xN)`K1Elv5TFF}Lx;>0LEAfRgnw*+Q^nlc8fu%$Gc*qX4`fd; z8c!na;WP^|=?rlo3i3gPd%1{BLnF#`Yb8*UK#~!kajJuvQsV>3=72n=rJ{s-nd5eR zc`+~0|0YVJU|M&>==jIHyPUCR9Fnpkq|CztD8g_vK25#8T-F~AIw*jR!~@Inki-N_ zA_deqjmjHL_gJt-{i66*AdS<5d3`rV2CbX&S!ExGH!~emq^#z)z4he0o0+B9S!*IwtfHhYN!7M@Eho8{WRWLwpU;-eZQq<^#~}h_8_& zAy|QXfrOXm2J{29Y~4RC$BTe`L`gx0AZR;c8UyE4oVL(`&Oo8Fx+q*A@ip`h#d}F3 zqiBYgdKOeQn-${&c1&cNM@7x>v-dU9@8xa2;Y)R>PUTk|dy(q1M@foLvK)IzS&0sV zh}aA2Ca6J8!l~=_0ntbT2&*G{VX`-=-1IyTwSYO_9BDOBLj*)7`VHV%a-W)W;aBlz z`?z!vKf#}dA0C=RIx%l9(|2lJ{pgn`tq<9YwjA#U5&~P-Ud%B)QHs$XsEUbz<5?Hk z7`&;E$RKG0t_CSpr4ZB|zbT_F9nEp%wcEt;24qL$^eAFLqy-I_t(ZX%I&FED(1*5r zHeFHS3{y&2I_+x`eVV)k_l9r>${kmx(xOx3Ce34kpb1K1XouPQzrNCKihz(0tSBD^ z_v(^P)juwhksKcRvDWnT^UU(((!@y%lHy3*D8U0Jq>wtmoJVbmrh~`e6g7623(Gos z%272z9lijKMj)@$lE^;s?Nf>4%0^MNojkrRp&``w%H$lrtW_Ss@Ilu=6R zP{KegBEd^-+)Ak{dn3HQgnNNUS*;R>oFEJYeWBA%g*e6RR73OQMhV>J$AYjnTtO2_ z0j+>Y6#=LRRR#!#8~pieNkTL<(;WQwEFkjGtPTSY#bC?^3O9gAy*wNArX22?Yx9Fn zA~aZnHh$NcvvWx$`On8eiPmH*MQMi9zI7iP6dp7~uy>G$>#ozng9%X~K?6Y$G9-~B3Q=$v zxKhaxTY$q05+J3Zf{2D$h$^8lkje@u2^txU#4w0yX(&jUm^1_i5lj#R6pKv)6k!Ri zWHbXU4Dv1*;9%sHW*LZB6%iSj8;vBHbG)rufYbpS@gNv z3YX*#1i2(SPTZ7OlddH9ta~4`ud9>tj(jzWdO#UcUvVN94Z6Z`iX@!ODxAMA*ES}? zFgxalSm)ydWG%-7un%aYlL;!=Rl1U*7 z#i^P{JvJ#jbRUEvb70|F;Ywhj_@aT`F!#YoeGq6xGk_MV4B=5c@};uOgJdcDcW#qb zE_5}jl48~qfWkP%2+5|awgD?9;E3`fB-6o!QpRIg9A=W2PU|qU7d0(YVP;K55*A~W zI%p=u)n;04Q0bFgkb-0zjItWonBd@T@guL}1LvE-Y&=WxEgT2*tRvA>Y!wCa0l(IW z4}rBPNAdIBGOvbYMJj7t%UoAfY70hgBzFb^AbgN0L?}?u1>$_cw_phD4t7B@HrznI z2s}?)4y#+N_KQwI8dA|8xeUAkS>P`Ce3(O@fY!*f@z93?aezCCLG-xmXDzIMF%jd| zG=am{m?7eLe2V)>4aFHyp}1B(M)U|CQ9u+56jF)d2P|#_a4(V|X!arL5HzTCqoMD? zLmSpCap4BE88B4l7+ZUj^xiN7Z9}Eo|#J*kl8nSf>iV}$g0KT3G+`1J~Q4X*IbpU?$ z^oOAK0nW-12SeM{U9H@B{Lv*7a3C8|sV0&_5$KD??vjqi1P?8kfRv)|V5SoR3QmeJ z3_`%jQ$m;^X({J9*kTwV2YclYG?c8Q!jz#5fgsc1;lV?AZ%)!*AOLDOz$~fTgb|iD?-6dQ)0z9_o#0GgV3N%Bcc#9;3T8LWPvcI1RL*P z8eL;nFl01@n$xKuT6M{z4I&tk!bX)%Lg5l)n9?7=Byhr13_&E+VPGT~mvBB(9%Ly< z$wNRWy;wTJz)~a-5Wu|qi$uIgU2sikToWS9!Ili^0>KFdEI}%O{^O#!pHDBpakLD2 zN-{8l`DgC*iJ5nV7osX(`)_EG=}*HLf{}bzubJa#zi~Tmhn2?D2I|o6fa7-|^$^fK z+VOct`|&pTGIwfQeLBTlYHpPklf)~%v(Z#e#_J0f17iQ(-#D5tRXFuK~r>d-)h>EWzC-*uwE+FK50ot;Q}Js4Ne^vbCm z8MiJ|p?QY~K1_oj4|Z~a*L$ZQOyYjyx3a38Z=u1cL1~w1F)}2Gr;fI@GTW?S7*CrK zlqB`perFCI7A_rKVme~U0TRI)oUnCd3#eUDcC*^aOhT}?<|1r5vP#P3;%jA1DBE30 z7hw~^X|Uzq9jymPiP+JP&Fym!ARswz*p8(S&58(Q4wz(IgZvKWCeLVV!{Lxx8ck-t zF7`RC=Litg$ua7=H4nz($GsRctw*QzAhSdU9zpYJF;$ue5uotOf#=E!m8Rq6BNrm? zy`Zg{Z88b+5RNttHkE%X*1@iCeltgiVAn5xrqxm?J4;+aNg&C)mv@wr4R&!Oz3y4Y zTXX=M?~?5L9yhE{@85t|SyT~pfQZ?Y?w*7{qnh+{Wp$AwXBoRKS?rp}Rl;c+9r`Pe zql2}qsVO>1HE5`o=Z0y?y5AQ{8ONARBs&k2bX|rBoyBvU+~Gak638oyWY~CyX_d-`vgw$e zHKyBM#b!)nC4rl^`kNhJR(R-uZ1zcX%CKu^P3{FNLT!v0;_%GZY=;frhl!0WgzRmg z>7#7N4uQ)hU|`K;#lKuG8pxAp&4KXy?|cZ83R7}6i_pZfX}Gp-Jvbo}X9 zB<{P*vqQcNTAfK)X2dliELq4A*>Sz1)*M=_Lu#f4gg}<0ajzk}aGgCCl=)TLT3Gzq zvJ00-Pp7V{XF8IEn#}O?PA6BedZ4{EwBg-e15Oya;zFyNa&{{2Eb`oX`3kiVkuqGQQ zVO*M?7VM0*ostPdu8V6$q?&e0>JxF7Hbzifq~=}ClV%*UGxpxr6D{n{f-%@2+JbEJ z7f{nF-7P|QN)s*QekjyFJGz`gO~P>uVeJe!cu^Cs5|wt9t2N0&xsG{a<2vzm%_YW& z(s?Tg#j%S_G&AN>)vI}7jMM6hCI?)DYk4D+=_P9m&C8V1J&h9>cAR3{Hq92%vapq+ z)-`4{cZ57;)>hw{pAth->7l4!e-n6Zm6FKXX}=uRBeNcvh1JWMBe_bQW>@jnD~;~d za>KxHUIY^qAxuX5BYt5ll_G3}3`)JP4hf|5>D$MV9)dBy0U4-@nIT+c8sh}qU^#G2Zd942FATEnhU z9|i|tHB>4O#CbMgG}n(K4!Sf)JguPftRVF(D@M{^XRo7^l2xv7n%1^Sa!TBCH#eDb z>x+#@k?5%kr}TYmF35hN6HRQk-3X_1obja!`M_jGB%p{sLQv8fpwE24aQaE`pG!yW zZUOD!6Z^)%>tVf zks=a#7KK$1*`Hc=Eddo0sXVnJK3V%*DtGGF z%e`>S3&v3Qz|R*lo$Xi8BdvzDp&{>P8h@1{n%)xYW5%vc5)LGAqO8ngZNpiHW#q3Y zfcw60|9fK$iL=c+`B#&`O|1rs#{tA_ z3(1UwcGV~_3tE%4ja*J~!WB#hPZWs)2hJE^J2r)$nzXQJ1U=qv5V99I00z<}0rd&t zn~thdq+#mbCm@cM0I;Bjk|;O6rNyWSQLfyU6GyfLj7Yc@Qqtrs5cv@M+&T6b_Dn+e z`^6dFQJ{;c4lq|(mB=Hsq`*Be>DgE@Tm+U*S`f-2a}fBuyjIl|%^h1<1R!c3WybnE zo02glux7eU=^(-Ya_MBYEZ|ss^K-a{1Ln>dc?CXnOsNRxFhJ)HPY_`0-_0U%;GE;6 z2pSS~XHO&xYSta(Zeo(58yrsoY-Iq=Lt6{nflQqT&^$iVdqDAowwe&g&>Nv~0vkv_ z7j};O<@~=2pwNM%aq{Ir=#~+UOjwpVs?nj*j)bsLge@n+0K!kg5G#;i;G0c4g!E0T z0f__(e(b~r5^ow4o1b09%k<0}&^HmV369_?gfXHd4daEF1EgkE5Lc|Xd4eu6yjrQ# z9>XAmO+YQgpjm-O8%Sep4LH^e%L>L|>kJ-si0Y*xqX5|H4I>ENLfb+cP%=E<3!c>6vGYmImfp3sK1>O@< zCE~6kp(3K)X>~|>lE^1{LMe~{Xwq3e^um!JVjjmT9(w@$G2TeZlcxiGo)S%w)Kr-+ z9GNqLJ<2@hv&r*E$~=g9U0=)6?u~T)A`#>|XN&>A1;#}X|fjdE^&8;_^9 z>Y*a7*<(y$Q_}wKP9o6MwCumNjApDlPLfw1D^)T&9J#TmD0{&(@3g?Qn7#DPRqWYn zF??FgNv04kapQWvAsEgf^e!vg$C0p_n8=P@j5Hw$ldRyxq!ctw=K$8NSOnHN<(8R~ zAQJwG6lhkZd1!Wry-`frtu~4_X=5(z$%heu5Nxw3TE=Fu^(oo~IlZ7bSl=c9!VxW; ziCbd&wZ2)D0VYZ;y0Kn4oAR8kRwf=|4;DVj!;_Zy?LmxY@a8XOy;`bY6#tXNXP6@2 zxCqkCMbi@VBS4vjq~ld6Maxl7jtp^P)*Fr7m&oR=1Rzy}U0fjy(p{z&(A?sP6|h5% z7rbkdHk+9(aVew@HXSfuBlSS!wot;gw<=K0rVRU{Ub6?n9x?LF&=jmA(-oSFU<^6?Lc#Q8{FHQqqgLLR8PYeeG?JmFwcrtTNIs8Yg=CabfJ zwYS8iCVgD1W$e%74{`UDHt(=q!ia2~k9jxTd)?ocdF1!xW{m@MT;2CjjQUHZ0Rk-! zRo`_E`+~F7TvdF*k1h4##x&?Odl2LdI2&Tnl1u6~81s>vvoisP8H*dBNG>=+yvJr0 zYaE*$rGRYkQEcEFF+?aTEEpp(xRU{ZF{~;O&u%SZ(eJ_OP+`PxU^MnTUk)53I}9gK zz`JA-Eh2N8lfAdsbBbLhRDVKcyk+k6`ya za~Vm2(ZL99A0c+5iei~%!K@l^)|~`0RZ#>4M_#Zr!4GyQYfdo^6`7L@7{(n!Ch7^6 zH)JVYScU^?97Gdn8xYXOOQd0rXDA$CXh?y3K`@pE3|8poHzEfu@KrN@CUuyQw7?q| z*=tR{+-4FE%ByUgs+aHh%FVl@h^HzxY>QOVSI*A~XEy-Yp9nM(>5+E|WUALNhkiJh zLII{|1`9F)F_dM-W^Ym{s4$;i*v=mk_*!5(LfB>q4ZIpf2pG6Vh1}>D(K?R^fv_!^ z6@Y+p9sCHQi7wHMQQjhxBOGwdmZDq59Y;hC9TYaI55Et354YR$Pv(}FL%>3(+NzUR zAp$`SXnM%I(YexmJt+@rSJHVBP{f$~om#?2P~b)+nK&$lN)afuhO`=S zD-%Quv9L5JcmX{ypd6M3@5riB2cal|2^ldZ7jgg}zaer|K-$6s>Xh~e+f$3iDTpVR zZ=b|UDjj8nOO`f91h~bTG-^VS)pXYYY$F#=b)fbxTfGxVeKS#H9Z_h4-3mu|mIlw& z0+Hj~5hDUDONbVn;iwEn(E^D0Z(*+2d2@Uu43j7-Jq#&Iq{$KhJfR1O^N1|yJL4B* zpF6@F4RyTHuq}C7tdg!rY?6p$Wu^H(_Gr@{;u=CU0y_`LA%ui+xf7Xza>G%nYL=Re zNU0=^Vxj3tPcAfgqmp`_7ec9jWx-4WS_-Z6{-j<~7jo;R=q$dq5mO24b?8v;Y!5 zvz?k(NhhoadM(=tgenIx!=2qmwqaTdG7eZ9JF#;xJP~x^lsjy#yK&28V-a}aHypUu zC%F3ak%yelpjbDgG-Z0+Ei!dsgA*wR#_whnuTb7244;M5aV%w9RjFHA>vcTonJ~QZ zXxY<5Xak#@aA{)#Ft#Pz1(^`{7Z^q+Y6hYzqQgPNvLK+*VfO+t2~jj4JW%lHx<{>5 zb@Gt{kp!k-LV+(jiUEVG(o@D0h+SSW!OKTMU>4#!eH!^+4$r~g!qHI&1jqsx*zn*b z;@!Pe2rvjm;1N^Aa8)i-^*oc6KgAlfl7$;VSiaP)k;d9^iIhP92nvNlky0d8paAVx zW8+jl{a`RpJU!@MK$Gx7Bmd%y4w)KPRS3Vlz{gD&m{(}M??g`pm2(-Z_iP#|&m)IMmKgovPweS1Ex zmxY#K5m|;g17-#gMi{0{lQm^IMk`}+gQS*52os@A2|+Sqj{8#%-ZNSV3`|l7A;W@K zX0R9OG7r&!0)pcxCYXV$`GQaw6p7ysBb3$b63sl%(J|s4w1lNYzH>`b z$o%+MDLjzUBrK@r8jj>-?@sIo*q5IZ@suYQ_V4g~pSNFWvv_-ubO?HmvRFP1ffs@U zwo)Z9I%f|{83$l~1&-L=0MJ&|g*;F$pfoo2a@3S=wgnKph~yl;kFOjsv6a>oH|7)g zaut9(I~q-c{#VsI4F-wmJd!7S7t?vL!v_g-EF?0@iIXz~O!~Ku^&!0x8H0dI9TT$C zNCVp`C$XonDt3dU3M6(T08XTVu?G=}`ZH)r03HCe;P76DLKC<hDZI_o8xlh*BKo8te~bPPnJ$iD)?7N(}BZ@23O2RO})2p9-I6)=RPoKV;5o zSU!ET3xc$7NQFoQGonA{cFE~gytZ)ns??su5#mN6B=CT=;K*6teb zM)jIa;4AsQgGXqiFjGn`z?vm0eGx}Z#Y)_4j?ti@(|D9T|0zY~qfKwdaDHaH8$2pQ zKKVWuHUBiVc~;hMGQ&2cpd0ue;VwHCvKqUw?DUya>^8PHgWLN;k&IUM8g1%~yy<@1^;$ED-(LY$d(D^=L$n@?B?Y!m)q2FVv?9hG77^L+v%yOJb(cp+WFQ{HR zFI1TR5o&FpZlZ07?_exkuTyqob209X2}OW_nhzm5%3jx@Q}KQO<(}8Z_^|(bF--8~ ze6f-KdE8c*AHOI@3=lrQ_s`+FztjGv2K)1qf(MuHk5i!V#^nw1_WD=2hf4qb{sI_> zBq0760+aGWY6VjLh)4VA*@+R6iZMh()O#n}`o0gR{Xd`l2ipH5pD&Y_RkNRTQ9lFh zKeC@1eJ2O!{9fHKr-XCrs`4kqDHFFK_(YfRYP8_-^Iu7z<0$R3_5?)m!{bA|_l~~q ztsHe#RaI3}llJU=hu>9IKEjvNHaywC1M#mn?#Y`=OH)xHN6=JX#0Bv=#6kWbzo|H?Mq%>^5tDFx#TXnyX5Y2`Q52ly2y$uTkslL?0jD}2Ux))|Neh;{=YSwqK8D8 z_!|zV-T(lAqi7eQ{nDB6GzeNIXkgYE`ngZz8`U=e|D(l!)<>(;&?rD5;87D106+|w z1UxEIdZYv}000O9^sobh(r5}iS8R$=Z?`Mzy;6>%K7`6v_m3g6AK@wCI0GpnaC0vG zV-RmN!<3@`NMi5`*rRqeRSLYi*1c4Fa7)*n_S8i88-)V@aJgLR8y;crA>u#@WwdU# zk^~1YO3W2`nLhlnQL}UwQV8Kg*MlAg@DK9E`Ui1z#}RQC`I2$l^5l0 zEHU)nxYrSvGcA_Mg+P__gH(wdnFOwGlRGU;GhL@!x)Y~S6XqwjTbS=xK_6u<#SY5`) zmuz3OB&F1W*={K~nHEm;#37%3eNjvyRgCvyv$XiVh9KD!#>oTsepov$L6N3|1*c)C zhFHc#t_jAo+TBO8+FhHju{y5W-O^z5En91&+guA-2jlEim1(c}2v&)WWut2SaK4`1 zKgdSK_X9;z#z81#f&TtS1rJrCTCpKNQk%1cnW0}axm_w~t!~*aGj4U^*tcF2@lIZo zbvR4JY-*?8aUd*pVWOmQ#g8dB0#?fQ!o3a^VZ}`z;Zna|oP1*bbUu+Ep?#-mNgm5K zyl3&t`b`zB`^$lbw4IUUE4Qvn+OqL-@}Sf=VC|v$Xv?)mOCQTJvInAwd&w__DipsD zRRm9cz}3B-a^dh8clOAF9B0pC-hxKyG)lhci_a~|6W*vZ@rZH1ukr;GH?WP6^-T#T zX7b2!Rr5Ps z!NB;ofnC24!|+bWS5ngX6Ndo~CHGJ&MOl!ndOq01E?eH^;F+*U)2p_16iiyCgYDrw z`YoLeZQ!;-7}jsRrmgm>G*5%F8V=ZeL&Z{MSXlI9td$nd#+LfM^ee^Lg!k zc^HklKh>?(`Vg&9LFZ-3Dr8|}gKI16g6`MFq(Njuve>qWPFD*3^~$Vm=h;S>uvg&A zo^HzhizoC?>_Vsgd>ym+3~L(|P>3lw|H0hz2#EDEwAHmVch*p;Ak^+-QWg-;o$9=l1*xY9x(`z# zeJgh6^z^Kc1K)pp_1yVB3x4yab>JBYht9nJmzIM&Ijz^Lj@9k`eZw`VV7&jGSgO510y70LWAev^+-+I>;rQ>Ik$~F~U zW(JQsETzP5&*eVaWCx45vmZuXC?%FmJ;LB>Jyw|LT>pUR=%jeTR+}wt{RmFGu`(F5 zuS-Zg_~i!$5EoxC0S7R5gwiVh*GuC^Wd%W2d6|t9Lo!iZc;DAjA%R|0IQ5RB&w>rkVL8F<=(ofiZ7sMJav8VZS%tMN2ph zkWB&8DpM`M(}i09+Tf2NcmFC|Z8>(P=d8vhkX4aw(yoVxf2!RvU$EibT<6r=SnY0I zKeVjLX3Ifx#Vnq?az^3#m=>^|f-^PsjB1LP{2f1CmUu=Mv}C^8(l~GA#Ht+V?%Ct@ z)OVD)W?|g3d{~7d$C^dEbvnNdQaa7B9dVf1Slw|`eHP68sc81f5X@T}bx<>&H-avi z!y}P*7&{SMtg{pS5%d>QUA&lAqfP^j0ffGJIeo9MIc_A_@>5KUBZiP>{uPoO*Hp$X zp24^pW>(_lw=`^O59deIIC-o|On68!6W+o3>7FLxE5W0c5HWeW2eN~o_)`5485&<~ zDY_dPKjSf0m9Z%XP;fHH-fZW|2pM#lzjD9khSP#z2Y&q;Mb%h5%7iX8!!F#V{doTa zC5#BR8jrf`;;S%jV2kNjWkTE+7H|Iiz8_F)#A=)A|5^clP*VZ+k&5)p+jUnI%l1+z z<53b%^(}4pCCO<|Q*DwtFklyRdVUhc?319r^B&!&u0$+umG2m7;af7L`TY?Fcdwn; z58F1_)W$2RxH3iN;DR^b^=Ct$OkKkc_J3#FSvvtZtpF&Q#Y@KZ3$J#J96-l4cfsq8 zCUxTS`OT$NHW$ZZ9*n8QjOuyk!Z`!OY&($#o?3l1W-vMU#{i3;Y_bF6P1O=ig$?2WdkO{+c3YF_H{>RD`B+InK!{%nX8J8rhUZMMXNUkBt~|33-*~ zOTKJf*w~NrTH=fn(x4$(oma4pK=e3Y9>-fHvh-x-KTFXmKzJ#|yyQX4pq*0qmOYlk zGy0*i@sP~|F!Ov6EU&iO{RB+Q35|g;_4J#|mVBTDvKbYaH6crh^;y2V;)@h`T_33t zg(UHKS)y@^cFLu{f)PbQ`+V4!?VE*iH8Phk*%)|3-}`8XN5z0d@kqwJmwuEf)Y?5O z8tLF$^I0F%dLy%JOk~@iTwm7zoF%d>=k?%u#E}XzSgzuM#%ycgfdUv~Q7$|kJPDBe z#Fuml?9YqZPd4KyL^}t+gv0s&G!QazWV$6yJ+C_~E`FmwJ=nDSgHCrSQFx@=5KN*s z2I}U|DejtV`!%B7BAy8~_=Dams&O7U&_)#3=39&DybvYTLblYh0&pW@uM zkYve5f^}|x6Gm+O%=MHrs?osa5ngB6K9po_baN%}%YyZk)q2XlbYDCEDW=%M$m~%IZDnTvXUwL66ZNg^;gt2RCTZ)X z_vM>U%kTNz^Y(s9{!e@;i6=*;r%BWQq|~YCdXcXYqW509zUSMe@$sL_ZoG+SPZSm& zGN|_6Rm=XKH5XO93OnL|i~C-wh$wGeHcVGf|G=}52LHX$i$qhaw^uB6s?>qV%~{>9 z%OB(s_|Ij%5UHd$Y(&bAnrmp|*dyZO{{~*2uohkh=8Q)$|KGS3O>%Eu%o^$x+cfnWk-zT8G*5RN|m028r&L`R3$22;*te-117)+Kqzy$mw zd0}R6I^#|V%ei}8UGhe`aWv4RAq=zCno=wd?Z)^-TVv&V?p_i{_u`&%QD`eBobz;N2SOzM{~7(`fRN$L*7ex4ZYd9`V^{7=aSP zLTC%}(-5AX%uea)8A5Z5LKdKI(9~)ryiJ}J6H|tW!Ke@7_}8hPgd@PlD(n_qRVII9 zi8%TUofOZ$QeZ#9{&UFXJ)+dQ&1;=94UYBDf`vjcEQ>{OZ{iPiLA?KP=GT=+RN*ug zWiylhk0_-F9_E_#zF18+@7)G>LY_P?XORhB`@8w$+?$U|6rV5l-T2v`(&OiE=9Gs` zA_AlPNAFN9RogxHwe60X?zy~51xY^pe{CsiRcN}&)rH6@L^JgVecnBHmCbs6{9jZ~EC44pi zs?A}B_lvn1F)sanbXVy={Ns@lV0ie^VPw^iZVM~1E)_gEBx{hm=gSfokMjABZ77v= zEWhL-jolT=UBCqU4GlUn^+0oXJ2Ja#LWBa@ zYc6M^D08y@rg=Gp-#1gT`PPcNb+4aD6H(CRxK(h#!=8NiGL)_RcB+4yl37XGvZ=q} z1+8Kc$){ShN{71FTX>R{m7{OKON7`mL<~4Uc)1Bi<}i?>^lTsNY@}Q~rTjH%qIY0k zI1pAHGTJc4k@NSmDcYNQNMubRMZwWyOy!Z0CT$h~$2xzPBD(GH=K<7qRpxS4O!}3~ zYQD$qV7FJ`uP}5JDUA{??h9^D`HsGvgs34!r%VRjhVPk}Tse2?wco2WbD2HfU*_5y z=9h}eafYb72QO^_PWyHkic(EyP@e)&-DirT4##$l?#ud>5C9MOg5*h;)(x4(lg>oN zP68Fp-f=lmez3cunMSS%9^toyZ#t7};<2d0il_g{_PodT2!W#S5@o98h1}Dukb{o8 zkzGID{adl(+o+yPdTM!Lk=|_DS2^xA1;JH``_QF^C#2I*Jl}HO--{a zzq7;?2XIX;!s^Nr68iDflxFHW108I4RDJyOt|W*V>0si4v7*VEIu@|2C0KRVweb6| zYiHTe5)DLjhu!PKZ~feiF(P(FhZ#=l#W*B&^WlU$)WCXwYgC;B{RtYv$NDO!49YUO6DyR?VK9 zXmme6!z}BSjSoOHj%cv_=`>E9yHJiv40M8%Dd+{8%|Kq0zxStrNUoXOv9Hl-mPm{x zi2R)LZ$LQwOv8-z?lh9MX=zQL{M@9+q~`0(A0AJCF|IpAH*9;l={~C8{MO%{{f%MQ zUZmiCnlBshjdZk4D-WeSrGPbV)z+)4|I&-%aCkrQs2OUIQL`_G<%4XT7OLE4eFib(4`pz~LXk*@A>|Iz=KKA-jz)E3w`z?adpDj(T(*G+ zZy%$QC*(O9`A(g09{vtD54>JZefhID$ONUxx?wL#8?563us4svu~%lOAaX2E0-ioB zZ_`_SHI2Ch78!ip9<+R1Z%nMNWd{Xoe?Vfnh6wAG?SOT$ND7X(z^4F#4|Iq`Iw+kn zrFNn=Fa|*zWz04EAUoDk2TEgy$h4n?bfc8LcJpMbl|6d^}W(pbN2o=oUI zPO?u%_wdpyb~>!Eg?;7gh&Z86Yy;l=<=@|TQuWUern@f1$UQW2^oWckw> zMiEx8JJ}`k$H^~KU^c8-zUN!Q1KQh|aytQzO3q}@Dqjn)533HOi88ya}9C&Xz2B`#N zwCe6Bo=SVQH6oEKa+6Ky?&j)eW~XM)Ap3|US${*&?6i4B*QLVi)iYz^RH?@5fj7U; zS!%Z395T$^xg9&J*B-#{q;x;6c6)SOt$o^=6E+DGnjPV<0e6XbmKz$vLNW)U-&RU} zH*f6^Y0)JS3txUmmCaZ-4f;=Sy>ZxJ=X(PKWXuXNqAIob3_hB>K0?Nr^T|~5Qo>eJ zEYCBQG`m&AL&&yuSW^7W_ho1Qj*OHs)*zLB-e-E!E8-9jn^-D&V=B(O5DH`k4 zgNd36AS!{gv(K2}8=i)GvZ0C=rFow^-ET_0#Uvb>@*)FmF1(6Fyb(cRV2m)Bi<_95 zNVHB_osPfCSe2R)NT*Ut1!iOr06J1o9C6yK(ee>csSpDa(eDUoIf+`N9nF;peIP(H zsyKHp0j&zA2$I%&JgWeE>Tluu0jnlE@k^~=KRD;wtZ=ITp~&M zj~?L@Dmz9Iay+G=HSgxfiy2G+am7Y;5dyfllr3lzIQR<*6W-$E!3j$M_z2Nh{8)2- zE`ey8SQ=%3TEaK3Zox;6hKvLv=7JPjgm5aAHaiYtD!lALQ4YZRl ztks|-l2;?7g)48I>>~VfB)UNoD=I8n4iZWUrowDc0x|6jj=d;`bOvG&*QgegBdHzG z0@sdFO(Oe)C`}qguC0kyNd<)fMYV+s-87Xcv8olCvxyo^lO0P&ESZyo(1qiflS&f~ zno5omH9g8vLUW*JYgZrRvdqVz#s8w?#GGEMzU8n3GBP3&F|q1#b@fn=T1F32JJQXi zM@pW#TE=)R$z@Rh7v%n@I!Rh@yX(|wOcdV3W2L#*N}(U7g+W&5tuJ0TeX0BO^yD_e zOz-?D@>Jnq9(2z7#9;JBo#{tN_Iu^eKlawc7EUKJu*aEtngw!GxidaK80X*13*ikL zRR|lGOidwpS+S(Dea6?gDU_$|GWQG*2*j`v(17sR0kUb^hB+MRnx~dndRlwgPdQj+ z^tWKs#nd}{ z-Ot_K3!)>(KxbIHXP-^1yF#y1W$uVs1a;=Y3OW#YWgyxw-Spd>*hwFkCc9lF-c44;kM)6OhJ9LuPoCpB#}rMkuiM?!6h zptq%ZWfmTc3Iq22^QjU;(vo6QGTDN#(b*k$+t~n7^C7tN;@IfBr@byYptu5@-l5)I z6K`kdvM}Cju~+8kHXbGxI>ny~)}DfWMVR;!yj;Y7ef~3yV2MRPzdLjQZg2gq1fOQM z%b!=!a`gnY)b7Q`D-_2=BMM<9*!E@dm6@aEZ&8=rpGq%mg}cl)(AW1)^^Z1WBNqfy z;5kf!LMd81Aid$dkrv}TsOq}bI)COxEEiTa2l%{Cx*tR!-igZVh);%9ds+6dEB#=M%ooT(IIRVC%T@%Jz~-S zaQ%|=q&a<`+_<0^!i2o%tGUHi-4Mxxd#~Q_C{mvpUKE^uZ&yBPYCRiq$mrjJ-IQK! zh7HIk+)Tjl>2AIRZVc!bz;4L&zl3LvNM}aC^E{Bh11{wC8Iv;3EjOTdW!d4w`DNYu zD{YzlkQ8y}fzn0d-zRJ)fWFB4&FD|bTsHmV&ObxNlw^cgpX_vwW z@uR=f=vzFu4g=o1r=xFf2ipZJbsQ0hq&3&?4=5i2H1nWH8un6L!s0R4G_;+$&xZKgRzDr9d~Sz(SFwF06v^B)tN|+ zTkO;*YTa&rX;VM>wDfufrsYxW^Ss0e238ycCyGMOx`y-Z_4?8$Ps~kNr91Ei^5ZIy z0_r>*-<;_EI_+e0XTweZ_9-}?NNKIXx(mn!MH>6}%Oaez@*yM0OBe}F+Yab$hyxua zn;+(!NS@%GH}yQ~q=0R`s;M2h!isEp+oN@eK4|be8(D&wHuvi^vq|PRU2PV`_W}FmpnRpQC8R93#YNzOIQbV=gE-FOhv|ck$E%g0oL$If@*T~am zcvj`~{E=dGeCxQ_NS<8xQC6Q*X*P1Y?{*^?w5BAJpeCE&~qJE|en!go8 z2xu9jlc-iUG~Rhz^T=0f1?-{Iq^N1B zOrH3p!p(NFXIPb>SD`m3^e`a$sysYFyMWM1E~PwV7<>?7*n9cqb2*e#-l!M_NFskZ_W|6m@M*5`<>fr%g;HkR_H{bMw^P|!CO2G<3T#eidueo zy;6l`Pi)vE^iwEOa}L8`r+u@KlCA&dhrwa&`m?QOr5M^Yg6?lFs)0hhyO?acZVV~s zrAi>Lmj;8u<_C0B0ySQYLHB~b@PxvTBdX-SOv7pkb~(LQ-Yu)WCuPfJK4ZNz5K(tG z)h(WJbZML@e?z~1yiR9hookCe1fuU)#ssM>idMvF_hi=$xTU$D&G`~1cet6CnC3T< zObiS7b_wO(RhUU6MYZ`-ZVKoPYm-nXyb~Ttz*5o@#$J%Sj#6vD3C-`QIPC>0;5bhQ z{f8zv{HQZMPR2p^QaYkK@=(-Tfc#(!3aaoAS@-dYOTJeWVcyc#)*JnPbD`(ECfHD7 zelIb{OB#op?FVi-s6yp^Pjo!;=iSQ(5BI5W1?19)?f+WH8B%y26u(yR#JXT{Rfe;X z2VeHdM~K;ThsAnZrh?+&Dh6&ZTpSU7f3#umX?E{b7 zIv38+w1IN^%dlGa1PbRI`$#Ak#7`gBuO)6Sq`zgeDiHdHUVu zb$C$7GBil0fWtQ5KLEk)45lx&h}l z3DMIQs!LednnGMAoy9JlH3kgNggIgm!%}USk#v8Jl(VhGx1$yb^G6;QZ(}T+wOLCs z=~mFe-=b=(rQnzzb>4ad58LIOW+~=uJD?j6W%p+YgOE25c+}Z4ZCPaqp||2%du>8x zj1CV<6;tkj2<~Wg{x)X<^x;v_W$LIv)eOn=x)kXyM@m8JBN%#7Sb%w+2k@Bz)=TwHThk4j?H8=? zO;aqU zok)kgKo4P`AdpuJKXuB=+r;y+y{B{^x*BN(5A=nLfjc|RnvF-SPFzr<_7H&16aWh6Q(`!*ud`4^;3PGG(zG1D~zJj~pu0R!RpNo6Ylm=Y0X5ZbnD!4Rp{G7KB zo#>RAOL>WqqTCcuToB+a>D3m5qKgwy)U`S3iOR+7xb7Lfht|K~p0)*V= zX($w8*M68~iL5L^wQJ+YGjERTnG6~EWnTEj5590vvnEup)kpNw=vipBeEA^=v?3hf zh^}|@;K~i3wHLKRRD1}U0~usBz%4eai~mM*R%~!KjQ`z2dp6_s#~_fO<7!c*DM%r* z)3LxR#>LSUZomsy*4oS-Db5D%Ht-7b)%}zctylZL(PMfU?onc#4fljX#`Y=Ifj8wt zA}}6Ni|52i)RJ@{9tN&asB;w~53vCiFOJdlJ_(qYLV~C#qrpQ*(W-1pOk-XF%d;3K zm}ybxIN$X;PSnk@HMrh5!MXT2@s-75;POyRW6dnY^|BT1`I0wRV6ftfIIfR0q01#x zNK{svzg>snt9G22oNBR2u;;`9pUaNIyM!)nL$G7Xnk*uWip9?tSfN!UHz3~L1(aQ( zhI*70eAa|&IDcn#3OO1OYQf5+iG^KtCFf=UH5zjfS=^61XsP-_b!j{dk7-IjFA8On zut(~y(_~O*=pvkv=@YQ$hWrQ%p6PKMpP-ppe{oRn`p5SQ=2-HQB6_(o$N08R@H$nbo;2~xt&O;`v)<5?NpE`h;#`!#HOYL=2EQ6RU6Iw z2eS+N)p5~8g|`7ZRncl{Kjyh#MF@bmsT~OBg>vW=zP_kFB_A+TVPWf<>|txf0^^(9 z@exDn#M=C5WO1T46s}IGwWCkj5AMHlO|nL#d55QgXV{n=tWbSHy-V(5VS`7G(2$^w z78@1cYewE@YTK_bcuFz?KX>(CQA2fhOA`^En%b-Zm?7S6`($&Kcs!U8WXKWAl`a-e zvx#9j_yFg_ao59S97x;^sWO7dw(6uisCsBYYQ@`@>Ik$}!%ms{+IatlK(cWfW$T-{1-0GzjFIbzV_*kzMS)chTBgt2hK)@YB{Z?YJgoj=TCDavA zido931r_VkJJ#Dy+1WYcBW*E)r6jz`=1EYgG5R@F2xhxSC8bhuzkUQ86USdV*m z+|23j<2@bwazDYHGujN&)*bDuM`{~VWjl>{F_r~#DgGNQvSG`DJ^qij#+tPiCQmpO zb)Oo_ls)tDqHoApl?slCObdKxSYr8Z!2ZYh^mkw&P-}85;HPu0SEe_gOKqJV=Q6}K zh}*nOHRD_XOZ1L7s2t1Zcwoo5R|>MZD+VpgnFw^qS2&JjrNCNfm3E>LM!$d#Xp| zlczcqu9eoy!W!!s>YMu+5olzTs0h4lQd{+8B~fvGY`gd)UW|DL)2CoR#`-Gir%`PI z+)M8sAq&^$KNTeb26J)^bvTnz4=zdlt)m{OJ1ljz%U~rd|0zr7T=*)h3Xx2eYvfH& z+Z-BfTaG?f#C|TBhV(k<7AF!_q8i)1a&575v%~&%0aX@V2bhJxSs7#y1KE*0)Bc&4 zkdSh!!~nB{xp8;4Da)w(^Zee=7@Mlrk4#KSY+OE2f1VjDBb$@KMr)}Ex%ecRync4Z zAOWBFIiz*({9+lWELCOT15a^Uvds*WosNc#jhpT|tu)SPTyyBOmk#SDxP@SC&+!rJ zq`{R#_R&_48mV=m3rW?t5lIhhrH((Z{q%9xQgb@xoOGo`syngUm;!65+gNNra*p3E zgLb~&xoT3@)yx#;M&JYjVjW-{5D^|NN3rhO(L%SmNujFSN$!prUyIL@74DO_yFD_{ zJQ>G+xuVxqBAOMv7h~suJ~c^*8;U@#{&>!oARid7W<58QxvX_O2s6ld%MIm?M#7ZHHsygFZ>jo|U-OM$&!&j}bLO1p+I<3ap8mr%M8Nh8h zMB5>Q7Gz$7HY{R{nJXk-)!ZyPl}TBqIj^I0oUE#HK7xR`v%O?Mp+c1&y20!~BHyyM>d+6t}r_bpc~66r;ml$v*lZ#LjSE!)Wt@8x=n3=D(EJ9yo#eU1(6G5=XfL z3#Z#AXLcA`xh`~aZtZLmroRfmQS`3Y)Ho@-Tz?(1#`^KUgNMJ;!Wpk`{R8h$6fqq& kBLh3Zr%fxK|BoeRApe{H$8_`J0X9UlrK0-2!PoZx0F_VPJpcdz diff --git a/man/get_target_type.Rd b/man/get_target_type.Rd deleted file mode 100644 index 78bf86455..000000000 --- a/man/get_target_type.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_-functions.R -\name{get_target_type} -\alias{get_target_type} -\title{Get type of the target true values of a forecast} -\usage{ -get_target_type(data) -} -\arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} -} -\value{ -Character vector of length one with either "binary", "integer", or -"continuous" -} -\description{ -Internal helper function to get the type of the target -true values of a forecast. That is inferred based on the type and the -content of the \code{observed} column. -} -\keyword{internal} diff --git a/man/get_type.Rd b/man/get_type.Rd new file mode 100644 index 000000000..bcce4b70a --- /dev/null +++ b/man/get_type.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_-functions.R +\name{get_type} +\alias{get_type} +\title{Get type of a vector or matrix of observed values or predictions} +\usage{ +get_type(x) +} +\arguments{ +\item{x}{Input used to get the type.} +} +\value{ +Character vector of length one with either "classification", +"integer", or "continuous" +} +\description{ +Internal helper function to get the type of a vector (usually +of observed or predicted values). The function checks whether the input is +a factor, or else whether it is integer (or can be coerced to integer) or +whether it's continuous. +} +\keyword{internal} diff --git a/tests/testthat/_snaps/plot_predictions/many-quantiles.svg b/tests/testthat/_snaps/plot_predictions/many-quantiles.svg index c89aa7a4a..a0b0e7f22 100644 --- a/tests/testthat/_snaps/plot_predictions/many-quantiles.svg +++ b/tests/testthat/_snaps/plot_predictions/many-quantiles.svg @@ -20,243 +20,299 @@ - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + - - + + - + - - + + - -IT -Cases + +IT +Cases - - + + - -IT -Deaths + +IT +Deaths - - + + - + - - + + - -FR -Deaths + +FR +Deaths - - + + - -GB -Cases + +GB +Cases - - + + - -GB -Deaths + +GB +Deaths @@ -292,103 +348,122 @@ Cases - - - - - - -May 15 -Jun 01 -Jun 15 -Jul 01 -Jul 15 - - - - - - -May 15 -Jun 01 -Jun 15 -Jul 01 -Jul 15 - - - - - - -May 15 -Jun 01 -Jun 15 -Jul 01 -Jul 15 - --2e+05 --1e+05 -0e+00 -1e+05 - - - - - -100 -200 - - - -400 -800 -1200 -1600 - - - - - -0e+00 -1e+05 -2e+05 -3e+05 - - - - - -500 -1000 -1500 - - - - -0 -30000 -60000 -90000 - - - - - -400 -800 -1200 - - - - -20000 -40000 -60000 - - - -target_end_date -True and predicted values + + + + + + +May 15 +Jun 01 +Jun 15 +Jul 01 +Jul 15 + + + + + + +May 15 +Jun 01 +Jun 15 +Jul 01 +Jul 15 + + + + + + +May 15 +Jun 01 +Jun 15 +Jul 01 +Jul 15 + +-2e+05 +-1e+05 +0e+00 +1e+05 + + + + + +100 +200 + + + +400 +800 +1200 +1600 + + + + + +0e+00 +1e+05 +2e+05 +3e+05 + + + + + +500 +1000 +1500 + + + + +0 +30000 +60000 +90000 + + + + + +400 +800 +1200 + + + + +20000 +40000 +60000 + + + +target_end_date +True and predicted values +range + + + + + + + + + + + + +60 +50 +40 +30 +20 +10 many_quantiles diff --git a/tests/testthat/_snaps/plot_predictions/no-median.svg b/tests/testthat/_snaps/plot_predictions/no-median.svg index 2d5cb577f..aa25ab251 100644 --- a/tests/testthat/_snaps/plot_predictions/no-median.svg +++ b/tests/testthat/_snaps/plot_predictions/no-median.svg @@ -20,305 +20,328 @@ - - + + - - - - - + + + + + + + - - + + - - - - - + + + + + + + - - + + - - - - - + + + + + + + - - + + - - - - - + + + + + + + - - + + - - - - - + + + + + + + - - + + - - - - - + + + + + + + - - + + - - - - - + + + + + + + - - + + - - - - - + + + + + + + - - + + - + - - + + - -United Kingdom -Cases + +United Kingdom +Cases - - + + - -United Kingdom -Deaths + +United Kingdom +Deaths - - + + - + - - + + - -Germany -Deaths + +Germany +Deaths - - + + - -Italy -Cases + +Italy +Cases - - + + - -Italy -Deaths + +Italy +Deaths - - + + - -France -Cases + +France +Cases - - + + - -France -Deaths + +France +Deaths - - + + - -Germany -Cases + +Germany +Cases - - - -Jun 28 -Jul 05 - - - -Jun 28 -Jul 05 - - - -Jun 28 -Jul 05 - -3900 -4200 -4500 -4800 -5100 - - - - - - -130 -150 -170 -190 - - - - - -160 -180 -200 - - - - -5500 -6000 -6500 -7000 - - - - - -120 -140 -160 -180 - - - - - -12500 -15000 -17500 -20000 -22500 - - - - - - -200 -250 -300 -350 - - - - - -120000 -150000 -180000 -210000 - - - - -target_end_date -True and predicted values -no_median + + + + + +Jun 28 +Jul 05 +Jul 12 +Jul 19 + + + + + +Jun 28 +Jul 05 +Jul 12 +Jul 19 + + + + + +Jun 28 +Jul 05 +Jul 12 +Jul 19 + +5000 +10000 + + + +50 +100 +150 +200 +250 + + + + + + +100 +200 +300 +400 +500 + + + + + + +10000 +20000 +30000 + + + + +200 +400 +600 + + + + +5e+04 +1e+05 + + + +100 +200 +300 + + + + +1e+05 +2e+05 +3e+05 +4e+05 + + + + +target_end_date +True and predicted values +range + + + + +90 +50 +no_median diff --git a/tests/testthat/_snaps/plot_predictions/point-forecasts.svg b/tests/testthat/_snaps/plot_predictions/point-forecasts.svg index ed6b8744e..1d7048d2f 100644 --- a/tests/testthat/_snaps/plot_predictions/point-forecasts.svg +++ b/tests/testthat/_snaps/plot_predictions/point-forecasts.svg @@ -25,6 +25,7 @@ + @@ -46,6 +47,7 @@ + @@ -67,6 +69,7 @@ + @@ -88,6 +91,7 @@ + @@ -109,6 +113,7 @@ + @@ -130,6 +135,7 @@ + @@ -151,6 +157,7 @@ + @@ -172,6 +179,7 @@ + diff --git a/tests/testthat/test-get_-functions.R b/tests/testthat/test-get_-functions.R new file mode 100644 index 000000000..217e954bd --- /dev/null +++ b/tests/testthat/test-get_-functions.R @@ -0,0 +1,72 @@ +test_that("get_type() works as expected with vectors", { + expect_equal(get_type(1:3), "integer") + expect_equal(get_type(factor(1:2)), "classification") + expect_equal(get_type(c(1.0, 2)), "integer") + expect_equal(get_type(c(1.0, 2.3)), "continuous") + expect_error( + get_type(c("a", "b")), + "Assertion on 'as.vector(x)' failed: Must be of type 'numeric', not 'character'.", + fixed = TRUE + ) +}) + +test_that("get_type() works as expected with matrices", { + expect_equal(get_type(matrix(1:4, nrow = 2)), "integer") + expect_equal(get_type(matrix(c(1.0, 2:4))), "integer") + expect_equal(get_type(matrix(c(1.0, 2.3, 3, 4))), "continuous") + + # matrix of factors doesn't work + expect_error( + get_type(matrix(factor(1:4), nrow = 2)), + "Assertion on 'as.vector(x)' failed: Must be of type 'numeric', not 'character'.", + fixed = TRUE + ) + + expect_error( + get_type(matrix(c("a", "b", "c", "d"))), + "Assertion on 'as.vector(x)' failed: Must be of type 'numeric', not 'character'.", + fixed = TRUE + ) +}) + + +test_that("new `get_type()` is equal to old `prediction_type()", { + get_prediction_type <- function(data) { + if (is.data.frame(data)) { + data <- data$predicted + } + if ( + isTRUE(all.equal(as.vector(data), as.integer(data))) && + !all(is.na(as.integer(data))) + ) { + return("integer") + } else if (suppressWarnings(!all(is.na(as.numeric(data))))) { + return("continuous") + } else { + stop("Input is not numeric and cannot be coerced to numeric") + } + } + + check_data <- list( + 1:2, + # factor(1:2) # old function would classify as "continuous" + c(1.0, 2), + c(1.0, 2.3), + matrix(1:4, nrow = 2), + matrix(c(1.0, 2:4)), + matrix(c(1.0, 2.3, 3, 4)) + ) + + for (i in seq_along(check_data)) { + expect_equal( + get_prediction_type(check_data[[i]]), + get_type(check_data[[i]]) + ) + } +}) + +test_that("get_type() handles `NA` values", { + expect_equal(get_type(c(1, NA, 3)), "integer") + expect_equal(get_type(c(1, NA, 3.2)), "continuous") + expect_error(get_type(NA), "Can't get type: all values of are NA") +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index def89fbb2..a909c7d46 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -35,77 +35,6 @@ test_that("get_protected_columns() returns the correct result", { expect_equal(sort(manual), sort(auto)) }) -test_that("get_prediction_type() correctly identifies quantile predictions", { - data <- data.frame( - predicted = 1:3, - quantile = c(0.1, 0.5, 0.9) - ) - - expect_equal(get_prediction_type(data), "discrete") -}) - -test_that("get_prediction_type() correctly identifies integer predictions", { - data <- data.frame( - predicted = as.integer(1:5) - ) - - expect_equal(get_prediction_type(data), "discrete") - - data <- matrix(as.integer(1:9), nrow = 3) - expect_equal(get_prediction_type(data), "discrete") -}) - -test_that("get_prediction_type() correctly identifies continuous predictions", { - data <- data.frame( - predicted = rnorm(5) - ) - - expect_equal(get_prediction_type(data), "continuous") -}) - -test_that("works with vector input", { - predictions <- rnorm(5) - - expect_equal(get_prediction_type(predictions), "continuous") -}) - -test_that("get_prediction_type() returns error on invalid input", { - suppressWarnings(expect_error(get_prediction_type("foo"))) -}) - -test_that("get_prediction_type() handles NA values across prediction types", { - # Quantile - # data <- data.frame( - # predicted = c(1, NA, 3), - # quantile = c(0.1, 0.5, 0.9) - # ) - # expect_equal(get_prediction_type(data), "quantile") - - # Integer - data <- data.frame( - predicted = c(1, NA, 3) - ) - expect_equal(get_prediction_type(data), "discrete") - - # Continuous - data <- data.frame( - predicted = c(1.1, NA, 3.2) - ) - expect_equal(get_prediction_type(data), "continuous") - # predictions <- c(1.1, NA, 3.5) - # expect_equal(get_prediction_type(predictions), "continuous") - - # All NA - data <- data.frame(predicted = NA) - expect_error( - get_prediction_type(data), - "Input is not numeric and cannot be coerced to numeric" - ) - expect_error( - get_prediction_type(NA_real_), - "Input is not numeric and cannot be coerced to numeric" - ) -}) # test_that("prediction_is_quantile() correctly identifies quantile predictions", { # data <- data.frame( From e413b0ab486b79caea69582780f0af6cd81cd3b7 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 21:29:50 +0100 Subject: [PATCH 04/17] lint files (not all of them, sorry Sam) --- R/check-input-helpers.R | 10 ++++------ R/convenience-functions.R | 6 ++++-- R/get_-functions.R | 5 +++-- R/metrics-range.R | 2 -- R/metrics-sample.R | 1 - R/score.R | 18 ++++++++---------- R/summarise_scores.R | 1 - R/utils.R | 1 - man/transform_forecasts.Rd | 3 ++- vignettes/metric-details.Rmd | 14 ++++++++------ vignettes/scoring-forecasts-directly.Rmd | 1 - 11 files changed, 29 insertions(+), 33 deletions(-) diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index 9c87c05a2..1fba68469 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -143,7 +143,7 @@ check_equal_length <- function(..., one_allowed, "' should have the same length (or length one). Actual lengths: ", "' should have the same length. Actual lengths: " - ) + ) stop( "Arguments to the following function call: '", @@ -162,8 +162,8 @@ check_attribute_conflict <- function(object, attribute, expected) { msg <- paste0( "Object has an attribute `", attribute, "`, but it looks different ", "from what's expected.\n", - "Existing: ", paste(existing, collapse = ", "), "\n", - "Expected: ", paste(expected, collapse = ", "), "\n", + "Existing: ", toString(existing), "\n", + "Expected: ", toString(expected), "\n", "Running `validate()` again might solve the problem" ) return(msg) @@ -171,7 +171,7 @@ check_attribute_conflict <- function(object, attribute, expected) { return(TRUE) } - +toString assure_model_column <- function(data) { if (!("model" %in% colnames(data))) { @@ -378,5 +378,3 @@ check_has_attribute <- function(object, attribute) { return(TRUE) } } - - diff --git a/R/convenience-functions.R b/R/convenience-functions.R index 3b1bd719e..870e4ac3d 100644 --- a/R/convenience-functions.R +++ b/R/convenience-functions.R @@ -1,6 +1,7 @@ #' @title Transform forecasts and observed values #' -#' @description Function to transform forecasts and observed values before scoring. +#' @description Function to transform forecasts and observed values before +#' scoring. #' #' @details There are a few reasons, depending on the circumstances, for #' why this might be desirable (check out the linked reference for more info). @@ -114,7 +115,8 @@ transform_forecasts <- function(data, if (scale_col_present) { if (!("natural" %in% original_data$scale)) { stop( - "If a column 'scale' is present, entries with scale =='natural' are required for the transformation" + "If a column 'scale' is present, entries with scale =='natural' ", + "are required for the transformation" ) } if (append && (label %in% original_data$scale)) { diff --git a/R/get_-functions.R b/R/get_-functions.R index 74475fbd0..1042f9ce3 100644 --- a/R/get_-functions.R +++ b/R/get_-functions.R @@ -105,8 +105,9 @@ get_type <- function(x) { if (is.integer(x)) { return("integer") } - if (isTRUE(all.equal(as.vector(x), as.integer(x))) && - !all(is.na(as.integer(x)))) { + if ( + isTRUE(all.equal(as.vector(x), as.integer(x))) && !all(is.na(as.integer(x))) + ) { return("integer") } else { return("continuous") diff --git a/R/metrics-range.R b/R/metrics-range.R index 95e4a9103..d638884d3 100644 --- a/R/metrics-range.R +++ b/R/metrics-range.R @@ -272,5 +272,3 @@ bias_range <- function(lower, upper, range, observed) { return(bias) } - - diff --git a/R/metrics-sample.R b/R/metrics-sample.R index f4bd32dc3..67291bffa 100644 --- a/R/metrics-sample.R +++ b/R/metrics-sample.R @@ -283,4 +283,3 @@ mad_sample <- function(observed = NULL, predicted, ...) { sharpness <- apply(predicted, MARGIN = 1, mad, ...) return(sharpness) } - diff --git a/R/score.R b/R/score.R index de0e4b821..a3818c9a5 100644 --- a/R/score.R +++ b/R/score.R @@ -111,7 +111,6 @@ score.default <- function(data, ...) { score.scoringutils_binary <- function(data, metrics = metrics_binary, ...) { data <- validate(data) data <- remove_na_observed_predicted(data) - forecast_unit <- attr(data, "forecast_unit") metrics <- validate_metrics(metrics) # Extract the arguments passed in ... @@ -122,8 +121,8 @@ score.scoringutils_binary <- function(data, metrics = metrics_binary, ...) { matching_args <- filter_function_args(fun, args) data[, (metric_name) := do.call( - fun, c(list(observed, predicted), matching_args)) - ] + fun, c(list(observed, predicted), matching_args) + )] return() }, ...) @@ -140,7 +139,6 @@ score.scoringutils_binary <- function(data, metrics = metrics_binary, ...) { score.scoringutils_point <- function(data, metrics = metrics_point, ...) { data <- validate(data) data <- remove_na_observed_predicted(data) - forecast_unit <- attr(data, "forecast_unit") metrics <- validate_metrics(metrics) # Extract the arguments passed in ... @@ -151,8 +149,8 @@ score.scoringutils_point <- function(data, metrics = metrics_point, ...) { matching_args <- filter_function_args(fun, args) data[, (metric_name) := do.call( - fun, c(list(observed, predicted), matching_args)) - ] + fun, c(list(observed, predicted), matching_args) + )] return() }, ...) @@ -177,11 +175,11 @@ score.scoringutils_sample <- function(data, metrics = metrics_sample, ...) { matching_args <- filter_function_args(fun, args) data[, (metric_name) := do.call( - fun, c(list(unique(observed), t(predicted)), matching_args)), - by = forecast_unit - ] + fun, c(list(unique(observed), t(predicted)), matching_args) + ), by = forecast_unit] return() - }, ...) + }, + ...) data <- data[ , lapply(.SD, unique), diff --git a/R/summarise_scores.R b/R/summarise_scores.R index 7695a6b15..c55ee9e12 100644 --- a/R/summarise_scores.R +++ b/R/summarise_scores.R @@ -381,4 +381,3 @@ add_coverage <- function(scores, return(scores_with_coverage[]) } - diff --git a/R/utils.R b/R/utils.R index 1301aa8fe..ea377dcb7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -151,4 +151,3 @@ assign_attributes <- function(object, attribute_list) { } return(object) } - diff --git a/man/transform_forecasts.Rd b/man/transform_forecasts.Rd index 406791bad..3bca5400b 100644 --- a/man/transform_forecasts.Rd +++ b/man/transform_forecasts.Rd @@ -55,7 +55,8 @@ additional column, `scale', present which will be set to "natural" for the untransformed forecasts. } \description{ -Function to transform forecasts and observed values before scoring. +Function to transform forecasts and observed values before +scoring. } \details{ There are a few reasons, depending on the circumstances, for diff --git a/vignettes/metric-details.Rmd b/vignettes/metric-details.Rmd index 1a5176c1f..300a501fc 100644 --- a/vignettes/metric-details.Rmd +++ b/vignettes/metric-details.Rmd @@ -26,8 +26,8 @@ library(data.table) This table gives an overview for when which metric can be applied and gives a very brief description. Note that this table on shows the metrics as implemented in `scoringutils`. For example, only scoring of sample-based discrete and continuous distributions is implemented in `scoringutils`, but closed-form solutions often exist (e.g. in the `scoringRules` package). ```{r, echo = FALSE, results = "asis"} -data <- copy(metrics) -setnames(data, old = c("Discrete", "Continuous", "Binary", "Quantile"), +data <- copy(metrics) +setnames(data, old = c("Discrete", "Continuous", "Binary", "Quantile"), new = c("D", "C", "B", "Q")) data[, c("Name", "Functions") := NULL] @@ -45,8 +45,8 @@ data$Q <- replace(data$Q) data[, 1:6] %>% kbl(format = "html", escape = FALSE, - align = c("lccccl"), - linesep = c('\\addlinespace')) %>% + align = "lccccl", + linesep = "\\addlinespace") %>% column_spec(1, width = "3.2cm") %>% column_spec(2, width = "1.5cm") %>% column_spec(3, width = "1.5cm") %>% @@ -62,9 +62,11 @@ data[, 1:6] %>% ## Detailed explanation of the metrics implemented in `scoringutils` ```{r, echo = FALSE, results = "asis"} - data <- readRDS( - system.file("metrics-overview/metrics-detailed.rds", package = "scoringutils") + system.file( + "metrics-overview", "metrics-detailed.rds", + package = "scoringutils" + ) ) data[, 1:2] %>% diff --git a/vignettes/scoring-forecasts-directly.Rmd b/vignettes/scoring-forecasts-directly.Rmd index e58001d9e..d7a68736f 100644 --- a/vignettes/scoring-forecasts-directly.Rmd +++ b/vignettes/scoring-forecasts-directly.Rmd @@ -216,4 +216,3 @@ interval_score( interval_range = interval_range ) ``` - From 74b84d3bb3834d62afaf5db1d2e204247e534d65 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 22:29:24 +0100 Subject: [PATCH 05/17] Add functions to remove a scoringutils_ class and scoringutils attributes --- R/utils.R | 48 +++++++++++++++++++++++++++++++- man/remove_scoringutils_class.Rd | 19 +++++++++++++ man/strip_attributes.Rd | 22 +++++++++++++++ 3 files changed, 88 insertions(+), 1 deletion(-) create mode 100644 man/remove_scoringutils_class.Rd create mode 100644 man/strip_attributes.Rd diff --git a/R/utils.R b/R/utils.R index ea377dcb7..cdb882093 100644 --- a/R/utils.R +++ b/R/utils.R @@ -133,7 +133,6 @@ filter_function_args <- function(fun, args) { #' @title Assign attributes to an object from a named list -#' #' @description #' Every list item will be made an attribute of the object. #' @param object An object to assign attributes to @@ -151,3 +150,50 @@ assign_attributes <- function(object, attribute_list) { } return(object) } + +#' Strip attributes from an object +#' @description This function removes all attributes from an object that are +#' specified in the `attributes` argument. +#' @param object An object to remove attributes from +#' @param attributes A character vector of attribute names to remove from the +#' object +#' @return The object with attributes removed +#' @keywords internal +strip_attributes <- function(object, attributes) { + if (is.null(object)) { + return(NULL) + } + for (i in seq_along(attributes)) { + setattr(object, attributes[i], NULL) + } + return(object) +} + +#' Remove scoringutils_ Class and Attributes +#' @description This function removes all classes that start with +#' "scoringutils_" and all attributes associated with scoringutils. +#' +#' @param object An object to remove scoringutils classes and attributes from +#' @return The object with scoringutils classes and attributes removed +#' @keywords internal +remove_scoringutils_class <- function(object) { + if (is.null(object)) { + return(NULL) + } + if (is.null(class(object))) { + return(object) + } + # check if "scoringutils_" is in name of any class + if (any(grepl("scoringutils_", class(object)))) { + stored_attributes <- get_scoringutils_attributes(object) + + # remove all classes that contain "scoringutils_" + class(object) <- class(object)[!grepl("scoringutils_", class(object))] + + # remove all scoringutils attributes + object <- strip_attributes(object, names(stored_attributes)) + + return(object) + } + return(object) +} diff --git a/man/remove_scoringutils_class.Rd b/man/remove_scoringutils_class.Rd new file mode 100644 index 000000000..9257d84dd --- /dev/null +++ b/man/remove_scoringutils_class.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{remove_scoringutils_class} +\alias{remove_scoringutils_class} +\title{Remove scoringutils_ Class and Attributes} +\usage{ +remove_scoringutils_class(object) +} +\arguments{ +\item{object}{An object to remove scoringutils classes and attributes from} +} +\value{ +The object with scoringutils classes and attributes removed +} +\description{ +This function removes all classes that start with +"scoringutils_" and all attributes associated with scoringutils. +} +\keyword{internal} diff --git a/man/strip_attributes.Rd b/man/strip_attributes.Rd new file mode 100644 index 000000000..5f727f539 --- /dev/null +++ b/man/strip_attributes.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{strip_attributes} +\alias{strip_attributes} +\title{Strip attributes from an object} +\usage{ +strip_attributes(object, attributes) +} +\arguments{ +\item{object}{An object to remove attributes from} + +\item{attributes}{A character vector of attribute names to remove from the +object} +} +\value{ +The object with attributes removed +} +\description{ +This function removes all attributes from an object that are +specified in the \code{attributes} argument. +} +\keyword{internal} From 6bb05db45b10c2c81f8be30bbc017c56158e0239 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 22:30:08 +0100 Subject: [PATCH 06/17] Add checks for clashes in forecast type and forecast unit directly to `get_forecast_type()` and `get_forecast_unit()` --- R/check-input-helpers.R | 7 ++++++- R/get_-functions.R | 39 +++++++++++++++++++++++++-------------- R/pit.R | 2 ++ R/plot.R | 2 +- R/summarise_scores.R | 1 - R/validate.R | 5 ++--- man/get_forecast_unit.Rd | 5 ++++- 7 files changed, 40 insertions(+), 21 deletions(-) diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index 1fba68469..c8edd73d0 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -158,10 +158,15 @@ check_equal_length <- function(..., check_attribute_conflict <- function(object, attribute, expected) { existing <- attr(object, attribute) + if (is.vector(existing) && is.vector(expected)) { + existing <- sort(existing) + expected <- sort(expected) + } + if (!is.null(existing) && !identical(existing, expected)) { msg <- paste0( "Object has an attribute `", attribute, "`, but it looks different ", - "from what's expected.\n", + "from what's expected based on the data.\n", "Existing: ", toString(existing), "\n", "Expected: ", toString(expected), "\n", "Running `validate()` again might solve the problem" diff --git a/R/get_-functions.R b/R/get_-functions.R index 1042f9ce3..f8dcbc81a 100644 --- a/R/get_-functions.R +++ b/R/get_-functions.R @@ -15,20 +15,23 @@ #' @keywords internal get_forecast_type <- function(data) { if (test_forecast_type_is_binary(data)) { - return("binary") - } - if (test_forecast_type_is_quantile(data)) { - return("quantile") - } - if (test_forecast_type_is_sample(data)) { - return("sample") - } - if (test_forecast_type_is_point(data)) { - return("point") - } - stop("Checking `data`: input doesn't satisfy the criteria for any forecast type.", + forecast_type <- "binary" + } else if (test_forecast_type_is_quantile(data)) { + forecast_type <- "quantile" + } else if (test_forecast_type_is_sample(data)) { + forecast_type <- "sample" + } else if (test_forecast_type_is_point(data)) { + forecast_type <- "point" + } else { + stop("Checking `data`: input doesn't satisfy the criteria for any forecast type.", "Are you missing a column `quantile` or `sample_id`?", "Please check the vignette for additional info.") + } + conflict <- check_attribute_conflict(data, "forecast_type", forecast_type) + if (!is.logical(conflict)) { + warning(conflict) + } + return(forecast_type) } @@ -148,17 +151,25 @@ get_metrics <- function(scores) { #' specified during scoring, if any. #' #' @inheritParams validate +#' @param check_conflict Whether or not to check whether there is a conflict +#' between a stored attribute and the inferred forecast unit. Defaults to FALSE. #' #' @return A character vector with the column names that define the unit of #' a single forecast #' #' @keywords internal - -get_forecast_unit <- function(data) { +get_forecast_unit <- function(data, check_conflict = FALSE) { + # check whether there is a conflict in the forecast_unit and if so warn protected_columns <- get_protected_columns(data) protected_columns <- c(protected_columns, attr(data, "metric_names")) forecast_unit <- setdiff(colnames(data), unique(protected_columns)) + + conflict <- check_attribute_conflict(data, "forecast_unit", forecast_unit) + if (check_conflict && !is.logical(conflict)) { + warning(conflict) + } + return(forecast_unit) } diff --git a/R/pit.R b/R/pit.R index 9366c9eb6..fccc8f088 100644 --- a/R/pit.R +++ b/R/pit.R @@ -198,6 +198,8 @@ pit <- function(data, coverage <- summarise_scores(coverage, by = unique(c(by, "quantile")) ) + # remove all existing attributes and class + coverage <- remove_scoringutils_class(coverage) coverage <- coverage[order(quantile), .( diff --git a/R/plot.R b/R/plot.R index 0a1366906..f5683dd3c 100644 --- a/R/plot.R +++ b/R/plot.R @@ -44,7 +44,7 @@ plot_score_table <- function(scores, metrics = NULL) { # identify metrics ----------------------------------------------------------- - id_vars <- get_forecast_unit(scores) + id_vars <- get_forecast_unit(scores, check = FALSE) metrics <- get_metrics(scores) scores <- delete_columns( diff --git a/R/summarise_scores.R b/R/summarise_scores.R index c55ee9e12..37569b4bb 100644 --- a/R/summarise_scores.R +++ b/R/summarise_scores.R @@ -84,7 +84,6 @@ summarise_scores <- function(scores, # preparations --------------------------------------------------------------- # get unit of a single forecast forecast_unit <- get_forecast_unit(scores) - check_attribute_conflict(scores, "forecast_unit", forecast_unit) # if by is not provided, set to the unit of a single forecast if (is.null(by)) { diff --git a/R/validate.R b/R/validate.R index 08fcfd4a4..d283f7aa8 100644 --- a/R/validate.R +++ b/R/validate.R @@ -122,10 +122,9 @@ validate_general <- function(data) { # assign forecast type and unit as an attribute and make sure there is no clash forecast_type <- get_forecast_type(data) - assert(check_attribute_conflict(data, "forecast_type", forecast_type)) setattr(data, "forecast_type", forecast_type) - forecast_unit <- get_forecast_unit(data) - assert(check_attribute_conflict(data, "forecast_unit", forecast_unit)) + + forecast_unit <- get_forecast_unit(data, check_conflict = TRUE) setattr(data, "forecast_unit", forecast_unit) # check that there aren't any duplicated forecasts diff --git a/man/get_forecast_unit.Rd b/man/get_forecast_unit.Rd index f17349853..4491c272a 100644 --- a/man/get_forecast_unit.Rd +++ b/man/get_forecast_unit.Rd @@ -4,7 +4,7 @@ \alias{get_forecast_unit} \title{Get unit of a single forecast} \usage{ -get_forecast_unit(data) +get_forecast_unit(data, check_conflict = FALSE) } \arguments{ \item{data}{A data.frame or data.table with the following columns: @@ -23,6 +23,9 @@ Depending on the forecast type, one of the following columns may be required: For more information see the vignettes and the example data (\link{example_quantile}, \link{example_continuous}, \link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} + +\item{check_conflict}{Whether or not to check whether there is a conflict +between a stored attribute and the inferred forecast unit. Defaults to FALSE.} } \value{ A character vector with the column names that define the unit of From 0c6fdf64eedde4e0a6658b37ff7da8f14419aaca Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 22:50:11 +0100 Subject: [PATCH 07/17] fix typo in plot_scores_table() --- R/get_-functions.R | 1 - R/plot.R | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/R/get_-functions.R b/R/get_-functions.R index f8dcbc81a..e9e5398ff 100644 --- a/R/get_-functions.R +++ b/R/get_-functions.R @@ -186,7 +186,6 @@ get_forecast_unit <- function(data, check_conflict = FALSE) { #' protected in scoringutils. #' #' @keywords internal - get_protected_columns <- function(data = NULL) { protected_columns <- c( diff --git a/R/plot.R b/R/plot.R index f5683dd3c..0a1366906 100644 --- a/R/plot.R +++ b/R/plot.R @@ -44,7 +44,7 @@ plot_score_table <- function(scores, metrics = NULL) { # identify metrics ----------------------------------------------------------- - id_vars <- get_forecast_unit(scores, check = FALSE) + id_vars <- get_forecast_unit(scores) metrics <- get_metrics(scores) scores <- delete_columns( From 0e991dc3787764f8fbcad68fe0c90b2ca27b0ff6 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 23:22:37 +0100 Subject: [PATCH 08/17] Simplify documentation for binary metrics --- R/metrics-binary.R | 72 +++++++---------------- man/{brier_score.Rd => binary-metrics.Rd} | 40 ++++++++----- man/logs_binary.Rd | 58 ------------------ 3 files changed, 46 insertions(+), 124 deletions(-) rename man/{brier_score.Rd => binary-metrics.Rd} (69%) delete mode 100644 man/logs_binary.Rd diff --git a/R/metrics-binary.R b/R/metrics-binary.R index 5c8182224..c96660243 100644 --- a/R/metrics-binary.R +++ b/R/metrics-binary.R @@ -1,24 +1,23 @@ -#' Brier Score +#' Metrics for Binary Outcomes #' #' @description -#' Computes the Brier Score for probabilistic forecasts of binary outcomes. +#' **Brier score** #' -#' @details -#' The Brier score is a proper score rule that assesses the accuracy of -#' probabilistic binary predictions. The outcomes can be either 0 or 1, -#' the predictions must be a probability that the observed outcome will be 1. -#' -#' The Brier Score is then computed as the mean squared error between the -#' probabilistic prediction and the observed outcome. +#' The Brier Score is the mean squared error between the probabilistic +#' prediction and the observed outcome. The Brier score is a proper scoring +#' rule. Small values are better (best is 0, the worst is 1). #' #' \deqn{ #' \textrm{Brier\_Score} = \frac{1}{N} \sum_{t = 1}^{n} (\textrm{prediction}_t - -#' \textrm{outcome}_t)^2 +#' \textrm{outcome}_t)^2, #' }{ -#' Brier_Score = 1/N sum_{t = 1}^{n} (prediction_t - outcome_t)² -#' } +#' Brier_Score = 1/N sum_{t = 1}^{n} (prediction_t - outcome_t)², +#' } where \eqn{\textrm{outcome}_t \in \{0, 1\}}{outcome_t in {0, 1}}, and +#' \eqn{\textrm{prediction}_t \in [0, 1]}{prediction_t in [0, 1]} represents +#' the probability that the outcome is equal to 1. #' -#' The function requires users to provide observed values as a factor in order +#' @details +#' The functions require users to provide observed values as a factor in order #' to distinguish its input from the input format required for scoring point #' forecasts. Internally, however, factors will be converted to numeric values. #' A factor `observed = factor(c(0, 1, 1, 0, 1)` with two levels (`0` and `1`) @@ -45,8 +44,7 @@ #' @param predicted A numeric vector of length n, holding probabilities. #' Values represent the probability that the corresponding outcome is equal to #' the highest level of the factor `observed`. -#' @return A numeric value with the Brier Score, i.e. the mean squared -#' error of the given probability forecasts +#' @return A numeric vector of size n with the Brier scores #' @export #' #' @examples @@ -54,8 +52,9 @@ #' predicted <- runif(n = 30, min = 0, max = 1) #' #' brier_score(observed, predicted) +#' logs_binary(observed, predicted) #' @keywords metric - +#' @rdname binary-metrics brier_score <- function(observed, predicted) { assert_input_binary(observed, predicted) @@ -68,46 +67,17 @@ brier_score <- function(observed, predicted) { #' Log Score for Binary outcomes #' #' @description -#' Computes the Log Score for probabilistic forecasts of binary outcomes. -#' -#' @details -#' The Log Score is a proper score rule suited to assessing the accuracy of -#' probabilistic binary predictions. The outcomes can be either 0 or 1, -#' the predictions must be a probability that the true outcome will be 1. -#' -#' The Log Score is then computed as the negative logarithm of the probability -#' assigned to the true outcome. Reporting the negative logarithm means that -#' smaller values are better. +#' **Log score for binary outcomes** #' -#' The function requires users to provide observed values as a factor in order -#' to distinguish its input from the input format required for scoring point -#' forecasts. Internally, however, factors will be converted to numeric values. -#' A factor `observed = factor(c(0, 1, 1, 0, 1)` with two levels (`0` and `1`) -#' would internally be coerced to a numeric vector (in this case this would -#' result in the numeric vector c(1, 2, 2, 1, 1)). After subtracting 1, the -#' resulting vector (`c(0, 1, 1, 0)` in this case) is used for internal -#' calculations. All predictions are assumed represent the probability that the -#' outcome is equal of the highest factor level (in this case that the -#' outcome is equal to 1). -#' You could alternatively also provide a vector like -#' `observed = factor(c("a", "b", "b", "a"))` (with two levels, `a` and `b`), -#' which would result in exactly the same internal representation. Probabilities -#' then represent the probability that the outcome is equal to "b". -#' If you want your predictions to be probabilities that the outcome is "a", -#' then you could of course make `observed` a factor with levels swapped, i.e. -#' `observed = factor(c("a", "b", "b", "a"), levels = c("b", "a"))` +#' The Log Score is the negative logarithm of the probability +#' assigned to the observed value. It is a proper scoring rule. Small values +#' are better (best is zero, worst is infinity). #' -#' @inheritParams brier_score -#' @return A numeric vector with log scores +#' @return A numeric vector of size n with log scores #' @importFrom methods hasArg #' @export #' @keywords metric -#' -#' @examples -#' observed <- factor(sample(c(0, 1), size = 30, replace = TRUE)) -#' predicted <- runif(n = 30, min = 0, max = 1) - -#' logs_binary(observed, predicted) +#' @rdname binary-metrics logs_binary <- function(observed, predicted) { assert_input_binary(observed, predicted) observed <- as.numeric(observed) - 1 diff --git a/man/brier_score.Rd b/man/binary-metrics.Rd similarity index 69% rename from man/brier_score.Rd rename to man/binary-metrics.Rd index ab0c4574b..615e2ef6c 100644 --- a/man/brier_score.Rd +++ b/man/binary-metrics.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/metrics-binary.R \name{brier_score} \alias{brier_score} -\title{Brier Score} +\alias{logs_binary} +\title{Metrics for Binary Outcomes} \usage{ brier_score(observed, predicted) + +logs_binary(observed, predicted) } \arguments{ \item{observed}{A factor of length n with exactly two levels, holding @@ -18,28 +21,34 @@ Values represent the probability that the corresponding outcome is equal to the highest level of the factor \code{observed}.} } \value{ -A numeric value with the Brier Score, i.e. the mean squared -error of the given probability forecasts +A numeric vector of size n with the Brier scores + +A numeric vector of size n with log scores } \description{ -Computes the Brier Score for probabilistic forecasts of binary outcomes. -} -\details{ -The Brier score is a proper score rule that assesses the accuracy of -probabilistic binary predictions. The outcomes can be either 0 or 1, -the predictions must be a probability that the observed outcome will be 1. +\strong{Brier score} -The Brier Score is then computed as the mean squared error between the -probabilistic prediction and the observed outcome. +The Brier Score is the mean squared error between the probabilistic +prediction and the observed outcome. The Brier score is a proper scoring +rule. Small values are better (best is 0, the worst is 1). \deqn{ \textrm{Brier\_Score} = \frac{1}{N} \sum_{t = 1}^{n} (\textrm{prediction}_t - - \textrm{outcome}_t)^2 + \textrm{outcome}_t)^2, }{ - Brier_Score = 1/N sum_{t = 1}^{n} (prediction_t - outcome_t)² -} + Brier_Score = 1/N sum_{t = 1}^{n} (prediction_t - outcome_t)², +} where \eqn{\textrm{outcome}_t \in \{0, 1\}}{outcome_t in {0, 1}}, and +\eqn{\textrm{prediction}_t \in [0, 1]}{prediction_t in [0, 1]} represents +the probability that the outcome is equal to 1. + +\strong{Log score for binary outcomes} -The function requires users to provide observed values as a factor in order +The Log Score is the negative logarithm of the probability +assigned to the observed value. It is a proper scoring rule. Small values +are better (best is zero, worst is infinity). +} +\details{ +The functions require users to provide observed values as a factor in order to distinguish its input from the input format required for scoring point forecasts. Internally, however, factors will be converted to numeric values. A factor \verb{observed = factor(c(0, 1, 1, 0, 1)} with two levels (\code{0} and \code{1}) @@ -63,5 +72,6 @@ observed <- factor(sample(c(0, 1), size = 30, replace = TRUE)) predicted <- runif(n = 30, min = 0, max = 1) brier_score(observed, predicted) +logs_binary(observed, predicted) } \keyword{metric} diff --git a/man/logs_binary.Rd b/man/logs_binary.Rd deleted file mode 100644 index 5a7d4c144..000000000 --- a/man/logs_binary.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/metrics-binary.R -\name{logs_binary} -\alias{logs_binary} -\title{Log Score for Binary outcomes} -\usage{ -logs_binary(observed, predicted) -} -\arguments{ -\item{observed}{A factor of length n with exactly two levels, holding -the observed values. -The highest factor level is assumed to be the reference level. This means -that \code{predicted} represents the probability that the observed value is -equal to the highest factor level.} - -\item{predicted}{A numeric vector of length n, holding probabilities. -Values represent the probability that the corresponding outcome is equal to -the highest level of the factor \code{observed}.} -} -\value{ -A numeric vector with log scores -} -\description{ -Computes the Log Score for probabilistic forecasts of binary outcomes. -} -\details{ -The Log Score is a proper score rule suited to assessing the accuracy of -probabilistic binary predictions. The outcomes can be either 0 or 1, -the predictions must be a probability that the true outcome will be 1. - -The Log Score is then computed as the negative logarithm of the probability -assigned to the true outcome. Reporting the negative logarithm means that -smaller values are better. - -The function requires users to provide observed values as a factor in order -to distinguish its input from the input format required for scoring point -forecasts. Internally, however, factors will be converted to numeric values. -A factor \verb{observed = factor(c(0, 1, 1, 0, 1)} with two levels (\code{0} and \code{1}) -would internally be coerced to a numeric vector (in this case this would -result in the numeric vector c(1, 2, 2, 1, 1)). After subtracting 1, the -resulting vector (\code{c(0, 1, 1, 0)} in this case) is used for internal -calculations. All predictions are assumed represent the probability that the -outcome is equal of the highest factor level (in this case that the -outcome is equal to 1). -You could alternatively also provide a vector like -\code{observed = factor(c("a", "b", "b", "a"))} (with two levels, \code{a} and \code{b}), -which would result in exactly the same internal representation. Probabilities -then represent the probability that the outcome is equal to "b". -If you want your predictions to be probabilities that the outcome is "a", -then you could of course make \code{observed} a factor with levels swapped, i.e. -\code{observed = factor(c("a", "b", "b", "a"), levels = c("b", "a"))} -} -\examples{ -observed <- factor(sample(c(0, 1), size = 30, replace = TRUE)) -predicted <- runif(n = 30, min = 0, max = 1) -logs_binary(observed, predicted) -} -\keyword{metric} From cd26a5d1d3853f7588371922942b5fd93fb3057f Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 23:32:56 +0100 Subject: [PATCH 09/17] Updating documentation for binary metrics again - unsure whether that's an improvement. But it's definitely a change. --- R/metrics-binary.R | 40 +++++++++++++++++++++------------------- man/binary-metrics.Rd | 5 ++++- 2 files changed, 25 insertions(+), 20 deletions(-) diff --git a/R/metrics-binary.R b/R/metrics-binary.R index c96660243..6d9d1b9a7 100644 --- a/R/metrics-binary.R +++ b/R/metrics-binary.R @@ -1,21 +1,5 @@ #' Metrics for Binary Outcomes #' -#' @description -#' **Brier score** -#' -#' The Brier Score is the mean squared error between the probabilistic -#' prediction and the observed outcome. The Brier score is a proper scoring -#' rule. Small values are better (best is 0, the worst is 1). -#' -#' \deqn{ -#' \textrm{Brier\_Score} = \frac{1}{N} \sum_{t = 1}^{n} (\textrm{prediction}_t - -#' \textrm{outcome}_t)^2, -#' }{ -#' Brier_Score = 1/N sum_{t = 1}^{n} (prediction_t - outcome_t)², -#' } where \eqn{\textrm{outcome}_t \in \{0, 1\}}{outcome_t in {0, 1}}, and -#' \eqn{\textrm{prediction}_t \in [0, 1]}{prediction_t in [0, 1]} represents -#' the probability that the outcome is equal to 1. -#' #' @details #' The functions require users to provide observed values as a factor in order #' to distinguish its input from the input format required for scoring point @@ -44,16 +28,34 @@ #' @param predicted A numeric vector of length n, holding probabilities. #' Values represent the probability that the corresponding outcome is equal to #' the highest level of the factor `observed`. -#' @return A numeric vector of size n with the Brier scores -#' @export -#' #' @examples #' observed <- factor(sample(c(0, 1), size = 30, replace = TRUE)) #' predicted <- runif(n = 30, min = 0, max = 1) #' #' brier_score(observed, predicted) #' logs_binary(observed, predicted) +#' @rdname binary-metrics +binary_metrics <- function(observed, predicted) {} + + +#' @description +#' **Brier score** +#' +#' The Brier Score is the mean squared error between the probabilistic +#' prediction and the observed outcome. The Brier score is a proper scoring +#' rule. Small values are better (best is 0, the worst is 1). +#' +#' \deqn{ +#' \textrm{Brier\_Score} = \frac{1}{N} \sum_{t = 1}^{n} (\textrm{prediction}_t - +#' \textrm{outcome}_t)^2, +#' }{ +#' Brier_Score = 1/N sum_{t = 1}^{n} (prediction_t - outcome_t)², +#' } where \eqn{\textrm{outcome}_t \in \{0, 1\}}{outcome_t in {0, 1}}, and +#' \eqn{\textrm{prediction}_t \in [0, 1]}{prediction_t in [0, 1]} represents +#' the probability that the outcome is equal to 1. +#' @return A numeric vector of size n with the Brier scores #' @keywords metric +#' @export #' @rdname binary-metrics brier_score <- function(observed, predicted) { assert_input_binary(observed, predicted) diff --git a/man/binary-metrics.Rd b/man/binary-metrics.Rd index 615e2ef6c..00ce3de70 100644 --- a/man/binary-metrics.Rd +++ b/man/binary-metrics.Rd @@ -1,10 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/metrics-binary.R -\name{brier_score} +\name{binary_metrics} +\alias{binary_metrics} \alias{brier_score} \alias{logs_binary} \title{Metrics for Binary Outcomes} \usage{ +binary_metrics(observed, predicted) + brier_score(observed, predicted) logs_binary(observed, predicted) From f206b01ac8833ffc9d3888c99acf3c44f85cfbcb Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Sun, 29 Oct 2023 23:42:35 +0100 Subject: [PATCH 10/17] Update documnentation by creating a documentation template from which other functions can inherit parameters --- R/check-input-helpers.R | 18 ++++++------------ R/documentation-templates.R | 4 ++++ R/get_-functions.R | 8 ++++---- man/check_columns_present.Rd | 2 +- man/check_data_doc_template.Rd | 16 ++++++++++++++++ man/check_no_NA_present.Rd | 2 +- man/check_number_per_forecast.Rd | 2 +- man/check_numeric_vector.Rd | 4 +++- man/test_columns_not_present.Rd | 2 +- man/test_columns_present.Rd | 2 +- 10 files changed, 38 insertions(+), 22 deletions(-) create mode 100644 R/documentation-templates.R create mode 100644 man/check_data_doc_template.Rd diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index c8edd73d0..5c2e2415e 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -2,7 +2,7 @@ #' #' @description Helper function #' @param x input to check -#' @param x additional arguments to pass to `check_numeric()` +#' @param ... additional arguments to pass to `check_numeric()` #' @importFrom checkmate check_atomic_vector check_numeric #' @return Either TRUE if the test is successful or a string with an error #' message @@ -70,9 +70,6 @@ check_try <- function(expr) { } - - - #' @title Check Variable is not NULL #' #' @description @@ -191,7 +188,7 @@ assure_model_column <- function(data) { #' Check that all forecasts have the same number of quantiles or samples -#' @param data data.frame to check +#' @inheritParams check_data_doc_template #' @param forecast_unit Character vector denoting the unit of a single forecast. #' @return Returns an string with a message if any forecasts have differing #' numbers of samples or quantiles, otherwise returns TRUE @@ -295,8 +292,7 @@ check_duplicates <- function(data, forecast_unit = NULL) { #' Check column names are present in a data.frame -#' @param data A data.frame or similar to be checked -#' @param columns names of columns to be checked +#' @inheritParams check_data_doc_template #' @return Returns string with a message with the first issue encountered if #' any of the column names are not in data, otherwise returns TRUE #' @importFrom checkmate assert_character @@ -317,8 +313,7 @@ check_columns_present <- function(data, columns) { } #' Test whether all column names are present in a data.frame -#' @param data A data.frame or similar to be checked -#' @param columns names of columns to be checked +#' @inheritParams check_data_doc_template #' @return Returns TRUE if all columns are present and FALSE otherwise #' @keywords internal test_columns_present <- function(data, columns) { @@ -327,8 +322,7 @@ test_columns_present <- function(data, columns) { } #' Test whether column names are NOT present in a data.frame -#' @param data A data.frame or similar to be checked -#' @param columns names of columns to be checked +#' @inheritParams check_data_doc_template #' @return Returns TRUE if none of the columns are present and FALSE otherwise #' @keywords internal test_columns_not_present <- function(data, columns) { @@ -343,7 +337,7 @@ test_columns_not_present <- function(data, columns) { #' @description Checks whether data is a data.frame, whether columns #' "observed" and "predicted" are presents #' and checks that only one of "quantile" and "sample_id" is present. -#' @param data A data.frame or similar to be checked +#' @inheritParams check_data_doc_template #' @importFrom checkmate check_data_frame #' @return Returns TRUE if basic requirements are satisfied and a string with #' an error message otherwise diff --git a/R/documentation-templates.R b/R/documentation-templates.R new file mode 100644 index 000000000..7f4b22907 --- /dev/null +++ b/R/documentation-templates.R @@ -0,0 +1,4 @@ +#' Documentation template for various checks on a data.frame +#' @param data A data.frame or similar to be checked +#' @param columns A character vector of column names to check +check_data_doc_template <- function(data, columns) {} diff --git a/R/get_-functions.R b/R/get_-functions.R index e9e5398ff..07857222e 100644 --- a/R/get_-functions.R +++ b/R/get_-functions.R @@ -37,7 +37,7 @@ get_forecast_type <- function(data) { #' Test whether data could be a binary forecast. #' @description Checks type of the necessary columns. -#' @param data A data.frame or similar to be checked +#' @inheritParams check_data_doc_template #' @importFrom checkmate test_factor test_numeric #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal @@ -49,7 +49,7 @@ test_forecast_type_is_binary <- function(data) { #' Test whether data could be a sample-based forecast. #' @description Checks type of the necessary columns. -#' @param data A data.frame or similar to be checked +#' @inheritParams check_data_doc_template #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal test_forecast_type_is_sample <- function(data) { @@ -61,7 +61,7 @@ test_forecast_type_is_sample <- function(data) { #' Test whether data could be a point forecast. #' @description Checks type of the necessary columns. -#' @param data A data.frame or similar to be checked +#' @inheritParams check_data_doc_template #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal test_forecast_type_is_point <- function(data) { @@ -73,7 +73,7 @@ test_forecast_type_is_point <- function(data) { #' Test whether data could be a quantile forecast. #' @description Checks type of the necessary columns. -#' @param data A data.frame or similar to be checked +#' @inheritParams check_data_doc_template #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal test_forecast_type_is_quantile <- function(data) { diff --git a/man/check_columns_present.Rd b/man/check_columns_present.Rd index 16ee334e2..25fc11bb4 100644 --- a/man/check_columns_present.Rd +++ b/man/check_columns_present.Rd @@ -9,7 +9,7 @@ check_columns_present(data, columns) \arguments{ \item{data}{A data.frame or similar to be checked} -\item{columns}{names of columns to be checked} +\item{columns}{A character vector of column names to check} } \value{ Returns string with a message with the first issue encountered if diff --git a/man/check_data_doc_template.Rd b/man/check_data_doc_template.Rd new file mode 100644 index 000000000..3228c423f --- /dev/null +++ b/man/check_data_doc_template.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/documentation-templates.R +\name{check_data_doc_template} +\alias{check_data_doc_template} +\title{Documentation template for various checks on a data.frame} +\usage{ +check_data_doc_template(data, columns) +} +\arguments{ +\item{data}{A data.frame or similar to be checked} + +\item{columns}{A character vector of column names to check} +} +\description{ +Documentation template for various checks on a data.frame +} diff --git a/man/check_no_NA_present.Rd b/man/check_no_NA_present.Rd index 0d5e0afa1..671e9a1f9 100644 --- a/man/check_no_NA_present.Rd +++ b/man/check_no_NA_present.Rd @@ -9,7 +9,7 @@ check_no_NA_present(data, columns) \arguments{ \item{data}{A data.frame or similar to be checked} -\item{columns}{names of columns to be checked} +\item{columns}{A character vector of column names to check} } \value{ Returns an string with a message if any of the column names diff --git a/man/check_number_per_forecast.Rd b/man/check_number_per_forecast.Rd index b17878d3a..043ca6573 100644 --- a/man/check_number_per_forecast.Rd +++ b/man/check_number_per_forecast.Rd @@ -7,7 +7,7 @@ check_number_per_forecast(data, forecast_unit) } \arguments{ -\item{data}{data.frame to check} +\item{data}{A data.frame or similar to be checked} \item{forecast_unit}{Character vector denoting the unit of a single forecast.} } diff --git a/man/check_numeric_vector.Rd b/man/check_numeric_vector.Rd index 70eafa2c1..7a1ec11f6 100644 --- a/man/check_numeric_vector.Rd +++ b/man/check_numeric_vector.Rd @@ -7,7 +7,9 @@ check_numeric_vector(x, ...) } \arguments{ -\item{x}{additional arguments to pass to \code{check_numeric()}} +\item{x}{input to check} + +\item{...}{additional arguments to pass to \code{check_numeric()}} } \value{ Either TRUE if the test is successful or a string with an error diff --git a/man/test_columns_not_present.Rd b/man/test_columns_not_present.Rd index 3b025f994..8da1af43b 100644 --- a/man/test_columns_not_present.Rd +++ b/man/test_columns_not_present.Rd @@ -9,7 +9,7 @@ test_columns_not_present(data, columns) \arguments{ \item{data}{A data.frame or similar to be checked} -\item{columns}{names of columns to be checked} +\item{columns}{A character vector of column names to check} } \value{ Returns TRUE if none of the columns are present and FALSE otherwise diff --git a/man/test_columns_present.Rd b/man/test_columns_present.Rd index 1e463316f..efbeea2cd 100644 --- a/man/test_columns_present.Rd +++ b/man/test_columns_present.Rd @@ -9,7 +9,7 @@ test_columns_present(data, columns) \arguments{ \item{data}{A data.frame or similar to be checked} -\item{columns}{names of columns to be checked} +\item{columns}{A character vector of column names to check} } \value{ Returns TRUE if all columns are present and FALSE otherwise From 9fe28e9769d8f08dd8a4e9b0b43ad2083c591f23 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 30 Oct 2023 13:42:47 +0100 Subject: [PATCH 11/17] Simplify documentation for input checking functions --- R/check-input-helpers.R | 2 -- R/check-inputs-scoring-functions.R | 51 +++++++----------------------- R/documentation-templates.R | 2 +- man/assert_input_binary.Rd | 4 +-- man/assert_input_quantile.Rd | 4 +-- man/check_input_quantile.Rd | 2 +- 6 files changed, 17 insertions(+), 48 deletions(-) diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index 5c2e2415e..e172fe0f4 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -173,8 +173,6 @@ check_attribute_conflict <- function(object, attribute, expected) { return(TRUE) } -toString - assure_model_column <- function(data) { if (!("model" %in% colnames(data))) { message( diff --git a/R/check-inputs-scoring-functions.R b/R/check-inputs-scoring-functions.R index 780086818..e640c4c2d 100644 --- a/R/check-inputs-scoring-functions.R +++ b/R/check-inputs-scoring-functions.R @@ -1,5 +1,4 @@ #' @title Assert that inputs are correct for sample-based forecast -#' #' @description Helper function to assert whether the input is suitable for #' scoring. #' @param observed Input to be checked. Should be a numeric vector with the @@ -10,7 +9,7 @@ #' If `observed` is just a single number, then predicted values can just be a #' vector of size N. #' @importFrom checkmate assert assert_numeric check_matrix -#' @return Returns NULL invisibly if the check was successful and throws an +#' @returns Returns NULL invisibly if the check was successful and throws an #' error otherwise. #' @keywords check-inputs assert_input_sample <- function(observed, predicted) { @@ -30,10 +29,9 @@ assert_input_sample <- function(observed, predicted) { } #' @title Check that inputs are correct for sample-based forecast -#' #' @description Helper function to check whether the input is suitable for #' scoring. -#' @inheritParams assert_input_sample +#' @inherit assert_input_sample params #' @return Returns TRUE if the check was successful and a string with the #' error message otherwise #' @keywords check-inputs @@ -43,12 +41,8 @@ check_input_sample <- function(observed, predicted) { } -#' @title Assert that inputs are correct for sample-based forecast -#' -#' @description Helper function to assert whether the input is suitable for -#' scoring. -#' @param observed Input to be checked. Should be a vector with the -#' observed values of size n +#' @title Assert that inputs are correct for quantile-based forecast +#' @inheritParams assert_input_sample #' @param predicted Input to be checked. Should be nxN matrix of predictive #' quantiles, n (number of rows) being the number of data points and N #' (number of columns) the number of quantiles per forecast. @@ -58,8 +52,7 @@ check_input_sample <- function(observed, predicted) { #' denotes the quantile levels corresponding to the columns of the prediction #' matrix. #' @importFrom checkmate assert assert_numeric check_matrix -#' @return Returns NULL invisibly if the check was successful and throws an -#' error otherwise. +#' @inherit assert_input_sample return description #' @keywords internal assert_input_quantile <- function(observed, predicted, quantile) { assert_numeric(observed, min.len = 1) @@ -84,12 +77,8 @@ assert_input_quantile <- function(observed, predicted, quantile) { } #' @title Check that inputs are correct for quantile-based forecast -#' -#' @description Helper function to check whether the input is suitable for -#' scoring. #' @inheritParams assert_input_quantile -#' @return Returns TRUE if the check was successful and a string with the -#' error message otherwise +#' @inherit check_input_sample return description #' @keywords check-inputs check_input_quantile <- function(observed, predicted, quantile) { result <- check_try(assert_input_quantile(observed, predicted, quantile)) @@ -98,9 +87,6 @@ check_input_quantile <- function(observed, predicted, quantile) { #' @title Assert that inputs are correct for binary forecast -#' -#' @description Helper function to assert whether the input is suitable for -#' scoring. #' @param observed Input to be checked. Should be a factor of length n with #' exactly two levels, holding the observed values. #' The highest factor level is assumed to be the reference level. This means @@ -110,12 +96,10 @@ check_input_quantile <- function(observed, predicted, quantile) { #' length n, holding probabilities. Values represent the probability that #' the corresponding value in `observed` will be equal to the highest #' available factor level. -#' @param ... additional arguments passed to other functions #' @importFrom checkmate assert assert_factor -#' @return Returns NULL invisibly if the check was successful and throws an -#' error otherwise. +#' @inherit assert_input_sample return description #' @keywords check-inputs -assert_input_binary <- function(observed, predicted, ...) { +assert_input_binary <- function(observed, predicted) { if (length(observed) != length(predicted)) { stop("`observed` and `predicted` need to be ", "of same length when scoring binary forecasts") @@ -130,28 +114,21 @@ assert_input_binary <- function(observed, predicted, ...) { #' @title Check that inputs are correct for binary forecast #' -#' @description Helper function to check whether the input is suitable for -#' scoring. #' @inheritParams assert_input_binary -#' @return Returns TRUE if the check was successful and a string with the -#' error message otherwise +#' @inherit check_input_sample return description #' @keywords check-inputs check_input_binary <- function(observed, predicted) { - result <- check_try(assert_input_binary(observed, predicted, call_levels_up = 8)) + result <- check_try(assert_input_binary(observed, predicted)) return(result) } #' @title Assert that inputs are correct for point forecast -#' -#' @description Helper function to assert whether the input is suitable for -#' scoring. #' @param observed Input to be checked. Should be a numeric vector with the #' observed values of size n #' @param predicted Input to be checked. Should be a numeric vector with the #' predicted values of size n -#' @return Returns NULL invisibly if the check was successful and throws an -#' error otherwise. +#' @inherit assert_input_sample return description #' @keywords check-inputs assert_input_point <- function(observed, predicted) { assert(check_numeric_vector(observed, min.len = 1)) @@ -164,12 +141,8 @@ assert_input_point <- function(observed, predicted) { } #' @title Check that inputs are correct for point forecast -#' -#' @description Helper function to check whether the input is suitable for -#' scoring. #' @inheritParams assert_input_point -#' @return Returns TRUE if the check was successful and a string with the -#' error message otherwise +#' @inherit check_input_sample return description #' @keywords check-inputs check_input_point <- function(observed, predicted) { result <- check_try(assert_input_point(observed, predicted)) diff --git a/R/documentation-templates.R b/R/documentation-templates.R index 7f4b22907..627bf831d 100644 --- a/R/documentation-templates.R +++ b/R/documentation-templates.R @@ -1,4 +1,4 @@ #' Documentation template for various checks on a data.frame #' @param data A data.frame or similar to be checked #' @param columns A character vector of column names to check -check_data_doc_template <- function(data, columns) {} +check_data_doc_template <- function(data, columns) NULL diff --git a/man/assert_input_binary.Rd b/man/assert_input_binary.Rd index 951a223f6..867df8380 100644 --- a/man/assert_input_binary.Rd +++ b/man/assert_input_binary.Rd @@ -4,7 +4,7 @@ \alias{assert_input_binary} \title{Assert that inputs are correct for binary forecast} \usage{ -assert_input_binary(observed, predicted, ...) +assert_input_binary(observed, predicted) } \arguments{ \item{observed}{Input to be checked. Should be a factor of length n with @@ -17,8 +17,6 @@ to the highest factor level.} length n, holding probabilities. Values represent the probability that the corresponding value in \code{observed} will be equal to the highest available factor level.} - -\item{...}{additional arguments passed to other functions} } \value{ Returns NULL invisibly if the check was successful and throws an diff --git a/man/assert_input_quantile.Rd b/man/assert_input_quantile.Rd index c2a5e6aa5..b27d9a9b4 100644 --- a/man/assert_input_quantile.Rd +++ b/man/assert_input_quantile.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/check-inputs-scoring-functions.R \name{assert_input_quantile} \alias{assert_input_quantile} -\title{Assert that inputs are correct for sample-based forecast} +\title{Assert that inputs are correct for quantile-based forecast} \usage{ assert_input_quantile(observed, predicted, quantile) } \arguments{ -\item{observed}{Input to be checked. Should be a vector with the +\item{observed}{Input to be checked. Should be a numeric vector with the observed values of size n} \item{predicted}{Input to be checked. Should be nxN matrix of predictive diff --git a/man/check_input_quantile.Rd b/man/check_input_quantile.Rd index 6a7a575c8..9799aeb4e 100644 --- a/man/check_input_quantile.Rd +++ b/man/check_input_quantile.Rd @@ -7,7 +7,7 @@ check_input_quantile(observed, predicted, quantile) } \arguments{ -\item{observed}{Input to be checked. Should be a vector with the +\item{observed}{Input to be checked. Should be a numeric vector with the observed values of size n} \item{predicted}{Input to be checked. Should be nxN matrix of predictive From 4a07dcc6ecbf4d32709e60e64ed22aad878957e2 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 30 Oct 2023 17:07:04 +0100 Subject: [PATCH 12/17] Update documentation for `score()` --- R/score.R | 161 ++++++++++++++++++++------------ man/avail_forecasts.Rd | 17 +--- man/available_forecasts.Rd | 17 +--- man/binary-metrics.Rd | 7 +- man/check_data_doc_template.Rd | 3 - man/check_numeric_vector.Rd | 42 ++++++++- man/check_try.Rd | 8 +- man/get_forecast_type.Rd | 17 +--- man/get_forecast_unit.Rd | 17 +--- man/get_protected_columns.Rd | 17 +--- man/make_NA.Rd | 17 +--- man/new_scoringutils.Rd | 17 +--- man/score.Rd | 164 ++++++++++++++++++++------------- man/score_quantile.Rd | 30 ++---- man/set_forecast_unit.Rd | 17 +--- man/transform_forecasts.Rd | 17 +--- man/validate.Rd | 19 +--- man/validate_general.Rd | 17 +--- 18 files changed, 266 insertions(+), 338 deletions(-) diff --git a/R/score.R b/R/score.R index a3818c9a5..afcf7724f 100644 --- a/R/score.R +++ b/R/score.R @@ -1,60 +1,102 @@ -#' @title Evaluate forecasts -#' -#' @description This function allows automatic scoring of forecasts using a -#' range of metrics. For most users it will be the workhorse for -#' scoring forecasts as it wraps the lower level functions package functions. -#' However, these functions are also available if you wish to make use of them -#' independently. -#' -#' A range of forecasts formats are supported, including quantile-based, -#' sample-based, binary forecasts. Prior to scoring, users may wish to make use -#' of [validate()] to ensure that the input data is in a supported -#' format though this will also be run internally by [score()]. Examples for -#' each format are also provided (see the documentation for `data` below or in -#' [validate()]). -#' -#' Each format has a set of required columns (see below). Additional columns may -#' be present to indicate a grouping of forecasts. For example, we could have -#' forecasts made by different models in various locations at different time -#' points, each for several weeks into the future. It is important, that there -#' are only columns present which are relevant in order to group forecasts. -#' A combination of different columns should uniquely define the -#' *unit of a single forecast*, meaning that a single forecast is defined by the -#' values in the other columns. Adding additional unrelated columns may alter -#' results. -#' -#' To obtain a quick overview of the currently supported evaluation metrics, -#' have a look at the [metrics] data included in the package. The column -#' `metrics$Name` gives an overview of all available metric names that can be -#' computed. If interested in an unsupported metric please open a [feature -#' request](https://github.com/epiforecasts/scoringutils/issues) or consider -#' contributing a pull request. +#' @title Evaluate forecasts in a data.frame format #' -#' For additional help and examples, check out the [Getting Started -#' Vignette](https://epiforecasts.io/scoringutils/articles/scoringutils.html) -#' as well as the paper [Evaluating Forecasts with scoringutils in -#' R](https://arxiv.org/abs/2205.07090). +#' @description `score()` applies a selection of scoring metrics to a data.frame +#' of forecasts. It is the workhorse of the `scoringutils` package. +#' `score()` is a generic that dispatches to different methods depending on the +#' class of the input data. The default method is `score.default()`, which +#' validates the input, assigns as class based on the forecast type, and then +#' calls `score()` again to dispatch to the appropriate method. See below for +#' more information on how forecast types are determined. +#' +#' @details +#' **Forecast types and input format** +#' +#' Various different forecast types / forecast formats are supported. At the +#' moment, those are +#' - point forecasts +#' - binary forecasts ("soft binary classification") +#' - Probabilistic forecasts in a quantile-based format (a forecast is +#' represented as a set of predictive quantiles) +#' - Probabilistic forecasts in a sample-based format (a forecast is represented +#' as a set of predictive samples) +#' +#' Forecast types are determined based on the columns present in the input data. +#' +#' *Point forecasts* require a column `observed` of type numeric and a column +#' `predicted` of type numeric. #' -#' @param data A data.frame or data.table with the following columns: -#' - `observed` - observed values -#' - `predicted` - predictions, predictive samples or predictive quantiles -#' - `model` - name of the model or forecaster who made a prediction +#' *Binary forecasts* require a column `observed` of type factor with exactly +#' two levels and a column `predicted` of type numeric with probabilities, +#' corresponding to the probability that `observed` is equal to the second +#' factor level. See [metrics_binary()] for details. #' -#' Depending on the forecast type, one of the following columns may be required: -#' - `sample_id` - index for the predictive samples in the 'predicted' column -#' - `quantile`: quantile-level of the corresponding value in `predicted` +#' *Quantile-based forecasts* require a column `observed` of type numeric, +#' a column `predicted` of type numeric, and a column `quantile` of type numeric +#' with quantile-levels (between 0 and 1). +#' +#' *Sample-based forecasts* require a column `observed` of type numeric, +#' a column `predicted` of type numeric, and a column `sample_id` of type +#' numeric with sample indices. #' #' For more information see the vignettes and the example data -#' ([example_quantile], [example_continuous], -#' [example_integer], [example_point()], and [example_binary]). +#' ([example_quantile], [example_continuous], [example_integer], +#' [example_point()], and [example_binary]). +#' +#' **Forecast unit** +#' +#' In order to score forecasts, `scoringutils` needs to know which of the rows +#' of the data belong together and jointly form a single forecasts. This is +#' easy e.g. for point forecast, where there is one row per forecast. For +#' quantile or sample-based forecasts, however, there are multiple rows that +#' belong to single forecast. +#' +#' The *forecast unit* or *unit of a single forecast* is then described by the +#' combination of columns that uniquely identify a single forecast. +#' For example, we could have forecasts made by different models in various +#' locations at different time points, each for several weeks into the future. +#' The forecast unit could then be described as +#' `forecast_unit = c("model", "location", "forecast_date", "forecast_horizon")`. +#' `scoringutils` automatically tries to determine the unit of a single +#' forecast. It uses all existing columns for this, which means that no columns +#' must be present that are unrelated to the forecast unit. As a very simplistic +#' example, if you had an additional row, "even", that is one if the row number +#' is even and zero otherwise, then this would mess up scoring as `scoringutils` +#' then thinks that this column was relevant in defining the forecast unit. +#' +#' In order to avoid issues, we recommend using the function +#' [set_forecast_unit()] to determine the forecast unit manually. +#' The function simply drops unneeded columns, while making sure that all +#' necessary, 'protected columns' like "predicted" or "observed" are retained. #' -#' @param metrics the metrics you want to have in the output. If `NULL` (the -#' default), all available metrics will be computed. -#' @param ... additional parameters passed down to other functions. +#' **Validating inputs** #' -#' @return A data.table with unsummarised scores. There will be one score per -#' quantile or sample_id, which is usually not desired, so you should almost -#' always run [summarise_scores()] on the unsummarised scores. +#' We recommend that users validate their input prior to scoring using the +#' function [validate()] (though this will also be run internally by [score()]). +#' The function checks the input data and provides helpful information. +#' +#' +#' **Further help** +#' +#' For additional help and examples, check out the [Getting Started +#' Vignette](https://epiforecasts.io/scoringutils/articles/scoringutils.html) as +#' well as the paper [Evaluating Forecasts with scoringutils in +#' R](https://arxiv.org/abs/2205.07090). +#' +#' @param data A data.frame or data.table with predicted and observed values. +#' @param metrics A named list of scoring functions. Names will be used as +#' column names in the output. See [metrics_point()], [metrics_binary()], +#' `metrics_quantile()`, and [metrics_sample()] for more information on the +#' default metrics used. +#' @param ... additional arguments +#' +#' @return A data.table with unsummarised scores. This will generally be +#' one score per forecast (as defined by the unit of a single forecast). +#' +#' For quantile-based forecasts, one score per quantile will be returned +#' instead. This is done as scores can be computed and may be of interest +#' for individual quantiles. You can call [summarise_scores()]) on the +#' unsummarised scores to obtain one score per forecast unit for quantile-based +#' forecasts. #' #' @importFrom data.table ':=' as.data.table #' @@ -62,9 +104,8 @@ #' library(magrittr) # pipe operator #' data.table::setDTthreads(1) # only needed to avoid issues on CRAN #' -#' validate(example_quantile) -#' score(example_quantile) %>% -#' add_coverage(by = c("model", "target_type")) %>% +#' validated <- validate(example_quantile) +#' score(validated) %>% #' summarise_scores(by = c("model", "target_type")) #' #' # set forecast unit manually (to avoid issues with scoringutils trying to @@ -80,19 +121,17 @@ #' \dontrun{ #' score(example_binary) #' score(example_quantile) +#' score(example_point) #' score(example_integer) #' score(example_continuous) #' } #' -#' # score point forecasts (marked by 'NA' in the quantile column) -#' score(example_point) %>% -#' summarise_scores(by = "model", na.rm = TRUE) -#' #' @author Nikos Bosse \email{nikosbosse@@gmail.com} -#' @references Funk S, Camacho A, Kucharski AJ, Lowe R, Eggo RM, Edmunds WJ -#' (2019) Assessing the performance of real-time epidemic forecasts: A -#' case study of Ebola in the Western Area region of Sierra Leone, 2014-15. -#' PLoS Comput Biol 15(2): e1006785. \doi{10.1371/journal.pcbi.1006785} +#' @references +#' Bosse NI, Gruson H, Cori A, van Leeuwen E, Funk S, Abbott S +#' (2022) Evaluating Forecasts with scoringutils in R. +#' \doi{10.48550/arXiv.2205.07090} +#' #' @export score <- function(data, ...) { diff --git a/man/avail_forecasts.Rd b/man/avail_forecasts.Rd index 498b79bb3..57d47c5cf 100644 --- a/man/avail_forecasts.Rd +++ b/man/avail_forecasts.Rd @@ -7,22 +7,7 @@ avail_forecasts(data, by = NULL, collapse = c("quantile", "sample")) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{by}{character vector or \code{NULL} (the default) that denotes the categories over which the number of forecasts should be counted. diff --git a/man/available_forecasts.Rd b/man/available_forecasts.Rd index da64eaacc..3c214a1e3 100644 --- a/man/available_forecasts.Rd +++ b/man/available_forecasts.Rd @@ -7,22 +7,7 @@ available_forecasts(data, by = NULL, collapse = c("quantile", "sample_id")) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{by}{character vector or \code{NULL} (the default) that denotes the categories over which the number of forecasts should be counted. diff --git a/man/binary-metrics.Rd b/man/binary-metrics.Rd index 00ce3de70..165ab5edc 100644 --- a/man/binary-metrics.Rd +++ b/man/binary-metrics.Rd @@ -1,13 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/metrics-binary.R -\name{binary_metrics} -\alias{binary_metrics} +\name{brier_score} \alias{brier_score} \alias{logs_binary} \title{Metrics for Binary Outcomes} \usage{ -binary_metrics(observed, predicted) - brier_score(observed, predicted) logs_binary(observed, predicted) @@ -46,7 +43,7 @@ the probability that the outcome is equal to 1. \strong{Log score for binary outcomes} -The Log Score is the negative logarithm of the probability +The Log score is the negative logarithm of the probability assigned to the observed value. It is a proper scoring rule. Small values are better (best is zero, worst is infinity). } diff --git a/man/check_data_doc_template.Rd b/man/check_data_doc_template.Rd index 3228c423f..72eecbd87 100644 --- a/man/check_data_doc_template.Rd +++ b/man/check_data_doc_template.Rd @@ -3,9 +3,6 @@ \name{check_data_doc_template} \alias{check_data_doc_template} \title{Documentation template for various checks on a data.frame} -\usage{ -check_data_doc_template(data, columns) -} \arguments{ \item{data}{A data.frame or similar to be checked} diff --git a/man/check_numeric_vector.Rd b/man/check_numeric_vector.Rd index 7a1ec11f6..847bef940 100644 --- a/man/check_numeric_vector.Rd +++ b/man/check_numeric_vector.Rd @@ -9,11 +9,47 @@ check_numeric_vector(x, ...) \arguments{ \item{x}{input to check} -\item{...}{additional arguments to pass to \code{check_numeric()}} +\item{...}{ + Arguments passed on to \code{\link[checkmate:checkNumeric]{checkmate::check_numeric}} + \describe{ + \item{\code{lower}}{[\code{numeric(1)}]\cr +Lower value all elements of \code{x} must be greater than or equal to.} + \item{\code{upper}}{[\code{numeric(1)}]\cr +Upper value all elements of \code{x} must be lower than or equal to.} + \item{\code{finite}}{[\code{logical(1)}]\cr +Check for only finite values? Default is \code{FALSE}.} + \item{\code{any.missing}}{[\code{logical(1)}]\cr +Are vectors with missing values allowed? Default is \code{TRUE}.} + \item{\code{all.missing}}{[\code{logical(1)}]\cr +Are vectors with no non-missing values allowed? Default is \code{TRUE}. +Note that empty vectors do not have non-missing values.} + \item{\code{len}}{[\code{integer(1)}]\cr +Exact expected length of \code{x}.} + \item{\code{min.len}}{[\code{integer(1)}]\cr +Minimal length of \code{x}.} + \item{\code{max.len}}{[\code{integer(1)}]\cr +Maximal length of \code{x}.} + \item{\code{unique}}{[\code{logical(1)}]\cr +Must all values be unique? Default is \code{FALSE}.} + \item{\code{sorted}}{[\code{logical(1)}]\cr +Elements must be sorted in ascending order. Missing values are ignored.} + \item{\code{names}}{[\code{character(1)}]\cr +Check for names. See \code{\link[checkmate]{checkNamed}} for possible values. +Default is \dQuote{any} which performs no check at all. +Note that you can use \code{\link[checkmate]{checkSubset}} to check for a specific set of names.} + \item{\code{typed.missing}}{[\code{logical(1)}]\cr +If set to \code{FALSE} (default), all types of missing values (\code{NA}, \code{NA_integer_}, +\code{NA_real_}, \code{NA_character_} or \code{NA_character_}) as well as empty vectors are allowed +while type-checking atomic input. +Set to \code{TRUE} to enable strict type checking.} + \item{\code{null.ok}}{[\code{logical(1)}]\cr +If set to \code{TRUE}, \code{x} may also be \code{NULL}. +In this case only a type check of \code{x} is performed, all additional checks are disabled.} + }} } \value{ -Either TRUE if the test is successful or a string with an error -message +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ Helper function diff --git a/man/check_try.Rd b/man/check_try.Rd index 931c1d4c5..87f479f66 100644 --- a/man/check_try.Rd +++ b/man/check_try.Rd @@ -10,11 +10,13 @@ check_try(expr) \item{expr}{an expression to be evaluated} } \value{ -Returns TRUE if expression was executed successfully, otherwise -returns a string with the resulting error message +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ Tries to execute an expression. Internally, this is used to -see whether assertions fail when checking inputs +see whether assertions fail when checking inputs (i.e. to convert an +\verb{assert_*()} statement into a check). If the expression fails, the error +message is returned. If the expression succeeds, \code{TRUE} is returned. } \keyword{internal} diff --git a/man/get_forecast_type.Rd b/man/get_forecast_type.Rd index 560a24589..a923baa80 100644 --- a/man/get_forecast_type.Rd +++ b/man/get_forecast_type.Rd @@ -7,22 +7,7 @@ get_forecast_type(data) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} } \value{ Character vector of length one with either "binary", "quantile", diff --git a/man/get_forecast_unit.Rd b/man/get_forecast_unit.Rd index 4491c272a..065fe94d4 100644 --- a/man/get_forecast_unit.Rd +++ b/man/get_forecast_unit.Rd @@ -7,22 +7,7 @@ get_forecast_unit(data, check_conflict = FALSE) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{check_conflict}{Whether or not to check whether there is a conflict between a stored attribute and the inferred forecast unit. Defaults to FALSE.} diff --git a/man/get_protected_columns.Rd b/man/get_protected_columns.Rd index f171b4c22..4bbf8f6da 100644 --- a/man/get_protected_columns.Rd +++ b/man/get_protected_columns.Rd @@ -7,22 +7,7 @@ get_protected_columns(data = NULL) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} } \value{ A character vector with the names of protected columns in the data. diff --git a/man/make_NA.Rd b/man/make_NA.Rd index 66be33ce1..1b1814c0e 100644 --- a/man/make_NA.Rd +++ b/man/make_NA.Rd @@ -10,22 +10,7 @@ make_NA(data = NULL, what = c("truth", "forecast", "both"), ...) make_na(data = NULL, what = c("truth", "forecast", "both"), ...) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{what}{character vector that determines which values should be turned into \code{NA}. If \code{what = "truth"}, values in the column 'observed' will be diff --git a/man/new_scoringutils.Rd b/man/new_scoringutils.Rd index 4792675df..b2f83ff6a 100644 --- a/man/new_scoringutils.Rd +++ b/man/new_scoringutils.Rd @@ -7,22 +7,7 @@ new_scoringutils(data, classname) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{classname}{name of the class to be created} } diff --git a/man/score.Rd b/man/score.Rd index 52a8c32a9..f1e87a9bb 100644 --- a/man/score.Rd +++ b/man/score.Rd @@ -7,7 +7,7 @@ \alias{score.scoringutils_point} \alias{score.scoringutils_sample} \alias{score.scoringutils_quantile} -\title{Evaluate forecasts} +\title{Evaluate forecasts in a data.frame format} \usage{ score(data, ...) @@ -22,73 +22,113 @@ score(data, ...) \method{score}{scoringutils_quantile}(data, metrics = NULL, ...) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction +\item{data}{A data.frame or data.table with predicted and observed values.} + +\item{...}{additional arguments} + +\item{metrics}{A named list of scoring functions. Names will be used as +column names in the output. See \code{\link[=metrics_point]{metrics_point()}}, \code{\link[=metrics_binary]{metrics_binary()}}, +\code{metrics_quantile()}, and \code{\link[=metrics_sample]{metrics_sample()}} for more information on the +default metrics used.} +} +\value{ +A data.table with unsummarised scores. This will generally be +one score per forecast (as defined by the unit of a single forecast). + +For quantile-based forecasts, one score per quantile will be returned +instead. This is done as scores can be computed and may be of interest +for individual quantiles. You can call \code{\link[=summarise_scores]{summarise_scores()}}) on the +unsummarised scores to obtain one score per forecast unit for quantile-based +forecasts. } +\description{ +\code{score()} applies a selection of scoring metrics to a data.frame +of forecasts. It is the workhorse of the \code{scoringutils} package. +\code{score()} is a generic that dispatches to different methods depending on the +class of the input data. The default method is \code{score.default()}, which +validates the input, assigns as class based on the forecast type, and then +calls \code{score()} again to dispatch to the appropriate method. See below for +more information on how forecast types are determined. +} +\details{ +\strong{Forecast types and input format} -Depending on the forecast type, one of the following columns may be required: +Various different forecast types / forecast formats are supported. At the +moment, those are \itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} +\item point forecasts +\item binary forecasts ("soft binary classification") +\item Probabilistic forecasts in a quantile-based format (a forecast is +represented as a set of predictive quantiles) +\item Probabilistic forecasts in a sample-based format (a forecast is represented +as a set of predictive samples) } -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +Forecast types are determined based on the columns present in the input data. -\item{...}{additional parameters passed down to other functions.} +\emph{Point forecasts} require a column \code{observed} of type numeric and a column +\code{predicted} of type numeric. -\item{metrics}{the metrics you want to have in the output. If \code{NULL} (the -default), all available metrics will be computed.} -} -\value{ -A data.table with unsummarised scores. There will be one score per -quantile or sample_id, which is usually not desired, so you should almost -always run \code{\link[=summarise_scores]{summarise_scores()}} on the unsummarised scores. -} -\description{ -This function allows automatic scoring of forecasts using a -range of metrics. For most users it will be the workhorse for -scoring forecasts as it wraps the lower level functions package functions. -However, these functions are also available if you wish to make use of them -independently. - -A range of forecasts formats are supported, including quantile-based, -sample-based, binary forecasts. Prior to scoring, users may wish to make use -of \code{\link[=validate]{validate()}} to ensure that the input data is in a supported -format though this will also be run internally by \code{\link[=score]{score()}}. Examples for -each format are also provided (see the documentation for \code{data} below or in -\code{\link[=validate]{validate()}}). - -Each format has a set of required columns (see below). Additional columns may -be present to indicate a grouping of forecasts. For example, we could have -forecasts made by different models in various locations at different time -points, each for several weeks into the future. It is important, that there -are only columns present which are relevant in order to group forecasts. -A combination of different columns should uniquely define the -\emph{unit of a single forecast}, meaning that a single forecast is defined by the -values in the other columns. Adding additional unrelated columns may alter -results. - -To obtain a quick overview of the currently supported evaluation metrics, -have a look at the \link{metrics} data included in the package. The column -\code{metrics$Name} gives an overview of all available metric names that can be -computed. If interested in an unsupported metric please open a \href{https://github.com/epiforecasts/scoringutils/issues}{feature request} or consider -contributing a pull request. - -For additional help and examples, check out the \href{https://epiforecasts.io/scoringutils/articles/scoringutils.html}{Getting Started Vignette} -as well as the paper \href{https://arxiv.org/abs/2205.07090}{Evaluating Forecasts with scoringutils in R}. +\emph{Binary forecasts} require a column \code{observed} of type factor with exactly +two levels and a column \code{predicted} of type numeric with probabilities, +corresponding to the probability that \code{observed} is equal to the second +factor level. See \code{\link[=metrics_binary]{metrics_binary()}} for details. + +\emph{Quantile-based forecasts} require a column \code{observed} of type numeric, +a column \code{predicted} of type numeric, and a column \code{quantile} of type numeric +with quantile-levels (between 0 and 1). + +\emph{Sample-based forecasts} require a column \code{observed} of type numeric, +a column \code{predicted} of type numeric, and a column \code{sample_id} of type +numeric with sample indices. + +For more information see the vignettes and the example data +(\link{example_quantile}, \link{example_continuous}, \link{example_integer}, +\code{\link[=example_point]{example_point()}}, and \link{example_binary}). + +\strong{Forecast unit} + +In order to score forecasts, \code{scoringutils} needs to know which of the rows +of the data belong together and jointly form a single forecasts. This is +easy e.g. for point forecast, where there is one row per forecast. For +quantile or sample-based forecasts, however, there are multiple rows that +belong to single forecast. + +The \emph{forecast unit} or \emph{unit of a single forecast} is then described by the +combination of columns that uniquely identify a single forecast. +For example, we could have forecasts made by different models in various +locations at different time points, each for several weeks into the future. +The forecast unit could then be described as +\code{forecast_unit = c("model", "location", "forecast_date", "forecast_horizon")}. +\code{scoringutils} automatically tries to determine the unit of a single +forecast. It uses all existing columns for this, which means that no columns +must be present that are unrelated to the forecast unit. As a very simplistic +example, if you had an additional row, "even", that is one if the row number +is even and zero otherwise, then this would mess up scoring as \code{scoringutils} +then thinks that this column was relevant in defining the forecast unit. + +In order to avoid issues, we recommend using the function +\code{\link[=set_forecast_unit]{set_forecast_unit()}} to determine the forecast unit manually. +The function simply drops unneeded columns, while making sure that all +necessary, 'protected columns' like "predicted" or "observed" are retained. + +\strong{Validating inputs} + +We recommend that users validate their input prior to scoring using the +function \code{\link[=validate]{validate()}} (though this will also be run internally by \code{\link[=score]{score()}}). +The function checks the input data and provides helpful information. + +\strong{Further help} + +For additional help and examples, check out the \href{https://epiforecasts.io/scoringutils/articles/scoringutils.html}{Getting Started Vignette} as +well as the paper \href{https://arxiv.org/abs/2205.07090}{Evaluating Forecasts with scoringutils in R}. } \examples{ library(magrittr) # pipe operator data.table::setDTthreads(1) # only needed to avoid issues on CRAN -validate(example_quantile) -score(example_quantile) \%>\% - add_coverage(by = c("model", "target_type")) \%>\% +validated <- validate(example_quantile) +score(validated) \%>\% summarise_scores(by = c("model", "target_type")) # set forecast unit manually (to avoid issues with scoringutils trying to @@ -104,20 +144,16 @@ example_quantile \%>\% \dontrun{ score(example_binary) score(example_quantile) +score(example_point) score(example_integer) score(example_continuous) } -# score point forecasts (marked by 'NA' in the quantile column) -score(example_point) \%>\% - summarise_scores(by = "model", na.rm = TRUE) - } \references{ -Funk S, Camacho A, Kucharski AJ, Lowe R, Eggo RM, Edmunds WJ -(2019) Assessing the performance of real-time epidemic forecasts: A -case study of Ebola in the Western Area region of Sierra Leone, 2014-15. -PLoS Comput Biol 15(2): e1006785. \doi{10.1371/journal.pcbi.1006785} +Bosse NI, Gruson H, Cori A, van Leeuwen E, Funk S, Abbott S +(2022) Evaluating Forecasts with scoringutils in R. +\doi{10.48550/arXiv.2205.07090} } \author{ Nikos Bosse \email{nikosbosse@gmail.com} diff --git a/man/score_quantile.Rd b/man/score_quantile.Rd index 002eaa147..5f51f94ec 100644 --- a/man/score_quantile.Rd +++ b/man/score_quantile.Rd @@ -14,29 +14,16 @@ score_quantile( ) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{forecast_unit}{A character vector with the column names that define the unit of a single forecast, i.e. a forecast was made for a combination of the values in \code{forecast_unit}} -\item{metrics}{the metrics you want to have in the output. If \code{NULL} (the -default), all available metrics will be computed.} +\item{metrics}{A named list of scoring functions. Names will be used as +column names in the output. See \code{\link[=metrics_point]{metrics_point()}}, \code{\link[=metrics_binary]{metrics_binary()}}, +\code{metrics_quantile()}, and \code{\link[=metrics_sample]{metrics_sample()}} for more information on the +default metrics used.} \item{weigh}{if TRUE, weigh the score by alpha / 2, so it can be averaged into an interval score that, in the limit, corresponds to CRPS. Alpha is the @@ -65,10 +52,9 @@ A data.table with appropriate scores. For more information see Evaluate forecasts in a Quantile-Based Format } \references{ -Funk S, Camacho A, Kucharski AJ, Lowe R, Eggo RM, Edmunds WJ -(2019) Assessing the performance of real-time epidemic forecasts: A -case study of Ebola in the Western Area region of Sierra Leone, 2014-15. -PLoS Comput Biol 15(2): e1006785. \doi{10.1371/journal.pcbi.1006785} +Bosse NI, Gruson H, Cori A, van Leeuwen E, Funk S, Abbott S +(2022) Evaluating Forecasts with scoringutils in R. +\doi{10.48550/arXiv.2205.07090} } \author{ Nikos Bosse \email{nikosbosse@gmail.com} diff --git a/man/set_forecast_unit.Rd b/man/set_forecast_unit.Rd index b0ffd8603..0f1dcc7d3 100644 --- a/man/set_forecast_unit.Rd +++ b/man/set_forecast_unit.Rd @@ -7,22 +7,7 @@ set_forecast_unit(data, forecast_unit) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{forecast_unit}{Character vector with the names of the columns that uniquely identify a single forecast.} diff --git a/man/transform_forecasts.Rd b/man/transform_forecasts.Rd index 3bca5400b..a77043a95 100644 --- a/man/transform_forecasts.Rd +++ b/man/transform_forecasts.Rd @@ -7,22 +7,7 @@ transform_forecasts(data, fun = log_shift, append = TRUE, label = "log", ...) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} \item{fun}{A function used to transform both observed values and predictions. The default function is \code{\link[=log_shift]{log_shift()}}, a custom function that is essentially diff --git a/man/validate.Rd b/man/validate.Rd index e9d190f58..88badf49a 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -22,24 +22,9 @@ validate(data, ...) \method{validate}{scoringutils_sample}(data, ...) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} -\item{...}{additional parameters passed down to other functions.} +\item{...}{additional arguments} } \value{ Depending on the forecast type, an object of class diff --git a/man/validate_general.Rd b/man/validate_general.Rd index b12aced3d..548fa0322 100644 --- a/man/validate_general.Rd +++ b/man/validate_general.Rd @@ -7,22 +7,7 @@ validate_general(data) } \arguments{ -\item{data}{A data.frame or data.table with the following columns: -\itemize{ -\item \code{observed} - observed values -\item \code{predicted} - predictions, predictive samples or predictive quantiles -\item \code{model} - name of the model or forecaster who made a prediction -} - -Depending on the forecast type, one of the following columns may be required: -\itemize{ -\item \code{sample_id} - index for the predictive samples in the 'predicted' column -\item \code{quantile}: quantile-level of the corresponding value in \code{predicted} -} - -For more information see the vignettes and the example data -(\link{example_quantile}, \link{example_continuous}, -\link{example_integer}, \code{\link[=example_point]{example_point()}}, and \link{example_binary}).} +\item{data}{A data.frame or data.table with predicted and observed values.} } \value{ returns the input, with a few new attributes that hold additional From b12f43b93f95f5f741a092ce5465d4202495daa5 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 30 Oct 2023 17:33:57 +0100 Subject: [PATCH 13/17] more "simplifications" to the documentation --- R/check-input-helpers.R | 12 +++--- R/check-inputs-scoring-functions.R | 38 +++++++++---------- R/documentation-templates.R | 21 +++++++++- R/metrics-binary.R | 8 ++-- R/score.R | 2 +- man/assert_input_binary.Rd | 6 +-- man/assert_input_point.Rd | 6 +-- man/assert_input_quantile.Rd | 9 ++--- man/assert_input_sample.Rd | 6 +-- man/check_input_binary.Rd | 6 +-- man/check_input_point.Rd | 6 +-- man/check_input_quantile.Rd | 9 ++--- man/check_input_sample.Rd | 6 +-- man/document_assert_functions.Rd | 12 ++++++ man/document_check_functions.Rd | 12 ++++++ man/document_score_data.Rd | 12 ++++++ man/score.Rd | 2 +- ...metrics.Rd => scoring-functions-binary.Rd} | 5 ++- 18 files changed, 114 insertions(+), 64 deletions(-) create mode 100644 man/document_assert_functions.Rd create mode 100644 man/document_check_functions.Rd create mode 100644 man/document_score_data.Rd rename man/{binary-metrics.Rd => scoring-functions-binary.Rd} (96%) diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index e172fe0f4..fce117640 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -2,10 +2,9 @@ #' #' @description Helper function #' @param x input to check -#' @param ... additional arguments to pass to `check_numeric()` +#' @inheritDotParams checkmate::check_numeric #' @importFrom checkmate check_atomic_vector check_numeric -#' @return Either TRUE if the test is successful or a string with an error -#' message +#' @inherit document_check_functions return #' @keywords internal check_numeric_vector <- function(x, ...) { # check functions must return TRUE on success @@ -53,11 +52,12 @@ check_quantiles <- function(quantiles, name = "quantiles", range = c(0, 1)) { #' @title Helper function to convert assert statements into checks #' #' @description Tries to execute an expression. Internally, this is used to -#' see whether assertions fail when checking inputs +#' see whether assertions fail when checking inputs (i.e. to convert an +#' `assert_*()` statement into a check). If the expression fails, the error +#' message is returned. If the expression succeeds, `TRUE` is returned. #' @param expr an expression to be evaluated #' @importFrom checkmate assert assert_numeric check_matrix -#' @return Returns TRUE if expression was executed successfully, otherwise -#' returns a string with the resulting error message +#' @inherit document_check_functions return #' @keywords internal check_try <- function(expr) { diff --git a/R/check-inputs-scoring-functions.R b/R/check-inputs-scoring-functions.R index e640c4c2d..ca41e932a 100644 --- a/R/check-inputs-scoring-functions.R +++ b/R/check-inputs-scoring-functions.R @@ -1,6 +1,6 @@ #' @title Assert that inputs are correct for sample-based forecast -#' @description Helper function to assert whether the input is suitable for -#' scoring. +#' @description Function assesses whether the inputs correspond to the +#' requirements for scoring sample-based forecasts. #' @param observed Input to be checked. Should be a numeric vector with the #' observed values of size n #' @param predicted Input to be checked. Should be a numeric nxN matrix of @@ -9,8 +9,7 @@ #' If `observed` is just a single number, then predicted values can just be a #' vector of size N. #' @importFrom checkmate assert assert_numeric check_matrix -#' @returns Returns NULL invisibly if the check was successful and throws an -#' error otherwise. +#' @inherit document_assert_functions return #' @keywords check-inputs assert_input_sample <- function(observed, predicted) { assert_numeric(observed, min.len = 1) @@ -29,11 +28,8 @@ assert_input_sample <- function(observed, predicted) { } #' @title Check that inputs are correct for sample-based forecast -#' @description Helper function to check whether the input is suitable for -#' scoring. -#' @inherit assert_input_sample params -#' @return Returns TRUE if the check was successful and a string with the -#' error message otherwise +#' @inherit assert_input_sample params description +#' @inherit document_check_functions return #' @keywords check-inputs check_input_sample <- function(observed, predicted) { result <- check_try(assert_input_sample(observed, predicted)) @@ -42,7 +38,8 @@ check_input_sample <- function(observed, predicted) { #' @title Assert that inputs are correct for quantile-based forecast -#' @inheritParams assert_input_sample +#' @description Function assesses whether the inputs correspond to the +#' requirements for scoring quantile-based forecasts. #' @param predicted Input to be checked. Should be nxN matrix of predictive #' quantiles, n (number of rows) being the number of data points and N #' (number of columns) the number of quantiles per forecast. @@ -52,7 +49,7 @@ check_input_sample <- function(observed, predicted) { #' denotes the quantile levels corresponding to the columns of the prediction #' matrix. #' @importFrom checkmate assert assert_numeric check_matrix -#' @inherit assert_input_sample return description +#' @inherit document_assert_functions return #' @keywords internal assert_input_quantile <- function(observed, predicted, quantile) { assert_numeric(observed, min.len = 1) @@ -77,7 +74,7 @@ assert_input_quantile <- function(observed, predicted, quantile) { } #' @title Check that inputs are correct for quantile-based forecast -#' @inheritParams assert_input_quantile +#' @inherit assert_input_quantile params description #' @inherit check_input_sample return description #' @keywords check-inputs check_input_quantile <- function(observed, predicted, quantile) { @@ -87,6 +84,8 @@ check_input_quantile <- function(observed, predicted, quantile) { #' @title Assert that inputs are correct for binary forecast +#' @description Function assesses whether the inputs correspond to the +#' requirements for scoring binary forecasts. #' @param observed Input to be checked. Should be a factor of length n with #' exactly two levels, holding the observed values. #' The highest factor level is assumed to be the reference level. This means @@ -97,7 +96,7 @@ check_input_quantile <- function(observed, predicted, quantile) { #' the corresponding value in `observed` will be equal to the highest #' available factor level. #' @importFrom checkmate assert assert_factor -#' @inherit assert_input_sample return description +#' @inherit document_assert_functions return #' @keywords check-inputs assert_input_binary <- function(observed, predicted) { if (length(observed) != length(predicted)) { @@ -113,9 +112,8 @@ assert_input_binary <- function(observed, predicted) { } #' @title Check that inputs are correct for binary forecast -#' -#' @inheritParams assert_input_binary -#' @inherit check_input_sample return description +#' @inherit assert_input_binary params description +#' @inherit document_check_functions return #' @keywords check-inputs check_input_binary <- function(observed, predicted) { result <- check_try(assert_input_binary(observed, predicted)) @@ -124,11 +122,13 @@ check_input_binary <- function(observed, predicted) { #' @title Assert that inputs are correct for point forecast +#' @description Function assesses whether the inputs correspond to the +#' requirements for scoring point forecasts. #' @param observed Input to be checked. Should be a numeric vector with the #' observed values of size n #' @param predicted Input to be checked. Should be a numeric vector with the #' predicted values of size n -#' @inherit assert_input_sample return description +#' @inherit document_assert_functions return #' @keywords check-inputs assert_input_point <- function(observed, predicted) { assert(check_numeric_vector(observed, min.len = 1)) @@ -141,8 +141,8 @@ assert_input_point <- function(observed, predicted) { } #' @title Check that inputs are correct for point forecast -#' @inheritParams assert_input_point -#' @inherit check_input_sample return description +#' @inherit assert_input_point params description +#' @inherit document_check_functions return #' @keywords check-inputs check_input_point <- function(observed, predicted) { result <- check_try(assert_input_point(observed, predicted)) diff --git a/R/documentation-templates.R b/R/documentation-templates.R index 627bf831d..3dbb52788 100644 --- a/R/documentation-templates.R +++ b/R/documentation-templates.R @@ -1,4 +1,23 @@ #' Documentation template for various checks on a data.frame #' @param data A data.frame or similar to be checked #' @param columns A character vector of column names to check -check_data_doc_template <- function(data, columns) NULL +#' @name check_data_doc_template +NULL + +#' Documentation template for check functions +#' @return Returns TRUE if the check was successful and a string with an +#' error message otherwise +#' @name document_check_functions +NULL + +#' Documentation template for check functions +#' @returns Returns NULL invisibly if the assertion was successful and throws an +#' error otherwise. +#' @name document_assert_functions +NULL + +#' Documentation template for scoring input data +#' @param data A data frame or data.table of forecasts following the +#' specifications detailed in [score()]. +#' @name document_score_data +NULL diff --git a/R/metrics-binary.R b/R/metrics-binary.R index 6d9d1b9a7..4a0abed49 100644 --- a/R/metrics-binary.R +++ b/R/metrics-binary.R @@ -34,8 +34,8 @@ #' #' brier_score(observed, predicted) #' logs_binary(observed, predicted) -#' @rdname binary-metrics -binary_metrics <- function(observed, predicted) {} +#' @name scoring-functions-binary +NULL #' @description @@ -56,7 +56,7 @@ binary_metrics <- function(observed, predicted) {} #' @return A numeric vector of size n with the Brier scores #' @keywords metric #' @export -#' @rdname binary-metrics +#' @rdname scoring-functions-binary brier_score <- function(observed, predicted) { assert_input_binary(observed, predicted) @@ -79,7 +79,7 @@ brier_score <- function(observed, predicted) { #' @importFrom methods hasArg #' @export #' @keywords metric -#' @rdname binary-metrics +#' @rdname scoring-functions-binary logs_binary <- function(observed, predicted) { assert_input_binary(observed, predicted) observed <- as.numeric(observed) - 1 diff --git a/R/score.R b/R/score.R index afcf7724f..4e235ade3 100644 --- a/R/score.R +++ b/R/score.R @@ -28,7 +28,7 @@ #' *Binary forecasts* require a column `observed` of type factor with exactly #' two levels and a column `predicted` of type numeric with probabilities, #' corresponding to the probability that `observed` is equal to the second -#' factor level. See [metrics_binary()] for details. +#' factor level. See details [here][brier_score()] for more information. #' #' *Quantile-based forecasts* require a column `observed` of type numeric, #' a column `predicted` of type numeric, and a column `quantile` of type numeric diff --git a/man/assert_input_binary.Rd b/man/assert_input_binary.Rd index 867df8380..4ca8f7883 100644 --- a/man/assert_input_binary.Rd +++ b/man/assert_input_binary.Rd @@ -19,11 +19,11 @@ the corresponding value in \code{observed} will be equal to the highest available factor level.} } \value{ -Returns NULL invisibly if the check was successful and throws an +Returns NULL invisibly if the assertion was successful and throws an error otherwise. } \description{ -Helper function to assert whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring binary forecasts. } \keyword{check-inputs} diff --git a/man/assert_input_point.Rd b/man/assert_input_point.Rd index 397a6ae0f..f2f9434a9 100644 --- a/man/assert_input_point.Rd +++ b/man/assert_input_point.Rd @@ -14,11 +14,11 @@ observed values of size n} predicted values of size n} } \value{ -Returns NULL invisibly if the check was successful and throws an +Returns NULL invisibly if the assertion was successful and throws an error otherwise. } \description{ -Helper function to assert whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring point forecasts. } \keyword{check-inputs} diff --git a/man/assert_input_quantile.Rd b/man/assert_input_quantile.Rd index b27d9a9b4..9a0de05d5 100644 --- a/man/assert_input_quantile.Rd +++ b/man/assert_input_quantile.Rd @@ -7,9 +7,6 @@ assert_input_quantile(observed, predicted, quantile) } \arguments{ -\item{observed}{Input to be checked. Should be a numeric vector with the -observed values of size n} - \item{predicted}{Input to be checked. Should be nxN matrix of predictive quantiles, n (number of rows) being the number of data points and N (number of columns) the number of quantiles per forecast. @@ -21,11 +18,11 @@ denotes the quantile levels corresponding to the columns of the prediction matrix.} } \value{ -Returns NULL invisibly if the check was successful and throws an +Returns NULL invisibly if the assertion was successful and throws an error otherwise. } \description{ -Helper function to assert whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring quantile-based forecasts. } \keyword{internal} diff --git a/man/assert_input_sample.Rd b/man/assert_input_sample.Rd index 556ebaea1..027899adf 100644 --- a/man/assert_input_sample.Rd +++ b/man/assert_input_sample.Rd @@ -17,11 +17,11 @@ If \code{observed} is just a single number, then predicted values can just be a vector of size N.} } \value{ -Returns NULL invisibly if the check was successful and throws an +Returns NULL invisibly if the assertion was successful and throws an error otherwise. } \description{ -Helper function to assert whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring sample-based forecasts. } \keyword{check-inputs} diff --git a/man/check_input_binary.Rd b/man/check_input_binary.Rd index 2120af24d..5b206f35b 100644 --- a/man/check_input_binary.Rd +++ b/man/check_input_binary.Rd @@ -19,11 +19,11 @@ the corresponding value in \code{observed} will be equal to the highest available factor level.} } \value{ -Returns TRUE if the check was successful and a string with the +Returns TRUE if the check was successful and a string with an error message otherwise } \description{ -Helper function to check whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring binary forecasts. } \keyword{check-inputs} diff --git a/man/check_input_point.Rd b/man/check_input_point.Rd index 5dc0835e0..060b785b6 100644 --- a/man/check_input_point.Rd +++ b/man/check_input_point.Rd @@ -14,11 +14,11 @@ observed values of size n} predicted values of size n} } \value{ -Returns TRUE if the check was successful and a string with the +Returns TRUE if the check was successful and a string with an error message otherwise } \description{ -Helper function to check whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring point forecasts. } \keyword{check-inputs} diff --git a/man/check_input_quantile.Rd b/man/check_input_quantile.Rd index 9799aeb4e..bcce6845a 100644 --- a/man/check_input_quantile.Rd +++ b/man/check_input_quantile.Rd @@ -7,9 +7,6 @@ check_input_quantile(observed, predicted, quantile) } \arguments{ -\item{observed}{Input to be checked. Should be a numeric vector with the -observed values of size n} - \item{predicted}{Input to be checked. Should be nxN matrix of predictive quantiles, n (number of rows) being the number of data points and N (number of columns) the number of quantiles per forecast. @@ -21,11 +18,11 @@ denotes the quantile levels corresponding to the columns of the prediction matrix.} } \value{ -Returns TRUE if the check was successful and a string with the +Returns TRUE if the check was successful and a string with an error message otherwise } \description{ -Helper function to check whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring quantile-based forecasts. } \keyword{check-inputs} diff --git a/man/check_input_sample.Rd b/man/check_input_sample.Rd index 92260edc2..607bebb5f 100644 --- a/man/check_input_sample.Rd +++ b/man/check_input_sample.Rd @@ -17,11 +17,11 @@ If \code{observed} is just a single number, then predicted values can just be a vector of size N.} } \value{ -Returns TRUE if the check was successful and a string with the +Returns TRUE if the check was successful and a string with an error message otherwise } \description{ -Helper function to check whether the input is suitable for -scoring. +Function assesses whether the inputs correspond to the +requirements for scoring sample-based forecasts. } \keyword{check-inputs} diff --git a/man/document_assert_functions.Rd b/man/document_assert_functions.Rd new file mode 100644 index 000000000..ee0dbc967 --- /dev/null +++ b/man/document_assert_functions.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/documentation-templates.R +\name{document_assert_functions} +\alias{document_assert_functions} +\title{Documentation template for check functions} +\value{ +Returns NULL invisibly if the assertion was successful and throws an +error otherwise. +} +\description{ +Documentation template for check functions +} diff --git a/man/document_check_functions.Rd b/man/document_check_functions.Rd new file mode 100644 index 000000000..5740193ec --- /dev/null +++ b/man/document_check_functions.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/documentation-templates.R +\name{document_check_functions} +\alias{document_check_functions} +\title{Documentation template for check functions} +\value{ +Returns TRUE if the check was successful and a string with an +error message otherwise +} +\description{ +Documentation template for check functions +} diff --git a/man/document_score_data.Rd b/man/document_score_data.Rd new file mode 100644 index 000000000..f0194697b --- /dev/null +++ b/man/document_score_data.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/documentation-templates.R +\name{document_score_data} +\alias{document_score_data} +\title{Documentation template for scoring input data} +\arguments{ +\item{data}{A data frame or data.table of forecasts following the +specifications detailed in \code{\link[=score]{score()}}.} +} +\description{ +Documentation template for scoring input data +} diff --git a/man/score.Rd b/man/score.Rd index f1e87a9bb..bf239ba7e 100644 --- a/man/score.Rd +++ b/man/score.Rd @@ -72,7 +72,7 @@ Forecast types are determined based on the columns present in the input data. \emph{Binary forecasts} require a column \code{observed} of type factor with exactly two levels and a column \code{predicted} of type numeric with probabilities, corresponding to the probability that \code{observed} is equal to the second -factor level. See \code{\link[=metrics_binary]{metrics_binary()}} for details. +factor level. See details \link[=brier_score]{here} for more information. \emph{Quantile-based forecasts} require a column \code{observed} of type numeric, a column \code{predicted} of type numeric, and a column \code{quantile} of type numeric diff --git a/man/binary-metrics.Rd b/man/scoring-functions-binary.Rd similarity index 96% rename from man/binary-metrics.Rd rename to man/scoring-functions-binary.Rd index 165ab5edc..9a06018a1 100644 --- a/man/binary-metrics.Rd +++ b/man/scoring-functions-binary.Rd @@ -1,6 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/metrics-binary.R -\name{brier_score} +\name{scoring-functions-binary} +\alias{scoring-functions-binary} \alias{brier_score} \alias{logs_binary} \title{Metrics for Binary Outcomes} @@ -43,7 +44,7 @@ the probability that the outcome is equal to 1. \strong{Log score for binary outcomes} -The Log score is the negative logarithm of the probability +The Log Score is the negative logarithm of the probability assigned to the observed value. It is a proper scoring rule. Small values are better (best is zero, worst is infinity). } From 49766f59cc25a2f468910eb9ddf07998e0b24247 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 30 Oct 2023 17:44:56 +0100 Subject: [PATCH 14/17] Rename `check_not_null()` to `assert_not_null()` and `check_equal_length()` to `assert_equal_lenght()` following their behaviour --- R/check-input-helpers.R | 13 +++++-------- R/metrics-range.R | 4 ++-- R/pit.R | 4 ++-- R/plot.R | 2 +- ...check_equal_length.Rd => assert_equal_length.Rd} | 12 ++++++------ man/{check_not_null.Rd => assert_not_null.Rd} | 6 +++--- man/document_score_data.Rd | 4 +++- tests/testthat/test-input-check-helpers.R | 4 ++-- 8 files changed, 24 insertions(+), 25 deletions(-) rename man/{check_equal_length.Rd => assert_equal_length.Rd} (61%) rename man/{check_not_null.Rd => assert_not_null.Rd} (88%) diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index fce117640..061eb9493 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -37,7 +37,6 @@ check_numeric_vector <- function(x, ...) { #' @return None. Function errors if quantiles are invalid. #' #' @keywords internal - check_quantiles <- function(quantiles, name = "quantiles", range = c(0, 1)) { if (any(quantiles < range[1]) || any(quantiles > range[2])) { stop(name, " must be between ", range[1], " and ", range[2]) @@ -59,7 +58,6 @@ check_quantiles <- function(quantiles, name = "quantiles", range = c(0, 1)) { #' @importFrom checkmate assert assert_numeric check_matrix #' @inherit document_check_functions return #' @keywords internal - check_try <- function(expr) { result <- try(expr, silent = TRUE) if (is.null(result)) { @@ -77,11 +75,12 @@ check_try <- function(expr) { #' variable and the function call where the variable is missing. This function #' is a helper function that should only be called within other functions #' @param ... The variables to check +#' @inherit document_assert_functions return #' @return The function returns `NULL`, but throws an error if the variable is #' missing. #' #' @keywords internal -check_not_null <- function(...) { +assert_not_null <- function(...) { vars <- list(...) varnames <- names(vars) @@ -109,14 +108,12 @@ check_not_null <- function(...) { #' @param one_allowed logical, allow arguments of length one that can be #' recycled #' @param call_levels_up How many levels to go up when including the function -#' call in the error message. This is useful when calling `check_equal_length()` +#' call in the error message. This is useful when calling `assert_equal_length()` #' within another checking function. -#' -#' @return The function returns `NULL`, but throws an error if variable lengths -#' differ +#' @inherit document_assert_functions return #' #' @keywords internal -check_equal_length <- function(..., +assert_equal_length <- function(..., one_allowed = TRUE, call_levels_up = 2) { vars <- list(...) diff --git a/R/metrics-range.R b/R/metrics-range.R index d638884d3..fe8f54cab 100644 --- a/R/metrics-range.R +++ b/R/metrics-range.R @@ -107,11 +107,11 @@ interval_score <- function(observed, "need all arguments 'observed', 'lower', 'upper' and 'interval_range' in function 'interval_score()'" # nolint ) } - check_not_null( + assert_not_null( observed = observed, lower = lower, upper = upper, interval_range = interval_range ) - check_equal_length(observed, lower, interval_range, upper) + assert_equal_length(observed, lower, interval_range, upper) if (any(interval_range < 0, na.rm = TRUE)) { stop("interval ranges must be positive") diff --git a/R/pit.R b/R/pit.R index fccc8f088..2e00e4b90 100644 --- a/R/pit.R +++ b/R/pit.R @@ -89,11 +89,11 @@ pit_sample <- function(observed, # error handling-------------------------------------------------------------- # check al arguments are provided - # this could be integrated into check_not_null + # this could be integrated into assert_not_null if (missing("observed") || missing("predicted")) { stop("`observed` or `predicted` missing in function 'pit_sample()'") } - check_not_null(observed = observed, predicted = predicted) + assert_not_null(observed = observed, predicted = predicted) # check if there is more than one observation n <- length(observed) diff --git a/R/plot.R b/R/plot.R index 0a1366906..73cef10cf 100644 --- a/R/plot.R +++ b/R/plot.R @@ -540,7 +540,7 @@ make_NA <- function(data = NULL, what = c("truth", "forecast", "both"), ...) { - check_not_null(data = data) + assert_not_null(data = data) data <- data.table::copy(data) what <- match.arg(what) diff --git a/man/check_equal_length.Rd b/man/assert_equal_length.Rd similarity index 61% rename from man/check_equal_length.Rd rename to man/assert_equal_length.Rd index aebeacabd..befa469f3 100644 --- a/man/check_equal_length.Rd +++ b/man/assert_equal_length.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/check-input-helpers.R -\name{check_equal_length} -\alias{check_equal_length} +\name{assert_equal_length} +\alias{assert_equal_length} \title{Check Length} \usage{ -check_equal_length(..., one_allowed = TRUE, call_levels_up = 2) +assert_equal_length(..., one_allowed = TRUE, call_levels_up = 2) } \arguments{ \item{...}{The variables to check} @@ -13,12 +13,12 @@ check_equal_length(..., one_allowed = TRUE, call_levels_up = 2) recycled} \item{call_levels_up}{How many levels to go up when including the function -call in the error message. This is useful when calling \code{check_equal_length()} +call in the error message. This is useful when calling \code{assert_equal_length()} within another checking function.} } \value{ -The function returns \code{NULL}, but throws an error if variable lengths -differ +Returns NULL invisibly if the assertion was successful and throws an +error otherwise. } \description{ Check whether variables all have the same length diff --git a/man/check_not_null.Rd b/man/assert_not_null.Rd similarity index 88% rename from man/check_not_null.Rd rename to man/assert_not_null.Rd index 149e90b8a..276615941 100644 --- a/man/check_not_null.Rd +++ b/man/assert_not_null.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/check-input-helpers.R -\name{check_not_null} -\alias{check_not_null} +\name{assert_not_null} +\alias{assert_not_null} \title{Check Variable is not NULL} \usage{ -check_not_null(...) +assert_not_null(...) } \arguments{ \item{...}{The variables to check} diff --git a/man/document_score_data.Rd b/man/document_score_data.Rd index f0194697b..9e30190d3 100644 --- a/man/document_score_data.Rd +++ b/man/document_score_data.Rd @@ -4,8 +4,10 @@ \alias{document_score_data} \title{Documentation template for scoring input data} \arguments{ -\item{data}{A data frame or data.table of forecasts following the +\item{data}{A data frame (or similar) of forecasts following the specifications detailed in \code{\link[=score]{score()}}.} + +\item{scores}{A data.table of scores as produced by \code{\link[=score]{score()}}.} } \description{ Documentation template for scoring input data diff --git a/tests/testthat/test-input-check-helpers.R b/tests/testthat/test-input-check-helpers.R index 8461d0e2c..d3dc8cd2d 100644 --- a/tests/testthat/test-input-check-helpers.R +++ b/tests/testthat/test-input-check-helpers.R @@ -11,9 +11,9 @@ test_that("Check equal length works if all arguments have length 1", { }) -test_that("Check_not_null works", { +test_that("assert_not_null works", { test_function <- function(argument = NULL) { - scoringutils:::check_not_null("argument" = argument) + scoringutils:::assert_not_null("argument" = argument) return(paste("Input:", argument)) } out <- test_function("works") From 8ba965f6f4115c50f2584bb3ba442f28bcb63748 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 30 Oct 2023 18:13:29 +0100 Subject: [PATCH 15/17] more documentation updates. yep yep yep! --- R/check-input-helpers.R | 73 +++++++++++++++++++----------- R/check-inputs-scoring-functions.R | 2 + R/documentation-templates.R | 14 +++--- R/get_-functions.R | 8 ++-- man/assert_equal_length.Rd | 2 +- man/assert_input_quantile.Rd | 3 ++ man/assure_model_column.Rd | 16 +++++++ man/check_attribute_conflict.Rd | 27 +++++++++++ man/check_columns_present.Rd | 8 ++-- man/check_data_columns.Rd | 8 ++-- man/check_data_doc_template.Rd | 13 ------ man/check_duplicates.Rd | 4 +- man/check_has_attribute.Rd | 4 +- man/check_input_quantile.Rd | 3 ++ man/check_no_NA_present.Rd | 8 ++-- man/check_number_per_forecast.Rd | 8 ++-- man/document_check_functions.Rd | 5 ++ man/document_test_functions.Rd | 11 +++++ man/test_columns_not_present.Rd | 4 +- man/test_columns_present.Rd | 4 +- 20 files changed, 156 insertions(+), 69 deletions(-) create mode 100644 man/assure_model_column.Rd create mode 100644 man/check_attribute_conflict.Rd delete mode 100644 man/check_data_doc_template.Rd create mode 100644 man/document_test_functions.Rd diff --git a/R/check-input-helpers.R b/R/check-input-helpers.R index 061eb9493..37c8c8a22 100644 --- a/R/check-input-helpers.R +++ b/R/check-input-helpers.R @@ -100,7 +100,7 @@ assert_not_null <- function(...) { } -#' @title Check Length +#' @title Check Length of Two Vectors is Equal #' #' @description #' Check whether variables all have the same length @@ -150,6 +150,18 @@ assert_equal_length <- function(..., } +#' @title Check Whether There Is a Conflict Between Data and Attributes +#' @description +#' Check whether there is a conflict between a stored attribute and the +#' same value as inferred from the data. For example, this could be if +#' an attribute `forecast_unit` is stored, but is different from the +#' `forecast_unit` inferred from the data. The check is successful if +#' the stored and the inferred value are the same. +#' @param object The object to check +#' @param attribute The name of the attribute to check +#' @param expected The expected value of the attribute +#' @inherit document_check_functions return +#' @keywords internal check_attribute_conflict <- function(object, attribute, expected) { existing <- attr(object, attribute) if (is.vector(existing) && is.vector(expected)) { @@ -170,6 +182,14 @@ check_attribute_conflict <- function(object, attribute, expected) { return(TRUE) } + +#' @title Assure that Data Has a `model` Column +#' +#' @description +#' Check whether the data.table has a column called `model`. +#' If not, a column called `model` is added with the value `Unspecified model`. +#' @return The data.table with a column called `model` +#' @keywords internal assure_model_column <- function(data) { if (!("model" %in% colnames(data))) { message( @@ -183,11 +203,11 @@ assure_model_column <- function(data) { #' Check that all forecasts have the same number of quantiles or samples -#' @inheritParams check_data_doc_template +#' @description Function checks the number of quantiles or samples per forecast. +#' If the number of quantiles or samples is the same for all forecasts, it +#' returns TRUE and a string with an error message otherwise. #' @param forecast_unit Character vector denoting the unit of a single forecast. -#' @return Returns an string with a message if any forecasts have differing -#' numbers of samples or quantiles, otherwise returns TRUE -#' +#' @inherit document_check_functions params return #' @keywords internal check_number_per_forecast <- function(data, forecast_unit) { # check whether there are the same number of quantiles, samples -------------- @@ -209,13 +229,11 @@ check_number_per_forecast <- function(data, forecast_unit) { } - - - #' Check columns in data.frame don't have NA values -#' @inheritParams check_columns_present -#' @return Returns an string with a message if any of the column names -#' have NA values, otherwise returns TRUE +#' @description Function checks whether any of the columns in a data.frame, +#' as specified in `columns`, have NA values. If so, it returns a string with +#' an error message, otherwise it returns TRUE. +#' @inherit document_check_functions params return #' #' @keywords internal check_no_NA_present <- function(data, columns) { @@ -247,9 +265,7 @@ diagnose <- function(data) { #' @description #' Runs [get_duplicate_forecasts()] and returns a message if an issue is encountered #' @inheritParams get_duplicate_forecasts -#' @return Returns an string with an error message if an issue is found, -#' otherwise returns TRUE -#' +#' @inherit document_check_functions return #' @keywords internal check_duplicates <- function(data, forecast_unit = NULL) { check_duplicates <- get_duplicate_forecasts(data, forecast_unit = forecast_unit) @@ -287,9 +303,11 @@ check_duplicates <- function(data, forecast_unit = NULL) { #' Check column names are present in a data.frame -#' @inheritParams check_data_doc_template -#' @return Returns string with a message with the first issue encountered if -#' any of the column names are not in data, otherwise returns TRUE +#' @description +#' The functions loops over the column names and checks whether they are +#' present. If an issue is encountered, the function immediately stops +#' and returns a message with the first issue encountered. +#' @inherit document_check_functions params return #' @importFrom checkmate assert_character #' @keywords check-inputs check_columns_present <- function(data, columns) { @@ -308,7 +326,10 @@ check_columns_present <- function(data, columns) { } #' Test whether all column names are present in a data.frame -#' @inheritParams check_data_doc_template +#' @description The function checks whether all column names are present. If +#' one or more columns are missing, the function returns FALSE. If all columns +#' are present, the function returns TRUE. +#' @inheritParams document_check_functions #' @return Returns TRUE if all columns are present and FALSE otherwise #' @keywords internal test_columns_present <- function(data, columns) { @@ -317,7 +338,10 @@ test_columns_present <- function(data, columns) { } #' Test whether column names are NOT present in a data.frame -#' @inheritParams check_data_doc_template +#' @description The function checks whether all column names are NOT present. +#' If none of the columns are present, the function returns TRUE. If one or +#' more columns are present, the function returns FALSE. +#' @inheritParams document_check_functions #' @return Returns TRUE if none of the columns are present and FALSE otherwise #' @keywords internal test_columns_not_present <- function(data, columns) { @@ -330,12 +354,10 @@ test_columns_not_present <- function(data, columns) { #' Check whether data is data.frame with correct columns #' @description Checks whether data is a data.frame, whether columns -#' "observed" and "predicted" are presents -#' and checks that only one of "quantile" and "sample_id" is present. -#' @inheritParams check_data_doc_template +#' "observed" and "predicted" are present, and checks that only one of +#' "quantile" and "sample_id" is present. +#' @inherit document_check_functions params return #' @importFrom checkmate check_data_frame -#' @return Returns TRUE if basic requirements are satisfied and a string with -#' an error message otherwise #' @keywords check-inputs check_data_columns <- function(data) { is_data <- check_data_frame(data, min.rows = 1) @@ -360,8 +382,7 @@ check_data_columns <- function(data) { #' @description Checks whether an object has an attribute #' @param object An object to be checked #' @param attribute name of an attribute to be checked -#' @return Returns TRUE if attribute is there and an error message as -#' a string otherwise +#' @inherit document_check_functions return #' @keywords check-inputs check_has_attribute <- function(object, attribute) { if (is.null(attr(object, attribute))) { diff --git a/R/check-inputs-scoring-functions.R b/R/check-inputs-scoring-functions.R index ca41e932a..350a3af4f 100644 --- a/R/check-inputs-scoring-functions.R +++ b/R/check-inputs-scoring-functions.R @@ -40,6 +40,8 @@ check_input_sample <- function(observed, predicted) { #' @title Assert that inputs are correct for quantile-based forecast #' @description Function assesses whether the inputs correspond to the #' requirements for scoring quantile-based forecasts. +#' @param observed Input to be checked. Should be a numeric vector with the +#' observed values of size n #' @param predicted Input to be checked. Should be nxN matrix of predictive #' quantiles, n (number of rows) being the number of data points and N #' (number of columns) the number of quantiles per forecast. diff --git a/R/documentation-templates.R b/R/documentation-templates.R index 3dbb52788..087c77d4b 100644 --- a/R/documentation-templates.R +++ b/R/documentation-templates.R @@ -1,10 +1,6 @@ -#' Documentation template for various checks on a data.frame +#' Documentation template for check functions #' @param data A data.frame or similar to be checked #' @param columns A character vector of column names to check -#' @name check_data_doc_template -NULL - -#' Documentation template for check functions #' @return Returns TRUE if the check was successful and a string with an #' error message otherwise #' @name document_check_functions @@ -16,8 +12,14 @@ NULL #' @name document_assert_functions NULL +#' Documentation template for test functions +#' @returns Returns TRUE if the check was successful and FALSE otherwise +#' @name document_test_functions +NULL + #' Documentation template for scoring input data -#' @param data A data frame or data.table of forecasts following the +#' @param data A data frame (or similar) of forecasts following the #' specifications detailed in [score()]. +#' @param scores A data.table of scores as produced by [score()]. #' @name document_score_data NULL diff --git a/R/get_-functions.R b/R/get_-functions.R index 07857222e..f9b88a971 100644 --- a/R/get_-functions.R +++ b/R/get_-functions.R @@ -37,7 +37,7 @@ get_forecast_type <- function(data) { #' Test whether data could be a binary forecast. #' @description Checks type of the necessary columns. -#' @inheritParams check_data_doc_template +#' @inheritParams document_check_functions #' @importFrom checkmate test_factor test_numeric #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal @@ -49,7 +49,7 @@ test_forecast_type_is_binary <- function(data) { #' Test whether data could be a sample-based forecast. #' @description Checks type of the necessary columns. -#' @inheritParams check_data_doc_template +#' @inheritParams document_check_functions #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal test_forecast_type_is_sample <- function(data) { @@ -61,7 +61,7 @@ test_forecast_type_is_sample <- function(data) { #' Test whether data could be a point forecast. #' @description Checks type of the necessary columns. -#' @inheritParams check_data_doc_template +#' @inheritParams document_check_functions #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal test_forecast_type_is_point <- function(data) { @@ -73,7 +73,7 @@ test_forecast_type_is_point <- function(data) { #' Test whether data could be a quantile forecast. #' @description Checks type of the necessary columns. -#' @inheritParams check_data_doc_template +#' @inheritParams document_check_functions #' @return Returns TRUE if basic requirements are satisfied and FALSE otherwise #' @keywords internal test_forecast_type_is_quantile <- function(data) { diff --git a/man/assert_equal_length.Rd b/man/assert_equal_length.Rd index befa469f3..8b83b4c85 100644 --- a/man/assert_equal_length.Rd +++ b/man/assert_equal_length.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/check-input-helpers.R \name{assert_equal_length} \alias{assert_equal_length} -\title{Check Length} +\title{Check Length of Two Vectors is Equal} \usage{ assert_equal_length(..., one_allowed = TRUE, call_levels_up = 2) } diff --git a/man/assert_input_quantile.Rd b/man/assert_input_quantile.Rd index 9a0de05d5..87247c0ff 100644 --- a/man/assert_input_quantile.Rd +++ b/man/assert_input_quantile.Rd @@ -7,6 +7,9 @@ assert_input_quantile(observed, predicted, quantile) } \arguments{ +\item{observed}{Input to be checked. Should be a numeric vector with the +observed values of size n} + \item{predicted}{Input to be checked. Should be nxN matrix of predictive quantiles, n (number of rows) being the number of data points and N (number of columns) the number of quantiles per forecast. diff --git a/man/assure_model_column.Rd b/man/assure_model_column.Rd new file mode 100644 index 000000000..456652df2 --- /dev/null +++ b/man/assure_model_column.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check-input-helpers.R +\name{assure_model_column} +\alias{assure_model_column} +\title{Assure that Data Has a \code{model} Column} +\usage{ +assure_model_column(data) +} +\value{ +The data.table with a column called \code{model} +} +\description{ +Check whether the data.table has a column called \code{model}. +If not, a column called \code{model} is added with the value \verb{Unspecified model}. +} +\keyword{internal} diff --git a/man/check_attribute_conflict.Rd b/man/check_attribute_conflict.Rd new file mode 100644 index 000000000..c01ac264e --- /dev/null +++ b/man/check_attribute_conflict.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check-input-helpers.R +\name{check_attribute_conflict} +\alias{check_attribute_conflict} +\title{Check Whether There Is a Conflict Between Data and Attributes} +\usage{ +check_attribute_conflict(object, attribute, expected) +} +\arguments{ +\item{object}{The object to check} + +\item{attribute}{The name of the attribute to check} + +\item{expected}{The expected value of the attribute} +} +\value{ +Returns TRUE if the check was successful and a string with an +error message otherwise +} +\description{ +Check whether there is a conflict between a stored attribute and the +same value as inferred from the data. For example, this could be if +an attribute \code{forecast_unit} is stored, but is different from the +\code{forecast_unit} inferred from the data. The check is successful if +the stored and the inferred value are the same. +} +\keyword{internal} diff --git a/man/check_columns_present.Rd b/man/check_columns_present.Rd index 25fc11bb4..cfe76f064 100644 --- a/man/check_columns_present.Rd +++ b/man/check_columns_present.Rd @@ -12,10 +12,12 @@ check_columns_present(data, columns) \item{columns}{A character vector of column names to check} } \value{ -Returns string with a message with the first issue encountered if -any of the column names are not in data, otherwise returns TRUE +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ -Check column names are present in a data.frame +The functions loops over the column names and checks whether they are +present. If an issue is encountered, the function immediately stops +and returns a message with the first issue encountered. } \keyword{check-inputs} diff --git a/man/check_data_columns.Rd b/man/check_data_columns.Rd index 041a51915..04fba0892 100644 --- a/man/check_data_columns.Rd +++ b/man/check_data_columns.Rd @@ -10,12 +10,12 @@ check_data_columns(data) \item{data}{A data.frame or similar to be checked} } \value{ -Returns TRUE if basic requirements are satisfied and a string with -an error message otherwise +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ Checks whether data is a data.frame, whether columns -"observed" and "predicted" are presents -and checks that only one of "quantile" and "sample_id" is present. +"observed" and "predicted" are present, and checks that only one of +"quantile" and "sample_id" is present. } \keyword{check-inputs} diff --git a/man/check_data_doc_template.Rd b/man/check_data_doc_template.Rd deleted file mode 100644 index 72eecbd87..000000000 --- a/man/check_data_doc_template.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/documentation-templates.R -\name{check_data_doc_template} -\alias{check_data_doc_template} -\title{Documentation template for various checks on a data.frame} -\arguments{ -\item{data}{A data.frame or similar to be checked} - -\item{columns}{A character vector of column names to check} -} -\description{ -Documentation template for various checks on a data.frame -} diff --git a/man/check_duplicates.Rd b/man/check_duplicates.Rd index 88bec59b3..e4b0918ee 100644 --- a/man/check_duplicates.Rd +++ b/man/check_duplicates.Rd @@ -14,8 +14,8 @@ the unit of a single forecast. If \code{NULL} (the default) the function tries to infer the unit of a single forecast.} } \value{ -Returns an string with an error message if an issue is found, -otherwise returns TRUE +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ Runs \code{\link[=get_duplicate_forecasts]{get_duplicate_forecasts()}} and returns a message if an issue is encountered diff --git a/man/check_has_attribute.Rd b/man/check_has_attribute.Rd index 48b49c208..339e0d6d0 100644 --- a/man/check_has_attribute.Rd +++ b/man/check_has_attribute.Rd @@ -12,8 +12,8 @@ check_has_attribute(object, attribute) \item{attribute}{name of an attribute to be checked} } \value{ -Returns TRUE if attribute is there and an error message as -a string otherwise +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ Checks whether an object has an attribute diff --git a/man/check_input_quantile.Rd b/man/check_input_quantile.Rd index bcce6845a..a2315aa2e 100644 --- a/man/check_input_quantile.Rd +++ b/man/check_input_quantile.Rd @@ -7,6 +7,9 @@ check_input_quantile(observed, predicted, quantile) } \arguments{ +\item{observed}{Input to be checked. Should be a numeric vector with the +observed values of size n} + \item{predicted}{Input to be checked. Should be nxN matrix of predictive quantiles, n (number of rows) being the number of data points and N (number of columns) the number of quantiles per forecast. diff --git a/man/check_no_NA_present.Rd b/man/check_no_NA_present.Rd index 671e9a1f9..cf89ce468 100644 --- a/man/check_no_NA_present.Rd +++ b/man/check_no_NA_present.Rd @@ -12,10 +12,12 @@ check_no_NA_present(data, columns) \item{columns}{A character vector of column names to check} } \value{ -Returns an string with a message if any of the column names -have NA values, otherwise returns TRUE +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ -Check columns in data.frame don't have NA values +Function checks whether any of the columns in a data.frame, +as specified in \code{columns}, have NA values. If so, it returns a string with +an error message, otherwise it returns TRUE. } \keyword{internal} diff --git a/man/check_number_per_forecast.Rd b/man/check_number_per_forecast.Rd index 043ca6573..4d0a18432 100644 --- a/man/check_number_per_forecast.Rd +++ b/man/check_number_per_forecast.Rd @@ -12,10 +12,12 @@ check_number_per_forecast(data, forecast_unit) \item{forecast_unit}{Character vector denoting the unit of a single forecast.} } \value{ -Returns an string with a message if any forecasts have differing -numbers of samples or quantiles, otherwise returns TRUE +Returns TRUE if the check was successful and a string with an +error message otherwise } \description{ -Check that all forecasts have the same number of quantiles or samples +Function checks the number of quantiles or samples per forecast. +If the number of quantiles or samples is the same for all forecasts, it +returns TRUE and a string with an error message otherwise. } \keyword{internal} diff --git a/man/document_check_functions.Rd b/man/document_check_functions.Rd index 5740193ec..6f7f7f677 100644 --- a/man/document_check_functions.Rd +++ b/man/document_check_functions.Rd @@ -3,6 +3,11 @@ \name{document_check_functions} \alias{document_check_functions} \title{Documentation template for check functions} +\arguments{ +\item{data}{A data.frame or similar to be checked} + +\item{columns}{A character vector of column names to check} +} \value{ Returns TRUE if the check was successful and a string with an error message otherwise diff --git a/man/document_test_functions.Rd b/man/document_test_functions.Rd new file mode 100644 index 000000000..620cb1989 --- /dev/null +++ b/man/document_test_functions.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/documentation-templates.R +\name{document_test_functions} +\alias{document_test_functions} +\title{Documentation template for test functions} +\value{ +Returns TRUE if the check was successful and FALSE otherwise +} +\description{ +Documentation template for test functions +} diff --git a/man/test_columns_not_present.Rd b/man/test_columns_not_present.Rd index 8da1af43b..f55fe25b1 100644 --- a/man/test_columns_not_present.Rd +++ b/man/test_columns_not_present.Rd @@ -15,6 +15,8 @@ test_columns_not_present(data, columns) Returns TRUE if none of the columns are present and FALSE otherwise } \description{ -Test whether column names are NOT present in a data.frame +The function checks whether all column names are NOT present. +If none of the columns are present, the function returns TRUE. If one or +more columns are present, the function returns FALSE. } \keyword{internal} diff --git a/man/test_columns_present.Rd b/man/test_columns_present.Rd index efbeea2cd..ed5076417 100644 --- a/man/test_columns_present.Rd +++ b/man/test_columns_present.Rd @@ -15,6 +15,8 @@ test_columns_present(data, columns) Returns TRUE if all columns are present and FALSE otherwise } \description{ -Test whether all column names are present in a data.frame +The function checks whether all column names are present. If +one or more columns are missing, the function returns FALSE. If all columns +are present, the function returns TRUE. } \keyword{internal} From 60dd7e95837cf19e550a91dc707eca1a3a88cf02 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 30 Oct 2023 18:43:59 +0100 Subject: [PATCH 16/17] simplify and speed up tests a bit --- tests/testthat/setup.R | 5 +- tests/testthat/test-absolute_error.R | 6 +- tests/testthat/test-add_coverage.R | 14 ++-- tests/testthat/test-pairwise_comparison.R | 14 ++-- tests/testthat/test-plot_correlation.R | 2 +- tests/testthat/test-plot_heatmap.R | 4 +- tests/testthat/test-plot_interval_coverage.R | 4 +- .../testthat/test-plot_pairwise_comparison.R | 2 +- tests/testthat/test-plot_quantile_coverage.R | 4 +- tests/testthat/test-plot_ranges.R | 2 +- tests/testthat/test-plot_score_table.R | 2 +- tests/testthat/test-plot_wis.R | 4 +- tests/testthat/test-score.R | 69 +++++-------------- tests/testthat/test-summarise_scores.R | 22 +++--- 14 files changed, 55 insertions(+), 99 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index dc3d6b941..c157fb958 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -3,4 +3,7 @@ library(ggplot2, quietly = TRUE) suppressMessages(library(magrittr)) # compute quantile scores -scores <- suppressMessages(score(example_quantile)) +scores_quantile <- suppressMessages(score(example_quantile)) +scores_continuous <- suppressMessages(score(data = example_continuous)) +scores_point <- suppressMessages(score(example_point)) +scores_binary <- suppressMessages(score(example_binary)) diff --git a/tests/testthat/test-absolute_error.R b/tests/testthat/test-absolute_error.R index a8259328e..f61493b25 100644 --- a/tests/testthat/test-absolute_error.R +++ b/tests/testthat/test-absolute_error.R @@ -2,7 +2,7 @@ test_that("absolute error (sample based) works", { observed <- rnorm(30, mean = 1:30) predicted_values <- rnorm(30, mean = 1:30) - scoringutils <- scoringutils::ae_median_sample(observed, predicted_values) + scoringutils <- ae_median_sample(observed, predicted_values) ae <- abs(observed - predicted_values) expect_equal(ae, scoringutils) @@ -68,11 +68,7 @@ test_that("abs error is correct within score, point forecast only", { eval <- scoringutils::score(data_scoringutils) - # actual <- score_forecasts(forecasts = test_forecasts, truth = test_truth) - expected <- abs(y - point_forecast) - - # expect_equal(actual$abs_error, expected) expect_equal(eval$ae, expected) }) diff --git a/tests/testthat/test-add_coverage.R b/tests/testthat/test-add_coverage.R index 43686ca80..fab1e72a1 100644 --- a/tests/testthat/test-add_coverage.R +++ b/tests/testthat/test-add_coverage.R @@ -1,16 +1,18 @@ +ex_coverage <- scores_quantile[model == "EuroCOVIDhub-ensemble"] + test_that("add_coverage() works as expected", { expect_error( - add_coverage(scores, by = c("model", "target_type"), range = c()) + add_coverage(ex_coverage, by = c("model", "target_type"), range = c()) ) expect_error( - add_coverage(scores, by = c("model", "target_type")), NA + add_coverage(ex_coverage, by = c("model", "target_type")), NA ) cov <- add_coverage( - scores, by = c("model", "target_type"), range = c(10, 50, 80) + scores_quantile, by = c("model", "target_type"), range = c(10, 20) ) expect_equal( grep("coverage_", colnames(cov), value = TRUE), - c("coverage_deviation", "coverage_10", "coverage_50", "coverage_80") + c("coverage_deviation", "coverage_10", "coverage_20") ) }) @@ -18,10 +20,10 @@ test_that("add_coverage() works as expected", { test_that("Order of `add_coverage()` and `summarise_scores()` doesn't matter", { # Need to update test. Turns out the order does matter... # see https://github.com/epiforecasts/scoringutils/issues/367 - pw1 <- add_coverage(scores, by = "model") + pw1 <- add_coverage(ex_coverage, by = "model") pw1_sum <- summarise_scores(pw1, by = "model") - pw2 <- summarise_scores(scores, by = "model") + pw2 <- summarise_scores(ex_coverage, by = "model") pw2 <- add_coverage(pw2) # expect_true(all(pw1_sum == pw2, na.rm = TRUE)) diff --git a/tests/testthat/test-pairwise_comparison.R b/tests/testthat/test-pairwise_comparison.R index 1ff94ad99..3d0120adb 100644 --- a/tests/testthat/test-pairwise_comparison.R +++ b/tests/testthat/test-pairwise_comparison.R @@ -254,15 +254,14 @@ test_that("pairwise_comparison() works", { test_that("pairwise_comparison() works inside and outside of score()", { - eval <- suppressMessages(score(data = example_continuous)) + eval <- scores_continuous pairwise <- suppressMessages(pairwise_comparison(eval, by = "model", metric = "crps" )) - eval2 <- suppressMessages(score(data = example_continuous)) - eval2_summarised <- summarise_scores(eval2, by = "model") + eval2_summarised <- summarise_scores(scores_continuous, by = "model") eval2 <- add_pairwise_comparison(eval2_summarised) expect_equal( @@ -271,19 +270,16 @@ test_that("pairwise_comparison() works inside and outside of score()", { }) test_that("pairwise_comparison() realises when there is no baseline model", { - - scores <- suppressMessages(score(example_quantile)) - expect_error( - pairwise_comparison(scores, baseline = "missing_model"), "missing" + pairwise_comparison(scores_quantile, baseline = "missing_model"), "missing" ) }) test_that("Order of `add_pairwise_comparison()` and `summarise_scores()` doesn't matter", { - pw1 <- suppressMessages(add_pairwise_comparison(scores)) + pw1 <- suppressMessages(add_pairwise_comparison(scores_quantile)) pw1_sum <- summarise_scores(pw1, by = "model") - pw2 <- summarise_scores(scores, by = "model") + pw2 <- summarise_scores(scores_quantile, by = "model") pw2 <- add_pairwise_comparison(pw2) expect_true(all(pw1_sum == pw2, na.rm = TRUE)) diff --git a/tests/testthat/test-plot_correlation.R b/tests/testthat/test-plot_correlation.R index 9d6280d6e..0a35b9a5e 100644 --- a/tests/testthat/test-plot_correlation.R +++ b/tests/testthat/test-plot_correlation.R @@ -1,5 +1,5 @@ test_that("plot_correlation() works as expected", { - correlations <- correlation(summarise_scores(scores)) + correlations <- correlation(summarise_scores(scores_quantile)) p <- plot_correlation(correlations) expect_s3_class(p, "ggplot") skip_on_cran() diff --git a/tests/testthat/test-plot_heatmap.R b/tests/testthat/test-plot_heatmap.R index 3246fbd64..9118ff21f 100644 --- a/tests/testthat/test-plot_heatmap.R +++ b/tests/testthat/test-plot_heatmap.R @@ -2,10 +2,10 @@ library(ggplot2, quietly = TRUE) test_that("plot_heatmap() works as expected", { scores <- suppressMessages( - summarise_scores(scores, by = c("model", "target_type", "range")) + summarise_scores(scores_quantile, by = c("model", "target_type", "range")) ) p <- plot_heatmap(scores, x = "target_type", metric = "bias") expect_s3_class(p, "ggplot") skip_on_cran() vdiffr::expect_doppelganger("plot_heatmap", p) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-plot_interval_coverage.R b/tests/testthat/test-plot_interval_coverage.R index 6180704a4..04f203b03 100644 --- a/tests/testthat/test-plot_interval_coverage.R +++ b/tests/testthat/test-plot_interval_coverage.R @@ -2,10 +2,10 @@ library(ggplot2, quietly = TRUE) test_that("plot_interval_coverage() works as expected", { scores <- suppressMessages( - summarise_scores(scores, by = c("model", "range")) + summarise_scores(scores_quantile, by = c("model", "range")) ) p <- plot_interval_coverage(scores) expect_s3_class(p, "ggplot") skip_on_cran() vdiffr::expect_doppelganger("plot_interval_coverage", p) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-plot_pairwise_comparison.R b/tests/testthat/test-plot_pairwise_comparison.R index 4cd477e90..ffbf15374 100644 --- a/tests/testthat/test-plot_pairwise_comparison.R +++ b/tests/testthat/test-plot_pairwise_comparison.R @@ -1,5 +1,5 @@ pairwise <- suppressMessages( - pairwise_comparison(scores, by = "target_type") + pairwise_comparison(scores_quantile, by = "target_type") ) test_that("plot_pairwise_comparison() works as expected", { diff --git a/tests/testthat/test-plot_quantile_coverage.R b/tests/testthat/test-plot_quantile_coverage.R index 9b210bfc9..6c3593c04 100644 --- a/tests/testthat/test-plot_quantile_coverage.R +++ b/tests/testthat/test-plot_quantile_coverage.R @@ -1,9 +1,9 @@ test_that("plot_quantile_coverage() works as expected", { scores <- suppressMessages( - summarise_scores(scores, by = c("model", "quantile")) + summarise_scores(scores_quantile, by = c("model", "quantile")) ) p <- plot_quantile_coverage(scores) expect_s3_class(p, "ggplot") skip_on_cran() vdiffr::expect_doppelganger("plot_quantile_coverage", p) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-plot_ranges.R b/tests/testthat/test-plot_ranges.R index d773d4f91..e9ae5575b 100644 --- a/tests/testthat/test-plot_ranges.R +++ b/tests/testthat/test-plot_ranges.R @@ -1,5 +1,5 @@ sum_scores <- suppressMessages( - summarise_scores(scores, by = c("model", "target_type", "range")) + summarise_scores(scores_quantile, by = c("model", "target_type", "range")) ) test_that("plot_ranges() works as expected with interval score", { diff --git a/tests/testthat/test-plot_score_table.R b/tests/testthat/test-plot_score_table.R index 662a1cefc..8336de7a9 100644 --- a/tests/testthat/test-plot_score_table.R +++ b/tests/testthat/test-plot_score_table.R @@ -1,6 +1,6 @@ test_that("plot_score_table() works as expected", { p <- suppressMessages( - scores %>% + scores_quantile %>% add_coverage(by = c("model")) %>% summarise_scores(by = c("model")) %>% summarise_scores(by = c("model"), fun = signif, digits = 1) %>% diff --git a/tests/testthat/test-plot_wis.R b/tests/testthat/test-plot_wis.R index 6e3c92fed..9e3c03409 100644 --- a/tests/testthat/test-plot_wis.R +++ b/tests/testthat/test-plot_wis.R @@ -1,5 +1,5 @@ sum_scores <- suppressMessages( - summarise_scores(scores, by = c("model", "target_type")) + summarise_scores(scores_quantile, by = c("model", "target_type")) ) test_that("plot_wis() works as expected with relative contributions", { @@ -34,4 +34,4 @@ test_that("plot_wis() works as expected when flipped", { expect_s3_class(p, "ggplot") skip_on_cran() vdiffr::expect_doppelganger("plot_wis_flip", p) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-score.R b/tests/testthat/test-score.R index 73c013eb9..9b4040723 100644 --- a/tests/testthat/test-score.R +++ b/tests/testthat/test-score.R @@ -20,9 +20,7 @@ test_that("function throws an error if data is missing", { # test binary case ------------------------------------------------------------- test_that("function produces output for a binary case", { - binary_example <- data.table::setDT(scoringutils::example_binary) - eval <- suppressMessages(score(binary_example[!is.na(predicted)])) - eval <- summarise_scores(eval, by = c("model", "target_type")) + eval <- summarise_scores(scores_binary, by = c("model", "target_type")) expect_equal( nrow(eval) > 1, @@ -36,13 +34,7 @@ test_that("function produces output for a binary case", { "log_score" ) ) -}) - -test_that("function produces score for a binary case", { - binary_example <- data.table::setDT(scoringutils::example_binary) - eval <- suppressMessages(score(binary_example[!is.na(predicted)])) - eval <- summarise_scores(eval, by = c("model", "target_type")) expect_true("brier_score" %in% names(eval)) }) @@ -55,13 +47,11 @@ test_that("score.scoringutils_binary() errors with only NA values", { }) test_that("score() gives same result for binary as regular function", { - binary_example <- data.table::setDT(scoringutils::example_binary[!is.na(predicted)]) - eval <- suppressMessages(score(binary_example)) manual_eval <- brier_score( - factor(binary_example$observed), - binary_example$predicted + factor(example_binary$observed), + example_binary$predicted ) - expect_equal(eval$brier_score, manual_eval) + expect_equal(scores_binary$brier_score, manual_eval[!is.na(manual_eval)]) }) test_that( @@ -130,25 +120,19 @@ test_that( # providing an additional, unrelated function argument works expect_no_error( - score(example_binary, unnecessary_argument = "unnecessary") + score(df, unnecessary_argument = "unnecessary") ) expect_no_error( - score(example_binary, metrics = list("brier_score" = brier_score), + score(df, metrics = list("brier_score" = brier_score), unnecessary_argument = "unnecessary") ) } ) - - - - # test point case -------------------------------------------------------------- test_that("function produces output for a point case", { - point_example <- data.table::setDT(scoringutils::example_point) - eval <- suppressMessages(score(point_example)) - eval <- summarise_scores(eval, by = c("model", "target_type")) + eval <- summarise_scores(scores_point, by = c("model", "target_type")) expect_equal( nrow(eval) > 1, @@ -181,21 +165,12 @@ test_that("score.scoringutils_point() errors with only NA values", { }) # test quantile case ----------------------------------------------------------- -test_that("function produces output for a quantile format case", { - quantile_example <- data.table::setDT(scoringutils::example_quantile) - eval <- suppressMessages(score(quantile_example[!is.na(predicted)])) - - expect_equal( - nrow(eval) > 1, - TRUE - ) -}) - test_that("score_quantile correctly handles separate results = FALSE", { - quantile_example <- data.table::setDT(scoringutils::example_quantile) + df <- example_quantile[model == "EuroCOVIDhub-ensemble" & + target_type == "Cases" & location == "DE"] eval <- suppressMessages( score( - quantile_example[!is.na(predicted)], + df[!is.na(predicted)], separate_results = FALSE ) ) @@ -227,11 +202,7 @@ test_that("score() quantile produces desired metrics", { test_that("calculation of ae_median is correct for a quantile format case", { - eval <- suppressMessages( - score(scoringutils::example_quantile[!is.na(predicted)]) - ) - - eval <- summarise_scores(eval,by = "model") + eval <- summarise_scores(scores_quantile,by = "model") example <- scoringutils::example_quantile ae <- example[quantile == 0.5, ae := abs(observed - predicted)][!is.na(model), .(mean = mean(ae, na.rm = TRUE)), @@ -243,12 +214,11 @@ test_that("calculation of ae_median is correct for a quantile format case", { test_that("all quantile and range formats yield the same result", { - quantile_example1 <- data.table::setDT(scoringutils::example_quantile) + eval1 <- summarise_scores(scores_quantile, by = "model") - eval1 <- suppressMessages(score(quantile_example1[!is.na(predicted)])) - eval1 <- summarise_scores(eval1, by = "model") + df <- data.table::copy(example_quantile) - ae <- quantile_example1[ + ae <- df[ quantile == 0.5, ae := abs(observed - predicted)][ !is.na(model), .(mean = mean(ae, na.rm = TRUE)), by = "model" @@ -273,7 +243,7 @@ test_that("WIS is the same with other metrics omitted or included", { metrics = "interval_score" )) - eval2 <- suppressMessages(score(example_quantile)) + eval2 <- scores_quantile expect_equal( sum(eval$interval_score), @@ -296,15 +266,8 @@ test_that("score.scoringutils_quantile() errors with only NA values", { # test integer and continuous case --------------------------------------------- test_that("function produces output for a continuous format case", { - example <- data.table::setDT(scoringutils::example_continuous) - eval <- suppressMessages(score(example[!is.na(predicted)])) - - eval2 <- suppressMessages(score(example)) - data.table::setcolorder(eval2, colnames(eval)) - eval <- eval[order(model)] - eval2 <- eval2[order(model)] - all(eval == eval2, na.rm = TRUE) + eval <- scores_continuous only_nas <- copy(example_continuous)[, predicted := NA_real_] expect_error( diff --git a/tests/testthat/test-summarise_scores.R b/tests/testthat/test-summarise_scores.R index 3c5ab37fc..d3fd830ce 100644 --- a/tests/testthat/test-summarise_scores.R +++ b/tests/testthat/test-summarise_scores.R @@ -1,10 +1,10 @@ test_that("summarise_scores() works without any arguments", { - expect_true("quantile" %in% names(scores)) + expect_true("quantile" %in% names(scores_quantile)) - scores <- summarise_scores(scores) - expect_false("quantile" %in% names(scores)) + summarised_scores <- summarise_scores(scores_quantile) + expect_false("quantile" %in% names(summarised_scores)) - s2 <- summarise_scores(scores, + s2 <- summarise_scores(scores_quantile, by = c( "location", "target_end_date", "target_type", "location_name", "forecast_date", "model", @@ -12,19 +12,19 @@ test_that("summarise_scores() works without any arguments", { ) ) - expect_equal(nrow(scores), nrow(s2)) + expect_equal(nrow(summarised_scores), nrow(s2)) }) test_that("summarise_scores() handles wrong by argument well", { expect_error( - summarise_scores(scores, by = "not_present"), + summarise_scores(scores_quantile, by = "not_present"), "Column 'not_present' not found in data.", # nolint fixed = TRUE ) expect_error( - summarise_scores(scores, by = "sample_id"), + summarise_scores(scores_quantile, by = "sample_id"), "Column 'sample_id' not found in data.", fixed = TRUE ) @@ -43,7 +43,6 @@ test_that("summarise_scores() works with point forecasts in a quantile format", ) ) - scores_point <- suppressMessages(score(example_point)) summarised_scores <- summarise_scores(scores_point, by = "model") expect_no_condition( @@ -64,11 +63,8 @@ test_that("summarise_scores() works with point forecasts in a quantile format", }) test_that("summarise_scores() can compute relative measures", { - ex <- data.table::copy(example_quantile) - scores <- suppressMessages(score(ex)) - scores_with <- add_pairwise_comparison( - summarise_scores(scores, by = "model") + summarise_scores(scores_quantile, by = "model") ) expect_equal( @@ -77,7 +73,7 @@ test_that("summarise_scores() can compute relative measures", { ) scores_with <- add_pairwise_comparison( - summarise_scores(scores, by = "model"), + summarise_scores(scores_quantile, by = "model"), relative_skill_metric = "ae_median" ) From 2f33bdc758fbc47f34d38d6517b6513edb849825 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 30 Oct 2023 18:53:04 +0100 Subject: [PATCH 17/17] Exclude an example from running --- R/summarise_scores.R | 3 ++- man/summarise_scores.Rd | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/summarise_scores.R b/R/summarise_scores.R index 37569b4bb..e62bac789 100644 --- a/R/summarise_scores.R +++ b/R/summarise_scores.R @@ -27,9 +27,10 @@ #' @examples #' data.table::setDTthreads(1) # only needed to avoid issues on CRAN #' library(magrittr) # pipe operator -#' +#' \dontrun{ #' scores <- score(example_continuous) #' summarise_scores(scores) +#' } #' #' #' # summarise over samples or quantiles to get one score per forecast diff --git a/man/summarise_scores.Rd b/man/summarise_scores.Rd index 33e43985d..5b65283ad 100644 --- a/man/summarise_scores.Rd +++ b/man/summarise_scores.Rd @@ -42,9 +42,10 @@ Summarise scores as produced by \code{\link[=score]{score()}} \examples{ data.table::setDTthreads(1) # only needed to avoid issues on CRAN library(magrittr) # pipe operator - +\dontrun{ scores <- score(example_continuous) summarise_scores(scores) +} # summarise over samples or quantiles to get one score per forecast