diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0c081e01..b0b9fb4d 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -61,10 +61,7 @@ cache: R: stage: build allow_failure: false - variables: - WARNINGS_ARE_ERRORS: 1 script: - - export WARNINGS_ARE_ERRORS=1 # remove vignettes folder and get VignetteBuilder field out of DESCRIPTION file - rm -rf vignettes - Rscript -e 'd <- read.dcf("DESCRIPTION"); d[, colnames(d) == "VignetteBuilder"] <- NA; write.dcf(d, "DESCRIPTION")' @@ -86,7 +83,8 @@ coverage: - master script: - apt-get install --yes git - - Rscript -e 'cc <- covr::package_coverage(); covr::codecov(coverage = cc, token = "50ffa0aa-fee0-4f8b-a11d-8c7edc6d32ca"); cat("Code coverage:", covr::percent_coverage(cc))' + # codecov token is set in https://gitlab.com/msberends/AMR/settings/ci_cd + - Rscript -e 'cc <- covr::package_coverage(); covr::codecov(coverage = cc, token = "${codecov_token}"); cat("Code coverage:", covr::percent_coverage(cc))' coverage: '/Code coverage: \d+\.\d+/' pages: diff --git a/DESCRIPTION b/DESCRIPTION index b7a7e584..9a9b9fa5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.5.0.9022 -Date: 2019-03-12 +Version: 0.5.0.9023 +Date: 2019-03-15 Title: Antimicrobial Resistance Analysis Authors@R: c( person( diff --git a/NAMESPACE b/NAMESPACE index f55cd80c..5ef332cf 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -71,6 +71,7 @@ export(atc_umcg) export(availability) export(brmo) export(catalogue_of_life_version) +export(clean_mo_history) export(count_I) export(count_IR) export(count_R) diff --git a/NEWS.md b/NEWS.md index 77b96a89..2d7bed2b 100755 --- a/NEWS.md +++ b/NEWS.md @@ -101,34 +101,35 @@ We've got a new website: [https://msberends.gitlab.io/AMR](https://msberends.git * Function `guess_mo()` is now deprecated in favour of `as.mo()` and will be removed in future versions * Function `guess_atc()` is now deprecated in favour of `as.atc()` and will be removed in future versions * Improvements for `as.mo()`: - * Now handles incorrect spelling like `i` instead of `y` and `f` instead of `ph`: - ```r - # mo_fullname() uses as.mo() internally - - mo_fullname("Sthafilokockus aaureuz") - #> [1] "Staphylococcus aureus" - - mo_fullname("S. klossi") - #> [1] "Staphylococcus kloosii" - ``` + * Now handles incorrect spelling, like `i` instead of `y` and `f` instead of `ph`: + ```r + # mo_fullname() uses as.mo() internally + + mo_fullname("Sthafilokockus aaureuz") + #> [1] "Staphylococcus aureus" + + mo_fullname("S. klossi") + #> [1] "Staphylococcus kloosii" + ``` * Uncertainty of the algorithm is now divided into four levels, 0 to 3, where the default `allow_uncertain = TRUE` is equal to uncertainty level 2. Run `?as.mo` for more info about these levels. - ```r - # equal: - as.mo(..., allow_uncertain = TRUE) - as.mo(..., allow_uncertain = 2) - - # also equal: - as.mo(..., allow_uncertain = FALSE) - as.mo(..., allow_uncertain = 0) - ``` - Using `as.mo(..., allow_uncertain = 3)` could lead to very unreliable results. + ```r + # equal: + as.mo(..., allow_uncertain = TRUE) + as.mo(..., allow_uncertain = 2) + + # also equal: + as.mo(..., allow_uncertain = FALSE) + as.mo(..., allow_uncertain = 0) + ``` + Using `as.mo(..., allow_uncertain = 3)` could lead to very unreliable results. + * All microbial IDs that are found with zero uncertainty are now saved to a local file `~/.Rhistory_mo`. Use the new function `clean_mo_history()` to delete this file, which resets the algorithms. * Incoercible results will now be considered 'unknown', MO code `UNKNOWN`. On foreign systems, properties of these will be translated to all languages already previously supported: German, Dutch, French, Italian, Spanish and Portuguese: - ```r - mo_genus("qwerty", language = "es") - # Warning: - # one unique value (^= 100.0%) could not be coerced and is considered 'unknown': "qwerty". Use mo_failures() to review it. - #> [1] "(género desconocido)" - ``` + ```r + mo_genus("qwerty", language = "es") + # Warning: + # one unique value (^= 100.0%) could not be coerced and is considered 'unknown': "qwerty". Use mo_failures() to review it. + #> [1] "(género desconocido)" + ``` * Fix for vector containing only empty values * Finds better results when input is in other languages * Better handling for subspecies diff --git a/R/misc.R b/R/misc.R index ec634752..b153c951 100755 --- a/R/misc.R +++ b/R/misc.R @@ -75,7 +75,9 @@ check_available_columns <- function(tbl, col.list, info = TRUE) { col.list.bak <- col.list # are they available as upper case or lower case then? for (i in 1:length(col.list)) { - if (toupper(col.list[i]) %in% colnames(tbl)) { + if (is.null(col.list[i]) | isTRUE(is.na(col.list[i]))) { + col.list[i] <- NULL + } else if (toupper(col.list[i]) %in% colnames(tbl)) { col.list[i] <- toupper(col.list[i]) } else if (tolower(col.list[i]) %in% colnames(tbl)) { col.list[i] <- tolower(col.list[i]) @@ -124,7 +126,7 @@ size_humanreadable <- function(bytes, decimals = 1) { out } -#' @importFrom crayon blue bold +#' @importFrom crayon blue bold red #' @importFrom dplyr %>% pull search_type_in_df <- function(tbl, type) { # try to find columns based on type @@ -151,16 +153,22 @@ search_type_in_df <- function(tbl, type) { } # -- date if (type == "date") { - for (i in 1:ncol(tbl)) { - if (any(colnames(tbl) %like% "^(Specimen date)")) { - # WHONET support - found <- colnames(tbl)[colnames(tbl) %like% "^(Specimen date)"][1] - } else if ("Date" %in% class(tbl %>% pull(i)) | "POSIXct" %in% class(tbl %>% pull(i))) { - found <- colnames(tbl)[i] - break + if (any(colnames(tbl) %like% "^(specimen date|specimen_date|spec_date)")) { + # WHONET support + found <- colnames(tbl)[colnames(tbl) %like% "^(specimen date|specimen_date|spec_date)"][1] + if (!any(class(tbl %>% pull(found)) %in% c("Date", "POSIXct"))) { + stop(red(paste0("ERROR: Found column `", bold(found), "` to be used as input for `col_", type, + "`, but this column contains no valid dates. Transform its values to valid dates first.")), + call. = FALSE) + } + } else { + for (i in 1:ncol(tbl)) { + if (any(class(tbl %>% pull(i)) %in% c("Date", "POSIXct"))) { + found <- colnames(tbl)[i] + break + } } } - } # -- patient id if (type == "patient_id") { @@ -170,8 +178,8 @@ search_type_in_df <- function(tbl, type) { } # -- specimen if (type == "specimen") { - if (any(colnames(tbl) %like% "(specimen type)")) { - found <- colnames(tbl)[colnames(tbl) %like% "(specimen type)"][1] + if (any(colnames(tbl) %like% "(specimen type|spec_type)")) { + found <- colnames(tbl)[colnames(tbl) %like% "(specimen type|spec_type)"][1] } else if (any(colnames(tbl) %like% "^(specimen)")) { found <- colnames(tbl)[colnames(tbl) %like% "^(specimen)"][1] } diff --git a/R/mo.R b/R/mo.R index 953b6aac..6379d3cf 100755 --- a/R/mo.R +++ b/R/mo.R @@ -31,10 +31,12 @@ #' This excludes \emph{Enterococci} at default (who are in group D), use \code{Lancefield = "all"} to also categorise all \emph{Enterococci} as group D. #' @param allow_uncertain a logical (\code{TRUE} or \code{FALSE}) or a value between 0 and 3 to indicate whether the input should be checked for less possible results, see Details #' @param reference_df a \code{data.frame} to use for extra reference when translating \code{x} to a valid \code{mo}. See \code{\link{set_mo_source}} and \code{\link{get_mo_source}} to automate the usage of your own codes (e.g. used in your analysis or organisation). +#' @param ... other parameters passed on to functions #' @rdname as.mo #' @aliases mo #' @keywords mo Becker becker Lancefield lancefield guess #' @details +#' \strong{General info} \cr #' A microbial ID from this package (class: \code{mo}) typically looks like these examples:\cr #' \preformatted{ #' Code Full name @@ -53,7 +55,9 @@ #' #' Values that cannot be coered will be considered 'unknown' and have an MO code \code{UNKNOWN}. #' -#' Use the \code{\link{mo_property}} functions to get properties based on the returned code, see Examples. +#' Use the \code{\link{mo_property}_*} functions to get properties based on the returned code, see Examples. +#' +#' All IDs that are found with zero uncertainty are saved to a local file (\code{"~/.Rhistory_mo"}) to improve speed for every next time. Use \code{clean_mo_history()} to delete this file, which resets the algorithms. Only previous results will be used from this version of the \code{AMR} package, since the taxonomic tree may change in the future for any organism. #' #' \strong{Intelligent rules} \cr #' This function uses intelligent rules to help getting fast and logical results. It tries to find matches in this order: @@ -174,12 +178,14 @@ #' df <- df %>% #' mutate(mo = as.mo(paste(genus, species))) #' } -as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE, reference_df = get_mo_source()) { +as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE, reference_df = get_mo_source(), ...) { if (!"AMR" %in% base::.packages()) { library("AMR") # check onLoad() in R/zzz.R: data tables are created there. } + mo_hist <- get_mo_history(x, force = isTRUE(list(...)$force_mo_history)) + if (mo_source_isvalid(reference_df) & isFALSE(Becker) & isFALSE(Lancefield) @@ -211,6 +217,13 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE, & isFALSE(Lancefield)) { y <- x + + } else if (sum(is.na(mo_hist)) == 0 + & isFALSE(Becker) + & isFALSE(Lancefield)) { + # check previously found results + y <- mo_hist + } else if (all(tolower(x) %in% microorganismsDT$fullname_lower) & isFALSE(Becker) & isFALSE(Lancefield)) { @@ -229,13 +242,22 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE, on = "fullname_lower", "mo"][[1]] } + # save them too + mo_hist <- read_mo_history(force = isTRUE(list(...)$force_mo_history)) + if (any(!x %in% mo_hist$x)) { + for (i in 1:length(y)) { + set_mo_history(x[i], y[i], force = isTRUE(list(...)$force_mo_history)) + } + } + + } else { + # will be checked for mo class in validation and uses exec_as.mo internally if necessary + y <- mo_validate(x = x, property = "mo", + Becker = Becker, Lancefield = Lancefield, + allow_uncertain = allow_uncertain, reference_df = reference_df, + force_mo_history = isTRUE(list(...)$force_mo_history)) + } - } else { - # will be checked for mo class in validation and uses exec_as.mo internally if necessary - y <- mo_validate(x = x, property = "mo", - Becker = Becker, Lancefield = Lancefield, - allow_uncertain = allow_uncertain, reference_df = reference_df) - } structure(.Data = y, class = "mo") } @@ -249,9 +271,14 @@ is.mo <- function(x) { #' @importFrom dplyr %>% pull left_join n_distinct progress_estimated filter distinct #' @importFrom data.table data.table as.data.table setkey #' @importFrom crayon magenta red blue silver italic has_color -exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, - allow_uncertain = TRUE, reference_df = get_mo_source(), - property = "mo", clear_options = TRUE) { +exec_as.mo <- function(x, + Becker = FALSE, + Lancefield = FALSE, + allow_uncertain = TRUE, + reference_df = get_mo_source(), + property = "mo", + clear_options = TRUE, + force_mo_history = FALSE) { if (!"AMR" %in% base::.packages()) { library("AMR") @@ -412,7 +439,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, # replace hemolytic by haemolytic x <- gsub("ha?emoly", "haemoly", x) # place minus back in streptococci - x <- gsub("(alpha|beta|gamma) ha?emoly", "\\1-haemoly", x) + x <- gsub("(alpha|beta|gamma).?ha?emoly", "\\1-haemoly", x) # remove genus as first word x <- gsub("^Genus ", "", x) # allow characters that resemble others @@ -458,6 +485,13 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, progress$tick()$print() + found <- microorganismsDT[mo == get_mo_history(x_backup[i], force = force_mo_history), ..property][[1]] + # previously found result + if (length(found) > 0) { + x[i] <- found[1L] + next + } + found <- microorganismsDT[mo == toupper(x_backup[i]), ..property][[1]] # is a valid MO code if (length(found) > 0) { @@ -469,6 +503,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, # most probable: is exact match in fullname if (length(found) > 0) { x[i] <- found[1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } @@ -494,6 +531,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, # return first genus that begins with x_trimmed, e.g. when "E. spp." if (length(found) > 0) { x[i] <- found[1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } } @@ -515,50 +555,80 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, if (!is.na(x_trimmed[i])) { if (toupper(x_backup_without_spp[i]) %in% c('MRSA', 'MSSA', 'VISA', 'VRSA')) { x[i] <- microorganismsDT[mo == 'B_STPHY_AUR', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (toupper(x_backup_without_spp[i]) %in% c('MRSE', 'MSSE')) { x[i] <- microorganismsDT[mo == 'B_STPHY_EPI', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (toupper(x_backup_without_spp[i]) == "VRE" | x_backup_without_spp[i] %like% '(enterococci|enterokok|enterococo)[a-z]*?$') { x[i] <- microorganismsDT[mo == 'B_ENTRC', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (toupper(x_backup_without_spp[i]) %in% c("EHEC", "EPEC", "EIEC", "STEC", "ATEC")) { x[i] <- microorganismsDT[mo == 'B_ESCHR_COL', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (toupper(x_backup_without_spp[i]) == 'MRPA') { # multi resistant P. aeruginosa x[i] <- microorganismsDT[mo == 'B_PSDMN_AER', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (toupper(x_backup_without_spp[i]) == 'CRS' | toupper(x_backup_without_spp[i]) == 'CRSM') { # co-trim resistant S. maltophilia x[i] <- microorganismsDT[mo == 'B_STNTR_MAL', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (toupper(x_backup_without_spp[i]) %in% c('PISP', 'PRSP', 'VISP', 'VRSP')) { # peni I, peni R, vanco I, vanco R: S. pneumoniae x[i] <- microorganismsDT[mo == 'B_STRPT_PNE', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (x_backup_without_spp[i] %like% '^G[ABCDFGHK]S$') { # Streptococci, like GBS = Group B Streptococci (B_STRPT_GRB) x[i] <- microorganismsDT[mo == gsub("G([ABCDFGHK])S", "B_STRPT_GR\\1", x_backup_without_spp[i], ignore.case = TRUE), ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (x_backup_without_spp[i] %like% '(streptococ|streptokok).* [ABCDFGHK]$') { # Streptococci in different languages, like "estreptococos grupo B" x[i] <- microorganismsDT[mo == gsub(".*(streptococ|streptokok|estreptococ).* ([ABCDFGHK])$", "B_STRPT_GR\\2", x_backup_without_spp[i], ignore.case = TRUE), ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (x_backup_without_spp[i] %like% 'group [ABCDFGHK] (streptococ|streptokok|estreptococ)') { # Streptococci in different languages, like "Group A Streptococci" x[i] <- microorganismsDT[mo == gsub(".*group ([ABCDFGHK]) (streptococ|streptokok|estreptococ).*", "B_STRPT_GR\\1", x_backup_without_spp[i], ignore.case = TRUE), ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } # CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese) ---- @@ -567,6 +637,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, | x_backup_without_spp[i] %like% '[ck]o?ns[^a-z]?$') { # coerce S. coagulase negative x[i] <- microorganismsDT[mo == 'B_STPHY_CNS', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (x_backup_without_spp[i] %like% '[ck]oagulas[ea] positie?[vf]' @@ -574,24 +647,38 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, | x_backup_without_spp[i] %like% '[ck]o?ps[^a-z]?$') { # coerce S. coagulase positive x[i] <- microorganismsDT[mo == 'B_STPHY_CPS', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (x_backup_without_spp[i] %like% 'gram[ -]?neg.*' + | x_backup_without_spp[i] %like% 'negatie?[vf]' | x_trimmed[i] %like% 'gram[ -]?neg.*') { # coerce Gram negatives x[i] <- microorganismsDT[mo == 'B_GRAMN', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (x_backup_without_spp[i] %like% 'gram[ -]?pos.*' + | x_backup_without_spp[i] %like% 'positie?[vf]' | x_trimmed[i] %like% 'gram[ -]?pos.*') { # coerce Gram positives x[i] <- microorganismsDT[mo == 'B_GRAMP', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (grepl("[sS]almonella [A-Z][a-z]+ ?.*", x_backup_without_spp[i], ignore.case = FALSE)) { if (x_backup_without_spp[i] %like% "Salmonella group") { # Salmonella Group A to Z, just return S. species for now x[i] <- microorganismsDT[mo == 'B_SLMNL', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } options(mo_renamed = c(getOption("mo_renamed"), magenta(paste0("Note: ", italic("Salmonella"), " ", trimws(gsub("Salmonella", "", x_backup_without_spp[i])), @@ -601,6 +688,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, } else { # Salmonella with capital letter species like "Salmonella Goettingen" - they're all S. enterica x[i] <- microorganismsDT[mo == 'B_SLMNL_ENT', ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } options(mo_renamed = c(getOption("mo_renamed"), magenta(paste0("Note: ", italic("Salmonella"), " ", trimws(gsub("Salmonella", "", x_backup_without_spp[i])), @@ -618,12 +708,18 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, found <- microorganismsDT[fullname_lower %in% tolower(c(x_species[i], x_trimmed_species[i])), ..property][[1]] if (length(found) > 0) { x[i] <- found[1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } if (nchar(x_backup_without_spp[i]) >= 6) { - found <- microorganismsDT[fullname_lower %like% paste0("^", x_backup_without_spp[i], "[a-z]+"), ..property][[1]] + found <- microorganismsDT[fullname_lower %like% paste0("^", unregex(x_backup_without_spp[i]), "[a-z]+"), ..property][[1]] if (length(found) > 0) { x[i] <- found[1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } } @@ -636,6 +732,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, mo_found <- AMR::microorganisms.codes[toupper(x_backup[i]) == AMR::microorganisms.codes[, 1], "mo"][1L] if (length(mo_found) > 0) { x[i] <- microorganismsDT[mo == mo_found, ..property][[1]][1L] + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } } @@ -737,6 +836,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, f.x_withspaces_end_only = x_withspaces_end_only[i], g.x_backup_without_spp = x_backup_without_spp[i]) if (!empty_result(x[i])) { + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } # THEN TRY PREVALENT IN HUMAN INFECTIONS ---- @@ -749,6 +851,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, f.x_withspaces_end_only = x_withspaces_end_only[i], g.x_backup_without_spp = x_backup_without_spp[i]) if (!empty_result(x[i])) { + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } # THEN UNPREVALENT IN HUMAN INFECTIONS ---- @@ -761,6 +866,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, f.x_withspaces_end_only = x_withspaces_end_only[i], g.x_backup_without_spp = x_backup_without_spp[i]) if (!empty_result(x[i])) { + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } @@ -784,16 +892,19 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, ref_old = found[1, ref], ref_new = microorganismsDT[col_id == found[1, col_id_new], ref], mo = microorganismsDT[col_id == found[1, col_id_new], mo]) + if (property == "mo") { + set_mo_history(x_backup[i], x[i], force = force_mo_history) + } next } # check for uncertain results ---- uncertain_fn <- function(a.x_backup, -b.x_trimmed, - c.x_withspaces_start_end, -d.x_withspaces_start_only, - f.x_withspaces_end_only, -g.x_backup_without_spp) { + b.x_trimmed, + c.x_withspaces_start_end, + d.x_withspaces_start_only, + f.x_withspaces_end_only, + g.x_backup_without_spp) { if (allow_uncertain == 0) { # do not allow uncertainties @@ -936,15 +1047,15 @@ g.x_backup_without_spp) { } x[i] <- uncertain_fn(x_backup[i], x_trimmed[i], - x_withspaces_start_end[i], + x_withspaces_start_end[i], x_withspaces_start_only[i], x_withspaces_end_only[i], x_backup_without_spp[i]) if (!empty_result(x[i])) { + # no set_mo_history here; these are uncertain next } - # not found ---- x[i] <- microorganismsDT[mo == "UNKNOWN", ..property][[1]] failures <- c(failures, x_backup[i]) @@ -1232,3 +1343,7 @@ nr2char <- function(x) { x } } + +unregex <- function(x) { + gsub("[^a-zA-Z0-9 -]", "", x) +} diff --git a/R/mo_history.R b/R/mo_history.R new file mode 100644 index 00000000..aac423dd --- /dev/null +++ b/R/mo_history.R @@ -0,0 +1,74 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Analysis # +# # +# SOURCE # +# https://gitlab.com/msberends/AMR # +# # +# LICENCE # +# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# # +# This R package was created for academic research and was publicly # +# released in the hope that it will be useful, but it comes WITHOUT # +# ANY WARRANTY OR LIABILITY. # +# Visit our website for more info: https://msberends.gitab.io/AMR. # +# ==================================================================== # + +# print successful as.mo coercions to file, not uncertain ones +#' @importFrom dplyr %>% filter +set_mo_history <- function(x, mo, force = FALSE) { + file_location <- base::path.expand('~/.Rhistory_mo') + if ((base::interactive() & mo != "UNKNOWN") | force == TRUE) { + mo_hist <- read_mo_history(force = force) + if (NROW(mo_hist[base::which(mo_hist$x == x & mo_hist$package_version == utils::packageVersion("AMR")),]) == 0) { + base::write(x = c(x, mo, base::as.character(utils::packageVersion("AMR"))), + file = file_location, + ncolumns = 3, + append = TRUE, + sep = "\t") + } + } + return(base::invisible()) +} + +get_mo_history <- function(x, force = FALSE) { + file_read <- read_mo_history(force = force) + if (base::is.null(file_read)) { + NA + } else { + data.frame(x, stringsAsFactors = FALSE) %>% + left_join(file_read, by = "x") %>% + pull(mo) + } +} + +read_mo_history <- function(force = FALSE) { + file_location <- base::path.expand('~/.Rhistory_mo') + if (!base::file.exists(file_location) | (!base::interactive() & force == FALSE)) { + return(NULL) + } + file_read <- utils::read.table(file = file_location, + header = FALSE, + sep = "\t", + col.names = c("x", "mo", "package_version"), + stringsAsFactors = FALSE) + # Below: filter on current package version. + # Future fullnames may even be replaced by new taxonomic names, so new versions of + # the Catalogue of Life must not lead to data corruption. + file_read[base::which(file_read$package_version == utils::packageVersion("AMR")), c("x", "mo")] +} + +#' @rdname as.mo +#' @export +clean_mo_history <- function() { + file_location <- base::path.expand('~/.Rhistory_mo') + if (base::file.exists(file_location)) { + base::unlink(file_location) + } +} + diff --git a/R/mo_source.R b/R/mo_source.R index 34f5f940..cd1f2365 100644 --- a/R/mo_source.R +++ b/R/mo_source.R @@ -99,6 +99,8 @@ #' @inheritSection AMR Read more on our website! set_mo_source <- function(path) { + file_location <- path.expand('~/mo_source.rds') + if (!is.character(path) | length(path) > 1) { stop("`path` must be a character of length 1.") } @@ -106,9 +108,9 @@ set_mo_source <- function(path) { if (path %in% c(NULL, "")) { options(mo_source = NULL) options(mo_source_timestamp = NULL) - if (file.exists("~/.mo_source.rds")) { - unlink("~/.mo_source.rds") - message("Removed mo_source file '~/.mo_source.rds'.") + if (file.exists(file_location)) { + unlink(file_location) + message("Removed mo_source file '", file_location, "'.") } return(invisible()) } @@ -165,23 +167,22 @@ set_mo_source <- function(path) { df <- as.data.frame(df, stringAsFactors = FALSE) # success - if (file.exists("~/.mo_source.rds")) { + if (file.exists(file_location)) { action <- "Updated" } else { action <- "Created" } - saveRDS(df, "~/.mo_source.rds") + saveRDS(df, file_location) options(mo_source = path) options(mo_source_timestamp = as.character(file.info(path)$mtime)) - message(action, " mo_source file '~/.mo_source.rds' from '", path, "'.") + message(action, " mo_source file '", file_location, "' from '", path, "'.") } #' @rdname mo_source #' @export get_mo_source <- function() { - if (is.null(getOption("mo_source", NULL))) { - return(NULL) + NULL } else { old_time <- as.POSIXct(getOption("mo_source_timestamp")) new_time <- as.POSIXct(as.character(file.info(getOption("mo_source", ""))$mtime)) @@ -195,9 +196,9 @@ get_mo_source <- function() { # set updated source set_mo_source(getOption("mo_source")) } + file_location <- path.expand('~/mo_source.rds') + readRDS(file_location) } - - readRDS("~/.mo_source.rds") } mo_source_isvalid <- function(x) { diff --git a/README.md b/README.md index 38be8ff9..adb301e1 100755 --- a/README.md +++ b/README.md @@ -25,11 +25,11 @@ Bhanu N.M. Sinha - - - - + + + + + ## How to get this package All stable versions of this package [are published on CRAN](https://CRAN.R-project.org/package=AMR), the official R network with a peer-reviewed submission process. diff --git a/_pkgdown.yml b/_pkgdown.yml index c6e66e05..5052090d 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -147,7 +147,7 @@ reference: - '`WHONET`' - '`microorganisms.codes`' - '`microorganisms.old`' - - title: Other + - title: Other functions desc: > These functions are mostly for internal use, but some of them may also be suitable for your analysis. Especially the @@ -155,7 +155,13 @@ reference: contents: - '`get_locale`' - '`like`' - - '`ab_property`' + - title: Deprecated functions + desc: > + These functions are deprecated, meaning that they still + work but show a warning with every use and will be removed + in a future version. + contents: + - '`AMR-deprecated`' authors: Matthijs S. Berends: diff --git a/appveyor.yml b/appveyor.yml index 6d0eeea6..a241a40d 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -55,9 +55,6 @@ on_failure: - 7z a failure.zip *.Rcheck\* - appveyor PushArtifact failure.zip -#on_success: -# - Rscript -e "library(covr); cc <- package_coverage(); codecov(coverage = cc, token = '50ffa0aa-fee0-4f8b-a11d-8c7edc6d32ca'); cat('Code coverage:', percent_coverage(cc))" - artifacts: - path: '*.Rcheck\**\*.log' name: Logs diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 5e593eff..fc84075e 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -78,7 +78,7 @@ AMR (for R) - 0.5.0.9022 + 0.5.0.9023 diff --git a/docs/articles/AMR.html b/docs/articles/AMR.html index e0076c6e..f06c27bd 100644 --- a/docs/articles/AMR.html +++ b/docs/articles/AMR.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to conduct AMR analysis

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

