From 6e2643bd8361629a6971bf1e39277769f9b5d8f1 Mon Sep 17 00:00:00 2001 From: Ethan Heinzen Date: Fri, 30 Dec 2016 00:18:42 +0000 Subject: [PATCH] version 0.1.2 --- DESCRIPTION | 41 + MD5 | 66 + NAMESPACE | 51 + NEWS.md | 16 + R/arsenal.R | 52 + R/formulize.R | 46 + R/freqlist.R | 138 + R/freqlist.internal.R | 50 + R/internal.functions.R | 1036 ++++++++ R/magic8.R | 37 + R/mdy.Date.R | 55 + R/mockstudy.R | 27 + R/modelsum.R | 544 ++++ R/modelsum.control.R | 132 + R/modelsum.internal.R | 151 ++ R/not.in.R | 26 + R/release_questions.R | 12 + R/summary.freqlist.R | 86 + R/summary.modelsum.R | 993 +++++++ R/summary.tableby.R | 204 ++ R/tableby.R | 627 +++++ R/tableby.control.R | 158 ++ R/tableby.internal.R | 1152 +++++++++ R/tableby.stat.tests.R | 61 + R/tableby.stats.R | 268 ++ R/write2.R | 88 + README.md | 38 + build/vignette.rds | Bin 0 -> 255 bytes data/mockstudy.RData | Bin 0 -> 36933 bytes inst/doc/freqlist.R | 112 + inst/doc/freqlist.Rmd | 244 ++ inst/doc/freqlist.pdf | Bin 0 -> 258253 bytes inst/doc/modelsum.R | 405 +++ inst/doc/modelsum.Rmd | 878 +++++++ inst/doc/modelsum.html | 3401 ++++++++++++++++++++++++ inst/doc/tableby.R | 327 +++ inst/doc/tableby.Rmd | 760 ++++++ inst/doc/tableby.html | 4294 +++++++++++++++++++++++++++++++ man/arsenal.Rd | 40 + man/as.data.frame.freqlist.Rd | 20 + man/as.data.frame.modelsum.Rd | 53 + man/as.data.frame.tableby.Rd | 54 + man/formulize.Rd | 46 + man/freqlist.Rd | 55 + man/freqlist.internal.Rd | 23 + man/grapes-nin-grapes.Rd | 33 + man/mdy.Date.Rd | 41 + man/mockstudy.Rd | 37 + man/modelsum.Rd | 80 + man/modelsum.control.Rd | 44 + man/modelsum.internal.Rd | 37 + man/summary.freqlist.Rd | 40 + man/summary.modelsum.Rd | 64 + man/summary.tableby.Rd | 96 + man/tableby.Rd | 136 + man/tableby.control.Rd | 103 + man/tableby.internal.Rd | 55 + man/tableby.stats.Rd | 63 + man/write2.Rd | 65 + tests/testthat.R | 4 + tests/testthat/test_formulize.R | 100 + tests/testthat/test_freqlist.R | 253 ++ tests/testthat/test_modelsum.R | 112 + tests/testthat/test_tableby.R | 401 +++ vignettes/freqlist.Rmd | 244 ++ vignettes/modelsum.Rmd | 878 +++++++ vignettes/tableby.Rmd | 760 ++++++ 67 files changed, 20513 insertions(+) create mode 100644 DESCRIPTION create mode 100644 MD5 create mode 100644 NAMESPACE create mode 100644 NEWS.md create mode 100644 R/arsenal.R create mode 100644 R/formulize.R create mode 100644 R/freqlist.R create mode 100644 R/freqlist.internal.R create mode 100644 R/internal.functions.R create mode 100644 R/magic8.R create mode 100644 R/mdy.Date.R create mode 100644 R/mockstudy.R create mode 100644 R/modelsum.R create mode 100644 R/modelsum.control.R create mode 100644 R/modelsum.internal.R create mode 100644 R/not.in.R create mode 100644 R/release_questions.R create mode 100644 R/summary.freqlist.R create mode 100644 R/summary.modelsum.R create mode 100644 R/summary.tableby.R create mode 100644 R/tableby.R create mode 100644 R/tableby.control.R create mode 100644 R/tableby.internal.R create mode 100644 R/tableby.stat.tests.R create mode 100644 R/tableby.stats.R create mode 100644 R/write2.R create mode 100644 README.md create mode 100644 build/vignette.rds create mode 100644 data/mockstudy.RData create mode 100644 inst/doc/freqlist.R create mode 100644 inst/doc/freqlist.Rmd create mode 100644 inst/doc/freqlist.pdf create mode 100644 inst/doc/modelsum.R create mode 100644 inst/doc/modelsum.Rmd create mode 100644 inst/doc/modelsum.html create mode 100644 inst/doc/tableby.R create mode 100755 inst/doc/tableby.Rmd create mode 100644 inst/doc/tableby.html create mode 100644 man/arsenal.Rd create mode 100644 man/as.data.frame.freqlist.Rd create mode 100644 man/as.data.frame.modelsum.Rd create mode 100644 man/as.data.frame.tableby.Rd create mode 100644 man/formulize.Rd create mode 100644 man/freqlist.Rd create mode 100644 man/freqlist.internal.Rd create mode 100644 man/grapes-nin-grapes.Rd create mode 100644 man/mdy.Date.Rd create mode 100644 man/mockstudy.Rd create mode 100644 man/modelsum.Rd create mode 100644 man/modelsum.control.Rd create mode 100644 man/modelsum.internal.Rd create mode 100644 man/summary.freqlist.Rd create mode 100644 man/summary.modelsum.Rd create mode 100644 man/summary.tableby.Rd create mode 100644 man/tableby.Rd create mode 100644 man/tableby.control.Rd create mode 100644 man/tableby.internal.Rd create mode 100644 man/tableby.stats.Rd create mode 100644 man/write2.Rd create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test_formulize.R create mode 100644 tests/testthat/test_freqlist.R create mode 100644 tests/testthat/test_modelsum.R create mode 100644 tests/testthat/test_tableby.R create mode 100644 vignettes/freqlist.Rmd create mode 100644 vignettes/modelsum.Rmd create mode 100755 vignettes/tableby.Rmd diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..2f783a6 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,41 @@ +Package: arsenal +Title: An Arsenal of 'R' Functions for Large-Scale Statistical + Summaries +Version: 0.1.2 +Date: 2016-12-29 +Authors@R: c( + person("Ethan", "Heinzen", email = "heinzen.ethan@mayo.edu", role = c("aut", "cre")), + person("Jason", "Sinnwell", role="aut"), + person("Elizabeth", "Atkinson", role="aut"), + person("Tina", "Gunderson", role="aut"), + person("Gregory", "Dougherty", role="aut"), + person("Patrick", "Votruba", role="ctb"), + person("Emily", "Lundt", role="ctb") + ) +Description: An Arsenal of 'R' functions for large-scale statistical summaries, + which are streamlined to work within the latest reporting tools in 'R' and + 'RStudio' and which use formulas and versatile summary statistics for summary + tables and models. The primary functions include tableby(), a Table-1-like + summary of multiple variable types 'by' the levels of a categorical + variable; modelsum(), which performs simple model fits on the same endpoint + for many variables (univariate or adjusted for standard covariates); + and freqlist(), a powerful frequency table across many categorical variables. +Suggests: knitr, rmarkdown, xtable, survival, testthat, coin, pROC, + MASS, gam, rpart +Depends: R (>= 3.2.0), stats (>= 3.2.0) +Imports: broom, stringr +VignetteBuilder: knitr +License: GPL (>= 2) +RoxygenNote: 5.0.1 +NeedsCompilation: no +Packaged: 2016-12-29 15:03:54 UTC; m144326 +Author: Ethan Heinzen [aut, cre], + Jason Sinnwell [aut], + Elizabeth Atkinson [aut], + Tina Gunderson [aut], + Gregory Dougherty [aut], + Patrick Votruba [ctb], + Emily Lundt [ctb] +Maintainer: Ethan Heinzen +Repository: CRAN +Date/Publication: 2016-12-30 01:18:42 diff --git a/MD5 b/MD5 new file mode 100644 index 0000000..cbe9746 --- /dev/null +++ b/MD5 @@ -0,0 +1,66 @@ +966d309a0df5d55be152e36454793ba7 *DESCRIPTION +3f62d030021234740076da4d1ba8f002 *NAMESPACE +a5124b7fb1a608cf22414d0d439c5893 *NEWS.md +babe9da5c34ab0be1462ebb582b67f01 *R/arsenal.R +79e2033244f329fa85d87cbc4013f678 *R/formulize.R +cfa9ea4571efbb3e9de3bc79dcc56041 *R/freqlist.R +e42ce669505128b0f0b20ac6c621e91d *R/freqlist.internal.R +02a7e6a76fe38503ed55d6d0da6e12dd *R/internal.functions.R +2f474534e9fc946996d331ad8103b5ea *R/magic8.R +e54a23c0326058d798de6b3c912a8003 *R/mdy.Date.R +1de6a042544ab82b1d3e5d5264e3ffe9 *R/mockstudy.R +8a60fb9fd3e6b75451fd52a671343fdf *R/modelsum.R +8972abaedd55f0c7f1418ad70f233302 *R/modelsum.control.R +8c879e7ce937bdbedb5fd3fb31a11d3f *R/modelsum.internal.R +0e56f25775a178e261295319e70889bd *R/not.in.R +50cd5149107450c83f3e3f855aeb57ad *R/release_questions.R +915d58ab60615cd9c66bfc92131cfba1 *R/summary.freqlist.R +1dff52d601070cac366b7123de8f8680 *R/summary.modelsum.R +318e7c0c95e3737f5c209a9ba9ebea7b *R/summary.tableby.R +918558ed28af0fd4f0338c9d9787b926 *R/tableby.R +6cd26e41a5b57be0697d1e98594fb16d *R/tableby.control.R +4b5df64d48a8f090b29f7eb55008b5db *R/tableby.internal.R +9bb29fd9186f2e7c11351693f70aa2e8 *R/tableby.stat.tests.R +d795cb92f9d3e5ec846b31c0579badd3 *R/tableby.stats.R +872993fdbe93e6707fae16f6e0a0c99f *R/write2.R +018618b1d1fb15a1945e7892e2868204 *README.md +4aafc7bc18223c036874a46def9050bc *build/vignette.rds +30cd2d9369ee4d94dd76dcbf5a215559 *data/mockstudy.RData +79433ae6628afba73b4751b5e6bbb32e *inst/doc/freqlist.R +b90b634df89f2a4dc597b834d4a0457d *inst/doc/freqlist.Rmd +197db4ba70c32f0a3579ba56e71b8c7b *inst/doc/freqlist.pdf +2be512c16c57f0c19d46a03559fa66ed *inst/doc/modelsum.R +cfe0b0bd54ea0d5dd64b179d025a5621 *inst/doc/modelsum.Rmd +85570c3c621adb383c345f2e09bd5a1e *inst/doc/modelsum.html +48ac3590253a78deafa97b9c8a30ba4f *inst/doc/tableby.R +0f686caa3862dd071b6538bd17b5d0c8 *inst/doc/tableby.Rmd +78a397ba49bf53164ac6bf6eb5278c0b *inst/doc/tableby.html +fb7f3dd8cf45309fc533d5cb863271b8 *man/arsenal.Rd +a08790dee110e6f91216f1c9f7b9888e *man/as.data.frame.freqlist.Rd +fb7c429f3c12092d0fad2dc88754fd8f *man/as.data.frame.modelsum.Rd +1326c71d7954bf79cd26895f0aedd30f *man/as.data.frame.tableby.Rd +2133b459a58b59f77b1e835fafc009e6 *man/formulize.Rd +c15c3a5f78637e5ac782800687fd2289 *man/freqlist.Rd +b149f67287b2605109b516fbd9ef8f20 *man/freqlist.internal.Rd +5148640645d5b9f0de27a83ba4ed6788 *man/grapes-nin-grapes.Rd +2e1f8c2d941134f65a82f84346247458 *man/mdy.Date.Rd +4cd57758131c3d1dffce65879eb34e76 *man/mockstudy.Rd +fb624ea9b801473dae9d30eefe8a1047 *man/modelsum.Rd +ee7241120bee38b7c92d9160f86699e0 *man/modelsum.control.Rd +56b926cfc2d81c0539e70ca8a4d68794 *man/modelsum.internal.Rd +562faf3ed641a245644af5887f5704aa *man/summary.freqlist.Rd +1a749d94bb67684290e8d11927700f0d *man/summary.modelsum.Rd +b03d9fe7d9940a052a7b539b58a4f2c5 *man/summary.tableby.Rd +d8894b3a8db813af90570d664d3009dd *man/tableby.Rd +e60ebe8ed16f9112a141ec2b24574b10 *man/tableby.control.Rd +c00a698159af17705b7306ce44e2070b *man/tableby.internal.Rd +a7d8a4fca049fadfeb6be460b35a209f *man/tableby.stats.Rd +6d0a923e8398c923744d26bcbb44ddc3 *man/write2.Rd +b86d96d2b720f7aeeb3b9412b87d67ef *tests/testthat.R +ba8ab9b99798b694a5f5b06b9a28f2d8 *tests/testthat/test_formulize.R +6811553415304e4626ae831d29c1d680 *tests/testthat/test_freqlist.R +d4732617af6ee210bbdc165014b5a4b2 *tests/testthat/test_modelsum.R +357806abad78c1b6ca0c358d6d4d9b4a *tests/testthat/test_tableby.R +b90b634df89f2a4dc597b834d4a0457d *vignettes/freqlist.Rmd +cfe0b0bd54ea0d5dd64b179d025a5621 *vignettes/modelsum.Rmd +0f686caa3862dd071b6538bd17b5d0c8 *vignettes/tableby.Rmd diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..c522040 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,51 @@ +# Generated by roxygen2: do not edit by hand + +S3method("[",modelsum) +S3method("[",tableby) +S3method("labels<-",freqlist) +S3method("labels<-",modelsum) +S3method("labels<-",tableby) +S3method(as.data.frame,freqlist) +S3method(as.data.frame,modelsum) +S3method(as.data.frame,tableby) +S3method(labels,freqlist) +S3method(labels,modelsum) +S3method(labels,tableby) +S3method(merge,modelsum) +S3method(merge,tableby) +S3method(print,freqlist) +S3method(print,modelsum) +S3method(print,modelsumList) +S3method(print,tableby) +S3method(summary,freqlist) +S3method(summary,modelsum) +S3method(summary,tableby) +S3method(tests,tableby) +export("%nin%") +export("labels<-") +export(Date.mdy) +export(N) +export(Nevents) +export(Nmiss) +export(countpct) +export(formulize) +export(freqlist) +export(mdy.Date) +export(meansd) +export(medSurv) +export(medianq1q3) +export(medianrange) +export(modelsum) +export(modelsum.control) +export(modpval.tableby) +export(na.modelsum) +export(na.tableby) +export(q1q3) +export(tableby) +export(tableby.control) +export(tests) +export(write2html) +export(write2pdf) +export(write2word) +import(broom) +import(stringr) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..74248d6 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,16 @@ +# arsenal 0.1.2 + +* `broom` and `stringr` have been moved to `imports` instead of `depends`. + +* Several minor tweaks to `freqlist` for better readability and performance. + +# arsenal 0.1.1 + +* The description and the title are more descriptive now, per request. + +# arsenal 0.1.0 + +* First release contains major functions `tableby()`, `modelsum()`, `freqlist()`, `formulize()`, and `write2...`. + +* Vignettes are included for `tableby()`, `modelsum()`, and `freqlist()`. + diff --git a/R/arsenal.R b/R/arsenal.R new file mode 100644 index 0000000..361dbac --- /dev/null +++ b/R/arsenal.R @@ -0,0 +1,52 @@ +## Created: 12/13/2016 +## Author: Ethan Heinzen + +#' An Arsenal of 'R' Functions for Large-Scale Statistical Summaries +#' +#' An Arsenal of 'R' functions for large-scale statistical summaries, +#' which are streamlined to work within the latest reporting tools in 'R' and 'RStudio' and +#' which use formulas and versatile summary statistics for summary tables and models. +#' +#' @section Functions: +#' +#' Below are listed some of the most widely used functions available in \code{arsenal}: +#' +#' \code{\link{tableby}}: Summary statistics Of a set of independent variables by a categorical variable. +#' +#' \code{\link{modelsum}}: Fit models over each of a set of independent variables with a response variable. +#' +#' \code{\link{freqlist}}: Approximate the output from SAS's \code{PROC FREQ} procedure when using the \code{/list} option of the \code{TABLE} statement. +#' +#' \code{\link{write2word}}, \code{\link{write2html}}, \code{\link{write2pdf}}: Functions to generate a word, html, or pdf document containing a single table. +#' +#' \code{\link{formulize}}: A shortcut to generate one-, two-, or many-sided formulas. +#' +#' \code{\link{mdy.Date}} and \code{\link{Date.mdy}}: Convert numeric dates for month, day, and year to Date object, and vice versa. +#' +#' @section Data: +#' +#' \code{\link{mockstudy}}: Mock study data for examples. +#' +#' @examples +#' library(arsenal) +#' +#' @docType package +#' @name arsenal +#' +NULL + +#### commands to build the package using devtools +# devtools::document() +# devtools::check_man() +# devtools::test() +# devtools::check() +# withr::with_libpaths(c("/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/testinstalls/", .libPaths()), +# devtools::install("../arsenal-eph/", build_vignettes = TRUE, dependencies = FALSE)) +# devtools::build("../arsenal-eph/") +## < restart R > +## library(arsenal, lib.loc = "/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/testinstalls/") + +#### to upload to CRAN +## Update DESCRIPTION, README.md, NEWS.md, and cran-comments.md +# devtools::revdep_check() +# devtools::release() diff --git a/R/formulize.R b/R/formulize.R new file mode 100644 index 0000000..f80b54e --- /dev/null +++ b/R/formulize.R @@ -0,0 +1,46 @@ +#' formulize +#' +#' A shortcut to generate one-, two-, or many-sided formulas from vectors of variable names. +#' +#' @param y,x,... Character vectors to be collapsed (by \code{"+"}) and put left-to-right in the formula. +#' If \code{data} is supplied, these can also be numeric, denoting which column name to use. See examples. +#' @param data An R object with non-null column names. +#' @author Ethan Heinzen +#' @examples +#' ## two-sided formula +#' formulize("y", c("x1", "x2", "x3")) +#' +#' ## one-sided formula +#' formulize(x = c("x1", "x2", "x3")) +#' +#' ## multi-sided formula +#' formulize("y", c("x1", "x2", "x3"), c("z1", "z2"), "w1") +#' +#' ## can use numerics for column names +#' data(mockstudy) +#' formulize(y = 1, x = 2:4, data = mockstudy) +#' +#' ## mix and match +#' formulize(1, c("x1", "x2", "x3"), data = mockstudy) +#' +#' ## get an interaction +#' formulize("y", c("x1*x2", "x3")) +#' +#' ## use in an lm +#' form <- formulize(2, 3:4, data = mockstudy) +#' summary(lm(form, data = mockstudy)) +#' +#' @export + +formulize <- function(y = "", x = "", ..., data = NULL) +{ + dots <- list(y = y, x = x, ...) + if(!is.null(data)) + { + if(is.null(colnames(data))) stop("colnames(data) is NULL") + dots <- lapply(dots, function(elt, cn) if(is.numeric(elt)) cn[elt] else elt, cn = colnames(data)) + } + trash <- lapply(dots, function(elt) if(!is.character(elt)) stop("One or more argument isn't a character vector")) + elts <- vapply(dots, paste0, character(1), collapse = " + ") + stats::as.formula(paste0(elts, collapse = " ~ ")) +} \ No newline at end of file diff --git a/R/freqlist.R b/R/freqlist.R new file mode 100644 index 0000000..f1a3748 --- /dev/null +++ b/R/freqlist.R @@ -0,0 +1,138 @@ +#' freqlist +#' +#' Approximate the output from SAS's \code{PROC FREQ} procedure when using the \code{/list} option of the \code{TABLE} statement. +#' +#' @param tab an object of class \code{"table"} or class \code{"xtabs"} +#' @param sparse a logical value indicating whether to keep rows with counts of zero. The default is \code{FALSE}. +#' @param na.options a character string indicating how to handling missing values: 'include' +#' (include values with NAs in counts and percentages), +#' 'showexclude' (show NAs but exclude from cumulative counts and all percentages), +#' 'remove' (remove values with NAs); default is 'include' +#' @param digits a single number indicating the number of digits for percentages (passed to \code{\link{round}}; default is 2. +#' @param labelTranslations an optional character string of labels to use for variable levels when summarizing. +#' @param groupBy an optional character string specifying a variable(s) to use for grouping when calculating cumulative +#' counts and percentages. \code{\link{summary.freqlist}} will also separate by grouping variable for printing. +#' @param ... additional arguments passed to the \code{\link[knitr]{kable}} function +#' @param x an object of class \code{"freqlist"} +#' @return An object of class \code{"freqlist"} (invisibly for \code{print.freqlist}) +#' @seealso \code{\link[base]{table}}, \code{\link[stats]{xtabs}}, \code{\link[knitr]{kable}} +#' +#' @examples +#' # load mockstudy data +#' data(mockstudy) +#' tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany") +#' noby <- freqlist(tab.ex, na.options = "include") +#' summary(noby) +#' withby <- freqlist(tab.ex, groupBy = c("arm","sex"), na.options = "showexclude") +#' summary(withby) +#' @author Tina Gunderson +#' @name freqlist +NULL +#> NULL + +#' @rdname freqlist +#' @export +freqlist <- function(tab, sparse = FALSE, na.options = c('include', 'showexclude', 'remove'), digits = 2, labelTranslations = NULL, groupBy = NULL, ...) +{ + na.options <- match.arg(na.options) + if (any(class(tab) %nin% c("table","xtabs"))) stop("table object is not of class 'table' or class 'xtabs'") + if (min(dim(tab)) < 1) stop("table object has dimension of 0") + if (!is.logical(sparse)) stop("sparse must be TRUE or FALSE") + if (length(digits) > 1) stop("digits must be a single numeric value") + if ((digits %% 1) != 0 || (digits < 0)) stop("digits must be a positive whole number") + if (!is.null(groupBy) && any(groupBy %nin% names(dimnames(tab)))) stop("groupBy variable not found in table names") + if (!is.null(labelTranslations) && (!is.character(labelTranslations) || length(labelTranslations) != length(dim(tab)))) + stop("length of variable names does not match table object dimensions") + + if("varnames" %in% names(list(...))){warning("The 'varnames' argument has been deprecated. Please use 'labelTranslations' instead.")} + + cumfun <- function(x) { + # function to create a cumulative sum retaining NAs, but omitting in sum function + x2 <- rep(NA, length(x)) + if (length(stats::na.omit(x)) == 0) { + warning("For at least one level, all entries have NAs") + } else { + x2[!is.na(x)] <- cumsum(stats::na.omit(x)) + } + return(x2) + } + # create data frame from table object + if ("xtabs" %nin% class(tab)){ + tab.df <- data.frame(expand.grid(dimnames(tab))) + oldnames <- names(tab.df) + tab.freq <- data.frame(tab.df, Freq = as.vector(tab)) + } else { + tab.freq <- data.frame(tab) + oldnames <- names(tab.freq)[1:(ncol(tab.freq)-1)] + } + if (length(labelTranslations) > (ncol(tab.freq)-1)) stop("Number of variable names greater than number of variables") + internalTable <- function(data, na.options = na.options, digits = digits) { + # orders and performs calculations for the table + # split into a function to be able to use with by statement + data <- data[do.call(order, data), ] + na.index <- apply(data, 1, function(x) sum(is.na(x))) + if (na.options == 'remove') { + data <- subset(data, na.index == 0) + cumFreq <- cumsum(data$Freq) + freqPct <- 100 * data$Freq / sum(data$Freq) + cumPct <- cumsum(freqPct) + } else if(na.options == 'include') { + cumFreq = cumsum(data$Freq) + freqPct = 100 * data$Freq / sum(data$Freq) + cumPct = cumsum(freqPct) + } else if(na.options == 'showexclude') { + freq_tmp <- data[, "Freq"] + freq_tmp[na.index != 0] <- NA + cumFreq = cumfun(freq_tmp) + freqPct = 100 * freq_tmp / max(stats::na.omit(cumFreq), na.rm = TRUE) + cumPct = cumfun(freqPct) + } + freqOut <- data.frame(cumFreq = cumFreq, freqPercent = round(freqPct, digits), cumPercent = round(cumPct, digits)) + minitable <- cbind(data, freqOut, row.names = NULL) + return(minitable) + } + #if a grouping factor is given, will add NA as a factor level so it is not dropped when using the by function + if(!is.null(groupBy)) { + if(na.options != 'exclude') { + for(i in match(groupBy, names(tab.freq))) { + if(sum(is.na(tab.freq[, i])) > 0) {tab.freq[, i] <- addNA(tab.freq[, i])} + } + } + byObject <- by(tab.freq, tab.freq[, groupBy], FUN = internalTable, na.options = na.options, digits = digits) + tableout <- do.call(rbind, byObject) + factorIndex <- match(groupBy, names(tableout)) + tableout <- cbind(tableout[, groupBy], tableout[, -factorIndex]) + names(tableout)[1:length(groupBy)] <- groupBy + rownames(tableout) <- NULL + tableout <- tableout[do.call(order, tableout), ] + } else { + tableout <- internalTable(tab.freq, na.options = na.options, digits = digits) + } + if (!sparse) { + tableout <- tableout[tableout$Freq != 0, ] + tableout <- droplevels(tableout) + } + variable_labels <- labelTranslations + if (!is.null(labelTranslations)) { + # applies new variable names, reordering to match current data frame output + variable_labels <- labelTranslations[match(names(tableout)[1:length(labelTranslations)], oldnames)] + } + outlist <- list(freqlist=tableout, byVar=groupBy, labels=variable_labels) + class(outlist) <- "freqlist" + ## if(!usingRCF() & !usingNCSA()) { + ## cat(paste0("R-", version$major,".", version$minor, "\t", system("echo $USER",intern=TRUE), "\t", Sys.Date(), "\n"), + ## file="/projects/bsi/infrastructure/s200555.Rinfrastructure/rlogs/freqlist.log",append=TRUE) + ## } + return(outlist) +} + + +#' @rdname freqlist +#' @export +print.freqlist <- function(x, ...) +{ + cat("Freqlist object\n\n") + cat(ncol(x$freqlist) - 4, " variables:\n", sep = "") + print(colnames(x$freqlist)[1:(ncol(x$freqlist) - 4)]) + invisible(x) +} diff --git a/R/freqlist.internal.R b/R/freqlist.internal.R new file mode 100644 index 0000000..2241cc3 --- /dev/null +++ b/R/freqlist.internal.R @@ -0,0 +1,50 @@ +#' as.data.frame.freqlist +#' +#' Convert \code{\link{freqlist}} object to a data.frame. +#' +#' @param x An object of class \code{"freqlist"}. +#' @param ... optional arguments included for S3 consistency +#' @return A data.frame corresponding to the \code{freqlist} object. +#' @export +as.data.frame.freqlist <- function(x, ...) +{ + return(x$freqlist) +} + +#' Helper functions for freqlist +#' +#' A set of helper functions for \code{\link{freqlist}}. +#' +#' @param x,object A \code{freqlist} object. +#' @param value A list of new labels. +#' @param ... Other arguments (not in use at this time, but included for S3 consistency) +#' @name freqlist.internal +NULL +#> NULL + +#' @rdname freqlist.internal +#' @export +'labels<-.freqlist' <- function(x, value) { + + if(is.null(value)) + { + x["labels"] <- list(NULL) + return(x) + } + + if((!is.character(value) || length(value) != ncol(x$freqlist) - 4)) + { + stop("New labels must be 'NULL' or character vector of length ", ncol(x$freqlist) - 4, ".") + } + + x$labels <- value + + ## return freqlist x with updated labels + return(x) +} + +#' @rdname freqlist.internal +#' @export +labels.freqlist <- function(object, ...) { + return(object$labels) +} diff --git a/R/internal.functions.R b/R/internal.functions.R new file mode 100644 index 0000000..bebc788 --- /dev/null +++ b/R/internal.functions.R @@ -0,0 +1,1036 @@ +########## Note from Ethan: if we want these doc pages, just replace all instances of "## '" with "#'" + + +## ' addToRow +## ' +## ' A row is defined as a series of non-empty strings, ended by an empty string or by the end of the +## ' vector. This method finds the 0 based curRow'th row, and pastes the strings passed in to the +## ' matching strings in the row. If there are already more strings in the row than there are to be +## ' added, the remaining strings are padded with spaces, to the length of the first added string. +## ' If there are more strings to add than are currently in the row, strings padded to the length of +## ' the first string in the row are added to the row, then added to
+## ' Examples:
+## ' Input row: {"foo", "bar"}, toAdd {"baz"} --> {"foo baz", "bar "}
+## ' Input row: {"foo"}, toAdd {"bar", "baz"} --> {"foo bar", " baz"}
+## ' +## ' @param rows Vector of strings to edit, and possibly add to +## ' @param curRow Current row to operate on, 0 based +## ' @param toAdd Vector of strings to add to the appropriate row +## ' @param sep Separator to use when pasting together, defaults to " " +## ' @param padChar Character to use when padding out because len row != len toAdd, defaults to ' ' +## ' @return The updated rows +## ' +## ' @author m082166 +addToRow <- function(rows, curRow, toAdd, sep = " ", padChar = ' ') { + numLines <- length(rows) + curLine <- getStartingLine(rows, curRow) + if (curLine > numLines) { + return(rows) # Nothing to do, bail + } + + rowStartSize <- nchar(rows[curLine]) + toAddSize <- nchar(toAdd[1]) + whichAdd <- 1 + numAdd <- length(toAdd) + + while (curLine <= numLines) { + line <- rows[curLine] + if (nchar(line) == 0) + break + + if (whichAdd > numAdd) { # Pad out the line with spaces + line <- paste(line, makePaddedStr("", toAddSize, padChar = padChar), sep = sep) + } + else { + line <- paste(line, toAdd[whichAdd], sep = sep) + } + + rows[curLine] <- line + curLine <- curLine + 1 + whichAdd <- whichAdd + 1 + } + + # Do we have to add more lines to rows? + remainingLines <- (numAdd - whichAdd) + 1 # whichAdd is one greater than # actually added + if (remainingLines > 0) { + newLines <- c() + for (i in 1:remainingLines) { + newLines <- c(newLines, makePaddedStr("", rowStartSize, padChar = padChar)) + } + + if (curLine > numLines) { + rows <- c(rows, newLines) + } + else { + rows <- c(rows[1:(curLine - 1)], newLines, rows[curLine:numLines]) + } + + while (whichAdd <= numAdd) { + line <- rows[curLine] + line <- paste(line, toAdd[whichAdd], sep = sep) + rows[curLine] <- line + curLine <- curLine + 1 + whichAdd <- whichAdd + 1 + } + } + + return(rows) +} + + +## ' integerDigits +## ' +## ' Compute the number of integer digits (i.e. significant digits to the left of the decimal place) +## ' a positive number has +## ' +## ' @param aNumber The number to do the calculations for +## ' @return An integer from 0 up, 0 if input isn't a number +## ' +## ' @author m082166 +integerDigits <- function (aNumber) { + aNumber <- as.numeric(aNumber) + numDigits <- 0 + if (!is.na(aNumber) && aNumber <0) { + aNumber <- -aNumber; + numDigits <- 1; # Account for the minus sign + } + if (is.na(aNumber) || (aNumber <1) | is.infinite(aNumber)) + return(0) + + while (aNumber >=1) { + aNumber <- aNumber /10 + numDigits <- numDigits +1 + } + return(numDigits) +} + + +## ' makeTitleCell +## ' +## ' Return an array of the lines needed to make the label cell, given the data in element, +## ' taking into account the maximum allowed width specified by colSize, +## ' which must be >= 4 + length of the name of element +## ' +## ' @param element List to get information from, whose first item must be the statistics +## ' @param colSize Width to pad the output to +## ' @param translations The List to use for conversion of labels +## ' @param boldMark String to use to mark something as bold +## ' @param indentStr String to use to indent something one space +## ' @param collapse ...? +## ' @return Vector holding the strings necessary to represent the rows of element, +## ' each row separated by a blank string +## ' +## ' @author m082166 +makeTitleCell <- function(element, colSize, translations, boldMark, indentStr, collapse) { + label <- paste0(boldMark, lookupHumanTitle(element$name, translations), boldMark) + theCell <- c(makePaddedStr(label, colSize)) + + if (collapse) # If true, we're done here, nothing more to add + return(theCell) + + statistics <- element$stats # GTD 10/14/15 was statistics <- element[[1]] + theNames <- names(statistics) + numStats <- length(statistics) + + for (i in seq_len(numStats)) { + statistic <- statistics[[i]] + subRows <- rownames(statistic[[1]]) + if (length(subRows > 0)) { + for (label in subRows) { + label <- lookupHumanTitle(label, translations) + # Add blank line to mark new row, then label line(s) + theCell <- c(theCell, "", makeIndentedStr(label, colSize, indentStr = indentStr)) + } + } + else { + label <- lookupHumanTitle(theNames[[i]], translations) + # Add blank line to mark new row, then label line(s) + theCell <- c(theCell, "", makeIndentedStr(label, colSize, indentStr = indentStr)) + } + } + + return(theCell) +} + + +## ' makeHeader +## ' +## ' Make the Pandoc format header for the table specified by group +## ' +## ' @param group Data we're making the table about +## ' @param minColSize Minimum size of the first column (which will hold label info for a row) +## ' @param includeTotal TRUE if should include last pre-pValue column, FALSE if shouldn't +## ' @param hasPValue TRUE if should have column for p-values, FALSE if shouldn't +## ' @param pValueTitle Title for pValue, only matters if hasPValue is TRUE +## ' @param leftJustify If TRUE, will left justify each column, defaults to FALSE +## ' @param rightJustify If TRUE, will right justify each column, defaults to FALSE +## ' When both leftJustify and rightJustify are FALSE, columns are centered +## ' @param labelSize Relative size difference between label column and other columns. +## ' Default is 1.2: label column ~20\% bigger than other columns +## ' @return List holding the lines of the header defined by group plus +## ' lineSize: the length of a full line, +## ' firstColSize: the length of the first column, +## ' colSize: the length of each other column, +## ' header: The lines of the header +## ' The last element is the last line of the output, to go after the body of the output +## ' headers: Vector of the plain header titles for each column +## ' +## ' @author m082166 +makeHeader <- function(group, minColSize, includeTotal, hasPValue, pValueTitle, labelSize = 1.2, + leftJustify = FALSE, rightJustify = FALSE) { + headers <- makeHeaders(group, includeTotal, hasPValue, pValueTitle) + size <- max(nchar(headers)) + 2 # Need one extra "-" on either side to center text + if (size < 10) + size = 10 # Minimum width for a column + bigSize = round(size * labelSize) # Want the first column ~ 20% larger than other columns + if (bigSize < minColSize) { + bigSize <- minColSize + size <- round(bigSize / labelSize) + } + fullSize = bigSize + ((size + 1) * length(headers)) + outsideLine <- makeDashStr(fullSize) + + header <- outsideLine + #First Line + head <- makeDashStr(bigSize, theChar = ' ') + + for (cellH in headers) { # Want it to insert space as separator + head <- paste(head, makeCellHeader(cellH, size, leftJustify, rightJustify)) + } + + header <- c(header, head) + #Second line + head <- makeDashStr(bigSize) + + for (cellH in headers) { + head <- paste(head, makeDashStr(size)) # Want it to insert space as separator + } + + header <- c(header, head) + header <- c(header, outsideLine) + + # Build a named List with the data to return + header <- list(lineSize = fullSize, firstColSize = bigSize, colSize = size, header = header, + headers = headers) + + return(header) +} + + +## ' makeHeaders +## ' +## ' Make the unpadded header for each column other than the label column +## ' +## ' @param group The data that will be turned into a table +## ' @param includeTotal TRUE if should include last pre-pValue column, FALSE if shouldn't +## ' @param hasPValue TRUE if should have column for p-values, FALSE if shouldn't +## ' @param pValueTitle Title for pValue, only matters if hasPValue is TRUE +## ' @return A Vector of the column headers, given the data in group, +## ' skipping the first (blank, label) header +## ' +## ' @author m082166 +makeHeaders <- function(group, includeTotal, hasPValue, pValueTitle) { + element <- group[[1]] + headers <- c() + len <- length(element) + + if (!includeTotal && (len > 1)) + len <- len - 1 + theNames <- names(element) + for (i in seq_len(len)) { + headers <- c(headers, makeCountHeader(theNames[i], element[i])) + } + + if (hasPValue) { + headers <- c(headers, pValueTitle) + } + + return(headers) +} + + +## ' makeCellHeader +## ' +## ' Create a string holding the complete header for a cell, of length size (which must be >= length +## ' of text). Defaults to center justified text , which requires that size >= length of text + 2 +## ' Input is not currently validated, caller responsible for setting values correctly +## ' +## ' @param text The text of the header +## ' @param size The size the header must be padded to +## ' @param leftJustify If TRUE, will left justify each column, defaults to FALSE +## ' @param rightJustify If TRUE, will right justify each column, defaults to FALSE +## ' When both leftJustify and rightJustify are FALSE, columns are centered +## ' @return String of length size +## ' +## ' @author m082166 +makeCellHeader <- function(text, size, leftJustify = FALSE, rightJustify = FALSE) { + neededSpaces <- size - nchar(text) + + if (rightJustify) { + out <- paste0(makeDashStr(neededSpaces, ' '), text) + } + else { + if (leftJustify) { + out <- "" + } + else { + out <- " " + neededSpaces <- neededSpaces - 1 + } + + out <- paste0(out, text, makeDashStr(neededSpaces, ' ')) + } + + return(out) +} + + +## ' makeIndentedStr +## ' +## ' Make a string consisting of indent copies of indentStr followed by the starting string, +## ' all this broken across as many lines as need to so each line is length size or less, +## ' each line followed by however many instances of the repeated character, which defaults to ' ', +## ' are needed to pad out each line to the requested length +## ' +## ' @param startStr The text that will be indented and displayed +## ' @param size Padded width of resulting strings +## ' @param padChar Character to pad out strings to length size, defaults to ' ', +## ' will cause problems if not nchar 1 +## ' @param indent Number of spaces to indent startStr, defaults to 3 +## ' @param indentStr String to use to indent something one space, defaults to " " +## ' (HTML non-breaking space) +## ' @return Vector of one or more strings holding the Pandoc code required to display the indented +## ' string +## ' +## ' @author m082166 +makeIndentedStr <- function(startStr, size, padChar = ' ', indent = 3, indentStr = " ") { + indentLen = nchar(indentStr) + curSize <- 0 + results <- c() + curStr <- "" + + # First add the indent + for (i in 1:indent) { + curSize <- curSize + indentLen + if (curSize <= size) + curStr <- paste0(curStr, indentStr) + else { + results <- c(results, makePaddedStr(curStr, size, padChar = padChar)) + curSize <- indentLen + curStr <- indentStr + } + } + + # Special case a plain text indent + if ((indentLen == 1) && (length(results) == 0) && ((curSize * 2) < size)) { + remainingSize <- size - curSize + hold <- makePaddedStr(startStr, remainingSize, padChar = padChar) + for (outStr in hold) { + results <- c(results, paste0(curStr, outStr)) + } + + return(results) + } + + # Close off indents as their own line + results <- c(results, makePaddedStr(curStr, size, padChar = padChar)) + + # Now add the string + results <- c(results, makePaddedStr(startStr, size, padChar = padChar)) + + return(results) +} + + +## ' pastePaddedStr +## ' +## ' Make one or more strings consisting of the strings in strArray, separated by sep, +## ' followed by however many instances of the repeated character are needed to pad out the results +## ' to strings of the requested length +## ' +## ' @param strArray Vector of strings to paste together +## ' @param size Size of each output string. If size < length of any of the strings in strArray, +## ' strings will be split by makePaddedStr +## ' @param sep Separator for paste, defaults to " " +## ' @param padChar Character to pad out strings to length size, defaults to ' ', +## ' will cause problems if not nchar 1 +## ' @param appendSep If TRUE, and sep and padChar are different, will make sure that n - 1 sep +## ' appear in output (where n = length (strArray)), defaults to FALSE +## ' @return Vector of strings of length size +## ' +## ' @author m082166 +pastePaddedStr <- function(strArray, size, sep = " ", padChar = ' ', appendSep = FALSE) { + if (appendSep) + appendSep = (sep != padChar) + + out <- '' + curSize <- 0 + results <- c() + sepLen = nchar(sep) + + for (aStr in strArray) { + strLen <- nchar(aStr) + if (curSize == 0) { + out <- aStr + curSize <- strLen + } + else { + test <- curSize + sepLen + curSize <- test + strLen + if (curSize <= size) { + out <- paste0(out, sep, aStr) + } + else { + addSep <- appendSep + if (appendSep && (test <= size)) { # Can we add sep to the end without problem? + out <- paste0(out, sep) + addSep <- FALSE + } + results <- c(results, makePaddedStr(out, size, padChar = padChar)) + if (addSep) { + curSize <- strLen + sepLen + if (curSize > size) { # No choice, have to put separator on own line + results <- c(results, makePaddedStr(sep, size, padChar = padChar)) + curSize <- strLen + out <- aStr + } + else { + out <- paste0(sep, aStr) + } + } + else { + curSize <- strLen + out <- aStr + } + } + } + } + + results <- c(results, makePaddedStr(out, size, padChar = padChar)) + + return(results) +} + + +## ' addNumberToEnd +## ' +## ' Make a string starting with the starting string, and ending with the passed in number, +## ' with however many instances of the repeated character are needed to pad out the string to the +## ' requested length +## ' +## ' @param startStr Beginning string +## ' @param addNum Number to put at the end, if NA, or not a number, will just pad to end +## ' @param size How big to make the string +## ' @param digits Number of digits to give the number when formatting it, defaults to 5 +## ' @param padChar What to use when padding the string, defaults to ' ', may break if length != 1 +## ' @param endText Text to add after the number, defaults to "" +## ' @return String of length size, starting with startStr, ending with addNum +## ' +## ' @author m082166 +addNumberToEnd <- function(startStr, addNum, size, digits = 5, padChar = ' ', endText = "") { + addNum <- as.numeric(addNum) + if (is.na(addNum)) + return(makePaddedStr(startStr, size, padChar = padChar)) + + numStr <- paste0(makeLimitedNumber(addNum, digits), endText) + out <- startStr + padSize <- nchar(padChar) + neededSpaces <- (size - nchar(startStr) - nchar(numStr) - padSize) / padSize + if (neededSpaces >= 1) { + for (i in 1:neededSpaces) { + out <- paste0(out, padChar) + } + } + + return(paste(out, numStr, sep = padChar)) +} + + + +## ' makeLimitedNumber +## ' +## ' Make a string with a number, or "< x", where X is minimum number to show +## ' +## ' @param addNum Number to use +## ' @param digits Number of digits to give the number when formatting it +## ' @return String holding addNum, or "< 10^-digits" +## ' +## ' @author m082166 +makeLimitedNumber <- function(addNum, digits) { + test <- 10^(-digits) + if (test > addNum) { # No rounding, it's a strictly less than test + return (paste0("<", format(test, nsmall = digits, scientific = FALSE))) + } + else { + return (format(round(addNum, digits), nsmall = digits, scientific = FALSE)) + } +} + + +## ' makePaddedStr +## ' +## ' Make a string consisting of the starting string, followed by however many instances of the +## ' repeated character are needed to pad out the string to the requested length. +## ' +## ' If nchar (startStr) > size, will try to split startStr at reasonable points so smaller than size, +## ' if that fails will simply break it at size length, & will then return a Vector of padded strings +## ' +## ' @param startStr String providing the text to get padded out +## ' @param size Size to pad the string out to +## ' @param padChar Character to pad out string to length size, defaults to ' ', +## ' will cause problems if not length 1 +## ' @return String of length size, or Vector of strings of length size, if nchar (startStr) > size +## ' +## ' @author m082166 +makePaddedStr <- function(startStr, size, padChar = ' ') { + if (is.null(startStr)) + startStr <- "" + out <- startStr + neededSpaces <- size - nchar(startStr) + if (neededSpaces > 0) { + for (i in 1:neededSpaces) { + out <- paste0(out, padChar) + } + } + + if (neededSpaces >= 0) { + return(out) + } + + # See if can split the string on a reasonable boundary character + for (split in c(" ", "\t", "_", "-", "*", ".", ";", ":")) { + results <- strsplit(startStr, split, fixed = TRUE)[[1]] + if ((length(results) > 1) && (minStrLen(results) <= size)) + return(pastePaddedStr(results, size, sep = split, padChar = padChar, appendSep = TRUE)) + } + + len <- nchar(startStr) + start <- 0 + results <- c() + + while ((len - start) > size) { + results <- c(results, substr(startStr, start + 1, start + size)) + start <- start + size + } + + return(c(results, makePaddedStr(substr(startStr, start + 1, len), size, padChar = padChar))) +} + + + + + +## ' endsWithPad +## ' +## ' Reports if a string ends (or starts) with one of the "boundary characters" that a padded string +## ' could have been split on, including a space +## ' +## ' @param testStr String to test +## ' @param testEnd If TRUE, will test last character, if FALSE will test first character +## ' @return TRUE if has a "pad" / "boundary" character in tested place, else FALSE +## ' +## ' @author m082166 +endsWithPad <- function(testStr, testEnd = TRUE) +{ + len <- nchar (testStr) + if (len == 0) + return (FALSE) + + if (!testEnd) + len <- 1 # Get the first character + + testChar <- substr (testStr, len, len) + for (split in c (" ", "\t", "_", "-", "*", ".", ";", ":")) + { + if (split == testChar) + return (TRUE) + } + + return (FALSE) +} + + +## ' beginsWithPad +## ' +## ' Reports if a string starts with one of the "boundary characters" that a padded string +## ' could have been split on, including a space +## ' +## ' @param testStr String to test +## ' @return TRUE if starts with a "pad" / "boundary" character, else FALSE +## ' +## ' @author m082166 +beginsWithPad <- function(testStr) +{ + return (endsWithPad (testStr, testEnd = FALSE)) +} + + + + + +## ' makeCenteredStr +## ' +## ' Make a string consisting of the starting string, surrounded by however many instances of padChar +## ' are needed to pad out the string to the requested length. +## ' +## ' If nchar (startStr) > size, will split startStr at whitespace so smaller than size, +## ' and will then return a Vector of centered strings of decreasing length.
+## ' If there are lineSplit strings in startStr, will first be split into separate lines, and +## ' each line will be centered separately +## ' +## ' @param startStr String providing the text to get centered +## ' @param size Size to pad the string out to +## ' @param padChar Character to pad out string to length size, defaults to ' ', +## ' will cause problems if not length 1 +## ' @param lineSplit String to split startStr into separate lines, defaults to "\\n" +## ' @param sizeLimit If TRUE, will never output a line length > size, if FALSE will try to avoid +## ' over-long lines, but a "word" longer than size will just be its own line +## ' @return String of length size, or Vector of strings of length size +## ' +## ' @author m082166 +makeCenteredStr <- function(startStr, size, padChar = ' ', lineSplit = "\n", sizeLimit = FALSE) { + finalResults <- c() + for (out in strsplit(startStr, lineSplit, fixed = TRUE)[[1]]) { + neededSpaces <- size - nchar(out) + if (neededSpaces > 0) { + start <- ceiling(neededSpaces / 2) + end <- neededSpaces - start + out <- paste0(makeDashStr(start, " "), out, makeDashStr(end, " ")) + } + + if (neededSpaces >= 0) { + finalResults <- c(finalResults, out) + next + } + + # See if can split the string on spaces + results <- strsplit(out, " ", fixed = TRUE)[[1]] + if ((length(results) > 1) && (minStrLen(results) <= size)) { + finalResults <- c(finalResults, pasteCenteredStr(results, size, padChar = padChar)) + next + } + + if (sizeLimit) { + len <- nchar(out) + start <- 0 + results <- c() + + while ((len - start) > size) { + results <- c(results, substr(out, start + 1, start + size)) + start <- start + size + } + + results <- c(results, makeCenteredStr(substr(out, start + 1, len), size, + padChar = padChar, lineSplit = lineSplit)) + finalResults <- c(finalResults, results) + } + else { + finalResults <- c(finalResults, out) + } + } + + return(finalResults) +} + + +## ' pasteCenteredStr +## ' +## ' Make one or more strings consisting of the strings in strArray, separated by sep, +## ' surrounded by however many instances of padChar are needed to pad out the results +## ' to centered strings of the requested length. The strings will be of roughly equal size, +## ' with a bias for strings to be in decreasing size as we go forward +## ' +## ' @param strArray Vector of strings to paste together +## ' @param size Size of each output string. If size < length of any of the strings in strArray, +## ' strings will be split by makeCenteredStr +## ' @param sep Separator for paste, defaults to " " +## ' @param padChar Character to pad out strings to length size, defaults to ' ', +## ' will cause problems if not nchar 1 +## ' @return Vector of strings of length size +## ' +## ' @author m082166 +pasteCenteredStr <- function(strArray, size, sep = " ", padChar = ' ') { + out <- '' + curSize <- 0 + results <- c() + sepLen = nchar(sep) + totalLen <- sumStrLen(strArray) + (sepLen * (length(strArray) - 1)) + minNumLines <- ceiling(totalLen / size) + baseLineLen <- ceiling(totalLen / minNumLines) + + for (aStr in strArray) { + strLen <- nchar(aStr) + if (curSize == 0) { + out <- aStr + curSize <- strLen + } + else { + curSize <- curSize + sepLen + strLen + if (curSize < baseLineLen) { + out <- paste0(out, sep, aStr) + } + else { + if (curSize <= size) { + out <- paste0(out, sep, aStr) + results <- c(results, makeCenteredStr(out, size, padChar = padChar)) + curSize <- 0 + out <- '' + } + else { + results <- c(results, makeCenteredStr(out, size, padChar = padChar)) + curSize <- strLen + out <- aStr + } + } + } + } + + if (curSize > 0) { + results <- c(results, makeCenteredStr(out, size, padChar = padChar)) + } + + return(results) +} + + + +## ' myFormat +## ' +## ' Format a number, adjusting nsmall as appropriate, and remove all trailing 0s, and a trailing "." +## ' +## ' @param number String to format +## ' @param digits Number of digits to display for number. Will be passed to format. +## ' If nsmall is NULL, will set to max(0, digits - number of integer digits in number) +## ' @param nsmall Minimum number of non-zero digits to the right of the decimal point to display. +## ' Will trim off any ending 0s after decimal place +## ' @param isDate Is it a Date? If TRUE, return it as.character +## ' @param doTrim If doTrim is false, won't trim, otherwise will. Default is TRUE +## ' @return Resulting String, will not be empty unless number was empty +## ' +## ' @author m082166 +myFormat <- function(number, digits, nsmall, isDate = FALSE, doTrim = TRUE) { + if (isDate) + return(as.character (number)) + + if (is.null(nsmall)) { + nsmall <- max(0, digits - integerDigits(number)) + } + + if (doTrim) + return(trimNumber(format(round(as.numeric(number), nsmall), digits = digits, nsmall = nsmall))) + + return(format(round(as.numeric(number), nsmall), digits = digits, nsmall = nsmall)) +} + + +## ' trimNumber +## ' +## ' Take a string representing a number, and remove all trailing 0s, and a trailing "." +## ' +## ' @param number String to trim +## ' @return Resulting String, will not be empty unless number was empty +## ' +## ' @author m082166 +trimNumber <- function(number) { + len <- maxStrLen(number) + if (len <= 1) + return(number) + + dotPos <- str_locate(number, fixed ("."))[1] + if (is.na(dotPos)) + return(number) + + start <- len + while ((len > 1) && (substr(number, len, len) == "0")) { + len = len - 1 + } + + if (substr(number, len, len) == ".") { + if (len > 1) { + len = len - 1 + } + else { # All we have is "." + return("0") + } + } + + if (len == start) + return(number) + + return(substr(number, 1, len)) +} + + +## ' makeDashStr +## ' +## ' Make a string consisting of count instances of the repeated character +## ' +## ' @param count Size of the returned string +## ' @param theChar Character to use when building the string, defaults to '-' +## ' @return String of length count +## ' +## ' @author m082166 +makeDashStr <- function(count, theChar = '-') { + return(paste(replicate(count, theChar), collapse = "")) +} + + + +## ' maxNameLen +## ' +## ' Return the length of the longest string among the names of elements +## ' +## ' @param elements A List of Lists +## ' @param translations The List to use for conversion of labels, so can use the proper name length +## ' @return The nchar length of the longest name from element's sub-lists, +## ' as translated via translations +## ' +## ' @author m082166 +maxNameLen <- function(elements, translations) { + theMax = 0 + + for (item in elements) { + theMax <- max(theMax, nchar(lookupHumanTitle(names(item[[1]]), translations))) + } + + return(theMax) +} + + +## ' maxStrLen +## ' +## ' Return the length of the longest string in a Vector of strings +## ' +## ' @param strings Vector of Strings +## ' @return The nchar length of the longest string in the Vector +## ' +## ' @author m082166 +maxStrLen <- function(strings) { + return(max(0, nchar(strings))) +} + + +## ' minStrLen +## ' +## ' Return the length of the shortest string in a Vector of strings +## ' +## ' @param strings Vector of Strings +## ' @return The nchar length of the shortest string in the Vector +## ' +## ' @author m082166 +minStrLen <- function(strings) { + return(min(0, nchar(strings))) +} + + +## ' sumStrLen +## ' +## ' Return the sum of the lengths of the strings in a Vector of strings +## ' +## ' @param strings Vector of Strings +## ' @return The sum of the nchar lengths of the strings in the Vector +## ' +## ' @author m082166 +sumStrLen <- function(strings) { + return(sum(0, nchar(strings))) +} + + +## ' lookupHumanTitle +## ' +## ' Take a string, and see if we have a human readable version of that string +## ' +## ' @param label The label to convert, or a vector of labels to convert +## ' @param translations The List to use for conversion of labels, defaults to format.translations +## ' @return More human readable version of the label, if have one, else the passed in label. +## ' If was passed a Vector, will return a Vector of translations +## ' +## ' @author m082166 +lookupHumanTitle <- function(label, translations = format.translations) { + if (length(label) == 1) { # Can have single string, or vector of strings + humanText <- translations[[label]] + if (!is.null(humanText)) + return(humanText) + + return(label) + } + + results <- c() + for (aLabel in label) { + humanText <- translations[[aLabel]] + if (!is.null(humanText)) { + results <- c(results, humanText) + } + else { + results <- c(results, aLabel) + } + } + + return(results) +} + + + + +## ' format.addTranslations +## ' +## ' Add translations from machine produced labels to a human readable ones +## ' Get translations from object control parameters as well as what was passed in +## ' +## ' @param object The data defining the table to display, and its control parameters +## ' @param transList List where name is the label in the output, and value is the label to display +## ' e.g. list (q1q3 = "Q1, Q3", medsurv = "Median Survival") +## ' @param baseList List holding any default / starting translations +## ' @param elemCol The column of object that holds the elements, defaults to "x" +## ' @param nameCol ...? +## ' @return Current translation list +## ' +## ' @author m082166 +format.addTranslations <- function(object, transList, baseList = format.translations, + elemCol = "x", nameCol = "name") +{ + elements <- object[[elemCol]] + + # First add all names with a label of the name capitalized + # theNames <- names(elements) + # for (name in theNames) { + # baseList[[name]] <- capitalizeWords(name) + # } + + # Now get every name that has an existing label, where label != name + for (element in elements) { + theLabels <- element$label + theNames <- element[[nameCol]] + numNames <- min (length (theNames), length (theLabels)) + + for (i in seq_len (numNames)) { + name <- theNames[i] + label <- theLabels[i] + if (name != label) { + baseList[[name]] <- label + } + } + } + + # Now get labels specified in the control parameter, which is a named list + labels <- object$control$stats.labels + theNames <- names (labels) + for (name in theNames) { + baseList[[name]] <- labels[[name]] + } + + # Finally get any labels specified with the call to summary + for (theName in names(transList)) { + baseList[[theName]] <- transList[[theName]] + } + + return(baseList) +} + + + + +## ' addTranslations +## ' +## ' Add translations from machine produced labels to a human readable ones +## ' +## ' @param translations List to add to where name is the label in the output, and value is the +## ' label to display, e.g. list (q1q3 = "Q1, Q3", medsurv = "Median Survival") +## ' @param machine Machine produced labels +## ' @param human Human readable versions +## ' @return Updated translation list +## ' +## ' @author m082166 +addTranslations <- function(translations, machine, human) { + # for (labs in machine) { + # translations[[labs]] <- human[labs] + # } + + transCount <- min(length(machine), length(human)) + + for (i in seq_len(transCount)) { + name <- machine[i] + label <- human[i] + if (name != label) { + translations[[name]] <- label + } + } + + return(translations) +} + + + +## ' capitalizeWords +## ' +## ' Take a string holding one or more words, and capitalize each word +## ' +## ' @param theStr String to capitalize +## ' @return String with each word capitalized +## ' +## ' @author m082166 +capitalizeWords <- function(theStr) { + strArry <- strsplit(theStr, " ")[[1]] + return (paste0(toupper(substring(strArry, 1,1)), substring(strArry, 2), collapse = " ")) +} + + + +## ' setParam +## ' +## ' Figure out which parameter value to use, and return it +## ' +## ' @param value The value to test. If it passes the test, will use it. If not, will use default +## ' @param default What to use if value isn't valid +## ' @param testNA If TRUE, reject value if it's NA, if FALSE, reject value if it's NULL. +## ' Defaults to TRUE +## ' @return Value, or default +## ' +## ' @author m082166 +setParam <- function(value, default, testNA = TRUE) { + if (testNA) { + if (is.na(value)) + return (default) + return (value) + } + + if (is.null(value)) + return (default) + return (value) +} + + +## ' setParam3 +## ' +## ' Figure out which parameter value to use, and return it, three option case +## ' +## ' @param value The value to test. If it passes the test, will use it. +## ' If not, will use default +## ' @param default What to use if value isn't valid +## ' @param finalDefault What to use if default isn't valid +## ' @param testNA If TRUE, reject value if it's NA, if FALSE, reject value if it's NULL. +## ' Defaults to TRUE. However, when testing "default", will test for NULL in all cases +## ' @return Value, or default +## ' +## ' @author m082166 +setParam3 <- function(value, default, finalDefault, testNA = TRUE) { + if (testNA) { + if (is.na(value)) { + if (is.null(default)) { + return (finalDefault) + } + return (default) + } + return (value) + } + + if (is.null(value)) { + if (is.null(default)) { + return (finalDefault) + } + return (default) + } + return (value) +} + + diff --git a/R/magic8.R b/R/magic8.R new file mode 100644 index 0000000..4c4cb08 --- /dev/null +++ b/R/magic8.R @@ -0,0 +1,37 @@ + + +magic8 <- function(question=NULL){ + sample(c("There is an 'apply' function for that", + 'It is decidedly so', + 'Without a doubt', + "Need to install another bioconductor package for that", + 'Better off asking Siri', + 'You may rely on it', + 'As I see it, yes', + 'Most likely', + "It might be time for a walking break", + 'Just bootstrap it', + 'May need to perform simulations', + 'Signs point to yes', + "You need to go home and rethink your life", + 'Reply hazy; try again', + 'Insufficient sample size', + 'The answer is 7', + "Bazinga!", + 'Cannot predict right now', + 'Concentrate and ask again', + "Don't count on it", + 'Maybe, p-value 0.06', + 'Hierarchical clustering always gives an answer', + 'My sources say no', + 'Make a 3-D pie chart', + "Yes, if the figure is colorful", + 'Very doubtful', + "PC Load Letter", + "Not Sure", + "The possibility of successfully answering your question is approximately three thousand seven hundred and twenty to one!", + "Depends...did you want the two-tailed probability or the one-tailed?", + "Error: 404 Not Found", + "You index is off by one (we won't tell)", + "Correlation does not equal causation"), 1) +} diff --git a/R/mdy.Date.R b/R/mdy.Date.R new file mode 100644 index 0000000..cf7c37e --- /dev/null +++ b/R/mdy.Date.R @@ -0,0 +1,55 @@ +## Author: Terry Therneau +## Contributed on 8/30/2013 +## Updated 7/23/2014 by Jason Sinnwell + +#' Convert numeric dates to Date object, and vice versa +#' +#' Convert numeric dates for month, day, and year to Date object, and vice versa. +#' +#' @param month integer, month (1-12). +#' @param day integer, day of the month (1-31, depending on the month). +#' @param year integer, either 2- or 4-digit year. If two-digit number, will add 1900 onto it, depending on range. +#' @param yearcut cutoff for method to know if to convert to 4-digit year. +#' @param date A date value. +#' @return \code{mdy.Date} returns a Date object, and Date.mdy returns a list with integer values for month, day, and year. +#' @details More work may need to be done with yearcut and 2-digit years. Best to give a full 4-digit year. +#' @seealso \code{\link{Date}}, \code{\link{DateTimeClasses}} +#' @examples +#' mdy.Date(9, 2, 2013) +#' +#' tmp <- mdy.Date(9, 2, 2013) +#' Date.mdy(tmp) +#' @name mdy.Date +NULL +#> NULL + +#' @rdname mdy.Date +#' @export +# mdy.Date(c(0,5),c(1, 1),c(2014, 2013)) # should return NA, "2013-05-01" +mdy.Date <- function(month, day, year, yearcut=120) { + ## keep operations vectorized + ## NA for day or month out of range + day <- as.numeric(day) + day <- ifelse(day < 1 | day > 31, NA, day) # stop ("invalid day") + + month <- as.numeric(month) + month <- ifelse(month < 1 | month > 12 | month != floor(month), NA, month) + + year <- ifelse(year < yearcut, year + 1900, year) + temp <- cbind(year, month, day) # force them all to the same length + ## allow NAs + dtext <- rep(NA, nrow(temp)) + dtext[rowSums(is.na(temp)) < 1] <- paste(temp[rowSums(is.na(temp)) < 1, 1, drop=FALSE], + sprintf("%2d", temp[rowSums(is.na(temp)) < 1, 2, drop=FALSE]), + sprintf("%2d", temp[rowSums(is.na(temp)) < 1, 3, drop=FALSE]), sep='/') + + as.Date(dtext) +} + +#' @rdname mdy.Date +#' @export +Date.mdy <- function(date) { + temp <- unclass(as.POSIXlt(date)) + list(month=temp$mon+1, day=temp$mday, year=1900+temp$year) +} + diff --git a/R/mockstudy.R b/R/mockstudy.R new file mode 100644 index 0000000..4ed06df --- /dev/null +++ b/R/mockstudy.R @@ -0,0 +1,27 @@ +#' Mock study data for examples +#' +#' Mock clinical study data for examples to test data manipulation and statistical functions +#' +#' @format A data frame with 1499 observations on the following 15 variables: +#' \describe{ +#' \item{\code{case}}{a numeric identifier-patient ID} +#' \item{\code{age}}{age in years} +#' \item{\code{arm}}{treatment arm divided into 3 groups, character string } +#' \item{\code{sex}}{a factor with levels \code{Male} \code{Female}} +#' \item{\code{race}}{self-reported race/ethnicity, character string} +#' \item{\code{fu.time}}{survival or censoring time in years} +#' \item{\code{fu.stat}}{censoring status; 1=censor, 2=death} +#' \item{\code{ps}}{integer, ECOG performance score } +#' \item{\code{hgb}}{numeric, hemoglobin count} +#' \item{\code{bmi}}{numeric, body mass index, kg/m^2} +#' \item{\code{alk.phos}}{numeric, alkaline phosphatase} +#' \item{\code{ast}}{numeric, aspartate transaminase } +#' \item{\code{mdquality.s}}{integer, LASA QOL 0=Clinically Deficient, 1=Not Clinically Deficient } +#' \item{\code{age.ord}}{an ordered factor split of age, with levels +#' \code{10-19} < \code{20-29} < \code{30-39} < \code{40-49} < +#' \code{50-59} < \code{60-69} < \code{70-79} < \code{80-89}} +#' } +#' @examples +#' data(mockstudy) +#' str(mockstudy) +"mockstudy" diff --git a/R/modelsum.R b/R/modelsum.R new file mode 100644 index 0000000..187d448 --- /dev/null +++ b/R/modelsum.R @@ -0,0 +1,544 @@ +## Purpose: multiple models from multiple y and x variables +## Author: P Votruba J Sinnwell and Beth Atkinson +## Created: 9/3/2015 +## Updated: 10/6/2015 +## Updated: 4/6/2016 to complete using of broom tidy and glance +## Updated: 4/12/2016 to make lm.beta work to skip categorical and psplines +## Updated: 5/19/2016 get labels and y~. and y~x1 working. subsets working. +## Updated: 6/28/2016 -label() works for assign and get, for x, adjust, and y. +## -Expanded labels for categorical adjust and x variables. +## Updated: 7/25/2016 bug fix for when multiple data columns match y name + +## examples now in modelsum.Rd and test.modelsum.R and modelsum.Rmd vignette + +#' Fit models over each of a set of independent variables with a response variable +#' +#' Fit and summarize models for each independent (x) variable with a response variable (y), with options to adjust by variables for each model. +#' +#' @param formula an object of class \code{\link{formula}}; a symbolic description of the variables to be modeled. See "Details" for more information. +#' @param adjust an object of class \code{\link{formula}}, listing variables to adjust by in all models. Specify as a one-sided formula, +#' like: \code{~Age+ Sex}. +#' @param family similar mechanism to \code{\link[stats]{glm}}, where the model to be fit is driven by the family, options include: binomial, gaussian, survival, +#' Poisson. Family options supported in glm can be in quotes or not, but survival requires quotes. +#' @param data an optional data.frame, list or environment (or object coercible by \code{\link[base]{as.data.frame}} to a data frame) containing the +#' variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically +#' the environment from which \code{modelsum} is called. +#' @param subset an optional vector specifying a subset of observations (rows of \code{data}) to be used in the results. +#' Works as vector of logicals or an index. +#' @param weights an optional vector specifying the weights to apply to each data observation (rows of \code{data}) +#' @param na.action a function which indicates what should happen when the data contain \code{NA}s. +#' The default is set by the \code{na.modelsum} setting of \code{options}, and is \code{na.fail} if that is unset. The default is +#' to include observations with \code{NA}s in x variables, but remove those with \code{NA} in response variable. +#' @param control control parameters to handle optional settings within \code{modelsum}. Control arguments can be passed to \code{modelsum}, +#' which are carried forward to \code{modelsum.control} via the \code{...} argument. See \code{\link{modelsum.control}} for more details. +#' @param ... additional arguments to be passed to internal \code{modelsum} functions. See "Details" for information. +#' @param x An object of class \code{'modelsum'}, or a list of such objects. +#' @return +#' An object with class \code{'modelsum'}, which is effectively a list with the variables from the right-side in x and the group variable in y. +#' Then, each item in x has these: +#' \item{fits}{a list with an item in X for each x in y ~ X + adjust variables} +#' \item{family}{family used in glm} +#' \item{Call}{Original call to modelsum} +#' \item{control}{list of control parameters used in \code{modelsum}, and to be used in \code{\link{summary.modelsum}}, +#' the result of \code{\link{modelsum.control}}} +#' @author Jason Sinnwell, Patrick Votruba, Beth Atkinson, Gregory Dougherty, adapted from SAS Macro of the same name +#' @seealso \code{\link{modelsum.control}}, \code{\link{summary.modelsum}}, \code{\link{formulize}} +#' @examples +#' +#' data(mockstudy) +#' +#' tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) +#' summary(tab1, text=TRUE) +#' +#' tab2 <- modelsum(alk.phos ~ arm + ps + hgb, adjust= ~age + sex, family="gaussian",data=mockstudy) +#' summary(tab2, text=TRUE) +#' +#' summary(tab2, show.intercept=FALSE, text=TRUE) +#' +#' tab2.df <- as.data.frame(tab2) +#' +#' tab2.df[1:5,] +#' @import broom +#' @name modelsum +NULL +#> NULL + +#' @rdname modelsum +#' @export + +modelsum <- function(formula, family="gaussian", data, adjust=NULL, na.action=na.modelsum, + subset=NULL, weights=NULL, control=list(...), ...) { + Call <- match.call() + + ## Allow family parameter to passed with or without quotes + ## exception is survival, would require public function named survival. + ## Here, we force quotes to simplify in for loop below + if (is.function(family)) + family <- family()$family + + if(family %nin% c("survival","gaussian","binomial","poisson","quasibinomial","quasipoisson")) + stop("Family ", family, "not supported.\n") + + if(family != "survival" && any(grepl("Surv\\(", formula))) { + warning("Found Surv in formula, assuming family='survival'\n") + family <- "survival" + } + ## pick up extra control arguments from command via ... + control <- do.call("modelsum.control", control) + + ## Tell user if they passed an argument that was not expected, either here or in control + expectArgs <- c("formula","family","adjust","data","na.action","subset","weights", "control", names(control)) + match.idx <- match(names(Call)[-1], expectArgs) + if(any(is.na(match.idx))) { + warning("unused arguments: ", paste(names(Call)[1+which(is.na(match.idx))],collapse=", "), "\n") + } + + indx.adjust <- match(c("adjust"), names(Call), nomatch = 0) + adjVars <- NULL + + if(indx.adjust != 0) { + ## will add adjVars to end of RHS of formula + j <- length(formula) + adjLen <- length(adjust[[2]]) + if(adjLen < 2) { + adjVars <- as.character(adjust[2]) + } else { + adj2 <- as.list(adjust[[2]]) + while(adjLen >=2 & as.character(adj2[[1]]) %nin% c("pspline","offset")) { + adjVars <- c(adjVars,as.character(adj2[length(adj2)])) + adj2 <- as.list(adj2[-length(adj2)][[2]]) + adjLen <- length(adj2) +# as.character(adjust[[2]][2:length(adjust[[2]])])) + } + adjVars <- c(adjVars,as.character(adj2)) # [2:length(adj2)])) + adjVars <- adjVars[!(adjVars == "pspline" | adjVars == "offset")] + } + + formula[[j]] <- call("+", formula[[j]], call("(", adjust[[2]])) + } + + indx.subset <- match(c("subset"), names(Call), nomatch = 0) + subsetVarsAdd <- NULL + if(indx.subset != 0) { + ## will add subsetVars to end of RHS of formula + j <- length(formula) + ## fix subsetting + oldwarn <- options()$warn + options(warn=-1) + subsetVars <- unlist(str_match_all(as.character(Call[indx.subset]),names(data))) + ##Subset to only those not already in formula + subsetVarsAdd <- subsetVars[subsetVars %nin% + unlist(str_match_all(paste0(as.character(formula),collapse=""), subsetVars))] + + if(length(subsetVarsAdd)>0 ) { + formula[[j]] <- call("+", formula[[j]], call("(",as.name(subsetVarsAdd))) + } + options(warn=oldwarn) + } +# indx <- match(c("formula", "data", "subset", "weights", "na.action"), names(Call), nomatch = 0) +# if(indx[4] != 0) { ## weights +# weights <- as.vector(stats::model.weights(modeldf)) + + temp.call <- call("model.frame", formula = formula) + + for (i in c("data", "subset", "weights", "na.action")) { + if (!is.null(Call[[i]])) { + temp.call[[i]] <- Call[[i]] + } + } + if(is.null(temp.call$na.action)) { + temp.call$na.action <- na.modelsum + } + + ## if(is.null(temp.call$weights)) { + ## temp.call$weights <- rep(1, nrow()) + ## } + ## added 1/12/16 by JPS + ## strip down formula for model.frame to just variables for use within loop + baseFormula <- temp.call$formula + ## y + + if(any(grepl("Surv",as.character((baseFormula[[2]]))))) { + ## skip ybase, put something here ##| length(baseFormula[[2]]) > 1 + ybase <- "" + } else { + ybase <- unlist(tapply(as.character(baseFormula[[2]]), 1:length(baseFormula[[2]]), + function(x) {tmp <- str_match(x, colnames(data)); tmp[!is.na(tmp),1]})) + ## if length > 1, choose one without parens "(" + ybase <- ybase[!grepl("\\(",ybase)] + if(length(ybase)>1) { + ## if still > 1, choose one that matches best + ypct <- unlist(tapply(as.character(baseFormula[[2]]), 1:length(baseFormula[[2]]), + function(x) {tmp <- str_match(x, colnames(data)); tmp <- tmp[!is.na(tmp),1]; nchar(tmp)/nchar(x)})) + ybase <- ybase[which(abs(ypct-1) == min(abs(ypct-1)))] + } + } + ## xvars + adjust + xvars <- character() + xformula <- as.character(baseFormula[[3]]) + for(xform in xformula) { + if(xform == ".") { + xvars <- colnames(data)[-grep(ybase,colnames(data))] + next + } + if(xform %nin% c("+","*","|")) { + xbase <- str_match(xform, colnames(data)) + xvars <- c(xvars, xbase[!is.na(xbase),1]) + } + } + + base.call <- temp.call + base.call$formula <- stats::as.formula(paste0(ybase, "~", paste(xvars, collapse="+"))) + ## undo for surv response, or I(fun(y)) + if(any(grepl("Surv",as.character((baseFormula[[2]]))))) { + #if(any(grepl("Surv",as.character((baseFormula[[2]]))))) { #grepl("\\(",as.character(baseFormula[[2]])))) { + base.call$formula[[3]] <- base.call$formula[[2]] + base.call$formula[[2]] <- temp.call$formula[[2]] + } + + ## create the environment where the formula will be evalulated + tabenv <- new.env(parent = environment(formula)) + environment(temp.call$formula) <- environment(base.call) <- tabenv + + basedf <- eval.parent(base.call) + modeldf <- eval.parent(temp.call) + ## ----- add weights + weights <- as.vector(stats::model.weights(modeldf)) + if(is.null(weights)) { + weights <- rep(1, nrow(basedf)) + base.call$weights <- rep(1, nrow(basedf)) + } + if (!is.null(weights) && (!is.numeric(weights) | any(weights<0))) { + stop("'weights' must be a numeric vector and must be non-negative") + } + + if("(weights)" %in% colnames(modeldf)) { + modeldf <- modeldf[,!grepl("(weights)", colnames(modeldf))] + basedf <- basedf[,!grepl("(weights)", colnames(basedf))] + } + ## assign weights, formula, data, etc. but don't need subset + for(cc in names(base.call)[-c(1,grep("subset",names(base.call)))]){ + assign(cc, get(cc), envir=tabenv) + } + + ## this assigns what is needed for evaluating all models with x, adjust, subset + ## check with: ls(envir=tabenv) + assign("basedf",basedf, envir=tabenv) + + if(family=="survival" | family=="poisson") { + ## put time/event/status vars into basedf, for surv, which is subsetted + if(is.null(subset)) { + subset=rep(TRUE, nrow(data)) + } + svars <- str_trim(strsplit(names(basedf)[1],split=",")[[1]],side="both") + rparidx <- ifelse(grepl("\\)", svars), regexpr("\\)",svars)-1,nchar(svars)) + svars <- substr(svars, 1, rparidx) + lparidx <- ifelse(grepl("\\(", svars), regexpr("\\(",svars)+1,1) + svars <- substr(svars, lparidx,nchar(svars)) + for(sname in svars) { + basedf[,sname] <- data[subset,sname] + } + } + + if (nrow(basedf) == 0) { + stop("No (non-missing) observations") + } + + fitList <- list() + modeldf <- modeldf[,!duplicated(colnames(modeldf))] + adjCols <- sapply(adjVars,function(x) grep(x, colnames(modeldf), fixed=TRUE)) + if(length(adjCols)<1) adjCols <- numeric() + ## adjCols <- which(colnames(modeldf) %in% adjVars) + subsetCols <- which(colnames(modeldf) %in% subsetVarsAdd) + ## effect columns are only those not in adjust and only in subset (excluded those in formula) + effCols <- (1:ncol(modeldf))[-c(1,adjCols,subsetCols)] + yTerm <- colnames(modeldf)[1] + yLabel <- attributes(modeldf[,1])$label + if(is.null(yLabel)) { + yLabel <- yTerm + } + + for(eff in effCols) { + + formulaStr <- paste0(yTerm, "~", paste(colnames(modeldf)[c(eff, adjCols)], collapse="+")) + + ## placeholder for ordered, don't do any fitting + ## y is ordered factor + if (family == "ordered") { + xname <- colnames(modeldf)[eff] + ## look into using same ordered test from tableby + fitList[[xname]] <- list(#coeff=summary(coeff(p(modeldf[,1]~ modeldf[,eff]), + N=sum(!is.na(modeldf[,eff])), + family="ordered", label=xname) + } else if (family == "gaussian") { + ## issue warning if appears categorical + if(length(unique(modeldf[,1])) <= 5) { + warning("Input family=gaussian, but dependent variable has 5 or fewer categories\n") + } + xname <- colnames(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- xname + + lmfit <- eval(call("lm", formula=formulaStr, data=basedf, x=TRUE, weights=weights), envir=tabenv) + ## lmfit <- stats::lm(formulaStr, data=basedf, weights="weights", ) + coeffTidy <- tidy(lmfit, conf.int=TRUE, conf.level=control$conf.level) + + if(any(grepl("(weights)", colnames(lmfit$model)))) { + lmfit$model <- lmfit$model[,-grep("(weights)", colnames(lmfit$model))] + } + coeffTidy$standard.estimate <- lm.beta(lmfit) + names(coeffTidy) <- gsub("conf.low","CI.lower.estimate", + gsub("conf.high", "CI.upper.estimate",names(coeffTidy))) + xterms=coeffTidy[grep(xname,coeffTidy$term,fixed=TRUE),"term"] + ## handle when xterm is categorical with level tagged on + if(nchar(xterms[1]) > nchar(xname)) { + labelEff <- gsub(xname, paste0(labelEff, " "), xterms) + } + adjterms <- adjlabels <- NULL + for(adj in adjVars) { ## manage adj terms and labels + aterm <- coeffTidy[grep(adj,coeffTidy$term,fixed=TRUE),"term"] + if(length(aterm)>0) { + adjterms <- c(adjterms, aterm) + alabel <- attributes(modeldf[,adj])$label + if(is.null(alabel)) + alabel <- adj + ## handle when adj term is categorical with level tagged on + if(nchar(aterm[1]) > nchar(adj)) + alabel <- gsub(adj, paste0(alabel, " "), aterm) + adjlabels <- c(adjlabels, alabel) + } + } + + ## Continuous variable (numeric) ############### + ## Note: Using tidy changes colname from 't value' to 'statistic' + modelGlance <- c(glance(lmfit),N=sum(!is.na(modeldf[,eff])), + Nmiss=sum(is.na(modeldf[,eff]))) + names(modelGlance) <- gsub("p.value","p.value.F", names(modelGlance)) + if(any(grepl("Nmiss2",control$gaussian.stats))) { + names(modelGlance) <- gsub("Nmiss","Nmiss2", names(modelGlance)) + } + fitList[[xname]] <- list(coeff=coeffTidy, + family="gaussian", + xterms=xterms, label=labelEff, + adjterms=adjterms, adjlabels=adjlabels, + glance=modelGlance) + + } else if (family == "binomial" || family == "quasibinomial") { + ## These families are used in glm + + ## I think this is taken care of with the pROC:: below + ## require(pROC, quietly=TRUE,warn.conflicts=FALSE) + + xname <- colnames(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- xname + + fit <- eval(call("glm", formula=formulaStr, data=basedf, family=family, x=TRUE, weights=weights), envir=tabenv) + # fit <- glm(formulaStr, data=basedf, family=family, x=TRUE, weights="weights") + rocOut <- pROC::roc(fit$y ~ predict(fit, type='response')) + #coeffbeta <- summary(fit)$coef + ## find out that broom:::tidy.lm allows conf.int and exp + coeffORTidy <- tidy(fit, exponentiate=TRUE, conf.int=TRUE, conf.level=control$conf.level) + coeffORTidy[grep("Intercept",coeffORTidy$term),-1] <- NA + coeffTidy <- tidy(fit, exponentiate=FALSE, conf.int=TRUE, conf.level=control$conf.level) + names(coeffTidy) <- gsub("conf.low","CI.lower.estimate", + gsub("conf.high", "CI.upper.estimate",names(coeffTidy))) + + coeffTidy <- data.frame(coeffTidy, OR=coeffORTidy$estimate, + CI.lower.OR=coeffORTidy$conf.low, + CI.upper.OR=coeffORTidy$conf.high) + + xterms <- coeffTidy[grep(xname,coeffTidy$term,fixed=TRUE),"term"] + ## handle when xterm is categorical with level tagged on + if(nchar(xterms[1]) > nchar(xname)) { + labelEff <- gsub(xname, paste0(labelEff, " "), xterms) + } + adjterms <- adjlabels <- NULL + for(adj in adjVars) { ## manage adj terms and labels + aterm <- coeffTidy[grep(adj,coeffTidy$term,fixed=TRUE),"term"] + if(length(aterm)>0) { + adjterms <- c(adjterms, aterm) + alabel <- attributes(modeldf[,adj])$label + if(is.null(alabel)) + alabel <- adj + ## handle when adj term is categorical with level tagged on + if(nchar(aterm[1]) > nchar(adj)) + alabel <- gsub(adj, paste0(alabel, " "), aterm) + adjlabels <- c(adjlabels, alabel) + } + } + ## tidy data frame has extra column for terms (row names), shift col index +1 + ## 'z value' changed to 'statistic' + modelGlance <- c(glance(fit),concordance=pROC::auc(rocOut), + N=sum(!is.na(modeldf[,eff])), Nmiss=sum(is.na(modeldf[,eff]))) + if(any(grepl("Nmiss2",control$binomial.stats))) { + names(modelGlance) <- gsub("Nmiss","Nmiss2", names(modelGlance)) + } + fitList[[xname]] <- list(coeff=coeffTidy, + family=family, label=labelEff, + xterms=xterms, adjterms=adjterms, + glance=modelGlance) + + } else if (family == "quasipoisson" || family == "poisson") { + ## These families use glm + xname <- colnames(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- xname + fit <- eval(call("glm", formula=formulaStr, data=basedf, family=family, x=TRUE, weights=weights), envir=tabenv) + +## fit <- glm(formulaStr, data=basedf, family=family, x=TRUE, weights=weights) + #coeffbeta <- summary(fit)$coef + ## find out that broom:::tidy.lm allows conf.int and exp + coeffRRTidy <- tidy(fit, exponentiate=TRUE, conf.int=TRUE, conf.level=control$conf.level) + coeffRRTidy[grep("Intercept",coeffRRTidy$term),-1] <- NA + coeffTidy <- tidy(fit, exponentiate=FALSE, conf.int=TRUE, conf.level=control$conf.level) + names(coeffTidy) <- gsub("conf.low","CI.lower.estimate", + gsub("conf.high", "CI.upper.estimate",names(coeffTidy))) + + coeffTidy <- data.frame(coeffTidy, RR=coeffRRTidy$estimate, + CI.lower.RR=coeffRRTidy$conf.low, + CI.upper.RR=coeffRRTidy$conf.high) + + xterms <- coeffTidy[grep(xname,coeffTidy$term,fixed=TRUE),"term"] + ## handle when xterm is categorical with level tagged on + if(nchar(xterms[1]) > nchar(xname)) { + labelEff <- gsub(xname, paste0(labelEff, " "), xterms) + } + adjterms <- adjlabels <- NULL + for(adj in adjVars) { ## manage adj terms and labels + aterm <- coeffTidy[grep(adj,coeffTidy$term,fixed=TRUE),"term"] + if(length(aterm)>0) { + adjterms <- c(adjterms, aterm) + alabel <- attributes(modeldf[,adj])$label + if(is.null(alabel)) + alabel <- adj + ## handle when adj term is categorical with level tagged on + if(nchar(aterm[1]) > nchar(adj)) + alabel <- gsub(adj, paste0(alabel, " "), aterm) + adjlabels <- c(adjlabels, alabel) + } + } + ## tidy data frame has extra column for terms (row names), shift col index +1 + ## 'z value' changed to 'statistic' + + modelGlance <- c(glance(fit),N=sum(!is.na(modeldf[,eff])), Nmiss=sum(is.na(modeldf[,eff]))) + if(any(grepl("Nmiss2",control$poisson.stats))) { + names(modelGlance) <- gsub("Nmiss","Nmiss2", names(modelGlance)) + } + fitList[[xname]] <- list(coeff=coeffTidy, + family=family, label=labelEff, + xterms=xterms, adjterms=adjterms, + glance=modelGlance) + + } else if(family=="survival") { + + xname <- colnames(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- xname + + ph <- eval(call("coxph", formula=stats::as.formula(formulaStr), data=basedf, weights=weights), envir=tabenv) + + #ph <- coxph(stats::as.formula(formulaStr), data=data, weights=weights) ## should be this:modeldf) + ## use tidy to get both CIs, merge + coeffHRTidy <- tidy(ph, exponentiate=TRUE, conf.int=.95) + coeffTidy <- tidy(ph, exponentiate=FALSE, conf.int=.95) + names(coeffTidy) <- gsub("conf.low","CI.lower.estimate", + gsub("conf.high", "CI.upper.estimate",names(coeffTidy))) + coeffTidy <- data.frame(coeffTidy, HR=coeffHRTidy$estimate, + CI.lower.HR=coeffHRTidy$conf.low, + CI.upper.HR=coeffHRTidy$conf.high) + + ## coeffTidy[ coeffTidy > 1e60 | coeffTidy < -1e60] <- NA + + xterms <- coeffTidy[grep(xname,coeffTidy$term,fixed=TRUE),"term"] + ## handle when xterm is categorical with level tagged on + if(nchar(xterms[1]) > nchar(xname)) { + labelEff <- gsub(xname, paste0(labelEff, " "), xterms) + } + adjterms <- adjlabels <- NULL + for(adj in adjVars) { ## manage adj terms and labels + aterm <- coeffTidy[grep(adj,coeffTidy$term,fixed=TRUE),"term"] + if(length(aterm)>0) { + adjterms <- c(adjterms, aterm) + alabel <- attributes(modeldf[,adj])$label + if(is.null(alabel)) + alabel <- adj + ## handle when adj term is categorical with level tagged on + if(nchar(aterm[1]) > nchar(adj)) + alabel <- gsub(adj, paste0(alabel, " "), aterm) + adjlabels <- c(adjlabels, alabel) + } + } + + ## work with fit to get hr, try summary(fit) as above + modelGlance <- c(glance(ph),Nmiss=sum(is.na(modeldf[,eff]))) + names(modelGlance) <- gsub("n$","N", gsub("nevent","Nevent", names(modelGlance))) + if(any(grepl("Nmiss2",control$survival.stats))) { + names(modelGlance) <- gsub("Nmiss","Nmiss2", names(modelGlance)) + } + ## Survival (time to event) ####### + fitList[[xname]] <- list(coeff=coeffTidy, + family="survival", label=labelEff, + xterms=xterms, adjterms=adjterms, + glance=c(glance(ph), + N=sum(!is.na(modeldf[,eff])),Nmiss=sum(is.na(modeldf[,eff])))) + } +## put xname and endpoint in glance, summary and as.data.frame to pull from there + fitList[[xname]]$glance <- c(fitList[[xname]]$glance, endpoint=yTerm, endlabel=yLabel, x=xname) + + } # end for: eff + + ## if(!usingRCF() & !usingNCSA()) { + ## cat(paste0("R-", version$major,".", version$minor, "\t", system("echo $USER",intern=TRUE), "\t", Sys.Date(), "\n"), + ## file="/projects/bsi/infrastructure/s200555.Rinfrastructure/rlogs/modelsum.log",append=TRUE) + ## } + + msList <- list(fits=fitList, control = control, Call = Call, family=family) + ##, adjust=adjVars) + class(msList) <- "modelsum" + return(msList) +} + +## Needed for being able to use "survival" with or without quotes, +## keep as private function +survival <- function() list(family="survival") + + +mySeq <- function(from, to) { + if (from > to) + return(seq_len(0)) + + return(seq(from, to)) +} + + +#' @rdname modelsum +#' @export +print.modelsum <- function(x, ...) { +# if (x$family == "gaussian") { +# printGaussian(x) +# } + +# else { + cat("Modelsum S3 Object\n\n") + cat("Function Call: \n") + print(x$Call) + cat("\n") + cat("y variable:\n") + print(x$fits[[1]]$y) + cat("x variables:\n") + xvars <- NULL + for (ii in 1:length(x$fits)) { + xvars <- c(xvars, x$fits[[ii]]$x) + } + print(xvars) +# } + invisible(x) +} + +#' @rdname modelsum +#' @export +print.modelsumList <- function(x, ...) { + lapply(x, print.modelsum, ...) + invisible(x) +} diff --git a/R/modelsum.control.R b/R/modelsum.control.R new file mode 100644 index 0000000..a7cbe7d --- /dev/null +++ b/R/modelsum.control.R @@ -0,0 +1,132 @@ +## Purpose: control parameters for modelsum function +## Authors: P Votruba, Jason Sinnwell, Beth Atkinson +## Created: 9/3/2015 + +#' Control settings for \code{modelsum} function +#' +#' Control test and summary settings for \code{\link{modelsum}} function. +#' +#' @param digits Numeric, denoting the number of significant digits for beta coefficients and standard errors. +#' @param digits.test Numeric, denoting the number of significant digits for p-values. +#' @param nsmall Numeric, denoting the number of digits after the decimal point for beta coefficients and standard errors. +#' @param nsmall.ratio Numeric, denoting the number of digits after the decimal point for ratios, e.g. OR, RR, HR. +#' @param show.adjust Logical, denoting whether to show adjustment terms. +#' @param show.intercept Logical, denoting whether to show intercept terms. +#' @param conf.level Numeric, giving the confidence level. +#' @param binomial.stats,survival.stats,gaussian.stats,poisson.stats +#' Character vectors denoting which stats to show for the various model types. +#' @param ... Other arguments (not in use at this time). +#' @return A list with settings to be used within the \code{modelsum} function. +#' @seealso \code{\link{modelsum}}, \code{\link{summary.modelsum}} +#' @export +modelsum.control <- function(digits=3, nsmall=NULL, nsmall.ratio=2, digits.test=3, + show.adjust=TRUE, show.intercept=TRUE, conf.level=0.95, + binomial.stats=c("OR","CI.lower.OR","CI.upper.OR","p.value", "concordance","Nmiss"), + gaussian.stats=c("estimate","std.error","p.value","adj.r.squared","Nmiss"), + poisson.stats=c("RR","CI.lower.RR", "CI.upper.RR","p.value","concordance","Nmiss"), + survival.stats=c("HR","CI.lower.HR","CI.upper.HR","p.value","concordance","Nmiss"), ...) +{ + + ## validate digits + if(is.null(digits)) { + digits <- 3 + } + + if(digits < 1) { + warning("digits must be positive integer. Set to default. \n") + digits <- 3 + } + if(conf.level <= 0 | conf.level >= 1) { + warning("conf.level must be between (0,1). Setting to default.\n") + conf.level <- 0.95 + } + + ########################## + ## Binomial stats: + ########################## + ##Other coefficient columns: + ##CI.estimate, N, Nmiss2, depvar (show name of dependent variable), estimate, se, zstat + ##Other model fits: logLik,AIC,BIC + binomial.stats.valid <- c(c("Nmiss","OR","CI.lower.OR","CI.upper.OR","p.value","concordance"), # default + c("estimate","CI.OR","CI.estimate","CI.lower.estimate","CI.upper.estimate","N","Nmiss2","endpoint","std.error","statistic"), + c("logLik","AIC","BIC","null.deviance","deviance","df.residual","df.null")) + + if(any(!(binomial.stats %in% binomial.stats.valid))) { + stop(paste0("Invalid binomial stats: ", + paste(binomial.stats[!(binomial.stats %in% binomial.stats.valid)],collapse=","), "\n")) + } + ## let CI.OR decode to CI.lower.OR and CI.upper.OR + if(any(grepl("CI.OR", binomial.stats))) { + binomial.stats <- unique(c("CI.lower.OR","CI.upper.OR", binomial.stats[-grep("CI.OR",binomial.stats)])) + } + if(any(grepl("CI.estimate", binomial.stats))) { + binomial.stats <- unique(c("CI.lower.estimate","CI.upper.estimate", binomial.stats[-grep("CI.estimate",binomial.stats)])) + } + + ########################## + ## Gaussian stats: + ########################## + ##Other coefficient columns: CI.estimate, N, Nmiss2, t.stat, standard.estimate, endpoint + ##Other model fits: r.squared, AIC, BIC,logLik + gaussian.stats.valid <- c(c("Nmiss","estimate","std.error","p.value", "adj.r.squared"), #default + c("CI.estimate","CI.lower.estimate","CI.upper.estimate", "N", "Nmiss2", "statistic", "standard.estimate", "endpoint"), + c("r.squared", "AIC", "BIC","logLik","statistic.F","p.value.F")) + + if(any(!(gaussian.stats %in% gaussian.stats.valid))) { + stop(paste0("Invalid gaussian stats: ", + paste(gaussian.stats[!(gaussian.stats %in% gaussian.stats.valid)],collapse=","), "\n")) + } + if(any(grepl("CI.estimate", gaussian.stats))) { + gaussian.stats <- unique(c("CI.lower.estimate","CI.upper.estimate", gaussian.stats[-grep("CI.estimate",gaussian.stats)])) + } + + +########################## + ## Poisson stats: + ########################## + ##(quasi)/poisson.stats=c("Nmiss","RR","CI.RR", "p.value","concordance"), + ##Other coeff columns: CI.estimate, CI.RR (ci for relrisk),N,Nmiss2, std.error, estimate, z.stat, endpoint + ##Other model fits: AIC,BIC,logLik, dispersion + ## dispersion = deviance/df.residual + poisson.stats.valid <- c(c("RR","CI.lower.RR","CI.upper.RR", "p.value","concordance", "Nmiss"), # default + c("CI.RR","CI.estimate","CI.lower.estimate","CI.upper.estimate", "CI.RR", "Nmiss2", "std.error", "estimate", "statistic","endpoint"), + c("AIC", "BIC","logLik","dispersion","null.deviance","deviance","df.residual","df.null")) + + if(any(!(poisson.stats %in% poisson.stats.valid))) { + stop(paste0("Invalid poisson stats: ", + paste(poisson.stats[!(poisson.stats %in% poisson.stats.valid)],collapse=","), "\n")) + } + ## let CI.RR decode to CI.lower.RR and CI.upper.RR + if(any(grepl("CI.RR", poisson.stats))) { + poisson.stats <- unique(c("CI.lower.RR","CI.upper.RR", poisson.stats[-grep("CI.RR",poisson.stats)])) + } + if(any(grepl("CI.estimate", poisson.stats))) { + poisson.stats <- unique(c("CI.lower.estimate","CI.upper.estimate", poisson.stats[-grep("CI.estimate",poisson.stats)])) + } + ########################## + ## Survival stats: + ########################## + ##surv.stats=c(Nmiss,HR,CI.HR,p.value,concorance) + ##Other possible coefficient table columns: CI.estimate,N,Nmiss2,estimate,se,endpoint,Nevents,z.stat + ##Other possible model fits: r.squared, logLik, AIC, BIC + surv.stats.valid <- c(c("HR","CI.lower.HR","CI.upper.HR","p.value","concordance","Nmiss"), # default + c("CI.HR","CI.estimate","CI.lower.estimate","CI.upper.estimate","N","Nmiss2","estimate","std.error","endpoint","Nevents","statistic"), + c("r.squared", "logLik", "AIC", "BIC","statistic.sc","p.value.sc","p.value.log","p.value.wald","N","std.error.concordance")) + if(any(!(survival.stats %in% surv.stats.valid))) { + stop(paste0("Invalid survival stats: ", + paste(survival.stats[!(survival.stats %in% surv.stats.valid)],collapse=","), "\n")) + } + + ## let CI.HR decode to CI.lower.HR and CI.upper.HR + if(any(grepl("CI.HR", survival.stats))) { + survival.stats <- unique(c("CI.lower.HR","CI.upper.HR", survival.stats[-grep("CI.HR",survival.stats)])) + } + if(any(grepl("CI.estimate", survival.stats))) { + survival.stats <- unique(c("CI.lower.estimate","CI.upper.estimate", survival.stats[-grep("CI.estimate",survival.stats)])) + } + return(list(digits=digits, digits.test=digits.test, nsmall=nsmall, nsmall.ratio=nsmall.ratio, + show.adjust=show.adjust, show.intercept=show.intercept, conf.level=conf.level, + binomial.stats=binomial.stats, gaussian.stats=gaussian.stats, + poisson.stats=poisson.stats, survival.stats=survival.stats)) + +} diff --git a/R/modelsum.internal.R b/R/modelsum.internal.R new file mode 100644 index 0000000..f6c73fb --- /dev/null +++ b/R/modelsum.internal.R @@ -0,0 +1,151 @@ +## Purpose: internal functions (and methods) for tableby function +## Authors: Jason Sinnwell, Beth Atkinson +## Created: 9/4/2015 + +## Helper functions for modelsum: merge, subset, and labels (work like names) + +#' Helper functions for modelsum +#' +#' A set of helper functions for \code{\link{modelsum}}. +#' +#' @param object A \code{data.frame} resulting form evaluating \code{modelsum} formula. +#' @param ... Other arguments, or a vector of indices for extracting. +#' @param x,y A \code{modelsum} object. +#' @param value A list of new labels. +#' @return \code{na.modelsum} returns a subsetted version of \code{object} (with attributes). +#' @name modelsum.internal +NULL +#> NULL + +#' @rdname modelsum.internal +#' @export +na.modelsum <- function (object, ...) { + omit <- is.na(object[,1]) + xx <- object[!omit, , drop = FALSE] + if (any(omit > 0L)) { + temp <- stats::setNames(seq(omit)[omit], attr(object, "row.names")[omit]) + attr(temp, "class") <- "omit" + attr(xx, "na.action") <- temp + } + xx +} + +##standardized beta function (for gaussian stat) +lm.beta <- function (MOD) { + b <- stats::coef(MOD)[-1] + sx <- rep(NA,length(b)) + b.idx <- 1 + for(k in 2:ncol(MOD$model)) { + ## skip factors and char variables, + ## psplines consider doing sx, but need a second for loop for the ncol of those + if(any(class(MOD$model[,k]) %in% c("character","factor", "pspline"))) { + b.idx <- b.idx + ifelse(is.null(ncol(MOD$model[,k])), length(unique(MOD$model[,k]))-1, ncol(MOD$model[,k])) + ## skip as many elements of beta as there are N.levels-1 of categorical variables + } else { + sx[b.idx] <- stats::sd(as.double(MOD$model[,k]),na.rm=TRUE) + b.idx <- b.idx + 1 + } + } + sy <- stats::sd(as.double(MOD$model[,1]),na.rm=TRUE) + beta <- c(NA,round(b * sx/sy,3)) + return(beta) +} + +## subset a modelsum object; +## syntax of usage: newtb <- tbObj[1:2] +## x here is the tableby object +## index is in '...', and allows only 1 vector of integer indices +## in future, maybe allow subsetting by names +#' @rdname modelsum.internal +#' @export +"[.modelsum" <- function(x, ...) { + newx <- x + if (length(list(...)) != 1) { + stop ("Only 1 subscript allowed") + } + ## index vector + idx <- (1:length(x$fits))[..1] + if(all(is.na(idx))) { + newx$fits <- x$fits[...] + } else { + newx$fits <- x$fits[idx] + } + return(newx) + } + + +## retrieve variable labels (y, x-vec) from tableby object +#' @rdname modelsum.internal +#' @export +labels.modelsum <- function(object, ...) { + ## get the formal labels from a tableby object's data variables + ## y and x labels + allLabels <- c(object$fits[[1]]$glance$endlabel, unlist(sapply(object$fits, function(obj) obj$label))) + ##, sapply(object$x, function(obj) obj$label)) + names(allLabels) <- c(object$fits[[1]]$glance$endpoint, unlist(sapply(object$fits, function(obj) obj$xterm))) + ## add on labels for adj vars + if(!is.null(object$fits[[1]]$adjterms)) { + nadj <- length(object$fits[[1]]$adjlabels) + allLabels <- c(allLabels, object$fits[[1]]$adjlabels) + names(allLabels)[(length(allLabels)-nadj+1):length(allLabels)] <- object$fits[[1]]$adjterms + } + + return(allLabels) +} + +## assign labels to modelsum object +#' @rdname modelsum.internal +#' @export +'labels<-.modelsum' <- function(x, value) { + ## if the value vector is named, then assign the labels to + ## those names that match those in x and y + if(is.null(names(value))) { + stop(" labels for modelsum requires a named vector.\n") + } + vNames <- names(value) + used.idx <- NULL + for(k in 1:length(x$fits)) { + v2x.idx <- match(vNames, x$fits[[k]]$xterm) + x2v.idx <- match(x$fits[[k]]$xterm, vNames) + if(sum(!is.na(x2v.idx))>0) { + x$fits[[k]]$label[v2x.idx[!is.na(v2x.idx)]] <- value[x2v.idx] + used.idx <- unique(c(used.idx, x2v.idx[!is.na(x2v.idx)])) + } + if(!is.null(x$fits[[k]]$adjterms)) { + v2adj.idx <- match(vNames, x$fits[[k]]$adjterms) + adj2v.idx <- match(x$fits[[k]]$adjterms,vNames) + if(sum(!is.na(adj2v.idx))>0) { + x$fits[[k]]$adjlabels[v2adj.idx[!is.na(v2adj.idx)]] <- value[adj2v.idx[!is.na(adj2v.idx)]] + used.idx <- unique(c(used.idx, adj2v.idx[!is.na(adj2v.idx)])) + } + } + y2v.idx <- match(x$fits[[k]]$glance$endpoint, vNames) + if(!is.na(y2v.idx)) { + x$fits[[k]]$glance$endlabel <- value[y2v.idx] + used.idx <- unique(c(used.idx, y2v.idx)) + } + + } + + if(any(!((1:length(value)) %in% used.idx))) { + warning("Named value(s): ", paste(vNames[!((1:length(value)) %in% used.idx)],collapse=", "), + " not matched in modelsum object \n") + } + + ## return modelsum object with updated labels + return(x) +} + + +## merge two tableby objects +## both must have same "by" variable and levels +## if some RHS variables have same names, keep both, the one in y add ".y" +#' @rdname modelsum.internal +#' @export +merge.modelsum <- function(x, y, ...) { + + newobj <- list(x, y) + class(newobj) <- "modelsumList" + return(newobj) +} + diff --git a/R/not.in.R b/R/not.in.R new file mode 100644 index 0000000..b7058d0 --- /dev/null +++ b/R/not.in.R @@ -0,0 +1,26 @@ +########################################################################################### +### Creation Date: 6/2015 +### Last Modified: Monday, 18 July 2016 03:00 PM CDT +########################################################################################### + +#' Not in +#' +#' The not-in operator for R. +#' +#' @inheritParams base::`%in%` +#' @return The negation of \code{\link{\%nin\%}}. +#' @examples +#' 1 %nin% 2:10 +#' c("a", "b") %nin% c("a", "c", "d") +#' @seealso \code{\link{\%in\%}} +#' @author Raymond Moore +#' @aliases nin +#' @export + +## The not-in operator for R +## From Raymond Moore, 6/2015, who found it on google +## '%nin%' <- Negate('%in%') + +## sorry guys--Ethan changed this on 7/26/16 + +`%nin%` <- function(x, table) match(x, table, nomatch = 0L) == 0L diff --git a/R/release_questions.R b/R/release_questions.R new file mode 100644 index 0000000..7044284 --- /dev/null +++ b/R/release_questions.R @@ -0,0 +1,12 @@ +release_questions <- function() { + c( + "Have you updated the DESCRIPTION file? Make sure the version number is right.", + "Have you checked for reverse dependencies?", + "Have you updated README.md?", + "Have you updated NEWS.md?", + "Have you updated cran-comments.md?", + "Have you updated all the documentation using devtools::check_man()?", + "Have you gotten approval from all authors to push to CRAN?", + "Did you make sure the DESCRIPTION matches what's in arsenal.R?" + ) +} \ No newline at end of file diff --git a/R/summary.freqlist.R b/R/summary.freqlist.R new file mode 100644 index 0000000..9a40dfc --- /dev/null +++ b/R/summary.freqlist.R @@ -0,0 +1,86 @@ +#' summary.freqlist +#' +#' Summarize the \code{freqlist} object +#' +#' @param object an object of class \code{\link{freqlist}} +#' @param single a logical value indicating whether to collapse results created using a groupBy variable into a single table for printing +#' @param labelTranslations A character vector giving the labels. Overrides the labels in `freqlist`. +#' @param ... additional arguments passed to the \code{\link[knitr]{kable}} function +#' @return Invisibly returns \code{object}, and uses \code{\link[knitr]{kable}} to print the object. +#' @seealso \code{\link[base]{table}}, \code{\link[stats]{xtabs}}, \code{\link[knitr]{kable}} +#' +#' @examples +#' # load mockstudy data +#' data(mockstudy) +#' tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany") +#' noby <- freqlist(tab.ex, na.options = "include") +#' summary(noby) +#' withby <- freqlist(tab.ex, groupBy = c("arm","sex"), na.options = "showexclude") +#' summary(withby) +#' @author Tina Gunderson +#' @export +#' +summary.freqlist <- function(object, single = FALSE, labelTranslations = NULL, ...){ + #require(knitr, quietly = TRUE) + if (!is.logical(single)) stop("single must be TRUE or FALSE") + if(!is.null(labelTranslations)) labels(object) <- labelTranslations + + # fmtdups <- function(vec){ + # x <- vec + # x[is.na(x)] <- "NA" + # y <- c(NA, x[-1]) + # x[x==y] <- "" + # return(x) + # } + + ## changed on 11/18/16 by EPH. The other one wasn't working in cases like the second testthat example (bug reported by Emily Lundt) + fmtdups <- function(tab) + { + tab <- as.matrix(tab) + tab[is.na(tab)] <- "NA" + output <- tab + num <- max(stringr::str_count(tab, ",")) + + for(col in 1:ncol(tab)) + { + tmp <- apply(tab[, 1:col, drop = FALSE], 1, paste, collapse = paste0(rep(",", num + 1), collapse = "")) # in R >= 3.3.0, we could use strrep instead + output[duplicated(tmp), col] <- "" + } + output + } + + if(is.null(object[["labels"]])){ + cnames <- names(object[["freqlist"]]) + } else { + cnames <- c(object[["labels"]], "Freq", "cumFreq", "freqPercent","cumPercent") + } + if(is.null(object[["byVar"]]) || single){ + freqdf <- object[["freqlist"]] + if(ncol(freqdf)>5){ + # freqdf[, 1:(ncol(freqdf)-5)] <- apply(freqdf[, 1:(ncol(freqdf)-5), drop = FALSE], 2, fmtdups) + freqdf[, 1:(ncol(freqdf)-4)] <- fmtdups(freqdf[, 1:(ncol(freqdf)-4), drop = FALSE]) + } + print(knitr::kable(freqdf, row.names = FALSE, col.names = cnames, ...)) + } else { + byVar <- object[["byVar"]] + freqdf <- object[["freqlist"]] + for(i in match(byVar, names(freqdf))) { + if(sum(is.na(freqdf[, i])) > 0) {freqdf[, i] <- addNA(freqdf[, i])} + } + printlist <- by(freqdf, freqdf[, rev(byVar)], FUN = data.frame) + names(printlist) <- gsub("[.]",", ", levels(interaction(rev(freqdf[,byVar])))) + for(i in 1:length(printlist)){ + if(!is.null(printlist[[i]])){ + if(nrow(printlist[[i]]) > 1){ + sublist <- printlist[[i]] + # sublist[, 1:(ncol(sublist)-5)] <- apply(sublist[, 1:(ncol(sublist)-5), drop = FALSE], 2, fmtdups) + sublist[, 1:(ncol(sublist)-4)] <- fmtdups(sublist[, 1:(ncol(sublist)-4), drop = FALSE]) + print(knitr::kable(sublist, row.names = FALSE, col.names = cnames, ...)) + } else { + print(knitr::kable(printlist[[i]], row.names = FALSE, col.names = cnames, ...)) + } + } + } + } + invisible(object) +} \ No newline at end of file diff --git a/R/summary.modelsum.R b/R/summary.modelsum.R new file mode 100644 index 0000000..c4c9744 --- /dev/null +++ b/R/summary.modelsum.R @@ -0,0 +1,993 @@ +## Purpose: summary method for modelsum object +## Author: Greg Dougherty, Jason Sinnwell and Beth Atkinson +## Updated: 9/29/2015 + + +## should not need these, especially for variable names +modelsum.translations <- list() ## adj.r.squared = "adj.rsq", sex = "Sex", sexM = "Sex", age = "Age") + + +#' Summarize a \code{modelsum} object. +#' +#' Format the information in \code{object} as a table using Pandoc coding or plain text, and cat it to stdout. +#' +#' @param object The data defining the table to display +#' @param title Title for the table, defaults to \code{NULL} (no title) +#' @param labelTranslations List where name is the label in the output, and value is the label you +#' want displayed e.g. \code{list (q1q3: "Q1, Q3", medsurv = "Median Survival")}. +#' @param digits Maximum number of digits to display for floating point numbers. +#' If \code{NA} (default), it uses the value from \code{object$control$digits} +#' (whose default is 3, which would result in, e.g., 12.3, 1.23, 0.123, and 0.012). +#' @param nsmall Minimum number of digits to the right of the decimal point to display for +#' floating point numbers. If \code{NA} (default), it uses the value from \code{object$control$nsmall}. +#' Allowed non-\code{NA} values are \code{0 <= nsmall <= 20}. +#' @param nsmall.ratio Minimum number of digits to the right of the decimal point to display +#' for the ratio statistics (OR, HR, RR). If \code{NA} (default) it uses the value from +#' \code{object$control$nsmall.ratio} (whose default is 2). +#' Allowed values are \code{0 <= nsmall.ratio <= 20}. +#' @param digits.test Number of digits to display for a p-value. Default is 5 (e.g. 0.12345). +#' @param show.intercept Logical, denoting if the intercept should be shown for each line +#' @param show.adjust Logical, denoting if the adjust variables should be shown for each line. +#' @param text Logical, denoting whether to print out the text version. +#' @param removeBlanks Logical, denoting if any blank lines should be removed from the output. +#' Default is value of \code{"text"}, and will be set to \code{FALSE} if text is \code{FALSE}. +#' @param labelSize Relative size difference between label column and other columns. +#' Default is 1.2: label column ~20\% bigger than other columns +#' @param pfootnote Logical denoting if a footnote should be added describing the test used +#' to generate the p value. Default is \code{FALSE}. +#' @param ... Other arguments (not implemented a this time). +#' @seealso \code{\link{modelsum}}, \code{\link{print.modelsum}}, \code{\link{as.data.frame.modelsum}} +#' @return Results are cat'ed to stdout, and returned invisibly as a character vector. +#' @export +#' +#' @author Greg Dougherty +summary.modelsum <- function(object, title = NULL, labelTranslations = NULL, digits = NA, + nsmall = NA, nsmall.ratio = NA, digits.test = NA, show.intercept = NA, + show.adjust = NA, text = FALSE, removeBlanks = text, labelSize = 1.2, + pfootnote = TRUE, ...) { + results <- makeSummary.modelsum (object, title, labelTranslations, digits, nsmall, nsmall.ratio, + digits.test, show.intercept, show.adjust, text, removeBlanks, + labelSize, pfootnote) + results <- results$results + cat(paste(results, collapse = "\n")) + invisible(results) +} + + +#' as.data.frame.modelsum +#' +#' Build a data.frame from the modelsum object and parameters, and return it +#' +#' @param x An object of class \code{\link{modelsum}}. +#' @inheritParams summary.modelsum +#' @param pFootnote Logical denoting if a footnote should be added describing the test used +#' to generate the p value. Default is \code{TRUE}. +#' @return A data.frame holding the modelsum +#' @export +#' +#' @author Greg Dougherty +as.data.frame.modelsum <- function(x, ..., title = NULL, labelTranslations = NULL, digits = NA, + nsmall = NA, nsmall.ratio = NA, digits.test = NA, show.intercept = NA, + show.adjust = NA, pFootnote = TRUE) +{ + if(length(list(...)) > 0) warning("The '...' in this function has changed. Are you passing positional arguments?") + results <- makeSummary.modelsum (x, title, labelTranslations, digits, nsmall, nsmall.ratio, + digits.test, show.intercept, show.adjust, FALSE, FALSE, 1.2, pFootnote) + + return(to.data.frame.modelsum(x, results)) +} + + +## ' Format the information in object as a Table using Pandoc coding or plain text, & cat it to stdout +## ' +## ' @inheritParams summary.modelsum +## ' @param pFootnote Logical denoting if a footnote should be added describing the test used +## ' to generate the p value. Default is \code{TRUE}. +## ' +## ' @return List holding the lines of the output plus information on column size +## ' results: The lines of the output, +## ' firstColSize: The length of the first column, +## ' colSize: The length of each other column, +## ' showIntercept: TRUE if included the Intercept with each variable +## ' showAdjust: TRUE if included the adjust variable results for each variable +## ' showOnce: Vector of fields to be pulled from element$glance, one time only +## ' translations: List to use for conversion of labels +## ' +## ' @author m082166 +makeSummary.modelsum <- function(object, title, labelTranslations, digits, nsmall, nsmall.ratio, + digits.test, show.intercept, show.adjust, text, removeBlanks, + labelSize, pFootnote ) { + digits <- setParam(digits, object$control$digits) + pValueDigits <- setParam(digits.test, object$control$digits.test) + nsmall <- setParam(nsmall, object$control$nsmall) + nsmall.ratio <- setParam(nsmall.ratio, object$control$nsmall.ratio) + showIntercept <- setParam3(show.intercept, object$control$show.intercept, FALSE) + showAdjust <- setParam3(show.adjust, object$control$show.adjust, FALSE) + + if (text) { + boldMark <- "" + } + else { + boldMark <- "**" + removeBlanks <- FALSE + } + + fieldName = "coeff" + oneTimeFieldName = "glance" + translations <- addModelsumTranslations(object, labelTranslations) + elements <- object$fits + if (length(elements) == 0) + return("") # Nothing to show, no data from which to produce anything + + theCols <- getColsToShow (object$control, object$family, elements[[1]], fieldName, oneTimeFieldName, translations) + showCols <- theCols$showCols + showOnce <- theCols$showOnce + + ## if Nmiss in showOnce and no missing, don't show Nmiss + totMiss <- sum(sapply(object$fits, function(x) x$glance$Nmiss)) + if ((totMiss == 0) & any(grepl("Nmiss$", showOnce))) { + showOnce <- showOnce[-grep("Nmiss$", showOnce)] + } + minColSize <- maxStrLen(lookupHumanTitle(names(elements), translations)) + (nchar(boldMark) * 2) + minColSize <- max(minColSize, maxMatrixNameLen(elements, translations, fieldName)) + minColSize <- max(minColSize, maxElementNameLen(elements, translations)) + + header <- makeModelSumHeader(showCols, showOnce, minColSize, labelSize, translations) + lineSize <- as.integer(header$lineSize) + firstColSize <- as.integer(header$firstColSize) + colSize <- as.integer(header$colSize) + results <- header$header + lastLine <- results[length(results)] # Clip off last line, will need to add it back at end + results <- results[- length(results)] + + for (element in elements) { + elmResults <- formatModelSum(element, lineSize, firstColSize, colSize, translations, digits, + pValueDigits, nsmall, nsmall.ratio, boldMark, showIntercept, + showAdjust, showCols, showOnce, fieldName, oneTimeFieldName, pFootnote) + results <- c(results, elmResults, "") + } + + results <- c(results, lastLine, "") # Table must have blank line after last dashed line + if (removeBlanks) { + results <- c(results[nchar(results) > 0], "") # Keep one blank line at end + } + + if (!is.null(title) && !is.na(title)) { + if (text) { + results <- c(makeCenteredStr(title, lineSize), results) + } + else { # Titles can be multi line, so have a blank line to clearly end title + results <- c(paste0("Table: ", boldMark, title, boldMark), "", results) + } + } + + theResults <- list(results = results, firstColSize = firstColSize, colSize = colSize, showOnce = showOnce, + showIntercept = showIntercept, showAdjust = showAdjust, translations = translations) + return(theResults) +} + + +## ' to.data.frame.modelsum +## ' +## ' Take a Pandoc Table and turn it into a data frame +## ' +## ' @param object The data defining the table to display +## ' @param results List with seven elements: +## ' results: The Pandoc multi-row table +## ' firstColSize: The length of the first column, +## ' colSize: The length of each other column +## ' showIntercept: TRUE if included the Intercept with each variable +## ' showAdjust: TRUE if included the adjust variable results for each variable +## ' showOnce: Vector of fields to be pulled from element$glance, one time only +## ' translations: List to use for conversion of labels +## ' +## ' @return A data.frame holding the modelsum +## ' +## ' @author m082166 +to.data.frame.modelsum <- function(object, results) +{ + firstColSize <- as.integer(results$firstColSize) + colSize <- as.integer(results$colSize) + showIntercept <- results$showIntercept + showAdjust <- results$showAdjust + showOnce <- results$showOnce + translations <- results$translations + results <- results$results + + start <- 2 + end <- 3 + while (substring (results[end], 1, 1) != '-') + end <- end + 1 + + header <- strsplit (results[start:(end - 1)], " +") + header <- compress (header)[-1] # Drop the empty first column + if ("endpoint" %in% header) + { + killCol <- -match (c ("endpoint"), header) + header <- header[killCol] + showOnce <- showOnce[match (showOnce, c ("endpoint"), nomatch = 0) < 1] + } + else + killCol <- 0 + header <- c ("model", "endpoint", header) +# header <- myStrJoin (results[start:(end - 1)], firstColSize, colSize) + + results <- results[-1:-end] # Delete all the header + rowCounts <- getRowInfo (object, showIntercept, showAdjust, "endpoint", translations) + + return (to.the.data.frame.modelsum (results, header, showOnce, rowCounts, firstColSize, colSize, killCol)) +} + + +## ' to.the.data.frame.modelsum +## ' +## ' Take a Pandoc Table and turn it into a data frame +## ' +## ' @param results The Pandoc multi-row table +## ' @param header Vector with the column headers +## ' @param showOnce Vector of fields that were pulled from element$glance, so will need to be duplicated +## ' @param rowCounts List with one element per model of object, holding # rows & y variable +## ' @param firstColSize The length of the first column, +## ' @param colSize The length of each other column +## ' @param killCol Column of results holding data to be ignored +## ' +## ' @return A data.frame holding the modelsum +## ' +## ' @author m082166 +to.the.data.frame.modelsum <- function(results, header, showOnce, rowCounts, firstColSize, colSize, killCol) +{ + baseList <- list(term = NULL) + holdValues <- list() + rowNames <- c() + curRow <- 0 + curCount <- 1 + curMax <- 0 + start <- 1 + len <- length (results) - 3 # Last three lines are not relevant + + while (start <= len) + { + curCount <- curCount + 1 + if (curCount > curMax) + { + curCount <- 1 + curRow <- curRow + 1 + curMax <- rowCounts[[curRow]][1] + curY <- rowCounts[[curRow]][2] + } + end <- start + while (end <= len) + { + if (nchar (results[end]) == 0) + break + end <- end + 1 + } + line <- myStrJoin (results[start:(end - 1)], firstColSize, colSize) + rowNames <- c (rowNames, line[1]) + line <- line[-1] + if (killCol < 0) + line <- line[killCol] + line <- c (curRow, curY, line) + + for (i in seq_len (length (line))) + { + title <- header[i] + value <- line[i] + if (title %in% showOnce) + { + if (value == ".") + value <- holdValues[[title]] + else + holdValues[[title]] <- value + } + if (is.null (baseList[[title]])) + baseList[[title]] <- c (value) + else + baseList[[title]] <- c (baseList[[title]], value) + } + + start <- end + 1 + } + + return (makeDF (baseList, rowNames, c ("endpoint"))) +} + + +## ' makeDF +## ' +## ' Create a data.frame, updating the "term" column to have the rowNames as its elements, and +## ' setting its columns to be numeric or not as appropriate +## ' +## ' @param baseList List holding the contents of the data.frame to be +## ' @param rowNames Names of the rows, will be added as column "term" +## ' @param nonNumeric Names of non-numeric columns of the resulting data.frame +## ' +## ' @return A data.frame holding the modelsum, with every column not in nonNumeric made numeric +## ' +## ' @author m082166 +makeDF <- function(baseList, rowNames, nonNumeric) +{ + baseList[["term"]] <- rowNames +# df <- as.data.frame (baseList, stringsAsFactors = FALSE, row.names = rowNames) + df <- as.data.frame (baseList, stringsAsFactors = FALSE) + + oldwarn <- options()$warn + options(warn = -1) + + nonNumeric <- c ("term", nonNumeric) + theNames <- names (baseList) + theNames <- theNames[!(theNames %in% nonNumeric)] + + for (colName in theNames) + class (df[, colName]) <- "numeric" + + options(warn = oldwarn) + + return(df) +} + + +## ' getRowInfo +## ' +## ' For each model, get the number of rows that are part of that model, and the y variable associated +## ' with it +## ' +## ' @param object The data defining the table to display +## ' @param showIntercept TRUE if included the Intercept with each variable +## ' @param showAdjust TRUE if included the adjust variable results for each variable +## ' @param yCol Name of the column in glance that holds the y column value +## ' @param translations Translations +## ' +## ' @return List with one element per model of object, holding # rows & y variable +## ' +## ' @author m082166 +getRowInfo <- function(object, showIntercept, showAdjust, yCol, translations) +{ + if (showIntercept) { + neverRows <- c() + } + else { + neverRows <- c("(Intercept)") + } + + results <- list () + numModels <- length (object$fits) + + for (model in seq_len (numModels)) + { + theFit <- object$fits[[model]]; + if (showAdjust) { + hideRows <- neverRows + } + else { + hideRows <- c(neverRows, lookupHumanTitle(theFit$adjterms, translations)) + } + + coeff <- theFit$coeff + coeff <- coeff[!(coeff$term %in% hideRows), ] + results[[model]] <- c (nrow (coeff), theFit$glance[[yCol]]) + } + + return (results) +} + + +## ' myStrJoin +## ' +## ' Take potentially split strings, or vector of strings, and join back together, each column becoming +## ' a single string +## ' +## ' @param theStr String, or vector of strings, to join +## ' @param firstColSize The length of the first column +## ' @param colSize The length of each other column +## ' +## ' @return Contents of each column de-Pandoced and formed into a single un-padded string +## ' +## ' @author m082166 +myStrJoin <- function(theStr, firstColSize, colSize) +{ + len <- length (theStr) + if (len == 0) + return (c ()) + + strLen <- nchar (theStr[1]) + row <- singleSplit (theStr[1], firstColSize, colSize, strLen) + if (len == 1) + return (str_trim (row)) + + results <- str_trim (row, "left") + numCols <- length (row) + for (i in 2:len) + { + row <- singleSplit (theStr[i], firstColSize, colSize, strLen) + + for (j in seq_len (numCols)) + { + size <- nchar (results[j]) + toAdd <- row[j] + if (size == 0) + results[j] <- str_trim (toAdd, "left") + else + { + cur <- str_trim (results[j], "right") + doPad <- (nchar (cur) < size) && !endsWithPad (cur) + size <- nchar (toAdd) + toAdd <- str_trim (toAdd, "left") + addSize <- nchar (toAdd) + doPad <- (doPad || (addSize < size)) && (addSize > 0) && !beginsWithPad (toAdd) + if (doPad) + results[j] <- paste (cur, toAdd) + else + results[j] <- paste0 (cur, toAdd) + } + } + } + + return (str_trim (results, "right")) +} + + +## ' singleSplit +## ' +## ' Split a string based on column lengths +## ' +## ' @param theStr String to split +## ' @param firstColSize The length of the first column +## ' @param colSize The length of each other column +## ' @param strLen Total string length +## ' +## ' @return Contents of each column de-Pandoced but not trimmed +## ' +## ' @author m082166 +singleSplit <- function(theStr, firstColSize, colSize, strLen) +{ + first <- substring (theStr, 1, firstColSize) + for (find in c("**", " ")) + first <- gsub (find, " ", first, fixed = TRUE) + + results <- c(first) + + start <- firstColSize + 2 + while (start < strLen) + { + end <- start + colSize - 1 + nextStr <- substring (theStr, start, end) + results <- c(results, nextStr) + start <- end + 2 + } + + return (results) +} + + +## ' addUniqueName +## ' +## ' Add a row name, making it unique if necessary +## ' +## ' @param rowNames Vector to add to, and test against +## ' @param newRow New row name to add +## ' +## ' @return rowNames with newRow concatenated as a unique text string +## ' +## ' @author m082166 +addUniqueName <- function(rowNames, newRow) +{ + if (newRow %in% rowNames) + { + count <- 1 + test <- paste (newRow, count) + while (test %in% rowNames) + { + count <- count + 1 + test <- paste (newRow, count) + } + + newRow <- test + } + + return (c (rowNames, newRow)) +} + + +## Take list of 1+ elements of vectors of equal length, produce a vector with things combined +## Example: [[1]] [1] "man " "woman" "child" +## [[2]] [1] "kind" "" "hood" +## --> [1] "man kind" "woman" "childhood" +## +## ' compress +## ' +## ' Take list of 1+ elements of vectors of equal length, produce a vector with things combined +## ' +## ' @param theList The list of data to compress +## ' +## ' @return The Strings concatenated together +## ' +## ' @author m082166 +compress <- function(theList) +{ + if (length(theList) == 0) + return ("") # Nothing to show, no data from which to produce anything + + result <- c() + + for (i in seq_len(length (theList[[1]]))) + result <- c (result, "") + + for (element in theList) + { + for (i in seq_len(length (element))) + result[i] <- paste0 (result[i], element[i]) + } + + return (result) +} + + +## ' addModelsumTranslations +## ' +## ' Add all the desired translations from machine produced labels to a human readable ones to the list +## ' +## ' @param object The data defining the table to display +## ' @param labelTranslations List where name is the label in the output, and value is the label you +## ' want displayed e.g. list (q1q3: "Q1, Q3", medsurv = "Median Survival") +## ' @return Current translation list +## ' +## ' @author m082166 +addModelsumTranslations <- function(object, labelTranslations) { + translations <- format.addTranslations(object, labelTranslations, modelsum.translations, "fits", "xterms") + + elements <- object$fits + + # Now get every adjterms and their matching adjlabels + for (element in elements) { + translations <- addTranslations(translations, element$adjterms, element$adjlabels) + } + + return(translations) +} + + +## ' makeModelSumHeader +## ' +## ' Make the Pandoc format header for the table +## ' +## ' @param showCols List of items that will be output as columns from each row, in order +## ' @param showOnce List of items that will be output as columns only on 1st row, in order +## ' @param minColSize Minimum size of the first column (which will hold label info for a row) +## ' @param translations The List to use for conversion of labels +## ' @param leftJustify If TRUE, will left justify each column, defaults to FALSE +## ' @param rightJustify If TRUE, will right justify each column, defaults to FALSE +## ' When both leftJustify and rightJustify are FALSE, columns are centered +## ' @param labelSize Relative size difference between label column and other columns. +## ' Default is 1.2: label column ~20\% bigger than other columns +## ' @return List holding the lines of the header defined by group plus +## ' lineSize: The length of a full line, +## ' firstColSize: The length of the first column, +## ' colSize: The length of each other column, +## ' header: The lines of the header +## ' The last element is the last line of the output, to go after the body of the output +## ' +## ' @author m082166 +makeModelSumHeader <- function(showCols, showOnce, minColSize, labelSize = 1.2, + translations, leftJustify = FALSE, rightJustify = FALSE) { + headers <- c(showCols, showOnce) + size <- max(nchar(headers)) + 2 # Need one extra "-" on either side to center text + if (size < 10) + size = 10 # Minimum width for a column + bigSize = round(size * labelSize) # Want the first column ~ 20% larger than other columns + if (bigSize < minColSize) { + bigSize <- minColSize + size <- round(bigSize / labelSize) + } + fullSize = bigSize + ((size + 1) * length(headers)) + outsideLine <- makeDashStr(fullSize) + + header <- outsideLine + #First Line + head <- makeDashStr(bigSize, theChar = ' ') + + for (cellH in headers) { # Want it to insert space as separator + head <- paste(head, makeCellHeader(cellH, size, leftJustify, rightJustify)) + } + + header <- c(header, head) + #Second line + head <- makeDashStr(bigSize) + + for (cellH in headers) { + head <- paste(head, makeDashStr(size)) # Want it to insert space as separator + } + + header <- c(header, head) + header <- c(header, outsideLine) + + # Build a named List with the data to return + header <- list(lineSize = fullSize, firstColSize = bigSize, colSize = size, header = header) + + return(header) +} + + +## ' formatModelSum +## ' +## ' Return a List with two elements: +## ' The vector holding the lines of a row in the table, defined by element, in Pandoc format +## ' Updated list of methods used by this modelsum object +## ' +## ' @param element List to get information from, whose fieldName item must be the statistics +## ' @param lineSize Length each non-blank line should be padded to +## ' @param firstColSize Length the first (label) column should be padded to +## ' @param colSize Length all other columns should be padded to +## @param hasPValue TRUE if has column for p-values, FALSE if shouldn't +## ' @param translations The List to use for conversion of labels +## ' @param digits Maximum number of digits to display for floating point numbers +## ' @param pValueDigits Number of digits to display for a p-value. Example: 5 ==> in 0.12345 +## ' @param nsmall Minimum number of digits to the right of the decimal point to display +## ' for floating point numbers. If NULL, use 'digits' to determine everything +## ' @param nsmall.ratio Minimum number of digits to the right of the decimal point to display +## ' for the ratio statistics (OR, HR, RR) +## ' @param boldMark String to use to mark text as bold +## ' @param showIntercept TRUE if should show the Intercept for each line, FALSE if shouldn't +## ' @param showAdjust If TRUE show all rows, if false hide the "adjust" rows +## ' @param showCols List of items that will be output as columns from each row, in order +## ' @param showOnce List of items that will be output as columns only on 1st row, in order +## ' @param fieldName The name of the List element that holds the matrix with the headers +## ' @param oneTimeFieldName ...? +## ' @param pFootnote If TRUE add a footnote describing the test used to generate the p value +## ' @return Vector of strings holding Pandoc code to create a row in a table representing element +## ' +## ' @author m082166 +formatModelSum <- function(element, lineSize, firstColSize, colSize, translations, digits, + pValueDigits, nsmall, nsmall.ratio, boldMark, showIntercept, showAdjust, + showCols, showOnce, fieldName, oneTimeFieldName, pFootnote) +{ + if (showAdjust) { + hideRows <- c() + } + else { + hideRows <- lookupHumanTitle(element$adjterms, translations) + } + + coefficients <- element[[fieldName]] + rows <- makeModelSumTitleCells (element, fieldName, firstColSize, translations, boldMark, + showIntercept, hideRows) + + numRows <- dim(coefficients)[1] + rowTitles <- lookupHumanTitle(element[[fieldName]]$term, translations) + colTitles <- getMatrixNames(element, fieldName, doRow = FALSE, translations = translations) + useCols <- getColsToUse (showCols, colTitles) + volueCols <- match(showCols, "p.value", nomatch = 0) + showExtras <- TRUE + curRow <- 0 + + for (startRow in seq_len(numRows)) + { + if (showRow(showIntercept, hideRows, rowTitles[startRow])) + { + extra <- c() + if (showExtras) + { + for (item in showOnce) { + extra <- c(extra, element[[oneTimeFieldName]][[item]]) + } + showExtras <- FALSE + } + else { + for (item in showOnce) { + extra <- c(extra, ".") + } + } + + rows <- addModel(rows, useCols, volueCols, coefficients[startRow, ], extra, curRow, + colSize, digits, pValueDigits, nsmall, nsmall.ratio) + curRow <- curRow + 1 + } + } + + return(rows) +} + + +## ' getColsToShow +## ' +## ' Takes the Vector of the currently filled in rows, as well as rows that have been started but +## ' not yet completed, and fills in the modelSum info for one more row +## ' +## ' @param control Control object, holding the columns we're displaying +## ' @param family Stats family of object we're displaying +## ' @param element 1st element we're displaying, to get column names / locations +## ' @param fieldName The name of the List element for the "show every row" data +## ' @param oneTimeFieldName The name of the List element for the "show once" data +## ' @param translations The List to use for conversion of labels +## ' @return List of Vectors of names of rows to output +## ' showCols: fields to be pulled from every row of element$coeff +## ' showOnce: fields to be pulled from element$glance, one time only +## ' +## ' @author m082166 +getColsToShow <- function(control, family, element, fieldName, oneTimeFieldName, translations) +{ + ## Match control stats columns by family to the stats in the object. + ## It is split by showCols and showOnce + if (family %in% c("quasibinomial","binomial")) + statFields <- control$binomial.stats + else if (family %in% c("quasipoisson","poisson")) + statFields <- control$poisson.stats + else if (family == "survival") + statFields <- control$survival.stats + else + statFields <- control$gaussian.stats + + statFields <- statFields[!is.na(statFields)] + + names <- colnames (element[[fieldName]]) + showCols <- names[match (statFields, names)] + names <- names (element[[oneTimeFieldName]]) + showOnce <- names[match (statFields, names)] + showCols <- lookupHumanTitle(showCols, translations) + showOnce <- lookupHumanTitle(showOnce, translations) + showCols <- showCols[!is.na(showCols)] + showOnce <- showOnce[!is.na(showOnce)] + + return (list (showCols = showCols, showOnce = showOnce)) +} + + +## ' showRow +## ' +## ' Determines whether or not a row should be displayed +## ' +## ' @param showIntercept TRUE if should show the Intercept for each line, FALSE if shouldn't +## ' @param hideRows Vector of names of rows that should not be shown +## ' @param rowTitle Name of the current row +## ' @return TRUE if should show this row, FALSE if shouldn't +## ' +## ' @author m082166 +showRow <- function(showIntercept, hideRows, rowTitle) { + if (rowTitle == "(Intercept)") + return(showIntercept) + + if (is.null(hideRows)) + return(TRUE) + + return (!(rowTitle %in% hideRows)) +} + + +## ' addModel +## ' +## ' Takes the Vector of the currently filled in rows, as well as rows that have been started but +## ' not yet completed, and fills in the modelSum info for one more row +## ' +## ' @param rows Vector of strings to edit, and possibly add to +## ' @param useCols Vector of column numbers from modelSum to use, in order to use them +## ' @param volueCols Vector of 0s and at most 1 "1", specifying if any column is the value col +## ' @param modelSum The row of the coefficients of modelsum to process, holding the info to add +## ' @param extra Vector of strings to pad and add to end of the row +## ' @param curRow Current row to operate on, 0 based +## ' @param colSize Width to pad each cell to +## ' @param digits Number of digits to round to when displaying percent or Other data +## ' @param pValueDigits Number of digits to display for a p-value. Example: 5 ==> in 0.12345 +## ' @param nsmall Minimum number of digits to the right of the decimal point to display +## ' for floating point numbers. If NULL, use 'digits' to determine everything +## ' @param nsmall.ratio Minimum number of digits to the right of the decimal point to display +## ' for the ratio statistics (OR, HR, RR) +## ' @return The updated rows +## ' +## ' @author m082166 +addModel <- function(rows, useCols, volueCols, modelSum, extra, curRow, colSize, digits, + pValueDigits, nsmall, nsmall.ratio) +{ + for (i in seq_len (length (useCols))) + { + col <- useCols[i] + if (volueCols[i] > 0) { + cell <- makeLimitedNumber(modelSum[col], pValueDigits) + } + else { + cell <- myFormat(modelSum[col], digits, nsmall) + } + + cell <- makePaddedStr(cell, colSize) + rows <- addToRow(rows, curRow, cell) + } + + for (item in extra) { + if (is.numeric(item)) { + cell <- myFormat(item, digits, nsmall) + } + else { + cell <- item + } + + cell <- makePaddedStr(cell, colSize) + rows <- addToRow(rows, curRow, cell) + } + + return(rows) +} + + +## ' getColsToUse +## ' +## ' Generate a Vector holding the numbers of the columns to be used, in the order to be used +## ' +## ' @param showCols List of items that will be output as columns from each row, in order +## ' @param colTitles List of column titles for modelSum, so can determine which to display +## ' @return Columns to be usedm in order +## ' +## ' @author m082166 +getColsToUse <- function(showCols, colTitles) +{ + numCells <- length(colTitles) + unusedCols <- seq_len(numCells) + colsToUse <- c() + + for (theCol in showCols) + { + for (test in seq_len(length(unusedCols))) + { + i <- unusedCols[test] + colTitle <- colTitles[i] + if (colTitle == theCol) + { + colsToUse <- c(colsToUse, i) + unusedCols <- unusedCols[- test] # Delete the used item + break + } + } + } + + return(colsToUse) +} + + +## ' makeModelSumHeaders +## ' +## ' Make the unpadded header for each column other than the label column +## ' +## ' @param object The data that will be turned into a table +## ' @param showCols List of items that will be output as columns from each row, in order +## ' @param showOnce List of items that will be output as columns only on 1st row, in order +## ' @param translations The List to use for conversion of labels +## ' @return A Vector of the column headers, given the data in object and extras, +## ' skipping the first (blank, label) header +## ' +## ' @author m082166 +makeModelSumHeaders <- function(object, showCols, showOnce, translations) { + ## second arg was fieldName, but not passed (tried by JPS on 12/15/16 + theNames <- getMatrixNames(object, showCols, translations = translations) + + if (is.na(extras) || (length(extras) == 0)) # length(NA) == 1 + return(theNames) + + extras <- lookupHumanTitle(extras, translations) + return(c(theNames, extras)) +} + + +## ' makeModelSumTitleCells +## ' +## ' Return an array of the lines needed to make the label cell, given the data in element, +## ' taking into account the maximum allowed width specified by colSize, +## ' which must be >= 4 + length of the name of element +## ' +## ' @param element List to get information from, whose first item must be the statistics +## ' @param colSize Width to pad the output to +## ' @param translations The List to use for conversion of labels +## ' @param boldMark String to use to mark something as bold +## ' @param showIntercept TRUE if should show the Intercept for each line, FALSE if shouldn't +## ' @param hideRows Vector of names of rows that should not be shown +## ' @param fieldName ...? +## ' @return Vector holding the strings necessary to represent the rows of element, +## ' each row separated by a blank string +## ' +## ' @author m082166 +makeModelSumTitleCells <- function(element, fieldName, colSize, translations, boldMark, + showIntercept, hideRows) { + theCells <- NULL + rowTitles <- lookupHumanTitle(element[[fieldName]]$term, translations) + + for (title in rowTitles) { + showThis <- showRow(showIntercept, hideRows, title) + if (showThis && (title != "(Intercept)")) { + title <- paste0(boldMark, title, boldMark) + } + + if (showThis) { + if (length(theCells) == 0) { + theCells <- c(makePaddedStr(title, colSize)) + } + else { + # Add blank line to mark new row, then title line(s) + theCells <- c(theCells, "", makePaddedStr(title, colSize)) + } + } + } + + return(theCells) +} + + +## ' getMatrixNames +## ' +## ' Get the row or column names for the matrix in fieldName +## ' +## ' @param element A List of Lists +## ' @param fieldName The name of the List element of interest +## ' @param doRow If TRUE get row names, if FALSE get column names, defaults to FALSE +## ' @param translations The List to use for conversion of labels, so can use the proper name length +## ' @return Vector of Strings, the row or column headers of the matrix +## ' +## ' @author m082166 +getMatrixNames <- function(element, fieldName, doRow = FALSE, translations = NULL) { + if (doRow) { + which <- 1 + } + else { + which <- 2 + } + + names <- dimnames(element[[fieldName]])[[which]] + if (!is.null(translations)) { + names <- lookupHumanTitle(names, translations) + } + + return(names) +} + + +## ' maxMatrixNameLen +## ' +## ' Return the length of the longest string among the names of elements +## ' +## ' @param elements A List of Lists +## ' @param translations The List to use for conversion of labels, so can use the proper name length +## ' @param fieldName The name of the List element of interest +## ' @param doRow If TRUE get row names, if FALSE get column names, defaults to FALSE +## ' @return The nchar length of the longest name from element's sub-lists, +## ' as translated via translations +## ' +## ' @author m082166 +maxMatrixNameLen <- function(elements, translations, fieldName, doRow = FALSE) { + theMax = 0 + + for (element in elements) { + theMax <- max(theMax, nchar(getMatrixNames(element, fieldName, doRow, translations))) + } + + return(theMax) +} + + +## ' maxElementNameLen +## ' +## ' Return the length of the longest string among the names of elements +## ' +## ' @param elements A List of Lists +## ' @param translations The List to use for conversion of labels, so can use the proper name length +## ' @return The nchar length of the longest name from element's sub-lists, +## ' as translated via translations +## ' +## ' @author m082166 +maxElementNameLen <- function(elements, translations) { + if (length(elements) == 0) + return(0) + + return(max(0, nchar(lookupHumanTitle(names(elements[[1]]), translations)))) +} + + +## JPS added 5/16/2016 +## skeleton that runs, but needs updating +summary.modelsumList <- function(object, title = NULL, labelTranslations = NULL, digits = NA, + nsmall = NA, nsmall.ratio = NA, digits.test = NA, show.intercept = NA, + show.adjust = NA, text = FALSE, removeBlanks = text, labelSize = 1.2, + pFootnote = TRUE, ...) { + + ## summary on a list of modelsum objects + for (k in 1:length(object)) { + summary.modelsum(object[k]) + } + + invisible(object) +} diff --git a/R/summary.tableby.R b/R/summary.tableby.R new file mode 100644 index 0000000..81de70d --- /dev/null +++ b/R/summary.tableby.R @@ -0,0 +1,204 @@ +## Purpose: summary method for tableby object +## Author: Greg Dougherty, Jason Sinnwell and Beth Atkinson +## Updated: 9/29/2015 + + +format.translations <- list(Nmiss = "N-miss", Nmiss2 = "N-miss", meansd = "Mean (SD)", q1q3 = "Q1, Q3", + range = "Range", Nevents = "Events", medsurv = "Median Survival", + sex = "Sex", age = "Age") + + +#' The summary method for a \code{tableby} object +#' +#' The summary method for a \code{\link{tableby}} object, which is a pretty rendering of a \code{\link{tableby}} +#' object into a publication-quality results table in R-studio, and can render well in text-only. +#' +#' @param object An object of class \code{"tableby"}, made by the \code{\link{tableby}} function. +#' @param title Title that will appear on the top of the header in the pretty-table rendering +#' of the tableby object +#' @param labelTranslations All labels that are to appear in the pretty rendering of the \code{tableby} +#' results have both summary-statistic labels that are replaced by a formal label +#' (e.g., \code{meansd} by \code{"Mean (SD)"}), and the variables from the formula can be replaced +#' by a more formal name. +#' @param digits Digits to round for significant digits of numeric, non-integer values. +#' If \code{digits.test} is not set, \code{digits} is used for that setting. +#' @param nsmall Minimum number of digits to the right of the decimal point to display +#' for floating point numbers. If \code{NA} (default), it uses the value from +#' \code{object$control$nsmall}. Allowed non-\code{NA} values are \code{0 <= nsmall <= 20}. +#' @param nsmall.pct Minimum number of digits to the right of the decimal point to display +#' for percent numbers. If \code{NA} (default), it uses the value from \code{object$control$nsmall.pct}. +#' @param digits.test Significant digits by which to round for numeric test statistic p-values, +#' if the test was performed. +#' @param text Logical, tell R to print the raw text version of the summary to the screen. +#' Default is \code{FALSE}, but recommended to be \code{TRUE} for interactive R session development. +#' @param removeBlanks Logical, remove extra blanks in the pretty rendering of the table +#' @param labelSize Relative size difference between label column and other columns. +#' Default is 1.2: label column ~20\% bigger than other columns. +#' @param test Logical, denoting whether the "p value" value should be printed. +#' If \code{NA} (default), it uses the value from \code{object$control$test}. +#' @param test.pname Title for p-value (only matters if test is \code{TRUE}; default is "p value"). +#' @param pfootnote Logical, denoting whether to add a footnote describing the test used to +#' generate the p value. Default is \code{FALSE}. +#' @param total Logical, denoting whether to include the "total" value. +#' If \code{NA} (default), it uses the value from \code{object$control$total}. +#' @param ... Other arguments (not in use at this time). +#' @details +#' For text-only, simply paste the summary stats together per variable, along with p-value and totals, +#' with group variable in the header. For other formats, the paste is done into a pandoc-style markup +#' such that it can be translated into 3 formats: latex, html, rft. The decision of which of those it +#' is translated to is left for run-time for whatever format into which the report is being generated. +#' +#' For all interative development within R sessions, \code{text=TRUE} is recommended. +#' +#' @return Results are cat'ed to stdout, and returned invisibly as a data.frame of the \code{tableby} +#' @seealso \code{\link{tableby.control}}, \code{\link{tableby}} +#' @author Gregory Dougherty, Jason Sinnwell, Beth Atkinson, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +#' @examples +#' +#' set.seed(100) +#' ## make 3+ categories for response +#' nsubj <- 90 +#' mdat <- data.frame(Response=sample(c(1,2,3),nsubj, replace=TRUE), +#' Sex=sample(c("Male", "Female"), nsubj,replace=TRUE), +#' Age=round(rnorm(nsubj,mean=40, sd=5)), +#' HtIn=round(rnorm(nsubj,mean=65,sd=5))) +#' +#' ## allow default summaries on RHS variables +#' out <- tableby(Response ~ Sex + Age + HtIn, data=mdat) +#' summary(out, text=TRUE) +#' labels(out) +#' labels(out) <- c(Age="Age (years)", HtIn="Height (inches)") +#' summary(out, labelTranslations=c(meansd="Mean-SD"), text=TRUE) +#' +#' @export +summary.tableby <- function (object, title = NULL, labelTranslations = NULL, digits = NA, + nsmall = NA, nsmall.pct = NA, digits.test = NA, text = FALSE, + removeBlanks = text, labelSize = 1.2, test = NA, test.pname = NA, + pfootnote = NA, total = NA, ...) { + frameOut <- makeSummary.tableby(TRUE, object, title, labelTranslations, digits, nsmall, + nsmall.pct, digits.test, text, removeBlanks, labelSize, test, + test.pname, pfootnote, total) + + invisible(frameOut) +} + + +#' as.data.frame.tableby +#' +#' Build a data.frame from the tableby object and parameters, and return it +#' +#' @inheritParams summary.tableby +#' @param x An object of class \code{\link{tableby}}. +#' @return Information is returned as a data.frame of the tableby +#' @author Gregory Dougherty, Jason Sinnwell, Beth Atkinson, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +#' +#' @export +as.data.frame.tableby <- function (x, ..., title = NULL, labelTranslations = NULL, digits = NA, + nsmall = NA, nsmall.pct = NA, digits.test = NA, + test = NA, test.pname = NA, total = NA) +{ + if(length(list(...)) > 0) warning("The '...' in this function has changed. Are you passing positional arguments?") + frameOut <- makeSummary.tableby(FALSE, x, title, labelTranslations, digits, nsmall, + nsmall.pct, digits.test, FALSE, FALSE, 1.2, test, test.pname, + NA, total) + + return(frameOut) +} + + +## ' Format the information in object as a Table using Pandoc coding or plain text
+## ' If doText is TRUE, cat it to stdout, else just return the data.frame +## ' +## ' @param doText Do we print text output, or only do the data.frame +## ' @inheritParams summary.tableby +## ' +## ' @return Results are cat'ed to stdout, and returned invisibly as a Vector of Strings +## ' +## ' @author m082166 +makeSummary.tableby <- function (doText, object, title, labelTranslations, digits, nsmall, + nsmall.pct, digits.test, text, removeBlanks, labelSize, test, + test.pname, pfootnote, total) { + control <- object$control + digits <- setParam(digits, control$digits) + digits.test <- setParam(digits.test, control$digits.test) + nsmall <- setParam(nsmall, control$nsmall) + nsmall.pct <- setParam(nsmall.pct, control$nsmall.pct) + keepTotalCol <- setParam3(total, control$total, TRUE) + if(!keepTotalCol & !any(grepl("Total", names(object$y[[1]]$stats)))) { + ## total column already not included, so tell method to keep last col, which it thinks is Total + keepTotalCol <- TRUE + } + hasPValue <- setParam3(test, control$test, TRUE) + pValueTitle <- setParam3(test.pname, control$test.pname, "p value") + pfootnote <- setParam3(pfootnote, control$pfootnote, FALSE) + collapse <- setParam(control$cat.simplify, FALSE) + + if (text) { + boldMark <- "" + indentStr <- " " + } + else { + boldMark <- "**" + indentStr <- " " + removeBlanks <- FALSE + } + + translations <- format.addTranslations(object, labelTranslations) + elements <- object$x + group <- object$y[[1]] + minColSize <- maxStrLen(lookupHumanTitle(names(elements), translations)) + (nchar(boldMark) * 2) + minColSize <- max(minColSize, maxNameLen(elements, translations)) + + header <- makeHeader(group, minColSize, keepTotalCol, hasPValue, pValueTitle, labelSize = labelSize) + lineSize <- as.integer(header$lineSize) + firstColSize <- as.integer(header$firstColSize) + colSize <- as.integer(header$colSize) + results <- header$header + headers <- c("variable", header$headers) + lastLine <- results[length(results)] # Clip off last line, will need to add it back at end + results <- results[- length(results)] + if (pfootnote) { + methods <- list() + } + else { + methods <- NULL # No footnotes are done when methods = NULL + } + + frameLists <- list(term = NULL, variable = NULL) + for (element in elements) { + + elmResults <- formatElement(element, lineSize, firstColSize, colSize, keepTotalCol, hasPValue, + translations, digits, digits.test, nsmall, nsmall.pct, + boldMark, indentStr, collapse, methods) + strings <- elmResults$strings + frameLists <- addListElement(frameLists, headers, strings, element$name, firstColSize, + colSize, boldMark, indentStr) + if (doText) { + results <- c(results, strings, "") + methods <- elmResults$methods + } + } + + frameOut <- makeDataFrame(headers, frameLists) + + if (doText) { + results <- c(results, lastLine, "") # Table must have blank line after last dashed line + if (removeBlanks) { + results <- c(results[nchar(results) > 0], "") # Keep one blank line at end + } + + if (!is.null(title) && !is.na(title)) { + if (text) { + results <- c(makeCenteredStr(title, lineSize), results) + } + else { # Titles can be multi line, so have a blank line to clearly end title + results <- c(paste0("Table: ", boldMark, title, boldMark), "", results) + } + } + + results <- addMethods (results, methods) + cat(paste(results, collapse = "\n")) + } + return(frameOut) +} + diff --git a/R/tableby.R b/R/tableby.R new file mode 100644 index 0000000..502f0b6 --- /dev/null +++ b/R/tableby.R @@ -0,0 +1,627 @@ +## Purpose: create analysis results from a formula, summarizing the response +## by the RHS variables, which univariate stats on the RHS vars within the +## levels of the response +## Author: Jason Sinnwell and Beth Atkinson +## Updated: 9/29/2015 +## +## to work with "specials" to specify the type of test or variable it is. +## look at survival package: + + +#' Summary Statistics of a Set of Independent Variables by a Categorical Variable +#' +#' Summarize one or more variables (x) by a categorical variable (y). Variables +#' on the right side of the formula, i.e. independent variables, are summarized by the +#' levels of a categorical variable on the left of the formula. Optionally, an appropriate test is performed to test the +#' distribution of the independent variables across the levels of the categorical variable. +#' +#' @param formula an object of class \code{\link{formula}}; a symbolic description of the variables to be summarized by the group, +#' or categorical variable, of interest. See "Details" for more information. To only view overall summary +#' statistics, a one-sided formula can be used. +#' @param data an optional data frame, list or environment (or object coercible by \code{\link{as.data.frame}} to a data frame) +#' containing the variables in the model. If not found in data, the variables are taken from \code{environment(formula)}, +#' typically the environment from which \code{tableby} is called. +#' @param na.action a function which indicates what should happen when the data contain \code{NA}s. +#' The default is \code{na.tableby} if there is a by variable, and \code{\link[stats]{na.pass}} if there is not. +#' This schema thus includes observations with \code{NA}s in x variables, +#' but removes those with \code{NA} in the categorical group variable. +#' @param subset an optional vector specifying a subset of observations (rows of data) to be used in the results. +#' Works as vector of logicals or an index. +#' @param weights a vector of weights. +#' @param control control parameters to handle optional settings within \code{tableby}. +#' Two aspects of \code{tableby} are controlled with these: test options of RHS variables across levels of the categorical +#' grouping variable, and x variable summaries within the grouping variable. Arguments for \code{tableby.control} +#' can be passed to \code{tableby} and will be set with \code{tableby.control}, but if using +#' \code{control=tableby.control(test=TRUE), test=FALSE}, \code{test} will be \code{TRUE}. See \code{\link{tableby.control}} for more details. +#' @param ... additional arguments to be passed to internal \code{tableby} functions. See "Details" for information. +#' Currently not implemented in \code{print.tableby}. +#' @param x an object of class \code{tableby}. +#' +#' @details +#' The group variable (if any) is categorical, which could be an integer, character, +#' factor, or ordered factor. \code{tableby} makes a simple summary of +#' the counts within the k-levels of the independent variables on the +#' right side of the formula. Note that unused levels are dropped. +#' +#' The \code{data} argument allows data.frames with label attributes for the columns, and those +#' labels will be used in the summary methods for the \code{tableby} class. +#' +#' The independent variables are a mixture of types: categorical (discrete), +#' numeric (continuous), and time to event (survival). These variables +#' are split by the levels of the group variable (if any), then summarized within +#' those levels, specific to the variable type. A statistical test is +#' performed to compare the distribution of the independent variables across the +#' levels of the grouping variable. +#' +#' The tests differ by the independent variable type, but can be specified +#' explicitly in the formula statement or in the control function. +#' These tests are accepted: +#' \itemize{ +#' \item{ +#' \code{anova}: analysis of variance test; the default test for continuous variables. When +#' LHS variable has two levels, equivalent to two-sample t-test. +#' } +#' \item{ +#' \code{kwt}: Kruskal-Wallis Rank Test, optional test for continuous +#' variables. When LHS variable has two levels, equivalent to Wilcoxon test. +#' } +#' \item{ +#' \code{chisq}: chi-square good-ness of fit test for equal counts of a +#' categorical variable across categories; the default for categorical +#' or factor variables +#' } +#' \item{ +#' \code{fe}: Fisher's exact test for categorical variables +#' } +#' \item{ +#' \code{trend}: trend test for equal distribution of an ordered variable +#' across a categorical variable; the default for ordered factor variables +#' } +#' \item{ +#' \code{logrank}: log-rank , the default for time-to-event variables +#' } +#' } +#' +#' To perform a mixture of asymptotic and rank-based tests on two +#' different continuous variables, an example formula is: +#' \code{formula = group ~ anova(age) + kwt(height)}. The test settings +#' in \code{tableby.control} apply to all independent variables of a given type. +#' +#' The summary statistics reported for each independent variable within the +#' group variable can be set in \code{\link{tableby.control}}. +#' +#' @return +#' +#' An object with class \code{'tableby'}, which is effectively a list with +#' the variables from the right-side in x and the group variable in y (if any). +#' Then, each item in x has these: +#' +#' \item{stats}{Summary statistics of the RHS variable within each level of the LHS variable} +#' \item{test}{Formal test of the distribution of the RHS variable across the levels of the LHS variable} +#' \item{label}{The label attribute of a variable. It is set to the label attribute of a data column, if it exists, +#' otherwise set to the variable name in \code{data}. Can be changed with \code{\link{labels.tableby}} function for the tableby object.} +#' +#' The object also contains the original function call and the \code{tableby.control} list that is used in \code{tableby}. +#' +#' @seealso \code{\link[stats]{anova}}, \code{\link[stats]{chisq.test}}, \code{\link{tableby.control}}, +#' \code{\link{print.tableby}}, \code{\link{summary.tableby}}, \code{\link{formulize}} +#' +#' @examples +#' data(mockstudy) +#' tab1 <- tableby(arm ~ sex + age, data=mockstudy) +#' summary(tab1, text=TRUE) +#' +#' mylabels <- list( sex = "SEX", age ="Age, yrs") +#' summary(tab1, labelTranslations = mylabels, text=TRUE) +#' +#' tab3 <- tableby(arm ~ sex + age, data=mockstudy, test=FALSE, total=FALSE, +#' numeric.stats=c("median","q1q3"), numeric.test="kwt") +#' summary(tab3, text=TRUE) +#' +#' tab.test <- tableby(arm ~ kwt(age) + anova(bmi) + kwt(ast), data=mockstudy) +#' tests(tab.test) +#' @author Jason Sinnwell, Beth Atkinson, Gregory Dougherty, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +#' @import stringr +#' @name tableby +NULL +#> NULL + +#' @rdname tableby +#' @export +tableby <- function(formula, data, na.action, subset=NULL, weights=NULL, control=list(...), ...) { + + control <- do.call("tableby.control", control) + + Call <- match.call() + ## Tell user if they passed an argument that was not expected, either here or in control + expectArgs <- c("formula","data","na.action","subset","weights", "control", names(control)) + match.idx <- match(names(Call)[-1], expectArgs) + if(any(is.na(match.idx))) { + warning("unused arguments: ", paste(names(Call)[1+which(is.na(match.idx))],collapse=", "), "\n") + } + ## pick up extra control arguments from command via ... + control <- do.call("tableby.control", control) + + indx <- match(c("formula", "data", "subset", "weights", "na.action"), names(Call), nomatch = 0) + if(indx[1] == 0) { ## formula + stop("A formula argument is required") + } + if(indx[4] != 0) { ## weights + control$test <- FALSE + } + temp.call <- Call[c(1, indx)] + temp.call[[1]] <- as.name("model.frame") + + if(is.null(temp.call$na.action)) { + temp.call$na.action <- if(length(temp.call$formula) == 2) stats::na.pass else na.tableby + } else if(length(temp.call$formula) == 2 && identical(na.action, na.tableby)) { + # purposely using na.action instead of temp.call$na.action here + warning("It appears you're using na.tableby with a one-sided formula... Results may not be what you expect.") + } + special <- c("anova", "kwt", "chisq", "fe", "logrank", "trend") + temp.call$formula <- if (missing(data)) { + stats::terms(formula, special) + } else { + stats::terms(formula, special, data = data) + } + ## set up new environment for + ## if specials, assign dummy versions of those functions + ## if(any(!is.null(attr(temp.call$formula, "specials")))) + tabenv <- new.env(parent = environment(formula)) + + if (!is.null(attr(temp.call$formula, "specials")$anova)) { + ## allow stat functions to be passed as single arguments that are strings of function names + ## Store this as attribute in the modeldf column, along with the actual name of the variable, + ## rather than anova(age) showing up in the result (though anova(age) will be the column name in modeldf + ## but we pull these attributes off later. + assign("anova", function(x, ...) + { extraArgs <- list(...); attr(x, "name") <- deparse(substitute(x)); attr(x, "stats") <- extraArgs; x}, + envir = tabenv) + } + if (!is.null(attr(temp.call$formula, "specials")$chisq)) { + assign("chisq", function(x, ...) + { extraArgs <- list(...); attr(x, "name") <- deparse(substitute(x)); attr(x, "stats") <- extraArgs; x}, + envir = tabenv) + } + if (!is.null(attr(temp.call$formula, "specials")$trend)) { + assign("trend", function(x, ...) + { extraArgs <- list(...); attr(x, "name") <- deparse(substitute(x)); attr(x, "stats") <- extraArgs; x}, + envir = tabenv) + } + if (!is.null(attr(temp.call$formula, "specials")$kwt)) { + assign("kwt", function(x, ...) + { extraArgs <- list(...); attr(x, "name") <- deparse(substitute(x)); attr(x, "stats") <- extraArgs; x}, + envir = tabenv) + } + if (!is.null(attr(temp.call$formula, "specials")$fe)) { + assign("fe", function(x, ...) + { extraArgs <- list(...); attr(x, "name") <- deparse(substitute(x)); attr(x, "stats") <- extraArgs; x}, + envir = tabenv) + } + if (!is.null(attr(temp.call$formula, "specials")$logrank)) { + assign("logrank", function(x, ...) + { extraArgs <- list(...); attr(x, "name") <- deparse(substitute(x)); attr(x, "stats") <- extraArgs; x}, + envir = tabenv) + } + ## set tabenv as environment in which to evalulate formula + #if(any(!is.null(attr(temp.call$formula, "specials")))) + environment(temp.call$formula) <- tabenv + + ## evaluate the formula with env set for it + modeldf <- eval.parent(temp.call) + if (nrow(modeldf) == 0) { + stop("No (non-missing) observations") + } + Terms <- stats::terms(modeldf) + + if(attributes(Terms)$response == 0) { + ## no response, create a dummy one + modeldf <- data.frame(Total="Overall",modeldf, stringsAsFactors=FALSE) + control$total <- FALSE + control$test <- FALSE + } + weights <- as.vector(stats::model.weights(modeldf)) + if(is.null(weights)) { + weights <- rep(1, nrow(modeldf)) + userWeights=FALSE + } + if("(weights)" %in% colnames(modeldf)) { + modeldf <- modeldf[,!grepl("(weights)", colnames(modeldf))] + userWeights=TRUE + } + if (!is.null(weights) && (!is.numeric(weights) | any(weights<0))) { + stop("'weights' must be a numeric vector and must be non-negative") + } + + ## find which columnss of modeldf have specials assigned to known specials + specialIndices <- unlist(attr(Terms, "specials")) + specialTests <- rep("",ncol(modeldf)) + ## If a special shows up multiple times, the unlist assigned a number at the end. Strip it off. + ## This disallows functions with a number at the end, and trims off up to 999 instances of + ## the same test name + specialTests[specialIndices] <- gsub("[0-9]$","",gsub("[0-9]$","",gsub("[0-9]$","",names(specialIndices)))) + + ## list of x variables + xList <- list() + ## turn warnings off (for chisq test), set back later + oldwarn <- options()$warn + options(warn = -1) + + ## fix of droplevels on by factor suggested by Ethan Heinzen 4/12/2016 + if(is.factor(modeldf[,1])) { + modeldf[,1] <- droplevels(modeldf[,1]) + } + + for(eff in 2:ncol(modeldf)) { + + ## ordered factor + if("ordered" %in% class(modeldf[,eff])) { + + ## stats + ostatList <- list() + ostyles <- character() + xlevels <- levels(modeldf[,eff]) + ## get stats funs from either formula or control + ordered.stats <- if(length(attributes(modeldf[,eff])$stats)>0) { + attributes(modeldf[,eff])$stats + } else { + control$ordered.stats + } + ## if no missings, and control says not to show missings, + ## remove Nmiss stat fun + if(sum(is.na(modeldf[,eff])) == 0 && any(grepl("Nmiss$",ordered.stats))) { + ordered.stats <- ordered.stats[!grepl("Nmiss$", ordered.stats)] + } + for(statfun in control$ordered.stats) { + ostyles <- c(ostyles, ifelse(statfun %in% c("countpct"), "percent",NA)) + + bystatlist <- list() + for(bylev in sort(unique(modeldf[,1]))) { + idx <- which(modeldf[,1] == bylev) + bystatlist[[as.character(bylev)]] <- eval(call(statfun, modeldf[idx,eff], levels=xlevels, na.rm=TRUE, weights=weights[idx])) + } + ostatList[[statfun]] <- bystatlist + + ## add Total + if(control$total) { + ostatList[[statfun]]$Total <- eval(call(statfun,modeldf[,eff], levels=xlevels, weights=weights)) + } + } + + ## test + if(control$test) { + if(nchar(specialTests[eff]) > 0) { + testout <- eval(call(specialTests[eff], modeldf[,eff], modeldf[,1])) + } else { + testout <- eval(call(control$ordered.test, modeldf[,eff], modeldf[,1])) + } + } else { + testout <- NULL + } + + ## label + nameEff <- attributes(modeldf[,eff])$name + if(is.null(nameEff)) nameEff <- names(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- nameEff + + xList[[nameEff]] <- list(stats=ostatList, test=testout, label=labelEff, + name=names(modeldf)[eff], + type="ordinal", output=ostyles) + + } else if(any( c("character", "factor", "logical") %in% c(mode(modeldf[,eff]), class(modeldf[,eff])))) { + ############################################## + ## categorical variable (character or factor) + ############################################## + + ## stats + cstatList <- list() + cstyles <- character() + + ## convert logicals to factor + if(class(modeldf[,eff])=="logical") { + modeldf[,eff]<- factor(modeldf[,eff], levels=c(FALSE, TRUE)) + } + + ## to make sure all levels of cat variable are counted, need to pass values along + xlevels <- if(is.factor(modeldf[,eff])) { + levels(modeldf[,eff]) + } else { + sort(unique(modeldf[!is.na(modeldf[,eff]),eff])) + } + + ## if no missings, and control says not to show missings, + ## remove Nmiss stat fun + cat.stats <- if(length(attributes(modeldf[,2])$stats)>0) { + attributes(modeldf[,eff])$stats + } else { + control$cat.stats + } + if(sum(is.na(modeldf[,eff])) == 0 && any(grepl("Nmiss$",cat.stats))) { + cat.stats <- cat.stats[!grepl("Nmiss$", cat.stats)] + } + for(statfun in cat.stats) { + cstyles <- c(cstyles, ifelse(statfun %in% c("countpct"), "percent",NA)) + bystatlist <- list() + for(bylev in sort(unique(modeldf[,1]))) { + idx <- which(modeldf[,1] == bylev) + bystatlist[[as.character(bylev)]] <- eval(call(statfun, modeldf[idx,eff], levels=xlevels, na.rm=TRUE, weights=weights[idx])) + } + cstatList[[statfun]] <- bystatlist + ## without weights can do: + ## tapply(modeldf[,eff],modeldf[,1], statfun, levels=xlevels, na.rm=TRUE,simplify=FALSE, weights=weights, ...) + + ## add Total + if(control$total) { + cstatList[[statfun]]$Total <- eval(call(statfun,modeldf[,eff], levels=xlevels, weights=weights)) + } + } + + ## simplify, only do if num-levels is 2 + if(control$cat.simplify==TRUE & + !is.null(nrow(cstatList[[statfun]][[1]])) && nrow(cstatList[[statfun]][[1]])==2) { + ##length(xlevels)==2) { + cstatList[[statfun]] <- lapply(cstatList[[statfun]], function(x) x[-1,]) + } + + ## test + if(control$test) { + if(nchar(specialTests[eff]) > 0) { + testout <- eval(call(specialTests[eff], modeldf[,eff], modeldf[,1])) + } else { + testout <- eval(call(control$cat.test, modeldf[,eff], modeldf[,1])) + } + } else { + testout <- NULL + } + ## label + nameEff <- attributes(modeldf[,eff])$name + if(is.null(nameEff)) nameEff <- names(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- nameEff + + xList[[nameEff]] <- list(stats=cstatList, test=testout, label=labelEff, + name=names(modeldf)[eff], + type="categorical", output=cstyles) + + } else if("Date" %in% c(mode(modeldf[,eff]),class(modeldf[,eff]))) { + + ######## Date variable ############### + + #stats + dstatList <- list() + dstyles <- character() + ## if no missings, and control says not to show missings, + ## remove Nmiss stat fun + date.stats <- if(length(attributes(modeldf[,eff])$stats)>0) { + attributes(modeldf[,eff])$stats + } else { + control$date.stats + } + if(sum(is.na(modeldf[,eff])) == 0 && any(grepl("Nmiss$",date.stats))) { + date.stats <- date.stats[!grepl("Nmiss$", date.stats)] + } + + for(statfun in date.stats) { + dstyles <- c(dstyles, ifelse(statfun %in% "range", "range", + ifelse(statfun %in% "q1q3","list", + ifelse(statfun %in% c("medianrange","medianq1q3"), "medlist",NA)))) + + bystatlist <- list() + for(bylev in sort(unique(modeldf[,1]))) { + idx <- which(modeldf[,1] == bylev) + bystatlist[[as.character(bylev)]] <- eval(call(statfun, modeldf[idx,eff], na.rm=TRUE, weights=weights[idx])) + } + dstatList[[statfun]] <- bystatlist + ## this works for median(date), but the above gets bad bc of list + ## dstatList[[statfun]] <- lapply(as.list(as.integer(modeldf[,eff]), modeldf[,1], statfun, na.rm=TRUE), + ## as.Date, origin="1970/01/01") + ## add Total + if(control$total) { + dstatList[[statfun]]$Total <- eval(call(statfun,modeldf[,eff], na.rm=TRUE, weights=weights)) + } + } + + ## tests: kruskal.test + if(control$test) { + if(nchar(specialTests[eff]) > 0) { + testout <- eval(call(specialTests[eff], modeldf[,eff], modeldf[,1])) + } else { + testout <- eval(call(control$date.test, modeldf[,eff], modeldf[,1])) + } + } else { + testout <- NULL + } + + ## label + nameEff <- attributes(modeldf[,eff])$name + if(is.null(nameEff)) nameEff <- names(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- nameEff + + xList[[nameEff]] <- list(stats=dstatList, test=testout, label=labelEff, + name=names(modeldf)[eff], + type="Date", output=dstyles) + + } else if("Surv" %in% class(modeldf[,eff])) { + + ##### Survival (time to event) ####### + + ## stats + sstatList <- stimestatList <- list() + sstyles <- stimestyles <- character() ## pass times to summary, delay to within loop + times <- list(...)$times + if(is.null(times)) { + times <- 1:5 + } + stratfit <- survival::survfit(modeldf[,eff] ~ modeldf[,1], weights=weights) + totfit <- survival::survfit(modeldf[,eff] ~ 1, weights=weights) + for(statfun in control$surv.stats) { + sstyles <- c(sstyles, ifelse(statfun=="NeventsSurv", "pct", NA)) + sstatList[[statfun]] <- as.list(eval(call(statfun, stratfit, times=times))) + ## add Total + if(control$total) { + sstatList[[statfun]]$Total <- eval(call(statfun,totfit, times=times)) + } + } + + ## test + if(control$test) { + if(nchar(specialTests[eff]) > 0) { + testout <- eval(call(specialTests[eff], modeldf[,eff], modeldf[,1])) + } else { + testout <- eval(call(control$surv.test, modeldf[,eff], modeldf[,1])) + } + } else { + testout <- NULL + } + + ## label + nameEff <- attributes(modeldf[,eff])$name + if(is.null(nameEff)) nameEff <- names(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + if(is.null(labelEff)) labelEff <- nameEff + + ## if statfuns contain NeventsSurv or NriskSurv, make new surv x variable + ## and rm from ssstatList and sstyles + evsurv <- risksurv <- FALSE + if("NeventsSurv" %in% names(sstatList)) { + idx <- which(names(sstatList) == "NeventsSurv") + sevstatList <- sstatList[[idx]] + sevstyles <- sstyles[idx] + sstatList[[idx]] <- NULL + sstyles <- sstyles[-idx] + evsurv <- TRUE + } + if("NriskSurv" %in% names(sstatList) ) { + idx <- which(names(sstatList) == "NriskSurv") + srskstatList <- sstatList[[idx]] + srskstyles <- sstyles[idx] + sstatList[[idx]] <- NULL + sstyles <- sstyles[-idx] + risksurv <- TRUE + } + + xList[[nameEff]] <- list(stats=sstatList, test=testout, label=labelEff, + name=names(modeldf)[eff], + type="survival", output=sstyles) + if(evsurv) { + xList[["NeventsSurv"]] <- list(stats=list(NeventsSurv=sevstatList), test=testout, label="NeventsSurv", + name=gsub("Surv", "Events", names(modeldf)[eff]), + type="survival", output=sevstyles) + } + if(risksurv) { + xList[["NriskSurv"]] <- list(stats=list(NriskSurv=srskstatList), test=testout, label="NriskSurv", + name=gsub("Surv","AtRisk",names(modeldf)[eff]), + type="survival", output=srskstyles) + } + + } else if(any(c("numeric", "integer", "difftime") %in% c(mode(modeldf[,eff]),class(modeldf[,eff])))) { + + ######## Continuous variable (numeric) ############### + + #stats + nstatList <- list() + nstyles <- character() + + ## for difftime, convert to numeric + if(class(modeldf[,eff])=="difftime") { + modeldf[,eff] <- as.numeric(modeldf[,eff]) + } + + ## if no missings, and control says not to show missings, + ## remove Nmiss stat fun + num.stats <- if(length(attributes(modeldf[,eff])$stats)>0) { + attributes(modeldf[,eff])$stats + } else { + control$numeric.stats + } + if(sum(is.na(modeldf[,eff])) == 0 && any(grepl("Nmiss$",num.stats))) { + num.stats <- num.stats[!grepl("Nmiss$", num.stats)] + } + for(statfun in num.stats) { + nstyles <- c(nstyles, ifelse(statfun %in% "range", "range", + ifelse(statfun %in% "q1q3","list", + ifelse(statfun %in% c("medianrange","medianq1q3"), "medlist",NA)))) + bystatlist <- list() + for(bylev in sort(unique(modeldf[,1]))) { + idx <- which(modeldf[,1] == bylev) + bystatlist[[as.character(bylev)]] <- eval(call(statfun, modeldf[idx,eff], na.rm=TRUE, weights=weights[idx])) + } + nstatList[[statfun]] <- bystatlist + ## add Total + if(control$total) { + nstatList[[statfun]]$Total <- eval(call(statfun,modeldf[,eff], na.rm=TRUE, weights=weights)) + } + ## old way to call with ind_var, group_var, may go back, so keep around: + ## nstatList[[statfun]] <- eval(call(statfun, modeldf[,eff], modeldf[,1])) + } + ## tests: anova and kruskal.test + if(control$test) { + if(nchar(specialTests[eff]) > 0) { + testout <- eval(call(specialTests[eff], modeldf[,eff], modeldf[,1])) + } else { + testout <- eval(call(control$numeric.test, modeldf[,eff], modeldf[,1])) + } + } else { + testout <- NULL + } + ## label + nameEff <- attributes(modeldf[,eff])$name + if(is.null(nameEff)) nameEff <- names(modeldf)[eff] + labelEff <- attributes(modeldf[,eff])$label + + if( is.null(labelEff) | (grepl("\\(", names(modeldf)[eff]) & grepl("\\(", nameEff))) labelEff <- nameEff + + xList[[nameEff]] <- list(stats=nstatList, test=testout, label=labelEff, + name=names(modeldf)[eff], + type="numeric", output=nstyles) + + } + } + + options(warn = oldwarn) + + ## attributes: label/long-names + ## number of RHS variables + + + labelBy <- attributes(modeldf[,1])$label + if(is.null(labelBy)) { + labelBy <- names(modeldf)[1] + } + yList <- list() + + yList[[names(modeldf)[1]]] <- list(stats=unlist(table(factor(modeldf[,1], + levels=sort(unique(modeldf[,1]))),exclude=NA)), + label=labelBy, name=names(modeldf)[1]) + + if(control$total) { + yList[[names(modeldf)[1]]]$stats <- c(yList[[names(modeldf)[1]]]$stats,Total=sum(!is.na(modeldf[,1]))) + } + + tblList <- list(y = yList, x = xList, control = control, Call = match.call(), weights=userWeights) + class(tblList) <- "tableby" + ## if(!usingRCF() & !usingNCSA()) { + ## cat(paste0("R-", version$major,".", version$minor, "\t", system("echo $USER",intern=TRUE), "\t", Sys.Date(), "\n"), + ## file="/projects/bsi/infrastructure/s200555.Rinfrastructure/rlogs/tableby.log",append=TRUE) + ## } + return(tblList) +} + + +#' @rdname tableby +#' @export +print.tableby <- function(x, ...) { + cat("Tableby Object\n\n") + cat("Function Call: \n") + print(x$Call) + cat("\n") + cat("y variable:\n") + print(names(x$y)) + cat("x variables:\n") + print(names(x$x)) + + invisible(x) +} + diff --git a/R/tableby.control.R b/R/tableby.control.R new file mode 100644 index 0000000..46b17f9 --- /dev/null +++ b/R/tableby.control.R @@ -0,0 +1,158 @@ +## Purpose: control parameters for tableby function +## Authors: Jason Sinnwell, Beth Atkinson +## Created: 4/16/2015 + +#The default summary statistics are: +#* `continuous`: Continuous variables will show by default `Nmiss, meansd, q1q3, range` +#* `cat`: Categorical and factor variables will show by default `Nmiss, countpct` +#* `ordered`: Ordered factors will show by default `Nmiss, countpct` +#* `surv`: Survival variables will show by default `Nmiss, Nevents, medsurv` + ## JPS: consider survKyr +#* `group`: The grouping variable will show by default `countpct` + +## Many of the test statistics are standardly defined in R (e.g. mean), +## These are extra functions defined specifically for this function. + +#' Control settings for \code{tableby} function +#' +#' Control test and summary settings for the \code{\link{tableby}} function. +#' +#' @param test logical, telling \code{tableby} whether to perform tests of x variables across levels of the group variable. +#' @param total logical, telling \code{tableby} whether to calculate a column of totals across group variable. +#' @param test.pname character string denoting the p-value column name in \code{\link{summary.tableby}}. +#' Modifiable also with \code{\link{modpval.tableby}}. +#' @param cat.simplify logical, tell \code{tableby} whether to include the first level of the categorical variable if binary. +#' If \code{TRUE}, only the summary stats of the second level, and total (if \code{TRUE}), are calculated. +#' NOTE: this only simplifies to one line if \code{cat.stats} is only one statistic, such as countpct. +#' Specifically, if \code{cat.stats} includes Nmiss and there are missings, then Nmiss is included in the stats. +#' @param numeric.test set test for numeric RHS variables in \code{tableby} to anova or kwt (Kruskal-Wallis) rank-based tests. +#' If no LHS variable exists, then a mean is required for a univariate test. +#' @param numeric.stats summary statistics to include for numeric RHS variables of \code{tableby} within the levels of the group LHS variable. +#' Options are N, Nmiss, mean, meansd, median, q1q3, range, or other R built-in or user-written functions. +#' @param cat.test name of test for categorical variables: chisq, fe (Fisher's Exact) +#' @param cat.stats summary statistics to include for categorical RHS variables of \code{tableby} within the levels of the group LHS variable. +#' Options are N, Nmiss, count, countpct, or other R built-in or user-written functions. +#' @param ordered.test name of test for ordered variables: trend +#' @param ordered.stats summary statistics to include for categorical RHS variables of \code{tableby} within the levels of the group LHS variable. +#' Options are N, Nmiss, count, countpct, or other R built-in or user-written functions. +#' @param surv.test name of test to perform for survival variables: logrank +#' @param surv.stats summary statistics to include for time-to-event (survival) RHS variables of \code{tableby} within the levels of the group LHS variable. +#' Options are Nevents, medsurv. +#' @param date.test name of test to perform for date variables. +#' @param date.stats stats functions to perform for Date variables +#' @param stats.labels A named list of labels for all the statistics function names, where the function name is the named element in the list +#' and the value that goes with it is a string containing the formal name that will be printed in all printed renderings of the output, +#' e.g., list(countpct="Count(Pct)"). +#' @param digits digits to print for non-integer statistics +#' @param digits.test digits to print for test statistic p-values +#' @param nsmall digits to print after decimal point for numerics +#' @param nsmall.pct digits to print after decimal point for percentages +#' @param ... additional arguments to be passed to internal \code{tableby} functions and kept for summary method options, such as digits. +#' @details +#' All tests can be turned off by setting \code{test} to FALSE. +#' Otherwise, test are set to default settings in this list, or set explicitly in the formula of \code{tableby}. +#' +#' @return A list with settings to be used within the \code{tableby} function. +#' @export +#' +#' @seealso \code{\link[stats]{anova}}, \code{\link[stats]{chisq.test}}, \code{\link{tableby}}, \code{\link{summary.tableby}} +#' +#' @author Jason Sinnwell, Beth Atkinson, Terry Therneau, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +#' +#' @examples +#' set.seed(100) +#' ## make 3+ categories for Response +#' mdat <- data.frame(Response=c(0,0,0,0,0,1,1,1,1,1), +#' Sex=sample(c("Male", "Female"), 10,replace=TRUE), +#' Age=round(rnorm(10,mean=40, sd=5)), +#' HtIn=round(rnorm(10,mean=65,sd=5))) +#' +#' ## allow default summaries in RHS variables, and pass control args to +#' ## main function, to be picked up with ... when calling tableby.control +#' outResp <- tableby(Response ~ Sex + Age + HtIn, data=mdat, total=FALSE, test=TRUE) +#' outCtl <- tableby(Response ~ Sex + Age + HtIn, data=mdat, +#' control=tableby.control(total=TRUE, cat.simplify=TRUE, +#' cat.stats=c("Nmiss","countpct"),digits=1)) +#' summary(outResp, text=TRUE) +#' summary(outCtl, text=TRUE) + +tableby.control <- function(test=TRUE,total=TRUE, test.pname=NULL, cat.simplify=FALSE, + numeric.test="anova", cat.test="chisq", ordered.test="trend", surv.test="logrank", date.test="kwt", + numeric.stats=c("Nmiss","meansd","q1q3","range"), + cat.stats=c("Nmiss","countpct"), + ordered.stats=c("Nmiss", "countpct"), + surv.stats=c("Nevents","medSurv"), + date.stats=c("Nmiss", "median","range"), + stats.labels=list(Nmiss="N-Miss", Nmiss2="N-Miss", meansd="Mean (SD)", q1q3="Q1, Q3", range="Range", + countpct="Count (Pct)", Nevents="Events", medsurv="Median Survival"), + digits=3, digits.test=NULL, nsmall=NULL, nsmall.pct=NULL, ...) { + + ## validate digits + if(is.null(digits)) { + digits <- 3 + } + if(is.null(digits.test)){ + digits.test <- digits + } +# if(is.null(nsmall)){ +# nsmall <- 2 +# } +# if(is.null(nsmall.pct)){ +# nsmall.pct <- 2 +# } + if(digits < 1 | digits.test < 1) { + warning("digits must be positive integer. Set to default. \n") + digits <- 3 + digits.test <- digits + } + if(!is.null(nsmall) && (nsmall < 1)) { + warning("nsmall must be positive integer, or NULL. Set to NULL. \n") + nsmall <- NULL + } + if(!is.null(nsmall.pct) && (nsmall.pct < 1)) { + warning("nsmall.pct must be positive integer, or NULL. Set to NULL. \n") + nsmall.pct <- NULL + } + ## validate all test names + if(!exists(numeric.test)) { + stop("numeric test does not exist: ", numeric.test, "\n") + } + if(!exists(cat.test)) { + stop("categorical test does not exist: ", cat.test, "\n") + } + if(!exists(ordered.test)) { + stop("ordinal test does not exist: ", ordered.test, "\n") + } + if(!exists(surv.test)) { + stop("survival test does not exist: ", surv.test, "\n") + } + if(!exists(date.test)) { + stop("date test does not exist: ", date.test, "\n") + } + ## validate summary stat function names + + if(any(!exists(numeric.stats))) { + stop("One or more numeric summary statistic functions do not exist.\n") + } + if(any(!exists(cat.stats))) { + stop("One or more categorical summary statistic functions do not exist.\n") + } + if(any(!exists(ordered.stats))) { + stop("One or more ordered summary statistic functions do not exist.\n") + } + if(any(!exists(surv.stats))) { + stop("One or more survival summary statistic functions do not exist.\n") + } + if(any(!exists(date.stats))) { + stop("One or more date summary statistic functions do not exist.\n") + } + return(list(test=test, total=total, test.pname=test.pname, cat.simplify=cat.simplify, + numeric.test=numeric.test, cat.test=cat.test, + ordered.test=ordered.test, surv.test=surv.test, + numeric.stats=numeric.stats, cat.stats=cat.stats, + ordered.stats=ordered.stats, surv.stats=surv.stats, + date.test=date.test, date.stats=date.stats, + stats.labels=stats.labels, + digits=digits, digits.test=digits.test, nsmall=nsmall, nsmall.pct=nsmall.pct)) + +} diff --git a/R/tableby.internal.R b/R/tableby.internal.R new file mode 100644 index 0000000..7e82381 --- /dev/null +++ b/R/tableby.internal.R @@ -0,0 +1,1152 @@ +## Purpose: internal functions (and methods) for tableby function +## Authors: Jason Sinnwell, Beth Atkinson, Gregory Dougherty +## Created: 4/16/2015 + +## Helper functions for tableby: merge, subset, and labels (work like names) + +## merge two tableby objects +## both must have same "by" variable and levels +## if some RHS variables have same names, keep both, the one in y add ".y" + +#' Helper functions for tableby +#' +#' A set of helper functions for \code{\link{tableby}}. +#' +#' @param object A \code{data.frame} resulting form evaluating \code{modelsum} formula. +#' @param ... Other arguments, or a vector of indices for extracting. +#' @param x,y A \code{tableby} object. +#' @param value A list of new labels. +#' @param pdata A named data.frame where the first column is the x variable names matched by name, the second is the +#' p-values (or some test stat), and the third column is the method name (optional) +#' @param use.pname Logical, denoting whether the column name in \code{pdata} corresponding to the p-values should be used +#' in the output of the object. +#' @return \code{na.tableby} returns a subsetted version of \code{object} (with attributes). +#' @name tableby.internal +NULL +#> NULL + +#' @rdname tableby.internal +#' @export +merge.tableby <- function(x, y, ...) { + + if(names(x$y) != names(y$y)) { + stop("tableby objects cannot be merged unless same 'by' variable name).\n") + } + if(!all(names(x$y[[1]]$stats) == names(y$y[[1]]$stats))){ + stop("tableby objects cannot be merged unless same 'by' variable categories.\n") + } + newobj <- x + y$y[[1]]$label <- paste0(y$y[[1]]$label, ".2") + newobj$y[[paste0(names(y$y)[[1]],".2")]] <- y$y[[1]] + for(xname in names(y$x)) { + thisname <- xname + ## if name already present, add "2" to name and add on + if(xname %in% names(newobj$x)) { + thisname <- paste0(xname, ".2") + y$x[[xname]]$label <- paste0(y$x[[xname]]$label, ".2") + } + newobj$x[[thisname]] <- y$x[[xname]] + } + + ## add on call and control from y + newobj$Call2 <- y$Call + newobj$control2 <- y$control + + return(newobj) +} + +## pdata is a named data.frame where the first column is the x variable names matched by name, +## p-values (or some test stat) are numbers and the name is matched +## method name is the third column (optional) +## to the x variable in the tableby object (x) + +#' @rdname tableby.internal +#' @export +modpval.tableby <- function(x, pdata, use.pname=FALSE) { + ## set control$test to TRUE + if(any(pdata[,1] %in% names(x$x))) { + x$control$test <- TRUE + + ## change test results + for(k in 1:nrow(pdata)) { + xname <- pdata[k,1] + idx <- which(names(x$x)==xname) + if(length(idx)==1) { + x$x[[idx]]$test$p.value <- pdata[k,2] + if(ncol(pdata)>2) { + x$x[[idx]]$test$method <- pdata[k,3] + } else { + x$x[[idx]]$test$method <- "modified by user" + } + } + } + if(use.pname & nchar(names(pdata)[2])>0) { + ## put different test column name in control + x$control$test.pname <- names(pdata)[2] + } + } + return(x) +} + +## Get the labels from the tableby object's elements in the order they appear in the fomula/Call +## including the y and x variables +# labels <- function(x) { +# UseMethod("labels") +# } + +## retrieve variable labels (y, x-vec) from tableby object + +#' @rdname tableby.internal +#' @export +labels.tableby <- function(object, ...) { + ## get the formal labels from a tableby object's data variables + allLabels <- c(sapply(object$y, function(obj) obj$label), sapply(object$x, function(obj) obj$label)) + names(allLabels) <- c(names(object$y), names(object$x)) + return(allLabels) +} + + +#' @rdname tableby.internal +#' @export +'labels<-' <- function(x, value) { + UseMethod("labels<-") +} + +## define generic function for tests, so tests(tbObj) will work + +#' @rdname tableby.internal +#' @export +tests <- function(x) { + UseMethod("tests") +} + +## retrieve the names of the tests performed per variable + +#' @rdname tableby.internal +#' @export +tests.tableby <- function(x) { + if(x$control$test) { + testdf <- data.frame(Variable=labels(x)[-1], + p.value=sapply(x$x, function(z) z$test$p.value), + Method=sapply(x$x, function(z) z$test$method)) + if(!is.null(x$control$test.pname)) { + names(testdf)[2] <- x$control$test.pname + } + } else { + testdf <- cat("No tests run on tableby object\n") + } + return(testdf) +} + + +## assign labels to tableby object + +#' @rdname tableby.internal +#' @export +'labels<-.tableby' <- function(x, value) { + ## if the value vector is named, then assign the labels to + ## those names that match those in x and y + if(!is.null(names(value))) { + vNames <- names(value) + objNames <- c(names(x$y), names(x$x)) + v2objIndex <- match(vNames, objNames) + if(any(is.na(v2objIndex))) { + warning("Named value(s): ", paste(vNames[is.na(v2objIndex)],collapse=","), + " not matched in x\n") + } + ## handle y label first, then remove it + if(any(v2objIndex==1)) { + x$y[[1]]$label <- value[which(v2objIndex==1)] + value <- value[-which(v2objIndex==1)] + v2objIndex <- v2objIndex[-which(v2objIndex==1)] + } + if(length(v2objIndex)>0) { + ## prepare to iterate over the rest for x, if there are any + v2objIndex <- v2objIndex - 1 + for(k in seq_len(length(v2objIndex))) { + x$x[[ v2objIndex[k] ]]$label <- value[k] + } + } + } else { + + ## Otherwise, assign in the order of how variables appear in formula, starting with y + ## check that length of value matches what is expected for x + ## for each of the RHS vars of x (1:length(x)-3), + ##assign strings in value to the 'label' element of the list for each RHS variable + + if(length(value) != length(x$y + length(x$x))) { + stop("Length of new labels is not the same length as there are variables in the formula.\n") + } + x$y[[1]]$label <- value[1] + for(k in 1:length(x$x)) { + x$x[[k]]$label <- value[k-1] + } + } + ## return tableby x with updated labels + return(x) +} + +## subset a tableby object; +## syntax of usage: newtb <- tbObj[1:2] +## x here is the tableby object +## index is in '...', and allows only 1 vector of integer indices +## in future, maybe allow subsetting by names + +#' @rdname tableby.internal +#' @export +"[.tableby" <- function(x, ...) { + newx <- x + if(length(list(...)) != 1) { + stop ("Only 1 subscript allowed") + } + ## index vector + idx <- (1:length(x$x))[..1] + if(all(is.na(idx))) { + newx$x <- x$x[...] + } else { + newx$x <- x$x[idx] + } + return(newx) + } + + + +## function to handle na.action for tableby formula, data.frame + +#' @rdname tableby.internal +#' @export +na.tableby <- function(object, ...) { + omit <- is.na(object[,1]) + xx <- object[!omit, , drop = FALSE] + if(any(omit > 0L)) { + temp <- stats::setNames(seq(omit)[omit], attr(object, "row.names")[omit]) + attr(temp, "class") <- "omit" + attr(xx, "na.action") <- temp + } + xx +} + +## wtd.mean, wtd.var, wtd.quantile (and wtd.table, wtd.Ecdf) all from Hmisc +wtd.table <- function(x, weights=NULL, type=c("list","table"), normwt=FALSE, na.rm = TRUE) { + type <- match.arg(type) + if(!length(weights)) + weights <- rep(1, length(x)) + isdate <- testDateTime(x) + ax <- attributes(x) + ax$names <- NULL + if(is.character(x)) { + x <- as.factor(x) + } + lev <- levels(x) + x <- unclass(x) + if(na.rm) { + s <- !is.na(x + weights) + x <- x[s, drop = FALSE] + weights <- weights[s] + } + n <- length(x) + if(normwt) + weights <- weights * length(x)/sum(weights) + i <- order(x) + x <- x[i] + weights <- weights[i] + if(anyDuplicated(x)) { + weights <- tapply(weights, x, sum) + if(length(lev)) { + levused <- lev[sort(unique(x))] + if((length(weights) > length(levused)) && any(is.na(weights))) + weights <- weights[!is.na(weights)] + if(length(weights) != length(levused)) + stop("program logic error") + names(weights) <- levused + } + if(!length(names(weights))) + stop("program logic error") + if(type == "table") + return(weights) + x <- all.is.numeric(names(weights), "vector") + if(isdate) + attributes(x) <- c(attributes(x), ax) + names(weights) <- NULL + return(list(x = x, sum.of.weights = weights)) + } + xx <- x + if(isdate) + attributes(xx) <- c(attributes(xx), ax) + if(type == "list") + list(x = if(length(lev)) lev[x] else xx, sum.of.weights = weights) + else { + names(weights) <- if(length(lev)) + lev[x] + else xx + weights + } +} +wtd.Ecdf <- function(x, weights=NULL, type=c("i/n","(i-1)/(n-1)","i/(n+1)"), normwt=FALSE, na.rm=TRUE) { + type <- match.arg(type) + switch(type, `(i-1)/(n-1)` = { + a <- b <- -1 + }, `i/(n+1)` = { + a <- 0 + b <- 1 + }, `i/n` = { + a <- b <- 0 + }) + if(!length(weights)) { + oldopt <- options(digits = 7) + on.exit(options(oldopt)) + cumu <- table(x) + isdate <- testDateTime(x) + ax <- attributes(x) + ax$names <- NULL + x <- as.numeric(names(cumu)) + if(isdate) + attributes(x) <- c(attributes(x), ax) + cumu <- cumsum(cumu) + cdf <- (cumu + a)/(cumu[length(cumu)] + b) + if(cdf[1] > 0) { + x <- c(x[1], x) + cdf <- c(0, cdf) + } + return(list(x = x, ecdf = cdf)) + } + w <- wtd.table(x, weights, normwt = normwt, na.rm = na.rm) + cumu <- cumsum(w$sum.of.weights) + cdf <- (cumu + a)/(cumu[length(cumu)] + b) + list(x = c(if(cdf[1] > 0) w$x[1], w$x), ecdf = c(if(cdf[1] > 0) 0, cdf)) +} +wtd.mean <- function(x, weights = NULL, normwt = "ignored", na.rm = TRUE) { + if(!length(weights)) + return(mean(x, na.rm = na.rm)) + if(na.rm) { + s <- !is.na(x + weights) + x <- x[s] + weights <- weights[s] + } + sum(weights * x)/sum(weights) +} +wtd.quantile <- function(x, weights=NULL, probs=c(0,0.25,0.5,0.75,1), + type=c("quantile","(i-1)/(n-1)","i/(n+1)","i/n"), normwt=FALSE, na.rm=TRUE) { + + if(!length(weights)) + return(stats::quantile(x, probs = probs, na.rm = na.rm)) + type <- match.arg(type) + if(any(probs < 0 | probs > 1)) + stop("Probabilities must be between 0 and 1 inclusive") + nams <- paste(format(round(probs * 100, if(length(probs) > + 1) 2 - log10(diff(range(probs))) else 2)), "%", sep = "") + if(type == "quantile") { + w <- wtd.table(x, weights, na.rm = na.rm, normwt = normwt, + type = "list") + x <- w$x + wts <- w$sum.of.weights + n <- sum(wts) + order <- 1 + (n - 1) * probs + low <- pmax(floor(order), 1) + high <- pmin(low + 1, n) + order <- order%%1 + allq <- stats::approx(cumsum(wts), x, xout = c(low, high), method = "constant", f = 1, rule = 2)$y + k <- length(probs) + quantiles <- (1 - order) * allq[1:k] + order * allq[-(1:k)] + names(quantiles) <- nams + return(quantiles) + } + w <- wtd.Ecdf(x, weights, na.rm = na.rm, type = type, normwt = normwt) + structure(stats::approx(w$ecdf, w$x, xout = probs, rule = 2)$y, names = nams) +} + +wtd.var <- function(x, weights = NULL, normwt=FALSE, na.rm=TRUE, method = c("unbiased","ML")) { + method <- match.arg(method) + if(!length(weights)) { + if(na.rm) + x <- x[!is.na(x)] + return(stats::var(x)) + } + if(na.rm) { + s <- !is.na(x + weights) + x <- x[s] + weights <- weights[s] + } + if(normwt) + weights <- weights * length(x)/sum(weights) + if(method == "ML") + return(as.numeric(stats::cov.wt(cbind(x), weights, method = "ML")$cov)) + sw <- sum(weights) + xbar <- sum(weights * x)/sw + sum(weights * ((x - xbar)^2))/(sw - (if(normwt) sum(weights^2)/sw else 1)) +} +## internal function borrowed from Hmisc +testDateTime <- function(x, what = c("either", "both", "timeVaries")) { + what <- match.arg(what) + cl <- class(x) + if(!length(cl)) + return(FALSE) + dc <- c("Date", "POSIXt", "POSIXct", "dates", "times", "chron") + dtc <- c("POSIXt", "POSIXct", "chron") + switch(what, either = any(cl %in% dc), both = any(cl %in% + dtc), timeVaries = { + if("chron" %in% cl || "Date" %in% cl) { + y <- as.numeric(x) + length(unique(round(y - floor(y), 13))) > 1 + } else length(unique(format(x, "%H%M%S"))) > 1 + }) +} +all.is.numeric <- function(x, what = c("test", "vector"), extras = c(".", "NA")) { + what <- match.arg(what) + x <- sub("[[:space:]]+$", "", x) + x <- sub("^[[:space:]]+", "", x) + xs <- x[x %nin% c("", extras)] + isnum <- suppressWarnings(!any(is.na(as.numeric(xs)))) + if(what == "test") + isnum + else if(isnum) + as.numeric(x) + else x +} + +########## Note from Ethan: if we want these doc pages, just replace all instances of "## '" with "#'" + +## ' makeDataFrame +## ' +## ' Make the tableby data frame and add the output to it +## ' +## ' @param headers Vector of most of the columns and their titles +## ' @param frameLists List of lists holding the data for the data frame +## ' @return Data Frame with all the elements set up and filled in +## ' +## ' @author m082166 +makeDataFrame <- function(headers, frameLists) { + df <- as.data.frame (frameLists, stringsAsFactors = FALSE) + colnames(df) <- c ("term", headers) + return (df) +} + + +## ' addListElement +## ' +## ' Make lists for the data frame the output will be added to +## ' +## ' @param theFrame List of Lists holding the Lists to be added to, 1st time through just +## ' contains "term" and "variable", both NULL) +## ' @param headers Vector of the columns and their titles +## ' @param rows Vector of text to be processed +## ' @param varName Name of the variable that created all these rows +## ' @param firstColSize Length the first (label) column was padded to +## ' @param colSize Length all other columns were padded to +## ' @param boldMark Text used to indicate something is bold text. Ignored if empty +## ' @param indentStr Text used to indent text. Ignored if " " +## ' @return List of Lists updated with the data from the passed in rows +## ' +## ' @author m082166 +addListElement <- function(theFrame, headers, rows, varName, firstColSize, colSize, boldMark, indentStr) { + numRows <- length(rows) + lineSize <- max(nchar(rows)) + colSize <- colSize + 1 # Add 1 for the between column spacer + numCols <- max((lineSize - firstColSize) / colSize, length(headers)) + curCols <- length(theFrame) + cols <- c() + which <- 1 + + while (which <= numRows) { + line <- rows[which] + if(line == "") { # Empty line means start of new variable + break + } + whichCol <- 1 + start <- 1 + end <- firstColSize + while (whichCol <= numCols) { + col <- str_trim(substr(line, start, end)) + + if(length(cols) > whichCol) { + if(nchar(col) > 0) { + cols[whichCol] <- str_trim(paste(cols[whichCol], col)) + } + } + else { # Always add, even if adding an empty string + cols <- c(cols, col) + } + + start <- end + 2 + end <- end + colSize + whichCol <- whichCol + 1 + } + + which <- which + 1 + } + + name <- getName(cols[1], boldMark, indentStr) + theFrame <- addToListVector (theFrame, "term", name) + theFrame <- addToListVector (theFrame, headers[1], varName) + whichCol <- 2 + while (whichCol <= numCols) { + theFrame <- addToListVector (theFrame, headers[whichCol], cols[whichCol]) + whichCol <- whichCol + 1 + } + + if(which <= numRows) { # If stopped with more variables to go, process them now + for (i in 1:which) { + rows = rows[-1] # Remove rows we've done + } + return(addListElement(theFrame, headers, rows, varName, firstColSize, colSize - 1, boldMark, indentStr)) + } + + return(theFrame) +} + + +## ' addToListVector +## ' +## ' If baseList[[title]] is NULL, make it a Vector holding value. If it's not null, make a +## ' vector holding its contents followed by value +## ' +## ' @param baseList List to update +## ' @param title Name of baseList element to update +## ' @param value Text to add to the Vector at baseList[[title]] +## ' @return baseList after it has been updated +## ' +## ' @author m082166 +addToListVector <- function(baseList, title, value) { + if(is.null (baseList[[title]])) + baseList[[title]] <- c (value) + else + baseList[[title]] <- c (baseList[[title]], value) + + return (baseList) +} + + +## ' getName +## ' +## ' Extract the row name from the text +## ' +## ' @param nameText Text to parse +## ' @param boldMark Text used to indicate something is bold text. Ignored if empty +## ' @param indentStr Text used to indent text. Ignored if " " +## ' @return String holding the ceaned up text. Will clean either boldMark or indentStr +## ' +## ' @author m082166 +getName <- function(nameText, boldMark, indentStr) { + bSize <- nchar(boldMark) + tSize <- nchar(nameText) + + if(bSize > 0) { + if(tSize > (bSize * 2)) { + + if((boldMark == substr(nameText, 1, bSize)) && + (boldMark == substr(nameText, tSize - bSize + 1, tSize))) { + return(substr(nameText, bSize + 1, tSize - bSize)) + } + } + } + + if(indentStr != " ") { # Trim takes care of a space indentStr + iSize <- nchar(indentStr) + while ((tSize > iSize) && (indentStr == substr(nameText, 1, iSize))) { + nameText <- substr(nameText, iSize + 1, tSize) + tSize <- tSize - iSize + } + } + + nameText <- str_trim(nameText) + return(nameText) +} + + +## ' process +## ' +## ' Process text, extracting the numbers and returning them as a list of Strings +## ' +## ' @param theText Text to parse +## ' @return List of strings holding numbers, possibly including a % +## ' +## ' @author m082166 +process <- function(theText) { + locations <- str_locate_all(theText, "-*[0-9.%]+")[[1]] + numResults <- nrow(locations) + results <- c() + + for (i in seq_len(numResults)) { + results <- c(results, substr(theText, locations[i, 1], locations[i, 2])) + } + + if(length(results) == 0) { + results = "" + } + + return(c(results)) +} + + +## ' addMethods +## ' +## ' Add the methods to the table output +## ' +## ' @param results Vector of strings to add to, will add immediately to end of results +## ' @param methods List of Methods, where the names are method names, and the values are the +## ' order the methods appear in the output +## ' @return Vector of strings holding Pandoc code to create the table and its methods, if any +## ' +## ' @author m082166 +addMethods <- function(results, methods) { + theNames <- names(methods) + if(is.null(theNames)) { + return(results) + } + + outOrder <- c() + for (aName in theNames) { + which <- methods[[aName]] + outOrder[as.integer(which)] <- aName + } + + which <- 1 + for (aMethod in outOrder) { + results <- c(results, paste0(which, ". ", aMethod)) + which <- which + 1 + } + + results <- c(results, "") + return(results) +} + + +## ' formatElement +## ' +## ' Return a List with two elements: +## ' The vector holding the lines of a row in the table, defined by element, in Pandoc format +## ' Updated list of methods used by this tableby object +## ' +## ' @param element List to get information from, whose first item must be the statistics +## ' @param lineSize Length each non-blank line should be padded to +## ' @param firstColSize Length the first (label) column should be padded to +## ' @param colSize Length all other columns should be padded to +## ' @param includeTotal TRUE if should include last pre-pValue column, FALSE if shouldn't +## ' @param hasPValue TRUE if has column for p-values, FALSE if shouldn't +## ' @param translations The List to use for conversion of labels +## ' @param digits Maximum number of digits to display for floating point numbers +## ' @param pValueDigits Number of digits to display for a p-value. Example: 5 ==> in 0.12345 +## ' @param nsmall Minimum number of digits to the right of the decimal point to display +## ' for floating point numbers. If NULL, use 'digits' to determine everything +## ' @param pctNSmall Minimum number of digits to the right of the decimal point to display for +## ' percent numbers. If NULL, use 'nsmall', if that is NULL use 'digits' to determine everything +## ' @param boldMark String to use to mark text as bold +## ' @param indentStr String to use to indent something one space +## ' @param collapse If true, data might have been collapsed, and needs to be tested +## ' @param methods List of methods and when they were first seen, or NULL if not tracking that +## ' @return List of two elements: +## ' strings: Vector of strings holding Pandoc code to create a row in a table representing element +## ' methods: Updated list of methods, or NULL if methods was NULL +## ' +## ' @author m082166 +formatElement <- function(element, lineSize, firstColSize, colSize, includeTotal, hasPValue, + translations, digits, pValueDigits, nsmall, pctNSmall, boldMark, + indentStr, collapse, methods) { + statistics <- element$stats # GTD 10/14/15 was statistics <- element[[1]] + collapse <- collapse && (numStats(statistics) == 1) && (element$type == "categorical") + rows <- makeTitleCell(element, firstColSize, translations, boldMark, indentStr, collapse) + outputTypes <- element$output + isDate <- !is.na(element$type) && !is.null(element$type) && (element$type == "Date") + + if(collapse) { + rows <- addStatistic(rows, statistics[[1]], 0, 1, colSize, outputTypes, isDate, digits, + nsmall, pctNSmall, includeTotal) + } + else { + startRow <- 0 + whichStat <- 0 + + for (stat in statistics) { + startRow <- startRow + 1 + whichStat <- whichStat + 1 + rows <- addStatistic(rows, stat, startRow, whichStat, colSize, outputTypes, isDate, + digits, nsmall, pctNSmall, includeTotal) + } + } + + if(hasPValue) { + ref <- makeReference(methods, as.character(element$test$method)) + endText <- ref$ref + methods <- ref$methods + rows[1] <- addNumberToEnd(rows[1], element$test$p.value, lineSize, digits = pValueDigits, + endText = endText) + } + + result <- list(strings = rows, methods = methods) + return(result) +} + + +## ' numStats +## ' +## ' Count the number of Elements represented by statistics. If only one element in statistics, +## ' count number of elements in that element +## ' +## ' @param statistics List holding the data of interest +## ' @return Count of elements in statistics. If that is 1, count of names in that element +## ' +## ' @author m082166 +numStats <- function(statistics) { + size <- length(statistics) + if(size != 1) + return(size) + + numRows <- length(rownames(statistics[[1]][[1]])) + + if(numRows > 0) + return(numRows) + + return(size) +} + + +## ' makeReference +## ' +## ' Return a list with two elements: +## ' The text specifying the superscript referencing the method used this time +## ' Updated list of methods used by this tableby object +## ' +## ' @param methods List of methods and when they were first seen, or NULL if not tracking that +## ' @param method Method used this time +## ' @return List of two elements: +## ' ref: Text specifying the superscript for the passed in method +## ' methods: Updated list of methods, or NULL if methods was NULL +## ' +## ' @author m082166 +makeReference <- function(methods, method) { + endText <- "" + if(!is.null(methods)) { + if(!is.na(method)) { + if(length(methods) == 0) { + ref <- NULL + } + else { + ref <- methods[[method]] + } + if(is.null(ref)) { + ref <- length(methods) + 1 + methods[[method]] <- ref + } + endText <- paste0('^', ref, '^') + } + } + + result <- list(ref = endText, methods = methods) + return(result) +} + + +## ' addStatistic +## ' +## ' Takes the Vector of the currently filled in rows, as well as rows that have been started but +## ' not yet completed, and fills in the stats info for one more row +## ' +## ' @param rows Vector of strings to edit, and possibly add to +## ' @param stat The Stats element to process, holding the info to add +## ' @param startRow Current row to operate on, 0 based +## ' @param whichStat Which of the items in outputTypes to use +## ' @param colSize Width to pad each cell to +## ' @param outputTypes Vector from which to pull output type +## ' @param isDate If true, show data as dates, if false treat normally +## ' @param digits Number of digits to round to when displaying percent or Other data +## ' @param nsmall Minimum number of digits to the right of the decimal point to display +## ' for floating point numbers. If NULL, use 'digits' to determine everything +## ' @param pctNSmall Minimum number of digits to the right of the decimal point to display for +## ' percent numbers +## ' @param includeTotal TRUE if should include last pre-pValue column, FALSE if shouldn't +## ' @return The updated rows +## ' +## ' @author m082166 +addStatistic <- function(rows, stat, startRow, whichStat, colSize, outputTypes, isDate, digits, + nsmall, pctNSmall, includeTotal) +{ + numStats <- length (stat) + if(!includeTotal && (numStats > 1)) + numStats <- numStats - 1 + for (theStat in seq_len (numStats)) { + info <- stat[[theStat]] + curRow <- startRow + len <- NROW(info) + if(is.data.frame(info) || is.matrix(info)) { # Have a multi item, like Male / Female + for (i in 1:len) { + data <- info[i, ] + isNum <- is.null(ncol(data)) + if(!isNum && (ncol(data) == 2)) { # Have a two item result + cell <- format.two(info[i, 1], info[i, 2], colSize, outputTypes, whichStat, + isDate, digits, nsmall, pctNSmall) + } + else if(!isNum && (ncol(data) == 3)) { # Have a three item result + cell <- format.three(info[i, 1], info[i, 2], info[i, 3], colSize, + outputTypes, whichStat, isDate, digits, nsmall) + } + else { + cell <- format.other(data, colSize, outputTypes, whichStat, isDate, digits, + nsmall, pctNSmall) + } + + rows <- addToRow(rows, curRow, cell) + curRow <- curRow + 1 + } + } + else { + if(len == 2) { + cell <- format.two(info[1], info[2], colSize, outputTypes, whichStat, isDate, + digits, nsmall, pctNSmall) + } + else if(len == 3) { + cell <- format.three(info[1], info[2], info[3], colSize, outputTypes, + whichStat, isDate, digits, nsmall) + } + else { + cell <- format.other(info, colSize, outputTypes, whichStat, isDate, digits, nsmall, + pctNSmall) + } + rows <- addToRow(rows, curRow, cell) + curRow <- curRow + 1 + } + } + + return(rows) +} + + +## ' getStartingLine +## ' +## ' A row is defined as a series of non-empty strings, ended by an empty string or by the end of the +## ' vector. This method finds the 0 based curRow'th row, and returns its location within rows +## ' +## ' @param rows Vector of strings to look through +## ' @param curRow Current row to operate on, 0 based +## ' @return The location in rows (1 based) holding the beginning of "row" curRow, +## ' or the length of rows if rows doesn't hold that many "rows" +## ' +## ' @author m082166 +getStartingLine <- function(rows, curRow) { + arrayLen <- length(rows) + start <- 1 + while (curRow > 0) { + while ((start <= arrayLen) && (nchar(rows[start]) > 0)) { + start <- start + 1 + } + + start <- start + 1 # Skip over the blank string + curRow <- curRow - 1 + } + + return(start) +} + + +## ' format.two +## ' +## ' Format two number output, according to the output type specified, padded to fill to colSize +## ' +## ' @param first First number to display +## ' @param second Second number to display +## ' @param colSize Width of the output string +## ' @param outputTypes Vector from which to pull output type +## ' @param whichStat Which of the items in outputTypes to use +## ' @param isDate If true, show data as dates, if false treat normally +## ' @param digits Number of digits to round to when displaying percent or Other data +## ' @param nsmall Minimum number of digits to the right of the decimal point to display +## ' for floating point numbers. If NULL, use 'digits' to determine everything +## ' @param pctNSmall Minimum number of digits to the right of the decimal point to display for +## ' percent numbers +## ' @return String of length colSize +## ' +## ' @author m082166 +format.two <- function(first, second, colSize, outputTypes, whichStat, isDate, digits, nsmall, + pctNSmall) { + doList <- isListOut(outputTypes, whichStat) + doRange <- isRange(outputTypes, whichStat) + first <- myFormat(first, digits, nsmall, isDate) + + if(doRange || doList) { + if(doRange) { + sep <- " - " + } + else { # Do list + sep <- ", " + } + second <- myFormat(second, digits, nsmall, isDate) + } + else { + doTrim <- TRUE + doPct <- isPct(outputTypes, whichStat) + if(doPct && !is.null(pctNSmall)) { + nsmall = pctNSmall + doTrim <- FALSE + } + pct <- getPct(doPct) + second <- myFormat(second, digits, nsmall, isDate, doTrim = doTrim) + second <- paste0("(", second, pct, ")") + sep <- " " + } + + return(pastePaddedStr(c(first, second), colSize, sep = sep, appendSep = TRUE)) +} + + +## ' format.three +## ' +## ' Format three number output, according to the output type specified, padded to fill to colSize +## ' +## ' @param first First number to display +## ' @param second Second number to display +## ' @param third Third number to display +## ' @param colSize Width of the output string +## ' @param outputTypes Vector from which to pull output type +## ' @param whichStat Which of the items in outputTypes to use +## ' @param isDate If true, show data as dates, if false treat normally +## ' @param digits Number of digits to round to when displaying percent or Other data +## ' @param nsmall Minimum number of digits to the right of the decimal point to display +## ' for floating point numbers. If NULL, use 'digits' to determine everything +## ' @return String of length colSize +## ' +## ' @author m082166 +format.three <- function(first, second, third, colSize, outputTypes, whichStat, isDate, digits, nsmall) { + doMedList <- isMedListOut(outputTypes, whichStat) + doMedRange <- isMedRange(outputTypes, whichStat) +# first <- format(first, digits = digits) + +# if(is.null(nsmall)) { +# nsmall <- max(0, digits - integerDigits(second)) +# second <- format(round(as.numeric(second), nsmall), nsmall = nsmall) +# nsmall <- max(0, digits - integerDigits(third)) +# third <- format(round(as.numeric(third), nsmall), nsmall = nsmall) +# } +# else { +# second <- format(round(as.numeric(second), nsmall), nsmall = nsmall) +# third <- format(round(as.numeric(third), nsmall), nsmall = nsmall) +# } + + first <- myFormat(first, digits, nsmall, isDate) + second <- myFormat(second, digits, nsmall, isDate) + third <- myFormat(third, digits, nsmall, isDate) + if(doMedRange || doMedList) { + second <- paste0(first, " (", second) + third <- paste0(third, ")") + if(doMedRange) + sep <- " - " + else # Do list + sep <- ", " + } + else { + second <- paste0(first, ", ", second) # Do nothing with third, it's fine + sep <- ", " + } + + return(pastePaddedStr(c(second, third), colSize, sep = sep, appendSep = TRUE)) +} + + +## ' format.other +## ' +## ' Format data output, according to the output type specified, padded to fill to colSize +## ' +## ' @param data Data to display, be it number or date +## ' @param colSize Width of the output string +## ' @param outputTypes Vector from which to pull output type +## ' @param whichStat Which of the items in outputTypes to use +## ' @param isDate If true, show data as dates, if false treat normally +## ' @param digits Number of digits to round to when displaying percent or Other data +## ' @param nsmall Minimum number of digits to the right of the decimal point to display +## ' for floating point numbers. If NULL, use 'digits' to determine everything +## ' @param pctNSmall Minimum number of digits to the right of the decimal point to display for +## ' percent numbers +## ' @return String of length colSize +## ' +## ' @author m082166 +format.other <- function(data, colSize, outputTypes, whichStat, isDate, digits, nsmall, pctNSmall) { + doDate <- isDateOut(outputTypes, whichStat) + doFloat <- isFloatOut(outputTypes, whichStat) + + if(doDate) { + sep <- " " + } + else if(doFloat) { + if(is.null(nsmall)) { + ## Don't allow nsmall < 0 -JPS 9/11/15 + nsmall <- max(0, digits - integerDigits(data)) + } + ## data <- format(round(as.numeric(data), nsmall), nsmall = nsmall) + data <- myFormat(data, digits, nsmall, isDate) + sep <- " " + } + else { + if(isPct(outputTypes, whichStat) && !is.null(pctNSmall)) { + nsmall = pctNSmall + } + ## if(is.null(nsmall)) { + ## data <- format(data, digits = digits) + ## } + ## else { + ## data <- format(data, digits = digits, nsmall = nsmall) + ## } + data <- myFormat(data, digits, nsmall, isDate) + sep <- ", " + } + + return(pastePaddedStr(c(data), colSize, sep = sep, appendSep = TRUE)) +} + + +## ' getPct +## ' +## ' Return the proper "pct" string for the specified stat. "\%" if it's percent data, "" if not +## ' +## ' @param doPct Logical. If \code{TRUE}, returns "\%" else "". +## ' @return The appropriate string: "\%" or "" +## ' +## ' @author m082166 +getPct <- function(doPct) { + if(doPct) + return("%") + + return(pct <- "") +} + + +## ' typeTest +## ' +## ' Returns TRUE if this stat's output type matches value +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @param value (see below) +## ' @return TRUE if outputTypes[whichStat] == value output, else FALSE +## ' +## ' @author m082166 +typeTest <- function(outputTypes, whichStat, value) { + if(is.null(outputTypes) || (length(outputTypes) < whichStat)) + return(FALSE) + + return(!is.na(outputTypes[whichStat]) && (outputTypes[whichStat] == value)) +} + + +## ' isPct +## ' +## ' Returns TRUE if this stat's two valued data should be displayed as a count / percent A (B%) +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if percent output, else FALSE +## ' +## ' @author m082166 +isPct <- function(outputTypes, whichStat) { + return(typeTest(outputTypes, whichStat, 'percent')) +} + + +## ' isRange +## ' +## ' Returns TRUE if this stat's two valued data should be displayed as a range (A - B) +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if range output, else FALSE +## ' +## ' @author m082166 +isRange <- function(outputTypes, whichStat) { + return(typeTest(outputTypes, whichStat, 'range')) +} + + +## ' isMedRange +## ' +## ' Returns TRUE if this stat's two valued data should be displayed as a median range A (B - C) +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if median range output, else FALSE +## ' +## ' @author m082166 +isMedRange <- function(outputTypes, whichStat) { + return(typeTest(outputTypes, whichStat, 'medrange')) +} + + +## ' isListOut +## ' +## ' Returns TRUE if this stat's data should be displayed as a list A[, B]* +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if list output, else FALSE +## ' +## ' @author m082166 +isListOut <- function(outputTypes, whichStat) { + return(typeTest(outputTypes, whichStat, 'list')) +} + + +## ' isMedListOut +## ' +## ' Returns TRUE if this stat's data should be displayed as a median list A (B, C) +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if median list output, else FALSE +## ' +## ' @author m082166 +isMedListOut <- function(outputTypes, whichStat) { + return(typeTest(outputTypes, whichStat, 'medlist')) +} + + +## ' isFloatOut +## ' +## ' Returns TRUE if this stat's data should be displayed as floating point number(s) +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if floating point output, else FALSE +## ' +## ' @author m082166 +isFloatOut <- function(outputTypes, whichStat) { + return(typeTest(outputTypes, whichStat, 'float')) +} + + +## ' isDateOut +## ' +## ' Returns TRUE if this stat's data should be displayed as a date +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return FALSE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if date output, else FALSE +## ' +## ' @author m082166 +isDateOut <- function(outputTypes, whichStat) { + return(typeTest(outputTypes, whichStat, 'date')) +} + + +## ' isOther +## ' +## ' Returns TRUE if this stat's two valued data should be displayed as an "other" type A (B) +## ' +## ' @param outputTypes Vector from which to pull this information. If NULL / NA, will return TRUE +## ' @param whichStat Which of the items in outputTypes to look at +## ' @return TRUE if other, else FALSE +## ' +## ' @author m082166 +isOther <- function(outputTypes, whichStat) { + if(is.null(outputTypes) || (length(outputTypes) < whichStat)) + return(TRUE) + + return(is.na(outputTypes[whichStat])) +} + + +## ' Make a string of the form "name (N=count)" +## ' +## ' @param name The label that's getting a count (i.e. "High") +## ' @param count The count that goes with this label +## ' @return String of the form "name (N=count)" +## ' +## ' @author m082166 +makeCountHeader <- function(name, count) { + return(paste0(name, " (N=", count, ")")) +} diff --git a/R/tableby.stat.tests.R b/R/tableby.stat.tests.R new file mode 100644 index 0000000..d5e8c16 --- /dev/null +++ b/R/tableby.stat.tests.R @@ -0,0 +1,61 @@ +### Test functions ####### + +## continuous tests: +## 1. anova (parametric) +## consider allowing glm, for now just lm with gaussian errors +## Would like to just use either "anova" or "aov", anova needs lm(group~x first, +## aov does not return p-value. Could add it after. +## For now, just write our own to avoid over-writing anova R-base function +## also, nice to keep same format to call, eval(call(function, x, x,by)), as other tests +anova <- function(x, x.by) { + if(any(colSums(table(x, x.by, exclude=NA))==0)) { + return(list(p.value=NA, statistic.F=NA, method="Linear Model ANOVA")) + } + aov.out <- stats::lm(x~x.by) + test <- stats::anova(aov.out) + test.out <- list(p.value = test[1,ncol(test)], + statistic.F = test[1,ncol(test)-1], + method = "Linear Model ANOVA") +} +## 2. kruskal-wallis (non-parametric) +kwt <- function(x, x.by) { + # na.ind <- is.na(x) + # stats::kruskal.test(x[!na.ind], as.factor(x.by[!na.ind])) + if(any(colSums(table(x, x.by, exclude=NA))==0)) { + return(list(p.value=NA, statistic.F=NA, method="Kruskal-Wallis rank sum test")) + } + stats::kruskal.test(x, as.factor(x.by)) +} + +## two tests for categorical, +## 1. chisq goodness of fit, equal proportions across table cells +chisq <- function(x, x.by) { + tab <- table(x, x.by, exclude=NA) + return(stats::chisq.test(tab[rowSums(tab)>0,])) +} +## 2. Fisher's exact test for prob of as or more extreme table +fe <- function(x, x.by) { + tab <- table(x,x.by, exclude=NA) + stats::fisher.test(tab) +} + +## trend test for ordinal data +trend <- function(x, x.by) { + ## should be taken care of with coin:: + ## require(coin, quietly=TRUE, warn.conflicts=FALSE) + indtest <- coin::independence_test(x~as.factor(x.by), teststat="quad") + test <- list(p.value=coin::pvalue(indtest), method="Trend test for ordinal variables", statistic=indtest@statistic@teststatistic) +} + +## ' logrank +## ' +## ' survdiff logrank test +## ' @param x surv variable +## ' @param x.by by, categorical variable +## ' @return test output with $method and $p.value +logrank <- function(x, x.by) { + out <- survival::survdiff(x ~ x.by) + out$p.value <- 1-stats::pchisq(out$chisq, df=length(unique(x.by))-1) + out$method="survdiff logrank" + out +} diff --git a/R/tableby.stats.R b/R/tableby.stats.R new file mode 100644 index 0000000..d110984 --- /dev/null +++ b/R/tableby.stats.R @@ -0,0 +1,268 @@ +##################################################### +## Testing and Summary stats methods for internal use in tableby +########################################### + +## summary stats +## considerations: handling NAs, or other miss.val +#medianDate <- function(x, na.rm=TRUE) { +# if(na.rm & sum(is.na(x))>0) { +# x <- x[!is.na(x)] +# } +# medint <- median(as.integer(x)) +# browser() +# return(median(xint)) +# return(as.Date(medint, origin="1970/01/01")) +#} +#range.Date <- function(x, na.rm=TRUE) { +# if(na.rm & sum(is.na(x))>0) { +# x <- x[!is.na(x)] +# } +# xint <- as.integer(x) +# return(range(xint)) +#} + +## paste mean and sd mean(sd) +#meansd <- function(x, na.rm=TRUE, weights=NULL, ...) { +# c(mean(x, na.rm=na.rm), stats::sd(x, na.rm=na.rm)) +#} + +#' tableby Summary Statistics Functions +#' +#' A collection of functions that will report summary statistics. To create a custom function, +#' consider using a function with all three arguments and \code{...}. See the \code{\link{tableby}} vignette +#' for an example. +#' +#' @param x Usually a vector. +#' @param na.rm Should NAs be removed? +#' @param weights A vector of weights. +#' @param levels A vector of levels that character \code{x}s should have. +#' @param ... Other arguments. +#' @return Usually a vector of the appropriate numbers. +#' @details Not all these functions are exported, in order to avoid conflicting NAMESPACES. +#' @name tableby.stats +NULL +#> NULL + +#' @rdname tableby.stats +#' @export +meansd <- function(x, na.rm=TRUE, weights=rep(1, length(x)), ...) { + c(wtd.mean(x, weights=weights, na.rm=na.rm, ...), sqrt(wtd.var(x, weights=weights,na.rm=na.rm, ...))) +} + +#' @rdname tableby.stats +#' @export +medianrange <- function(x, na.rm=TRUE, weights=rep(1, length(x)), ...) { + if(na.rm & length(x)==sum(is.na(x))) { + return(c(NA,NA,NA)) + } + wtd.quantile(x, probs=c(.5,0,1), na.rm, weights=weights, ...) +} + +#' @rdname tableby.stats +median <- function(x, na.rm=TRUE, weights=rep(1, length(x)), ...) { + if(na.rm & length(x)==sum(is.na(x))) { + return(NA) + } + if(class(x)=="Date") { + as.Date(wtd.quantile(as.integer(x), weights=weights, probs=0.5, na.rm=na.rm, ...), origin="1970/01/01") + } else { + wtd.quantile(x, weights=weights, probs=0.5, na.rm=na.rm, ...) + } +} + +#' @rdname tableby.stats +range <- function(x, na.rm=TRUE, ...) { + if(na.rm & length(x)==sum(is.na(x))) { + return(c(NA,NA)) + } + if(class(x)=="Date") { + as.Date(base::range(as.integer(x), na.rm=na.rm), origin="1970/01/01") + } else { + base::range(x, na.rm=na.rm) + } +} + + +## survival stats +## implemented with using pre-calculated +## kmsumm <- summary(survfit(Surv() ~ group)) + +## ' Nevents +## ' +## ' Number of events in a survival object, within a group +## ' @param x a thing +## ' @param ... other arguments +## ' @return the events stat from km$table +#' @rdname tableby.stats +#' @export +Nevents <- function(x, ...) { + mat <- summary(x, ...)$table + if(!any(c(grepl("^events", colnames(mat)),grepl("^events",names(mat))))) { + stop("Survival endpoint may not be coded 0/1.\n") + } + if (!is.null(nrow(mat))) { + rownames(mat) <- substr(rownames(mat), regexpr("=", rownames(mat)) + + 1, nchar(rownames(mat))) + return(mat[, "events"]) + } + return(as.numeric(mat["events"])) +} + +## Median survival +## ' medSurv +## ' +## ' Calculate median survival +## ' +## ' @param x kaplan-meier summary object, used within tableby +## ' @param ... other arguments +## ' @return vector of median subjects who have survived by time point +#' @rdname tableby.stats +#' @export +medSurv <- function(x, ...) { + mat <- summary(x, ...)$table + if(!any(c(grepl("^events", colnames(mat)),grepl("^events",names(mat))))) { + stop("Survival endpoint may not be coded 0/1.\n") + } + if(!is.null(nrow(mat))) { + rownames(mat) <- substr(rownames(mat), regexpr("=",rownames(mat))+1, nchar(rownames(mat))) + return(mat[,'median']) + } + return(as.numeric(mat['median'])) +} +## +NeventsSurv <- function(x, times=1:5) { + ## x is result of survfit() + xsumm <- summary(x, times=times) + if(is.null(x$strata)) { + byList <- data.frame(n.event=cumsum(xsumm$n.event), surv=100*xsumm$surv, row.names=xsumm$time) + } else { + + mat <- with(xsumm, data.frame(time,n.risk, n.event, n.censor, surv, strata)) + byList <- list() + for(strat in unique(mat$strata)) { + stratTrim <- substr(strat, regexpr("=", strat)+1, nchar(strat)) + ## could add any other column of mat to data.frame + byList[[stratTrim]] <- with(mat[mat$strata==strat,], + data.frame(n.event=cumsum(n.event),surv=100*surv, row.names=time)) + if(nrow(byList[[stratTrim]]) < length(times)) { + byList[[stratTrim]] <- rbind.data.frame(byList[[stratTrim]], + byList[[stratTrim]][nrow(byList[[stratTrim]]),]) + rownames(byList[[stratTrim]])[nrow(byList[[stratTrim]])] <- times[length(times)] + } + } + } + return(byList) +} +NriskSurv <- function(x, times=1:5) { + ## x is result of survfit() + xsumm <- summary(x, times=times) + if(is.null(x$strata)) { + byList <- data.frame(n.risk=xsumm$n.risk, row.names=xsumm$time) + } else { + xsumm <- summary(x, times=times) + mat <- with(xsumm, data.frame(time,n.risk, n.event, n.censor, surv, strata)) + byList <- list() + for(strat in unique(mat$strata)) { + ## could add any other column of mat to data.frame + stratTrim <- substr(strat, regexpr("=", strat)+1, nchar(strat)) + byList[[stratTrim]] <- with(mat[mat$strata==strat,], data.frame(n.risk, row.names=time)) + if(nrow(byList[[stratTrim]]) < length(times)) { + byList[[stratTrim]] <- rbind.data.frame(byList[[stratTrim]], + byList[[stratTrim]][nrow(byList[[stratTrim]]),]) + rownames(byList[[stratTrim]])[nrow(byList[[stratTrim]])] <- times[length(times)] + + } + } + } + return(byList) +} + + + +## Can write similar functions for NcensorTime, NriskTime, etc. + +## ' survNinterval +## ' +## ' survival summary stat per N units of time. Default is years. +## ' +## ' @param x a Surv() variable within tableby formula +## ' @param x.by the by-variable in tableby +## ' @param time.interval the interval of units of time over which to summarize in categories +## ' @return vector of number of events per time interval +survNinterval <- function(x, x.by, time.interval=1) { + #kmsumm <- survfit(x~x.by,type="kaplan-meier") + nsurv <- as.matrix(x)[,1] + breaks <- seq(0,max(nsurv)+time.interval, by=time.interval) + tapply(cut(nsurv, breaks, levels=breaks[1:(length(breaks)-1)]), x.by, table, exclude=NA) +} + +## quantiles +#' @rdname tableby.stats +#' @export +q1q3 <- function(x, na.rm=TRUE, weights=rep(1, length(x)), ...) { + if(na.rm & length(x)==sum(is.na(x))) { + return(c(NA,NA)) + } + wtd.quantile(x, weights=weights, probs=c(0.25, .75), na.rm=na.rm, ...) +} + +#' @rdname tableby.stats +#' @export +medianq1q3 <- function(x, na.rm=TRUE, weights=rep(1, length(x)), ...) { + if(na.rm & length(x)==sum(is.na(x))) { + return(c(NA,NA,NA)) + } + wtd.quantile(x, weights=weights, probs=c(0.5, 0.25, .75), na.rm=na.rm, ...) +} + +## Inner-quartile range has a function IQR in R, but a wrapper +## would need to be written with weights in mind + +## Count of missings: always show missings +#' @rdname tableby.stats +#' @export +Nmiss <- function(x, levels=NULL, na.rm=TRUE, weights=rep(1, length(x)), ...) { + sum(weights[is.na(x)]) +} + +## Nmiss2 make similar, but in tableby, always keep nmiss, +## even if there are no missings +Nmiss2 <- Nmiss + +## count of complete samples +#' @rdname tableby.stats +#' @export +N <- function(x, levels=NULL, na.rm=TRUE, weights=rep(1, length(x)), ...) { + sum(weights[!is.na(x)]) +} + +## count (pct) where pct is within group variable total +#' @rdname tableby.stats +#' @export +countpct <- function(x, levels=sort(unique(x)), na.rm=TRUE, weights=rep(1, length(x)), ...) { + ## tbl <- table(x[!is.na(x)]) + ## data.frame(count=as.vector(tbl), pct=100*as.vector(tbl)/sum(tbl), row.names=levels) + wtbl <- wtd.table(factor(x[!is.na(x)], levels=levels), weights=weights[!is.na(x)], ...) + df <- data.frame(count=as.vector(wtbl$sum.of.weights), pct=100*as.vector(wtbl$sum.of.weights)/sum(wtbl$sum.of.weights), row.names=if(length(wtbl$x)==length(levels)) levels else names(wtbl$sum.of.weights)) + ## make sure all levels are in df. If not, add them and re-order. + if(nrow(df) < length(levels) ) { + misslevs <- levels[!(levels %in% rownames(df))] + df <- rbind.data.frame(df, data.frame(count=rep(0, length(misslevs)), pct=rep(0, length(misslevs)), row.names=misslevs)) + } + return(df[as.character(levels),]) +} +## format the countpct result for better printing (should work for meansd as well) +## Greg to edit this one +format.countpct <- function(x,digits=5, pct='') { + if(!is.null(ncol(x))) { + ## multiple rows + xformat <- cbind.data.frame(format(x[,1], digits=digits), format(x[,2], digits=digits)) + rownames(xformat) <- rownames(x) + digits <- digits - 2 + return (apply (xformat, 1, function(xrow) paste (xrow[1], " (", format (round (as.numeric (xrow[2]), digits), nsmall = digits), + pct, ")", sep = ""))) + } else { + ## just one row + return(paste(signif(x[1],digits=digits), "(",signif(x[2],digits=digits), ")",sep="")) + } +} diff --git a/R/write2.R b/R/write2.R new file mode 100644 index 0000000..cf8b979 --- /dev/null +++ b/R/write2.R @@ -0,0 +1,88 @@ +#' write2word, write2html, write2pdf +#' +#' Functions to generate a word, html, or pdf document containing a single table. +#' +#' @param object An object whose \code{summary} output looks "good" when using \code{results='asis'} in markdown. +#' @param file A single character string denoting the filename for the output document. +#' @param ... Additional arguments to be passed to \code{summary}, \code{rmarkdown::render}, etc. +#' One popular option is to use \code{quiet = TRUE} to suppress the command line output. +#' @param keep.md Logical, denoting whether to keep the intermediate \code{.md} file. +#' @return \code{object} is returned invisibly, and \code{file} is written. +#' @details This is (kind of) an S3 method (the real S3 method is \code{write2}),and the default +#' (used for \code{\link{tableby}}, \code{\link{modelsum}}, \code{\link{freqlist}}, etc.) assumes +#' that there is a \code{summary} method implemented. +#' +#' To generate the appropriate file type, the default uses one of \code{rmarkdown::word_document}, \code{rmarkdown::html_document}, +#' and \code{rmarkdown::pdf_document} to get the job done. \code{"..."} arguments are passed to these functions, too. +#' @seealso \code{\link[rmarkdown]{render}}, \code{\link[rmarkdown]{word_document}}, \code{\link[rmarkdown]{html_document}}, \code{\link[rmarkdown]{pdf_document}} +#' @examples +#' \dontrun{ +#' data(mockstudy) +#' # tableby example +#' tab1 <- tableby(arm ~ sex + age, data=mockstudy) +#' write2html(tab1, "~/ibm/trash.html") +#' +#' # freqlist example +#' tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany") +#' noby <- freqlist(tab.ex, na.options = "include") +#' write2pdf(noby, "~/ibm/trash2.pdf") +#' +#' # A more complicated example +#' write2word(tab1, "~/ibm/trash.doc", keep.md = TRUE, +#' reference_docx = mystyles.docx, # passed to rmarkdown::word_document +#' quiet = TRUE, # passed to rmarkdown::render +#' title = "My cool new title" # passed to summary.tableby +#' } +#' @author Ethan Heinzen, adapted from code from Krista Goergen +#' @name write2 +NULL +#> NULL + +write2 <- function(object, file, ..., keep.md, output_format) +{ + UseMethod("write2") +} + +write2.default <- function(object, file, ..., keep.md = FALSE, output_format = c("html", "pdf", "word")) +{ + if(!is.character(file) || length(file) > 1) stop("'file' argument must be a single character string.") + if(!is.logical(keep.md) || length(keep.md) > 1) stop("'keep.md' argument must be a single character string.") + output_format <- match.arg(output_format) + + output_format <- if(output_format == "html") rmarkdown::html_document else if(output_format == "pdf") rmarkdown::pdf_document else rmarkdown::word_document + dots <- list(...) + utils::capture.output(summary(object, ...), file = paste0(file, ".md")) + + output.args <- dots[names(dots) %in% names(formals(output_format))] + + render.args <- dots[names(dots) %in% names(formals(rmarkdown::render))] + render.args$input <- paste0(file, ".md") + render.args$output_format <- do.call(output_format, output.args) + render.args$output_file <- file + do.call(rmarkdown::render, render.args) + + if(!keep.md) system(paste0("rm -f ", file, ".md")) + invisible(object) +} + + +#' @rdname write2 +#' @export +write2word <- function(object, file, ..., keep.md = FALSE) +{ + write2(object, file, ..., keep.md = keep.md, output_format = "word") +} + +#' @rdname write2 +#' @export +write2pdf <- function(object, file, ..., keep.md = FALSE) +{ + write2(object, file, ..., keep.md = keep.md, output_format = "pdf") +} + +#' @rdname write2 +#' @export +write2html <- function(object, file, ..., keep.md = FALSE) +{ + write2(object, file, ..., keep.md = keep.md, output_format = "html") +} diff --git a/README.md b/README.md new file mode 100644 index 0000000..ab4c939 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# The `arsenal` Package + +The goal of `library(arsenal)` is to make statistical reporting easy. It includes many functions which the useR will find useful to have +in his/her "arsenal" of functions. There are, at this time, 3 main functions, documented below. Each of these functions is +motivated by a local SAS macro of similar functionality. + +## The `tableby` Function + +`tableby` is a function to easily summarize a set of independent variables by a categorical variable. +Optionally, an appropriate test is performed to test the distribution of the independent variables across +the levels of the categorical variable. Options for this function are easily controled using `tableby.control`. + +The `tableby` output is easily knitted in an Rmarkdown document or displayed in the command line using the `summary` function. +Other S3 methods are implemented for objects of class `"tableby"`, including `print`, `[`, `as.data.frame`, and `merge`. + +## The `modelsum` Function + +`modelsum` is a function to fit and summarize models for each independent variable with a response variable, +with options to adjust by variables for each model. Options for this function are easily controled using `modelsum.control`. + +The `modelsum` output is easily knitted in an Rmarkdown document or displayed in the command line using the `summary` function. +Other S3 methods are implemented for objects of class `"modelsum"`, including `print` and `as.data.frame`. + +## The `freqlist` Function + +`freqlist` is a function to approximate the output from SAS's `PROC FREQ` procedure when using the `/list` option of the `TABLE` statement. + +The `freqlist` output is easily knitted in an Rmarkdown document or displayed in the command line using the `summary` function. +Other S3 methods are implemented for objects of class `"freqlist"`, including `print` and `as.data.frame`. + +## Other Notable Functions + +* `write2word`, `write2pdf`, and `write2html` are functions to output any of the above objects into a document. They're a shortcut for + "I just want to output this one table but I don't want to open an Rmarkdown script, ugh..." + +* `formulize` is a shortcut to collapse variable names into a formula. + +* `mdy.Date` and `Date.mdy` convert numeric dates for month, day, and year to Date object, and vice versa. diff --git a/build/vignette.rds b/build/vignette.rds new file mode 100644 index 0000000000000000000000000000000000000000..7d4268a08a41613df72ec6d1a0e41b7f5b29da7c GIT binary patch literal 255 zcmVthe*U#sjBMooM@|rp+rPRQdp6sCEiDLy#a`=O&mS~ F0041feqsOs literal 0 HcmV?d00001 diff --git a/data/mockstudy.RData b/data/mockstudy.RData new file mode 100644 index 0000000000000000000000000000000000000000..3470afba5d12bf3247d9e6977e29fd8771a3142b GIT binary patch literal 36933 zcmZsBcT`i)^R|kDNEeY#1U`a_fJl>;2neV&6{YtUFcj%EiPDuOqI3vFMWu#bgGjFd zDG4<|fB>Nf2qc93{Jwv`d*;m9`|R#Hd!IY^%bB_;gp9Fhm85p|` zjRlliFiszq%s6@X3pKvpI*+(jr$M|nV^YL3<6G}&Wom=`X7JpjEYHNlSmc?9#>TC> zVJRM~&G0TIwP#4fWD}3~W;|AZRl@VWVpk_$d64ehs+Cjh@(`;653nG5`40$335XE7dAq_P~#_7NOfAG25>Fg zFVWG@0f@2tUeH zng7m711xoFLfwW&^9d5>U~X)F-)jZzw?2m&%m~cP!!W)eWF$ZN`^U0%nHm$fk)Sb- z(fnrDFQfOs)p{eLMQjfRBb1ofn!M@++3-q{Nm+ylVN#Lik!jheQDLr5N2pc(LrDB2 zzcd#c>aRc(q?K*UP@#8>G4yq0<8)_HnO5Z4%mPfXcVaa_p?7>$UEs9P(@UYWP5SiL z*4>&Ax5^MJY=Q8>ybOnc|2R9ugK4Io7{%E3IvKJRIeG(MgyFGbDs9yU)j-{Pu37bb z|Hnp8{YZXn(nwhGFSikJv4b1;Xr6AQU0@;EzQ?Go9fRB+{x-5OmRmp{wiyl0zgfVh z*D;$*C~Rj^b27{gDr}8AViY(SyA-%~|Ei~iK===q%@H1@ElWW*;9nlf=Jfe8S%L2L zrfZ%m(^vixc<7?AhLrLj=Rr;#%GaPrQF_{g{yI4UG@h;d0+VxWXESU~>x^yNx_EZE zkuo*`kJ&Pg>4!B)w~xhwr&Tk0ZhZBE-J6W`&6wlO81wZQWYf%uh;B#loYQE2@pfG5 zwmBrI^HmVGLhTeqb*~8;y=O$09Ytw(@M+x8=je3g;9-Mooew*F3k-euT_kaIAxvX| zTjQP=M`sAfu^&h8gp<60{}hAVG(+9mdH%46=^C7Ljmk-pO8sQesLVU<-7n^A_v`ot z4*24+anT$-5mHEVySvMY(Lg6T*So>jSm1Hdc0CbbWL&y=rRb4~LIQw=9#7Ll9zIGS zN6l)q=jX)@<&C(Y-zap38y|zs5!h7@!24L> zQpX6V_ug)5aHp3#A2&y9Pmo?@(o#WoaA(k|ea%m|kte5)3YC%~l;qf4d_iPzr?Gl4 z565t)xC9=Z|E_Bfkl((#7grFBZBgFW@jia$UD-x1a$B(2xu~#Kq`bPOagEJqR0%}hLjszi0-7-oz z4(7n>0!wWij`WI}d7)23CRr*lLc+zf8y( zf}TR@PYz#az#Ek8zPsI8qwMhnFKm{#X*)i6okf`3l||L6hqlL}M!fCTYGpmBmXetw@_~Tv5U)v7uVF!pWJe|DBz#>*81bQ*8koX zFvqQ2Jhr=V@adfHe_!)8Wtm5wTyQpcm~$8@MC0tCeN>~qTcmx+7nLPPveJGdU<($Y z(t3c$EJsKQV09xlgd#dgaoD0Qn9%IwVJst@U>fHP?VdO2I2?4Z1>le4P+gBbBuCnj z^`!sOMHP+%;DZZgETOf}otf*y2S)*N69A75j!ANC+mYVpkzU?bvJeI! zHv>5N3F_WS-lJ;cXzi4<-ej6=z9{UfoSxX^7jr%~)+bRFHyu6S+k1%lXJ2lX_|tPW z#gCf{^nSPY(Q@M>tO^$__p+T)RNKuzlkelQA069>O=ev-l@QzcFXHz5xPnK$UoN90 zBP8F)5g(PRaaG;?*R{74JIINv<#=eJa_&syT%GWOR>vtre$V*~r*q+M=O$IpL4@CC z2)zwp|82?mN15>tfJtngNsNQ_kr3-<9ODUNL?lBBm`QAyu`ov9@(f2*I70#bUFFHc zd*B=9@|?bG7tNToV%{l_{NB;5B;8nZ<~#sh1}fiTWb;wF3{$#%rg-_3@1hsS1t+HV zqsRsCNPDVgT)SrPO5_dFjY@A$fBDOU!WZY+wS?F&kQmzujG~N8@3tcIlQk<{I^1t4?}r$R~rf9y8__9qQ)AX%o>f85Isu0VRCh&`oG>UQOCwwUi!b@ z#pEC^)=3mhKKav>${F;855(+~7bS3q8I~T^V5H^sL`z*#v+loR*wu!#sHXpz)%7np zefqeQ`i$^jfs6mQM?GcR;iA|IY z8O`^a$@bx5`^df@!jj@U1~DQMPIIY?)u|~Yi4O1Lh52jP*H@NvF940s zb9}#1Y@k^te<=ql;0I&_gb4r-6~amG%hAO?-gn9kqlLdmh>zVMDva}teGDqr+!MzD}MKLY+Zz9GcPG4E9p3w-N-2R?7KF2EJg5t+F^`; zO`f48^SssYTiL;fr-N_r%2y8a?-KaU(X7Y&tb=k4azF-a#QC358FS!`B=F>UA=m@9tXqtr#| z)Ke+kS;=2n@JvpSG^E=yd_J9UgK_mC*>6G5kJHR=#GCzfjLOKA^`Jbjk36q>c6_M4 z%mI-1ZZ-=&GyXU?z9~%RfhzC*(4{bfn9QnX59xPuNH0IhekbIkr${(d#9W?ZAFVw* z*wa8-OeZ1rG63%wm4@}UvpEFOu_%Ig@ldRt^jqll-%2dMk(ca8FKi;N+s|GyM_*W8 zxU^QyNwm2Px4X>GD^|zrcorR(8U4eF*Ks>KZZW#gZFesEpH$+-KnhF(la-f`Y@-5^i|Ng9FPZS$Bihrgi9f6jKz{%>e+pxA-vkKqU^^lE8yxyT3|J+JO z7ib=VOt<&czcFxi*PnUGli34#QQhK#piDcTK39-_igH@vnfVnXS)DVxD|D+XAd4%F z=~~|UDe-BArj{Rk(#7a^by#I|lI%Vx-qnU#F_z0j8m6_w1{Pum@<}eiF#h0HR%9(} zqbL7lEi15vwaz96x_tkQkIE@nWxvC>w^j(%D1?^jnRiubXcSVlOxiPhD=fvyD^(f8 zV@|x%TXz9!X8#XRlUmr3dRAZY*3is;kf#!Jr4(}MH0Y*z_0>`f=9%(GLKRWyibp7$ z_v-ameaoWg6;Z=xjyYfKu}`t!o0Cmf8$EBHI`OPpU80pnw3<1fUL_ZZUN>!zHElOG zYu7FL-SnyweFqEX*~h%@{PVifS& z{x|FRSYQyzSZBv@RQe8u$(ONVfL3VASpC!Qj4PsnlYe+IVnG$r9uO`PB&B51(Gwzf zW~p9%J={8$NUW4KXJW62EW?aKdWVS5q)HiZ7$=T;5mpP1nX-zcm@J5fqrb+Io5r#g zhhP~~&!l)og&wU&WZ(1mtYAKxZDfFPd6~_AoUs(b;NNh5ujzciAtTm{VYBl5eeZ|D zm0W0#D7a^ow9+56vR1m_qM+bngtCNJn4+!x=S)y;Soe*Wc=yz0IPRi_ zvZ#@AJBQLgDF~d7I>tp&?75d*xjm|weLW&(vp>ozISgfg1Sq%1WPc1(cJj=YBe*W7 z4aFr7eGHO6x|qEfpY0GiWKML&I>?{8$*#au`&D>$%az{u;ou@`vH%V*@H!aBV%x0lOrniZuwom4G zTxQ&+xsnNcseD^Yx{5`0F1j&Dv!a<3(EQOX@Ex&vVW&C2$YyucW;fpEqaP+fVJ%dd zvaRc}8DqS|NDOpJt{3#%Vk90tR1W({CciBR6Z;opY4qBJEwqJkribMtG)6i^HW5em z^BQs08ga22y$oTT;4n`7|0am;*uDYF`ciGjpNFL|kR3TtyrJ_fa4bvnW>+YA>7+Fn zCVNoF8#)(%+RS^_$XhqZf}4)lIJ3oi0({4T2}q7v9Fyx#q&l@S2uFS(aNNuh@*0pg z7aNRan%j!B+hM|!JCvwgYE(Hg?4CQw@eOFR89;5PEeybRT|mxL9AP`LxUEq6f}T@Xd#fIH4)WlwqR>N{&pDO<_+g(C zum-xehK!M^a<2Cs)%fe4#NhtZ2K2>|oI5>yITQv{5>!4d()-LI_xJ7YZ!9{$k>H2u z$CRf!ke%1=@&mJ2sgfOLpBAP1cE31x`rm($nb7Kf-~2PHhD79EpSj=t$-L8INBwsk z#lKOvKT2OB8fngcy|HTYvF!yX>GnstOR&_4h9{b*#W&i%-#~wTn0DDHyg&@1LC7ieD}D&HP?e#H@Z=|uX{S;__B zZ*N6!@6KI24!*Ma=|ZzmR00zhm?@==T?@`s&=$FHrimro2oB{0hH%#Y(d-=4?4)b< z!Z@iFkw0YF|Df5m&LS7cnx%_3HiI}%_HUSna#A!dql7j~ZUy3Vn+rSh6*c_|6(5x( zuR0)F-DGMW*Sx8Dw$9f*>`oVO6R`BG(RJh6eB1*`_+F@kB>qw`x)@fcXn8q1HNSCm zqhP`jA3F7bZKQCD)NU}GwrP7Wb*#fV-qC6IP^StqkvYgV1r4>mRK}j2-Tyo>arATI zmJ5bh<hAbK!scvFFCgL6ZdLH|BR>Ih(6jf1?>roZW{6x&lzgC9d)C1)fD4jL5^?CUU_~@{zJ3x5I|JtzS zwK4YqiF%nto5=O<0cZT#)j!U^dX~SI)rp0d-?wB@f^mPRy8g9p|4Vp$q!Q7GiyIQ` z$it%+UG6KoqH7&V(Nz#@@0Z{2e;TaXCf@$D`YrRWYHFb{7XR`^O%9v+GQ|7ahS=DDzQ{OIB zKXIu;g>LfwygaPrbYB@v&brqcJk=m)ASolkKnT4jsOJ>w)(ynCK#A2Tb;293aVK&S zPkaBJ4{;pI&D&{{Q=c`8kds-7#FWiv@8^n~CLEi*hYy}&Pe(m~Oxfu6ycL3BMncZ{ zl)o*9nYL@KA3juu+#>eybN4yNIg{5~#tBw;A~F?k3hN>Ff=`tlAr-^R1x|mlU!0oH z3(9^tWPAQdB;KAP_94#w%erWmaEMniK@m%0o03;gZ^l~NDls`=8jMXstSTV|9vWO8 zrEac~F`K}x0lWz~kQt1}IP5EdRoNY&KZI`bw12nsD0MYRdurf)aAL2stdZ9vHkA>T ztL)-y<`7!;XZ2@CQUK3$ah=NnsOHDDa>dZx3?ra`oM@-dfBC&^o|PR7=b zO9^Gd74XpAJy%`E`a_&2YW|H<;47WZ=fXPofDwnD|CMD@Wh)RxnMuK$A=lbH@7Q@t z`03Yq+4?EC_$fOeW-3FRu05~VQy(B1De4@5@3)K+d!6exS+A&8yuWXm;g^dkk-qj^ zUfJaD{l6t&50gVb{FwW$xcvQljSsY=&wZp>!p3j12d7jGe!fi?IH({;U)vG zrn)-@d2e)<;pL=N1If`%i>BdEpEjTW6=KWqQ~?OyYivOK!rwbKxecs(6;#X8+zu~(j28kspE8q0sM-6FoeRj35{5f{$g z-d)k}e77vl@*PoBi%XFMCv~wp%*eIkjt5LNP+I4h8=a}X`d;ivqW!}U4oG!Ki07i| zMN-kV=K~Yqs-_He^|sy6x+XDSWJ}No2U26^{8On2<8aVujt$GJM>$~`h9y#B}4tdA<{3cs+fUc+NUCM6V#gi)PoW<%1GO3R!7_`m4ro`$>S`?u z#wN}g?fQ4NMdlUHbMP)%kY|blxgQc7|NIfO9dZ+82PwNe>7)CmIh5x)x_Rn2XC_>B z!8O#kN^v56x$I|LhOFe!T-+4qXB>^If~5b1=w5Jn{&`x>i$}C|M?{A?UcInxEF&pS zY@XX^RRIjuy7nCX>qDHL?Eq;Sbvw0y)ynLiV96J;qa5|X5~N>VNr+(=fBBsy4IS1o zQQ=s>$%441RKh{T2YX37Wg9c$z_v66P_l^#;1v2)yUumkC{Y9Rl1rtyPR!RcLF|aR zHgh=Zj+kyq6|&^^QtMN0oi{~S!;*S@t-c!%f132zY7%>`k(;RBQ}Ht{G-0OdCebQe z_$2Qe``AC95JR|zYD>1Kcnmq`6CvpB36m(qC8zg2lz1x+kF$PyO5G9z z?Po<$jiBH4ZJV2?!VRVOqvZLEc#!bLo%1EP#DaA1tGvEbm?rt*$L*g&>g-mPd&koc zKv`0bxZfnjim(%^{wuB>ai{n6!t~PTf86)HFXQGWY+4g=WPASe+Tg(}&SzfQN7TC12ZdezU zH_p``?ZY;agmO8bNw~{pTU|d>vFW2fNyTq=>tmFK|=L{$EZSt-##%7LpzWUc< zdBmR5YE0N9)m9>{xv8fO9EP;YJU%MlPn&-;H?<*8cr+j^W$smh@~h;S?^7kSW0-@g zvWA{CQ?h?|ZoRT#pQp@K=gxcTjO1E(*%$zW6lZ3uzh*|(?*%>oWHt3+)^vAnKpHYU z#W2?;tU2sM4r^rVS4qh*v8%%MiP4T2X*S_FKPmSOqwV{CmCZPL|G9pw3Snq;PU_{( zMs@)`5yKQT5ghb)yuRjJW7+T4L~dM#1#LJ@DQM?XzfBp|3qMdF=Dv}G*Cm(!YHBTQ zDzVryLZvtR&BV}0>wSY1?dH`^X9qCSWT}~Li``T2<$|zAC|V^uP0b=eT>(iUJHcUiaYC^Fa0=CEdLQMpCZvyO&a(IGr;eyK>@>Be zwPiOCscFm#w?g&6&2Zj8S)FDCV;ds;Bn@+fi>Aw*1}(O+&~1)){=j+9ns@)dP%}*Q zaA&`cUi6hlYzDkmRsaTK-yXl~=+|Kr&i{Hwn}eMKrfUkOq=zIFo4+MX$D=0+)$(bz z#->hF(t37;%*2#jWc4ShY9IMeQY9)?Qppv2-rY)5wLz|E@OOIYWQGmR`9C{TKNktY z5O&GbBmE2N{zmGTA+Ob`!N~(}sHnWK^Qw~tQdGVf+=H%~0jVAJ_Y>sfYqOCMU7wr@ zA&V)gBFL13gR4iM*QSdZNV((Z;OR}Zy_C%I>ixaJ?*9Jt>XO*aV?W)dCLRF29_1$$ z+Q1KW>A_XW2bl&AyJ^s4z*CElP08}v;>{#im-<2f6yav@b@8daj?#=k`OV%WkTZr* zZ3#C;rP`Fc)Z`7WHdqY1)XtZdgI$U?*OZ!JKGmwj!|GE=eOF)(e{5BiVc=vYm&tw7 zQ1;@JK+p7)^6F0n*U1ohRFD)ZH3fYvAgjjOe@C~92+mwrl%E5eC2hXBQ9|(6MQwI! z2huiO4??8QK23$wyY;Gz(3@*_o1MU2b=jGc@}|y;|8kiMB|i5Z$A_@eYLLF|YGu3$ zzmJ$2EF}}+j8U%sFgAF4ujKet8JO{^ZSWxd3)dklvyg7{p2ex$!V_-C*wEEW-`!2Lrt@eSzLw{)4= z3SQqzqN~%#w?F9D0;LjK#d$ASvJ(YC2ir0l-bL6HBr|h>Raf`T1JswpGy1&UY+Fg2 zwC#cH>rZg`9q4Clwde-4CW}hY8h-V9_{-hcbN2>Bw=X*HjFd#=R6S`nGfFohEy5`c zQ!G<=IqAh~fpkkED0iY07k?seTQ{iL*)4OndxdQ-^I5OH^rQtX0vq4ZRY%(1x0m8r zRx)}~`T~9J0u68*l8nn&19(BY(_qH7RuY}Qan?4J?Q}iW>Dn8!5kF;^qkpR z)Mhq&`3M&rP1}o5 zl04nH*iY}r75SMhW|~5RD8jqaGizQdmPRMv(>FBz zpr><|MjGA@Jbku>VnzuS9nMH^Y{f1@_c8NxW$C*rE4&nymGqlII!S8utuaF$As`*; zNmoMp>^Qd&>(kWXGJZ_Sapf~~+vSg{b+MvV(wT)r-IpFA|O}ZU~sBW7yB%d|9(W{PIIC@Sq zSVH%DvQD!W{p7y)a6ORu9omHS$!jOfubE^ejxp<%Dk~qj7g5@$H|-XV#mcpDFu@Vn zZvrL}RVQ&Qlq7!OQLP!H7$bdpBbFvq{#>{`deh3MLUc8p1H)3pG2tgP%!J1dRwhG# z`ILWdCk^=cR}%CKbMJ31VAwsyEUyB`4ks1E|5RKgvIsK0$bH@#%68%*>4WHJ5-FIi>|I{YG@#M{W($0nYY2fIK^0p=w(N~A? z$E<*=4*G?>ZpGuaGR~y&m|Uzz=QEkoo4o#xC5d5tcFfA*8I%@JIiR-dOt=vIUN<^A z>?kP1Iu10$tbpxcgg+}^YD{|&>$TP4V|yNR^#=C@+{9Wf#_yM;W2rRnYIQru*2~F( zHLCpZ4F0kelR}Tm!3Gn3UoA?B1Fh8EdN~IagAcmPKFvp|v5^ZOOsc(8GE$sU0HF)I zwJpxujW|eZvu{}SzZl#Tr)YD)M&gG!^b*{|*l41~W!I-+l^_Ke6Yude0))U$Mw+9T(Wf)tRRC#e(Xe@0Gq)sJW=jk3t2V-vb*wd zO>`};T~a{yX+}H83^*Y*o=s%twtleytLcZrL(NEGnp~P;kILax-C8x9-f_0Do)vi3 zSRvRL|Ciksi|XVm9n$f;vVFU)=BK_Q zs7f?h>a$tp`^0j7={3_b# z%kM?`@Hz%{RBHML^`J!&yo>5bTB zs3)ASQByN##;0Zs(yq(SE&#!Hvj<)rg^cSil(L;fPF@Mzm5H0YQ=|LPaK)IQIXLsf zu-*OJCoWK(N_UexVjTOYX-l7t-%Z#)mgZ4e<}18)cWluqq21j3HQSqrm6SW(Bv_nN zn_U9d?3o&6Z1!yfspxK$@pL7ujXR-YybYwZN{ZbXu}qF@be}zIcy-yfJngKX{or?K#-GAR@eo5^o>%q5i!-Rqr&6k07nbCxG}kVlgfy2hkDw1 z9G8RSeD5T(eamU*04?)bN||*3Rh)90GdKwo!2FPYo<1YNck;nEmXfVSX5t%5?q@xd zT7y8)!FmC@Q&(~s+nL;QjUhm_mET3(0t`QQUdV_mOL^F;4LOZ_`RL|8wkUZfGpg#( zfp>n(MW~Da@Laivuau*ZrBEg8GZI{=v>Q2pt@2R_bK<1Cf^j~3QGnHrA*85o>uWoQ zWx;;!esRzSpfVA3Ds%4eZQ_1L6=TTl5!d5bVUN0Z0asr8gE}kiV38|74T>mw9w+#z zw=#Em$C|3%rVuuN@G`go&yzPl|2wSe)v%ke%OgTDyUOrhp>y=3B1M4%54{AY{{)+= zIGj&-b9MoqSnC2sz7_8P@iaH-9le0*nK{yOsa}(IWUO?7SxsrhjpIYz|`1ALpK$SfpOx&#$=bk@dsz}Y$vA+vggNThxx)Nb-VWPq&Y#jOgd&2_wBEZVNo@ERxlY|QB%V8*LhN?m+- z{SrzzPMtUSuetafi;3E|{SVviZqUQ%_UduyDmo?srfuPA1bH>)jYhMtP09k>?S1P~0ZfmTcrA=P&7rNQs z`}|0ivE#F3V$OH}-x<^dxfkT)8n0WB@v54<@Az-qOuxT8%&HLNSG-Xc>*UU3PyVI#kU-7&_?m(5%-5wcyZ^q!44GGTFClL-i`ME!aekwE~7-)yQ$Se+4Oni&ud> zb(@6rf;WK?uH%vl?CwLtj~lfD-ukS~CsPu3lnE_;lCzBusZ0J@cQXb)I=f~}P9F!X=j|Ft4*cBz zGkLy@4Oigv^iY>v@pTDT%+{=tHy2Qu*k2gRyc}GlU7Y6u%nviD# zys+`&pXk3dW+?rw`gSZ-|J)q$nd_hQHR_LZ8%0FcZY=2D2G=jYEHe|F%4jG*#)RCm zl|V^eHCJ0M+A-gZQ*6`F^{RBTBN{{YU&pYosa>Tc#jR?oK{-aVH2k`Q$*HgPHt=!H z=YCZfv#$P~R(!i!QU3-uWS>jFfT!`yr89Zl-}v&fTuT>JkCgaUDVi&qe* z=|5}v$`Uzc-@U}tB;9iCT{X7Q#0ftG7J}xajyquIfAqY7cvJ4qjVb=F^^3v1Ko}*u z^m3j%`}VI^GC;5vm);#Fk)^gy6{3hlZ}%`1CPJMa3X9i|1~I-gKCAS;v2qU@G=Vku zKIeapGtO^q3}F4OR<5js;c`6pGOyr)caQ42+9SGNqT<+z3At&sROD;G%AUuDk^Mc!Ul>!ZO}s5<#-Bf1gHQjErBw)oeCoaqMRPqQ>W!QB=4U7r>LACq~>p9YB#Avy&2r$%Ynn` zV_SaB&TUr2mZ^}lErBXQzdE=adh0XQmPqrW)XS#LuAl7aoX+So2|bS+}_+x4mh7EyzmMViL&bGHL=Qh>fB50!wSpw|^CUrOsuj;u0wj9N&I{3=y~0A+bx z+fQ+?FHh=!+1cS;J~J$bDc!^?(zAs=jUBd%pd;38s%5p!-X2(s;!}FITGAFEV&`ia z@ac*a>fnC5Y}}8J3ZI4)J4l>qzixe;O%6GB+o5zkgScdQ!?|qOImUu zU_T2g@pT7b6gVKC+2>8(%aLvEgS=WU(h>11Wd;t*r#wf7D;=)tqnOi*?iP>ZFgfl^ z)4sCJvje^9;Tz~ssMa(D2vsYR3qPnnLjrsJ5Vi2Y9<&F$3G8MWym*g?2ykaF;rMP* z?_wR&qHtQJ4*4=>7CxY~+b6n?3fT5{x(z(INltg!+nbukSvG&o#;KxKY+aFQ!YcBg zCjK!^_^tuf0Dl2TeCk#*J%N^WsHUTflF!^%5&6eCYGcR!j~M|@#~*SNe4|TcOW;5BU#LcQS!1_`JK^pnB?t6aPS#-`Hu2OYX-#4LkV#<*$ww)Qbb7`#szEP*pYK z$6>NIMl}g3Tw&0OKdXqltG%D;lVE8CbZBb;9SlN1GH=Y0MN4LTva-VyLrhM@BSHMD z4~aezpH2`4+u+W7r0I({O=i9}%8D8R#e*TyQofuXCqB_36*z~zJ5`l@}2xwAg8R5XbDF5#2V zWbJer?Q;!;^h){8U#Q)Qc%tWBQgL(fVCQ*sU@4O{x}TjUkf+Xf}S{_=VEayyq2`_kvz zndrn6lCjzD{agj|^O=S2FC`%Dj%~#604xKD`$&jh~#F(r9`YW3hZf96}sf7|# z$n_$IAt#|y-*VBLW*t@AO=%C7&g^Ci^}LkJi>I%j4EZzy8)n^Upw`*z^q)DV^mPhp zPsQ$z1udC~pi0)q>)6Tw&?d9x)^O7{c>;c~4@e4@BeKM+^E3cR51eUttPVOcHkmW% zU%V(0{nPP&dnk|e9)#j;88UdLE}OB}hXCvOsiWAHDkhRctoKicXj4nc--UAQtl>P; zA(P|vdlqY7?CP<70^l_CpX7$TDfLO!uissARQcD+e!0+QlO!sn!xwWF4$s>GFp>m5 zf)GaEWq>l&GEDIS{czvQerkFWPWo>yv{BfAUNwlu=aTWnr9i@&O~<|v*$HJd9Fk{t z67HJYPkTp9CZkNh^WTjQ^{f*F+z4VR# zP7YU(2mCWlDo+FIR`Ds{e@Hj9H zbBVOM({wt80kMg81xrjEQ5^HXd(ijnCTdH22CHXL*V(Q1-Bs0mjIvMW|4@Iq6Sz+% z>xE3qGl+zML`B=XKG_BHQsxJL4jpPMzNAl-`o2-yKVBk|rOlc`lZe^GvZR|pL!eJ{ zHTu=vz#lH_;O(MgzsmdyYKUz4*1qPZszooj5{h4pjH zX%mAa4`5#MiQi=SbCoiBR!hmpM&XORC#qA&>_8AkkZRpi=uLut^j6D+^&EDs$Pszs zQA6afn?N*Gu@vU8rwyUGLqT1QFO?ZW8gpuoDR=QcwwT)90sQ;*r2D8;p-#;GQ*^-uxzlc1ELYM+wyEGNd0?t_AB_S(vUc!qGwKKs62jD zOwVPY>5gxklOD0DF?W#maJm86ZKtZ1xsxe-#Hr%56iaHo^LUoq`yTpq?obP$rlmIL@uX&6{o``%L7@$;# z%G=m<;Hoom_2x@h3hX_V9}{a4TbxMt4_yoyq~yg>{n+BqN)PP<;=@VnFGUJ!$+&Nvywh4UGPL)Gq6 zTO|;8iu(6+3ljK!#OK1K{19l$9&wdw{}0b=UqZaPi?<}oi3F`5$y#sMoYwV&hY0Ir zWfWdvE_4X`)kVY$L=3x7Zf4t)y(5YZAhjZHwq;YF4+MWl1%rmAaTNV@P($wEj_BPz z2Pon-%DX-RO_WC&%MtnWl8>9DVP4Rkmt*_Z(Qn5AFP)ERk94WQ+hA9X4(hjBNE0Q` z?@lDG4V!Lp;I@r;kc&3Hq zr}Fj50U&d!Ex+~sn-$_ir!KYW-X|B^8bOtWu~s-f6u;-RSK`0pARSr*0}LL5QL^^< ztTxgD+G^=D0b&a#1z2qW_QKL?@ZZ8fzlk!#0NC=ONIHhnYS#pf@3I>rH-^LFVS~8# z-2lrx<8;DtXk*Ug1AAW|>Yh*8j?Q5CZ(8C^q(;xm>Wk^F5EhseN{n5%S<#FM4sTUNs~L=e}#GN|VV!dGFjGky0f zbdvmARt`mR;7n?N%~{HJ2oaV^%~g~c+_8|}bC{4ymi1EJ2AhUu?5Ihji}6)m!>cW6 z59(V0b-o%!hsF5j6Af84U-+s|&NkIp!Y;aoJXVJJh4#nI_`<996O$2|KqXwy?t?|& zH}LA-fu7n;<+1gmBpq8Kxp{KOM4qDYe%*N1$a7jx2iHD8b%PVirNu!SZiHv(3U7WQ2@(UUks zv$_PZZyHpo4OcxW=iX!7^9mxO2nTssn_X+(qXv5K#j$~8>1hoj#!W(*2a!{t@Zaf| z^tZ9vTB?S<_4fU-onM;KAN{~jInjT0!@OGP=STAf1hFAQvYm&sQb*C!QXfast=cGV z6H1+erv}R<((@AYS7#U#CUK(kuMl3ft-CjvRrYN9cCOgmeBJ&BR}*v~AsP}kyw2~R z5(PU9AF9ZceRQA%It%?;nfpk@ue@}Mev$dTJGa{L-g+mVK6na~4V2`1MU<*Gi{bLd zeQf0bh9)ZbzJ$y>;vO&k-PA&S0{BN!IIFRJ$EY5h8<-k*pMFHM~sAIG(BZ_mSq znE7{Cky6QwTwCqDR{ml6vdlY`_PX{d=R2WyHpwOqyv$SNalps@7N$RN*H^we-=ekL12{>oL~IxyNkntKXr&re`LHrWGItNs zsixdC%S94tKm75AVc56lb5Hc*0#{`N46wxi4$5Rb&1!>}y!>eEm;8b__b~%H_!1+@ z4TgBxyl_8|4;|+0I#PH4t7+ed5WDpger9IakGUYU>`l=M-Vd$Fav(F&@0Zr$D*EGy zbqw&pl?1#a*d~O(l(cow?XrYAoA_4$t6Va)q>Jf}-Q^pW1)qd@P2G(P^@g)ol{+-G zB&H?n!)rO1;U0wbB1xym=4%77_2Z|Boe8rog}Zg+^v6@(lgBHvN*J~uS_)(gF;CB~@q6{97^h|VQC*PEFrVj7e!4nkjKCkPT!Q@Hi`O#hr1>}iE z-D`V&JzU-R&6W2}_OhzbrF&O@%>`GDmDWG*Wh2+dPA301O)|3rQi!5ge+uuYSGZjf zedl-e0^#7=-nVNrv#x(%FB$$+tE&$D6ufAo4Tnapg$NEGunTJS=JQn8l#gdc1zaX> zPhWqiu4aYdXrx?zk2JpfYOA}xllCLj>$L0Ye>HuLcfj$bqQmR(K()o-tc%`PZddy3 zh%JRybQnwOUA!v&)j!(31kEkIG+WaI{`45T((}t;#_Ii}@cz?9in2b(5G5&CP(s<- z=c~Y;wGeeOjeX*=dA#zkWdup^Il86?;rieBA-MTP9-!d=h0qG^uL7Ma$@+c_1cY#E@(t9UJ??h_oNN<4vA%rB5T;6-vdhc5M zznOJr)}DRNp4n%VU;dOBVP*v zJ?yby)9j7r`HCRe&_xM++8f%LHR4|*AWZ)J?R(9eA7^`!KUMStk6R_57)$GS?i4{l zjjKxSCvXL?(lstd{o){s!tNp0pVOi%nmuF|aya2i7R=zIBh4*RsjwXx4s>O~6Bjc)@?}}!crcC+u<2B81 zh&*EcbCbL>gj-%xiiwh{nWPtBD^0E@K)&@?p6-jclSgeX`dt$J*j|(G%pKU~$_Y-Pow%W#lKGEK(zjJUn(w9jR zjcc?ouHxl70Jxb!O+445VR&SN7fN%mhku!{kEtkyxRw3s?u3cKPocH{lv9#tFfCI8t=RQ!VeNCpPQRD@ttSS z;|20Gw{&TraB0VXLsn+5IO$q5;(q_~cfh}R-ENS*6YQaBydKhaxXy3n%1czXTmaK& zst*3zSpi=38|BX)HOph_(|R}N%^{Xi&b+6K@aI(_zH(9Qrrh9OEHW`s55CPR8pQ0G zL3b$Qwf0fz={W7`d(V4OFD&W;T6PY3dCwChQHa&I(*ymE>@MMpXU!;yU$Ig;zIh-+ z{?aUqtykQq+i|CDn!j-J9Ce=K{EAz?C8)gtnvzu_5$)*Vu|Cw{yV91ilk~HCvKIGkm;%3Nd4YkS&Q<|X+x zyan0l*3ijB{rKYk)|b&} zV+h%S?c@)l@K&sO-;N@6JeLlV4v7d?%%e0HFR!Xp`JKltPr-TYMuP*%MBvx((yGf7 z<;TanSSt_)(oVPS*7ReICPqUh`D0Y=;oV=1GlxxqmKtZ#&QJ)a`4<%@!{|Gf1X#Ez zaCgT6T2Jm^Sq~+IO^yT|@vb334~_jj9!`yOQZi4+zNJ0Yc}Mu^NIQWryIdEE8jCDL zC-5u6Oj4RN+98K&0*;X@M{SxD@J4Ryy2@OqWdByc3adhNZ5@M3TjHeu zfFOq+NHP*gSn$lJ4gOF;su<@z!}fp-iQVvkDkE_EBwj2kG-2N3vWMTO52DMxZ)ql0 zW@maVLU^aH`$A8z;w^0Db9k$P)OCJfn}}%l-8e)&W%SR0MKD(lQ4vJyM}fYar*k8b z)&3eC-dm(GQlSiWAf?5!;veaxyZ-P4W*61_3iX$1aOST}__mEw1hDd-6K$7Rky)8LTm&u4kD!8elNG;IQEpF^8cz&!G*s}|0cvio%zfsex zJaZ8$xvp6Eb1<()T4VQTh2d&uaHdm7Ohwj}4SznW#?aqb@!rwnOCv$;PY_3tbAN8| z%t2S&ilyoj91+43dbZIU{OLULcBebH^$qa^oxQsFfPZ2dd~tXA^gb1wx6o$=t}35+ z7gn1#?ZFP0uM&t%$@#fKVu*Otgj1p=*u>>`aj{F+PQv0@_P=zp9fyvw!QXl>r=8V% z{0=pz;c>uCfe-u(G)Hr0pa@10TBNh@XpmTl@zH@%lTQf!eW&4Paj-g!sydA)aowS`|iMLivs|L!t?*Df$Znxj&kqHGZ|eL)$n&!kS^ zT)pNe`l}!sE3UOrbr+u#cCI8E*9?vXW^QZ8QjR$CCH1<%5-)Pa@!#Z^Z9!gdw#34D zS6F6U8BQ1XO$~N(Lmm@uZuRzkxvi8_fUn4_K8ds;$%Dm1)3@5kpKJSTwPsVmdvTI+;dj2BqG`Oi38 zy~_Pmo|=~USBt=q_70SH4{FbTz3we93*vit*ZWC3osl9={a}sJJz+!qIM4nfIE2xY z@c^hzLG$FXA+M?tpBUC<7B-qHLG1k2fl!@jA@MKGtl^+#%ydj|7NuZ$=Q%rn9zaCS zFkgCG!4x{&M8(E{DYoti8V|@;Nplaj<#6UjBfRmkfPqkDCFoK8Hr$&ONhJ95wXp|; z$-MKWBQ-oY;SIU*70%and!M7F-63bL^D?A%NN|IShw|K>A6>3<_6VE{cBXujV6nzr z^iTBkF7j-3aSlO~|HyPsYCYL6y?KWGchJTrf=v2e65C27M4a2?>(_+pu>N*Snjb5{mY+8A+w#i!5Uj`n{7fn6YmZQ1s^^<5rOO^iEi7ChqGa z%PFXDnn)Bv5Sq~y4CWJMYZ9DkljK_S(4knbPZ#j6`-G}YK4yHlyDy5J$A+h}5M37g z5@LvlI5Uz}RhqWa&6p!IsiT)sg=+w*m~bn)XXg`t1RX$bKcos#+sqn1Bf`GhImG`G z8`;dH$@Lt1!1UlwT;ah_U6=D9JQY7RFkpA)JAVR`ZrKH2m#ue7;uI$2{S5i;tnYdo zN^X|ds*|BFLHN6Me~kYra)AC}KtlM8)CJ4%xv1IlGTC53O0Atapv?bCz$fSKJp4B! zz9VBq=KK8KSBxCX)~Z#}YrGd>j>Gp7x)9_=IzXycyP8jJ(>#p_z2w$YxI~WU)~kn% zVy>m$N+sjGUg#zvdc(}u)8UW$m>XYRhAK*J2Mh-=4xM)FROpMa-)&+*wn;X+EjEVl zq7`&@qxpj^vpZ9IW0&Pb_l5wPgN6U~ae$k(B@g;%Sh14_SNju5dcY(w>_x?_ zpnA7pNS(uB5x7e|HD;*uvvk|CB=G$}sDPj9QD|51749#x`wQjC3bTXN-b;ey^x8M} zeW0lFc{6jiSF?ka+{JO^luGb~Y!LV{m1ihX!gSt&omvC~(07>jWSrnR-`sJlypP;6 zu#JF_r95>5iv~YmM)b*@se06(!T8qzwGcxb9<+$Ck)+;}+Y${{5>;X!xuOdBtE$ko z-@|VbIyWWzLAQiP#TTgMKgX<|AF%@_UGy)9Z-R3%@3jLNXU{Z>`lZpl+hg?E-^MFd zy4BBc&>zhyPST-Kv8x+T7RqShmEL$Dnhn-fZKcJ+{8W2m9i5r0G^!q>ZR#6X?FW38rS#|jE-<_x(Q`&@Pz zRdQrZ%LMb#sizvIU8-w(Kpj`g&T%#VPrgUiOH+tP;@qk*o8e2l*tq6ZI-OFcrDzq5 zcF-<5HMG~XcE3A*s3trIHr4JIwi?-l1fqb<=R7NZYg9pv0SlW}?^ou&CisWM1^~em zjS9v|Dvcbq$9OH($czr@KW5rs{8e3Fr2jxvKS${~*V@=X<-zgxzw0LR`^R4sJt7r% z-+IjRa57p^8vMQJb2PZy5}nN%6|dte)a8tf0Jcujc|iw zVbob?Di?2pc&SU~Sd-w*v6pH&OdgkHgF(sl!@l*8C%={93Ns1Kii*`XkUvuE(a%y* zzDIZT-lR+cpf#xh=T8B%uz!IMLR+u0vm^25{X-(L^24(EnEiG| z#eVzis+rGX`;H*v`5U_{fHLqta;`D>k+g!2g#tMmf;lNt@z^>gT|OSX8VuGo>>(~~ z?2HF(qy~V>baCe7-#}H(O#qc%mJaudI^C7;iU_@@NC38b_6>Z8PoAOTBGJjpK2fY** zs28QqT`e6qz8MyU*BUtKTLF0-F%1IK$_$YTF-`zj)`{Dwz&dPsZz#Ggl>6gWv8QEa zcqZ}Q<0^1K{sXF6i zBYu{ga;V~nv(vb2`Kw4j{UmSs=DDxY3hxS)e9?+O`ssou@o5D$wdy1Hy$A^94+;(H z@6b}xl3EIKvNl~OOZr(}N%3g}WSh+e`tvjBDxNRIJ)5Q+n61bJtO3_AFNV#jR=8ba%5E(A5v%}>Y;JUj5CPyV@d z8(|gX4DuXkdIOW#VqSmjaTeo#wY$CH5})*QTCP#v6N53@>UD7(!$&09lP<}Nh zJyOYbmLLP0=Je<=a&si&DzoiFLqw=r2Y#qTbIK2)sl?xxFaosupXaIx%Q*1C6%z6>(hx8)I%493}-tM zC3bRR-+So4-UcVLYs>ffu?IC%b{s&Mzj|}k#(YT)QgKz580l$EK`WLO3`4#MV9q+& z3dA^hGBr^D)IJi3Vrz+zfX*$^J5^dsq5_{YR6uiA_0>?kdI!(t-v{V2Gr~|HiS{YO zbt`i}_p>6p?cn6ZP<}I9hgViFS|Q+MeKkdMqhf!q=Ov=_) z4mH(3B>vtmd>uA1)Y}EJa>+ZoJF4v83*^@M`n_BUF9Cyjx!k${vN5G`5F#b zWr(nME0#Q%qA5$U5%w4q$0>2-bNcXC{hRy0Q0)~k!b^Ak*CX=a1u8x<(^q{^J@-7h zS|LTm5*#5{W~^G&K=EbN%b!e4s*LIdBG$uhlFsuc!19?;M{Rc z28YnT`GC~8B5IyMK}3fiJ~!Lj5IIdu%zte>4h>1%RoF(57C)f@0*^e}HI?*N9S80k zXR}ni!)xSM8mgCPO~k1vDjuEgY#^R4Y&*_g)vs|!JzJ1oJtLrlAjGT&3S+OI+0tCNImLMQd<8oYq~WG z`58Q!_&kpvz$e;gTs1j-_+&*OW@UeoY=|E4%blC{6rCW^laHtP%Mv4tZqh4CU}Zd~ zs;JH|V|YAg>#`BG=d3m1#c79Zn!Y0U(csQ7?&Ew|c%k-Hz&zTI*XKwb6msmKx=yZ} ztKqW8GR#0JlTilGld6ZS(g3T$T-3l1K*;u~CKeJ!>`tr29EN79Jh%4!S4!jQiewDZ z-y%3_m%dZJsTRvhz4!+UZ$918*koIsgUP%LlYza74-gPJckD3Q{@1xNFPpN{z5V~KEy?hp8;9_7y|7Ki2Uh>JzugEVU8j{3)LIA=<9t0Rz8p8KdM-y zECAhPspn57bM6v57HaO$SAniY4dmmc9GOE8#`T8WLn-Nr%{Z&XN7Y|7r&q+3b4Yhi zT2sOm@Jq!W=O7IYSYQFM6Z?dk@a5!Zj3;lLi2uC)+}rxU3hMqGK;3rw&Q{`B1L(gE zdbQgPr7GN&kn~UTWL7S~p&ZF!k(W{Oc$x>v&n|u7?T?3J<>mHnufGt*m>rc)@IJM( z&S=Wu;KT7Wb<6>e-!S^ss5MQ|w`z_a51_6L^IuHRU&&p+(lYg0<|Bta)%CzqXp>D0 zII*dcbrr1I-rVTB=y8VuGx(LXO4t&~#}nKg3cgS9?!StmN+4tZ(IZg_aUwzl(C;5V zmK?749!z!U>HY}dDV&WWYQdZS(%bW=3Y6x7DP|65*b zEGOcG5S$j(>Zm@G8>hqQNT}#Ss&MjhU5`H5woS#`>N%;50xhX5f#Oztac8fw9hyF+ zP{Yqq4{F+HSH=j-C+uJamY4Nn67gIOK zFnru4z8?6#FV7e)xp6d4l+q{S_NsdIfamsiYYgVBGnEPzdgv{qi$r z7yc{!k68WhH@v0(f4_1UvGazE2(Eausoxhmjv8JS646j{l^*764+szE4Y~g)pqb~y z2Cvk(a-YP}yipZM)4dXtI!`E0s;+=H0E3+9J*fiJ4WU=hqUcujoA&)9G!&$+iK@`C zW%9%u6`)7E$Ge`9c14P-{km2CIwAbJa-{gQay*q##e{0$Pz|~l@;TsUvWM$Ozc3Zw z)@a%upBi16xF&>uZ1}Am z;KiZtR!wKls(Xi5Qn;ZIscY3*Ra2!d!$@Azoh^#hkBeNVZY8$rEeogHBl&EY^~yH9 z?NUy2;|)SN(#yX`OPsXNbg14K=-F13UvEpe89H}zKWfxv_gY`O?|u69btO^t^{KFm z+b6%dn=UR){!|+sz-x3#$MlbB5QlDN4lU;0ns?`p1A{`RUZ+|hf6D;-&nGLvxmUQY zk8eLF9@EU^RE6B2$U*Hs{>jpvL&5%y+PmCM&UK_`m~@G9T%K#^bxmCk9`4Y;n8%)} zUPxfC+?~ibbtzMwf_f#fb(WA2Ahpm6(RJszo7Z)-e`h4;;~Q>dnsA|9DDM&1&iH$v zSwwSZIcRqubo^_Yqlyfend@YT=I+3-|yN_eG@@}6Md z28wF^`>d!59COj?gUH)3R{BWS+}JUp&WjEb^4I0q(3aXv2&&Z^1;HUo+(5DsWb(M> zI#Y-wHuSdr-OaP*snK!3@$zEC z&y&_T;i>iW#ga6V!^Yf=2+e1~B18DNg&|aMtn&rKubxf{^rUWXfG&^oSFnS2i?JL7 z63yf?u&Ws!Lcsr@eF@#}b&d1;95b&{}al*ZA=3If#}k3G8EWHa1koYx7t1 z{ccgD|3Qr&?(|h94fv4F;D^A;1Ji)oA)Hk2(Efk#h}f*WoiR*OgU2@+{*ZGnF8l8k z1zy54YHEe~(pho7w@^=d2NIm)%}OX~No@V3>}qWEA6w126toY=vfz#AQ8`74IyV(M#nMCO=Zxa@pex|%9>U3Q zLqyiD4%)$AMdhMC1PXj4bt$>QF)H;$T1wDyM#pwAD;XI6M|zw7q5&+qmXvbwfY-G!j%29R&9blQ7tSIk;M(p%tn7sU!rE_IT4FO#U`#y{3Y2b2O` z+h{sfyH}+`6CQZ_DfQ5cR7pVLy{pJ(`o;j?kx4q<{K^x~-eAwQuXfV~NB`69rMmKG zz$9-*!V$hq>$2x05N3wY-3S@j&2~xrxF*Q!+B;j;0l&uwgLMvgn9K}ZLRbV)TYs9< zL>MsW5VrvzJiqlBj+7p^O}eA+GJ$N|=Uguy$uW*}>U1lw$J^Y z+o`LP{_HlIKdt}F`O{q0m5cMN@?1&6vt!~X@`?Iw#@Wcez9BV$ut!LGKpMTe$}J)O zq`0TK0*6;wP9`%&{3xbF`bS7K$;^Xf8!Y8M_EsYf!h{qyRq3Xx{AGNc!Wh1Zq4a$2 z+|KGuh%#x+8%xaqaZjA2eH`5l{+#%FfHM?T!00w#{IG^_Nu4#=T=(2HWOQP<*E0{t zhJ*mLl>BE72*h4X-rD1?!zhSc7D2;twJZp)EwDNUiwvqd$^@I;lYn-vi^|qzE%b0N^zm6Y!%FL@tOn@})i{?{0Wk1(ZY(Xwv2fStBTbmO}&x$Di{p^;iM#5~Wh+PKB zW{nD%a<|`GKbWxgUv=x8M?4$Ecj|8b(PiC{xWPfnpR8;Y#wGN6P)n!7JL6*Nu%`?| z=U-7PBdTX=s=y3F9p{815b9S*;llc>6Mq|`6fMDV;WLBV6}MRxktCH%AH?liH!uSMd+JKqb78WPkEJ;Dt1E_bFKXs3<HnJMt3-Jgbh-vTbbRA3svuwR zQNq<4YzarQe9GmWxdNwPcQavp8iQv{Wzgw=!+_dQYoCINFHW|m7TN(H^GQ(~y)~W| zGf73&9=;&bdvs3zPe5pV1<>}P=i37Cl7f0Zhy&z4iOTC;JjIUeC>m>Iid+BQR2Q@X z)s`P0qdLVqjp@wg_fKpC2QoWt?{UO>iDNVe4bS`=-02xZ(GO3Zz2lsGfTmt7p2$*= zP$kB(_t5N6Xy>u^5@7kl?Jtf$GI%c9YCzFUxxHY$criy+bFl4B26qolppghA+399B zq;aqJA4Wt#_i%~yH2(^!EjET8msstsrob2&q^ zzeB4|Be8Np*wC~4)Q{(b;A7t)m@>mEf49?A0`Nz5kXr<784IL_zBC41nW-{L@irPx z4@GFG>=mSyO4jnJ*WJYbS$C&56MyQzwcZ5e!(iAZIr>H_s! zeRYYDe1@ofRhlU*ubme%<-n_oUvFoQyagXq)*8Qx37~Vc@cFPO#n_5Z(BLbViu!(m z{{oaQ{Jfd+ zgv~{mRVew_DD5BOj|OG7FX#Ve7u;sGtC`?^7^h~R_sZ37(5^>v@nsHW$j-?*)@>wV z!?|A1DUR0EP4E*sw()KSJ1eB-75uG=w|Ga6N_M;yQ|%)g6!)Lvd=BNs-*z97XA3ts zwjB<_bkaPXs`4z=VpIx1@p~h)Dj0v&0+348h|fYUj=*~8scgj7AaW+1-&ZG^CvL7MrF*?{pChNHw}1L+28mjanhoX2}A0~!gVp%I>nk%Xb=joY^*F4D#RSCK7RS<80iBpUe8 zO@dAQ`@C(s&Bc@ni;guCFM-Z{zN4`%0v2sEFrQUE=p!l%XMHGx2299A)RiU7n>fm&UB&aq#1yTfZS*DV^tSsch+w2 zJHqrd^UnoJ`(0{HPV7Xlu}ve!CLHPxD*l+&V#CmL-Mh9uA&qQW&jI=^DwHZI*0Sk- z``C+j-)kKGSY2wE^}=(%i7I>vY!pK;1o*|Be(6unuq?54>+)?~yF+nJ#_`#syQF6W7&@!x88ekwjwzrWF_rme`@ zDWR6a%P~oKCN9wFtdmb+KB85Y{uL@2gA2Zgf0puW3RTeI5}PZ>9EbB$3z@fabP0MK z=YIE~4k>3loSjVHn1nu~tu$69eT$<3zx$HOo*OIcrXqS-BW+HPd-#2$|HlM7Fe>hA zi$0bMC;c(S6HU}8=!_#*S4g(ajwWgbQXLxm#r3nK;i%6ad%E`!(`K|jD(-04>6sgV z@(Io|*-Y$>Enh?3?B`j4bB?{mkbBwENtVGXXS$XET*^LLe5^`vPBtd^`jeV5ngRYN zCU<)Rg0^z*`y(`F%QkQJ6NY+rC!^pGSt-Wxie>{839*m1xmdtPGqefK$0ACg5QsGk!fNe0)~d8|C3D%&Lp|b8@ZZ^1Wz}J1yV`3j&|k z@z{%v?etv>)fYcj6P^wH>Tq6G_7;i}d0rAnUfq$1H@N03#lBO)u5m)9Zm&0XO!?AewRjJJFw2_&v=7I7%G-H` zVFn^&>M4oIuj1E)@!DmPt)3cJ)BL~Bx!nbfon7l~;m%ht=VeMlVP*qDHu#?y+WQA@ zE5ywO)DCZx=7$Ad_}3{a6b0U4LoNnAKG3c(5TFqN?9%)huWz)0)F>{>`Ed@|*#r)r z0}pgjue<>jUCz00T$%y%;ysxbG4qbSiL{FLScCAYW8XiLf0_Yru_fGdtJ!;rMCl6I zo_QQ%lDJDrdh0Fm@zJ80Uj@}d6FO(%wsxc5;*s9Hr#Oe!AD-$5wEN2PoDS9Bkmtj$ zu@lil?-s+*tdP9bq}-{1Jb8+VDEgI4e92q~M|9V@t|VG+#NKtGfiZv= zkkxFxAEuNwaXFTT(9AEue^3AtZMyIR+44tKzQT?~-XQoVNgPaV=56tWr(o;E91&O?iZB}ZZKW9T06Hh{&X;GgNtb#v7 zisedswo5`)uIeAQspD82V@oc(D)m;0DKpHV0=G5WI#N~jN!JUu4qZq_KMd5Si_>%aEXaeD=c+gAIIr?0c#BbRd>C}aGS&uU2Sf%J^zsrtzX?a2<3OFCWU!97raa#iY!kk<0xO}>z z@f&YZb%Ui#!eDzY8+{Bdg?=>N@66$sz$}Ik{d53v8qt_T1oXn+p?#^Q_sp)Re<{!Ye<8oI_>-k?lH{_xKn1 z`LKC$pLkKUA|%2~ZE{)csX0BLq?P_g=4^;OtWn@s%Y+f*0Q|x`Io@oIbL)R`tDr2! z;#yLwApd-zL8I_~hWK2=_@qhLLtA)6N1hvBo0^O2@GaO5Gt0oV#ThSK45BK}LdDI! zt$+Im>HYUr^~VRA6>d(D!9xw%S6Ng4L0|(iTAP|J&s@@9cD(B>IL~)o8YaG5wJc-tRj800e`z@>uh?S}CZ;JG624>loNWg8 z@F@+hqXlisN>%SpZ4U|5_Tre7bA6B!g=vEodKR%LqN3s`{{sDNh=n-rxMdpjpi6Vv zb*jWEj0vW;Os_OtDELwCPVsQWpv12-VY?x&$i(54TYlw3uslr7MQ9v~Wn|6@wtXUe zJzH!Q<{{ijWPhIDw+;is@6|FPyQ@9UXap(W(|wkN4#-i^J>dN)UTWJ~BGYqZKsK<_ z4>kb*uvlwQD|LNj>H1+~0uLlS*nn8(FX@V&>AGAQIq{i57ZOkvK6I=k3F%AWy$Ho7 z3(af~8q;lna4zO*+)2 zD(JYrB3SnKILPru9=@e&N>cy)ZH8UGcYod0Ep#SPC$X>Ajq^Yml5@n|TIbuK(BEGi_CIdLaz@b=-FaAZ!Yi+P3xBnO6oYp4X(BrOW0}8s9uMkm>ht089oW&fMn=r zTYA?L05(^xbqDl<{h^;{zexC}*(3Eq!VzkRMKwDyHOQI5&@;2geS_Yqb@lGPb)kHw z@Y8an@}vddyzC4g#KYjbWr>&pT%ga)$}g@`*YR}Q@$|hlGSvpsZ3=iEe7jyr8=;TB zW}vEjO8L7L3lg1*O<;7r?A8VoGU-0nwP0&;h7Pq< zH5)yymE79j@?FvYpo#zUD-4Qu+(@;B)6_lcpEb+eE94AD)bkoko@XsI(g91(GY4nY zb|8symhWqwW&Lz^B5gJ%MW1a1zYJs_rIXlhtC2KJK3hrKYhjoIa1^{qX=0hu)boqm z|NQJ5DAms87jpLGew!{z-}Or}u|(n^1HM;v%Ut~>Y4p%I99MGneik|AqfGiE<21be zSM=4PstZQJ$#7n756d%${W?F_ z*{fuk;%Knsn$6hH<37;c65xq5i0AkPevnq_QZ9l5t2UCqTn0+%>J@i-IT7Y?`r07c zIhJWe-+Tw}IlE<5M4Tq+kADv90aL#jS8>8AI*4I5T2!{V;^#P9t>5UPrMXK<}GhJg#@^4bf6^+gVpubQRU z3RtEdH}IeW?fnuE8PA4y?9>hAc1U90acFPq*(ydCJ*|a+AKrSv_qMfL_E)Dh=@~0V7btB1yAc;I-m4{s+Q|#9Pia*8+?UZ(aWf`>p?z_iRGHp`_-DJz8TY z=G`sIK`q&*Jla+MV}hJ^$?drddEsl?7=hPvLb=*zu2$l@(@djSHh;Ln8%X$owwr2o zL%zhLw6K8}Gfem{`Erqls6BwIVkt!*ZT9-9I3B~T9Utu)N_I7D)EQTY@sQpSg?`6> zoln}&=){inRDOMPwRe#!AfF!d277|16`nm6RhS4U>phaql%Ga@ug0!xlUuc|%m79o zu0{mDS+dq3d_qf6m*~*YYxaTeRRYvebD%CmqKv%xwRd z>;x6HZX&u@?T2wHe0&`kZ_s7~-55o3{=0LoIwZPZ7{@n$yEH?3Ue=LsF`;PolJJnh zvAwbIRDOuKX&*6G9r*= zH9Na9skGDMIk{;M^rjx!Y$%SN8AQkF+HZ!Q|0pz&b1=W2o378=tYU{=x2SI9F0|fY zE8#oPU0qJI#g|n#eCnjLMuv+)Qf-MpF!SuLA)IVH^E<`mBCBi@4cl8p2d^|^71%mS zwpEebA%`=7fe)(5Ie@LX5Y zmMYa)S+uvIlh;r7#i5~RT zg}}v2uDckdpI%M-_arNx3Uq(tnY+9_2eHCW1WJ-~c=;jmM+r_sih7zOiPM(@<0G|d zhY$Ktd~t^HW2&-9-(K%qfP{mvS!VkOYiwWVEF>aMAYX@JMH`dE*wbI!!LakZz$ntQ z8EPm}*|d8#>bwpdC1#XEvFaI+Yke>H)o zT2db*fsb*eJ$SGthwq0<7wBdcbK0`Us`TLGsFXbg zKA>(D80uFM#l3RFi?Sa45Z3uzt9H{topY)$({*dUeXHnTiT+KEy#=frR6Y*@%^r)wuT`Pyh#)LH;=V_z}gC%T1jA$6Uv~0X%!Eub0kt zxz0?Uga{PSM=(l?8#%Z!ZsD#hCq-Fisp$BLdAICEdDcZ73|hk|4AhbeicT)bam4C~ zA?2-)Hm1hr2zTev>43D^Zj{D#MJGF{91sUZfJ;t>vC77ceneN(MhE^jb%W|25yHzUq-O}&kW-GUL?4QU;wKM4+B@cy6E9lf zLIg20b%%oud^xfCaqi_Cg{9OEvBy&j{MS2NM-?qrXRIv_Yc1tFZcOGb6RvF;GE-=GkC<_w2%NseuHUeRX~K` z;wk)srgaVJ_lPCIQsT>Y#vZ2fC3a#kn?r9Jum9t_&3PX$O-NnPxzXiVNzSEwouhaw ze8Ozrv5$y;TYlg$3wPj<&MPoqhA-9Y+W83a$d*HDv9T|19@rk@t7daK9#^2;x3i$) z{(i8vppkJF3$PdEUcaWlNZm>5y(7U#;H<>1mMXGo#Q?Xt-{$D^hzs@}Vr*4GmEydG zOL}PfL^EQ%u8us~?_I%)VHyy<%i^>JT8^c&L``XGOlw5_kxqaQfS-R@c zLCM9rC|IsxU+J8w%pGD$Q$4DSnHR4Sz<4x;oHw1-RO+2`fXQ1fu>Xy)BWC~Z*vf;& zZV`76MnuX*pDuQ@l0tGU9?6Eiur)*4XJZS>p)R8*CJp=3t>2#Pd8?hLY^5B+Mowcb zH9bJ!lMgc)l9ijj_6|H{9ThH#_K5>$29pQr3Gg?yaQM189r#}IPPG?rLBj~by1_oN zs8hu9f{@vRA_k5W72;k)o#S$FM(!inkfz0Q}v3r8o zLV=q7CFYolz@AmHZ#Y>~-C6~^>_s7ON8W2r{>Pa#Nhs;mUl4A`v85lfsGH80VNVA} zT>Fo`OgQX8QbI*+`atdWYp_(qHnmI0NJCbdy_Y+_Pao_(64cNiA>vLbg`%~B=EaBK z)FREU^u}{%*`2n&H;~u7u31)Twr^$`FgqTBI#yM_6dRoNd_qNyQ=DuW#S1bL%niOg z+tSV2f|T78qq7MQbfF9c?fx$6v4@&qHUnkxcqEGho+9 z81A}}jxd5Zip4Ds7$Z*X*%U*CM@$fx@8WNRB@@u}k55K)HAU*GF6zwtYx*nFN)Tv4 zQengGYXF&9i3sOhkz<9YVBPNwT5)W`lRZ zCKBrLl7Hg7pi~ry`1e06X8N&Pk?$ z{5E59i-hNMPVcCJ_gsa~ISo|7hWmoWe^kJ4HHxF=B_@oS4R&o#T3KE*^X%H#SZbHY zbS)|Ixu0a3J5364ddCdNuZt!GjPh*aA`w!NFVI+pTJmj(s?U)y_h`tPde|FxiAS5DC{#~dZs zX8eE7+IyHB*yq|EXK`&`UJ9=PudVWf_pOXiEE&oVORk4g6Hd93d00o?-5lQY|C`12 zk(a_5nPdM?d*>I@#vQ=%L=sTTy5>fl-O#n_rCDMRghPgP!`4PkZYhc0_0q+JEE{EU zMRX>Rbc0IfXfDdq)chIO20G1QJs&RarJ7zJQf};FO>qY!6WrDwESn9KX1BIJR9M<{ zV{|W4>gXWwdHC{q`tkX_{T}YX#(}TjyZY|nRb-I%zU?KDmqInSmt-dfNfU7gh?lwX zIWqDMHJO=sb@^}B4)sY@aqBhJgKOZ(FCR^=PTXH!bGF|MKqW$77&nqg8Pj!8{p;_6 z)lO%7NiThcJmOpJaWS|$@#$sRKAV3Ux_Ph6&`9bHPheo~;WcCDhXnNHx#7`Uiqic` zZCDqsY)f`S2zqD$><^#N2W z$C5j-I|r4Ym~@BCat#``q6c5VlDjd1WSQ9!`^^tlX1T*~2Ds!PtSN54MW|~X-4R=oBWr%Jq8~R=v=*ylUK!Hq2OBd$ z$U*d`xMqv6O^z--}c-lG@ONuP~p%UY9NFo-nI(lGPn9O79LW>nb)z4)&QWfu_f7SE<( z=E<3+d_VH+u*-f4W~^jxf3^_Idl0d#8(sF&C%=2iTywS%&fo15PbPhD@@!e-WKNqc zMDuqI;z`PPg=b4o1q{sKBrZg|D{Q&IfDo;)#R7;Bt+2%cnxY}Z|QLXvoK*MIknLlQMDPS>nZ)zGt>P> zO3(5wb{D|F1Ws~VqYzaU4b$G|SO22|*s~7Ix(RcdQ`?*osLc?sr;sWBu}0DyXcNvt zqx$$#5*g${XdQ^ViT_mBtpk&8LYL;6Y|b#W*cZ1XkyajjO8uHm2tmc(_(u0BOX40Q mU0nS5#Xo`#b=JB2D?dm}zvlaS^UDXDr}n-NQ*RloB!2?gXfG-N literal 0 HcmV?d00001 diff --git a/inst/doc/freqlist.R b/inst/doc/freqlist.R new file mode 100644 index 0000000..3989afb --- /dev/null +++ b/inst/doc/freqlist.R @@ -0,0 +1,112 @@ +## ----setup, include=FALSE----------------------------------------------------- +knitr::opts_chunk$set(echo = TRUE, tidy.opts=list(width.cutoff=80), tidy=TRUE, comment=NA) +options(width=80, max.print=1000) + +require(arsenal) +# source("/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/arsenal-eph/R/freqlist.R") +# source("/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/arsenal-eph/R/summary.freqlist.R") +# source("/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/arsenal-eph/R/freqlist.internal.R") + +## ----loading and setting up data---------------------------------------------- +# load the data +data(mockstudy) + +# examine the data +str(mockstudy) + +# retain NAs when creating the table using the useNA argument +tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA="ifany") + +## ----console.output----------------------------------------------------------- +noby <- freqlist(tab.ex) + +str(noby) + +# view the data frame portion of freqlist output +noby[["freqlist"]] + +## ---- results = 'asis'-------------------------------------------------------- +summary(noby) + +## ---- results = 'asis'-------------------------------------------------------- +summary(noby, caption="Basic freqlist output") + +## ----labelTranslations, results = 'asis'-------------------------------------- + +withnames <- freqlist(tab.ex, labelTranslations = c("Treatment Arm","Gender","LASA QOL"), digits = 0) + +summary(withnames) + + +## ----sparse, results = 'asis'------------------------------------------------- +# we create a second table example to showcase the sparse argument +tab.sparse <- table(mockstudy[, c("race","sex","arm")]) + +nobysparse <- freqlist(tab.sparse, sparse = TRUE, digits=1) +summary(nobysparse) + +## ----na.options, results = 'asis'--------------------------------------------- +summary(freqlist(tab.ex, na.options="include")) +summary(freqlist(tab.ex, na.options="showexclude")) +summary(freqlist(tab.ex, na.options="remove")) + +## ----frequency counts, results='asis'----------------------------------------- +withby <- freqlist(tab.ex, groupBy = c("arm","sex")) +summary(withby) + +#using the single = TRUE argument will collapse results into a single table for printing +summary(withby, single = TRUE) + + +## ----changelabs, results = 'asis'--------------------------------------------- +labels(noby) <- c("Arm", "Sex", "OtherThing") +summary(noby) + +## ---- results = 'asis'-------------------------------------------------------- +summary(noby, labelTranslations = c("Hi there", "What up", "Bye")) + +## ----xtable setup------------------------------------------------------------- +require(xtable) +#turn off xtable header +options(xtable.comment = FALSE) + +#set up custom function for xtable text +italic <- function(x){ +paste0('{\\emph{ ', x, '}}') +} + + +## ----printxtable, results='asis'---------------------------------------------- +xftbl <- xtable(noby[["freqlist"]], + caption = "xtable formatted output of freqlist data frame", align="|r|r|r|r|c|c|c|r|") + +# change the column names +names(xftbl)[1:3] <- c("Arm", "Gender", "LASA QOL") + +print(xftbl, sanitize.colnames.function = italic, include.rownames = FALSE) + +## ----------------------------------------------------------------------------- +# base table default removes NAs +tab.d1 <- base::table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA="ifany") +tab.d1 + +## ----------------------------------------------------------------------------- +# without specifying addNA +tab.d2 <- xtabs(formula = ~ arm + sex + mdquality.s, data = mockstudy) +tab.d2 + +# now with addNA +tab.d3 <- xtabs(~ arm + sex + addNA(mdquality.s), data = mockstudy) +tab.d3 + + +## ----------------------------------------------------------------------------- +# providing variables separately (as vectors) drops column names +tab.d4 <- base::table(mockstudy[, "arm"], mockstudy[, "sex"], mockstudy[, "mdquality.s"]) +tab.d4 + +## ----------------------------------------------------------------------------- +# add the column name labels back using dnn option in base::table +tab.dnn <- base::table(mockstudy[, "arm"], mockstudy[, "sex"], mockstudy[, "mdquality.s"], dnn=c("Amy", "Susan", "George")) +tab.dnn + diff --git a/inst/doc/freqlist.Rmd b/inst/doc/freqlist.Rmd new file mode 100644 index 0000000..74111f0 --- /dev/null +++ b/inst/doc/freqlist.Rmd @@ -0,0 +1,244 @@ +--- +title: "The freqlist function" +author: "Tina Gunderson" +date: '`r format(Sys.time(),"%d %B, %Y")`' +output: + pdf_document: + toc: yes + toc_depth: 3 + html_document: + toc: yes + toc_depth: '3' +header-includes: \usepackage{tabularx} +vignette: | + %\VignetteIndexEntry{The freqlist function} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE, tidy.opts=list(width.cutoff=80), tidy=TRUE, comment=NA) +options(width=80, max.print=1000) + +require(arsenal) +# source("/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/arsenal-eph/R/freqlist.R") +# source("/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/arsenal-eph/R/summary.freqlist.R") +# source("/data5/bsi/adhoc/s200555.R-infrastructure/devel/eph/arsenal-eph/R/freqlist.internal.R") +``` + +\newpage + +# Overview + +`freqlist` is a function meant to produce output similar to SAS's `PROC FREQ` procedure when using the `/list` option of the `TABLE` statement. +`freqlist` provides options for handling missing or sparse data and can provide cumulative counts and percentages based on subgroups. +It depends on the `knitr` package for printing. + +## Sample dataset + +For our examples, we'll load the `mockstudy` data included with this package and use it to create a basic table. +Because they have fewer levels, for brevity, we'll use the variables arm, sex, and mdquality.s to create the example table. +We'll retain NAs in the table creation. +See the appendix for notes regarding default NA handling and other useful information regarding tables in R. + +```{r loading and setting up data} +# load the data +data(mockstudy) + +# examine the data +str(mockstudy) + +# retain NAs when creating the table using the useNA argument +tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA="ifany") +``` + +\newpage + +# The `freqlist` object + +The `freqlist` function returns an object of class `freqlist`, which has three parts: `freqlist`, `byVar`, and `labels`. + + - `freqlist` is a single data frame containing all contingency tables with calculated frequencies, cumulative frequencies, percentages, and cumulative percentages. + + - `byVar` and `labels` are used in the `summary` method for subgroups and variable names, which will be covered in later examples. + +```{r console.output} +noby <- freqlist(tab.ex) + +str(noby) + +# view the data frame portion of freqlist output +noby[["freqlist"]] +``` + +\newpage + +# Basic output using `summary` + +The `summary` method for `freqlist` relies on the `kable` function (in the `knitr` package) for printing. +`knitr::kable` converts the output to markdown which can be printed in the console or easily rendered in Word, pdf, or html documents. + +Note that you must supply `results="asis"` to properly format the markdown output. + +```{r, results = 'asis'} +summary(noby) +``` + +Additional arguments (except digits) in the `kable` function can be passed through. Perhaps the most useful is `caption`. + +```{r, results = 'asis'} +summary(noby, caption="Basic freqlist output") +``` + +You can also easily pull out the `freqlist` data frame for more complicated formatting or manipulation +(e.g. with another function such as `xtable` or `pander`). See below. + +\newpage + +# Rounding percentage digits or changing variable names for printing + +The digits argument takes a single numeric value and controls the rounding of percentages in the output. +The labelTranslations argument is a character vector whose length must be equal to the number of factors used in the table. +Note: this does not change the names of the data frame in the freqlist object, only those used in printing. +Both options are applied in the following example. + +```{r labelTranslations, results = 'asis'} + +withnames <- freqlist(tab.ex, labelTranslations = c("Treatment Arm","Gender","LASA QOL"), digits = 0) + +summary(withnames) + +``` + +\newpage + +# Additional examples + +## Including combinations with frequencies of zero + +The sparse argument takes a single logical value as input. The default option is FALSE. If set to TRUE, the sparse option will include combinations with frequencies of zero in the list of results. As our initial table did not have any such levels, we create a second table to use in our example. + +```{r sparse, results = 'asis'} +# we create a second table example to showcase the sparse argument +tab.sparse <- table(mockstudy[, c("race","sex","arm")]) + +nobysparse <- freqlist(tab.sparse, sparse = TRUE, digits=1) +summary(nobysparse) +``` + +## Options for NA handling + +The various na.options allow you to include or exclude data with missing values for one or more factor levels in the counts and percentages as well as show the missing data but exclude it from the cumulative counts and percentages. The default option is to include all combinations with missing values. + +```{r na.options, results = 'asis'} +summary(freqlist(tab.ex, na.options="include")) +summary(freqlist(tab.ex, na.options="showexclude")) +summary(freqlist(tab.ex, na.options="remove")) +``` + +## Frequency counts and percentages subset by factor levels + +The groupBy argument internally subsets the data by the specified factor prior to calculating cumulative counts and percentages. By default, when used each subset will print in a separate table. Using the `single = TRUE` option when printing will collapse the subsetted result into a single table. + +```{r frequency counts, results='asis'} +withby <- freqlist(tab.ex, groupBy = c("arm","sex")) +summary(withby) + +#using the single = TRUE argument will collapse results into a single table for printing +summary(withby, single = TRUE) + +``` + +## Change labels on the fly + +At this time, the labels can be changed just for the variables (e.g. not the frequency columns). + +```{r changelabs, results = 'asis'} +labels(noby) <- c("Arm", "Sex", "OtherThing") +summary(noby) +``` + +You can also supply `labelTranslations` to `summary`. + +```{r, results = 'asis'} +summary(noby, labelTranslations = c("Hi there", "What up", "Bye")) +``` + +## Using `xtable` to format and print `freqlist` results + +Fair warning: `xtable` has kind of a steep learning curve. These examples are given without explanation for more advanced users. + +```{r xtable setup} +require(xtable) +#turn off xtable header +options(xtable.comment = FALSE) + +#set up custom function for xtable text +italic <- function(x){ +paste0('{\\emph{ ', x, '}}') +} + +``` + +```{r printxtable, results='asis'} +xftbl <- xtable(noby[["freqlist"]], + caption = "xtable formatted output of freqlist data frame", align="|r|r|r|r|c|c|c|r|") + +# change the column names +names(xftbl)[1:3] <- c("Arm", "Gender", "LASA QOL") + +print(xftbl, sanitize.colnames.function = italic, include.rownames = FALSE) +``` + +\newpage + +# Appendix: Notes regarding table options in R + +## NAs + +There are several widely used options for basic tables in R. The `table` function in base R is probably the most common; +by default it excludes NA values. You can change NA handling in `base::table` using the useNA or exclude arguments. + +```{r} +# base table default removes NAs +tab.d1 <- base::table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA="ifany") +tab.d1 +``` + +`xtabs` is similar to `table`, but uses a formula-based syntax. However, there is not an option for retaining NAs in the +`xtabs` function; instead, NAs must be added to each level of the factor where present using the `addNA` function. + +```{r} +# without specifying addNA +tab.d2 <- xtabs(formula = ~ arm + sex + mdquality.s, data = mockstudy) +tab.d2 + +# now with addNA +tab.d3 <- xtabs(~ arm + sex + addNA(mdquality.s), data = mockstudy) +tab.d3 + +``` + +## Table dimname names (dnn) + +Supplying a data.frame to the `table` function without giving columns individually will create a contingency table +using all variables in the data.frame. + +However, if the columns of a data.frame or matrix are supplied separately (i.e., as vectors), +column names will not be preserved. + +```{r} +# providing variables separately (as vectors) drops column names +tab.d4 <- base::table(mockstudy[, "arm"], mockstudy[, "sex"], mockstudy[, "mdquality.s"]) +tab.d4 +``` + +If desired, you can use the `dnn` argument to pass variable names. + +```{r} +# add the column name labels back using dnn option in base::table +tab.dnn <- base::table(mockstudy[, "arm"], mockstudy[, "sex"], mockstudy[, "mdquality.s"], dnn=c("Amy", "Susan", "George")) +tab.dnn +``` + +If using `freqlist`, you can provide the labels directly to `freqlist` or to `summary` using `labelTranslations`. diff --git a/inst/doc/freqlist.pdf b/inst/doc/freqlist.pdf new file mode 100644 index 0000000000000000000000000000000000000000..306cb93438481caf946862d3dc2001ebd85e7130 GIT binary patch literal 258253 zcmbrG1z6Ns*T89MkVa|{M4A~GVkkknLAtx7I|QUbI;0y(5h>}EmJVs@20=7(4z}9fI46wK8~ODDVZ4qOze&AEX^Gpzr7grHGZ#@ z^Y1EUzga0O@MonD^&QL&0X9yKwoZ-!CkJzDQ-Fh$m6g7|+i!KVg8r^9Wx0>a;St;9Znw79Nv~;?D zGea9I19NNrZ!I_gT+AKKt~KOjY;9-`eH9xMfV;81&2J5|{jKUDe`xSG)yvs_Z{b_t z$O;0WJ!fQjvwPV7R{bF0&6>f#>0cCTP~XIL0~kWJ1=S3+>KpoUfLenA)OrC1ZU7T~ zLq}-)md4J;mcMr*_;0NP1o}hMznO>7Hv=#RSn3-<>jT(W1025@xaIGL2mV{7gZ?mt z!M|x;`Pz_O9k0#G(dL^?S?N1|f46U@_4_!oH+FEcbiDC8e`^zf2u%$#*eqe(2EL8t~{hi(vm-ivaz>8?gUo60(B73(fxb>i@&= z=lD(iO4mJPWN!6s?EM&kTC_&i)>?GG$;j~^G_1+-?cE;%04$>BjsWc&zLfKaA^^O+ zs4UXP)~3*L0fD-a??0%}=PezL?V;r?^&O3cjSX##j8UPU*ul}>Slq$d4sZ`01|IKi}!P?C==9A-qLL_e4FmYDhJXEO?C++>tCTc6gB^ASl6i45vk zGqUK71AqU0OS^-wzFWb!U*W|L8{mUPLA~YT=HbsqhO@)?vpXuE;mQ(eIIZQqKBIiq znHNmwi!XvNt-)iyG#JV`$U+oJ+o2(8Qi~emWBQPNTpBT5IToHoVrX^pdEU0B3!5Zf zoMCUjiWE1ua^%_aRwH{y_z_i^RZ{^hF5ra%Szm z5QVkLZDeJYHvGx^u!?5MrzAEuh64g0tc;tu`FtLj(7|(;WSa_(VTK9^<2jg6>`E`v z&9A3eS?#=o&>vEM!XT1=3)l6GdPR=JfBb2INf454E9vZTmp{E=gT>k`#fMaZS7wx7 z(yW$eYZY^Na>5J+->>WuqecpeiKFE|E7kTbAwDxe6(h0h2T>Vtukml?+fI)zGkz+9 zvoS#{Aat#x}^?q(G!VL};xK-^q7VRT=nOGa?nyQ0iglT7vSXZ?= z;tzRYg4o=ygQe1qf%z)Z>MBBG9Bw;qNjyQNm)O#y8ExQ|{0SL_$i;n_f$Z6KMj@$g z4HcD7F3l=!m1!s>n3+5MX35#Ci*K|~D{S)o-qW&PDhcN0aDHrKo*Hzsspb(qYzllg zR#=VYFQLvO#g=>JL;X30#XWVIwkIO_>Tckqp9lLikyXeOn=f!fR)+4#Ua%}DC@^GI zd_y}B7`~{Z<&iiB9^Fnxk>j_yZXju$;{M`B|H()5LI;(Cyk0XR#R}U;hT)TwF4_WDLk3v^@<5WJ((}*d3(Xb=j1!} zM6U7=%VsUOWUI5@c~>p(BHHHTX;-$rzvpO@=Cb-h0UfJYn1_%^O(~pW-bW$H2u{JP z1w(PUnnXf1zvV9e(le!y=E^MF#C0)HbLl;%lle<=Ws(`0vyS(wtw*@gIhJ>b%u>x> zU!`0mPAxu24r$yuCBhERjoBk%q6@TNYb?duR}GE*WPt7={|$(KjL{#^bnOA4C~`f} zmE3HN0W9*+D38h_WMl0Jjrb0LYgh0HmF1DKgN+lE0-)b~b5_uAWQ>i>^&i@}0yMvQ zBMvAxaY9(NQK1#sLrVg?KY}tDK$8>13<~_7HZBkV#0q2vLR~Zm zkb{|xgAMwaqLYE+b!SPNTU$V15!%TAi>Nom`Vl?<8?m_9nIX^+$b4CdkjfY`yz zU?_~TL%__epnoOR_Xv1Hsvm*+zme)^XK{d-+1LRfPF7}4s8-mapJ2$p66$-Lydl(& zQ2D}ATw05e5evl0%n9u*FbLXNY*4XS zxtKZF!T(CE@5p{bteYYG`$+z`_6~-yGjoABp*mz|X651putV*gla1qFiS?c0Z;15+ z$Nrn%`eE;2sJ(MR9Th87JT@*c01UNvcCLTdTi@pazl(M4TK?$w{&8>p6bowj5FoU- zAkbdoVg-P?SijlWzv`{;vxOUC{UEjfrMK82%n&Hlvavy(6$AnRa{`$;IRBl~`Z3qI zA=eK`{$Jz*b2399-@1#98S2r&>|D@~f7e?-<{>x4`X7A!Pc5>sGjl>?5gT+ULO@&q zFc_-Mf9d0YOk!@x^*=cIAMO+k0yBeH!2mWOJ2MCjwJuh6W+3=qs_|Dhe;qCVN2>=y z{l@k0{QQpz(T(o<9~}J;HL`I*n4u`a3Sxr>A*dFC&@2+?zZ#05 zU;RAiP0u9^_&Hf(QB&9W#v+_x@b&PwcCxg*$sJrjre@beS1{GivDrMLY0Zbdx(T*B2xfZONfusje1_@FBcqI2 z9g`|QJtlh`7_n)zlhdE2+czAQ>b4e_q@@vc1?XSz$SyVOdf6Q2+5R{=EzFY?j zH+fh_^qDQRukO=0ACqP1OIjJ+-7}9br!wdMOuh?+N~~l-8<$RYmu;>w-A3R>*Q-OX zLxVy!)L0)FEGLt7Pd0$^i+T&GFQ2W-G;n$>>Ti+wi{+=jV-zjRAKc?0WQ?|}Dba~_ zh$9_C;|zgM4v3fD0OL8hec2s7hu?B|`zS8pe0spKs+>r%N~|dCUT>`J;bDxl3Gu@0 z)K)eOy-jGX)w`3ox0&4a6gayZIf~q#QTmj;G^67$?PM{Z$TMdeaTq1e(aZ3w#Apv- ze3uyW9EEN9D`wIgL?q&hCi}1^u(sVc?O@51Bc;%JSrkd{=aN}mrYjN^Z{Do*yoo0m z%Xz(15-&4blBJ@-k={;E?D^65vGs(I{q$G^2ItP;Gc`XOMY3s^3i`S=fdC_jl)h)F zjg`qjFbNROsoo5|>4Uw|t0c)dEE69SAxqjIEf(A;;Io{y9K2otO5objl+yOdJK0!D zgJQm@hnYY-bv!gBE;3Wp{CAq?ETC8(Xc3@3`dRwe*h4 z>njghPruHXrx14%-$$qMYkVG?S)`11Bb!AduX!;+b9Tk!{FD+I=sW^03gKfHzv|(^4MCMhcmJS(ytR|fvR|PFK`>AveyZ1z zq2f+zmvu9ZSZ2=;=wwt(D|ez;+0?kds#I;@BM*$4AykAUyk5{Xr=67GA9 z-dYrr*TYI_G(7ZQkzH_)4;`{qb?xZ6yt1;{H~SjDc~_sCFi84J@wA-HH}-v1EV7S7 zj6A|wKkmB9QXSz_WLiydUN$^)6!KV!>&FCgoX-Twrf};O!H1-N^18J%Jpym}l)a_& zaEPm$w42G?2dE_|kw6fw7cI@pBS~-l(1n{tWXrZ1xZaNX3%B0xV~+veS1ikd9KVTr z#E`?rfg=STk*jGSI~mk(3QsjouFEfB3FFslY+b=1}^p6#j?>!I7|Mc zoNq^Sn1>fV9-iYg%Lb@v;Ry!^l|8#P#Li57W#>EJm0MfBS|;`G)4S#g44E{hVi#aU zvsw);g`z(>!@elz82O9*_SE#J$>~?OHrbXuQ@zfRmi(|d7ovz zv+v|rJ@MW&by<^W5h`U_o+;l(TBwerpF!(w_Rp0p4 z0^dhX@FC>_<7dxAx6PQ-^kR-8k3fbhlra-NUQ`#ib20~I{3ms>(i|}kk+{2WH;z*k zUc^r;mZW|D^w^aWb44yM*LmNL-6gy;TDGtM;LTZvV?CD3(m`Nx$#%T#Qdd{*+8p@l zk*(Z`khqmBnJ&S@b8l*XDtxAhL(_Zt=Jh}%tSCIlY$ySF)BrEJ?g)8!< zXdU9m@-z#1EkFTA@qFdAXS6@lIyQiV^x{u6hV!^I~Ct`eSs2!+R_sHqJ zTwCi+ZT6(I#G0r!pRVZD*%S}*j53}tR+X=#l*b+bQcpz>X8p5K)BM=_(|mAbFu8o5 z=zKLmr9e0P&@^!ufh}5&Kgo-avVo;DQ!##>1iixZtSs8P@M%?~-bGm!$+9RnP)-K` zTSUD3yaZreRLmE%CL1xI{z(?6HqL$i6K_riR*_ob*hQ?j&OW5!aQ$&|g|vx03b7Wp zeONI%K%oAVjGSNO`Jb~$kUvjbe#s(T)4?CINRaE~&Ogl}{SJ$eo6HY|rR%n#tn)Wm zb`vrGq7)Fw49#5p39&%Gz}zp5aR8xn8StOU?E2mQOlGV%2<&&d`XhlsXKs-1sjWZK z7<8Qh@}1cJ8I9e{2K=NkE-3b0|NMOdzh7-ec10B1bDe<^hfWAVW}d|i*PO~&g(P|w zA(|Ga*UuCf_M+B%$7l7EqUT|l%%Jg+s&w# zVYclxIa8}vd1iUYqKSnc4`}M|Xvv1W*zVPp4Qi+eQ!q;O7W$Aq^U^gj-f3CY8S6Qm zMCWo($Hs<#^xOFkE=C$wwr+9y9SvV#KpYp90Gxy@Yav~BpHV^uCShX}-A5pv-R#Wp zy(*MYU_g#hV{z|k4IQDwg4E|s`ebAFk{v9z?zS9uB=P~G2X@1Y6yb&2-~Xw#J*~u z>O=>hu8ld93gVSV$Jq<;H&4MKM>F9gH9It$Cr5^urwJGeNRJYgb-y-aTXUpspB}+A z!0y0FM?LU4CCi|F+bE;`5RXoDq;{0jH+mQ(3=vHAL-f5%6I`9?kCrEiX@8FGSC=|3 zgZ98Fma~>(R^{~79$F`MKL`1NJ*HIK+~#|%B`H_MzOF$pvDnBw5dk;)6bUtVVZC`* zNPo%_O*S5u)TAoG=Q0^oJ|Y&=FTC{y9&e};>WeJny7l5DB5t$UK~Uilw344TO>Z^#lfyoHuoDH?4#_|?rW)` z^4qI;bK6>siURc=&_CvW=@U0lTPjSdaqxQpIHDH8FxsupfVF$XC~s0Y2op-WWT<1QnXS=Hw#5q&)3(k7G1K~ zExbYi9oohN^hf;CHRWpS%RNIqSrbU$P#Hb~y1jvQar0*r!;M)!Fnw`+4}C1AIX>0< zdrTT?`dN8CYy#gK@Vyh{l8!&0LFVHmUlfel83rKJtUz{k&iwkRE0eehzMKZtKX-RJ zM81@x#6;|Vs)6P0kL^GTPL<@3C!1jRKEAw;7jgQW{2nCZ%@pYrP{MFP?JlSCOkCM&N})q2b!MGRmFJ@ly|u~AC~sz8y|*k zu~3KmfHtEsw)q=8KYwJVz@lWyBo{|+h0z`mGSQA^%PwhKq~S%udW)M*ea09F#Asn0 z8EM4|+hCsTK(D(ihj~WWKmj3tm`soVwv8d84L#rIKH*~A(p$X#*06Zj2O%m-UJe)P zxF`KtaZlc2RUsMdSrP9q;sWGbX{G6M#^#z(YA%n{H*iGOaWN=T_03dL@$P2#F0@PO zN`sK}AK4Da@0@%^xS3v@l+m zT!k|GGx+0gb5OqS;dZi*dwKtA`)qo+BHg~B+bqHPw#}?mRJ~H`bmd*LkwF69L`7h` zeox3gY(_y{M|(r=E}`>x10 zY@HX`pQQjrb{}rmhjpsieP-5r5IHU%E{r3Fm_FNS;}BIwAe#8a#1LxHSZne3G zc4NuZh5}}OZ={jZrSDpe*WyPsz5+PX)D7t6NRQmDq>$a_nGS@T0K;r5(-K)Zu^{HS zz}ynxVT=&uQ?YbpPR zXKrMU{*Y1nEsMk=$_`x~0$yVuG&S`*&_I9x4SN0&+<<^L8Sp3FutT$(|B!BW)TAP3 zMA4hhRgs^>__(ru67wd-$;8yikx98@<^#S}!Zh=cv3K~zyUX(!HY&GVt~p1}AifoY z!O#^k`xByJqm-eQG5^l1gwS`R5Kfd>Ve$Uh4jK?IC=7>Qx?Ju4r;&tSZe1DE)`B;d zDTXutcAD!!J4Y8w3Hc6?Ow(2zNl5AOijyW@?-os}5w~5t`Rfb8CAndLAA#(9Qg2rM z(GnO@0a_o+yXWR;Lhxj9n8%`)QiMTS!4)Rr>PG#qQwM5fCPtI8d1s%GAujfTmPA`Q zmA}|!O!OOXl7<;})@a4QqZ5LrSIUE)=neF`j`^MNk~DT6n{48{kDJuHqr z`*T|cn=H34AAODW=4R1qsvZkB(>G2&-M?RSXD@o8C#3@mNS?>|nbK$5_#{Z`L|^-E zf4-2~>6_k0_j;f<(?y+h$wgY|2lsmwPLusuRBkZ&%*X1JA~OpHNc*+TD9iLbuVCd> z5D8G#y{GS=1MiY;6foZA)wnDv#BZ^@K%n&(kEBHBu-nRQxf-Bi_`(&tdB?9Kr>LqM zZe{w(y)0pcl)gkt*Nq6-zdg$Jt@BEUjH2 zLv+|xk<~$EadpYA#OG0i1G|x0d7hd#dtIcr^|qBkZ=K8$QmauE5jct%r=%}ySUO(| zV+U^A%Cr;BA z^++oy#-f_=r*~(cB)`(fEqQH6bGi~q;4N`NDiZ5?a6fT`fxC|^I>~-I<7gv68I&fm z?W$p#u^0pC*6uhntpBjyj|aDA^4M4s5Dt_z=kDtEE5DtOE#vUvL9w39Dc?%EGWwg* zsePn7+pp?+eDt|UiWt%wBkMYS9Gv8jJ1Ve=9t`TX39!Xp*0mqCC+X3p4ZI=XSjGI3 z%HahF7^B0JgB8j(BRWGDVe-N6ChI%zJPcyZOtPgj#c>s1q4asAW(4QTXq(k7B1DOb zV%EJ-O(_2WY>UkYZ+I7#mOt;st*P7hM#ek(B1#G31GBeWH_j&7VBPI^} zw;^-6oF|7a?<#|lwNbv>|mowg0GM=H1KPQ=y);=tV1nxs5G>W3b%>WhTje$ zknL>Zzj0e5=MP_dUpRIo+}6M)*8_25J0 zne;o2rT)g;=M6m(GKnRJR&(#O9J*?4v;%6F5#PcxzpxKpu;@RtTCq(OSR}(qp92L0 zjwXRMUy2_S&~zDVpU)9>_P?f|*@@7ji!o=+uU{?W7d&1MDUZ;oa;h>vZi`614`=_X zWrEeWd)wj6*KjclPcwDwU_;-l@UHX2NrM1~$QQ$S?^~p1_&P-u_3RbC>W8nznyuD@ zs6UzXJeZ5vuSAbshj)99TuQ#eaN@K6dYx4bVpkiIp=|r%DfeE*UQf*(Af{`xn2-l+ ze`#YI7W@$QK+WBdE|v#qefj)%Jed~d6?2|n+@f@)vRWt`_v;Ec3E1HHQc)X5g1M^g zl|hhdfhjX$X#KXJYE!%bxR0S)ZXOwB)qhFqmu>kmNeozM7;g%6L=S)z^MjNogKaa>bc>;x@pEnvCF zx%JLJv2l-oxwCy&yhF@xt^Y||mNywu=_iy|+lIbx;DiDnp_#My4x^#P;5*qrxn(I9 zG=VO>>+l5}G%l@v&yg8L^&`z`oX0GUD#@EZG@D%GnF|tPSD%e3=PqlvjVWk!$hYH}@KRq4ZdxouC~j1STB_}7AKW^^gQlFM zB;%D5gt-y~+9)GhAp~Rq48KikWzImsRVps5{c690+Os}-i6cj~*ztKqw3%o;$YAIY zBS6WsK9lII++BUo?$t{~=tf5GMM~MT5{~J{l3If2;EkTub^QFSmpxu;2mGV-#aZVZ z>xK0|=uEc>%}GmthAGp!{&(-&l3Nxr+Q7^Z&Dv`SU=<^{nJ4&a<&Y{^`gpR*`U+ z;lOL!R@L*!Hep0Kk1@v@kX|*X2`3Q?8mNH`;Z(lCqf>mI_Vt|C5?tu|Y*q&u+qL(& z>39#uS0y;}@b5<_ zePy;L!X7A*QW8>HHu;KUhre%|Cd}b}`9P6!z88-QV{eL#m$qml{XBt!Rnn1jKaHA; zyRONndFjH31ezVsg~UPn-su2T@iH7dx;Ef4L4OsDYZcO{)*fa|%6k7+DPmurk(HYH z;nP{&XoS|%TM5SRk4G}cEZ6iGof(zm6M||oR6~JD6K`!56NWWXfMBvGyCph-cI!)h zA)tQVXz3?+8<~3nU$Vl_hITQToTY0fpFvP{aQnhGZVjrdtW7Kkn~Fe4NLr#*&sl9a zomLxQs>vv)ap4$JJcs()fG(89hcp@0BDmDnX^tS9?USd~uaDnpD-=&Vsm*bhwecr6 zMwGdiEv-c*=rX9;X(@fKcreg#w%_#K~Uj#(uNKYXbS0zQ6(QqPW6`N=lA+AWcZ z1p5iXcsZSQ4+hMPn68uF0tMjwJ)&HBoqbF5JrS{n^{g%*`9ur;1@FTJbkU~;T5%8A z&-RSJyvC&S!98(tijxkKrX<9BwD{$h-3($|2>b>t*P9Bv(vP*;xX!#ZUq0|fv~vBBe)z8wFQ zjO(e0xYEO3HZW!C1N<<5k}QfIIYrEa`xSZJnr4w!Fka)9a!5@AYe$GkjnT1(*&2BL zS9%+5Q|lElA4fZaC_W079w8E^04d9SI9vQ5S>~dK<<=i&y}2FP?Fqo2+t6Djr*%V~ zmZRe7x$u8GY=|z(^%k7@fud@r;q;3Vv28%y)`Xx7!4tj9-c1THndH5A)alUi#D^Dx z6SZd#hu}Eo{mQHE%(@LTEg?-l+QnoTHr)_x3PqoXyi0s^nSD&@Kf|kJ>fSGKKM<8n zj+TlVO_|{7!(1-dg6B0H7zEZ!pT3p`;16rs6)(wMaiEsqexiOyZo>sfktgt$%qo%? zd%PhKR)6tBZ%fP64EFFR#b9xq+=>VGSII_NLhoc2KxV8ag59m@DKI{F4S{EAwl;P2 zk5~yj-$)BiX>Wv~9v|3G`}*BMbgHI?@LCoeAa%=sURDPW@+cQSNpH;CPsV*)b|;-9 zBgSC6Ei<)%8NDZlJ$5N`?vACpO|j`mT2$0a-*Ny-$TRswFIHsHSQ<9?>U24Zc0UAJ z!^e5Mh_3tkTaqiSo|nEyv=Zb!c%M8ZcmRDid>IT>FPaGMuJ(wQW^F&XlPB{s@csn7 z`Afp}msI_<_Rkp#GkW6?)02u+C37V7_mD+L@3+Z=Hy!NmI-7`$sdvS$T5g+uA3)SeD>{1=ziYiGhQj_{29N6T8tD^1 zHAYWn^;c9{M9z-ouRK{*kEu~-c!pbXrMs7Ro}<<9`+L0$XLZfMJfpu)DrGj{t1qeU zU4T?gt9OD4@A}H?FGADL6LHu6`L9FMwG01aXafDW*!yde3UuB6-(xT9O*;QZufLT0 zhP`ai?NGmFw?Lp@vG z@3F+}EKOT<7|(>gT)yru?_1(%i&49KKHNJ!Tv<8t-3$)#N9)Lb$2-C}@|@a#+l)1o zztfaTc6sWR8ex&KN<^ntFV|H%lXY(cxo7g%wTaPo@y+pAvp(r;jL*F+38VIG4Dl0Q ztB#eWt{I`mCa@MZjSSQJvmajkqx&^y!5O&pHcU`0B3;8sO9Jh(M(eaCe9W$5i(F#nUoOWys! zUP#@bkR!uYs#bVn#DmmkVYV8Whop$+ncgCjd+or*<9W-J-f@VkfUCN@#o|HilZt-K zy`g?gn{xP1ARekahQ2LpIPD<8fk%vu#-4tq#tJ2%z}jjhH;kP3@r?RQ6)=^sEA-yp zOQef?#%Z2`ocCJ$Ly~5=b}WubY7=&lFu7CbIvnb)K(iYZy#SuH6~4~a$agC zJ$1N4yPYs+yWTWi7M!n~UJQ@)dLX}OwJ(yg3CFa~$j4l9*>Mmls9)JDkcZcr=hQ*gVI382s|U%5e{RvgipdC^b4xxloxRT2R|hi{srSV@R7rYYtt@QxJHurVVX$#B=*CS9CV4oh(#uE9&!|J8xtYefzTF2+ z?XFl6f}8D$G=ZDUSFHLC+nzQddY7T}DQhh58+x8@F#f&0q1;!O6q!b2OR%UPgT2Zr zUW-g z?V0VR+T522BNZ*eZFer5rGhF7=(26a8-OG2epfm9G!)diKj02%wYkM_ecHW-$b zd#zjVKAt{u)!+Ss);q9wStE@HR?s}hwWT62dqA^bUYeG!Iwa2AW$G-(sJ#CvsWDlP z{Mn$+DdytAQuxl@d(V;(LKUVlgi%M$vjuCS%sB0>u+0Q$rxOM`80MX{Cc~RN9rQ`k zs-3?k9CjGeV5=u0sZ+Ab)qG++Pb|58c+lgcAuh1Y8qk(WnjE4`a$f`-jjW4`2*2N3 z%w_fEAYi%0c$1OKoGX*^5!qeDxVu&D;6jK=gQ+b!KQ7h5htD|l9QsN+;-85Vj}F?^x+u#sDDJ4XUoEhP-cX{ocMTXgJAl$ z?_R6T-7)w{dtE^oeoS~QRGko*0dx2PlD#9kI~pov7>q+LwL+ubNX1V{il?$dbjvXu z3uKAmxDSGQkn<5x`BF`Nn`)|>YLqL=8}ujz`5xqA?u-qWKV)LiVqFp8aZ__NGsDXc z#S47G)|Ms^*6xZyg*j{=vBD*fkNN==(6-s07e(ySV%(kApVc*i;B?}z5=gACgl4bmID(WCZOJH! z>4=q{O{wc%c8>>K#iCD7j8?D~H5+wHy&&TD&|l_wbSD3CO#YS80U5Nm%hq?MPa(7I-Iykjqwy_a}MtW<&0$nHaGjP_~ho4^gr;)_3ZZM z${Pq8nXhNle{+ltbbWgM(T$zXAm|S3->1OWpz+UE-&lXml0nbf+?;d&CqQBQWfv0Y z*K*Lj!?y!rf8vv$w*>rL?)$YMI|rB<2<5at6};}7|358v6KsB8zq`3@{N@Ixe+D_w z^A5jv>`%yHhwkgY{`vb|OFOE))-$4bv)c?v>IwqvX~!=F2 zhLFUFM8VI>8qh!CudvNji&DZIe3bmSNKYrW`PNemFJdgOhJ`@at#F_b@Alio{M09` z=`mOxFH@D;qS<>0tUfz&;iSLI)?x~zT5X_Z4wS_&+B&ptM>Om(s_@3Itz`Av%n(`( zdCXoI&!v9+Y1hVsw3+-XH@^`@tP)AJO~%14`Z)sbb1Av7py6&aUHNK_=T33&-A_kt zsdE{<>Rs7L&GXdX4m~zRd(A6Ukw!<i&QJbsC z3hZ&)ydO)DCvqam9;Acsq83BW=Hr@4-0(le0lf`eKwk`%sCd@#z7u25Ce_2Y4@No) zce|fp`{1P{c`M+C{d3hjMV|Fk(*SMfQYi{5^2W-B)=t%ivD3gwDP z6|KN+n0q!`_I#0R`Jd-97s8mtxWrA<%PFVmD$-_i;Y6$OPz4H~gC5~4mgXhLrMQ!2 zC|3C&9&$ubGVHlcZI%GTm$q_Hrga7qjAd=q`spaE8?&n(`37$J^;N;4T0Pa$jy|uN zYjj^JOq1l~=aRO#WsHYPHW3%_vOK~TV}f5@*$64_LY&MY-#3(CJRqpq!^{+M4#Op= zToXSM#2#Yr(OUFkmXTm}i{p%uvh8-YlklC#r5vs2S1tDvNIf*Zrd!GctPmrosPNfL zbWtpiR8h(H?y6Tc=)2Xi_skeUU;^NzXUXhb&GZS2A6-}aZit~4WcC&9ZV??3`N+@ z)- zDNS3R#SATEk#)C=wt}@{heq}9?FTB!2{58#XFjwI2uA|pr9SV*;o4Ycl>@fi!n}?3 zae5lY_an?J84YB5OMa|!ZLSC0-63D-RKfj(S_n!l_EQ|9+Fd%lk6kIodaCSpV;+YX zk1;x_v+L7Mh{?eBj-D<=Zs^6u!I->QJ{^7?`iYgFgg9fHNVl{y)Xb*pBlY8XNUU)< zy?4M3%5ZsyWjw}kFR+ub4Su6 z3SE-!v+b1I;lzSl)e6L2-gC9F!Ffzk^C^8YDk^{wsW>Fq*(kd9e~PEwuwX-5A3@Lu z5ccq*jlQpgzdc($J@u*rPdf>vr}>hba_5rKGCu_d#95=TGe#VuD)&B zpZ)#geZF#z#j2&l2Npb$m6a3yGH2pvYke4AO72&@?=cV_4feZ8&-&Xd-MQd>FC#$k zh@$RzaG0A6&Que$$AbrMEvVgqKi~mZ8NUUROlE z`rIKnwiy|mQ&&eK=HQ)=n9I9umYm1@Laj6^BgZ@vW##lM`nvh@ock>tMtWRa0B#o)bHWuuesqmBKe)aFUf%Vrs!?gf^pV(l#85Y0s#xLc*Ez3c-)BGul|A{w#DaQ^yg9(9t_veB) zf$A?BWaWe&l7t5RKNq~2g84lma+4KqCP#ixg52bWf5r-bfTEwQzzNOV{6kjgSD&#a z;l%blR%JYR19vyRjVE-C5_Tz5aOO=RJf8SLY5YW$cihfKO#9RMwv-%Yqj&Z(d068E z2dt^YoYQ4q}P<-!Cb+o0SNBS-z6An0-ekVy+_E z@bk*Yw(QN$L!Z*mJ1vFD{YXMMsS{oB_qWZ@DVrk*VwZ=SA47sp)&*+n(jumd0DY>4 zoIG7yv;+Cxr1QWwoyx~Ovq`ENxjSnG>1-o1B7fU`BDo7-QT#J-& zNOY4V({XV`AL&QTiu0_TE^Xm^^$qZ*1G?mr-dnt#M80D@A>emHRG3H|_rQ960k z3f*HkjLzCB1l&jD*uMV>CLVl3-fQ!!I4MdAFTn48xapxb1A~F=yU)4n{d5)&9yC=W zj?H8d)HOYx{M_&1;ThmSK9_N%f_S7)aDe3%<(HkU(R0YxNf3mpF8S6Z z1!L@AJ67&(ps6z>gSt>??zKlPXA`lK+I0<;^C^Zz*%+qdqO#?pZI0iSTlWY(mpv^o zsbN~2OY0O-LJNH}Pz5U_QX~*|bjc{oJVR5gMPpZ~3W}#=)T+IWw91QfX3s3_*vxb>Ne3BsjNQO6J==iUWgSg3Sv!E5+jKj z{+92>BDHC+vFvS?DU*Q;@>CMWBbczu>fFvRc-i2Wcexv~@v0=(f<3h9Ni~Bk=*~YH zR%yObeW9sl;KWy_qlHn*d8qDg^Lil0*6-G;BjH&}C2rq!FdNji))y{V)c zotwF7I_%mBVj?q0Q)CT;p|2}U=BPKpeRZ=N>2GJFX2q6Wv|fH;tYqek3GQ-C74EB( z9aI<%C(vf2(A8cE?4YKNw4zwHiVl%jYox;rmE<>5f~)##-d)OukfD*oeWn$vrDJ)L53$8T;kd4ZDfefV^d8B|2etVjS`s zmD_z^@{%|XIVxWSZcbZvr>Hxp8Bj0F9!qAzS%k-0c7N8!imm6!7?RJ^7x)C^lUN;i zx6L_Nor&y}Io9jTh%Ziu7AM{vXEP;Rd8B#wKzrgt-}F&@G{7Nhjm|eqBayOQ0<+F? z&NB&)I+RdCBBWncNdYT)tQS!0dyDk8dA0gmwBDNG`80^bUi zh+~F1C*RmDenx9F&S&;D%CAh?cP@w{Dy5&(zgH)!JXDO*qA#sVq->EsR(9>MGBotY z^zKW>(bKY5M|qza;*4wYOnS-1T3CT*(PSzZ|6 zP3O_=a~_!xHy6SaXWS`q9AOh60ropmo)B1WS;}Yio?rs$3K;CJmqUW4M8`a^w5SaC zWDvbsqvrWw`qE=Z0os??A735fb)_ET6Mwj6!YMbL3HCV7k9Z{=B-g6>;N#bY232&W z5aLCbyPq!SB;WbV-|~#x&}+R-VplTLn2irdndFoTEu_u5BRF-d*0Fu?-UVurjrFja)}6g zT=VI#=;dY>;;-rDI!69NFFz6?|DImhZZ39QL&5cSgugv`1^RjI-fvk5=vnqZq&-+6 z%%H!>LO?G@`5n*xqCqea!VHAoGV~`3`FTsf8CL7Z&RL<`4XwD@aE=$F2MfS6gK8zKJmicsl)Z}6`{>#yModiMXfQ)vGX zv~JqjPtby1`|yuJOZ7WwO{ik;_M!$84eaT>!Lq)M2+hhkDP?-c-cr|@p;vj7EromK z86@>+MDk#|JRHC>t^U}}nc3776S3aJw{bVv@!|t)9V!yKyd5}1eeVOZ(F=+7uP^ix zj@C(NYCgw%7E+`E&8bxh-o2hYAJ9$HMM_KX1ok=D43)keLy~sIT$oyjNh54K&6!ag zFf5~Oc7C#fND$jQSftOc<2+1It(}kBwDAQdfc8xLeyH0iWHv%2*6ZYHg}umHhPI;! zgd%QKkCAh5_j2EEFYoZNEv*)1Er&Iy*6J)(D?2%ah`4R%YH~+{jt)CyXLiQRc18Q- z)Rd>yp7mAF8$cbOVGcvoE?Va7Tq4{%`H`endl@X+Vi7PMHBzgchCUz6?xsd_A_q}a z6U--MAz~?_bVfpff*4qN1iUU3-j-mR7K;4YbPj(#06bST40bT8(Jf8^WajqST6Uz` z@dF}yDsxxZFH(F~4?=7E8KI<0Ub503oE>-a2;V`-7!_%U| z%Fm^i8Q$8dr+c6I(m7tuY=ZHtXTnoq(v%v)uy#J<@efpNQJr+w3bTTIrfd%Wl6`jF zh%{ReIc1w%@|Wn|%&_tT8gpWeL=Db9ch`u zSIC_nP7Ux?cJZBtedr~BBw1;GZ@#Tfq$@no^UG8tc>(5;fI-wth?&KUwaj%V2K2Gx zT06IQjm9!VZ)Kuf`Ey!XcaIMzw)w?(NsXGqkaiF^{h5@9lW0!MxP(T9=yJf6k(Y$x`mdo-zUEq8ZX2&n@Ne-^`^fry=+E z&&J}Sn+eBneKMu$%wWN@5jtkXnmW%RZyq!=EtobM6}f+kbrj%1%wofAt=rCrwdb8i zLEAcP4w-*$^~B}~C5BB-e^Ib7n>t{r@325e1ZNuMl&nYx(Q)jA_oXTd^|N@<8S~xG z7u7~Yr4o7or;hNJ&xN%w=KGwD6%8Z4G#(J>Gu?jPcQG3yR@#Es)LO$jO?6$Q8O#x_@~5n{jQo#N5s4>AVw%xfrR zz~Zg6DA;@F6W~)g0xX!ehSx!dlZTUJB7BVPQU24Hs&!A%OK(NO?uZT9xL|U9AyJ0Z zaClC6gXcq=q&*3J&+sodk^hj18vyVjZuimE0iFHgoWZ zy9Ng1>)FOIw5!(yy=I6akmF>i<9_i1)FoAFM8Z&f9TMc;5DD7_t3)_@cG-k$jXYy=13h+7Q(UW_^(=jI z^!44QhkbdGwJxcTeE!Oc=jmr+`MKM(>wY9SJNKD<&o`956kNDHMv>zWc;&X|xZ3Py ztk~sFU!P}U3{FU_Z!mL}$e6#<5JGAC3wZcLZ2b@La2@;puw-(5OYMJ^`uKTY?QbFZ zT7bV#eSm)6PWzt;naol*BY*a49F(qO}F=@xUy!>RhwklG8B?Ne2&@ytk472wR8GFH3()<~$ z82hpjFGYiAS2u$0r7#iuK-A#kDCD+=f*$G&+kwg6%)+VJ-U=Mp?!EczcN_M%I!O_2 zjlh&Pp{D&FYLZND`+1kFjJ4774bxf^{TuFeHFx4$h#8mzRq$jkKo_Jo>yuQ+?#yMU z+fg&w)}5bQIXUWWuyh+pF2E;V@4I49UcTWoqDyPMCAGta$b{3I-}VSu;j8OD4#^$q zeFyfUXl7)UQvE_ETtt_X0dw3tkJPkboZwO<%O=~qQGilqLC?LlPtZ@iv0H__|Bt=5 zj_Paa(u8pf5|6?hXNhy9S5gPH=Yu!QFy;aF+ykcTaHn4v_TCJMZo3JN?aC z^G~xD^{Z30clp_SSDmVQ-oS4&l7yj6_=xt=er5>&Oc?;uUJug3gB{lgP52f>PaZAB zCc1ldjxB_qG*=wQ7ul|0)9Y=Idsf%8C9H8n%aFHma;f1XnP*;xmLP0iqH%)E-#12T zGt#-f{{UsxPwNVB?SSaVfv8dJJT|cUNFU{k*&O(;sUv{$-R0S*AhYn#pHt=P*b-?( zXkLupKu8sfQwaAJDmPKGVA5MtX6!27YWzKL&pi+w;^)E8MCpzFj-$-P0tD zg8rM7#S^RG0;H{DWfT)d zSgJ~OxM0w(PPH3373K(J`Rf{TvH=nW213GF^iK!A(xhZOii~`yw3bXl`@F(s@rZUK zTcPH&ou9!U!ghMHZa4fA(O(yXl|~)L3oo6=fxv-h<@b{I*$ls^{L~iJ=6-M_gZF*A z&C2I!Z134HBa2{SR87SU5q=La8MJk{?|P|4v$)73t=7y9byBUU@$>tet-BKDQ%Waj z-`8Mt0XPd6FOdDvp|9VdKraS0JiFsZeX+6k0|K!#6F-Mh*J^P`B-Q!o=PGj<*g)p1 zl0vCBb0y87bEnC({DdM$_jnaVC~qC9zeX|0BL|UJoriZ<6L}4RhjI3Wbl!Xw`;a|c zwdg8PQr>$M^YQYeX;x`w>eC{`={5c37Mtu`Ko!qUrVJ^qHKu;wyiVr()gz;Xr3IZ- z!^}}Q^;|35kvXTpfGOhxAC75ZYAvy=-EL;1u`l1Ht448U=hq#oL;12C>O&7Cj?+Tf zMulhJVK%$=r-l=D(xjMqi2VKc7z>Q zU!oy8d_*S_VyrKjw0BkV$loYbOC2dBv)7VZ^%VNdGOs~jlgy*fT8Pos+*Ok&sqq?- zwu-wpU??6L6_w?ZMe$w3dtNaNLrwPG`);XDP$kJT4aFPW<(8&=jz;G^jRgFfZ#m7o zX)8L8cYJYE>^7|dGV(dF5{(JW(UNoh2CT5-n^MkjE+`(w1;+t91@13B_WL}-WsGpG z4SW6|HiCf`Exq^_h!YT_W0K|iN|Z=|9fV|pVQz6CI47} ze_~erIjQ{{Miyp9Iu6!<-x={Q75p1MM&QC(4&Zyuzv=4VSKH-R;KH;Fa~{|75UI$2PG&K6VH6A*$gz9Z)mf!v%su3xk`BNpnW4}{`h2N=T>HXNb}9-aN~2Y ziJ=bX#adg~I>Lg=W1ihiH|L#qx%9(@-Oe?x=M@QEVY?n5G%V9f#`kvNb|>tJ%te~C zr0@=M=Sw_z4`(w8G85MsU8bvY-zt#kF7i{BIK?$r<9;i-t3Jn4@5g}Uq!&tMl8N3N z56Q$LPB;<7s%+pbyDhXb+b*Ac*8-cpdM|jEI{1mtW7lP8+{K~kV0dpAS!yfn$L)2Y zMgB}HhGZLoqW#`E-upSvADalZuQaW~>V%y)?51AW(%LSJgw*XjymOO@sI9?s~&8hRm^lIzHffb6hyi?c&I#17<$dB0BdT z!N>~HI#1%#=EjHrJ)c^!VU3&E2Q}WNB6;Us_HFf%TL*46sj;hGS2pdHg-|YbL=357 z%#hMgVV2AI{dbFBZfkB<(M>qTSN9D$libs2__D`N>a-I0_!M^egNSUp;8SjqV$Q8}%^)YsvE>;to#{EG(a&F!+?po~lP)=z2_qO-1 zblNnJ2i>Ax?3;sDih6@`PBES?0_ZyDx zyxqBb^?vAT1g>>wdLg;0x|+ISd)9d3R`=@2hFh<{dy#wcuH|$!(-7mG3yHo$BmVaBZU8U_?NL5*)nI!X+0Avs9>iC%1}aF9A=ip;!#K=BDWC!PZ( zH_)c>6cnWm!+ECt>|lOs=y~;b`8F|!5iFb%1Z|fE1n5`ZIO3^yw7owBUa~CQLr7gH`AHkBoP-Tp9zM+OQ)tWV>ibgE|2$Eb( zRnG8X9It#QaIZ&MjX?$OWg(3|Exy7$#nOBE5wg67mXzxT# znnVF2I{DYp!K8{V`e|YUQgq7m&w>MkA*S|p$J=$vDhx42Y@sz+WSeN^{FuX>nRC9% zwF14sPm1ske5S?Oe05>zz0evu%_1~lbkj5^P; zfK>FqGpM7!@sq>e@WCb|hUDp0{dyktp2hVwoj25)fC`)T78P-W5U7-8tSm3fiBSzj zUT<*}RYDgWE+|`r($6v@DBE42ZkG8MC4-SwP?SW89YdM39v=6}m3{ zHR@uZ``Jb57fM8+tek3cp?YxdZCD&$i_y;x(?xS^>kJVfm3|;8C!s7+gp<5N0g&ao$cMICt3``-kTUIS}NcTYz zuR*2K4qaP0FhhrOeYk*HQBWx+W!VfGB4S9kX;qz!%fL{GsUp1~KSR!a~Y@qc8Te7J9Gr}5FlB^=>g%QaO?sawvXD)Ah;Be|W;wVGvTqu-CRY6$ zK2&iqDTi3u43?8=Oce71JM=iUy`g8IY`aRjyjh?*lgQhVx8BSflIh11U9(-#v0NW1 z#$q+GI^U@{KpbhDh;y*rlV}@KOOTyG!k`#eRCpJ(NsQ=|Lb9o;{iMHQC4n=quIPY5 z>=r2k24|UkM|d-e5^u(Ay{%^~nj8srKgC(aQx8tPiSbS}{EUw37VhntR8^EWBk@K8 z&U~z*!{vqy0hG;5O_vZYyh(;JsUbf*1YSy!hBL*@0C6OWk3jXO({I)|--(naIP7 zsY={x<3HdZKS;91{nq%wRKZS~BSOY372g0;1tZ+XTg|~eM&U-mHAbO9?7>(3Ax2^D z%+i@mn*8+2M0K}x1TxIoc(=|sg{k?@Qs#Im@*d2-MKbemOm)Dx{mV-HdsF?;)&W{E72c|l3YtVnr$ixI7DFEeU;sh4u0Lp)}yB`bu?>m|Q z$+{Q-IRHRx0GR`Y{NtAFfA-Z3xP<(#QvY5gV+PQl{-F{6fS?4N*8Kpe z3|A;-Z45`(*M>t37wQgqn^^>o|LaI%HUV?PH^1^-Id)U>Z1)!@BjZ9}zJ_*_Ocb&X z)YmlG&!PF~(9%bbx+P@Ft!T(z>;tRoTrW7a;Q8bN&c}8#4S% zP~ciVm@65ZebjUpk|Te#H2=2U|Gm~)jkb{m_-pbH&uv7m@Z{!1ZcW}PZ&)u4ow5v8 z)|4I9ec)d6YUp~U+Z4DH%Nsi-_i9kZel8una908c-(R49v|xg?b*;bkR_}$2?0q0y7C&2M>(cY&Ps)e~4vp11~#@?&; zJSDKtHVrqm!(O4b{*sX3hcsPVM3|sx1l0!z0%`#+uGs3gxfj+s=6q1PJ)S84Y7puZ zRPnVua$f>58tFjv5D#vG+bho{pXVpBz7ZvU4j4X*L-rN4j1VkxE3g+C@P01b3hM6Z zQ0A6ht^Htmd|+m6?6TIiWkHsP)vXC8@ezh{TPz+7&c+zk-geD<`iS4Li};Me6{8X| z*3OAPyuu?8CSfhHv1_iWM9;JRR>y&-ZemEV+~;e4yt6Nf9q&yWFA(1Id}N#FYoi+- z7#%EXBkvtKI?LduN30TVsTJMOPkyL3l%rIs_!aap=hemd2rpASP|>%O(`=?1Irs&^ z&y(d}xk1vJ+~kKTi&c@W8_f_foEkd+L#s$%R*CSMFhRY-OljZZ} zKv-=uyh^5&{pdQ=P{~jTDx{epE2~bf$qpA3)z@|K0Ww&_X>L9ynUl=ZHeo z*;n#5^zR0H8H|lm_WAeFT9;6-YmlRd4dOTP2V$D0vwdSDyA3hV*-a+e;nGCbohi;C z7H^*EC(2D&%a*)&jvG`2>HOKcpF~Po&MTPeRci$S98m`ORz9b?J0W?CaJ}k9gf|jT_FRy~C8UvS3W=dd;bmTP7`Wrq zv|l$~lykS!ENY{LCIvNar_|Aa3sfq7Eb6XcbBtWoSz5HL(esoBDIw>zu8-%KL2{{ycK#_mS_Kz)N}eC-c5=w&0@ZDv*K zH*2hmVl4!C!znTZPEwlQNngSj)OOAsPdgH(Yc?HFHXyH=5Y$UIdT&_63Ivbs-Maik zpa_qb?_M3|UzlxtzK3kP`V>;FYT*`kD=;KAs)*Q#P-e8xP)ZIabcVmd_4V!F>ApX| zVEiY#??Hb5FS_qxaqAx}Q$2$7{mX$NU{|rmwUzFG1@cm~8h90%n zZ>9Hle86@T4qykzziZ1s*YE!NqV(4a)Srs*&po?;-r@Iue(vWH8SHm?e=AEyU@Oc& zRF;GPp)9o@l%;kfOhnpQ#E_yTvk8;E{Z>daIITQlE>V6&jJf93Y-OuA3S~oe!FLmS zqIV4!XI}F%A#*6gbRq*D9tojCxl}}qp;aUL)dZ30;vH%#Xz!VdJSNP=tVc+^26r1-!z-nBSPa3Ju*eQ% zJlKS0mGjoT_ME{mZ;|SIo-#{B8!c_5VtVZ>N*lAhr==#BC zF}i59rDyJ9afzj7YC7G@P*mB)3E+|ZoiTG0%~SExbYTVY8L;5Jj_YTErrR;emg%m6 zJhjc`0<3jUH{ZwMi1Df&4`fE-S~EA*ud~Lat4PlIzfqUFAo& zSXZC)3D-3u)j%o&q~%%>YiFa&5|HwwE^kPCJ#< zg00L3aR%}QWM73%bEoh0HSEPRmVsI;sK8$B`HNYDh;#>Z^R5hkje-4qsPhw)8c&%c zg7)KuQZy^@w6Wk22Erfgq3m~xYSxZtf)h0^uV zjsr4Q7^4=n^oAleOpAZDB}dY{kR%wn*{B)&k)`D3S9FkdkOJXPSqvHX&-$p-j|+Nu z(i@Y6_gZoq1+b`ydD9yU>%D7My#jBI6V6;lJ#o zcm!nqZ)uW8@WkJe@C+<~WuMSA~OBPdH)%?dwEpJ?Wu!Kx;wx_vW7qLjs=l!vglr&!u} z9c-oqgU?0@HQsVa<474;QN$q)_k&>Hnq%0?pS!&$iNS_f@A$@<^Fw7soIcApjp%h= zP{RDts2AEXu!3=rbyDvA67fUmD!pHo((Y<+VwafFB_lXN24mo&tV+G-8al7-hFIls zNaR~p!L*@;*p$@X#C8Up1E486w%Q*_=L+Pgx%2ILx$2L(_{WkWSC;G-XkO!I`N!pd z_sq>meBL(HaBWBDD+)Jh@m58{KUcF)YV60dPVA)D7B^<#{vzGfCjn>-!uHqD?LwNL z0zsMJsIU!A9OhL@r0b-rM{QPR5_#4%F*!adWXoAcFUHa}7AlCI^x1!({lu7rRWhD--@mJ4IYbd3>NU8=1oLI159oI&5y(-NPb8uTnlc zk{<1j5k?$!NXlHl6Dfi%#Ta%fqg=-w<~9mbh`<#AT6a9gO$oYQSOZ*X!?9!!%q_l@ z53=Bp?I%}6b2IoTk2$+k7W>b<(YnIIec8$kQO4NJFsu)61D?yJ9Sq)ags-E+aEuS+ z_6eS#4uQ(9owYiDheDzp=Fvw!gxxd@?8WKOryVRanC8nmrL+!37!)~fIhrj_8qc+y z#cY`E$259Q+|o0q2g5xHIj4!ufX0l4_^rf0V3 zCdw)&Z{vC9QQb6ctIRSD;`=4~q`AJlH?8hRE!vhyU4x=M5yLO$bn3OZej{O~WZ4Y4`ptp5Jx0iHI3iV+h*=oE`u{ z_>c}OaC7%BAM0b;o=Wi)$H+(rKso{wpND_e|9E<$|10e2nVI<^|A$Z}ASG4+t&Sb2 z+f%8Yc>hX)g^3Z!n}y+_WKVpoz~+4b+3y$1?*nMdV^0Ci#||X(N5rr7MmTk#js6J! zwb|}5__6sOn(%-A|F5>eAI<&iMf#uS{(msU{^*8Zg7<&A;U9LxA5Hgbtq5qkN4fXp zaxgzg#wYhdGBP~~9|Gowb(KFtpW+_{({BonM@jbRKJfiZ++&(gDLusf)Bh)qC-*76 zKV238h#QdhkL6P%OADT zBR3l$C^;D)^~*y#PhpR|zfuPzGr;kr9iGyEpacGa9n25S^O!yG$o8lp{;KFN-xDJc z|5waYVk`jEDj=U8k#;jvnb z439q#Bpi>O%+B%9IZu87OdBW$8}q|Z~xODj2Rgpo8sx=$z=!jp95q2vFs0Z z{N;Nr&lAP(5MV4lCi-^J~Es4nXY%1}!r?P~Ru_!OQ@v@UVv;FhL&t ze}+H#IUXzd5XbV!`Q$!v{uRgkA5>2<|9{*E^y!C&eQ?A- z4?8C(Fm8e6+Xq^p2EfY_ zl06b|JYX0<+K&&3KlnL-{fj``K3J6ioH;NKfg7TL5%`!faAOvb@}u|3W#f2g*QZiH z4UC5}{SuImbid*NOzj5)6^H{y+vD$(VF?U-z_5H8jX>K<^3*GjeE&hq z`WVjwfSm)q^vLnlOOI5KaZfGuMEA>OVEAi@{Kjd9Q)dPW#SDm@hu?oHb06p)`G8+` zKvF)~>c4#tagR?-07Nz*U7tD!2z%@%HsEyx-qNQoV||pSk95qyof<%Q0SyCmCGfTY zoR5AEARG{#k2DXdKJh=M{}|8ukncl|PZW!u-(He_Gv-fYiWp4)8t#!w*n4 zKo0>g`lHJU9I6Gx!XF{5Koc<%0C)ipqXS6pm+w*FJkdRcJYdKJS^$8@24L=ii3lKI z{_rya;~hW(|AXd<>sR=r%zFv}j`RZg{o?(Dp5>8-87SX_0DBP2PyR>BKSt8O@3#d? z&&b39NB^{P1#C}XVPj$W{Rm7U?;p-t_itRC6<>V8>Ei9^GD8&NhNl z7H(~+ucxo$E3~YvBKUMNM_C2KN3XpB&_gC=3d<+=38*% z*N7kr>9IknkRbY?BOs>WEaRl(-$BPr`;w@3zDOQ=jnCuY@(L;ZW?I1l_y%kbgu^PiN1tr=TLqZ zedbXs*Tf8dBeg$2{uN9AUIh#!G`6si7@xT^AOJc#J2{vdwP!l2cl3bX{iX5*9SBlH zCGFDfJeD!^O(BCN;>K$u&qDMgEzr9k5b4?$PI@axa1U6xQ z{V5~a;E@Qf;n{jGu4k}v5?|{5@grF4LdQ%S`j+;J_L=3D>B`Oq7{i^!*&RfZ!hJBo zbAp47y&Lj?l@_I;d$Cii9o_Wv*zMWNizKHTtL}w>_Reeks>?%zWG@_zB25j=J9K22 zva)LMJDtOmT%!p@k6tvPSp960an=M4Ud?-^3seC`0WYN1_OFoI>+2vlSdwDUw(ldF zZn@41^2RGtE$Wz(f9)7008a$fM)1@a*S%2u?5>$vq9v<_V0}b9M-POjJjL z*70eCt=&_ZP7h)TWlPVxs>I!Ejg~_M-<1W*m$ z2UJ!C$5fGzXmrku5A0|u-NtK7jIX&33E|T0dmiFmN@QIc?M^ifZ(Vch-EO9UF;v)C z--aK!-3*xHdeYH>lz7yEE}9*^a$S6OA3*D=2B33l2!-8wbgk19i$OC-)K&SAdWJ?n z(_Yy#U-4@_;R82MNddv1INxT4cDZ9E0Wl}C5?Jqioa#Ua$UHL7DRLeh!+ZXeLoVis z`44_~v^oYlpbW|P;1ysAUiY4dCbV}B_dc&Jhweuz!4qijK^L9XZo!-BC$8|1+^X0B z3jMu1(8a`=djz#b=UX4LU2ggj4}$In+MZ>69<{|p&O7kt(+g;c2}e9SkJ1$+uzK+O zu%S!K1Ks^gqyWd95|6?~+lIHC;P*q_m(oMy;6IQ8&M|5q@)*3uKT0j>UX0kEzt-x# z`*5dtmr~`CN=@T|w05s4;Gtu$ViZ9u+dp%23w9R}^f{=ovMLwv8EXHBbJaVZyW8HS z78Kb#x3t@KbxHWO?e?Cwc1Ugg)pggF`NiR9%E}H7i}xq2*OP8XlU_fXZSO+wQwBf? zMo^9Y%NjwLR*}lZOc1G0qiGVT0&><2xQaV4#^SEQs#5sI`8}y48>FDn=-|y^d(x>O zD0_~uE=Zxd(99J4wWpgbzmO?OEhH3v+)KEiyh2VF{TR04sy_zbC#wNRaY&TO8`a-C zNx7WRYkWN>3_pUyi?O-C?>?C;oGgh*t(SjCfCet|VCw5LHZv7?-l{Nr%1=XFDv2qDg69td6Q! z5)n!j9XPNtn)-FZIVtw>p(^r0xEKwTmM?e!@@ueekDE2cHuHsvTVdU-MSw{io(cL} z{_`>Kv5ce44q|2l9g)+w3|KfabCP)hv*?!=!DI0866CQ2rwh(?7Z8c~ntR&4<>Z}2 z(V2S9g_1ig+zD-{uzUKS=Di0XcCX`nig8~&6J#HvA>ZKSH+greda+r67)4si@Kd2o zy3pG9N2|N6c`K#xuF)5bK%1!kD23uHhAj3D85SL|$>OsFo_Q3#(3j*x;3_{Lv~Cnc zG?hYvu1{Uq)N+w|{he`LLs0z0_U+p*{oCjgqv~Pt4DSRwJJf8SiQRwVccpnjWJl{<$B4p|pATXqJVipmru3dBksak`iRilD#u`|`l>xQ=ocPG?w;SiGO56;>f0udjL%C)oyuHjI3!F*b(jg=tk9 zyCOWb#}(q2`G6Ps$DxvU1-Rz=uQbOlMRnFVESXrgHR~B^r^0hRxH{f?8W|LWj4SIC zkjV&6m&YBwIF0)jA=B?~-}_csDU(Fk8}iofF443X%imLEKiSoN{CN9#+uV*86kHVT zvO0cDyC%TaKRa~xuv6Wmyd;&H{`eeiuNi_l)KdEZ>L;=i7|synSG6RC4ahn;)A=7O zdFfSGv3aSVDOu`$zP>G$)qAyDi7R*Q_EIL9R2l=WDxUVfCxCpv<0K&>Y_vjrZcDHe z;tJbDM()y8eiJDw0UXq*0*1W%#kOH!=eW@Df+)83pL=)q$uzL1<%~mROBDcpgLE)%CkiviNS?{ z*1H-l)H2M>6m25%9J=)}F5IfdWBD=ezf2e1kMC?5NsSWEUB$4dN;(~N@D5tXwiD6Y z)2w_W_cuFwwhjLgGS}F+kA;Td#y={9_$`EGXRz`=F`6}>*RM+6U z71CUY&925JT4{|7LuUlr?#ordJGGc)3>54HZw~rt`8@g6u8;3*k&4KgY<&IXDE6ul zz2k{l`g7QtH$_5_;A*s*&@hVJ3E>SBL=hG82+!^C-ZY)C!8;=rbquwuv2BEfFf$*p z1h2btzyEwW%9oNJ&vn*$x)acWGnP{mrRP)Q#>Y1O41SVv@O0RSfy}{!W9y>=YaN4s z*dgSCoA&U&?=cT%z|wg_8BHyjcHh2&KYG_!+leDc30Ndo{f%3hyWu7|pDyi%J%P{H z3fJ(|cPDwG6DI!_8m5R0emAT2CTCxD-0Y<-MJGS(LiSikiIU4e6z| zv1mT>9`&_d2j&D<8vE%+KiA<&n>C;0>5AzsT@WH60C{t01gV z)Hk*#bl_bP*2I^qaI_VvMi*zKZdbfuC*md#g?P2$Xh=Ahg)gGahYre#rFXKPVizyf z7{QuY!SnJtSGJDQ*+L5Tt0h?&i?SRnr-;)J*3{bQpOtscutIIH!MGqzE^5s9BrI4a z2UWc|!=W+Mt5dvh>y@T2>?EhGKz9T%2YR1yK*C+9Bd8Uq);to7O~E4Ls@l4MS`<}CX zB^`o6ukhtiMD#pOu)kAWl@rT)$;l|cupxxGN}rkELutXUky*(LS_VvIjW}WP1XJM3~mxEJ&X&CzI4rIa|>9LIs1ss z&hty?9zreq@MEWTYK~|)doLwuAAZ#zNn>1oec^VM^Pa(S*X<2kBbFJS!AqZ5^jSE( zgc>SdNbKxXn9+H!oCZ>%*S(BiN~;Gg@+rK#m^H1s+f{q2ZkGies`Yil_NhO6QjFFG zH;4=(ytAHuof^q!I`i^aff zE{7D}fVWa19XAYBIERV`+PPGtIt zPq+eSUJ|29q|s=Q6kZH@tR>tX^^=`q*Y?fbT0;nl1`8v2*I=G@h!gHU$6Bt1Gtc5= ztRo0%r~Rv0HouszN&y{Z185>iS@&M)D<~Ud&A!$XjGP^+c0D2Qk*%Nn7tg6#q(LkI ztR~8dPh~KMW}jXOl*9J8sqIFF+K)%h<`>P6Wiu*#k&79Pq=}N$lH%Z+{F*h=Ki4?C zhPF6L`0Q@kivq+Nm29;8|)8#*q;3eNct z1f4Iz5+kVJlwBEoQ(O9-tj}t)#cg?ZXt~YEL0-u=SA&y1R?K&2__MKHrczBtNR zLQ~Xx7x0~4zaD+8!NpbTU4!bnVzuX8PR)dSaWIR*UWCprKDT0dz}jS4e9z0K9ZOz3 zIejE^tnG2 zU*pX4Q*66X$DBn#d_!YUWtBgTaFs(OP0CMRTxsDi{B~H*ugKubPCt2@gY8A|1|`{k z8vS`=Q1c}yDVhCT@{Cfw=Yo7@4Fdr+{XRKEBWCKG z_ko3wThTsJKe*qrFUICDw_AnpcNu%|R6P@hNCA5n6j9h4kZ6v|vYwQ}=B2kES#F6~jVK`q z&+wk(RAbASo)Q;aR>CWvnZKPrU(q(K!-6+1I3-s&8*{9x_g`4NX-QFKFWGWEr0c!v zQOdaILO6~~OG)z@KML}?k;jBhggX!@O9_iyXj~+!Me}H&b^2lM5s*G6u(_bN9M7Q=D<0he2{^XrMt)q(< zWl<<4SjMyBi`JWOr{E@AlY_S`jbi6itYzni_#w3>k8;%ld^L`B|K0=+d3yY*wE)QUc8J|e!Kph7-eh!x*8c)J4+VqbhK z=DC#ryg@JJF>@*?q%ZlMDVWBxGf7kZ^A^uHtWQv)c7wHTR3*OPR){=aiCOWsifyg3 z*52)L2Q#iB9P16NRl`cNn)HfCZZ9-stD%@(Rc`8h<-wG+CZ;PtHc5Na8aTx5h!g5z&?N3kj1An=W z`JJAh&-)Ya(Hxo_j+VILwO;uu2WJ?{uY_u%_3wXykC^noNo76r@kz83C58as`P%SW z0ZK&8juE8-dF&+EYpho;^%N=p1!Th!qgk5*dXn9EPzvoLaS@HvHOyrUDsjF{(B<$Q ze;tA{{2M+|QYJR*+fxB@l%qV24oUomaqQPLI=OiI67$|M2~lT=Zg8Crvh#J*%M1bS z@)^Q$1mR}hlXfxwP*y)d=~3U=ZAWdzMr2yv;+O|%zHuQzyoxYp7VZe7t#cal@`D}n zai)xs;B{3h5rg_1Djd;W@p12Li_UQR{cSvC6tvO{%&FX&g8J0O1FcE6e(t5*gqirTl{nQ&PLav1O?OgivXWVZM zq}GowZs(PI%U)S;ZxJTYS-(Qwv{!yNA})EVwEESBFsH| zy9fm-=5%VW-{{T`ml2b$<+MgPUk4)_g`}qhiNA*kJ*np(?zt=*pWD;Y>Ppbnd+D6M z?edKRWH3H^uPo!sTAQw$-HBHkW6|}GI(@uj3A1nJu6o_miV}xElg!J zdz}`oo}^VZDr2Nla~YzKW|r!SGO_Ht9}*OY*9ZIZZLU9jdiw&VdC z##HCpeAaM>rk%AWp>yP!rPt$d2&1ZGA*;E^ zFaEIaY-E3laOF%qSXwbcvWfvGEzVSuf)L#elE4xziT(-F&4$hO3>9HD{@Wuaml+w^xJNqF3g=7xYe|TCC@sv z3x%$H4?B~0arMLb1o}0IIaely$S*Xq0{)~oTssRPTmc5tH;HOMPA*BcJld;@&P8@u z*vP6-3zY<6l7s{C2pi+HgN6sZyh}4R9X(l3oW|y6(w7#$Kf*66PCc3*R+MxaX+evS zdvAllrrkDUGXRM)3;pd}h%!8^(RH#6A7(thZ#)9ysGx^TIE&w$#Ndvq4wPEfL5#~_ zuguMt2>N%O)(YgLn-Tk`Ml`3D8V+YO$T~rG6$Hi7mBqQ7i61g3zM}>rh^|+z;byFm zP@%<1QUnJX2uo}4d=;#t-=qKw_Z?v<^L0r#wAqmw5b&=-$}DWqJf=FI`MheB7lw(z zIC*izz{f>Hyic;kSpI6LgGKS%NriI4?pD2R4aHV3ePq_|JO=T1ISo~LE~YBKQQtB& z^W-ar-ZfvIXm~n_Z?pPr4VSQWQVFM@F%CPo%6B}KqUvK@sK}J;l?wDM8>6p#;eF@w>`0&5mtr>i z7R`_4#afaUphZMR*Pq0v-~4%y9S@?XR+`m*S(h1L+m`9>uV(kKCh#Tz_rX&gZ-oaCfK`D2)@B}Q-fT=J10 zh8d-oD2;~i73q_21vX{;FrFiFj($CpKgN0Sk^z0IWmOO&O=PJD2>Ct{zLJ{wQp>#y#AF@9$*-dp3&_rV}4JeuLn+kpK_MTYD&_ zTx0UCy%J8+I9>H6a z$xf%mm4P11|J zG_oWLQ&e6U~U*fq^7mSwBv!{Lh zE6qsM6<&Sl7$;#qP_qP2dQ-x2LgT-`?2z$ECS%m3%laE_dNw6v`j8}i@kdkR5IJ{b zv}a2*cAb~neQ8{WU(KXWDJlh@b4GHL%cL-Wu;Z9++b*|N)7#zGF{-ZMkBbWwD{h*t*P$HVO9J#XX72@+(pvC-hi^AkVHze`cPANnP!*p*$V~0PcLGE4KHt`Imzvoh*J!tj z5S2!=*W?E3u$JfFKZIN?&abXK2UF7*Sc9Oy`fSV^v1w;L(M$KThD3ZRk}{FQL58Nv zJ#8ruQuF_O63XLs>sB z!-7m_VEx~q6h(`C*X3b;cg03XVXF7s)+K4>)3)<0;^E#TC^Ig+&eaD*^QrTIpJOj; zK2%G~W$$PAY7cS7@;8JTu1jAp6Z%(p=<*kRKzQx9UbYAxPgsQu#p2lZ;Vv=U(x@l<8? zL{)m8bBtAl2&d>C-QC7D)z6l0=0E|{vjf&dpO4pM+tow#hqaj)E@)=t5FjDKAKe1p zT14ZBGKx^#hA_jd%q@s`N22Sev3EiTaxWHxO zD484-GvlJ27FxLD$0_81k2l7J=x6~oc%Vu-48=t!{N&ih>A z4`i`oKW$TbMkWYxlNq*eMByZEaT5AI->j@I5!e$b4%>QFH*LSsOs#T09F`TJ`{j*? zUb`PUUUuA$cgu8!QzfgAIhUv&o^g=EN-JCu=Zi{4DTx|(v|wer4Jx`;U7k1_3rbS` z?#dV52rX@4yp|HYB!c&?XDrc#zOUYW`%0wrZN)jf7w0r_skP^h z-WQft+m3y)U}vtm^bXsC7`(nEF=D;lR6_rlZ&4gtODnQcfx=VJ3AGNQ$Jn2DYR2qr z>74o}3o%l=Z=X-)PQ6M)May6dQ%Q+7Z!cFRG#j&ff~vq#?4b?bh(obpYX?K8w#j`H zkGL^|Zn#Cm58Jx{p^)Q}bkyKQlQ=;#FN_q9jAObhnE5dDo^!D?uk_lqANj}5+P%mG zUvJ8$kFv>nYQBoe8L5E!3DXioNxXF?BHS5>iBipy zmF0k&0B`R&aaYx-V%R}9)l4LcDATXE!dl+gU;U~91APeM6eJtawc7{MnF4G4HnE++y?pNnJHK@+PHHl%goq$6l{*_OKoD6FmIQ2##wB|zH0 zZz;1NLwdq^Jo78f(Z<&Us|2A_G8A?;>u(wXC#GEOYaLsidRxyMq_GrTI&rKiea(gSIgOPZkfnoQ2o<1dxS)ob4Q0pQf|bz*-#`NI-&Jwkw== zDLUiYbYtexN3~h*IDWn^vWNNo-F_^#j+s|=1aEEgI*oBc9G@l=6H@XkDdM)FY$=vW zy0Y~?CcT6g*h}3C*ksje^&1OEQ221)Q#413g~qz~LW0NR`Um;S*H0_TujXs_IwaWL z1H`$jsk`K7LG_RGqXulP!VINP8uoQX`Q2>z#iS03O{bxI!H8V*QW202Td}al8TwZe z5;vB8p!B|zQD84ELDn+1Nf73JOxd$`np+Sruw0S(M>Tc5H_ia+A((As<#*yBO+mq% zqV8W{A^aEof(--x4^SD%8_um)h}Q|{-%g^==+%pVZCl62%|@*p_?}b*gq)_knV0WU zA}Q3%XmqQ{biNLw_2aEeZ)mh7eZ&B5ocfAnm-LuP5c$}a7Kvn zc^v-2aXeOD>7KJlR54YL0Ji<3BCh~dQ;N*DV=zdiXC}c;>So8?JDuHzYJt@)GK7UM zm9pOmtnaG34i>tm6rhJFmGjgX^N*|EbX{{q>O!%1)vDPkql!AvEF0W2xXPc+K{7OP!C7OSCmByLYDL^yc1g(9TQ| z`)mke433nGW{~AVpFa^bjR3b(YF9Hbk#B(6>;o;v+1y8vF&F&=dCt(<3H|PvWsrtG zXlTmmdqLiMk+j)8UsbBBf>7@(adqWJC4I18a`KJs`g&YHi2L4NHJEHya>)^Q%)D@< zg(SK;6LHX>4vLsxK+vno<^HGr4lol6 z#!a3xTH+CN@w-L$dm1TRY|Hc&u;@}s$7*f8yW&*%k|zG`(xg=^vzGflr6qgoC^+8R+cxWO(nO$QEc)_gvlDcB@e_VZMc z05|m>?|nIbYhViVUjsW;#Ig&usCLyeW*O3y)miGg`gm7^?BdIKoM&MSsTB3Q2xzdB z|AUGqUyixY7SfT59y|lZNx@x<5WNP$^6QE21M_S=_ZgSU`y- zlXHq(2Z|Go>Mg{hsC}+)GCVD~w5)XaBkhj8kAuz@0J$4dh%%oZ;T8vR(w~it-3+0m z6}It1x?NTo0f@oC%bciH{svqRF=^{6v;qDzc!s&}-Z+IKR#Eis+I`s=-HrNa-U347 z>l}{#$zpKG!mODF5Qg2?qT}6i07~zPat@xSAHVBE;vmnIFzP;Z$ZDj3PZLf3f`3|C z-?hEIZOcN19kM>uQ55CDMl-ddbIQVPx?kLj%{001dDs>y5?Ls{Q}bQu=n>EIoUxbe zI`9#h*x&jhkwVR5(2Z%tedjm)yyMxQ1PR$b_wj{wil)5@*k#1Jp))~$X^SNComRQ* z8LEy6jH;o67O&k*YhSKggY<cI138yN9n53V`jlp45F#w{3d76kVXiYo@x&}MTr7!!;w2fSAF&cB z9U!kVp6t8VTb+fIL95TwG%SFrJndJ3HwtUV#cQwN2GjGotPf^4`m3`#s$P9@4K>Rb%B0K=qP9KdIVcfCPCXx-gBo3i#JvGe8a?+4EAlFJTVi2BDhyHp znV|06{8|5zbOpoh%7qT!094XJ{)uoGv|jbpPRh?|T|V_xd?T!AMaybvL(^%N01}QZ zyPhHU+9~Jbwr_`DD7jKk{aqtzSjXz(Yj3d3e6xzVI*C8CCPrmWovDQFn`ti_OldR+ zAA~6208N$n3tBXKB|oNb^FrOLGc#pW%9c^dR1ipM`1#78Jv|c+kx%pDC z|MQJg?Nfcs(WlIsO39;9zAPifuj9F34A{0A^_5;~I7ov78Ezi~O!qr`5SFrb=Z0Zf zChK)}WH9yh(^WkLk=z>2Nvm6?2BAL{oQd9kP<;%N)b#lj(dauv&+LVN(yXI9S!nRa zj2vu?k2JiXOuO6(KEd?G+h^s2E&2C|Cn|FlHo{>T>RkTuO_lD~5jH)yD8o%C7 z3U3-I+u~c9(nF?x#3))2+>=I+MEYH^OH686TxKhq+>Cg$)KD{(3(-)#`-CRSDvGS~ zmDld(|MkZNovQb#aHsWvVPm4%g-4Y=)We-jLD>%LBV}iD!^8K&?9a#&*qpeM6x##D z9urSfV7bT{FH`}@e7x}-&`a!6pb>)%FPGv|!*CbASuG?&W zJtr2tw02qTi6L>O$zq0kgZR~l&fqQ0V1o4I4D9{w7J_23B$)7KGN5AFjdb(NTl31qr#3jF<$5v-HOa~}cqKAfeJ zhCRTwpo)28UVQW9% zkl8K!ub4um_Sl$DXRh8tC#63S@SFI-pncHV!3{>;a6&DN;N4iv*a?J-9>l{JwU6?u zc9MCdSk+uzw z8BnHG>@-5|rb|V|;Y6`>R#*sHOPVWzhUB;0slI`;5R7da!@sA_+VRIn&;|Wm#=w@F zp}Cfp%{+0{yP2NFu~YUE4_kd76++smX?G;Ij}Lo-;Rp{q${T$>{s%0cU@x57>rLO zZv1B{=fKorRgDLa?mjLH)njfwL0uAGeqn)&JH#yhmS}=2%RVUN4$802V=)Q6>kJw% z&Hg2rS@6my9(wZXCEFrK&Dz=e+Pe4xu=MS}PCX=}nP_F$Y~-~25i}$U7L?$Iz-$+NG#K~>i0$<2pE1P8I-oRs#7 zUl~rCLU@R^;Zj{~*oB}8;0o)@dyKJp@P>}HD-0Pu-b9c-5x_RLVWd+MOmf82;hmj) zgNKRPwD_!LjaxXrNarWz_}P_Ae?@xTD}oq79(Nlpn`!?w)8Na=ywmE&LugYrcyL%* zwB9YWz;8+ciXVEq#bhLsQCNf=C~TYqXU5q=iqG>GxpAph^&h15Gmbt*knvXckNFd? z>o-267}xJq;YQSuiew##cE=DuC$YcL_t`48L#Q^hNDF%;XOXY|XtO(v*6S_i$KAsE z_Hm0c%ztpKVKD++e)6Uyu^7TH>8Dp$Ep&{#fZQ)Dp`Z043&FUcZ~BILT{ud#<`b$4e5u3uVd5!A2 zwP_;ogCh72%L=WGtp#_?_1C?N9}e4GbdV`kOt_!O)^duRxGATS!D%rdF-Z%iQ8GIX zlp?H`TdS@zd*?QxT_%!psrX)Z1um5X3oF<^VO1Le-D5Ia!7ui*?qZfn-E9==RPknR zYyzG6o4?sA2rx0}g@#mttGl-6&p3evm-ws&Rh85kD33OuUrrw`tEpu2b596e5>BIZ zLD41}$;N$O*kDpM?&2S1&FOh%Opp16xfc4(tWV<*+=tQ52PCG@i;()eA>@fet-Kol zieHxQHJ3llM!rz%6VK4xiir|dyj0@vJ`8qzZhB#BBI73Z=hcG_ASynT4f!1UIN~;^ zDJP>@Ez-V{mIx{i1$now2F%!RU)#u$K*;+6cFm%Lo@`PQ9XLUSsTv4F^TPp8|135` z9HP1I0U;)?4?iwGj>yPWr`8zvR^P$pp{3^uH$RE=c|+BDbDj7Y$I?yV4k=56Cv>yf zB_8HHA@VqlNZTGRA~6<#c(p`buD`>nI&}BD_InaY`mKuEUEDQ~rq4YVIGtruBipw4 zkcKr^tcP7H$m?-mk6|IBtyLG9H5X-|n|o4sfY3S^1Qy3HVsDtKo>8hEr+8#rC&0B- zAOkZxF?UiZS$11*UwU!-po=E?0+T2>d7{?k*K&!0L~+&Qg|>lUK&s09C>qpkb_$KW z+k=dJGd12%f&;oA#*?XmIG)j3ee72wz?}B)7h5-pz70sHy~s>mG%ndZ=FCw^kNO-1i&hMdK;N5mrma>sVl z)ajJ9mE1m*RC3`|c?_k!hV98muVQ|#bbkxk`wnGm=YYbX4@XudH^x&e^FedpBoPWP z%?*k!Q&b>0wrz`mRhQq^=sPFDxi<1FcR8_iZj7!-9bBbF=0-fZb*3b9*rD$63K1Zuxq?My#I2Mm zDfm=R7&AieO39f6=kwsA`T?iY^>4!V>(BNGRQtk#C^jr$hhI^gz6pJXq;?>ClBB~W z%UVvHCRWW!x)<|vh^GF&Gli^zh4J2q274o^_scL#x-o7*ACGqu8bQ{U!(?B}kleK+;3{t3%A2T{@JVzLvz^0F3(D`RN zqj47|8niw>4y$FM8G5*xkBdVx*6;z4>N3sy7+6qJw8DJ!oB{&rQFTO288A=18|<@n zUk#z_8_dv1Bws3WS`g&Rzq+5dwuw-+QqnCpxeke9thg0`_Nlr`;n#?K5q_(6`b^mh zNXhC@nj~fxgV^1g`o?&dKO%u6V3^&LLu#|gmlp8!-#5Jfp2H|sCWbhwB)J;=*mwPr zfG|&ZmECskQuOFmYEZ9)|4Li84dn{*qkrn}qPC{7rte=}i0^m0YFU$CA`}+_?+Jd1 ze*lCB74iE<1U`q1y3iyv3!U?b7)nL!RLacki_X^ zQKF@Ew$Z2rAqsE|QwJon0&o>MJAPLO|MW11MDeJWyj3{2O=_8H{74c?ry&uG38`rl z^zre-QCp#eVZbg2G$nKJqqvN$@BBc218&h`~}sAgQF1fa0PAx zIYWg`DlP}rNWLoGcj+09BE^0m;JjE_e{)h@ykzy=Lrc`dUSr0xCNHkf8)vC_w~=BX zC`9CqZ8Ok~Fp!+}<#U)iwwF~x5TRq2k4~g$_hkDDr;ExU zO^D;SRRadRBzI07|LF)pXcHn^p7{$nLQ@czj;#w_C;>dm7L`@Wy_r>VIVud^C71bU zRmBie6yA}-QIZqhx;SxK)o>X^bcyA(a$bNg!;IOW2j<=lIQ)``Dl4&VCAa-mhb15h z_w=B-Z;Cl#!mVg^geTewj-Cxubq%z>i`%@j3(N9~3Fw+QNqw~L_Fkb3cp-_2|iIr3Y#X)c@m6w+$PF`I8JRb#$uEL$|(t`&a>XnSh!@%@9ibR!A7vhXDd6j=;(`n<9p7=(aekQm#U$O0X0epA}# z)AD+*WCdJHF55L7ggF;f7;BBQU(}fKVi;rP{lSg=+hy*;tDWuh2#7`;aelw>V!$-5 zj#fkKbCHo_0T4>9c zwkZdaNRe&|8k$_yuYPw(Aqv&h*TH3sz$BFP)@Z=YTDmYP8!>yR0t99YzG%gJ(F zLDDSCuQ!gCp2rDq`%K-ZOgp2KIS%v8;$UJHS~6#DQH?bD`S84}c3%%YEXjWD=*-Xh zC^7+{7#bJ%vI4wZOWZ%;=v$v2qj-d>RM^buCATg&N{S)aw`$hq0wS zEHUBpkY@DH9w@FNpn2(K=&rbvvqq(_12IC#VzXM+l%<{+e3}7XWQHX|ZY`KD)a${} z8;}w|0fHsHL70j>3lkVKCvrmRK(R(zqKnSbYxh#NT6O1n3B5!e6Lcdb@ufJQgtfJX zTjK#P9FGkTt=U2L8^z{C<$J{_dg4QY6_~!7_&L4NZ}mfV~kWrJ+2OqIzeJ z=)!(Ze9dbw8pf0h6)PE%L1q>1x0CQ<>klpE$={M@So70aJHHdq+B+~uJbnflWcL}h z94osuhds7A6-=`GHLPD@3+a>6-{YfSSVP5m^tt-Eb9x+rrd~SdU=;X(4Pm0aRR=LF z-F*XfGMvs*$P*-%9avx7+d;%ljMj-VKoTfHB|TM+21vu7WZxMxdM1P?EGS3mId|8V z=i%+aT?maDnsU(9&@p%J-3HT+e+52iH_e-ir)<6#xMntC>->0xNs%33YTr+5jaJi zQ#>R?$yx~>~?y)k<`A(5%0#?9a{w2_(`(=43!TIE=q%D$XhN{FCoG54AqE|s( z0y=+Ez_$1(QGpkY)f8~CnI@^mCTWmHb~o`t7^DG#Dwx=We?K{|;(3HFgz~dqAFIxw z@EA*p4qqilR8NUcoxy%$#M0h{?17_?s;UZ?+eSa-M>7^!0|}30N1NPin9I+zDlWfF zdsXz&OUETP?TYQpm61G~Mr^`Os}32$R7Xg)8Sc)Tkot(B5u@h`nK)bRxqn?lbIhXgQ2xjo$E7;SumZ6ZkGHmn$aY zJ?LRp4*quZ$Wy!#Cu%svAyHXpUkm^oX=#87usyoB;)EA6FcDE~Ov@_lxny1i;b@P| z9GOW^F=f#rj)dSl=W0o$SOwAizPP+cME?=r+Z3I4f@|xrRB0GaQo;SJV+Smh*nn1( z=ET$M)Nk8b0P&e^UC`XRN$N=xJtpdwrNXXUgze;U)bVfp1Bh# zsQC4oACxIRB7*7Tvq-nt_1xh4)#d z&C3LIc4n1j{eql!o)mGy67$YmV@nAlB@II_blT8bqyya-A_@`s9{ZjMa}g|?3>S?@ z_6h-msPe+Q2&T{Ro4S#9Blqt4SZwi64$U6ZwlryWOe8_b{3y|R>N>99B@Ea0lQ0oM z1s}fa1GoHRRm^)d3)R=~CM-^SwM>?^^M5+TvsnSl3|u$NJX8U68M3c}4OcWy&=xQM zVxis3cO{tS{Pn+i`*xl*u?1z4ujex9AE!zgj+1P5%1td&E9o!+bucG5ut|4d2u=VF zLH|3xM@G8E&}|xg`3Ea<_@@B|cxpha%^u;HA%mp)c0*iT3aLSSn4%|Pi4C8EdM^@^ zM_@=0DJk5+XRCDGnDoqol8uircVHu*X-6~6JCvC;!&SiYv_fjc45UNi#SM793?IDC z4f3^B5EJ^iabG|Cjt^fQD;4?LvQa?VS(8Q`;y5mEEZ+gIcStTr3M7&lc2^X4a$EFZGSZ`1!i4@Zsvl6 zGk|6>WYRJzZjffK!0udq&q>l)msDb=w%@;Z`=ngemdATS(h+YPE^3!NUAAQD(+|9!be|F-MTdnZgj9nf%HXn+ZGy?m!S^$1?61hQ`ay%ds#X3`4K;F6%W!lIXU#g7NGXVac@^&VdzKv&x#S zMcsSoy}&W+q7|LMDWfNQI805#>0by9(w~7X_WBJ7aTXtR)A)TofUTY`O)p9l$r%I4 zM+8O11JJ`TE((n1qU#Fm)g9-SMKfZ9<15MS79zML86BMUbcW6O~u6~6?{7f@z6o3BnQ&bprgJfS6L zns!_wC_{?0Oze_R5x9S5$!9P>YNKnFdr)K=5rz4xJ-?8oXz=P|8JNVptik$dF?I(j{WE3%xH4w?oRLP}t!{`@xVrLM zw~7>`Km`U%00^^6`LMSDv582ydgBV;JuJ^t-DA&0rumQR?Bn8Ze<3AA4oVf0Z!KAZ zG)tdeqB+UBShvmHzA|l-!ZZSoQ0@YT`Db|+GV0a_iKDkONs&4s7w$ZoSlT79>w-Zj z#MKb4vYfyyKh0}eAFu!3ImiZo@j3W_jb1^>Rh}F-L}%DkLSdd z#mS;+0%|k0W(^Lh9b?38RUVDIEQo6hMI(x`3i!%G=LV!X$un=FwgCjG$?Bx@hA(9| zx&`WpV`Rt0yQkxG%ePHC;*NCI;nu-F{6fZM@k>1f@YR@azP1vT}QukXRmml+2877WqsZ$s2K7{aOkuXsek@yU-0|7nveRl6$V_CvCpFY9ewy@=b z2=AHXnza{8{H$TMl3N$?IPhy5t+Tov=S>$`W_;t1)MEdwb+?2p_pgoYZdy25A&!uh z3aEm4>^4WR&3Piyhf1%br8HfBp?yS~Sr%|g^KH~%OwRphYr5Qj!Q2Fz?simfx_LXC zM!ux1IXzCcrS3GtI~3LEW6iN%;V2+D6^*mIONLqn;pWthpBCDE$S=_L%Rt*~z6pGljZDv)p|( zQH>g(`f8~n=kpljf)NiGmZCg0-IOchji#8S@AZfLeUcggh{X<4&3V|||e ziD?P$C(n+hc+W84FZE03UDxn6e&KWLE$?9^mmm@%KpiobF~VCrqn5!nW-X>QhZ*+K zC6~K#{keRcy6!m}rI>ESxY_u3z;h8yXxY_G>Vw%s!UXc~=FJyD&Thiwo1^s;#AFGq z`tJGe-E;gWAg~z&(~qMGxAQ?~PtET+_jI$0IE6I)Ur^cXyv$U41G>cHpJ{TcDC@N+}$>2LGVpx*KZx03u-YQNOYr5>34 zpK;XIE*WmMS$mu){cCl_(i3NhY?EQVW#qV`m*DmyOOkz$nJG!Qd@c8$?m!)l>b3zd zs8mKV5ZQS24K~3<5xR-<(C`wW79YU$roE{a*_>F};)+82aqo*a%pw`RMflL4K3GQA z>fYH^*?$bmy{x7;YPdnthBFFH-M?cTZzoG4>iR;F>&fIlUfHXjQ=s^d92l+fXrssKHkEZVb0$tK5C17Ww=!`(I4O zMtmwWD}N@dtTsda0lkr&0~Wd2^2pRcT_zaWXs1@k{$sxEts%DnWHNpY*W^XANsy?n zQeYD?GEl!d_IZ-7mj@1kE#|kGy zaYj%u2!X%H3Q^ZiG{a59<3eV3FF9)v`cS6)1ZqymDC||M{)0)F?*@VOS1OS%D67by z!Z6#9HXcSe{P)gj#5~Cw*@oz>lVH@&lYoV6{Hs5ssSK!;_VDG5^Y4nqbz}O7AG=rbY3Ik&N7Lz^I{}> zZfHu{&?PqrH~wdRkB1}dW{%?1F4jHguyLhn%J_MHoRmQ$4(9Ei+@3;~kMDg5{Gtmg z8Dc*e(zJ#%>nzk?5VxbZ-_iR*`jg_Rl2|}{3~~7Gbm5C)bzEn1L7M;`-+nka2>-du zpy&=$5%eS*>0oLROs;!149N-&8Q>Gqyk(r+?fvmV=&*9KXV(*<@f-DqwB}rd<0;2w z(FQKfa*57y>uXxHTPf2kzbQ$OFLy$`zoi?8Ik8%Vs*$)JJvlVzs;^FBpH0*gve$4~ zpW-{eI2~!A^=s|PvL^j6Lj`=Mwe*oevOGa^+Z~%P`|V95D);k zf6|Sj^%K1RtV1LseXo}qw7C>d*V>eSNjdywI6-9WsdQk$8XX4voR!uct$p6@4BJFmQO)X5YKpxj9g9i<)HLp|TG zb(b>SHZKMHbi?p0wz={5LtdpdW>$0|(Lo%Ual3?XXfHv}*6xPM0Qu5eQ4nbXP{{4F z*~-TbQ&EO*p2fOu{&S*&n-#7ihn-+uIe;rCTy`D`Hrp=+ zyNH=tR2-KtTL1XkWP0rjK)E3a{5f8vlQcjXHj5`yD%f>xdpm5p!HoM6-4>a;vCg>>+_;VLhktYE~^@$Y_W!@;31$#yMxpzoTBMUs2D~nurG`)><}6 zVnrG~y%p0oXcS@R<`%vp`JkBFdHAJ~@VuyG*oYZIf4!zA^l&@4`Oz@7#UeFnT5v%M zD}fe?2e~L{kV86zSA8w2Dm|}S4g^_4y+PlFQI1^&)SA5Vuv{!2xdmndf zUW9e{Nl8n7vNVu!HqN7EY#{$Stf84tKg;mlT9C&*DV-P$idNJCSlanKE0@ztqM{@^ zIykwL>vL0X!lj}oC|kK!Ow=t-t(|x7Z?vsS9RGK64B595CNHE`EK+4yb47ue#U`qh z1YyQ@0u>(xp8E*LT%I0rSGF9q?dVQj1|cy&I-sD65Ea{Wp+ZAN?>fOpJOrNat*MWQ zEAT_WkBH4+4jTf5?_&J9!0vmklLg{k=)k&ee4P61NEMR?PlwTMrkNRtAwGrM9zPiA zS_|aYB{gA~hpd4PE6x1cAS3meN;gCqU8tcCA=md3Cblph>-HcZEwk;KkDDG!;A8(z z`gPP1KYiVGYpCm#voTNHfG{%xffg>MVgM>MBJ-jLL^Fy>uwgIG+}o%{bk=;w7A5?v zqt0$xH3P`!ZKu<(fHx7nYb*rejDU$JvMcQMZr)?x^E%U1F^tqNTk69dJC=#ewOh6f zA&r_SaxmBtTNoDuNI*?~C)~>he0t-)-3`m0g~D?N6oA~6S=0hamwDlMSXWHz{KGrj zp7cWj0)}=*m2^=Fkp5*XRgiPE!7EOVPP@-cr0rasQ6vXmT(^$PW(}pKVl{ic@GXH6 z$+V(g5K)nB#5kgcACXJI>&hH^2@^(=+1^}$yGe!;=tnpWEg-R|o*ViCA>{oX!6FFF zWIuk06k4cm<(UM;sUJ!{Wm^GN7MVXF00sTnB+ zApW9PZ!%{g&ET`4si1|e4y?2<#qc3FruOdIlswIG3659nM7!9@*)Le}Gu*&cm5Mpk z8G(=P&Mv$P*yUSQ=e^r>5Z~@lu-9k;M*E}XO!)!;ak=$oYK*5s)$H6sRnY&ICfiHy zO&{gY3M6dugbCC&q45O=u|lZd$1+zxin3>-9OZ%3wz711Pb)lJQ@tYASxCo8j~}dp z)0k5S$VEMu%O3Gl3tXB;nNOJ$+1P~@=Ox3cICd5(pmrS{5$kWvZH~s3k;VIbbzYmH ziG7o&b)0mC1zY!7#!STq>H#ohL9!3Qe%MS^B?dhRAQ!+w?YhWUgbH2_*3L38Cd>e_ z?&gvpNb~a*bc$ubgCx9TtfC|ZbD}fR1giM%Ml7_Mv|Yq(AMlEKG`9I%9apmrVk7Yv zNG?1v;A>D^4)6(dbIa>CAJ{Z6H*5AbPI-JCM@~JWE!RA92(pM0qq?vyRBS3KtLyEX zfUVin^O1M$?M0T5nO81boo!|68Gl%Zc1UT!JG?q2`-_v$@H_ju?Sfe1V*mUFDxjNA z0KKj15Se(`4;uKZG>#+Dqsa%W)MRF?`;y8^yz87oEAmG7(ma}63>NE3`-W3kkuQ<% zv1iW#1a36fZabKC+oqD2m;No0Hx7nL74;#}nz1~8NQp@q@Be5Z{tiaXPA%#^5cAcz zA1zjCkkTqbED5WeY&OY!>ZY!pKZ!$VkEpR2bp!NiY|_{Bw>*naoZ~%t!R@vII|CYp z#wDA^;9!0vs8n5fFGLErrPy<4-sL;PxQ^~dfgbdYIP(P|479O~I$xez0S1)uwH*dc^6A>*b&PcQ z6zHRKMb!s)75f_`PaXfKT1xl$nAK;tE*xhco(o@$cnM!K+wFslVeMwd1n*tVIYaCUyIe2@L4E6ot<6!}X)M2)4O~XgSS1y%`0h2o#n+ z#NEX9`jhikGcXnFj#4~suIbpztf&8$YvwJar96;UOt_44!)l0{xdafdZ6uxiXZEMr zz|2-pF7&7hL^X>aNWj9oc_6^eamVW3mZ^kG`VK4enYY|ZJc&0Ngi$d_5ztP>P{d>! zwzgxsifcB=O~VM#CYo_YTj*@rwC9s6Z<_axm%`@d!1ezh7Bb-lK)|lFv0HVpEoTv^ zXqo1Plxy=G!frCj8Uzx<4T#Q9dG5*ctlR7_k_52*Fqm~c|6%&Q{|}C%x{-;0>2VK> zQQT1Q>i2v_c!7JpzN8&}38WvIom!zZwhWO!XO((4jZrg9{8Q3#8H78S7*mEp8b`;g zXJ+{Pa=@4@l{2{zt72lUDDM6dhk%4hBc7sYjp&1dA>87G`RcH=F^m~QlBmwKai%<~ zd;lx(0r<^nSc5Y$qW+49NAkyUNa~&miJx+!Y_qWujR=@`=igW|0fF8V=>zvswCXlr zr>RB%z4_1+)&d%Ph{zNevoxX|qZT6wz&ygU? zj{2S4y7ZkSUC9eqZwS@Yn*yOT7aAzwW(hX|iwF4>4%&{Zpl;{&s1&I!UfbWw*DSg@ ze0_hEO`P#+?1XbO54NDvQb{ztrtf0s4EAaiq)?KYbMy%NA;oI|3fN6W;$C_v|Ud)xq|JzU`yy+u9AnlE96!SgmJhpN1pg zeys~%W9nV@z z9rrn>`K*0f>m{BC_&Q=Up=zG5TpG`e3TWZP51(L5c@bqSLDK%ED`jP#!wHvF?{f1iDA$Cb3g)R<1M^=>&oCy6e)qrn2l)$c{}_rJG|X zx`>>%fA+KN5xYNs0>KZ)H6u?WePe&yLO zdY&<`e&|zgc=I{#2?fI^#k{9E50T|%>?Ql+$_jNGL9OJB+reV=hehFY1xQe{aWY8= zW#%f?L7#Lf$azh5c}D_PaYA(dWs(GQQ=V(c43|$Jl>O87A0?4s2%p!j>xEL8A(0oY zCA`+w=j|KWVD0fXnR#;q4Q_>H#EUMT*ukza@r<0)8*C7Eoolu4J;*M1))~xfeR2C# zKa8GZk>%b~JY%KLglmz=3C;(|m1WS)vmU<5agdOL%b5*wXpXaYB4%GV1VDpQr&HhD zmaotk(7Vw%jW0dqgoMr$b8xmd!Pg8kVmdI#!~C>LKCCuKz3%`@Ylq#%Fi@< zj&{-O2s3U+Hni0Tyr?K*Z;+6gP7|#z#RZKXNID%_*y4!yh8xtOJv9XBq

WK52o#w}urNBe5C4@=pDo}a9E47!f1OeJh~tZ!L4;8AJ|3)iQ(=a-uO{8Wj$ z1oZR7<)xAPTV&4j?#F?sG1UbcN(zl-SHEgl=eup8I(hQ@dIBjP$SB4M;p@VPoPA|)XCJOY2#Xne`v;}4!ndJ)G}2wv0g~cA z%OrOYG?cpi_c(#qvTvT)d;ohz7z<0h6V7P}m1XJSwI8OBgj(y*DVpy^-&|Kz8A>&^ zI+?;LupF0B%tL9=yp<<^T2o?<&)GR`8DNYf%X#Y_3ymnS)Li4hXQk%L)jR%=@{x$0 zq$Zk?y*2jQzHPqR7~dxtPwX}9yNfRG8ci!X_x97PIWC+e)}L-OVKXJ(E~*M0|4CDR zvh-=@9UeaA_W2b%-o~(U2Q)n17k1v}RwW$rXV+30i9#+2mM0qFqPH+N<%H-MwabS; zzjnu`uqcHuZ;FK+cug%ll)%1o`*cN>)VBl`+r2!Njt3UU{p+84XHsF-ymZhg&1V8-=LNu~8P1ymIwB}`_rm=8pvkBCzUQFA&zuS zCk!9MO>O)|xN~N@kFuSTaV0UMyuA>dFTSy27go4)`N%tqN2Dvnm!(wJX7uq;I+Rnj z?&W3M=Or=UhlaR4e=Pf5R(@b(4b#tzY9`0sb*~WW*)PW!fstm^mP38^o1M%$#-B29y7gc404#4tZ4SrH0-%9W(Scvq?@^lz9X*#YM` z95%!oEt4{Pzk|ZTiYD4#$TK9P1>pK zP&!8yQk<@@8-{k2e2K0v$7d@5;VBozlQb?CCPzG#!24J}+@u49FoUr;wFYE=Se`!# z)bSx-b%GThCA+P$(bmOGl_Lcc^5=)yr+S$}Z{BP|{dy=|m=M6!W{llaj3`amDC)62 zYi!%LZQHhO+qP}nwr#Aj?b++w``;%y$+7?I!pApmQ76>@gBEX6` zc2AJh`nHoUzeyUY$P!|1B1_jTk9;sPmODo^c&r6^Wh(0P0=!eccq6@QH&4Jiki)(Q zrV(xL96QTppoV&9N}g+{6UAgK2sdl=zMB)xo3Y{I+V#@Z8t-q$wOnlBcMid%E;v=K^`RxbzVznF{fNbY)yx(K{ z{h|)3EWUSUT4H863f5(s*haTwxf4+fhDLVKsftrfDMl=d&^!vsF(7X? z$`!mc>O>*^yVsm3=d#q7m|O?P!pSD6kSfeqM)D}rZeJh;euaPW(OLKjCm<@-rw@|L za)cCK>0`02ON9gSHU`&Q8s;u6O->HJWps3;!C{vsP)5vvY#{}zjQWIFV>^Kc{v(fa zle<8csL2>Q1SALe%s1>Q^6=2|>mGyfy6gCrB~h_VM`qB_twdLR>_SmV4yw@n zZ14pr9oB$RN-FHCm)h?&fEI?$SFs4>hT2%S<0S2c>5GPi@ib?Y|9itdv!#%7XTg4M zhJ*k=WK-FnI=9Myp{bLN^kR}}yxl$j;OCXq^y6Vcs;iRvl2cfaY}jdEWF7^8tJdF9 zCd&fB;)od*s9G!!oRb#O2y3O%0NdZOn*VI#H1h#&qB0!3z(@_R5xc{0SQfC*$5UMB z8x0P(zVl5K+B)XTe(2*}9PDKi!jE6oaA2{?=`yVALi8*^0f3z(poQaBMD#g{WX*;- z%dnJ@OZ-+CjyEH%B|BBn99yXVhiY5?}6XV&UUYCq9lj&HoSZf<>q?2c{Oq4M37j(=s%>Ms_DrNs4 zKJtIN$Nz^a{m%gvHgPg?w6J%!bNuJE{42{E*qGqcDJlsI$xBj6%P88}7}zq<(+JvG z8~w6O#@Uoq&^(iLLWL#)lD# zPRPJs+{D7n{C|r74ftOj4Fku&jwGB7tSyWLY|X4q{zGJxoK0+0|8?@OM*V+I`lpor z>%-i@QOU#^pPWvBPLNKPPL58IPMOYt&XCTC&dAQ%&X&%Y&VobI4H7oe_D+|B8)WT3kXHQu%?-l#PGDEpl-Nx-)9dW= z?Oq+ZySmjD=jWAE?u8|kBB%+N0kRfResE0;GB7j|6CJ;(>cr~id}v6D!0_rM$lYuM zJ(0Y8I41yX&a{oqFiehrHvpl@!6X#*k*d>7J$XBkg(15HqNxnO!m*QzLEZ0(z#qS#F3Yy zk(8F2n3R)$K@8+RQxP>0|Lp2>4l}s?)+Ru-ziFr{zCR5_KF~5iIb{?T1u${Su?kAE z1^ON`71!3r2Ip5Es)7lMiiD?sdVO{zJ3zT8e7v%X>ieS_sJRh{Gkpp8ct!Wt@3M#6 z7cwnXEn#(G1^(>dlNl@ksz3Dnz`~c@#_xjYdo9deTl1@Yd{E7^9w@-FsjRGPx3qL^ zZEbYvY^-c_D_m)`tE%6*5(ASPNc$$II?!$&96!~*UW`L410W|r_O$=6& zhO&;{#>$4u&c*@+^|in1N;j6o)KtZs{x;$} zVIj}wiDt2HF;r}(Z*c*ajQq^K<_NxJF@bUdrUUYO0nE>=N1w}8^o1V5&pd?r>OHH; zacOY@jL%OZzO7(`c>CeIb7FP^0LsG6_Sfb9GJmlN>K_25r(<#T%sqc@@V`-YHN%dh z_CL~n=uGs<{I(q}`{77uzA9N5S{eO?qX!H`NI$mD*?rCX_{}qV=4&C&uBkqTsR>yA z-I@P=W^86{bNsdI`*lzN|4ESi{)J$5OQv@N&LmIg!pQors`@=F$${BB)m|T6hI;EI z@>8hvi;Z3RjPBiII`O-q004$Y8~a_~9h+NU1Uox}*gyW70`a~b_&xKn`@(AhAT^+2 z5RrlG{KZJ?%O19gwvm~(kp`^B&IS+y2N!Y!IeEp<|GN+1-qA|}vwM{MD|!V$n$ow>g}U;KpZj_d`j5+j68-Nm`YV8a%W9-m^~(F3 zWnkcoX7vC+4x|tCPrH!<`i9-u%@I)jrSG$1{s#9(vv`4jt6luUyX!GQ{U_#V{$yO} zlt1sq|Ls}iQ*P{@YW&wI&Eyqt{O88X?9KOF15iNLuZjA1?B`PY8|Slj;|K3fr)h|9 zzsq#YuitIvH`?d6`H^q`6G{7@y_2^8!Dj4}_V>R*#{Q8xK9IP61HZT?A$)5udTM_j z_nN-_Zkzh*8_zFdY zt#`OF);rh%VXC*e0Z`#+Yx!~xKR)ytMt?n9zFgXR@CN;k_|mumAe@0QiKu5cFdsoR ziC4hUJfeQH$wN!`4Y+AXP?z7ZpeximVfC>pd^MY#(Ok;-6Vh^LSB#cl{Q_xZ`Lv15+w`G_2Sjq^!bqbs3^CRiY@7EUMf#wBM z9#-(o0mtNYiqf@9d63f3x)Ko@H5Sg5^Hd2S8;*wc9{#=ptLV@|XKYO|m7oBU4Vn9c z%OBRi2bj7YOsFm`59#<=^ieEjfXUqAI%u&Ue#{ag_~_8tzGsF`d072}sH54Fu5d&B zAqxnu)9cz#4#Hv0dUrpIJ4RCQ9XYfg#KJqPl>B2u1a3H-LZ5eN5Twy!kEpPl8jIy)bdDBq-AHC|?iW<{N^USLRDy?dtBWIfQL5%$48o`aoS zJ8<84l!)>`*hP;hc(ci;fJP!?P zy+IMA_cyd}G+I+NKL8)?H6ZCA7`yR0Dr+>0pD6!6dr$10xp9y77POB)dzJ~-tkwIs zt05-^Z@sCUd&aD~Vr;ctL3V?B>AmK@gW~(BfW!GMClP4tl|XN)!&;K{iIXb6dv1pM z>mVDAX?s^jH~6)DV--G-T*+6X8P2NZ>JbbKpf2qP zrJZS8lkq$j5m=K*&Vn1XM8hNXOKf#{nB4a0uM1~}m$=gCqoTJ*TEGQ$Y%CC(IMD(G zmwnby!PxcaLKdqUaIQ2`dzhX6i0QEnl9G1Q$iDFjx+mtU0O)uXHgZHb`Kivj2x_B4 zJyI^RR6*3xy0Szgj;$F!J9$RL&YYM(eNV zSdPg)askSu5#qjkN8;=oD6_}&icb4v2(7IaYFA(=2$;J|r;F0GM>5`|74H z=1mSM)}rc?!^BqGu6N!)pAlxCRj$lOH6)JFh0avfwhT&HvI6dhB7Wo&W;N?6rhihX znqt&IJe@i3i1OAIj&JJ9YJ0_zW}~^T_3YYqCdidU54_+xIyFxilYb8Di@X%rV-a2` zNEmJ8b`vj1R|Lc~AGs;}XQSnUir%uTv$=B{v<^IQC{DkgIF>dg#Rm`L3-J`l%hH6{$PxqLjKR_> z5WpvvI$#I@+KfiOX0-pbq%CMBe<~9JQd~G2?(uIp=?npvpgynFHP7IM3o(wU4RuG; zEvnWU1T3;RV}G9`4+O0O7rGdtM)W7JdL$B4w9UpX+e`;M<|oiU)q8n)tcIj$D_R%@ zTvo=SWWi)p1=9;W{H;9@cBn6}N9VFRDM_SvF@?>BKQ|O{J6Ddx3Uo6KR{tXs7((cS zH8~`17L}ub#JX%9D!|CQjP9=c$_9y6sX3DGe4)9&z4W}?43gl4YNz)y#6NcUMnJ> z@|ScxX>*ndPr!ikfB5K7o*@?v)t@(*?B=KFyLpXxuP4GTQN;l z11Z44HeBu#2fEUb!+6zZbFO@30kZ_ z%1!FL;4Xt~W>u1X8`WT=9F{^`+~&gcQ)sDYyI|=0VA->T&<=VhwTC-jWI1cogg0>{>lg4r4^NuA1rDkr2>zl?< zLHRr_kt!k~Q=LyS0_Y0JcW?}9KE)(;{%t6hifYSECBV(wfx zo%>%#nm6KJ_dl~YZ(o7_+%4x!iA0C{>*#g0hcwhbOPJa!3d7l*Ht;@Qys6_At~1%6>WlsO z7LCSoz-J)iyElsN=O^P@jzxhn=sYPyl^Xjckpq1O*{awGt2v#q><&0htmiF317X6= zW^;>Q-WMe)b!#8@2{w5V&bgnk?O86i?WVUsC*5zGdT&^(eN6P?!JHd$R(3X^7k2Mo zSUNWWM;@+@WYnS(fkqko-YORoUSyhg57%Y-9AryZGtveC*=iUEiYs~ZX}wN%%r(vd z5#R$2aPG)wwO~2x+iH)Jrw_S!oA~5VGAEHr4XSP)(;8Iyp;aw-aD6uii-cpbLkAyW zzGRk^FI+Qn!B;t7nB#B$dN6eFqjC-5G|()4qZUT6{?}9?A~eRa|?GrPg-h}N`CA&nXwF(+VyCwW|Jz`%gMS9s(cDq>7|sGt9uO@ zs33&^N+V-LJ}pyB6Rse!!TVsI zLo681ylxI%P!Q4foVBeB{(;TyNb1rEI48SbqNjkhv2m$YW2+U*ViY3pF?gbMHp=eG zxgi_XaGlj;PIGthDe?K_PWdXTy{6nGOQuIk%MLg1lDik-{jl~#h7#)HbWxi)#jAO# z2wnN}VXjlpk83EBieZj0lsu%>1tX7_x}9~Ix^@kT?d-#m0X|T5r)%yvZ1*FJkwyay zS1$G9BWErCE?XoGK%6R3YaMhwiMsI9YoD`Fn@YC6g@EYR+UOU>5FeD#)fgai?0}IOkKq1?O;bM*`CU=;@-TKi&`Z95YAdP|6&*sL(Y4eLQ&2Hgkk-S@ z#Q=*rf#j>=!|9F$R+BPCk>MI!$5$dTmj|OUw|^|hL6x{RS)Ve@@_+;E8&K>M{OLT9 zl!$C9-U5@X#Ps&60Iy{1u<&e5*eINseYy=s4MBI;K5&ceO~uh(l$}bCI8!oE6-~Ia zNjg0cgW+=Kp3>A1k5K4A4_2X2Hi!~x7$sG-14xr26Uoe-m2#J{HUqjC?ZotBx+(_f zPo}S>gSVL6#i)9egWrKlD!7K+<(j$)jr=5v)2pzDOoaBtloYQksH0-g&E@*UQhXSi zRf+9f)7Mcpi*J9e4~G%;U(R+%=cs`^wUllWK%J(3V}q5}xUn&hYja%YX=SG%G9#&f zp?brj*JoYH@k)Juv~wdL3CoqziHS%>FtZV=kBAJ4fxVcxKOLVmXS~=J@&{W-XjBj- z_pB|EZ=}Bq5-HlE3DbkbB&uL}Et+@gl*u)ufGdqyPfQLoU|k5lRd68lf{v9W?6H9v z`#-d}M)D8DX~HB@5iUWF$D8Wi=`}h87Y?n(Ay%r3)s#SqgSw~iibyi-fah}tO|0)m zYV=p%c;2|$G^8CGrmgg-5)U&G!DFYn zM3KCLBvPS=61aFNV|9{LED3uWcU6y#y6^M5a5}(`I&oREM znZ^u4M$}Rc=KnJ3*MO%4*C;NBoidHRB`NFMlBi@`o}92Vy4qJm9Ia&7fpRW(7G zK&9orp-h%hSIk`GoT>RJiN}`ZnbxzjMuq0XcW()Wgi%bU6gnBjqpppqYeqKcslDfN zKw4CtNxhLiSW-9{p#^`3MkC%qH<-4CP0V=;*K^pY-YY3Qkiu>0-XmcYP#ZhF@OwYa zrh(4cj@>?P>}S1Jg>?;8MD-}E&f`!|t1hbD9GvX&(kwV@*-;9U4U;tvAvFoDSsUSm zJ3q6|t>0h#-8}WeW#bgKez|$Rde{>=s&hf$J&Vb(#?jUBLJOqMuKHNSCr%0E>cHqz z6o*^w%%I!gtlU_NC)P*-6~E|rlEYy<{Vxjt;{L6XpskOP&PoAbW&;(}lZF=is5CeiLf5F}Wm1UHw~`{MllX#7L{Ac#*{;Hj9?lXj&I2x?>PJx~0r ztWdF9iD3lgS*X{3H^3P1bNOYX?t+~vOUOCa{By)QkFk3o%;jvcfUknTc zFzs^jO^VB(L_Tzpkp*yuE+`mL7U#zZ$gDhYJbC%8or^DhIQ78|yDi1;wL2@#Qmi=B z^JWu{_tB*e+2uTFNsYL`wJTJK=!=mpYK?XN;t%tN1q6wtg#sjpz%>lLZOQ>#W5WAt z4~S%DoNJLm^Zx8bLmu-40t*aIq9-V>111a~ZH!9KPj#g;B0SFzjB)>Kg!Y;6!ECzX z{NAg7@Vvi)m;=sOk7_v~d#`3t4q{)Q%$$v&sa!1n@Ltj0{gzqt_z-itKb$G!H?{dY z6mYn?j78`bZZa22n(Y~?&H=;Wjg0Q?Mydd1xa0{nLHomxwyXwn-<*M!NE0`_V1{?? z4A*$!5f@2jZhY0_PELK~muwD%s^st27EMfDzj&U2#!hopmnH3=EYlhYZO}y(nQ-U+ z`iAg~BQ-;$xuR9iI?P=vGQ40_f{3QDm*}?pI`3@~1&8y!#{$rp zwu8G<4?s3+FP@-fe}x3h4R>X6&xJ+o&RQTAtv>r7Q~^4P!f1?EWpuDZ>#92h8fcJ0 zO+L3d^~Dd`;Vs@SVb|+Gv!O%RpkTAxYbDxx=0vIr*K|!(*?02*3cHpo7JNjx`Q9|| zh>x}9PA`-`LD;0!ofgs6dpo&tOopb>t3`85>d~Vf95r~WF}=*mkofLJV`EL=>Z9lI zv+W^xpcyeb2W;oDd6g0E<~`+r)U##I7+0$2*&_`kB5#LnqH=*g1+)U!i@`lGABD=6 z&^rtpQSj18B-H!pgRt^(qgjf4Zlp9(ZP#G?$;~!d=3EZ8MfkuxiURG;2L^RJr zn_>Qb$QsZ?J;8+)$pD7b>e=x#|K3ejC7|SrI(#Ztr4=*opzU$ZZ7D6>M}&i{C#TEv z?r_;}gOyte~cyI92Y#TvdF9Vr{#s!XXOwk%Ucp&Q-`pWs#hJqe2aM*dUW1kZj}dyHEHAYKIB4nfxH$un!Fculuz9|*`PDk$n|osDj;yzd}(sNoEDK48#-#i z$&f@C72!SbHht&_6Nhh_jmCS5rs1%GR|Rtfo5v$_$k~vTJ1S)i32q$IAL`TB3U8(;{XPMPeHn$NLK)i_c7EF}d#Tko1WO5G z3_7a{fzQr~XP>kEd7#e%H+uVMb)5KnwTSTwe5PhS3&0I|u~8;eg=M8|67lg-OHvpD zn)~j!MBOXYH!BJ29}mlE`I1|!}C@#CD-kcoq7L&p6!8Fy8!c+0{)o#t2A zBlx=^>c97D`9S2mj#NHchhPtPo0W5n3(OWt%}P86M#l-SJL zsvv|0(zM)guDJSmt$CL8an^82M4e)zq#+-@QbPDYJqXs9WvRU{ON;{hpE)W{11tR7^lMYIMpDcBSW0=D|hPz)V253(lG0rV(J)H0{kMl8gIAthP@;9 zH1y5&lfwYq15Mc;fi&TmK!-3*cu!$dPBV8eJ*~wq=23bl1sP!T3T(LRaNM8a@ z(Bsj9tUwm!%!Q55t$IpQkgrDG%1A2;uH#}$OnKnGbfVrvr~ej$ey)h;#G5q!VzO9j zm{tWwM$-_YSstEC43o{~ZQ=HzKga`l+B)`J^81m{w4`QLzoYjDi^ZuKd?4FDS;9~+ zWSUWn_~0oAa*|%|YNrc9kIEJ0^Kg++`0d$h5$)NfnHX^AFtOcuGP9{bNJ&$pURBMCfFVXKqs-MAhtsus!4;B_I9%=sDjX0$%e&}M`b-7@7!^pP-hoBKP}f+I@DFh&lzJw( zEibZs>2D+tB z5WL{YyF>_HOW~Q=O^FJvdxEVjAZW{9x^>>uJVh8g*I0fnHgj1`p7)EiP_Wbe^hXO~ z?>iv}88UBPvmTuDOhjr|Ex4`W+4R$}pDySedVMaCdQE?!2cpxjam^Wa4iin?+pmXS z-J`gnDI0fWqvuyKx=$!!^nq?h(|$zCraz>yBECtVQ>d$GAGEl9P7!6MPE<28s2OIEX&af`!Rl%0ACRIkCU!n^cM%G1B`z27D@Oo{(! z%rP_Qj@>TNr84nQ))8|l^2VPoJQ?2@n7UaRywb3Y_{vcxY0EN)yqVvm+^)@I&x(Kn$9AP8t?@=~n6g!gIfTju~y_eTj zr24x5a^O$0timvH9NtV^*-pye^oD@diY@I@#6d$VY+@Rx06_Xv!L={F7|3WJS$tD)lWhIvg>SQ3bpn5ahKz9AH#T z_7vJytALsdM9ubg(CC1_4%>KAXlDLVJ)R$f>qf_&JO~U>y`)XP-B!PWV!kx)7 z*SlQY*r3AtWa{)|=ar}!QZU$gLSojle4fEOs@M7l-=DOvQcRhmKT;<{Yw%~cpvqHv z$_OyfL!`o9Cp87~uhkGU0YIa&74Sip8RHX5ePjT$T%2USc9eSpeGF|l#57qYx0hH& zr)U#IU@!skn&wTmuH>8>1ejFb#as!`b5(AW@((A+rXrq00+$wkX4OfnWNLD%ib-5#7c^46^D2c|%XUC=?W&fX!fsn% z^sqJ;8I%)CrwliG+cNX#(2x_)4H@Qrc_o+8^(n>{m@NIk;co|~J`=1zoQ zUPZ&czRR@*q=&>?77)??AR?e$fKLU z8FCRO(nHD@(T8Q#=w-~UzM?`Ay>e+MF=}FT#4jFc@qw?%7F-&!>QiQzvb}i>#x(=?TZ8Nv7 z1db@8B5mKh?&0(0;ij#Z{!*|FY1c^J*(R#lVv$QFpToZ9t|t*g65y#vHtk?Ddz)3f zX|&e8aWXNokob7($cSNz)on)VlOf`F0}Fb-Tu4wCd+b@PqH0=?)M zyXUxGO{P4O^kNp1nn+%}iZCGvDi57Hn`@FpO$q7WCgw8-lA0^cw;HWG1qrhB#~@Cj zwd)>Dg>mlhg-c7nMOZV}d`*axmz8CEoQxCfNwuY-YMZ_n!yK*o*yoW&KfF_^g-lsA z&V;j)r=l>@vR;CWY@tjP5s6Z{H`PHya{Wk7pf>PG>ZU0`aEkwgxpzcn5bm4?rJ9-A z!TSZ%%7r1=G)A#%1SS(pFGo>BAjpC)HLGA_9|poh(t3OnfWovbJ(lad&DVR&~+BZuMe&^@zq{ z>LS=(!n{V3(0Omk$|k%^aMquuY+JZVJL$?bvg*p%`3r{Bd>YE9e2B+ZAWun02=3q9 z3EG;fa4GlZ3qq)#<}++=>*xEzm$h($D^s$!yGj*vpY!EH^xTY%S-+&;du(*@xW(kS zVJcd;wf^dwcand$9f04r;#~uy)rKGxQy_yT1@=(--jr|yL<}AJ7*g{92tWD`k>!In zZ$X{ks9cVta$s$7==8_{qlCz3?v|leXj->V#%0Y*>1Bq^F!A1hW|Vf;Yt<3_WAC}L z@l7I-FMS`6a+qFKXHn**tCJ&w-N-kK2QraQMH1b69|JW*F}p_o3b0)F`i za`&1}F7o}|eODo|kL{U7U1Ug602%v~@L*VC_H7LP#n!2(k z76J0YyJaVdd)vsX!CUFU05MUR%B$uLF@ZZ-d{IcKnozN8Y1Hk9)e4^mCxVEf3rdBQ zu+eA<7`Zn<9+e7IylHL(X$f+G-$ryOt8^D z(0kyJUuup}s>Hq(!q!fOlWLK>G0Gm^X<27=Ce?_jdU!CMy}~E%=|L$VF>frcEF&by zRZ`$n)UlOnQz`9O)j}6jj>q_DSi) zpG0opMHPdVG8X99JSv zz)=GdzFk?DS6Bt+N^>I`y^Rw0tG85!5{{le=861S#an=77(gw=fPvJf0fB6t{1SRRBR-6Bc;of9qDg}RfuMXXIyvHCX{Hr=;HjoT$6Jpw3YUL@JI(!{Dm$^sW%;Y zHfaCKvAsXLs~zm;uR(>nu#_jHaaKj&tT_2E6C@q?IjLxf7zn`H%OJlm4=R+2y2%reo70 z^N;$y0bIqAgXt+y@5B!{wQ=}fZ`&2UmQTYs&68u;3b#l((gp*PrZz_;pj;)GSgU;= zLvalB0>9N~3&JQaTWOUt(>W5JlU&4aF{gkc=B=>N(sEJV7q@w-Q~YY$ay!0_xMgDJbQ^)7PhxJ-gn&q_HX2GeTcHY4v zL)xv10n>U{yp=-XWKX>%i(fN~2BGs0U2Hx8e!`M8M&zpKLF- z6~#YP%-9)LGw;~iLbgG7hQ%~YJ}I8;lXf=j)88ZfR~});=kvOY=p)#Rbl!CC3q;?C@(MHn`PvtA_LJ&jD+Ei{ePn;s(5*CU(aL7VvK53-p-s&{Je`v{LicUp0I8JOUp$azkWlYdFk=Fz( z&KSUhk+vai&OSq^rJO>y&=Z$^XJ~`I(=^58bce|11HmS;1O?KHx&;s~`G$os4}y7A zTnQf6fHzZ_&YjgGowK7l9P86e2++ zC@fP&_GbCnr-;mVR|2!ee?AHomGtZKyWoFQ=FM0UERS7>99CHs{r&3UWfwfebAQ{^ zRsz8_dE(;nv0 z3SZJ~`-QzZCFfFQ-gF{6S`ul<#DCf6{hmUx5LRTS^b%yFbD zV(!IJbO@BYSps2AZAxx}c94OPscTFU4AMT8;56*8z(%0)bDb6ks`EH*jzK!c2)L52 znj{$A>O0Nqe>NV>8H{7D9LJ#?$0Y<;k~PDw?80h+Z5*+O4rDge>!2dW7Q4ccZpJG) zSBoivjpg-h%u@ZEKH3WK9=L*%&1@f9-i8Y0LCkg}Ds0^z(7m1oO4in-4~}>3S_|dz(YsW=O;T( z|Ey+41t+zn_=+~g($|u>C?{astLvp5)9Xlxo$sGda&QnE0(MV7g3TmF1Pcfb!A<9ZQ!p7NDQtq z#as^@jrl{3&c)oDWOchu%=lL<5SINAs@;+FRn1&)JKEw>nwIH~HqLY%hXD(=n*!mA z5>DotRem?=I>u+Pf?gL^8c&5oB8=t&E+*8dt7ItO2m2fH(09pMZIOKnuGl4rCWEx* zo!IPwB7M$}BJd4B4J4#12i$8}@;#k&p)xOL^*X8xw>>jEj++@jSd4HVt$GdE4l}Os z@?=i#rGc?0q4Wu0Yr05!d(DUjW3}PgPWl+ofUPy#&n|R&8SY$^$84$1a4JCud}uKt zmJTJ6_JjWz?%qTYU_eHIA_kg@Z^-4t%8vV>j@VXL85E?DEM%~qO^+OIYPd{i@mEF* zyq?M__xM_G_=^=1Czk@*E$;0+v4>{pF-) z#Av$DoLO;Z&1F=VQHJi6$5aCKzQoa6VB@Cv$bPpE)I3Q+v~pnWW}fLx;9M3qu#Evb@ z`loFK^8!o6UsGTk0Q5LOWJ1V`^McpXD0||Snfbw3qeF8U31}I4<~x5Y=csXK{zcvi zAC!a`^)4DvY+KHG*Uv06?f5%b#3r#?iO+&XE$T3kMLCP9d`)Dwz#^)M-P3nhFAPXlz-53oia8#64X^BoU;5~cEtG&?F zu}n^|zod6H$!@>Wgh+*iInjsrd7UDqt?@x%`QdA;oatj ztZ@~$U4C*idP4nQYO~bl1ftcs2!x*xRTzVb1yoB0whvDO%CEJSa=p~+G#U1g&o10* z!p-U_1Wun(>g`1WXnnimcr_6p4d-|)AQ_C4qYjk_1K&HCYah!%-uVGGEraCt4W}mS z=DrW#LH0+ljdaSeQ(<<<);)N7;{;>{I3saPLh!R5I00(`d`KhR4v4C0(H*^dxI!D0 zlu|zt*smH)D+h})*JH3!Sc9QzV^-tso&AJFEc7Iz(ju@;*RJE+_MsB1uy3ojJVu1(z=v4u~ z?s&M{Xp-jJXR!*nQ+eIjEn7`y_VjCR+v-6FO0#02f{1ndK~LM2A^TB%_Y3g5h|-Fz z5*6l)wXT6MmM>bXrQT%Fi)i1sa0P^0ILfm5UaW8IWY7*y=5mOK^mKFux+%JlDycyr zo1H4$uJr8BVSAT=#apI~`_MP4?tC$(uv8Sj?7OuV66}hv(`dGp7&t(#FEq@+3{E%b zYu36>OtK@2+=MYb=@U4i!e}ATH1&z9SVzbO2KJJ=DO?82mH(9PM&(L`($XjntmR_f$&po&6^+Dmcyl^jmeEF)H2f1QCszCCo6Yz@b-)#2 zh}j0bReiAk*`)NEUC+Y9p}gbpoRB ze48Z+LCcSt zH+|i8vH~ouf4iY zA%b^XfzEw+dtr(Ps}E+&h}@xOIw-kPbDhgRYjV0Aow3_4p|AZid4cdHg;QA4Nc824 z*M@a-MNuj0m`dm(gs^D2B&R@0^H3pYCah(}e6(*=HKL%qt;_a>t+0U)n@8dlt=GFi zQASOlo85W^TE=UQsFRhk;p@)tA473xyep^LSX@3i{%afaQ+0|^<~p@G9uhNlJ=f&x z%{P^0f!ft~Lf26Gj%!m@<{HH1b6hi%E^oLAkDT%?Lv`Ws?W*%{biZvKDhyHr%X)@V zl1PNX95^l81tm%}uhHQTDlwGQz_Nwg>)ybsx@JOx`C@q( zOEO#1mUpzd>UUFFFuc2S{l(j~({t{uQxm3Wv?#c#I^_MXyz1^YFN}2HreeGZL~ru+ zP{h()fYJ+o7uyG=2Vm|m?xT+o(BIixy=3z&!n<;6-tpjdncGD#JW>l;rxc%?AMb(H zmAZrQU!}@mTO^~>&(ha7>Hf|Ml{?ptWMZ4er;Zc#j0aUw&O!F8H5&%#*ua}Z0aFs? z3M@dpS|?SOM=8E#s}lfE%;~Vxzr~}rQAjpoc!gqGNd0zz@Fg>2x)CI9ek3^c#=V{i zy^6&>vaY`O&eCe)AKL1|Qvv4n2!9uG&o=TX8U96muX+y++U8%JDsa11hq>T@ofm@J zMo@xmnentgx<8r@==ofk(}EtN2-9W}LWqI_H^KH|oppuc%t<(EHhR!=!5&9(2jp+_k`YSovnudO-qg&wjZw(Uc z$7`)hFmNt_eQPltQh_U&yUtK>@ze7P$Ozc&aBgMRs%p9RwO`Ldtmo(0xqHmUn<)i_ zs)}f}F?)sA5ZXaY_)~>Z1wmv%SKy@H0iqH{Rb(Hov8P{{%4^q}PQS@>4-%G5Zhy56 zX;HMNLidM!?1%F{wDvc{XfS;-ZEr|`P69VHA|b5-yiyx&JkoYVz0<(^*la?O%0WW2 zD)(`gT_T!tzA{4XT%Mn`&Go)b$*+Cut$v0ra{RNdEqI@1Rf$}70l;0g78ZdmWHlDU z584WjhcH}q^!414-v9a#`%XAuC4z5o!YISJsxJ*lQ)FpoE&ai3E!H-e5Jgv9K6HDO zubS`uM;D&rKZJnG86Yb7$?a8^k6B0A3?uLikp=%^(r=1<6%ue!SnF0nPt3MsfoU0b zJh^b_4Yy`bKuLRd`$IF};kT+Ik0AjTINGb|7o-Gm{yoKtyl6jI7b;BVDp3X1pPHA` zWH4u<*0RFbw4br^8I6kT+|Z9>H;-(+VqtadrvcD`p&EWZj&N`hhcH=U78pyGCl8W9CMUap!_`m5mKiAeUwB)0T)glIC^#3D^HewRs!E()Pv)S+iX3U6%5I5`!v=e zCmJZmBI1eU6zM<00hpNFs5<`un2hsgI}&=$Hl9qWWc-_s@TZ&R;)P4%ilf_DzE58z zqd+O1F6hC6GplN+*4X0)pJkeW&+)Bu%k%4yP}KfF7~%1rFPQV!Eh(W97ES8*1_Dz zAYyxnbc5qOwJcQvaE}sm!0eBkX93ErmDiXmpy9)l(Hh#V&jD&+~ z_u#aOsNNiP-o=SYdHN88$uS1(@X^lOAW)0?Yk$L*fv*%(mNL_+=p|vW6p^u)_sQ&& zgZ#=T3t-$h+URx6ufEV}jrleJUjTl{5a{j;&7${?&F6)cR6i!-CfIJla6Qu+pbcFts-4MPgL0m!mv|$(4 z#=KrvL{FBK3^uw_xTBJ2H?ewTDeeFehPhZ9LKHz0p_0bw>F#3KonBu<|KZA(tRbDl zrwB%0C@;@4lv)@GifC@`G+l`MP=b8{_e*aMBfAh@_xW_@0=&ofC9dNKc^QhgDenh! zO`6v8AsbN0Lv9vAL(;oKRdJs|k6tM?^GyR%OHj)YBH!hx+<}z4X7Te;lf{AY9I00^ zc*S+N`F=^iwAk&4ZezEA!4@&kFv2E3(s`KzsL25XI=}t%_H2hN>-SD1<&-*gd$#y_ zPmXuu-OP{pp4_l5kYy#y_Ld0t4@ZuGYx>4ZOQhU;A_LRmMb_;pU|#kbV)l$?vC|*5 zBcWLp2~oVr1A+rrij>7at9OcD61U?_`teOuE^eHow?~tRCfc!H#DGo*n+hNDb}_71 zk0E4PB&!c!I#gOSX;nl?A)1Cq+2zIKOtRzui?MqO7A=U<1buAVwr$(CZQHi(bM8I1 zZQHhOTYal$rn)<(qodw3^KrdoT0<`!wa(>-*-jkN)E z;XFHH^0~s7>gW&H@}GsQyt(ma7x-a%EZ=}F#@EL}@g!kfRt4r7fiD)c{n$f+;-y7! zjm!b`Ll61Hk|nYmC2lO3bzGl_8)ulq)2-I9gP~GYD<~MdVDJyl&qA7_W-+le*GwB( znEfU<9$Ur0OJ3C>pP2;qy1cq3dUpzp z$XxBV44l|p{P`?Xn*eWSTuE52JNqM{>}WjlMiZ$pZJgq+hZ}1?Gawu=oknx(6AZ4Y$teOcK&4s}In)F3a}>OAZ+Xj`1#%rN8$-oE71VSt6>MuJf= zf3Edp+<)0Fe%#95%|!NaE3sD>4+v+uekvhYChvNLr8(oyZ<=>kR<|Cq zQsf>x?Y%hrL=0Y|zyo|AKVKxE$PVtX)3eXk>17Vw?6YcG)Js$3Qv)j_E|U+Hz^HoHwUl>}2y(x}dd}lH=h=Kv4rJWz-Ohzaoq@Eb~)4T^hg=4MCPFoW}e~QnAEpsmMUh|ybldx>v zuxyJ(40%_n(;Kw81DTJOXOLliQ6@95$Jy!Nt1aoPd~kmDsdCXvIDwgOc15Aq<1-VJ zTY6Uhz)=s0su08pvoCFeO`6}9_WGnIx#yQ>v!@>X=z93lo^Vba3W4+8kC%~~X*6}A z=;TGwmt-cyR-dIP1_>5)**TRtBX4Jwh>TVKp@p)LqVf^Jk@IZJA>erCo!l6xPg-@k zO}D1GuLZp~mncR}tBEPwyWq@qz#`qBL*yX?s}Idv}Ei0>F!CAlg{tKIJbKI z1I?P&75*5(*4^XLCKYkbo28^1YGgFZE2}unG3-S6dMiUAq=yVi=1a2Zoa7opVY(;C zLJOMXt~ujF_KDRoW~AR5fDpziIWlzrd@2%YiKtG|H#=uRXdr{yY`~(z47dWj?+HRi zM)f|kw6q%Z&LbsKu{7KroTdHm!jA;9a7qI#%~n|OD9IGZ!^9<%zXbD_3?Y9k_?eU7L~UEM@`ztCBK{zwLz zYD&u>16(yBt9I12ryL&Ak9~}=g!RN&L0^GtF^pJSQxU6oB$NUhOhQ=LzQh`z&1_~ z%j^jJpH+@{WljdGKc2m$#PwDX{EjdPbl~-HpE@uj%Iy3Ibeu{_NG*DZ42<)cV zC`{+N=Q<2TN=sp8WWLl9z%%@d1#<*aWQxAd>*GNvT68eUfnv8zK$E!rUb7(1D_RYh z{#<+`;scs4HFLdM9ksGr>`~afv6Twr4MYx4eI^_!*S$jNY&`m0)yK$;D+Yf2 zA@|7Ds3*-;nX6aF>1i+&0hrr! zuP~<25JWHUwn&JFj>ApFgWpX$n2iW1pRX4QFfV++O|4K`+*~x@|7)iueY7QEJPy-L zDQUn1PF`SFgT9>Dq33J*iP5FqYC@WvOp^yYMY*cut`B&Yvp0WAwq&p)$oErX*_t@> zh6|pBVDX^-Nggs4Z)QxE+B~+b0w_5}s;RiAy9cvf%CBa(-%zNgJWef6 zXh1p(r=VpE19tjeCka#v=9BSP9t52M3L#E06lF3D zj@^7M0$BYR&{6!DonEEYq-ct}zAWXu&MM$y2tZ2RK*T;cJj>cYIN*hyfF%JO3Y{HLwOkXcQTC-%)Q zCK6liYNJd|5n`9AJlI!o;7|RUw?2TrH1ZW8uhtcb;ZrNN1BIZ@%%W_AHcohDX9CV0 zUP><02R^R0AhW?KNF9IQ#4pyNEd)%`V1o$L>q2&Oss_phk!@`?+ooH|y?-_f4?9JJ zRm~$0jObiraX#Aq4GTLTiaraJox8*G-$Y#rqqi_0&drg!#(?fLMu>K%iI0;czI1yJ z+w1lT{m)nLq#(C!+1p%}=oqLWaSIHj!=_3IzuH?uwBXBl`v(SV7n~H;rht@{OA*wm z3;mK)JV6#xw7%7^Mdw-%PSSmiW5TW@FKHp zB9KOfpCsU)sh5-b8`?er6nNZ$?uQ^6eP_>pf&;o$A2GPM*cvMuH4g??XxOx=kvB2H zEKf(@Ot=CT&PHGAa;@2i0FabAQ>@(BQ+xBxPJEzG4>acAS}PY9;?&u*{`Ua70a3n{ z0a!7g@=*9h{@Z8)kc%y;2yzywiTBN9j)WAcOUFZe9mtkvtI z>edoh#!VGq7mqTk<-18hd=atnHOX@x*LWxgpYunt7%QTt0` z{2|7$inW2DQf6jdKnoq|Y=5Yl8B^qtNkRr628?5P&vP}|?N5y8X6jXD#w4c?ZBYN*D-i>tWN!tPVs6Nk#IxZlkb@K;|*l2 z4%>jHX4(2hr%2y44yA3$_qpWUxnqs6iJEmF{Pp)szNV=viWnR1RU!Sv^Um-$`f>jb zb;IX=hzj!7cMWdDYw=>r-~xJGKTQ0Mq)%1(vyRPmUOkuvQwvR-j0Y|pD2D%)GLmBi z2pgfo#PUp4sj1nyO0&#=diI!_ygza6N6(1jdSP+DJtaet+*cHbaL8&j5r>I@2~te+ z>cv$vSq5OUbJWnW%7^M3rw6Oh5;=gKLNDJbYf);+IHT-=NxviTkJ;l!^Iyz`hPO{j zmr@@FCxfZV9_7fM^%(1QRqIu(Xs(t{U`V?+S%EN^X!5ooA_&b%^@Wa|BewdSy5DhE zx}{*|&v^E`6*#d^waZB6ih<+p#0Bg95kV!HNf|6$k;iW z4;(CUC_pM4Z8m>)m2?23q$o`kWC-f2Fh46N?f7f~jaAcMg(XJAJ>LD!f944O z?@Wpu$;X<-#uBr1bsp>t_uJC!osD*i9pT(_Y34K_&hOD!bz&=y^bhiLER;5t4+BP_ z+_Jch;KQc4*Tuh&?50UzFjF;v!RWi2r;v__%`!Xb+M_EuT-1~#UYqMB-DavHra1lw zC{+=?D3c-sy3TCPty;_ z-ekpdB=#j{UPEM1tG;!hYpiv$gA@v|J#=OT^I#UbVXvi~LcCZ$gvxj{ii+gfzc_X4 z6rifLdw;pnelgpO?3|>@YcIn>Rc6^nU5xkF7hTY^nVdHNNN~&X1y6dBQ)bACCSuX& z+XjM6e50ByHb*uGtgC;q?UFnI#2V(dYIlTE;0Q8_c1%_e%;M5loQptfl+PN)vcHmo#E(Ek9n93yyIr)@iA5oZbXblm9_(4-g%gltIsdkzWG z&%KKW6A|kD(L6~`8`K(t^pQ5oU$CVO`~+p>z>fg<^6FAyL-uJo>)ubDjih?&y|EEp zYO*mV>!CwfH4*$l8CZiRcdFAZf#>bl3e>W$y&lXQYcRc81tcd>e)CB0D07eL zbCM$N@A4C4I3$Ty*rIyeA^9Hrw3Rh!d7y?$$+K{x@DS}Md<7W^ zA3W_q{kv@i511E%jr4am9#N{n`wEC5HhGbfv2(D^$fFTg=siaPgd3W6JE$WJt^Q5S5m9P-Isrv1poW$t4>_BNBzSeT35 z`hCaPOFIqklPh+j%e0{@4LiWVxRo^l+~QPM1Q_71QzF@l0nM>HVr6(*6~SUwL`OdW zwN9r~*~>1F7(2uB2IB9xR>bPg30RgiyVNh&I=H>qSHylCV0N71=}ms-Vh+u25VkzO z)Xap{m5>23+8?RzU!NiN#pGJ0J=#s%2*d{%h4`QFTLCFb?@F2^nQ-RGQ;usTJCg*F z*`+j=ARw!qVtHI_BFEV8FU^Y!DdxJHSp`ahX?sYOI=3@*t;stN%O3A6*Rk)OaPIr6 zGk^me%Nz8(F_tJsyk)#@bLecH`$LVjgEq434{~B<2FF5yQFY=_@b;(C#KTRkJjf?Y zaBKnMJCQFXvqb}_%t#s(K*D9MEW`<|O-qx1-ASm$bFx+#qG&*JR~Mi&mN;dzp$#;- zffw1u0}fV|AAPjVTFfT(9Cp88Jo&X%4jn{2qCX!|p7Q31bl4{{eG#zWMq?JePR$Qu&1}wDJ{b!pu2C;K%9d@$7(f@hV;&2eERuze@>c1 zS5!gh>`tH*-J5!4r`^juF5QV9rbbwM24*9eVX zsUrN5xk+3Oiy}bJ&Xy2%!!Cm*V%Wc6?(e=N3}ukZ?84dP(jZ)mhbUP4Aif4AG}CnDWxeBt&`5Ix zRrT`%D(n`?Z?Yh}0|#n=04~%wp4gm8m3(FjkUsLDX%Q*}P0g`Y)lAY8jX62KC{BG5 zHn$Pd1e%+@9w+Yp^wD}xzlL&T%o^*k<2};xGtKTTVay8%aCwqZohR1|XE?@%jW1C( zf#QiA7xN+e#9hu{vfnCLrfmu7M||?LsY0=!QBazqmUT61S;?J^dv5%ia!+sQHfdthPT6y|DK6=IyeZqI zP~MDKSdZ9{Xa~etsC2Kxr(1bLi3)Ea>`zsQP<*&xX1DBjz_3`Z6k>7ae--kG8t48^ zj30pzo_EEa`!xSW*bYC$@I3xW5CeAFcj(M$jYy}7XD9a`W(ymk)MtUSwUcfGAw{;= ze3Ol)WtAAdNc|HP{P3K*Q!Ex!G0+;Pg_-=&!p^=FzvBStzh}? zRg4Dwk_Gm8`h-w6=;d>jU!#aGAPsqLfVZrl_KpnDJ+SAK3U@g`x!)wP^XQomFO6Ry z912oiI~DE_P3H6STBvw#n-27q^Ze+;GnVulxz;NI@tsc-b|*tz4iWd4K;hbs%<)8S zl2agR@|=gAQO&>}<|Dyt5glKf6CJmrfO6;IJKI?at!bS~BXRD=z`k6*i566ED(o3Z zqT0EswV+$}PK)tAY;6Y;iV@*~-{;bhas3f0s~ynd&^4r!0{A8H%~1Yo#>U)vU*E_Tnr}mVMZ8BIs@f; z#uGe?7jh*r!QK7En5erK8MQ0v=*2Wtyp`GuQYqiT@&& z?17Zw@(N~eu|zN&{OK(WYAE)m$^@dxt1?PM|D7mL@D}jO%exi?Z{&m6Wo3DqB5qz@8@% z0tvJXfj?ob6I}g4hDEj^tm5k0H4#B@@99z^K@ZjxR?>Sw&PGZ4x$?^?_wL-lHXI>B z2YdFuiXZ_|sL}B-Ii$j}No6^idBp#+p&b!u)V)oakdEB!>C6jXOXmQJ9w`+tIu?*r z7A?AMI9rvlmDf$@E99n5M1_`L zp2MFPh2$grq3hCnO^7wzav_?Wo096abgPgJIQpb98O@RNc7KKI=eU>eDK%I$kVmze z2H+p5A(3pTv+3uN^Cmwp1C`~qHr6DY)Ra@2o~-Llxchyb`7*%2;2!`Q6OV?&5vf~; zA=qkcY87JyD^+^4)rzL?FBqO=`gh?d<+#MIikG%RN>-FlY?(;6J&`N@z2d%s|J%7w zD?Ui8cEAoG$<)B40xkAXKf0Pb0?1fOhy)0bvPFo~Fqu-|N>VhSX!Y-}jLCV>lM;H9 zTTPegIMR{?o2p;~?FcPt0Uue|F_W-oh?>O3%q!_Oift^?MgJ7BIs}&>O0Jf|px%ir zbh3EPdX6rgs;suGF0iNTkwHVe#po3Y1|*Vg@8>u*ovda#nPzWYZDsF;-$)4SxuJ<; z^=mUWa9{w!J5}@WCI%0>wZJcZ4!P@6smNb3wU)dz9_;tF831bsoK)iG_IlB_COas^ z9vJ?dyT|rpO()-FhG3@F0s<=|F??mwG}>$KfVvJ`#GmGDVSO$!>&21H{h0j>M7a~^jV)oXztPGZ#i%YJe;v#Gk}ho?v%SypVDLk96VARtNQGcqg*X!*#DNg-kT`t?Y0 zYb_}jCti*2Bi(58*h!^f48+1vPQD7eZF7W!ANcIJBNpv!wW}8+wn$K%hzlWGH3S%M z!4&~A6A^`s<9+Jx!|z|`5IWB~dn(}wZ_;;8I~%9Ii&7@GRHbMd9vE{eMd&7 z?{A{}Ayc3!7_md{*pVPNms3P|=haXKf@)qkA)Nvc{U%$zqkA1F)@nJ%mz1AClCWm> z`NudMgVL6I7I=zbC`}d#rEA_`+ks!B;KAs3IB<;n1vXD=j{O^C6N6vBrz1|WdCZU$ z{m1WB?k*!T*5qZ8(6b2J7d(?Q$C)=3AiZJaYu;bP{8l} z<$q=ShH2O>n5S~U-3qO7`V*9QVQ~`%Hst|v$-y!s3ieg%F4)yeY&87Q9-GjgfUv*h zp8C#B6&)$#=L+n);78rV^QXwW`S`=YT#{b18Sp-CfP#cI-@?CpqVT`)6RCXgjkQh} zBWkF@{o?tgey513Lf*PnR^i}?7z z7}{=8W9Gb4dPOmvO?Q71xhWlEDiKGxfrJ3HMy}IBV}KBOWXxua%|ethLU<=b`l zT5>(#n|mFdflh)FUdNL~DUeifq5>AfPJd=O!{1etYxU13+ZfV~^LWj^s7#14 z;nx(=JRBU)o^A4p+l0e`3k6CW0B#h+kL<{N%wwt3xn;ux{DDSg>U=K(DYzFAF;rts zRN%G55I8wG= z2U&qVyOd>V4%a9^=)V@A#soKlmbT=W0o;}k;(^8wH*;NyL*OU}6PEPoBQ3xHq?)Zn z&&;LIi68dhEDDc~yCh}VZ3`N9?Q0Z|$>)X)CHj3ZHBDquCp;>oByA=mg^f~mX1OMD zYNl0~HDL5N*91z@dHQzocy;VY#o4{rB;3(=?H<9)#$sD}vI!iV`%~KBD;r<6z0O=k zQWLhc!?X*;9yT4Z;%nbj`P&iFyRhola~0iDR#Klgt`D$F>N8bEQj27x&$$XPN8az-YQ|P0WJLfAF+|6+n@Jv^?8-1 z4&Yn^c(zPG%vDUHOW1@c3fOZ+Y!uMQzE%mllt4qM-jSXAgfRXyPz6A1^38bnF43)GwVvc zFzF%)dnl(a?RjjWoyF?%Y8r@OmhpvO;luppZV0wMo58=V(m+MF8Fe?PqLDrlcAM8+eV5qyJ~e*ZHmXMI`eiP#_T;Z3p7)tKUxWWNWZJSF;}_7knqFhK_uN8y1tb~I>;bsV zjne)UCX`#p5A-|;lo~{5P6JFyB5N8-{yp2Mw{^(Qmv6n9*1yHym2F_@Pz_8_Wy?_h zHiL3yNJF78bC#QR%=4o_OsJt$0mFeu|{T^MT%w)%YQH1v0V zzW;mr*ElGoFNmsN9O{?L&3>DW+Sd%k$U0ap@<9=5DW9YwslRG07`4XBpo5!(DvAo4 z2)+D5P#4hh$j*;2io+rwo}aTIjs3RA1EGNA?L!FN(2mf}36Z4U(5b|HzpHd$moUW} zw^Usm^Q?Wo|E^bRYuL~yW3W|{5;fQtuR8SR>h`+(VUsAwIT(ZMD8E&Ma9DkuPhi{R zGx4SC_eGEyibgJ7ep{M*-*w5fK1N$j3f$hek*cK>w{2LPJS4YW&v?3|E6wd=(uB;` zYgNHyz4W1W9x<6fR}X6r>FIS3Akta3;E~IizshK>mY+$9NaxZU;dv0jK>Q22fz@x$ z#_SvP7V3)cTwgywl9xyB8{s9*{0O&!wiWv${W zKqj9vhkTjsQi8`btVPd24Ss2mFCl(BSgj`EqzjSnFWOobRjPbkHfVHg-OIY5ej$Uv zh?la{#sJ`8atd5!fqXoelq+CFNWuX{7DYq9P5awcx{8C1U=ujfS5{!*>~zCAN-1SO zV)gn0<05Zbn5pTahX}t*(F?}u)GBGevUzN;xG7a~^Q8mbP0TMUCPe5|UD}~}p+6il zaMOZyH|Y%a6GlZf2Nc4bN^KcRY8YL;cmRBodkN71>J?uTIfumNJXgoN6qH8H&AO@` zpe@fr=41F{YnIc@0p1q3V@PX+(rpjiJtgX>!$^OTg*8e+@M2ZJ=2Jw92~+EHqx;@Ho+$0 zPwWG@UNKy&PZ35RcOpg&6xtt5jY}(I^|e-K z()HDDslQ-NmLJ;hDDJ{aFqu_p6CLYtAeye#ipX@t18Ch3;Yr zE0f741Ed;9FVgXmW?1y3Od5dO&KGmLfM3YgEKd#D?&6wXJ{iTrz1X)w=1UsHho(B| zDquyjC$6YhOo63pK!aPxD=Am8Mo>3}htp+)ilQ}7gw~V1i7X!<85oKisvFh$I`==cN+=?->kKom#9>}YP zH2mkC#iJ&78rJfyx=-j`>5_?a(sZm4m@0=gJ8VTrDY zv)t%~0EXIlTCy|%>r2PaB8B;o!Jr$RW-K0Hl}HD^lbxuEV)BGC&yL<|?S$1Im3aHv z%@CT!AhGPcW7nG5uF*xl45dynT>qv>bjmw7pzu+mocy2g7S?|piM^54e+zFB)DltD z6#Fl{h3Wr>x3K>Q-on92z{tw}pLh%V|HNC^IQ|1(`7gZXKezuKyoG`D|BAN=(~Hqd z{=bBa@;}5y_5Z}U*!=$x7YBL=Lnl)^8&flv|7Yd&AEXSu)l2rSrT1xO(E6D^nV2~ z0Br;Or(N_e{?u-i^`!#-q=31xy1UhVk^=^eEDR4Prf05iZ|9B=pdJkz?b-AnS$xX- zUZnklWjcc!VFA9*VVXdHgkvhZG3PM%j3B?%19m5Y5?Yx+H-ZCtb4hT2ikpCyA>Du` zb$^sGG9c1-8Et<};Q#;we^W;mFrMOTyBZpJ`exQ9c0euuDML_fE{txDpnx$yiGjU= zW=p?R2oMO)u5LfM!uz{ar@uw-?&k$?doxeA-M+Egzpqh&;lM}F=5l!kVw@-CR(&foyEy+eCaKh+<9Tua~0y%&OB zOEQDItI7LdEaJwh&h~)vfUsc zWoWKz1FUhh1B}efjO0bo>}eVt9)Wl?2AQwJoZZjX0c2!e;p+6!0f?)k>j$(4GauZ7 z9v^@(M1P@uLpuUyi2f4T0W_}R|C3wN-u}rgfDF<i)!<@^z_eKg5+h5Ac#aQI1I zUHuH1m;$m}yr6@)Lwq3vPHpfXzNZ7WSw8Y7z~;z?*=g zzmhYNuPx(sN&hSauRFXc!>q0E_b%<3;ry2M_v6I&yNA=xeZd>zRQ(dW{?Oy~YbUQG zp4lAVp}$rckmdYn>DNUjR|Z4h_3~qb@+x3DtG^c4x)Dc zwRY&+!Sfe%@R;o-$k43i9}Xn;1kC+Sz37dnKHhD8;&(@!{PTF}kEj3BZ$&o)$0k5a z&3sq5sZRzqLN}v^=S3q!vlnUp{{4Kr3-dz_c>IU^j^18T5gguL4DQZ`x#2z_o)^yH za?f(_<(poA(VtiH%Q-R-e#8H8*PROh;t3#&sD_3s;~`X|v?V0aFN zz9$deVskdmsi6(fpJ)9 zcAmvMv+Gp@i3MIRyAn&>!7K4E9f?sy>krBhDw-0&g@~_+&T9-HXqU-Zgr&;Z8<9e* zwL#!i42G-R9it%g$khWe{AX%>T-}G3LdDRz)~{g&EU0})Zc4h9S%zr1LS;BW61P56 zE(ie~^RGzDzT*D33E5!m<@ZZ%n6NH)E`0<&_ucC>wb-4aB*_Yx##O{}b20SoB0}w7 za9wWKFv>j_wYnBGM>^y0O^|1~rUmnT4(TakcH1;=hh|+95%+>=ESLbKeEreNs*3y4 znvx)0ONDAIPuMq?;lZfcMkAn8RcA&SsTg&j7oZ36xldv;%omekBve`AWow8Vp&M;&ss$qS^hoTC}>tcsrP@Ty-{m zTjm9foE0jdLs8TX3AH@_^m$GqAi_)Ws1=3MY0)uwPSYM45|AkW2&7PfA;`#49`KbF z7_3sHY+}`}(9oWW)S4F|xN(G?kn0;}VK=Q}ikEj+MLf+issvg_)EGp1A{VmfujWqR zsKQ_k^`|WZlvoBUjsxbwnQ`-PCDR&DQ3Zq9gLxGK~q%EaU)q>DK)UIo^ndO zU}^CorlEWC35`+$t~I&kNhKg2bmixQyRP)84gsmcL>6T!p|J|kld*~_}pP;p%!7*7K1!}e?oQH$>T zw1omSvPSH<1LwLE%P9N+y29>tR=QP`JScd{#u@iXt0yBYuimC*%LX-K2f_Zm$!m{~ zVWqTM7iT`iE%h?6K%e!UVna4=h}VZ7HlfQ~h>lwo#C>$eik(0UQFrEeJV;BMkZ~Sk zEOg!YsGfWQY1L)7q8t!3f=3K4Cs~s^m<`H(R6*Rq;_IWfI6B9&{_^YFx@|~>T@PF^}T5e^P_ZceK3y8?E%B*m%9pl#RL zw;0hIra5PvesLQVY7~7?4pDi$6sZ!M+i*J9RCc2I$J$wMbWXq&x4Wm!+2aqaVl3JF}PYbWRXgdd9E5mnHTD5TUb9Slq zfU+|i5)nxbEifhOz?HLytn7du$U~}+tA~I-O3-8l7ngrhbeh-3L0H#nk)f3Rw>r#) zcz7mna%dgrM!Xv=wl~s7UGG!r)YqcoXL4H@qH#m1inYx)nO{T5PA+AL*asr5H1N%a zKB+rDBm}oLBWWdKw%@0nZdse|@f2$5b}Le6SD4c?tN2}Knks+3g}xhO@=fh&>j~Z# zTc``}qa_h5ghlgr(;wDiv9}{ji}ig!Cf1>$%dBqX!{PA$Rxj8n zzVFiNd<)AXqW7V=yHUmSurHxDIpg6=_P!gXCfXQNE&KTkcfv0^M0}nzZ$o4fcvjKp&ix)|>PMb7CHWsUM3TiYh6g=}({;)b}~0 zCYU5d#4OJHJ`I6dgp<$=b#HGlsHYyW^PCJ=|G`cXCB3RH!V2)>il{7T>(dJmrA9x|1vsSPzvAX~*Zwy`ZRS~FgWdaaQHtk>nnp&4^ohs;95#2WbLX}h z43)33Fi}3DVuXvpRxAtJzVi}?)JVNHZe16F{^uS6%wh?&>wK3dNVI2goQ1vp;br3(eXm$*0nNL4_1wpYDTIrVhK{rqk?Gfe>lX+n0$=zcddvIeXxMaqWt39nBC3R#!r*x1cNeDVkGIE z$>(lD^^3pJlIDZ~rtL(BtjP!enp}^pzZh=ZhogOJ27_K!At9~fILJ@=fQzmp$AU|(GtrqY=yY3-a5cow8zYR9SrI$ zn_)(|x}gKQQuA=5U!1(ieOBqce6iaEBSeXrI!?JT$4@?6VmswJdbEq%td}=i)5LVv z|4iOf&V7xc8PDp*g}Sb6cMvw_Yt=RDGe!MXJP(1V(*27u@Pg{ubDIC4IS2_J;p?eG zX|wCmqVuO^ZI@7BwIzE)lXgCb7JgpQTy>yCnT4E3;XEyuMNGLq=g()m8-Cb?R{>-! zu?IhS^w2J)0x{;Hs=uhe+z6~Q-;me9%c`dT2HIjo zp>NHnMP828%3QE{LkIvf9Gm z2s}TKV4gK$#n{4=1~Z8lYI!l;`!{g1SFm)DZBYSdlELuOB_5d9-S>U8zgIxgnrOSV zfZcb=#I}5j*d*QBo1oo>w*kkCfkHs@bavC)CAKEzh$*`N#<$P{PyVJ(0u!ngm1$>K zwxmCXyI<5&GcjNtteTk$ExU^DNmTON2>{)b*gsia0n`%ZfjFpeO@TQnqur8od@E|- zfCQ;EClSekAQqU!*Oo|px{SSo1?3NnmpAeyWqF7Cz*P~v4YIIG>VCdeo%Aa9hP*kA_O$t_aRIkYVZ%JQuJu7u}`8n zPpAsbvGo!SUg{x6gWcD{Vj`EsPj>~}nVLtg-hONn(5HXy8=7^fnKQ3oa{2e!s#J|1 z)hQ6SY0>uTPOlQktlx&yCgE@07qM_4?qTw3%(5OEW1qn%v*Xs|cuOIAy#4@a@dPT^ zDR3|oyB08YdJJiB9Ux1?PK`l2rI$NmL>k%RyAHAKQP`i2AL2Y`-Wn@3VC#ZB8tu%5X|z)erDTyTQR$Iq)5aN_b2*j8Z5Brsrlq(oq() z3}zwv<~1%y8GkKxObg$RbJZno=$!A9P!8i1RH6Q@<(XcaeOnWY zLT?@lJU1Tf-mzp)3bAkdGD+XS(`m+0<4Lzzi5&GxW%l>IAI(VXOc{JjoiVB4C@BKw{r9u#n<#JZ*rnKl`pv zT2G|yqq|IOFXsXQ%U4R*j*E=<3@ejDD=2WbtTW-E8;HvnSfR0 z1OS&3IrfKPhk8OzDzEX9`hCUB1NOrAlc3<>F=h4! zWP!j=M$nLkPI@8_N@@ou8!x6c#72G2PYwcA#6j)Tj|+kA3bQc$Jtk7UL6r zz%}D%8rLClvP$LybTHP2)N^9Kav&jJLYD-h#kdfBxI=Q`7|Zc(uWxqvi!kLR9pA1*whE}MQdiybrxsRk9fD)of`p?*63D*su_`-Z+s!ntN6DdHG|XoarzqK(&Hb! zTBn4C+DNIT1q3>Hmmv(i2uLvJ@!Iw+qL)_`*Qwg0T~7jy2B zM=)%3p0MHV3?dVhiY&4gWD{R2C}Iwh>L$H&%LOU0%+*|w-$nzei&2tVLF+}EEKI1w z9-WCYvv?Wa$lP;9Mlw$=6=rEBIS>B=K@{^1=Oh&7P4cfPvdJNLdAw8DXB*Er(T6>( zA|Zr(v9A3(*(Og1DGcp?hfMR>PIGQP0p{R}j%VRVQW6ylfU|F5OqTYt|I|a9;qwV5-BAPXgKy_kXWkq&!;7IYOTYI2t+S4) zr8yk~rB;Z{4k$Rph2I)nZr#*>D=Av)<<8j4NWyZ*hgw&Vprstg8<0 zl&Gf=tduvw=rrz!rE_b13;yXQ6}tAjl-rBU;A3jA0N)4(?_{8p4}C%o*H6KNgsR#q zQtC1eg`bX;&0~B-y~&a&L-XEN`CP;mM*o#dx|dvs#*-yOngQ@HeoG{=)HNd$X4PH= z-2!ntjlsh1(U^~Uk?UxMEYDrtcAZrcfgjbd#c&~QP|IK<;%T7knh~7Qx zjcGpP1irg&Z&^CAw1a>w$3n>ff^PZBE#*?2Hk^M&4x{k{kvuA@qARY|o0PtR1;xOm z(T>~63R~4Gbx%>$kS?gjG7z` zWw%+D(5*@SO(_L4u05_*w*AY8+|Ds^Q*k&b-Hjya%rD!stxB=_9&AMIUOVu{h6WI8 zQD>b&2s%1eCv23NjVlgDw`XqA%RcyTI&c9r)7hS9@2%xaK8AmFl;qa=39*_d$3AP< z(nzca(v(LpW4am-H-T7ytE5mJ$U#boCB!8h&PD8E_=vnT5C?B+HE$rO3(qeYqKQ+E zzLY%*>-qsCGtZ{K{4)3>p@i=2|5}LN`lm7iu7fA>$u3Y%*opZIv(lTo=&F6*vFZYK zpRSh9ex#0uNNERKzjrYV10yOfl*cM>5=$L#4BLKq$R*8;T)}3R;Sj>KfeX&!JrzGFaEbyC+RV!wb9fP_Cj^ zGeM=%vW^-6m@VQOe%g4-IF$KU^7n3EKaNkvMciHabdoDg zBy8ot9O>%5QXxgn9j7g}UY`50Q=K>TVhz>LI#ETxzuGe0tEmiG9fw%&f{tJgTc%FB zQ1nZ)_+DMDv~}q3hT;q{q=Vg*hHD(`H7^>d&X2cqZEjW5h0ChA+jG_!0Ob(*5Oo*} zTEdeH@$ffIsjI%l(Z?;svD&yFj$HK;99|{WCx0gRWqI7td5K(rkKfE%jb4DX79UI^ zVdx|{7e?wqcx|9Dx6B@X6s}lm{xM|fMNngi@)t|T2=X@9KE5?tw8Bypgpn1B2h1i7 zLXe@;!UiEBP1YEhy&A@kt!uq^Z{BUBi(up*HuXFlHy<2o?)JT@snx{Ebe6L?q2+FN z@<^qd+LuOwGZEjgb7M>Lk!`HapVti3!&lAdR83j%cz0Tj8!f{LXZVG4;x2yOY2UZ2 zXhW;|NLl#pmEF?x9gJbLa}*S3{`KhLd-5@M`ifT{k{c6K{xkl8w;5H)$gCS#z60`7 zA(I2j6D+=_TlDi+!(W=23|uQ+4p|bje&jsyYnVF~A^>sXMxZ=NSJ=b))u%eI)AlUI zE!r3e!j7cb1>Yj+ZT35}%%vD<=%mc_e6R??&IcUS3;9}*2Q{tqZol4rX z&h;d2RxAf72R7Hc({JkOv6RupQsm-07BtT_=opRvt6kIcXW$|0N=uWoc~d^T+&8Bg zu9Q5gM=y0nnaz#$vCW9<&%+eF-ufy=R4MuuRg7@oIc$v$Kd_YMGF@9ge7fd)`|gZ- z3JHCWcv`6(geB&jia4g?OFiEP;a_FZF6@Sh3ChRkL#G!DujI33_9zinS*BdT z9KKP+GdXfW(^@iu!a00?_p4ZyROk!o=r1wd1yM1~UsaI9SSv}GsSDg?Qj2#?440v< zXB#hr-x?&;q;$7i^vZW3u=0j~2FP|r8+Bc9jq(t3mGMYv@YPIeU7xI$fT~di7w*2p z+v<%`Yuj@wU$RT83J1mQz&SkX)N+J)jThxy-@&06?f!rcab}^{K5NskgAjSIK*wpv z_$sQtu{-4SdAQCS!8oe+RghOGX&Twh>MV!r!#bmG`eh6mT}#K0RQzKlmh;_Wj|7~6 zk%9}Ld(W>;PK>L-%84MNA4Q_0bBMa{AhFn@gJ^dNap1gS_Pe|tWH6U|!o8%uDe3hi z2PXYa2xe90;`R}da(>EwShBcYVDEZFu{XWtUNH%#sh4sia)KrB%5y~3hp!rn<$x~2 z{V8_Y9CM?XbhS3diOXVgFv@6T-O#yInONqjTVw&6-YkN4YRpJ3XvSF$D@dGFc2aZA zqVR+~DH~iE{pjtGV}Vyvcx0-hdrqc`ZE$VG5oO)+3$#s!OsL)@8TtN11y2yBA`I(o z=fGR>UYiN+CGNX9o|E14Z$%G*byKQ`CWgrD)$VT`sO~p$9(61t(+-KhxSGy+rE-g@ zk`&hsVz3WqEa^zDJz=*+*Rx)jBsHl)IO=)W^v(cz*oRd&hDyE1lUr^zpipVes)MTC z-!s0-z;8I$NM?#B-F1kuwlo~w9$E%*I~_;z>0d*|BgYYN#0reXAn1EAdp4#N&@y8_ z$(Z!>)Oo6WjC80^J*&j#=th(KI0F!X|G1R@>@#XwDCt3b}fZfi%&^a@l6rF{`-1v!0Hb{S7vRcS;2sIN{pNXvRj zDNWv}t=GMMAai1D^E?v5TBzF)e1jq}AO9GHu!U@JB#LS@9chhxmvfwW!r3C=cXgq> z&cXSOR)qB_=}og3Nt87~M4fEGET+~}k<6JR!iRzcD5tkZliikQnyDv{+O&>a9Qxc> z-7m6%uT^jvvTJf_NSYUK7eBl`9kQv7Wigq0C}@lK981qT3>vVic@+DepAlZjKYAxCyi;awNthxO^mdp<;+oCnRP{48wL z5%&8+BrT>tluPJ;Em~e-_v1AAXUQ~4h%%yHML)H8oGRMMwp-g{)eX!lI!kjoNXWs( zh8mK_G$U-?3^O^@y-!?+AY|plCvpkp-~WmgKrgkk5aSs1?_d$GLaLejap(wIN(EsOhAb{we2kW;v9FX9-o=r!_h3cwsVzb#FYy6{L6kCOF~f z6srK2Lzd#!HyM7fN=Fjd4B#>(KU2hvR|b z*$?CbsgV3N|0ILLF;?XG!-l}dvG+6nBSR^oac;G!5ggm)vsMCdC}gNKDX4OEQpyjx zlGW^ly&vw8I?rXbq4Y?l_63nJWu?DZ`k!KT`bmdv()#OqAJ;8XS}_}wo0kjTaE<_y zQB?S924)wH)s=`^Mrq?|cVmCTGY@0LZh(yNa{$pS0sryJ z=E6~8k$!ccGGI+w{O1VmO=(rC{6LR4tzp|PVRnE*(Yzg@!lT@xBI5d2Ahko&lflBl z>W{X}pv<%8-3_A~F~M&K&M|PLy%rmh_gZWiTK9YHAu_EQ+JQSzU-T{l7CduQ!yNS` zd4vJG8E)ALoYNrPs~_js(-+ms07M)ol{=FUrnL5K9~e04^v?$hyz%#?TD|Hv0DMJ$ z=DTf)6!uv&L^XWPR_+&va~Rr___wP3cP*TGf?o0gXP<~y8D*9%mq^0Ps| zRHK;(WIto~TaJb+a$FF862yC039xUvdBFi9UrT!>Mq&6J>P`egokjPt8~0b?nTADf ztEvjPYUkzdc2(LeKv1BPn)#d|Av~4_E7?uJkoX0T!M|vzeqe|%Q&sl-?3-KiqUT#w zU>eAqXXUTS&o-PRJafzAK7M!BSfJfKYB)(DDTGf*mkXTi3oM|^8Gz$}&Mc8PW-xxY zMRxlu=qrq0;r0GmMMrXdc#+xrL>_&)de_U274g&P67<^8y{oBngx17T51 zh&7~ioKeD;`Hb|M@ewmz3b3XTkVZWpxD{R%*?bG`vEPWDYDLyLO~a_e$;J0mP?^e4X&}X zbvm1r$kOXL>e@VZ-bty!n%cxoqiT z!)0B(*u)NUTx>Py4Z^}Z3q2i6yr0}3nKuFLI0$B#Zl%lOZBR1O#Jizdcdm@_3294* zrvg&>tr$qrdk9=%A^H4k!t+sC_!tVbsx!JF_(-#Jg1%B>->M0;D}Sbpl;daQ;$j(D z@_a;qPMe44hpDiITl|^2KJT6>O^%#bV1Z?DaMn<&c0s3SWVI0L(STEKj6)vI<#hoMNg|&`W#)!pD^=j2aFeP&8}3u-t)WFWr@a=VAV0-hL$>IGpsJi)OYTOV zZuj{W_(UlC!8Yc_Bbb_7OP|vO=reZOFk3QZm>vGHw^X|!kKqncvT(_TCyQ?(85?8x z+V(0*1#{sNZdxez%VoZhR4ukJBwJQvkb@?!n7rM+G^;u7xYTPV9CR>uiUa1{l917P zs^`1s!lMuZ%L+&cM~am8y@CIoT?y# z3K%SPLB?KX_O@zEEJbdZon)a(ZBJH1GeAeV!wA`W&68n{%VDzh{O{Yqdy0YuG$uU5lcFxIvg;2 zbYgj{@~9q+`pztd1ZA6ISrz`r+dhaal5Cn*LJAug{yjzD<I<(4PkpgCUr z7A*m{NFT9Rj+tn;+Z0WWz~~ZhNUeK*dF%aiD38TlrPbA?1erV0%8l7FOnpSq0hJ@YQh?6QxR6v?9>4&RyM+kAs8?YXj{RD?*-Dr~Uc(Ib@b zdop);eRSa;>i|?_VG#c8=~C&^s;-H78N{vkD`f-lt4jToPzeRjTQleupSIXJ6vuA4 zq*htTcuEs>n{2{V9;Oa?zwO@K_qq3FdTi%k2zAeUbi2lEl*U6AHnbKtw-1_tozz^G z&U&x(Hb0%3_Jlg|opoW_lGInG^TOf;Om8(KaFB3WHu&f%g4ts@`p2u$uhfq*O33lv zOHZ&xiwI#9rua3~kt;h;*hdWJW)U-Y0s>i5-x7JIvd~MAq63k#ut6parWB(3dCrF1 z1xBoGv!rLUsPe+ji2g*^7?@O65-V_S5OqQdPRtzl?$m?R9t%U4*dkF~O_CIRpdKrN zbTaN+1ARioeMfl{;h$TO2!TY_kRy7I6N;{l+hP2+&ST#9vTu5m2%)W*KYgl#3!>Uf z47PZadHW^dt3vV8jOQ&ouRfXvc1_U)uwUy`))tLJ(Qk(6xxq2t-8nNgef;D|jPW|#`qQ-PY_nq_ z8RjioA63OV3`zoKf>5ONe%Y7=MqwW&F(FlT>HtN9>$od`teN9 z0zem4L7tXqng@{nH!CK$UgRE*bCms|s72xX#s`GBB(n=1^_TYjv%cger(Rct<9%+k zZ%?=&%M)A7NF)$W)*q}B;d+E>Zk&M0dBK_&jy#UGO;l%#b8xzXKN-+JDTCV3qEq75C z^8>ea{?Xe&WeWbjyFKIvA(2kgvwp%1YGmLjQ(F3&{?!e-o&S2cX-tP|3y?mWDNd`r z$b%S8f|HvdUT4pzc-E0XtlQZPT@h*=z+d>8Rz!}7_N-Y5VtVS{uIZvr55Fi{wZWNn zywh4_8k%nE#?7B1HMN@@D(?lK7^`agV^cxTSaFIJgY(?H3kZr7;Qdv;RdpeoV9%FEWIw?B`67ATZACiz~u>ntGd;GPF!7*hMcYJ1qmU%z; za;RA4Sj=U9;Vd=B>uFCNCM_d~G_!ct?oMx3k8=_@vVBE~^`^@(qq>DeLRTKTK`v)4 ztC@+T66N>kyMQ8*9Cr`3hRqk>KpOGssgmlTVT1Q)XFz(s`s%rVd(_Xr5@wX~88V#; zq40Ua?dD7#=FjL{fFzV9{7rls=N-r7}| z%Oaj;;L3Alz4M*>G}uie25lcsPX~K>q9~&w)o(zPxch-Z%uu6X(e~)qaUL9{F@9Z` zZ$Z@~&%^DHw}HcO8~swg4-Ny~4g(uYd0J_q!d_Coguba% zGMD=md0Lc}i_n#foijM6pn!^FR1RkKZ~Q{iVfYYk*f?`HykWMj)>QeBcu>O3};Z+?Ko_ zF15MP?6@|o;iyT(3MtnU!?QFxSScGVu<)KtMTPaujW{b=O?6#40bHhyW9ss(zz&*^h79P!k5*q_u|4se&bczp4s7wG^v~55OTU9)vQ3Be7STQy z-37Ooe8FXBzn%VkT;mzI?lJUC`)-4enIH$FG)WS2>S$I=Tn+O)rwt#pVVd8=c{CZM z^T{IaHk&xj+U%$PP8ROlw=Z)D8zF_6%r<>?jJe`1l-shdd_k$7Y$EruJtujgx}k?O z>H=bgKda51YK9v*Nqeh<8aGL0-^bf)z-q_0r#ehUej?GEV3F4)<~)nFX*Lit9Ctr$ z#A8;~ldG+KT#MfGDj9y)K@!#(YS>`=;6wIgvkuq~$knffOkba6Wfsi$>sezttAl{TW(?+CvbY`|h_rOB$=G7J21E$JH=Q07v zj@M50T9-Q?W7LPA5M9)jOKjTghgcKO5cb7(p<^q^I0T}~TOw8$ix3ONL8i3w+JoJb z6qABIc*dMB5x>G>m+;!{=fZd=Bhe=55J8zznmYxM*S?*UWsW-kUEo`(l8SW9ooP^9 z?TLebjwwPZaZq05B;zG~VvLC|8LntT3BxMRVD^B6OM2>fnOlM>XfHc=1&W;6+UjobV7$9WaBL_Rn}Vq%MSV8DGyrHV8p5FiplKWJHV>$ zn+M6d$B~d(Un44OgpD_QChoM>b-0D8V`5$*R@bH1=5X_zmjRzXSBHt5YH>x_IozJq z^2>718a0F`Of31SUj=s`f-n0e_uel3aBNV36rIe<1N@EfvB%`wf@gi@1|>>YUActz!A9QNceaX^|t@r6zwtkkxACd;pdx4&GWB|S3dRRWN& zPE)N86;c>{+v}dUZy2J_|9Hc?iO@{%n79;r{T{x$kvCNGy^V34fTxH1+Za_{5nQ## zZI+MItA$+_lc=8DNN3N0EYsE3*WefibJA=JSJlsiS$9fw1RrY7S8>Mz-j(hPla@$j z_p)R}jzn;$;%i8MY*r!NJ~rJ{h^jIRnS+1CS7+KYALK=DIi~3 z4oaFb7Dq$iB_FJ7IbFaxWtDeHJWP;+|IupkK(sEmWM({@X@6T4tZj;cA|1BZh^$mu zq%RtEt|0?G-&t6mBn`vT80aq_@U=MDfQKD^z<1hXF=Y=yjqicCOo8Gk{HSx+m~N;= zP=SEBwmR4k9wXDPU9i58yuWkP5ALcLobtCJ(LV4EFWVMoLfx3d8wA zu6JJv(qpB|qZ{Q-ZQaa=nQ5v&Seg*K*uK=_+r+0;Stua7E#>1n4q;H0Y-uzi`5=Yi zh-oEp=|ud%b;_%V`~)j5EghV9!Q9m7LHzpREsk;_)@+T%SIKHVZ|x(RT7Q%Vts=z! zY+ATRPQmhGoGJqw!)RS>sQ$rqNFo>(^Fu5*$L5M8|_ycM>Kj*35#}TjAoN zj+$~?LXyvP2Z1z6SYdh>SlSE>?>;#NTT+t|g=fA|UCLPxR&zZQn%Uw|Nv7FBnetj3 z|J zhlJ8_Xm~v5dZYNpCkFTrlN!)c?i#T7-s`<&khNFQ`SD(~w)90uXWVw*CI*CvaB2BP zy0;+BL788*Miriu{qh6!QbTE{g84{JYm@ve)=D8%OP@@=aD|eS_Vjomf=5^CKYLOU zLH^?B&=(s~j3~?Br>^_%U1Jg!9JK1B=R{VBGRtTc{Ft3w;zdq~w=30^blX0c z6bAfugr@LdR_F39sxd}TOU|GpmfMfp?j%E=Wnj6Pmhxo7WX&Wi!YSl%n+u?aon4;E zFn7g`?QOv8KN&F7j8+D6Gptglo8}vfu;N$uE+bcZt5c^R*iE;REx2rMDeX5;G+z*^ zz(Ath^7EP;z_DX5S~Dw4Yu;Wwzx0Uqf4sq)i5Z8r|4I&J>p&%j86B_j;2usqY$3Jh zu6s)I5b;2c<+7}tnI5{5ur@4~u32kmbtE!YZA@8g!clH(Jujp=%GKF<$P5cL>TmRG zQlF~GeHKxL=&C1?q6ua^irFiG*z0jp`$1?jc>U^!_KS3EcGNQ}JJu@5wdn$_339H2 zQLgTwB*|<;00FO0EyJK9V_wmTqgzJ~xMcTfblAz?AnB=?E!B6=83(W;Wyjaqy+CA< z+`ZcABc(so?)H8__A&01BR}OqaZf!+PvPnEoqmpTJmm$kzm*n>l zqqKYW9#fsrYF9Wa48b8#3L_*zQM^?;zrTSYGSO8k?jc_$Q|#1*)%cT#7ngV!EfS7W z9~Lrpi<^80v42~ndO`R40bbpU_&sD!Ox>x4rX05%*@#mbu&KApiA`VNwHM30-lEeA z0IQAG&>13-#5pB&z`L^sw-j?kFjR=k7t;61R?`IM{M`ZD!;aO=o!Jk~q&~4mn;9CF zW)eBOmFpRGaneo^*l%)y+Ss>&eRfl_H>TY;HDw||iai4-7&&<(`;ZAKPKsn(>D{K` zXTMK^>fPPc^AjGAIlP#mdJ5b@-N~*80-iLKBZ>y-*ZZHe?ip%NMM`>Mj=Z1{=@VdP zkM1vu-s4Li^jDZjm8o6?f~YMxcF+Kq*;i!lcX{q8f^&Nd4!CNR6kj5G8sKUq z-#1yR=;w^AO$D^XHR)J9>N+<;2|wa?`S-%2#k3voQK+2Z%uv;J_;H7jO)^SH_F0O6&F$_2^Q z&W4jSBMXDr3op^R;-y@#?)g$;Jeg`P6YKEF`L^IJ&~Nt)=95HB?Su|e&_#d5<9#xU z%PYUqQk8#hqbhQLjD9D>+ry$gW4m!Fy3BY>e3GE<&O?7#dUCSO7plVgbo3QXq?Lpp z6Wjs_pS#KtkMVC2KYeviqr{}y5tMBl6`!ZL2rMjg3r#`JhQT>cW+c`6{CPh&{bdhR zb3ij1tM8MPalrg@&BiuwdJdZwU$;6eBNumHnS3|zg_GD^?O|zZT-qne6>=wsqLty@9A|TG(U8(GSIg*rn9`=iR1KKc+U51Wr1lII4Mql-FJ71XZSHrmDTkei~Kbv`7sO|ag#4M>NQOF0bjDLd$p zgXSF1NJp<^M2(!8&mf9nMCY$PLg%*>v{M*A6OSK$c=-Sb#l!%?+cGdVK`DoBBH9(z z8@Q!OLe=Tv;J>aUh@cG`09+F~1KauNhn?X`=4LwMY^B3*#k{|5tnW2nH8!>qzYmgF z?g26qx$GzdaaR_!TDTr`D$*!Bwk1^1PgJNVr%m11{R-Y&JU?W@L8 zy!L|PCy^-4o<2DUInpNCoSi2#wwe!5dh-Wgst@w-UW_BA;a>QPoTRyDd_;(;$^$-( zb^5v|W9yujR5&c4V{bT~0bi}|(%0L8#0i1EEaAsKbudcp^K2N{&Wp@s8`zL~b_})X7{0plsOQNw0dyH>9W336V;8}Qq(m)ujwRyinU=W5`t!^#NA>{ zj{#!MCm4lI_zB4iP=U(V~3t#XYMsJ>4UN`w%&jvvZAcb%@En(5vX1!_oIR^7Q+ijsIov@$LGLw15axG=n91uX z(P_z=lz^SUOffJ+vH`E9^PT^jG2fOWE+hrR4t1n3WGBq04=YP=%I{a}Of~DdScTmm zUv)B!P297D@T(Ev?>-zBtdOiRJ}W`uv)TaFP5KqE&5jL|t0fi8bLPa%!;z3T2(eg+Aa% z-uQk#K;uUM+mlw^UVn*A22qbtqrMW~hE#bZ@z9#)n_<$TvKfk78BUf~p5P?RI)7Z8 zW-@lMJzScHawe?7L*cJ2L;@QA&u??-%NL?M_d`jC=4Ey*u19>}eeEG?ylo&AYea*$ zu3X_wzsF7%etq)|iPZ2`dP(^zwdUY59`)5)%kk9^GI<2 zUmNGtBMQUl>alIxwr$&6jkwgwsQx3mIX-CI z44#IM@`*!xh+_SfN_&c^t3)(U=9&3aJ=S@dSd;Qp35cz+#ZQu*&gl&AFyRg|P2!}1 zvw*w?OLD$}6YvV98yHTJi${12l_!YgkXiK)zYgj9pn+8zd zQip37VSmw1RKt3Q(4sB6CK8(-hU)!0*&s&%UV4u~QBi8{whi z<-MtYN3=QCAR4@KhbD3NgH#`Tk;gVd;i>7zvtmmags%Xwar)zSFIp%{( z*v(*3QR7mI#j_d<@9h%u1w4hBWvG8_O*kqa*inS3Y}yU05fMUYY9Y`@H<4E2M>17> z-<#r3mz||$8Z@`r`f2BQ^@8*|1$eE!@}onTXq#qhdCU(p{(Wj}kyvEU!>4ZbqdGhf zI8$Ave%5b$%NerPpdpt9T8U6$3*vgy1{+b`Fg@!dH*%E7JzeTVk?(U?>4aB)z}^gV zruTIr<0R&m_qh~@#ltbtH>*Zo?70g?J+}O=tY*igP%>2|e@A9#SCX?I3=M5RSyNEE z3kxV{*;{kq?s<*U6?}6&eC6MzW)bg2WwE(s@{LB-wX2qnt>(!*E8Ij|$(Iy6tzETK zWvmSkhN*PMT|45u<1&%Id)Ja^Dk9f}F=MGcl^tEjT55Cv0ykEdr;45+0`Ez?&1g(Y%SH$y`K;^MxLe6!KkHoI z7ZK6#$dMWfH1k9cikF7wyO$2R+mm%O6-648mxe9U=+!i56c>NQ$pIoVqEEb{dVavYP2e zko>+?PvpO>46x@kzjk!yx*T9to4vS%bAoNP$N;Lhw1vlJGTw(ep#*4eQ%itrvt-~E z;~49D8^{u8S38Q`)elv3&QDLtV)a#o*-b=N$qd3dHwMZ4II^mbR~XD4hf?JF+T9zd zbxA|vRTN79^p2oavm6iI7+mnnCLWC?Ty3A4lKjd0A%j<&F|hAIQ*xn1puc#ZOp6zu zhDuA_hkz4Z;?a_J*<>_asqz;lY1G}idv0mI4%*2}S6ucxxGa;DK^{loxZooDuKu%b zuj-4sE0V42*cAKw8k@O6J1@?hyG0F^eqe2qX~SnA-OD0EOWB3Lb0SfFMI71pesPS| z_N5G_AhPOafZsP#_$#xP;tEl!Q#Hhr!w25s-?=HIxl;4X?CLK?T`)=C6!#jARN>n( zj$Y{IE!@_vWWE!BGs0lP5Fw`|`u0-_3wdJPrz!?Kf{IUtI3FIdF1*l7D6WQ^V;h2Z zt+_(FkrM3Oqt8@C9`(buMl0q}F|AH}d4KL<7n}B%IH8_`fiay&1m12gIrh}Z+FI6~ zUw2xkvVh-?OFWAGk>qov9z20>NNBK7SQoe3yrb`cqR(m=JGbv8ph6_T#vjznTv+ZP#=Al zrq`?E$^EWDT?hpZd6)yb_%`#8!T86?C>7gm@G)ZPwM>pd#=0sGTr5y11Lga4YYPQh zkH6o^1$(O2%e6*%kVbOl>eS;AF?+X_&MjM@_IK!wVoj3)N28sA@g_dVfaQpq-y>n% zSU7oS*n1N`+*e6yiTZ()Cpe}@OcTr|YTTTT;W3(yrC=jA4<+|AG6eZSCxR;?Rj+?fe zrm`37naIdJd5|MHvs?vI1qe~hY%7P_oCR2Sc61>va17?ta=fQmfZ1kW%lluQ)6+%S&UPXz|UD# znG9hryBuk*6yWUvbq~aVCtb@(b3>^Bd++=Hrzhk3*$+FgIu6CuNRJic33LrshVjKc z<^RuiyPdXgql@b1HreGU{&ypmoRb&fF?;i%4!W-bD}Wr2itFp2nV2&kWb|_e)%q5* z+W4<}3&}0%o?CM{2I;)&DP1_zsrHNJD3s$}-4{Eyb2YNnSWG<7L?R8VO0Ftz{wCiv zcn?s70OT)`TYLBwEMo3>VpM5NiOj8K_{^ZdYocy0egthT@Yk4$&6d-et16YIOpAaM3J6Vzw2_yOio6Ne1hS5or@ z7}6Skx*FHQCCivhZ9`Sh=CW{og+BOfss%7Wja-~uZUCggddN~wi!7B_pCKBu+r?+} zO(M-(j`R&wSUw5FH%&;Bp>;h>auLtx8GMQB@FbFSEGqsVV*T#tS5bbx52jaK68rIp(h$2{eg ze1K_DbXu}P>;)~$(bq8JQFf75sl*7KsPRVagL*GZ<={}+U7#=-VH@{1mvev?qm;5Z zeC%1si130_BTXUQ5Y2Zi6m@czAaL9r>LcaY0^~Y$l;eLYNhOPx;SWQ&D1S3Hk_*GU zD5%#jd1$ThW6c~Gv61(B8YAnon*J=H02_KXUP79T$aCb2rNPsB*`&BUtNt6R*tL=C z)0Cj~bgAU?q0in^iwcNSlq(-B`>=7|J()Kl@)WDU%*`0vYFqhvlHYH3*)yv?et|Vt zg59dFw$B~|kTgJs8^j>OQ$ym_U=By}ppTxc#LyzmdKc<@eXb-FY8L^&BuW$qtM7)7 zu)K$R>w!hfwvCaHddsuX=j6u~@}mtvXR4dwdMSPZb}oW?8)xZaLj1cZMw1jlmSs_# z@(!b~h9>+0zLzy`QGhfhLCKp$RjX}3u$e5~_ABHC%&|4rD{SN8*;J(@J)(SU8spOk zfJWn>R&pIwg26L{fBfd0G6Pu#g@>W{S5V&SgA~p8yaLngP}>tmZ@Ht5Q?W}23j5FS zHD7XMEMB_|1j)DTskMtxX-%BALACt-)Vr73^tRClt?cN!cY9&#r}D!~DCTxp(3ZVQ z-x16TD;s)@YfAvSK)XL^9k|Cwaaso?u z-s8Y^hNb> z6t`*mX2Amzasgtpz-tXXd_z^}P&bNsu({f$rcbX?DTaA~I2A|o_#jdJ!Y0%H-9z~v z8K_i>-gHE&2vIE>*wct$ULSm}IAFY&kpD!N@KMN^-o?!s}#dD~Z*tgcaTP3Ka@@JpM0ho(x*KwI85|@Zz z1Zo^2NW1PUDADgt3FKVKYQ31ziXZCIUO*g_l8|Rix#7;-Tw#q?ElDuzl}*<+qH9q6 zWDEhMa}~l1U!`|6GP$9yNRW#WX{_w^t!=tLh`{`6sdRnDTs%v#Oh5J0g`g%;?bPEo z`!EnaodlerP<&~bXyl1QzCkr0NJnyR)C+GA?S#RDg%GJ%ir@xsng7)iRDyC+VrTh-JmwKLR;*w8 z!PXFHU=oODelH->&w+LFv4*`o81n0bZuvP3y{wY5A!h0Oq81bQ+{LFZ`tVw|LaWh^ z;SLYFY(asKWOe>B7~vc2Lo3h{Mg(aj zoK*tGwi4Msbetk`;V=S1N%tVg_-gel7x-L_VKd*?n_Nvh;WXacg_sC#KF2o}rQ?x_ z)PiGlZCeU61qOpfQPt~Qce!7ssQkf`7Vy>x6Vv-1uM0G@5!wSKTPk!bWhVeMth;Zc zO=i^u*DCYUlGeEa1bvaC1zi0_#>6G?`KIe5V$mZYM_J1{WE>1jB3(Sj1EdZnIQp6MhaJx0^5(?Tz?Q3AR)?YD?oL|G!ekZh*`!+x-B z6MibnSmoaRzvu~NE#_bTevuyuRp@13KqY%3_|n zGJ#`{Xh)fABFQ@DU+$tI{zY^=UK5w)=fzZ)Ib~I}0lo6Gags%~Faw~Zjr&}9K()a4 zdgfsgfisgD<>Fs6mrtX5)`j9;qJkSNGYfQ1n93`c|G&c7>g)r6m8vKUE+Bz_1b-~+ z$>p6A4POkK&8VUYA-?0}7Or^t(!5tCtcpG|f$$UVg$>Fg_%P@h`pLd4~4GEtDW@`<^T5D zU*<#{zqcs~?5i`+A05pQE`P=_aI9Zrwb=a9GXz&XIk+FS6gz--i$41-^E_%yP?wI-$7H#1gndR}ul*vCv{%OaxnVRbYDE@1h=D-e?QYt&;RMlyjqCyY=ZSG8Pjb@tLpDh zVZeqZ$o$JR3^!FT6EvkG6V@t{OIc07bS)4rZH?`r&y}+rxJwR;6hwCk?4UZaF(6jF z#t8_RxkM)Ij+}hGXRb3@QQu&&h7(0<^UeUreAUcvZilEW%n7l8>nHl}vVemNL{dsW zPrpA4ui<|DvxwFy%mcenooEp!s-(F4+1mNOiM?pCUB~3_uBw&HGp)Z|HRhW6#|>z~ zp>wO(^;4r2DgDXS2qWLefg;1{zlC~^-HE@jNuR9=g%@ToxMXqkaGJVCb+u`^Y>$ee z@E0!5(+r8E!Y{ce+KnfwN+**|6C0wt{1od(OFYJBq+E+v?-DcC7w6h$biI%5!N~Jx z`j>Wtv-xfJ12e?nIX`0!aTp^~Bd|x-G{~EAB&HL5VZ1-HPo)~;j?)Zd!#>S;o|JLl zf~*t{L7P_eA!TJ=5=_9`gqi2DQ(kNjk1Tg6iizmTm^+HLw<*sYE9TnDKxD z6iSVP+AM>D3H#Kmi>5!mA;Mw?ehtVdMKTX}mUrtuVFJ}!#ZH^m_Tp5FqkqU4d}?+R z8g%XJRuz|C_3{kkq+-;xLVx9&V5(R4t;O1Nzc(4Tx^g*eJjBc)5w?#Uk$`l^@}DDJ zcZziq1BaEF!wFWv@5gC&ME(^6KO6IdEP>B((Ceri$b`zd1Qq6((;x{*VPfWk!erc! z(l~{pFyv}+k-8TjyO)7#R3nWfXRF&r$}|X|AWCC-)#GvPylsHj?GPt5E%}^h5WN+D>U7h_03f|hgDgeD07rdk8O1@=TJ|9eDj@UzYrp4tE- zx!^p?2P`nA7c#5h`^GA`n}GdC!6w=jb>+kLNS$KDEBVO!DCMBq6LybmJ^%Gwp)MjM zC(UxjXo&0MJ@Oky>FqjmiBgZ7<2kY8?+wp4wwHjpBRUL7e##<)ZTH~HDaf??i6XYz zGUbhmVI%d3HkA8i|BP91J`Pt8JY4+5E%LGt4|7GabZqxHWnq5qur}z_SO-+e#rHA0 zrbNx=Ro);>Gok{9Sal{quRb01{Fc%gmZIx3S;XJ&S)#`}(T(!Q%ij|U7d60XCF6%A@ z(a>(v*b^k;Wyl}D*$}}^DW&+@E@6u~49VbcI(e4tX6Tdq*efKHM=kbUK*8KLVPivT z_N#PnD75|L{CmSmCShm_i0zx0={MY4zkZ+^dcI|d&{27apn`#~#QY(yvuO8bkEg(5 zy>OM{H_nL(u>D%;Ey}Ta6@PE>sdu`IktViD4BCr;|L&s_ZBAW_bZgakOAcR@OETmt z56LB!^(HO)B`gl{HM0g4RvKmyGDIDh*$VZ1ZpX@{olZdVyN(VoI1x z-+~7JxB`I#`(dZU0McCR)5=-AR4QbMiaiXbSdX)6_sqWBvrO<)H!VQf`hnC@Ulg&c zZ=fbcQ~V#SfS4OBDe1bxV*djBPUAa_Czcs%*FH6?%AA`zboc4Y$+7D$5J8S}PSjaf z`Mk7hV(j(x^UI#=OGFxv=ON7sk}cMKe&U_UFakzi6*OJZxCeU_%Y>W_+MPf&Ab~7* zgJ7RJ^Ee5aeU&iT@j4>ju<#6yfA=gR5>0e|>Mabw(W#B=N9~sR(;P0*D)NL#h-LtC zc3(}!Y;AD;x1((oUj2j&15zs5iL3z&?Q&gU>l71-!salqY#TI2!~ESV(Vjv*~e>7I0}LJDuWWdKbe&q-_$CUOAS=o&X2f5;zg2jOZt!O zLxs^P5Ml$DNcw3Bn=4e=oCb}+0jSpWe67?g_)!) zHF8CF)DuJJStq-SuT^jcCh71%StZ5Cm4TLRDDIkOq5?5XT{OE5Xoh5eaNfzsuNUU4 z2?haOarvrYivGJYF^Mym*E@Tl?-NK9(fd+t*ucP{9N2uySNb_GRd&!}0p8Af%_H9Zf>kh~rz5>% zDCv?V(#rHJcFO|4Z+!JXbe48;;Nz?=UAusPAx!4M zz##*gC{*g{CJn2nlW;2HFaUY7OB&Z?Z1Hp*u?-p6gt{PwquRVF)ChWC6D6KV2h*!l zY3aqM#O@1l!Mi?)*Z>hzU0WcBZ4G+f?%Sb017*&5`(n9PU=K&u(S4KPvp6a1`MBiz z>=nMb`!O;4qINIZjwl6o25`txtfh=0_SlfGHmeNQxcUcmq&D?fcm(}6AxQF54}i^I zpZ-h&8hIF^x5K^d898hi?E&D}1q3%3eJO-x6f=w1&WY1@0j!Tv6=uitv8AByZ@ zu>yK|fxuExH-rs>Az2a_3yMeu$*ir|k_ox1~wr&&HQ z8s*hanz42s9qRR8;_oV(e`zj?f3ItD>Npbi`q^7JSd{%W%g^nLh0G3z(MH9Qu!;JtXK>x6$j}(@bRUiG&WV< zK`U3;l(lIxKQ8&c+2RIe2DIBfCb_Xj3t_cHec<){Ho{%O25?aA@T10!bT|aV$l%#g zUr)iRS#pF`L$S&O0I#ihau>hf7K$F8ViQMS$8kU4jec5Bdo8FKVpLL=a7hC_!xSFT z7&6g8?Ie$d*MK=Vs%CTRad^~PeBFrCN`M%oF%KC)03wd`xx1DY9U~15F?)wbR@boD zoVTt>TdmRQ6q+nbWcRgd2Q(92(Q(EQruGyDkE< zvp}l_A2S=vchGYR(3MGU``;=SmM9VSJIwG4ku}6`*WkwMVVS6xGF>8VMlw@SXWeEC zg5q>73=&FVRN+K5CC2G}_=Hw4M5N==a+eO2z!i<{=P+nE@Iln6XB#t_H6tghd1p<` zn?6A2Bc&eD<8^w5+WmVu%Ur}gYM9jItM826`d3ptOPa7dLNL>`NrKM8cTK>jr%`&0 z+{)yL>ZoX@xc&_JV>r?`q7V>~ zJXpS-B*qSkTG?yU{4{*AD`GzQJsqA~%nIBo#tr`xDS=quj%N*qK!zPIc<~4+TjZuP zjH7pYa_vL+O3-^@&dXnFOGX}r>ksQ=;$=2(+gJnrtz$_?tXrsN!`I(z=jfV+2FjxF ze0rMj`C>K-(-Fh8A!fgWS^cJc)fr^FITMgR#-Bf-jPOpmHxnJ z3LG9RZ8)XN-!=L0@<(>1xDsU6YN9rzwngF})Va^}FQ+Hs>>&gu_>aDmqe~Xw8G6YY zuQ^d}a7cR2TS$GIdoHBV) zb@MhMZM*HFR81#?&ru{#5SaTT1sC zZWt3~8*eLNdB(N&ft?)NhM$2YJ`;zt?3T}(QW~n>vTF&d8#T86G>9IS9Z}w2ana!{J9V&835!NxK9Q->k6df-#RO zbh;vIRFH84g=B9{7vB@$0uA3)pbGmhg4m@jU0D&m@Wwg z&yAWePPyi9G4SQ)tUVR&)qqCuW)#b+{3Ync?5elBID82?HbuoeOV;uHX~RS+V7dwS zc3;{MBvWdAjgX(@2q;d&vzeSCx0pf=G;=~QcZDFZ;Y$j$xcN3sv7rFK!OO4YeY6tJ zcb=;xCJjD1VY!~a=A}j`t)o_ZV!sCq%?ls(ddupiQ1A{3ltO&CDgX<%XsPO^2aCn; z!=WbfF0RG~K;Q0C?MR225T(ka-p8-;;Sb|Ue}%Zhn!Q@GaEF&U)~ZRyJy^+u*95-D z1Oqd6$xNX#<+xH$`kd=3ph>p$=!VaY`Z3a3Df`1*s9 z+=tj*2lIe4#E5ghyYW2+KNojq_7I3Aa?+Ol$qZG4IAvqcl1t%dX6u(prHi`E0W>ky z=!tIU*dz-Uvo#5?t`bf%-o&jBntjZ<9__~OcT6(z3+@8tH5}Lx+H1;Gdu$sB?@F-@ z%R&@Xqnv#OG)KT+?#mbZu&SAKvMtG88cucXvRPl+V1e(~#)rox<66kaAPa;eb7qUH zDh%qLuaTtDCSqI1W0%#T%Yw%E+!PtnoiL0Be%#A1ogDhI?6WNGJ5+&pcvq@YeZM(a zHs7q#i9$UfY&X49nF@v&ch{I0M37+m!PUn#KJ!5iX;2vFC)Nt*8?+-z>@oiRyiQ%C zfIUnRzw`H!KuI3^JKDHV3u+B}Rj%8suQEMP=mh$0=Z3z3{bVsHl5b-5MBckC_d0W!r<~gJ-nj0sCWGYnM09EBZn6tMcwacF7D&v&@wP9x9!ZXfr!h$5|6afLI zdN=MjiNC8BKFW&;94IvkMrp>QkMho0?bK(Fxm~2hng`(&GzKQ(JF`J|} zYX|1?cLDjeR?UVio_Mn}YcB#f9bg@&-3`%GGN%$=wphIR3`ISQM=6g#Z?6X)e`d$);n#;N4&~V2NEr#nNYR zpW6|)&{$n&_NkD*LsEo9*Aho4xOl&vPru^*Hu7;N^%^{v6Qz2YYSpfjhm+lJY84_G zys<{lNJqox0S{B78?$Uy3GpD_EX+Dl@A^AcgSqX*6oU!ug*LGkJ9Kj!LfE+f_8hKEw_Xt z@HtQ2tVr}be46Xs8{bs6vzri{Bk@c>o5VjI0!a2Q(dXZPiN=x;V+|y$F&70!J}6bX z3Rd_eA>zv`Q?i}OS%JR=I(~4Ms;bbg&Ll}qcc^@yCVI30uR^dSBW>=T%}vwt_!e-rv?c-g7L_DgPk3?XFPT>p+Wb@1?k;sSn8XI#7QDB)2ZnDbRMJiVssOCgHzK#$dD2J>FsCG=b+OvVT5tcm=G+Meme;lEsKM1Z z=CO3ftw*Ca(C;6`+n%emT76_NI{^I?-=j{n!QlmI29bek`wPd4VTG~Lf z_!LVdl|bZ1!D?FXs8YZ~GtLoYeCbb+*(2-yd;1~OnKZN^1c71%al8Rl7jHjA{y}(>WL1b-j0= zRPX_Xq{Et8cT#2KC-#FTekGYZ-lQjn)`nJJ%c=VlNv2{J!{W((%c-78q^h$^HQD`D zs#s&)za%DAB6U4C$!hfex{~%~s})nz^3=byk(YzIZh$Ab`yphgx0l)zXU1`%fb%AT z;|0YmMtYd4@ydcFUKEL?mH|F9j6Us%_e_s?to6qGJ>~*$`fELpT$(1U*zr z@8Vx`I1UN2xL+2wm2VL%NpY(rqzxSMI#Bp4GSIx6i#!B^*t^P*hgZSNL^=yZz09ba8F+(|Kn%oWHKmb=i+XTWSN1MH*2)sl$_$?#KO0X=A@)x6+X z6fvIag$p!FnZn!z+t%}jC70xY_ILwwG11nxsX@y2EDqgysOJ~XrCfdGz<2ZJ9%0I! z%7q+KpGy_rPjr3401#%Uu4jP8MZyN2@go-4a<}mbdW2pAEmvmTNi(i9cqPP{JICRaaMAy7!W3>{}>}P zH<6VwB63G#>a&f2=L{J$iwi7{4m>P+@G_~;%fc3xS^G76P?N3TOyi8lNs+l^*%^Z` zS&PnT58pH5BqvIKH#duRxYwyU2^=^wpMgZ{z|89S4Xzg-v%~d7R}qU76rkQAB{>x1 z?^mC;qy0@D4E|~aPpKNs-}tZ^qG@p7?A|3F+}*_-k-1Qsk$I>aLWjOCMVRukh1}rWKx-OmjXwL zyx;Nhao@lhlSc;Nyry%u#6Y9Xs~;-3>Df3()>vt7Ic{1+n*#iC9pOrYH$g)CaT11Q z$bOwndZ+78k(n}%4Z?V>v3ok|gBAPEKuB1#4~6aE4!k~?H><#s$Inv7&QZb@OmWU7 zqgq#SucISbt)3}{GOW=!tIdb9LKGcI6a(W)lk)t{I2OXPNxzagWJoA+eke%_zq8b( zA2AqufebZDSw*Dk>`v9LT_h?S&Z7OjYo!GpLO`XoD%`k(2$?bjphwJDutO%C%efar zsmsoy+Bls1Wlcs>?cE|jjYo3u4t24&x~`O$r8I(MZCP!|&fhWHH&JF2+OHzuReP$P zA<**!ADu`RI3mT^>Ig0yE-2COYz+KV%Zr;lV!rno$i}ss(1SXuw90@mea_F+Ez}}e zprOViD#0oZHfJGjITNmIUwBk$GM7*LXx~fOk5iOUYC*p=ObomGe{{Lm=jSbDOTyh!sxt4P*4q-@$9AmNi>ng)yIEo(P_cf zrxQWMfO+5z{9r&r-gJ26mxlWsObzQ{H-hI^;wdtC`g>%O7K>2_T3d{%WBR6&n!HOL zuof+XJsIdoD5#U8SgFwV z#g1SOm$^2*Dh=z14(+2!U1<%^9yTn+&>8boCYOcRaoCeb{|-}1$!Xk;&Ev)*eMTuO zOLAJYxkziM0I}8`;$pb{4^+BPcgrxxNEx$w)1fg9m#zbkX~+j8lIH=f3aqCE62v^F zTaE6uxm|nyoL_9_EfjC%y>3P>)pMY&9dHk)OTQIIOHl=<9WYRQdAG2zlpgHk|I0?N z{Kl;0W~jS%@F`JJGYqGTybEbz2DcE%ZSJR- zk<&0~!?L@x1gK5OHum59k-FqZi`yAZ z#4=_4)rPK6)Kuv8sv@?phmDRxY*ZDCYr?lbRvoj)ZaTVZ1HVupC}VPms$Wxr1S+q_ z92HPn9*RZBLq*w7uXq~cEW&T4PEkyQaZoGh;nzz1b_h^-JpPPW$=QOqG42e!DtfhL ze3VtSnahJA$ZI8dHRiCTJIx};RC3}$RC$i!OQHof;{ zo5Oqu`4Mop+Ti8VT;cYK$M!E}e^(9m@&kp$FW-&7o?pE>ZJN_t8_%9^m3eL6%~raP z)?M{)me|TQGkMnRzRmj0SXeDY_Y&^}*dxLQeHXh3Kan(ImTo$57)O~|z~^80h;2G) z8x`<-fL|n-BNO>=Qixx-QC!f=#dBPhqqzloO00`x&_S!q738??H<=8*2TD%KCjWT% zLYkiU_gW{AEATDEnTX;JuptIXinE2~$KoSr{JML(^vYUglQ$1gh_4g4liPmm#L9;e+C2-)b)-6W25Vo+lVD-?p+3cMP%Nn*>3E;o|DNZT8ZbBuhh$!oMGd#$8JTMV=;mCC% zX_3OoV&Y{mZfSo$44Ytwq?jhq@X;^1lbt%auCB&EsJez!d-N#wpt{&cyuH7)9h+$U zm6O+B37b@gASEH5Zs!9#Qmk?T{E*DJsV_OcrXPeI%{%P1hh8;UcOeN!z7~XYj;4Tm z_MyI&4SvmJ@G1quHd4khM!8K zK9``CKbojvKOZR;mb~cgq-E?9kP*ZGHMfI%gq;+J| zmQn9~maoEvdm*z0!nWF%DF;zVE&&)autSev{T_5Nwugg3W>do#Dzs%vzbr9~PGB|M zSnv`32xM=~xvC1FN!SBjQ;Ki^0T+YpzxliL*UiKZlpoQ)(0mnaBG}b?4;wa>sb1>CjSmLvlJJ%98clLKX(L~=W zO5%xORxJ+K2~7_9iu&>iPr1px6fI%^R4y!$oezgi_+Z0mE90RF#=>aQEto6=Ulyc}6F!~rQTw-mb9$Z+V$Q{p4H!vDn(B5Y4 zJ-Z4>r>u!U(D}e<_{(vVdx5i=ZlG#k4j-{*85MDPe^T8?!4A0%hWEQMb1@w+%!yyGgb&n|R({2LJB9 zGmC42V%-!8Ynj=l+FyJ#GZTAO$q0IZmxOhj;Suvup^5Fu7U8cf$qt)9iPS@E3=PKV z-St|k^!&+t3b2vH4@d;nN%*`xQ^d`EL;cv`LGy7oD>X0g2V{#$x}ErZR#8M*Ppqtk5x! zCD!wHF0T)lo}gsD*3JH+yGZMj4xWin#9v?oxaA=xZ*j%HxmqNOR^p1fumflDJxiGZ0>Hpk$R$L+QOXd1hS9gJbIp;+|a>C}I-d%q6; zz6;|1PT>wYf)tf&HyndXiCyU_#rpN#_$HN`W6V@Z$)=#@I&j%=IuFjd0CBNed0Y)? zDO!}$jImdm#QIr=3IC+!>-BK&=i%${%qt+ek-=0*VD{~Y2_)m=nB1u^wOBnB2D$_z zJe6DJ+M7;=qVX`hSR0NOi^xc2YbJXiq={$1)1sfD4KARrvj?o%Etr)wAGxUxO7Q7$ zK!t=#&_Pze!$%AU(e#t;@mwPb07@a<{Kmg-UeRlG{7RQ8C6}TNW>MUcrm6V#?83p$ zTyvgi?3!n5fYOk_#;j^?xKY%~-!R5yhsDvt8~S$wUX7A0q}p^X+%2-`^ia~STrx~m zMxPFLfUp_$!2mSk1^44SW>5Uj5q3gWCRC_~71AgBM_Wa0sy8yRY}JpBilhFxjjq0{ zzW5rH`@U=D%zjORt<@l0MJr6|!;F); z1{Tl^>}-Veg#Rc)E-q+*lDnNTAwa~|#!1N7(a^!%&dJsR`hR#Ced~WSiUOjN0)o_1 z(h9cL`Zf&ovS^0R{jAXDcgXCx9Wq(ALV<=3j4Ztq(8)7z6%iDF73IiTS_B#TZ~>1u(I7b^w?H z%m8NYc4o#l0CRu^z!G2uum;!wY|L$p0k#0!f4v>RPT#@U#>&{l>A#f2e|811Gj=ey zH3HZJ?450${?Y##a{xF39F48b|Et{5*yZ0_9nIYUj#m1PW&kIElbM6DF~G^y7T^qU z0k{I(0PX+}fQPYz?eG7ZR>b_DRT$V=|2a(onumw*|GAO<|8t|1v5l#d8N)w0MkZ*$ ze>p}%MtTlL*8j^g{l~Qbogrjoq-S9#{7?I*!`$lMTK~m>mA;d)kg=hyk?}t@(El4W zZtIO6&PtjW8EmM(6*eQmBREl4_OGw8xyNvWxIXk|R^kvnLN>p2JS+G(#zuQaCp*wudIo#KIM6|VR=!ZSYN*~(I6@dOobuK+ z;B;W65MN+$O;P%;_`e4@IA(?>`k;kAib%~(j*hkTOprfycj-Cbu|>S=0lTv#SPthlndH^QmMY5s{JJym_#m17_+^db{KV$6_3@t9 z=TikxWkBaoM)^(y=|QlA;^ESMw|>R0Qf?E2eo{BGDJw#1&g#MgDIM$8;<1qwL`K2{ zrYDl5^)2^B^-aImyedu7;sVn(!>jnURDjN6zp5H!SxNc91J!ce+JgFygT&R*L#(rd z{7{CkeNTaP72QjpMZC$6GHc+Ue|JL z=kz0L^Zm6t+{_w-9-}wXLkj|2jK18guy{s z;5}otuQya`s;hMck%;(AeZ_&=(`9BN#OwtFS_k#39zKrp#r<9)_8pz{9kn%mxvy<# z0!_o#-~{QSk@C0207DQJG$jPO+y#5Qf2BCsK>}fd>>cdK{9N9$MG3e~br#1_)C5}D zIcyR8&V15!E_t`)D%&wx7+fA+htmUL7S>B@0Pk@IUi!)1dq>bUkXc@K2q7d~`WZj- zg~kq`soeV3e&iKe^!Lp#N@#Ef!qWJGoavXJ>_;=p*8^r{{o!o#T_EcVv84t4i$*vv z>Iq%aC0<3NujOi6>XH4Kagf=D+PY83n<|ul;pi6=1N7XpvxbqOR02`R`1R@|bar*8=AM&I*P4>kK#V**UixVjp! zqXgt4qX+OSs{-xM4RELj!BqZ^`xemB0unj+;h&V61QOZhC4}*tdnCA(Uiu`6gX=ZB zLl}k9Yy8GAG6A7q{{-z;Z~lV(gw<>Of%Iy)yhV65S-T^M!|VO^4S5Je|K|(*hua_8 z_jy=%q3^LK>U%}t3x+xn&#KDr9G%>jEzvh@6gvQqMyn|uGi^I&=JDidXUFMh3iz$( z-v{Y+0fFXf{KrZuDO=+cBS?DR@5wiGVwlX8o-^#9u8nW(ikA5ww(kaGAig~6SxkNR zzU4HEUdFcHrHh)(zU8nXS&@5y)^i^GC zpPDKb^5gp%f3?qL$Z@z^=f4`S%xW&<5U4BJF>6NiKUub4CfKgADV&p(U2;tsET=y< zud)*RouAgxtBS4&l1>cTHcpT#WY;%0XH$b@auNElOx^Qckwp(ESE+5K7L3O+r@bo&Ezr}OjY63A_X)lJazdu`0?rcYU zD}3nD`)y=zc?6B34o(hend5EPoE|bnYJ{Xw5%h4d zX1=F5l4E2Dmn2K&met!dXH#B6vN7`7A(KQMyGk=6J**}NpL~SiYq{gZJYI}~?=Jkc zrcJ2TD;NzzghB$8?()&ji4l*n1Os3<+#BpEGc94@Jjf~Xv4Hythj}Pj(eu;APkqG~ ziNpDEbDrw^8!|Y+hBm(QE0*<1A6B{;>-z?u-~~%cIFI|eU2x9`L7RRWH%iIW04QT~ zbiaNX9Se!Tp}^kNh^I_|ZvUEd>p1+tKkxP8!k)y?=?#XZ28@1m3-p$W?QNC*7cW)$>X(+*xoAqErb3FY6wI$+GkID^ z@7k%}0KS(B6cO%jOsHdR5Wbeu)dM2i-)x!^=(QO0V=5E_jLwgi$FO(oH_EdEccw1x zJv+yhwM+#)E10c$EyJ+`k&_KFi>Wd}$V6(UaR=RWbHCg}xn|EV4}Q#w$k51ZI`N5J zS%YYr^Lt+`g~(7_H8H#DlwtGlab}#>A{(>8Rpb=4krv}zfaB<_<+5gQn97IpR#hfwCDT^*1QFH~|7SqN}vs_@P zISGU7eYg$=9rV7J7RTz-wRmRx5<8h`Y11n`GSK-qDXC-1`d)>`wFYNIg&3_TT{S(M ze!8Yx!(=Z=Q6b3m0^?j~%ReCjg@}~gC4Jqf)A!a-^ zEj@FySGlx*s6V1bYK^FY17$fOA75C_e*Nlub2`fY3hD=#%arVbv-u?S`w-~{+T*$Mq3Hvh=}C8xJ|6D8#J{kdxYy0s zQ-jzetWvMv>Ilg2{BO|rbYfEH!u%RM57`@I5(pv*X;K>)E*jSw?lgt4F;kfaEJ*%r zu2Ivd+5nLYldYDD9#Z4SXm}1%t_8w=6D=gx9UdCZMwAelx@pZpnPUt%e$dc-Jfrbs z`XI|Zd8I`l!D-pI_8Z!*Pgbx;_lCb$Tbv&#NzO4pi@tjHTj4O!xb>o=n@PgUv|A^I z9F*U>?Z~^Hd`M@noMJaZRy-If(n_X5cVwg*^L#Zmy|CPlwthd+>@Zz36dH*!(xRFc z$^hkqYWt-BHgB&M<1n}LhUBUR@n)T4q>?a$O-Mog}#~t%{r? z)`zm<6mtUX8{iMFUm@;5c7!JHTPiGtt-!(yRHt%2&NvbKI}{=dF2C?e$^=3eJ9s4~ z&sF|Qh)TgeJXsA@!*Gd!c%pe!iPd~&$8$NW`yi}(=#6YmbVTaJQBJEYL!#5Nots5N zd9ScV2S&c@EZNESs?}f!G#CL!bd$HSvs%zKInlMb;GJ_qNBSFtu6I zPMK%-)gc`~GhMrn^vBoAJ5fK<+>@s?2)_8KqV)+#O_q2X@bOvhzlygj6Y=UbG(~Cx z#^SmQChx!Z7BcRNG1r4h#J8xxTzWQyyxNCqhPl#9BL?c7%DLHJs0R-iFt3;XA(iy))6p2gvqp$3Tcf6; z@Jj`z;(yzcvvhRcn_i6Fq&*O`7x-PD#`_8ay1`T#<2K2+9248%_Q;wh*S zdhuR>rQ17QhrLc8S~O7onoTA0ge**HQ$Ik@Ur@n2VuKOAcCtE^f(_}eerKW7SqA%f z+iIoQe2qEL#=aI&f)Z2beUnkzPiiiUE!Krqi7VPiZ!N#62ev7Vltqyszz9-|t<#gg z9Y{ttU~%zjR2X-dM5nvWNrr>9U31?+UCQ8Xc}w0A1M`$O5jcq&DPl3UlwDfx0LtO& zh65gmxyF!1Q=Rf}rp|AIO+*2OXX0)QU`mBklIDW;2y0q^P+06j~O?P z&T!0L5T>mmIGbtnF}NFw0~@-=q%^7Z`7Xq@PWxwE>hKSy&zFkuI!6Jp0PKtd4k3&HE7sjv zZ_qO*9P1}SHGPc(TXI!2%GFuiHI6PjL~KkH-A!P(yIwE@jJL3L7(jATF+CjR!hD`o z@Z@KB(Mnx%^sg=xr|s7M4`Q;Kew9*0cy)-_Y1UBok2BeuPnT(?mTqP8krJ(SnM~hP zLwv5xElW(3`!gD4Y{ZJRVOW~EAZQ5>o4Z76k215h2fG3h8pqFkr6(5e zfm5FyG4$sgVN#H?9o-HPRZ>EPxM`-S;txO-PSn0eN@Y`g%ti{0&A|WCUU#PWl}2TF zpuXH;EGuR1mOC9?qlZO}dH>0x9o1L#f1|SmluJsIo~)_^lc#2tz|G!Nt~JTvu!`+( zoE`3o45+8ru8fCSy`tkUdS{M&?%#{_?SQMD5k6`(z5!ZRCPwAIwl+4)CKz;>JWiVR za4C=-C|h-3+yIAP(Bt6mQyIby@z7Fgh+Rt7gJiAhp?agpq7#h2_W=NOqA-Sq7{@DF zgw?Y7j~xod2X=7Lyx4VrZJLkDAlpfi?#a)L(>0Y=`IvAoo^3{0rIAc`(;IYVbaIIX z)6E9(sdI$de3+c7j6A3ff?q<7ys!nqG7s$%!UT_s@zI*8%XNw_@99WZhcdSrszxWq z;JSR+#(Hw3&(6lu&h(k)Qn@KJcfmcFT~)r#U!lQ>PRfLV%IeI)op_DOol$$Kg`Iv} zD|=@_j44~+r(y)U_)CkPx)M#4AgyNOjjEIZcy7fyBZf;`)lL|!@cRVrYz9V?89o*2 z8Kj%+!11aJFCacqfntk)Q+?7l!SRR+*^YWVUI)MwQD=A+!Ja?aEP;xeU+;ZG z^81*!j-p-5QhzN`wt_})@PmC#@L;UDcjDQ+&V(MC7Zln?FAK~P(*Jg2D$j{zna6L- zM>Nbc8hqf(|I?}EQLP5d;$WS{)w}j0(4&*Lt|nB6EF7QofFpdLo}7h7el^G`%m45( z=`}K(tr79EIb+1@w6}8Wq(9C;R^;7fqC4m^RNm>Bk}uJgs28WR@MycrhI9k;fJ|dtC%v$#dRyl=89GRVu)|aoK}DGt6{lf@+7W zL~dR{jm>ZAh)%1^d-Tre#+ENA;!3QCk4#g49|U(*3uN;B5Hc5H6UWIoXwY}qX&qYf z*c0bRl{5Rfd?mH?iw`NI?PZuuIwmY{z4=egr6(_9SE&smAlaa0c9@l1MK z3@S>0IY6m}%I6dUCV(16_RqA><3&&8Zt{!0Zv|#3cL@fFs%kut1buygh#YB|oN?8v zXw;nRPCRtRRl^K>9L;Wz$TbS;X}Jel2WTDUUHk8l`WI*~##ogA^d`mv@YAc2f#`Cp zma~$TK@IVgbvpLioTZpQ8IE9}3PfKdNV6wi{S?mc*(8YPZSpt2-9J55bFqCAG}kJ~ zs1iQ2a>1uHWS?e1gHvQ9eE#l~Vn>d?(3(g(E)cBp{G}HtjTgBQTDCSAD7;RINHDk+ zPB=E|c;Cj@@6h^?ctH82)HW^$NkbURu7$k!qR+)*4x3Ms{W&YUdKwD%CSLlN$3BYc zJ%4LnX&1ke`8IlmmU&DlqQR2`ME^9MrGOV1;v#wlU0g-am($Mf#viS==VqToQs-cM zuEX&}UIZ*O$nao!>a;(|#ixLJf_F0~l%Cq^c#(tL?qw_nWHK(@;rFC|6#QxPbclzs z)e5T%$-6!+V6)p+l&ip_@eEM^L)CUOxYW3@KtB|r2;K`jjuk#2;&p-6C(AdJ%qI%5BQl$^p0)u98?7a<^=U?f~{+1J+=KV!5AMdm#7ick^;I(0P{w8;&}F7FFZij|AGbS1DK8{VNgh zklpdT7EUZCTpFpAu9qFwJMgoWI9z1=Yg_}JpKGFm8aZ;tASp!(z7;=;^~lyzJJ~3o z)`UvAbDO9orS^0O)=z?L4L>Uu#A3bdpT%+(@*rT^?zL%RB2~@}$Fr3DI+3XGP2W;z zn@z!3y9_>PA#HXzo^#|INa2xXl}}#KWd*8d*nV?zu&faltV80 zEWRGLeQdlT8&+WwFa!69tHRQqp8S#mDJqKV7@p`!@^Gs~gq%ug94F3j=N~5WZfl$1 zj`vjC)#bf+?=!ev`6IJYyQ>1S=l(llBI3d}dn35}2Mkw)?)2~9AVNY|W)(7~0 zx|4-j$uh})SAC;*Qi>lm1@AxO9smJd+hW5wJB=)2pP=#}F-avTt-R$!$(%m;8@|*& zvV@DgXUii`Lj>2O{fa;vGkymO5r1tz5!J5@9V~)&wtWOv6-KzM$t^@st_P=ISiyIF z%_K1&@AY`^`H|lQ3hB$0;zhHx+JK153>7Xx5Vx#E$92In0#)T;u36i>+f~KHRk;o&|%Z|^38-Ui51PxTX034mI6}6 z=SrdFXVmDNTIyil+zT12%x@m(M-ZDmEZPrbpRsqU4Qa!gbS<7|GsG6+Co?TVNFdP~t zRUodLJ1*9@ZaJeKF+}qEC478)sG3mngpwwPakCt2vg46{?9z3}tX3PtM-q@oKJU&) z>k^XOmXx6PjJ@;pIYz+ezK?guX0ta#%htoCfnl_owNnSL_pmJ*KyFiBnSzw#OdrFviXt%m33Zb=F zCi1Y$Z6^y?jHu;?eH^p$t=5#mHh+xu-QNzh{74w4>e7TXs&<0+BzjSEd7)$8%T)C{ zdE`vuNJ%cKOJe}6SQ7i~PCA7iJ0{Sw{BoT-sE87*5PNh-#iT#5)a>8M4Ol>!2L5%Y07h0=@C>mu70?;~?0?e|C z)eOGg$)ummZ-9k2zFAinJ5`#baw9FiXiJk4Dc|o-y+)7GL^4*w2=y@mT0c=Iv6#w_ zgYlhI&xI`}WZ<>U-bLsDrAQ9B&>cHjehZ3nCQe36`Fa+kEt)WpZ{E*{k!>}3dV!;g zQ!ae<4D2q5y#a93Hw}JfRxx=!kO+fUxW+q#cag;w1HDn76H1(AvT*f+;7h568YgLL zoizHgFuEFa(A;_X$Jbfyz9$O7efZ$siVP*Tbr;N&e}%L~$Efde_#^CU#eQ#=#IAG` zc?q-8Hs5+}Z-in`t--9ZYuOO}(kESJ&8vrAsmhYw2t|I|6%gBZl94_;k(s06UEtay7wQg3Fno~Sr_bwJ{3`fcLX`5B4 zhDc4;fF@rpTUbqE##mTeLcO;&OQ{m6q78k8qmW{Rv+Z)|2%vTrw)-uZD{h+!Ct9A* zRg1Z2Qk!g=a&n4fA)q>-TtOeua!OWn)j;qyJgM~cl=>#-JkVo{Qe8MUefyCzY&Nn! z6LjV^*RN=SgcP@tbRgGJjWbOmjD&XRUL=XHhV=d`rM8K6M!)`P&?aH(vC+@0s6!v* zP_I@(I#74wyX~*XH3#x(S1S&MU6~9^u-Q#GYc{2u5BP-6>~3FL8taKXC$ZGk?=?HS zn>lFrSx*9`e<-jLFJ*X>*xsa1+g=c1v#@nAyL@e zMfF1`?@xwMiKwO1nDqgD{{9=kQ1hw$KufW_+Gu-xzvZj%j0SS2;o@i#om`Q3G+*hQ zv6PYljno(GQ+_Ld+kA{W8(o20pr>B*6~&#m7yTpJFAI^1RJW6+CyFI;x=+EYy5z** zBDNoR&b+jSGquNzn-VHzp;;4R&Pym^Wy&zqMpFVLHGrFAG)=Mawr;BmdILYg{W$w% z_q#(THKv&`<%zjK!j(;=+pvcN0``hcP?pk<2P5eD_x^_dQewQa+@o$|>kKzNzFgzr zQ|d(m{a~n9QV2#!OJOz?2v%WZwwKq&O0iXlh}UPeVV6vlvrZ2R&1G#P$NY5FK3Wb9 zYs`B~=NCnklI02euIHVRy;7MLxr2A&k36QQY4Ao@MuWm1xQaSGE*uNb8KOQ{Y~KRU z*{Yv1K5wGfZjL}bXTr^VhlzkJb9t23%@3Qtg07zI?3AcJi2ZW%c@7m6gJ<^xnAd{M z+a^>?5tI273$K_|vsOf>7;9Ucg1)~vdzR`7xP?LraUUp>BK72N){(7`E<3LzUdbVFtQnkNdyuPW zcKe3vwrB|%9ZYn4KgrknXP8~Iwaas_j1Z>R1_yYOF--1$Q%L2B(rOE zRu^hafTKD#S`nxH^=HYWAmmVAA9t}_U$r>eQkZjTq@RzAEP)oF4i#W@fhM(V#@~D2n z%v_KYh2}7#pTFR#C~Qmyz9jU-LUsLdEEn$GLpd^8PeKuBH)a!7LDFJ{#uE8pW4Z2_ zrCz*7p!-Eh0XdRn2~8z5J@eA6z{t?1y3mN#YntZOVdpWK7|};EI)6oIPECmVQNV@A zRBQ7BLkn2Z$czI_C3vZV`%=3Ex~@C*d&i@l#U}F#AY!;B(G{zLvCM0B(vhCPstp{y zy)x<%%bR|t_gHy+_mV5r&#+4HvzI}{H%x@xw@Iacj1>3De&ZngH7Q+P%TA&R4m2`_ zG?s)^r`v$(Lc#62J7l{ui60^s)<(WBFd0X2IiL!0eOUv? z+7v`LBox^_gJ+cRio;*%RXANEZ-&LBl7)_pqi90)*wPxH{%JJmulL^I7#dpMuTU zhx_LmdMZ&vGMWRiQ@dWMrWkKI1DP@WbeJpR+U@;+d}W_=OU;D^MN;Nz;9jLcfWcU~ z6V5(KCpOlvnJwVc*R9lgf$y1czRpP;Qc@BX`9=5Ac)5~Q(5`J~@FAp; zY8U1+%`=)^M6#&GEZ63f8rVunrHO~KIg-`Cq(jd(KF&v=6PGEJ*Vob=I|+2`aR0>4W%OIX)cdSZ?sPuq)5ZIZ zwN3a719g`vELhat?w+=x5oJ!^aOYsq1~+Hk@tgFIC?quKUo~;ZI(_K=?TV+_`b{m`bHnTMe&4-^o0^MGZtWGbL!b+V0K@rNoE10E%)`3 zXEi4AM**p3zZi`1sP$3h9_@P=h_as8K@9H}bX7L?KcS-7h)E(q-WWycXEftaTD3f1 zLzanWkT@a;p;~yIS1*&7o_;C8RDOd0iQ@ctq0FYZP8UJDJ{qPU|0(U{wooDVRE{<= zFv{?3cE*2BhNt>yndfElLL!nhgj??Sl_VEixAwv(T15M)jbW5jKd2ItK6Ta$EG~r~ zcZ|0sl}}80+k|z-iisus=w|C+|4R1+}51)qL1J^L9$gCE1TX$Yu(j z6+^tq86padS)pS_Oj)~%Zkh$JF9{e4t2m7&Y`^!XUH9XE@e&aW*Pr9@{SKJ~M;5qw z7y+*<)~ifTbLXr50Qb5r%>JBNTnGJ*#PnCsnnb4lr!PuU=4ej$uT1J)HrX9lw`{*& zB6IZHt`Iq>+fZ4gi)l3giB>@$li7Mn(?**oth}N)yjCqm6ACRxAtLgTLtXq*0>^`P z;iRO|+%*X>!i7K3qfS^7cm#YN{Wwr$iYDa!;TH5kRwF!|{_>SYv)D6MnG=&Jttnel zE438~u3fv}tdh z9Tzr&`+4i2%D-Z(98aWkW&6n>+X#;;zmVvsGDVk`Gg71@(ZzSCCu7hY$Ee4#@1d(~Sqxnbi7*NCMD!K&kwy{jhC|B9f6)X_Z!0q15#nrNEaGxJxsF3H09&nI z_VSJ9J8^p6Lswmxa%foI;Hs%EV#QG+eK+D<`#?x=taT(C(AYNeqRa#baBG!=i6p>> z(^5wuYq1quJh_zZbN0IqShEXh+D=yor&5uq+RBl#ZXpgV;sMKlH~kWT49V1$`@Lky zqfocWd444|Ril-Su>`Va8*k((<;H3W-TIV^Z%xDY*hhC>IPqTXDBi(+lxt{y5Cw6u zr)*nP_<&rr7G0@&dzjgYs#8sn<3-(UeOEwxU@C;2NT>Z&@i@FP6*FT@7S$Nn;PX8a zyUK{;1ysfvr?B3XArW8~It#mNI;cWfRL*<-{3+`+m95pK>!I?g7;<<8b;%GEweoet zsu;SFdOBDXskz%Oe#A7Nxcbp9(HL8B<}#Z%4?y6wgOiWE)F4EB^D50T=~(wb7ae4peus zsbjJIkl9tkjYw^WB?Mn@dKM##7o(X5$7#--{H?N4#H*9 zGN}e8Q`x4EUnCNWAl}oA*$v|dTgs>zFt>T-wJj&=#~2o7B+7CPgs|epXxe|06Fl|- z&Ixi173^E0x#Ur#?ZCfRi=GX$NVnBRf7IFp+avj<2ErfDUE9=~g=t%fnGGXco=#SQ zAxD)O8@iYvOVEGdn{3V2llQ2)Jbl7nGy$ufaJabSZv?A2@&sjGstO;Lil5 zN`vrUR~g+oi)4!wvks}MUSrqV1Axr)@wzG8I~|+3n(re zEFfeE;fBIml9ody(SJ*We(=+6S|zF%ry+P$W(aP9h1M>@i*UoWTO`uj#8a@bOfgQt z0zr$ML>pX+$3Rp{6f->fOjp>66hOj~SY3Z9M&IYC*%w*#9e%nKx5tiM>Z#m=*)RmV zjOsO_e3)2W%q;tGOD<#Njz6v&$3ah;`_VM9fuI3j}O0vP$pbw$cO=9U}pnaKPKUaK5*UTkb)=4 zMO=22z5DwYUi*C8^U*qfFG}!CSivyFd%W_8*{RVN+am9xvBfV+x{8Y!V@C5efXatY zcg7`G2U!*KeN`lfTR+xO^&O=_MX)EH^uLBJ>i1R*eZJKO1#%Jvj?reW>LfaDxFKhr z84hEVKEBcyU0VE(Z+)HOppU#|^&{7>@r+eLtIh%WvfP_7Aj3jz)Q5ebz%BHXF!$7n zb=WPN*|Bl`A$(bV;Ke9!g(9&Ksm@O|JA+5YKkDX*c*Rsw=IZ$0MJ|9KFgk|b%39rZ7H}c+EEc)sY zbCI|rK_jtqYcFj`5-#g_U+UuO)*o0KH+9>!CKk|IJ`@B6^$VGAry4aekcXTA{a#Ssb0%W`M(U9#CWX^07Je8G40ev7 z!ruGkwOhWIK^>79euOLRiSX}APLCJBL#M~HuvrmXNp@M|y>u)30f9Mm( zFoA0FY>Avfnoj;uU;`6IKW0N2XfgSeQfa7|Yc-Ouf)H57rK_Eg7>1zGa9^=QhIBL^O!3 zshdkher-7V`QF)L;sBh@&4&zMk--L8aHj^_9fhY+xxvEP<;x%^L7 zU3Ma?*P7cIXk}r2G3D^Wz7M#%tFUu;T%YH9hDHLC@vPVr~$Kd)-PG*2pa zD%PYz>$d7HKK__1Npgq6Vaa%wUoQt^PT@`jnQ~S{3Xj+4`@iBc9HvS3M$j8;Q7!Ye z{@B0`SoH7NfyVS52%^)On)4>@Q7z1|q8X~?3y=~SKw}#s&eX6$X`j}k1+lZ10E%{< zTVG{KUQstZ)ThN<&}Sz_j1j2xod~PX`gUjMi4Ci1ajncNB@uC z`o9pBLo9^f6|6jv^Of8~3ot>6TroVGnR}*?Ced@{Bk<`8Gbd-n%B+k>DOGWqyL8); z*pBC;sDHY1sCAajqRUw5A_zZvM}F<#Tl?D%wBNrmffu#ru6>#SU!Rx=3~Qi1zhSfW z97o%`e7Q1H=ZNAT-F7{1tQpX3BS|l~va`qta^0|Z3F`kg5xaZNHBym=he_xmI62Lx z4kx~QbiD_a$B=Im>iR5TDU(L_=981?N~^A) z=4C;DezKH9 z%AXRO?|zlGK0`T_Ri?~nU%#@^i^yNmrOFE(FTnM8od4&303A@+V zpMKKwY`-V3ATVDEhvEp33#j&dW2k>;yBXg}us`hQ=_{9`kUtl-2O--f1st1csO|CA zR+pB7*l>STX3f%VUIa{c?*;qC=~**l1d6ps7W%iabw)>0BQ7OQSrS=a)!UhPmgBO@ zIL3(mx(GoVu$s5!K|lAH=HwuUq1Db!Ya`UYc<(5PC=9D5?E<|Cl>h|YX(LsaYeA^! zmZfU*u9pXA%#d}`^2`PEoDMmb4&o%`9z=a>eVzRIyRviNc{y?cAkAN?@UEY3RS{zf zCb!7~@_BS1h1&G9CJw>=qrRNf@K=fM`RETv!MjT!2exSC{%taQ`~Ty){&x_~lLP~7 zcl^=G4kJ(Yd|g;eJTXD+>3%5{Lv$cg<@EQlSAd5ZeRK(ASvhr{`qZ( zUkv3n)JbtG{-#`=o0T5)qIyN{hIf8rJQ`Dz#0lc9dA@nrFkhTBAMXtWV{9L}{xThO z&-<)NC#;-HKHPfKfZsnXRkx!MBRTPoRdlXouy#2PWar-56xx=OxcbXX@GHv5#~F0= z^Ei(ps{iz#yRluZsT24Kwl_Gp$=^SGVvcFv?vkOMT?-3#O1*N(Q*LT->6J2KV0GLk z7=SvYK|nVF>7FU-1=on zKAo-b)3S4fH!l}l!=gmpuh$SpQfd#HkjBSHGwDXqsPco`C&N!6IBjeajye*fC&g#& zDv+XK*=`kh_)+lBoFMs$FVW)rAU#(OX0pRB*Ye_i7{#3Qw~6Iq*|wV5RoYW)Zwed?2kTdX8~(c+hQ z!~}G-$;ro|Z{;Ywrygh#Iq!$lM!6%Z?Q1JSCSoR;qK`W*#7q0I2Gpwoi(U{aMNIJa z$KXwtMW#vkO{t-D61>2vG@e%LDN@y9^R%zhYSI>&5{kie9gq{7xyB0TM_u3I+4aU< zMbZt|;;u9{*NJqKx)Q%Ad=D`F&PM0fl?Qx?8*G~%Aqw$afBNZ`nwatfY;s7CD|2VH zKc?KKk9H`KY5OHPB&p>tr@>+R;rBqahv(#-4NYzI^!#e3}r+EtP}!&u*z!L3WDE>$?c*WXN+onq@HXF(y6D@?$Cc*4~4QynW|!%EHAl3hPoE&h&AtRU9tT{narv6<=bbm5QyJ%$gQoa*=mhvt5A8?3m`~lI zfcq~pRQg(K)^Oti?QSMWJzQZNX51J@?V+ys%k9CIUIj*fD8Ba-yvPF1CR0{kDPqI4!b|mJ zO;vu4#13gw-#T~6oxooiDcaZ9F`i9ud+yoSR5+B|gg`PO zy3MsyZq26(a8>!T>)Bt@m1hTi6;pc9k)&8(SH(yP-mQ+%!aA3ixdbhC$jjpU9}zBo zS5X^fC+3%Zj=SHXa+nO!+Y=tvbfa1MiuUDuwVQ1CIyOzJdNVJoSam3Ko}YK0UDk24 zRBl?Qjs19sXEzHjcBCxSxS$|h>n}mEbZ~*H*7Y#V zwY{VD+9Cx0#ujK}aaGTFqq^I@{&U@G69z?sI%yYI=uVsJ{8E9>d(lmzeU|x|I?S2g z2dtqV%<6{GXVUoE3CXi}kDUSzdg`asx*P6YiTEqHdGo}TND4+_wduC4??^;pK2Kk$ z^&VTKksqex{k|8k<3Zy2_%L2I?rOO@Yw+^b^yv8W67PKsn~L>#Bk5iEJ7Tv6<;QO)ipk2kmfxZ6Ui)o5)JA z^z@s6%{Lp-vic?CLlU>0{PK&|Agre5L2?IjPENOc`fZ+PLA}PHff4uZ@(~{)KDC=U z#57@{!XUc}3oOVOrTse;T8OUtFP0d8;SW=LfGKaa6KVwNk0ytm2AB9*?1aw-FHr=GD@^;-B8mXGZ3o`@C?t z(oE8^JFR=KHBxk@WmRWL1ADZ>>&-UpAlo{efPoNOm_U4!i(D3_zcVhsuQ6{WjPjiU zB+PlPk@z9%eCp6Z*<(u&%a-UzIn3AV&M;7z`A@AX1j8tDbqFR+-oP-bE{CQIm(1r8 zhQS9<%EYmclnvr>U1QoIGwQKSxh#7=#Bv7-1X!v8zx5u3!mTK@jIXtI(z$2YAT%`j z4eza>BIe-$lW5G9NVbghG^n);fD}Lx&s3*Sr zXOVin7gJeSL&t=m(DxVy?sRCL?+v6wGogV^i9|*(wJqfSV!_HbaIr|txX|X-c4r(h zuGrG~zPe4wt^FStjOzPS-Dnm-pRZv%hUHYUG>$b*BRXD zXIIJ`lAa`&T_3>9+c}Ids_ABCV8&mTmc~E_Z_sm=do)E6JEA4r4b%Hu=xsD=Ud)x; zu@7UZ8&x#l^L5He#c&!MsU5f7w>>hipj>a{5x| zatp^j1|jdvH3hfnq{6Mxv{ACy#o-c3@XObVaLaFIxHYkhXg7f2$+^I1yEGH(Ua`yX zV^u(Sw2#aDd)-51fz-PbIYI)x$-HIqZJxyiXF%iJ3RAhGdyH9n95F2RrGp7@h($n` zr28|iV|BoD`5dbPFWcEC#BdK5Cm(&bm&RU|fw)TzpwdABID)Rlztw!I2ac!F{!4u1 zC+WJ4#6xAw2A<14zCPlSgd1CigD6F3AGU>o+}cyK@cIV*Z=I4MjTJBUwYsz1%f1z| z15E*W<==Rgo#!<2W@8lHEWTp3^eajUF3LE{6gCX?M0CR#pB3w%dp8v7LI3b1ZO<@~`%$wwJm$Oc z)p!dAUhO0{q*#!Mt24CC{S`D6zTC$Nm4GrU$uk607>KzJQ$Nog|EDm=i=8h#X9 zfA|f>blzR$xWK$L%0Sz+XUpom9wQ~6+W;&vdfKYyx!{qfx2`PMo?9;042TpA24^9- zL5z)`v|1%3Lua%0mx7iB1VoLY**p5~E2oV%^31#h4~o-?$Rghzv+ZYUA2FA zo!M&gg=$OjG9_%K+LuVyEjg@-Yix!v9S%C`@xgP8ZZ*ht{njgp7B^Ps0EokCg};c>~|Y<7{yH$OkA zUKl`UkZzKqo1_9!M}K4gBCei?QUJL)(pN1v5Q--@%UmX!TFwfP-eGXWJsM;M0gCjc z%G{%{UbLl_(=0`4S3Gwzvk>kW5z0+B+ascI1~$?UN!=z@uuPEj2`5OKNt0k=88rj} zaE?BLm66*>Ld_+yu&{PWA6x!k+h)}k1)ykAx_jvEl)YSnVg76vTyorI4t{#xnyMAeIOxkK1*5CRMdP@3 zvKG<3NZSiA(Wtg~7l#!`^Dm=eK?#W-`G2E2G&g4+eEV6%liDS`;U@dnm*@&P=99?- zf_hx@k-XLLfnb1XE+95anWw5cwwEbpR9~f%_E13Bl2nkUjNUp`OiUop*TiK)(d)U+1 zY;LH%)cZdFd6UK1sgy-RnOd5}@<%!S(?R{1ghknFY9Y}RDk@;SizF7fOH?XD}*m^}24SrE`A=@y;@8 zxFOtM-%?2G{$(dbIV5AXq2MeUi1hz_3zBkZU1S;#aKznM#^FI^#FD$$gO8)8J-SmKvRt@nKoI2wl6Oa&g zDj|aneImbhdoep{h%yNjmKB6J25MsR0e3Ga^gPeur$NgRo?&U%^?d1Y|*_yZm|5clxbQ&EYyrhF`2`PC2&Qzc+bw=ahWIc3Jz} z@6Wp!3FGggXQwuzw(1t{N(91(uQrUKRF+Em@!m40B;`6l6oCxqYh`{f$Bwbaqd+o} zWu-e0Eblj2E6nN-K-N#M(Cq!xJ(D7I`t3xnCfzxUC)!@5EaB10Qw^6L$paJ&K8W8- z1z@v&2H{w3Y}F{vTxurkhVk^d9;X*J!C^vW#prm%s>w=) zQunfILI~B`fb=c>gd1tK1Zj>VmNLSkBVvrWeXLWiDcNxgmC6tqtomA#WtWT@Xp7Tx@BWD-Jyq!_GwdAM0Sw4E*{+S5O zP&^bkpa&DORma!r+Fd)}Xt41lSTn@GpP8Bfs)B{npOwEZjI`UEO62*38+YWChCPI7 ze`9tEWK+XtQ5jwLLE*Q9vKEtn1h6ag=%5 zgNoX)#}C)OTPrcw{K5!%;GP^Uhw{q>8X4Q}I1_?rpSUIgckE;Ijgt?9I60wsC)B}w zN@^JDgpZ|c9PUb&inP>2kq18o4%>UcOW0&Ijt74-z3#Q?Lnivh`0H%tULfH*UlkO7 zspN~2c|J{Tk4~AEMIG0dT<0U9Rn5y7pYLPD3vvnr?ox=qFx46+bNzEgBpvdu;3so$ zEhaDsR3&>K+-b%kaGC64=Wne!rvSw-e5CcAFF#;T#|7!WW~+E!;RAU(+}Pz+^DSU|hK`oU|ZE zYUe4}-+zn@cJ58FIVv|6Ec}|K*BT&8ob@b!*Cyh=pY)MPMb&8BBHBxr!bBCJjJ9`E z5mYFlEMReadAY*XqpGM$SKV;;S_q`mulM&SnYx%ZX7y=d)w+4cNv@oYNwU3e23*U8 z8e3k`;?tU+J*^_Mt_Zuy+W*}u9RP$?epdY_^PA7Wu$M1qiZy7InqxiyzOgAN=5AA? zNnT$?3kmD^93F#coL%0G2Gc3-`|J7Pz1W7^ZZ8i6<-yp*jf~B~HOR=W^DI<~o6hJ{ zzym>(PeZ04YweE!;qU*ks8TlRf-(YNN(+^Q;i(378{WL;x9)yOIH6S{8kNm4sRSDjcfojAt6|xAWYc=|MEJX zcA%&CvmSSh+&eYb9eznmxpLCJYl1aMhcsQ+hjH`xm|$%^D$82a;M1h0RmSy;Sf{YX z15xFARmfqaWq4zFwx$1L5?MOxM?TwB#D;uoz_6Uh_+u9C-|t|72+$L-l{caFpc`LH z!_N(dJ-b?@ABX#?Ru|Z$sNrAIkFM3nQLMQ&avGfRaq}xVc&xZH4BZ>_4lts{)DQFW zYCGzq$`GGo?jDpp&|Di)4o9Nf4I26Nv8}xH*)yMIO%_O+Ilt{iBQkpL@PCnNJp!+- zaRVwJC}g;r$)aO3ELYpI*!~}YCk0s|1ny(W@R-SF#49r##?GqjV4EUuK771S1=}?f zn`6bl$C6vH{wr0VFb-g37A;*~e6sHlJZc2Z(>&0UWt)g~=XI^8d1M|J-0n;bccwm3 zniP6Zp`r)e#Uq`*)qiac#H*F~pxsJvAZ4viG2==erl* zJ7ipr*V`A@^TGFn)z-?;1)y9U*8jlFj+7;%<1N(OAw57E{aheO3mz=t-Q>Qd78D_8 zlOr$l*rT^TtM{^7YABnV_AXxPIcZv)(!D*xS>|>BF z{bvTWuvDx2#y+pIV)nFLr43HJ7%lHX(;&Axj(;}XaVLrX{zb24CkY(q4mLDa9OQkC z>K~6BQz%{gPQ;41FE&MG_v+|E3SIa9uHAn95hlFe>=jQx6NS@B09cYSc$TX7J$*OG zh1!wdrSu-`WAG2k8lP~gNU_du4cPwz3o(5h&qY@Roe zVf(;%{?9v#;{8@bewWU8b?Vvy{~vB`vvV|+0Reat^7tc@UR!@4B(;eCiwfo58Ux$R zz~^4|8aA3gKkpV_(k#s`4ti*}c9&{1`3rqPKV-$st|E!-SIw)pr08>c_@Dt1^30%$ zDU-Z$5?YNa58of^-3(uaEk6lgwjn_itvg#VL?VQGJ#QV*;4rqtYOZsvz?+NL}*|nZH7@wrR_Z zIh4(V-mMY)l*lsGzocc5APfg-So>QJVz|F&251>Cbiaj_gQ(WbUxX&Ab7_QFl-;qy zyM;LYp%>?CWXtes!b+8d+@{ykq046~J#5$!{2it^eb*?8bRE6ZWLKBu&b zqw05?I+u^~W;^UU#rUF(VrO<7kdO=5pfwI-H=t>gF8wh)0^yx);-EH!Ow=wh({LBi z)mkC`L24SRu9kWLi5JaMCiulSH_Kdk+q++fVV)v;5)gR-{#bT>Wa;@|eK@h6hR*imaADUcS)K{>L9kcL~!ZZ+gm^ zS2@k4Zjh`VBg)Kb|8Egkwo>1rQAf@)Gj6W6%?UkT*w!~u7SSr~wUjEHW;9;@EW=j;HOWsgu?Se;d?+hi+OF3O)7PN)?+9xvWy^}IA${^n`TZwRyE7%SoYi1YL3zyZi*_j zQVb&Zli{JVVcpGX!H^`N^|Xv+OD_y5+B({~P!PEKT%1Q`YpFSeK#^KbOrPHR(K0&^ zF4e0GW?QwFXD{CgYud@B~ z1=2$@FZLmS@{{%65^LFMU-p;pRu#-O3 z&{nGsKZcu>1~7Gx`e-LjPW+S~z~t3||B_ZMW@88MXBS&WB)Um0UbLv%!i(XDTIG)^ zV&6~lwv)i+BR5rHQHvLbBGGFnlM=Z7P>iG@NCZjD;F1GyGhyrzXI~uiv>W@E*BGc~ zS`CNT$JuK>bK{ba1p;bQc7={f8k27Cd8Hh8C$m)E-miCP$}*CIqK_tSS}HZza=pHY5q&+GU1q@_N)Y5(PNkM{{uU zQ2zp@&npmEfjUrK_sSLpE>pXM4XXDYgy>?_oRBqF=s1%0-qHc&59D~10fOEYdNF3c zEPs5htEm5hhOQQ@aCUH4THJ0ZtR$I91JD2}NUx24=b(8;8H2%@2y)T~0|Q$n-?IAy zyJeJJ*SPfFqZS{1BeKR18X45A)!16#OhrgIJ~QO;5c5{0CihQ08oEc^Uwom1!;vDA z-7k|4(IkR@kk00^5ax8W`dfshlgIs(7UMJ=89GjchWbC@+9eTR=ib&4Zqw=XDUgr9 z`S_UK9#*qtf0jNG{*}VhFduchK7J#>6^(7F?~}Iju}!0`3g^R-gh^~zlqGONdt7(dGmsY z=qUkjyB{#PBXDV6WbfwVHF;dxGWv}G1cGBd&>KKYk=d#^1N~bOQj3AC@Rm9=~+qRR5ZQIGjb~?6g+qN^YZQIsFzr5Yrx9@Fj z)&9DwtM2JP`d0O=>gvAdd_M<4<*Yz&K2yw*kb~OJA$KI$wGKwsMd$a7`#c2EL9B)> zcfm?jkO*ZSkRyZ-fd|EJ&N^e$st^AUd}Rn8xc^NW=KL3;_WzQG)s!VP#MS>P4YU6r z(lEn6q~UKBmywy7;~&y6>winbY#dDgY7PI#@V~TST1L)qSNMMghZ#Bk6&(HtSNuO8lvN8dMVC+^TA&l0Y zVpCnJ26)-k*MHtVgwXaqoo#F&?Clzwfii$=0sUA>Tm_;+ic!mh_XP%lNcF3fxugX~ zlJZ3tN6f9FtjdFqU6fx`oi{f2bgn!-I)SqP%+V%cZE7^p08-qe(wqZ|MSvAh)lxd2 z)}uvQfjh7o1d*ThSo{jR|NRnDO;bf$T~tFh+4p%22ZZ3uJ+eA@B)9T47InqS{5?J6 zS)|D&g!2glq+jde?EFLD?D^(Kzrn%L-XwrStB!N+D=8LJdTU?TEAj{t!X}`l@w$qdBHFSF!O3K=q^zJjc&@0%U+{3*>%5 z8Cjp*VW>&S$UyJt{|0pd_mk;6stK+xuC}2AO6W1J=^=pq+k*-QOtP7o_4P;oGiB@* zFz`<83_Wr_3U}%4CBysKVN~V|lLi zS7z7B*EG$#A0eK8&KGq{Be0hG=l3LU25|@5%Frl03H>AgQVr1oV7yYG8i)Ys01U`I zU8~^>`gz&+9og|6xhH#Lc^G*Qs+Oh675H^c-Cq}fgpaQHiomy`0efWmI4Ar|cm$^t z2o~FMd3n{R3x5RQo&u@$3+NpXp~w81at3Ihx>-In_UcMQN2=|@=mjwjo2Uk{_s#+i z{sL4l0S4pk8(P#Doq-tNT_wKOrxyB#w$Ax!zs7|z9>_Hy&_Wvm%02+6R@%l^Jc8)I z*{YA00BTRRuiJHh`c$6?fT$rcuwxUBFSmbQ^0SYAIveXPM^EN7J&H}=>$NXiu(W^% zd_%h0y*rUm(3q{6B%W zK~`wLfc4rCzJhUTv~T!#EOANz0(3wf_uq$4)nC4yKrSskI{K=VQ(+04(?8+57YRQh@B84vY;B zBIhQL=1Jg zw+WW|4Qjmz#SU<94Qq=Dgo8Dskt+_g!mF$^nAys&GAFTmGKbq7Yr%|^vuKSoHv6yK zfi(})rPV3Kq8CVDN(T}o|wp`8cjn&m6EvmV&~$zC$8a1m`>0M)px$jI-kFaF?<0JE;ievk;lx zi{2GW5XxU_OOzof;iTM7Ng#C4BN#JXXdQ#J|I)d$9x zxVnoQ3z*9v=TWyAXxQlZ2f==}#8qRaDXoZ%yT%%jF(zQ)bn9Z^T~uA2T-rBE|Sgmnj`1PnkW;e+RE0dgkUvNi z*FG~J?0;4{#Tp6mf{?f2jOKQ^mUYdVaFJZEl+ox9c*4J{XIbp3ffKv;;zysp?>H$pahC<2Fa&|V4Ut&yc4MK=qO8%kJQqh zrquEvmb(_Kdv|w(zw1+>Vt1MHFW72yyx|`c`#XkD$-JYKCDXjVj;Kr2YK*hwV+zRb z2fn)LJZQVI54fk&m)ejSwNSmEM}xN^Iws5G+tF%0#dfn9s*%ldR*!G~q&(d}jDilc z{fTc>Wm9m1KMD%qlKqSr{3BWUVu#HD)E=4q2_BW{d&F=7Wj7o>`^qDAIxxpoOsbf* zt$vz7+;SA76G@De3T7E0z!5W4uu7r`J!AvC6{c**r!a2gMxmUYu9tzcQ>2mntQl{A zdM_3!HK8KcbnLTR(9O^n6JuJ=Pf+GPD&o59_jy`SpKVAUV9B`{(gbMof7oCijb|(z z2tm~5sn~kEWA-bb_+^d|t>lKaLfW3b=}g|sU~7-1wy$#3{Jr?C*Cn|w{L0>>{hQD+ z*vi`VzNWt;AiIZI zNp>_E`Q{fzi8WU4k$R;P0%x%qOxJzUQia}dnZ&jnhm-qWy}kF+u@8H;h1#0|7hPZ3 zRdKYNbbnqMs%HU8!r1D8@x!Y~jNCKraY=enT?Gm;EC^4Wg_-)Rbtm#~NIi9KB`Y4rr@T_!F4QM{Z)u^2%T8SN;Yi2l$o0=Q8@ z0AS^c3u6YG$I&taBGe!iO_A@-J_`M0mZ=xMooaOna6IV(RM#-oBaLd>{DLd7)Q|7K zZ6O?_$}BWX9K;p72b|oj^0Y`n2a%iO-kGQ`3&Z@95gHCikfXz zGK+)d=WsYXZT0FRCVn>;s5|m&3rJ0`M8hIotPyZYdiMtH<69MKsZwvMbCRv(r|K>% z8beL82*cpP)v_Aa)2Xi^wfnX0?00+|gvjh2+>`9rxVfn-N&5S!(V54V#J@He-WE?# zuHPku&dCsJuB7nx{hgXWs!d*j&urkPMq%R@N%e_rbNWH)AiB`TZlOxKxG%jJW2Ad) z)!xOmv$tiC8W`omo+EVXi9k-m8a4gSE`sKHdtvO!)5dWu3iO0TEh_jWcAT8#crp)` z|KJG_b$O0iCgjHAsqReX1}6P*&LVO3|1kpHmEQ!%|7r^19FyQ8Xfcm7ND%=Vd52jV z5SF-=^u6gme}qXuxt`+f}|*JU8hecf|!P6@8_YZ=vslTDK+ry z;rIR18&YkA`R`vS2Nt$2; zdYz0>mB1Vh(~-VyFS594W`Z5~JOo4W?mY8|D7EFEnN#T!n-`McK7#{O%K&9D2>QWc zGy2xxP$=WidT6bhJ55lM(ol@TkVl)5N7J4l^-R3Qk!I)V`L}&qZKHaCJo)P)|79L< z+Z2F_kgbR=%=%vS%D`zqPVV;v7zVpeez-w;c+LVP#uQJ%sOqr$7~)e-yes+Ng+&5i z<>K-f+=i-P1U0ovb=Za4y;5u2)RX5PgidVTT*P<+N8{LDfgvWTHylQf*|H_+vl#9C z6^#BfK6wk;aTC@>q~`!+R3Fi{=C1I@7U1JeF|79N1eRh2EB;{(W#E+rrw;M%5~e!) z+%Nt9<_g3$l={G$%S`V^6p+v4o+hA{hl7yqkOw9imhXKVH_)Me{H%_D&To0F1qIm+ zJ?U(a5-`H})3yf}2A3f=Pp#)EO>{iP5bo=<{@bQ}TR> zri?v(rjVG}pEKOr$=OP(dMB;gEl*w+d{R8vPdXl@tx_SNYBhTWJXt3?&i)p7N|iAO z%wTY)9)k{G4ytZB3ZH^YiN%++Vw@@g!;`KiTarDU(v&_QOncxIEl#mhvZXC4ZmQd^ z*>t=kP6tta4vj!N$kP*Nc3KFw*w4bT;0v*vUuGQ(7`X5oG3Aq>0{9gSf1oM?`1G8W zu|=eaC~iMS$uCt8ZYE)$I*oRf@W3j5Mo3HLg`%$n$GFxFtzT*dh?j94^)T)0P&HzN%*k1Dq=_<$$Uuv*wyTZn0&>> zn+Hdi+mi8zIHmQ+LZwZAV_S^R8_fRH6rxA*_K%++7hvHWJ*1Ve`+GdP1b9R9)cl>5 zHR-mKd&}1ve>aQNd7rEKSUm7(+HCp(~ruIw5v#U>Xct@<%$5Li;*`3K`K zidWqQ82&!)mV3qyi-)nDFxq{zvCO--z^L+IdfbWFU!y`lMKv9;QSmWVs#AmwVQk>q z1O+}mTmG;NdqylBR~hPHCz47DG%za6dCB(JmF8$qMo)bX)sITAH{Sd%H%FnS&EnsA zGQHTrPgz~y>fh){qB$`ggN^j3-E%Iy%_IEH_p>lthDgZ&t5M0%42V{0V$I_1RR7ed zuYGWtbH243J&`kyL1k@7|F~ZyU0WeL z=y!ctrOi)Vcf8ximn(z!xRXZQEPi$4@7m{+sNl5}lyW9PE8?CdokTJo{hY#6gkz%?VopXl1$zH-NQl<*`Vq(gjn*jfoLY=Weh+OWKPF_xnlAjiW2= z%m?^hx7@!u?-9_)+EP(ac?q!3GP08TUR6g{K+WFr1U;w=1>K_9kP17@Sw7g&`rAvR zQ?}(U<8#Nk5AtED|NbZBvpL8;vS{>VTcWP?Tgp{ZTY^)LXd>n7{q(lUOb@7!onqQ! z9fXDBNRgEM9e}wqV~#F#X|HK=AT!OT7UD1UB*Gf7z5kAAoq5kflaQT#@|*{9M0C&3 zfd((VtkI>FKacN!L^hkN9Fn;>N{_i3wMbMXRmGC61 zFS4t17%M9+3S?N+q72rtF|)Qkofnb#aN`E;+c*?H&V8E*Yiv;l1FV(XzpUfddrghT zRmM`<<$fYAUA-m%FZq!aHU_P@aWN5TL9z~Y!!(bm{%v)rOB}GrKX24}TOL9ZMT{nr zf6TT(_i;*i@3ax|`DxZsY%-iL-jKWosl$mH7!{CTuxjy03#K4fIwH|vVz5|81?rNpO?>D9tB(-DrP@1O@b5v_X4`3hqp6Ka`oh1K zx~gco?mu12?UHu`B`flGG46@>cAY+UV1l!*@c&RLkXf_tqL*PAe-65LH|PelR2@?a zMtP_7(=XTL+S1~5kNFF4C#heT8185JdPFQ+_#*S%;WJy!;fGV*;=$_>?O=RMnmGmh z?#uIK%dvu@agTRZh=Dn;#lc^9trt2YvR zDKT$dY~(&v0T^vVh{mqs(Tk(yvUwZ6KqxQV!-HRR6TGz7!a*@01; z`k99!$VBp%)K9L%c)xD~f#yV5NjRDYxW}I`-fbmYE5w83Dbn`(3tb^Mv1T%}bm--A zLF_ulpyhZT51XHFOE4uac+_SnI0_Xc@-4ZK%F|yj;M(1cUEh@kKsBYVrFu>dE46#( z{a`{K7N$i~g&9p7(aH9;Dr5yR^3>_AJqvQV2!UXc~8xh9KOmELCJVH*|BX@|7_q9vFO%Bk?# z)}iSqRQcd?IA3Ea4h=;yks}2q+q-{e74Slr#slt78D-)QNTTa%kaoh6J5$;#cmh@qR@bAEp1_4qz!NBm1mcOD&xjJ{#S~<~rD%@~gimZ& zC9iLza4%Ghf=FO7ul)(4T4?upK9%*TeALZc8I$J9Q-;j7Hs_e$AiR^fH5kxI6|FapSoDU1o|s$>d%2Bk!B5tTV{Bw+ zetOw`w*87NflO-^;nYg3_T;r!WwNMT`YLJ9Fgu<$m;?d6-f}!LMzQ_Y?Uxoe!(bH? zE$MCeHtgHi7yBKG^>=nWnjUZj-V;cQpJc#2Yvne}6; z+(T1^t0qC_S-z&gRHQD=6Ng5f*b}Yw;fJoXciehNxtU{YY3(M+fL>Fa?c6!_%M}>; zajOZvAuP$3xmkxb>qn#Z;1|S(QGP3xvVx*!)w2cG3E82o&Zcb6gcil*mqu$0H>fd~ z3>A}&(EfI5aZsF&*w^1cn<7-FyHzSH;f#3Qlu_*8jaJ*|IuN~`zuXq?9CFhYH1>J! zZ7?NnFYK^lUPY7MY&h&oAc=E~ChDI5PM0npay3gt*f5*`_mK8wB1B7Q9XofE1oRuNU zX1Q~T;ULQRUwOx?*2slbaM?Bu2i@ImqHKz#_p%I{MxF1 z2Fq|Baxa~@fo@fez+UaE>&b$)i7va;MBA#S1*k>yIrdy8XEXC5({p!rFuQ`7dO>~q zymq780_aMgsHw52Qv(lWhjpPIl+W`ShMfaeBDwRsy^heehfG(pu(QgaQJ3kpl%uDT z#n^hr1$`I#@X2niVH9|o!)gVH9eKZc=>>g8Y-L#M7EAVX*bRx%l4-1?_++kD&`_eV zvi47M7zuvAiYRKowR=ymJov;TEV}+4fenDJk>CQRbvWn?p|Xl+P=QypF>q zpguY|txM?Q?j%o%Sgi1-KqpGt_!sr-=Pr{NsH!9{Rb zaGYLC@l}TAV|Q)QlysfVc!-a;_d~Mh`fF0#Gz;Hd)EZ`qONvq!pUOVOPh34!w`{FK z_3^@bF9_2pwG%Z=bi)0%EAz}wL5?3`>4~PNbqzUfLJSCLBSiKbq#1aoG9#NCTN!BV z8b5%9rg5rfVT&*F#~1n;vsc&BrYcQnH<$QJ+(}1MYo)tPR)z2G18EN#UCGQmzk2H# z6S`ExIL(DC7+5Hs*N*U;Pj^EdCThn*e2;cmzIfzBY=!QPdIbY%yyqzAfNT8RIHUl^ zJ}#>jUtsogGqprFGiiqeSo>v5i31EqaN>*P2{T66al#8|TJo?qjp585b;VEudJiK$ zHH3fc5lpFnA5v%Dtj{!ugKcc~`#^FrfTiycOI<{hLgA}p#Aht+$w8mSdKKd=JU(B^ z>IfN~(2@^MX0{LMM@Xb##u@)r&MCRu(;Bc+yVR))oq@XC9^82N!4GoZU^pn6nQ(-m z*RE*qRY(N~%7TGXoaR!bDpdXGDSXc2tZoFXz!n*9^6rK1>5JPquGUq4Ta(Qhztt{& z_;3vG_7|(@mB_Cc@q!cbgY!M*W+GfLle&nVsV)4zO>4eO?8H|{UVPSLVlkhf^Z5EN)vYW2BD zv*=6E*R~1>mFyW_@w*O@%lje6+ksu5ub7&OG?B=8Nj+I1 z=Miq(L^D1t%6d9@p~Qa4ssYPKDnR;9%DIjsvMXnLF>|wP%}`THf~)pui&G_8+{zfw z>GI<~J$y@-)2*k3x-mdKO7&uNQjk>CmaYJF2RR29YHF2K&UWEdiuvR#*dtHLj_Khu zx5j1{G=f^f9^D(c?o?Sk#l`>yy`VB&l3;uDqb0HYdd~T#z{0X(-{=8|TaYvc)d+Nyv zt?1bKYe9cHR*>d=f6!odjS4P89h;b+lclY)Y!Jioq8W9j*I`Nt3(Po2-^kH8$_DJ) zM#1G%yPCTe{zMSM?a@RFg;X)b6aHZ2oG!W~k+acnEQ;O;Q?$7D22CGJnGL5A`w8@3 z*mYWjCH2{3l8`**#Dj8i&%#fLQE%7`!)R()=`nh>nLQ`zsyFUJ1O=bfjBS-Ap*s`{ z3&VEH3e>io9P%^t*mgIe{#vd|o@o zGM}^tgDk~a$sv^$n4>X)(B^0G$#AJaU;;10mb%un+BB_z-dq1YZ?lNo&?S_0t|IrM z#||F5AT_XbM;ra*WBuH*AP`y#L7M50EQ-sl8I zfL}mN==9F*CTuccFii?^PSj7!MFOQf7*+0zb{!UkP`-B8==R;N`29c42ZSwbMeL;a z4Gx*{Se*Ezs%fw>;ioG{mnY+fA7=49)`H;tgiReQVo08k>|v!Z>Dgth&Ii7~YK&<8 zDM#sn;f7_`cHCYmn^HEE1i?w;iTT%`Ce2vg3<57Mhs1dsFM0Dul7erMFYET4#lHH7YLM@0`&PHhrH* z(+{;+Lh8mZ9E=aTaFdJX>04L}cV|PmW00$f(k?KdlFPK8mDL?MD#qKkPz>waE@;NN zCl46!g@hM4QGN-+p$4T}hpT$5pzj^EgoyWlI-UOhHfb$Xm5~ZjlK0PBLJIToN{dlH!gT*@5Uq3<{Sx*+*no7Eje%l*h z%%LQOfXURZ$n5?y+nF&SW_7||U=u7xc%5O65})?djz2j^4`}wxLC%I%YT_v_b=5`U zlXC#DL;lE)oi~CDwJW_}3gl%iJK&(c6p{X8{C1kS60~2JGpUJ~ziCJ>cTB9U0Y;XT zfXw&TC$ z2@}bl_LczdMqi#&RQNkO=C!8znAb3ND_>Bks;>2rT&|^!@8=^c;$2BL=j#RFz!EFO0`H_8qwYzEAQFwPh^%2z?kU}SgCkB2V=KKC6DI{{-?Hs^Bk7&2 zDQ&8l@QA@xow@wR?`$<&AKpJbd5LI`xl%yaFSc4C<@TysOa0XiO3BB{xs~^+s>%yo z)yPG0E<-N(k{=UJ-=BsMFY7I9v(lb4Pmf#9V#(u(mBh~%mpM|k-Fp7cK9U_MD-yePOXa8Cr0A3-`(_z(Z2oJLh9JIvwn_sp z`nmn7yQW0zZeC~q#O+p|E2PiDO`mU{Rtaq_&6FK(;4sXyj6Jm5{?D(HdC@aGYfHG~ z+D+t)*c^Sump}W8%;lgFC)y|61$r1pU+gFl4ly<5Cfm@@v zCh$cj)UjSvW8SPl2+6OcSr0`Z?Ml(3pEvXRappgtj&Xtci2##|{W%7ZrQ79`mLaBm zWp6i@B>>HK{Y9SkeEv=S#jLV^WPZ=})o8iVM+)uDyUZU(Y-kB_%#z^4@u{jDC=M|b ziHvIl2!HszjZrt_Lrp(~OJ6%LUBfih;u~Ga_`w%4Nj8j6x=6)^uc(kIL3cUc}nLn!e(B+}G4wJS7H>Jf~<=J2sRyayniG9d2(zZZm!l|C`YS$I-k+WkDq#$l8ZOH}N zmQ^faA4<*Dt*ZBJy`fC^B^)#sU`$}Z-0B?%@ldRR_h#SzVsk2Wq-u1I(weNL6__6> zkGIG#m&7$)E$CEtGUR4`8z!@Po{10p!b1x|%?;j`I7rP)i%gxpH7%6Z+-rxfYXtYc zUCwQ~N{iz_@A%_Z{4_DLG2wv*+8+n;LsVo2Of_OXYgMi$jdK31mVEr>Ve1*W;&)mD zO{C#qV3En=hYV6oX6~NphNh9~KwF8MK1pix zv@>jUv>}7a*1gW-H!6s#iD&9A$)Yk)(fV#)S^-`B;h5;h3D{c^%yzLfc|!Tw_7aDY zt<*Ud8G=JB!q!5yd2pju2{`jwN11zmB--&=e1O|KX=B7AF9NlQw;y+=9^2Ty7_$e@!khN@7K)X@i^() zv|C&{yeWL4e3cX({?MQn`mha-2;H>osXyD+2>lxe;L*UdT}qbmJENZDRDp5L+%~%9 zmR`;|uF@W2@TL}97+lHk5TDY{6U8ExSE7lqrV=g{=IGonZRENRu{ZaE8ZInCV`V5w zJr&%uF3)dk%}~R}*oXKvFXJNAP~LC! z^(gbgHs(0IjL>Q$|2oUca+FRO)JIoRCJcYW>8)p#VV}H(AF~<2GQUwn0mI#N*La=< zeCvo{L8HliTOAUL|M$oXdBUjZ@CR>UjBWe~`^xH<) z{<(M1=vu~?ZQJn7??`Rd8cm%(DB%Ov5vevC8K*H#KG+WYtKRyZO9s$+~-RZg#mB#Y>n=*cjE-_*#OBqx^r zEmYy~nZ_2h64dTuJa_FeWZiW**$0B7wjpGlM0{BOle;H^xpc zxevjC4+!o4&uBfhDwue=C6#Pl8D``0Axu=>G;CRog^37{{sxoSll*$GLjBbhdBRy! z#*EfpSK2=R8s{oi8*F8dT97+bjEq{U!i~V4oB0X3N>tBfu72M3Ckg-e>V%sszg8=^ zJ%htwMeBfin=hxYb;-u373HwFROze;Bg1L;bt3>54ALwH-Zd;9gk z*W?uy_CldG!xI11&4*Td-E$M_u^p~iD+`v~_TnoS$E_O4w0-k(F_W!{x z9a^9VPiS^s_1D|E_`J6LH7?XI<2gy}L~LD#)~O0QaduLq z%4Rf-Gw~k|gd*l7@cL;IsF=LCqC!6L?am!c#Y- zH)me2)p;Vq+&-#=M1$UBx%6}`v$VK2tOh99Bn@>zfpN2FyRTxh58~Twp;qQ?ctP%P z6t_whA>GObIaS;=+YMe@s2Y+i=Y*ExfMslYAJ_Fj;st3xKDMPAJ+fJk{7(-nN+nw| za(shdJ@XFE-7xCbZW~nvD@ce46pg$lqAJ*ycX_GkNAkt^NWZMCi)_x7EpQhj4PzFP zyaOxLmC|I4G3Rgv!{63+vsdibpWkkN^S-ZxSTSJfgkGfoHO3byL8sev73NK|z@v{I zrx#eT5RwoXahIzTJm=P3W{Ai+D_0~}b#475RM&L?6~fO-#yS|oqckbyk2T1n)Hkdf z%P7-$xkq1@d;nu}PHhT=rr5lG;l=`BP|_aVde~I&>X6-07l=(bbJ48&W1ae~20(@A z#^8#!>nTME`=BJj-su}yQexkHKo0tJdYvMv%)_^bkQF)Mn9&8`w?pmeb=+&vFntAJzArAvR~6L&D!VY;Tv zYbkrzUhl^u>TN#unFpCwEeOREBi4gKVt4g?VykH?zok+!wGcVCtv_-o{v>M99fl_^ zup}xEw_1D0;r;`0eC`1fWA}wkgKt?LDom_Jwa8 z=RDaEGVHSIx_jE#YHHS*dl97U)%oEi>+zFk?831&0x}vgJjfersx7{(FLXTXTCsNs zAKOUPz7hndr(WG$D~^$?CmNGxtmO=OqgL)jSU1{%OY4?s%xi0*RwR<*hF5gdQm?w~ z1`Zs7?p0f8$qJ08nc&c$+cAE(XY+kgbjwX#w6ium*Q&md#Hr!nhh55OuGpY)=^P2J z2TKN|WHDaE+o)AUpq1TFBrAqmrUh+KfHEi-^YnOYV9K}bE^{ja|ie{$G-0qY# z${+EG9(QCjOWhG%$~KG6?6NaNn(aRg|MOl3oVIQ1II z3MwR!h$B4Sb9O!shlOnfTf8OYz(=gZYzyxf<`9ei)~SlY%#Kv(xM~ifqyrW^PQ$OH z>33lt#{-wYJT}fnFTwb5l+v|RoQ1A-q>7cV^WiIW@1wgsk2Z7iTR$MxWvYnWA8IZo zK9AV8T76|JDF{r)m2+$a zwXtX)g7eg%^KstZ{&Y_Yuy4C!E(YK28F;J40KUbJqXUG;7^V33Tjqh4n69U;dH+ zmhk>>C-m$|%{U@3o{2t$Nq86Jvm;TBff^bu1gNr0w03cFF0LpH^DMV>(?lo)-CIutmwp@(cXN=U(j7aL%wY2P2KO=TpiS_S;>ehmy!di^k`+C!%B_pUC(&7oSJ6IX)rDP zvg$_8H&?z{ALVCx-7XG_A1$ZM8<8tu_*B+Jhj9KqJmS(f+#0!ms*;dIm^`Wx%g8yq zyMvSciQh91P$u0B+u|V6lmmVjNBC{=DwO1bruANL=Q}dB0jT1adY_`ASrL53z2v~W zNG1j4%v4>lR|5SFX>MLQ##Ti4vfdawT~5x1?1$1$AG@R<_HDG$8oTTYj5j1NI$xrnKV6@cE2tafbq75Q$LY7k5MRqgAp#uD9N z4|;y|HrWrk&I>x2%gy4FL0U-?^&Y$=9otN{*>}JGV4G}cWRfCFtcYmh2_MCUvIt7u zPE1=*gx}YJ+I9a2r;dgolFKtCis$xp0uUvNOhjKPmwP^+LVM}*gJRTh~7%y-( z_UBpvF;+OJxJTaJZkd~#5Su^L$(RDov+ANq(TEQ-v{=nu;XyJdR&qu%ij<LdZJrD2p4RkpE@>v=>~-?>{NBcF8{DH1Q@}^Y^vWa1 zX4$K(-xwyytc2^R8KLvzGI6Lhu)lT8^5VKBO&~nI2b+s(#o!>44HFs=|5E`V0R}}* zWuQ=H1Z8qAu)q=6*{UqoGrt|@D?lB}#r*=KnJ#y9x&I;Lqh{`+uqHti8|TCtOKauK z@h(*_GVqS%gR_11@dXCON8#@1;86oG*VRk5%;cu`6WvOWrm||W+~`m9#-A8(Oog_Q zK;6gG6LCR%II3m#LCSqu)G=i|+JwFLv@@NNWkb7F31{CNVcbeo`6f$X;yF)H_ib(H zT&gEGTPmprrap(sg*Z`P3~Kw3HawhiRt}IDyZI7XSGeZEVM1EN-{hjAZ@Wym`MBb8 z@-b?b1qcqet2;ZdtpIT{NZg{zcWq!9yqM*~Jj-7`t`hz6nxU@KuM9Zw#u?f4s}0Fh zpw!`ay>jS^wC7|$f}@juaR9t7r{WT|+zl*F5z|Qw!9b}O=^THn<8Y?|GH}7xqTTUg zkB)Q+yjY};4&}XL%Z`%duP})+z6-FwUqJhHz+C@Jw#Ui%FU{KjneC~|3CRinGuvaJ z{m-@zhF;Xlz|4_=<@>qNS{4@0?`rS6iTh65zSF(`QSEX5d$spH{FiF) z`;Gp!+M{LsenH8}#9EbrmF-`s_dQo~YdTDw&dU<*UdZq7*&-gz&KI`v> z?;i!<|Lphvqt^TPevj#2K8t_$dz{SQ=lo~C$IQy`&*8uIdo1kCjQ_v=p1X-Mj%K}$ zo$K?^=06@5I6qyXuBw6kAwqW0p{n~>#qC_-ZDKMVuQSuydbZCN?~;5v%3Yjm7847p z&LZ>C37B(#jLb&GC4~hc=H`|{I50RHn;0cJGdHy`LUu}NXzWl@4(j+8+prOcK`XHn z;QJ+W8IHO=h6zOI2s*@lT3un z7iHvL#~d^lm=k2ecd7U(87P)i0JIczMma@U2~xa*(z3jCo~a8`)z#Gjr0pFM!`>NQ z#sb1OurxlH1gLZnD0WGC`Q^SG*og(SU7Zmqk!9-UYT3H~e$z8SS5k6}kEOKz0mG_D-N&>0IeO*zIZUZ5<%epYdJ% ze&`DTR4|Y~n>yN`2lDTFN#i|p@AS@$GjF4C7v3K-yk8wg*8{s}_qI*1(?%HqI6Bta zo7!K|P+;n7E1+Mst{?Nv*uy=>;rWvFit%SZrEPR=09fzPgj9LGkUIvuAhmZ6K%a2M zg#|$zBYnGBrPS{^;SwvIDMRoFdz0?~)72^DgVU2Yz+p05GqE)RCQW-{W*WZ*Fr8<>U-*XZKzN(w(y36Wa5660{(?8Ti$C)B>imU%2 zL;qL*nGGEQcW!gk;M?+YPZ~vfd)tcJX#+!DCq~fW^ge(e>r)J548Ydc;~o*_*Xf1D z$)OGuX~okCr0OD@?K)+Z`T4bL`T5NDaZc5Pxc0Tj?+FhC<^eppo8sd?@hW7^oIWrP zO41{(BA{@`l%;F{dpbfYNM|DBP2QU{vP}dEg8|+IVXB1Y_rv%F4s^~RN6LvpsO~~< zxx2_G>)kq!s^0o%E~bDl4JB84$zUN?W>qVu`mBVgCq;@{sn!@{!e;VIgc*OD8xEd4|zi99Le5qPOsuUP{T#vsu=%Y@hMJ)_2_mcAm z6H%VgN8gTs>q9k7c7Vn>Q2jdLF&u|^jiEWYy`U1z#M2<}r$PWVeS%+kr8J?~QZfI%4{)!*2bQd{<0RxTjkCU`X)isXzmESI`vWXdl5BMLv^7*SH8 zu8PnN%{dQ)6$QzAmiP&X%f028CFg7UHHi-s4{yj}d=Rg2K~iPEb0AD&Ee-nykTNf= zoP<*N&jN+Q2yJWWWPe*-ds#mfvgT6$ilM`Gm*J53-ff!`EJTE-h70No+LD*)EZ4u> z^AUJ)mU8SU2CR~FAM<_TyqN>pk8?krO1jp?{cDoxvP6b8j;*>bsIg_unHq2PNT;sL zXZR4;U_5@G&}vOEzT}&}{AfY!7-uQVI}G(tr8-SC+9g?cu(g1aWV zimE%8I1eS-o{z`}X7?FyILP4Rfh_P_$k}zK(Tc@AT=_lt_BY6O_eJU zsYAJLRL@CwQtQJ~LRR^AHugqGDa$z2$$`E4sb~kNqqIQZ2Y&?O{{4vleM5cXWmT2H zvl}eAwoz~~6s*I#e26g!d=5&pnQZSRIe;bJ6x&UD(rGDoNRKdX^EzjTHaCepO^HOT zUMhv6DifS6M*Vt8>Fbg5YM_p2-GopHhNS){=#mHZBrz(vR^qaeCZh!5h?nfo?+u+l z6*h05Lz+J?qP$I#JYP%7G!i*M4CpY5wSCff!0+@Z+2}(~Ctn?sIlN)2 z`DndCA;S~6|v&Ss6$cy%yDs@me4&d|B zQ_$ZTsx#uZ)QjnpYZ1Di1Qb70+AJr%Q+qHRnsEmyC%pegre31jEr2yZsCO2EMDYo* z%Jq7M$!-Vz5PO`{b8^;*pVzAG4+V#NDuFF&cRmDfoj+YyX!s2igG+m&E76ef2jtm;5 z2%GQ$OCn)u9p?^@rdn4uyOyuY*d-#Y@b0D4JM5<_TujY+sSVB*0$~>v?6@sA-DqH6)^5oo zUc#!@nuD^hn#F29fWlY5+=3yJdg7zO$BuIy&rd z1C{+M!-e$05#&V%w!80ZHL`QZ>Rr+mQaITHDe<0*M|;I;U7$S)?w8Y%5mJSfw&|^h z46$f`T*xhRVVW!7tZKW>n+}+>1`D^R<^3%tTQC|fvfB36KYh`rEi$=5U5KsYB4U|PRhssMG+(1Di`owOD;z|WdG<(%!zJr1s0;#G1_0;f=2USl!&~p-D zK`eo`gG`%==q|6wZUI*ecf2z2LKX9`Ym2g8j&+op2-3kmnuk&39y0%cGc=${1QCXe zMu<4bCZ-sm7;J2IpC0{Sf=eh!tIH4$=$8obxz*6D8c>Z5V5{)4*E|Mvr5^Yx(TnBi znm4sV(95BdxF%ygkfT9df{kJyNqEyup8nXsPz#SiJoGc}b{Tr?w7u1oTb-l*CB6he zR=keo&Sub#nhI~g%{c)koI8GzWRf)}H>D>O_gO6Z?5!N(*0RPJ>B(jJcU)e|bpn34 z23)I;Ru0+$+)T#$SZ8gn08xEJVn+I|VZGMNo`aM9n+SM&wD7ENt2s%;c^tu6Mu+JG z6yL#;c?eB2bAIvM@k2}P5N(?CLs^6@SCEW3$Dz7ryLX!r(`95ikM@IO)|mtiY_!zN*+_4HT2cINnleK?TN`hz5i2 z4tHKoPoP!())Q^w0VpPl#BX%$`yz7gtXf@aw z|GgvT7UNA@3q7T9$31(>BXpwJT6;3V^*Ekcow;~YdCLA_m={Eu;Uy^ff0xgc?gKm0 zDGe*hYTNSp{-nHXc5?S45e{3A3({-1Pa*s7HIb~Y*GX1v=pqLOjD!z6`qv4mk$L*E zxI&N`XBaKw80{qhTA4raN7dOzH_O zHl(t`swM6qh_w}c$?yTbwGVE@yX3>ZQ{8inxcV&6nh${m_wcKLuY30G#DRL%9$8H8 zID_f3ToD>B9GVKvm<~v5n_VlEHyl+ua7Byxj(hX;Y-*4->ik?%g zU$GozoCvuxce)GHBS;{xrE|*oF8F242woz8k5?PKL))tvE<)V_HaD1K!NyPi`7Qjez0 zn{_uPgvb;V3x?1~Ooim%mfC$D?pMXS14;2FGuPZ~x#J>B6B~l2CxW-jS`Zb9RE%%9 z8OT^a>yQxBb9)ED`1dFZx#)$z&*z$kM>o#0u8*Adx7|0GI$W`5oUnRj+&>YXXsuYb z2m~LM0AkR##au%-@r+5|fzDGOL8dA9AxkatUbasFs5<qiFpQN6*J49?sWgg=%NJx(|lSxr!^;yO{j%#CLEx zOMHl2B9Uf8q2;lM(-@uOScp{gh@n}}?YPY(v|tW-C?s3!2n;A!8Dc!x1XLlC7{H=$ zv@zG=N0nENj#wsaZhEGfeA`GZ_nZFs#{qpovI*=WxND7bFMHk16cVcVOgGLu{JH*E z0qaaC$-AKo5QU^c4s-SED@5Oe4-Udd9+%4>UosIDuqXLY28N&ZoKJ%yXQrC0qupEi z2El)>_NI??mhzWCC|#MWH#47DRHyhzptddm3yo-avNEkp=Ri%aD2ZdN4hFdyxN^kS z5zBXXZ1OCcjG#wDA&zXZw-m*BN+J@58JsU@pmGQIj2b0UM&zi5o@we{VlPtgfKA@w zN@KT{G|8heS0_11xOw1f0?+FEkET{Y8J`GI(QZ+jE{zqP*Gz%^VmPFjZoJ>WDC&KG zuAp!lgY}9USMuY5(twNM88wzH*174_9LcAKt(B^xX(IvsX0UxlkY7GfjaJ2o4N-cM zKJ5#SF^&1`?=ew)zExVxd3#g~vkj)sUz&{dD7vqZ(nWvC&t=<#H<572PweY9%~Ee1 zGi`SJa&^H&M`a7;SuIMSW2*s>>SfIOQ`6r!a^y=+7V=cUb#*UkSI)@R>}7Lc_m4Rz zHOSK`guf0zO^W~&e*PpjEl44nQ(K94G`aGS*`Sho zur(F99Sn<_EG&+5DQz`6TPUV0TUfp^hZayL(VM5x9CKGOwnu~_i)jq6sZn6Hn@;#P z!Jy#zooZjLAK!1CQtPzL(&8M-4g3xj=AW}`r2YLgC(wg;BJ94_72_{+(>!KusNviVL~H48=AR(-kT zCcey}YSjBusp*AQ^l!MfTjn)a0-~ausN!Nn%C$bFO9$eVH40)I&@Of>!IvCdtf+@Q z`I{~tc=R3{Ck{bY>G_vXw&&8l4%stGr~Nf71-ScqGfFy`JmDkllF zS-E^+6L&a#Y^@HdHjCvQW=y}qBqDOuv86=n&z|t|O8I718f*)n!<45?L&RP@({4&x zDZ-c%-$r2uqf>Y#Jt>BV9QBF;&O%byh8=giw8qLV@Sq5O)53jT`*$xPhp@I14{rCk zMoqK;>&hCE1b*DDNe>fZ^cJ3&NFZ~J)B&Q@M(#pUeNm3c$M6FdJ)s-i(ByW##hf4O z#d-eZfL(~}ipuwfqk*l@kI)g%AD!NMb59@Okhu@V0f*$%d;NWrArY_7Z|b3_k1N+G z_d%bBoU!Xi0Gu<~!y52drCK7cJ=L1vM`MF(H3MCOMb|e2HZOji5zESLOG8gFq#?KW z2^`Kp&By4(OKNm2FbW8@po2GjOH$~p{R+&^iMGtQME51~*!(ovV_OC>>p11$U&l4U z?dk3rK3M@VmBnVU_dx<#llq$_#Cz0hT~@)esj^^r0nu(HaYbriy%RG%%~?OK&XUIT zICHX5)5hiZW&^ut`z>}4j{9H%{p8lc{FaDzc%4zn8MaP=(gS_zD*b5W^kx;MgGHBI zA$oSi<0*K}6bQ>q&oo*1Qiy>ieo8Hh4(cf%GGOKe;!IL-~@nYRW&+Id8DC*;8I z?R98y68l$zo2kg7wRP$wZcn;^#^b!gLe)I&UB+=6O(2r8nq|Zo_KV!Iy2H-?Hu;!I z@=z_)out2PQHu&Xc@w)LNxrJq5viy^f@{1G*e8_3KUBql8HyqvFX2%nj9${qHT&m> zoS+J{1|eAHngz4n)Ln~S_7ZRSxI324KHsC18y-W};L}KncBSgRjMl4=6-oYjf>TQy zLKY|#HrSZdVY(Q|@T6}V&O7!SAP<^(4jey1?+R&@SUf}>1__HH+UAr170suSM7k&~ z+2pg{DzbQ|K2t=q;_BI;U!%CR4jc<~Vm0%@!HI2`m$%3|^!H=_PTRoK`B$^Ftcsm1 zH=tAbURRTshyN*Xxq4g7aTaA#dC0bKv8l+UpkZ>zJsYH6A~~UTCLTHt*v;qHM-Ox6 zq4IBJO4z>f7{#zbV2`UC-J^}(D3=Hx(8V7R7Ol`UprQ1jm#++UcBaadynB_4=Cw7S z-OQkgO(!+EimV~v-x>13r))3eih16-307Z{)0uI1%>{FWjR*wrv3u-JBH8U%vpne5 z-KTTuXrBI3=)k<@5W9emW@ zA}qx!L$sj=YSbVX>n!_}*(J=y&X1c*_EiYK47k(iPA)^o-m4q8gtN1T$+IZp8VS#b zHdUkrgF{K;%^qlHZ9)$2=BgawiQBWCxn;?zImN#ZrIGXMXU<;2fQm1?8W5YG);k*t z7H%^Dq}j$RQ)wF7Bf{ZJ0aSVx(`yBpJyDNas_=I+p=}_&@L8}>g-iRoZbd>i-b@G0 zPH}fxGVc9mNcSr{`ylt^o#Q*uGSeUfpDJ}3q#V3EluqaXr+}xxHfxYvh>VJMKjUA_ z!G;i+Ni8r;$)Jvtb7JJ33Pw0B7tBr5n39HOqo-iDf9zL** z)t*4FcC5J;BJD(uF_YX3iHzGG%(i9cS^=1QDRqllG>&b zYZ_c>ndPO&VsszWNhU8tMh`6h3ReP!zxrqi^9M^^+c)9hBV=A^&2cQHnq|qhVmrLX zSV%JtFWSQyP*s7{!MGWh>{$6vi6j5dhbZLz3zRArVEcJiV)>D2AnY}iLv62MyMQ69 zwb3k^7%?^qR3S^yvAt}JiC$>yVl5wsHzx*UrqX>2aGamRQGEASa zku)R{Dy>b~etLUyn$@6mu-0_Vi2lRrgDyzpqd@vInJy_9D69$OmnbI||JVe=id+-) zVtb&RYs5(siTcjMV>~?0vgtaYlBq(lsy9!yx#_SFZWx*gzH3Ep6-==8>|9`zt*?bU!5^4&xc4LbV_TrD~1)Ctk1sh z79c<+ZYVs#)Zdlv-&aI<1qkIKw`NtuUvF=W0Z)8n93BAg=5|0nG24U1>F=RT++~$7 zj&pM{noLb%Px2rm$(y0m8TjRdb(BY=@H;Yy0%|I|Ss?6Oc0nmNx7 zo0W*^w|Eb}gWWGbtjt3uIHAOgLD9mc?A(L`U&gX(xuk~bk0Q0qg{$?GQpViBt5dX* zamxv#nk+A_EVaoIe6mW=aIZ&EhJ4q6tz1VPDbxF$Pfz=!%imDOz73c#>X&KIO96m% z66>3@`}>UPmW;Q=Xm&9}-fGdS*DM}b>JUf}%`z1N9!8|`sNxpvP2Ix`JS-q(6(VP7 zdr>H>)h)T~Qkc{S?CpvR`ScQp0%Fs92<6f#z( zBNvor}M4|(rC)r&?=P>b& z`8O zJB+CMAqJ-P2D(sR##u}cp704|@I8VjGbv@E6sshn)x86R6;h^6-ev5|k44z{Bl5vRA^8qRc+zg)#gn*}%PyI7$+gd#bBe^CZjjSX@TPm>?C5exs zVDECwlec>&TJ;NIB%8_BufwhZ=QE9CUifSWM>g5k=&vaW(>C5 zj>n8s0gO}t6Y|r%5jr={urIB%DTK#-+H>QQcbL`m>O~=lF%@vN$ktd{=<1lJScxD* zqajnQ@Wfk2!O&{m{N2iWSy^hRMFWvGO$v4=?NTww-xJJScx@xs zapT5CAdt_&kEsnOPKT?D*`HOq7Uv5faw`HCot8Lrk&o_Uas{n4%r!v}z38|n+vSA! z1<(W}!L?h9<#@?i=mYOQrqMcw$P0uAt>H$l?jd_~}0qivl_`el9=HCw>d!#4X zuOST2P!(g+J!Kp5c}yDA*~IxGD47SI2ExBhb!_nhiB81iRM#0J&tq*)6%wN_kq5L6 z3SDt5UTJtW>Mt>N8bp7S2Q*em2(~hhDvREO%``NG?mPq7mgZP2j8@5P9aJlYiA0mw z8W6rR3=r6wUv!)^P4sL-W|}L5M_sS2)OBvx9jQoamy}tdhbKDs zv&UB$UcDkKP^?PGs*;Q4$YVFe!n4*oT#`WLV>WwBEQ&paHuCrkScI>>pl&+%Z)(bWuCPne_G<&P*t~jpQz6Xn3?$os z@f-@~d*|igE8&Oqo7kax1zM|DnJJ>@(lAM^MGKYOm9nl0?FOGPW;Pa{h!#cL4T|V8 zT0^q#6-FeIo(TQOt)XNMYADp_6}_PZs(|n!uJsdpXk|8TPp0c= zAoy49+u+=HH@F$5X8LBM?sOsvACsu=m6YROyk4tw%t4@4W9^-@UY zsBFd>gRjbwwc&crB%{Y>HxoKiv8PsJd6s#L!V{JQnTx!o4K5oy#VjRBBZj0;_ye7{ zH_*_*!bUAOtD%>=;xB;Tz>w9ky#i~SBIh7dh@(x1D_CuQiF@%&WSWqur|=qmB}az4 zwA{oDBC?JdQUg<~n51K*L;YXmpk_1;WvdYBW)WYL?b5xgBN$8wmzNdQil)FzfCsaGaQ18{XVr){5>;-e9P8t6WO1KEK#KkdtpJ57W#A?DZ zRGPRygXAfLA@4u5+#}LBTYYK@-ydtzkp>oR|c*AkV-f_Z?Hhw|+2Y`YlLBNpL-~qwfttcWPS~rZlo%HniP6HR>wv^CB zccVjd*6GzFY244@>l`lgIt(&XtjVyUg*737@#Am?R@|I!?xQ{sNi~z#9(hLO{7di^ zTxv>LxaXJ(C1;v>Yi?m%^zbb#&Ib4`S}LI7DI_NL2Qy$4aN!703jPN zVIpOB!Lt}cwIY>!eh)A2v7kmiL=QOUwv0mV3Y68H;heRJE6LHCuXoq3U7A^SuwBu= zcNVQC<5aWtCnvl@a^Njg>xUG|zc)gAV(|GB&I3RchgZ<{#96R3Q7q|Zl4BGy{Nc^n z3_t9CC&;sD3js!kk!$37AJdhx#g#*zot%~FTe2%| zC<3;mIRW}`tU0De(|ss@yz&9e-~kL6ygA%B)0Ra#5(3l4CJVuw5^?1}HcVMg? zERHbG%pRF3=Z)DIK-O#iTL*!(P01@#1(i0SWMsVlJp9h0do2vR!}uMXC@ENOHgHAs zqL+JY&52k%bUX!|SbLwpm$1gsqFh-G1F@WTXLS0w4hEQlUa}ZG^t6?^-Dn&YB`o&ML?FwI4_}$CKxIqP z{7G_cIsu=^awO|&sQC__hxw>5nbCQ5>a}n#M%Nbiogc>i$=RO{icC2$xt#ld^Bp3V z7~3UAmkr-gtv{ehqOQKXtR`r`%pn_4S+^HaXS!t&h|dS?KgPTD=}DZkW}aeH+k;*;#h^7lG9rT?$;zuVHOovK%V}-lfxRR1yv+~A!0_as0QdQ zgu!WmTK=TiRRALY1uba~$41W@$&^4qLv)%6i^8T3O++BWo?kS>!D%i$8@L~NeMT() zGuhjsEf6=A?EqE*M%Kl0d5q4PvFjcSS>iOTez7KQ6*TEEBRaKF)$ks-zjs;NYs2Lc zT)cTmsmO<7lag-Ue7FM-P^Y>fJ*|4rbKL%|`hi=d;@A>f6LFKWAGdEs_UK4Ky?x?b z{BgSX&|{7lAk&M=hiYO3qA33_fQS;(m5?d}jrUS)H!e@=>?s;$5Zb7j=03|S>vT2M zOqmV4KdeT=tuiWr)NqyFgrDGhhZ92-Aq2_Fpf;7+7K2}3E-zp4J~VK;+j^Pc1Sa^- zqy`eZIW3FBGq&Qo&F9h#jrAcM+bqbqNKAO2Z4wu8Ok`W7KrU{MPhshW~QT z9KWeGDu=5=m-JUyG`cwG5@{V?yoC=~UKA%!rdH2rlt>&l<-xa z>u)BexXacvJZrxZQm*_E;Se13<4&L}zuw?UYlsh%@A(bnHzCKf-iq?4~vgP@Fne+PBXUvmlaTPQ}GgXrb%IVwPhjIbW5)?$G#8Dcw5U8QQ|c-rF9KljrFg z^=|z<8aD9+8Z(k0BFCW<`7y``Z9I;^IkSz2CpHS)vYZsYfdDx>Tq1+<(5v-ErVk(K zsE3Uqhk~RI_Auv^rPK{EA=mew87gm%HxDpS%}Q?%Q!-aGuXKN?zdaxnA#xUp!m3wz z?|1bOrwg$-2YM`!#ggJ_*OK@tVTy%bCyP+*_FTlc)gd>0-goG7^tqw7%wJ;^X#O0vG`NrDApEK_j;Bn21;e3?( zn(KG^tPl=-rDM#&L;7!E?_N4S!%itz$xT7n|DM@Rd5!2iy|;{tkXG8rwuT zJnp%Ui@auL4QIg1`W(?{t8{uaX#TIQ>FX@wXXaHf0GGSfQrm-o?v6a5eyTawxlrR3 zlN++8h_(gkr>{HmXgHe}U4;crmD5;PC6+D2!*N-)y(kVZ=c3LDA94dBU|z9hr3vj@ zSoFbg2G$uW95c|VToX*IDh-8nBjutt$@)e1-~bDW_!580My=rRC387;iMm2{D9bqz zT#`(o*bOD~2R3Xj179a>J>ccCwohn+OluIvN)oW&wx1bmg5ifQI+IeT+QMDGM>L9r{Je0(dKZ`9=%28|ZmKQ~Vx+_ZegL zVt5eP97?uXyj_-P$s>+3E$xwAIy+7jacs(|wSMZ#6QvxJdF_20#M}4KHO@EIuC6M7 z8r%8B5+B0cwL4aS{UXMdj+z%4t|#fGU$p(l>eqG&x#?Se-lH1X1EJ5YF;+yV?toczaxosb` z9ikVG8!_K$(}48+DLDyIss09TO~ihqha~KY;{JNwkgnGzMtscNm#J6^4CTWm-Y>w> z#Z(*tak-(Fvc5~z*Y!=O*3MPuXcBiiU|&TtTLm!!Y>&R`$tnoNXpLtwH{F9{*oKxR zrp=`U*DMG_eBiaBu57GRJTWWca$@LhXbSV^D^a{pl5c&QBd%z@+D5r>DPx!Myk5}U zUQS8nGLp#Ud{Cj%A571c#?Zq@jkDF5vgE57lf)!Qymzo+#Mm|2Z(q3nunWy*KyJ*{ z7(U$T;gqd?4>c>z&i&&)A()EBt4|qRzHbUUiKLX8pdnxT$%)}O{cyy^XMwiDrU^U{ zKJWYV6hcMTKx02gH!UZ8upAV~^9*$TYS!m1LKt&~Km5bYo-gMeal`u-pNCkrQDSW0 ziLW8ArSpJfjfPQ4a*Zn_DsPTM`RrE@nNXAfI&ZF zV73JH(B>XZ3W^1e+B5ZbzDxfyhc+tF6F?%_PH(iQEu&Z4eBQXuUR##gi*B;!htLxG zA^OXWQcrD(tc#Z>F?ZI>y~%4i@;OvS-};Aac2E@zLD!}~TyRJXdxO}mm#VMpl1go~ zW%B7+;uj@He3m_10RXwVim%aD2>EmWvhmFmE&Xj}ynKcTe9w*cJ5a)2`p_3LDEXxD zzL@?56wqC6UeIig%OduXv|Et@-9vc~Nq5&dPQ{ptNJ&x4&ZwOl#2YVa41VEKRjksI z7@i*%bDvZipnSQ*P^U{)u}_~OZP)hzTwo427C5isb3mi0unkM zjCJ)M5>-X(dXnT$ekaNOo1j54N!x~mYLHj^175DV*i(4X7f8*cQE84Jnfql(vzm*N%;5MFezF$ct|wa7PamM2?nT2_Jn4(phbR#^Q#j71y4^mt4v-j*3Rky8}$w<~^vzm>= zFp(_KNjWnmk1?h_zRS>@Ad_0p_#H^0BN(uw(}jy^fYg@pu=x96Z%8}a_E zaSqsTfeE-`i5a0;P)u`=#pHH>#S#Sg5UTc5j=^UA9L zoorJ_&3Ou%CgP6P{ne}s^K8;%VM4HzZ0Z1get#F1}e2wo;eh^6yO_7*gwJrQ6PTe9dcB3&fjrwc6zb;}bf~i6&tcOocm$Ye>tvJ7)kw10!vQ`oNvlh2* z3z$wd(C>A<0`Lvc$R*!`vey%O2ja0evacp6bI_zveb{va9_h3a!w|PnnjU@iG7e8C zEj$i3B@U1*K4dV@%EfhrjCZsn-iGCU_`0f>f2L*A=&j`^V0N02Lr+8$wVzjdh{&C@ ziv|tyz2#L{eI<9}(@D-~4o45gjDqdoBNC^HqO{8__W`YC`X7E1R*L{x67zqyR zApv)|LHK+#6|j!Yf85c?Zah;aa->;P2)<`m5xK&|`Pfr2gG&h&rsu>Vjeft{fx0S^xp{r}CwD#-qk6%+ao56kp_@v#4+V#)c> z!?OPG70dr$5BslvsV-q+VP@`3z{31rJgmq+4XaFVKyUa@!W!Ax*cki|4{JgH-#x6Y zg{{fIu%+Fz3Hl0Z=;2~dA4>|#NA@U zjl21=aQkI?lB4l>+iIz@?a7wc_{w)$qa`XuQ!7HPZ*2vE(%kG&U{YkX2O=>^(YXnz zgFBVu4;Ky7Gyn#d>JJY}42(lr9uGX%H@>wZw$=yv59t|yA}lg8GI)m&gN6gz_`~5F z8u|a_763alz9WYs_8-`zC$PIb6R|Sid;1Hvk)F8;K*_HiY<<0jJN0Ke8vvg%-NNEm zH0bocuIr-O{3fKlF0Iq}u zK;szxJC6rH)Nji~BpEcB^+*)s{I?3Q55gXhizD+_@>6eXj4vJV=g;-v@=*WE$3Gwo z#Y|4lE$iv2rl!WFWF}6|r3J3U#a-F^Mwykt4WwGV9&3Jk=g!hQcY7= z7fatp-}VrsiLs9HgTa}}-q980?3eV@9XMwER}cXL!O_+JElKz!k1EWs_?_HEa5FB& zLd(MwyY0tq6vjFmm-k0C>sPxap*p6py)fyJp9lz$>_oMX{|fi_X=>|)J|o({D!42> zktruBYw=&)QV0S<+6kzqp%EY*V;#VcOmS#LeQagpBdCmcD=!i<%P)Cke5F6<$8Wm6 zIHtNX=JZ!NBYhJi>x;6zz7e-OGN!$oSzhSv7l%*8{x>xPCh%O#U2nS8z(zpC)ZEyi#*Wi3yOh_-SH#+ zE=~vNRm~X^8(9lrlz#|c=BNClcSq@~nVpiKt)#v>CWX5X!yHJQ-s_Zy# zi(M0_x8A zE8Ws4e^ZYbIKQ;9-sQs{aE+7O16alyckibuB?eW1{_bDg@?+vB;Z867klKG|Z}&{t z?9FZnFrWPc-OyMcU=I5imI>%Az%NJ!z%!}0KQ8;kF9<)N`Ui}kNb47y$ycQ19s4WX z`jh<)as9?F9#g>XmwgN<-|Y?iYwYrkeGDw$?F0Kuz5212a8X>h_1_!1Zhix4@RND{ z;eH7o@^X@Xo$SAxSuuaMCw{r-e+Q&w;aXA!Se=Z>8+)_HFgQ5VJ1rRJ7`;*A_Gd5i zcAbBS0ndBmf_punp*A`^78>dr0L(M^FWyr!jtk?baCUz8EuZ2VpKEEq86AIz{A4)+ z5YE6@0<|(*Sr4EZBrKpPpAjk3X@W?O^SR6Wj#Sd3gVd$+tcM5DX10G|j;NpPUM2~s zn^MqDm+mDWTHkAAv4RbrTXquFIUS6u`g)D_h!2CpD2Nym3#Cet;t3ni)K-2n9^{$G z^$OEXxDL&>rhR36N(8}ceW;%h`3qxt7>tK_%Q5*#+~(8xCh za(3|Ndqpvwp=lJR&rZYiVa^mEMoguW_h$QaFw^+Tn>RP3;-g7>M?J{!DHm+$J>4#Z(ZAes zHR%NNQr*I&(-oYwELO>Ecp|>4U3>4L(cF4F z)Cp7rLJxbo&)NDM4Twe1zFOzbC6Kzwu_eTgF?pcU(piqpt)3X6p#8DehT8vi-7UQDn&1Zu zgJzymdFwM5qCmFuCbRyVV$1Hn1&h8X(vTry77AoCBGs`N*^?n`m)XFhb0oDU!`wY`iAXN`-o2I4hv5|t5O8$vhJwr4fD0;?hIF`ApW3^e&vbq}Z$P#Kv!S9+ zDVvaIJ=j=NB{4}g3=2>64Sme?*qaU6q%kxRV=XMj1&J?0u@x~(^NWpfnk=JvD+o%8 zU(n(*&*QqrxB#OSImcm*xksbbqjo&C_6jo3f}c-`{UV~A>{#Xo94b+j{8b& zTvr|bnmjWlEN~yV8fW)+M)~2s_nF@-<(_*sLWm@ms=XTnq!$y(|HB!I#(|W8zK-(1K z`hg--{(;O@WGyXPA;r6L(Go62;qa~VY$cf0&;%~b>O1>T4GW}e!=4J=zswINQ zZIvI`%o04>vk#P(;e=A@(bC#tx3)hVV(QHzJtDZSs|)u9sc5?s|Ki^nrBaxm=zY^g zNKL*aUNqn8dDED%+W_v9*rX0hjez@Y4JRctN#jr6`Hdw8M-w4Z3f()6M{K~D?(Z>! zCt~kExk5;D+K64FWvBe!JQH5t%UlneXdUDt&HE)3`Ydh`Foa)d<)|pJ8@MSmb%k4> z5VN_0qY@8-s}jM@-B%VLw?(U?6Uzfe#cwrk&m}V=y%z){`OuEAYi?#0em;IRC|!V% zS39D-i_N$UPo2=3jJizV%M)#5C6$kG*zn$}C3P39b9&@LoG#hB82T*Ruzx8}I3IUe0?beM8|56^vI zPT}mpq+`Z(w?c&q0s&q>sAQT|w7V^+B5~roM&rf6&uSHl&^_aly6a!=d;2(kyL}OPWK8X;OG z0@dLaU(@NKY1qT^%Z}JYe*GcXDoNPCE#p0B8B3!!g<9O+K@)w(3uLv~;`(&m6z?o| z3ur=r+jSEe$#;;ikYC53+iNOe#0))@$JI6DX6#Ib{GvDet#W6NuSFH9f&s-4ummWA z4nn0Wjo3GFW=#j5Nt#pgaI-P7AAt$5#Uz*NPlSWfjnw*MV?x*f1-alLtmxBAQU3b$ zP#=qZ>MNNCwG{+QU(}NJM(}2{_`d~Nl{kO`;R1m5KefiWaWy)cc5;o zpv$$-tJR2#qT+O(vL|ee)X~x*hk zSv=KX%o3#x2lXk8ftpr4_Nnd|{F|W&cY&nvV4F*Fs@f4QWbyKBvObsjD+GIc6hW7y z0i1-%o;OM)5RZ}Y8_tmzH5=Q=0H8+?+z;8va5Synq_rTDN!1nLz@KH6>T;UaAyu5n z!^F8J($%pQO^xn}E(dy079B#JU@$>8PLtf{s)llBPx0%ovJnY9mQ2aRhp<69q!pz?Flr z$X5xE@vqsz2Y}m~>=`C-|1&>PIlY!3ynt1L1+FZRncNz{%0EZYRqND%i;g z4N$nIb)TM#j+hpCUx;)`_AAEwYS9T&VY+|LCkq8H>K+#$rn51OQ*=NR7cjX%DF3r* zIOzW}w6^MhYcb6Zp1`{|5s4|Txe{6mskhfc%GdywV8fRBPU1#=0V*B;`dKy_42}Qj zc8~EAI+SM#RvKE(OZ#sR{GJ?s1G5JC-vBp2$iIdH*D2Hw;_fz!eLyXmoQS6Z2{miz z8*#%AlPzHbgPW`na*jhHp^B%dk7_s>2eq+JR27OGa$T`sNwU{v#`*aw<$mkm)4I&+ zpR+UttPT^^?W1^A$xE`n7R57=tp^P!v;NE)@xG*wnzqr(z82}A-PC?hsxR~+kdVcN z^f$KXz^uhFI}Srh|EeSEWQDzIF`>O0@tKBnVc{kME^)evjaGT*n5Q5-l4Un&&Rt350KBsqFhivj>;%5|G;*`v64HK&pJ|m;$ z7=(J7jD5P#Q>@AbAg4`c7MsBZ=xd&A z+K4N(QujPm20W7M64?1drZ25A3~E5`^c!ArTWm?IQYU?U#=|FbIiy~l=(M2)qQ@le z)I&_M#E`k@neRG#kH-ohiu8b=aLKJwIve-I@j5;6Jcn#$=GB7*sqJf*-Hxy9iszG5 z0qTr(E!p+GG2(Cpy@wyZ$J3blBi~ry>h-z$oAeO>1?qca0{=8G-Wz)8B3U>}Mzg95 zy=D%wwSE@(wx>v>^y#OsNZA=@4v@UjOY~PAHC83)l?g1cL#csfI>8Zh*-}l}h|dh9 z5O4>+CN_765iNLN{~NC zOdVhVHg{D(k^OXV_~9H4(H`ThK_yiYR)o-u4PL?IT5x1*UW4B(V+F+Q5-FFIrjJMm!nTZPJgu2&um_U_`g z#}{S^j(qF67T}SBbYjpRvG__+dLDC3dY8|zYEfesQwm1vAwk`Ip4>9oT?<3L%& zvbG{=&E-CY?9;|HUGE>`TZj)yzAj`+He}WXMUKO~*_ur+m7u7p%*|NT}I< z;iv@3MRM^hF-Q4~xuJ41SX@vq;_1(?mn^{h)T*#LuJF2(ugsT{yz08@0^z0;{R~l? zz8ukP-AQ>^c)%tsUdl1wt#mV`M;wn6pmhWl7=L(zj2mr1Hug|S@El+Xx{{ErQ5}D% zZ|rjYhMSAtsoBMR4885!9{A;n{yir|T=rTH*3qj#;#5443HgTpF=4G`uw&3FNi`3m z;8f;R3R;oLx9lgLzBHMQZ9|DZNtVy+$>5r!OvZ~Ok3aVW+T2RGfM)YN=l0G1JZCLc z9{N|v6DG1qG)cSNnM7b@tl?aMH0PZ+!Z@y+M5NZ|J-9^Sa~1J}pTxU)_l(>LY3vPe z8TNcSq|2r6`tuy?P%*|DwUQg9PvW}MB^NE@1sh)!R`d2_VJUZ0r+sx>wwUe(MDxs#^z8n%{r zdEmfdefsi?B^c^xaZ937i$X0%Mb3MLY{5OK^aowzIwb4Jv08ITaua>JKY8Az6Z^CS zT*k3l8BhCzDQ-oN9ItewFLe14Ud5z0+~cJtGux*lwzVV9yGbTpeqo53It3J54HXi7 zp+R7FDEa`g@Q!>1bEV%%P&umR`qV3?4Xmxymu>LCOqNek5G_kg*1j^Cjx`a1dMQfR zY#e|pFQ1>+r*780lbiIo=VcL|)X6D?tn0YP#-XZfJ%rp0qiol0sIP4S%f?!Rs9spVG)VD zRY(n*b9*$tm#qfGJHm3-E%s(Y*If2OO9Db%D5Y=5I+E$@HN%F{#ht|lf#eh5!w%FE z{MKLlG&4j*Y~-hWr(xudghFfYEk+&&Tf8sKO4QVfnK%!-rvk;-K~%9^*YN8p6?&RA zDuBD)$kK?B7EBQu*4Q%!n>D4kj0hi3X~qcHNta)eLL3*;QJM|xQ?t~L*Nz&Q8J)08 z4o&Y^D|311-u-5ciW4*H+!Of zvsj)SYJ*dj&&`3dh*9m_gA$=!LJ*piPct};h4SS-G$ z0&}syl+y}PlIoy^p(z%!AiwLg-o?cnMX<d7t=pFt?7Cjzeg0)BHh2M@0PM~eMHYEzO^`RINxbGUq zJ_;u`!H5Ecny;xMGqE?I zA(JK$OY~N&${KL@X&j3QNqKd#jCj#jj!H^bEQ!rQ36 zvl!Ug>piDWwW5du73Kwk{YL$;0^YSUH!xJn&ZPIFa*w=c334WQjval!G730y3HM(V zsF2f~#1iihA#L5}7MYIaB#QRPeFv(Hf~xYE0_|-n5Lny>&t$)|yZriE#klygfV%WL z+J7ivw`@jG6j7w!Zhb8g^8&BEWo+tGo1E?U!XKfI-pkg)iSw!qZ-r)ZS84HzTPGw> z74nQN#pgGe-UJOqdZ0(ypf0dmn|I*GkdFOCkYvrLx4$_?`R;~~T_ie>< zA|?6@=JdOs0PDdKPYdzB8>+)SVZn3H+i%j^m2nteof&!LX0L>*R}axP)F3o^qV6O6 zQ5`xebc^`LQ`CDR42;SYf`Avo{g7`vllp6(n#Cr)8;WTX9J)W)!%Hv;4^PQN-_*b- z)Lj8Oj-R#}D8cQ5EyACoRTXnc>Ad>bU)3lyg2YTUn+$PZdCj_{H86rM!!7j^Eb}mF z?jAm7N#EiJ3#E`JK}0ygNUNQHj@=xaURc!Zz0&1e$_BVJ|4nme6lRe&JDu|oQr3ToIdm(1S|}p zN(X97-gF)U73?X$L2rDu-UCiyfSFTj7|`P)D#LT26i)}mg>l7)I8?`Ys6K3t*sA7= zS!yBNvEgk;Z!dbPq&`HNAPLn}|@K$L23@cCW$j%z$U zDl3p;YTOnWKZ%?pOmtTjH0=7?{iM}A%X!+k*njQ#DJ&Bck%rSE;{Dw zw!Wg<;Bms&Q3?Vx3M~aV#V?C6a1a0<@-uIeOGlzc$t58q6t6)6MJlG1VN`vd-rH?^>$vq)n3|UK-Q-s8gH={-fd#CBCw)kA8Uq3mg=ahUF&3T<6s5#Wa`(@a?b}<&F3B2<7x+OYh;NMFQrpNOfIh2Nn zli0UZx4TAU^<#LtD?4vW+SKINh42znplZ4UhwATkMsql7rV8OGcPhUOSPD?7rJ zA}@Xk%?wQ<8e%MR9QwWGry7|jykAOTs0_b=|QF&oD9q96T^-? z(S*mJUGh2Lce?Ii-iD#y@XipPs1immB-uXem1a;d3C^MPFny*UeH%ZcVH;(J>ib@N z6^~{*EfHNXjb25r`6wXMSHIAA4sB;c*NdF}ZREXn6poGU`bWjr8;n=_m|~Wv z#Q5;#9@4DwOuqOGNVY1^Y>EhKMgb3lw!$GmngU^)u}?lAA|6xFVgq))%4A!x?zEU>4EGAqnsAWNz z#J6`%#hEb%SAPD!thcvZFTeTp$H8@Bij4D@l>OTg>2+R$P{sAB7oeh?Z zo?8G>1ZGHCgTo_weZ~Db+^W~ z>eBkWGT4yvQQ|EVHI8VVUY{mER1P_x<4ATKZ1(Az#RBk3Yzv(g$RxBVL>_0K==LTL zZA<<>nF``QDjA8mG&jQp?$+Q8#NM*fS?hZ=-l!F*fD@%xCaQ}eKS^>%)Kj+~0!mJm z&}v##kh?QmP^$Cp9{5AuiyKW#)1-z?|lfqXiXa~YMGaz>;xbi4|eb$!>T065R4ITVB z0Z>V)v#YKs+u{L-d|ueA8o z3k)u6I|a8RtY0ufXY*};Y;|VO!WKAxU4QF~xN1X^&^fAXxx}Z%%kl)efMr?Xy!5kd z#z?~T+yJs{J|F3;^4RQFfJl?Ybd;G#tvSq`rwFrenh`!LmAC` z4>qs%)Q;Z>f>B$_6Z2MDh~hA{NQYhn?y<_gP^vv*P~q#qbN5l7!hcC$3 zam_$DZsZmbw_K(+R0rAH-;cxcJA_U2P2`#xKB14-v@KkSSpiDV_;y*JQFOI(xfT}3 z9wsC|kK`aD+E@q$bJS7NxaHuoG#QC$+5Uk4HwANWz1wxfj9XUrpz{u=;JB1PY;;CM z${>h4P@IgJ8FAZO+5Gig`XK(b3Y3*4w`*`(`u;ZMR~O@_8;4()oPF4zGu6|-4W)ot z@#e_^(79tzO}?)rU{_3UIoQW4Wuq!1f%3c-lG9J1#5tz1#6wT`kr1TewF$3xELZz# z%ed<d* zUd`z{Mv5ZzTR!!RSSg6wWT3wg>FMGhjEx^C6<*67!P8jM!SmpLZ4QGjapIs8=1w(* zu$2OXRoR*uSnMF?YavlGV^2FdIN{m2t!WQt>VOQ%? zXcvY#A=}@72-f}uB#p@e^h?g#ex zeFMigbSS);6Yg1zu zvlQEO=@;^*x;W}r(6KFtS&KegEY70XrXjk|B(^6iTi9B}0TlY2Qdn$EI$2I5d^^fl zS^+od9L)_Rymvg{A@nq30uaDl#;qrc=>qbNTQqvYLuxeM9E&Q1W$Y`#n2J5REh)VN z@ki(qw54XQQhaK{!dkEsOc&nGTUeUBafL?eO(bF^62@7IT4Vu zDPzuzb|@LH_^&v8)Vah~PRqQA;xa;pgy!BAQGGw|^3{Fecsi%N70!lj3M)pBUPbm; z-X)ptLhs9Wr=DxO71Bb4aNRe_3@t{{Vy@C`J#g{uHHv-0+ zV(5LoHI4D>poiyIv@EpL$M;28_~Mz%T5G3oMT{aep3Ab-(x4^Vlc?o*4uwVO3+j{i zSpL2Y(C^(}aT9ZXm=f`fpc5%2Rc6+O3^sMT)^%G}&2B76`S$F=*Tzt$$e|M>av}UB1y;CMl)56CcsbRMFoA!`# z*pPigBQ0*yd)#B}t{0Jij%t(3F!l)Ug0CW>duv`5IM|b5!G5(xBz^N`gh#*+>;QCF z&;ea)kCY_|rEzo0xRt!K! z=pBU4sC;Fht1J@S)rHuCbjwg(iQz&3?O#x$kOKO$g=~6-X-;(Rn_$XoGxUJan|s=J>u%kEejun`zP4d_34~k37liZ@CX}EBdS+#~6+JdkmgFRz%%L zz4*b%^BpS3_+~>A5)1znMJ0PTB$9cKPaM8T1xg@fPLTL9R^iLxKm@r?hWSjif>^xk z%A)Q2R)8&oRCQD6NATo3o}W#`Imdv# zky7BR6`~$w!o)^^Fg!{g3uz-D2>wEP30?U)#d!l6W~zHtE5OeGd*%S$Djodx=MHqW zsb*H1o_>ekmjYs-T0A<$?7mT@zkJn1&d7lZ#h87gS6~F;VGzWQq?VyLQyX)gDY+`; z@YEU?dQ&{xhSN2wZb!`m@*vlQMQUd9ezpMaGzT@^I)oyNEd}j(&0Gg@D)eMy<{sZwA8ys`R_pq5T6HAlnmN1kUi0+36?5 z&;~Y7fp->=O4({G4f)Fj1N*N59;mhVbCt$$q#aIFPVZ4%G!SUfmS>V)5h(iX?KRdt zh>O27+TMiy3an-yDTqrNT}Z(l7uk6p4N2c#hn{A`6*mQJR}`IF>sBe;_`g`+ROk!f zfaNF;D^!Vo#+Z(-zNj~U_Ce31ub(|It|zniKLRF5H$mxPN-7FIp0rVrqwd3Pf{VHo z9dYq{aUxDZABhLZWLF^6$8f!h%X&M!O4buw-&HUaSP&SxQ7Wly_XxqY2jnj7(scRs zQhIxtE|ScrJIIJedcHM2REDs^s+S(P)8XGE(D+dnK9dr@szj@?Hpl1PWk%upkN3)g zu}j}%o)soQP43cR3t??EA>n^Iv&burB97Ji84jFa=aZA%UrwDeAb{MW<}&7lxeP8uA2lYpw7G|?2!*cksExKAx*j8E^w=9bKOH>{`Dy#;peMd%aO&7x zG-nmG)hZYUg}901+XtFL&f&>xl-Cof@3L2;!@8qto)*5pW4x!|S3t%lhhXE1b6$jcANUpE$2UORlS zO~*kjm!25p;{5H+g6h6p>8Fq_9)iPM@4^l$rJ3WhoxdBfDTEb)a6>mcFz2y2DNnwX z^e!d0K|85zPG3!S0@?a)s)9#~Ctu!vhmHEao{!8qI;dfMV<#c%AXyL`y#PL0S2-Q5 zq!bma_O*0A>v=hHnQgdp^_pPCZBXKT73jiitV}j}jmrw$2>vN2g+5F0Qjjm{kvwMPU1~pN!X4kNn#^f}!pZ@(0McQ}e@r@{t)|D7H1PS47 znK*5oVGps#)h8PM`!08r#V*6Q>(`9Vh{bZ_FOOvRbH>+B2lX~Q6ZkSiko7{p90Y() zB#4Zi)e*|fiy|i}2(Bn=+mTeC5zmU{PG5u9E=dSEjC@`PA?r*U5<#%U#CYc?ltB<1 z{eJ&wh#5xiX?Z0{U6iVjF-~Bpbmc(HuMDv^r(8?K>s7E>#?4(qIl1W_KJU`e@hlRS zZ4p$bt@E+MRry9szFU+%a+Z3A_3H27~k1fTmpNn1jUshJTy9h&sHQ+waNYhX& z&kaNDt@Pu4{&l=kkk|sVOgn}0Kb~AxHTt<^C2?B)?$|M+SMjXZw4aKMLS|Ew$~%3_ z=aRA;IgU)@m@Yp9G2xF{;ZYIF$xF5MHb0@vBr!0=ZyG-y*Jvcc33y_gc&2DQINr3E zf&mW>2i!wKR}<{)n-O3sIakcEkd zSK0cyt2bl2y3eA;&o5Q!;W}b-YY&UjVarpS&}Ah{+k*{36mg?e4(o`SFa(=eS#t!g z?;VxY9bsk*goL5)SD+Y${!?G%NRZuzkmUh3)W@+AOB3 zJ`hM-j)w75y}V@NpzmqDdKx=_s}K<;kpzT`o>;GR}LoDUU?CG6~xU1QT+_` z!Kp_hRTCni`;*!Ubic7Dr$Q{*?4r@cOALUXbqH-p{5=n z)g}TbB623SyXV9%e}ESvzgB@uLq|FNPOF`gIsD~V4fh)Yx%auJP_LbM7yHR@DMiP^1#<9tI z|3*tGp!YT_IJRV8=OMD_Wy5ccMaglOa99SuuKSA6fdlMu5c+o1qwe7qVN+5-N6ejU8sSUp~fbI)YFuN=|_Zxg&gu) zJ^5EuZS9&kN=W4zm)~ldBNt)c%BsQBtdlLaA>`ZAArq&@;&oQLPl!EFuAM{OHANH> z6j4%{({z^wp*t`d+9whdy!JFsFUimn8J{rYoYf==COV^l8G{?H&jMt7Td%3+KE(Hx z+*i-+DHzl~IbPCiHNORL%hUC{UoU5z(_5Fb8r~Zw?Bu&T6HuX(5i*L*;?q)MK`p`9 z7I5B8uZ5U`v}xJi&#_j6DBSU55x;u6iR2hbDP*aYM7cNW7)zH^s>snXzM2U=lYMz& zV9bazd$?b{&epp>S>6egS=`nZ;R|{iu!oyui&mzKFwAJ>wxJC^HmD;pRoT>S3qdcZ zFG>0R*#mw-(Q=Tks$0>c9dBNQ>JEeM&~XhHwW?xyDb$}5N#4)D+iD0F@nWXqTVN|M zPmcyAsbW9y0go__p)jc`SJN~|8$_OXu6q#d$gDu>BntU#5Cp7;VGy11AYEC6P4wpH zObPic{Szn#I2b6bY9FBZp6eZkLOI9@O^j{T?_A{5LX@a{S{F@BoDrr-c4cPzNwu}areESnda z;bYoO@ZA7Svuuo?a0992zTjFmAl9&66P*_GkaNKk(V0HWsQc4DFXji z5wl7{(8C5JT!~uyW)8!YA|N|Pbnd7G5PL>d%=%zd(hDPT8Tz0RLWR) zV3F9tEi!Cy!nF(wlnFH?+IMCeHiKR;n|Nv%Nw(Bk6tc!`>p8w%AzYzskRM3_=lQk< zvK#2aV~c0SJ}WoXQ^qH{14p-S)IDmvz0Af~?w7s;CL!q~5uk&kkg40KhVihx9q)+m z=sZ(E&Hn3vKr)2nelNcQzH}e=*a{XHuYy0mhH~GN;iA(gRcwxK9YR8G=yZ>^@Qn?zdq20YQ465b}w>aWVN9u+TNa zJe@45hg`ihy2jGatyHq(y&eZOUV@?I_b4sOt%>ktVzVN3%tRrT%qcD_(H&OiFZA@Q zN3(&Yhn-cfok$NFjFtA3KjVM&ASioXePJQeBrbgU2FV<|eX8_*9znk0p<LCTnArYpzsxyTPo;5alY26!bQ2kK(dTOeXCU|L$@C{|;~ad#A4+QO zML!!CsRh4?DdFP=DGcC#$LdX-ZZ_rHI_;a_9Vfg*DN}wC`sNHad9iRdT(3I}UBQ5b z_l*}4@`qdvFAHUqBZH{#`MBXTpA)sNtlEKLsz^+QAfV+ZCvsto0;Vq6mW!owIxjbW zLa^fCz+@&|2k7i#75g>Wr1_N0BS(QNEuP0ujM?;xsDKN;zCg(bX zmqQWVq(-kGV%Z$5ZB^s<)O8X-{Z4+gqxPzGSq!d5q$URT@MkE744XQjj+=lmpMc30 zX83Me^`}P{i<_*~2U@^$rz*~oE34Bj34_l=cTkT>M}PLnjd=V(i{Pjnya@~agZ`pl zNq38`N#71iwnMeuf<<%d4*;d)QXIC~67kzO2o!bHK`i2r!bE}x3lCq6T5qgMHYL%c zHCfxJemWk7Oe?%PJYs$VktY8>qVbUOkbPzc<6wVdm(7?`&vZ3QVOfyQ+RSWcG`8@V zmwC4XrNm>F6e1X1L+1q)+j>vNV;2@W{Vu6IC*J)R2%H^N>Dg$d(EhjQ-~M+qCqG>e z0BIXoPlg4wq}6M^JU&HORF}KUrk1tNziUiw8PKPAql^XCaMF)A=-bO6P6v? zIZe9{qeo;|kv~63qeb9vXmcVLbg-ci$lgJP8EY2gw4#pkEEKonCOfMNKnh9bY5rjubeUyn$cxlMTQv45= z@i#iv>`Ww7tgIM~^|vneZHB8;S5Pczt`+8)*m@aBFo1=Q-yF+up< z+hcPv(BG<>a==~fptr`rJ|>uf!roMcq424Kzs{oJv;Ifb1(YtQch{eXryZ#zz z%+wYfuKOKL?uoQypUTG0AElG#p31uGJ^Ntcdm6A0^)oZnhYYSS(hkh?lkpw%hL&YD z!S1{!_a&+L=X!Omc1vZM;{mEp>tAFwQ*UZL$!R0bIM=s!jQB9nQrs`Hq&wG^Eh3q= z0`(1NT1IL_*ay(QII%$aE&tLrnaI$IhB9705E!@GW9gr>;BhBN3zg3Gs#K*nBDW zp-X6xS}@uQ`_lK+l1o(Tzz87g=Rrsjx)8Yayw|4Fe7epTrSzMJXOsz?K`-+eOQ+=c=G zXr^Db5nzxoGX?Fev*njJf$Lx&m5l>Fzlh-31j5W?Gvz3$bBiv7ur6re@eOdLJCsM3@y5QF{$umtn5mcI zmhoMeRmYqVHkzo(<3z<5K>0?(;gV&#-Zoen6+#%h$3(}!FOdL(41<6=>U12X7`A1$ z6%~?Ls7OY)rLtH!+tO_n%fWxI!j3y(f}2BFC@e^a0H$|V<|06PkdYtx_LJ0E!CghPpe6}9JCzEm^MThfAyj&&QiB$* z>k}cJrp0Y-;YP2}g{J-6u2hdwzc~ck?ci)& z?z+mNCf zlsKn6LD??^7&KAu%I4B~hv@!FKnig|^0X*quBH`s%zV7dJvTy=dei|m_qUWB&FYKr zm^=+Kh-R@8(nIlI#*h!28_rLpnUhh1P{s)32(`zB=wP{a97%?lqCeUR&4t#e!b{?LH&K3@dnWFgwmGHTNEZ_?{x&rBmqYLJXY*ze60*7{4}q0181<~>xhKZFV*_BD*=c?%0VeoXJUWvLD^$O zpkD4wL*lL^WpQ&X*Et9-y2yOS-^l}gMEO-Y{ctc?&aiF!4z83SJNSzFjxvn*O?L#D zNy5%xivJ_KFhZA|QxBqRs^c%_SHbONF7M zBA3gl8@vC2ywD4M>|#$BS^WopCt6SGH&w`+0nRTP^ltsV$ty;LZ2OT^Cf?W5lp-B3Jh7fH6UggW#yDp!Od- zabxM3g&U_T33NvOja1I*%fq;e_YY~$*1*oG&^OriU-b$o4idb6#vQw13+Vr2^u<0y zUxpdtR^js*9m;*)(M$vKJjXr)wFX_@22EtJd{9BXxqGXC7&|_5Dtq#<6%Q{CHT2K` z+(pe~1?0iASEe_Jw2be#P?UvBG~pWM?y9wSr2{kU7~M3M5JP}BgVM@Z0+_Vv45>E< zVhXa=pU7`LU~17_n4({;SEYkKPR9#jL{E%?yP>2eXWZ>Ar&Mh!U{YPdG6|tl55~Ux zt_TV0f%#^E$R3b2A_ROa)Mm@>C*cRM%rgFjEs15@V5=W+@_9=lK{hL?uyqfdBo2dto`+J7B~}i)#39ysx7#@INa9HM2~0hBYK0CMs*#$jE8v`-2hb zRbw5tNDSi4t>E!8lsfKJ|L$TR3TmqDg&!Qm1c8(PQ)%te)#l|n5M87R6nz?elRcJA zFh%!p1sF_8*^??x=e&qX^82yLie8_ji{&Bsk5o<*&vRWkayHk~5B-Q99hyDe<$BXW zYi%I9fqJx_%-D??rfd=>qE$zz&iYGRAG9r-=RR+%Cttmm($B;J61Wsc%*?H(hg%`> zUvP5Nz4Lqvl*}LI^!Cm(D$v&pb;{kFmh$-fOwzs~`)*GKJ^Lm>h!|r5S6}AB(|wPS zwF&G%0#Fbbf=mt!{aE>Wm4Eq-TiQN82Z5=k^dt2UR^1(@vPSmJJVS}&0OBUo0DzH* z%7P!OQM5!AM>wTRRFg#skj;a5w4t)qj95e^C;b~E1OcT`m<#i#y2=41`s0bAu(HBx z%qDhj6`N?H=(fhrIyucE&YUkjTLJ^=`WNz@zz&eWHt{ZnM3q_eU?wNZiLPgE@U1gf zV4fbnkVAC78f7MUkW9S}@7#nY(bo9&(ia^TuSL-Ups=S3coR(t^tQb9M$*qN3JO;q zd_`SWAR|Fk!#SN<4mF@;pI3YphBOso}sFQ5~uC&i!A8)i*bE9suYAcXmxZq%`hxk^OuOKau!xyLPfP84^lxfKdMHWhl zPgNRjvbWaAL;N`@t(O3^AX-B(7MB|GNb4nXEzb2mXch|K)GA_*oa~+pS$K}Qx%?C} zh4L=mQx1w~hrJZl*YI?qAei-T+)`!ZJT!fqQ%=Ok*E*q2n3VUHcuh#~hvzK4yZtU`*F0G*QiD_znB74E1N1399erESKxhN zwf2NoL%!iuwdn3nD_}#l(SFA3b>X8qGnw*C;mV_RwUT+4lQ|Aaoyh@gG!qC1if1A5 zqUdbVnNLArSSoB#m+Vl*|4U9VWXVWKSS}M(4uGlcL7M8ZBqnL&H=OTI5qV}0n%~?6 zYoC0KFfu%O^?gpjhI-;h9FsvUlLI~beJd{+<$}aGJ<6_IZ0jp3JStFyyAFrn(76i5 zWTOIHpLBWlP3aCwJ+PmBNr=Akwr>cWP04cfM0CqFbAWWbx&Gt_e89w??v2PgUcLEw zepM}#aZQE0Qs9L8G=PGz2+#o({+n~dA0@7^r1%?WViiMDmnSHMDQiD_l7>q_#Y_3+ za|Sz&;PldKFxRf5`HP9?``}lT(wkKf z6=IhWzI!{yFMkX#m207>up7T@x!mn8PK4rn^?|SkNtNgglyw*bw*~g_+^Db`Bs)1{5O5SCFvnTp|sqW(PVf9 zDU*s%r@9NQs8zGh>N$^>u8qhPW47ydB@El-VgAI#LSZFq$I(R1L6hs&T995)+i5Db zb2jct2M-9o6t{GGj4wggs7K+25qd!8ZS8e-$0?Q$9vb{{w$|g{8S1gF2u>WXPW4>h zEUdEbrP{sAdH;QzXfYwEq`fIjx1tyYShtAr=^7fu{_!AVxXVolhQ}3HrMh3N|NQ$uuCyUO{ zOJ$w9yGp_iw_bkq8c#LWPVBQON$$md!_)P)kjKOr7gv@alKwt#)PX?V;AQO;Jf8*3 zczCxV-9PleBZ0k^hIq?3_e~Ofv_Bv7eS=S|IXgONrcnyky@%<&4}O!Taar}}S7m1v zr&Y=7RBulPfWI&`hS@DxnWA_BUx|<|7h2Q(J?+%UUgaTkdD}rw^F5vM!_%0c`FGNu z&9ZChon{S!X;n61N#Y7-c`B_9S%OZ{pp)5bfKLMp1l|j*>Z`cK=m%XwKS2GduRivMzR zNmXin19dy4I(-be_?iCmqUxlmBUMgEDL?6=Q0F72PlGuboBYwl|2*V{9Z634eKl}b zu{t<@WHvporL5gX-JdbKVTZ?K8k*^UM-p+x`cUs6?6czt4~*SYj3`mGCg8Sh+qP}n zw(aiIwr$(CZQHha+L|+WkUPnp%)C{lcIu(BQdz0J>i7X9W2M4SH#+Ki4xG5A3gO z6ykai0-VCrmlT2hj7g}#C zxj(adME>NGoU&fIf7BpM3d{MT@#G_s{V?`WRdsqlcL-@~lsTC!u=*B}CfFWF!#83YM$GY9&52 zJ7cNPbOjk@0`|Yh(;}}UL z{Eb|iPsxIKv5sKeVDx{nLO!>9h^GWu0xwLwquyu#w+{%uIsfSnv9Fs%mzlm#45l`A;-zgt?^RTl+9_hd>oKSscgIRjQ@bvHw@K1Id)fK)qGsQ|ee~ zWkuDS!~IV}v{X1w>YAS-p|S5Er7c0x27ni3ab;^xio`r-*r=Zy9S({8>!TQAQ5Iek zKDcr$_I>FK5wEVj#DS>i&mdl@t%(nGsf9M>vZ1dx2>c3D5W4 zKNP$5jA6FxBWZEvy3k*HC!kScTMiVw!xaOj7S}mC2dEOF>VrCC2E*eLVyvh3b_enW z##hp;`Qr)%tc^bI1+)ijo<|!4zHk7#aWb{6tCH%^DNH{qvB36}bkZLi-^#NE9uaD6 zlJI8aK;2keml>puy#)o)A<>}B`@%x-5qn|ISHI1fHmZx7267{Hj@XXE1Bp)-< zF*9_62NUnPd*Wh{UWz5}@;QmmhrHGFCPJnnzsP*27`&*^CnG3Sr-i+*hJ<4gRipbM zQ2HXA8z!}v@tJjDT-sy=w}w&KJl*OD8|6PDFdrTTn0|8zG(F>gI)#~F0RLqvh~MJc zcBmL?>SSXnv8+&c1&$WW#p;KGfWtn49cOiK3HDPDkEfD~vhkM2o zGHJ}Ql2M6)c#Cu0Rpn4Y9UcX`F*P*I7jq}zQ19IVe)c@J>Fk*;oiwCUyaseT#Z@ar zH}{NhY5b~;lb+=}lV5MqMWZQJ5Bvs0_@wlD(GOONSVe3vI*~=$UD{F%k4}yR;X-T^ zVB1G;F(}S>zE#Na`tK*;-4lqmyxhyX$}o7(g4z!9%@8^9RIC17AvU9MP6b=P)0$CT zbsEeraL5Hs2+N`Cdg{w@$q0t0#*T@skHGC)@Ae}zthVEvQiR)+ne1k!+ZG+?Qsq&t zWC3FKw#fqb0_FyMYWHXaHxYNjDHXg^0)F}(7+Li_=pWE3F4V4fa;3~>G|7ADs!-|| z0Wi1NjJyqf!zLNoL~9;@yir{r1{dhMj~m|-fVqBTq)&b4^P_I|W+8yaF1PuKavQ5< zA>S;L*!o~rzy>D5EzPQ#I(7@SJq@NCTji&qUoL|cC*0>7-MKBZDZ;Ngkd0C zW{$w!jUa=|Uzio-!yYxqx+QEB!GX!0uU6O&Qn4!4rP;2cOalDDw(hW5y>hawdD6&c zxDBmbis3TQuQQM(6H%ZRa4-E7Y?S9A(UX0+v~N)R^Dl0J@!FRcKrj#@h!qGQ^se)X zmW@(?d%=JH0w~hkuz`_=W8nzU`fu}PzxTwXUasS0ofi6vW=w2Uo70{1vEUu5daEV* zK#pls7d11O$1L>1XXf$M1}$0K&iE_pz>U8(3-R&NMWGTm5yl>*e}@18)>2Am?S}Y_ zzR!B#p@DP4anBwaL4_uo<&#$)zB)`CKX=kr_XjJYS!F~n`=CURd2jdW0fo$xQH!2a zpCvluDa9!hZXpaWB=!01Fw&Yx6l1gyLM-_)qwc8SDkz@#)fv*=sOg5!;E|RWRA0+B zhYY0>WYfiXQ$VO5HJ`dvZjwKzC#hM6Y0|`mjZg*Xjqsd0MGy+l3a_i7En>8Cdys(m z9?M#s%n(C9a~`Xl6RC~CO;vz|bd`I_kH%~luB~q)Mf-RA~jjZiSd`zTe=YUkWy}mhw~XwP z$83tG7?b}*GV5!#K{9=gX%`QlM1&$-5LM;b`TCsw>T4mT(1;!K9%aS`cj8+RAxoR zfk`N&5rd#)*S_kJ3$1RY6A$s<$7K`kol3rM)sFMZLiD)?TL)9e76IU=m~6&gOQ$?? ztBX1L^3SjlVX5%Yl^_fpDa!<9;l`T`Q7B&bZyimQzJ{2XtQ;cpu^oRXSiC&9XdCc^ z*N+CLT~!6coA)i2AP{h#e{u)dAR3{jtt7Jjb$>o5S+J)nm9BiCSL*@P+I>%e-!vFG zlrNFj3NP*F@vD+2!2PjWWzRS} z@U(Z8sAH(k*Q#sNNtp>G8P0h=wRh6wPW%{bT-H!AW*i=rc!X@82sk}K7| z;PWDw%9wPI{Y6V~e^~p!9<4@#(=`^3v?elS&P;eaZR2Og73%u8>fXf8Y!|bW$;BRt zdw9;u;YjqBJ+wvN+rr5`7oLD2Sb-0qe-5qX>%vl4*T3e@0;8X;q_i}tBBaj<+-`|q zqgJlYc@+x%E5;OYsiPp$wggmv#ZqMH)&YWs^mn&MVVmOz*erlPS>c?lzZoe zFTxPkw~j*wt-MCsu-}5&9Lx<8YP~#vv!! zWL&FlH+1#Qa%T%E^oAA9I*2ZsHJVWXDXCs=)4`z^^{UEx@l~~PRt=KN`?YO5=%(!d zH4RVa%8~giI?bTN+rOldEIdx-K8jfxa)VmZU9`Q50#`QUHe*PhzoCN~&O1}+{xgL| z25r*XlrLO;i9?*0tV>}xfJ}@aO9MT%23kdK>M+1SNmSY@v(pNvT|xa3J7{nO&t7wM z6#5%kHWU6Nm`Jd9emz-x;2OD4MZ81M!mP#0vRx!gfgVbOf6wJj%B{L7? zSDL3JX-AksLj!x(9?1M8?_NBc>qv}c4ap3on;>WeAQySb~Eqpgyg0)ahYNg4t+!2y8+!Z^2dSrX@!rz(P73M#!Vo=j*9 zF7X_Y;^V62+{O;)7KCm1-;FUEGsOPhq7~TJC#SoMrx4fEQ5mRZvxmCQiz; z_&JUr1iy&4hH3`cTO);6o2c#WhffVc&Zwj+3|kb60!--Zz>&4~H^ll6oAUWT3fr5r z(4KVHb8 zgk^pMNP;QA=>Pkh0cnL%rbybwGNUasreTC%nCcr!NfEr5SGm*TqE zv{uf_A!6owJ>T*xvVv?9KMILe&a3~G!TFci_!(ZW9+F=|szcw7au5JK{Pn)J6UeE_DJv-dqY3`|LU$)i7gHxj23iqACu=BrF&jg3X9AXg2ljR@LPGW)1lqJL ztSkhy%nTd^?940#j10`2x={3j&c>#8E(B~03{dpKh7SLe8TgM=5!3&1jh2a#9g1Gk z#n8smSkTVg#+2aST4fhgTQvd>=Km{AAV@FwKVbqBdQ*BcdP{nn|6mF1=^f}D|3f5j z`DYP$(0l$D9>IUt2mViwfbBm$mjC4uFme7L9svgj$N%OD{|LqZUnkwjQ zt+Gak?$ZfkySu~Q-rmLtAKj904D9eqIJmD700x4lA?O5Nt#O|1CS_~iJv~uFWiq-} zbDn8g-&K~9sHz#GFoI_QkqW}qMpw(wcmsHXy3&j1hc&fO&u65BD56?in3*5K09%-9Ix z(Y3AuAcH&m(R16Z0B;4%(XaF^f5Wg*(=qqiS?jApn8$zq;RIOJ>gwWrW@hm4@MO~L z=;~zgO{7UhJNjSCHPyNRcm(F!0B=i}7T{l140dp*0_OfzsP}gOeO|!vZEV0??Erq9 zl7T;Jn?cf$Za`DIzl30P!B=(Z{|rB19shp6k_INn_bGKfO-(!ld!w6uC>I7t24L*Y z%=XR>fau@E0Kb6KWj|yPpyBQ89KREVx4OyqJeJ=QIw+tznZ4Pux#1%}ZZJGJ^gDj5 zr#sWE034laT^-$@SO^dejV(aG2KVZjO|dqe6a-L{vi=L z(DQSfKoCCy_l}H?;6OS#JN~|WepEj(2pS!Lr>kbQ`<&o+sKI@OQyd!p0Ns9312R8V zA9En{UoDE316|8F#|CGh4B%P>4Ag--15W}^zjJJ#c{+)9Zf=oeF9Mmr?uNf>o5Q=C zvsb@{zx-}m{rcUOD1x&uWNyDjO>POzFCdxJ+FhBN->M6JBTThq`?>^&2A1F;uV?fL zqjfQ+;JF6(lqTO-D8LMjPL98Ea6H*&t#AV9=m6+<`cwq%M888=+oAf|fYX_oR+o{L ze}BgizD;Qk48WM$-0DH<9i0GWvU6m+5j6Uf21X|!?+roc+BxT+>J|Y1y}0~!2Iv69 z+12^|LB}x<)c8Ki#1tOHCh z_91fnYo4+LnaBUe^kbs<65|0h9omD;mi>i41UysziRph=@g;WPTiJuimcL;?1YoH8 z72992`Vups%j`o;k6N_{IW7Fg4(K@l3i238CF?`v2#ScxXlco4Y0Aj@=66zKtNo?W zskxaB_#Nk5_l+3HX?AP)#s$fq{mTxNl^*CG7L^kbwSo`G=^K&ri{PJTb!lS+#d{r5|^egFqn-eeP?yKTDk z|9rIJ>2&d%1)$p8bF-0iqyoRuya~hWv7WQz)-#{$Tiqk!_*D%I;K=r;o%U^x4}9QX z{KFUkYwL+UkOca+1_9~figLE_Z8Qgv%Jyu5*G4B`L3)X0f6sxaH9o`vH3v@KaRZ*v zfjWN``Q_?6qFT=GiuYN6=Xja|E56AlAy4nDPGG)@8unc~z5IV10LC0Xfdl{S|A2$2 z&m6_+0=&F@0S6BK`34+7eg2V!!>NVd8Jox>dVXi>8u=R8~1ytGspOcML@C$Yh;3FJoGh5+CtGjrBP(lg_Rtea#ao^ zE~dtWX-=l!67(a_Z4m+Y(n485P8U-FO-MgszLA4-CR-@?4z>Q#vzGl}akZ=^>b5Dnr0tEFoCjoMp4!)bMSXgvj(< zF3T37tw^xaEKy7ue^ZOW5LKt?M=+Hug8 zgd`;hj&L;LyRJy?{}x~W!OII}$z@|#!-nfA(^nfKIIAJ4O-=AZPLr5-L9BT)JyC@L zS)TLdZ%87`D3_=WW~a#E?W>3I&bW8>`h*~SESEE1qwdXJdzhA_L;)@L=@f&a@b|Nt zg^pkKuY6aHvRh;QRc@!wF@8*waNEBbEIyR!yvq2EtQ&A9A}1H}FMe}ZR_Kn4BC+Tr4mRGKiu@5CNuh8QuD z)FG3>S}wMxIN_o*%b0l`%mj5 z@slgECgu{XgjHs$<^Z@MOuQ3hcP86ORnC6lvk(vBkm*UhEb)5KU3SGcy<<*~Hxte! zXTE67LBHrvCcYP)2X9`$ANTCfIV~7U?59y)u=5oAT;qS3RKM}r(J!$sbDIso+I@RW(g-| z;T`jvUdheDU+q)L;;z=>o&pJ{b}6U~7s)MMAIqzr8#8UebA1XP38FJ}y!hTV;&|d{ z$Rk!6NP=h?nRr90d^E|gq}K}P>mpSHe6+n5ms|n0jJZV85_|sydWPFB?NYJou5gX8 zGK%GY(ho@;jazxd4fba274?Vwq`ZCe!mjkO9c3G|NCk)Gu#++xKh0#hd-mTXdm2wr zy?h>2L5Mj%Dk$b_y4c(0Btx>b@8wb|`m{seOHUJ-c{0h)E12Rj%_zSXc?9Il=hLy9 zr=t6n{uHi{$7C+~VCwA?!_hVOh|bN_Kd8LQ%94X$$F4I6yY0n@zJ#c@w-#Q2SEJB} z8guoE&AUjP92W1@_Mw_r_{KaH*v;!8KpUWc^JNL!Z(F5s6Yy+15Q|;FQa%%6N;Xu( zd9T(K>6?L`L_Z@GJ+_ZlJnF-lGo4Ibmb4S}+pbo$qFKZgR6BF~t2!m@k((;93tDYK z9wOro&QbUDJn`>+@D1g?sIhxT&qH_C&vo$rR2>QDV1AaMepl!QjEu~?v;c{l>b1CU zT~x(E1z0V#XNQc#R*yYbH!scGk=7^{9r8^BK`n6`L%c9GHiG8IW^(>tRUqa838vU4 zZ;I-{f@(0iqF2sHM6$`S;ZRSIT9bF~IV0o*^AB6*lF!qL5FNO|?ta?803(Z^(?e-E zuC`-ds8L99flZ$9ao~!%LM4fI#7`rLDV5lBF4t` zEx}l38!w!_`)VQFeX~g3f{^`Ofr0drCD@CxKBNl5JZatr@Omv3^!> zGjZ!s3Gldfs(s)!JrvjW>gL_tSY-;Br$7rG8d8eQ7?VshA$y+lYRS~(1au*pt5)Qt zxH{H9>S55W1#+V(OxY7?O68olW#O99mWz4vT_QKe_;md8{QK3XI(Zq)sz0kw%>)+e zj_KRCnXDPPG{vokb;}TA;mKtGh(5Z}tXV3jymqr;kTZ2|Bv^yMK-#o=>w$2dSNOyW z%K*u%O7*p$X4+53cEEMhUZj*C0iA~wx%PIBT(LRYqGnuH%{!jm={?oDY5KXJJS63K zh`D2flI{RxLn=rbx>mu4=g&m8Vi#d6ebymTceo4pCwt`$ZY>sey4RaBBs*8Ax$N5v zzO@ERy-mOXgLct^Wd%P83-DfBXVg+5XsUR~&azF38lMytd6<*tqaZTXYINL)9qcZ2 z>W*J)bBxsX_d_^Ky!IyVO2~)`VAJC48ghD4t7MnMp`!DTgXU;dTZ@!CYH+$>3i&oc99%x&)BbW4DM=1s3R0rtWfRuSd~@*0gI~aB1obna=IG; zQrohPgnkf+A#q!w{blsHO9hz%#r!8rKxr=}0ti zC+6-IpA~ebtYVru`dd1n_rhL&GC|lfw93$i^);b{j?+D!qvhRNC;9DZ60#V7wTLCj2K-d6mOE*k%a1cHHNh zX14J_D`?^&-UShq|75nT z13}Csau#PDjNrBgm$s?Hd-2)P37Q>DS*)O27$X%7Vk6VXr37tepW)uSD$Fx2xFt$tH3%kgNgI@MX-w zbHwjN8e)p;D@D>&w50-r{}m~^1Lo+KVeR8lhFY&;^kN{>e>e5}H>#kDxjnee2T-tF zj%ACsBb3966_I8&c{C$w;_|1eu@8OUb|~A7nl?PAR;#Cni8N2#gA3sJ5$mj((AP7T zK;0rqce`;OY?7N_rjQePvFTC2n6#c`{}v^G>byJ2zHunx;Ba#zBT)f^!+o$9qu5)v zl*T=d+JUL9rSweQiUR}Ljw^PR`d9H2+_*rh`^x5=J7st%hpN0x_|b~YpV(Q;gZN4V z{3-?k?@PuD37s(zMR%^#rqBvEp*;RT_qQSS4|@3)r_mXWb7TpbU$^@q5oh+SZ?v1P z8)U^7S)D46ra071=}t7ol;=LmamA>^AjX03({6+*Om0nWqv-hGQ$dF(T$hO->2%YB z`5iA};S)6R34)?iH1=Q^ZQLxb!eh~!d!ZMEIJdNU9b`qQh!%Y905amoSXBY)tA2lQ-Jp1cM1t_AY18B`7Den%8i zWu*t)YvAXYadMkY0lc860s6Z}v3Ys$>0&;E$rYgO5xHY~8DwvKe)`U`p3><`_q5pDMP5g-utTY638hmZ3TLL{);;tzIDYp$$uMVhJW5Lf42j&kPCR$rBG~v6)iU~l!MU4FZc~?8BCQ1GaqOnoR8~9S(eeikA35_5 zRxAS5H1)uK51A8zwy9@MAds}VM>Xv?srMRy`7=nLDkE>ZK>w^8suXg%vlgXJqswqwN$&^(1#Y^Adloo4op1NNdSdPwE^vj>Ej~ z^1#&*LkN?`wy#wrOeHbD#NT!yMt_RDCGzuXbH#Mp=!YJUv=x5FA6Zk4?1%CQ`fkH% zj)X`j+@V^~A8UWz4Po~R>2svmUifK8jTm}m=rw@#(XQC&Wb*B@L@)YKTy6MAC@?Gh za8B1%Po~S^FO_!_;EG-eWS*U3>il^Dv0+#F%{TXD`07qD{S*^e7yyd80P|fDV0a>S zs7pO$b7^4Wv2fzsrX6r1c@5AvWb>tXz;EayIEENNhc8DL0TMZv&yw;3H7eM;2Zb`Ap`2nW0>-+ zzR|O=`tMG)kjIr8#?W19TZBBQr3zYGMe!bs8U0gd$E!!bQbO7@|fU#hhXG_%27YQheI!i+vQu zDqoBsq2iQJKzSM@rzsKYNKzfUIBStgsbV z>PtLbuRCLoe!JRS=lCN=khe+X3#EhwE26$_Hm_S2bGt}24=2<&2hHwMFh)qn*9DD! zcw5==5;Rm6xlyT}rWA;$H(Slmbz{*C#Lqd%DaNIf=Bwk?vFAsaTANU4n{f6@iz`gV zht#>Rw(4%DGlfM(2eeY4RGEATSHe^sBzZjnS1P^8)>XF1G99Wyoh?1Thyt7?%-R8X z3tu?7)8_`+5>~_se&Aj=?Dr7u6)o|z4JoZSB3*20r4HekDmFG3?8L(`+nk_V>Jmsr_w>ZG z0h0KnQG zeYzGE^fdKy7t2!JN=lQOw30c{qJ`R6!t|;bWkNKk2X^lhcE*1I_6P&*|=~|WVYLo;f`F2u)-x)?WpnMB@n=UDe`h zaM!QP{dn$U;F&{gM;?2TU1#$jc(enQ)}Uphrbqq^5GWr+ka~G*U>UuUDWtzG;ie_E z+aba8$v9EoJ=FcHRf*Rq6mF9?^IuAc>nwrA0nMvP9kqKeHBDg33%eY_oAgeRSD+7D zaH&Jn=%4l^NQBrzNT;ia7IO2{whOisUGi$wxu-14F*VP zZh?s=Wy`EQUqX@VubYw z2cK&c^qv9{OL|KrT7SKqhA|{VxjdHRy3R^KlXq0KRXzDtwZ&7gyVn9J-pZ+>81H!Y zo@A-kWdPH(94YCN$nCnH4DYv)$D}=30&b0uwHX3bE~v z>nCNkuc!^*eBmDDeY6`65Cc7C&#h7SXcE%9J#5YFob2NOUM|vCR(O7~@RHS7H%EmN zB*<#&XccRiuVc7>%2ebUABiEoDYrxHf`54dkD$5mY2|ju9DLWzvXi}Q1HvTHd#6e@ z{6%dnGmEdLa6QZ~lkj1piy$RqEH)n47Dk1P-o%LN_-P&QlDbQ&Rk_?U|5{;^_bsVe zHcE0W#+O+vm^WO0cG{~G*r4f3$Tr^yd01}EYznU;G6IHShKkI92n{At9p6O5osJmDUewy#Cu#_YuXfD3a|_V4WbH z`FzXZD_^gZ9EbMaQ!JejP8?&#N`!z=#m(M$eOKG5H;=hI<$P$}OT-pd6eclGkCnaX ztL?WkKH?;dYV%{+8*7c}#SonN69%%b$V{GY{*_u1D1A!r`>6?+%P72pn5JppXUT%zl4y}7cC8AlG4)LF54dcMmPi>UNI>j+S$-?1LSjuy&~VD0Qy!;RBu(cTWK^ z5^i<@$%z68R8(w2eNUYmDr%T_>UD{N z;=jQ3EQ+M9v8Wd;5&=LQCylB z{nFDm_%DfgVQ4EBr+$FidDuON9&0qtWi7cjq3CcA`VCFyl&v^e&yJvC>rO_r&Y2%& zsCvy+=M^_ob0|J<9wBdA=0H(uz;DQNKT^-o-D& zV(x5M6jL;6rv^?k(GLd-rk&*Mg+F4%vkopA-MO>8d&cI=EGs)nf`H$DKUTKrXBs)g zo-eR!$)s?R?u4!~*exnR!k7gw79@ED_1jp_^|s_m4}*)PCV0hw1MR?!?TpC_YHBvf zB}$F&mWX#zy^HWzd~CYV>~LkFAPDJe%Pch1kmz@PJaKhsfiKL*WNy9#6FHa^+G(v^ zWcNaB+gWIn3(;Ei~aAOBzVv)@EJzB+jtK^u=_!mF5fizQpCc6F z_Ss=Ux4+on%%_sB#-h$uaDFW`PTNv?__Z-QtH^uobF!b4NVb+0JrEsp=9?k}AHqXJ zqXyOxg>fN@Vp#(qmAc}Vzm0-O~68{>vHf!eKM!N z^O`Hib@>{fGb0~B{xZ!63U0G=s2g1r;)^}#p58J}tL7ajA+6r)+!AXqeXLL~ueCyX z2cO)yG)o7f;)9vwG@up%L>Vm`=gmvkFnXJpmLQku+TsOXW@w>ij~&~Q*G{}Nxe2I` zcn0Ni$mmVg<*Ra{-AT0vcbno(Y?`C$;e$;-Y{c7RckJ?g8nUvFyHa8gfuB>kRx7lT z^>R|j;b&FWs77hm$QK4$>Ku$%s}$A(1(uSixC+WqlS5nyiuBnC`6M z+rKOY=~Ejvv0um)wsYeo{fm_U`HO4yp_gaFhmAyBdV=>8=!Auc%yp!onB@POQqTy+ zzk10yr2P`_&F5ShLPXk#)NsxHQ-Iq|*$A3}z@ruBI4I{);1cZxKXRUS5&x7)6{J*Z z{+vPbnhv|Tvb$&)hOG}CNAmpzw>KW>1p96qKCgZ5JXq8}T4+TkLk(CefvciQ%ppBT zf~(?M*Cfiw&&xBc)&1qhCRJXS+qQ1Q2NiLxB3-mo&f_U|Avy?1P$6G_fr5ln_`J22 zehYa)>0~)gyjjOwm0I1Q-#~_(sf(LN{J7Ti2S8t6tH+pm>i6=2PZ}%~?qMm)3fzFA z(78p`ZkPHQE9H4NIc*HIN#k#rp&2FR*cqa481|X~&W5;RMB700xe0~KHzo%KaZy*+ zimxQoA4tog%2(f3L}S5u_MmI5kw3hg#UxyHpr$#qZVPH?b7r8qyd0AaYwcQjROgwY zD_hx+hi%qH^OHD4ThDnGqxWQo4BRC>Q6juY^bTr~(oXZ%-KmwlQDRF_Il|}x{ns!N zuRthM+`v3gY;NI^Z-JDz}YkXh;XOjmE7kBR`W1InP!Q%%5FD;>ORkn*cGS zMJQv&T>jGaE#toLNHV!U?7Y^U*pHON#einx@=8V!EWW-F88Kw=J48|vudoPY^}3+j z0OoJU+x1uJ!JHv;Y^&~%!xBQ>-^C8ho2(Q= zneV}=wB%k?0jv9idswF_+pe0kQ-RbQX-R>J`305>}S@dnHFM*=0vDsN9Gu#XO+vCLI+nXFMH{232m$%%}F;ML&t9f)lP; zT3;lUZ6u8I{(fg?Jed!|S&KBN($}>!4K%Kk=@XvWBekG}fU~(KjT}%D7T%7{lXq9)4Osn8)uScVvjIYMf7|MIA z;HmOFb=5x!szcJ`|MXd!H^6pY9{xiM3OA`5-J)C5aVvr5mWsIiZ9qq-ae)nd!;pxK z>WoziW11Vg%_J;`p%+g1lkhHtshs-g>?GB_vD})69fB|N2k}@`uFHMWRrVuWfOuYO z9{TtkpUp7GoXLKdf>YRYkI~bd466&b$AVww#kQBH714gp_8hP`lFiQ^Yb;In?@aJa z4tXe=_l)Q}({2Z+<&r*4Tktw1q&h$kt;)L@L<#+Vum=f8>@S^vpTMzlv6-0nM6;cB zp%b888GGe)TZ4Q_NsO zam78IL=3nhwF_@-5}1{xMGlVov>=`n0tV_ETuT%OL1H&z;*X%i6Vx^uK3-r5$~Jj zhD=BRCTVR9Clw>0*MbKTE`_@c35;hI!d?74$L8#oBlXMYnaW_ug2NU>L2NEd`eNm9 z8yelRpkD$u72-oM$}w!uEJhy}r}~BXb#zl%OK*OUmBhmwNx9y`5*_J&@RMsNTocOP zgPd;?9t@5@g8D3jJTWS$B@e)2m z5xE&?kh^#~{aGBw)GpKisuVv8@;Hm8SJsLC^GLqXi<-pU_H9)z6(7p<+(BeFX?u}? z8KD{qU{;<{^s!imO0Ur+_~|uea&cao|_9MyElwta)4nRe(R?0Q*}v! z#ujI6l^iHR{z_Sr5y1ClI97|&!J+uSK!2HOEv(}jLlmAfJ2RB?q-!z>#b&oB^cV%% z5(C6|-sVUy?*d?Ixjxuj`$Ig=T)kWC3G;F->|NI`bBq=cor(HPepgmq7PnWc94&A9Pv03?FYN_i z=KvP9-a=9^?uqTMJ6(wcC3v-8E}K2d`~lW{#I>~c;5m0%%>EwMIV0+iXhA6y@Wf<1 z0$JaYWuXI)`fhVEBI0mzlOvnL;i314&w|*BEe)Tv<1D=vg41^fvc*n7Lv9Y39U{ZxjYZ ze}#K4hZbRt@=Fv7aSfQm@ll45PHZv)MN52dCvxTlB416+B7qCE78vrwB?Dy$(=*LjV~onuNw`|X)_zlF zBe>a>Yf)Q@L-bh;Cwnol1i>N6hywu8(ZDY(Qu|;vCFO%ZWEyQb{N|ymvZ#3c4n8as zK@F~GhNE=qR_NHDdd%07(IYC(Ty|23t1m1>UIY{RumsUx6k6kClGFGX0M#MYKMM3* zpQa}v|HCKj+mjG*tvtk@syRIypJ8jqeU#M?vg6VHufu0*eD(aG6|N7)%!5GPRTl=# z&7m}EOVU$l{NRhgQF%$)?u%Du%~!B@sBXWxDPe=ct2E!hA_>8V8W5kv`^qM{SRvfH zfOnG$55~#OF&$&aiV^EKs~(3f^!K1Xyq|vCmFmCd20fkvZQN zlsFW+tjd8WIc$I_CJ--Lm;-q7LGwH2Xa-!ZsmoCrqfw7ydyXz5d8y?oO%_q;0GtL| z8LFadWd$~*M4@9CwE3C0{QT&WXV1G-f{_U!;E{HK7}BO=!%w*4NWx8l^3tePCoo z0stphbdl#YBt^14e+M~hCp>1*jVoXZ?i@_tF7Ji3Y%oL{te5Rl-(BS>dUM@1oeE_N zm$0MR(mHQ7qHkXK5X&U3r0Tgu&GgyEx-U_G`o2Mt7+{f4TDM66XP*yv*kphVW2J$D zcYkUD2igfFQ&_3L+iF?^$ELPj?ogzs-*J~GtpYGvy=rCXd>CRPP22$i=|&m=J4Awb z8c@bBiVNak^$nT8g%<2~*1sZ@lb|GdMOYT#fN_m(ZKdrT8vqVZgz!j3zY4~e40B1; zmjBa`s;jo4J)~(cT*4UxMBHa9;honkFXOB{MvH-#Nxr>xK<(3j9U8Ttl$Vl38aZrd z!)L*S7?!?!Pr+WafHpvT)f^cm`X$isM2oYiaKv&}=lpm2%PI z9&x$$URs|3hIO;>m&o+HLO`{@m!9zO5!V5kQ9t9Bkp5qi%M8?d;}r;J9$mJRPysqvOOZSnycVU8}sLrHWl5EelyhzTLlnL&gio+ zMDt5$>+USk*_1jr&Hgq^+}$Pfof@bYLJ?A7QsHf6dt5tX=0RAqw>!4h^xZ0UP;wpe zSQSM`t{}22Y9Zz+BY1qyAg;W@Ugr#SAjIHub)((akZz*ed33R@;Cd~+5KPdUiAjYg zoN#Tr+!KmfRK+#WAtJ-ft^{zKDmqnhx5dXouL*+(o4~;r6#oYYyLLn{gYGAh@9MH@QT-hP!@R87 z57sOeKUq5Bq-n&fEh-}7;HGaYlk|DBB7B(xa8LUH2fW)MC5E4B!wH01LGRWR zsb2KF7QRXTWG+iQUOm)2#^vgyYDOl+G^gWw$tBy68QHI5#G;Xn#CX3P)EImg z&U}awV!w{aH-L^TTCy+EFk#ry4 zOuw{~U`ZW@U5^!dG%J;mgFM4KaVb&Tt!mTaGJ@#egH@GW?37X1dX?iz&dm2|~rzJlTHOxE`sO|I~VX7YQ=M`rR2MV#7q{X51f zq#nz64`qa}iNQPR4xpBh-IHWm!77dZA)1sI>R1j?~0rAXK~=N=+VBKvDCz*YgehYjogumZ*S(%G4m>mH}>QjI&f|8 z*V(rmVxDPDU&C(C8H_pTTWJ$cFrckZ(V=GW%;b72=g|&QdCN$6OTTSiBbmEYDO0$% zW(=FF7@r-;ICRM%->4m#;t;7j!5}tuIB`OXgO{6J~L@P)^+QkNLOfr)T6;u0Z22!)B>)_G{Hjwc)%nPzSxO7{)kmGKwZ*N*>du z*X8?GLGL&v5>NvyDC%u9Mg-qBfzn9s%o(~~84ZoUjO_}Wsz3s6@%yW~YSQgbzGn|b zW5zbzY`t`W%=w-!Q%uE~o^;OiQt&T`wrbtuE~BDtRZnR_iMfDId4;{WiIt}4A*ZyX zv(F3AIcCTRKCOy#t1RAdsp|v%$KUwO_F@v6kO#VO#=Z_T<*04s>*VWg%NXBetB1aI zlQK-G5g}6RP+Em9)>6&y>OC*XFD~wGlqL8v4D&|8xioELp!ae+&j|K{7(?K6WbBp) zG@iiQf^2ht&rr+jPG2+wV@JMnW=)1qQ=eK#n$x3bwhtY&T};Ij=7VY%h)!mC%dV^MLpV|tzKry`BXvAhAOI5LN0BDLq6-0n?p zO@h9jDpt}`8Ia$2+{3(&)KNG`p}OfT&{H@=T4Ke{>8=npMf}Jv%O?}^M#E=yu-$@z z(eNI=4OUTKqG>dgQ|tznWT{zBs+tLlHN#|_vq}u7#)Pjl!mnKEr;o;L`>My~p8S%1 zH;DkV8^fk_|H$}&ai}3%;BF39@3p*gv_Mb?o|Ca(4VBAkv-=_j`<@K0b^15Sr?_Rf z>T}bnywuWyNwTVP<&-=#7IWH-eg*NG6Xv{3U@7+vRYg zw^{SH%jr8qGbaZ*wxDGl;WHBm8T*peUX*|r|_re`?vAlG0^1dp9j3)^<@wTpq&a(vse)Z8_v38d+I&i>1!II@ z!Jv6-ZnLn1g~slrvr_*v@2mW*tMCk%S@I=EOUh6>(IHmJAy0e~3%Y%}8$Rr-js{6l zLJ>*EE(7YkC`ao48NvAT-T0FEyA^TjpsmIrO{b+#3yWA~TWnav5ftl+NfdO`7!J=^ z#qgx^eB-z+TW0KEo#QI_;GQSW7+ZoCWqyivZd zY%OJJ+HoJ+EFAm(YUoww&-C`6n5>L@Yj>C0>C$QCPgDT|jeIFX+5Bwe1}9bO+?3j9 zs9rLHqZEvZzF}zy%iP<+jWThZ9G|rUy0V!&R9Aa*8@LxRJhCDuRaQ5j7B%m;Mr`n* zrDC4FqnLd%O;6Bae|o1EzTR67EQE~u_@pSSz3He^Vq<~H$Y})&SrqUjz*s?DfN#87 z$Lc2#SX+wdRIcWRQ&N=>r19-!EBn7+5@5!|77DR|pHUZJc-7!WFC;PP(s*TG@xxt+ zj;*7BHOCHnS@rc!d)kxC3WvQmQPpI>7qT;hzuxjshnkku-mJXxD&uZDRzioeMenc} zrVARC&1E5l?Iwi9v&n;}UIo_-7dadXGJj9BjFenyIIG+r2AzH{3V32gPFnWTDQ~}7 z1?ccsa1O0>=i?X+U%y_KqJQN2CW-lDA&oOFTqzj2ul{>m7A(T2EYs1 zkWLyz33D0r^0EU)P5?z^^3_+b}kGYmwaP54g9wT(d!~;^ntD498nA?49Hn3pCv=h zo8>jB+{nYx=T|lm%WRh{jh9sml_7J_qa&72qjXcvg`!gnadi&^C_Uom4+B^3ChAr^ z!@_5^*X{U;Gh|0O?$UpHme@Fib@7DOSosMV3v2XegaH8J}u3^>Q$f!)nV~~k@>ui=k=$g9YkA6=YsQAYJ@q@{3rVMpk zjeuDhnGvWz_r*XEk>eUZdY;Z~FuHqtwmUvoxI;!uD!+ELgSj=^`!MG)B#C9H_Zsd< z>Ab*uPL4g;0V!9`X9UwMTN%Mk6nUJY`&dFRNXdNwJ4ai({uSM~I0D4Vv1+{zOuMbs z)D-{E$>l70)9a+@`dqmoh}YM)M+$tHX+sD_DQkxh)Q|!JE0=B$R^?@1BuM*w3pAh* z9E9F5yY-g5cMtd=5rFHM?2-R~LCZkh;wIpfvRcdTyx5e%hGlche)Cb?77ip+ThtX4 zP%QqrP!NneNui++vZiy~|u9ya?m!?8<|4)B?Hk#k-MN3belYJmr2h_xm1SE*cWq|vy&9R zL0z{RQJ>6IA4O_u#07JX-e<1RL$=?V)5g$A&Oj7 zcqegJ<1Cz+vM5doA-{V%?vfENVS;aF2tp}IRa9z(2s z@GeRaekFt&{LiDCTZDj&EH7_i>(eRrGD-HQ)N+)*{P4{Q?|qz&;}JWcMHIK1?<@F| zkYRdSRLla{qqhtfI#XYOHpr^ieV%Y&yN#XFX1o)5IW074h?{$4|+Rz^l_*U-sz^}1HrN0IG(+u83qwhMQo?*UbL;G^LDZdgO< znJp*5nmFGW2|ck)20n#K6zj5>>YENxBsGGN$yZEb036RI+Y?K$tH0nnLZn6XIYT7k zQ8&8cJGhYb@K>SPv3y8lQi&7{_*4;-?U8vfTXb366V-+A8FDl6A-VQ zaD}AR%irbv5TO&m{VJW6QZG_f2JcBE=;}^NyAMUHN4+lnX-z8)gIoWA0 zhj~il=wnN}BI(GrWBX)?#``2m+Gag>tuE18nO&NCEgH&hb=xCR9#F^GTxi=0p$@5I38PhOXt=hPQ0o{PP#wcyvu(#+ukhtT>MTkj}cX7oigg z*%pltBfzzFPa@gmujcknhHZo_W-_@HR<#LjghRok^hw(0{3~J&+f9#6?xNJ?!nuQM zC6yO^ueY*ATQJZ+fUxJZ&z*RU#Lfdh74&|;G#nM={4kbJ*l*=FH+O)NhRLIDED6QK zf}(`HkpB=S#{E96ihY2H^l4q6LM5|1S4PVWwauT>IP>#C=Dn258Id=Y$^ES&*~D3- zWVBwp`^lAS^|HNkk9{9O3ir&yyLrnBr+Tfi(^XH5cedGiJpoC6ZWObALwv#rI=oT# zGp!%5L+8t(P-Ji!pq9g9Hu$?{x3h^y)mxx@v*)fFqZI%c8;WKKW>c~RbvLyyxM8xT zpSMb7?0YcwXoTH)BM_1r(z^o;$~8SX8YILZwmm-srE6eY62wG!*LCG_M9^B+qL;(y zA2@*@%6pR?&I;8MT*vkjz0vQnmCtIUn<^O2 zB=U|<1oZg3p`PSkK#mI)h4()#-DJZ#D;U;ldsGO5JXrC&+rCxHj)7Ix{Ch z>>9G;a+Et?=pV&#-RbTqjDwaT^t-U%ef-%@(~2akdz-Euip#Zd=ax97X~JYmK5X{Q zdxaQ?plGBwT0y%Hu^fE->5uz;O7^8>h*q9sZ{_~*?tPg)*J zCo?yY8?hsnq`SHDRK6oxWf7f z-QV-nudyWW)i*f0@CA@U-q{tvN!X=%m@uV-QiDaqclTXbNx`hfu^Ld*K&Eufj|P>` z-Snzz7@OpusmLx(#8O*ZXelhH7h^Y{V@$+P8}1L|@M%`8wr4n$DB0raW=L9=a zQ=AJK;vK#->GsT|$n~2XhclHrw_&WOaLOgd1$j7V8~?^YgMj0cw`R;xBqZ>7` zhnpldhHJD|QHKKy=247Bzrm6chS(>R@J@c1W0fUZFW7MyHzK45_ry|3R41M%UAv9T zj`VvWp|%&at`+k2z%IL7bcr>CW&RUFI<=A==<3C4+gSS;!g@i@P&}_D+^kPXN0@48 zG~Aw5GsWo_mbir%W3bC<{IVmp$S@@U)AP));{U(M8>Nc_uC5BCH=an13_Qw-QkIGW z7noo2&^%G|e)Tpm*aV8yE$cO}nrnRq{97e3B{Mv2YUHEXld)4Y_Oe{pa4i2fzP74R zIwN>gDQK57m!@+G$iOgjp2w%#$wV00U}<`zpD2)*MBOS5g-vq8SbJ=(DePTMbZkrV zV7bLm5AyOfw_&C^=k^te;4u%@8A&K3GLD5@I3M^Or}TH4eIq|>79}bhV+HLZYI1}g zirO;pN4Tq&XsX-hR8>NQGV(QkBhY4_ zF-=z#f%KW!TDZW#OtZR|_#;SebfoMif>Vs}O?`@r8J;s{igaD(Jd_{VdD}3Smr&=$ zKA@8i5@zQqbDR?wtaEd)nMx)^Gl9t4Kd9@f-<37Ri;-S>4}8B2gz8LPSc|RdGT-9{ z&^|`vSL(lZ)D;t>(~~z#9Dhb_g6Jt&D%ohuK6J;<<4+izJ#1>hFi(VS%;plheV%jz zrB=*$UysbYNiUrk{O$yiC?XRG@VXJKGw@pW$}{raK{jIHTjbgO{c9#10|JSL82pql z%!t}jQ6_?~@PWtqw{J=&BNLz-U#;)htKLenQlfmcSL%<>fCRR`B_ zeZjMsNY$5+>SGw*4uEp6z#$waUXQCwt^Vol0|Uw}HzEg4h;~3;BWTY%#!x_Hh!__t zW_K73-bq(6HB~+DioF&;jphnPc}AS|mlSxd*eD2|@P-Yl>_>}YNuedPIK4Z{k#7*u)H}e{UB<%)*+9ZI84vXiZ zrIZLH6RaDdT)Zty$6knnMQr=?@+SSweYT!gdt&BOkT_?nM-4%7fGz3zu7~xe5wTrq zJjitaiF+V^hI?h1#5-}WP(i+zKx$vbAU!!$E5*4NxK~5EQ#T{hq_a!5a+u=jCUkZbLs+}3-r56DQnUIQa z>_a7M?1PKZBMghOC0A}X%jOjs^wMM&!}+@RCQ}+k95~sM@pqi%c8`Q&3@xVC^K%Q> zt8D!J>l9R76?;S^*iN9jR1dA&v1JCk7MAX1bSyX*At(@wI-Yp8i(OVc2%TBIsD%h% znuSZ!C?WNTQT5CNk9+uNESQVC(=1P36fz)wm7(hV)drJ$%(=p%1voXy3Y#Hq6ksPA z=4*i&h6Oyc3>9dFi8$t|B)Er}HFz9dwEJ$Uj?Qlm1h5V`c%>7uFttAQ5A!FSsJ?i3 z@+}&*s@{7eB~2!CCr;O;&&&W<+fc4U!4Hk>*tRly=CsezY%;Vg`3N-9y*VuKKpxbG8Ozk8#C7H&-tK?2gO_m^o|#&mb)K`B=kS)xGmp% zW6p6x-EfCmR&kIM7aCjj&6sL*%@!T0%vf6R+m?hm^3Vd8%xsRo>IgVU3D0FO9$+qi zBk@#WUtC3Y_U}Z?`^AI4tEQ!QWgGq1H|b=O(*}LXKc% zXUIOLx%HJuo0Y`d4IH0#QXAoG4Z{GADpYB%+_iBO=r#|u*khc|u@*_GfL69uP2I{C z_GNAPLw2tBH%j5tFykPU0;0hSvdWgHyDBkcj5Z;9e;x~7XCa$-?wF6xCAGF+ zwjpqgJmDjJZN0FiO&B)DSp_G&KjC~`P>E%F@Vhnjvo78=E|?hYC^NJQC5U||%#78~ z_hu$(U_%>B7mdnjf3h+hEcflg;YqO*Nc@B(op=4yJQ!ztoudG>*~zfI4!7rI=xWF% zH4p^uQ$!O}SDS(<-lPFf>PF$2VvsU)b!`qPC{5Q|aFZtl9yt8y8fzlk?gdRi%pvoC z^Nd7NSK=HNZa&-CkuFWcD=<3hYmjhY1njeROJp$c#l(=LT;T4oh_(+srn#f4m+B?X zUF(nYdbN@TT%Pa2zTTdh2KJ_+eM1{rSTRWYf6)=K532aw7w`LeMsqwTd}Ri}NQvqz zMJFe9g?`?>0D38MV9K{x$5)oBb0q?q(jF|9eaq}VdNYNrrI~#-u{h!Q(&n=2#zoYq z-$6?Kol;e8yQHE~ZNItJ}iKF?EL#YU*jo*iAy#qc==p#XsDTSNc- zATk&e(uSp#gDsUh=haRrB@>`AKW1}a|43&%iumk(I)IMv>wsu3_a+3Mh9*{rHiRI_ ze>y>3Q@qj0!I2ywc1~|sl>^Z});Cc28S+kjZ&e=8f>}Z;(qM2bL>Yz(l+fg7se>;1 z`_eF;dA~TvDnAsx^yF&}mBU+LSN@hpXcVhH*Os^#nm==#a+h2T;fHX(v3 zJ97(|fWED3IfLio-1h%_ga`WAS*^%x2TXJ^iA4xK&xN&)7upIOiU*-p3R{|-l0sU! z3Lhc6hVEYEqaix_XV+hCT4K?&yNJSm$l8lEV0^zOrek9xG*qRU`eT^#S>TCVMD-C! zTQI0c2?b9%)g=&LK^4JfjzPj-e`}8epKD0}>phQXURE@!>`ZwWPcC@7!`Ou|1c3hL z`{$gum6ddAtr9*pSdTF;-lFF=zyoelo&vK?bX&v(U&xwQRZ( zT_0(w`sBT3o+tnL4A1BQ&wn=SjJ4Z#j3m5RD?GAmb1m){xT24b!@qe1bJ%Eh;(V81 z(m1q<<~;`G%p&#O-Ozyre`2iabNvnsWlf%!a(n5YXa>Zb7B;7FAay$Fs#n3xr-pB1 zC(CW@IZe^dscl{SXjw>D@oo$X~)o`*_bs=;CPmv zyO9Q$@-Ko$@O!wV;3xc$)l_|Tu}8>Ih;Te;z!;SlG4kqw-zlU4W2bRHdkFav7@56> zzNvnjYZMV0PsI74xW~gsif#}`TE$^P@(o7-*HjRu%*!fNE<5gz$+dgRT?g$X2G;s;=`97o|r$pm~aIx z2K@Kg_hK-W_?6kWS zswQZI`oXlpD&B9V>C_I8vuEF_GJ-2Z-e7H3vA*D;a@ccQi);f~O-*jb~jm!#Bvt`#aP!bko;wabf(* z1WQbDfRzUBFR(Z7{cGU$8 z$4}-G2e%Q{E9Of^Z8DT9IW|_MeKvy`KhJ9JD=hpJ;ujd zCkiL*dJT2wdIqBG3vm-aDN7AgK^P1qq+uQ+2H9MHl*G?OV#b1r((E#{X3`v+fG_cZ1X$vAYVKQs{PJctM9GC25jF4?XCm;w z9s14Vd;T&WpwbECiVw6o>4+F?3zPvk6#>keEguUJO z-hc^J~r|iIZCU-0$N@D71tX<-t^ycwSfB{LM{)~8H!@u|edV~lQ|nkpJ70TaMe!>Ce)#X}%4R+8H3Gy#Z0%|uzzgwc@T_qg@J^bB~Mfkp4{4H2y z?%Rs+<nTq@riBDptHgIXlh71hWUkr!T+6WcOl>hNyOuApMU(pJ}2k7~B9N~0R$;7?T^Wf^n<2%{cT3KHWN|Ux$v{49g(o>4vMY2YG z;2cgs&R%9ZZ$0P>{|eYy#a?hd5c|Jm)Ew$I8;#&GADMd( z6w+Tkr*pnuW!NUrbdS`V{-Hac81w=wQj-83=MHE<_7mvE%?>fM_{hxw8LwkxO+Q`|nehf+x zd%Yp%X%J~ADr)3au{r48@*iRRF6Q4+p=(KLwPBts75>`@l8v!-azegG!tWM>pjyim zHN;j>8g9q8%X+Fun(or_GqoG@*`lc*B5L-)@*sYvDx$*bR7ffolRl?l6e_<~OO#n9 zPh=fiC5Hk5pXIAvXWW)INES_{R;DL-E24Zv{h1eG$`Jee=mP!*D&5blR@N{dbW{XGu-MV2e zL1}d&G-UZRIAEx%Meq43ChnXuu2k5TMV9eZ3Bc)ZGOGx@N*x47^*1HO&{z+8XIUgRH&uo>-DMEEA0jonp(OI48Qz+92 zKSj)dp{I>m{S$hsmHZr=;HjtiTpeQ_e_O&ELbdcBkA_Oc{Lq(uG4IVr%tjGOS<#7f z!ie;f=&?r5*sjo6#R3(hPdQsbUzKI$bhUBJdcaX0%FTc$^hMJno!Ioqgv9*+I^&+Y z8uV6mETd9mPKlJO7vmdP!Cb^SZ0B3RSPylxxrR@-B7@mH8Mr$3=~p?4hqx+(x)?lR z(B8i+t35sNG`2S^EWq2*0fYPqSFd9op*(h^z7z!9S(bt)erg~Aor5CI0GYmcsyh~P z0Cz9D?^pqgwh3F6q)VtBI`G59(#vT&qT9Hn;?-Mpm=Vz_)N;=YIJ)i|#y$D&%a}x- zT>yv9)7q6b=;QQ1$471{v>MaZx74=9IwWf8Cuy?@{u8DX;w?PFlPXFhZLyS>?-|mK-pFR z7inaf%JT|bYaf()#}sb(kqayOetw!kI6WR?c}hg&!hsz($pV&=-;R{_{y9fZ;X3K~ z(lt(ys(Pu7#>-GrK<3$GcJ5%yzMO-*{nKfI<1YZa-$sPgS`t%(S}=Bib=Mb) zmg0cVed0d2QfL#251gJFPue@4YaM_GsPIvB#K(nWNvN_x0X5Vf+{KC= zPmsp>C$wN0ucLULDB-riQJ{mbQOyVQ{?!L(si{Met3xoeeNKKM0@!Dx!g;N?#Fi|M z23I{uCA}DxbQM33;NFX-0sks z=50cWFsMjM*1B~E83V1Y?!|M>+1p)4@hne@wu0ls+tdti|2V`uj<0fm4+YSL|ATeG zP`4#pm~u|-fBazy(^HkYI{53{8n%Wp;`iBLzge%oONz)`et~_ux(;~rX;kTwB8CQh zBQN0ab_UvU2!+GG;QXWs0Te429vBQ+*x0R>1W0Yn`bn%?F7CDqt4h9&g0??$X=r9L z7YKr{)`>(sVkxYVV7xrEPb2l!0loI=SD{9uZT+WbmU=_8(ewOISsVTiq14qBOgrQ5 zUBDWjsncOT1oW~R`nK(>esxaIt_#L;K2{44+WR!y1=OGt(Cwel=0E${TtqMMJB&P70Q?(&FFc; zj0tNJU^WGDXzsXT_CS<7x}%fk*YBx4>xQ7Q*Tzl7?R9mB?6T?+=V3OezT@w2LYGbp z`|b~3Tfh17vRe6$@K4#KCI%0WlmMSqa}xNunvIj`EX)>tvu$!%UJ)*CjJ=G3YX{S3 zI(LhMGbYY~ayB~~O7GwABMDm{D(94pCP0J;@K@gSQg6QQf4wHex;O<54x+-X7N7G% zW>Nc0S`1VG$<^T83Siq2*5H}#h5c-YdGARtM52^9`CefE4vX~x7w45hQ#&Qvb2bt%f*#g5;k8t#$X_q9zz|gNNK5pDKG=b zJHWMaX9(x$mJI=sh~PU5hE~Mj6AoUQJx-}kw@NRz=o@Eiu3Z`9sW)6GHt(%wO3JaNj~X;-}8LwxbE!c<~(-N$i0? zCiYX;?&q-rD_948wr)TiVT_46X|n_VyDT89aV}6zCO*={ndq1PKu!Is~a~WE+6^r0(c8qiP zlt$V}pz$7B=fh(YO?6I)qSrPJ(VnT{ANwUwr{BgGnva-Fp+HtBpK57l-X+&tWJ=<} zYeqLGsICyk%9ef14fffOR?8fgSjG4x2(B#s#CLWk%0G0~%`Ni_@!N`NapBRnYavkT ztqfeD{V*a~W1e)dvwb_=3P0xVTfEd?;C%%p&K4 zwM4Y9aVP3+TaWdib5@ay_>N5qC)D0rv-C~%ATy!vC>d50Yf~)+QQiF;L|kj%q&U|K zRbO^{c_u8GLJf}ZZpsATg*gr;8$+d4x|g~A1+}9_&6i_>P7m>Mi=%dIEXXCQ)8a+a z$g?`x`&RGl1q55nC`xsXadW%`vcrx?K_MfR7e@~)SJ!X_@szBH9B?US_o)YjXG8#| zXbtjvc%4<3{)oKV(vn>NVD+f#V9`m0NcD|@*wilygQp>d&+Rq>>Hhf=@0UC6Do;0J zdBJfONnJQ0WE95Tsr-O1MQAc^==l~xVTV|)vhyjw%8^Wp`~*qlT7rf9tP`wQ`gX7i z>OlE!d4I63q}?{lR_J9q3Gy%@3T5OjXs?X)$70m~qs-+y5%wl5uDm@ex4*8uh`2Hw zHk((yN_ObZkmr|>OKBRmPf>^=>ftQ940=qr4;Wdy)$;gQeFEcH0b&( zI=s=fcyT^30G#2s-!xU8>?ChRBy5B=ibQlp%9=dAR=I;CRg&Cc?`ot~BdK%zJf>BJ zNQ*uuzg@NRy=HQ1RF?Bk;TpEcek%7Y6XJ*uI$DhMsn-kT_cUv`(E_!wyahfoCe=O% zUl4WMD&LKaYhg^(Oo9wI6DLeY7bEh{wUJE(xTTl}00h58v(PDa*8uU<$`RmO(X%;TH|#h%UeZ5-!Oj947?ewydux~y1Fl#{ zr1U}GD@wVVO-q@YBEJca)7S^$^U6f`2bA5da}?{L3I0?nPYKfGNfPB4?$p&?SJ^+Hq zF@1}1hrzs@Ta8^yOAPW}rpou2X^ko~-7mAAu5bk#Ct(>1bE>FQSI;`N9CTNhf{Wnr zp5lj-*6_&%CnRqK9aPnQCl3z!@GPuu-Wwtj-OdfaFGNZ2i7K2UiAtQ_Vk!Mu<^nQ^ z@YoY@_ar25_^al#QlPk5s_WY>(cC*J9IM#1pEqzmX4vjG{;D-y^Gb?l zewOR@%+-INwi^du#Sx}63Mh$a?gFv3$WX~Bvy#WlLM9LcSwaXPbdbB|(cHFjFz@pY zodiiLI%YC<0@Y0bv39bK_W_>tUBXDFe{duvDfzqnw>uI!*nVgH4k z9~wRiK_X6q5ijncc(8U4YDM?6?5qNIesT#rKbZa26GVN z^c#B2-CfK-%u{(qDA^Mt-&g|Irhcm=$~x2&rtXh7iVZ3CRnca|>VFD+w5`9PM=q5L zYPbScV9GwKv)tVVnGJKXV#oHJk-g4#T)Xl%zm%0s6~(BI=TkU{8?ie+KQbzY-+?0r zTw|5%mm%KnOIb;h=nHB$0^|MWcqPtNFmbSq_ecKY8f5{Na7Qmm%VJ?|)Vo~Dhw=K> zXSof?9vUsBRehn66@S58&K-zZn`PHwCi;6|R0=sI4)6-u?eu9<)j|5b4m3vXSw-SL zk)`c9Ft_fXL%rsT47~ZZ@RK#7Ef_;WaV%GCFjY-&o!mFsXym0biof(Ja+oR;ZdrEj z?4($OLbqG| zc770`Ajb`U`%efe^o35dbB%Z>Eb972h6aRQp?lUutedmpyeb}3C#Kqkv;8QKC{onAu&X=g=p;1jl zn)CDIXuUMU0IC|mrL}6ju~!WhPBQO+Ty>?&u;|fO_P*0)r3Ol`E@I=h6`rF4x#ta0 zJg*r`iRWNm0H^$JjCzNeCY@}rU{t^sXl&ZZ%VL!VCa` zI8K-iE>m`g%kJQ5OCp<-I;qvEvv(=kH>ptArZziZ2o8`PlpZVu32NPss`Cf*K*3NO z6Gf;)pWYFpVT1Q%2uR!+U|C}3!}Y~*;k2(Dw_8FuzIQ`UGO^^fnNt^Se=v)}B$$g5 zwKiB`kEu(%t}VnPj#0=U%Z!Mu&<+6w@=Zj7x)JBIV*5_n#x$6KY_%xKd$op@=1EFjg(8!JWV5^y~PhL#sO;C47yvyfgJ__hTPRS z$tZ7{%Ya5rqhINOXp}K-R;NwjO0rT1U#4R=#mp_K_sZT2n7wG{#nM@st>%`p7D#t8 z;lLTdy?~xt5j_5rP{T|wCs0d0pXtJnQeendn?rk(L?nvhW`+nXbK-CY=@XNy^^GW{ zid`iq16d5i`N`*;FF6^4VTLy|St*WRq+`Fsw8lfyquoI9&77K?tq6p-spKaB+fuW^ z=~1}s!aHus$94uI!*f9-$}x7U6j%(vzA=~TGrk!X)r0ozmuIdc){8(rp zR>DTU1&-8=Y>XqcDra$Xa`k^>6iWj9(>izXo!JXlo+KRP_?IZAlNeX5!Cql0`ZC~d z#SUwg9?vvTsJ^;dFH&6=Y5!(z*x64wTO+=iGAY!JSecn;YG1aRZYIe@Ow)MK4TT&N zAV%=#RUo69H`8ztv|y9+xLDQb4J*_Ha-oF~g?J*Y$caYqc`I`+0(C}7EuLlxDu{Fa z4NEzPsR*dU?w+F&_wpG!B7|=Jg^@$zV9iQwjNR6F^SGPPNM-r1;)#(6tbX zxeOS0Flk#~5#{Yx4Il;5@oJN$$w;po42k14>tk zo@lKbl5~fExi2+g8Ph@avQKlZx&kW6aD3Ar{CL26;c9C}Svg0k(TDU1qnp27wT*8V zl?qKT=8__2ZTyco35Ch^t7l=p=a{No=P;#14|r3h(bwf}<$;9C8~_~2O|0!)`F4+l zr?Z0IGek;egEU`{9#R4^aI(J#v}YgioBGq1Obe31Usu?LkO)?jNA3dh$a}hCAAoEl ztE42ub=Xr3qZt_}@8r}*@(2z^E+%~NHK5$3QEDdT8UEI<)M;J3xTrk&e|SrvFq#*8 zSKR;aJz$GnE|X(QzQ>zu(JG9DJ*LmTxLLQf1r0C%M~jyT*TdMFrBbZM{9TM^GvkrE zxOGDTb^;~OWpVvhCqHeWiHNh7Qd$a~4~o4~XWXEj*;uP><|snZjUzh}g=!k4Tuj)W zYqc4L4|w4L@_@0lB17)nAm$m9SQg?_mm{(DJ+y@mR(Csqvi_}`rVBA(M%1cV)2w_U}CT%lnG4M)@!IG z$Sm*_!OvHrYp7Uj?3664}E_JuFj8hE|qXYsRg^e)B-R-Mx1);ugb zI1e?T(GsdZIlYwfv6cJ6o24|1r3h)10z3?YtO~)&leW&cVK7=-$G8nNO|0+umw_=f zTJr7NN5ijTrawz6G-Ao)Yz(m5!cY{dnA6Z~os4@ZvxeDFpojvCD?DjucvQtUzRs0s zY9!oTTo{>_3n{P2b@F7vLtUx+DPFO=Ln~Sc9;TfNfQdiW=BcjQ<$8|hah=C1vETE^ zLBMsy-x;9rV&N>{QlbXgu`XsrUaf2SfI`2x661=W=?(lY@#GOY7+y6U3k&SlX3_2= z?+Cwjdr=JcQB^^i2cC)&EALT>l|;niS0~} z*bq6%L64MS^S`T|;`@tn@aA2Nv@NoR+c#C8Qp3K#2qj9WJ&KA=iJUe3Zb!uG6PgnL z8gU-1wIxYVHQt4Z25-{L@OzzGT{8)#TSFWVRzUBFR(Z7{itst+x79GTodYt_Dp;!% z5>kYaD`p(ZHaj&cMqewzD#yFhv=v2d*X|Y*sQjETWQWk~s9>Oln>~sbSB7t7Sw#=0 zteP@^#}r(s&C^j%@(Kdr_`W_^Y}0!@%P_VdhBV|UTKGGmU`=5v>IA9$YV#%@m9S*G zZ9?GyLJd=mlc5RUTFjlBdkU94&X0CPV^>5xbzxB~#P6&|e82A^gJ=tNzSMSU0)_E`s{TUbwHIFo{7FRCYwod(#$A$damLV6N`bw7vuENh-Q` zL{!%X!|gn5=Lfx}Br+h?&Hxt+`hQ9kwmi)*#nxR3VO}Cs2L(p&LW{S<2frBIym?+$ zq`VG$zzk4QH;`=c_yuig_QP(LyU!b4RX%V>UIv1I|iY_T;T;XxS>VUf?W5(thgK{jU8tuNKa;2P-08l|J`aP5kax3YasV@d+36k7Yo` zhrCz=!18Z1?8#SuRe-sUZu%{-#2bRB>qK`#L~9HU5y40mRvI#JwHiIr z)j|mdTw-t@ID+gDN{6dV?Mj4+?`u>17({}ee&Xzs&_x$Ic1StMVEKaQjaQhq$UM^R))0>q~dp}%YW&3S1wQ(X$!p6#V1nDdRAL-2Pms95Va3G%u?14Xk()yp(h1by(%lbkDc~z7 zO2i&6MMaIsD026jM=RNmG<8($w1v_&1IsZ>F=255P~TKrc(-{(4g*o61ZLO&4BZ-) zRmdfZ;1k=!5~{$cP!RkwQF?_1F8^n73J0o{F+y)uQikE(?c36TPE6G?tlQTh5&R!a(1xCV~9X} zMxOwrU3H{J{k*c2se>suspD$9^QlLizh$ty34bJd>{duXO1HKOG00G`DFZ^R;djh* zY$}5CpnXo%U_+@@sCPuH@{9lU7xcDs#L9J;uErULJ&&m(h^dgn0w%S*IgI2{z`7!% zll0w#3YgOHh7q_Gt_PM}*=Y9!g;IUpSqP%@J8XfYlp+~|yX+(21>1TjCSGv${f9#F zJ|%Ze#^(y85YE2Q0+g_q0ig#019$THkl8zktbJYq(?JHByD9hcLLWZwy2{LqH(b#hD7AMw~U#-Y`1%qQGd*Tmx)J zm@&opx6i{V^NfI--gaUcKaI5jLc({_g4@TkP;7*T-qOs);cm1Zxv90%P=+2PkQ zk8FLBQ8d1?v}pDSrXmBQhH3>dM1~4{2Trd@3Xgo@ei#hqVs}s1q$gb3 za}<2trW5X&zXyoNUQ%pBjJ@6t$Izq~>wpH>YWy zys|&RrP2=;Rq!nzDFpmCJhY zJ^`4lHJ{~gP&Ftdx8=3djPG+!t~Qx-qRwfWaML0{f=z@&zb*076ywOr`qKp~EjVLY zSria3hs}0;)jivTP)r2H=97n52Pm|e+hZ8*Q7$t)&Ro&o!ah)lWipnzH~b6?g|8qc{L!3(` zJ%8-}=~bs-t)4BL)^0;cZBv$#LQZ4WCR{AvefB0|Q1=|{agR&ZrLUQYOvenD3%J_2 z@x8z-s`59uaOmG|EVsQayD`t_?9ibsY+b3KuLI2V}5slw-ixY;e^D> zIRoVm_4a)x5BOOyFRLu(1C1I*bzWPAegElI!v3FZWA^_A@%{g^jn&kYRpgZZpSH0Q zz|6(k(DDC`H)j0djTzZ~cw@#N-k6c?|K^SVH{AGV@jqzepYs3c8nbc!f4Ig%^uqL_ z^kVel^b+)v^fL6aKhm*0y#l==y%N1Ly$Zc5y&Anby#~GJkAH0FWNcw!Y~g6^V)LKc z*}~cc@KgR+%@$5p^hWeXhQ?M-)`m{zKb0fBk)xq8z#3rc{GZCv!p!_Xr4_*We?I+F z|K|l`dSg3lJKLY5jg29_3B8G(_0QG$;g$ja{XT$$i=j2WDZQzM>yN-}=i*3jMsMZ_ zF#PFFZ%%LSVQ&tw{c)MCeq?5AfRodI^USsuwg7rNdb^*aJ-xl5Bf$2*+x~a;pQiRd zpWM!b-rm~9=?8LlaItd+m>60Ar*N|PFCUuD*@^MLg=Z&#>rV$K3wQeeoS`$lv$-Px zK=15k_hUc1(!2e~fBruR(EsH<|L+1c$NzHk{7(Uzk@M#p{LhMsfRUA%o%Me#|5pK; zk&T^!jo`l?KR1qr_0Q=O{FjgI3=jbr+nE5M`1qiloPVy14V3#vbBC%*_IU$aB)D53 z7?ztG^lvveyL^W-2Y4iiE4u!_e`z)Bp|6lg+Ro*VHms)GSJ#g3qVZ_uPw!W>Rd-~S z6R9ege3_cr!6er<128o+G+uxl?=11)2-wM`8O9=h0B9_jrg|3Ou8JT3nUYd8M?j#i zq&o)#0cP)4onrtk5R(8mdVUhPe@sXSb^;OsWWz7cZVOr95j-Fd1dJDQ9BO~C7j%UN zH!xTag`CRrv{;Rt^%ehSd(W#50qY;yat=I@H$YfjQ~Mc0q!JrVFrYYJs5^J z>8B^K45jZV0tkY$y@Lnxu#a9Jvd>>;fCK99Sx>0O%aTT)O0a%j**sDfn zz;+KpcXmJx0npkw=)wM@{P4F}_@6BxWohIa?X+H5s6GAplFO+J;I40^UdGqfGrz06 zqguuipDaaXFK%pjf66hK1kHZDj}=&!?{AoOzr#fP`g%p6jX?9S*^aMP#<`V+k^OIm zZ+dRoIs6S4s3*A=fvoQZO)hDTjv$#7ntn1gKhy{PJ-@?u6EoXiAV1tQLw%i7{ik%% zmsy+jcE^hivgX&iiJd3i)%QX-Yk5R7?$|nJ-|%}H)Pq{uH_^8%reFE5bX1YyWRm35 z?`yfYNwuw+q3xxG8Jxb6aZn&GPGDXH&Fzh#m?Y%g;kT8eQiA8+H}JkG6Ek>UCt!{? ze;**zC%JIHtMn-3zK_$m6a8@XKAJE52R7g-sBb|YYar8#@c2V>e&vG8rlySeacTj?T`7u-pfBW4{Cl7AH=R@`t5%K zWP0z{$DWDy?Qh3J`whGkuJ!$^r~cLKfW5NCPk4ph$nW07FUsWD$m+w4ZR%Sv?=hy} zlYbYRJM3E^wiN-cuQkN%7t^nATEOQIj!br9x6@k0@%5_*clZ?lCdU7sp8(zeHLu5x z-02nEn>*v2e|K|y>nqgSu4(J1+l%`L=(n3X)#v)WpAA83@8*Lao}QnfYF$z{tHk2M z!)5;`JhBJD+W3NQT1dpeDK9&d2pqC=Rkp@Uw~TINW%vFCCZt`A02>FqnObwiW-#(h>-v+D26lM9|_%O}qL zng_MHsdF^0OMqUf6pcCna?3IfzFgLH!x{u-S}o_7B$&%icW{2GqKqloXZS=FA9VXy zs4o8$LIkrIvLAV@E(dl8`yodD5;4NS9)}xF|4Nq%Adr?1^zV2WHgNROaEtd-CvUKB z@w#=Cq&*XUtX)8^|#FTJW!7^InB-E>c%pIZ3C;Q z#UDFP^YQ)BeY+0IHr-HmxvQn28 zqa?4@(7?ihsgLPM2N#7{U#@#vLOz&8h;S6|V?Cn>@LE2p82rV(XxbKRgXVON=e+c{ zX}doN6~xQW;)#nXNS_l+G?d+~T8t%AqgWjxXOzL&)l?W(1TEyKP)u3>u<_zTKD| zs_vu(!p@whK$ci3EggV@Y(lte=&o(xI<@xrzkQMAkgOL)>9gnZ%kZM_Qz)Fb`;k@n zDRJ)FD|25ix}?gqRflnMvin5e%$vcOkkO5VB1Avhk;9^w{A~+45YixJ$g@+Rb_iHc z6N|goru2fb<;WQfL%3S8QAX$N!Za-3lJR}mZ+(Jn$MI`$4}G?CDq9MNvqha7ge!I} zoxr(ly}7%z8$xsh1~~$Oqq8FduQ^EhJ?4R=9oppamN8<0+lTm(Q~JQ+n%-5B*8`ac ze>>$n$Hhsg0asvw7{WMf!*nK-%E=`D&>cG1u$&>A>qKs^_W|21H8a>%I4kwSn)+5l z_>aig=u}}ByZKQ${ZMI&a=OF8pIMB!RdcvV*fJbrn$RqGfkPPhR^=jIY=349w?dSW z{352td{mq(WY*~7wqaXqg>vP7omsP#^GQ&BX%POjQ@Q_-6-aE zxQtm8?z&x8veCKig1N~1D0fZCkUioB$$^Xby0}w;{K*aF)N2@J(KGq6#$Encz!=8s zL@3#q%EqULR|Al7dmCPT?5a@S%WRYz8Q&N*Fkp=jhsX(Y77$&PkWA=n*<<-^BCTjU z55)(?UzJhRYJ z_|0anh(&A)hu7OPVm^!Gx!nI(I8w!OSWk(vYRvI4z3zap=Kv73S`eJ_5G1?j>$0*q z?yHYsQ`A5CyB(=a(yxq-p{iesA_2mT61okzas4KRl(ETLOHsfeW?5fMkK1|`hoUB( z$6|a90U1KMwf*o$x`>{u;g4*@saF(ZI@nYE zM3GRETIo@d`=Mg+Uv>>?ZaAY;^8PQfO~eixXs5-Hneb!}MI|I{NH?efwKDF8@mire6huTWDVz`Y_kRiio^#$V}8Uvx80jZUQ~VeQPS3YBWF z=j!KegtlE~j8c0NrNH_CnTav^t?f??ajk+gfM+b;z4LOi(&_am*lw1uwM)bWGrlpT z(j?7IBEsW^80V zM#gt39d~0Rgo2IkVVykQ)$@2DVXP(UAPROZlD~tk;#j!;j`gK;#+J7ojYq?Yy3Z zzOl4E@ymkCa(SU!G9*7R30OHevdYIY zj(c8#gx(4j6Hu4Kwox5KvxA1!P3N_A6t-~aQN1k3zx$L&KRjB@dr%6Ekof0l4wft( zXrd-hn+ybchr^Gp@`t|4a#a}jIvj&WzXszSifY5`Iv}@%r;fS6UUyNl{qQag zac*tW{Zi8{PKd?1RD*ZnfKGqAVk9Y_f5Z8J(r0u!K$Bi(yAmj#R-yg7pqnVl6$$Y= z0_dhr@CCSrn}PKdj4)nz7ieQ&c($!u#7&*)n$RcTXoYp)S78e3HX2C~8jZ+LBt{@s zhNWBhizYc^N!*~S&GF;n6^#H*>#gzFNxQDPChf=pr$VlZdZMGREJKG0we&R z1un?aaO+1-d)o7RcR^pv-<$neBG2;C#M`e@5fU7P1ByWJCmKM&Ab(b!ZqXIXA$rdI z9jJ9uKYoLJn=Q|xx3R)50R!CYh*5mG-Ym3`ay3~pig6ocZAYRu6Ztb^g%bm(kXwMM zq<*tO)jGUyI*a< z55&HFi^3c_piWA{ciDhtWvvZyOY@t7fgyd?RD_nP?M3eqQ+XjXSiy9{x7&f5+mOlP zi}_iy;?3bv>2{NKNMc_SCLYdum-u~Ej;fPm#2wwJxBF2z=Y!7pss8!E2>Yc72bZSt zWAM6bK?j-}JqY%Nq{8TaLG!P`;>6X@l{37?^1MESo(tV@h4>9maPh!nTw@Z?45eC8 zqdjqpfOeb1Ka8t1`;!MH$hQ6i)rszaEj+S={8Jud(P{v;$s;w9R*~@D4-7t zd}CBpMV$6~6jrwdQc=}+*kfA0_lwLmV-$ot&}678msEBP9E+jX5-9a>L#jT#tu9+j z_2|NuPk*vfh?bMM)jK%3{=M{V-sW4Rc+3=pF%Sa^!*}$;_vMt>YmX#@pDLZz`-Zd#w*axJo2*!U3 z&N3s-kpe>`e4y>J{jeRgpJj+KOa3ub%N}U8i47Je#@A%{C{@S7>_D1b%v^1-QIFWu z0Eyp!)KDMCXFmbUT+X{C{G8=2JT}%I* zLmS*@UiJYs80$dQ<0fS^n54)SFDC~vJptw^mz!n+!;0dbF3WCFPb;v>J<_ce1h$0* zDLrdK&G{z95zg2Wg)9V^eo>MHm$re+swajz%BVx8n~dk`9F%+dSc~jhA&Nyi)x_05 zD^;p6u!?jwwAlmP{FCK`=-ycSwng@PN&iRYo2Y9d&`QQ(L~cpzUa-ro&>wS1I(>BI ze&V+-6|ZKliP8;%?r)TD$~?%}nCz3EH>h(r=OP^9Kt&oKU9Z`lPZ26j!us!wv&ddY zoZ9E^Z>!x=2cu~nKD;_Jb_CGiZ}E zDYtdv5>(LRkgGDMHyQgBVV9Fh7ADUk)rE z>0k1aqSuyJRC~#prc=`>yXw9T1`rF@i9GJ90#XkN!|MI;&yAx(<(fiH_S(hBLK~HB zCV>yrmTOYxitb7P@#;4fC*71JqPki|IkCAT(m<0wYWbovb4JhZG#V{sc+7IR zLBZ?WGRAnG6pW_oIh!;2)QfhlspQHRSN=6S{Q)B6ZDQ_+Ra$Pn2lor1pCV>^531Jq zK4t@cBilO&-ehWpA4P@Hq+T3-lB3aTnn7MJWGCa}Qo8~KqwS!Awm`q!byTGOp`H_1 z48Eh9!+Urvu{CpZpLm!4!Gem|(s>Nh>)eYu8d{nN zq?UendW=M;g)fFukB9zLt`2OtczOsXL=N=k@wdCbT?ca5|5aydm02IVisZw~b?%~? z`8_2eF@gWS=FJ59(3mj2^THkwqPzSAKXuPb7HLVoGwiK(dIi8jlIMj!2F#K% zb*n636GqrPF$_n%8deT0k|3qK0O!%fA+_=b@yyYvTOJw`u)jIBm2Z`_-p?8nBQLW; z=9$k2xIfhtD3~kg?HEl+&_LsB*U`zP_X(D{K^y#(x8_gPNLJnyBw^mQewz=5UBN63 z(B-7xYpgt%^qT4jA_H&+zWVg?y?oeJzp+ij_}X77*8L?j5nvyA=NwNvMWZjR#C1gu z`xO;N=L=Y)~NzG2*h3RMPKA0aszr4->|Ol18U|4`bvtB5(iCCJ67avdBBcgq*h^1LEPapyH4 zpSOf0>%3~GTv_CVs7FO4yxCL`5)-O;0TNax4q?zf3qbk+`B}x3O`@B z*0zns`P?n<-bx`UG=MXdG@HTR1hzZxgG>!Y98i?Sych;epSX^6-)iVEDwDLI#%BeT zcT5?Z5anpUrg$5*0^)#OnC-l`Z)nc4LK_$SRkOVg?-zFso4h0RdtuuL@KDSDk1oN)*GJLO-OQPv%H{Qcw6MkmS1{Vv59-W#W9H!TM8_P|S@lST^ z&zTR}OubdsnX1f{y7y_$l0NN%4D_HJ^0^TT|}cX&2ez|a(k>zvG51VCX+|A*QNgRVuHM=0P?K1JjSJS%!rdW zC>)TgHMFuVO4TE^JpJ>)*W)0jo9!q@FVgY7m0FvKt9ZI>A^|8Oio;0Bz_HV*nH>TA z$gDfUS5wYM%YKTQqqRU<1H)&C*eFxb=mEr>Qz%^UGOu=ES!a9Kh_wwTo?DZ+mWFT`8i$cwl zYRHU}_g%xJ?Xmd_~Ks#pU)~e^7`?k>nQB$*Y^Tp*2*28U_DCOKBK~M3DP} z-$*@W+)ufi{~qnZi)`gVMjrF;?yunTy?3Qg+_kH;`CuQS^Z=h#9l<(bG7)yhH5OPy ztkXGimxT^31g0UTS|VVw2=mH3X5MAm?*aLc}RFN8WD5P- zt3Tf~x+?se;g9<)#8#_Twy0$0$pz!$MYINT{Z z%U=r+n!N6@YR2nA!3(eHRrjw+)O0?g;~1Co2`3C$vUfb$P&>?o#XocXdNglt4v)cN zt|VGY!3`tj%gs#3cMlXhsFs)M6z3LfJmP$Q&vVZj!@t|exQq27c^mF)-Cc6mgoMka zP6?(O!)7_SvYf!`Mb|Zd&+hXkE}D0mJ9p<)RTIyUsHrLW#_(V$5A}${0;9(AIxT3a zB$|8ILp(^nm)$nksT9vJn_VDy)6IFn!Qa;1S&=KkM#W8nEaj#kFl1O(el%W`lG5uw zly6vhUk;!WV+k-%Rrnh_mS(;Nj!u{S3@2zQ0?giXJR&uL(FstK?-RHtswx&2O+xy7 zH(P0ZeYGqU{~j^Qhs5IidQFCt=e(}zMs}|!V%tI*U=6kO!gkqRUKyPa7Oi?#*d6UB z=PGS~hB$Bha#%oWUqU;~1J@SH8bX_r=#w0q$ul|biw2P*Hi0HG_ z9Nkn*w__c>CI`|42uU_vPSmA1=kmtJ{_^*ToC>;vl6>`)Cv9N?h-t0$xoe%dWJ4b) zkiG#E5&&cv*qJVUTgf6(E7jw%mWyn7eTE{)k_7y*%(px* zw}L#~7xeCZ$bhq12kGiu3}bQ)8m>4=KYW50{UZ>RoolhcjAk$mFMU%lRGIIN8ZN|c z#}xhrf4+8HW|jq3kW+Rzb5L`IrT7$!FrrWce>^$bq83ys=&-}ogBaF;E54_Wy9WR~ zTlcK^gFe*2^aN9XgjDo5o_FS69C zK2}t?2P{Gb!*H7^f4$jMe4u$k;owanxW72qI3L3PL2aE+g z&+Tijm}Cj<(EWn5jW~UpSuXgiQ&SHlcKfeVOv|}p{+=6r)Y@*(q^RTIcV={dY{$&o z)88zeN8~M54!k%%<6TqnqtsdEWP78FF5bL^4OQFnh1fc09DJ3PC+)bkW~9vn^b6PX z4tfs|G{3=+HF6Td@b0|4Q~nX(&;cWEGJ}7ZSi9|&%NMb z5~Kn&h+1s-ZD<+0`z;WC)Y$~_b)3h1vzIh6esG7{e%{hZf(M8%^plqQTcK*2xf0Ja zZwJx3Uyao%@D5k$NQye$rcc$AIckE7V*%gJqmL$Mvzv+V4b!~oK3VerSSKDy+0=p-R-^qxVr#YTCOM%U0rjhA zxkbq7nvrS^y?2>N{elAgiJ5+4L1ap0Mia4=iI@^hb{mhIL|GQs+csZkTkBdP>51WTn^r2xFOejFgf*7ntx19Qo!33B zbn9iIPcJLw+uk1+trmOs^Z(s(^d@M-MdWR%xhQhCxVQm%%N7g$4Wm{xtZX5EJK3B( z9iR0EvPNPxLFSM0*fUi5Cimp9&=3&t>}@5jrGnYpp;q>zom%(rp9vqg2Y7y3&G& z;DZPFv3%Zc^FoULvH5Fy_9O4SQX+(e^^NyRGPof1Ep~WlyyalCcP=CjVF87LOpG_t zi$Gn_O})x9Hee>Wt^;f9BM0`^vT+!iM1qHjmlV~b^d`KxAOvM3FSqNyJ`^f5=Ol-z z^d{k0QmEOmc7exB_*BBsdWMx%Fq{dn+poQ{5FL(S;3DrFm{c`6LIm6 z!tQ&sUnLLGmAw1Vka5fcwn}<=O6jbXR;R`$pvbjx7L$Ir(EpO>A9qMw@7ffCBQI1r zHQV3X7dOx8gL3(q{?+Rnt6zG(xUomnuE^RG3zJ~hInza}I&Q6Ua%HF?W*9TZ!_Srz zeRK8A@nqyKCTDA+YC(=T*PxhGO9p->Z)III0Yl?hr@kZ>o3EfLBQ&Ag``Mi0x2sDZ z+vDnw2{l~hU}XJIzOS^kro0I;f!rOxLuQvMDQV_#zx3*Uk{DM7ChzW3?i!l&y|QNZ z_s`;BZsFb*hLT4&KScSX3N)~1eb0&P z!@~aRvlz4cuWDy(I8_7KeWQbTTLir{hMbJGCiT%AxUYLKpqma*p_l{}YoPp7{2p?{ z=fg~3YfmJy_Z$O%n^-Fm0B(pWJq24sQ$A|WnbC%M%YZ8D{oYw(vkU{2 z<~K7+WpQCXjthIq+w&oxM~>m6#3JF%vMZ<%noh)hm=pq3zIAfOu^69>lyBZ~<5L7DiY;7$QJ0#4V61etOr zFG}vFlgH3unh1%u+0@#s+KWU851ylr_toWgeWjal@(Z~8psDXUs%f62|_wyOQMNICN0`??mHk45t)ETn{XRBCDwPsN>#mtfl{73}fPxwMKfxU@5eU_~HAp{cQ+}P0^cc`l?^5emue?ED1c6tO!7Z z9LeNOkG#QtTYjnwRK?Z%RhcY2fnp)86#euLoeI1egVcH#l$?iDh$qZ%cB^HK8Gv$; zP`k5&X8dqZUTiyB6tD`;F}mmEf8^%E?6k9{hNsKLWi~#ru8ha6Kq5%2d=>HxLe++w zoVaTmmrfN`at#~pf(vPD$ZdYQJ3rm-KqLqv@26sAaydJ@#tnXLCetEd9UbRle_HV@ zGk^TT4JS&G7S@w@qc_TBh8OnMXeMFJ1Ij|L({AQp67-d+^pm z3JWnYRbf=VQ&N%Svmwi=@bH>h04;L2&_?X7y?u#1D~$OrLG%nwORQUmGw|6YD5?8Lz|Ud;WUV3M%x#@KGF8A zK6q8QGWL_6R>sr$JF)a~HN)l<`3+EL`PdCM@pEyrGvT9|SkI@C z{z5624bgQ(%}sN`3B;|CxK1$`CSxnW!kxYe2mb9m#_}p`m%yuOC6o}OSl?R&>M64BXdNNW%ySKHXv_8@l`lU@-Fs#6v4xD=De6|0vFY{U zOvSGYVMSG`KJUfTNiSP zlKtWL5MlH#oe#Tr&Ie5N9e3)}=V2D&wQi$eJB)q}sta-Y2xu-dg&=6^VdJ%AbV4x5 zQF#W)IVOZ8yIJEW&pA3I{MbCP@lfIzU^dsC$d-ur2efE;4YegAvm9*%KKaL?P9HP& z3$%M(I4NeJ)=o7X@qQ%|Y?30lxh^FmvOZLVwM1!a_1Tv!fr9o2)bF3^#pkvSo)OeR zbvBLy;yPcVf=_C)^>H#qR*D9MyeB$%^lk!=Dgd9F!MgOy2^+5HZODJpbFW}6ubFID z=zR4w8LXMYC9-*=T#FIWW*CUp)1}<%i;xDu)vWzaJ^m>oOhcIs^P= z>nkTNb=Lkj{YS&v@h+iC-o(2r02W#V<04DU!&^+BeM%TP%O*1fFLWM@-9vHPHxQik ztqvWN?#QcH){k**XE+QnHP6GhhB%Ap4@d@f6KPjeC|GU_PRp{3Y?`$8vFmlL#Rs^J zurcE5OwYoK84}zQ#;t$e0;m9Kkna-r!u!nHZS&0R1BeKE)r`0VMMqrwx1jlEyFSr;9-iz)PM zqnGPkO5iP?2*9GG@j!HFO0X{@R}^Q4XPXiPz7uRx@0I5ESh(2SY&)}3vPp#mg($H+ z+!5XI7=WpxAXW5uAfHk~@v^rY5$=Z0=Ufg=c?_q)Bewj$lLiVE?SBZidsUNC>Dw|x zqD+`eE)F+-G0xn@n#7zZLGuh*P8ih`;vfUrJyc&wR{M*S*oHZ+g9q&K!(Z_X>%3$c@w^J_wmznNYw zOOnCrBwEA`)={Dl+FPlit{;41`JhLJMn(B4Ho-@#i@eXucH3Z+W-`?GI9O0z^YM#J zpkh{c%RXglwe7vT9r~;F{L7SMBQGycglZl|#9xe7h54b4z0Tsdd>iPHhyL}F$1ncS z6LXfD0Bj4N&YwLc*Bc9ZeN&{RSXqC1uB6j=rA3eFPmJ0B0;l10G~*m(;1p+dYdJCT zG>OO_dPamp>b1X1sPBppk9LVxg8F_@Y~8rH7!x5*&v79KK>VWb+~fhy)`Vxnwc3%ag-M$@dT1GjQD zo^8C-z`=;|z%+C~kxW1`6%QTxD(0tnd(?%)9Uq5lw)h#+YHW~oAl){x5oBmX*#Vrk zWacHaC}Dk6cGK*!{($lYu6#O~4a7*u6rL6{5ad^LY+GR%rwuwUxX7k>ZRILob4Ko zwQx`cS@fA!T)VKivb9n(+B2@fIajF;25WDhFw>fv)w3levVV=yegY{LJ0DZI^ZMW( z=uS&8CUerB^zG-Bun16rLimNo0iUsAzBJ8=)rA7UcX)4Hh_w8<+vthsW!gE_;$5IZP~I)&+T+jW70qA zAwg=bSv0eWNSwv|s|c)aM$^uWM%yj#w2RXH4Je?bHA-9H25{ZG%iMQkUL{1Hb6zL= z9cRM}Xl&Z675$r6MPeVoAk%wReX6lwPf^A@XGP-9&dHl1KU^Pe^v-+RTg7CN9i!6r zf5iLAkCCBHWktGQ#Xxe3ZcDA5m|jzHEAehqxw=3X)ByB9s9J6FZm`Z*TNSMZ3FJM| z89mnP%_+Un>AzH;0{8m|;mkQSU|E#=MNu51|I5jfrA@L{>Kz z;x8t!g+w=jHAWza*TKN^PKmslHYOxxM2G)@y{wVtmfG_u53Y}>X=1&Q_vPr;?R^l@ zdceBI6mPWT9e+2?t3a>A3RWvZNZ$+0dXgUoE`R#LTct(~aS?-A79q1D8)b}^<+%J^ zbK3r`LE0jkK5&g_<`EF~7KG?Wn^O=}bR`WJ33=KRY7;`age;#}boQ^*G%6NjA3j@A zUJs1;(|?PoJrdj-`cH<^B;6Z?AA>fUbLWn^{|pi1sYPcg~QlM057>%KH8+jD6m+ zlF-T128Vri=A*}7yTGfZ&eo$L!rL?E4opWV=N*!BJHcrI9^FZoZ;^T{EpJXU=*kF7 zqz0sV<%O^TJh894Hr*A6v5PQCGdzLx)Noy(KLo{SfzJ)Nu#rHNqwTyczC7PFDV}J^ zFg=Mjsdc=lEO!M&&Y{k_T#4kfAu#8^eU8;JTS4*oP3UIwI=(t0aa4Z&%96R!=rYD7 z>aK~q&RpzCDxm8=F1lcFn$Bpw3`cwlw}1iIRcb(u3#&u?dFc0!5Wjfp-i>S&?^xRV z%Hca|lvbd`XLm&FGM~(2@Vro)weS%a9+1e(_YF#j>sLSjvMPB?3z=YC(CL$fve^?t zG+y>P3HByl<$QwtS`wcYl9t(kFM;5AzaKaWoh&ai^L#+`z>7ZkRb3>c~aB^pKgGB%mFxTZ%mY;UjFGe&S`j zb;^NwR(V*t8lks#oD{r;Je@loBvR5s|GbDbcR9B9qo!rGnsBUU;jl1xr2YL;%{g7S zdHtGjlzLlO1uDuHwhop=17sy0;{i?fIofUlIlYzLuk1_Wp4Q!{ea?+hXW_t-FTU^$ zQUah4USKAQ^B7&lT!#XROU=f^f)DAkl(y{dav`C07Hx;NWp zjhLYutYMa+9E7+dNVvqmx(iw6bTM8u=TF9Lcxl%H_Xmjp(EvfJkYhrpLLFyaN_FIL? z5p6ElbhmG&r`#Sq_gDMF7q%G_6DLuJ^8@=Vi@6(U_&KzT2*}jjx zQ%}wQ@l1H51K*|mIn~ywdGDUvFSXgybLGaX`sS-FPcClzty0nOE!scVEN!yh=HFml zuem=oIX-BUd$51Q1CNq_*!}p?*0`EU-Rm0M*ZKDwos?wUTx&vdM%$6wPh~EmF5R8D zJ~F#~-pyM-xsAItu)%~FQ(lCbTDz&Rif7G{=2xrF{SkBPYL&vGInhtt&uw+PTrh3I z(19ns>VEdyi2)VW>J6^jtpPu_n(vIMZ1c(Y8aEwTn+`iWNaty9<#*d>$TqLEDMK{n zEj~Hk?A62Swq9$}Djyns&yDqunqu#_rR4;Bm1{efB(L>gnk^|CyU2KZXua8^;*wV7 z1~*^xVb`N6UJa`kwh!=&>9MnSwOvbl{=TGLyVa`(4P807c++s*g7d9A9sOj}{_LK+ zy}x>t`s94;rM1WHxK_pZ`%5GI}pBHqrbXcP%_qsi<(WKwlvggy+P5pH{H|i^X z%f3I(MWmk{-S9@4YK!}ZtUImjvwD91+OLcT;=aGGv{seYJeB`()ZP)hYt86ZHL=Fb`yn@y^Z)+IJZpR0_w92kCJ!vJMh)Fs zEB*1-?1!UH*JQ_Z%Gti5S>*#I5gpdvG)~!)9I-R?<&ixjuW~_^PaZKP&US0^Y{4(~ zYnj6iQ|s*?{r2P0o#lr0E%w$4%&wak_hL}+il^HrZ0?ovJoi)1v&PZmH**5^es0~H z@M{0q1uxwB2Maa7NB=hZ#El~wMa*$DSjHTV0MDxhQPJowFZAo=Sc-@Z7$o z`*v44(_a+(&gg& zyT+D&9TfiI<6+-MwH|obu;Iu>ZAi|){_CS>7k|baIau*-z+0DPQE21xF-|uG^h8WO_VIbuXW6F4P8n*024g=(8tQ^vPa) zSzVHQ_V%6DgJyXTsoMV0ck3RP)fmvd-HgBapJL7w=dBrPaI0FU%fh5D)PESMHK&S~ zuUfP?y;i-J>HWsNAOB16_tXb}<@|lQi?;ea&%5P~o-I?&TpY1?_Vo$2!4*BvTsqaY zd%~EO^Y$)$HtAqs@$>S8g8Z?`ru32_I_pdG@{{vkCLFn!SI~K1m-Z*lG_wrYwB%>= zKgZYPuC%w=*#ByWS+R*P?J4ZF4GSw4-rZNbad&RlQG0GmkI>kF3h%`sX3s_=rq#O~ z{B7b#p4+bv*ppa$)V-%;JO*7Ty?xtMsowKzcOK+7yy$jq)b*dtw@*fV*?w-7_#WTx z+<*R@+VE;-tjGLO4fv8}%;X&ft4mVWd@_7gJM||I!gepRUYq`RVM5~jFH#SZU-~w>@Ax8 z{zvXNhqj+|$wJ7uzQ3&#eVBKYO(L$l)QkR^9x&bIH^F`F$&HHp#LKD%|X)n-Ch;aDsiw zqESzS8qEA*`t~;5?)RDu-*&vn|8a1`RrA+1ifTU1e`v2<6o*nw9_Hb@t#rIdXc?`J06nr&we8&d1`QWw-&eZR2=3h=Oe-Ti*ATU3@ zMbGc@GBX3_Pxf2SXLhSG;K}eS3BP2F4Gr;|oONLRhpUZkBQ~yBX!-WgC{ysOR&BZL zq~Sj|o1FMKy~&Qaj^lz}M#inUd2vhmvBLHDTFv})Vp9EK>RW#gDx^xi+B_U>Up97Y zpX-}#jd>oq_>61A#%jUl+e;5yA#P&payFZw& zjrr5-^oghSzK`r5xufA}PkPz*`r&K(?|sr^+K7Yk$4`z}!M6{6b;7+jTc#QjsQEE$ zPl!jI5nK4v;m^$L#&>I0Gpc^dYPz&xR7HC2FHerU;@N5A!TTxqY5%~Vmxtf+ZT#^^ z=a`DC^$(sKFsJ$!TjP?F9Jc>&qh|E1V_A9bX7gSTX6y2wYYkQ zZcuZfHMd9U2bMeE<}Eg-vls7O`L#H6aHB_G|Hy_!dfx4l(>@_;@!WGG7wRrl?pONP zrIfgiJ;ujOo-&0C`1a!P9d$;8_TF){(Y%?Zm2y_y4<5l6PdDyO-8m~LuyG5`7p0Ti z-5oTgEFphGyT{=THoaO`T4l;~&llIvKQkUp=^sqjyV9mOZKwI`?lrU8emW}n)>Zui z|I`Z`@BC~peK|ArOsl$wzpk_1-tzN~@vSPBPg*jkatqb7m!BMqZQHANHCy(&|6ALv zyk?JBk1OU2EAF+KUtHd}dRXm~LC4ts`r-ZkhL1lR_~gkgpS>{)nw6cO*z!Qq{TiNL zdDl;PJ;`l)BzeSTyU+8ZE6wKj%I=yADh@|&eURrF-tbhx0ej%F`tQvNO9)MD8nbM4 zkFsHXW9P(q?9p|0uk?6QhIM z8@*t>hB#NFuga`4XZKC!ty!jCW*DsThM^k$gn1b@*HjE2*sR5DgK-r+#Td}=3&l7L zEveHmGYqqU`5Q3Z#FUoC!{m+>K8xzg>S6weDlLQJ)UIJ2GDzag5Q;O1-%2w+UN`u| zIkZF={UOdAk%ov!GeN{DA9=i093Xc7byb?;QQ3a{c=jChNy}JZxB8(ER103 zY)ZBD&Y~Ed=%^~kZYV}@RJrR4>_7`tK!BTo31+dp187i}(3qrfCs6iHK#>X*Kv^YF zh<7JY6hE-`Z9vfsntum0F1T%n;1DNJ+SfI&2)3wDDw>6)#Hv>)RgP6!`!=kkL%mC> zo#WdjMSSDLs(TAoNmnih&_kkhIRK+`=~a(_yj`!1M*Xi9+xeU5kmyh+SlZWF5HP(O zB>66^S~L>K>8x_BI{KYh_3Xcf8q+bVV|cI=D*I-rWL&*jt^Wbk*H71aTLS2q*fFkC z96&{>!EQCdU?j)_p+;*TG7A`p;8H6c7E+5dxWwsAZw)T_I44(6@HVvXnh1t_0uf=H zLcOe323XqMTO!Qx@16D?tqhKrh%!#$xvX5l2+TX8j7Bc=ze`_GmE>`TJ~`b11(5=+ zQ2*pbLGZ4B2ll^r2YGSe;DZyd6qqh=An@wR_N$Yz7oP>)rX?F{E9|}#YN2ctE7$>c z-@%j$-I!L;1#~7zCD3jN|6^#8%Fsgjq!>o{EHCd2OJ?~0Od`WbLRev26vGOR25p2S zOf5t!OivRqDTHcCA5sYA-n30dBMFuE%V-55a^|99lr~o|XTbeMr3u=O1>~aE7y(wS zk{PL<=xkdC46_592*rSs@&T#^l(<)ywOqZKMqybK4Bewdac-(0O5Bxm(+)13tb7io z5p#%)6CybGCveh8i4izSJ|=mIgHuPoKY$Z6fsB)4b0Q}xrh=du6Qj%NZ-SBlBLc-r zn-(=7K@`fNLyF|EzO1Z2Rimer$kkF~2lAv`>5wN$5X7m)UAd481dNlEyMU7esT3)4 zPMowWK_LPjdAbn3#n?&}GKk_Fd|t;^0xz<~(Q>54IH$!prNtbY74{ADCWQ@ zlpuVoM9VqNCq|>wr5tQUP9jO2%5b_5m+-XZOG+oOal<+Oa*J(^KdA*6R+?rx~li_7ZYr34lCaC*BDE^vis>392xTmad|Z#B&&nsA#(RV9LGV(k*S0Stp+ zPH6>zFv$0USkQ77hyx?+O^(tjPvok>AR-2@g{Vc` z`wfN^DgrJ~i~*J=GBcrP96gE@jGGjBtXO;Ajt*xh&+~8{2GxO;il?hevO*X;go<|q zAx4`q!va^^!U@53sB-l9KykESLZM?_^}QD#1v8#i30b^jv70J7lQ#zmX_wN9&&kEh zb7xStt+&PM9d9xlskYhXRJg~tn0-|7s0sIu@6A(bR=!_`362zL*=B*G54v$photW9 zqY6R8w&C$eV?6&2WjEP+Q*dFm55$u zSj-gX2kA#+U?s%9tRG8xcjlAX5K8B#@q-}ilWBx&VctmPI3GcDS(nluRN+R07iisR z#}5OS{TfJrX_Siweu#b)G;k(@2H{E2AQ|8^lyL-_*&##6qP|5=V>OWCAadk1^gHqx zoCdF;FdEFDci@v`06z|$WU*(3B!kn?aal<-XwXf%oQC+J9#2k#-v!slX{h5@&>-ic zI|w-q_z9sWr@`+mdijLWICQR4&=@s`uLFKU+EuKhY0luVhg0{oT8G;ME(}oilRpdm zXcXmg8vL$7)f}gxBfEkI{InQmRzn+55m2lH^Wt*hd#w(8mS*%il>g+<0zW*b&_T}IPi^RvF7C|AGhOU9+$7u<_V%4YVQlTX#~Ql8*v zAblK44Y4=14mF&ZTs`WhNJF^Ip>CnmlVTkM7X;)w9j*fieI1e8 z!QwyHZU34d)T&LC& z`GtWtiol}Pp{oh`vtT0wdch&5L4DH`xtP&w(AiSCPOC@nZj>~=mfVM4hsPk2LD(FQ z14NGm=b+bMF%Wr@rS)W;0q4c`3mp>un))kT*(mk_CmcfefRCt`Kq2(PvU+kK3`fK- zcni_f0FB58EGL|jmH0SDhuZ_{KG_RsIHC?haU|lL<-mzBTSB!YY823j8o=sVQU`hn zb%LK7?~7>`@-7zpkc+j1kHb2`4?ukcjWy_qn!@Ti(&h#Ojt|sA6ZI1QNhu=daL|_E ze#OxYAs6}xqCeo^+=jlxen@)8eMNFe1iipnC@Ynp70kAe()Rt zB)sO)K*ReXpy|-dAf;R|FM$Q}8is}DpnTvto71S#%TgsjjRD^;&1pGwX`o!E)ev#1 zWwpflNXr_C^MYPa)(?nYe7|ryGT=22&fsd?Mv%s}c&$YzN&LLUXg~<2KXfX?&nb*f zP2=ZPph1#Q>Hz*qP=_vX<$3|cG`e|~)8JsB#d}9cIpq0Qts{C&h!2M7X&{y0`3h2m z2E8m*$kjl)!s-^RBlH4C4O)w1hEpCXg9T0FGFY%WL4!m@(1@A`odAvgI8BKef}ePn zWASqyJj>$#0yMSUMmDPv{+QG177#$G;!JtGaOt6nwOHVf1jL(b_;XZqngu?=?$IAi zvcM8g++(E{XfCG9OwW5 literal 0 HcmV?d00001 diff --git a/inst/doc/modelsum.R b/inst/doc/modelsum.R new file mode 100644 index 0000000..1ff4c13 --- /dev/null +++ b/inst/doc/modelsum.R @@ -0,0 +1,405 @@ +## ---- echo=FALSE, message=FALSE, results='hide', warning=FALSE----------- +require(knitr) +require(broom) +require(gam) +require(MASS) +require(pROC) +require(rpart) + +opts_chunk$set(comment = NA, echo=TRUE, prompt=TRUE ,collapse=TRUE) + +#vignette: > +# %\VignetteIndexEntry{modelsum} +# %\VignetteEngine{knitr::rmarkdown} +# \usepackage[utf8]{inputenc} + +## ---- load-data---------------------------------------------------------- +require(arsenal) +data(mockstudy) # load data +dim(mockstudy) # look at how many subjects and variables are in the dataset +# help(mockstudy) # learn more about the dataset and variables +str(mockstudy) # quick look at the data + +## ----simple1------------------------------------------------------------- +tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) + +## ----simple-text--------------------------------------------------------- +summary(tab1, text=TRUE) + +## ----simple-markdown, results='asis'------------------------------------- +summary(tab1) + +## ----adjust, results="asis"---------------------------------------------- +tab2 <- modelsum(alk.phos ~ arm + ps + hgb, adjust= ~age + sex, data=mockstudy) +summary(tab2) + +## ------------------------------------------------------------------------ +fit <- lm(alk.phos ~ arm + age + sex, data=mockstudy) +summary(fit) +plot(fit) + +## ------------------------------------------------------------------------ +require(MASS) +boxcox(fit) + +## ------------------------------------------------------------------------ +fit2 <- lm(log(alk.phos) ~ arm + age + sex, data=mockstudy) +summary(fit2) +plot(fit2) + +## ------------------------------------------------------------------------ +require(gam) +fit3 <- lm(log(alk.phos) ~ arm + ns(age, df=2) + sex, data=mockstudy) + +# test whether there is a difference between models +anova(fit2,fit3) + +# look at functional form of age +termplot(fit3, term=2, se=T, rug=T) + +## ------------------------------------------------------------------------ +tmp <- tidy(fit3) # coefficients, p-values +class(tmp) +tmp + +glance(fit3) + +## ---- results="asis"----------------------------------------------------- +ms.logy <- modelsum(log(alk.phos) ~ arm + ps + hgb, data=mockstudy, adjust= ~age + sex, + family=gaussian, + gaussian.stats=c("estimate","CI.lower.estimate","CI.upper.estimate","p.value")) +summary(ms.logy) + +## ------------------------------------------------------------------------ +boxplot(age ~ mdquality.s, data=mockstudy, ylab=attr(mockstudy$age,'label'), xlab='mdquality.s') + +fit <- glm(mdquality.s ~ age + sex, data=mockstudy, family=binomial) +summary(fit) + +# create Odd's ratio w/ confidence intervals +tmp <- data.frame(summary(fit)$coef) +tmp + +tmp$OR <- round(exp(tmp[,1]),2) +tmp$lower.CI <- round(exp(tmp[,1] - 1.96* tmp[,2]),2) +tmp$upper.CI <- round(exp(tmp[,1] + 1.96* tmp[,2]),2) +names(tmp)[4] <- 'P-value' + +kable(tmp[,c('OR','lower.CI','upper.CI','P-value')]) + +# Assess the predictive ability of the model + +# code using the pROC package +require(pROC) +pred <- predict(fit, type='response') +tmp <- pROC::roc(mockstudy$mdquality.s[!is.na(mockstudy$mdquality.s)]~ pred, plot=TRUE, percent=TRUE) +tmp$auc + + +## ------------------------------------------------------------------------ +tidy(fit, exp=T, conf.int=T) # coefficients, p-values, conf.intervals + +glance(fit) # model summary statistics + +## ---- results="asis"----------------------------------------------------- +summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial)) + +fitall <- modelsum(mdquality.s ~ age, data=mockstudy, family=binomial, + binomial.stats=c("Nmiss2","OR","p.value")) +summary(fitall) + +## ----survival------------------------------------------------------------ +require(survival) + +# multivariable model with all 3 terms +fit <- coxph(Surv(fu.time, fu.stat) ~ age + sex + arm, data=mockstudy) +summary(fit) + +# check proportional hazards assumption +fit.z <- cox.zph(fit) +fit.z +plot(fit.z[1], resid=FALSE) # makes for a cleaner picture in this case +abline(h=coef(fit)[1], col='red') + +# check functional form for age using pspline (penalized spline) +# results are returned for the linear and non-linear components +fit2 <- coxph(Surv(fu.time, fu.stat) ~ pspline(age) + sex + arm, data=mockstudy) +fit2 + +# plot smoothed age to visualize why significant +termplot(fit2, se=T, terms=1) +abline(h=0) + +# The c-statistic comes out in the summary of the fit +summary(fit2)$concordance + +# It can also be calculated using the survConcordance function +survConcordance(Surv(fu.time, fu.stat) ~ predict(fit2), data=mockstudy) + +## ------------------------------------------------------------------------ +tidy(fit) # coefficients, p-values + +glance(fit) # model summary statistics + +## ----results="asis"------------------------------------------------------ +##Note: You must use quotes when specifying family="survival" +## family=survival will not work +summary(modelsum(Surv(fu.time, fu.stat) ~ arm, + adjust=~age + sex, data=mockstudy, family="survival")) + +##Note: the pspline term is not working yet +#summary(modelsum(Surv(fu.time, fu.stat) ~ arm, +# adjust=~pspline(age) + sex, data=mockstudy, family='survival')) + +## ----poisson------------------------------------------------------------- +require(rpart) ##just to get access to solder dataset +data(solder) +hist(solder$skips) + +fit <- glm(skips ~ Opening + Solder + Mask , data=solder, family=poisson) +anova(fit, test='Chi') +summary(fit) + +## ------------------------------------------------------------------------ +1-pchisq(fit$deviance, fit$df.residual) + +## ------------------------------------------------------------------------ +fit2 <- glm(skips ~ Opening + Solder + Mask, data=solder, family=quasipoisson) +summary(fit2) + +## ------------------------------------------------------------------------ +tidy(fit) # coefficients, p-values + +glance(fit) # model summary statistics + +## ----results='asis'------------------------------------------------------ +summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="quasipoisson")) +summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="poisson")) + +## ------------------------------------------------------------------------ +# add .01 to the follow-up time (.01*1 day) in order to keep everyone in the analysis +fit <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, data=mockstudy, family=poisson) +summary(fit) +1-pchisq(fit$deviance, fit$df.residual) + +coef(coxph(Surv(fu.time,fu.stat) ~ age + sex + arm, data=mockstudy)) +coef(fit)[-1] + +# results from the Poisson model can then be described as risk ratios (similar to the hazard ratio) +exp(coef(fit)[-1]) + +# As before, we can model the dispersion which alters the standard error +fit2 <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, + data=mockstudy, family=quasipoisson) +summary(fit2) + +## ------------------------------------------------------------------------ +tidy(fit) ##coefficients, p-values + +glance(fit) ##model summary statistics + +## ----results="asis", eval=TRUE------------------------------------------- +summary(modelsum(fu.stat ~ age, adjust=~offset(log(fu.time+.01))+ sex + arm, + data=mockstudy, family=poisson)) + + +## ---- results='asis'----------------------------------------------------- +mycontrols <- modelsum.control(gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"), + show.adjust=FALSE, show.intercept=FALSE) +tab2 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy, control=mycontrols) +summary(tab2) + +## ---- results='asis'----------------------------------------------------- +tab3 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy, + gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"), + show.intercept=FALSE, show.adjust=FALSE) +summary(tab3) + +## ----check-labels-------------------------------------------------------- +## Look at one variable's label +attr(mockstudy$age,'label') + +## See all the variables with a label +unlist(lapply(mockstudy,'attr','label')) + +## or +cbind(sapply(mockstudy,attr,'label')) + +## ----add-label, results='asis'------------------------------------------- +attr(mockstudy$age,'label') <- 'Age, yrs' + +tab1 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy) +summary(tab1) + +## ---- results='asis'----------------------------------------------------- +mylabels <- list(sexFemale = "Female", age ="Age, yrs") +summary(tab1, labelTranslations = mylabels) + +## ---- eval=TRUE---------------------------------------------------------- +labels(tab1) +labels(tab1) <- c(sexFemale="Female", age="Baseline Age (yrs)") +labels(tab1) + +## ---- results='asis'----------------------------------------------------- +summary(tab1) + +## ---- results='asis'----------------------------------------------------- +summary(modelsum(age~mdquality.s+sex, data=mockstudy), show.intercept=FALSE) + +## ---- results='asis'----------------------------------------------------- +summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial), + show.adjust=FALSE) + +## ---- results='asis'----------------------------------------------------- +# create a vector specifying the variable names +myvars <- names(mockstudy) + +# select the 8th through the 12th +# paste them together, separated by the + sign +RHS <- paste(myvars[8:12], collapse="+") +RHS + +# create a formula using the as.formula function +as.formula(paste('mdquality.s ~ ', RHS)) + +# use the formula in the modelsum function +summary(modelsum(as.formula(paste('mdquality.s ~', RHS)), family=binomial, data=mockstudy)) + +## ---- results='asis'----------------------------------------------------- +## The formulize function does the paste and as.formula steps +tmp <- formulize('mdquality.s',myvars[8:10]) +tmp + +## More complex formulas could also be written using formulize +tmp2 <- formulize('mdquality.s',c('ps','hgb','sqrt(bmi)')) + +## use the formula in the modelsum function +summary(modelsum(tmp, data=mockstudy, family=binomial)) + +## ------------------------------------------------------------------------ +newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(age,sex, bmi:alk.phos)) +dim(mockstudy) +table(mockstudy$arm) +dim(newdata) +names(newdata) + +## ---- results='asis'----------------------------------------------------- +summary(modelsum(alk.phos ~ ., data=newdata)) + +## ---- results='asis', eval=TRUE------------------------------------------ +summary(modelsum(log(alk.phos) ~ sex + ps + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy)) +summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset = age>50 & bmi<24, data=mockstudy)) +summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset=1:30, data=mockstudy)) + +## ------------------------------------------------------------------------ +## create a variable combining the levels of mdquality.s and sex +with(mockstudy, table(interaction(mdquality.s,sex))) + +## ---- results='asis'----------------------------------------------------- +summary(modelsum(age ~ interaction(mdquality.s,sex), data=mockstudy)) + +## ---- results='asis'----------------------------------------------------- +summary(modelsum(arm=="F: FOLFOX" ~ I(age/10) + log(bmi) + mdquality.s, + data=mockstudy, family=binomial)) + +## ---- results='asis'----------------------------------------------------- +mytab <- modelsum(bmi ~ sex + alk.phos + age, data=mockstudy) +mytab2 <- mytab[c('age','sex','alk.phos')] +summary(mytab2) +summary(mytab[c('age','sex')]) +summary(mytab[c(3,1)]) + +## ---- results="asis"----------------------------------------------------- +## demographics +tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) +## lab data +tab2 <- modelsum(mdquality.s ~ hgb + alk.phos, data=mockstudy, family=binomial) + +tab12 <- merge(tab1,tab2) +class(tab12) + +##ERROR: The merge works, but not the summary +#summary(tab12) + +## ---- results='asis'----------------------------------------------------- +t1 <- modelsum(bmi ~ sex + age, data=mockstudy) +summary(t1, title='Demographics') + +## ------------------------------------------------------------------------ +## look at how many missing values there are for each variable +apply(is.na(mockstudy),2,sum) + +## ---- results='asis'----------------------------------------------------- +## Show how many subjects have each variable (non-missing) +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("N","estimate")))) + +## Always list the number of missing values +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("Nmiss2","estimate")))) + +## Only show the missing values if there are some (default) +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("Nmiss","estimate")))) + +## Don't show N at all +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("estimate")))) + +## ---- results='asis'----------------------------------------------------- +summary(modelsum(bmi ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2) + +## ------------------------------------------------------------------------ +format(pi, digits=1) +format(pi, digits=3) +format(pi, digits=4) +format(pi*10, digits=4) +format(pi*100, digits=4) +format(pi*100, nsmall=4) +format(pi*100, nsmall=2, digits=4) + +## ------------------------------------------------------------------------ +mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE) + +## create weights based on agegp and sex distribution +tab1 <- with(mockstudy,table(agegp, sex)) +tab1 +tab2 <- with(mockstudy, table(agegp, sex, arm)) +gpwts <- rep(tab1, length(unique(mockstudy$arm)))/tab2 + +## apply weights to subjects +index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(arm)))) +mockstudy$wts <- gpwts[index] + +## show weights by treatment arm group +tapply(mockstudy$wts,mockstudy$arm, summary) + +## ----results='asis', warning=FALSE--------------------------------------- +mockstudy$newvarA <- as.numeric(mockstudy$arm=='A: IFL') +tab1 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), + family=binomial) +summary(tab1, title='No Case Weights used') + +tab2 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), + weights=wts, family=binomial) +summary(tab2, title='Case Weights used') + +## ------------------------------------------------------------------------ +summary(tab2, text=T) +tmp <- as.data.frame(tab2) +tmp +# write.csv(tmp, '/my/path/here/mymodel.csv') + +## ------------------------------------------------------------------------ +## write to an HTML document +# write2html(tab2, "~/ibm/trash.html") + +## write to a Word document +# write2word(tab2, "~/ibm/trash.doc", title="My table in Word") + +## ------------------------------------------------------------------------ +args(modelsum.control) + +## ------------------------------------------------------------------------ +args(arsenal:::summary.modelsum) + diff --git a/inst/doc/modelsum.Rmd b/inst/doc/modelsum.Rmd new file mode 100644 index 0000000..03dc754 --- /dev/null +++ b/inst/doc/modelsum.Rmd @@ -0,0 +1,878 @@ +--- +title: "The modelsum function" +author: "Beth Atkinson, Pat Votruba, Jason Sinnwell, Shannon McDonnell and Greg Dougherty" +date: '`r format(Sys.time(),"%d %B, %Y")`' +output: + html_document: + toc: yes + toc_depth: '3' + pdf_document: + toc: yes + toc_depth: 3 + word_document: + toc: yes + toc_depth: '3' +vignette: | + %\VignetteIndexEntry{The modelsum function} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +```{r, echo=FALSE, message=FALSE, results='hide', warning=FALSE} +require(knitr) +require(broom) +require(gam) +require(MASS) +require(pROC) +require(rpart) + +opts_chunk$set(comment = NA, echo=TRUE, prompt=TRUE ,collapse=TRUE) + +#vignette: > +# %\VignetteIndexEntry{modelsum} +# %\VignetteEngine{knitr::rmarkdown} +# \usepackage[utf8]{inputenc} +``` + + +Introduction +============= + +Very often we are asked to summarize model results from multiple fits into a nice table. +The endpoint might be of different types (e.g., survival, case/control, continuous) and there +may be several independent variables that we want to examine univariately or adjusted for certain +variables such as age and sex. Locally, the SAS macros `%modelsum`, `%glmuniv`, and `%logisuni` +were written to create such summary tables. With the increasing interest in R, we have developed the +function `modelsum` to create similar tables within the R environment. + +In developing the `modelsum` function, the goal was to bring the best features of these macros into an R function. +However, the task was not simply to duplicate all the functionality, but rather to make use of R's strengths +(modeling, method dispersion, flexibility in function definition and output format) and make a tool that fits +the needs of R users. Additionally, the results needed to fit within the general reproducible research framework +so the tables could be displayed within an R markdown report. + +This report provides step-by-step directions for using the functions associated with `modelsum`. +All functions presented here are available within the `arsenal` package. An assumption is made that users +are somewhat familiar with R markdown documents. For those who are new to the topic, a good initial +resource is available at [rmarkdown.rstudio.com](rmarkdown.rstudio.com). + +Simple Example +================ + +The first step when using the `modelsum` function is to load the `arsenal` package. All the examples in this report +use a dataset called `mockstudy` made available by Paul Novotny which includes a variety of types of variables +(character, numeric, factor, ordered factor, survival) to use as examples. + +```{r, load-data} +require(arsenal) +data(mockstudy) # load data +dim(mockstudy) # look at how many subjects and variables are in the dataset +# help(mockstudy) # learn more about the dataset and variables +str(mockstudy) # quick look at the data +``` + +To create a simple linear regression table (the default), use a formula statement to specify the variables +that you want summarized. The example below predicts BMI with the variables sex and age. + +```{r simple1} +tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) +``` + +If you want to take a quick look at the table, you can use `summary` on your modelsum object and the table will +print out as text in your R console window. If you use `summary` without any options you will see a number of +$\ $ statements which translates to "space" in HTML. + +### Pretty text version of table + +If you want a nicer version in your console window then adding the `text=TRUE` option. + +```{r simple-text} +summary(tab1, text=TRUE) +``` + +### Pretty Rmarkdown version of table + +In order for the report to look nice within an R markdown (knitr) report, you just need to specify +`results="asis"` when creating the r chunk. This changes the layout slightly (compresses it) and bolds +the variable names. The three single quotes are often located above the tab key. + +`r ''` ```{r results="asis"} + + summary(tab1) + +``` + +```{r simple-markdown, results='asis'} +summary(tab1) +``` + +### Add an adjustor to the model + +The argument `adjust` allows the user to indicate that all the variables should be adjusted for these terms. + +```{r adjust, results="asis"} +tab2 <- modelsum(alk.phos ~ arm + ps + hgb, adjust= ~age + sex, data=mockstudy) +summary(tab2) +``` + + +Models for each endpoint type +================================== + +To make sure the correct model is run you need to specify "family". The options available right +now are : gaussian, binomial, survival, and poisson. If there is enough interest, additional models can be added. + +Gaussian +----------- + +### fit and summarize linear regression model + +Look at whether there is any evidence that AlkPhos values vary by study arm after adjusting for sex and age (assuming a linear age relationship). + +```{r} +fit <- lm(alk.phos ~ arm + age + sex, data=mockstudy) +summary(fit) +plot(fit) +``` + +The results suggest that the endpoint may need to be transformed. Calculating the Box-Cox transformation suggests a log transformation. + +```{r} +require(MASS) +boxcox(fit) +``` + +```{r} +fit2 <- lm(log(alk.phos) ~ arm + age + sex, data=mockstudy) +summary(fit2) +plot(fit2) +``` + +Finally, look to see whether there there is a non-linear relationship with age. + +```{r} +require(gam) +fit3 <- lm(log(alk.phos) ~ arm + ns(age, df=2) + sex, data=mockstudy) + +# test whether there is a difference between models +anova(fit2,fit3) + +# look at functional form of age +termplot(fit3, term=2, se=T, rug=T) +``` + +In this instance it looks like there isn't enough evidence to say that the relationship is non-linear. + +### extract data using the `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tmp <- tidy(fit3) # coefficients, p-values +class(tmp) +tmp + +glance(fit3) +``` + +### create a summary table using modelsum + +```{r, results="asis"} +ms.logy <- modelsum(log(alk.phos) ~ arm + ps + hgb, data=mockstudy, adjust= ~age + sex, + family=gaussian, + gaussian.stats=c("estimate","CI.lower.estimate","CI.upper.estimate","p.value")) +summary(ms.logy) +``` + +Binomial +---------- + +### fit and summarize logistic regression model + +```{r} +boxplot(age ~ mdquality.s, data=mockstudy, ylab=attr(mockstudy$age,'label'), xlab='mdquality.s') + +fit <- glm(mdquality.s ~ age + sex, data=mockstudy, family=binomial) +summary(fit) + +# create Odd's ratio w/ confidence intervals +tmp <- data.frame(summary(fit)$coef) +tmp + +tmp$OR <- round(exp(tmp[,1]),2) +tmp$lower.CI <- round(exp(tmp[,1] - 1.96* tmp[,2]),2) +tmp$upper.CI <- round(exp(tmp[,1] + 1.96* tmp[,2]),2) +names(tmp)[4] <- 'P-value' + +kable(tmp[,c('OR','lower.CI','upper.CI','P-value')]) + +# Assess the predictive ability of the model + +# code using the pROC package +require(pROC) +pred <- predict(fit, type='response') +tmp <- pROC::roc(mockstudy$mdquality.s[!is.na(mockstudy$mdquality.s)]~ pred, plot=TRUE, percent=TRUE) +tmp$auc + +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit, exp=T, conf.int=T) # coefficients, p-values, conf.intervals + +glance(fit) # model summary statistics +``` + +### create a summary table using modelsum + +```{r, results="asis"} +summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial)) + +fitall <- modelsum(mdquality.s ~ age, data=mockstudy, family=binomial, + binomial.stats=c("Nmiss2","OR","p.value")) +summary(fitall) +``` + + +Survival +--------- + +### fit and summarize a Cox regression model + +```{r survival} +require(survival) + +# multivariable model with all 3 terms +fit <- coxph(Surv(fu.time, fu.stat) ~ age + sex + arm, data=mockstudy) +summary(fit) + +# check proportional hazards assumption +fit.z <- cox.zph(fit) +fit.z +plot(fit.z[1], resid=FALSE) # makes for a cleaner picture in this case +abline(h=coef(fit)[1], col='red') + +# check functional form for age using pspline (penalized spline) +# results are returned for the linear and non-linear components +fit2 <- coxph(Surv(fu.time, fu.stat) ~ pspline(age) + sex + arm, data=mockstudy) +fit2 + +# plot smoothed age to visualize why significant +termplot(fit2, se=T, terms=1) +abline(h=0) + +# The c-statistic comes out in the summary of the fit +summary(fit2)$concordance + +# It can also be calculated using the survConcordance function +survConcordance(Surv(fu.time, fu.stat) ~ predict(fit2), data=mockstudy) +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit) # coefficients, p-values + +glance(fit) # model summary statistics +``` + +### create a summary table using modelsum + +```{r results="asis"} +##Note: You must use quotes when specifying family="survival" +## family=survival will not work +summary(modelsum(Surv(fu.time, fu.stat) ~ arm, + adjust=~age + sex, data=mockstudy, family="survival")) + +##Note: the pspline term is not working yet +#summary(modelsum(Surv(fu.time, fu.stat) ~ arm, +# adjust=~pspline(age) + sex, data=mockstudy, family='survival')) +``` + + +Poisson +-------- + +Poisson regression is useful when predicting an outcome variable representing counts. +It can also be useful when looking at survival data. Cox models and Poisson models are very closely +related and survival data can be summarized using Poisson regression. If you have overdispersion (see +if the residual deviance is much larger than degrees of freedom), you may want to use `quasipoisson()` +instead of `poisson()`. Some of these diagnostics need to be done outside of `modelsum`. + +### Example 1: fit and summarize a Poisson regression model + +For the first example, use the solder dataset available in the `rpart` package. The endpoint `skips` has a definite Poisson look. + +```{r poisson} +require(rpart) ##just to get access to solder dataset +data(solder) +hist(solder$skips) + +fit <- glm(skips ~ Opening + Solder + Mask , data=solder, family=poisson) +anova(fit, test='Chi') +summary(fit) +``` + +Overdispersion is when the Residual deviance is larger than the degrees of freedom. This can be tested, approximately using the following code. The goal is to have a p-value that is $>0.05$. + +```{r} +1-pchisq(fit$deviance, fit$df.residual) +``` + +One possible solution is to use the quasipoisson family instead of the poisson family. This adjusts for the overdispersion. + +```{r} +fit2 <- glm(skips ~ Opening + Solder + Mask, data=solder, family=quasipoisson) +summary(fit2) +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit) # coefficients, p-values + +glance(fit) # model summary statistics +``` + + +### create a summary table using modelsum + +```{r results='asis'} +summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="quasipoisson")) +summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="poisson")) +``` + +### Example 2: fit and summarize a Poisson regression model + +This second example uses the survival endpoint available in the `mockstudy` dataset. There is a close +relationship between survival and Poisson models, and often it is easier to fit the model using Poisson +regression, especially if you want to present absolute risk. + +```{r} +# add .01 to the follow-up time (.01*1 day) in order to keep everyone in the analysis +fit <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, data=mockstudy, family=poisson) +summary(fit) +1-pchisq(fit$deviance, fit$df.residual) + +coef(coxph(Surv(fu.time,fu.stat) ~ age + sex + arm, data=mockstudy)) +coef(fit)[-1] + +# results from the Poisson model can then be described as risk ratios (similar to the hazard ratio) +exp(coef(fit)[-1]) + +# As before, we can model the dispersion which alters the standard error +fit2 <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, + data=mockstudy, family=quasipoisson) +summary(fit2) +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit) ##coefficients, p-values + +glance(fit) ##model summary statistics +``` + + +### create a summary table using modelsum + +Remember that the result from `modelsum` is different from the `fit` above. The `modelsum` +summary shows the results for `age + offset(log(fu.time+.01))` then `sex + offset(log(fu.time+.01))` +instead of `age + sex + arm + offset(log(fu.time+.01))`. + +```{r results="asis", eval=TRUE} +summary(modelsum(fu.stat ~ age, adjust=~offset(log(fu.time+.01))+ sex + arm, + data=mockstudy, family=poisson)) + +``` + + +Additional Examples +==================== + +Here are multiple examples showing how to use some of the different options. + +###1. Change summary statistics globally + +There are standard settings for each type of model regarding what information is summarized in the table. +This behavior can be modified using the modelsum.control function. In fact, you can save your standard +settings and use that for future tables. + + +```{r, results='asis'} +mycontrols <- modelsum.control(gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"), + show.adjust=FALSE, show.intercept=FALSE) +tab2 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy, control=mycontrols) +summary(tab2) +``` + +You can also change these settings directly in the modelsum call. + +```{r, results='asis'} +tab3 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy, + gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"), + show.intercept=FALSE, show.adjust=FALSE) +summary(tab3) +``` + +###2. Add labels to independent variables + +In the above example, age is shown with a label (Age in Years), but sex is listed "as is". +This is because the data was created in SAS and in the SAS dataset, age had a label but sex did not. +The label is stored as an attribute within R. + +```{r check-labels} +## Look at one variable's label +attr(mockstudy$age,'label') + +## See all the variables with a label +unlist(lapply(mockstudy,'attr','label')) + +## or +cbind(sapply(mockstudy,attr,'label')) +``` + +If you want to add labels to other variables, there are a couple of options. First, you could add labels to the variables in your dataset. + +```{r add-label, results='asis'} +attr(mockstudy$age,'label') <- 'Age, yrs' + +tab1 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy) +summary(tab1) +``` + +Another option is to add labels after you have created the table + +```{r, results='asis'} +mylabels <- list(sexFemale = "Female", age ="Age, yrs") +summary(tab1, labelTranslations = mylabels) +``` + +Alternatively, you can check the variable labels and manipulate them with a function called labels, which works on the tableby object. + +```{r, eval=TRUE} +labels(tab1) +labels(tab1) <- c(sexFemale="Female", age="Baseline Age (yrs)") +labels(tab1) +``` + +```{r, results='asis'} +summary(tab1) +``` + +###2. Don't show intercept values + +```{r, results='asis'} +summary(modelsum(age~mdquality.s+sex, data=mockstudy), show.intercept=FALSE) +``` + +###3. Don't show results for adjustment variables + +```{r, results='asis'} +summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial), + show.adjust=FALSE) +``` + +###4. Summarize multiple variables without typing them out + +Often one wants to summarize a number of variables. Instead of typing by hand each individual variable, +an alternative approach is to create a formula using the `paste` command with the `collapse="+"` option. + +```{r, results='asis'} +# create a vector specifying the variable names +myvars <- names(mockstudy) + +# select the 8th through the 12th +# paste them together, separated by the + sign +RHS <- paste(myvars[8:12], collapse="+") +RHS + +# create a formula using the as.formula function +as.formula(paste('mdquality.s ~ ', RHS)) + +# use the formula in the modelsum function +summary(modelsum(as.formula(paste('mdquality.s ~', RHS)), family=binomial, data=mockstudy)) +``` + +These steps can also be done using the `formulize` function. + +```{r, results='asis'} +## The formulize function does the paste and as.formula steps +tmp <- formulize('mdquality.s',myvars[8:10]) +tmp + +## More complex formulas could also be written using formulize +tmp2 <- formulize('mdquality.s',c('ps','hgb','sqrt(bmi)')) + +## use the formula in the modelsum function +summary(modelsum(tmp, data=mockstudy, family=binomial)) +``` + + +###5. Subset the dataset used in the analysis + +Here are two ways to get the same result (limit the analysis to subjects age>50 and in the F: FOLFOX treatment group). + +* The first approach uses the subset function applied to the dataset `mockstudy`. +This example also selects a subset of variables. The `modelsum` function is then applied to this subsetted data. + + +```{r} +newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(age,sex, bmi:alk.phos)) +dim(mockstudy) +table(mockstudy$arm) +dim(newdata) +names(newdata) +``` + +```{r, results='asis'} +summary(modelsum(alk.phos ~ ., data=newdata)) +``` + +* The second approach does the same analysis but uses the subset +argument within `modelsum` to subset the data. + +```{r, results='asis', eval=TRUE} +summary(modelsum(log(alk.phos) ~ sex + ps + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy)) +summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset = age>50 & bmi<24, data=mockstudy)) +summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset=1:30, data=mockstudy)) +``` + +###6. Create combinations of variables on the fly + +```{r} +## create a variable combining the levels of mdquality.s and sex +with(mockstudy, table(interaction(mdquality.s,sex))) +``` + +```{r, results='asis'} +summary(modelsum(age ~ interaction(mdquality.s,sex), data=mockstudy)) +``` + +###9. Transform variables on the fly + +Certain transformations need to be surrounded by `I()` so that R knows to treat it as a variable +transformation and not some special model feature. If the transformation includes any of the +symbols `/ - + ^ *` then surround the new variable by `I()`. + + +```{r, results='asis'} +summary(modelsum(arm=="F: FOLFOX" ~ I(age/10) + log(bmi) + mdquality.s, + data=mockstudy, family=binomial)) +``` + + +###10. Change the ordering of the variables or delete a variable + +```{r, results='asis'} +mytab <- modelsum(bmi ~ sex + alk.phos + age, data=mockstudy) +mytab2 <- mytab[c('age','sex','alk.phos')] +summary(mytab2) +summary(mytab[c('age','sex')]) +summary(mytab[c(3,1)]) +``` + +###11. Merge two modelsum objects together + +It is possible to combine two modelsum objects so that they print out together, however you need to pay +attention to the columns that are being displayed. It is easier to combine two models of the same +family (such as two sets of linear models). If you want to combine linear and logistic model results +then you would want to display the beta coefficients for the logistic model. + +```{r, results="asis"} +## demographics +tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) +## lab data +tab2 <- modelsum(mdquality.s ~ hgb + alk.phos, data=mockstudy, family=binomial) + +tab12 <- merge(tab1,tab2) +class(tab12) + +##ERROR: The merge works, but not the summary +#summary(tab12) +``` + +###12. Add a title to the table + +When creating a pdf the tables are automatically numbered and the title appears below the table. +In Word and HTML, the titles appear un-numbered and above the table. + +```{r, results='asis'} +t1 <- modelsum(bmi ~ sex + age, data=mockstudy) +summary(t1, title='Demographics') +``` + +###13. Modify how missing values are treated + +Depending on the report you are writing you have the following options: + +* Use all values available for each variable +* Use only those subjects who have measurements available for all the variables + +```{r} +## look at how many missing values there are for each variable +apply(is.na(mockstudy),2,sum) +``` + +```{r, results='asis'} +## Show how many subjects have each variable (non-missing) +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("N","estimate")))) + +## Always list the number of missing values +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("Nmiss2","estimate")))) + +## Only show the missing values if there are some (default) +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("Nmiss","estimate")))) + +## Don't show N at all +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("estimate")))) +``` + +###14. Modify the number of digits used + +Within modelsum.control function there are 4 options for controlling the number of significant digits shown. + +* digits: controls the number of significant digits (counting both before and after the decimal point) for continuous variables +* nsmall: controls the number of digits after the decimal point for the beta and standard error +* nsmall.ratio: controls the number of digits for the ratio statistics (OR, HR, RR), default=2 +* digits.test: controls the number of digits after the decimal point for p-values (default=3) + +```{r, results='asis'} +summary(modelsum(bmi ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2) +``` + +It is important to understand how R treats the `digits` argument. Here are some summaries for +the variable `pi`. Note that with 4 digits, the number after the decimal point changes after +multiplying pi by 10 or 100. However, the `nsmall` option specifies the number of values after +the decimal point. The two can be used together (see the help file for `format` for more details on how that works). + +```{r} +format(pi, digits=1) +format(pi, digits=3) +format(pi, digits=4) +format(pi*10, digits=4) +format(pi*100, digits=4) +format(pi*100, nsmall=4) +format(pi*100, nsmall=2, digits=4) +``` + +###15. Use case-weights in the models + +Occasionally it is of interest to fit models using case weights. +The `modelsum` function allows you to pass on the weights to the models and it will do the appropriate fit. + +```{r} +mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE) + +## create weights based on agegp and sex distribution +tab1 <- with(mockstudy,table(agegp, sex)) +tab1 +tab2 <- with(mockstudy, table(agegp, sex, arm)) +gpwts <- rep(tab1, length(unique(mockstudy$arm)))/tab2 + +## apply weights to subjects +index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(arm)))) +mockstudy$wts <- gpwts[index] + +## show weights by treatment arm group +tapply(mockstudy$wts,mockstudy$arm, summary) +``` + +```{r results='asis', warning=FALSE} +mockstudy$newvarA <- as.numeric(mockstudy$arm=='A: IFL') +tab1 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), + family=binomial) +summary(tab1, title='No Case Weights used') + +tab2 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), + weights=wts, family=binomial) +summary(tab2, title='Case Weights used') +``` + +###16. Use `modelsum` within an Sweave document + +For those users who wish to create tables within an Sweave document, the following code seems to work. + +``` +\documentclass{article} + +\usepackage{longtable} +\usepackage{pdfpages} + +\begin{document} + +\section{Read in Data} +<>= +require(arsenal) +require(knitr) +require(rmarkdown) +data(mockstudy) + +tab1 <- modelsum(bmi~sex+age, data=mockstudy) +@ + +\section{Convert Summary.modelsum to LaTeX} +<>= +capture.output(summary(tab1), file="Test.md") + +## Convert R Markdown Table to LaTeX +render("Test.md", pdf_document(keep_tex=TRUE)) +@ + +\includepdf{Test.pdf} + +\end{document} +``` +###17. Export `modelsum` results to a .CSV file + +When looking at multiple variables it is sometimes useful to export the results to a csv file. +The `as.data.frame` function creates a data frame object that can be exported or further manipulated within R. + + +```{r} +summary(tab2, text=T) +tmp <- as.data.frame(tab2) +tmp +# write.csv(tmp, '/my/path/here/mymodel.csv') +``` + +###18. Write `modelsum` object to a separate Word or HTML file + +```{r} +## write to an HTML document +# write2html(tab2, "~/ibm/trash.html") + +## write to a Word document +# write2word(tab2, "~/ibm/trash.doc", title="My table in Word") +``` + +Available Function Options +================================== + +### Summary statistics + +The available summary statistics, by varible type, are: + +* `binomial`,`quasibinomial`: Logistic regression models + + default: `OR, CI.lower.OR, CI.upper.OR, p.value, concordance, Nmiss` + + optional: `estimate, CI.lower.estimate, CI.upper.estimate, N, Nmiss2, + endpoint, std.error, statistic, logLik, AIC, + BIC, null.deviance, deviance, df.residual, df.null` +* `gaussian`: Linear regression models + + default: `estimate, std.error, p.value, adj.r.squared, Nmiss` + + optional: `CI.lower.estimate, CI.upper.estimate, + N, Nmiss2, statistic, standard.estimate, endpoint, + r.squared, AIC, BIC, logLik, statistic.F, p.value.F` +* `poisson`, `quasipoisson`: Poisson regression models + + default: `RR, CI.lower.RR, CI.upper.RR, p.value, concordance, Nmiss` + + optional: `CI.lower.estimate, CI.upper.estimate, CI.RR, Nmiss2, se, estimate, + z.stat, endpoint, AIC, BIC, logLik, dispersion, + null.deviance, deviance, df.residual, df.null` +* `survival`: Cox models + + default: `HR, CI.lower.HR, CI.upper.HR, p.value, concordance, Nmiss` + + optional: `CI.lower.estimate, CI.upper.estimate, N, Nmiss2, estimate, se, + endpoint, Nevents, z.stat, r.squared, logLik, + AIC, BIC, statistic.sc, p.value.sc, p.value.log, + p.value.wald, N, std.error.concordance` + +The full description of these parameters that can be shown for models include: + +* `N`: a count of the number of observations used in the analysis +* `Nmiss`: only show the count of the number of missing values if there are some missing values +* `Nmiss2`: always show a count of the number of missing values for a model +* `endpoint`: dependent variable used in the model +* `std.err`: print the standard error +* `statistic`: test statistic +* `statistic.F': test statistic (F test) +* `p.value`: print the p-value +* `r.squared`: print the model R-square +* `adj.r.squared`: print the model adjusted R-square +* `r.squared`: print the model R-square +* `concordance`: print the model C statistic (which is the AUC for logistic models) +* `logLik`: print the loglikelihood value +* `p.value.log`: print the p-value for the overall model likelihood test +* `p.value.wald`: print the p-value for the overall model wald test +* `p.value.sc`: print the p-value for overall model score test +* `AIC`: print the Akaike information criterion +* `BIC`: print the Bayesian information criterion +* `null.deviance`: null deviance +* `deviance`: model deviance +* `df.residual`: degrees of freedom for the residual +* `df.null`: degrees of freedom for the null model +* `dispersion`: This is used in Poisson models and is defined as the deviance/df.residual +* `statistic.sc`: overall model score statistic +* `std.error.concordance`: standard error for the C statistic +* `HR`: print the hazard ratio (for survival models), i.e. exp(beta) +* `CI.lower.HR, CI.upper.HR`: print the confidence interval for the HR +* `OR`: print the odd's ratio (for logistic models), i.e. exp(beta) +* `CI.lower.OR, CI.upper.OR`: print the confidence interval for the OR +* `RR`: print the risk ratio (for poisson models), i.e. exp(beta) +* `CI.lower.RR, CI.upper.RR`: print the confidence interval for the RR +* `estimate`: print beta coefficient +* `standardized.estimate`: print the standardized beta coefficient +* `CI.lower.estimate, CI.upper.estimate`: print the confidence interval for the beta coefficient + + +### modelsum.control settings + +A quick way to see what arguments are possible to utilize in a function is to use the `args()` +command. Settings involving the number of digits can be set in `modelsum.control` or in `summary.modelsum`. + +```{r} +args(modelsum.control) +``` + +Settings: + +* digits=3 (number of significant digits for beta coefficient and standard error) +* digits.test=3 (number of significant digits for p-values) +* nsmall=NULL (number of digits after the decimal point for beta coefficient and standard error) +* nsmall.ratio=2 (number of digits after the decimal point for ratios, e.g. OR, RR, HR) +* show.adjust=TRUE +* show.intercept = TRUE +* conf.level = 0.95 +* binomial.stats, quasibinomial.stats +* survival.stats +* gaussian.stats +* poisson.stats, quasipoisson.stats + + +### summary.modelsum settings + +The summary.modelsum function has options that modify how the table appears (such as adding a title or modifying labels). + +```{r} +args(arsenal:::summary.modelsum) +``` + +Settings: + +* title +* labelTranslations (allows user to modify variable labels) +* digits +* nsmall +* nsmall.ratio +* digits.test +* show.intercept +* show.adjust +* text=FALSE +* removeBlanks=FALSE (used on conjunction with text=TRUE to clean up output) +* labelSize=1.2 +* pfootnote + + + diff --git a/inst/doc/modelsum.html b/inst/doc/modelsum.html new file mode 100644 index 0000000..a53f2c5 --- /dev/null +++ b/inst/doc/modelsum.html @@ -0,0 +1,3401 @@ + + + + + + + + + + + + + + +The modelsum function + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+ + + + + + + + + + + + + + +
+ +
+ +
+

Introduction

+

Very often we are asked to summarize model results from multiple fits into a nice table. The endpoint might be of different types (e.g., survival, case/control, continuous) and there may be several independent variables that we want to examine univariately or adjusted for certain variables such as age and sex. Locally, the SAS macros %modelsum, %glmuniv, and %logisuni were written to create such summary tables. With the increasing interest in R, we have developed the function modelsum to create similar tables within the R environment.

+

In developing the modelsum function, the goal was to bring the best features of these macros into an R function. However, the task was not simply to duplicate all the functionality, but rather to make use of R’s strengths (modeling, method dispersion, flexibility in function definition and output format) and make a tool that fits the needs of R users. Additionally, the results needed to fit within the general reproducible research framework so the tables could be displayed within an R markdown report.

+

This report provides step-by-step directions for using the functions associated with modelsum. All functions presented here are available within the arsenal package. An assumption is made that users are somewhat familiar with R markdown documents. For those who are new to the topic, a good initial resource is available at rmarkdown.rstudio.com.

+
+
+

Simple Example

+

The first step when using the modelsum function is to load the arsenal package. All the examples in this report use a dataset called mockstudy made available by Paul Novotny which includes a variety of types of variables (character, numeric, factor, ordered factor, survival) to use as examples.

+
> require(arsenal)
+> data(mockstudy) # load data
+> dim(mockstudy)  # look at how many subjects and variables are in the dataset 
+[1] 1499   14
+> # help(mockstudy) # learn more about the dataset and variables
+> str(mockstudy) # quick look at the data
+'data.frame':   1499 obs. of  14 variables:
+ $ case       : int  110754 99706 105271 105001 112263 86205 99508 90158 88989 90515 ...
+ $ age        : atomic  67 74 50 71 69 56 50 57 51 63 ...
+  ..- attr(*, "label")= chr "Age in Years"
+ $ arm        : atomic  F: FOLFOX A: IFL A: IFL G: IROX ...
+  ..- attr(*, "label")= chr "Treatment Arm"
+ $ sex        : Factor w/ 2 levels "Male","Female": 1 2 2 2 2 1 1 1 2 1 ...
+ $ race       : atomic  Caucasian Caucasian Caucasian Caucasian ...
+  ..- attr(*, "label")= chr "Race"
+ $ fu.time    : int  922 270 175 128 233 120 369 421 387 363 ...
+ $ fu.stat    : int  2 2 2 2 2 2 2 2 2 2 ...
+ $ ps         : int  0 1 1 1 0 0 0 0 1 1 ...
+ $ hgb        : num  11.5 10.7 11.1 12.6 13 10.2 13.3 12.1 13.8 12.1 ...
+ $ bmi        : atomic  25.1 19.5 NA 29.4 26.4 ...
+  ..- attr(*, "label")= chr "Body Mass Index (kg/m^2)"
+ $ alk.phos   : int  160 290 700 771 350 569 162 152 231 492 ...
+ $ ast        : int  35 52 100 68 35 27 16 12 25 18 ...
+ $ mdquality.s: int  NA 1 1 1 NA 1 1 1 1 1 ...
+ $ age.ord    : Ord.factor w/ 8 levels "10-19"<"20-29"<..: 6 7 4 7 6 5 4 5 5 6 ...
+

To create a simple linear regression table (the default), use a formula statement to specify the variables that you want summarized. The example below predicts BMI with the variables sex and age.

+
> tab1 <- modelsum(bmi ~ sex + age, data=mockstudy)
+

If you want to take a quick look at the table, you can use summary on your modelsum object and the table will print out as text in your R console window. If you use summary without any options you will see a number of \(\&nbsp;\) statements which translates to “space” in HTML.

+
+

Pretty text version of table

+

If you want a nicer version in your console window then adding the text=TRUE option.

+
> summary(tab1, text=TRUE)
+----------------------------------------------------------------------------------
+                    estimate        std.error       p.value         adj.r.squared 
+------------------ --------------- --------------- --------------- ---------------
+(Intercept)        27.5            0.181           <0.001          0.004          
+sex Female         -0.731          0.29            0.012           .              
+(Intercept)        26.4            0.752           <0.001          0              
+Age in Years       0.013           0.012           0.290           .              
+----------------------------------------------------------------------------------
+
+
+

Pretty Rmarkdown version of table

+

In order for the report to look nice within an R markdown (knitr) report, you just need to specify results="asis" when creating the r chunk. This changes the layout slightly (compresses it) and bolds the variable names. The three single quotes are often located above the tab key.

+

```{r results=“asis”}

+

summary(tab1)

+

```

+
> summary(tab1)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)27.50.181<0.0010.004
sex Female-0.7310.290.012.
(Intercept)26.40.752<0.0010
Age in Years0.0130.0120.290.
+
+
+

Add an adjustor to the model

+

The argument adjust allows the user to indicate that all the variables should be adjusted for these terms.

+
> tab2 <- modelsum(alk.phos ~ arm + ps + hgb, adjust= ~age + sex, data=mockstudy)
+> summary(tab2)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)17620.6<0.001-0.001
Treatment Arm F: FOLFOX-148.730.117.
Treatment Arm G: IROX-2.29.860.820.
sex Female3.027.520.688.
Age in Years-0.0170.3190.956.
(Intercept)14819.6<0.0010.045
ps46.75.99<0.001.
sex Female1.177.340.874.
Age in Years-0.0840.3110.787.
(Intercept)33732.2<0.0010.031
hgb-142.14<0.001.
sex Female-67.520.426.
Age in Years0.0950.3140.763.
+
+
+
+

Models for each endpoint type

+

To make sure the correct model is run you need to specify “family”. The options available right now are : gaussian, binomial, survival, and poisson. If there is enough interest, additional models can be added.

+
+

Gaussian

+
+

fit and summarize linear regression model

+

Look at whether there is any evidence that AlkPhos values vary by study arm after adjusting for sex and age (assuming a linear age relationship).

+
> fit <- lm(alk.phos ~ arm + age + sex, data=mockstudy)
+> summary(fit)
+
+Call:
+lm(formula = alk.phos ~ arm + age + sex, data = mockstudy)
+
+Residuals:
+    Min      1Q  Median      3Q     Max 
+-168.80  -81.45  -47.17   37.39  853.56 
+
+Coefficients:
+              Estimate Std. Error t value Pr(>|t|)    
+(Intercept)  175.54808   20.58665   8.527   <2e-16 ***
+armF: FOLFOX -13.70062    8.72963  -1.569    0.117    
+armG: IROX    -2.24498    9.86004  -0.228    0.820    
+age           -0.01741    0.31878  -0.055    0.956    
+sexFemale      3.01598    7.52097   0.401    0.688    
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+Residual standard error: 128.5 on 1228 degrees of freedom
+  (266 observations deleted due to missingness)
+Multiple R-squared:  0.002552,  Adjusted R-squared:  -0.0006969 
+F-statistic: 0.7855 on 4 and 1228 DF,  p-value: 0.5346
+> plot(fit)
+

+

The results suggest that the endpoint may need to be transformed. Calculating the Box-Cox transformation suggests a log transformation.

+
> require(MASS)
+> boxcox(fit)
+

+
> fit2 <- lm(log(alk.phos) ~ arm + age + sex, data=mockstudy)
+> summary(fit2)
+
+Call:
+lm(formula = log(alk.phos) ~ arm + age + sex, data = mockstudy)
+
+Residuals:
+    Min      1Q  Median      3Q     Max 
+-3.0098 -0.4470 -0.1065  0.4205  2.0620 
+
+Coefficients:
+               Estimate Std. Error t value Pr(>|t|)    
+(Intercept)   4.9692474  0.1025239  48.469   <2e-16 ***
+armF: FOLFOX -0.0766798  0.0434746  -1.764    0.078 .  
+armG: IROX   -0.0192828  0.0491041  -0.393    0.695    
+age          -0.0004058  0.0015876  -0.256    0.798    
+sexFemale     0.0179253  0.0374553   0.479    0.632    
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+Residual standard error: 0.6401 on 1228 degrees of freedom
+  (266 observations deleted due to missingness)
+Multiple R-squared:  0.003121,  Adjusted R-squared:  -0.0001258 
+F-statistic: 0.9613 on 4 and 1228 DF,  p-value: 0.4278
+> plot(fit2)
+

+

Finally, look to see whether there there is a non-linear relationship with age.

+
> require(gam)
+> fit3 <- lm(log(alk.phos) ~ arm + ns(age, df=2) + sex, data=mockstudy)
+> 
+> # test whether there is a difference between models 
+> anova(fit2,fit3)
+Analysis of Variance Table
+
+Model 1: log(alk.phos) ~ arm + age + sex
+Model 2: log(alk.phos) ~ arm + ns(age, df = 2) + sex
+  Res.Df    RSS Df Sum of Sq      F  Pr(>F)  
+1   1228 503.19                              
+2   1227 502.07  1    1.1137 2.7218 0.09924 .
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+> 
+> # look at functional form of age
+> termplot(fit3, term=2, se=T, rug=T)
+

+

In this instance it looks like there isn’t enough evidence to say that the relationship is non-linear.

+
+
+

extract data using the broom package

+

The broom package makes it easy to extract information from the fit.

+
> tmp <- tidy(fit3) # coefficients, p-values
+> class(tmp)
+[1] "data.frame"
+> tmp
+              term    estimate  std.error statistic       p.value
+1      (Intercept)  4.76454026 0.14102237 33.785704 1.928465e-177
+2     armF: FOLFOX -0.07668790 0.04344412 -1.765208  7.777754e-02
+3       armG: IROX -0.01945575 0.04906984 -0.396491  6.918118e-01
+4 ns(age, df = 2)1  0.33031939 0.26002425  1.270341  2.042041e-01
+5 ns(age, df = 2)2 -0.10069469 0.09349337 -1.077025  2.816809e-01
+6        sexFemale  0.01829092 0.03742970  0.488674  6.251598e-01
+> 
+> glance(fit3)
+  r.squared adj.r.squared     sigma statistic   p.value df    logLik
+1 0.0053278   0.001274531 0.6396787  1.314445 0.2552466  6 -1195.653
+       AIC      BIC deviance df.residual
+1 2405.305 2441.126 502.0747        1227
+
+
+

create a summary table using modelsum

+
> ms.logy <- modelsum(log(alk.phos) ~ arm + ps + hgb, data=mockstudy, adjust= ~age + sex, 
++                     family=gaussian,  
++                     gaussian.stats=c("estimate","CI.lower.estimate","CI.upper.estimate","p.value"))
+> summary(ms.logy)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimateCI.lower.estimateCI.upper.estimatep.value
(Intercept)4.974.775.17<0.001
Treatment Arm F: FOLFOX-0.077-0.1620.0090.078
Treatment Arm G: IROX-0.019-0.1160.0770.695
sex Female0.018-0.0560.0910.632
Age in Years0-0.0040.0030.798
(Intercept)4.834.645.02<0.001
ps0.2260.1670.284<0.001
sex Female0.009-0.0630.0810.814
Age in Years-0.001-0.0040.0020.636
(Intercept)5.765.456.08<0.001
hgb-0.069-0.09-0.048<0.001
sex Female-0.027-0.1010.0460.468
Age in Years0-0.0030.0030.925
+
+
+
+

Binomial

+
+

fit and summarize logistic regression model

+
> boxplot(age ~ mdquality.s, data=mockstudy, ylab=attr(mockstudy$age,'label'), xlab='mdquality.s')
+

+
> 
+> fit <- glm(mdquality.s ~ age + sex, data=mockstudy, family=binomial)
+> summary(fit)
+
+Call:
+glm(formula = mdquality.s ~ age + sex, family = binomial, data = mockstudy)
+
+Deviance Residuals: 
+    Min       1Q   Median       3Q      Max  
+-2.1832   0.4500   0.4569   0.4626   0.4756  
+
+Coefficients:
+             Estimate Std. Error z value Pr(>|z|)    
+(Intercept)  2.329442   0.514684   4.526 6.01e-06 ***
+age         -0.002353   0.008256  -0.285    0.776    
+sexFemale    0.039227   0.195330   0.201    0.841    
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+(Dispersion parameter for binomial family taken to be 1)
+
+    Null deviance: 807.68  on 1246  degrees of freedom
+Residual deviance: 807.55  on 1244  degrees of freedom
+  (252 observations deleted due to missingness)
+AIC: 813.55
+
+Number of Fisher Scoring iterations: 4
+> 
+> # create Odd's ratio w/ confidence intervals
+> tmp <- data.frame(summary(fit)$coef)
+> tmp
+                Estimate  Std..Error    z.value     Pr...z..
+(Intercept)  2.329441734 0.514683688  4.5259677 6.011977e-06
+age         -0.002353404 0.008255814 -0.2850602 7.755980e-01
+sexFemale    0.039227292 0.195330166  0.2008256 8.408350e-01
+> 
+> tmp$OR <- round(exp(tmp[,1]),2)
+> tmp$lower.CI <- round(exp(tmp[,1] - 1.96* tmp[,2]),2)
+> tmp$upper.CI <- round(exp(tmp[,1] + 1.96* tmp[,2]),2)
+> names(tmp)[4] <- 'P-value'
+> 
+> kable(tmp[,c('OR','lower.CI','upper.CI','P-value')])
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ORlower.CIupper.CIP-value
(Intercept)10.273.7528.170.000006
age1.000.981.010.775598
sexFemale1.040.711.530.840835
+
> 
+> # Assess the predictive ability of the model
+> 
+> # code using the pROC package
+> require(pROC)
+> pred <- predict(fit, type='response')
+> tmp <- pROC::roc(mockstudy$mdquality.s[!is.na(mockstudy$mdquality.s)]~ pred, plot=TRUE, percent=TRUE)
+

+
> tmp$auc
+Area under the curve: 50.69%
+
+
+

extract data using broom package

+

The broom package makes it easy to extract information from the fit.

+
> tidy(fit, exp=T, conf.int=T) # coefficients, p-values, conf.intervals
+         term   estimate   std.error  statistic      p.value  conf.low
+1 (Intercept) 10.2722053 0.514683688  4.5259677 6.011977e-06 3.8305925
+2         age  0.9976494 0.008255814 -0.2850602 7.755980e-01 0.9814436
+3   sexFemale  1.0400068 0.195330166  0.2008256 8.408350e-01 0.7119068
+  conf.high
+1 28.876261
+2  1.013764
+3  1.533763
+> 
+> glance(fit) # model summary statistics
+  null.deviance df.null    logLik      AIC      BIC deviance df.residual
+1      807.6764    1246 -403.7734 813.5468 828.9323 807.5468        1244
+
+
+

create a summary table using modelsum

+
> summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial))
+ +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ORCI.lower.ORCI.upper.ORp.valueconcordanceNmiss
(Intercept)NANANA<0.0010.5070
Age in Years0.9980.9811.010.776..
sexFemale1.040.7121.530.841..
(Intercept)NANANA0.0030.5521
Body Mass Index (kg/m^2)1.020.9871.060.220..
sexFemale1.050.7171.560.794..
+
> 
+> fitall <- modelsum(mdquality.s ~ age, data=mockstudy, family=binomial,
++                    binomial.stats=c("Nmiss2","OR","p.value"))
+> summary(fitall)
+ ++++++ + + + + + + + + + + + + + + + + + + + + + + +
ORp.valueNmiss2
(Intercept)NA<0.0010
Age in Years0.9980.766.
+
+
+
+

Survival

+
+

fit and summarize a Cox regression model

+
> require(survival)
+Loading required package: survival
+> 
+> # multivariable model with all 3 terms
+> fit  <- coxph(Surv(fu.time, fu.stat) ~ age + sex + arm, data=mockstudy)
+> summary(fit)
+Call:
+coxph(formula = Surv(fu.time, fu.stat) ~ age + sex + arm, data = mockstudy)
+
+  n= 1499, number of events= 1356 
+
+                  coef exp(coef)  se(coef)      z Pr(>|z|)    
+age           0.004600  1.004611  0.002501  1.839   0.0659 .  
+sexFemale     0.039893  1.040699  0.056039  0.712   0.4765    
+armF: FOLFOX -0.454650  0.634670  0.064878 -7.008 2.42e-12 ***
+armG: IROX   -0.140785  0.868676  0.072760 -1.935   0.0530 .  
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+             exp(coef) exp(-coef) lower .95 upper .95
+age             1.0046     0.9954    0.9997    1.0095
+sexFemale       1.0407     0.9609    0.9324    1.1615
+armF: FOLFOX    0.6347     1.5756    0.5589    0.7207
+armG: IROX      0.8687     1.1512    0.7532    1.0018
+
+Concordance= 0.563  (se = 0.009 )
+Rsquare= 0.037   (max possible= 1 )
+Likelihood ratio test= 56.21  on 4 df,   p=1.811e-11
+Wald test            = 56.26  on 4 df,   p=1.77e-11
+Score (logrank) test = 56.96  on 4 df,   p=1.259e-11
+> 
+> # check proportional hazards assumption
+> fit.z <- cox.zph(fit)
+> fit.z
+                 rho chisq     p
+age          -0.0311  1.46 0.226
+sexFemale    -0.0325  1.44 0.230
+armF: FOLFOX  0.0343  1.61 0.205
+armG: IROX    0.0337  1.54 0.214
+GLOBAL            NA  4.59 0.332
+> plot(fit.z[1], resid=FALSE) # makes for a cleaner picture in this case
+> abline(h=coef(fit)[1], col='red')
+

+
> 
+> # check functional form for age using pspline (penalized spline)
+> # results are returned for the linear and non-linear components
+> fit2 <- coxph(Surv(fu.time, fu.stat) ~ pspline(age) + sex + arm, data=mockstudy)
+> fit2
+Call:
+coxph(formula = Surv(fu.time, fu.stat) ~ pspline(age) + sex + 
+    arm, data = mockstudy)
+
+                         coef se(coef)      se2    Chisq   DF       p
+pspline(age), linear  0.00443  0.00237  0.00237  3.48989 1.00  0.0617
+pspline(age), nonlin                            13.11270 3.08  0.0047
+sexFemale             0.03993  0.05610  0.05607  0.50663 1.00  0.4766
+armF: FOLFOX         -0.46240  0.06494  0.06493 50.69608 1.00 1.1e-12
+armG: IROX           -0.15243  0.07301  0.07299  4.35876 1.00  0.0368
+
+Iterations: 6 outer, 16 Newton-Raphson
+     Theta= 0.954 
+Degrees of freedom for terms= 4.1 1.0 2.0 
+Likelihood ratio test=70.1  on 7.08 df, p=1.59e-12  n= 1499 
+> 
+> # plot smoothed age to visualize why significant
+> termplot(fit2, se=T, terms=1)
+> abline(h=0)
+

+
> 
+> # The c-statistic comes out in the summary of the fit
+> summary(fit2)$concordance
+          C       se(C) 
+0.568432549 0.008779125 
+> 
+> # It can also be calculated using the survConcordance function
+> survConcordance(Surv(fu.time, fu.stat) ~ predict(fit2), data=mockstudy)
+Call:
+survConcordance(formula = Surv(fu.time, fu.stat) ~ predict(fit2), 
+    data = mockstudy)
+
+  n= 1499 
+Concordance= 0.5684325 se= 0.008779125
+concordant discordant  tied.risk  tied.time   std(c-d) 
+ 620221.00  470282.00    5021.00     766.00   19235.49
+
+
+

extract data using broom package

+

The broom package makes it easy to extract information from the fit.

+
> tidy(fit) # coefficients, p-values
+          term     estimate   std.error  statistic      p.value
+1          age  0.004600011 0.002501114  1.8391844 6.588807e-02
+2    sexFemale  0.039892735 0.056038632  0.7118792 4.765396e-01
+3 armF: FOLFOX -0.454650445 0.064878289 -7.0077441 2.421952e-12
+4   armG: IROX -0.140784996 0.072759529 -1.9349355 5.299821e-02
+       conf.low    conf.high
+1 -0.0003020836  0.009502105
+2 -0.0699409642  0.149726435
+3 -0.5818095536 -0.327491336
+4 -0.2833910528  0.001821061
+> 
+> glance(fit) # model summary statistics
+     n nevent statistic.log  p.value.log statistic.sc   p.value.sc
+1 1499   1356      56.21071 1.811218e-11      56.9642 1.258749e-11
+  statistic.wald p.value.wald  r.squared r.squared.max concordance
+1          56.26 1.770173e-11 0.03680443     0.9999923    0.562838
+  std.error.concordance    logLik      AIC      BIC
+1           0.008779125 -8797.588 17603.18 17624.03
+
+
+

create a summary table using modelsum

+
> ##Note: You must use quotes when specifying family="survival" 
+> ##      family=survival will not work
+> summary(modelsum(Surv(fu.time, fu.stat) ~ arm, 
++                  adjust=~age + sex, data=mockstudy, family="survival"))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
HRCI.lower.HRCI.upper.HRp.valueconcordance
Treatment Arm F: FOLFOX0.6350.5590.721<0.0010.563
Treatment Arm G: IROX0.8690.75310.053.
sexFemale1.040.9321.160.477.
age111.010.066.
+
> 
+> ##Note: the pspline term is not working yet
+> #summary(modelsum(Surv(fu.time, fu.stat) ~ arm, 
+> #                adjust=~pspline(age) + sex, data=mockstudy, family='survival'))
+
+
+
+

Poisson

+

Poisson regression is useful when predicting an outcome variable representing counts. It can also be useful when looking at survival data. Cox models and Poisson models are very closely related and survival data can be summarized using Poisson regression. If you have overdispersion (see if the residual deviance is much larger than degrees of freedom), you may want to use quasipoisson() instead of poisson(). Some of these diagnostics need to be done outside of modelsum.

+
+

Example 1: fit and summarize a Poisson regression model

+

For the first example, use the solder dataset available in the rpart package. The endpoint skips has a definite Poisson look.

+
> require(rpart) ##just to get access to solder dataset
+> data(solder)
+> hist(solder$skips)
+

+
> 
+> fit <- glm(skips ~ Opening + Solder + Mask , data=solder, family=poisson)
+> anova(fit, test='Chi')
+Analysis of Deviance Table
+
+Model: poisson, link: log
+
+Response: skips
+
+Terms added sequentially (first to last)
+
+        Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
+NULL                      719     6855.7              
+Opening  2  2524.56       717     4331.1 < 2.2e-16 ***
+Solder   1   936.95       716     3394.2 < 2.2e-16 ***
+Mask     3  1653.09       713     1741.1 < 2.2e-16 ***
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+> summary(fit)
+
+Call:
+glm(formula = skips ~ Opening + Solder + Mask, family = poisson, 
+    data = solder)
+
+Deviance Residuals: 
+    Min       1Q   Median       3Q      Max  
+-4.7252  -1.3409  -0.6276   0.6930   5.2342  
+
+Coefficients:
+            Estimate Std. Error z value Pr(>|z|)    
+(Intercept) -1.30871    0.08068 -16.222  < 2e-16 ***
+OpeningM     0.25851    0.06656   3.884 0.000103 ***
+OpeningS     1.89349    0.05363  35.306  < 2e-16 ***
+SolderThin   1.09973    0.03864  28.465  < 2e-16 ***
+MaskA3       0.42819    0.07547   5.674  1.4e-08 ***
+MaskB3       1.20225    0.06697  17.953  < 2e-16 ***
+MaskB6       1.86648    0.06310  29.580  < 2e-16 ***
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+(Dispersion parameter for poisson family taken to be 1)
+
+    Null deviance: 6855.7  on 719  degrees of freedom
+Residual deviance: 1741.1  on 713  degrees of freedom
+AIC: 3337.2
+
+Number of Fisher Scoring iterations: 5
+

Overdispersion is when the Residual deviance is larger than the degrees of freedom. This can be tested, approximately using the following code. The goal is to have a p-value that is \(>0.05\).

+
> 1-pchisq(fit$deviance, fit$df.residual)
+[1] 0
+

One possible solution is to use the quasipoisson family instead of the poisson family. This adjusts for the overdispersion.

+
> fit2 <- glm(skips ~ Opening + Solder + Mask, data=solder, family=quasipoisson)
+> summary(fit2)
+
+Call:
+glm(formula = skips ~ Opening + Solder + Mask, family = quasipoisson, 
+    data = solder)
+
+Deviance Residuals: 
+    Min       1Q   Median       3Q      Max  
+-4.7252  -1.3409  -0.6276   0.6930   5.2342  
+
+Coefficients:
+            Estimate Std. Error t value Pr(>|t|)    
+(Intercept) -1.30871    0.12496 -10.473  < 2e-16 ***
+OpeningM     0.25851    0.10310   2.507 0.012382 *  
+OpeningS     1.89349    0.08307  22.794  < 2e-16 ***
+SolderThin   1.09973    0.05984  18.377  < 2e-16 ***
+MaskA3       0.42819    0.11689   3.663 0.000268 ***
+MaskB3       1.20225    0.10372  11.591  < 2e-16 ***
+MaskB6       1.86648    0.09774  19.097  < 2e-16 ***
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+(Dispersion parameter for quasipoisson family taken to be 2.399074)
+
+    Null deviance: 6855.7  on 719  degrees of freedom
+Residual deviance: 1741.1  on 713  degrees of freedom
+AIC: NA
+
+Number of Fisher Scoring iterations: 5
+
+
+

extract data using broom package

+

The broom package makes it easy to extract information from the fit.

+
> tidy(fit) # coefficients, p-values
+         term   estimate  std.error  statistic       p.value
+1 (Intercept) -1.3087062 0.08067587 -16.221780  3.537930e-59
+2    OpeningM  0.2585107 0.06656163   3.883780  1.028452e-04
+3    OpeningS  1.8934884 0.05363137  35.305612 4.816124e-273
+4  SolderThin  1.0997315 0.03863508  28.464582 3.216362e-178
+5      MaskA3  0.4281934 0.07546810   5.673833  1.396375e-08
+6      MaskB3  1.2022472 0.06696662  17.952933  4.552147e-72
+7      MaskB6  1.8664830 0.06309987  29.579826 2.716304e-192
+> 
+> glance(fit) # model summary statistics
+  null.deviance df.null    logLik      AIC      BIC deviance df.residual
+1       6855.69     719 -1661.623 3337.247 3369.302  1741.08         713
+
+
+

create a summary table using modelsum

+
> summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="quasipoisson"))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
RRCI.lower.RRCI.upper.RRp.value
(Intercept)NANANA<0.001
Opening M1.290.9151.840.147
Opening S6.645.068.89<0.001
(Intercept)NANANA<0.001
Solder Thin32.343.89<0.001
(Intercept)NANANA0.007
Mask A31.530.992.410.059
Mask B33.332.275.01<0.001
Mask B66.474.539.53<0.001
+
> summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="poisson"))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
RRCI.lower.RRCI.upper.RRp.value
(Intercept)NANANA<0.001
Opening M1.291.141.48<0.001
Opening S6.645.997.39<0.001
(Intercept)NANANA<0.001
Solder Thin32.793.24<0.001
(Intercept)NANANA<0.001
Mask A31.531.321.78<0.001
Mask B33.332.923.8<0.001
Mask B66.475.727.33<0.001
+
+
+

Example 2: fit and summarize a Poisson regression model

+

This second example uses the survival endpoint available in the mockstudy dataset. There is a close relationship between survival and Poisson models, and often it is easier to fit the model using Poisson regression, especially if you want to present absolute risk.

+
> # add .01 to the follow-up time (.01*1 day) in order to keep everyone in the analysis
+> fit <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, data=mockstudy, family=poisson)
+> summary(fit)
+
+Call:
+glm(formula = fu.stat ~ offset(log(fu.time + 0.01)) + age + sex + 
+    arm, family = poisson, data = mockstudy)
+
+Deviance Residuals: 
+    Min       1Q   Median       3Q      Max  
+-3.1188  -0.4041   0.3242   0.9727   4.3588  
+
+Coefficients:
+              Estimate Std. Error z value Pr(>|z|)    
+(Intercept)  -5.875627   0.108984 -53.913  < 2e-16 ***
+age           0.003724   0.001705   2.184   0.0290 *  
+sexFemale     0.027321   0.038575   0.708   0.4788    
+armF: FOLFOX -0.335141   0.044600  -7.514 5.72e-14 ***
+armG: IROX   -0.107776   0.050643  -2.128   0.0333 *  
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+(Dispersion parameter for poisson family taken to be 1)
+
+    Null deviance: 2113.5  on 1498  degrees of freedom
+Residual deviance: 2048.0  on 1494  degrees of freedom
+AIC: 5888.2
+
+Number of Fisher Scoring iterations: 5
+> 1-pchisq(fit$deviance, fit$df.residual)
+[1] 0
+> 
+> coef(coxph(Surv(fu.time,fu.stat) ~ age + sex + arm, data=mockstudy))
+         age    sexFemale armF: FOLFOX   armG: IROX 
+ 0.004600011  0.039892735 -0.454650445 -0.140784996 
+> coef(fit)[-1]
+         age    sexFemale armF: FOLFOX   armG: IROX 
+ 0.003723763  0.027320917 -0.335141090 -0.107775577 
+> 
+> # results from the Poisson model can then be described as risk ratios (similar to the hazard ratio)
+> exp(coef(fit)[-1])
+         age    sexFemale armF: FOLFOX   armG: IROX 
+   1.0037307    1.0276976    0.7152372    0.8978291 
+> 
+> # As before, we can model the dispersion which alters the standard error
+> fit2 <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, 
++             data=mockstudy, family=quasipoisson)
+> summary(fit2)
+
+Call:
+glm(formula = fu.stat ~ offset(log(fu.time + 0.01)) + age + sex + 
+    arm, family = quasipoisson, data = mockstudy)
+
+Deviance Residuals: 
+    Min       1Q   Median       3Q      Max  
+-3.1188  -0.4041   0.3242   0.9727   4.3588  
+
+Coefficients:
+              Estimate Std. Error t value Pr(>|t|)    
+(Intercept)  -5.875627   0.566666 -10.369   <2e-16 ***
+age           0.003724   0.008867   0.420    0.675    
+sexFemale     0.027321   0.200572   0.136    0.892    
+armF: FOLFOX -0.335141   0.231899  -1.445    0.149    
+armG: IROX   -0.107776   0.263318  -0.409    0.682    
+---
+Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+(Dispersion parameter for quasipoisson family taken to be 27.03493)
+
+    Null deviance: 2113.5  on 1498  degrees of freedom
+Residual deviance: 2048.0  on 1494  degrees of freedom
+AIC: NA
+
+Number of Fisher Scoring iterations: 5
+
+
+

extract data using broom package

+

The broom package makes it easy to extract information from the fit.

+
> tidy(fit) ##coefficients, p-values
+          term     estimate   std.error   statistic      p.value
+1  (Intercept) -5.875626610 0.108984423 -53.9125359 0.000000e+00
+2          age  0.003723763 0.001705363   2.1835606 2.899455e-02
+3    sexFemale  0.027320917 0.038575062   0.7082533 4.787879e-01
+4 armF: FOLFOX -0.335141090 0.044600079  -7.5143610 5.718959e-14
+5   armG: IROX -0.107775577 0.050642805  -2.1281518 3.332450e-02
+> 
+> glance(fit) ##model summary statistics
+  null.deviance df.null    logLik      AIC      BIC deviance df.residual
+1      2113.504    1498 -2939.082 5888.164 5914.727 2047.979        1494
+
+
+

create a summary table using modelsum

+

Remember that the result from modelsum is different from the fit above. The modelsum summary shows the results for age + offset(log(fu.time+.01)) then sex + offset(log(fu.time+.01)) instead of age + sex + arm + offset(log(fu.time+.01)).

+
> summary(modelsum(fu.stat ~ age, adjust=~offset(log(fu.time+.01))+ sex + arm, 
++                  data=mockstudy, family=poisson))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
RRCI.lower.RRCI.upper.RRp.value
(Intercept)NANANA<0.001
Age in Years111.010.029
armF: FOLFOX0.7150.6560.781<0.001
armG: IROX0.8980.8130.9910.033
sexFemale1.030.9531.110.479
+
+
+
+
+

Additional Examples

+

Here are multiple examples showing how to use some of the different options.

+
+

1. Change summary statistics globally

+

There are standard settings for each type of model regarding what information is summarized in the table. This behavior can be modified using the modelsum.control function. In fact, you can save your standard settings and use that for future tables.

+
> mycontrols  <- modelsum.control(gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"),
++                                 show.adjust=FALSE, show.intercept=FALSE)                            
+> tab2 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy, control=mycontrols)
+> summary(tab2)
+ ++++++ + + + + + + + + + + + + + + + + +
estimatestd.erroradj.r.squared
Age in Years0.0120.0120.004
+

You can also change these settings directly in the modelsum call.

+
> tab3 <- modelsum(bmi ~  age, adjust=~sex, data=mockstudy,
++                  gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"), 
++                  show.intercept=FALSE, show.adjust=FALSE)
+> summary(tab3)
+ ++++++ + + + + + + + + + + + + + + + + +
estimatestd.erroradj.r.squared
Age in Years0.0120.0120.004
+
+
+

2. Add labels to independent variables

+

In the above example, age is shown with a label (Age in Years), but sex is listed “as is”. This is because the data was created in SAS and in the SAS dataset, age had a label but sex did not. The label is stored as an attribute within R.

+
> ## Look at one variable's label
+> attr(mockstudy$age,'label')
+[1] "Age in Years"
+> 
+> ## See all the variables with a label
+> unlist(lapply(mockstudy,'attr','label'))
+                       age                        arm 
+            "Age in Years"            "Treatment Arm" 
+                      race                        bmi 
+                    "Race" "Body Mass Index (kg/m^2)" 
+> 
+> ## or
+> cbind(sapply(mockstudy,attr,'label'))
+            [,1]                      
+case        NULL                      
+age         "Age in Years"            
+arm         "Treatment Arm"           
+sex         NULL                      
+race        "Race"                    
+fu.time     NULL                      
+fu.stat     NULL                      
+ps          NULL                      
+hgb         NULL                      
+bmi         "Body Mass Index (kg/m^2)"
+alk.phos    NULL                      
+ast         NULL                      
+mdquality.s NULL                      
+age.ord     NULL
+

If you want to add labels to other variables, there are a couple of options. First, you could add labels to the variables in your dataset.

+
> attr(mockstudy$age,'label')  <- 'Age, yrs'
+> 
+> tab1 <- modelsum(bmi ~  age, adjust=~sex, data=mockstudy)
+> summary(tab1)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)26.80.766<0.0010.004
Age, yrs0.0120.0120.348.
sex Female-0.7180.2910.014.
+

Another option is to add labels after you have created the table

+
> mylabels <- list(sexFemale = "Female", age ="Age, yrs")
+> summary(tab1, labelTranslations = mylabels)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)26.80.766<0.0010.004
Age, yrs0.0120.0120.348.
sex Female-0.7180.2910.014.
+

Alternatively, you can check the variable labels and manipulate them with a function called labels, which works on the tableby object.

+
> labels(tab1)
+                       bmi                        age 
+"Body Mass Index (kg/m^2)"                 "Age, yrs" 
+                 sexFemale 
+              "sex Female" 
+> labels(tab1) <- c(sexFemale="Female", age="Baseline Age (yrs)")
+> labels(tab1)
+                       bmi                        age 
+"Body Mass Index (kg/m^2)"       "Baseline Age (yrs)" 
+                 sexFemale 
+                  "Female"
+
> summary(tab1)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)26.80.766<0.0010.004
Baseline Age (yrs)0.0120.0120.348.
Female-0.7180.2910.014.
+
+
+

2. Don’t show intercept values

+
> summary(modelsum(age~mdquality.s+sex, data=mockstudy), show.intercept=FALSE)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squaredNmiss
mdquality.s-0.3261.090.766-0.001252
sex Female-1.20.610.0480.0020
+
+
+

3. Don’t show results for adjustment variables

+
> summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial),
++         show.adjust=FALSE)
+ +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ORCI.lower.ORCI.upper.ORp.valueconcordanceNmiss
(Intercept)NANANA<0.0010.5070
Age, yrs0.9980.9811.010.776..
(Intercept)NANANA0.0030.5521
Body Mass Index (kg/m^2)1.020.9871.060.220..
+
+
+

4. Summarize multiple variables without typing them out

+

Often one wants to summarize a number of variables. Instead of typing by hand each individual variable, an alternative approach is to create a formula using the paste command with the collapse="+" option.

+
> # create a vector specifying the variable names
+> myvars <- names(mockstudy)
+> 
+> # select the 8th through the 12th
+> # paste them together, separated by the + sign
+> RHS <- paste(myvars[8:12], collapse="+")
+> RHS
+

[1] “ps+hgb+bmi+alk.phos+ast”

+
> 
+> # create a formula using the as.formula function
+> as.formula(paste('mdquality.s ~ ', RHS))
+

mdquality.s ~ ps + hgb + bmi + alk.phos + ast

+
> 
+> # use the formula in the modelsum function
+> summary(modelsum(as.formula(paste('mdquality.s ~', RHS)), family=binomial, data=mockstudy))
+ +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ORCI.lower.ORCI.upper.ORp.valueconcordanceNmiss
(Intercept)NANANA<0.0010.62208
ps0.4610.3320.639<0.001..
(Intercept)NANANA0.7830.573208
hgb1.181.041.330.011..
(Intercept)NANANA0.0020.54921
Body Mass Index (kg/m^2)1.020.9871.060.225..
(Intercept)NANANA<0.0010.552208
alk.phos0.9990.99810.159..
(Intercept)NANANA<0.0010.545208
ast0.9950.98810.099..
+

These steps can also be done using the formulize function.

+
> ## The formulize function does the paste and as.formula steps
+> tmp <- formulize('mdquality.s',myvars[8:10])
+> tmp
+

mdquality.s ~ ps + hgb + bmi <environment: 0x676f4c0>

+
> 
+> ## More complex formulas could also be written using formulize
+> tmp2 <- formulize('mdquality.s',c('ps','hgb','sqrt(bmi)'))
+> 
+> ## use the formula in the modelsum function
+> summary(modelsum(tmp, data=mockstudy, family=binomial))
+ +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ORCI.lower.ORCI.upper.ORp.valueconcordanceNmiss
(Intercept)NANANA<0.0010.62208
ps0.4610.3320.639<0.001..
(Intercept)NANANA0.7830.573208
hgb1.181.041.330.011..
(Intercept)NANANA0.0020.54921
Body Mass Index (kg/m^2)1.020.9871.060.225..
+
+
+

5. Subset the dataset used in the analysis

+

Here are two ways to get the same result (limit the analysis to subjects age>50 and in the F: FOLFOX treatment group).

+
    +
  • The first approach uses the subset function applied to the dataset mockstudy. This example also selects a subset of variables. The modelsum function is then applied to this subsetted data.
    • +
+
> newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(age,sex, bmi:alk.phos))
+> dim(mockstudy)
+[1] 1499   14
+> table(mockstudy$arm)
+
+   A: IFL F: FOLFOX   G: IROX 
+      428       691       380 
+> dim(newdata)
+[1] 557   4
+> names(newdata)
+[1] "age"      "sex"      "bmi"      "alk.phos"
+
> summary(modelsum(alk.phos ~ ., data=newdata))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squaredNmiss
(Intercept)12346.90.009-0.0010
age0.6190.7190.390..
(Intercept)1657.67<0.001-0.0020
sex Female-5.512.10.650..
(Intercept)23933.7<0.0010.0111
bmi-2.81.210.022..
+
    +
  • The second approach does the same analysis but uses the subset argument within modelsum to subset the data.
    • +
+
> summary(modelsum(log(alk.phos) ~ sex + ps + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squaredNmiss
(Intercept)4.870.039<0.001-0.0020
sex Female-0.0050.0620.931..
(Intercept)4.770.04<0.0010.0270
ps0.1830.05<0.001..
(Intercept)5.210.172<0.0010.00711
bmi-0.0120.0060.044..
+
> summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset = age>50 & bmi<24, data=mockstudy))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)17914.6<0.0010.007
ps20.813.40.122.
sex Female-1816.70.293.
(Intercept)373104<0.0010.009
bmi-8.24.730.083.
sex Female-2416.90.155.
+
> summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset=1:30, data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squaredNmiss
(Intercept)169570.0060.2940
ps25568.1<0.001..
sex Female49.667.60.470..
(Intercept)4532010.033-0.0491
bmi-67.410.426..
sex Female-2279.80.782..
+
+
+

6. Create combinations of variables on the fly

+
> ## create a variable combining the levels of mdquality.s and sex
+> with(mockstudy, table(interaction(mdquality.s,sex)))
+
+  0.Male   1.Male 0.Female 1.Female 
+      77      686       47      437
+
> summary(modelsum(age ~ interaction(mdquality.s,sex), data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squaredNmiss
(Intercept)59.71.31<0.0010.003252
interaction(mdquality.s, sex)1.Male0.731.390.598..
interaction(mdquality.s, sex)0.Female0.9882.130.643..
interaction(mdquality.s, sex)1.Female-11.420.474..
+
+
+

9. Transform variables on the fly

+

Certain transformations need to be surrounded by I() so that R knows to treat it as a variable transformation and not some special model feature. If the transformation includes any of the symbols / - + ^ * then surround the new variable by I().

+
> summary(modelsum(arm=="F: FOLFOX" ~ I(age/10) + log(bmi) + mdquality.s,
++                  data=mockstudy, family=binomial))
+ +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
ORCI.lower.ORCI.upper.ORp.valueconcordanceNmiss
(Intercept)NANANA0.1260.5140
Age, yrs1.050.9571.140.326..
(Intercept)NANANA0.6110.50833
Body Mass Index (kg/m^2)1.090.6381.870.748..
(Intercept)NANANA0.0740.502252
mdquality.s1.040.7191.530.819..
+
+
+

10. Change the ordering of the variables or delete a variable

+
> mytab <- modelsum(bmi ~ sex + alk.phos + age, data=mockstudy)
+> mytab2 <- mytab[c('age','sex','alk.phos')]
+> summary(mytab2)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squaredNmiss
(Intercept)26.40.752<0.00100
Age, yrs0.0130.0120.290..
(Intercept)27.50.181<0.0010.0040
sex Female-0.7310.290.012..
(Intercept)27.90.253<0.0010.011261
alk.phos-0.0050.001<0.001..
+
> summary(mytab[c('age','sex')])
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)26.40.752<0.0010
Age, yrs0.0130.0120.290.
(Intercept)27.50.181<0.0010.004
sex Female-0.7310.290.012.
+
> summary(mytab[c(3,1)])
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)26.40.752<0.0010
Age, yrs0.0130.0120.290.
(Intercept)27.50.181<0.0010.004
sex Female-0.7310.290.012.
+
+
+

11. Merge two modelsum objects together

+

It is possible to combine two modelsum objects so that they print out together, however you need to pay attention to the columns that are being displayed. It is easier to combine two models of the same family (such as two sets of linear models). If you want to combine linear and logistic model results then you would want to display the beta coefficients for the logistic model.

+
> ## demographics
+> tab1 <- modelsum(bmi ~ sex + age, data=mockstudy)
+> ## lab data
+> tab2 <- modelsum(mdquality.s ~ hgb + alk.phos, data=mockstudy, family=binomial)
+>                 
+> tab12 <- merge(tab1,tab2)
+> class(tab12)
+

[1] “modelsumList”

+
> 
+> ##ERROR: The merge works, but not the summary
+> #summary(tab12)
+
+
+

12. Add a title to the table

+

When creating a pdf the tables are automatically numbered and the title appears below the table. In Word and HTML, the titles appear un-numbered and above the table.

+
> t1 <- modelsum(bmi ~ sex + age, data=mockstudy)
+> summary(t1, title='Demographics')
+ + +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Demographics
estimatestd.errorp.valueadj.r.squared
(Intercept)27.50.181<0.0010.004
sex Female-0.7310.290.012.
(Intercept)26.40.752<0.0010
Age, yrs0.0130.0120.290.
+
+
+

13. Modify how missing values are treated

+

Depending on the report you are writing you have the following options:

+
    +
  • Use all values available for each variable
    • +
  • Use only those subjects who have measurements available for all the variables
    • +
+
> ## look at how many missing values there are for each variable
+> apply(is.na(mockstudy),2,sum)
+       case         age         arm         sex        race     fu.time 
+          0           0           0           0           7           0 
+    fu.stat          ps         hgb         bmi    alk.phos         ast 
+          0         266         266          33         266         266 
+mdquality.s     age.ord 
+        252           0
+
> ## Show how many subjects have each variable (non-missing)
+> summary(modelsum(bmi ~ ast + age, data=mockstudy,
++                 control=modelsum.control(gaussian.stats=c("N","estimate"))))
+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimateN
(Intercept)27.31205
ast-0.005.
(Intercept)26.41466
Age, yrs0.013.
+
> 
+> ## Always list the number of missing values
+> summary(modelsum(bmi ~ ast + age, data=mockstudy,
++                 control=modelsum.control(gaussian.stats=c("Nmiss2","estimate"))))
+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimateNmiss2
(Intercept)27.3261
ast-0.005.
(Intercept)26.40
Age, yrs0.013.
+
> 
+> ## Only show the missing values if there are some (default)
+> summary(modelsum(bmi ~ ast + age, data=mockstudy, 
++                 control=modelsum.control(gaussian.stats=c("Nmiss","estimate"))))
+ +++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimateNmiss
(Intercept)27.3261
ast-0.005.
(Intercept)26.40
Age, yrs0.013.
+
> 
+> ## Don't show N at all
+> summary(modelsum(bmi ~ ast + age, data=mockstudy, 
++                 control=modelsum.control(gaussian.stats=c("estimate"))))
+ ++++ + + + + + + + + + + + + + + + + + + + + + + + + +
estimate
(Intercept)27.3
ast-0.005
(Intercept)26.4
Age, yrs0.013
+
+
+

14. Modify the number of digits used

+

Within modelsum.control function there are 4 options for controlling the number of significant digits shown.

+
    +
  • digits: controls the number of significant digits (counting both before and after the decimal point) for continuous variables
    • +
  • nsmall: controls the number of digits after the decimal point for the beta and standard error
    • +
  • nsmall.ratio: controls the number of digits for the ratio statistics (OR, HR, RR), default=2
    • +
  • digits.test: controls the number of digits after the decimal point for p-values (default=3)
    • +
+
> summary(modelsum(bmi ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
estimatestd.errorp.valueadj.r.squared
(Intercept)27.490.1813<0.010.0036
sex Female-0.73110.29030.01.
(Intercept)26.420.7521<0.011e-04
Age, yrs0.0130.01230.29.
(Intercept)26.490.2447<0.010.0079
fu.time0.00113e-04<0.01.
+

It is important to understand how R treats the digits argument. Here are some summaries for the variable pi. Note that with 4 digits, the number after the decimal point changes after multiplying pi by 10 or 100. However, the nsmall option specifies the number of values after the decimal point. The two can be used together (see the help file for format for more details on how that works).

+
> format(pi, digits=1)
+[1] "3"
+> format(pi, digits=3)
+[1] "3.14"
+> format(pi, digits=4)
+[1] "3.142"
+> format(pi*10, digits=4)
+[1] "31.42"
+> format(pi*100, digits=4)
+[1] "314.2"
+> format(pi*100, nsmall=4)
+[1] "314.1593"
+> format(pi*100, nsmall=2, digits=4)
+[1] "314.16"
+
+
+

15. Use case-weights in the models

+

Occasionally it is of interest to fit models using case weights. The modelsum function allows you to pass on the weights to the models and it will do the appropriate fit.

+
> mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE)
+> 
+> ## create weights based on agegp and sex distribution
+> tab1 <- with(mockstudy,table(agegp, sex))
+> tab1
+         sex
+agegp     Male Female
+  [18,50)  152    110
+  [50,60)  258    178
+  [60,70)  295    173
+  [70,90)  211    122
+> tab2 <- with(mockstudy, table(agegp, sex, arm))
+> gpwts <- rep(tab1, length(unique(mockstudy$arm)))/tab2
+> 
+> ## apply weights to subjects
+> index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(arm)))) 
+> mockstudy$wts <- gpwts[index]
+> 
+> ## show weights by treatment arm group
+> tapply(mockstudy$wts,mockstudy$arm, summary)
+$`A: IFL`
+   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+  2.923   3.225   3.548   3.502   3.844   4.045 
+
+$`F: FOLFOX`
+   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+  2.033   2.070   2.201   2.169   2.263   2.303 
+
+$`G: IROX`
+   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+  3.667   3.734   4.023   3.945   4.031   4.471
+
> mockstudy$newvarA <- as.numeric(mockstudy$arm=='A: IFL')
+> tab1 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), 
++                  family=binomial)
+> summary(tab1, title='No Case Weights used')
+ + +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
No Case Weights used
ORCI.lower.ORCI.upper.ORp.valueconcordanceNmiss
(Intercept)NANANA<0.0010.55210
ast10.9981.010.258..
(Intercept)NANANA0.0910.529
bmi10.981.030.808..
(Intercept)NANANA0.9900.514210
hgb0.9650.8941.040.372..
+
> 
+> tab2 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), 
++                  weights=wts, family=binomial)
+> summary(tab2, title='Case Weights used')
+ + +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Case Weights used
ORCI.lower.ORCI.upper.ORp.valueconcordanceNmiss
(Intercept)NANANA0.5040.55210
ast111.010.068..
(Intercept)NANANA0.8200.529
bmi10.9881.020.780..
(Intercept)NANANA0.0390.514210
hgb0.9560.91310.058..
+
+
+

16. Use modelsum within an Sweave document

+

For those users who wish to create tables within an Sweave document, the following code seems to work.

+
\documentclass{article}
+
+\usepackage{longtable}
+\usepackage{pdfpages}
+
+\begin{document}
+
+\section{Read in Data}
+<<echo=TRUE>>=
+require(arsenal)
+require(knitr)
+require(rmarkdown)
+data(mockstudy)
+
+tab1 <- modelsum(bmi~sex+age, data=mockstudy)
+@
+
+\section{Convert Summary.modelsum to LaTeX}
+<<echo=TRUE, results='hide', message=FALSE>>=
+capture.output(summary(tab1), file="Test.md")
+
+## Convert R Markdown Table to LaTeX
+render("Test.md", pdf_document(keep_tex=TRUE))
+@ 
+
+\includepdf{Test.pdf}
+
+\end{document}
+
+
+

17. Export modelsum results to a .CSV file

+

When looking at multiple variables it is sometimes useful to export the results to a csv file. The as.data.frame function creates a data frame object that can be exported or further manipulated within R.

+
> summary(tab2, text=T)
+-----------------------------------------------------------------------------------------------------------
+                   OR             CI.lower.OR    CI.upper.OR    p.value        concordance    Nmiss        
+----------------- -------------- -------------- -------------- -------------- -------------- --------------
+(Intercept)       NA             NA             NA             0.504          0.55           210           
+ast               1              1              1.01           0.068          .              .             
+(Intercept)       NA             NA             NA             0.820          0.5            29            
+bmi               1              0.988          1.02           0.780          .              .             
+(Intercept)       NA             NA             NA             0.039          0.514          210           
+hgb               0.956          0.913          1              0.058          .              .             
+-----------------------------------------------------------------------------------------------------------
+> tmp <- as.data.frame(tab2)
+> tmp
+         term model endpoint    OR CI.lower.OR CI.upper.OR p.value
+1 (Intercept)     1  newvarA    NA          NA          NA   0.504
+2         ast     1  newvarA 1.000       1.000        1.01   0.068
+3 (Intercept)     2  newvarA    NA          NA          NA   0.820
+4         bmi     2  newvarA 1.000       0.988        1.02   0.780
+5 (Intercept)     3  newvarA    NA          NA          NA   0.039
+6         hgb     3  newvarA 0.956       0.913        1.00   0.058
+  concordance Nmiss
+1       0.550   210
+2       0.550   210
+3       0.500    29
+4       0.500    29
+5       0.514   210
+6       0.514   210
+> # write.csv(tmp, '/my/path/here/mymodel.csv')
+
+
+

18. Write modelsum object to a separate Word or HTML file

+
> ## write to an HTML document
+> # write2html(tab2, "~/ibm/trash.html")
+> 
+> ## write to a Word document
+> # write2word(tab2, "~/ibm/trash.doc", title="My table in Word")
+
+
+
+

Available Function Options

+
+

Summary statistics

+

The available summary statistics, by varible type, are:

+
    +
  • binomial,quasibinomial: Logistic regression models
    • +
  • default: OR, CI.lower.OR, CI.upper.OR, p.value, concordance, Nmiss
    • +
  • optional: estimate, CI.lower.estimate, CI.upper.estimate, N, Nmiss2, endpoint, std.error, statistic, logLik, AIC, BIC, null.deviance, deviance, df.residual, df.null
    • +
  • gaussian: Linear regression models
    • +
  • default: estimate, std.error, p.value, adj.r.squared, Nmiss
    • +
  • optional: CI.lower.estimate, CI.upper.estimate, N, Nmiss2, statistic, standard.estimate, endpoint, r.squared, AIC, BIC, logLik, statistic.F, p.value.F
    • +
  • poisson, quasipoisson: Poisson regression models
    • +
  • default: RR, CI.lower.RR, CI.upper.RR, p.value, concordance, Nmiss
    • +
  • optional: CI.lower.estimate, CI.upper.estimate, CI.RR, Nmiss2, se, estimate, z.stat, endpoint, AIC, BIC, logLik, dispersion, null.deviance, deviance, df.residual, df.null
    • +
  • survival: Cox models
    • +
  • default: HR, CI.lower.HR, CI.upper.HR, p.value, concordance, Nmiss
    • +
  • optional: CI.lower.estimate, CI.upper.estimate, N, Nmiss2, estimate, se, endpoint, Nevents, z.stat, r.squared, logLik, AIC, BIC, statistic.sc, p.value.sc, p.value.log, p.value.wald, N, std.error.concordance
    • +
+

The full description of these parameters that can be shown for models include:

+
    +
  • N: a count of the number of observations used in the analysis
    • +
  • Nmiss: only show the count of the number of missing values if there are some missing values
    • +
  • Nmiss2: always show a count of the number of missing values for a model
    • +
  • endpoint: dependent variable used in the model
    • +
  • std.err: print the standard error
    • +
  • statistic: test statistic
    • +
  • `statistic.F’: test statistic (F test)
    • +
  • p.value: print the p-value
    • +
  • r.squared: print the model R-square
    • +
  • adj.r.squared: print the model adjusted R-square
    • +
  • r.squared: print the model R-square
    • +
  • concordance: print the model C statistic (which is the AUC for logistic models)
    • +
  • logLik: print the loglikelihood value
    • +
  • p.value.log: print the p-value for the overall model likelihood test
    • +
  • p.value.wald: print the p-value for the overall model wald test
    • +
  • p.value.sc: print the p-value for overall model score test
    • +
  • AIC: print the Akaike information criterion
    • +
  • BIC: print the Bayesian information criterion
    • +
  • null.deviance: null deviance
    • +
  • deviance: model deviance
    • +
  • df.residual: degrees of freedom for the residual
    • +
  • df.null: degrees of freedom for the null model
    • +
  • dispersion: This is used in Poisson models and is defined as the deviance/df.residual
    • +
  • statistic.sc: overall model score statistic
    • +
  • std.error.concordance: standard error for the C statistic
    • +
  • HR: print the hazard ratio (for survival models), i.e. exp(beta)
    • +
  • CI.lower.HR, CI.upper.HR: print the confidence interval for the HR
    • +
  • OR: print the odd’s ratio (for logistic models), i.e. exp(beta)
    • +
  • CI.lower.OR, CI.upper.OR: print the confidence interval for the OR
    • +
  • RR: print the risk ratio (for poisson models), i.e. exp(beta)
    • +
  • CI.lower.RR, CI.upper.RR: print the confidence interval for the RR
    • +
  • estimate: print beta coefficient
    • +
  • standardized.estimate: print the standardized beta coefficient
    • +
  • CI.lower.estimate, CI.upper.estimate: print the confidence interval for the beta coefficient
    • +
+
+
+

modelsum.control settings

+

A quick way to see what arguments are possible to utilize in a function is to use the args() command. Settings involving the number of digits can be set in modelsum.control or in summary.modelsum.

+
> args(modelsum.control)
+function (digits = 3, nsmall = NULL, nsmall.ratio = 2, digits.test = 3, 
+    show.adjust = TRUE, show.intercept = TRUE, conf.level = 0.95, 
+    binomial.stats = c("OR", "CI.lower.OR", "CI.upper.OR", "p.value", 
+        "concordance", "Nmiss"), gaussian.stats = c("estimate", 
+        "std.error", "p.value", "adj.r.squared", "Nmiss"), poisson.stats = c("RR", 
+        "CI.lower.RR", "CI.upper.RR", "p.value", "concordance", 
+        "Nmiss"), survival.stats = c("HR", "CI.lower.HR", "CI.upper.HR", 
+        "p.value", "concordance", "Nmiss"), ...) 
+NULL
+

Settings:

+
    +
  • digits=3 (number of significant digits for beta coefficient and standard error)
    • +
  • digits.test=3 (number of significant digits for p-values)
    • +
  • nsmall=NULL (number of digits after the decimal point for beta coefficient and standard error)
    • +
  • nsmall.ratio=2 (number of digits after the decimal point for ratios, e.g. OR, RR, HR)
    • +
  • show.adjust=TRUE
    • +
  • show.intercept = TRUE
    • +
  • conf.level = 0.95
    • +
  • binomial.stats, quasibinomial.stats
    • +
  • survival.stats
    • +
  • gaussian.stats
    • +
  • poisson.stats, quasipoisson.stats
    • +
+
+
+

summary.modelsum settings

+

The summary.modelsum function has options that modify how the table appears (such as adding a title or modifying labels).

+
> args(arsenal:::summary.modelsum)
+function (object, title = NULL, labelTranslations = NULL, digits = NA, 
+    nsmall = NA, nsmall.ratio = NA, digits.test = NA, show.intercept = NA, 
+    show.adjust = NA, text = FALSE, removeBlanks = text, labelSize = 1.2, 
+    pfootnote = TRUE, ...) 
+NULL
+

Settings:

+
    +
  • title
    • +
  • labelTranslations (allows user to modify variable labels)
    • +
  • digits
    • +
  • nsmall
    • +
  • nsmall.ratio
    • +
  • digits.test
    • +
  • show.intercept
    • +
  • show.adjust
    • +
  • text=FALSE
    • +
  • removeBlanks=FALSE (used on conjunction with text=TRUE to clean up output)
    • +
  • labelSize=1.2
    • +
  • pfootnote
    • +
+
+
+ + + + +
+ + + + + + + + diff --git a/inst/doc/tableby.R b/inst/doc/tableby.R new file mode 100644 index 0000000..15e44d2 --- /dev/null +++ b/inst/doc/tableby.R @@ -0,0 +1,327 @@ +## ---- load-data---------------------------------------------------------- +require(arsenal) +require(knitr) +require(survival) +data(mockstudy) ##load data +dim(mockstudy) ##look at how many subjects and variables are in the dataset +# help(mockstudy) ##learn more about the dataset and variables +str(mockstudy) ##quick look at the data + +## ---- simple1------------------------------------------------------------ +tab1 <- tableby(arm ~ sex + age, data=mockstudy) + +## ---- simple-text-------------------------------------------------------- +summary(tab1, text=TRUE) + +## ---- simple-markdown, results='asis'------------------------------------ +summary(tab1) + +## ------------------------------------------------------------------------ +## base R frequency example +tmp <- table(Gender=mockstudy$sex, "Study Arm"=mockstudy$arm) +tmp + +# Note: The continuity correction is applied by default in R (not used in %table) +chisq.test(tmp) + +## gmodels frequency example +#require(gmodels) +#CrossTable(mockstudy$sex, mockstudy$arm, prop.r=F, prop.t=F, +# prop.chisq=F, chisq=T, dnn=c('Gender','Study Arm')) + +## base R numeric summary example +tapply(mockstudy$age, mockstudy$arm, summary) +summary(aov(age ~ arm, data=mockstudy)) + + +## ---- check-labels------------------------------------------------------- +## Look at one variable's label +attr(mockstudy$age,'label') + +## See all the variables with a label +unlist(lapply(mockstudy,'attr','label')) + +## ---- add-label, results='asis'------------------------------------------ +attr(mockstudy$sex,'label') <- 'Gender' + +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +summary(tab1) + +## ---- results='asis'----------------------------------------------------- +mylabels <- list( sex = "SEX", age ="Age, yrs") +summary(tab1, labelTranslations = mylabels) + +## ---- assignlabels------------------------------------------------------- +labels(tab1) +labels(tab1) <- c(arm="Treatment Assignment", age="Baseline Age (yrs)") +labels(tab1) + +## ---- results='asis'----------------------------------------------------- +summary(tab1) + +## ---- results='asis'----------------------------------------------------- +mycontrols <- tableby.control(test=FALSE, total=FALSE, + numeric.test="kwt", cat.test="chisq", + numeric.stats=c("N", "median", "q1q3"), + cat.stats=c("countpct"), + stats.labels=list(N='Count', median='Median', q1q3='Q1,Q3')) +tab2 <- tableby(arm ~ sex + age, data=mockstudy, control=mycontrols) +summary(tab2) + +## ---- results='asis'----------------------------------------------------- +tab3 <- tableby(arm ~ sex + age, data=mockstudy, test=FALSE, total=FALSE, + numeric.stats=c("median","q1q3"), numeric.test="kwt") +summary(tab3) + +## ---- testformula-------------------------------------------------------- +tab.test <- tableby(arm ~ kwt(age) + anova(bmi) + kwt(ast), data=mockstudy) +tests(tab.test) + +## ---- results='asis'----------------------------------------------------- +summary(tab.test) + +## ---- testsAndStats, results='asis'-------------------------------------- +tab.test <- tableby(arm ~ kwt(ast, "Nmiss2","median") + anova(age, "N","mean") + + kwt(bmi, "Nmiss","median"), data=mockstudy) +summary(tab.test) + +## ---- nobyvar, results='asis'-------------------------------------------- +tab.noby <- tableby(~ bmi + sex + age, data=mockstudy) +summary(tab.noby) + +## ---- results="asis"----------------------------------------------------- +summary(tab.test) #, pfootnote=TRUE) + +## ------------------------------------------------------------------------ +mockstudy$age.ordnew <- ordered(c("a",NA,as.character(mockstudy$age.ord[-(1:2)]))) +table(mockstudy$age.ord, mockstudy$sex) +table(mockstudy$age.ordnew, mockstudy$sex) +class(mockstudy$age.ord) + +## ---- results="asis"----------------------------------------------------- +summary(tableby(sex ~ age.ordnew, data = mockstudy)) #, pfootnote = TRUE) +summary(tableby(sex ~ kwt(age.ord), data = mockstudy)) #) #, pfootnote = TRUE) + +## ------------------------------------------------------------------------ +survfit(Surv(fu.time, fu.stat)~sex, data=mockstudy) +survdiff(Surv(fu.time, fu.stat)~sex, data=mockstudy) + +## ---- results='asis'----------------------------------------------------- +summary(tableby(sex ~ Surv(fu.time, fu.stat), data=mockstudy)) + +## ------------------------------------------------------------------------ +summary(survfit(Surv(fu.time/365.25, fu.stat)~sex, data=mockstudy), times=1:5) + +## ---- results='asis'----------------------------------------------------- +summary(tableby(sex ~ Surv(fu.time/365.25, fu.stat), data=mockstudy, times=1:5, surv.stats=c("NeventsSurv","NriskSurv"))) + +## ---- results='asis'----------------------------------------------------- +set.seed(100) +N <- nrow(mockstudy) +mockstudy$dtentry <- mdy.Date(month=sample(1:12,N,replace=T), day=sample(1:29,N,replace=T), + year=sample(2005:2009,N,replace=T)) +summary(tableby(sex ~ dtentry, data=mockstudy)) + +## ---- results='asis'----------------------------------------------------- +## create a vector specifying the variable names +myvars <- names(mockstudy) + +## select the 8th through the last variables +## paste them together, separated by the + sign +RHS <- paste(myvars[8:10], collapse="+") +RHS + +## create a formula using the as.formula function +as.formula(paste('arm ~ ', RHS)) + +## use the formula in the tableby function +summary(tableby(as.formula(paste('arm ~', RHS)), data=mockstudy)) + +## ---- results='asis'----------------------------------------------------- +## The formulize function does the paste and as.formula steps +tmp <- formulize('arm',myvars[8:10]) +tmp + +## More complex formulas could also be written using formulize +tmp2 <- formulize('arm',c('ps','hgb^2','bmi')) + +## use the formula in the tableby function +summary(tableby(tmp, data=mockstudy)) + +## ------------------------------------------------------------------------ +newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(sex,ps:bmi)) +dim(mockstudy) +table(mockstudy$arm) +dim(newdata) +names(newdata) + +## ---- results='asis'----------------------------------------------------- +summary(tableby(sex ~ ., data=newdata)) + +## ---- results='asis'----------------------------------------------------- +summary(tableby(sex ~ ps + hgb + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy)) + +## ------------------------------------------------------------------------ +## create a variable combining the levels of mdquality.s and sex +with(mockstudy, table(interaction(mdquality.s,sex))) + +## ---- results='asis'----------------------------------------------------- +summary(tableby(arm ~ interaction(mdquality.s,sex), data=mockstudy)) + +## ---- results='asis'----------------------------------------------------- +## create a new grouping variable with combined levels of arm and sex +summary(tableby(interaction(mdquality.s, sex) ~ age + bmi, data=mockstudy, subset=arm=="F: FOLFOX")) + +## ---- maketrans, results='asis'------------------------------------------ +trans <- tableby(arm ~ I(age/10) + log(bmi) + factor(mdquality.s, levels=0:1, labels=c('N','Y')), + data=mockstudy) +summary(trans) + +## ---- assignlabels2------------------------------------------------------ +labels(trans) +labels(trans)[2:4] <- c('Age per 10 yrs', 'log(BMI)', 'MD Quality') +labels(trans) + +## ---- transsummary, results='asis'--------------------------------------- +summary(trans) + +## ---- results='asis'----------------------------------------------------- +class(mockstudy$mdquality.s) +summary(tableby(arm~mdquality.s, data=mockstudy)) + +## ---- results='asis'----------------------------------------------------- +summary(tableby(arm ~ chisq(mdquality.s, "Nmiss","countpct"), data=mockstudy)) + +## ---- results='asis'----------------------------------------------------- +mytab <- tableby(arm ~ sex + alk.phos + age, data=mockstudy) +mytab2 <- mytab[c('age','sex','alk.phos')] +summary(mytab2) +summary(mytab[c('age','sex')], nsmall = 2) +summary(mytab[c(3,1)], nsmall = 3) + + +## ---- results="asis"----------------------------------------------------- +## demographics +tab1 <- tableby(arm ~ sex + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","meansd"), total=FALSE)) +## lab data +tab2 <- tableby(arm ~ hgb + alk.phos, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","median","q1q3"), + numeric.test="kwt", total=FALSE)) +names(tab1$x) +names(tab2$x) +tab12 <- merge(tab1,tab2) +class(tab12) +names(tab12$x) +summary(tab12) #, pfootnote=TRUE) + +## ---- results='asis'----------------------------------------------------- +t1 <- tableby(arm ~ sex + age, data=mockstudy) +summary(t1, title='Demographics') + +## ------------------------------------------------------------------------ +## look at how many missing values there are for each variable +apply(is.na(mockstudy),2,sum) + +## ---- results='asis'----------------------------------------------------- +## Show how many subjects have each variable (non-missing) +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("N","median"), total=FALSE))) + +## Always list the number of missing values +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss2","median"), total=FALSE))) + +## Only show the missing values if there are some (default) +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","mean"),total=FALSE))) + +## Don't show N at all +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("mean"),total=FALSE))) + +## ---- results='asis'----------------------------------------------------- +summary(tableby(arm ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2, nsmall.pct=1) + +## ------------------------------------------------------------------------ +format(pi, digits=1) +format(pi, digits=3) +format(pi, digits=4) +format(pi*10, digits=4) +format(pi*100, digits=4) +format(pi*100, nsmall=4) +format(pi*100, nsmall=2, digits=4) + +## ---- results='asis'----------------------------------------------------- +myfunc <- function(x, weights=rep(1,length(x)), ...){ + mean(x, trim=.1, ...) +} + +summary(tableby(sex ~ hgb, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","myfunc"), numeric.test="kwt", + stats.labels=list(Nmiss='Missing values', myfunc="Trimmed Mean, 10%")))) + + +## ------------------------------------------------------------------------ +##create fake group that is not balanced by age/sex +set.seed(200) +mockstudy$fake_arm <- ifelse(mockstudy$age>60 & mockstudy$sex=='Female',sample(c('A','B'),replace=T, prob=c(.2,.8)), + sample(c('A','B'),replace=T, prob=c(.8,.4))) + +mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE) + +## create weights based on agegp and sex distribution +tab1 <- with(mockstudy,table(agegp, sex)) +tab2 <- with(mockstudy, table(agegp, sex, fake_arm)) +tab2 +gpwts <- rep(tab1, length(unique(mockstudy$fake_arm)))/tab2 +gpwts[gpwts>50] <- 30 + +## apply weights to subjects +index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(fake_arm)))) +mockstudy$wts <- gpwts[index] + +## show weights by treatment arm group +tapply(mockstudy$wts,mockstudy$fake_arm, summary) + +## ---- results='asis'----------------------------------------------------- +orig <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, test=FALSE) +summary(orig, title='No Case Weights used') +tab1 <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, weights=wts) +summary(tab1, title='Case Weights used') + +## ---- results='asis'----------------------------------------------------- +mypval <- data.frame(variable=c('age','sex','Surv(fu.time/365, fu.stat)'), + adj.pvalue=c(.953,.811,.01), + method=c('Age/Sex adjusted model results')) +tab2 <- modpval.tableby(tab1, mypval, use.pname=TRUE) +summary(tab2, title='Case Weights used, p-values added') #, pfootnote=TRUE) + +## ---- results='asis'----------------------------------------------------- +levels(mockstudy$sex) +table2 <- tableby(arm~sex + factor(mdquality.s), data=mockstudy, cat.simplify=TRUE) +summary(table2, labelTranslations=c(sex="Female", "factor(mdquality.s)"="MD Quality")) + +## ------------------------------------------------------------------------ +tab1 <- tableby(arm~sex+age, data=mockstudy) +summary(tab1, text=T) + +tmp <- as.data.frame(tab1) +tmp + +# write.csv(tmp, '/my/path/here/mymodel.csv') + +## ------------------------------------------------------------------------ +## write to an HTML document +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +# write2html(tab1, "~/ibm/trash.html") + +## write to a Word document +# write2word(tab1, "~/ibm/trash.doc", title="My table in Word") + +## ------------------------------------------------------------------------ +args(tableby.control) + +## ------------------------------------------------------------------------ +args(arsenal:::summary.tableby) + diff --git a/inst/doc/tableby.Rmd b/inst/doc/tableby.Rmd new file mode 100755 index 0000000..3e7d5a8 --- /dev/null +++ b/inst/doc/tableby.Rmd @@ -0,0 +1,760 @@ +--- +title: "The tableby function" +author: "Beth Atkinson, Jason Sinnwell, Shannon McDonnell and Greg Dougherty" +date: '`r format(Sys.time(),"%d %B, %Y")`' +output: + html_document: + toc: yes + toc_depth: '3' + pdf_document: + toc: true + toc_depth: 3 +vignette: | + %\VignetteIndexEntry{The tableby function} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +Introduction +============= + +One of the most common tables in medical literature includes summary statistics for a set of variables, +often stratified by some group (e.g. treatment arm). Locally, the SAS macros `%table` and `%summary` were +written to create summary tables with a single call. With the increasing interest in R, we have developed +the function `tableby` to create similar tables within the R environment. + +In developing the `tableby` function, the goal was to bring the best features of these macros into an R function. +However, the task was not simply to duplicate all the functionality, but rather to make use of R's strengths +(modeling, method dispersion, flexibility in function definition and output format) and make a tool that fits +the needs of R users. Additionally, the results needed to fit within the general reproducible research framework +so the tables could be displayed within an R markdown report. + +This report provides step-by-step directions for using the functions associated with `tableby`. +All functions presented here are available within the `arsenal` package. An assumption is made that users +are somewhat familiar with R markdown documents. For those who are new to the topic, a good initial resource +is available at [rmarkdown.rstudio.com](rmarkdown.rstudio.com). + +Simple Example +================ + +The first step when using the `tableby` function is to load the `arsenal` package. All the examples in this report use +a dataset called `mockstudy` made available by Paul Novotny which includes a variety of types of variables (character, +numeric, factor, ordered factor, survival) to use as examples. + +```{r, load-data} +require(arsenal) +require(knitr) +require(survival) +data(mockstudy) ##load data +dim(mockstudy) ##look at how many subjects and variables are in the dataset +# help(mockstudy) ##learn more about the dataset and variables +str(mockstudy) ##quick look at the data +``` + +To create a simple table stratified by treament arm, use a formula statement to specify the variables that you want summarized. +The example below uses age (a continuous variable) and sex (a factor). + +```{r, simple1} +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +``` + +If you want to take a quick look at the table, you can use `summary` on your tableby object and the table +will print out as text in your R console window. If you use `summary` without any options you will see a +number of $\ $ statements which translates to "space" in HTML. + +### Pretty text version of table + +If you want a nicer version in your console window then adding the `text=TRUE` option. + +```{r, simple-text} +summary(tab1, text=TRUE) +``` + +### Pretty Rmarkdown version of table + +In order for the report to look nice within an R markdown (knitr) report, you just need to specify +`results="asis"` when creating the r chunk. This changes the layout slightly (compresses it) and bolds the variable names. + +`r ''` ```{r, results="asis"} + + summary(tab1) + +``` + +```{r, simple-markdown, results='asis'} +summary(tab1) +``` + +### Summaries using standard R code + +```{r} +## base R frequency example +tmp <- table(Gender=mockstudy$sex, "Study Arm"=mockstudy$arm) +tmp + +# Note: The continuity correction is applied by default in R (not used in %table) +chisq.test(tmp) + +## gmodels frequency example +#require(gmodels) +#CrossTable(mockstudy$sex, mockstudy$arm, prop.r=F, prop.t=F, +# prop.chisq=F, chisq=T, dnn=c('Gender','Study Arm')) + +## base R numeric summary example +tapply(mockstudy$age, mockstudy$arm, summary) +summary(aov(age ~ arm, data=mockstudy)) + +``` + +Modifying Output +================ + +### Add labels + +In the above example, age is shown with a label (Age in Years), but sex is listed "as is" with lower case letters. +This is because the data was created in SAS and in the SAS dataset, age had a label but sex did not. The label is stored as an attribute within R. + +```{r, check-labels} +## Look at one variable's label +attr(mockstudy$age,'label') + +## See all the variables with a label +unlist(lapply(mockstudy,'attr','label')) +``` + +If you want to add labels to other variables, there are a couple of options. First, you could add labels to the variables in your dataset. + +```{r, add-label, results='asis'} +attr(mockstudy$sex,'label') <- 'Gender' + +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +summary(tab1) +``` + +Another option is to add labels after you have created the table + +```{r, results='asis'} +mylabels <- list( sex = "SEX", age ="Age, yrs") +summary(tab1, labelTranslations = mylabels) +``` + +Alternatively, you can check the variable labels and manipulate them with a function called labels, which works on the tableby object. + +```{r, assignlabels} +labels(tab1) +labels(tab1) <- c(arm="Treatment Assignment", age="Baseline Age (yrs)") +labels(tab1) +``` + +```{r, results='asis'} +summary(tab1) +``` + +### Change summary statistics globally + +Currently the default behavior is to summarize continuous variables with: Number of missing values, +Mean (SD), 25th - 75th quantiles, and Minimum-Maximum values with an ANOVA (t-test with equal variances) p-value. +For categorical variables the default is to show: Number of missing values and count (column percent) with a +chi-square p-value. This behavior can be modified using the tableby.control function. In fact, you can save +your standard settings and use that for future tables. Note that `test=FALSE` and `total=FALSE` results in the +total column and p-value column not being printed. + + +```{r, results='asis'} +mycontrols <- tableby.control(test=FALSE, total=FALSE, + numeric.test="kwt", cat.test="chisq", + numeric.stats=c("N", "median", "q1q3"), + cat.stats=c("countpct"), + stats.labels=list(N='Count', median='Median', q1q3='Q1,Q3')) +tab2 <- tableby(arm ~ sex + age, data=mockstudy, control=mycontrols) +summary(tab2) +``` + +You can also change these settings directly in the tableby call. + +```{r, results='asis'} +tab3 <- tableby(arm ~ sex + age, data=mockstudy, test=FALSE, total=FALSE, + numeric.stats=c("median","q1q3"), numeric.test="kwt") +summary(tab3) +``` + + +### Change summary statistics within the formula + +In addition to modifying summary options globally, it is possible to modify the test and summary statistics for +specific variables within the formula statement. For example, both the kwt (Kruskal-Wallis rank-based) and anova +(asymptotic analysis of variance) tests apply to numeric variables and we can use one for the variable "age" and +another for the variable "ast". A list of all the options is shown at the end of the vignette. + +The `tests` function can do a quick check on what tests were performed on each variable in tableby. + +```{r, testformula} +tab.test <- tableby(arm ~ kwt(age) + anova(bmi) + kwt(ast), data=mockstudy) +tests(tab.test) +``` + +```{r, results='asis'} +summary(tab.test) +``` + +Summary statistics for any individual variable can also be modified, but it must be done as secondary +arguments to the test function. The function names must be strings that are functions already written for tableby, +built-in R functions like mean and range, or user-defined functions. + +```{r, testsAndStats, results='asis'} +tab.test <- tableby(arm ~ kwt(ast, "Nmiss2","median") + anova(age, "N","mean") + + kwt(bmi, "Nmiss","median"), data=mockstudy) +summary(tab.test) +``` + +### Modifying the look & feel in Word documents + +You can easily create Word versions of `tableby` output via an Rmarkdown report and the default options will give you a reasonable table in Word - just select the "Knit Word" option in RStudio. + +**The functionality listed in this next paragraph is coming soon but needs an upgraded version of RStudio** +If you want to modify fonts used for the table, then you'll need to add an extra line to your header at the beginning of your file. +You can take the `WordStylesReference01.docx` file and modify the fonts (storing the format preferences in your project directory). +To see how this works, run your report once using WordStylesReference01.docx and then WordStylesReference02.docx. + +``` +output: word_document + reference_docx: /projects/bsi/gentools/R/lib320/arsenal/doc/WordStylesReference01.docx +``` + +For more informating on changing the look/feel of your Word document, see the [Rmarkdown documentation](http://rmarkdown.rstudio.com/word_document_format.html) website. + + +Additional Examples +============================ + +Here are multiple examples showing how to use some of the different options. + +###1. Summarize without a group/by variable + +```{r, nobyvar, results='asis'} +tab.noby <- tableby(~ bmi + sex + age, data=mockstudy) +summary(tab.noby) +``` + +###2. Display footnotes indicating which "test" was used + +```{r, results="asis"} +summary(tab.test) #, pfootnote=TRUE) +``` + +###3. Summarize an ordered factor + +When comparing groups of ordered data there are a couple of options. The **default** uses a general independence test available from the `coin` package. +For two-group comparisons, this is essentially the Armitage trend test. The other option is to specify the Kruskal Wallis test. +The example below shows both options. + +```{r} +mockstudy$age.ordnew <- ordered(c("a",NA,as.character(mockstudy$age.ord[-(1:2)]))) +table(mockstudy$age.ord, mockstudy$sex) +table(mockstudy$age.ordnew, mockstudy$sex) +class(mockstudy$age.ord) +``` + +```{r, results="asis"} +summary(tableby(sex ~ age.ordnew, data = mockstudy)) #, pfootnote = TRUE) +summary(tableby(sex ~ kwt(age.ord), data = mockstudy)) #) #, pfootnote = TRUE) +``` + +###4. Summarize a survival variable + +First look at the information that is presented by the `survfit` function, then see how the same results can be seen with tableby. +The default is to show the median survival (time at which the probability of survival = 50%). + +```{r} +survfit(Surv(fu.time, fu.stat)~sex, data=mockstudy) +survdiff(Surv(fu.time, fu.stat)~sex, data=mockstudy) +``` + +```{r, results='asis'} +summary(tableby(sex ~ Surv(fu.time, fu.stat), data=mockstudy)) +``` + +It is also possible to obtain summaries of the %survival at certain time points (say the probability of surviving 1-year). + +```{r} +summary(survfit(Surv(fu.time/365.25, fu.stat)~sex, data=mockstudy), times=1:5) +``` + +```{r, results='asis'} +summary(tableby(sex ~ Surv(fu.time/365.25, fu.stat), data=mockstudy, times=1:5, surv.stats=c("NeventsSurv","NriskSurv"))) +``` + +###5. Summarize date variables + +Date variables by default are summarized with the number of missing values, the median, and the range. +For example purposes we've created a random date. Missing values are introduced for impossible February dates. + +```{r, results='asis'} +set.seed(100) +N <- nrow(mockstudy) +mockstudy$dtentry <- mdy.Date(month=sample(1:12,N,replace=T), day=sample(1:29,N,replace=T), + year=sample(2005:2009,N,replace=T)) +summary(tableby(sex ~ dtentry, data=mockstudy)) +``` + +###6. Summarize multiple variables without typing them out + +Often one wants to summarize a number of variables. Instead of typing by hand each individual variable, +an alternative approach is to create a formula using the `paste` command with the `collapse="+"` option. + +```{r, results='asis'} +## create a vector specifying the variable names +myvars <- names(mockstudy) + +## select the 8th through the last variables +## paste them together, separated by the + sign +RHS <- paste(myvars[8:10], collapse="+") +RHS + +## create a formula using the as.formula function +as.formula(paste('arm ~ ', RHS)) + +## use the formula in the tableby function +summary(tableby(as.formula(paste('arm ~', RHS)), data=mockstudy)) +``` + +These steps can also be done using the `formulize` function. + +```{r, results='asis'} +## The formulize function does the paste and as.formula steps +tmp <- formulize('arm',myvars[8:10]) +tmp + +## More complex formulas could also be written using formulize +tmp2 <- formulize('arm',c('ps','hgb^2','bmi')) + +## use the formula in the tableby function +summary(tableby(tmp, data=mockstudy)) +``` + +###7. Subset the dataset used in the analysis + +Here are two ways to get the same result (limit the analysis to subjects age>5 and in the F: FOLFOX treatment group). + +* The first approach uses the subset function applied to the dataset `mockstudy`. This example also selects a subset of variables. +The `tableby` function is then applied to this subsetted data. + + +```{r} +newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(sex,ps:bmi)) +dim(mockstudy) +table(mockstudy$arm) +dim(newdata) +names(newdata) +``` + +```{r, results='asis'} +summary(tableby(sex ~ ., data=newdata)) +``` + +* The second approach does the same analysis but uses the subset +argument within `tableby` to subset the data. + +```{r, results='asis'} +summary(tableby(sex ~ ps + hgb + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy)) +``` + +###8. Create combinations of variables on the fly + +```{r} +## create a variable combining the levels of mdquality.s and sex +with(mockstudy, table(interaction(mdquality.s,sex))) +``` + +```{r, results='asis'} +summary(tableby(arm ~ interaction(mdquality.s,sex), data=mockstudy)) +``` + +```{r, results='asis'} +## create a new grouping variable with combined levels of arm and sex +summary(tableby(interaction(mdquality.s, sex) ~ age + bmi, data=mockstudy, subset=arm=="F: FOLFOX")) +``` + +###9. Transform variables on the fly + +Certain transformations need to be surrounded by `I()` so that R knows to treat it as a variable transformation and +not some special model feature. If the transformation includes any of the symbols `/ - + ^ *` then surround the new variable by `I()`. + + +```{r, maketrans, results='asis'} +trans <- tableby(arm ~ I(age/10) + log(bmi) + factor(mdquality.s, levels=0:1, labels=c('N','Y')), + data=mockstudy) +summary(trans) +``` + +The labels for these variables isn't exactly what we'd like so we can change modify those after the fact. +Instead of typing out the very long variable names you can modify specific labels by position. + +```{r, assignlabels2} +labels(trans) +labels(trans)[2:4] <- c('Age per 10 yrs', 'log(BMI)', 'MD Quality') +labels(trans) +``` + +```{r, transsummary, results='asis'} +summary(trans) +``` + +Note that if we had not changed `mdquality.s` to a factor, it would have been summarized as though it were a continuous variable. + +```{r, results='asis'} +class(mockstudy$mdquality.s) +summary(tableby(arm~mdquality.s, data=mockstudy)) +``` + +Another option would be to specify the test and summary statistics. +In fact, if I had a set of variables coded 0/1 and that was all I was summarizing, then I could change the global option +for continuous variables to use the chi-square test and show countpct. + +```{r, results='asis'} +summary(tableby(arm ~ chisq(mdquality.s, "Nmiss","countpct"), data=mockstudy)) +``` + + +###10. Change the ordering of the variables or delete a variable + +```{r, results='asis'} +mytab <- tableby(arm ~ sex + alk.phos + age, data=mockstudy) +mytab2 <- mytab[c('age','sex','alk.phos')] +summary(mytab2) +summary(mytab[c('age','sex')], nsmall = 2) +summary(mytab[c(3,1)], nsmall = 3) + +``` + +###11. Merge two tableby objects together + +It is possible to combine two tableby objects so that they print out together. + +```{r, results="asis"} +## demographics +tab1 <- tableby(arm ~ sex + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","meansd"), total=FALSE)) +## lab data +tab2 <- tableby(arm ~ hgb + alk.phos, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","median","q1q3"), + numeric.test="kwt", total=FALSE)) +names(tab1$x) +names(tab2$x) +tab12 <- merge(tab1,tab2) +class(tab12) +names(tab12$x) +summary(tab12) #, pfootnote=TRUE) +``` + +###12. Add a title to the table + +When creating a pdf the tables are automatically numbered and the title appears below the table. In Word and HTML, the titles appear un-numbered and above the table. + +```{r, results='asis'} +t1 <- tableby(arm ~ sex + age, data=mockstudy) +summary(t1, title='Demographics') +``` + +###13. Modify how missing values are displayed + +Depending on the report you are writing you have the following options: +* Show how many subjects have each variable +* Show how many subjects are missing each variable +* Show how many subjects are missing each variable only if there are any missing values +* Don't indicate missing values at all + +```{r} +## look at how many missing values there are for each variable +apply(is.na(mockstudy),2,sum) +``` + +```{r, results='asis'} +## Show how many subjects have each variable (non-missing) +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("N","median"), total=FALSE))) + +## Always list the number of missing values +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss2","median"), total=FALSE))) + +## Only show the missing values if there are some (default) +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","mean"),total=FALSE))) + +## Don't show N at all +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("mean"),total=FALSE))) +``` + +###14. Modify the number of digits used + +Within tableby.control function there are 4 options for controlling the number of significant digits shown. + +* digits: controls the number of significant digits (counting both before and after the decimal point) for continuous variables +* nsmall: controls the number of digits after the decimal point for continous variables +* nsmall.pct: controls the number of digits after the decimal point for percentages +* digits.test: controls the number of digits after the decimal point for p-values (default=3) + +```{r, results='asis'} +summary(tableby(arm ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2, nsmall.pct=1) +``` + +It is important to understand how R treats the `digits` argument. Here are some summaries for the variable `pi`. +Note that with 4 digits, the number after the decimal point changes after multiplying pi by 10 or 100. +However, the `nsmall` option specifies the number of values after the decimal point. +The two can be used together (see the help file for `format` for more details on how that works). + +```{r} +format(pi, digits=1) +format(pi, digits=3) +format(pi, digits=4) +format(pi*10, digits=4) +format(pi*100, digits=4) +format(pi*100, nsmall=4) +format(pi*100, nsmall=2, digits=4) +``` + +###15. Create a user-defined summary statistic + +For purposes of this example, the code below creates a trimmed mean function (trims 10%) and use that to summarize the data. Note the use of the `...` which tells R to pass extra arguments on - this is required for user-defined functions. In this case, `na.rm=T` is passed to `myfunc`. The *weights* argument is also required, even though it isn't passed on to the internal function in this particular example. + +```{r, results='asis'} +myfunc <- function(x, weights=rep(1,length(x)), ...){ + mean(x, trim=.1, ...) +} + +summary(tableby(sex ~ hgb, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","myfunc"), numeric.test="kwt", + stats.labels=list(Nmiss='Missing values', myfunc="Trimmed Mean, 10%")))) + +``` + +###16. Use case-weights for creating summary statistics + +When comparing groups, they are often unbalanced when it comes to nuisances such as age and sex. +The `tableby` function allows you to create weighted summary statistics. If this option us used then p-values are not calculated (`test=FALSE`). + +```{r} +##create fake group that is not balanced by age/sex +set.seed(200) +mockstudy$fake_arm <- ifelse(mockstudy$age>60 & mockstudy$sex=='Female',sample(c('A','B'),replace=T, prob=c(.2,.8)), + sample(c('A','B'),replace=T, prob=c(.8,.4))) + +mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE) + +## create weights based on agegp and sex distribution +tab1 <- with(mockstudy,table(agegp, sex)) +tab2 <- with(mockstudy, table(agegp, sex, fake_arm)) +tab2 +gpwts <- rep(tab1, length(unique(mockstudy$fake_arm)))/tab2 +gpwts[gpwts>50] <- 30 + +## apply weights to subjects +index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(fake_arm)))) +mockstudy$wts <- gpwts[index] + +## show weights by treatment arm group +tapply(mockstudy$wts,mockstudy$fake_arm, summary) +``` + +```{r, results='asis'} +orig <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, test=FALSE) +summary(orig, title='No Case Weights used') +tab1 <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, weights=wts) +summary(tab1, title='Case Weights used') +``` + + +###17. Create your own p-value and add it to the table + +When using weighted summary statistics, it is often desirable to then show a p-value from a model that corresponds to the weighted analysis. +It is possible to add your own p-value and modify the column title for that new p-value. Another use for this would be to add standardized +differences or confidence intervals instead of a p-value. + +To add the p-value you simply need to create a data frame and use the function `modpval.tableby`. +The first 2 columns in the dataframe are required and are the variable name and the new p-value. +The third column can be used to indicate what method was used to calculate the p-value. +If you specify `use.pname=TRUE` then the column name indicating the p-value will be also be used in the tableby summary. + + +```{r, results='asis'} +mypval <- data.frame(variable=c('age','sex','Surv(fu.time/365, fu.stat)'), + adj.pvalue=c(.953,.811,.01), + method=c('Age/Sex adjusted model results')) +tab2 <- modpval.tableby(tab1, mypval, use.pname=TRUE) +summary(tab2, title='Case Weights used, p-values added') #, pfootnote=TRUE) +``` + +###18. For two-level categorical variables, only display one level. + +If the `cat.simplify` option is set to TRUE then only the second level of the group. In the example below +sex has the levels and "Female" is the second level, hence only the %female is shown in the table. Similarly, "mdquality.s" +was turned to a factor and "1" is the second level, hence + +```{r, results='asis'} +levels(mockstudy$sex) +table2 <- tableby(arm~sex + factor(mdquality.s), data=mockstudy, cat.simplify=TRUE) +summary(table2, labelTranslations=c(sex="Female", "factor(mdquality.s)"="MD Quality")) +``` + +###19. Use `tableby` within an Sweave document + +For those users who wish to create tables within an Sweave document, the following code seems to work. + +``` +\documentclass{article} + +\usepackage{longtable} +\usepackage{pdfpages} + +\begin{document} + +\section{Read in Data} +<>= +require(arsenal) +require(knitr) +require(rmarkdown) +data(mockstudy) + +tab1 <- tableby(arm~sex+age, data=mockstudy) +@ + +\section{Convert Summary.Tableby to LaTeX} +<>= +capture.output(summary(tab1), file="Test.md") + +## Convert R Markdown Table to LaTeX +render("Test.md", pdf_document(keep_tex=TRUE)) +@ + +\includepdf{Test.pdf} + +\end{document} +``` + +###20. Export `tableby` object to a .CSV file + +When looking at multiple variables it is sometimes useful to export the results to a csv file. The `as.data.frame` function creates a data frame object that can be exported or further manipulated within R. + +```{r} +tab1 <- tableby(arm~sex+age, data=mockstudy) +summary(tab1, text=T) + +tmp <- as.data.frame(tab1) +tmp + +# write.csv(tmp, '/my/path/here/mymodel.csv') +``` + +###21. Write `tableby` object to a separate Word or HTML file + +```{r} +## write to an HTML document +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +# write2html(tab1, "~/ibm/trash.html") + +## write to a Word document +# write2word(tab1, "~/ibm/trash.doc", title="My table in Word") +``` + + +Available Function Options +================================== + +### Summary statistics + +The **default** summary statistics, by varible type, are: + +* `cont`: Continuous variables will show by default `Nmiss, meansd, q1q3, range` +* `cat`: Categorical and factor variables will show by default `Nmiss, countpct` +* `ordered`: Ordered factors will show by default `Nmiss, countpct` +* `surv`: Survival variables will show by default `Nmiss, Nevents, medsurv` +* `date`: Date variables will show by default `Nmiss, median, range` +* `group`: The grouping variable will show by default `countpct` + +Any summary statistics standardly defined in R (e.g. mean, median, sd, med, range) can be specified, +however there are a number of extra functions defined specifically for the tableby function. + +* `N`: a count of the number of observations for a particular group +* `Nmiss`: always show a count of the number of missing values for a variable within each group +* `Nmiss2`: only show the count of the number of missing values if there are some missing values(not developed yet) +* `meansd`: print the mean and standard deviation in the format `mean(sd)` +* `countpct`: print the number of values in a category plus the percentage in the format `N (%)` +* `medianq1q3`: print the median, 25th, and 75th quantiles `median (Q1, Q3)` +* `q1q3`: print the 25th and 75th quantiles `Q1, Q3` +* `medianrange`: print the median, minimum and maximum values `median (minimum, maximum)` +* `Nevents`: print number of events for a survival object within each grouping level +* `medsurv`: print the median survival + +### Testing options + +The tests used to calculate p-values differ by the variable type, but can be specified +explicitly in the formula statement or in the control function. + +The following tests are accepted: + +* `anova`: analysis of variance test; the default test for continuous variables. When + the grouping variable has two levels, it is equivalent to the two-sample t-test with equal variance. + +* `kwt`: Kruskal-Wallis test, optional test for continuous + variables. When the grouping variable has two levels, it is equivalent to the Wilcoxon Rank Sum test. + +* `chisq`: chi-square goodness of fit test for equal counts of a + categorical variable across categories; the default for categorical + or factor variables + +* `fe`: Fisher's exact test for categorical variables; optional + +* `logrank`: log-rank test, the default test for time-to-event + variables + +* `trend`: The `independence_test` function from the `coin` is used to test for trends. Whenthe grouping variable has two levels, + it is equivalent to the Armitage trend test. This is the default for ordered factors + +### tableby.control settings + +A quick way to see what arguments are possible to utilize in a function is to use the `args()` command. Settings involving the number of digits can be set in `tableby.control` or in `summary.tableby`. + +```{r} +args(tableby.control) +``` + +Settings: + +* test=TRUE (show p-values in table) +* total=TRUE (show summaries for entire dataset in addition to doing it by the group) +* test.pname=NULL (column name used when supplying own "p-value" or other summary value to the report) +* cat.simplify (for dichotomous variables, only show statistics for 2nd level) +* digits=3 (number of significant digits for continuous variables) +* digits.test=3 (number of significant digits for p-values) +* nsmall=NULL (number of digits after the decimal point for continous variables) +* nsmall.pct=2 (number of digits after the decimal for percentages) +* test.pname=NULL (use column name other than "P-Value" ) +* numeric.test, numeric.stats +* cat.test, cat.stats +* ordered.test, ordered.stats +* surv.test, surv.stats + +### summary.tableby settings + +The summary.tableby function has options that modify how the table appears (such as adding a title or modifying labels). + +```{r} +args(arsenal:::summary.tableby) +``` + +Settings: + +* digits +* digits.test +* nsmall +* nsmall.pct +* test.pname +* title=NULL +* labelTranslations (allows user to modify variable labels) +* text=FALSE +* removeBlanks=FALSE (used on conjunction with text=TRUE to clean up output) +* labelSize=1.2 +* pfootnote + diff --git a/inst/doc/tableby.html b/inst/doc/tableby.html new file mode 100644 index 0000000..24aa6ba --- /dev/null +++ b/inst/doc/tableby.html @@ -0,0 +1,4294 @@ + + + + + + + + + + + + + + +The tableby function + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + + + + + + + + + + +
+

Introduction

+

One of the most common tables in medical literature includes summary statistics for a set of variables, often stratified by some group (e.g. treatment arm). Locally, the SAS macros %table and %summary were written to create summary tables with a single call. With the increasing interest in R, we have developed the function tableby to create similar tables within the R environment.

+

In developing the tableby function, the goal was to bring the best features of these macros into an R function. However, the task was not simply to duplicate all the functionality, but rather to make use of R’s strengths (modeling, method dispersion, flexibility in function definition and output format) and make a tool that fits the needs of R users. Additionally, the results needed to fit within the general reproducible research framework so the tables could be displayed within an R markdown report.

+

This report provides step-by-step directions for using the functions associated with tableby. All functions presented here are available within the arsenal package. An assumption is made that users are somewhat familiar with R markdown documents. For those who are new to the topic, a good initial resource is available at rmarkdown.rstudio.com.

+
+
+

Simple Example

+

The first step when using the tableby function is to load the arsenal package. All the examples in this report use a dataset called mockstudy made available by Paul Novotny which includes a variety of types of variables (character, numeric, factor, ordered factor, survival) to use as examples.

+
require(arsenal)
+require(knitr)
+require(survival)
+data(mockstudy) ##load data
+dim(mockstudy)  ##look at how many subjects and variables are in the dataset
+
## [1] 1499   14
+
# help(mockstudy) ##learn more about the dataset and variables
+str(mockstudy) ##quick look at the data
+
## 'data.frame':    1499 obs. of  14 variables:
+##  $ case       : int  110754 99706 105271 105001 112263 86205 99508 90158 88989 90515 ...
+##  $ age        : atomic  67 74 50 71 69 56 50 57 51 63 ...
+##   ..- attr(*, "label")= chr "Age in Years"
+##  $ arm        : atomic  F: FOLFOX A: IFL A: IFL G: IROX ...
+##   ..- attr(*, "label")= chr "Treatment Arm"
+##  $ sex        : Factor w/ 2 levels "Male","Female": 1 2 2 2 2 1 1 1 2 1 ...
+##  $ race       : atomic  Caucasian Caucasian Caucasian Caucasian ...
+##   ..- attr(*, "label")= chr "Race"
+##  $ fu.time    : int  922 270 175 128 233 120 369 421 387 363 ...
+##  $ fu.stat    : int  2 2 2 2 2 2 2 2 2 2 ...
+##  $ ps         : int  0 1 1 1 0 0 0 0 1 1 ...
+##  $ hgb        : num  11.5 10.7 11.1 12.6 13 10.2 13.3 12.1 13.8 12.1 ...
+##  $ bmi        : atomic  25.1 19.5 NA 29.4 26.4 ...
+##   ..- attr(*, "label")= chr "Body Mass Index (kg/m^2)"
+##  $ alk.phos   : int  160 290 700 771 350 569 162 152 231 492 ...
+##  $ ast        : int  35 52 100 68 35 27 16 12 25 18 ...
+##  $ mdquality.s: int  NA 1 1 1 NA 1 1 1 1 1 ...
+##  $ age.ord    : Ord.factor w/ 8 levels "10-19"<"20-29"<..: 6 7 4 7 6 5 4 5 5 6 ...
+

To create a simple table stratified by treament arm, use a formula statement to specify the variables that you want summarized. The example below uses age (a continuous variable) and sex (a factor).

+
tab1 <- tableby(arm ~ sex + age, data=mockstudy)
+

If you want to take a quick look at the table, you can use summary on your tableby object and the table will print out as text in your R console window. If you use summary without any options you will see a number of \(\&nbsp;\) statements which translates to “space” in HTML.

+
+

Pretty text version of table

+

If you want a nicer version in your console window then adding the text=TRUE option.

+
summary(tab1, text=TRUE)
+
## ---------------------------------------------------------------------------------------------------------------------------
+##                          A: IFL (N=428)      F: FOLFOX (N=691)   G: IROX (N=380)     Total (N=1499)      p value           
+## ----------------------- ------------------- ------------------- ------------------- ------------------- -------------------
+## Sex                                                                                                                   0.190
+##    Male                 277 (64.7%)         411 (59.5%)         228 (60%)           916 (61.1%)        
+##    Female               151 (35.3%)         280 (40.5%)         152 (40%)           583 (38.9%)        
+## Age in Years                                                                                                          0.614
+##    Mean (SD)            59.7 (11.4)         60.3 (11.6)         59.8 (11.5)         60 (11.5)          
+##    Q1, Q3               53, 68              52, 69              52, 68              52, 68             
+##    Range                27 - 88             19 - 88             26 - 85             19 - 88            
+## ---------------------------------------------------------------------------------------------------------------------------
+
+
+

Pretty Rmarkdown version of table

+

In order for the report to look nice within an R markdown (knitr) report, you just need to specify results="asis" when creating the r chunk. This changes the layout slightly (compresses it) and bolds the variable names.

+

```{r, results=“asis”}

+

summary(tab1)

+

```

+
summary(tab1)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Sex0.190
    Male277 (64.7%)411 (59.5%)228 (60%)916 (61.1%)
    Female151 (35.3%)280 (40.5%)152 (40%)583 (38.9%)
Age in Years0.614
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)60 (11.5)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
+
+
+

Summaries using standard R code

+
## base R frequency example
+tmp <- table(Gender=mockstudy$sex, "Study Arm"=mockstudy$arm)
+tmp
+
##         Study Arm
+## Gender   A: IFL F: FOLFOX G: IROX
+##   Male      277       411     228
+##   Female    151       280     152
+
# Note: The continuity correction is applied by default in R (not used in %table)
+chisq.test(tmp)
+
## 
+##  Pearson's Chi-squared test
+## 
+## data:  tmp
+## X-squared = 3.3168, df = 2, p-value = 0.1904
+
## gmodels frequency example
+#require(gmodels)
+#CrossTable(mockstudy$sex, mockstudy$arm, prop.r=F, prop.t=F, 
+#           prop.chisq=F, chisq=T, dnn=c('Gender','Study Arm'))
+
+## base R numeric summary example
+tapply(mockstudy$age, mockstudy$arm, summary)
+
## $`A: IFL`
+##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+##   27.00   53.00   61.00   59.67   68.00   88.00 
+## 
+## $`F: FOLFOX`
+##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+##    19.0    52.0    61.0    60.3    69.0    88.0 
+## 
+## $`G: IROX`
+##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+##   26.00   52.00   61.00   59.76   68.00   85.00
+
summary(aov(age ~ arm, data=mockstudy))
+
##               Df Sum Sq Mean Sq F value Pr(>F)
+## arm            2    129    64.7   0.487  0.614
+## Residuals   1496 198628   132.8
+
+
+
+

Modifying Output

+
+

Add labels

+

In the above example, age is shown with a label (Age in Years), but sex is listed “as is” with lower case letters. This is because the data was created in SAS and in the SAS dataset, age had a label but sex did not. The label is stored as an attribute within R.

+
## Look at one variable's label
+attr(mockstudy$age,'label')
+
## [1] "Age in Years"
+
## See all the variables with a label
+unlist(lapply(mockstudy,'attr','label'))
+
##                        age                        arm 
+##             "Age in Years"            "Treatment Arm" 
+##                       race                        bmi 
+##                     "Race" "Body Mass Index (kg/m^2)"
+

If you want to add labels to other variables, there are a couple of options. First, you could add labels to the variables in your dataset.

+
attr(mockstudy$sex,'label')  <- 'Gender'
+
+tab1 <- tableby(arm ~ sex + age, data=mockstudy)
+summary(tab1)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Gender0.190
    Male277 (64.7%)411 (59.5%)228 (60%)916 (61.1%)
    Female151 (35.3%)280 (40.5%)152 (40%)583 (38.9%)
Age in Years0.614
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)60 (11.5)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
+

Another option is to add labels after you have created the table

+
mylabels <- list( sex = "SEX", age ="Age, yrs")
+summary(tab1, labelTranslations = mylabels)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
SEX0.190
    Male277 (64.7%)411 (59.5%)228 (60%)916 (61.1%)
    Female151 (35.3%)280 (40.5%)152 (40%)583 (38.9%)
Age, yrs0.614
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)60 (11.5)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
+

Alternatively, you can check the variable labels and manipulate them with a function called labels, which works on the tableby object.

+
labels(tab1)
+
##             arm             sex             age 
+## "Treatment Arm"        "Gender"  "Age in Years"
+
labels(tab1) <- c(arm="Treatment Assignment", age="Baseline Age (yrs)")
+labels(tab1)
+
##                    arm                    sex                    age 
+## "Treatment Assignment"               "Gender"   "Baseline Age (yrs)"
+
summary(tab1)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Gender0.190
    Male277 (64.7%)411 (59.5%)228 (60%)916 (61.1%)
    Female151 (35.3%)280 (40.5%)152 (40%)583 (38.9%)
Baseline Age (yrs)0.614
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)60 (11.5)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
+
+
+

Change summary statistics globally

+

Currently the default behavior is to summarize continuous variables with: Number of missing values, Mean (SD), 25th - 75th quantiles, and Minimum-Maximum values with an ANOVA (t-test with equal variances) p-value. For categorical variables the default is to show: Number of missing values and count (column percent) with a chi-square p-value. This behavior can be modified using the tableby.control function. In fact, you can save your standard settings and use that for future tables. Note that test=FALSE and total=FALSE results in the total column and p-value column not being printed.

+
mycontrols  <- tableby.control(test=FALSE, total=FALSE,
+                               numeric.test="kwt", cat.test="chisq",
+                               numeric.stats=c("N", "median", "q1q3"),
+                               cat.stats=c("countpct"),
+                               stats.labels=list(N='Count', median='Median', q1q3='Q1,Q3'))                            
+tab2 <- tableby(arm ~ sex + age, data=mockstudy, control=mycontrols)
+summary(tab2)
+ ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)
Gender
    Male277 (64.7%)411 (59.5%)228 (60%)
    Female151 (35.3%)280 (40.5%)152 (40%)
Age in Years
    Count428691380
    Median616161
    Q1,Q353, 6852, 6952, 68
+

You can also change these settings directly in the tableby call.

+
tab3 <- tableby(arm ~ sex + age, data=mockstudy, test=FALSE, total=FALSE, 
+                numeric.stats=c("median","q1q3"), numeric.test="kwt")
+summary(tab3)
+ ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)
Gender
    Male277 (64.7%)411 (59.5%)228 (60%)
    Female151 (35.3%)280 (40.5%)152 (40%)
Age in Years
    median616161
    Q1, Q353, 6852, 6952, 68
+
+
+

Change summary statistics within the formula

+

In addition to modifying summary options globally, it is possible to modify the test and summary statistics for specific variables within the formula statement. For example, both the kwt (Kruskal-Wallis rank-based) and anova (asymptotic analysis of variance) tests apply to numeric variables and we can use one for the variable “age” and another for the variable “ast”. A list of all the options is shown at the end of the vignette.

+

The tests function can do a quick check on what tests were performed on each variable in tableby.

+
tab.test <- tableby(arm ~ kwt(age) + anova(bmi) + kwt(ast), data=mockstudy)
+tests(tab.test)
+
##                     Variable    p.value                       Method
+## age             Age in Years 0.63906143 Kruskal-Wallis rank sum test
+## bmi Body Mass Index (kg/m^2) 0.89165522           Linear Model ANOVA
+## ast                      ast 0.03902803 Kruskal-Wallis rank sum test
+
summary(tab.test)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Age in Years0.639
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)60 (11.5)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
Body Mass Index (kg/m^2)0.892
    N-Miss920433
    Mean (SD)27.3 (5.55)27.2 (5.17)27.1 (5.75)27.2 (5.43)
    Q1, Q323.6, 30.623.7, 30.123.2, 29.623.5, 30.1
    Range14.1 - 5316.6 - 49.115.4 - 60.214.1 - 60.2
ast0.039
    N-Miss6914156266
    Mean (SD)37.3 (28)35.2 (26.7)35.7 (25.8)35.9 (26.8)
    Q1, Q321, 4219, 4020, 4120, 41
    Range10 - 2057 - 1745 - 1765 - 205
+

Summary statistics for any individual variable can also be modified, but it must be done as secondary arguments to the test function. The function names must be strings that are functions already written for tableby, built-in R functions like mean and range, or user-defined functions.

+
tab.test <- tableby(arm ~ kwt(ast, "Nmiss2","median") + anova(age, "N","mean") +
+                    kwt(bmi, "Nmiss","median"), data=mockstudy)
+summary(tab.test)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
ast0.039
    N-Miss6914156266
    median2925.52727
Age in Years0.614
    N4286913801499
    mean59.760.359.860
Body Mass Index (kg/m^2)0.641
    N-Miss920433
    median26.226.52626.3
+
+
+

Modifying the look & feel in Word documents

+

You can easily create Word versions of tableby output via an Rmarkdown report and the default options will give you a reasonable table in Word - just select the “Knit Word” option in RStudio.

+

The functionality listed in this next paragraph is coming soon but needs an upgraded version of RStudio If you want to modify fonts used for the table, then you’ll need to add an extra line to your header at the beginning of your file. You can take the WordStylesReference01.docx file and modify the fonts (storing the format preferences in your project directory). To see how this works, run your report once using WordStylesReference01.docx and then WordStylesReference02.docx.

+
output: word_document
+  reference_docx: /projects/bsi/gentools/R/lib320/arsenal/doc/WordStylesReference01.docx
+

For more informating on changing the look/feel of your Word document, see the Rmarkdown documentation website.

+
+
+
+

Additional Examples

+

Here are multiple examples showing how to use some of the different options.

+
+

1. Summarize without a group/by variable

+
tab.noby <- tableby(~ bmi + sex + age, data=mockstudy)
+summary(tab.noby)
+ ++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Overall (N=1499)
Body Mass Index (kg/m^2)
    N-Miss33
    Mean (SD)27.2 (5.43)
    Q1, Q323.5, 30.1
    Range14.1 - 60.2
Gender
    Male916 (61.1%)
    Female583 (38.9%)
Age in Years
    Mean (SD)60 (11.5)
    Q1, Q352, 68
    Range19 - 88
+
+
+

2. Display footnotes indicating which “test” was used

+
summary(tab.test) #, pfootnote=TRUE)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
ast0.039
    N-Miss6914156266
    median2925.52727
Age in Years0.614
    N4286913801499
    mean59.760.359.860
Body Mass Index (kg/m^2)0.641
    N-Miss920433
    median26.226.52626.3
+
+
+

3. Summarize an ordered factor

+

When comparing groups of ordered data there are a couple of options. The default uses a general independence test available from the coin package. For two-group comparisons, this is essentially the Armitage trend test. The other option is to specify the Kruskal Wallis test. The example below shows both options.

+
mockstudy$age.ordnew <- ordered(c("a",NA,as.character(mockstudy$age.ord[-(1:2)])))
+table(mockstudy$age.ord, mockstudy$sex)
+
##        
+##         Male Female
+##   10-19    1      0
+##   20-29    8     11
+##   30-39   37     30
+##   40-49  127     83
+##   50-59  257    179
+##   60-69  298    170
+##   70-79  168    101
+##   80-89   20      9
+
table(mockstudy$age.ordnew, mockstudy$sex)
+
##        
+##         Male Female
+##   10-19    1      0
+##   20-29    8     11
+##   30-39   37     30
+##   40-49  127     83
+##   50-59  257    179
+##   60-69  297    170
+##   70-79  168    100
+##   80-89   20      9
+##   a        1      0
+
class(mockstudy$age.ord)
+
## [1] "ordered" "factor"
+
summary(tableby(sex ~ age.ordnew, data = mockstudy)) #, pfootnote = TRUE)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)Total (N=1499)p value
age.ordnew0.040
    N-Miss011
    10-191 (0.109%)0 (0%)1 (0.067%)
    20-298 (0.873%)11 (1.89%)19 (1.27%)
    30-3937 (4.04%)30 (5.15%)67 (4.47%)
    40-49127 (13.9%)83 (14.3%)210 (14%)
    50-59257 (28.1%)179 (30.8%)436 (29.1%)
    60-69297 (32.4%)170 (29.2%)467 (31.2%)
    70-79168 (18.3%)100 (17.2%)268 (17.9%)
    80-8920 (2.18%)9 (1.55%)29 (1.94%)
    a1 (0.109%)0 (0%)1 (0.067%)
+
summary(tableby(sex ~ kwt(age.ord), data = mockstudy)) #) #, pfootnote = TRUE)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)Total (N=1499)p value
age.ord0.067
    N-Miss000
    10-191 (0.109%)0 (0%)1 (0.067%)
    20-298 (0.873%)11 (1.89%)19 (1.27%)
    30-3937 (4.04%)30 (5.15%)67 (4.47%)
    40-49127 (13.9%)83 (14.2%)210 (14%)
    50-59257 (28.1%)179 (30.7%)436 (29.1%)
    60-69298 (32.5%)170 (29.2%)468 (31.2%)
    70-79168 (18.3%)101 (17.3%)269 (17.9%)
    80-8920 (2.18%)9 (1.54%)29 (1.93%)
+
+
+

4. Summarize a survival variable

+

First look at the information that is presented by the survfit function, then see how the same results can be seen with tableby. The default is to show the median survival (time at which the probability of survival = 50%).

+
survfit(Surv(fu.time, fu.stat)~sex, data=mockstudy)
+
## Call: survfit(formula = Surv(fu.time, fu.stat) ~ sex, data = mockstudy)
+## 
+##              n events median 0.95LCL 0.95UCL
+## sex=Male   916    829    550     515     590
+## sex=Female 583    527    543     511     575
+
survdiff(Surv(fu.time, fu.stat)~sex, data=mockstudy)
+
## Call:
+## survdiff(formula = Surv(fu.time, fu.stat) ~ sex, data = mockstudy)
+## 
+##              N Observed Expected (O-E)^2/E (O-E)^2/V
+## sex=Male   916      829      830  0.000370  0.000956
+## sex=Female 583      527      526  0.000583  0.000956
+## 
+##  Chisq= 0  on 1 degrees of freedom, p= 0.975
+
summary(tableby(sex ~ Surv(fu.time, fu.stat), data=mockstudy))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)Total (N=1499)p value
Surv(fu.time, fu.stat)0.975
    Events8295271356
    medSurv550543546
+

It is also possible to obtain summaries of the %survival at certain time points (say the probability of surviving 1-year).

+
summary(survfit(Surv(fu.time/365.25, fu.stat)~sex, data=mockstudy), times=1:5)
+
## Call: survfit(formula = Surv(fu.time/365.25, fu.stat) ~ sex, data = mockstudy)
+## 
+##                 sex=Male 
+##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
+##     1    626     286   0.6870  0.0153       0.6576       0.7177
+##     2    309     311   0.3437  0.0158       0.3142       0.3761
+##     3    152     151   0.1748  0.0127       0.1516       0.2015
+##     4     57      61   0.0941  0.0104       0.0759       0.1168
+##     5     24      16   0.0628  0.0095       0.0467       0.0844
+## 
+##                 sex=Female 
+##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
+##     1    380     202   0.6531  0.0197       0.6155        0.693
+##     2    190     189   0.3277  0.0195       0.2917        0.368
+##     3     95      90   0.1701  0.0157       0.1420        0.204
+##     4     51      32   0.1093  0.0133       0.0861        0.139
+##     5     18      12   0.0745  0.0126       0.0534        0.104
+
summary(tableby(sex ~ Surv(fu.time/365.25, fu.stat), data=mockstudy, times=1:5, surv.stats=c("NeventsSurv","NriskSurv")))
+
## Warning in tableby(sex ~ Surv(fu.time/365.25, fu.stat), data = mockstudy, : unused arguments: times
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)Total (N=1499)p value
Surv(fu.time/365.25, fu.stat)0.975
NeventsSurv0.975
    1286 (68.7)202 (65.3)488 (67.4)
    2597 (34.4)391 (32.8)988 (33.7)
    3748 (17.5)481 (17)1229 (17.3)
    4809 (9.41)513 (10.9)1322 (10.1)
    5825 (6.28)525 (7.45)1350 (6.78)
NriskSurv0.975
    16263801006
    2309190499
    315295247
    45751108
    5241842
+
+
+

5. Summarize date variables

+

Date variables by default are summarized with the number of missing values, the median, and the range. For example purposes we’ve created a random date. Missing values are introduced for impossible February dates.

+
set.seed(100)
+N <- nrow(mockstudy)
+mockstudy$dtentry <- mdy.Date(month=sample(1:12,N,replace=T), day=sample(1:29,N,replace=T), 
+                              year=sample(2005:2009,N,replace=T))
+summary(tableby(sex ~ dtentry, data=mockstudy))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)Total (N=1499)p value
dtentry0.554
    N-Miss325
    median2007-06-162007-06-152007-06-15
    Range2005-01-03 - 2009-12-272005-01-01 - 2009-12-282005-01-01 - 2009-12-28
+
+
+

6. Summarize multiple variables without typing them out

+

Often one wants to summarize a number of variables. Instead of typing by hand each individual variable, an alternative approach is to create a formula using the paste command with the collapse="+" option.

+
## create a vector specifying the variable names
+myvars <- names(mockstudy)
+
+## select the 8th through the last variables
+## paste them together, separated by the + sign
+RHS <- paste(myvars[8:10], collapse="+")
+RHS
+

[1] “ps+hgb+bmi”

+
## create a formula using the as.formula function
+as.formula(paste('arm ~ ', RHS))
+

arm ~ ps + hgb + bmi

+
## use the formula in the tableby function
+summary(tableby(as.formula(paste('arm ~', RHS)), data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
ps0.903
    N-Miss6914156266
    Mean (SD)0.529 (0.597)0.547 (0.595)0.537 (0.606)0.539 (0.598)
    Q1, Q30, 10, 10, 10, 1
    Range0 - 20 - 20 - 20 - 2
hgb0.639
    N-Miss6914156266
    Mean (SD)12.3 (1.69)12.4 (1.76)12.4 (1.68)12.3 (1.72)
    Q1, Q311, 13.411.1, 13.611.2, 13.611.1, 13.5
    Range9.06 - 17.39 - 18.29 - 179 - 18.2
Body Mass Index (kg/m^2)0.892
    N-Miss920433
    Mean (SD)27.3 (5.55)27.2 (5.17)27.1 (5.75)27.2 (5.43)
    Q1, Q323.6, 30.623.7, 30.123.2, 29.623.5, 30.1
    Range14.1 - 5316.6 - 49.115.4 - 60.214.1 - 60.2
+

These steps can also be done using the formulize function.

+
## The formulize function does the paste and as.formula steps
+tmp <- formulize('arm',myvars[8:10])
+tmp
+

arm ~ ps + hgb + bmi <environment: 0x6593680>

+
## More complex formulas could also be written using formulize
+tmp2 <- formulize('arm',c('ps','hgb^2','bmi'))
+
+## use the formula in the tableby function
+summary(tableby(tmp, data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
ps0.903
    N-Miss6914156266
    Mean (SD)0.529 (0.597)0.547 (0.595)0.537 (0.606)0.539 (0.598)
    Q1, Q30, 10, 10, 10, 1
    Range0 - 20 - 20 - 20 - 2
hgb0.639
    N-Miss6914156266
    Mean (SD)12.3 (1.69)12.4 (1.76)12.4 (1.68)12.3 (1.72)
    Q1, Q311, 13.411.1, 13.611.2, 13.611.1, 13.5
    Range9.06 - 17.39 - 18.29 - 179 - 18.2
Body Mass Index (kg/m^2)0.892
    N-Miss920433
    Mean (SD)27.3 (5.55)27.2 (5.17)27.1 (5.75)27.2 (5.43)
    Q1, Q323.6, 30.623.7, 30.123.2, 29.623.5, 30.1
    Range14.1 - 5316.6 - 49.115.4 - 60.214.1 - 60.2
+
+
+

7. Subset the dataset used in the analysis

+

Here are two ways to get the same result (limit the analysis to subjects age>5 and in the F: FOLFOX treatment group).

+
    +
  • The first approach uses the subset function applied to the dataset mockstudy. This example also selects a subset of variables. The tableby function is then applied to this subsetted data.
    • +
+
newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(sex,ps:bmi))
+dim(mockstudy)
+
## [1] 1499   16
+
table(mockstudy$arm)
+
## 
+##    A: IFL F: FOLFOX   G: IROX 
+##       428       691       380
+
dim(newdata)
+
## [1] 557   4
+
names(newdata)
+
## [1] "sex" "ps"  "hgb" "bmi"
+
summary(tableby(sex ~ ., data=newdata))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=333)Female (N=224)Total (N=557)p value
ps0.652
    N-Miss6444108
    Mean (SD)0.554 (0.6)0.528 (0.602)0.543 (0.6)
    Q1, Q30, 10, 10, 1
    Range0 - 20 - 20 - 2
hgb<0.001
    N-Miss6444108
    Mean (SD)12.7 (1.92)12.1 (1.4)12.5 (1.76)
    Q1, Q311.3, 1411, 12.911.2, 13.7
    Range9 - 18.29.1 - 15.99 - 18.2
bmi0.650
    N-Miss9615
    Mean (SD)27.5 (4.78)27.3 (5.51)27.5 (5.08)
    Q1, Q324.4, 30.223.3, 30.424, 30.4
    Range17.9 - 47.516.6 - 49.116.6 - 49.1
+
    +
  • The second approach does the same analysis but uses the subset argument within tableby to subset the data.
    • +
+
summary(tableby(sex ~ ps + hgb + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=333)Female (N=224)Total (N=557)p value
ps0.652
    N-Miss6444108
    Mean (SD)0.554 (0.6)0.528 (0.602)0.543 (0.6)
    Q1, Q30, 10, 10, 1
    Range0 - 20 - 20 - 2
hgb<0.001
    N-Miss6444108
    Mean (SD)12.7 (1.92)12.1 (1.4)12.5 (1.76)
    Q1, Q311.3, 1411, 12.911.2, 13.7
    Range9 - 18.29.1 - 15.99 - 18.2
bmi0.650
    N-Miss9615
    Mean (SD)27.5 (4.78)27.3 (5.51)27.5 (5.08)
    Q1, Q324.4, 30.223.3, 30.424, 30.4
    Range17.9 - 47.516.6 - 49.116.6 - 49.1
+
+
+

8. Create combinations of variables on the fly

+
## create a variable combining the levels of mdquality.s and sex
+with(mockstudy, table(interaction(mdquality.s,sex)))
+
## 
+##   0.Male   1.Male 0.Female 1.Female 
+##       77      686       47      437
+
summary(tableby(arm ~ interaction(mdquality.s,sex), data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
interaction(mdquality.s, sex)0.493
    N-Miss5515641252
    0.Male29 (7.77%)31 (5.79%)17 (5.01%)77 (6.17%)
    1.Male214 (57.4%)285 (53.3%)187 (55.2%)686 (55%)
    0.Female12 (3.22%)21 (3.93%)14 (4.13%)47 (3.77%)
    1.Female118 (31.6%)198 (37%)121 (35.7%)437 (35%)
+
## create a new grouping variable with combined levels of arm and sex
+summary(tableby(interaction(mdquality.s, sex) ~  age + bmi, data=mockstudy, subset=arm=="F: FOLFOX"))
+ +++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
0.Male (N=31)1.Male (N=285)0.Female (N=21)1.Female (N=198)Total (N=535)p value
Age0.190
    Mean (SD)63.1 (11.7)60.7 (11.8)60.8 (10.1)58.9 (11.4)60.2 (11.6)
    Q1, Q356, 7253, 6951, 6751, 6852, 69
    Range41 - 8219 - 8842 - 8129 - 8319 - 88
bmi0.894
    N-Miss061512
    Mean (SD)26.6 (5.09)27.4 (4.7)27.4 (4.9)27.3 (5.67)27.3 (5.1)
    Q1, Q322.8, 29.224.3, 30.223.7, 29.623.1, 30.423.9, 30.3
    Range20.2 - 41.817.9 - 47.519.8 - 39.416.8 - 44.816.8 - 47.5
+
+
+

9. Transform variables on the fly

+

Certain transformations need to be surrounded by I() so that R knows to treat it as a variable transformation and not some special model feature. If the transformation includes any of the symbols / - + ^ * then surround the new variable by I().

+
trans <- tableby(arm ~ I(age/10) + log(bmi) + factor(mdquality.s, levels=0:1, labels=c('N','Y')),
+                 data=mockstudy)
+summary(trans)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
I(age/10)0.614
    Mean (SD)5.97 (1.14)6.03 (1.16)5.98 (1.15)6 (1.15)
    Q1, Q35.3, 6.85.2, 6.95.2, 6.85.2, 6.8
    Range2.7 - 8.81.9 - 8.82.6 - 8.51.9 - 8.8
log(bmi)0.811
    N-Miss920433
    Mean (SD)3.29 (0.197)3.29 (0.183)3.28 (0.2)3.28 (0.192)
    Q1, Q33.16, 3.423.17, 3.413.14, 3.393.16, 3.41
    Range2.64 - 3.972.81 - 3.892.74 - 4.12.64 - 4.1
factor(mdquality.s, levels = 0:1, labels = c(“N”, “Y”))0.694
    N-Miss5515641252
    N41 (11%)52 (9.72%)31 (9.14%)124 (9.94%)
    Y332 (89%)483 (90.3%)308 (90.9%)1123 (90.1%)
+

The labels for these variables isn’t exactly what we’d like so we can change modify those after the fact. Instead of typing out the very long variable names you can modify specific labels by position.

+
labels(trans)
+
##                                                           arm 
+##                                               "Treatment Arm" 
+##                                                     I(age/10) 
+##                                                   "I(age/10)" 
+##                                                      log(bmi) 
+##                                                    "log(bmi)" 
+##       factor(mdquality.s, levels = 0:1, labels = c("N", "Y")) 
+## "factor(mdquality.s, levels = 0:1, labels = c(\"N\", \"Y\"))"
+
labels(trans)[2:4] <- c('Age per 10 yrs', 'log(BMI)', 'MD Quality')
+labels(trans)
+
##                                                     arm 
+##                                         "Treatment Arm" 
+##                                               I(age/10) 
+##                                        "Age per 10 yrs" 
+##                                                log(bmi) 
+##                                              "log(BMI)" 
+## factor(mdquality.s, levels = 0:1, labels = c("N", "Y")) 
+##                                            "MD Quality"
+
summary(trans)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Age per 10 yrs0.614
    Mean (SD)5.97 (1.14)6.03 (1.16)5.98 (1.15)6 (1.15)
    Q1, Q35.3, 6.85.2, 6.95.2, 6.85.2, 6.8
    Range2.7 - 8.81.9 - 8.82.6 - 8.51.9 - 8.8
log(BMI)0.811
    N-Miss920433
    Mean (SD)3.29 (0.197)3.29 (0.183)3.28 (0.2)3.28 (0.192)
    Q1, Q33.16, 3.423.17, 3.413.14, 3.393.16, 3.41
    Range2.64 - 3.972.81 - 3.892.74 - 4.12.64 - 4.1
MD Quality0.694
    N-Miss5515641252
    N41 (11%)52 (9.72%)31 (9.14%)124 (9.94%)
    Y332 (89%)483 (90.3%)308 (90.9%)1123 (90.1%)
+

Note that if we had not changed mdquality.s to a factor, it would have been summarized as though it were a continuous variable.

+
class(mockstudy$mdquality.s)
+

[1] “integer”

+
summary(tableby(arm~mdquality.s, data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
mdquality.s0.695
    N-Miss5515641252
    Mean (SD)0.89 (0.313)0.903 (0.297)0.909 (0.289)0.901 (0.299)
    Q1, Q31, 11, 11, 11, 1
    Range0 - 10 - 10 - 10 - 1
+

Another option would be to specify the test and summary statistics. In fact, if I had a set of variables coded 0/1 and that was all I was summarizing, then I could change the global option for continuous variables to use the chi-square test and show countpct.

+
summary(tableby(arm ~ chisq(mdquality.s, "Nmiss","countpct"), data=mockstudy))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
mdquality.s0.694
    N-Miss5515641252
    041 (11)52 (9.72)31 (9.14)124 (9.94)
    1332 (89)483 (90.3)308 (90.9)1123 (90.1)
+
+
+

10. Change the ordering of the variables or delete a variable

+
mytab <- tableby(arm ~ sex + alk.phos + age, data=mockstudy)
+mytab2 <- mytab[c('age','sex','alk.phos')]
+summary(mytab2)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Age in Years0.614
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)60 (11.5)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
Gender0.190
    Male277 (64.7%)411 (59.5%)228 (60%)916 (61.1%)
    Female151 (35.3%)280 (40.5%)152 (40%)583 (38.9%)
alk.phos0.226
    N-Miss6914156266
    Mean (SD)176 (129)162 (122)174 (139)169 (128)
    Q1, Q389, 21785, 19587.8, 21086, 207
    Range11 - 85810 - 10147 - 9827 - 1014
+
summary(mytab[c('age','sex')], nsmall = 2)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Age in Years0.614
    Mean (SD)59.67 (11.36)60.3 (11.63)59.76 (11.5)59.99 (11.52)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
Gender0.190
    Male277 (64.72%)411 (59.48%)228 (60%)916 (61.11%)
    Female151 (35.28%)280 (40.52%)152 (40%)583 (38.89%)
+
summary(mytab[c(3,1)], nsmall = 3)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Age in Years0.614
    Mean (SD)59.673 (11.365)60.301 (11.632)59.763 (11.499)59.985 (11.519)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
Gender0.190
    Male277 (64.72%)411 (59.479%)228 (60%)916 (61.107%)
    Female151 (35.28%)280 (40.521%)152 (40%)583 (38.893%)
+
+
+

11. Merge two tableby objects together

+

It is possible to combine two tableby objects so that they print out together.

+
## demographics
+tab1 <- tableby(arm ~ sex + age, data=mockstudy,
+                control=tableby.control(numeric.stats=c("Nmiss","meansd"), total=FALSE))
+## lab data
+tab2 <- tableby(arm ~ hgb + alk.phos, data=mockstudy,
+                control=tableby.control(numeric.stats=c("Nmiss","median","q1q3"),
+                                        numeric.test="kwt", total=FALSE))
+names(tab1$x)
+

[1] “sex” “age”

+
names(tab2$x)
+

[1] “hgb” “alk.phos”

+
tab12 <- merge(tab1,tab2)
+class(tab12)
+

[1] “tableby”

+
names(tab12$x)
+

[1] “sex” “age” “hgb” “alk.phos”

+
summary(tab12) #, pfootnote=TRUE)
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)p value
Gender0.190
    Male277 (64.7%)411 (59.5%)228 (60%)
    Female151 (35.3%)280 (40.5%)152 (40%)
Age in Years0.614
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)
hgb0.570
    N-Miss6914156
    median12.112.212.4
    Q1, Q311, 13.411.1, 13.611.2, 13.6
alk.phos0.104
    N-Miss6914156
    median133116122
    Q1, Q389, 21785, 19587.8, 210
+
+
+

12. Add a title to the table

+

When creating a pdf the tables are automatically numbered and the title appears below the table. In Word and HTML, the titles appear un-numbered and above the table.

+
t1 <- tableby(arm ~ sex + age, data=mockstudy)
+summary(t1, title='Demographics')
+ + ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Demographics
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Gender0.190
    Male277 (64.7%)411 (59.5%)228 (60%)916 (61.1%)
    Female151 (35.3%)280 (40.5%)152 (40%)583 (38.9%)
Age in Years0.614
    Mean (SD)59.7 (11.4)60.3 (11.6)59.8 (11.5)60 (11.5)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
+
+
+

13. Modify how missing values are displayed

+

Depending on the report you are writing you have the following options: * Show how many subjects have each variable * Show how many subjects are missing each variable * Show how many subjects are missing each variable only if there are any missing values * Don’t indicate missing values at all

+
## look at how many missing values there are for each variable
+apply(is.na(mockstudy),2,sum)
+
##        case         age         arm         sex        race     fu.time 
+##           0           0           0           0           7           0 
+##     fu.stat          ps         hgb         bmi    alk.phos         ast 
+##           0         266         266          33         266         266 
+## mdquality.s     age.ord  age.ordnew     dtentry 
+##         252           0           1           5
+
## Show how many subjects have each variable (non-missing)
+summary(tableby(sex ~ ast + age, data=mockstudy,
+                control=tableby.control(numeric.stats=c("N","median"), total=FALSE)))
+ ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)p value
ast0.921
    N754479
    median2727
Age in Years0.048
    N916583
    median6160
+
## Always list the number of missing values
+summary(tableby(sex ~ ast + age, data=mockstudy,
+                control=tableby.control(numeric.stats=c("Nmiss2","median"), total=FALSE)))
+ ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)p value
ast0.921
    N-Miss162104
    median2727
Age in Years0.048
    N-Miss00
    median6160
+
## Only show the missing values if there are some (default)
+summary(tableby(sex ~ ast + age, data=mockstudy, 
+                control=tableby.control(numeric.stats=c("Nmiss","mean"),total=FALSE)))
+ ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)p value
ast0.921
    N-Miss162104
    mean35.936
Age in Years0.048
    mean60.559.2
+
## Don't show N at all
+summary(tableby(sex ~ ast + age, data=mockstudy, 
+                control=tableby.control(numeric.stats=c("mean"),total=FALSE)))
+ ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)p value
ast0.921
    mean35.936
Age in Years0.048
    mean60.559.2
+
+
+

14. Modify the number of digits used

+

Within tableby.control function there are 4 options for controlling the number of significant digits shown.

+
    +
  • digits: controls the number of significant digits (counting both before and after the decimal point) for continuous variables
    • +
  • nsmall: controls the number of digits after the decimal point for continous variables
    • +
  • nsmall.pct: controls the number of digits after the decimal point for percentages
    • +
  • digits.test: controls the number of digits after the decimal point for p-values (default=3)
    • +
+
summary(tableby(arm ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2, nsmall.pct=1)
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Gender0.19
    Male277 (64.7%)411 (59.5%)228 (60.0%)916 (61.1%)
    Female151 (35.3%)280 (40.5%)152 (40.0%)583 (38.9%)
Age in Years0.61
    Mean (SD)59.67 (11.36)60.3 (11.63)59.76 (11.5)59.99 (11.52)
    Q1, Q353, 6852, 6952, 6852, 68
    Range27 - 8819 - 8826 - 8519 - 88
fu.time<0.01
    Mean (SD)553.6 (419.6)731.2 (487.7)607.2 (435.5)649.1 (462.5)
    Q1, Q3255.5, 724.2345, 1046306.5, 807309.5, 878.5
    Range9 - 21700 - 247217 - 21180 - 2472
+

It is important to understand how R treats the digits argument. Here are some summaries for the variable pi. Note that with 4 digits, the number after the decimal point changes after multiplying pi by 10 or 100. However, the nsmall option specifies the number of values after the decimal point. The two can be used together (see the help file for format for more details on how that works).

+
format(pi, digits=1)
+
## [1] "3"
+
format(pi, digits=3)
+
## [1] "3.14"
+
format(pi, digits=4)
+
## [1] "3.142"
+
format(pi*10, digits=4)
+
## [1] "31.42"
+
format(pi*100, digits=4)
+
## [1] "314.2"
+
format(pi*100, nsmall=4)
+
## [1] "314.1593"
+
format(pi*100, nsmall=2, digits=4)
+
## [1] "314.16"
+
+
+

15. Create a user-defined summary statistic

+

For purposes of this example, the code below creates a trimmed mean function (trims 10%) and use that to summarize the data. Note the use of the ... which tells R to pass extra arguments on - this is required for user-defined functions. In this case, na.rm=T is passed to myfunc. The weights argument is also required, even though it isn’t passed on to the internal function in this particular example.

+
myfunc <- function(x, weights=rep(1,length(x)), ...){
+  mean(x, trim=.1, ...)
+}
+
+summary(tableby(sex ~ hgb, data=mockstudy, 
+                control=tableby.control(numeric.stats=c("Nmiss","myfunc"), numeric.test="kwt",
+                    stats.labels=list(Nmiss='Missing values', myfunc="Trimmed Mean, 10%"))))
+ +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Male (N=916)Female (N=583)Total (N=1499)p value
hgb<0.001
    Missing values162104266
    Trimmed Mean, 10%12.611.912.3
+
+
+

16. Use case-weights for creating summary statistics

+

When comparing groups, they are often unbalanced when it comes to nuisances such as age and sex. The tableby function allows you to create weighted summary statistics. If this option us used then p-values are not calculated (test=FALSE).

+
##create fake group that is not balanced by age/sex 
+set.seed(200)
+mockstudy$fake_arm <- ifelse(mockstudy$age>60 & mockstudy$sex=='Female',sample(c('A','B'),replace=T, prob=c(.2,.8)),
+                            sample(c('A','B'),replace=T, prob=c(.8,.4)))
+
+mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE)
+
+## create weights based on agegp and sex distribution
+tab1 <- with(mockstudy,table(agegp, sex))
+tab2 <- with(mockstudy, table(agegp, sex, fake_arm))
+tab2
+
## , , fake_arm = A
+## 
+##          sex
+## agegp     Male Female
+##   [18,50)   73     62
+##   [50,60)  128     94
+##   [60,70)  139      7
+##   [70,90)  102      0
+## 
+## , , fake_arm = B
+## 
+##          sex
+## agegp     Male Female
+##   [18,50)   79     48
+##   [50,60)  130     84
+##   [60,70)  156    166
+##   [70,90)  109    122
+
gpwts <- rep(tab1, length(unique(mockstudy$fake_arm)))/tab2
+gpwts[gpwts>50] <- 30
+
+## apply weights to subjects
+index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(fake_arm)))) 
+mockstudy$wts <- gpwts[index]
+
+## show weights by treatment arm group
+tapply(mockstudy$wts,mockstudy$fake_arm, summary)
+
## $A
+##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+##   1.774   1.894   2.069   2.276   2.082  24.710 
+## 
+## $B
+##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+##   1.000   1.042   1.924   1.677   1.985   2.292
+
orig <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, test=FALSE)
+summary(orig, title='No Case Weights used')
+ + ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
No Case Weights used
A (N=605)B (N=894)Total (N=1499)
Age in Years
    Mean (SD)57.4 (11.6)61.7 (11.1)60 (11.5)
    Q1, Q350, 6655, 7052, 68
    Range22 - 8519 - 8819 - 88
Gender
    Male442 (73.1%)474 (53%)916 (61.1%)
    Female163 (26.9%)420 (47%)583 (38.9%)
Surv(fu.time/365, fu.stat)
    Events5548021356
    medSurv1.51.491.5
+
tab1 <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, weights=wts)
+summary(tab1, title='Case Weights used')
+ + ++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Case Weights used
A (N=605)B (N=894)Total (N=1499)
Age in Years
    Mean (SD)58 (10.9)60.2 (11.4)59.1 (11.2)
    Q1, Q351, 6553, 6852, 67
    Range22 - 8519 - 8819 - 88
Gender
    Male916 (66.5%)916 (61.1%)1832 (63.7%)
    Female461 (33.5%)583 (38.9%)1044 (36.3%)
Surv(fu.time/365, fu.stat)
    Events125213482599
    medSurv1.531.51.53
+
+
+

17. Create your own p-value and add it to the table

+

When using weighted summary statistics, it is often desirable to then show a p-value from a model that corresponds to the weighted analysis. It is possible to add your own p-value and modify the column title for that new p-value. Another use for this would be to add standardized differences or confidence intervals instead of a p-value.

+

To add the p-value you simply need to create a data frame and use the function modpval.tableby. The first 2 columns in the dataframe are required and are the variable name and the new p-value. The third column can be used to indicate what method was used to calculate the p-value. If you specify use.pname=TRUE then the column name indicating the p-value will be also be used in the tableby summary.

+
mypval <- data.frame(variable=c('age','sex','Surv(fu.time/365, fu.stat)'), 
+                     adj.pvalue=c(.953,.811,.01), 
+                     method=c('Age/Sex adjusted model results'))
+tab2 <- modpval.tableby(tab1, mypval, use.pname=TRUE)
+summary(tab2, title='Case Weights used, p-values added') #, pfootnote=TRUE)
+ + +++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Case Weights used, p-values added
A (N=605)B (N=894)Total (N=1499)adj.pvalue
Age in Years0.953
    Mean (SD)58 (10.9)60.2 (11.4)59.1 (11.2)
    Q1, Q351, 6553, 6852, 67
    Range22 - 8519 - 8819 - 88
Gender0.811
    Male916 (66.5%)916 (61.1%)1832 (63.7%)
    Female461 (33.5%)583 (38.9%)1044 (36.3%)
Surv(fu.time/365, fu.stat)0.010
    Events125213482599
    medSurv1.531.51.53
+
+
+

18. For two-level categorical variables, only display one level.

+

If the cat.simplify option is set to TRUE then only the second level of the group. In the example below sex has the levels and “Female” is the second level, hence only the %female is shown in the table. Similarly, “mdquality.s” was turned to a factor and “1” is the second level, hence

+
levels(mockstudy$sex)
+

[1] “Male” “Female”

+
table2 <- tableby(arm~sex + factor(mdquality.s), data=mockstudy, cat.simplify=TRUE)
+summary(table2, labelTranslations=c(sex="Female", "factor(mdquality.s)"="MD Quality"))
+ ++++++++ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
A: IFL (N=428)F: FOLFOX (N=691)G: IROX (N=380)Total (N=1499)p value
Female151 (35.3%)280 (40.5%)152 (40%)583 (38.9%)0.190
MD Quality0.694
    N-Miss5515641252
    1332 (89%)483 (90.3%)308 (90.9%)1123 (90.1%)
+
+
+

19. Use tableby within an Sweave document

+

For those users who wish to create tables within an Sweave document, the following code seems to work.

+
\documentclass{article}
+
+\usepackage{longtable}
+\usepackage{pdfpages}
+
+\begin{document}
+
+\section{Read in Data}
+<<echo=TRUE>>=
+require(arsenal)
+require(knitr)
+require(rmarkdown)
+data(mockstudy)
+
+tab1 <- tableby(arm~sex+age, data=mockstudy)
+@
+
+\section{Convert Summary.Tableby to LaTeX}
+<<echo=TRUE, results='hide', message=FALSE>>=
+capture.output(summary(tab1), file="Test.md")
+
+## Convert R Markdown Table to LaTeX
+render("Test.md", pdf_document(keep_tex=TRUE))
+@ 
+
+\includepdf{Test.pdf}
+
+\end{document}
+
+
+

20. Export tableby object to a .CSV file

+

When looking at multiple variables it is sometimes useful to export the results to a csv file. The as.data.frame function creates a data frame object that can be exported or further manipulated within R.

+
tab1 <- tableby(arm~sex+age, data=mockstudy)
+summary(tab1, text=T)
+
## ---------------------------------------------------------------------------------------------------------------------------
+##                          A: IFL (N=428)      F: FOLFOX (N=691)   G: IROX (N=380)     Total (N=1499)      p value           
+## ----------------------- ------------------- ------------------- ------------------- ------------------- -------------------
+## Gender                                                                                                                0.190
+##    Male                 277 (64.7%)         411 (59.5%)         228 (60%)           916 (61.1%)        
+##    Female               151 (35.3%)         280 (40.5%)         152 (40%)           583 (38.9%)        
+## Age in Years                                                                                                          0.614
+##    Mean (SD)            59.7 (11.4)         60.3 (11.6)         59.8 (11.5)         60 (11.5)          
+##    Q1, Q3               53, 68              52, 69              52, 68              52, 68             
+##    Range                27 - 88             19 - 88             26 - 85             19 - 88            
+## ---------------------------------------------------------------------------------------------------------------------------
+
tmp <- as.data.frame(tab1)
+tmp
+
##           term variable A: IFL (N=428) F: FOLFOX (N=691) G: IROX (N=380)
+## 1       Gender      sex                                                 
+## 2         Male      sex    277 (64.7%)       411 (59.5%)       228 (60%)
+## 3       Female      sex    151 (35.3%)       280 (40.5%)       152 (40%)
+## 4 Age in Years      age                                                 
+## 5    Mean (SD)      age    59.7 (11.4)       60.3 (11.6)     59.8 (11.5)
+## 6       Q1, Q3      age         53, 68            52, 69          52, 68
+## 7        Range      age        27 - 88           19 - 88         26 - 85
+##   Total (N=1499) p value
+## 1                  0.190
+## 2    916 (61.1%)        
+## 3    583 (38.9%)        
+## 4                  0.614
+## 5      60 (11.5)        
+## 6         52, 68        
+## 7        19 - 88
+
# write.csv(tmp, '/my/path/here/mymodel.csv')
+
+
+

21. Write tableby object to a separate Word or HTML file

+
## write to an HTML document
+tab1 <- tableby(arm ~ sex + age, data=mockstudy)
+# write2html(tab1, "~/ibm/trash.html")
+
+## write to a Word document
+# write2word(tab1, "~/ibm/trash.doc", title="My table in Word")
+
+
+
+

Available Function Options

+
+

Summary statistics

+

The default summary statistics, by varible type, are:

+
    +
  • cont: Continuous variables will show by default Nmiss, meansd, q1q3, range
    • +
  • cat: Categorical and factor variables will show by default Nmiss, countpct
    • +
  • ordered: Ordered factors will show by default Nmiss, countpct
    • +
  • surv: Survival variables will show by default Nmiss, Nevents, medsurv
    • +
  • date: Date variables will show by default Nmiss, median, range
    • +
  • group: The grouping variable will show by default countpct
    • +
+

Any summary statistics standardly defined in R (e.g. mean, median, sd, med, range) can be specified, however there are a number of extra functions defined specifically for the tableby function.

+
    +
  • N: a count of the number of observations for a particular group
    • +
  • Nmiss: always show a count of the number of missing values for a variable within each group
    • +
  • Nmiss2: only show the count of the number of missing values if there are some missing values(not developed yet)
    • +
  • meansd: print the mean and standard deviation in the format mean(sd)
    • +
  • countpct: print the number of values in a category plus the percentage in the format N (%)
    • +
  • medianq1q3: print the median, 25th, and 75th quantiles median (Q1, Q3)
    • +
  • q1q3: print the 25th and 75th quantiles Q1, Q3
    • +
  • medianrange: print the median, minimum and maximum values median (minimum, maximum)
    • +
  • Nevents: print number of events for a survival object within each grouping level
    • +
  • medsurv: print the median survival
    • +
+
+
+

Testing options

+

The tests used to calculate p-values differ by the variable type, but can be specified explicitly in the formula statement or in the control function.

+

The following tests are accepted:

+
    +

  • anova: analysis of variance test; the default test for continuous variables. When the grouping variable has two levels, it is equivalent to the two-sample t-test with equal variance.

    • +

  • kwt: Kruskal-Wallis test, optional test for continuous variables. When the grouping variable has two levels, it is equivalent to the Wilcoxon Rank Sum test.

    • +

  • chisq: chi-square goodness of fit test for equal counts of a categorical variable across categories; the default for categorical or factor variables

    • +

  • fe: Fisher’s exact test for categorical variables; optional

    • +

  • logrank: log-rank test, the default test for time-to-event variables

    • +

  • trend: The independence_test function from the coin is used to test for trends. Whenthe grouping variable has two levels, it is equivalent to the Armitage trend test. This is the default for ordered factors

    • +
+
+
+

tableby.control settings

+

A quick way to see what arguments are possible to utilize in a function is to use the args() command. Settings involving the number of digits can be set in tableby.control or in summary.tableby.

+
args(tableby.control)
+
## function (test = TRUE, total = TRUE, test.pname = NULL, cat.simplify = FALSE, 
+##     numeric.test = "anova", cat.test = "chisq", ordered.test = "trend", 
+##     surv.test = "logrank", date.test = "kwt", numeric.stats = c("Nmiss", 
+##         "meansd", "q1q3", "range"), cat.stats = c("Nmiss", "countpct"), 
+##     ordered.stats = c("Nmiss", "countpct"), surv.stats = c("Nevents", 
+##         "medSurv"), date.stats = c("Nmiss", "median", "range"), 
+##     stats.labels = list(Nmiss = "N-Miss", Nmiss2 = "N-Miss", 
+##         meansd = "Mean (SD)", q1q3 = "Q1, Q3", range = "Range", 
+##         countpct = "Count (Pct)", Nevents = "Events", medsurv = "Median Survival"), 
+##     digits = 3, digits.test = NULL, nsmall = NULL, nsmall.pct = NULL, 
+##     ...) 
+## NULL
+

Settings:

+
    +
  • test=TRUE (show p-values in table)
    • +
  • total=TRUE (show summaries for entire dataset in addition to doing it by the group)
    • +
  • test.pname=NULL (column name used when supplying own “p-value” or other summary value to the report)
    • +
  • cat.simplify (for dichotomous variables, only show statistics for 2nd level)
    • +
  • digits=3 (number of significant digits for continuous variables)
    • +
  • digits.test=3 (number of significant digits for p-values)
    • +
  • nsmall=NULL (number of digits after the decimal point for continous variables)
    • +
  • nsmall.pct=2 (number of digits after the decimal for percentages)
    • +
  • test.pname=NULL (use column name other than “P-Value” )
    • +
  • numeric.test, numeric.stats
    • +
  • cat.test, cat.stats
    • +
  • ordered.test, ordered.stats
    • +
  • surv.test, surv.stats
    • +
+
+
+

summary.tableby settings

+

The summary.tableby function has options that modify how the table appears (such as adding a title or modifying labels).

+
args(arsenal:::summary.tableby)
+
## function (object, title = NULL, labelTranslations = NULL, digits = NA, 
+##     nsmall = NA, nsmall.pct = NA, digits.test = NA, text = FALSE, 
+##     removeBlanks = text, labelSize = 1.2, test = NA, test.pname = NA, 
+##     pfootnote = NA, total = NA, ...) 
+## NULL
+

Settings:

+
    +
  • digits
    • +
  • digits.test
    • +
  • nsmall
    • +
  • nsmall.pct
    • +
  • test.pname
    • +
  • title=NULL
    • +
  • labelTranslations (allows user to modify variable labels)
    • +
  • text=FALSE
    • +
  • removeBlanks=FALSE (used on conjunction with text=TRUE to clean up output)
    • +
  • labelSize=1.2
    • +
  • pfootnote
    • +
+
+
+ + + + +
+ + + + + + + + diff --git a/man/arsenal.Rd b/man/arsenal.Rd new file mode 100644 index 0000000..7452805 --- /dev/null +++ b/man/arsenal.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/arsenal.R +\docType{package} +\name{arsenal} +\alias{arsenal} +\alias{arsenal-package} +\title{An Arsenal of 'R' Functions for Large-Scale Statistical Summaries} +\description{ +An Arsenal of 'R' functions for large-scale statistical summaries, + which are streamlined to work within the latest reporting tools in 'R' and 'RStudio' and + which use formulas and versatile summary statistics for summary tables and models. +} +\section{Functions}{ + + +Below are listed some of the most widely used functions available in \code{arsenal}: + +\code{\link{tableby}}: Summary statistics Of a set of independent variables by a categorical variable. + +\code{\link{modelsum}}: Fit models over each of a set of independent variables with a response variable. + +\code{\link{freqlist}}: Approximate the output from SAS's \code{PROC FREQ} procedure when using the \code{/list} option of the \code{TABLE} statement. + +\code{\link{write2word}}, \code{\link{write2html}}, \code{\link{write2pdf}}: Functions to generate a word, html, or pdf document containing a single table. + +\code{\link{formulize}}: A shortcut to generate one-, two-, or many-sided formulas. + +\code{\link{mdy.Date}} and \code{\link{Date.mdy}}: Convert numeric dates for month, day, and year to Date object, and vice versa. +} + +\section{Data}{ + + +\code{\link{mockstudy}}: Mock study data for examples. +} +\examples{ +library(arsenal) + +} + diff --git a/man/as.data.frame.freqlist.Rd b/man/as.data.frame.freqlist.Rd new file mode 100644 index 0000000..50065af --- /dev/null +++ b/man/as.data.frame.freqlist.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/freqlist.internal.R +\name{as.data.frame.freqlist} +\alias{as.data.frame.freqlist} +\title{as.data.frame.freqlist} +\usage{ +\method{as.data.frame}{freqlist}(x, ...) +} +\arguments{ +\item{x}{An object of class \code{"freqlist"}.} + +\item{...}{optional arguments included for S3 consistency} +} +\value{ +A data.frame corresponding to the \code{freqlist} object. +} +\description{ +Convert \code{\link{freqlist}} object to a data.frame. +} + diff --git a/man/as.data.frame.modelsum.Rd b/man/as.data.frame.modelsum.Rd new file mode 100644 index 0000000..0bf4fe8 --- /dev/null +++ b/man/as.data.frame.modelsum.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.modelsum.R +\name{as.data.frame.modelsum} +\alias{as.data.frame.modelsum} +\title{as.data.frame.modelsum} +\usage{ +\method{as.data.frame}{modelsum}(x, ..., title = NULL, + labelTranslations = NULL, digits = NA, nsmall = NA, nsmall.ratio = NA, + digits.test = NA, show.intercept = NA, show.adjust = NA, + pFootnote = TRUE) +} +\arguments{ +\item{x}{An object of class \code{\link{modelsum}}.} + +\item{...}{Other arguments (not implemented a this time).} + +\item{title}{Title for the table, defaults to \code{NULL} (no title)} + +\item{labelTranslations}{List where name is the label in the output, and value is the label you +want displayed e.g. \code{list (q1q3: "Q1, Q3", medsurv = "Median Survival")}.} + +\item{digits}{Maximum number of digits to display for floating point numbers. +If \code{NA} (default), it uses the value from \code{object$control$digits} +(whose default is 3, which would result in, e.g., 12.3, 1.23, 0.123, and 0.012).} + +\item{nsmall}{Minimum number of digits to the right of the decimal point to display for +floating point numbers. If \code{NA} (default), it uses the value from \code{object$control$nsmall}. +Allowed non-\code{NA} values are \code{0 <= nsmall <= 20}.} + +\item{nsmall.ratio}{Minimum number of digits to the right of the decimal point to display +for the ratio statistics (OR, HR, RR). If \code{NA} (default) it uses the value from +\code{object$control$nsmall.ratio} (whose default is 2). +Allowed values are \code{0 <= nsmall.ratio <= 20}.} + +\item{digits.test}{Number of digits to display for a p-value. Default is 5 (e.g. 0.12345).} + +\item{show.intercept}{Logical, denoting if the intercept should be shown for each line} + +\item{show.adjust}{Logical, denoting if the adjust variables should be shown for each line.} + +\item{pFootnote}{Logical denoting if a footnote should be added describing the test used +to generate the p value. Default is \code{TRUE}.} +} +\value{ +A data.frame holding the modelsum +} +\description{ +Build a data.frame from the modelsum object and parameters, and return it +} +\author{ +Greg Dougherty +} + diff --git a/man/as.data.frame.tableby.Rd b/man/as.data.frame.tableby.Rd new file mode 100644 index 0000000..61250d8 --- /dev/null +++ b/man/as.data.frame.tableby.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.tableby.R +\name{as.data.frame.tableby} +\alias{as.data.frame.tableby} +\title{as.data.frame.tableby} +\usage{ +\method{as.data.frame}{tableby}(x, ..., title = NULL, + labelTranslations = NULL, digits = NA, nsmall = NA, nsmall.pct = NA, + digits.test = NA, test = NA, test.pname = NA, total = NA) +} +\arguments{ +\item{x}{An object of class \code{\link{tableby}}.} + +\item{...}{Other arguments (not in use at this time).} + +\item{title}{Title that will appear on the top of the header in the pretty-table rendering +of the tableby object} + +\item{labelTranslations}{All labels that are to appear in the pretty rendering of the \code{tableby} +results have both summary-statistic labels that are replaced by a formal label +(e.g., \code{meansd} by \code{"Mean (SD)"}), and the variables from the formula can be replaced +by a more formal name.} + +\item{digits}{Digits to round for significant digits of numeric, non-integer values. +If \code{digits.test} is not set, \code{digits} is used for that setting.} + +\item{nsmall}{Minimum number of digits to the right of the decimal point to display +for floating point numbers. If \code{NA} (default), it uses the value from +\code{object$control$nsmall}. Allowed non-\code{NA} values are \code{0 <= nsmall <= 20}.} + +\item{nsmall.pct}{Minimum number of digits to the right of the decimal point to display +for percent numbers. If \code{NA} (default), it uses the value from \code{object$control$nsmall.pct}.} + +\item{digits.test}{Significant digits by which to round for numeric test statistic p-values, +if the test was performed.} + +\item{test}{Logical, denoting whether the "p value" value should be printed. +If \code{NA} (default), it uses the value from \code{object$control$test}.} + +\item{test.pname}{Title for p-value (only matters if test is \code{TRUE}; default is "p value").} + +\item{total}{Logical, denoting whether to include the "total" value. +If \code{NA} (default), it uses the value from \code{object$control$total}.} +} +\value{ +Information is returned as a data.frame of the tableby +} +\description{ +Build a data.frame from the tableby object and parameters, and return it +} +\author{ +Gregory Dougherty, Jason Sinnwell, Beth Atkinson, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +} + diff --git a/man/formulize.Rd b/man/formulize.Rd new file mode 100644 index 0000000..b3e3830 --- /dev/null +++ b/man/formulize.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formulize.R +\name{formulize} +\alias{formulize} +\title{formulize} +\usage{ +formulize(y = "", x = "", ..., data = NULL) +} +\arguments{ +\item{y, x, ...}{Character vectors to be collapsed (by \code{"+"}) and put left-to-right in the formula. +If \code{data} is supplied, these can also be numeric, denoting which column name to use. See examples.} + +\item{data}{An R object with non-null column names.} +} +\description{ +A shortcut to generate one-, two-, or many-sided formulas from vectors of variable names. +} +\examples{ +## two-sided formula +formulize("y", c("x1", "x2", "x3")) + +## one-sided formula +formulize(x = c("x1", "x2", "x3")) + +## multi-sided formula +formulize("y", c("x1", "x2", "x3"), c("z1", "z2"), "w1") + +## can use numerics for column names +data(mockstudy) +formulize(y = 1, x = 2:4, data = mockstudy) + +## mix and match +formulize(1, c("x1", "x2", "x3"), data = mockstudy) + +## get an interaction +formulize("y", c("x1*x2", "x3")) + +## use in an lm +form <- formulize(2, 3:4, data = mockstudy) +summary(lm(form, data = mockstudy)) + +} +\author{ +Ethan Heinzen +} + diff --git a/man/freqlist.Rd b/man/freqlist.Rd new file mode 100644 index 0000000..8b36e1b --- /dev/null +++ b/man/freqlist.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/freqlist.R +\name{freqlist} +\alias{freqlist} +\alias{print.freqlist} +\title{freqlist} +\usage{ +freqlist(tab, sparse = FALSE, na.options = c("include", "showexclude", + "remove"), digits = 2, labelTranslations = NULL, groupBy = NULL, ...) + +\method{print}{freqlist}(x, ...) +} +\arguments{ +\item{tab}{an object of class \code{"table"} or class \code{"xtabs"}} + +\item{sparse}{a logical value indicating whether to keep rows with counts of zero. The default is \code{FALSE}.} + +\item{na.options}{a character string indicating how to handling missing values: 'include' +(include values with NAs in counts and percentages), +'showexclude' (show NAs but exclude from cumulative counts and all percentages), +'remove' (remove values with NAs); default is 'include'} + +\item{digits}{a single number indicating the number of digits for percentages (passed to \code{\link{round}}; default is 2.} + +\item{labelTranslations}{an optional character string of labels to use for variable levels when summarizing.} + +\item{groupBy}{an optional character string specifying a variable(s) to use for grouping when calculating cumulative +counts and percentages. \code{\link{summary.freqlist}} will also separate by grouping variable for printing.} + +\item{...}{additional arguments passed to the \code{\link[knitr]{kable}} function} + +\item{x}{an object of class \code{"freqlist"}} +} +\value{ +An object of class \code{"freqlist"} (invisibly for \code{print.freqlist}) +} +\description{ +Approximate the output from SAS's \code{PROC FREQ} procedure when using the \code{/list} option of the \code{TABLE} statement. +} +\examples{ +# load mockstudy data +data(mockstudy) +tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany") +noby <- freqlist(tab.ex, na.options = "include") +summary(noby) +withby <- freqlist(tab.ex, groupBy = c("arm","sex"), na.options = "showexclude") +summary(withby) +} +\author{ +Tina Gunderson +} +\seealso{ +\code{\link[base]{table}}, \code{\link[stats]{xtabs}}, \code{\link[knitr]{kable}} +} + diff --git a/man/freqlist.internal.Rd b/man/freqlist.internal.Rd new file mode 100644 index 0000000..7556480 --- /dev/null +++ b/man/freqlist.internal.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/freqlist.internal.R +\name{freqlist.internal} +\alias{freqlist.internal} +\alias{labels.freqlist} +\alias{labels<-.freqlist} +\title{Helper functions for freqlist} +\usage{ +\method{labels}{freqlist}(x) <- value + +\method{labels}{freqlist}(object, ...) +} +\arguments{ +\item{x, object}{A \code{freqlist} object.} + +\item{value}{A list of new labels.} + +\item{...}{Other arguments (not in use at this time, but included for S3 consistency)} +} +\description{ +A set of helper functions for \code{\link{freqlist}}. +} + diff --git a/man/grapes-nin-grapes.Rd b/man/grapes-nin-grapes.Rd new file mode 100644 index 0000000..25e2c2a --- /dev/null +++ b/man/grapes-nin-grapes.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/not.in.R +\name{\%nin\%} +\alias{\%nin\%} +\alias{nin} +\title{Not in} +\usage{ +x \%nin\% table +} +\arguments{ +\item{x}{vector or \code{NULL}: the values to be matched. + \link{Long vectors} are supported.} + +\item{table}{vector or \code{NULL}: the values to be matched against. + \link{Long vectors} are not supported.} +} +\value{ +The negation of \code{\link{\%nin\%}}. +} +\description{ +The not-in operator for R. +} +\examples{ +1 \%nin\% 2:10 +c("a", "b") \%nin\% c("a", "c", "d") +} +\author{ +Raymond Moore +} +\seealso{ +\code{\link{\%in\%}} +} + diff --git a/man/mdy.Date.Rd b/man/mdy.Date.Rd new file mode 100644 index 0000000..676e891 --- /dev/null +++ b/man/mdy.Date.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mdy.Date.R +\name{mdy.Date} +\alias{Date.mdy} +\alias{mdy.Date} +\title{Convert numeric dates to Date object, and vice versa} +\usage{ +mdy.Date(month, day, year, yearcut = 120) + +Date.mdy(date) +} +\arguments{ +\item{month}{integer, month (1-12).} + +\item{day}{integer, day of the month (1-31, depending on the month).} + +\item{year}{integer, either 2- or 4-digit year. If two-digit number, will add 1900 onto it, depending on range.} + +\item{yearcut}{cutoff for method to know if to convert to 4-digit year.} + +\item{date}{A date value.} +} +\value{ +\code{mdy.Date} returns a Date object, and Date.mdy returns a list with integer values for month, day, and year. +} +\description{ +Convert numeric dates for month, day, and year to Date object, and vice versa. +} +\details{ +More work may need to be done with yearcut and 2-digit years. Best to give a full 4-digit year. +} +\examples{ +mdy.Date(9, 2, 2013) + +tmp <- mdy.Date(9, 2, 2013) +Date.mdy(tmp) +} +\seealso{ +\code{\link{Date}}, \code{\link{DateTimeClasses}} +} + diff --git a/man/mockstudy.Rd b/man/mockstudy.Rd new file mode 100644 index 0000000..f138e7e --- /dev/null +++ b/man/mockstudy.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mockstudy.R +\docType{data} +\name{mockstudy} +\alias{mockstudy} +\title{Mock study data for examples} +\format{A data frame with 1499 observations on the following 15 variables: + \describe{ + \item{\code{case}}{a numeric identifier-patient ID} + \item{\code{age}}{age in years} + \item{\code{arm}}{treatment arm divided into 3 groups, character string } + \item{\code{sex}}{a factor with levels \code{Male} \code{Female}} + \item{\code{race}}{self-reported race/ethnicity, character string} + \item{\code{fu.time}}{survival or censoring time in years} + \item{\code{fu.stat}}{censoring status; 1=censor, 2=death} + \item{\code{ps}}{integer, ECOG performance score } + \item{\code{hgb}}{numeric, hemoglobin count} + \item{\code{bmi}}{numeric, body mass index, kg/m^2} + \item{\code{alk.phos}}{numeric, alkaline phosphatase} + \item{\code{ast}}{numeric, aspartate transaminase } + \item{\code{mdquality.s}}{integer, LASA QOL 0=Clinically Deficient, 1=Not Clinically Deficient } + \item{\code{age.ord}}{an ordered factor split of age, with levels + \code{10-19} < \code{20-29} < \code{30-39} < \code{40-49} < + \code{50-59} < \code{60-69} < \code{70-79} < \code{80-89}} + }} +\usage{ +mockstudy +} +\description{ +Mock clinical study data for examples to test data manipulation and statistical functions +} +\examples{ +data(mockstudy) +str(mockstudy) +} +\keyword{datasets} + diff --git a/man/modelsum.Rd b/man/modelsum.Rd new file mode 100644 index 0000000..dcbe264 --- /dev/null +++ b/man/modelsum.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelsum.R +\name{modelsum} +\alias{modelsum} +\alias{print.modelsum} +\alias{print.modelsumList} +\title{Fit models over each of a set of independent variables with a response variable} +\usage{ +modelsum(formula, family = "gaussian", data, adjust = NULL, + na.action = na.modelsum, subset = NULL, weights = NULL, + control = list(...), ...) + +\method{print}{modelsum}(x, ...) + +\method{print}{modelsumList}(x, ...) +} +\arguments{ +\item{formula}{an object of class \code{\link{formula}}; a symbolic description of the variables to be modeled. See "Details" for more information.} + +\item{family}{similar mechanism to \code{\link[stats]{glm}}, where the model to be fit is driven by the family, options include: binomial, gaussian, survival, +Poisson. Family options supported in glm can be in quotes or not, but survival requires quotes.} + +\item{data}{an optional data.frame, list or environment (or object coercible by \code{\link[base]{as.data.frame}} to a data frame) containing the +variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically +the environment from which \code{modelsum} is called.} + +\item{adjust}{an object of class \code{\link{formula}}, listing variables to adjust by in all models. Specify as a one-sided formula, +like: \code{~Age+ Sex}.} + +\item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. +The default is set by the \code{na.modelsum} setting of \code{options}, and is \code{na.fail} if that is unset. The default is +to include observations with \code{NA}s in x variables, but remove those with \code{NA} in response variable.} + +\item{subset}{an optional vector specifying a subset of observations (rows of \code{data}) to be used in the results. +Works as vector of logicals or an index.} + +\item{weights}{an optional vector specifying the weights to apply to each data observation (rows of \code{data})} + +\item{control}{control parameters to handle optional settings within \code{modelsum}. Control arguments can be passed to \code{modelsum}, +which are carried forward to \code{modelsum.control} via the \code{...} argument. See \code{\link{modelsum.control}} for more details.} + +\item{...}{additional arguments to be passed to internal \code{modelsum} functions. See "Details" for information.} + +\item{x}{An object of class \code{'modelsum'}, or a list of such objects.} +} +\value{ +An object with class \code{'modelsum'}, which is effectively a list with the variables from the right-side in x and the group variable in y. + Then, each item in x has these: + \item{fits}{a list with an item in X for each x in y ~ X + adjust variables} + \item{family}{family used in glm} + \item{Call}{Original call to modelsum} + \item{control}{list of control parameters used in \code{modelsum}, and to be used in \code{\link{summary.modelsum}}, + the result of \code{\link{modelsum.control}}} +} +\description{ +Fit and summarize models for each independent (x) variable with a response variable (y), with options to adjust by variables for each model. +} +\examples{ + +data(mockstudy) + +tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) +summary(tab1, text=TRUE) + +tab2 <- modelsum(alk.phos ~ arm + ps + hgb, adjust= ~age + sex, family="gaussian",data=mockstudy) +summary(tab2, text=TRUE) + +summary(tab2, show.intercept=FALSE, text=TRUE) + +tab2.df <- as.data.frame(tab2) + +tab2.df[1:5,] +} +\author{ +Jason Sinnwell, Patrick Votruba, Beth Atkinson, Gregory Dougherty, adapted from SAS Macro of the same name +} +\seealso{ +\code{\link{modelsum.control}}, \code{\link{summary.modelsum}}, \code{\link{formulize}} +} + diff --git a/man/modelsum.control.Rd b/man/modelsum.control.Rd new file mode 100644 index 0000000..d3e3e81 --- /dev/null +++ b/man/modelsum.control.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelsum.control.R +\name{modelsum.control} +\alias{modelsum.control} +\title{Control settings for \code{modelsum} function} +\usage{ +modelsum.control(digits = 3, nsmall = NULL, nsmall.ratio = 2, + digits.test = 3, show.adjust = TRUE, show.intercept = TRUE, + conf.level = 0.95, binomial.stats = c("OR", "CI.lower.OR", "CI.upper.OR", + "p.value", "concordance", "Nmiss"), gaussian.stats = c("estimate", + "std.error", "p.value", "adj.r.squared", "Nmiss"), poisson.stats = c("RR", + "CI.lower.RR", "CI.upper.RR", "p.value", "concordance", "Nmiss"), + survival.stats = c("HR", "CI.lower.HR", "CI.upper.HR", "p.value", + "concordance", "Nmiss"), ...) +} +\arguments{ +\item{digits}{Numeric, denoting the number of significant digits for beta coefficients and standard errors.} + +\item{nsmall}{Numeric, denoting the number of digits after the decimal point for beta coefficients and standard errors.} + +\item{nsmall.ratio}{Numeric, denoting the number of digits after the decimal point for ratios, e.g. OR, RR, HR.} + +\item{digits.test}{Numeric, denoting the number of significant digits for p-values.} + +\item{show.adjust}{Logical, denoting whether to show adjustment terms.} + +\item{show.intercept}{Logical, denoting whether to show intercept terms.} + +\item{conf.level}{Numeric, giving the confidence level.} + +\item{binomial.stats, survival.stats, gaussian.stats, poisson.stats}{Character vectors denoting which stats to show for the various model types.} + +\item{...}{Other arguments (not in use at this time).} +} +\value{ +A list with settings to be used within the \code{modelsum} function. +} +\description{ +Control test and summary settings for \code{\link{modelsum}} function. +} +\seealso{ +\code{\link{modelsum}}, \code{\link{summary.modelsum}} +} + diff --git a/man/modelsum.internal.Rd b/man/modelsum.internal.Rd new file mode 100644 index 0000000..6b46326 --- /dev/null +++ b/man/modelsum.internal.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modelsum.internal.R +\name{modelsum.internal} +\alias{[.modelsum} +\alias{labels.modelsum} +\alias{labels<-.modelsum} +\alias{merge.modelsum} +\alias{modelsum.internal} +\alias{na.modelsum} +\title{Helper functions for modelsum} +\usage{ +na.modelsum(object, ...) + +\method{[}{modelsum}(x, ...) + +\method{labels}{modelsum}(object, ...) + +\method{labels}{modelsum}(x) <- value + +\method{merge}{modelsum}(x, y, ...) +} +\arguments{ +\item{object}{A \code{data.frame} resulting form evaluating \code{modelsum} formula.} + +\item{...}{Other arguments, or a vector of indices for extracting.} + +\item{x, y}{A \code{modelsum} object.} + +\item{value}{A list of new labels.} +} +\value{ +\code{na.modelsum} returns a subsetted version of \code{object} (with attributes). +} +\description{ +A set of helper functions for \code{\link{modelsum}}. +} + diff --git a/man/summary.freqlist.Rd b/man/summary.freqlist.Rd new file mode 100644 index 0000000..bf4bab2 --- /dev/null +++ b/man/summary.freqlist.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.freqlist.R +\name{summary.freqlist} +\alias{summary.freqlist} +\title{summary.freqlist} +\usage{ +\method{summary}{freqlist}(object, single = FALSE, labelTranslations = NULL, + ...) +} +\arguments{ +\item{object}{an object of class \code{\link{freqlist}}} + +\item{single}{a logical value indicating whether to collapse results created using a groupBy variable into a single table for printing} + +\item{labelTranslations}{A character vector giving the labels. Overrides the labels in `freqlist`.} + +\item{...}{additional arguments passed to the \code{\link[knitr]{kable}} function} +} +\value{ +Invisibly returns \code{object}, and uses \code{\link[knitr]{kable}} to print the object. +} +\description{ +Summarize the \code{freqlist} object +} +\examples{ +# load mockstudy data +data(mockstudy) +tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany") +noby <- freqlist(tab.ex, na.options = "include") +summary(noby) +withby <- freqlist(tab.ex, groupBy = c("arm","sex"), na.options = "showexclude") +summary(withby) +} +\author{ +Tina Gunderson +} +\seealso{ +\code{\link[base]{table}}, \code{\link[stats]{xtabs}}, \code{\link[knitr]{kable}} +} + diff --git a/man/summary.modelsum.Rd b/man/summary.modelsum.Rd new file mode 100644 index 0000000..f19222b --- /dev/null +++ b/man/summary.modelsum.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.modelsum.R +\name{summary.modelsum} +\alias{summary.modelsum} +\title{Summarize a \code{modelsum} object.} +\usage{ +\method{summary}{modelsum}(object, title = NULL, labelTranslations = NULL, + digits = NA, nsmall = NA, nsmall.ratio = NA, digits.test = NA, + show.intercept = NA, show.adjust = NA, text = FALSE, + removeBlanks = text, labelSize = 1.2, pfootnote = TRUE, ...) +} +\arguments{ +\item{object}{The data defining the table to display} + +\item{title}{Title for the table, defaults to \code{NULL} (no title)} + +\item{labelTranslations}{List where name is the label in the output, and value is the label you +want displayed e.g. \code{list (q1q3: "Q1, Q3", medsurv = "Median Survival")}.} + +\item{digits}{Maximum number of digits to display for floating point numbers. +If \code{NA} (default), it uses the value from \code{object$control$digits} +(whose default is 3, which would result in, e.g., 12.3, 1.23, 0.123, and 0.012).} + +\item{nsmall}{Minimum number of digits to the right of the decimal point to display for +floating point numbers. If \code{NA} (default), it uses the value from \code{object$control$nsmall}. +Allowed non-\code{NA} values are \code{0 <= nsmall <= 20}.} + +\item{nsmall.ratio}{Minimum number of digits to the right of the decimal point to display +for the ratio statistics (OR, HR, RR). If \code{NA} (default) it uses the value from +\code{object$control$nsmall.ratio} (whose default is 2). +Allowed values are \code{0 <= nsmall.ratio <= 20}.} + +\item{digits.test}{Number of digits to display for a p-value. Default is 5 (e.g. 0.12345).} + +\item{show.intercept}{Logical, denoting if the intercept should be shown for each line} + +\item{show.adjust}{Logical, denoting if the adjust variables should be shown for each line.} + +\item{text}{Logical, denoting whether to print out the text version.} + +\item{removeBlanks}{Logical, denoting if any blank lines should be removed from the output. +Default is value of \code{"text"}, and will be set to \code{FALSE} if text is \code{FALSE}.} + +\item{labelSize}{Relative size difference between label column and other columns. +Default is 1.2: label column ~20\% bigger than other columns} + +\item{pfootnote}{Logical denoting if a footnote should be added describing the test used +to generate the p value. Default is \code{FALSE}.} + +\item{...}{Other arguments (not implemented a this time).} +} +\value{ +Results are cat'ed to stdout, and returned invisibly as a character vector. +} +\description{ +Format the information in \code{object} as a table using Pandoc coding or plain text, and cat it to stdout. +} +\author{ +Greg Dougherty +} +\seealso{ +\code{\link{modelsum}}, \code{\link{print.modelsum}}, \code{\link{as.data.frame.modelsum}} +} + diff --git a/man/summary.tableby.Rd b/man/summary.tableby.Rd new file mode 100644 index 0000000..840b74d --- /dev/null +++ b/man/summary.tableby.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.tableby.R +\name{summary.tableby} +\alias{summary.tableby} +\title{The summary method for a \code{tableby} object} +\usage{ +\method{summary}{tableby}(object, title = NULL, labelTranslations = NULL, + digits = NA, nsmall = NA, nsmall.pct = NA, digits.test = NA, + text = FALSE, removeBlanks = text, labelSize = 1.2, test = NA, + test.pname = NA, pfootnote = NA, total = NA, ...) +} +\arguments{ +\item{object}{An object of class \code{"tableby"}, made by the \code{\link{tableby}} function.} + +\item{title}{Title that will appear on the top of the header in the pretty-table rendering +of the tableby object} + +\item{labelTranslations}{All labels that are to appear in the pretty rendering of the \code{tableby} +results have both summary-statistic labels that are replaced by a formal label +(e.g., \code{meansd} by \code{"Mean (SD)"}), and the variables from the formula can be replaced +by a more formal name.} + +\item{digits}{Digits to round for significant digits of numeric, non-integer values. +If \code{digits.test} is not set, \code{digits} is used for that setting.} + +\item{nsmall}{Minimum number of digits to the right of the decimal point to display +for floating point numbers. If \code{NA} (default), it uses the value from +\code{object$control$nsmall}. Allowed non-\code{NA} values are \code{0 <= nsmall <= 20}.} + +\item{nsmall.pct}{Minimum number of digits to the right of the decimal point to display +for percent numbers. If \code{NA} (default), it uses the value from \code{object$control$nsmall.pct}.} + +\item{digits.test}{Significant digits by which to round for numeric test statistic p-values, +if the test was performed.} + +\item{text}{Logical, tell R to print the raw text version of the summary to the screen. +Default is \code{FALSE}, but recommended to be \code{TRUE} for interactive R session development.} + +\item{removeBlanks}{Logical, remove extra blanks in the pretty rendering of the table} + +\item{labelSize}{Relative size difference between label column and other columns. +Default is 1.2: label column ~20\% bigger than other columns.} + +\item{test}{Logical, denoting whether the "p value" value should be printed. +If \code{NA} (default), it uses the value from \code{object$control$test}.} + +\item{test.pname}{Title for p-value (only matters if test is \code{TRUE}; default is "p value").} + +\item{pfootnote}{Logical, denoting whether to add a footnote describing the test used to +generate the p value. Default is \code{FALSE}.} + +\item{total}{Logical, denoting whether to include the "total" value. +If \code{NA} (default), it uses the value from \code{object$control$total}.} + +\item{...}{Other arguments (not in use at this time).} +} +\value{ +Results are cat'ed to stdout, and returned invisibly as a data.frame of the \code{tableby} +} +\description{ +The summary method for a \code{\link{tableby}} object, which is a pretty rendering of a \code{\link{tableby}} +object into a publication-quality results table in R-studio, and can render well in text-only. +} +\details{ +For text-only, simply paste the summary stats together per variable, along with p-value and totals, +with group variable in the header. For other formats, the paste is done into a pandoc-style markup +such that it can be translated into 3 formats: latex, html, rft. The decision of which of those it +is translated to is left for run-time for whatever format into which the report is being generated. + +For all interative development within R sessions, \code{text=TRUE} is recommended. +} +\examples{ + +set.seed(100) +## make 3+ categories for response +nsubj <- 90 +mdat <- data.frame(Response=sample(c(1,2,3),nsubj, replace=TRUE), + Sex=sample(c("Male", "Female"), nsubj,replace=TRUE), + Age=round(rnorm(nsubj,mean=40, sd=5)), + HtIn=round(rnorm(nsubj,mean=65,sd=5))) + +## allow default summaries on RHS variables +out <- tableby(Response ~ Sex + Age + HtIn, data=mdat) +summary(out, text=TRUE) +labels(out) +labels(out) <- c(Age="Age (years)", HtIn="Height (inches)") +summary(out, labelTranslations=c(meansd="Mean-SD"), text=TRUE) + +} +\author{ +Gregory Dougherty, Jason Sinnwell, Beth Atkinson, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +} +\seealso{ +\code{\link{tableby.control}}, \code{\link{tableby}} +} + diff --git a/man/tableby.Rd b/man/tableby.Rd new file mode 100644 index 0000000..79879de --- /dev/null +++ b/man/tableby.Rd @@ -0,0 +1,136 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tableby.R +\name{tableby} +\alias{print.tableby} +\alias{tableby} +\title{Summary Statistics of a Set of Independent Variables by a Categorical Variable} +\usage{ +tableby(formula, data, na.action, subset = NULL, weights = NULL, + control = list(...), ...) + +\method{print}{tableby}(x, ...) +} +\arguments{ +\item{formula}{an object of class \code{\link{formula}}; a symbolic description of the variables to be summarized by the group, +or categorical variable, of interest. See "Details" for more information. To only view overall summary +statistics, a one-sided formula can be used.} + +\item{data}{an optional data frame, list or environment (or object coercible by \code{\link{as.data.frame}} to a data frame) +containing the variables in the model. If not found in data, the variables are taken from \code{environment(formula)}, +typically the environment from which \code{tableby} is called.} + +\item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. +The default is \code{na.tableby} if there is a by variable, and \code{\link[stats]{na.pass}} if there is not. +This schema thus includes observations with \code{NA}s in x variables, +but removes those with \code{NA} in the categorical group variable.} + +\item{subset}{an optional vector specifying a subset of observations (rows of data) to be used in the results. +Works as vector of logicals or an index.} + +\item{weights}{a vector of weights.} + +\item{control}{control parameters to handle optional settings within \code{tableby}. +Two aspects of \code{tableby} are controlled with these: test options of RHS variables across levels of the categorical +grouping variable, and x variable summaries within the grouping variable. Arguments for \code{tableby.control} +can be passed to \code{tableby} and will be set with \code{tableby.control}, but if using +\code{control=tableby.control(test=TRUE), test=FALSE}, \code{test} will be \code{TRUE}. See \code{\link{tableby.control}} for more details.} + +\item{...}{additional arguments to be passed to internal \code{tableby} functions. See "Details" for information. +Currently not implemented in \code{print.tableby}.} + +\item{x}{an object of class \code{tableby}.} +} +\value{ +An object with class \code{'tableby'}, which is effectively a list with +the variables from the right-side in x and the group variable in y (if any). +Then, each item in x has these: + +\item{stats}{Summary statistics of the RHS variable within each level of the LHS variable} +\item{test}{Formal test of the distribution of the RHS variable across the levels of the LHS variable} +\item{label}{The label attribute of a variable. It is set to the label attribute of a data column, if it exists, + otherwise set to the variable name in \code{data}. Can be changed with \code{\link{labels.tableby}} function for the tableby object.} + +The object also contains the original function call and the \code{tableby.control} list that is used in \code{tableby}. +} +\description{ +Summarize one or more variables (x) by a categorical variable (y). Variables + on the right side of the formula, i.e. independent variables, are summarized by the + levels of a categorical variable on the left of the formula. Optionally, an appropriate test is performed to test the + distribution of the independent variables across the levels of the categorical variable. +} +\details{ +The group variable (if any) is categorical, which could be an integer, character, +factor, or ordered factor. \code{tableby} makes a simple summary of +the counts within the k-levels of the independent variables on the +right side of the formula. Note that unused levels are dropped. + +The \code{data} argument allows data.frames with label attributes for the columns, and those +labels will be used in the summary methods for the \code{tableby} class. + +The independent variables are a mixture of types: categorical (discrete), +numeric (continuous), and time to event (survival). These variables +are split by the levels of the group variable (if any), then summarized within +those levels, specific to the variable type. A statistical test is +performed to compare the distribution of the independent variables across the +levels of the grouping variable. + +The tests differ by the independent variable type, but can be specified +explicitly in the formula statement or in the control function. +These tests are accepted: +\itemize{ + \item{ + \code{anova}: analysis of variance test; the default test for continuous variables. When + LHS variable has two levels, equivalent to two-sample t-test. + } + \item{ + \code{kwt}: Kruskal-Wallis Rank Test, optional test for continuous + variables. When LHS variable has two levels, equivalent to Wilcoxon test. + } + \item{ + \code{chisq}: chi-square good-ness of fit test for equal counts of a + categorical variable across categories; the default for categorical + or factor variables + } + \item{ + \code{fe}: Fisher's exact test for categorical variables + } + \item{ + \code{trend}: trend test for equal distribution of an ordered variable + across a categorical variable; the default for ordered factor variables + } + \item{ + \code{logrank}: log-rank , the default for time-to-event variables + } +} + +To perform a mixture of asymptotic and rank-based tests on two +different continuous variables, an example formula is: +\code{formula = group ~ anova(age) + kwt(height)}. The test settings +in \code{tableby.control} apply to all independent variables of a given type. + +The summary statistics reported for each independent variable within the +group variable can be set in \code{\link{tableby.control}}. +} +\examples{ +data(mockstudy) +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +summary(tab1, text=TRUE) + +mylabels <- list( sex = "SEX", age ="Age, yrs") +summary(tab1, labelTranslations = mylabels, text=TRUE) + +tab3 <- tableby(arm ~ sex + age, data=mockstudy, test=FALSE, total=FALSE, + numeric.stats=c("median","q1q3"), numeric.test="kwt") +summary(tab3, text=TRUE) + +tab.test <- tableby(arm ~ kwt(age) + anova(bmi) + kwt(ast), data=mockstudy) +tests(tab.test) +} +\author{ +Jason Sinnwell, Beth Atkinson, Gregory Dougherty, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +} +\seealso{ +\code{\link[stats]{anova}}, \code{\link[stats]{chisq.test}}, \code{\link{tableby.control}}, + \code{\link{print.tableby}}, \code{\link{summary.tableby}}, \code{\link{formulize}} +} + diff --git a/man/tableby.control.Rd b/man/tableby.control.Rd new file mode 100644 index 0000000..cfd33b6 --- /dev/null +++ b/man/tableby.control.Rd @@ -0,0 +1,103 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tableby.control.R +\name{tableby.control} +\alias{tableby.control} +\title{Control settings for \code{tableby} function} +\usage{ +tableby.control(test = TRUE, total = TRUE, test.pname = NULL, + cat.simplify = FALSE, numeric.test = "anova", cat.test = "chisq", + ordered.test = "trend", surv.test = "logrank", date.test = "kwt", + numeric.stats = c("Nmiss", "meansd", "q1q3", "range"), + cat.stats = c("Nmiss", "countpct"), ordered.stats = c("Nmiss", + "countpct"), surv.stats = c("Nevents", "medSurv"), date.stats = c("Nmiss", + "median", "range"), stats.labels = list(Nmiss = "N-Miss", Nmiss2 = "N-Miss", + meansd = "Mean (SD)", q1q3 = "Q1, Q3", range = "Range", countpct = + "Count (Pct)", Nevents = "Events", medsurv = "Median Survival"), digits = 3, + digits.test = NULL, nsmall = NULL, nsmall.pct = NULL, ...) +} +\arguments{ +\item{test}{logical, telling \code{tableby} whether to perform tests of x variables across levels of the group variable.} + +\item{total}{logical, telling \code{tableby} whether to calculate a column of totals across group variable.} + +\item{test.pname}{character string denoting the p-value column name in \code{\link{summary.tableby}}. +Modifiable also with \code{\link{modpval.tableby}}.} + +\item{cat.simplify}{logical, tell \code{tableby} whether to include the first level of the categorical variable if binary. +If \code{TRUE}, only the summary stats of the second level, and total (if \code{TRUE}), are calculated. +NOTE: this only simplifies to one line if \code{cat.stats} is only one statistic, such as countpct. +Specifically, if \code{cat.stats} includes Nmiss and there are missings, then Nmiss is included in the stats.} + +\item{numeric.test}{set test for numeric RHS variables in \code{tableby} to anova or kwt (Kruskal-Wallis) rank-based tests. +If no LHS variable exists, then a mean is required for a univariate test.} + +\item{cat.test}{name of test for categorical variables: chisq, fe (Fisher's Exact)} + +\item{ordered.test}{name of test for ordered variables: trend} + +\item{surv.test}{name of test to perform for survival variables: logrank} + +\item{date.test}{name of test to perform for date variables.} + +\item{numeric.stats}{summary statistics to include for numeric RHS variables of \code{tableby} within the levels of the group LHS variable. +Options are N, Nmiss, mean, meansd, median, q1q3, range, or other R built-in or user-written functions.} + +\item{cat.stats}{summary statistics to include for categorical RHS variables of \code{tableby} within the levels of the group LHS variable. +Options are N, Nmiss, count, countpct, or other R built-in or user-written functions.} + +\item{ordered.stats}{summary statistics to include for categorical RHS variables of \code{tableby} within the levels of the group LHS variable. +Options are N, Nmiss, count, countpct, or other R built-in or user-written functions.} + +\item{surv.stats}{summary statistics to include for time-to-event (survival) RHS variables of \code{tableby} within the levels of the group LHS variable. +Options are Nevents, medsurv.} + +\item{date.stats}{stats functions to perform for Date variables} + +\item{stats.labels}{A named list of labels for all the statistics function names, where the function name is the named element in the list +and the value that goes with it is a string containing the formal name that will be printed in all printed renderings of the output, +e.g., list(countpct="Count(Pct)").} + +\item{digits}{digits to print for non-integer statistics} + +\item{digits.test}{digits to print for test statistic p-values} + +\item{nsmall}{digits to print after decimal point for numerics} + +\item{nsmall.pct}{digits to print after decimal point for percentages} + +\item{...}{additional arguments to be passed to internal \code{tableby} functions and kept for summary method options, such as digits.} +} +\value{ +A list with settings to be used within the \code{tableby} function. +} +\description{ +Control test and summary settings for the \code{\link{tableby}} function. +} +\details{ +All tests can be turned off by setting \code{test} to FALSE. + Otherwise, test are set to default settings in this list, or set explicitly in the formula of \code{tableby}. +} +\examples{ +set.seed(100) +## make 3+ categories for Response +mdat <- data.frame(Response=c(0,0,0,0,0,1,1,1,1,1), + Sex=sample(c("Male", "Female"), 10,replace=TRUE), + Age=round(rnorm(10,mean=40, sd=5)), + HtIn=round(rnorm(10,mean=65,sd=5))) + +## allow default summaries in RHS variables, and pass control args to +## main function, to be picked up with ... when calling tableby.control +outResp <- tableby(Response ~ Sex + Age + HtIn, data=mdat, total=FALSE, test=TRUE) +outCtl <- tableby(Response ~ Sex + Age + HtIn, data=mdat, + control=tableby.control(total=TRUE, cat.simplify=TRUE, + cat.stats=c("Nmiss","countpct"),digits=1)) +summary(outResp, text=TRUE) +summary(outCtl, text=TRUE) +} +\author{ +Jason Sinnwell, Beth Atkinson, Terry Therneau, adapted from SAS Macros written by Paul Novotny and Ryan Lennon +} +\seealso{ +\code{\link[stats]{anova}}, \code{\link[stats]{chisq.test}}, \code{\link{tableby}}, \code{\link{summary.tableby}} +} + diff --git a/man/tableby.internal.Rd b/man/tableby.internal.Rd new file mode 100644 index 0000000..0f1a70c --- /dev/null +++ b/man/tableby.internal.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tableby.internal.R +\name{tableby.internal} +\alias{[.tableby} +\alias{labels.tableby} +\alias{labels<-} +\alias{labels<-.tableby} +\alias{merge.tableby} +\alias{modpval.tableby} +\alias{na.tableby} +\alias{tableby.internal} +\alias{tests} +\alias{tests.tableby} +\title{Helper functions for tableby} +\usage{ +\method{merge}{tableby}(x, y, ...) + +modpval.tableby(x, pdata, use.pname = FALSE) + +\method{labels}{tableby}(object, ...) + +labels(x) <- value + +tests(x) + +\method{tests}{tableby}(x) + +\method{labels}{tableby}(x) <- value + +\method{[}{tableby}(x, ...) + +na.tableby(object, ...) +} +\arguments{ +\item{x, y}{A \code{tableby} object.} + +\item{...}{Other arguments, or a vector of indices for extracting.} + +\item{pdata}{A named data.frame where the first column is the x variable names matched by name, the second is the +p-values (or some test stat), and the third column is the method name (optional)} + +\item{use.pname}{Logical, denoting whether the column name in \code{pdata} corresponding to the p-values should be used +in the output of the object.} + +\item{object}{A \code{data.frame} resulting form evaluating \code{modelsum} formula.} + +\item{value}{A list of new labels.} +} +\value{ +\code{na.tableby} returns a subsetted version of \code{object} (with attributes). +} +\description{ +A set of helper functions for \code{\link{tableby}}. +} + diff --git a/man/tableby.stats.Rd b/man/tableby.stats.Rd new file mode 100644 index 0000000..6bbd44d --- /dev/null +++ b/man/tableby.stats.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tableby.stats.R +\name{tableby.stats} +\alias{N} +\alias{Nevents} +\alias{Nmiss} +\alias{countpct} +\alias{meansd} +\alias{medSurv} +\alias{median} +\alias{medianq1q3} +\alias{medianrange} +\alias{q1q3} +\alias{range} +\alias{tableby.stats} +\title{tableby Summary Statistics Functions} +\usage{ +meansd(x, na.rm = TRUE, weights = rep(1, length(x)), ...) + +medianrange(x, na.rm = TRUE, weights = rep(1, length(x)), ...) + +median(x, na.rm = TRUE, weights = rep(1, length(x)), ...) + +range(x, na.rm = TRUE, ...) + +Nevents(x, ...) + +medSurv(x, ...) + +q1q3(x, na.rm = TRUE, weights = rep(1, length(x)), ...) + +medianq1q3(x, na.rm = TRUE, weights = rep(1, length(x)), ...) + +Nmiss(x, levels = NULL, na.rm = TRUE, weights = rep(1, length(x)), ...) + +N(x, levels = NULL, na.rm = TRUE, weights = rep(1, length(x)), ...) + +countpct(x, levels = sort(unique(x)), na.rm = TRUE, weights = rep(1, + length(x)), ...) +} +\arguments{ +\item{x}{Usually a vector.} + +\item{na.rm}{Should NAs be removed?} + +\item{weights}{A vector of weights.} + +\item{...}{Other arguments.} + +\item{levels}{A vector of levels that character \code{x}s should have.} +} +\value{ +Usually a vector of the appropriate numbers. +} +\description{ +A collection of functions that will report summary statistics. To create a custom function, + consider using a function with all three arguments and \code{...}. See the \code{\link{tableby}} vignette + for an example. +} +\details{ +Not all these functions are exported, in order to avoid conflicting NAMESPACES. +} + diff --git a/man/write2.Rd b/man/write2.Rd new file mode 100644 index 0000000..6d194ac --- /dev/null +++ b/man/write2.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/write2.R +\name{write2} +\alias{write2} +\alias{write2html} +\alias{write2pdf} +\alias{write2word} +\title{write2word, write2html, write2pdf} +\usage{ +write2word(object, file, ..., keep.md = FALSE) + +write2pdf(object, file, ..., keep.md = FALSE) + +write2html(object, file, ..., keep.md = FALSE) +} +\arguments{ +\item{object}{An object whose \code{summary} output looks "good" when using \code{results='asis'} in markdown.} + +\item{file}{A single character string denoting the filename for the output document.} + +\item{...}{Additional arguments to be passed to \code{summary}, \code{rmarkdown::render}, etc. +One popular option is to use \code{quiet = TRUE} to suppress the command line output.} + +\item{keep.md}{Logical, denoting whether to keep the intermediate \code{.md} file.} +} +\value{ +\code{object} is returned invisibly, and \code{file} is written. +} +\description{ +Functions to generate a word, html, or pdf document containing a single table. +} +\details{ +This is (kind of) an S3 method (the real S3 method is \code{write2}),and the default + (used for \code{\link{tableby}}, \code{\link{modelsum}}, \code{\link{freqlist}}, etc.) assumes + that there is a \code{summary} method implemented. + + To generate the appropriate file type, the default uses one of \code{rmarkdown::word_document}, \code{rmarkdown::html_document}, + and \code{rmarkdown::pdf_document} to get the job done. \code{"..."} arguments are passed to these functions, too. +} +\examples{ +\dontrun{ +data(mockstudy) +# tableby example +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +write2html(tab1, "~/ibm/trash.html") + +# freqlist example +tab.ex <- table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany") +noby <- freqlist(tab.ex, na.options = "include") +write2pdf(noby, "~/ibm/trash2.pdf") + +# A more complicated example +write2word(tab1, "~/ibm/trash.doc", keep.md = TRUE, + reference_docx = mystyles.docx, # passed to rmarkdown::word_document + quiet = TRUE, # passed to rmarkdown::render + title = "My cool new title" # passed to summary.tableby +} +} +\author{ +Ethan Heinzen, adapted from code from Krista Goergen +} +\seealso{ +\code{\link[rmarkdown]{render}}, \code{\link[rmarkdown]{word_document}}, \code{\link[rmarkdown]{html_document}}, \code{\link[rmarkdown]{pdf_document}} +} + diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..a6ddc05 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(arsenal) + +test_check("arsenal") diff --git a/tests/testthat/test_formulize.R b/tests/testthat/test_formulize.R new file mode 100644 index 0000000..7db4245 --- /dev/null +++ b/tests/testthat/test_formulize.R @@ -0,0 +1,100 @@ +## Tests for formulize + + +context("Testing the formulize output") + +data(mockstudy) + +########################################################################################################### +#### Text input +########################################################################################################### + +test_that("Two-sided formula, text input", { + tmp <- capture.output(print(formulize("y", c("x1", "x2", "x3")))) + expect_identical(tmp[1], "y ~ x1 + x2 + x3") + expect_true(grepl(" +# %\VignetteIndexEntry{modelsum} +# %\VignetteEngine{knitr::rmarkdown} +# \usepackage[utf8]{inputenc} +``` + + +Introduction +============= + +Very often we are asked to summarize model results from multiple fits into a nice table. +The endpoint might be of different types (e.g., survival, case/control, continuous) and there +may be several independent variables that we want to examine univariately or adjusted for certain +variables such as age and sex. Locally, the SAS macros `%modelsum`, `%glmuniv`, and `%logisuni` +were written to create such summary tables. With the increasing interest in R, we have developed the +function `modelsum` to create similar tables within the R environment. + +In developing the `modelsum` function, the goal was to bring the best features of these macros into an R function. +However, the task was not simply to duplicate all the functionality, but rather to make use of R's strengths +(modeling, method dispersion, flexibility in function definition and output format) and make a tool that fits +the needs of R users. Additionally, the results needed to fit within the general reproducible research framework +so the tables could be displayed within an R markdown report. + +This report provides step-by-step directions for using the functions associated with `modelsum`. +All functions presented here are available within the `arsenal` package. An assumption is made that users +are somewhat familiar with R markdown documents. For those who are new to the topic, a good initial +resource is available at [rmarkdown.rstudio.com](rmarkdown.rstudio.com). + +Simple Example +================ + +The first step when using the `modelsum` function is to load the `arsenal` package. All the examples in this report +use a dataset called `mockstudy` made available by Paul Novotny which includes a variety of types of variables +(character, numeric, factor, ordered factor, survival) to use as examples. + +```{r, load-data} +require(arsenal) +data(mockstudy) # load data +dim(mockstudy) # look at how many subjects and variables are in the dataset +# help(mockstudy) # learn more about the dataset and variables +str(mockstudy) # quick look at the data +``` + +To create a simple linear regression table (the default), use a formula statement to specify the variables +that you want summarized. The example below predicts BMI with the variables sex and age. + +```{r simple1} +tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) +``` + +If you want to take a quick look at the table, you can use `summary` on your modelsum object and the table will +print out as text in your R console window. If you use `summary` without any options you will see a number of +$\ $ statements which translates to "space" in HTML. + +### Pretty text version of table + +If you want a nicer version in your console window then adding the `text=TRUE` option. + +```{r simple-text} +summary(tab1, text=TRUE) +``` + +### Pretty Rmarkdown version of table + +In order for the report to look nice within an R markdown (knitr) report, you just need to specify +`results="asis"` when creating the r chunk. This changes the layout slightly (compresses it) and bolds +the variable names. The three single quotes are often located above the tab key. + +`r ''` ```{r results="asis"} + + summary(tab1) + +``` + +```{r simple-markdown, results='asis'} +summary(tab1) +``` + +### Add an adjustor to the model + +The argument `adjust` allows the user to indicate that all the variables should be adjusted for these terms. + +```{r adjust, results="asis"} +tab2 <- modelsum(alk.phos ~ arm + ps + hgb, adjust= ~age + sex, data=mockstudy) +summary(tab2) +``` + + +Models for each endpoint type +================================== + +To make sure the correct model is run you need to specify "family". The options available right +now are : gaussian, binomial, survival, and poisson. If there is enough interest, additional models can be added. + +Gaussian +----------- + +### fit and summarize linear regression model + +Look at whether there is any evidence that AlkPhos values vary by study arm after adjusting for sex and age (assuming a linear age relationship). + +```{r} +fit <- lm(alk.phos ~ arm + age + sex, data=mockstudy) +summary(fit) +plot(fit) +``` + +The results suggest that the endpoint may need to be transformed. Calculating the Box-Cox transformation suggests a log transformation. + +```{r} +require(MASS) +boxcox(fit) +``` + +```{r} +fit2 <- lm(log(alk.phos) ~ arm + age + sex, data=mockstudy) +summary(fit2) +plot(fit2) +``` + +Finally, look to see whether there there is a non-linear relationship with age. + +```{r} +require(gam) +fit3 <- lm(log(alk.phos) ~ arm + ns(age, df=2) + sex, data=mockstudy) + +# test whether there is a difference between models +anova(fit2,fit3) + +# look at functional form of age +termplot(fit3, term=2, se=T, rug=T) +``` + +In this instance it looks like there isn't enough evidence to say that the relationship is non-linear. + +### extract data using the `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tmp <- tidy(fit3) # coefficients, p-values +class(tmp) +tmp + +glance(fit3) +``` + +### create a summary table using modelsum + +```{r, results="asis"} +ms.logy <- modelsum(log(alk.phos) ~ arm + ps + hgb, data=mockstudy, adjust= ~age + sex, + family=gaussian, + gaussian.stats=c("estimate","CI.lower.estimate","CI.upper.estimate","p.value")) +summary(ms.logy) +``` + +Binomial +---------- + +### fit and summarize logistic regression model + +```{r} +boxplot(age ~ mdquality.s, data=mockstudy, ylab=attr(mockstudy$age,'label'), xlab='mdquality.s') + +fit <- glm(mdquality.s ~ age + sex, data=mockstudy, family=binomial) +summary(fit) + +# create Odd's ratio w/ confidence intervals +tmp <- data.frame(summary(fit)$coef) +tmp + +tmp$OR <- round(exp(tmp[,1]),2) +tmp$lower.CI <- round(exp(tmp[,1] - 1.96* tmp[,2]),2) +tmp$upper.CI <- round(exp(tmp[,1] + 1.96* tmp[,2]),2) +names(tmp)[4] <- 'P-value' + +kable(tmp[,c('OR','lower.CI','upper.CI','P-value')]) + +# Assess the predictive ability of the model + +# code using the pROC package +require(pROC) +pred <- predict(fit, type='response') +tmp <- pROC::roc(mockstudy$mdquality.s[!is.na(mockstudy$mdquality.s)]~ pred, plot=TRUE, percent=TRUE) +tmp$auc + +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit, exp=T, conf.int=T) # coefficients, p-values, conf.intervals + +glance(fit) # model summary statistics +``` + +### create a summary table using modelsum + +```{r, results="asis"} +summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial)) + +fitall <- modelsum(mdquality.s ~ age, data=mockstudy, family=binomial, + binomial.stats=c("Nmiss2","OR","p.value")) +summary(fitall) +``` + + +Survival +--------- + +### fit and summarize a Cox regression model + +```{r survival} +require(survival) + +# multivariable model with all 3 terms +fit <- coxph(Surv(fu.time, fu.stat) ~ age + sex + arm, data=mockstudy) +summary(fit) + +# check proportional hazards assumption +fit.z <- cox.zph(fit) +fit.z +plot(fit.z[1], resid=FALSE) # makes for a cleaner picture in this case +abline(h=coef(fit)[1], col='red') + +# check functional form for age using pspline (penalized spline) +# results are returned for the linear and non-linear components +fit2 <- coxph(Surv(fu.time, fu.stat) ~ pspline(age) + sex + arm, data=mockstudy) +fit2 + +# plot smoothed age to visualize why significant +termplot(fit2, se=T, terms=1) +abline(h=0) + +# The c-statistic comes out in the summary of the fit +summary(fit2)$concordance + +# It can also be calculated using the survConcordance function +survConcordance(Surv(fu.time, fu.stat) ~ predict(fit2), data=mockstudy) +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit) # coefficients, p-values + +glance(fit) # model summary statistics +``` + +### create a summary table using modelsum + +```{r results="asis"} +##Note: You must use quotes when specifying family="survival" +## family=survival will not work +summary(modelsum(Surv(fu.time, fu.stat) ~ arm, + adjust=~age + sex, data=mockstudy, family="survival")) + +##Note: the pspline term is not working yet +#summary(modelsum(Surv(fu.time, fu.stat) ~ arm, +# adjust=~pspline(age) + sex, data=mockstudy, family='survival')) +``` + + +Poisson +-------- + +Poisson regression is useful when predicting an outcome variable representing counts. +It can also be useful when looking at survival data. Cox models and Poisson models are very closely +related and survival data can be summarized using Poisson regression. If you have overdispersion (see +if the residual deviance is much larger than degrees of freedom), you may want to use `quasipoisson()` +instead of `poisson()`. Some of these diagnostics need to be done outside of `modelsum`. + +### Example 1: fit and summarize a Poisson regression model + +For the first example, use the solder dataset available in the `rpart` package. The endpoint `skips` has a definite Poisson look. + +```{r poisson} +require(rpart) ##just to get access to solder dataset +data(solder) +hist(solder$skips) + +fit <- glm(skips ~ Opening + Solder + Mask , data=solder, family=poisson) +anova(fit, test='Chi') +summary(fit) +``` + +Overdispersion is when the Residual deviance is larger than the degrees of freedom. This can be tested, approximately using the following code. The goal is to have a p-value that is $>0.05$. + +```{r} +1-pchisq(fit$deviance, fit$df.residual) +``` + +One possible solution is to use the quasipoisson family instead of the poisson family. This adjusts for the overdispersion. + +```{r} +fit2 <- glm(skips ~ Opening + Solder + Mask, data=solder, family=quasipoisson) +summary(fit2) +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit) # coefficients, p-values + +glance(fit) # model summary statistics +``` + + +### create a summary table using modelsum + +```{r results='asis'} +summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="quasipoisson")) +summary(modelsum(skips~Opening + Solder + Mask, data=solder, family="poisson")) +``` + +### Example 2: fit and summarize a Poisson regression model + +This second example uses the survival endpoint available in the `mockstudy` dataset. There is a close +relationship between survival and Poisson models, and often it is easier to fit the model using Poisson +regression, especially if you want to present absolute risk. + +```{r} +# add .01 to the follow-up time (.01*1 day) in order to keep everyone in the analysis +fit <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, data=mockstudy, family=poisson) +summary(fit) +1-pchisq(fit$deviance, fit$df.residual) + +coef(coxph(Surv(fu.time,fu.stat) ~ age + sex + arm, data=mockstudy)) +coef(fit)[-1] + +# results from the Poisson model can then be described as risk ratios (similar to the hazard ratio) +exp(coef(fit)[-1]) + +# As before, we can model the dispersion which alters the standard error +fit2 <- glm(fu.stat ~ offset(log(fu.time+.01)) + age + sex + arm, + data=mockstudy, family=quasipoisson) +summary(fit2) +``` + +### extract data using `broom` package + +The `broom` package makes it easy to extract information from the fit. + +```{r} +tidy(fit) ##coefficients, p-values + +glance(fit) ##model summary statistics +``` + + +### create a summary table using modelsum + +Remember that the result from `modelsum` is different from the `fit` above. The `modelsum` +summary shows the results for `age + offset(log(fu.time+.01))` then `sex + offset(log(fu.time+.01))` +instead of `age + sex + arm + offset(log(fu.time+.01))`. + +```{r results="asis", eval=TRUE} +summary(modelsum(fu.stat ~ age, adjust=~offset(log(fu.time+.01))+ sex + arm, + data=mockstudy, family=poisson)) + +``` + + +Additional Examples +==================== + +Here are multiple examples showing how to use some of the different options. + +###1. Change summary statistics globally + +There are standard settings for each type of model regarding what information is summarized in the table. +This behavior can be modified using the modelsum.control function. In fact, you can save your standard +settings and use that for future tables. + + +```{r, results='asis'} +mycontrols <- modelsum.control(gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"), + show.adjust=FALSE, show.intercept=FALSE) +tab2 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy, control=mycontrols) +summary(tab2) +``` + +You can also change these settings directly in the modelsum call. + +```{r, results='asis'} +tab3 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy, + gaussian.stats=c("estimate","std.error","adj.r.squared","Nmiss"), + show.intercept=FALSE, show.adjust=FALSE) +summary(tab3) +``` + +###2. Add labels to independent variables + +In the above example, age is shown with a label (Age in Years), but sex is listed "as is". +This is because the data was created in SAS and in the SAS dataset, age had a label but sex did not. +The label is stored as an attribute within R. + +```{r check-labels} +## Look at one variable's label +attr(mockstudy$age,'label') + +## See all the variables with a label +unlist(lapply(mockstudy,'attr','label')) + +## or +cbind(sapply(mockstudy,attr,'label')) +``` + +If you want to add labels to other variables, there are a couple of options. First, you could add labels to the variables in your dataset. + +```{r add-label, results='asis'} +attr(mockstudy$age,'label') <- 'Age, yrs' + +tab1 <- modelsum(bmi ~ age, adjust=~sex, data=mockstudy) +summary(tab1) +``` + +Another option is to add labels after you have created the table + +```{r, results='asis'} +mylabels <- list(sexFemale = "Female", age ="Age, yrs") +summary(tab1, labelTranslations = mylabels) +``` + +Alternatively, you can check the variable labels and manipulate them with a function called labels, which works on the tableby object. + +```{r, eval=TRUE} +labels(tab1) +labels(tab1) <- c(sexFemale="Female", age="Baseline Age (yrs)") +labels(tab1) +``` + +```{r, results='asis'} +summary(tab1) +``` + +###2. Don't show intercept values + +```{r, results='asis'} +summary(modelsum(age~mdquality.s+sex, data=mockstudy), show.intercept=FALSE) +``` + +###3. Don't show results for adjustment variables + +```{r, results='asis'} +summary(modelsum(mdquality.s ~ age + bmi, data=mockstudy, adjust=~sex, family=binomial), + show.adjust=FALSE) +``` + +###4. Summarize multiple variables without typing them out + +Often one wants to summarize a number of variables. Instead of typing by hand each individual variable, +an alternative approach is to create a formula using the `paste` command with the `collapse="+"` option. + +```{r, results='asis'} +# create a vector specifying the variable names +myvars <- names(mockstudy) + +# select the 8th through the 12th +# paste them together, separated by the + sign +RHS <- paste(myvars[8:12], collapse="+") +RHS + +# create a formula using the as.formula function +as.formula(paste('mdquality.s ~ ', RHS)) + +# use the formula in the modelsum function +summary(modelsum(as.formula(paste('mdquality.s ~', RHS)), family=binomial, data=mockstudy)) +``` + +These steps can also be done using the `formulize` function. + +```{r, results='asis'} +## The formulize function does the paste and as.formula steps +tmp <- formulize('mdquality.s',myvars[8:10]) +tmp + +## More complex formulas could also be written using formulize +tmp2 <- formulize('mdquality.s',c('ps','hgb','sqrt(bmi)')) + +## use the formula in the modelsum function +summary(modelsum(tmp, data=mockstudy, family=binomial)) +``` + + +###5. Subset the dataset used in the analysis + +Here are two ways to get the same result (limit the analysis to subjects age>50 and in the F: FOLFOX treatment group). + +* The first approach uses the subset function applied to the dataset `mockstudy`. +This example also selects a subset of variables. The `modelsum` function is then applied to this subsetted data. + + +```{r} +newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(age,sex, bmi:alk.phos)) +dim(mockstudy) +table(mockstudy$arm) +dim(newdata) +names(newdata) +``` + +```{r, results='asis'} +summary(modelsum(alk.phos ~ ., data=newdata)) +``` + +* The second approach does the same analysis but uses the subset +argument within `modelsum` to subset the data. + +```{r, results='asis', eval=TRUE} +summary(modelsum(log(alk.phos) ~ sex + ps + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy)) +summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset = age>50 & bmi<24, data=mockstudy)) +summary(modelsum(alk.phos ~ ps + bmi, adjust=~sex, subset=1:30, data=mockstudy)) +``` + +###6. Create combinations of variables on the fly + +```{r} +## create a variable combining the levels of mdquality.s and sex +with(mockstudy, table(interaction(mdquality.s,sex))) +``` + +```{r, results='asis'} +summary(modelsum(age ~ interaction(mdquality.s,sex), data=mockstudy)) +``` + +###9. Transform variables on the fly + +Certain transformations need to be surrounded by `I()` so that R knows to treat it as a variable +transformation and not some special model feature. If the transformation includes any of the +symbols `/ - + ^ *` then surround the new variable by `I()`. + + +```{r, results='asis'} +summary(modelsum(arm=="F: FOLFOX" ~ I(age/10) + log(bmi) + mdquality.s, + data=mockstudy, family=binomial)) +``` + + +###10. Change the ordering of the variables or delete a variable + +```{r, results='asis'} +mytab <- modelsum(bmi ~ sex + alk.phos + age, data=mockstudy) +mytab2 <- mytab[c('age','sex','alk.phos')] +summary(mytab2) +summary(mytab[c('age','sex')]) +summary(mytab[c(3,1)]) +``` + +###11. Merge two modelsum objects together + +It is possible to combine two modelsum objects so that they print out together, however you need to pay +attention to the columns that are being displayed. It is easier to combine two models of the same +family (such as two sets of linear models). If you want to combine linear and logistic model results +then you would want to display the beta coefficients for the logistic model. + +```{r, results="asis"} +## demographics +tab1 <- modelsum(bmi ~ sex + age, data=mockstudy) +## lab data +tab2 <- modelsum(mdquality.s ~ hgb + alk.phos, data=mockstudy, family=binomial) + +tab12 <- merge(tab1,tab2) +class(tab12) + +##ERROR: The merge works, but not the summary +#summary(tab12) +``` + +###12. Add a title to the table + +When creating a pdf the tables are automatically numbered and the title appears below the table. +In Word and HTML, the titles appear un-numbered and above the table. + +```{r, results='asis'} +t1 <- modelsum(bmi ~ sex + age, data=mockstudy) +summary(t1, title='Demographics') +``` + +###13. Modify how missing values are treated + +Depending on the report you are writing you have the following options: + +* Use all values available for each variable +* Use only those subjects who have measurements available for all the variables + +```{r} +## look at how many missing values there are for each variable +apply(is.na(mockstudy),2,sum) +``` + +```{r, results='asis'} +## Show how many subjects have each variable (non-missing) +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("N","estimate")))) + +## Always list the number of missing values +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("Nmiss2","estimate")))) + +## Only show the missing values if there are some (default) +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("Nmiss","estimate")))) + +## Don't show N at all +summary(modelsum(bmi ~ ast + age, data=mockstudy, + control=modelsum.control(gaussian.stats=c("estimate")))) +``` + +###14. Modify the number of digits used + +Within modelsum.control function there are 4 options for controlling the number of significant digits shown. + +* digits: controls the number of significant digits (counting both before and after the decimal point) for continuous variables +* nsmall: controls the number of digits after the decimal point for the beta and standard error +* nsmall.ratio: controls the number of digits for the ratio statistics (OR, HR, RR), default=2 +* digits.test: controls the number of digits after the decimal point for p-values (default=3) + +```{r, results='asis'} +summary(modelsum(bmi ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2) +``` + +It is important to understand how R treats the `digits` argument. Here are some summaries for +the variable `pi`. Note that with 4 digits, the number after the decimal point changes after +multiplying pi by 10 or 100. However, the `nsmall` option specifies the number of values after +the decimal point. The two can be used together (see the help file for `format` for more details on how that works). + +```{r} +format(pi, digits=1) +format(pi, digits=3) +format(pi, digits=4) +format(pi*10, digits=4) +format(pi*100, digits=4) +format(pi*100, nsmall=4) +format(pi*100, nsmall=2, digits=4) +``` + +###15. Use case-weights in the models + +Occasionally it is of interest to fit models using case weights. +The `modelsum` function allows you to pass on the weights to the models and it will do the appropriate fit. + +```{r} +mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE) + +## create weights based on agegp and sex distribution +tab1 <- with(mockstudy,table(agegp, sex)) +tab1 +tab2 <- with(mockstudy, table(agegp, sex, arm)) +gpwts <- rep(tab1, length(unique(mockstudy$arm)))/tab2 + +## apply weights to subjects +index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(arm)))) +mockstudy$wts <- gpwts[index] + +## show weights by treatment arm group +tapply(mockstudy$wts,mockstudy$arm, summary) +``` + +```{r results='asis', warning=FALSE} +mockstudy$newvarA <- as.numeric(mockstudy$arm=='A: IFL') +tab1 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), + family=binomial) +summary(tab1, title='No Case Weights used') + +tab2 <- modelsum(newvarA ~ ast + bmi + hgb, data=mockstudy, subset=(arm !='G: IROX'), + weights=wts, family=binomial) +summary(tab2, title='Case Weights used') +``` + +###16. Use `modelsum` within an Sweave document + +For those users who wish to create tables within an Sweave document, the following code seems to work. + +``` +\documentclass{article} + +\usepackage{longtable} +\usepackage{pdfpages} + +\begin{document} + +\section{Read in Data} +<>= +require(arsenal) +require(knitr) +require(rmarkdown) +data(mockstudy) + +tab1 <- modelsum(bmi~sex+age, data=mockstudy) +@ + +\section{Convert Summary.modelsum to LaTeX} +<>= +capture.output(summary(tab1), file="Test.md") + +## Convert R Markdown Table to LaTeX +render("Test.md", pdf_document(keep_tex=TRUE)) +@ + +\includepdf{Test.pdf} + +\end{document} +``` +###17. Export `modelsum` results to a .CSV file + +When looking at multiple variables it is sometimes useful to export the results to a csv file. +The `as.data.frame` function creates a data frame object that can be exported or further manipulated within R. + + +```{r} +summary(tab2, text=T) +tmp <- as.data.frame(tab2) +tmp +# write.csv(tmp, '/my/path/here/mymodel.csv') +``` + +###18. Write `modelsum` object to a separate Word or HTML file + +```{r} +## write to an HTML document +# write2html(tab2, "~/ibm/trash.html") + +## write to a Word document +# write2word(tab2, "~/ibm/trash.doc", title="My table in Word") +``` + +Available Function Options +================================== + +### Summary statistics + +The available summary statistics, by varible type, are: + +* `binomial`,`quasibinomial`: Logistic regression models + + default: `OR, CI.lower.OR, CI.upper.OR, p.value, concordance, Nmiss` + + optional: `estimate, CI.lower.estimate, CI.upper.estimate, N, Nmiss2, + endpoint, std.error, statistic, logLik, AIC, + BIC, null.deviance, deviance, df.residual, df.null` +* `gaussian`: Linear regression models + + default: `estimate, std.error, p.value, adj.r.squared, Nmiss` + + optional: `CI.lower.estimate, CI.upper.estimate, + N, Nmiss2, statistic, standard.estimate, endpoint, + r.squared, AIC, BIC, logLik, statistic.F, p.value.F` +* `poisson`, `quasipoisson`: Poisson regression models + + default: `RR, CI.lower.RR, CI.upper.RR, p.value, concordance, Nmiss` + + optional: `CI.lower.estimate, CI.upper.estimate, CI.RR, Nmiss2, se, estimate, + z.stat, endpoint, AIC, BIC, logLik, dispersion, + null.deviance, deviance, df.residual, df.null` +* `survival`: Cox models + + default: `HR, CI.lower.HR, CI.upper.HR, p.value, concordance, Nmiss` + + optional: `CI.lower.estimate, CI.upper.estimate, N, Nmiss2, estimate, se, + endpoint, Nevents, z.stat, r.squared, logLik, + AIC, BIC, statistic.sc, p.value.sc, p.value.log, + p.value.wald, N, std.error.concordance` + +The full description of these parameters that can be shown for models include: + +* `N`: a count of the number of observations used in the analysis +* `Nmiss`: only show the count of the number of missing values if there are some missing values +* `Nmiss2`: always show a count of the number of missing values for a model +* `endpoint`: dependent variable used in the model +* `std.err`: print the standard error +* `statistic`: test statistic +* `statistic.F': test statistic (F test) +* `p.value`: print the p-value +* `r.squared`: print the model R-square +* `adj.r.squared`: print the model adjusted R-square +* `r.squared`: print the model R-square +* `concordance`: print the model C statistic (which is the AUC for logistic models) +* `logLik`: print the loglikelihood value +* `p.value.log`: print the p-value for the overall model likelihood test +* `p.value.wald`: print the p-value for the overall model wald test +* `p.value.sc`: print the p-value for overall model score test +* `AIC`: print the Akaike information criterion +* `BIC`: print the Bayesian information criterion +* `null.deviance`: null deviance +* `deviance`: model deviance +* `df.residual`: degrees of freedom for the residual +* `df.null`: degrees of freedom for the null model +* `dispersion`: This is used in Poisson models and is defined as the deviance/df.residual +* `statistic.sc`: overall model score statistic +* `std.error.concordance`: standard error for the C statistic +* `HR`: print the hazard ratio (for survival models), i.e. exp(beta) +* `CI.lower.HR, CI.upper.HR`: print the confidence interval for the HR +* `OR`: print the odd's ratio (for logistic models), i.e. exp(beta) +* `CI.lower.OR, CI.upper.OR`: print the confidence interval for the OR +* `RR`: print the risk ratio (for poisson models), i.e. exp(beta) +* `CI.lower.RR, CI.upper.RR`: print the confidence interval for the RR +* `estimate`: print beta coefficient +* `standardized.estimate`: print the standardized beta coefficient +* `CI.lower.estimate, CI.upper.estimate`: print the confidence interval for the beta coefficient + + +### modelsum.control settings + +A quick way to see what arguments are possible to utilize in a function is to use the `args()` +command. Settings involving the number of digits can be set in `modelsum.control` or in `summary.modelsum`. + +```{r} +args(modelsum.control) +``` + +Settings: + +* digits=3 (number of significant digits for beta coefficient and standard error) +* digits.test=3 (number of significant digits for p-values) +* nsmall=NULL (number of digits after the decimal point for beta coefficient and standard error) +* nsmall.ratio=2 (number of digits after the decimal point for ratios, e.g. OR, RR, HR) +* show.adjust=TRUE +* show.intercept = TRUE +* conf.level = 0.95 +* binomial.stats, quasibinomial.stats +* survival.stats +* gaussian.stats +* poisson.stats, quasipoisson.stats + + +### summary.modelsum settings + +The summary.modelsum function has options that modify how the table appears (such as adding a title or modifying labels). + +```{r} +args(arsenal:::summary.modelsum) +``` + +Settings: + +* title +* labelTranslations (allows user to modify variable labels) +* digits +* nsmall +* nsmall.ratio +* digits.test +* show.intercept +* show.adjust +* text=FALSE +* removeBlanks=FALSE (used on conjunction with text=TRUE to clean up output) +* labelSize=1.2 +* pfootnote + + + diff --git a/vignettes/tableby.Rmd b/vignettes/tableby.Rmd new file mode 100755 index 0000000..3e7d5a8 --- /dev/null +++ b/vignettes/tableby.Rmd @@ -0,0 +1,760 @@ +--- +title: "The tableby function" +author: "Beth Atkinson, Jason Sinnwell, Shannon McDonnell and Greg Dougherty" +date: '`r format(Sys.time(),"%d %B, %Y")`' +output: + html_document: + toc: yes + toc_depth: '3' + pdf_document: + toc: true + toc_depth: 3 +vignette: | + %\VignetteIndexEntry{The tableby function} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +--- + +Introduction +============= + +One of the most common tables in medical literature includes summary statistics for a set of variables, +often stratified by some group (e.g. treatment arm). Locally, the SAS macros `%table` and `%summary` were +written to create summary tables with a single call. With the increasing interest in R, we have developed +the function `tableby` to create similar tables within the R environment. + +In developing the `tableby` function, the goal was to bring the best features of these macros into an R function. +However, the task was not simply to duplicate all the functionality, but rather to make use of R's strengths +(modeling, method dispersion, flexibility in function definition and output format) and make a tool that fits +the needs of R users. Additionally, the results needed to fit within the general reproducible research framework +so the tables could be displayed within an R markdown report. + +This report provides step-by-step directions for using the functions associated with `tableby`. +All functions presented here are available within the `arsenal` package. An assumption is made that users +are somewhat familiar with R markdown documents. For those who are new to the topic, a good initial resource +is available at [rmarkdown.rstudio.com](rmarkdown.rstudio.com). + +Simple Example +================ + +The first step when using the `tableby` function is to load the `arsenal` package. All the examples in this report use +a dataset called `mockstudy` made available by Paul Novotny which includes a variety of types of variables (character, +numeric, factor, ordered factor, survival) to use as examples. + +```{r, load-data} +require(arsenal) +require(knitr) +require(survival) +data(mockstudy) ##load data +dim(mockstudy) ##look at how many subjects and variables are in the dataset +# help(mockstudy) ##learn more about the dataset and variables +str(mockstudy) ##quick look at the data +``` + +To create a simple table stratified by treament arm, use a formula statement to specify the variables that you want summarized. +The example below uses age (a continuous variable) and sex (a factor). + +```{r, simple1} +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +``` + +If you want to take a quick look at the table, you can use `summary` on your tableby object and the table +will print out as text in your R console window. If you use `summary` without any options you will see a +number of $\ $ statements which translates to "space" in HTML. + +### Pretty text version of table + +If you want a nicer version in your console window then adding the `text=TRUE` option. + +```{r, simple-text} +summary(tab1, text=TRUE) +``` + +### Pretty Rmarkdown version of table + +In order for the report to look nice within an R markdown (knitr) report, you just need to specify +`results="asis"` when creating the r chunk. This changes the layout slightly (compresses it) and bolds the variable names. + +`r ''` ```{r, results="asis"} + + summary(tab1) + +``` + +```{r, simple-markdown, results='asis'} +summary(tab1) +``` + +### Summaries using standard R code + +```{r} +## base R frequency example +tmp <- table(Gender=mockstudy$sex, "Study Arm"=mockstudy$arm) +tmp + +# Note: The continuity correction is applied by default in R (not used in %table) +chisq.test(tmp) + +## gmodels frequency example +#require(gmodels) +#CrossTable(mockstudy$sex, mockstudy$arm, prop.r=F, prop.t=F, +# prop.chisq=F, chisq=T, dnn=c('Gender','Study Arm')) + +## base R numeric summary example +tapply(mockstudy$age, mockstudy$arm, summary) +summary(aov(age ~ arm, data=mockstudy)) + +``` + +Modifying Output +================ + +### Add labels + +In the above example, age is shown with a label (Age in Years), but sex is listed "as is" with lower case letters. +This is because the data was created in SAS and in the SAS dataset, age had a label but sex did not. The label is stored as an attribute within R. + +```{r, check-labels} +## Look at one variable's label +attr(mockstudy$age,'label') + +## See all the variables with a label +unlist(lapply(mockstudy,'attr','label')) +``` + +If you want to add labels to other variables, there are a couple of options. First, you could add labels to the variables in your dataset. + +```{r, add-label, results='asis'} +attr(mockstudy$sex,'label') <- 'Gender' + +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +summary(tab1) +``` + +Another option is to add labels after you have created the table + +```{r, results='asis'} +mylabels <- list( sex = "SEX", age ="Age, yrs") +summary(tab1, labelTranslations = mylabels) +``` + +Alternatively, you can check the variable labels and manipulate them with a function called labels, which works on the tableby object. + +```{r, assignlabels} +labels(tab1) +labels(tab1) <- c(arm="Treatment Assignment", age="Baseline Age (yrs)") +labels(tab1) +``` + +```{r, results='asis'} +summary(tab1) +``` + +### Change summary statistics globally + +Currently the default behavior is to summarize continuous variables with: Number of missing values, +Mean (SD), 25th - 75th quantiles, and Minimum-Maximum values with an ANOVA (t-test with equal variances) p-value. +For categorical variables the default is to show: Number of missing values and count (column percent) with a +chi-square p-value. This behavior can be modified using the tableby.control function. In fact, you can save +your standard settings and use that for future tables. Note that `test=FALSE` and `total=FALSE` results in the +total column and p-value column not being printed. + + +```{r, results='asis'} +mycontrols <- tableby.control(test=FALSE, total=FALSE, + numeric.test="kwt", cat.test="chisq", + numeric.stats=c("N", "median", "q1q3"), + cat.stats=c("countpct"), + stats.labels=list(N='Count', median='Median', q1q3='Q1,Q3')) +tab2 <- tableby(arm ~ sex + age, data=mockstudy, control=mycontrols) +summary(tab2) +``` + +You can also change these settings directly in the tableby call. + +```{r, results='asis'} +tab3 <- tableby(arm ~ sex + age, data=mockstudy, test=FALSE, total=FALSE, + numeric.stats=c("median","q1q3"), numeric.test="kwt") +summary(tab3) +``` + + +### Change summary statistics within the formula + +In addition to modifying summary options globally, it is possible to modify the test and summary statistics for +specific variables within the formula statement. For example, both the kwt (Kruskal-Wallis rank-based) and anova +(asymptotic analysis of variance) tests apply to numeric variables and we can use one for the variable "age" and +another for the variable "ast". A list of all the options is shown at the end of the vignette. + +The `tests` function can do a quick check on what tests were performed on each variable in tableby. + +```{r, testformula} +tab.test <- tableby(arm ~ kwt(age) + anova(bmi) + kwt(ast), data=mockstudy) +tests(tab.test) +``` + +```{r, results='asis'} +summary(tab.test) +``` + +Summary statistics for any individual variable can also be modified, but it must be done as secondary +arguments to the test function. The function names must be strings that are functions already written for tableby, +built-in R functions like mean and range, or user-defined functions. + +```{r, testsAndStats, results='asis'} +tab.test <- tableby(arm ~ kwt(ast, "Nmiss2","median") + anova(age, "N","mean") + + kwt(bmi, "Nmiss","median"), data=mockstudy) +summary(tab.test) +``` + +### Modifying the look & feel in Word documents + +You can easily create Word versions of `tableby` output via an Rmarkdown report and the default options will give you a reasonable table in Word - just select the "Knit Word" option in RStudio. + +**The functionality listed in this next paragraph is coming soon but needs an upgraded version of RStudio** +If you want to modify fonts used for the table, then you'll need to add an extra line to your header at the beginning of your file. +You can take the `WordStylesReference01.docx` file and modify the fonts (storing the format preferences in your project directory). +To see how this works, run your report once using WordStylesReference01.docx and then WordStylesReference02.docx. + +``` +output: word_document + reference_docx: /projects/bsi/gentools/R/lib320/arsenal/doc/WordStylesReference01.docx +``` + +For more informating on changing the look/feel of your Word document, see the [Rmarkdown documentation](http://rmarkdown.rstudio.com/word_document_format.html) website. + + +Additional Examples +============================ + +Here are multiple examples showing how to use some of the different options. + +###1. Summarize without a group/by variable + +```{r, nobyvar, results='asis'} +tab.noby <- tableby(~ bmi + sex + age, data=mockstudy) +summary(tab.noby) +``` + +###2. Display footnotes indicating which "test" was used + +```{r, results="asis"} +summary(tab.test) #, pfootnote=TRUE) +``` + +###3. Summarize an ordered factor + +When comparing groups of ordered data there are a couple of options. The **default** uses a general independence test available from the `coin` package. +For two-group comparisons, this is essentially the Armitage trend test. The other option is to specify the Kruskal Wallis test. +The example below shows both options. + +```{r} +mockstudy$age.ordnew <- ordered(c("a",NA,as.character(mockstudy$age.ord[-(1:2)]))) +table(mockstudy$age.ord, mockstudy$sex) +table(mockstudy$age.ordnew, mockstudy$sex) +class(mockstudy$age.ord) +``` + +```{r, results="asis"} +summary(tableby(sex ~ age.ordnew, data = mockstudy)) #, pfootnote = TRUE) +summary(tableby(sex ~ kwt(age.ord), data = mockstudy)) #) #, pfootnote = TRUE) +``` + +###4. Summarize a survival variable + +First look at the information that is presented by the `survfit` function, then see how the same results can be seen with tableby. +The default is to show the median survival (time at which the probability of survival = 50%). + +```{r} +survfit(Surv(fu.time, fu.stat)~sex, data=mockstudy) +survdiff(Surv(fu.time, fu.stat)~sex, data=mockstudy) +``` + +```{r, results='asis'} +summary(tableby(sex ~ Surv(fu.time, fu.stat), data=mockstudy)) +``` + +It is also possible to obtain summaries of the %survival at certain time points (say the probability of surviving 1-year). + +```{r} +summary(survfit(Surv(fu.time/365.25, fu.stat)~sex, data=mockstudy), times=1:5) +``` + +```{r, results='asis'} +summary(tableby(sex ~ Surv(fu.time/365.25, fu.stat), data=mockstudy, times=1:5, surv.stats=c("NeventsSurv","NriskSurv"))) +``` + +###5. Summarize date variables + +Date variables by default are summarized with the number of missing values, the median, and the range. +For example purposes we've created a random date. Missing values are introduced for impossible February dates. + +```{r, results='asis'} +set.seed(100) +N <- nrow(mockstudy) +mockstudy$dtentry <- mdy.Date(month=sample(1:12,N,replace=T), day=sample(1:29,N,replace=T), + year=sample(2005:2009,N,replace=T)) +summary(tableby(sex ~ dtentry, data=mockstudy)) +``` + +###6. Summarize multiple variables without typing them out + +Often one wants to summarize a number of variables. Instead of typing by hand each individual variable, +an alternative approach is to create a formula using the `paste` command with the `collapse="+"` option. + +```{r, results='asis'} +## create a vector specifying the variable names +myvars <- names(mockstudy) + +## select the 8th through the last variables +## paste them together, separated by the + sign +RHS <- paste(myvars[8:10], collapse="+") +RHS + +## create a formula using the as.formula function +as.formula(paste('arm ~ ', RHS)) + +## use the formula in the tableby function +summary(tableby(as.formula(paste('arm ~', RHS)), data=mockstudy)) +``` + +These steps can also be done using the `formulize` function. + +```{r, results='asis'} +## The formulize function does the paste and as.formula steps +tmp <- formulize('arm',myvars[8:10]) +tmp + +## More complex formulas could also be written using formulize +tmp2 <- formulize('arm',c('ps','hgb^2','bmi')) + +## use the formula in the tableby function +summary(tableby(tmp, data=mockstudy)) +``` + +###7. Subset the dataset used in the analysis + +Here are two ways to get the same result (limit the analysis to subjects age>5 and in the F: FOLFOX treatment group). + +* The first approach uses the subset function applied to the dataset `mockstudy`. This example also selects a subset of variables. +The `tableby` function is then applied to this subsetted data. + + +```{r} +newdata <- subset(mockstudy, subset=age>50 & arm=='F: FOLFOX', select = c(sex,ps:bmi)) +dim(mockstudy) +table(mockstudy$arm) +dim(newdata) +names(newdata) +``` + +```{r, results='asis'} +summary(tableby(sex ~ ., data=newdata)) +``` + +* The second approach does the same analysis but uses the subset +argument within `tableby` to subset the data. + +```{r, results='asis'} +summary(tableby(sex ~ ps + hgb + bmi, subset=age>50 & arm=="F: FOLFOX", data=mockstudy)) +``` + +###8. Create combinations of variables on the fly + +```{r} +## create a variable combining the levels of mdquality.s and sex +with(mockstudy, table(interaction(mdquality.s,sex))) +``` + +```{r, results='asis'} +summary(tableby(arm ~ interaction(mdquality.s,sex), data=mockstudy)) +``` + +```{r, results='asis'} +## create a new grouping variable with combined levels of arm and sex +summary(tableby(interaction(mdquality.s, sex) ~ age + bmi, data=mockstudy, subset=arm=="F: FOLFOX")) +``` + +###9. Transform variables on the fly + +Certain transformations need to be surrounded by `I()` so that R knows to treat it as a variable transformation and +not some special model feature. If the transformation includes any of the symbols `/ - + ^ *` then surround the new variable by `I()`. + + +```{r, maketrans, results='asis'} +trans <- tableby(arm ~ I(age/10) + log(bmi) + factor(mdquality.s, levels=0:1, labels=c('N','Y')), + data=mockstudy) +summary(trans) +``` + +The labels for these variables isn't exactly what we'd like so we can change modify those after the fact. +Instead of typing out the very long variable names you can modify specific labels by position. + +```{r, assignlabels2} +labels(trans) +labels(trans)[2:4] <- c('Age per 10 yrs', 'log(BMI)', 'MD Quality') +labels(trans) +``` + +```{r, transsummary, results='asis'} +summary(trans) +``` + +Note that if we had not changed `mdquality.s` to a factor, it would have been summarized as though it were a continuous variable. + +```{r, results='asis'} +class(mockstudy$mdquality.s) +summary(tableby(arm~mdquality.s, data=mockstudy)) +``` + +Another option would be to specify the test and summary statistics. +In fact, if I had a set of variables coded 0/1 and that was all I was summarizing, then I could change the global option +for continuous variables to use the chi-square test and show countpct. + +```{r, results='asis'} +summary(tableby(arm ~ chisq(mdquality.s, "Nmiss","countpct"), data=mockstudy)) +``` + + +###10. Change the ordering of the variables or delete a variable + +```{r, results='asis'} +mytab <- tableby(arm ~ sex + alk.phos + age, data=mockstudy) +mytab2 <- mytab[c('age','sex','alk.phos')] +summary(mytab2) +summary(mytab[c('age','sex')], nsmall = 2) +summary(mytab[c(3,1)], nsmall = 3) + +``` + +###11. Merge two tableby objects together + +It is possible to combine two tableby objects so that they print out together. + +```{r, results="asis"} +## demographics +tab1 <- tableby(arm ~ sex + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","meansd"), total=FALSE)) +## lab data +tab2 <- tableby(arm ~ hgb + alk.phos, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","median","q1q3"), + numeric.test="kwt", total=FALSE)) +names(tab1$x) +names(tab2$x) +tab12 <- merge(tab1,tab2) +class(tab12) +names(tab12$x) +summary(tab12) #, pfootnote=TRUE) +``` + +###12. Add a title to the table + +When creating a pdf the tables are automatically numbered and the title appears below the table. In Word and HTML, the titles appear un-numbered and above the table. + +```{r, results='asis'} +t1 <- tableby(arm ~ sex + age, data=mockstudy) +summary(t1, title='Demographics') +``` + +###13. Modify how missing values are displayed + +Depending on the report you are writing you have the following options: +* Show how many subjects have each variable +* Show how many subjects are missing each variable +* Show how many subjects are missing each variable only if there are any missing values +* Don't indicate missing values at all + +```{r} +## look at how many missing values there are for each variable +apply(is.na(mockstudy),2,sum) +``` + +```{r, results='asis'} +## Show how many subjects have each variable (non-missing) +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("N","median"), total=FALSE))) + +## Always list the number of missing values +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss2","median"), total=FALSE))) + +## Only show the missing values if there are some (default) +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","mean"),total=FALSE))) + +## Don't show N at all +summary(tableby(sex ~ ast + age, data=mockstudy, + control=tableby.control(numeric.stats=c("mean"),total=FALSE))) +``` + +###14. Modify the number of digits used + +Within tableby.control function there are 4 options for controlling the number of significant digits shown. + +* digits: controls the number of significant digits (counting both before and after the decimal point) for continuous variables +* nsmall: controls the number of digits after the decimal point for continous variables +* nsmall.pct: controls the number of digits after the decimal point for percentages +* digits.test: controls the number of digits after the decimal point for p-values (default=3) + +```{r, results='asis'} +summary(tableby(arm ~ sex + age + fu.time, data=mockstudy), digits=4, digits.test=2, nsmall.pct=1) +``` + +It is important to understand how R treats the `digits` argument. Here are some summaries for the variable `pi`. +Note that with 4 digits, the number after the decimal point changes after multiplying pi by 10 or 100. +However, the `nsmall` option specifies the number of values after the decimal point. +The two can be used together (see the help file for `format` for more details on how that works). + +```{r} +format(pi, digits=1) +format(pi, digits=3) +format(pi, digits=4) +format(pi*10, digits=4) +format(pi*100, digits=4) +format(pi*100, nsmall=4) +format(pi*100, nsmall=2, digits=4) +``` + +###15. Create a user-defined summary statistic + +For purposes of this example, the code below creates a trimmed mean function (trims 10%) and use that to summarize the data. Note the use of the `...` which tells R to pass extra arguments on - this is required for user-defined functions. In this case, `na.rm=T` is passed to `myfunc`. The *weights* argument is also required, even though it isn't passed on to the internal function in this particular example. + +```{r, results='asis'} +myfunc <- function(x, weights=rep(1,length(x)), ...){ + mean(x, trim=.1, ...) +} + +summary(tableby(sex ~ hgb, data=mockstudy, + control=tableby.control(numeric.stats=c("Nmiss","myfunc"), numeric.test="kwt", + stats.labels=list(Nmiss='Missing values', myfunc="Trimmed Mean, 10%")))) + +``` + +###16. Use case-weights for creating summary statistics + +When comparing groups, they are often unbalanced when it comes to nuisances such as age and sex. +The `tableby` function allows you to create weighted summary statistics. If this option us used then p-values are not calculated (`test=FALSE`). + +```{r} +##create fake group that is not balanced by age/sex +set.seed(200) +mockstudy$fake_arm <- ifelse(mockstudy$age>60 & mockstudy$sex=='Female',sample(c('A','B'),replace=T, prob=c(.2,.8)), + sample(c('A','B'),replace=T, prob=c(.8,.4))) + +mockstudy$agegp <- cut(mockstudy$age, breaks=c(18,50,60,70,90), right=FALSE) + +## create weights based on agegp and sex distribution +tab1 <- with(mockstudy,table(agegp, sex)) +tab2 <- with(mockstudy, table(agegp, sex, fake_arm)) +tab2 +gpwts <- rep(tab1, length(unique(mockstudy$fake_arm)))/tab2 +gpwts[gpwts>50] <- 30 + +## apply weights to subjects +index <- with(mockstudy, cbind(as.numeric(agegp), as.numeric(sex), as.numeric(as.factor(fake_arm)))) +mockstudy$wts <- gpwts[index] + +## show weights by treatment arm group +tapply(mockstudy$wts,mockstudy$fake_arm, summary) +``` + +```{r, results='asis'} +orig <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, test=FALSE) +summary(orig, title='No Case Weights used') +tab1 <- tableby(fake_arm ~ age + sex + Surv(fu.time/365, fu.stat), data=mockstudy, weights=wts) +summary(tab1, title='Case Weights used') +``` + + +###17. Create your own p-value and add it to the table + +When using weighted summary statistics, it is often desirable to then show a p-value from a model that corresponds to the weighted analysis. +It is possible to add your own p-value and modify the column title for that new p-value. Another use for this would be to add standardized +differences or confidence intervals instead of a p-value. + +To add the p-value you simply need to create a data frame and use the function `modpval.tableby`. +The first 2 columns in the dataframe are required and are the variable name and the new p-value. +The third column can be used to indicate what method was used to calculate the p-value. +If you specify `use.pname=TRUE` then the column name indicating the p-value will be also be used in the tableby summary. + + +```{r, results='asis'} +mypval <- data.frame(variable=c('age','sex','Surv(fu.time/365, fu.stat)'), + adj.pvalue=c(.953,.811,.01), + method=c('Age/Sex adjusted model results')) +tab2 <- modpval.tableby(tab1, mypval, use.pname=TRUE) +summary(tab2, title='Case Weights used, p-values added') #, pfootnote=TRUE) +``` + +###18. For two-level categorical variables, only display one level. + +If the `cat.simplify` option is set to TRUE then only the second level of the group. In the example below +sex has the levels and "Female" is the second level, hence only the %female is shown in the table. Similarly, "mdquality.s" +was turned to a factor and "1" is the second level, hence + +```{r, results='asis'} +levels(mockstudy$sex) +table2 <- tableby(arm~sex + factor(mdquality.s), data=mockstudy, cat.simplify=TRUE) +summary(table2, labelTranslations=c(sex="Female", "factor(mdquality.s)"="MD Quality")) +``` + +###19. Use `tableby` within an Sweave document + +For those users who wish to create tables within an Sweave document, the following code seems to work. + +``` +\documentclass{article} + +\usepackage{longtable} +\usepackage{pdfpages} + +\begin{document} + +\section{Read in Data} +<>= +require(arsenal) +require(knitr) +require(rmarkdown) +data(mockstudy) + +tab1 <- tableby(arm~sex+age, data=mockstudy) +@ + +\section{Convert Summary.Tableby to LaTeX} +<>= +capture.output(summary(tab1), file="Test.md") + +## Convert R Markdown Table to LaTeX +render("Test.md", pdf_document(keep_tex=TRUE)) +@ + +\includepdf{Test.pdf} + +\end{document} +``` + +###20. Export `tableby` object to a .CSV file + +When looking at multiple variables it is sometimes useful to export the results to a csv file. The `as.data.frame` function creates a data frame object that can be exported or further manipulated within R. + +```{r} +tab1 <- tableby(arm~sex+age, data=mockstudy) +summary(tab1, text=T) + +tmp <- as.data.frame(tab1) +tmp + +# write.csv(tmp, '/my/path/here/mymodel.csv') +``` + +###21. Write `tableby` object to a separate Word or HTML file + +```{r} +## write to an HTML document +tab1 <- tableby(arm ~ sex + age, data=mockstudy) +# write2html(tab1, "~/ibm/trash.html") + +## write to a Word document +# write2word(tab1, "~/ibm/trash.doc", title="My table in Word") +``` + + +Available Function Options +================================== + +### Summary statistics + +The **default** summary statistics, by varible type, are: + +* `cont`: Continuous variables will show by default `Nmiss, meansd, q1q3, range` +* `cat`: Categorical and factor variables will show by default `Nmiss, countpct` +* `ordered`: Ordered factors will show by default `Nmiss, countpct` +* `surv`: Survival variables will show by default `Nmiss, Nevents, medsurv` +* `date`: Date variables will show by default `Nmiss, median, range` +* `group`: The grouping variable will show by default `countpct` + +Any summary statistics standardly defined in R (e.g. mean, median, sd, med, range) can be specified, +however there are a number of extra functions defined specifically for the tableby function. + +* `N`: a count of the number of observations for a particular group +* `Nmiss`: always show a count of the number of missing values for a variable within each group +* `Nmiss2`: only show the count of the number of missing values if there are some missing values(not developed yet) +* `meansd`: print the mean and standard deviation in the format `mean(sd)` +* `countpct`: print the number of values in a category plus the percentage in the format `N (%)` +* `medianq1q3`: print the median, 25th, and 75th quantiles `median (Q1, Q3)` +* `q1q3`: print the 25th and 75th quantiles `Q1, Q3` +* `medianrange`: print the median, minimum and maximum values `median (minimum, maximum)` +* `Nevents`: print number of events for a survival object within each grouping level +* `medsurv`: print the median survival + +### Testing options + +The tests used to calculate p-values differ by the variable type, but can be specified +explicitly in the formula statement or in the control function. + +The following tests are accepted: + +* `anova`: analysis of variance test; the default test for continuous variables. When + the grouping variable has two levels, it is equivalent to the two-sample t-test with equal variance. + +* `kwt`: Kruskal-Wallis test, optional test for continuous + variables. When the grouping variable has two levels, it is equivalent to the Wilcoxon Rank Sum test. + +* `chisq`: chi-square goodness of fit test for equal counts of a + categorical variable across categories; the default for categorical + or factor variables + +* `fe`: Fisher's exact test for categorical variables; optional + +* `logrank`: log-rank test, the default test for time-to-event + variables + +* `trend`: The `independence_test` function from the `coin` is used to test for trends. Whenthe grouping variable has two levels, + it is equivalent to the Armitage trend test. This is the default for ordered factors + +### tableby.control settings + +A quick way to see what arguments are possible to utilize in a function is to use the `args()` command. Settings involving the number of digits can be set in `tableby.control` or in `summary.tableby`. + +```{r} +args(tableby.control) +``` + +Settings: + +* test=TRUE (show p-values in table) +* total=TRUE (show summaries for entire dataset in addition to doing it by the group) +* test.pname=NULL (column name used when supplying own "p-value" or other summary value to the report) +* cat.simplify (for dichotomous variables, only show statistics for 2nd level) +* digits=3 (number of significant digits for continuous variables) +* digits.test=3 (number of significant digits for p-values) +* nsmall=NULL (number of digits after the decimal point for continous variables) +* nsmall.pct=2 (number of digits after the decimal for percentages) +* test.pname=NULL (use column name other than "P-Value" ) +* numeric.test, numeric.stats +* cat.test, cat.stats +* ordered.test, ordered.stats +* surv.test, surv.stats + +### summary.tableby settings + +The summary.tableby function has options that modify how the table appears (such as adding a title or modifying labels). + +```{r} +args(arsenal:::summary.tableby) +``` + +Settings: + +* digits +* digits.test +* nsmall +* nsmall.pct +* test.pname +* title=NULL +* labelTranslations (allows user to modify variable labels) +* text=FALSE +* removeBlanks=FALSE (used on conjunction with text=TRUE to clean up output) +* labelSize=1.2 +* pfootnote +