From 86b03577a76ad8b97d991028d4a0a82c3964ec44 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Fri, 19 Oct 2018 13:53:31 +0200 Subject: [PATCH] fix for as.mo, added also_single_tested --- DESCRIPTION | 4 +-- NAMESPACE | 5 +++ NEWS.md | 3 +- R/count.R | 15 ++++++--- R/data.R | 2 +- R/eucast.R | 41 +++++++++++++----------- R/mo.R | 11 +++---- R/portion.R | 21 ++++++++++--- R/rsi_calc.R | 57 ++++++++++++++++++++++++---------- data/microorganisms.certe.rda | Bin 13822 -> 13828 bytes man/count.Rd | 12 ++++--- man/microorganisms.certe.Rd | 2 +- man/portion.Rd | 17 +++++++--- tests/testthat/test-portion.R | 4 +++ 14 files changed, 128 insertions(+), 66 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ec73018b..54bff7fd 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.4.0.9004 -Date: 2018-10-17 +Version: 0.4.0.9005 +Date: 2018-10-19 Title: Antimicrobial Resistance Analysis Authors@R: c( person( diff --git a/NAMESPACE b/NAMESPACE index 7554b16a..b29d1ce5 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -175,6 +175,8 @@ importFrom(data.table,as.data.table) importFrom(data.table,data.table) importFrom(data.table,setkey) importFrom(dplyr,"%>%") +importFrom(dplyr,all_vars) +importFrom(dplyr,any_vars) importFrom(dplyr,arrange) importFrom(dplyr,arrange_at) importFrom(dplyr,as_tibble) @@ -184,7 +186,9 @@ importFrom(dplyr,case_when) importFrom(dplyr,desc) importFrom(dplyr,everything) importFrom(dplyr,filter) +importFrom(dplyr,filter_all) importFrom(dplyr,full_join) +importFrom(dplyr,funs) importFrom(dplyr,group_by) importFrom(dplyr,group_by_at) importFrom(dplyr,group_vars) @@ -192,6 +196,7 @@ importFrom(dplyr,if_else) importFrom(dplyr,lag) importFrom(dplyr,left_join) importFrom(dplyr,mutate) +importFrom(dplyr,mutate_all) importFrom(dplyr,mutate_at) importFrom(dplyr,n_distinct) importFrom(dplyr,progress_estimated) diff --git a/NEWS.md b/NEWS.md index 6cc75700..567fb82e 100755 --- a/NEWS.md +++ b/NEWS.md @@ -11,10 +11,11 @@ * Better error handling when rules cannot be applied (i.e. new values could not be inserted) * The amount of affected values will now only be measured once per row/column combination * Data set `septic_patients` now reflects these changes -* Empty values as input for `as.mo` will be processed faster +* Tremendous speed improvement for `as.mo` (and consequently all `mo_*` functions), as empty values wil be ignored a priori * Fewer than 3 characters as input for `as.mo` will return NA * Added parameter `combine_IR` (TRUE/FALSE) to functions `portion_df` and `count_df`, to indicate that all values of I and R must be merged into one, so the output only consists of S vs. IR (susceptible vs. non-susceptible) * Fix for `portion_*(..., as_percent = TRUE)` when minimal amount of isolates would not be met +* Added parameter `also_single_tested` for `portion_*` and `count_*` functions to also include cases where not all antibiotics were tested but at least one of the tested antibiotics includes the target antimicribial interpretation, see `?portion` * Using `portion_*` functions now throws a warning when total available isolate is below parameter `minimum` * Functions `as.mo`, `as.rsi` and `as.mic` will not set package name as attribute anymore * Data set `septic_patients` is now a `data.frame`, not a tibble anymore diff --git a/R/count.R b/R/count.R index 6dbcdbb4..d0bf15e7 100644 --- a/R/count.R +++ b/R/count.R @@ -92,56 +92,61 @@ #' group_by(hospital_id) %>% #' count_df(translate = FALSE) #' -count_R <- function(...) { +count_R <- function(..., also_single_tested = FALSE) { rsi_calc(..., type = "R", include_I = FALSE, minimum = 0, as_percent = FALSE, + also_single_tested = FALSE, only_count = TRUE) } #' @rdname count #' @export -count_IR <- function(...) { +count_IR <- function(..., also_single_tested = FALSE) { rsi_calc(..., type = "R", include_I = TRUE, minimum = 0, as_percent = FALSE, + also_single_tested = FALSE, only_count = TRUE) } #' @rdname count #' @export -count_I <- function(...) { +count_I <- function(..., also_single_tested = FALSE) { rsi_calc(..., type = "I", include_I = FALSE, minimum = 0, as_percent = FALSE, + also_single_tested = FALSE, only_count = TRUE) } #' @rdname count #' @export -count_SI <- function(...) { +count_SI <- function(..., also_single_tested = FALSE) { rsi_calc(..., type = "S", include_I = TRUE, minimum = 0, as_percent = FALSE, + also_single_tested = FALSE, only_count = TRUE) } #' @rdname count #' @export -count_S <- function(...) { +count_S <- function(..., also_single_tested = FALSE) { rsi_calc(..., type = "S", include_I = FALSE, minimum = 0, as_percent = FALSE, + also_single_tested = FALSE, only_count = TRUE) } diff --git a/R/data.R b/R/data.R index d919ffdb..9f07703b 100755 --- a/R/data.R +++ b/R/data.R @@ -175,7 +175,7 @@ #' Translation table for Certe #' #' A data set containing all bacteria codes of Certe MMB. These codes can be joined to data with an ID from \code{\link{microorganisms}$mo} (using \code{\link{left_join_microorganisms}}). GLIMS codes can also be translated to valid \code{MO}s with \code{\link{guess_mo}}. -#' @format A \code{\link{tibble}} with 2,664 observations and 2 variables: +#' @format A \code{\link{tibble}} with 2,665 observations and 2 variables: #' \describe{ #' \item{\code{certe}}{Code of microorganism according to Certe MMB} #' \item{\code{mo}}{Code of microorganism in \code{\link{microorganisms}}} diff --git a/R/eucast.R b/R/eucast.R index 47f395aa..220103ea 100755 --- a/R/eucast.R +++ b/R/eucast.R @@ -361,15 +361,20 @@ EUCAST_rules <- function(tbl, changed_results <<- changed_results + sum(before != after, na.rm = TRUE) # will be reset at start of every rule if (verbose == TRUE) { - verbose_new <- data.frame(rule_type = rule[1], - rule_set = rule[2], - force_to = to, - found = length(before), - changed = sum(before != after, na.rm = TRUE), - stringsAsFactors = FALSE) - verbose_new$target_columns <- list(unname(cols)) - verbose_new$target_rows <- list(unname(rows)) - verbose_info <<- rbind(verbose_info, verbose_new) + for (i in 1:length(cols)) { + # add new row for every affected column + verbose_new <- data.frame(rule_type = rule[1], + rule_set = rule[2], + force_to = to, + found = length(before), + changed = sum(before != after, na.rm = TRUE), + target_column = cols[i], + stringsAsFactors = FALSE) + verbose_new$target_rows <- list(unname(rows)) + rownames(verbose_new) <- NULL + verbose_info <<- rbind(verbose_info, verbose_new) + } + } } } @@ -410,15 +415,15 @@ EUCAST_rules <- function(tbl, # since ampicillin ^= amoxicillin, get the first from the latter (not in original table) if (!is.na(ampi) & !is.na(amox)) { if (verbose == TRUE) { - cat("\n VERBOSE: transforming", - length(which(tbl[, amox] == "S" & !tbl[, ampi] %in% c("S", "I", "R"))), - "empty ampicillin fields to 'S' based on amoxicillin.") - cat("\n VERBOSE: transforming", - length(which(tbl[, amox] == "I" & !tbl[, ampi] %in% c("S", "I", "R"))), - "empty ampicillin fields to 'I' based on amoxicillin.") - cat("\n VERBOSE: transforming", - length(which(tbl[, amox] == "R" & !tbl[, ampi] %in% c("S", "I", "R"))), - "empty ampicillin fields to 'R' based on amoxicillin.\n") + cat(bgGreen("\n VERBOSE: transforming", + length(which(tbl[, amox] == "S" & !tbl[, ampi] %in% c("S", "I", "R"))), + "empty ampicillin fields to 'S' based on amoxicillin. ")) + cat(bgGreen("\n VERBOSE: transforming", + length(which(tbl[, amox] == "I" & !tbl[, ampi] %in% c("S", "I", "R"))), + "empty ampicillin fields to 'I' based on amoxicillin. ")) + cat(bgGreen("\n VERBOSE: transforming", + length(which(tbl[, amox] == "R" & !tbl[, ampi] %in% c("S", "I", "R"))), + "empty ampicillin fields to 'R' based on amoxicillin. \n")) } tbl[which(tbl[, amox] == "S" & !tbl[, ampi] %in% c("S", "I", "R")), ampi] <- "S" tbl[which(tbl[, amox] == "I" & !tbl[, ampi] %in% c("S", "I", "R")), ampi] <- "I" diff --git a/R/mo.R b/R/mo.R index 6f3990e7..492b5dd8 100644 --- a/R/mo.R +++ b/R/mo.R @@ -195,7 +195,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = if (all(x %in% AMR::microorganisms[, property])) { # already existing mo } else if (all(x %in% AMR::microorganisms[, "mo"])) { - # existing mo codes + # existing mo codes when not looking for property "mo" suppressWarnings( x <- data.frame(mo = x, stringsAsFactors = FALSE) %>% left_join(AMR::microorganisms, by = "mo") %>% @@ -661,13 +661,12 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = x[x == MOs[mo == 'B_STRPTC_SAL', ..property][[1]][1L]] <- MOs[mo == 'B_STRPTC_GRK', ..property][[1]][1L] } - x_input_unique <- unique(x_input) - # fill in empty values again - x[is.na(x_input_unique) | is.null(x_input_unique) | identical(x_input_unique, "")] <- NA + # comply to x, which is also unique and without empty values + x_input_unique_nonempty <- unique(x_input[!is.na(x_input) & !is.null(x_input) & !identical(x_input, "")]) # left join the found results to the original input values (x_input) - df_found <- data.frame(input = as.character(x_input_unique), - found = x, + df_found <- data.frame(input = as.character(x_input_unique_nonempty), + found = as.character(x), stringsAsFactors = FALSE) df_input <- data.frame(input = as.character(x_input), stringsAsFactors = FALSE) diff --git a/R/portion.R b/R/portion.R index 0ad593fa..cc89e09a 100755 --- a/R/portion.R +++ b/R/portion.R @@ -24,6 +24,7 @@ #' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link{as.rsi}} if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See Examples. #' @param minimum the minimal amount of available isolates. Any number lower than \code{minimum} will return \code{NA} with a warning. The default number of \code{30} isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see Source. #' @param as_percent a logical to indicate whether the output must be returned as a hundred fold with \% sign (a character). A value of \code{0.123456} will then be returned as \code{"12.3\%"}. +#' @param also_single_tested a logical to indicate whether (in combination therapies) also observations should be included where not all antibiotics were tested, but at least one of the tested antibiotics contains a target interpretation (e.g. S in case of \code{portion_S} and R in case of \code{portion_R}). \strong{This would lead to selection bias in almost all cases.} #' @param data a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}}) #' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations to, using \code{\link{abname}}. This can be set with \code{\link{getOption}("get_antibiotic_names")}. #' @param combine_IR a logical to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. IR (susceptible vs. non-susceptible) @@ -134,12 +135,14 @@ #' } portion_R <- function(..., minimum = 30, - as_percent = FALSE) { + as_percent = FALSE, + also_single_tested = FALSE) { rsi_calc(..., type = "R", include_I = FALSE, minimum = minimum, as_percent = as_percent, + also_single_tested = also_single_tested, only_count = FALSE) } @@ -147,12 +150,14 @@ portion_R <- function(..., #' @export portion_IR <- function(..., minimum = 30, - as_percent = FALSE) { + as_percent = FALSE, + also_single_tested = FALSE) { rsi_calc(..., type = "R", include_I = TRUE, minimum = minimum, as_percent = as_percent, + also_single_tested = also_single_tested, only_count = FALSE) } @@ -160,12 +165,14 @@ portion_IR <- function(..., #' @export portion_I <- function(..., minimum = 30, - as_percent = FALSE) { + as_percent = FALSE, + also_single_tested = FALSE) { rsi_calc(..., type = "I", include_I = FALSE, minimum = minimum, as_percent = as_percent, + also_single_tested = also_single_tested, only_count = FALSE) } @@ -173,12 +180,14 @@ portion_I <- function(..., #' @export portion_SI <- function(..., minimum = 30, - as_percent = FALSE) { + as_percent = FALSE, + also_single_tested = FALSE) { rsi_calc(..., type = "S", include_I = TRUE, minimum = minimum, as_percent = as_percent, + also_single_tested = also_single_tested, only_count = FALSE) } @@ -186,12 +195,14 @@ portion_SI <- function(..., #' @export portion_S <- function(..., minimum = 30, - as_percent = FALSE) { + as_percent = FALSE, + also_single_tested = FALSE) { rsi_calc(..., type = "S", include_I = FALSE, minimum = minimum, as_percent = as_percent, + also_single_tested = also_single_tested, only_count = FALSE) } diff --git a/R/rsi_calc.R b/R/rsi_calc.R index 83addfe9..15a1f030 100644 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -16,12 +16,13 @@ # GNU General Public License for more details. # # ==================================================================== # -#' @importFrom dplyr %>% pull +#' @importFrom dplyr %>% pull all_vars any_vars filter_all funs mutate_all rsi_calc <- function(..., type, include_I, minimum, as_percent, + also_single_tested, only_count) { if (!is.logical(include_I)) { @@ -33,6 +34,9 @@ rsi_calc <- function(..., if (!is.logical(as_percent)) { stop('`as_percent` must be logical', call. = FALSE) } + if (!is.logical(also_single_tested)) { + stop('`also_single_tested` must be logical', call. = FALSE) + } dots_df <- ...elt(1) # it needs this evaluation dots <- base::eval(base::substitute(base::alist(...))) @@ -67,23 +71,53 @@ rsi_calc <- function(..., } print_warning <- FALSE - # check integrity of columns: force rsi class + + type_trans <- as.integer(as.rsi(type)) + type_others <- setdiff(1:3, type_trans) + if (is.data.frame(x)) { + rsi_integrity_check <- character(0) for (i in 1:ncol(x)) { + # check integrity of columns: force rsi class if (!is.rsi(x %>% pull(i))) { - x[, i] <- as.rsi(x[, i]) + rsi_integrity_check <- c(rsi_integrity_check, x %>% pull(i) %>% as.character()) + x[, i] <- suppressWarnings(as.rsi(x[, i])) # warning will be given later print_warning <- TRUE } x[, i] <- x %>% pull(i) %>% as.integer() } - x <- apply(X = x, - MARGIN = 1, - FUN = min) + if (length(rsi_integrity_check) > 0) { + # this will give a warning for invalid results, of all input columns (so only 1 warning) + rsi_integrity_check <- as.rsi(rsi_integrity_check) + } + + if (include_I == TRUE) { + x <- x %>% mutate_all(funs(ifelse(. == 2, type_trans, .))) + } + + if (also_single_tested == TRUE) { + # THE CHANCE THAT AT LEAST ONE RESULT IS type + found <- x %>% filter_all(any_vars(. == type_trans)) %>% nrow() + # THE CHANCE THAT AT LEAST ONE RESULT IS type OR ALL ARE TESTED + total <- found + x %>% filter_all(all_vars(. %in% type_others)) %>% nrow() + } else { + x <- apply(X = x, + MARGIN = 1, + FUN = min) + found <- sum(as.integer(x) == type_trans, na.rm = TRUE) + total <- length(x) - sum(is.na(x)) + } } else { if (!is.rsi(x)) { x <- as.rsi(x) print_warning <- TRUE } + x <- as.integer(x) + if (include_I == TRUE) { + x[x == 2] <- type_trans + } + found <- sum(x == type_trans, na.rm = TRUE) + total <- length(x) - sum(is.na(x)) } if (print_warning == TRUE) { @@ -91,21 +125,10 @@ rsi_calc <- function(..., call. = FALSE) } - if (type == "S") { - found <- sum(as.integer(x) <= 1 + include_I, na.rm = TRUE) - } else if (type == "I") { - found <- sum(as.integer(x) == 2, na.rm = TRUE) - } else if (type == "R") { - found <- sum(as.integer(x) >= 3 - include_I, na.rm = TRUE) - } else { - stop("invalid type") - } - if (only_count == TRUE) { return(found) } - total <- length(x) - sum(is.na(x)) if (total < minimum) { warning("Introducing NA: only ", total, " results available (minimum set to ", minimum, ").", call. = FALSE) result <- NA diff --git a/data/microorganisms.certe.rda b/data/microorganisms.certe.rda index 15fe6e6ce3229b63146e0ca3d2cae3428d22d48e..33bc19997d77e828b59cc9c63af330f165292e69 100644 GIT binary patch literal 13828 zcmV+fHv7p!T4*^jL0KkKS#Xofh5&yT|KR`r%m4rjf8am=|M0J;oPa<80DuAk;6na9 zo001X0HmORkojp!)`W^yR<^G4Vm-djLPcqP+V$=0FSo~gUfTw}14F)VzU$W5`n6(* z%;U}JH(l}9cd+fNZ+7d`t@j@L@0-2e_iwKA<=Cvf29*u!kN^M%L7)HtM3YIWrlyT4vP2E3qfCu54KjL6 znrWbD_DTs5fdptERX-?D000>VfB+5ss(`ljm*3L%>jhCahybYl`cvkB5&$0zRX%7k z2>kF7`Cy+Meu$05eqY%}V(KUDiToqCh;9XQ_zZn{t*~<{ycxr zZ<@9)>Lb>k{G@=|ZVx%_>(eiz|HPwdC! z|CMs5`8w67F=)wYx#`rvJ~o>EXegG~Rh#h_K@iQ&_DhuB`PDyNR?!fAGOO+Q-eL5E zi%HlZgJnS{`Z`2J0nQY%vF%e3LVBP>xuM+4G|G&ajCVf2t^-?+iHVFksqy=$OhLfg z@QVq9bb|&R@}fc*&fn3vL>yv@G3h#zV8)hA!?WbdutB&1Ip6R27!AE|)${9_BU|)*EtW~s^~{&2^+8q6=p9*)%HD%2 z6_;bzdgkEXe5|+}JNErAW6m>nxsU7DuR5k(k6gZ(7p_xN2k=c zE^U19#=UZzYw459Kz!@lDULYf#vMCZoMo6A3DB9yKGR{Nv)Ub(>X3GB&AMjmZu8!+ zQ>0s`Q16{pUU4h#8@g8IF#8jpla$3$ubE<2cuIIkL;C*n#(CoN{_8b+@0ZQFP0Jk` zXf8zIUU9n7Tw2$()=zm-JA7ljQRuWYYMebMwH(lbv$u(syj9K z^Ut5``1^x#FKg?fd)Mj=LoBJp%jX6GKE=dh!>t5;au^Q)~<*|f

7l%fpoGtWZT|Q=;E;qoatVYx8cfdgiZFRMnwI zM4K>Y4;^x897Y^R(f(~I)2-sqd@RwMZ)K(J49XU)(eIsM zf8(h`?{{%4%?>nGq$vtgjwMO^@w?Ak$8W@3T@feoG5l#e)QBPX`V;c#d-LXJo>A^6 zI^IpaJWYDS$9>o7b+wF5jaL6n{HOA7&1BltKacL_+s)(KiZ`w} z+Gk4;lwQ4X-&a~Z*pg#TDc2FrH8p~?KBaEw%wF^Bo3ANYM=iX0wp59yTE+=?7j<;& zR?4?=cM)|A*3dF}wB9$ygvIA+&6GYZ7}*A`cjLqNdQDooeA+dF-8YmHd`L69gD`x{ za(kr8E}3Y{cr@QJbGu$+d#wk}`Dpy+r}59V2GR}$=Gxy6e^?VMQZ;$5sgE}8LE6#U zsje(%4s+r!x$oQTA64G`X>dLsV9aUE&b;O; zJsWzOu~d9NEPR8V{NXm{IMil4Ejm2EdfubF-FluisQPxRYdcS=Zo0YY+vm?CXO*S4 zJtp-T!#K7jZ@-ILJl`|-rIn{_L&z^0#y1(S7nL$}y}Z}EPcZexVMoJo&z)jz3sRam zr1-;LOBa}y@ng)TIBsF4cv~E=bvRxT#pwq1Cp(>+q;uPEoBMk~WtfTGCVd`Gf0<@y zH0zmqk6DzX#wgW=d{oY1sJ+t=tZEO`qeO&isR{nCEkf(K;qM%I=RTvDwzv6xX1Le1 zzXSIDxQ9LXlI97&QFOv;Jn>@|Gdd+_XjQtbw>CJ|_?;H~Rxtf?aP9NKMRI)Tx{zdpHKX(SRggd=KUubSCy5Mp0bj6COP%Fr?!SEh zizh30&XR|t2dvZ)I%z=7koekjI5Q3i=qwE&FI&r)zG^wfBdv?@`bHQW_c*?B!@D`v zhQZc6X2w{Iu?BMiAfhdT^Y70+^l0k4om$kNdp}%PgPp=!1_{opg-zRg&h-&^=|%IZ+e6odyid2=apc z#OW{#CO2DZeY8ltZ7G@nUFR;titaTMfw(gfy(O~_c1$|q6!u~%8JWHF9A|rmh!iGc zbq#*&z>1gvh$b085#t6Kv(E>Mvz@h$oH0Gx7FtN$#cwkEwl%FH3MN{l8h)TSeXehd z1|TsMuw+vNP%;A1;N4am%~dbM$DHlkyUepR%)7kYEOPwm&osIRb1E2|_~;iF0wrT3 zxXkx;)R^Tg`R()m58w0qW-*MFR#KFu7{|#fq@^$4JL(2&%X9nwzPh$^n>KU!^WvQ6 zk0HYQcaAT|96uaFaS@DT80XZbDOumwfgPpq~dH4an^veM00-PbDo0f}$$ z5coWsJnc@@t+2){W@APLD3KqB&94-khosqO^h;q5K$bN^G=RC>)1B>@ml>^eh-m>H zQM9e-(Ad%ks{l%`GnYW4(k8Hd*lZ8HH}xe_Gt5*%TAEi$6U6|-Sb#8Z5bd>M2Zyyp zrCZ)}!?~{jW>`ALxhl!(?GKl9aU0s;?OAfdjGiJ2r^SC-Y?9Yjn%5|+*04BC`LKA# zcLfKT7f#)sfUOq;U1LvtVPv8T10kf1?3yKp%=L{M)XkU>V}D9IzTEBNjc(FI3$af4 zecOG^YqM)D@#mardR=vvdZ!n}W`l!tEHEY0mfYIaxlv!+w_e)hol-$4UImovpL|Jj zl2vHrsO`~JBh2Tfwk3J7*3;H7&v!e3U@8PGo#F5}1Yu*vjFceYbM2(MiRXoi9@A35 z%nvoS1C6I#CTvqpWYo~Xu4T<-a}Ox6qQ(KoI%J23um%na%LH93vcLvBzMzG8Dt;Fml$?vU}g902LotC@6$b1xrFdR2&2! zk|3xnm?)|rOc6m4J^#+20T3b?>OY(O|M#zcKQIr(`(I)%eG}!?KzUR3f2Mt(x7Rmz z+hMknNfJyR^=WS=khc2xRY_e#%YYr zCXw3M+{U|MnI>>l!$wJa`K&2gAJOs7b>^4GgNBKucW~N{#uJ6WN;A|>_0Dqk#=f;3 zbNI|>IW+b|p7qa70ZVOLEhnS~$NCMU^EW8r4#WBEb;T*n6^;Vu7>mpp{$J8c3qQ-m zv>0k(d6$Mta%n!fPhm_Z5V#7W*(i+sK{oW%$d-a)X6E>V1hy5No>B$RT`WeZYEs(O z(&sp$fNIIZY{d~J^K@9g+kqplyR4HG1^_nCdw-M zwXj|>@w2hMTfpd6hYqT$PYQ`UYUq+=UcDF_k$WnO#ZVOk7uCQB#~`?c=HHhGO@j5~ z<5w;1wm=WNQoc`Cq&9l*2aY=9e5;C@0?b>w8LgoUJ?-&9=a@NUG%tpOo#swwZL5|L zqVlZ6-fl`FaoETABY&a7%fSdER)dX=*3N(^FA8R04!CsV2dhFGSf?~gGA6W2>8pmEGkYIo{B994Hx1Ed~ z7IU3DbB?JcB;YkBPR#7_YNP`RPo;UvP+B6H3X+^hK9WR;9TE`YYNj!MjA&$xd*X;B z=0yT59f(4Z9a`*Vnt6W=<)*+Q&==pu>>0WY%rMCcCIu($Ifp0ip1ejEsZhb^&ir_^ zL_|QB3-KEYGn@gz?8@FOcLfj=^=0eQOo+g@VGORKlJnB|Li5l?X--kCky8;2_d3gE zMi#WLy!eb93|waGiI>H*J?Ac4;*M8wnQ0Mn5N(Sp+RC_Dvv$S5hBCJ+VHZf9Mr`CT z7->=4W4qN@VJToq1E#Tuw)5J1dk`V$z@6DhixXv;@}quhR*AN^zB%6={C9OPVywyK zTn+((;S;{)9ho(OOxG4j$W^r9%=fI;=subj(%O7DuhwUu6DOU!?aUp5H-Vx~Q!+b= z>JD1aLRC-*b+1go&b(`1$bSv+e|x5kU~CvMILc*1IZ(+KNesB4!hP^4VFwpOf-#9P zMPmhx35-^12%QhB50z!McV8TL49gsG0 zfe1AKXdn?Hs3r+8QDB&m0A?Fe!3+cp6M(=X7^;ZCgp39fsHid#NHz(#P(kXXm5WHG zpduiKJj;@3!pfrHv8b&I&9#RWj2ea2G(aLk7fDHUNHqxw7c_xH7z_|277&9AplGs+ z2q6uZCIc5mZAC$dLn!8)!EF(>zq$m0ZN@}^nxrX-2m>JqFx3q(QV85afFvYi%8H1< zg2+f3ykMM)X|~e>q=o>7hBlCxHiq+sN`wG_6k#D40rxwN;ILpu5k!!tsz{&&AP|cU zHBpKNFls759FS5G9GS^LR1_peDFK8eBqcOctY8ca%9>&lB!MC%lN2-O~nH9y%P=iYXVBB+AnnnXuM}H5_A}(yh0woLvW44(xdZ)Dux&P+Cb9s+@?h(OpQ0 zK}rH74BKlcKydhHO^cHLyG{Y*6Vq3iVBA4%T1Meq#7lkr`h)YU%CCB-o0yXNuMOvArFdfBi`1b8Jx=@1qPV{PqmM=b*bf9R8+3Ypd-j}j zu-9qD((IxeWYcV(sbA&$#4DXjb^_pg`Z5SWjDdm~=5xih&MY-VGK5cWVw*y7=u!xl zB-l2Rm}c%zfSTgLk*QEvO*X$6ODU8wx@i+5^?oD`XD?_`^f6wjm9h>{O;i?yJY;C# zIcQU&(&VCXwZR}52EZ;qAFp(m>YyH*rQPh9cO3^C@3x^PjGtNCSk|<(Q#tckOJk!u z;dKo7mYyO8!8rp$5m111%^Q*dBMg`rV+a%B(jo^H8_?@3)$}hkBLOEgMj*ik%&gJ& zA#ubK=_w8gGUGU5-Zf|_gh*Iu&vrnh49tO_*z9hS5QsDhK`c18uaT@;Ry8SLPFzaT zK~Y8$I%^R@*cgiL)pR;kpeQ`bRU{k~5QPLt(8wYY29wtW4ycvhd3Rd^>to{)R` z9gq<+24Z|yg8zh|as`u0wn-g`a3Mf#;W|nAwf;Nq{-+5{1Vb}9Nw0c&;DXKok5+j8N>(D!?;=V1w1 z2rm2?lT@InVV)Sjvk(Eh-Soi1(C1Ia9x#D+R}3=*n1Rejfyz{s7z5Nt6^ieK{r42) zRqV zm^{z6lRDtXhQ`+FJhtKd)POSvImALHP35%T-XlZ70#vk#6vqN#*cuMHtKqUZ^%KRzZI+)w_I}z5c!8Z!<&0q}ZlgFiGct+@JwSZvbvFy-;ZjBT*bjUYy6b zsRVPQrVO8^-M!8NRv_jD77j`e#wpW24~atoD=0wq&x%u8N?@4>&iZ^^R-RvDHg4sU ziKZz)M~*fZQ52BFdw#sY==eKY?N&W$W%&kjpDEXJ?HaxHG8!b+IZ2AyAOPvRenI?1 z@fIqOZvSbkZNix1q+V?CY~Sx~84WFl1SI;1fC7vVG6$i;D32OOsnm(1rJfL(;;EW` zlE5*!hMx1qV~U5g2GiQ*RBX+{-&p$I%>;w--_MZ!%V3bT&=G^srAO$6dS32k_Un2( zwVHY}GYFi{&S?^N)rfogBG|o=Rg@=E^%_nxF4()ZX(VOZvw8rzyBjSqA3WKP(eK|z zyJtnE)FMsMP=knVkZG8!yYpTa?)`cKU;sdieWpk!uWx$zV_92p@4BFi?p3*1SbWb1 z*cOA7lwwP7Sv@iauI&%Cw;xvXct4tjur#6okR(HdetGY_2FlP(w!@?mP8HSdx z2YKFUFf79RK-k#{h|Ayat8^_=vFE<^&4;uI0~hUnEN6A1R*3O4L9C_L=Fn_f?dU#^u)zb zq6rL+`A$iq37lkQ$}xlyZ3u+{hial{v#S+ZZAz?+tIi2y-iS=0GK9^<;S&HpNcZc$ z_tOH2wbJ_ck3oefi=sjD5!DFpgpe`a^1Q-O5*H&%h7fHihC(g&`C22M ze!1SuZa0I`mlrOAPpi*t{+s>?X&{CV<2$=^z`+<6807F0Ns61xW!V&7@D~I`4l7h) z_bgaOePHSwvSbXSSxE?q4#nvE7E4ChzcrSO;Q8+RsF7f;v3;<$3FDa@4lA6g~4C}5D*LuxldZ{Z+1}LckvW&&2D1atacXOg;CvDD5!`5FhO^#@wFRdGTs(+ z{{cV|0SLlFh6$$HW1ii*Z!=1{BCTS=scp37SeKimac`!2j2Wr#5s1UJ#UY|CwC2By z%+HdRL=pPp zA8uy6@~!fcrJKDytAA+VGS*LBxi zX4#v*o+Ix(W6ex68ZH;p163t)=~Ye68ix>f*10)--G{~8@{b{YGn%fU4~)0oU}}tt zur&kN-EMN8)E9B&=vn|~##YhIi9WAauv`d6>rVXxYPY1T<3))|Wa-=($9OJ8=V( zcF;v?H5$!GDvBii_3yWQH|)xWs}Z-p)lhnf-(7{l%Ib+q?uuF%vglQ7rpXKz0N|0) zM>=l2>P)U{sI8usCM>fiQ?de?Ps&FE-G_V$^E!0y?IgD0!rxM$5~+Xy02Hzr<6oWh z*?s+}k+%J9vDN%u^S%1*%3ed@_WJ6^+@Cmt2Z`U9Rv4J~^h%sHYe#7%GX983p1;_7md+LBgH z4>=9XMig*CR$A3}OU)eIHYTD4a^AOfA3DQtt&qE2R{28QI-HHeP$8B2d89y%x#uyf z;$JrN0vs6_*NX`tQ^pXFD9^`SX<4thmodByed4n)^7*885;?T;A7Kh2SdYpKYRm*} z?R3l`8+F&}l1Xv&=Nf1LLIFfQ=BZUsvu8F5-28#K#m>5+ka>ww5+a7$jy!vr*2Kx= zjrx>G(WYFKQQ(Jmz?)3baKoOpF=i&@kdhAx8|OGMF*A1`7`Hx_O9m1)n>U=ilWyhN z6*IZhG~#iI5_Qbh=;pW!FeMny zHkGLYuDP6ctYLK9-XOEn2fQlRg6?|at4lsq+wMg z6e^I^dWCC}cSIOO0_V;U$z-n*KoNO|93%!dCO1Q%mCL7DQS)xpa;#^$!Jlm+5ZMCo zI7VdUWexH=s+OhwxKBzo1p-B3H=Ywh&tOle8$)H5O8rHcm^1OdRGHp@EdO4 zhD_0^e?I6Zk*?ZImTwMDTLM=a2WB_c{0ndlKwVa9XCQBM>aOGbHUzzk%Ys;_!5F!LM-B=p2Qmg2^UPBw4Zqp@-NsGBYDGF788ZSB{WTmM|Ft*>}*8;sKEp{GwB-;aiyJP2EC= zfjZmQ@Ny`hu9w+iZXp5mpTlBl8pOL&jgr0B6a!c)sHo9YN`#F_6BJB0takC^$jD=3 z#Yw-!;h}`YZN_=B$S<=#KE}L!B$t=$NZVz5e9B6x4VS*Ao4iNH&>1q4SFtD#{(JBB z^kddh<%2u%>wNpovKa4cRMzvu8P?bFRVi9K_7U)@AP7VeMuaB=utJ7X$kS|)GY}?1 zp4d%&2n3PvDdF{7+yt;eBwSOvjt<0v%aAOIWQz@4QYRDfBDHl=Kp1K{@a1+ANUtOW zV3_kLGbAEe8C6wH4^-}f(pj=mN}M(mOqof^CW?q?O9d3!Wx@s%b>#&z?IUVlWJoaN zvJ=Tyo5hw%S`fJ|Y0YBrfu+6hy2b^TAjAbQ_``En*Wl)?>Te^`O=FA+;^L$WdThYE zw}wk>0giGnw_C&m$aSQGqL~0BL<2DEuAqSFXU3-(vAnO;0%jK%B^x3RKvB4 zT<#mKYaVpKIN3_RZ?S`Ns_ znPe^P!hwpX#`<&!?9l`Q2nP?Qsgg%mtK5f01kKNG6VG)cLqlIv`P#h0sx~+P|m(>D-8604fP0%O8l?Fj9LKeN_*pto%~U)ap;^=%P}x| z?ayI@!F{6|%Y>As_wxxC=?+ox5IYEXw>y={6%2?W07$do#`(qd-K-`k>Z@6Dzb_AV z)H7n+bBHQyzsDv>&)bj2(hiHR->LIO>e;zWMEZm7Aq+41@m27);L($(jnGUF9T3PM z5+X)xS04G7Z{z1Og&Od^=b5xa#6_u%s$ou6)Coy~aY+VX&%XBq2WFpAgRnM)rl;+= z`=jXCiq?gM4jgoYm(X3AA{1Oeux<)WF^qc<*a{ z&ses;O|;*RFTPtCkV|Z_+sKkuH2D)vAW%vCUD4kZ)eZ{rEV2$B;$6%iB6t>9oD}wf zi2+e6ZDdLq5)Q(JESV~!i~+1joSVVs!RK*4lmPzh}I4@j3ad_Kj#@h-4#2n8E}AznSiR zL|76zdCTy9JTvC=iug2T1(<}VCw47Xdg6K|f!CSaS1waBW8U5?jx@LUgrXa5w)eem zB|S`lZ%33nN~Uiofo)V6Gq6a;6`%w30fB1wDb@3EP|^xPwzXvxRG=bxQJ^6pAm_Xh z*d(k{Qv}hcQHHf1{EFr`owgvK2jSDi^+0rboJnq1VTMzNHUpEWt=l#l&SO<@xR_}! zdB&>co>(FTwJPJz8cLWh#fWA$)t8FktvTmtCIzdp02yE;S%KEjW*sC1r`9|3#ntn? zEkq?nrd0T%WPHNWMJQ zgCV66C%MzkmmEn7A8%xs3{WF>l0I$DcfW|+k59|cgTD#A(Xo*q7Am{a1+iG39IXnO z;=Fwva^UD}bLr`=_%O4q%58J-yxM|37h!#IKUf4b4%}2%SIDMn#gzCE`2QMQf4nUP6Assq~6{t|bgChL8zVe^}#`!nf zpl1Q1Y{_S|Q|VPElBA0+q+Qscb}j`2GfuaUTCrRw+t)MhRH!Pf53kf8Nig%CHJ#8K z_|9f)<~tpLg|8(y8bXUdOA4Ee)y8 zHO-}mz6c1d%<&gwxP^8%o&$-P2qF|VM4MF`fpj2kxJI>kEot5mRd1FQg#z4!eUh(e zQLQ%Hduu5mpu;puk53Xtm-mjX2J3fJs7m*Q5GY0Mxh1kEn9Pm0s|yrnV$0%kNc;Re z;)6c+-oClM1~%|cD+9C3fEvB!RYqUUs+~T<>u*uKD4!VP%wU>9zJMAEW4q%_U<#EA zl~qlO59taRfl$8eh$P{tPl4Zr$Wf5fzLVv|#Um!V=k;$9rDJ6+Q|* z=LZP7L{8b%V)AYVGKa5vu`IwHPa;tSbFT@BBN;rXYe3=0}ifRSv;v-BJZJgqIV$hcolo1^5$m@0>{b(~onc zsE!Cklx~z+u>^|rGQ|7gz;VvcL+JRz^#hUynV0w(OwJ&6c!FY@)&|2_U^e`4gxYw z=FD)4ELUCm@y4jY5_0Ub<>8qj;7Vkm0T53FO(`7AvCmPSi(e~&!P_@n)ExD5C@bi? zTCsZ>at(qJ1s4r(H0Z)QX@hED(r6nUwBGflnb9*EgA)#CZVA>@ZyC)xiYfi#@*=MS zUQpeVz|026SU*=4x3RO?x#$N0EvI2ir8uDI3v=H9ysVIHg_37%PUGABC8p@+>LW?a zsY1=n1A;g(et0&j)$l-+0KP%%#+icC**Au~S|hmh@RXg!-2jDED%DceP$qrp$9Ej~ z&oJt2Cy~533SwgFNF`A-Iq~rtZENd{2e!67hR^~68b5uu%$V2%A|_O&)UQ_JeI{7(ndHUZ5_{HQLmJjkJUISV{{Ed+}tu@x?_&_S8&L z6IF7)_-P3!MkJt^Gv?0m>DJsyFYC;w$EJfhE2qTWPoi?@3lK9T+Q4MT!4RK+SpbZ{ zHaj5zbKiau@U^FEU1ruUVF~n)nbhDx*q$JZNHYPz*^>bfLVY9S5-2_t?zUSfaRVbR zXr{dD8i_C{st3gLmTJ}vT0Hy1BIHH_?}$5y#aV$dY1!TJXsz${!s-w27UQFbQsIxU z7sQRDzbL=J9Kc zNG;&AiNtk$GZp?sJq{F4L0bf6$;6dnkrN=UJLc=C?9Qv~4TOycZd z83-nY3YO`O&1DZYM*|gUH8^wGd2x&t;|pq93eKCFIV&V&&T!VH(GoHdmA!%yNO@Ht zMiprVj84Pc_pDMPbp&<;X>?;oCf2EQXAtBc883qQAtj%Fq}9EHCUpVX;oO+s>rx*( zOq9bpAos2279G!H_w4^fsiatz6Z&xRLfr=$Lw4(QM-wY#RZL8#&F8Z$6)`)cNMP z!WMBzLvLRQ3xQ$1u{o}>JqpoNVr>g(7jptZ&c#O5hH($P66aJ^JC(ykg5m*71Ih$U zAfyRhfn0j5Rs?<~B9W|{Sgq6(WyLMraS`-Ac-LKedC9*7*ihl5+Qu?0CG?B|XOSmf ze8_j|>8gC=jPbY9Xx`vj)C>%=>Yh z@#EfZWDk_Yw9u!wPPg;3=fE84iMD$1uPc87;1dwg58Iu6x2)~gTN1PoaY=$V!+4v``UFp=Auz!b^_J^Ytv071eI zCZa|NgNY6=+XrDp%;(b~>RRduiaga)Z1jc=G_l&+=#`2D2i6rlM^8TzZXMgber_G=p( znYQ$D9!N%yik|u$-!e6GN*3=z6kE&Fs!&N0QoyV0?t6+-Csy6k?0o*9ZU{ADDkKqJ z`<_e3OqnZrdJrhevS8ZBJdwq>U812GV6;k&j~5%jW;rn2FQwIzBH)mO5Tn8sAVXiU zA&@b$Bw5j-?IE<-4Tx;}_;H4O96kFYjm*u9W8>hm+}8y8e0DGRp`d}J9?wvbIc2)1 zNh66!Ru_0kEhnpoiva5m^lxw4y~`J2X@M=a&0ow##JxSx|KWH^@(sBvlMXDq0Dj>7_3TA=L5b9M7Rc-wxU*EEe?o)(}kCA z)N2)C2s|RptcRo7cq04 zZ>fT7IRR{PUJK?WwfJkk`#!`LK{Lx zvkPsuoHT?3V4#de!U{{9PQ@*;fV0htiU40c^WSZ#mqxI+jY*kBX0IqDt=48DATnZa zV(>)Lx{_qeVkO2!$*8-!6u}hc(&Pi2Vz;qa#GnXZsvrT%F7r8O&(F;Ed3!(i$bXNA ze>vn)w;3_UeQ%f9_3zo9T>X>Ix&2>*&TFpb=Pu80m(oQP0Fe{`;S>P>;_gVN3K9+y Gd2qlvEDn_pP6O zZ*D$5d+$P@YWJ^JTRz_LI`?@&;0gwOyIDP&ifW0(i!Pk}Ybb_dv+K>TJ`n40+03-lEL{&X-WD)xy zBlW>PsQY3!iu(OjVlHBRaX);0u=^#Ypl>$Xiif%w7Q${HgjBl4$k5uk8{k%U9O5MM zAfV-<8V+~nQ4KE6?@a3uZpEgyY4Zs|sQwe%4deb{$|lhrV5#R(L4Hvg-#-<;?~jf} z$HNvCMAT3wG_B&OD!!5^s73k=377x^Aj>U#@1)NxsNbzgz5Tc2*~{U66h!^ZeUJC+ zmOo>yJ!dUt8sDCwhzE_T|CUl|_0{KoCl(b+gBva>cgH%o>#N#kPY%r+ep}SWlyQZv zf{8Ao(ffPJB3LueinGN|xsMyg4um=nw?5Rn0x{J3{ZJXya!gEN%};-lguEOLKG9(? zZjfNZzEns;_|y0|2!nT`i}+5Ymob%-Fzop<;s`YfEJj7q!!PU6lkat*@Gq z8&l#kOJSmr1z*+uvai$NTsE_>7RQccjbFj-YO+qBu4KJGiVhbVpmky;XP5-w?@%HDMRNY%&2PFpzEpMc3u(Lt-n5g zKfB-Q53h2PX8dtJ@4RPxH<&|?poC^6Dvs$9IQLAk?O{=jSo!uPsr%Acs#V zaMJVQI-rdC)p+JJrlTrPz84%ql^$lDyg1aOOg9#rUvZQX&WU5J-m6Pi7?dl-(d~@g zf5S3|(^hdSO%60wq$vtgjwMO^Z&sdle&2C%WJI65$Lz{?nGi$Q_@|tX@w!uck=RGk z?-V*LAp=*0UXV!CJKv?s3{LXKrqjoY@kSXn4G-NiyF_g}fu`SF}wM*szJnjbD55rpSz(#}N0@tkyM;F>K~>%eSrW zHF;KAW6EnWoH2UdRr-6@vF6yHwJNPT-X37P&F`qqcWF}xOIOZ)ns|qe@d`cLZ1~OQ z(5)$xOOH5x?W!;@zBWAF;(Ne+9vfqO?#6eT<9y5fTb+)r(mCn1&Aobp%MlZ@O!_<= z{?f$GY1cCG9i+yonJ9;!>lYr{W^WMna4&> zY8|>+JRa))Il}FLnSjZ`-yS(z+?{l3t*K0Bna zdb+QAmS3ILVZ|p7BiYh6cZI3Gsc9!TrrQ~An)i6+oyOrtwIkIV3mP_bKy{_s_R(RVl5mV zI9%18WSR){Q6U9#iFlJMUSke`K*qM5$ZX+CfQEeSx-tUCt}RG2Q3(X80TkyCMymjN zy1kGfm6}TY@f^c;dGV8`pItG%dN}sgJ$asXMnuZ{Aem4#K(nVL z1cx7XnX(j2I-poTR&}wNooG6s&DE=PoC>ma4J!;8lrCBgLnAxyJV&W8`Qp%aZH7HT z&&D3w1<4)jZn5t4iR0;sP!qiK4miH&Q%WC#MDJ^daf+o5S4BM-ibiH{Y)1Ijp^^m& znAZWV-y0EA0FfQ4Ku3%iX3snxF3xr}j_w$q?F%g=8Wj3wJeMu3&`K%RW%2PN$nCk` zjf0>ZQtTaAgh?m{)8O5jU(H>~^<+(cD7y;Vd-Vplw%(Vu2t4X&eE!;huRB!QJClQmx5uwo~5z2Y)jdfVdltI`mEJ~;1I&2e65pU)iP z^}6vclH0v^6S0rde^0w8$7W_{O84&Ec^_P7X94GnX!WnZ-}KIyzp~=hvD((RNb669V0N{q%Hh(4ve6gkSbQTdr7ZfFn) zzW*Sn!^wEY+4p4Iu;gq>9S|u*i2A-OXr$ykCW{|(T8MH4ubL601&+p?>rBMlbFFl$ zRz-5Jrhi3Cm67WJ3TEcBiwQoJb&>aRus!6*s!bt0(+R$?y6I@~kT`vi0t`@x?VSPQ zHqg7&%U;GtI{;e{3)VLe2yrC=+|3SG7k~}T7C?hT%0ffT{daX$w~KRb)Fvj;283h7 zfvDq9P@O4*HoSD2NCW zLN=;5efJ|>m%?wDu5$Gj+UqzvxESJdxnbHC%rNQ8Zf$DZsITqYzqYw2RFFy+fTTv& z>Z%|aCBsJrLD6vzXB@R}8&!_go^N)0IoKFX5W0HV_B#oae=~it2(WeUc-C)@yG`&=BlA6;r_Z~NzT+&EVqu`JRYCBDu}iUdJ}aNp!qJ7( z-=6jcB}i|YTo0c5qQdk`bqgi)?Rimbe_P+ax9@A;Vbes~Ji2XHlS$I(C0EdWqnozX zXWt{M{H-qR!)Zr8M?2sZU1gZEt73y={Rb8M2N4{h&_4YS9Ljn^XOJ*C%ELoHm-h)l zXZd)RgAGmRtXlOMvaCM+N3%3y@VgTxqSX`VhIYM8M4%;F#9P`lNE;CkC&&bjIpnk= zS|UwRbh*wbpc=Ap+c88*eBBr{+kZz&^XDn=DwBAdt!*ma7~TRv!PaL-52i;>(CzP6 zDX2(bQ}IRRX47BgE*%%&)edg@HHN1v)p`5l?HlR(cEN-bL2!l)HoYI*jIx;^%XJ!Q z`1s8vdS|r00fY$CPPq3z{l<-$34my6xB)T)H5!KCJx85&cBt)DM%renSDK%r;A`p$ zIGHw{q`P*DEaeP2oAKVO);lDcK-XndJYQHaE>>*tL_PX{9VqE^a1cmAi&Pccw5KLY zm7bY&7u9@eq-|`}H!Fip5fJBvf=;r~NiHWlup1FNSV^dWSs1^0K@D^_5WL&+;OVel zynJfqy|%~!^wh7D)u|1hx`W3Z_}?nxrhu~+?uKhT(E($mQZBX~jA2N%Pz3JcX$QV#f=DVd0h8{aULE-qyu0qwbHN%^5}t-Nxhl_2GkZc5TbZ#q;l( zyN3^kM8I#3)l9*m_2W{sIoz~6N8t)Z2kLzriH~X-7h9f^uRm1c`E9Iva^oRsyy+q_ ztoXwE;fAxiV_JEfRU?$t%xVOjo9%SFqLs^VfyhEa5dJw$#H2m>TR;Z`#@ zqK6B2c<-F}NhnT3P{Yi*c-guF46nAmJFN$*tmHM7;(7G6C`joQ2M-YGQ|?m*$giFt zf=#%9M2~hsXb$rp9Wzfa;hePC1X=?7_`QQSKwBvS!lJT-qwQJAqwc=ER~XeWaTVu& zMB!Bt5G3HfAyFeZ+zpwTk8Z1nB-^iWtEz2x!BXPeXR^jSQ?+Pi`@YJ$K>25J%W2>T_$F;V&|(?RkON+4`4 z!C)u~DN);Fr>d~RV?l&G){UPWzc;KPK{bcgUtQ~-gUEm! z1b##?O$BLPBBd+B*-YRwG+~5gUez_)bEUzc5^w;N%{e8DFk4#E&9dJDwM3ReN4-6` zR55MU5*mV?0!XN%C>YpNc}12g8xaZ+h6x}y-)^s&*WC{uaYqhMhk4EGpghjGR{#w5 zW0A9PuHs6bK69BGL`Wj30L1FHxO=Wsh&zPjV?Uzz9S(V^b-pZq6@54LEb-xefv$ae z&7?N&7E9A zisCi~3uI20ly8Gnn^>FL1`4gG24}TqxuEzoEv2;gaW{x2vXDJb6RH_hBY6!Ha+#6X zPcU-MLK3QgN1vZ{?n%e5K7RAzf1~@}nk`|tFk*4SVM7>D!4^pjHlVV9h!ik`YtYz? zVoOn0v(n>nAcO)CszR34QDk7ka;kt4A|!&s1c5H&7YneFgeG%p3K+o*e^-)F#@kmw zT}+4=p@7gpB1I|;fXGpaSgMjp%qdMmGD1c{fWRUas))dZj0OaX34$9!1eg~TUYAOq zu}Rg$q>2dTMJlzY$=b0tI5y&KnbkU#OG3F#5D1Wk=_xNngHVu>aYz(FfWZPWVF)n2 z14YUxAcQnr77JdA(u#u+h7rX$g543i-`@g2yLiZu6EuY}Apm3{1{tBI3PBshC;~!8 zI?+)W5LpQWH?@hWO*d|q3j}14i5Q^Cf@t^he3ftiqOxoPK%MEwlP{8Pe=*7Hya@m?W;n5E<9U-tX78 zSvw_rzHSRJc6sb|cotGGN)qdew|NY>HwnXLO1e69PMtvLfS5v-0iq^iy1{8Awe{Bu z?JC%^rjBS@FMas!VnhhZHu-GSdf})8U?IUKHsQ?K1P(WX!g000A?E}sOycI27+Il? z&@)xMR5W40BsiVgz_6@yLq>@c4p18gN8I#!{J#(IJ&rwNJBDuqJt_mXd!&UCkYkA* zkYO@@pn?cy5SiBgH66KriQw(x^+%3?;U<7gF?y6BE7NODg?*=9mv2P@&>o0iTHUew z+jjNNhII8Xy~0y6-KJ%}@fZGf`0aiA@11ZQhv&;gAv7@^de*yf-`8#q`$Jd3?d(%% zPCW`i62zMZ(o+oG$?y|gSTZ##3kjyz;|XOlhBr+jWPY#2fvn~23O!G*IWAF z$e&q;?PWpY?jpuc*QMLCM0g(U?f92@ z9{ulF>@k76H?rOJ3~i})ON@bjXr?floYo6+vE(Z{84nLcN=@R@F&SmoUUrTHJspl* zxI{CMN+wPBqp~$~YT#gvFRoO5dY@Ru(a=?AIjOJ zxd82)f*y#-fEJA53yCLVDhu8O7E0Sp5~?wX9!qpX$?MP}?E~?$4s=`~m1*@8qVm94 z!suczi^y6b`ueUkUqgffY-^t4IT^QEh$ohKbB_jb=UUT-DqEi0CMgaQN6KZ;$yM6u za*EVll{a8pI9s#@!Q>PO8b}x%+6@hW+GU9oCQwK1Xu)@hJa;|yKKbr*s7xbTh@uP- zXv(c0L@YN1vPwf_m~o4+?)j_~LL@3OXO1GKfM`BLvARe?AkZZQu;S-l!&tPeYErvJAWjjPmoZA14d0AvyCiVD1#zSnX`JO#ZafyAihDDs7g>LX5MmQl@)}GqX!LmCT!D{%b>U2c6~_YT61qEuJNaymSm02GHb2O~V)hLLt`F3Z0? zFR9s#>r-hRKfU~YRtSrU16d$f_+dik(A&`~|6h58(ZA;oF34r@^x4tg+_I^yk z#v>;(*tJ0(y5M5!ts$29{kcQ4=;~Lvk?)Bu>l^B*Jke$4YHwwb1ErhD zeWGm^48#Wq@`m11LWoC8@)kV&iiwVU^hr%KYF!wG15;Q>~8YS=30x>;( zd#+n&OIJ{dH$_4YA+|xLZmi9v$e}ln05Jdz0)pw7!Jc*IoT#HG7g%mAL!T}$H5iOO zXM^kuLCQ)oCAX}enFCjFr-;x!N0OuKV-5=10E!l70>?lS*ws;4-`Z_Z)m5mGbjk`b zl8B@ipTJA@I!Nnnj;hEzHsGFLTIk_6>sor0{d(Xk#``8uBX#>So`@!S@XKEWSZt|k z@O3-QCIy&ZXd4?LF$+5SbsYr5qz^gM?*QdO00mDIvFnqpO6j?9epvK zMc)cG?Dw!g5SdbIuEkzteXlnn&O9w+JKVy|FdQVr)3lItYc3)X$QK4GS30PviN#IB zGgqduV>Ap3f{AI%o|194Hf`579?W!8@*hN0f-s8!k!cACKq0NT;|PLXN$V7zR!jD! zZx~nsA(82%;Wj}tIvQ~r$_TcFQlP`ax|7Si3%xd?y$vjDB(d?b5+NcIVy00v3F)6- z9(cbvEZu7}>*D^3GbQzv2iX>wPgyXAc-K^0H(q$=`-dZKjkmZnhJspd8bJe292;xk zz;n;nJK1f<@Om=h<dF`Lmf58JHAP~Sl<*PS47b60q{GGx{FTuRDU6DoY1Cb;= zPVqA*qq(dXivfp{Vmi%i#0p;S^dQrVV1~~ z5JAkxpCbMMV8Mar{yfg!eSU4;-ab9g0y!68A_4({mnrLAt?tSj&i*2e`K{Kmwd>E9 zB0zu}1TRW(ZmcROP3vlgiF<6%zWKao6gHOcT}INOR25+Ef@_5u)tn@PBx850@wFRd zGTs(+{{cV|0SL;HpfQpqw$qkd;$>F^RjXVomhI?iGcGC=;qXVQ$kct(%E`P6U~Coc z^*>PZtIJ@LNE^|}oqDOEq<~<$2Bvy*;P7zrrsjkBzZ+{C_tDdlF1jPU-rnY?2OT0ej6AsJRk6xvt~2A*{%r|x70m2;&91~MB7t+M zXE&v3OFs_?edBsXT}!!E%6)Pk?Qf4v%wWsd;!Zl(CZl+9@r+gx;upm+DP{+rFtMQ~&?~6tWrL zm$yA^zF#F0Hl?RCvvkxqd!tiQ^l%kAff!{wF3RD>J(ufwb=F#(&9{ST~3hr9#Yu^wK#tVCx4tTwkm zteGBp4a-Ipa6!Fz@yDI}Y^>Opv_T>%T9K;fNbT{kBdFf^1}JA_sgWVb!WmnqnnVcK zo^c)?^7yZth-}ElejYS~J#?t|Q2FuB)n>j^EpUMcx|(R{_LMsb9NKvgu!NOJzmjWd zXoq>;_LiVq_uKY}NiM#7=WT!pP$-AYyH|EFaCLxBC+Y_yIGgT{(++sKST!*T2_W*3$9tlJo#s>GrJvnwuqdi!S&ZGa zlPxaNL_6^Hn@X%=ihE{jbaPwpQDLpFRl{|g5LtFI@^q;2D)3crn69B`{zDdK{GNFd{KP_w8*Q!!FOc8lw_8@5J zN=6%63^zl@eX++K>g^%YKz2U8BTr8ANCf?H=geH~;L+n}v747pvZLnRsO4DCM+SYg zh(lxxz~L-0eW7$-dHEo3)5Oc0)O{d(u&5OT0I~ z%11Dz!W&^vfO!%_QENyX7-Ta)laoM5O9S#jI;291cdNie{TR{DMc-k@{$k=bk>MP( zpT{23gug-c1GOOsvW5tDn5K!eAB0-hvw19@V7voHyry;)Eh`~GL+ zx0FoG;p}0SZa=TZfmk#;%E5<$x$WZW=nN8qNe_5RsVH{T1br0IU@L6i>Vr!$Ym|PP zLJ||Us8j;*g)Nhrg|C{qmn5=#%139Sf7|*XG-LhCf!Am;^!UFVZeu;AUcL z8p}?O!_ynk@*^5pl+vqK#A+(eDutZhF@!Oi)~dqrINO<+siGWF_J{%jgg|iuZAC&) zY~DSgKKWhwJjwds)qk)~;oQGN-xG8}E^}P3jz#?;9txW##aj z?TeZ*$ccvj{) z(|1sz;7+#n{5cd)*LC(_c!+`C&dtQiHEDaPMu}bRs0OS_6dY0_3Xtg~Qq@4)U3_@* zg#-xI*yGySi2~JIZ?BUMp!gc}@FUZ*uUY35+hNy%2^t2z)J&3 z7)n04O?(6bNc9x%`d2%EmIx$^igr=K*pOLr1(7U~VXKNn;(g>+uBu1_RUdCkx#3tW zdWk`U^|+|8B3T+&cWn=)yjVL%a7rm#row5H5^$4cRWu_76xn6c29tN}f|21Pg&v@Q z(}j?ph?tiQDLj;7QD>KO!88W%p}av7gcAx1ux=@t;#q$|xRaAMJ=IxjiVwu3I1<>? z0W&R3OEUl~n-kwtNDm>S4hj>gfDsH3Hiunx1P4mJ^Ekzg)^* z`8g0RYST&B)HT_oc90Y5eO0PZek8!Z&y43R;EU1)J|bxIGvlOyfs8(o{TgY%+@IiZ z>@_{1v8JPv&(`L+;GFROU)^tS)uEkgm?8iG*-GhZufBc^)%>D~JK9RXd( zeIe<41tEVmw~Dvu(Z{V{dK9C*C8vIpgc~7cG?J^NAS6%)2_P_nges_#4a6f2)`NJ+ zm}D;UvVm%k+WK@zd3X?zgpF5Da)4dyop36_6r(TS3fJPe!O3rodTZ&EsCfA5eL#a` z6-9&S+bfpR=GG~kS}6n$$R~EMP*a*-l7Gu}u4Q<%9U(Q-=+=t)Q(@IrZzXZBY-nZ_ z^O_%ZoUZyi!=qqPaso}}p`HG1D-8604fljarG8i8MlAq!gl=nWneE0gx1iMK$fi;2 zjraruLUOf>Du|^wznDnBxOvCaL257cJib>bTQrD3qIKnsb9-mH)J!?i9*nG?URJ88 zN^lTWR*4!j@5T*`OXB}d7#!0#_+7ArJfIlC1?2~%LIwmqyJqaE!J{X4jnLXXa|T8Y zij3Q7UtLt*et$DiS;wXMzFt&@%Bx*Y*HXrt3d28Z`JQ9Kg~NnxCyl z*&imvRjeu?aNkHde1*}T2P^EHyN;Wvq98$2b%F$gQA#w0DHnnrm&cx6d{PYVMiL%8 zXt_7Qc16&XC6)oS0Fdo?nM<;&!BTNDFbo8u9Wd81D0pQE*!sp3ZoVWFB;Try8_xBr zQ67iAa3Z$r+OTANQt4N&c?C>tO`G6?a?!qjdE{s@`pWI+y=|S$bTDjfj#>^qcs zp7^%DO|;*RFTPtCkV|Z_+sKepLg9!&*$fxDseM{eEkjp{Wsq?666|316Tq^>;HQ`v zkQEZ9)SfULx-a=0}eO%&bPN*f`*V%4YjK%qNM>7$VPyK00kTJ zp?C{THn!n(SEZycooB{=*QV9SS9V_UOkW%v+tA)hF zNpsFMS1j_u5GAQs9&plB!FDV|F}AF{R|RR$J3%llU5Eh70V2!}`$3p=kP@GKb54BT+WG`S0W36^*+2 z-oDFW_iFSSHLArw71B(_BFT7!;n0cOmVg8G^yem&l* z10S7jA6uFP5@=`j2-S6LRvF8>r2?Wr@2SI zcr#G6F}37W*_0J(J^pgR*q|LAL#YIFo)$`GGZMzw(qdQU5RPoIV%O#S)FYuDDybAz zu(L|QX(tTJSecx(UyPefK?EPNJcClGb_-7GkSUxbxSiZNpPs-kz?-L@TBLW_p0~Be z`icPz;yjs57Co0LSMcjiO6z&k_DcoMa#IAd{YK#?OXdB!aJD#}T+wZ^5HwqjY$N@!d(%qH=go#yw0K@f8{ z<#_d#(>rGFwF-g{gcIz&HNs|milB7Ty*&Vk0+H%mElpV#9@6s0*V!;sih-qE zW2VuUNdrWX+Qu87zuP70d-**_TXt7Mp|Cm5IHw;zaI7TFHj>+3&A)sY#F0>_grV#- z)0;8E1TFUO&yF;W0S=xEKF=(|9z;x(03wO#!#Xg-GK^$O$xf2u=ft4+ayeyLkR&XY zfd}-aA{6Rzc&rW^ZKE>TiBTC|Hsc%G)F{@F!$rOM4_T$U)}e|BeshK>OdyHk z0$~#&+zlJZ{amy0fwW-3&=3OQ>tSuCcgbiMFMI;>vO%&INxR&7{|Ut99Nk1|Ih80` zy9ao%$My7hnXUedsRDklZT$DDCvUj%+PTGG_-mhT5z$ouAc%yLh=igb5pTD@I?kgY zbyy4J?=S-qQ;Vbvc8>6P_?{ZBgeEw(=aDt^!4+I_tmZLU&xDit zGq7lgL79;hl#>1u*;Q6&4q*xx!Ge#SFgzDZ0tSIW;EGhFix-~$LG8#^PELfG#s)!w z1kkZ@yJM4jL)z@nsFhY%rheDilBln$T|(eR<6{QO*%n^umuEI*8(u1F*$H5_CQz9( zm^5u33u_)X+EP}LJpr`3F{2Y}RJpT=au1A`!F-S)w%;2%AHAt&i25JM2!P{}aB>N&~`wR)WlNQ^YCh)1x)yNHm4LzzX|L1vDU zoJfH3(Ug)}EZ!&&Ezt*N^^Q5eyrSO&cAy&saLNnPr^5;$%^+#5qd}+?BdUX_Cd06z zl!@CrQen0TmEk~d<}zP5p1Rz#_udouQSz92T_V}WFxWN&7&dd8Al`jHTdDKSafB@5 zkcQsA5ElZ&dt!54@jb<8sj)VNvhzDWBc-(FzR7^Ag~_>X};iljvmLW)4#7fR^c+O-hYi`j!;KIVP6&G_-} zH!=sxVp?bsxahun!fnwfYK6q_(0Li?jS>)ofRdhVer2Z{{Z6y&;!ImLID)3KlHZl6 zr>1@I97U^13A3BK77^jzk+Cjjb@`SbN1?*I0ruWCxnrpHE_4Q#K49rhh=rPfgoA34 z8+is`Wh>TM`5O!D!Qo+{vB|>v?wkqtomgOL9kjK0njjZlWlOz6X$q)92CHP0kV(pZ z6SA=*8|%T(>}>aP)Dyjwu02?rvCJI#dlxk9YHc<_RA(Tprqzn%d_0JTH_1b*$2fz@p zAnE5-Sn4I93@GzWN@#!x;;#p`a)p{yl_O1d&mLht%NLlGgaUsF*RC^W!85E7PRs*U zI}Jl9lK$QGWGx8=_U8NR+r4cUbsAiomA+s_rH755EGdLVDvHWFGam^M3o+`Fusr}v zj>{C?dw%jEj#CiTcs%oYT0+DEmqbEHK&%K?vR2X{G6PEYq&VP)fRyeoDKI_Unv4Oi zguQHF92xOBlo0yqe=p!61;GsBA2A(gw-@&jfc1R7J#TSoU2Dhbd^?D-2c1clBv{Gk zpNcI;(bl!@q4&>z@I+DOs*`7=FlnWZ*4G>k+aM;=Aym$7`SI8-fYl==qLQe_FR9XV zIq|QC*w(rl=6I3V&gVp=od}TaWygzb+5Eq+n=D30;<+c{CRmCDZ42^Zv}N8|u+AFD zQwP*Pn0dccZ7&H02B1L&Ed1gU1U7_`Kt*@+enVS~J$H8T}t_kw^>|gOiK?6uVo}nUg%Xg z7f_H|Pge(U053*dYCg#_AV~rlLMC%>J}SsW^mK1{SG*u0*{HW~RO-6HtCcoH$lDS` zx6A-q^76E`fW2KJg{t>dsHuEVp@^r7)hfe8eQcHy3;=miwa_wlAf$^jSPIby1<6p5Dz$}rCQG~TG8oqv&hb)4d(Ot7 zEX|03#6m;8?!=f<3^Z--0~4X+t!-qmkR0wrKx$G9u>@R&^7!$LKhS_GF?5k-8`myr zR82Zc&ih8$oM!bzOL1z~1Ez|d61l6@Hww}(f{`u(rfsN|my1K9AT;4++qD|SSV9A| z5bWx8ij0U5B9+ULmk2Ex?$AX|<#085dCVz+LxztH3v*Ee61|?MYJnTTYWrL&uAM+2 zzZTmz5=G-#)n;MbOFD!a#Y{}1Cs|sSjM*=h7_fw(L@twMYyrZ`35;5AZrHr5ZFym~ zi&79)s&U9nKK->uuz@3f2{xdDp#ro$OjH7i=AEGvWu_Er5EU8&A+&?8(=d>AhRFjI zHg|D_j192n=>Rg*dqoPfj%{46ATb4t>dSk;q_Ys$Tw0HibBAPTOs4 z#SkP0ip^*gU3{3f#oe=zv(1QN04r;4tKJ7tVp6HYc5p?atbqcys*VUNX1p{PI1OJP;BAh5l3ThmH0C0qI AF#rGn diff --git a/man/count.Rd b/man/count.Rd index 17e32403..9137ff6f 100644 --- a/man/count.Rd +++ b/man/count.Rd @@ -15,15 +15,15 @@ Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html} } \usage{ -count_R(...) +count_R(..., also_single_tested = FALSE) -count_IR(...) +count_IR(..., also_single_tested = FALSE) -count_I(...) +count_I(..., also_single_tested = FALSE) -count_SI(...) +count_SI(..., also_single_tested = FALSE) -count_S(...) +count_S(..., also_single_tested = FALSE) count_all(...) @@ -35,6 +35,8 @@ count_df(data, translate_ab = getOption("get_antibiotic_names", \arguments{ \item{...}{one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with \code{\link{as.rsi}} if needed.} +\item{also_single_tested}{a logical to indicate whether (in combination therapies) also observations should be included where not all antibiotics were tested, but at least one of the tested antibiotics contains a target interpretation (e.g. S in case of \code{portion_S} and R in case of \code{portion_R}). \strong{This would lead to selection bias in almost all cases.}} + \item{data}{a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}})} \item{translate_ab}{a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations to, using \code{\link{abname}}. This can be set with \code{\link{getOption}("get_antibiotic_names")}.} diff --git a/man/microorganisms.certe.Rd b/man/microorganisms.certe.Rd index 7b8ff185..b15bff2c 100644 --- a/man/microorganisms.certe.Rd +++ b/man/microorganisms.certe.Rd @@ -4,7 +4,7 @@ \name{microorganisms.certe} \alias{microorganisms.certe} \title{Translation table for Certe} -\format{A \code{\link{tibble}} with 2,664 observations and 2 variables: +\format{A \code{\link{tibble}} with 2,665 observations and 2 variables: \describe{ \item{\code{certe}}{Code of microorganism according to Certe MMB} \item{\code{mo}}{Code of microorganism in \code{\link{microorganisms}}} diff --git a/man/portion.Rd b/man/portion.Rd index 57368a68..3b8820dd 100644 --- a/man/portion.Rd +++ b/man/portion.Rd @@ -15,15 +15,20 @@ Wickham H. \strong{Tidy Data.} The Journal of Statistical Software, vol. 59, 2014. \url{http://vita.had.co.nz/papers/tidy-data.html} } \usage{ -portion_R(..., minimum = 30, as_percent = FALSE) +portion_R(..., minimum = 30, as_percent = FALSE, + also_single_tested = FALSE) -portion_IR(..., minimum = 30, as_percent = FALSE) +portion_IR(..., minimum = 30, as_percent = FALSE, + also_single_tested = FALSE) -portion_I(..., minimum = 30, as_percent = FALSE) +portion_I(..., minimum = 30, as_percent = FALSE, + also_single_tested = FALSE) -portion_SI(..., minimum = 30, as_percent = FALSE) +portion_SI(..., minimum = 30, as_percent = FALSE, + also_single_tested = FALSE) -portion_S(..., minimum = 30, as_percent = FALSE) +portion_S(..., minimum = 30, as_percent = FALSE, + also_single_tested = FALSE) portion_df(data, translate_ab = getOption("get_antibiotic_names", "official"), minimum = 30, as_percent = FALSE, combine_IR = FALSE) @@ -35,6 +40,8 @@ portion_df(data, translate_ab = getOption("get_antibiotic_names", \item{as_percent}{a logical to indicate whether the output must be returned as a hundred fold with \% sign (a character). A value of \code{0.123456} will then be returned as \code{"12.3\%"}.} +\item{also_single_tested}{a logical to indicate whether (in combination therapies) also observations should be included where not all antibiotics were tested, but at least one of the tested antibiotics contains a target interpretation (e.g. S in case of \code{portion_S} and R in case of \code{portion_R}). \strong{This would lead to selection bias in almost all cases.}} + \item{data}{a \code{data.frame} containing columns with class \code{rsi} (see \code{\link{as.rsi}})} \item{translate_ab}{a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations to, using \code{\link{abname}}. This can be set with \code{\link{getOption}("get_antibiotic_names")}.} diff --git a/tests/testthat/test-portion.R b/tests/testthat/test-portion.R index 8ad11ac5..60df5fd0 100755 --- a/tests/testthat/test-portion.R +++ b/tests/testthat/test-portion.R @@ -17,6 +17,9 @@ test_that("portions works", { expect_equal(septic_patients %>% portion_S(amcl, gent), 0.9210074, tolerance = 0.001) + expect_equal(septic_patients %>% portion_S(amcl, gent, also_single_tested = TRUE), + 0.9239669, + tolerance = 0.001) # amcl+genta susceptibility around 92.1% expect_equal(suppressWarnings(rsi(septic_patients$amcl, @@ -66,6 +69,7 @@ test_that("portions works", { expect_error(portion_I("test", as_percent = "test")) expect_error(portion_S("test", minimum = "test")) expect_error(portion_S("test", as_percent = "test")) + expect_error(portion_S("test", also_single_tested = "test")) # check too low amount of isolates expect_identical(suppressWarnings(portion_R(septic_patients$amox, minimum = nrow(septic_patients) + 1)),