@@ -201,7 +201,7 @@ -

Note: values on this page will change with every website update since they are based on randomly created values and the page was written in RMarkdown. However, the methodology remains unchanged. This page was generated on 05 March 2019.

+

Note: values on this page will change with every website update since they are based on randomly created values and the page was written in RMarkdown. However, the methodology remains unchanged. This page was generated on 15 March 2019.

Introduction

@@ -217,21 +217,21 @@ -2019-03-05 +2019-03-15 abcd Escherichia coli S S -2019-03-05 +2019-03-15 abcd Escherichia coli S R -2019-03-05 +2019-03-15 efgh Escherichia coli R @@ -327,21 +327,21 @@ -2010-01-23 -E2 +2011-03-23 +H4 Hospital B -Staphylococcus aureus -I +Escherichia coli +S S S S M -2017-12-07 -L8 +2016-02-07 +A10 Hospital B -Staphylococcus aureus +Escherichia coli S S S @@ -349,49 +349,49 @@ M -2012-07-19 -W5 -Hospital A -Staphylococcus aureus +2017-05-30 +Q9 +Hospital D +Escherichia coli +S S -R S S F -2013-11-26 -L7 -Hospital A -Escherichia coli -S -S -R -S -M - - -2016-01-24 -M7 +2016-09-19 +U5 Hospital B Escherichia coli S S S S -M +F - -2016-11-13 -V10 -Hospital A -Escherichia coli + +2016-03-20 +X10 +Hospital D +Streptococcus pneumoniae S S S S F + +2012-07-29 +D10 +Hospital D +Escherichia coli +S +S +S +S +M +

