From 0a5898b17d31891c61e7c31698eb6505b803e30d Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Fri, 8 Jun 2018 12:06:54 +0200 Subject: [PATCH] fix for printing tibbles, improve guess_bactid --- DESCRIPTION | 4 +- NEWS.md | 8 +- R/atc.R | 128 -------------------- R/first_isolates.R | 84 ++++++------- R/guess_bactid.R | 185 +++++++++++++++++++++++++++++ R/print.R | 26 ++-- data/antibiotics.rda | Bin 12694 -> 12654 bytes man/first_isolate.Rd | 2 +- man/guess_bactid.Rd | 18 ++- man/key_antibiotics.Rd | 4 +- tests/testthat/test-atc.R | 16 --- tests/testthat/test-guess_bactid.R | 40 +++++++ 12 files changed, 306 insertions(+), 209 deletions(-) create mode 100644 R/guess_bactid.R create mode 100644 tests/testthat/test-guess_bactid.R diff --git a/DESCRIPTION b/DESCRIPTION index a5cb48d5..37bbb549 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.2.0.9002 -Date: 2018-05-31 +Version: 0.2.0.9003 +Date: 2018-06-08 Title: Antimicrobial Resistance Analysis Authors@R: c( person( diff --git a/NEWS.md b/NEWS.md index 615fbdde..c94f4c8f 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,13 +1,13 @@ # 0.2.0.90xx (development version) -#### New + * Vignettes about frequency tables * Possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)` - -#### Changed * Renamed `toConsole` parameter of `freq` to `as.data.frame` * Small translational improvements to the `septic_patients` dataset * Coerce RSI values from combined MIC/RSI values: `as.rsi("<=0.002; S")` will now return `"S"` -* Fix for warning `hybrid evaluation forced for row_number` from the `dplyr` package v0.7.5 and above. +* Fix for warning **hybrid evaluation forced for row_number** ([`924b62`](https://github.com/tidyverse/dplyr/commit/924b62)) from the `dplyr` package v0.7.5 and above +* Support for 1 or 2 columns as input for `guess_bactid` +* Fix for printing tibbles where characters would be accidentally transformed to factors # 0.2.0 (latest stable version) #### New diff --git a/R/atc.R b/R/atc.R index 6a14b349..444d4610 100755 --- a/R/atc.R +++ b/R/atc.R @@ -238,135 +238,7 @@ abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'offi abcode } -#' Find bacteria ID based on genus/species -#' -#' Use this function to determine a valid ID based on a genus (and species). This input could be a full name (like \code{"Staphylococcus aureus"}), an abbreviated name (like \code{"S. aureus"}), or just a genus. You could also use a \code{\link{paste}} of a genus and species column to use the full name as input: \code{x = paste(df$genus, df$species)}, where \code{df} is your dataframe. -#' @param x character vector to determine \code{bactid} -#' @export -#' @importFrom dplyr %>% filter slice pull -#' @return Character (vector). -#' @seealso \code{\link{microorganisms}} for the dataframe that is being used to determine ID's. -#' @examples -#' # These examples all return "STAAUR", the ID of S. aureus: -#' guess_bactid("stau") -#' guess_bactid("STAU") -#' guess_bactid("staaur") -#' guess_bactid("S. aureus") -#' guess_bactid("S aureus") -#' guess_bactid("Staphylococcus aureus") -#' guess_bactid("MRSA") # Methicillin-resistant S. aureus -#' guess_bactid("VISA") # Vancomycin Intermediate S. aureus -guess_bactid <- function(x) { - # remove dots and other non-text in case of "E. coli" except spaces - x <- gsub("[^a-zA-Z ]+", "", x) - # but spaces before and after should be omitted - x <- trimws(x, which = "both") - x.bak <- x - # replace space by regex sign - x <- gsub(" ", ".*", x, fixed = TRUE) - # add start and stop - x_species <- paste(x, 'species') - x <- paste0('^', x, '$') - for (i in 1:length(x)) { - if (tolower(x[i]) == '^e.*coli$') { - # avoid detection of Entamoeba coli in case of E. coli - x[i] <- 'Escherichia coli' - } - if (tolower(x[i]) == '^h.*influenzae$') { - # avoid detection of Haematobacter influenzae in case of H. influenzae - x[i] <- 'Haemophilus influenzae' - } - if (tolower(x[i]) == '^st.*au$' - | tolower(x[i]) == '^stau$' - | tolower(x[i]) == '^staaur$') { - # avoid detection of Staphylococcus auricularis in case of S. aureus - x[i] <- 'Staphylococcus aureus' - } - if (tolower(x[i]) == '^p.*aer$') { - # avoid detection of Pasteurella aerogenes in case of Pseudomonas aeruginosa - x[i] <- 'Pseudomonas aeruginosa' - } - - # translate known trivial names to genus+species - if (toupper(x.bak[i]) == 'MRSA' - | toupper(x.bak[i]) == 'VISA' - | toupper(x.bak[i]) == 'VRSA') { - x[i] <- 'Staphylococcus aureus' - } - if (toupper(x.bak[i]) == 'MRSE') { - x[i] <- 'Staphylococcus epidermidis' - } - if (toupper(x.bak[i]) == 'VRE') { - x[i] <- 'Enterococcus' - } - if (toupper(x.bak[i]) == 'MRPA') { - # multi resistant P. aeruginosa - x[i] <- 'Pseudomonas aeruginosa' - } - if (toupper(x.bak[i]) == 'PISP' - | toupper(x.bak[i]) == 'PRSP') { - # peni resistant S. pneumoniae - x[i] <- 'Streptococcus pneumoniae' - } - if (toupper(x.bak[i]) == 'VISP' - | toupper(x.bak[i]) == 'VRSP') { - # vanco resistant S. pneumoniae - x[i] <- 'Streptococcus pneumoniae' - } - - # let's try the ID's first - found <- AMR::microorganisms %>% filter(bactid == x.bak[i]) - - if (nrow(found) == 0) { - # now try exact match - found <- AMR::microorganisms %>% filter(fullname == x[i]) - } - if (nrow(found) == 0) { - # try any match - found <- AMR::microorganisms %>% filter(fullname %like% x[i]) - } - if (nrow(found) == 0) { - # try only genus, with 'species' attached - found <- AMR::microorganisms %>% filter(fullname %like% x_species[i]) - } - if (nrow(found) == 0) { - # search for GLIMS code - if (toupper(x.bak[i]) %in% toupper(AMR::microorganisms.umcg$mocode)) { - found <- AMR::microorganisms.umcg %>% filter(toupper(mocode) == toupper(x.bak[i])) - } - } - if (nrow(found) == 0) { - # try splitting of characters and then find ID - # like esco = E. coli, klpn = K. pneumoniae, stau = S. aureus - x_split <- x - x_length <- nchar(x.bak[i]) - x_split[i] <- paste0(x.bak[i] %>% substr(1, x_length / 2) %>% trimws(), - '.* ', - x.bak[i] %>% substr((x_length / 2) + 1, x_length) %>% trimws()) - found <- AMR::microorganisms %>% filter(fullname %like% paste0('^', x_split[i])) - } - if (nrow(found) == 0) { - # try any match with text before and after original search string - # so "negative rods" will be "GNR" - if (x.bak[i] %like% "^Gram") { - x.bak[i] <- gsub("^Gram", "", x.bak[i], ignore.case = TRUE) - # remove leading and trailing spaces again - x.bak[i] <- trimws(x.bak[i], which = "both") - } - found <- AMR::microorganisms %>% filter(fullname %like% x.bak[i]) - } - - if (nrow(found) != 0) { - x[i] <- found %>% - slice(1) %>% - pull(bactid) - } else { - x[i] <- "" - } - } - x -} #' Find ATC code based on antibiotic property #' diff --git a/R/first_isolates.R b/R/first_isolates.R index 1dba01c3..f64847d1 100755 --- a/R/first_isolates.R +++ b/R/first_isolates.R @@ -22,7 +22,7 @@ #' @param tbl a \code{data.frame} containing isolates. #' @param col_date column name of the result date (or date that is was received on the lab) #' @param col_patient_id column name of the unique IDs of the patients -#' @param col_bactid column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset) +#' @param col_bactid column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset). Get your bactid's with the function \code{\link{guess_bactid}}, that takes microorganism names as input. #' @param col_testcode column name of the test codes. Use \code{col_testcode = NA} to \strong{not} exclude certain test codes (like test codes for screening). In that case \code{testcodes_exclude} will be ignored. Supports tidyverse-like quotation. #' @param col_specimen column name of the specimen type or group #' @param col_icu column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU) @@ -291,15 +291,15 @@ first_isolate <- function(tbl, return(tbl %>% pull(real_first_isolate)) } - scope.size <- tbl %>% - filter( - suppressWarnings( + # suppress warnings because dplyr want us to use library(dplyr) when using filter(row_number()) + suppressWarnings( + scope.size <- tbl %>% + filter( row_number() %>% between(row.start, - row.end) - ), - genus != '') %>% - nrow() - + row.end), + genus != '') %>% + nrow() + ) # Analysis of first isolate ---- all_first <- tbl %>% @@ -328,39 +328,44 @@ first_isolate <- function(tbl, } } type_param <- type - all_first <- all_first %>% - mutate(key_ab_lag = lag(key_ab)) %>% - mutate(key_ab_other = !key_antibiotics_equal(x = key_ab, - y = key_ab_lag, - type = type_param, - ignore_I = ignore_I, - points_threshold = points_threshold, - info = info)) %>% - mutate( - real_first_isolate = - if_else( - suppressWarnings(between(row_number(), row.start, row.end)) - & genus != '' - & (other_pat_or_mo - | days_diff >= episode_days - | key_ab_other), - TRUE, - FALSE)) - + # suppress warnings because dplyr want us to use library(dplyr) when using filter(row_number()) + suppressWarnings( + all_first <- all_first %>% + mutate(key_ab_lag = lag(key_ab)) %>% + mutate(key_ab_other = !key_antibiotics_equal(x = key_ab, + y = key_ab_lag, + type = type_param, + ignore_I = ignore_I, + points_threshold = points_threshold, + info = info)) %>% + mutate( + real_first_isolate = + if_else( + between(row_number(), row.start, row.end) + & genus != '' + & (other_pat_or_mo + | days_diff >= episode_days + | key_ab_other), + TRUE, + FALSE)) + ) if (info == TRUE) { cat('\n') } } else { - all_first <- all_first %>% - mutate( - real_first_isolate = - if_else( - suppressWarnings(between(row_number(), row.start, row.end)) - & genus != '' - & (other_pat_or_mo - | days_diff >= episode_days), - TRUE, - FALSE)) + # suppress warnings because dplyr want us to use library(dplyr) when using filter(row_number()) + suppressWarnings( + all_first <- all_first %>% + mutate( + real_first_isolate = + if_else( + between(row_number(), row.start, row.end) + & genus != '' + & (other_pat_or_mo + | days_diff >= episode_days), + TRUE, + FALSE)) + ) } # first one as TRUE @@ -402,8 +407,7 @@ first_isolate <- function(tbl, #' Key antibiotics based on bacteria ID #' #' @param tbl table with antibiotics coloms, like \code{amox} and \code{amcl}. -#' @param col_bactid column of bacteria IDs in \code{tbl}; these should occur in \code{microorganisms$bactid}, see \code{\link{microorganisms}} -#' @param info print warnings +#' @inheritParams first_isolate #' @param amcl,amox,cfot,cfta,cftr,cfur,cipr,clar,clin,clox,doxy,gent,line,mero,peni,pita,rifa,teic,trsu,vanc column names of antibiotics, case-insensitive #' @export #' @importFrom dplyr %>% mutate if_else diff --git a/R/guess_bactid.R b/R/guess_bactid.R new file mode 100644 index 00000000..9194c4c8 --- /dev/null +++ b/R/guess_bactid.R @@ -0,0 +1,185 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Analysis # +# # +# AUTHORS # +# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) # +# # +# LICENCE # +# This program is free software; you can redistribute it and/or modify # +# it under the terms of the GNU General Public License version 2.0, # +# as published by the Free Software Foundation. # +# # +# This program is distributed in the hope that it will be useful, # +# but WITHOUT ANY WARRANTY; without even the implied warranty of # +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # +# GNU General Public License for more details. # +# ==================================================================== # + +#' Find bacteria ID based on genus/species +#' +#' Use this function to determine a valid ID based on a genus (and species). This input could be a full name (like \code{"Staphylococcus aureus"}), an abbreviated name (like \code{"S. aureus"}), or just a genus. You could also \code{\link{select}} a genus and species column, zie Examples. +#' @param x character vector or a dataframe with one or two columns +#' @export +#' @importFrom dplyr %>% filter pull +#' @return Character (vector). +#' @seealso \code{\link{microorganisms}} for the dataframe that is being used to determine ID's. +#' @examples +#' # These examples all return "STAAUR", the ID of S. aureus: +#' guess_bactid("stau") +#' guess_bactid("STAU") +#' guess_bactid("staaur") +#' guess_bactid("S. aureus") +#' guess_bactid("S aureus") +#' guess_bactid("Staphylococcus aureus") +#' guess_bactid("MRSA") # Methicillin-resistant S. aureus +#' guess_bactid("VISA") # Vancomycin Intermediate S. aureus +#' +#' \dontrun{ +#' df$bactid <- guess_bactid(df$microorganism_name) +#' +#' # the select function of tidyverse is also supported: +#' df$bactid <- df %>% select(microorganism_name) %>% guess_bactid() +#' +#' # and can even contain 2 columns, which is convenient for genus/species combinations: +#' df$bactid <- df %>% select(genus, species) %>% guess_bactid() +#' # same result: +#' df <- df %>% mutate(bactid = paste(genus, species) %>% guess_bactid()) +#' } +guess_bactid <- function(x) { + + if (NCOL(x) == 2) { + # support tidyverse selection like: df %>% select(colA, colB) + # paste these columns together + x_vector <- vector("character", NROW(x)) + for (i in 1:NROW(x)) { + x_vector[i] <- paste(pull(x[i,], 1), pull(x[i,], 2), sep = " ") + } + x <- x_vector + } else { + if (NCOL(x) > 2) { + stop('`x` can be 2 columns at most', call. = FALSE) + } + # support tidyverse selection like: df %>% select(colA) + if (!is.vector(x)) { + x <- pull(x, 1) + } + } + + # remove dots and other non-text in case of "E. coli" except spaces + x <- gsub("[^a-zA-Z ]+", "", x) + # but spaces before and after should be omitted + x <- trimws(x, which = "both") + x.bak <- x + # replace space by regex sign + x <- gsub(" ", ".*", x, fixed = TRUE) + # add start and stop + x_species <- paste(x, 'species') + x <- paste0('^', x, '$') + + for (i in 1:length(x)) { + if (tolower(x[i]) == '^e.*coli$') { + # avoid detection of Entamoeba coli in case of E. coli + x[i] <- 'Escherichia coli' + } + if (tolower(x[i]) == '^h.*influenzae$') { + # avoid detection of Haematobacter influenzae in case of H. influenzae + x[i] <- 'Haemophilus influenzae' + } + if (tolower(x[i]) == '^st.*au$' + | tolower(x[i]) == '^stau$' + | tolower(x[i]) == '^staaur$') { + # avoid detection of Staphylococcus auricularis in case of S. aureus + x[i] <- 'Staphylococcus aureus' + } + if (tolower(x[i]) == '^p.*aer$') { + # avoid detection of Pasteurella aerogenes in case of Pseudomonas aeruginosa + x[i] <- 'Pseudomonas aeruginosa' + } + + # translate known trivial names to genus+species + if (!is.na(x.bak[i])) { + if (toupper(x.bak[i]) == 'MRSA' + | toupper(x.bak[i]) == 'VISA' + | toupper(x.bak[i]) == 'VRSA') { + x[i] <- 'Staphylococcus aureus' + } + if (toupper(x.bak[i]) == 'MRSE') { + x[i] <- 'Staphylococcus epidermidis' + } + if (toupper(x.bak[i]) == 'VRE') { + x[i] <- 'Enterococcus' + } + if (toupper(x.bak[i]) == 'MRPA') { + # multi resistant P. aeruginosa + x[i] <- 'Pseudomonas aeruginosa' + } + if (toupper(x.bak[i]) == 'PISP' + | toupper(x.bak[i]) == 'PRSP') { + # peni resistant S. pneumoniae + x[i] <- 'Streptococcus pneumoniae' + } + if (toupper(x.bak[i]) == 'VISP' + | toupper(x.bak[i]) == 'VRSP') { + # vanco resistant S. pneumoniae + x[i] <- 'Streptococcus pneumoniae' + } + } + + # let's try the ID's first + found <- AMR::microorganisms %>% filter(bactid == x.bak[i]) + + if (nrow(found) == 0) { + # now try exact match + found <- AMR::microorganisms %>% filter(fullname == x[i]) + } + if (nrow(found) == 0) { + # try any match + found <- AMR::microorganisms %>% filter(fullname %like% x[i]) + } + if (nrow(found) == 0) { + # try exact match of only genus, with 'species' attached + # (e.g. this prevents Streptococcus for becoming Peptostreptococcus, since "p" < "s") + found <- AMR::microorganisms %>% filter(fullname == x_species[i]) + } + if (nrow(found) == 0) { + # try any match of only genus, with 'species' attached + found <- AMR::microorganisms %>% filter(fullname %like% x_species[i]) + } + if (nrow(found) == 0) { + # search for GLIMS code + if (toupper(x.bak[i]) %in% toupper(AMR::microorganisms.umcg$mocode)) { + found <- AMR::microorganisms.umcg %>% filter(toupper(mocode) == toupper(x.bak[i])) + } + } + if (nrow(found) == 0) { + # try splitting of characters and then find ID + # like esco = E. coli, klpn = K. pneumoniae, stau = S. aureus + x_split <- x + x_length <- nchar(x.bak[i]) + x_split[i] <- paste0(x.bak[i] %>% substr(1, x_length / 2) %>% trimws(), + '.* ', + x.bak[i] %>% substr((x_length / 2) + 1, x_length) %>% trimws()) + found <- AMR::microorganisms %>% filter(fullname %like% paste0('^', x_split[i])) + } + if (nrow(found) == 0) { + # try any match with text before and after original search string + # so "negative rods" will be "GNR" + if (x.bak[i] %like% "^Gram") { + x.bak[i] <- gsub("^Gram", "", x.bak[i], ignore.case = TRUE) + # remove leading and trailing spaces again + x.bak[i] <- trimws(x.bak[i], which = "both") + } + if (!is.na(x.bak[i])) { + found <- AMR::microorganisms %>% filter(fullname %like% x.bak[i]) + } + } + + if (nrow(found) != 0) { + x[i] <- as.character(found[1, 'bactid']) + } else { + x[i] <- "" + } + } + x +} diff --git a/R/print.R b/R/print.R index a631ac22..7cb3b4de 100755 --- a/R/print.R +++ b/R/print.R @@ -192,7 +192,7 @@ prettyprint_df <- function(x, if (n + 1 < nrow(x)) { # remove in between part, 1 extra for ~~~~ between first and last part rows_list <- c(1:(n / 2 + 1), (nrow(x) - (n / 2) + 1):nrow(x)) - x <- as.data.frame(x.bak[rows_list,]) + x <- as.data.frame(x.bak[rows_list,], stringsAsFactors = FALSE) colnames(x) <- colnames(x.bak) rownames(x) <- rownames(x.bak)[rows_list] # set inbetweener between parts @@ -204,12 +204,12 @@ prettyprint_df <- function(x, # class will be marked up per column if (NROW(x.bak) > 0) { rownames.x <- rownames(x) - x <- x %>% - filter( - suppressWarnings( - row_number() == 1) - ) %>% - rbind(x, stringsAsFactors = FALSE) + # suppress warnings because dplyr want us to use library(dplyr) when using filter(row_number()) + suppressWarnings( + x <- x %>% + filter(row_number() == 1) %>% + rbind(x, stringsAsFactors = FALSE) + ) rownames(x) <- c('*', rownames.x) } @@ -252,12 +252,12 @@ prettyprint_df <- function(x, } # markup cols + for (i in 1:ncol(x)) { if (all(!class(x[, i]) %in% class(x.bak[, i]))) { class(x[, i]) <- class(x.bak[, i]) } try(x[, i] <- format(x %>% pull(i)), silent = TRUE) - # replace NAs if (nchar(na) < 2) { # make as long as the text "NA" @@ -297,16 +297,16 @@ prettyprint_df <- function(x, colnames(x)[i] <- paste0(strrep(" ", width), colnames(x)[i]) } - # strip columns that do not fit (3 chars as margin) + # strip columns that do not fit (width + 2 extra chars as margin) width_console <- options()$width width_until_col <- x %>% select(1:i) %>% - apply(1, paste, collapse = strrep(" ", width + 1)) %>% + apply(1, paste, collapse = strrep(" ", width + 2)) %>% nchar() %>% max() width_until_col_before <- x %>% select(1:(max(i, 2) - 1)) %>% - apply(1, paste, collapse = strrep(" ", width + 1)) %>% + apply(1, paste, collapse = strrep(" ", width + 2)) %>% nchar() %>% max() extraspace <- maxrowchars + nchar(rownames(x)[length(rownames(x))]) @@ -340,9 +340,9 @@ prettyprint_df <- function(x, if (ncol(x) < ncol(x.bak)) { x.notshown <- x.bak %>% select((ncol(x) + 1):ncol(x.bak)) if (ncol(x.notshown) == 1) { - cat('...and 1 more column: ') + cat('... and 1 more column: ') } else { - cat('...and', ncol(x.notshown), 'more columns: ') + cat('... and', ncol(x.notshown), 'more columns: ') } cat(x.notshown %>% colnames() %>% diff --git a/data/antibiotics.rda b/data/antibiotics.rda index 6d5d5d8b320f74ee02af000eee22ebee196eeaf1..27221fdac2acfcd21d823d9938cc061305cab87c 100755 GIT binary patch literal 12654 zcmYlNWmFs5^9Bkh!2$#b5FmI67TjGLNT7k@Rw$*#-HKb=00Dw)DP9QfPVwRt*HVfV zr!A#|R?oTT_kY*B?tRw&u=ng)GxK5gTC?XF?R)MjGFmo5<~GL0^g)2YoPYoSxc+Z* z`Rd<)|BL|e(p*4*b5wPGsk`?bon7p2%^yE_wZvm19^3PBXjt%F0%#enVJ5|Wg`tmZ zS9u<5;(2a*0yAgM+{#OVXaKi7%Vu){_3gIx7{ac2ZU^@SStct+vf!=_i+%=uUmnh; z?Tr}Lhp;YZnbYAeQHrr(c^SgpHQWog6l=%k)T1dY%G*J=T|bZ0>-r4G=7i}%qv?c% z3}s~gW)R$mj0(A?@oz!|36iMWjzI1^1PhC z71Gg$8W`i%l2VR{0{Mt^6982WfR0XsvC31{834HA0Julsv6%+YB@TWA{fO!#4dyGo zkLm>;<%U899At(Nj3*r(u&O{dBDypJzvxUEkEiqmXM(jrjx^o{##(y6sy|f6sb{ZV zaX2pm`}eCVx}vQua#jDI1z1?%Q-#Hpb$J zcRgA%)*$oK9GEW;jVxX>ePeea#v<>@N;x`F7msaOQbl>697xRTy$yW21m+PtB;lX_ zFfsA!m)ZdHX)Lm!a5X<}76o$<2`)4-Iih$SOO2;%Z8g7k29VWr_);9W7WqQ#Z5hM6 z?BmrWHAEZW77xvz#9!TaPsXL)+DcXg#!Rx$-_5_qFea5u^U_gE9ay_{V#=+aU^Lap z@*Eo&R-CWj?L4;P#sv!~;p*z?CtV|ILf`wmU@uOeGA6vBe!)`gcb6urDoQ@VgGI|! zc-(1vflLz_DD$^o-Qe)j=lEFG={x(LVdzHO7DmS|^|bukc&gJ6FC52od=1 zIX_|eLXS1%ckcfkE`%2Pb%aY3!oRe9RdeChjy|~ae(-6?R1u2%n9320HARxf+2O=; zcwNnyjt)EtNg{Tw3w(C?KqB0vT>Ms(jZmBq?K$?@I^D4QG%?&eDlIWFG7)7G^V{f@ z)ARI>n|RJ_TZ@-$tmlz`wuF!sT-Z_k1t!j$O~7@$;12dD(NY*?ANNY?ZsS=$_G2e` z38#)`N(PvP05$`a-(LEDu{PR#^vBkFPuCt1ZTI4nq zNE8VaGtNp&@sOX-lEtxf9OhU$M$E*_bQ#y&Z2vg0Phex^l0DP>VzV=lc=nQ+)7xl8 zeldl@lXPLy`n{RRJDJd{zDB-&5at`I;xcZt;C1L%eI zR!kqJpwXu;^0~}K(8Az$m-2e|{~2ngK0bN|DbIXY{Vo{eHUC%r+QF+}_WRg|a0L6A zI>*A-`8gIQAbF0qNJdkc8jTsB^<1_E$1`DOW3Bk!f9%8r$$u>kZC^K!{5TO2LE2Ya zSx5Y9nEO?o*v<40P;*dfh;|-?dHgxn_hz~eP`-?fh;pU0nmS9=dAzT zsb>H~{CTMLZwB^}Qjt3!1+w((5=F#zJ{sTw`8ip4|9@J7Uia2I>*`1V2)`o&TzK#8 z#0`LUhvF-FUypJTb!Z?X)IIC-7uT_DZRCBb#EPc>nRd?ZW*a!xulvtgMV6kR#hg|i z(9)s~4|NV$ttH2q=EQ@yd^YJ`c+q=PR~7#&ED33OZDW{g#HV|t z?L#L$f-6d7m31+9aZG$`J<~L7(Q$J|A(9v`A)}v|69@N%S?PU+jD_<1r6eW6~r2-@34%$#PISK}}qZ=<*?$X^xyZM?k<(&`2FJGP2mZMn67m z4EbJ)K~jlT%E?m%wj7uIW6yianL%W|hDb0plVm z6jl++5@bYrt?CO8{JaF zRnulo;Xcm!u2~~3njZU3UOB1%ddit9b8qOuC;N<@9aovoQAVqu>nyX4-gQ<9_gcai zfpN4ZW#eS!PC$FQToa|FVOOx}3e4ZH7&`xnvyT$Of~FI-NC~eEYI01pM1LUmKu6ro zrdv1^qf-Jl0hMK{xlQPH#`EI)~MoI}Td;1xytMtiu{;0rj*9lt3T`x5j zw{RPk>mx&+q;fvnq94+aVzQCJW=+@_Dc0nJjibZ_ zs*Lbo3Ym$*fV0vR5I%6XrJ^yg)BF`Wj9Z_4s;9yLl^ODSDZ3-av|FUijKD9YvoTE~ z7Y`Y3{dqs_!&qKytGczGS5y7Tk?eGD0!EAQ71G~W(sjwT$Au5C}XOF!6tWpMwX*2+>{9G+H zZe$D+bHt9g4R)rgjRsCiI&_;j8$Lr6(yltTp!2zwNG(>^G&&LcyZ3TP)(2&&W8qfW z9s>N-^!2kN7g=OLL{GV|thY@WPnhVCVS_e7!o18p-~-;1p0a>bZhjnI;K%3xI^KHJ zvkD;$`VB(oiB1#AMQcNsKRB|IlL_FC=-SFv7SZ3|hIIig8&QdnCJ50|ak-HdU3dMk znq#m_vpyup>gP0l9Q6pg;7dLVFh+d@6s1AZsI5l>9-PYt@h3$;c>_>4(6J(CJHM03 z{CkkcS3`n~^UHAp@``2C)*fKjM^Q0U;sM@Dc|G26mOzwFrqL-|yQI*BKV`^w4 z@XEDXIZj8+k&=GoJBeXvC_JN`f+s7TpAwAGfdd~H)A{l1;#`?^-P`7dlT+yR6YXp3(HxaoB#r%iRo zp~Jdlu@vz~?9v<@u*D7S)gj1q@vDbP@0(n9oXdE*UAkyqzRWL-bXjFaNe@v$@;lwW z1V$cjrq#6yOtt^_-Yo;LdBoV23&9k(suvRG*{h~HFw@i4qxPd=-`>-v|6BEtWv0r{ z!_;&!4Ke|N^H;@FLVls15bCx3_MW9iS;MSJ&dyJPD|PkaPL}zdl&?*9P4h;?7QY-Arat%h)dJsak2x)lJfqayv;*+_5?Ld1H^FaOh3l`K)UyftQud_^c1mruGdo>t z)0nxtQ?+^zHAC^m!;qD~=cLXj^c{|qW|bXX>*t>`K8W6~nob6Gh?xxt4+&39QIBBX zA!Cv$VkXN+x4(r(mfT`UZu?r_Xj~HV0Z=k&!5`^&k46VkHq56;Fu;imP~a;(G;$gN6kG=YM;Xh}hKOsJrAFI8dyFRlwN^_8UPeSxrlaPzz8ar$$wk;w-a|GwyAYH5 zx9r`h=(!)*_9}tZd}b1l;~z<#{@HeVFz=<(CEBiqftY-`{9i(Zbkl{h)@6a2WdQ6% z5E21Sh=zVc^3cjU&gQiv{wrS+1=<*`9q#HRwugo|XNr~vpW515`m{+&1abO&-k~{> zm}zXhSHrc|_1Z$m4Bp<;#d<7lj5~r!D?JZ0Qh%01iaZ#jzK|~%)Y8zmk1^D~IlyKy zHC1iJ{Yp&FdfGaO0kC8nS>9+x?GAV>{}$x!xn3x_g^hE4<+ho48L>bAy14?*ho~bnjn>|KtN}?Tx3Ix!O~bRgzwF>E@3J(KXQc?@ zT!LAr+jcA$Et5fw)?O4!;Qax>?@akCDsHoyye#7E*ty6N)BRmNDSKW(?=3*TUXY<- zRqNH4%g=TScc$C#R7*T`a=-*`SiB6v&Vfu!MqgDJWv{w~9k{kN*5%>$HeKsCkbJB{u9 zOHG{OB!4@fS z9LcWEz0b_d_dG+3j{s?~u@yCE&t00g9qjDbWN&<}D+96b@H&0y7pdnJdOB!#qI$s8 z04sLo6}C}fcy_fwI{9;>{7a!VUzy7l<3&aBGnwscVM6I2r>M<`T1y{eK9?_?y~(%% zM<5i?VX*Ngj&zZ|i(rJihiS@l7+T?W57uh~{{MPNM-Jj@d6aII@7qHtr z$!TZjN)Dpoxi7dX;jKY;zJcL-1o+o9ccpadjPqigPsbC^U;mO{HFO9nRWE%E(YQSl zekXc8O2n_}sqU}I8r9yh(NjsJr%<%85HDPtU)1rq(9D0#lDReJO`Z3AaR7EX$7lEM8W(L6*=b?CEbYFji9%99rnR|? zCUTWwguj+AI*8a=Sz$jK_jOP0H?z`9I`igpwarKGI)z2jCPt0bD?Q3OU8@Snz2`ty zyWi>*DGL}l8B=FwSoe~!iH;8(*rTNq8dOckvThGDKh=Wujzzw{6Q%(^6Ue+`+QZ-P zzAu0C_QiX_`gBd}z_aVFi^a|C>pq(s%$&iMuR#fE)^Xy>GBeJPuQt44te&~{j;XJM z;B^ZwCxPA&f1AK~_}20|bw4b%wW!v#kEVUBOTH5GAk6sDzC)-jsYXP|D z9PXTPF|Kbd&Go%~|EKC#>&wBzKgRDINVb#M(0#v-Sys9~3>69^h4xKThe02ohZa6< znw_UoysEpNXyO)6bbrAHy;3lTLnt>(i$->`0tyA|Kv&v;&P-)y|Um5!o9LGXVCs6b(4;(HPYIO~5i)#=s6YXMp4Otb*UHLn3usuxH zMx_C<97+9L%(?SoQaax0@vEojf#FQt;`MOU6yJPQ7n09a>W|BsvOLgLPLSdbg<_vj z7SWv=$;!!Pm^z9!RlX%Xq{T=>!K*v@jJn0){hREEHhrJfr`4m;f4V?rX`>0V-v4Aj zXWNavXxo|RKD`G)k;c;~>NLl+b!38AwZK~b7m+DhPn^+;R0}oS7G`J@A+$J57tl9s zJZ^Ce6yKhM~}~6t7-ms4%3tb+&`g0G5r|&zu}eMeP`qg>Ye-A+zTpJEXYKz&`YpZl8i}G zEtW#`cMm0p2SPM=j8YZz{b6%gEI*w*wG*@@SR2~%89rGXy)l*!dWIlq@v$HXK;^WD z4p2T2O=JyoD8rVY@Al;t$AVd3f1hI8jQBctx1Z0?Q=9W9ov#h1y2;Y+9KWL*-9~rKQAy{ynQ$@|;d?AJD=3ja`t$c` zg45@KL+9|!SmU{aeh0GMcpUKf^SQr92`0Hu>#)CH`rwY}nAxg4IaGwEm9gooyIEmq z-(0|(ADS;Fv+J3QlpYIa2pBm;jAiIi@{vb_q13TQ@N-F$C+f!_pQj+co8eyB4E`aM z8GnQK{jPP}IRa+(Gl-HAr1<$a=2464*%8^%^bZTp%e}p6s_{~8O5I~y4COLx5jVms zl5I?xj0k2sP*M_a=Xj&cW#|QulPS8Tl^qz6{9LMK(^cT)r(3(-V4B9?C}aG%amd-! z#S~c>NmZ4ube-?nwD)!Cr#%Q2}HGFJfp@bO_+T?_SV zGEZ?6NY@el#@PAh%=@DfndJ-yS%3+e<&QwPW*afVp)bup-rd2QEB8D~fyDGl3ymX} zj^B8vbyIy%(%SARY$%P#kc*St3eOKp2RMfmwBokNW$ue^aHW~^s|ky^ZtRZsXVWhM zswFyHI5|D*ynO6EQ2Dv;IaLIGGeHr36B69LV#t*+TV~dV)8ctgSoGs!GbF9vQFhsx1Mno%=r>kHtJU?P!-AQE$!@1cmq7z=GQD;h~a+Gk5_@>H{$ zM=36A(B%E54Cf>R>`0D#WY1n zKG~T@xk-thyedzE^h<~OLuq){hqk{haj_J97%SJ+EhO0IVCAFIJ_k9ZrCX+DBp`7| ze-f5Lmz2V(8BJt&ubAVKxjEav$$9%f2$+iXC>v&9$2t*XT)9c9vfbzg@V+&x00hm+ zK`BJ<3isD@ba&2faS#JJ37P`$FqL8BoHOm)HsAt;chPeyQ03@$%6&gFEQXvP7Jq5l zo3lh7Cq%d-&Ie*BGwupvn)M^E4$wzYlF7{WQdHb*6B1dB@Lc@mG*z!N9dxlMFfJ*` zjGB+u;E5=erMVFu6plurgUb+xt3w|0Yk>R~1zFCu{P(PpbI@z{+hQ0=@lQ;>x?88&6lYVRM8z>--89QNi59tDj(^ z=XhBu@!K|`vdR8MG%ipLYzhoQUuNJn7oRL$&xOam(6h8VeLOT2!w05%;2(#2$JTjK zW{ae1NVc=q&_G-m>m0@rykhGpD0XzC!NOJ7v>%m8^zMNm;A-@6Ge=>6UCT!A>o#ra zL`ujy%=|nxf;)cY>0LxnSTRHFKJfM3jc@Bz;Hs~CWC^=vbMKdZ6Nsnl;3?@vnT~R- zk3)_jM@A2)f$CKS!d;%vF5h`nPCTQSAsrE!$#dhf z_2kDN3Zn%3K;VaXVE^yO=PsOF-#x56bl|=Wp;CeI3x_F%as<5R=1pd{WX*j-AmT~ltOk*y{7r) z5m-QX!(yMy?*6cS;f>L3k9U)r8tSMKn5WZQ6J`+==+sTH-*Ts@S&oi#g2Tr7KgtZJ z?%r_kK58jCDePeQ{p;J}9350v%T`rb(s&^61-5BNNl^dyM#G0TnEO&j9JE|FN%rn} z6qX^piOnFYgapvd)2c3F*>vM}r^j+-$*w|Tr)#guy+gz~K zMJw@>7nmxWDkYgn#G8D9nmEYamQXR@pH z$y;dFB=kPA`H-0xzA|O8Xn!}}{xMoHRt%@h7z0(8!3${m8&dxycyq|t+%n_7(_-Ds z7mc}5wTl#cw_^SESChVyJv2HG^f#%3QTp(S%dZwSz`C+GB#D2Y*P~QNM<9toKkG!G zMKPJ>-CZt(Ofe8ajo0(jjC~iw@Z{fsoUNC(OD1(kpzTiwu|O=UEXF`yiP1X?dQ(-U z_70bbEjMC_EW(tH3K$*>6y1Lo7$z3K&FMvRkC)$opr3pd+FukK2zz5ehmpPUrJ@pg zUhiN+P$7Wty60tyL^?>^ftW*6%sVEC0ZxSzA3nLZRT_+;%X0)n{i$ynQtsq%H6N^Da$nB_g5_@Hl$r2oO!NU@Y>cYB?Q~oCM+=jG{Re*N8u& z_IpG{E>4WgWF)<|aSUx8KTy&cI-OfC-8H;*yPIrw>6;qEd!Dw5LkOR^DGj+?P?!pU zr7!RNyh-`35q6+H;ZF6PiO<7YD-F+>S1RfPH=2vKbD!^x|A<&1@g{-*M4zRUX!>MvRQ&?Gi{_L5e)mmXuepct>jd&LxL zkb(ejR`(NMQ%H)w{A~)LAq={t`z`2bck@k9NWU6q28o(ctsE8ZBC@rTm=S4r}DVOK}Q+eb$~JSxF>v6 zWzv^Q3QC*0@#JK{EcOE`Im_8H@z@PA)nk3A58fJN6sgS&g8s(_&ARIlu*->PO}e5< z!3aPQ7mCs-nC#7Zom+RjEv9kmlx>Ccr!`GzNe(YM78-e9>}v$Ka6%kA9+!;A0TE;} z7SUmrT_16cfN`cp6y>wXXN6trKi;z>&R~Ov&!P-Ok1R$3);`_Hm6!EB%X19Rj>y+~ zA&P$C*#UgV$eVRyFhQM^X@L}gWdh%Tzd_SVYdNJw%9d`1w%BrO)N{$eC><6n8A=G$ z9#u+!Ge!Z#E8;GGJPc+?#o%532F`p559HM{*qGCBZ~Z=M$DvnG#H3eiwgl>W5IRZ}%5 z^Q~)cvh#TRW#8m{LTU67PYjt2K|_Y@J^c|nq0_*Zx;f>S)*iMRPxie{9ZGG}UR3^a z<-_|2W`@J}+dh??!oH)B2kgajj9fCt0$6?RzBuV?4RX2P0Qz(OA z6zUdc$O@epUb0QQuO&W|P4rraYTQ5AJJTy1zxh(mvPtg?hvVGy%y!@NC#_>L$}1hYAMd%R8mcz?=Gstfo_QY&vaMcv)3U67!wq@)E6(R z1(HP+uqPeAoccr$s6=oUExz%gomd>5uh#tA%x8lVSuY2UWK9p3+6m^Hj?%_DgH8B6 z43|7bitbUOIG9;=%+ThC8e|#LizX4XeQGKaz$L<{4-L?VuZAtAqK@n-vh`g0-As3Q zVR}b(>kXi&r+nbM(B7v~rfdYuR5gWGBD^r+{w7UYIx?Z3q5V&(%nsl4Fgq9w^K{ZY zdJR+wSky(up&bzl)p@$|rksaxkGo#LN*siIpa_4DCn(8U8ETKCh9U`>AS#a+=@JPL z-l+vSWM7w2K*4c`riq9X9~c@9;)fsho3%b_#vgMLpv#j45F!74|8o5wx)-DG6ZoM?^$Gay|5&*{^(>sDhES*Yok@y3L>q#&u(gkP0+yQtMv$0NCi~Dy69Qw`}I)hc(Q~+o@Ttk9JL+!a2*&fM2+*ss*#&lwM zPIxpBIS$5B>vo|`RccHnqnX5k)Z`#EY}0ky)Fl_?($;n@j=$2?Ag#X@D#lPKbtObWC|` z4sc5q^&FB)OdEdGD42r*GLBWa%^+#`B^3iM(q?7Sb)(`-O43$+?9=%Tf;gWGk2wE& z89h|WlHea^^4qHH;`7iCGSGbO_*C>k=G)$YJd(mNFGX&Wd7LLROMY>pCbb=sdMnLHXWrfaga zE0BlFqhq3JLNg%opk5xuMT>ef=_bZ3|7uR1s%MP+!DML}CUn z(@yOO@8hqk_zve?V|yy;tA2$c_b`?-*(=%8(vSGEdPdpclUWQmKbgZmo(BL%ntZWw zKFw4gR;>p0%vRAU)CnN5L$131*jdCNy`ykVf`Ep2u(5e);!ZQ3eEf%Zl#n}>7;v8% z;7AU`4Bl!UcPm)9SrlF>>oY`LT zyg%LB@U&`#6I_>Rz-_qwmfe*X=c6xg7czpOJ2jg9sF+++Eoa)t<24fl_4H5Y(Dji!$KqbA?{J8 zHXxUl(>_0(a|x_*ufEgL`*U=wR#~j?&tC~is$s$8Ar&&k)a&eALsov!EXT3?tIHBkGvJ$Pn%YPkpb> z3?=3jOKX##q!c{z@yGA2l$mFcbOqnKUY^l|y}9y~9jOiAL=`aF>_}<(^vPYIBB*M} z$SHg+sLDNb581*a#W<>1%o7r)4~$@gU52ruecgON5rp4=9;_pMcs%6Omgj$TDMuqS z<172$Oyr0>Np?=I0Z}?49_k1}CrzCgDfcRk_k^M2R`tOoBV0m=t2iWRItexV8kpCy z!b0YhmoxZ?^xnzvP&Mc{XfdI_{IuQ9u7oX<#|TYk7$o^ot5Q;wUHK(+K1XSCko^@W zTkFaGNzGheyga$$)dj$aPM3CnNM@kyHBsW7HSC3%W{7X>Iyssmli*cKomHh4>zg zaum=O0)3=KPKXYH_yqK6Qt~9+hbR%bi}$%5Glp5F3?xiir36ctDefuz+vR>S?Xp;% zN&;D|!H!rY0z|DGbMKV97+6R*BIQl!Byw3vj)lX?^`49J`>dz@I<=B`>CTYn-1n!= zp_#7a=P_(7cS`L|iU7`6_=1V5Xh#8MtjlwQDsmE#FPYrG)P9S-NI6C!pus-wgz1>f z-kj3F{Jp0sB??nX2aO*GYPnFby?ok9Hj6h&Cc^ouM+%@VL0C-m4pdvT@0o0m11)&# zEP!R)SdX~N??)XJA%nyCS|#NOLQzIwunR#Cpn6U1Q|Ihl^xk?_P3jK;P3fn1mdj9|mLP3l+zIs90{kp?Sd&v(5_ict!%cAc8)Ceuyyx zpeoV;wP=-@Dtl(Wr))r4nvL7n{!#%_}A@7=W5)niC__uJv3ASz@w70ZKy3KJwr&0Rk~3*XmM+0+VREO$Yja-(cF^X-{acPcNa4 z5Vs;%THow2F1zxB2q#1g79OL61L$NI4wdp4_MjoX%|V+R${!fX42ON5O-b)P2US$) zK5@uTRuHCmB>W0x0%@}^JEV0!s(&8Pps}-CD(-yo`vw12TI9Qo{oBdTDSQYt0XJgw zgwO~d>o))#j;Herj#5HjFT(jWO&Mwi--?x90fvXcOo0rxh+EPTix9O)x|HGsG*s%@ zqA}NYK5T;B13ObV7{%hzd98Kf>w%hK)F-O#d@NZmwbT010E5~sfW!j;O%0@i`mSl;Ezx}T)SHe0{G2|r@61#453U725% zIO#1t{>S@Fsm9NoZT7~1N`RXuowgJ>moZtkFYod-f_37F5v;lsugMB*1cj{=?W*fr ztF_=+9CUwv=aQ_01*Fl6Of1xniaeXrF zO?@BCTud3l`1o^`-q-hqW{ENpi<`zC$sD@#5(TMZ#zIXBpDm8IMcqXU%vWN`3yva< zBV>ExFYUjt=6@P@lB}Gm*SUDLcD{L|ckRS{_98!Kt+V!v!m#DTz2Eg3K3!uSl53^) zWo9YXqDc!2eadt64wy*$3JWVoD;;LTnS5(;8;B=-^_hpKB^=rF9L@-H%xH9@Y|~M2 zuLp}}Iw0E+Q7B{=zUxQH8rcOB>B5o$gzP7NM3YOfu*0w&Sle+|Uh5~1{(ci+`0;P{ zwi6Wl^n0!Az1sXd)6~j)cLk{wU}W!2;$La}dwgr6`YkfySJK~G#s9K=?vyCaLp^p! ugzYx(y?XerYO;-l*J1lggn(2HRRqz{1f)urWpebO*$%d@ADVxG4;e~HmFyPC+uu14*BtlUzI8g*pn2H3&06IGd)sWg4A)V;( z{sF2yGgr1w*+yofoUw)h@dsa_BP;RaB;QNNXX5$AlYb1)US7Zf01)Ft`D~M711uN= z4Ko01h5g(6|KJp(8&FdGqEsI6Q7a1oUhE-w#= zfAn9JLbIS`zC6GffXfjeFMo)01b`8$TI4YRn=k@{dpTy5yZI=<_>Y44%3w&@@(c0r zDMx(8S*o}rd0A#=KtPtOSScWY{7)J>2unn$12CC+C@#B4xtj(>|I|WCp<%eAe=IQ1 zj=uC?1npu70J>qzpe^CZYs?jRTNvB1ncSd}A<^Ds2Df^dhp&_-Y2C!>VmBekUc0F6 z0(G!w7C2#j^ID&B1(;TE!xZf}btTkR{CVw6Im@r54}F$7$#q`tlQ7<)g#z-^QzFs% z)s+dDfC@>1m}q$Hm8VAxhBgBUQcvYTMa_YVs(U=)hIa zgCB1Ka*BfE+B8?2vRgxH8*Uv1%6}L`~zSJ_d%>(=mAr|a!w5dvNWQD{*b zZVF^a;3e1~c%-S3`p@Y7E?fxqoG-*TgsUWa>HGVrdkRI8k~~aupwa1>Ap4~R zeZzh-z1l^wf_)yVl^MOhjyoD9x#p9GTczyD)u$#_bR8* z_m$FqMF8Q{P(zgA%O8Q)FNx)zeywgj9B+j2r~fEIs5kO!lf$0%-eE&@yz@A-CquRn z56a8)|F~{Lh#Ut6<@}*A`f(xQFir?W0$GG3A_@fsB=U95CFmrOk}wGZ)slf2uEPMw zcXj-9eh5Qp7YatRONa>nNbt1c`GV-`_``MOYr^kFnZeEa)vC|v1sk)(!XQ40y)^ye zKBEWsY#;3iMRuPB2D6p;jYqFQzpz>#wlZ_)5I8>F>Sh`~<{1rZjJ4qvxwi0H|C{wI z1(q5IRCXPY935M9pG-`7DH#m=(gVB@XY;cKz}U#) zq1Td}*`Mww!v>9(8eQ|ykrx!{@Xykn_$RBMHO0aF&RZW8D;qW<oGYDxh zX}q8Oz8U%XogsfkbhqkP=M1-QJkL^%*NjDM9sCjcO!ut69_J~;>6V&isS<@tLW1O}& z?QJeRuTd5#uw>fi>@&90TSGrzg7>&5!8VZ;`|)*YZ%w>ngwjBnFh7cw7=lM2Je)(jF$qOnwzKBnpaPP_Nnr`3{GkXmn!)5ja5N)} zK@4^*uLhdtl&p0(ty7Oa*Y_P$ljzFKMiDa;ntK>Yr!lU%tFO6T1Sd?TV0#F0*yknR z5*L^n@5reeU$=S2h_gyrTgzQl?RWhN3)sxw9Sc=uaAVa7~`2z#`qmXK;(u9z%&zoTH4Z;OBB z#~zl@Xe<_CNPc}wQOeab8RTX3TJl=Oh|+yS{cp&VE=*_$z);gh5EEs?M%F|T&vls) ze@VG1c9Lq2dj0)9J=8={nK&Z@NL!n(koGpOK93fzS=87VQJ0xWBEHD?lT6#yaWQ-l zd4orjoiPswF*W%4V3!I%7vw)A=Vh_sps-#XvkjJiH5BZGASSX4LvEhmK3~#~zH(OL z?*H~#IUm`D-%xH{SUfzM0j47vca;P2)Q26E7ub0OdhwAy(@$1iTCD0-gnt*G+S~;Z z&1=!rd?R5~8mlkPzw%eij~I8GtEl#iSMfzOREd8$nPwC0`Rl@uy|#+T0(=;-EY6DU zG?{@N4p@|;V-kQhn9AS!@wRN9c74`op2@&;9FIg!?+2O5ZHPcrV<40aU5r!kaC5Kn!VpCwSIE9nfpHv+2nEIz z5`{aT%xB*N{k_i>0fmekG32%OU4k%BdO0Olok>QQMvp1>;)JTNiNOTFSH(%%T1cMh z(5)UCnt`sD%QXz&NAPbl1IkxL!0sCN8Yk_Nz3D}NXMAx+Il2!=bQ^JfXJMBIDyMg7 zUyyiP0ECyD`iZDxjWC>oqO`AA+2=x|&9Bn{*f+0%!U6rXa@QgYNs8(EJ5l*|Uo}gg z6tmeb7EO8y=5sxHfEM5cFv$SJ(Xu9SPnWxeYzEy0{37F<_+-i8T_CR-!31`7{z%H_*~I@+2=i*%@;9=50^rE?@tYzlv+X0 zrQzn{hM7AW#!4H0bHxGdgqOlkio33q-E2rO1h{Jf&VdiU*I8JC4zU22@x5A23pN$O=-m;dPMaNZTj+h+uqZ0RvQcR4`BP_ z<7&Vg0em0FH0V(3b1N6k8Ra~7uVee|fn;E}sH=tQsJp}4 zZ;z^UWIYZ6)~5F|MfpzNe^`n}>#6*wEFzMZ2^Xx!cI*2{~`8(prb||csr0S za`)lN#<)+xfT-JiskE4l1IzlYo&hC2m7U5Gt@iTQF5k>J>!1%Kheu^fECeqh0r5~# zpGTQW9}KT;Wll3wKStzt27q&uNIo7cmUFsxA$BXsHs%`{8ZXm+ zbU9F`;^EJn%#oitUqlDF*`*MMB^*P-Im(m0s!+cET7Nnn#@U-``vHD34*KnbFubZHta1IuWcJB(75 z_ZY89fMH0`;}>e18_(q~vTeWBiDncQiKGdOa?hv7=F}wQto!yK0zStt_RAu{nEuCH zM}je=+jlJNFa*YTPfBUOYt=jrp&2+^d}WG$HTUwn$U z`9mg(fS`7gT>3M=l9q<)Z<_~GjjyctGgbiq-67cfjaCVBLTGXjkGRVa$$EUh?m*D) zqX7lUny)3*xrlAir#D!QeyGFa?A(}Vu@V`k##}$%4yH>PVv(W3g0TX%qRA`_NM^y$ z5$s$vB?*yPf@sQ|e6Kcgv&PiWsh3U*VGA>;p&PcB(jSO_I5SWN9lp*WYalDC=zNzV zlL(%+AEa_Qjj3t9dunU&YW96o!^`}M8`$)t|J(-ZEJa+hz0EQ*BSrlJ|2ZRP;Ojn# z!cfRC4r&9SQb7WXikYsmpY3ah9RE2JL7mGCX=r=NZCRsCs-Fh{m|3Tv?gyav8^Xvv zXS)6H5D>RNTff~6NlwieuD8MH$=^@d(I0WL<&I#;u>0C@y!R(sLD?8GMkQ@b1rIP? z++mVasE@dOH#17Px8yu_TU6~@$Sr{rTxpWgvu4H(y3Jd9tD?W3HV5sW*+_f}_>ane zyY$%Z!8^~#tGTtg_sQ@Z{_J^1!*AwuPsOGQsd59T96s0G_TYD3YyP$Co^)4kYE?cl z3)K-qmnOy~T@+3-57qf!tEWFatdT+W^QZa&pf)UCkAH5i1umT2&_efSlF=;1VHl5i zm+5D5UDikBCNg*m)Z2Yhy?1s>Qu$8`5SuIcPgFrpR=awq#G0}S*C~n{pWCM4|0cc{z}A&%ZQ7Y zJ_c{})C~|9O20PD|IU=v3L!{1S(#_$L|1@mj8B6XINirCES;?McJZz!sgbmeKP$A zVOsLKu|K~TziHkbgM-aBJ7qQ13t|j*8BZ93_5&{(*YONFdGqD6US+5+&amoCO+L&} zVaRJ}(n&jXXmMM(;^%p9wC8xJj@CC8_~PW+=tI4>Z0QtH^uJeMTQ{|h>Ujw=E3Gcg zAUVAE!-=GTpR}a-RqNW9aMUdD3kY)hhqIw^gIPn5wKN3h6)s9$e(u}l@)HpbhDm<0 zyvn^WWvO~rd9jX98&|NsPJ6d}fPD7Lsy0~h>H5p`5(kFZ_-sbZ5i^&3cE(k?hL%GA^-ZL!9@X1v(w?6Cj za$Za;O0X+DeDa6Ib|OeD?k#UgS32_3`m(t@i&=hBoBOC-rHf5m>L%m8gz1-kuB(sd zCN8cH-IrHgZkJR1ORpApp5bl4H>##Rb*J%_4s^?rS(sliEa&4PAxS18wtV@WkEe?7 zK)W?xy9nf`U2aZjdp73}_Jt4u-e@MqQq5pjo1NdgO+kA*{R}QnO5BZ*j>vX~dO@@kJ6a25K@V7I%8B{H&w_;i3uSl$ z3GCMkSK0WgBQ&R%xb$$qZhHB?dr(3jPvh5$z^8$dBQLD}oVNm3Us%ZXKUcRv*ha=s z)k+9X^CFHYl4qQ|BE-Kwm2WAjLuX}ZsgRPgBeC?#*&*+{+3B+3 z>vByfr-$==Yq_dwENxq=yZs%%;}3-Lo$Ap2UJaJB44++o(*td1OryZy-J6pCsjY#t z_(tOucmf^Sb9&TdbRXG|e3<%iX33Ztmb>+Sp0$0eH*xw>doRMLNp>o_GtBu-73CQ) zBU+M08+*>fU7~X|`dz+f?AuorY*G#m%g+3U;fzmKm|H5Co&PHAbdcW>$k-{#9epEnCrLUx&6t? z^T$`OHQM)YJDoEtcGWG|@pp)*y6)d%K(p~($xiKz7fmMf4SEt1N1?r*OD2~}RVt4j zn0x%R>dB+8_Y~0vX2~W6);#WZS94pZPk#5y^(fyqx~G}_rSoi8 zruccBG$8UDA(~T-?pp>m#<@Flc*OBh?j))80j$eSC_ z4x;lKymrR|PS*Y8j}YkNN`=p^BHW$N9F^+SNgqk=$@jeVjJKg3*Nl7;i+5}^AFnIH zzuwB_rETvXE&u$If|~tI`fkM>=j_pw2j5;+Twl86 z<>?aVxf+)*`v@qM6Hn)i^!?nUsJP`4{QH#O?m4{!1X1vK@53FofVn4EjGe}wyD|Uy zGyA;o5QD|_vwp-m8JoTR=2=s*HLGwU)wlZD+i{uyzLI!}WBp0lEJcgGNw;0Hpk3_l zk}6T&=(W`Jk01OjFy1OYKZ42e<6`N=Q$8=qd= zGTfm9pA6G!=<|kbIsB?@%bgB8saqRuKY9&C8QQ!z`o!OfNYwir+JgwcxW{S>$tB?A z>AN#{CXH}J(GE$J7NE8B_Lp)$K$_cj?yFr@#1#0Nd+L!GFtMsURR7CO=I%U&G}T|(suRs_R(R*ZixDx z6ou7m!8Agu;p#9&F%H$#5mgpdMh0_Ewk#A+DbeBfCjn)9v){F3l3% z2crD2eDMHprugCdNM<|nyu@(TH3QxeMvNE7q>Iblhw>BI@oQdzT^S>})XuUp&7z`a zF2|mnpoZdrdS`u#1a#9Z59Vt=Pkc3J|&@? z5&@WPCTHD|9YQi)sXVYWHHRz$Uth#REj^a$09XwCkInV=P->Kh z**PAaACaLXxqGrMEHW8NrokTam|<@`dI~xJ$Rqf~7zUAzNHM5?n#tSyV+}YCn)bdcxZAYoyCUD=y7lHlCahXtTYLcYE*&8W9kow*+t_8!#pbh_(I1E9RCq(kAUhA?7JS*>28gn2X@8yixX zpbm%KUqyrqfY@PhNDLSw#E8f`=w90xbblev&u(zTYWO!zw2fkHo7Q}hs(N|UwV^b8 zDxaY@Xr^xyUF1qnG8?KQ%}n+i9_xMDHA9VuHCjzV@`(FHPYj3pcbZX02NYY*Miw#n zQUJ&`3;Rswio8Ewz^mZ4*_R_9alOH%eEz<5*tLPEl|CI&21HG$NDVTkO!jV)m+M%) zv>68-*%Spb0$30@hK*+G8^e*4VDalSDLZ|~4}5FGn*KXTWSa!;A&S9l-()}xaMR|Z z$pW^k@u4>dw_$W05#``S_}yG-;riEub)ciuLqiR;U!}tS=P;IGUdwP$)GN}Xla=_v zUQZjtWUxU#T7-=$7hJ)UZks&Xog&aA?D1dceqEEGJ&p>uPUkO75icnTy|3une% zYsDBb>ZX)=6v=IdhP{sK>ekd-tApRn6E;`pMq@NeiK!o6&G-<14Vpu?j`$)w0axcg z<%1g)ZJq=)-Ox0M%8+;jcbr|EhlxWrZ}#U8Bh6dO^g`mp`lk`M3M0iO&>kHrVRTE8 zKv&S3e3BJ?j!=2?)ER{W!6R6Ltl@@lujnn|>jmlaV(&i*YNhPvaxX@NJ6DW@LiZ?* zc!rZ)+Jojz>h=677=0?Z=#5QI+h)~Lfc9IwbTpKy!|?X{bCr8MJm=@Y`ECEUJt}nh zoxp4rw7>Yx6xd;jxb&spC93p$Ka<%o#NLolfGigoXF?mjPSt#_)B}-5V@!sfTw0n< z3KQL75v4f~m(lk~AWj)Zieq%ri7Z-IUKTSR`?fpZOJtj(C4Ik7I~2k6&kQB&l|GZAmZkQGWb*U2cnI* z8VY0+yu^n2DUG9%zBE;@s5;UMwQcMVH4Ur8crQYhn{FpJ-`gC6UdZD8Pz%^&EjGl4 zt!2I8ZB-5I5(zDdP}OI@&QBxZ!ZFfM{0mgwDysen?Xq9v1@_RL{RR#o0t>1BscQm> z%9JF}3y&AEDcSJ}#mYpmXTQ1tOr6Af1;qeZ6zac^3(dkN{0Ftb1o!}gS*J}H6`56& zE@EuW%r?CNn%Fo@v7+nz<{^8TTHGb}^s?MT55C-eGc;U_+ zChMrmXP~MWd_CxSD<*VY7O0z>DJVYHxb)dgx{H%rzHH{YDldhU^Xs-*JGye_$Z%_JiNIvZP&TJ>IAP?=RC;MGbEzgxP!H zuYN0Ue=es^yXqLVr#W*<;^Q)<5d|o_0WJ9N1wr}&xwos&l814yk1+XTP^;^70eJ_r zotTd6SFO9f6hEuqdqp=6xww4M)&?P`cMG~V%Hi0?vz1@u{$TxL0YF}w(vbwbF8rl%fVOAcA)Wwb3ztah87--ejEMDh~k3Qs0z(KoyAo# zoWzhwkmX0WwSo+lJ5=xyOMDsy>?rL>lgCx{_6b4b43dxOx+MOir5`h2FVAF**&ce9 z!A!HahjmHg>4SG6QMDHYgAQGoIZgPpqGYG&V)oIf8+>=}2mCzv$oo`bKx-I;kOMq; zQ3lb!#vgh z2f|lvV;`7!$(S1z3!=pHIJr8mLR0Qh9|;sO+AOOxM&k(_06X3ONNhhRKBAhjA=oA4 z<8$V)sJco`Btscw|7HXgMZLX zh%LxlG~j=;3|w>!Oo%#QRkv;eOQ&HYK-|~ctZ?wvxu7@jo!5Tb!@6l+85zj|!#W@v zo6q5DCF z;rAzPd$cd^Vu;%@Bs`l26WD7%Iq;B|P=yuKD)Q#-y{70iTUDR%o(?fN_EOl5h#FUC zN^z!_;*D3?xp~Jy!w7{7gZU@s9bjK}LnFeX7_@fi(2{F+BPgLUvX8N~#W5J3yfO8G zcxsx8emvx=BQ_k<&24B0LNGe+OJXC@@mVM+?3%zaOeH!hu`IJPQ&t+o!G!3WR+77i z5}~T%98|O@B1Uu=_2p8wDnV_E5%n`M78ad~BnN)sVS(=h`(5%lucKJU>`lHVGB-v& zpZyto62*56dchjN>KKLyxOZvm2~UZGJttW^maGlLfMrZ5{-*WcwO<2zkz-hBYTzXW z7Zumnn?HjRhv+Mot?s~!WVYc3#rOFwv_2Eqg8}ku~&6A~h;UU=J0O z&xR?avJ!+Q@v1;0MUt^b%aMBHl_))tjZca8;VEQO?P?oMnlKDO(%c5TP2zaJ8XT3P z(UN<=z*PsvP5BnAy0sCs#$THkc>dcq%;`1+BohiDd9e1JeXM}!tL3Ino=B|=CH7PN zG=jy}LLOXZwH&qpST{ll*E>m<+l268eynNI-5;o1nu<=(`dw>EUhl5HZ&}>aSkDW5 z-$Od-96grKH*8NekZ6XxA09W`rB z4y6c!1x30fZz+eCWO%-@oGJ?Cd$Ie|@74-riA=uh>H=N;)Urha7}*bI9O*2t0jWTw z7G6sSbA2D?Z2+^Bf~mK_q!V<-DQKBcXP=j_*!oMiXs}(m~SCQ zoEV)#_t=$oCuZQC>bD}$%vh(=B=ReKcB!6Zg$Pyzkg9oAv$XiJBRbDf|1P@@@V52m zYhY$N`i!B9ili}KCQ)ujBBK*C<~}^Bl(}W_eRX7|RanPNu!t%vmEoQDllGn!HE)p7 zBT#egD$zzuOyC1^=*#5({9W*R2#sSG(f#VOCLLmWyR2$$$%yPIgu>^^Ah?D)wB!xB z7tv04EP+MZOpvyFWD7o2jJXnmq|Ja33{M2n8}kh-GH2Xy=0UT6s#Z#wX4F^(rO6^F zFod8?LdEQ*o4RMaor{>r{ncn8usjOSW{vJBh=D(p_O(0(cs5+jU>gK6er>yYvVS_p&yut30$pd%TI(wd4vB1HZRFTAkv z?WOJM*}JeeELsBWcUYD@B4C!kd?l_%W?|klx3MrvtJ}ffKLl3`Fmic_6XMt~*fAi$ zvncwJIB9&Yi$+eTQZSOF0&P%3m?1#`gz31Bvm&%!iJk1ByMFMx!$k%J(u_e+kqNO_ zL*)%aX$n#j$N&N1P#?8MJ%1DWTPOhQZe2=gGef6l3?7T>pw~_Z(v}q=S|`l?_sWYu zh$@-)g7&yF@g2{@=*&kH96)4q)TfxR$5|)9N1F$}a@!x2H0;C&Ky1WBB*B^;jRVls zh1D^yAfdeqE1L9xIPH37X7O}VjSw9h83!a2Xuu?KbYWsEM%}O*3!b}Pn$GM&U9`IN z#4cPK!6R}(O6eJq)3YYljb~UUO7Wgnd%NqY*ZzC3mNK+=U^i3EHO~!8XFbC^sTNB- z{x+Te&25WAz;i92CB^CLYEx^X!N%;`Y|Z$m9qzh)`#rCU=aauksoy!)*bFI0)Vsg_ zx~=zb)e5ACEjZjyxMN8bAA=lS-AomRDF7rxD6Dd*J^EIG;c{AtLH-zSx!aQ&pHH~Z zZ$)RQ-qRdGqvZR`EQ@4y$RLI*owd~))bsos8y5kh=$qw1`P80k=j%0JClS7LKBIZW zXC>}tk=45l)m0s|I1K(0h=Bo?B-pD_@Sor1md1!$OT|N7=Hs&2*Mk-21GJ_jV3-Ie zwxBos7l6($EBpCsHbmY~;D>csEaj7_ub)k2HrIITHOy8F!VNR@B$~#zyx`Q#uQ%ld zbcS{X;FMT3YAm5Qt?w7}J>)sysX{5sT)0yb(#7SDMyt}mV?c;5pMFrttE>&KmQ&TI z9Jt+}uIOZ(YV;0d0`@?vOKei3lQqADaF)~dOd%K``s|DC0W*!25x9K;(*qL+hN>$+ z>PawU{>!;xZm7biN;y*X|6V3^agb{wfVx?52q0(ya2tm5vxmmF8l% z9#ENZ>r2Cd*>XEU&9+wO-eXXVmF4l8SAJdr&vs7k})hvHL-aDpCFqiOqXH}%}LH?IUPz(Z6RTFo? z-8n{perW6syJ>^80#+WaxRaaV_cGl<`lf{j=gb{>(LS}b<+;gsR=Tub`;G-+#$9u7!<`{~I6JjoNo7l-K*KH9=#*ab!(T@qC zng|LZcya8YTKQ_BKNC1=K)rFBwBqS;>fYY1n_s*9lU+d@7WL8hky6NvXg=GOYxlw# zdiU+yvSxuT>4L?}(dhJhUboGCG{6<~${=H?AWH!P)nste{IzRQ6le^1{$6h4iD-Y| zexf<6L)H4j=L^RXy1<}2gwwM$oSS>FDeQJh!LRbzyi-bLxpjAXU4~(T<<$-VpZ$0d zTXmXOI0~(q@Cv8Rc2~`AC*Ak#>J=EGIa(d1vq%lBmnS*3*BWZ|$KcTAhhX3cHDHD-)AklFD0+?LThjUjhmI-)*G_ zw(KMzB1wc!OaEdm35?Kllw!#!l-Be#W;Bu18*r4Tm?iLV*tejZQ{|-ZlT+nw>8&ODlVoYVfJI0Z}Aw&~=-q7|VIESUIv6=;DcJx%0ERA(~k=yQsC z3}RJ-AW()Q-c{G!n*NU4$Djn4p)ki|WBf&yaKcsIe28GhfU(O(0UIS%magWq6Z3>n z#ohFqZsIWKu5qLA0y>5!Ad_@7hQ0)38KIzHOnSq0Yj_oj698SfSy6mO&gi`3XefH# z;a#-GL|@@*p5|a~`>#EA(A+(r^xnFylTkFMCFG-$EOn?(E3#0#OWSOY1Za@-9GLLk zQSs5(K!n!9jb<~fDTfaH_~zU3HPlz7vd&UR&9 z=;gy-6NssuG_11QUegF-&~Y|)zw!QG=J)Pze(~ZK`7achU&9(})6-P!0M&~ffD@2k zx&c{KXpt=g>dtJjV?UpIb8^B7WyyeaT(ClfuONj@8l#v1a@ob&ZWEd-+6Q z$SgZxQSj%i7!!qbxdozrO)Y-6w2?33RczDvfStCwe$rxCSq5N!F%OjI5P99F3^dHy znG_eP?HfZkec8uQ2w;T*L%m67?HXCc(BFiSt^1I5)bDl$>Qah;$ApjA)_A%o;eb!;< z>)cNgVD#*|)lkS$G5upeVVrLVgF~3VH(-W1-_NRR@d7shC=g~@7WZo0+3IUh^{NGj z{d^^W#zoBnk07BCRrKvACu|C6ag;&Iuf^ZG2!SE0#@D}De3gI)8CSONob}5<<<_`C zU;5YR9Vn;#*nUhR6q9HKV6$7^#nK155y4Wa-xLm0j2Ikzz()yjRe4AL*R!K{PLnj! zp_DD-eH0e@MVfdVvAr|4bIfjiIu}Z=aj4lierL_+&KzZ=YEWp+0D=f=A$|Qs9Bq+5 zq`}D-RhZJ5&>BKGQuqlqsQ0kR3Oop=hhTJiREEjt;9;`$^ynkIjcWi(kW{GO!|ncJ z=^GTSg+12E|zi-gLxDi)CUD;0x>`;zB9z0trptBNSDN^ z2*O$-@{554TSj257NCco1@cpgIDEN(opl7i0uGVQ^mZf%Us40mduEkiu9ky;j^@gv zY}Bqp*#OcS2q*eo&)O*r9;%H;MBwv{YSahiiKK{S;4w*{#`e}1moif~!APx^wwbFV zV(wANGa6%t+c837&jvMt(KKiWGcW8$g`Vj?;a5%d4n>*zBmX{1#P&1{Oxz+LG zerNf6#~I5mhibKbtHp||<-gw9g{+(I4{BI;eo492PB`R-L|@Jcn68{^EsHnL(OS^I zTzUGAvJk8`eNn>Uv-eSM%l%JxJgnkJ68sV=m9`K4!iz(iB|dQU^(uKxzj1bR`eyOn zmq%&XXs$`&dqHpWH@D^%)E0NfRjfiq^JNo>FZsQ%oz}2PvLAf6Ek-OW8(_2V+*rM@ zXm3gzCmdz#DRh^7@H`3r6&z%;%O6PWlZl?OCDMO8o(=fY;3OwJG8+wc6xEc3T^Sr1 zks5!kpZrv|%aCruWSfpFj#`+>=szy%)FD}_9_4DF{YbIz2WHh8j zV6B6gja~fOa7w!2D=1oh7l8PT&BX%*983EPL<$5KF3FwQ{#oCBYbkd8_rjm@Lc-HN zQLBdxubqtrUrS81qIgq?tQC0P8#;e~^6!bCYUlqod~g`NcYbI2k>z9A{4)>SDdx@I qgYMI^>eCb=tl+\% select(microorganism_name) \%>\% guess_bactid() + +# and can even contain 2 columns, which is convenient for genus/species combinations: +df$bactid <- df \%>\% select(genus, species) \%>\% guess_bactid() +# same result: +df <- df \%>\% mutate(bactid = paste(genus, species) \%>\% guess_bactid()) +} } \seealso{ \code{\link{microorganisms}} for the dataframe that is being used to determine ID's. diff --git a/man/key_antibiotics.Rd b/man/key_antibiotics.Rd index 12932662..6ff3af20 100755 --- a/man/key_antibiotics.Rd +++ b/man/key_antibiotics.Rd @@ -14,9 +14,9 @@ key_antibiotics(tbl, col_bactid = "bactid", info = TRUE, amcl = "amcl", \arguments{ \item{tbl}{table with antibiotics coloms, like \code{amox} and \code{amcl}.} -\item{col_bactid}{column of bacteria IDs in \code{tbl}; these should occur in \code{microorganisms$bactid}, see \code{\link{microorganisms}}} +\item{col_bactid}{column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset). Get your bactid's with the function \code{\link{guess_bactid}}, that takes microorganism names as input.} -\item{info}{print warnings} +\item{info}{print progress} \item{amcl, amox, cfot, cfta, cftr, cfur, cipr, clar, clin, clox, doxy, gent, line, mero, peni, pita, rifa, teic, trsu, vanc}{column names of antibiotics, case-insensitive} } diff --git a/tests/testthat/test-atc.R b/tests/testthat/test-atc.R index d309bbb9..8fc674ef 100755 --- a/tests/testthat/test-atc.R +++ b/tests/testthat/test-atc.R @@ -1,6 +1,5 @@ context("atc.R") - test_that("atc_property works", { expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin") expect_equivalent(atc_property("J01CA04", "DDD"), 1) @@ -15,21 +14,6 @@ test_that("abname works", { expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin") }) -test_that("guess_bactid works", { - expect_identical(guess_bactid(c("E. coli", "H. influenzae")), c("ESCCOL", "HAEINF")) - expect_equal(guess_bactid("Escherichia coli"), "ESCCOL") - expect_equal(guess_bactid("Negative rods"), "GNR") - expect_equal(guess_bactid(c("stau", - "STAU", - "staaur", - "S. aureus", - "S aureus", - "Staphylococcus aureus", - "MRSA", - "VISA")), - rep("STAAUR", 8)) -}) - test_that("guess_atc works", { expect_equal(guess_atc(c("J01FA01", "Erythromycin", diff --git a/tests/testthat/test-guess_bactid.R b/tests/testthat/test-guess_bactid.R new file mode 100644 index 00000000..8bb7b010 --- /dev/null +++ b/tests/testthat/test-guess_bactid.R @@ -0,0 +1,40 @@ +context("guess_bactid.R") + +test_that("guess_bactid works", { + expect_identical( + guess_bactid(c("E. coli", "H. influenzae")), + c("ESCCOL", "HAEINF")) + + expect_equal(guess_bactid("Escherichia coli"), "ESCCOL") + + expect_equal(guess_bactid("Negative rods"), "GNR") + + expect_identical( + guess_bactid(c("stau", + "STAU", + "staaur", + "S. aureus", + "S aureus", + "Staphylococcus aureus", + "MRSA", + "VISA")), + rep("STAAUR", 8)) + + # select with one column + expect_identical( + septic_patients[1:10,] %>% + left_join_microorganisms() %>% + select(genus) %>% + guess_bactid(), + c("STC", "STC", "NEI", "STA", "STA", + "NEI", "ENT", "ENT", "ESC", "KLE")) + + # select with two columns + expect_identical( + septic_patients[1:10,] %>% + pull(bactid), + septic_patients[1:10,] %>% + left_join_microorganisms() %>% + select(genus, species) %>% + guess_bactid()) +})