Now, let’s start the cleaning and the analysis!

@@ -411,15 +411,15 @@ #> #> Item Count Percent Cum. Count Cum. Percent #> --- ----- ------- -------- ----------- ------------- -#> 1 M 10,562 52.8% 10,562 52.8% -#> 2 F 9,438 47.2% 20,000 100.0% +#> 1 M 10,422 52.1% 10,422 52.1% +#> 2 F 9,578 47.9% 20,000 100.0%

So, we can draw at least two conclusions immediately. From a data scientist perspective, the data looks clean: only values M and F. From a researcher perspective: there are slightly more men. Nothing we didn’t already know.

The data is already quite clean, but we still need to transform some variables. The bacteria column now consists of text, and we want to add more variables based on microbial IDs later on. So, we will transform this column to valid IDs. The mutate() function of the dplyr package makes this really easy:

data <- data %>%
   mutate(bacteria = as.mo(bacteria))
-

We also want to transform the antibiotics, because in real life data we don’t know if they are really clean. The as.rsi() function ensures reliability and reproducibility in these kind of variables. The mutate_at() will run the as.rsi() function on defined variables:

+

We also want to transform the antibiotics, because in real life data we don’t know if they are really clean. The as.rsi() function ensures reliability and reproducibility in these kind of variables. The mutate_at() will run the as.rsi() function on defined variables:

data <- data %>%
-  mutate_at(vars(amox:gent), as.rsi)
+ mutate_at(vars(amox:gent), as.rsi)

Finally, we will apply EUCAST rules on our antimicrobial results. In Europe, most medical microbiological laboratories already apply these rules. Our package features their latest insights on intrinsic resistance and exceptional phenotypes. Moreover, the eucast_rules() function can also apply additional rules, like forcing ampicillin = R when amoxicillin/clavulanic acid = R.

Because the amoxicillin (column amox) and amoxicillin/clavulanic acid (column amcl) in our data were generated randomly, some rows will undoubtedly contain amox = S and amcl = R, which is technically impossible. The eucast_rules() fixes this:

data <- eucast_rules(data, col_mo = "bacteria")
@@ -443,10 +443,10 @@
 #> Kingella kingae (no changes)
 #> 
 #> EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes (v3.1, 2016)
-#> Table 1:  Intrinsic resistance in Enterobacteriaceae (1344 changes)
+#> Table 1:  Intrinsic resistance in Enterobacteriaceae (1315 changes)
 #> Table 2:  Intrinsic resistance in non-fermentative Gram-negative bacteria (no changes)
 #> Table 3:  Intrinsic resistance in other Gram-negative bacteria (no changes)
-#> Table 4:  Intrinsic resistance in Gram-positive bacteria (2767 changes)
+#> Table 4:  Intrinsic resistance in Gram-positive bacteria (2799 changes)
 #> Table 8:  Interpretive rules for B-lactam agents and Gram-positive cocci (no changes)
 #> Table 9:  Interpretive rules for B-lactam agents and Gram-negative rods (no changes)
 #> Table 10: Interpretive rules for B-lactam agents and other Gram-negative bacteria (no changes)
@@ -462,9 +462,9 @@
 #> Non-EUCAST: piperacillin/tazobactam = S where piperacillin = S (no changes)
 #> Non-EUCAST: trimethoprim/sulfa = S where trimethoprim = S (no changes)
 #> 
-#> => EUCAST rules affected 7,383 out of 20,000 rows
+#> => EUCAST rules affected 7,488 out of 20,000 rows
 #>    -> added 0 test results
-#>    -> changed 4,111 test results (0 to S; 0 to I; 4,111 to R)
+#> -> changed 4,114 test results (0 to S; 0 to I; 4,114 to R)

@@ -489,7 +489,7 @@ #> NOTE: Using column `bacteria` as input for `col_mo`. #> NOTE: Using column `date` as input for `col_date`. #> NOTE: Using column `patient_id` as input for `col_patient_id`. -#> => Found 5,676 first isolates (28.4% of total)

+#> => Found 5,688 first isolates (28.4% of total)

So only 28.4% is suitable for resistance analysis! We can now filter on it with the filter() function, also from the dplyr package:

data_1st <- data %>% 
   filter(first == TRUE)
@@ -516,19 +516,19 @@ 1 -2010-01-20 -L10 +2010-04-01 +K1 B_ESCHR_COL -I R S S +S TRUE 2 -2010-03-26 -L10 +2010-04-30 +K1 B_ESCHR_COL R S @@ -538,10 +538,10 @@ 3 -2010-05-05 -L10 +2010-10-12 +K1 B_ESCHR_COL -S +R S S S @@ -549,19 +549,19 @@ 4 -2010-06-20 -L10 +2010-12-05 +K1 B_ESCHR_COL S S S -S +R FALSE 5 -2010-07-10 -L10 +2011-01-19 +K1 B_ESCHR_COL S S @@ -571,21 +571,21 @@ 6 -2010-08-01 -L10 +2011-04-07 +K1 B_ESCHR_COL S S S S -FALSE +TRUE 7 -2010-08-27 -L10 +2011-06-16 +K1 B_ESCHR_COL -R +S S S S @@ -593,19 +593,19 @@ 8 -2010-09-09 -L10 +2011-07-16 +K1 B_ESCHR_COL -R S +R S S FALSE 9 -2010-09-26 -L10 +2011-08-25 +K1 B_ESCHR_COL R S @@ -615,18 +615,18 @@ 10 -2010-10-11 -L10 +2011-09-11 +K1 B_ESCHR_COL R S -S -S +R +R FALSE -

Only 1 isolates are marked as ‘first’ according to CLSI guideline. But when reviewing the antibiogram, it is obvious that some isolates are absolutely different strains and should be included too. This is why we weigh isolates, based on their antibiogram. The key_antibiotics() function adds a vector with 18 key antibiotics: 6 broad spectrum ones, 6 small spectrum for Gram negatives and 6 small spectrum for Gram positives. These can be defined by the user.

+

Only 2 isolates are marked as ‘first’ according to CLSI guideline. But when reviewing the antibiogram, it is obvious that some isolates are absolutely different strains and should be included too. This is why we weigh isolates, based on their antibiogram. The key_antibiotics() function adds a vector with 18 key antibiotics: 6 broad spectrum ones, 6 small spectrum for Gram negatives and 6 small spectrum for Gram positives. These can be defined by the user.

If a column exists with a name like ‘key(…)ab’ the first_isolate() function will automatically use it and determine the first weighted isolates. Mind the NOTEs in below output:

data <- data %>% 
   mutate(keyab = key_antibiotics(.)) %>% 
@@ -637,7 +637,7 @@
 #> NOTE: Using column `patient_id` as input for `col_patient_id`.
 #> NOTE: Using column `keyab` as input for `col_keyantibiotics`. Use col_keyantibiotics  = FALSE to prevent this.
 #> [Criterion] Inclusion based on key antibiotics, ignoring I.
-#> => Found 15,767 first weighted isolates (78.8% of total)
+#> => Found 15,948 first weighted isolates (79.7% of total) @@ -654,56 +654,80 @@ - - + + - + - - + + - + - - + + - + - + - - + + + + + + + + + + + + + + - + + + + + + + + + + + + + - - - + + + @@ -713,21 +737,21 @@ - - - + + + - + - + - - - + + + @@ -737,48 +761,24 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - + + +
isolate
12010-01-20L102010-04-01K1 B_ESCHR_COLI R S SS TRUE TRUE
22010-03-26L102010-04-30K1 B_ESCHR_COL R S S S FALSETRUEFALSE
32010-05-05L102010-10-12K1 B_ESCHR_COLSR S S S FALSETRUEFALSE
42010-06-20L102010-12-05K1B_ESCHR_COLSSSRFALSETRUE
52011-01-19K1 B_ESCHR_COL S S S S FALSEFALSETRUE
62011-04-07K1B_ESCHR_COLSSSSTRUETRUE
52010-07-10L1072011-06-16K1 B_ESCHR_COL S SFALSE
62010-08-01L1082011-07-16K1 B_ESCHR_COL SSR S S FALSEFALSETRUE
72010-08-27L1092011-08-25K1 B_ESCHR_COL R STRUE
82010-09-09L10B_ESCHR_COLRSSSFALSEFALSE
92010-09-26L10B_ESCHR_COLRSSSFALSEFALSE
102010-10-11L102011-09-11K1 B_ESCHR_COL R SSSFALSERR FALSETRUE
-

Instead of 1, now 4 isolates are flagged. In total, 78.8% of all isolates are marked ‘first weighted’ - 50.5% more than when using the CLSI guideline. In real life, this novel algorithm will yield 5-10% more isolates than the classic CLSI guideline.

+

Instead of 2, now 7 isolates are flagged. In total, 79.7% of all isolates are marked ‘first weighted’ - 51.3% more than when using the CLSI guideline. In real life, this novel algorithm will yield 5-10% more isolates than the classic CLSI guideline.

As with filter_first_isolate(), there’s a shortcut for this new algorithm too:

data_1st <- data %>% 
   filter_first_weighted_isolate()
-

So we end up with 15,767 isolates for analysis.

+

So we end up with 15,948 isolates for analysis.

We can remove unneeded columns:

data_1st <- data_1st %>% 
   select(-c(first, keyab))
@@ -786,6 +786,7 @@ 
head(data_1st)
+ @@ -802,90 +803,96 @@ - - + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + - - + - - - + + + + - + @@ -908,9 +915,9 @@ 
freq(paste(data_1st$genus, data_1st$species))

Or can be used like the dplyr way, which is easier readable:

data_1st %>% freq(genus, species)
-

Frequency table of genus and species from a data.frame (15,767 x 13)

+

Frequency table of genus and species from a data.frame (15,948 x 13)

Columns: 2
-Length: 15,767 (of which NA: 0 = 0.00%)
+Length: 15,948 (of which NA: 0 = 0.00%)
Unique: 4

Shortest: 16
Longest: 24

@@ -927,33 +934,33 @@ Longest: 24

- - - - + + + + - - - - + + + + - - - - + + + + - - - + + + @@ -964,7 +971,7 @@ Longest: 24

Resistance percentages

The functions portion_R(), portion_RI(), portion_I(), portion_IS() and portion_S() can be used to determine the portion of a specific antimicrobial outcome. They can be used on their own:

data_1st %>% portion_IR(amox)
-#> [1] 0.4762479
+#> [1] 0.4812516

Or can be used in conjuction with group_by() and summarise(), both from the dplyr package:

data_1st %>% 
   group_by(hospital) %>% 
@@ -977,19 +984,19 @@ Longest: 24
- + - + - + - +
date patient_id hospital
2010-01-23E212011-03-23H4 Hospital BB_STPHY_AURB_ESCHR_COLSSSSMGram negativeEscherichiacoliTRUE
22016-02-07A10Hospital BB_ESCHR_COLSSSSMGram negativeEscherichiacoliTRUE
52016-03-20X10Hospital DB_STRPT_PNESSSRFGram positiveStreptococcuspneumoniaeTRUE
72015-08-01Q4Hospital AB_ESCHR_COLS I SSSMGram positiveStaphylococcusaureusTRUE
2017-12-07L8Hospital BB_STPHY_AURSSSSMGram positiveStaphylococcusaureusTRUE
2012-07-19W5Hospital AB_STPHY_AURS RSS FGram positiveStaphylococcusaureusTRUE
2013-11-26L7Hospital AB_ESCHR_COLSSRSM Gram negative Escherichia coli TRUE
2016-01-24M7Hospital B82012-03-10Z10Hospital C B_ESCHR_COLR S S SSMF Gram negative Escherichia coli TRUE
2016-11-13V10Hospital A112014-10-21G8Hospital C B_ESCHR_COL S S S SFM Gram negative Escherichia coli
1 Escherichia coli7,76249.2%7,76249.2%7,95249.9%7,95249.9%
2 Staphylococcus aureus4,01425.5%11,77674.7%3,88624.4%11,83874.2%
3 Streptococcus pneumoniae2,45015.5%14,22690.2%2,50915.7%14,34790.0%
4 Klebsiella pneumoniae1,5419.8%15,7671,60110.0%15,948 100.0%
Hospital A0.47174960.4801481
Hospital B0.47546620.4811895
Hospital C0.47481700.4707087
Hospital D0.48544300.4915144
@@ -1007,23 +1014,23 @@ Longest: 24

Hospital A -0.4717496 -4761 +0.4801481 +4861 Hospital B -0.4754662 -5523 +0.4811895 +5582 Hospital C -0.4748170 -2323 +0.4707087 +2441 Hospital D -0.4854430 -3160 +0.4915144 +3064 @@ -1043,27 +1050,27 @@ Longest: 24

Escherichia -0.7333162 -0.9035043 -0.9748776 +0.7282445 +0.9031690 +0.9756036 Klebsiella -0.7352369 -0.9104478 -0.9733939 +0.7270456 +0.9000625 +0.9787633 Staphylococcus -0.7416542 -0.9160438 -0.9763328 +0.7220793 +0.9184251 +0.9796706 Streptococcus -0.7473469 +0.7182144 0.0000000 -0.7473469 +0.7182144 diff --git a/docs/articles/AMR_files/figure-html/plot 1-1.png b/docs/articles/AMR_files/figure-html/plot 1-1.png index 49a734cc..c93a5298 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 1-1.png and b/docs/articles/AMR_files/figure-html/plot 1-1.png differ diff --git a/docs/articles/AMR_files/figure-html/plot 3-1.png b/docs/articles/AMR_files/figure-html/plot 3-1.png index babc025c..464e8829 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 3-1.png and b/docs/articles/AMR_files/figure-html/plot 3-1.png differ diff --git a/docs/articles/AMR_files/figure-html/plot 4-1.png b/docs/articles/AMR_files/figure-html/plot 4-1.png index 4ec461ef..7da245da 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 4-1.png and b/docs/articles/AMR_files/figure-html/plot 4-1.png differ diff --git a/docs/articles/AMR_files/figure-html/plot 5-1.png b/docs/articles/AMR_files/figure-html/plot 5-1.png index 47ed2dd4..df3534bd 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 5-1.png and b/docs/articles/AMR_files/figure-html/plot 5-1.png differ diff --git a/docs/articles/EUCAST.html b/docs/articles/EUCAST.html index ceb9fd3f..47e067ad 100644 --- a/docs/articles/EUCAST.html +++ b/docs/articles/EUCAST.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to apply EUCAST rules

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

diff --git a/docs/articles/G_test.html b/docs/articles/G_test.html index f25feb89..d7cbe252 100644 --- a/docs/articles/G_test.html +++ b/docs/articles/G_test.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to use the G-test

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

diff --git a/docs/articles/SPSS.html b/docs/articles/SPSS.html index 3461506f..9d08b222 100644 --- a/docs/articles/SPSS.html +++ b/docs/articles/SPSS.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to import data from SPSS / SAS / Stata

Matthijs S. Berends

-

09 March 2019

+

15 March 2019

diff --git a/docs/articles/WHONET.html b/docs/articles/WHONET.html index c6d941c0..e3c39870 100644 --- a/docs/articles/WHONET.html +++ b/docs/articles/WHONET.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to work with WHONET data

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

@@ -227,17 +227,17 @@ # get microbial ID based on given organism mutate(mo = as.mo(Organism)) %>% # transform everything from "AMP_ND10" to "CIP_EE" to the new `rsi` class - mutate_at(vars(AMP_ND10:CIP_EE), as.rsi) + mutate_at(vars(AMP_ND10:CIP_EE), as.rsi)

No errors or warnings, so all values are transformed succesfully. Let’s check it though, with a couple of frequency tables:

# our newly created `mo` variable
 data %>% freq(mo, nmax = 10)

Frequency table of mo from a data.frame (500 x 54)

Class: mo (character)
Length: 500 (of which NA: 0 = 0.00%)
-Unique: 39

-

Families: 9
-Genera: 16
-Species: 36

+Unique: 37

+

Families: 10
+Genera: 17
+Species: 35

@@ -258,7 +258,7 @@ Species: 36

- + @@ -314,23 +314,23 @@ Species: 36

- - - - - + + + + + - - - - - + + + + +
2B_STPHY_CNSB_STPHY 74 14.8% 319
9B_ENTRB_CLO51.0%43987.8%B_STRPT81.6%44288.4%
10B_ENTRC40.8%44388.6%B_ENTRB_CLO51.0%44789.4%
-

(omitted 29 entries, n = 57 [11.4%])

+

(omitted 27 entries, n = 53 [10.6%])


 # our transformed antibiotic columns
 # amoxicillin/clavulanic acid (J01CR02) as an example
diff --git a/docs/articles/atc_property.html b/docs/articles/atc_property.html
index f541d6cf..bcc1f409 100644
--- a/docs/articles/atc_property.html
+++ b/docs/articles/atc_property.html
@@ -40,7 +40,7 @@
       
       
         AMR (for R)
-        0.5.0.9021
+        0.5.0.9023
@@ -192,7 +192,7 @@

How to get properties of an antibiotic

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

diff --git a/docs/articles/benchmarks.html b/docs/articles/benchmarks.html index 9f9c9b39..578d71ef 100644 --- a/docs/articles/benchmarks.html +++ b/docs/articles/benchmarks.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9022 + 0.5.0.9023 @@ -192,7 +192,7 @@

Benchmarks

Matthijs S. Berends

-

12 March 2019

+

15 March 2019

@@ -215,33 +215,33 @@ as.mo("S. aureus"), as.mo("Staphylococcus aureus"), times = 10) -print(S.aureus, unit = "ms", signif = 3) +print(S.aureus, unit = "ms", signif = 2) #> Unit: milliseconds -#> expr min lq mean median uq max neval -#> as.mo("sau") 16.70 16.8 25.70 17.00 19.60 59.7 10 -#> as.mo("stau") 39.10 39.2 43.70 39.30 40.60 80.4 10 -#> as.mo("staaur") 16.70 16.8 24.60 17.00 18.20 58.9 10 -#> as.mo("STAAUR") 16.70 16.7 22.70 16.80 17.20 74.5 10 -#> as.mo("S. aureus") 29.70 29.7 46.70 29.80 71.30 110.0 10 -#> as.mo("S. aureus") 29.60 29.7 36.10 29.70 33.10 83.7 10 -#> as.mo("Staphylococcus aureus") 7.03 7.1 7.14 7.14 7.17 7.3 10 +#> expr min lq mean median uq max neval +#> as.mo("sau") 17.0 17.0 22.0 17.0 19.0 59.0 10 +#> as.mo("stau") 41.0 41.0 46.0 41.0 44.0 83.0 10 +#> as.mo("staaur") 17.0 17.0 26.0 17.0 18.0 74.0 10 +#> as.mo("STAAUR") 17.0 17.0 29.0 17.0 52.0 62.0 10 +#> as.mo("S. aureus") 31.0 31.0 32.0 31.0 32.0 32.0 10 +#> as.mo("S. aureus") 31.0 31.0 48.0 32.0 73.0 110.0 10 +#> as.mo("Staphylococcus aureus") 7.4 7.4 7.7 7.4 8.2 8.6 10

In the table above, all measurements are shown in milliseconds (thousands of seconds). A value of 5 milliseconds means it can determine 200 input values per second. It case of 100 milliseconds, this is only 10 input values per second. The second input is the only one that has to be looked up thoroughly. All the others are known codes (the first one is a WHONET code) or common laboratory codes, or common full organism names like the last one. Full organism names are always preferred.

To achieve this speed, the as.mo function also takes into account the prevalence of human pathogenic microorganisms. The downside is of course that less prevalent microorganisms will be determined less fast. See this example for the ID of Thermus islandicus (B_THERMS_ISL), a bug probably never found before in humans:

T.islandicus <- microbenchmark(as.mo("theisl"),
-                                 as.mo("THEISL"),
-                                 as.mo("T. islandicus"),
-                                 as.mo("T.  islandicus"),
-                                 as.mo("Thermus islandicus"),
-                                 times = 10)
-print(T.islandicus, unit = "ms", signif = 3)
+                               as.mo("THEISL"),
+                               as.mo("T. islandicus"),
+                               as.mo("T.  islandicus"),
+                               as.mo("Thermus islandicus"),
+                               times = 10)
+print(T.islandicus, unit = "ms", signif = 2)
 #> Unit: milliseconds
-#>                         expr   min    lq  mean median    uq max neval
-#>              as.mo("theisl") 417.0 419.0 450.0  460.0 464.0 474    10
-#>              as.mo("THEISL") 415.0 416.0 443.0  458.0 460.0 468    10
-#>       as.mo("T. islandicus") 281.0 281.0 299.0  285.0 325.0 352    10
-#>      as.mo("T.  islandicus") 292.0 298.0 341.0  336.0 340.0 495    10
-#>  as.mo("Thermus islandicus")  66.2  66.5  75.5   66.9  68.2 112    10
-

That takes 10.9 times as much time on average. A value of 100 milliseconds means it can only determine ~10 different input values per second. We can conclude that looking up arbitrary codes of less prevalent microorganisms is the worst way to go, in terms of calculation performance. Full names (like Thermus islandicus) are almost fast - these are the most probable input from most data sets.

+#> expr min lq mean median uq max neval +#> as.mo("theisl") 420 430 450 470 470 470 10 +#> as.mo("THEISL") 420 440 480 470 480 680 10 +#> as.mo("T. islandicus") 290 290 310 300 330 350 10 +#> as.mo("T. islandicus") 300 300 330 330 350 350 10 +#> as.mo("Thermus islandicus") 67 67 86 68 110 120 10 +

That takes 11 times as much time on average. A value of 100 milliseconds means it can only determine ~10 different input values per second. We can conclude that looking up arbitrary codes of less prevalent microorganisms is the worst way to go, in terms of calculation performance. Full names (like Thermus islandicus) are almost fast - these are the most probable input from most data sets.

In the figure below, we compare Escherichia coli (which is very common) with Prevotella brevis (which is moderately common) and with Thermus islandicus (which is very uncommon):

par(mar = c(5, 16, 4, 2)) # set more space for left margin text (16)
 
@@ -251,12 +251,15 @@
                        as.mo("T. islandicus"),
                        as.mo("P. brevis"),
                        as.mo("E. coli"),
-                       times = 50),
+                       times = 10),
         horizontal = TRUE, las = 1, unit = "s", log = FALSE,
-        xlab = "", ylab = "Time in seconds",
+        xlab = "", ylab = "Time in seconds", ylim = c(0, 0.5),
         main = "Benchmarks per prevalence")

-

Uncommon microorganisms take a lot more time than common microorganisms. To relieve this pitfall and further improve performance, two important calculations take almost no time at all: repetitive results and already precalculated results.

+

In reality, the as.mo() functions learns from its own output to speed up determinations for next times. In above figure, this effect was disabled to show the difference with the boxplot below - when you would use as.mo() yourself:

+

+

The highest outliers are the first times. All next determinations were done in only thousands of seconds.

+

Still, uncommon microorganisms take a lot more time than common microorganisms, especially the first time. To relieve this pitfall and further improve performance, two important calculations take almost no time at all: repetitive results and already precalculated results.

Repetitive results

@@ -286,9 +289,9 @@ times = 10) print(run_it, unit = "ms", signif = 3) #> Unit: milliseconds -#> expr min lq mean median uq max neval -#> mo_fullname(x) 794 834 863 844 876 1050 10
-

So transforming 500,000 values (!!) of 50 unique values only takes 0.84 seconds (844 ms). You only lose time on your unique input values.

+#> expr min lq mean median uq max neval +#> mo_fullname(x) 738 813 847 819 921 975 10 +

So transforming 500,000 values (!!) of 50 unique values only takes 0.82 seconds (818 ms). You only lose time on your unique input values.

@@ -301,9 +304,9 @@ print(run_it, unit = "ms", signif = 3) #> Unit: milliseconds #> expr min lq mean median uq max neval -#> A 10.900 11.100 11.200 11.200 11.300 11.400 10 -#> B 27.300 27.900 28.300 28.000 28.100 31.500 10 -#> C 0.319 0.326 0.472 0.563 0.568 0.579 10

+#> A 11.000 11.100 15.700 11.300 11.400 52.900 10 +#> B 28.700 28.900 29.400 29.200 29.500 30.500 10 +#> C 0.322 0.556 0.523 0.568 0.581 0.586 10

So going from mo_fullname("Staphylococcus aureus") to "Staphylococcus aureus" takes 0.0006 seconds - it doesn’t even start calculating if the result would be the same as the expected resulting value. That goes for all helper functions:

run_it <- microbenchmark(A = mo_species("aureus"),
                          B = mo_genus("Staphylococcus"),
@@ -317,14 +320,14 @@
 print(run_it, unit = "ms", signif = 3)
 #> Unit: milliseconds
 #>  expr   min    lq  mean median    uq   max neval
-#>     A 0.308 0.332 0.396  0.393 0.457 0.498    10
-#>     B 0.349 0.376 0.419  0.444 0.462 0.467    10
-#>     C 0.351 0.398 0.529  0.555 0.628 0.702    10
-#>     D 0.302 0.330 0.378  0.381 0.424 0.465    10
-#>     E 0.282 0.329 0.371  0.374 0.384 0.539    10
-#>     F 0.281 0.354 0.364  0.366 0.402 0.444    10
-#>     G 0.275 0.309 0.347  0.351 0.380 0.420    10
-#>     H 0.279 0.306 0.356  0.363 0.404 0.411    10
+#> A 0.314 0.339 0.399 0.380 0.460 0.507 10 +#> B 0.347 0.387 0.455 0.402 0.493 0.684 10 +#> C 0.429 0.505 0.566 0.588 0.656 0.660 10 +#> D 0.321 0.340 0.383 0.367 0.412 0.490 10 +#> E 0.303 0.328 0.369 0.379 0.403 0.449 10 +#> F 0.251 0.323 0.346 0.348 0.391 0.400 10 +#> G 0.286 0.305 0.345 0.338 0.389 0.398 10 +#> H 0.272 0.297 0.355 0.338 0.427 0.450 10

Of course, when running mo_phylum("Firmicutes") the function has zero knowledge about the actual microorganism, namely S. aureus. But since the result would be "Firmicutes" too, there is no point in calculating the result. And because this package ‘knows’ all phyla of all known bacteria (according to the Catalogue of Life), it can just return the initial value immediately.

@@ -351,13 +354,13 @@ print(run_it, unit = "ms", signif = 4) #> Unit: milliseconds #> expr min lq mean median uq max neval -#> en 16.61 17.17 17.23 17.28 17.38 17.56 10 -#> de 28.83 28.85 29.31 29.50 29.63 29.67 10 -#> nl 29.08 29.44 33.71 29.65 29.72 71.15 10 -#> es 28.86 29.52 38.07 29.70 30.60 72.14 10 -#> it 28.71 29.48 34.04 29.63 31.28 71.09 10 -#> fr 29.32 29.47 41.44 29.53 62.86 73.16 10 -#> pt 29.05 29.43 33.93 29.62 30.93 71.00 10
+#> en 18.05 18.11 19.33 18.25 18.65 25.12 10 +#> de 30.15 30.84 43.57 31.08 72.47 73.96 10 +#> nl 30.30 30.63 34.96 30.71 30.73 73.40 10 +#> es 30.24 30.49 31.39 30.97 32.20 33.68 10 +#> it 30.53 30.71 31.18 30.83 31.71 32.38 10 +#> fr 29.64 30.49 35.32 30.84 32.25 73.00 10 +#> pt 30.73 30.81 39.47 31.09 32.29 73.25 10

Currently supported are German, Dutch, Spanish, Italian, French and Portuguese.

diff --git a/docs/articles/benchmarks_files/figure-html/unnamed-chunk-5-1.png b/docs/articles/benchmarks_files/figure-html/unnamed-chunk-5-1.png index 22db0a14..9cd7c1ca 100644 Binary files a/docs/articles/benchmarks_files/figure-html/unnamed-chunk-5-1.png and b/docs/articles/benchmarks_files/figure-html/unnamed-chunk-5-1.png differ diff --git a/docs/articles/benchmarks_files/figure-html/unnamed-chunk-6-1.png b/docs/articles/benchmarks_files/figure-html/unnamed-chunk-6-1.png new file mode 100644 index 00000000..18c316e1 Binary files /dev/null and b/docs/articles/benchmarks_files/figure-html/unnamed-chunk-6-1.png differ diff --git a/docs/articles/freq.html b/docs/articles/freq.html index 9aa22ce2..94897c26 100644 --- a/docs/articles/freq.html +++ b/docs/articles/freq.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to create frequency tables

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

diff --git a/docs/articles/index.html b/docs/articles/index.html index fefc0597..9b46fe1f 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -78,7 +78,7 @@ AMR (for R) - 0.5.0.9022 + 0.5.0.9023 diff --git a/docs/articles/mo_property.html b/docs/articles/mo_property.html index e61fca60..1ba5e03b 100644 --- a/docs/articles/mo_property.html +++ b/docs/articles/mo_property.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to get properties of a microorganism

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

diff --git a/docs/articles/resistance_predict.html b/docs/articles/resistance_predict.html index 7fd8803d..b98b3bf3 100644 --- a/docs/articles/resistance_predict.html +++ b/docs/articles/resistance_predict.html @@ -40,7 +40,7 @@ AMR (for R) - 0.5.0.9021 + 0.5.0.9023 @@ -192,7 +192,7 @@

How to predict antimicrobial resistance

Matthijs S. Berends

-

05 March 2019

+

15 March 2019

diff --git a/docs/authors.html b/docs/authors.html index 0cae75ad..c149c7c1 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -78,7 +78,7 @@ AMR (for R) - 0.5.0.9022 + 0.5.0.9023 diff --git a/docs/index.html b/docs/index.html index 131bee7f..5bb1144c 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 0.5.0.9022 + 0.5.0.9023 diff --git a/docs/news/index.html b/docs/news/index.html index 7bc98225..c6f0e65c 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -78,7 +78,7 @@ AMR (for R) - 0.5.0.9022 + 0.5.0.9023 @@ -349,8 +349,8 @@ These functions use as.atc()
  • Function guess_atc() is now deprecated in favour of as.atc() and will be removed in future versions
  • Improvements for as.mo(): +
  • +

    Now handles incorrect spelling, like i instead of y and f instead of ph:

    # mo_fullname() uses as.mo() internally
 
 mo_fullname("Sthafilokockus aaureuz")
@@ -358,9 +358,9 @@ These functions use as.atc()
 
 mo_fullname("S. klossi")
 #> [1] "Staphylococcus kloosii"
    - +
    • +
  • +

    Uncertainty of the algorithm is now divided into four levels, 0 to 3, where the default allow_uncertain = TRUE is equal to uncertainty level 2. Run ?as.mo for more info about these levels.

    # equal:
 as.mo(..., allow_uncertain = TRUE)
 as.mo(..., allow_uncertain = 2)
@@ -368,15 +368,15 @@ These functions use as.atc()
 # also equal:
 as.mo(..., allow_uncertain = FALSE)
 as.mo(..., allow_uncertain = 0)
    -Using as.mo(..., allow_uncertain = 3) could lead to very unreliable results. - +Using as.mo(..., allow_uncertain = 3) could lead to very unreliable results.
    • +
  • All microbial IDs that are found with zero uncertainty are now saved to a local file ~/.Rhistory_mo. Use the new function clean_mo_history() to delete this file, which resets the algorithms.
    • +
  • +

    Incoercible results will now be considered ‘unknown’, MO code UNKNOWN. On foreign systems, properties of these will be translated to all languages already previously supported: German, Dutch, French, Italian, Spanish and Portuguese:

    mo_genus("qwerty", language = "es")
 # Warning: 
 # one unique value (^= 100.0%) could not be coerced and is considered 'unknown': "qwerty". Use mo_failures() to review it.
 #> [1] "(género desconocido)"
    -