diff --git a/DESCRIPTION b/DESCRIPTION index 2bcfe90b..37d7b636 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.3.0.9028 -Date: 2020-09-24 +Version: 1.3.0.9029 +Date: 2020-09-25 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 7d68359e..bce8ff8e 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -58,6 +58,11 @@ S3method(skewness,matrix) S3method(summary,mic) S3method(summary,mo) S3method(summary,rsi) +S3method(unique,ab) +S3method(unique,disk) +S3method(unique,mic) +S3method(unique,mo) +S3method(unique,rsi) export("%like%") export("%like_case%") export(ab_atc) @@ -217,6 +222,7 @@ importFrom(graphics,arrows) importFrom(graphics,axis) importFrom(graphics,barplot) importFrom(graphics,par) +importFrom(graphics,plot) importFrom(graphics,points) importFrom(graphics,text) importFrom(stats,complete.cases) diff --git a/NEWS.md b/NEWS.md index 929b7b65..ffbfb4ae 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# AMR 1.3.0.9028 -## Last updated: 24 September 2020 +# AMR 1.3.0.9029 +## Last updated: 25 September 2020 Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly! @@ -63,6 +63,7 @@ Note: some changes in this version were suggested by anonymous reviewers from th * 'Penicillin G' (for intravenous use) is now named 'Benzylpenicillin' (code `PEN`) * 'Penicillin V' (for oral use, code `PNV`) was removed, since its actual entry 'Phenoxymethylpenicillin' (code `PHN`) already existed * The group name (`antibiotics$group`) of 'Linezolid' (`LNZ`), 'Cycloserine' (`CYC`), 'Tedizolid' (`TZD`) and 'Thiacetazone' (`THA`) is now "Oxazolidinones" instead of "Other antibacterials" +* Added support for using `unique()` on classes ``, ``, ``, `` and `` ### Other * Removed unnecessary references to the `base` package diff --git a/R/ab.R b/R/ab.R index 79cc09dd..2129f64b 100755 --- a/R/ab.R +++ b/R/ab.R @@ -99,6 +99,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { # remove diacritics x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT") x <- gsub('"', "", x, fixed = TRUE) + x <- gsub("(specimen|specimen date|specimen_date|spec_date)", "", x, ignore.case = TRUE, perl = TRUE) x_bak_clean <- x if (already_regex == FALSE) { x_bak_clean <- generalise_antibiotic_name(x_bak_clean) @@ -212,26 +213,26 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { } x_spelling <- x[i] if (already_regex == FALSE) { - x_spelling <- gsub("[IY]+", "[IY]+", x_spelling) - x_spelling <- gsub("(C|K|Q|QU|S|Z|X|KS)+", "(C|K|Q|QU|S|Z|X|KS)+", x_spelling) - x_spelling <- gsub("(PH|F|V)+", "(PH|F|V)+", x_spelling) - x_spelling <- gsub("(TH|T)+", "(TH|T)+", x_spelling) - x_spelling <- gsub("A+", "A+", x_spelling) - x_spelling <- gsub("E+", "E+", x_spelling) - x_spelling <- gsub("O+", "O+", x_spelling) + x_spelling <- gsub("[IY]+", "[IY]+", x_spelling, perl = TRUE) + x_spelling <- gsub("(C|K|Q|QU|S|Z|X|KS)+", "(C|K|Q|QU|S|Z|X|KS)+", x_spelling, perl = TRUE) + x_spelling <- gsub("(PH|F|V)+", "(PH|F|V)+", x_spelling, perl = TRUE) + x_spelling <- gsub("(TH|T)+", "(TH|T)+", x_spelling, perl = TRUE) + x_spelling <- gsub("A+", "A+", x_spelling, perl = TRUE) + x_spelling <- gsub("E+", "E+", x_spelling, perl = TRUE) + x_spelling <- gsub("O+", "O+", x_spelling, perl = TRUE) # allow any ending of -in/-ine and -im/-ime - x_spelling <- gsub("(\\[IY\\]\\+(N|M)|\\[IY\\]\\+(N|M)E\\+)$", "[IY]+(N|M)E*", x_spelling) + x_spelling <- gsub("(\\[IY\\]\\+(N|M)|\\[IY\\]\\+(N|M)E\\+)$", "[IY]+(N|M)E*", x_spelling, perl = TRUE) # allow any ending of -ol/-ole - x_spelling <- gsub("(O\\+L|O\\+LE\\+)$", "O+LE*", x_spelling) + x_spelling <- gsub("(O\\+L|O\\+LE\\+)$", "O+LE*", x_spelling, perl = TRUE) # allow any ending of -on/-one - x_spelling <- gsub("(O\\+N|O\\+NE\\+)$", "O+NE*", x_spelling) + x_spelling <- gsub("(O\\+N|O\\+NE\\+)$", "O+NE*", x_spelling, perl = TRUE) # replace multiple same characters to single one with '+', like "ll" -> "l+" - x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling) + x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling, perl = TRUE) # replace spaces and slashes with a possibility on both - x_spelling <- gsub("[ /]", "( .*|.*/)", x_spelling) + x_spelling <- gsub("[ /]", "( .*|.*/)", x_spelling, perl = TRUE) # correct for digital reading text (OCR) - x_spelling <- gsub("[NRD8B]", "[NRD8B]", x_spelling) - x_spelling <- gsub("(O|0)", "(O|0)+", x_spelling) + x_spelling <- gsub("[NRD8B]", "[NRD8B]", x_spelling, perl = TRUE) + x_spelling <- gsub("(O|0)", "(O|0)+", x_spelling, perl = TRUE) x_spelling <- gsub("++", "+", x_spelling, fixed = TRUE) } @@ -264,7 +265,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { # try by removing all spaces if (x[i] %like% " ") { - found <- suppressWarnings(as.ab(gsub(" +", "", x[i]), initial_search = FALSE)) + found <- suppressWarnings(as.ab(gsub(" +", "", x[i], perl = TRUE), initial_search = FALSE)) if (length(found) > 0 & !is.na(found)) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -273,7 +274,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { # try by removing all spaces and numbers if (x[i] %like% " " | x[i] %like% "[0-9]") { - found <- suppressWarnings(as.ab(gsub("[ 0-9]", "", x[i]), initial_search = FALSE)) + found <- suppressWarnings(as.ab(gsub("[ 0-9]", "", x[i], perl = TRUE), initial_search = FALSE)) if (length(found) > 0 & !is.na(found)) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -318,7 +319,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { # try by removing all trailing capitals if (x[i] %like_case% "[a-z]+[A-Z]+$") { - found <- suppressWarnings(as.ab(gsub("[A-Z]+$", "", x[i]), initial_search = FALSE)) + found <- suppressWarnings(as.ab(gsub("[A-Z]+$", "", x[i], perl = TRUE), initial_search = FALSE)) if (!is.na(found)) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -326,7 +327,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { } # keep only letters - found <- suppressWarnings(as.ab(gsub("[^A-Z]", "", x[i]), initial_search = FALSE)) + found <- suppressWarnings(as.ab(gsub("[^A-Z]", "", x[i], perl = TRUE), initial_search = FALSE)) if (!is.na(found)) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -357,10 +358,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { } # make all consonants facultative - search_str <- gsub("([BCDFGHJKLMNPQRSTVWXZ])", "\\1*", x[i]) + search_str <- gsub("([BCDFGHJKLMNPQRSTVWXZ])", "\\1*", x[i], perl = TRUE) found <- suppressWarnings(as.ab(search_str, initial_search = FALSE, already_regex = TRUE)) # keep at least 4 normal characters - if (nchar(gsub(".\\*", "", search_str)) < 4) { + if (nchar(gsub(".\\*", "", search_str, perl = TRUE)) < 4) { found <- NA } if (!is.na(found)) { @@ -369,10 +370,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { } # make all vowels facultative - search_str <- gsub("([AEIOUY])", "\\1*", x[i]) + search_str <- gsub("([AEIOUY])", "\\1*", x[i], perl = TRUE) found <- suppressWarnings(as.ab(search_str, initial_search = FALSE, already_regex = TRUE)) # keep at least 5 normal characters - if (nchar(gsub(".\\*", "", search_str)) < 5) { + if (nchar(gsub(".\\*", "", search_str, perl = TRUE)) < 5) { found <- NA } if (!is.na(found)) { @@ -529,24 +530,33 @@ c.ab <- function(x, ...) { class_integrity_check(y, "antimicrobial code", antibiotics$ab) } +#' @method unique ab +#' @export +#' @noRd +unique.ab <- function(x, incomparables = FALSE, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} + generalise_antibiotic_name <- function(x) { x <- toupper(x) # remove suffices - x <- gsub("_(MIC|RSI|DIS[CK])$", "", x) + x <- gsub("_(MIC|RSI|DIS[CK])$", "", x, perl = TRUE) # remove disk concentrations, like LVX_NM -> LVX - x <- gsub("_[A-Z]{2}[0-9_.]{0,3}$", "", x) + x <- gsub("_[A-Z]{2}[0-9_.]{0,3}$", "", x, perl = TRUE) # remove part between brackets if that's followed by another string x <- gsub("(.*)+ [(].*[)]", "\\1", x) # keep only max 1 space - x <- trimws2(gsub(" +", " ", x)) + x <- trimws2(gsub(" +", " ", x, perl = TRUE)) # non-character, space or number should be a slash - x <- gsub("[^A-Z0-9 -]", "/", x) + x <- gsub("[^A-Z0-9 -]", "/", x, perl = TRUE) # spaces around non-characters must be removed: amox + clav -> amox/clav - x <- gsub("(.*[A-Z0-9]) ([^A-Z0-9].*)", "\\1\\2", x) - x <- gsub("(.*[^A-Z0-9]) ([A-Z0-9].*)", "\\1\\2", x) + x <- gsub("(.*[A-Z0-9]) ([^A-Z0-9].*)", "\\1\\2", x, perl = TRUE) + x <- gsub("(.*[^A-Z0-9]) ([A-Z0-9].*)", "\\1\\2", x, perl = TRUE) # remove hyphen after a starting "co" - x <- gsub("^CO-", "CO", x) + x <- gsub("^CO-", "CO", x, perl = TRUE) # replace operators with a space - x <- gsub("(/| AND | WITH | W/|[+]|[-])+", " ", x) + x <- gsub("(/| AND | WITH | W/|[+]|[-])+", " ", x, perl = TRUE) x } diff --git a/R/disk.R b/R/disk.R index 143e2f48..89289231 100644 --- a/R/disk.R +++ b/R/disk.R @@ -177,3 +177,12 @@ c.disk <- function(x, ...) { attributes(y) <- attributes(x) y } + +#' @method unique disk +#' @export +#' @noRd +unique.disk <- function(x, incomparables = FALSE, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 9266cb7f..a4ef37bf 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -137,7 +137,7 @@ eucast_rules <- function(x, ...) { x_deparsed <- deparse(substitute(x)) - if (!x_deparsed %like% "[a-z]") { + if (length(x_deparsed) > 0 || !all(x_deparsed %like% "[a-z]")) { x_deparsed <- "your_data" } diff --git a/R/mic.R b/R/mic.R index a51fb1b2..5811fa90 100755 --- a/R/mic.R +++ b/R/mic.R @@ -287,3 +287,12 @@ c.mic <- function(x, ...) { x <- as.character(x) as.mic(c(x, y)) } + +#' @method unique mic +#' @export +#' @noRd +unique.mic <- function(x, incomparables = FALSE, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} diff --git a/R/mo.R b/R/mo.R index 3915ff95..8a022110 100755 --- a/R/mo.R +++ b/R/mo.R @@ -204,11 +204,11 @@ as.mo <- function(x, return(to_class_mo(x)) } - if (tryCatch(all(tolower(x) %in% MO_lookup$fullname_lower, na.rm = TRUE) + if (tryCatch(all(x == "" | gsub(".*(unknown ).*", "unknown name", tolower(x), perl = TRUE) %in% MO_lookup$fullname_lower, na.rm = TRUE) & isFALSE(Becker) & isFALSE(Lancefield), error = function(e) FALSE)) { # to improve speed, special case for taxonomically correct full names (case-insensitive) - return(MO_lookup[match(tolower(x), MO_lookup$fullname_lower), "mo", drop = TRUE]) + return(MO_lookup[match(gsub(".*(unknown ).*", "unknown name", tolower(x), perl = TRUE), MO_lookup$fullname_lower), "mo", drop = TRUE]) } # start off with replaced language-specific non-ASCII characters with ASCII characters @@ -481,8 +481,8 @@ exec_as.mo <- function(x, # also, make sure the trailing and leading characters are a-z or 0-9 # in case of non-regex if (dyslexia_mode == FALSE) { - trimmed <- gsub("^[^a-zA-Z0-9)(]+", "", trimmed) - trimmed <- gsub("[^a-zA-Z0-9)(]+$", "", trimmed) + trimmed <- gsub("^[^a-zA-Z0-9)(]+", "", trimmed, perl = TRUE) + trimmed <- gsub("[^a-zA-Z0-9)(]+$", "", trimmed, perl = TRUE) } trimmed } @@ -497,49 +497,49 @@ exec_as.mo <- function(x, x_backup[grepl("^(fungus|fungi)$", x)] <- "F_FUNGUS" # will otherwise become the kingdom # remove spp and species - x <- gsub(" +(spp.?|ssp.?|sp.? |ss ?.?|subsp.?|subspecies|biovar |serovar |species)", " ", x) - x <- gsub("(spp.?|subsp.?|subspecies|biovar|serovar|species)", "", x) - x <- gsub("^([a-z]{2,4})(spe.?)$", "\\1", x) # when ending in SPE instead of SPP and preceded by 2-4 characters + x <- gsub(" +(spp.?|ssp.?|sp.? |ss ?.?|subsp.?|subspecies|biovar |serovar |species)", " ", x, perl = TRUE) + x <- gsub("(spp.?|subsp.?|subspecies|biovar|serovar|species)", "", x, perl = TRUE) + x <- gsub("^([a-z]{2,4})(spe.?)$", "\\1", x, perl = TRUE) # when ending in SPE instead of SPP and preceded by 2-4 characters x <- strip_whitespace(x, dyslexia_mode) x_backup_without_spp <- x x_species <- paste(x, "species") # translate to English for supported languages of mo_property - x <- gsub("(gruppe|groep|grupo|gruppo|groupe)", "group", x) + x <- gsub("(gruppe|groep|grupo|gruppo|groupe)", "group", x, perl = TRUE) # no groups and complexes as ending - x <- gsub("(complex|group)$", "", x) - x <- gsub("((an)?aero+b)[a-z]*", "", x) - x <- gsub("^atyp[a-z]*", "", x) - x <- gsub("(vergroen)[a-z]*", "viridans", x) - x <- gsub("[a-z]*diff?erent[a-z]*", "", x) - x <- gsub("(hefe|gist|gisten|levadura|lievito|fermento|levure)[a-z]*", "yeast", x) - x <- gsub("(schimmels?|mofo|molde|stampo|moisissure|fungi)[a-z]*", "fungus", x) - x <- gsub("fungus[ph|f]rya", "fungiphrya", x) + x <- gsub("(complex|group)$", "", x, perl = TRUE) + x <- gsub("((an)?aero+b)[a-z]*", "", x, perl = TRUE) + x <- gsub("^atyp[a-z]*", "", x, perl = TRUE) + x <- gsub("(vergroen)[a-z]*", "viridans", x, perl = TRUE) + x <- gsub("[a-z]*diff?erent[a-z]*", "", x, perl = TRUE) + x <- gsub("(hefe|gist|gisten|levadura|lievito|fermento|levure)[a-z]*", "yeast", x, perl = TRUE) + x <- gsub("(schimmels?|mofo|molde|stampo|moisissure|fungi)[a-z]*", "fungus", x, perl = TRUE) + x <- gsub("fungus[ph|f]rya", "fungiphrya", x, perl = TRUE) # no contamination - x <- gsub("(contamination|kontamination|mengflora|contaminaci.n|contamina..o)", "", x) + x <- gsub("(contamination|kontamination|mengflora|contaminaci.n|contamina..o)", "", x, perl = TRUE) # remove non-text in case of "E. coli" except dots and spaces - x <- trimws(gsub("[^.a-zA-Z0-9/ \\-]+", " ", x)) + x <- trimws(gsub("[^.a-zA-Z0-9/ \\-]+", " ", x, perl = TRUE)) # but make sure that dots are followed by a space - x <- gsub("[.] ?", ". ", x) + x <- gsub("[.] ?", ". ", x, perl = TRUE) # replace minus by a space - x <- gsub("-+", " ", x) + x <- gsub("-+", " ", x, perl = TRUE) # replace hemolytic by haemolytic - x <- gsub("ha?emoly", "haemoly", x) + x <- gsub("ha?emoly", "haemoly", x, perl = TRUE) # 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, perl = TRUE) # remove genus as first word - x <- gsub("^genus ", "", x) + x <- gsub("^genus ", "", x, perl = TRUE) # remove 'uncertain'-like texts - x <- trimws(gsub("(uncertain|susp[ie]c[a-z]+|verdacht)", "", x)) + x <- trimws(gsub("(uncertain|susp[ie]c[a-z]+|verdacht)", "", x, perl = TRUE)) # allow characters that resemble others = dyslexia_mode ---- if (dyslexia_mode == TRUE) { x <- tolower(x) - x <- gsub("[iy]+", "[iy]+", x) - x <- gsub("(c|k|q|qu|s|z|x|ks)+", "(c|k|q|qu|s|z|x|ks)+", x) - x <- gsub("(ph|hp|f|v)+", "(ph|hp|f|v)+", x) - x <- gsub("(th|ht|t)+", "(th|ht|t)+", x) - x <- gsub("a+", "a+", x) - x <- gsub("u+", "u+", x) + x <- gsub("[iy]+", "[iy]+", x, perl = TRUE) + x <- gsub("(c|k|q|qu|s|z|x|ks)+", "(c|k|q|qu|s|z|x|ks)+", x, perl = TRUE) + x <- gsub("(ph|hp|f|v)+", "(ph|hp|f|v)+", x, perl = TRUE) + x <- gsub("(th|ht|t)+", "(th|ht|t)+", x, perl = TRUE) + x <- gsub("a+", "a+", x, perl = TRUE) + x <- gsub("u+", "u+", x, perl = TRUE) # allow any ending of -um, -us, -ium, -icum, -ius, -icus, -ica, -ia and -a (needs perl for the negative backward lookup): x <- gsub("(u\\+\\(c\\|k\\|q\\|qu\\+\\|s\\|z\\|x\\|ks\\)\\+)(?![a-z])", "(u[s|m]|[iy][ck]?u[ms]|[iy]?[ck]?a)", x, perl = TRUE) @@ -549,11 +549,11 @@ exec_as.mo <- function(x, "(u[s|m]|[iy][ck]?u[ms]|[iy]?[ck]?a)", x, perl = TRUE) x <- gsub("(\\[iy\\]\\+a\\+)(?![a-z])", "([iy]*a+|[iy]+a*)", x, perl = TRUE) - x <- gsub("e+", "e+", x) - x <- gsub("o+", "o+", x) - x <- gsub("(.)\\1+", "\\1+", x) + x <- gsub("e+", "e+", x, perl = TRUE) + x <- gsub("o+", "o+", x, perl = TRUE) + x <- gsub("(.)\\1+", "\\1+", x, perl = TRUE) # allow multiplication of all other consonants - x <- gsub("([bdgjlnrw]+)", "\\1+", x) + x <- gsub("([bdgjlnrw]+)", "\\1+", x, perl = TRUE) # allow ending in -en or -us x <- gsub("e\\+n(?![a-z[])", "(e+n|u+(c|k|q|qu|s|z|x|ks)+)", x, perl = TRUE) # if the input is longer than 10 characters, allow any forgotten consonant between all characters, as some might just have forgotten one... @@ -571,12 +571,12 @@ exec_as.mo <- function(x, x_trimmed <- x x_trimmed_species <- paste(x_trimmed, "species") - x_trimmed_without_group <- gsub(" gro.u.p$", "", x_trimmed) + x_trimmed_without_group <- gsub(" gro.u.p$", "", x_trimmed, perl = TRUE) # remove last part from "-" or "/" x_trimmed_without_group <- gsub("(.*)[-/].*", "\\1", x_trimmed_without_group) # replace space and dot by regex sign - x_withspaces <- gsub("[ .]+", ".* ", x) - x <- gsub("[ .]+", ".*", x) + x_withspaces <- gsub("[ .]+", ".* ", x, perl = TRUE) + x <- gsub("[ .]+", ".*", x, perl = TRUE) # add start en stop regex x <- paste0("^", x, "$") @@ -616,7 +616,7 @@ exec_as.mo <- function(x, } # valid fullname ---- - found <- lookup(fullname_lower %in% gsub("[^a-zA-Z0-9_. -]", "", tolower(c(x_backup[i], x_backup_without_spp[i])))) + found <- lookup(fullname_lower %in% gsub("[^a-zA-Z0-9_. -]", "", tolower(c(x_backup[i], x_backup_without_spp[i])), perl = TRUE)) # added the gsub() for "(unknown fungus)", since fullname_lower does not contain brackets if (!is.na(found)) { x[i] <- found[1L] @@ -670,7 +670,7 @@ exec_as.mo <- function(x, # very probable: is G. species ---- found <- lookup(g_species %in% gsub("[^a-z0-9/ \\-]+", "", - tolower(c(x_backup[i], x_backup_without_spp[i])))) + tolower(c(x_backup[i], x_backup_without_spp[i])), perl = TRUE)) if (!is.na(found)) { x[i] <- found[1L] next @@ -1121,8 +1121,8 @@ exec_as.mo <- function(x, if (isTRUE(debug)) { cat(font_bold("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (4) strip values between brackets\n")) } - a.x_backup_stripped <- gsub("( *[(].*[)] *)", " ", a.x_backup) - a.x_backup_stripped <- trimws(gsub(" +", " ", a.x_backup_stripped)) + a.x_backup_stripped <- gsub("( *[(].*[)] *)", " ", a.x_backup, perl = TRUE) + a.x_backup_stripped <- trimws(gsub(" +", " ", a.x_backup_stripped, perl = TRUE)) if (isTRUE(debug)) { message("Running '", a.x_backup_stripped, "'") } @@ -1612,7 +1612,7 @@ format_uncertainty_as_df <- function(uncertainty_level, pillar_shaft.mo <- function(x, ...) { out <- format(x) # grey out the kingdom (part until first "_") - out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(font_subtle("\\1"), "\\2"), out[!is.na(x)]) + out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(font_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE) # and grey out every _ out[!is.na(x)] <- gsub("_", font_subtle("_"), out[!is.na(x)]) @@ -1747,6 +1747,15 @@ c.mo <- function(x, ...) { as.character(microorganisms.translation$mo_old))) } +#' @method unique mo +#' @export +#' @noRd +unique.mo <- function(x, incomparables = FALSE, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} + #' @rdname as.mo #' @export mo_failures <- function() { diff --git a/R/resistance_predict.R b/R/resistance_predict.R index 544aa765..3607f76d 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -294,7 +294,7 @@ rsi_predict <- resistance_predict #' @method plot resistance_predict #' @export -#' @importFrom graphics axis arrows points +#' @importFrom graphics plot axis arrows points #' @rdname resistance_predict plot.resistance_predict <- function(x, main = paste("Resistance Prediction of", x_name), ...) { x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") @@ -304,12 +304,7 @@ plot.resistance_predict <- function(x, main = paste("Resistance Prediction of", } else { ylab <- "%IR" } - # get plot() generic; this was moved from the 'graphics' pkg to the 'base' pkg in R 4.0.0 - if (as.integer(R.Version()$major) >= 4) { - plot <- import_fn("plot", "base") - } else { - plot <- import_fn("plot", "graphics") - } + plot(x = x$year, y = x$value, ylim = c(0, 1), diff --git a/R/rsi.R b/R/rsi.R index 67dc2ad8..827a46a1 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -19,7 +19,7 @@ # Visit our website for more info: https://msberends.github.io/AMR. # # ==================================================================== # -#' Interpret MIC and disk, or clean raw R/SI data +#' Interpret MIC and disk values, or clean raw R/SI data #' #' Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing R/SI values. This transforms the input to a new class [`rsi`], which is an ordered factor with levels `S < I < R`. Values that cannot be interpreted will be returned as `NA` with a warning. #' @inheritSection lifecycle Stable lifecycle @@ -339,6 +339,7 @@ as.rsi.mic <- function(x, ab_name(ab_coerced, tolower = TRUE), ")", mo_var_found, " according to ", font_bold(guideline_coerced), " ... ")), appendLF = FALSE) + result <- exec_as.rsi(method = "mic", x = x, mo = mo_coerced, @@ -482,7 +483,7 @@ as.rsi.data.frame <- function(x, ab <- colnames(x)[i] if (length(sel) == 0 || (length(sel) > 0 && ab %in% sel)) { ab_coerced <- suppressWarnings(as.ab(ab)) - if (is.na(ab_coerced) | !ab %in% sel) { + if (is.na(ab_coerced) || (length(sel) > 0 & !ab %in% sel)) { # not even a valid AB code return(FALSE) } else { @@ -494,7 +495,7 @@ as.rsi.data.frame <- function(x, message(font_blue(paste0("NOTE: Assuming column `", ab, "` (", ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""), ab_name(ab_coerced, tolower = TRUE), ") contains disk zones."))) - } else if (!is.rsi(y)) { + } else if (!check & !is.rsi(y)) { message(font_blue(paste0("NOTE: Assuming column `", ab, "` (", ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""), ab_name(ab_coerced, tolower = TRUE), ") must be cleaned to valid R/SI values."))) @@ -581,11 +582,20 @@ exec_as.rsi <- function(method, warned <- FALSE method_param <- toupper(method) - mo_genus <- as.mo(mo_genus(mo)) + genera <- mo_genus(mo) + mo_genus <- as.mo(genera) mo_family <- as.mo(mo_family(mo)) mo_order <- as.mo(mo_order(mo)) - mo_becker <- as.mo(mo, Becker = TRUE) - mo_lancefield <- as.mo(mo, Lancefield = TRUE) + if (any(genera == "Staphylococcus", na.rm = TRUE)) { + mo_becker <- as.mo(mo, Becker = TRUE) + } else { + mo_becker <- mo + } + if (any(genera == "Streptococcus", na.rm = TRUE)) { + mo_lancefield <- as.mo(mo, Lancefield = TRUE) + } else { + mo_lancefield <- mo + } mo_other <- as.mo(rep("UNKNOWN", length(mo))) guideline_coerced <- get_guideline(guideline) @@ -781,7 +791,7 @@ summary.rsi <- function(object, ...) { #' @method plot rsi #' @export -#' @importFrom graphics text axis +#' @importFrom graphics plot text axis #' @rdname plot plot.rsi <- function(x, lwd = 2, @@ -810,12 +820,6 @@ plot.rsi <- function(x, ymax <- pm_if_else(max(data$s) > 95, 105, 100) - # get plot() generic; this was moved from the 'graphics' pkg to the 'base' pkg in R 4.0.0 - if (as.integer(R.Version()$major) >= 4) { - plot <- import_fn("plot", "base") - } else { - plot <- import_fn("plot", "graphics") - } plot(x = data$x, y = data$s, lwd = lwd, @@ -896,3 +900,12 @@ c.rsi <- function(x, ...) { x <- as.character(x) as.rsi(c(x, y)) } + +#' @method unique rsi +#' @export +#' @noRd +unique.rsi <- function(x, incomparables = FALSE, ...) { + y <- NextMethod() + attributes(y) <- attributes(x) + y +} diff --git a/R/sysdata.rda b/R/sysdata.rda index fc2a8cfc..7422746d 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/zzz.R b/R/zzz.R index 8f25e441..d84b201e 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -90,10 +90,10 @@ create_MO_lookup <- function() { MO_lookup$subspecies))) ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname) MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname"]) - MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower)) + MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE)) # add a column with only "e coli" like combinations - MO_lookup$g_species <- gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO_lookup$fullname_lower) + MO_lookup$g_species <- gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO_lookup$fullname_lower, perl = TRUE) # so arrange data on prevalence first, then kingdom, then full name MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower), ] diff --git a/data-raw/eucast_rules.tsv b/data-raw/eucast_rules.tsv index e1e84d40..9ab899f1 100644 --- a/data-raw/eucast_rules.tsv +++ b/data-raw/eucast_rules.tsv @@ -1,13 +1,13 @@ # ------------------------------------------------------------------------------------------------------------------------------- # For editing this EUCAST reference file, these values can all be used for targeting antibiotics: -# 'all_betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_except_CAZ', -# 'fluoroquinolones', 'glycopeptides', 'lincosamides', 'lipoglycopeptides', 'macrolides', 'oxazolidinones', 'polymyxins', 'streptogramins', 'tetracyclines', 'ureidopenicillins', +# 'all_betalactams', 'aminoglycosides', 'aminopenicillins', 'carbapenems', 'cephalosporins', 'cephalosporins_1st', 'cephalosporins_2nd', 'cephalosporins_except_CAZ', +# 'fluoroquinolones', 'glycopeptides', 'lincosamides', 'lipoglycopeptides', 'macrolides', 'oxazolidinones', 'polymyxins', 'streptogramins', 'tetracyclines', 'ureidopenicillins', # and all separate EARS-Net letter codes like 'AMC'. They can be separated by comma: 'AMC, fluoroquinolones'. # The 'if_mo_property' column can be any column name from the AMR::microorganisms data set, or "genus_species" or "gramstain". # The like.is.one_of column must be 'like' or 'is' or 'one_of' ('like' will read the 'this_value' column as regular expression) # The EUCAST guideline contains references to the 'Burkholderia cepacia complex'. All species in this group are noted on the 'B.cepacia' sheet of the EUCAST Clinical Breakpoint v.10.0 Excel file of 2020 (v_10.0_Breakpoint_Tables.xlsx). # >>>>> IF YOU WANT TO IMPORT THIS FILE INTO YOUR OWN SOFTWARE, HAVE THE FIRST 10 LINES SKIPPED <<<<< -# ------------------------------------------------------------------------------------------------------------------------------- +# ------------------------------------------------------------------------------------------------------------------------------- if_mo_property like.is.one_of this_value and_these_antibiotics have_these_values then_change_these_antibiotics to_value reference.rule reference.rule_group reference.version note order is Enterobacterales AMP S AMX S Enterobacterales (Order) Breakpoints 10 order is Enterobacterales AMP I AMX I Enterobacterales (Order) Breakpoints 10 @@ -216,20 +216,19 @@ genus_species is Aeromonas dhakensis aminopenicillins, AMC, SAM, FOX R Table 1 genus_species is Aeromonas caviae aminopenicillins, AMC, SAM, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus_species is Aeromonas jandaei aminopenicillins, AMC, SAM, TIC, CZO, CEP, LEX, CFR, FOX R Table 1: Intrinsic resistance in Enterobacterales and Aeromonas spp. Expert Rules 3.2 genus one_of Achromobacter, Acinetobacter, Alcaligenes, Bordetella, Burkholderia, Elizabethkingia, Flavobacterium, Ochrobactrum, Pseudomonas, Stenotrophomonas PEN, cephalosporins_1st, cephalosporins_2nd, glycopeptides, lipoglycopeptides, FUS, macrolides, lincosamides, streptogramins, RIF, oxazolidinones R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -fullname like ^Acinetobacter (baumannii|pittii|nosocomialis) aminopenicillins, AMC, CRO, CTX, ATM, ETP, TMP, FOS, DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -genus is Acinetobacter DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -genus_species is Achromobacter xylosoxidans aminopenicillins, CRO, CTX, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -fullname like ^Burkholderia (ambifaria|anthina|arboris|cepacia|cenocepacia|contaminans|diffusa|dolosa|lata|latens|metallica|multivorans|paludis|pseudomultivorans|pyrrocinia|pseudomultivorans|seminalis|stabilis|stagnalis|territorii|ubonensis|vietnamiensis) aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CRO, CTX, ATM, ETP, CIP, CHL, aminoglycosides, TMP, FOS, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -genus_species is Elizabethkingia meningoseptica aminopenicillins, AMC, SAM, TIC, TCC, PIP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP, IPM, MEM, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -genus_species is Ochrobactrum anthropi aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, SAM, CTX, CRO, ETP, CHL, TMP, tetracyclines, TGC R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, SAM, TIC, PIP, TZP, CRO, CTX, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, DOX, TCY, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 -genus one_of Haemophilus, Moraxella, Neisseria, Campylobacter glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -genus_species is Haemophilus influenzae FUS, streptogramins R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -genus_species is Moraxella catarrhalis TMP R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -genus is Neisseria TMP R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -genus_species is Campylobacter fetus FUS, streptogramins, TMP, NAL R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 -fullname like ^Campylobacter (jejuni|coli) FUS, streptogramins, TMP R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +fullname like ^Acinetobacter (baumannii|pittii|nosocomialis) aminopenicillins, AMC, CRO, CTX, ATM, ETP, TMP, FOS, DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus is Acinetobacter DOX, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus_species is Achromobacter xylosoxidans aminopenicillins, CRO, CTX, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +fullname like ^Burkholderia (ambifaria|anthina|arboris|cepacia|cenocepacia|contaminans|diffusa|dolosa|lata|latens|metallica|multivorans|paludis|pseudomultivorans|pyrrocinia|pseudomultivorans|seminalis|stabilis|stagnalis|territorii|ubonensis|vietnamiensis) aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CRO, CTX, ATM, ETP, CIP, CHL, aminoglycosides, TMP, FOS, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus_species is Elizabethkingia meningoseptica aminopenicillins, AMC, SAM, TIC, TCC, PIP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP, IPM, MEM, polymyxins R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus_species is Ochrobactrum anthropi aminopenicillins, AMC, SAM, TIC, TCC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, SAM, CTX, CRO, ETP, CHL, KAN, NEO, TMP, tetracyclines, TGC R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, SAM, TIC, PIP, TZP, CRO, CTX, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, TCY R Table 2: Intrinsic resistance in non-fermentative gram-negative bacteria Expert Rules 3.2 Additional rules from header added in separate rule (genus is one of…) +genus_species is Haemophilus influenzae FUS, streptogramins, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +genus_species is Moraxella catarrhalis TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +genus is Neisseria TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +genus_species is Campylobacter fetus FUS, streptogramins, TMP, NAL, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 +fullname like ^Campylobacter (jejuni|coli) FUS, streptogramins, TMP, glycopeptides, lipoglycopeptides, lincosamides, oxazolidinones R Table 3: Intrinsic resistance in other gram-negative bacteria Expert Rules 3.2 gramstain is Gram-positive ATM, TEM, polymyxins, NAL R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2 genus_species is Staphylococcus saprophyticus FUS, CAZ, FOS, NOV R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2 genus_species is Staphylococcus cohnii CAZ, NOV R Table 4: Intrinsic resistance in gram-positive bacteria Expert Rules 3.2 @@ -263,6 +262,7 @@ genus one_of Arsenophonus, Biostraticola, Brenneria, Buchnera, Budvicia, Buttiau fullname like ^(Serratia|Providencia|Morganella morganii) TGC R Expert Rules on Enterobacterales Expert Rules 3.2 genus is Salmonella cephalosporins_2nd R Expert Rules on Salmonella Expert Rules 3.2 genus is Salmonella aminoglycosides R Expert Rules on Salmonella Expert Rules 3.2 +genus is Salmonella PEF R CIP R Expert Rules on Salmonella Expert Rules 3.2 genus_species is Staphylococcus aureus FOX1 R all_betalactams R Expert Rules on Staphylococcus Expert Rules 3.2 genus_species is Staphylococcus aureus FOX1 S all_betalactams S Expert Rules on Staphylococcus Expert Rules 3.2 genus_species one_of Staphylococcus aureus, Staphylococcus lugdunensis PEN R AMP, AMX, AZL, BAM, CRB, CRN, EPC, HET, MEC, MEZ, MTM, PIP, PME, PVM, SBC, TAL, TEM, TIC R Expert Rules on Staphylococcus Expert Rules 3.2 all penicillins without beta-lactamse inhibitor @@ -278,6 +278,7 @@ fullname like ^Enterococcus (faecalis|faecium) AMP R ureidopenicillins, IPM R Ex fullname like ^Enterococcus (faecalis|faecium) AMX R ureidopenicillins, IPM R Expert Rules on Enterococcus Expert Rules 3.2 genus is Enterococcus NOR S CIP, LVX S Expert Rules on Enterococcus Expert Rules 3.2 genus is Enterococcus VAN S lipoglycopeptides S Expert Rules on Enterococcus Expert Rules 3.2 +genus_species is Enterococcus faecium CLI R Expert Rules on Enterococcus Expert Rules 3.2 genus_species one_of Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G PEN S aminopenicillins, cephalosporins, carbapenems S Expert Rules on Streptococcus A, B, C and G Expert Rules 3.2 genus_species one_of Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G NOR S LVX, MFX S Expert Rules on Streptococcus A, B, C and G Expert Rules 3.2 genus_species one_of Streptococcus group A, Streptococcus group B, Streptococcus group C, Streptococcus group G NOR R LVX, MFX R Expert Rules on Streptococcus A, B, C and G Expert Rules 3.2 diff --git a/docs/404.html b/docs/404.html index 29394d05..8c45c889 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index c79279f3..36af7ed3 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029 diff --git a/docs/articles/index.html b/docs/articles/index.html index 3b74aec8..6dac5bb3 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029 diff --git a/docs/authors.html b/docs/authors.html index 11bf5502..31538a70 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029 diff --git a/docs/index.html b/docs/index.html index 606b6bd3..93ac465b 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029 diff --git a/docs/news/index.html b/docs/news/index.html index 25cbdcc2..d6d9958e 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029 @@ -236,13 +236,13 @@ Source: NEWS.md -
-

-AMR 1.3.0.9028 Unreleased +
+

+AMR 1.3.0.9029 Unreleased

-
+

-Last updated: 24 September 2020 +Last updated: 25 September 2020

Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly!

@@ -329,6 +329,7 @@
  • The group name (antibiotics$group) of ‘Linezolid’ (LNZ), ‘Cycloserine’ (CYC), ‘Tedizolid’ (TZD) and ‘Thiacetazone’ (THA) is now “Oxazolidinones” instead of “Other antibacterials”
    • +

  • Added support for using unique() on classes <rsi>, <mic>, <disk>, <ab> and <mo>

    • @@ -437,7 +438,7 @@

    Making this package independent of especially the tidyverse (e.g. packages dplyr and tidyr) tremendously increases sustainability on the long term, since tidyverse functions change quite often. Good for users, but hard for package maintainers. Most of our functions are replaced with versions that only rely on base R, which keeps this package fully functional for many years to come, without requiring a lot of maintenance to keep up with other packages anymore. Another upside it that this package can now be used with all versions of R since R-3.0.0 (April 2013). Our package is being used in settings where the resources are very limited. Fewer dependencies on newer software is helpful for such settings.

    Negative effects of this change are:

      -
    • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
      • +
    • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
    • Printing values of class mo or rsi in a tibble will no longer be in colour and printing rsi in a tibble will show the class <ord>, not <rsi> anymore. This is purely a visual effect.
    • All functions from the mo_* family (like mo_name() and mo_gramstain()) are noticeably slower when running on hundreds of thousands of rows.
    • For developers: classes mo and ab now both also inherit class character, to support any data transformation. This change invalidates code that checks for class length == 1.
      • @@ -774,7 +775,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

    This is important, because a value like "testvalue" could never be understood by e.g. mo_name(), although the class would suggest a valid microbial code.

    -

  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

    • +

  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

  • Renamed data set septic_patients to example_isolates

    • @@ -1043,7 +1044,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • The age() function gained a new parameter exact to determine ages with decimals
  • Removed deprecated functions guess_mo(), guess_atc(), EUCAST_rules(), interpretive_reading(), rsi()
    • -
  • Frequency tables (freq()): +
  • Frequency tables (freq()):

    • speed improvement for microbial IDs

    • fixed factor level names for R Markdown

      • @@ -1052,12 +1053,12 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

      support for boxplots:

       septic_patients %>% 
-  freq(age) %>% 
+  freq(age) %>% 
   boxplot()
 # grouped boxplots:
 septic_patients %>% 
   group_by(hospital_id) %>% 
-  freq(age) %>%
+  freq(age) %>%
   boxplot()
      @@ -1068,7 +1069,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • Added ceftazidim intrinsic resistance to Streptococci
    • Changed default settings for age_groups(), to let groups of fives and tens end with 100+ instead of 120+
      • -
    • Fix for freq() for when all values are NA +
    • Fix for freq() for when all values are NA
    • Fix for first_isolate() for when dates are missing
    • Improved speed of guess_ab_col() @@ -1309,7 +1310,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • -
  • Frequency tables (freq() function): +
  • Frequency tables (freq() function):

    • Support for tidyverse quasiquotation! Now you can create frequency tables of function outcomes:

      @@ -1318,15 +1319,15 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/ # OLD WAY septic_patients %>% mutate(genus = mo_genus(mo)) %>% - freq(genus) + freq(genus) # NEW WAY septic_patients %>% - freq(mo_genus(mo)) + freq(mo_genus(mo)) # Even supports grouping variables: septic_patients %>% group_by(gender) %>% - freq(mo_genus(mo)) + freq(mo_genus(mo))

  • Header info is now available as a list, with the header function

    • @@ -1410,21 +1411,21 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

  • Using portion_* functions now throws a warning when total available isolate is below parameter minimum

  • Functions as.mo, as.rsi, as.mic, as.atc and freq will not set package name as attribute anymore

  • -

    Frequency tables - freq():

    +

    Frequency tables - freq():

    • Support for grouping variables, test with:

       septic_patients %>% 
   group_by(hospital_id) %>% 
-  freq(gender)
+  freq(gender)

    • Support for (un)selecting columns:

       septic_patients %>% 
-  freq(hospital_id) %>% 
+  freq(hospital_id) %>% 
   select(-count, -cum_count) # only get item, percent, cum_percent
      • @@ -1443,7 +1444,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

    • Removed diacritics from all authors (columns microorganisms$ref and microorganisms.old$ref) to comply with CRAN policy to only allow ASCII characters

    • Fix for mo_property not working properly

    • Fix for eucast_rules where some Streptococci would become ceftazidime R in EUCAST rule 4.5

      • -

    • Support for named vectors of class mo, useful for top_freq()

      • +

    • Support for named vectors of class mo, useful for top_freq()

    • ggplot_rsi and scale_y_percent have breaks parameter

    • AI improvements for as.mo:

      @@ -1610,13 +1611,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

      Support for types (classes) list and matrix for freq

       my_matrix = with(septic_patients, matrix(c(age, gender), ncol = 2))
-freq(my_matrix)
+freq(my_matrix)

      For lists, subsetting is possible:

       my_list = list(age = septic_patients$age, gender = septic_patients$gender)
-my_list %>% freq(age)
-my_list %>% freq(gender)
+my_list %>% freq(age)
+my_list %>% freq(gender)
    @@ -1691,13 +1692,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • A vignette to explain its usage
    • Support for rsi (antimicrobial resistance) to use as input
      • -
    • Support for table to use as input: freq(table(x, y)) +
    • Support for table to use as input: freq(table(x, y))
    • Support for existing functions hist and plot to use a frequency table as input: hist(freq(df$age))
    • Support for as.vector, as.data.frame, as_tibble and format
      • -
    • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn) +
    • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn)
    • Function top_freq function to return the top/below n items as vector
    • Header of frequency tables now also show Mean Absolute Deviaton (MAD) and Interquartile Range (IQR)
      • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index c5df8645..fd39eafb 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -2,7 +2,7 @@ pandoc: 2.7.3 pkgdown: 1.5.1.9000 pkgdown_sha: eae56f08694abebf93cdfc0dd8e9ede06d8c815f articles: [] -last_built: 2020-09-24T10:36Z +last_built: 2020-09-25T12:44Z urls: reference: https://msberends.github.io/AMR/reference article: https://msberends.github.io/AMR/articles diff --git a/docs/reference/as.rsi.html b/docs/reference/as.rsi.html index 0453a8a5..dcedcd51 100644 --- a/docs/reference/as.rsi.html +++ b/docs/reference/as.rsi.html @@ -6,7 +6,7 @@ -Interpret MIC and disk, or clean raw R/SI data — as.rsi • AMR (for R) +Interpret MIC and disk values, or clean raw R/SI data — as.rsi • AMR (for R) @@ -48,7 +48,7 @@ - + @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029
    • @@ -233,7 +233,7 @@
    -

    Interpret MIC and disk, or clean raw R/SI data

    +

    Interpret MIC and disk values, or clean raw R/SI data

    Source: R/rsi.R
    diff --git a/docs/reference/index.html b/docs/reference/index.html index 39a88a1b..406eb19b 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029
    @@ -425,7 +425,7 @@

    as.rsi() is.rsi() is.rsi.eligible()

    -

    Interpret MIC and disk, or clean raw R/SI data

    +

    Interpret MIC and disk values, or clean raw R/SI data

    diff --git a/docs/survey.html b/docs/survey.html index 75c96f3a..315ad96f 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9028 + 1.3.0.9029
    diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index bf8cc511..56b25ff1 100755 --- a/man/as.rsi.Rd +++ b/man/as.rsi.Rd @@ -8,7 +8,7 @@ \alias{as.rsi.mic} \alias{as.rsi.disk} \alias{as.rsi.data.frame} -\title{Interpret MIC and disk, or clean raw R/SI data} +\title{Interpret MIC and disk values, or clean raw R/SI data} \usage{ as.rsi(x, ...) diff --git a/tests/testthat.R b/tests/testthat.R index a1bf3735..0d7a21b4 100755 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -19,7 +19,7 @@ # Visit our website for more info: https://msberends.github.io/AMR. # # ==================================================================== # -library(testthat) +library(testthat, warn.conflicts = FALSE) library(AMR) test_check("AMR") diff --git a/tests/testthat/test-ab.R b/tests/testthat/test-ab.R index 9549e40c..3fda6fd4 100755 --- a/tests/testthat/test-ab.R +++ b/tests/testthat/test-ab.R @@ -67,6 +67,7 @@ test_that("as.ab works", { expect_s3_class(x[1], "ab") expect_s3_class(x[[1]], "ab") expect_s3_class(c(x[1], x[9]), "ab") + expect_s3_class(unique(x[1], x[9]), "ab") expect_warning(x[1] <- "invalid code") expect_warning(x[[1]] <- "invalid code") expect_warning(c(x[1], "test")) diff --git a/tests/testthat/test-disk.R b/tests/testthat/test-disk.R index 48246e23..218b383c 100755 --- a/tests/testthat/test-disk.R +++ b/tests/testthat/test-disk.R @@ -29,8 +29,11 @@ test_that("disk works", { expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA) # all levels should be valid disks - expect_silent(as.disk(levels(as.disk(15)))) - + x <- as.disk(c(20, 40)) + expect_s3_class(x[1], "disk") + expect_s3_class(x[[1]], "disk") + expect_s3_class(c(x[1], x[9]), "disk") + expect_s3_class(unique(x[1], x[9]), "disk") expect_warning(as.disk("INVALID VALUE")) expect_output(print(as.disk(12))) diff --git a/tests/testthat/test-ggplot_rsi.R b/tests/testthat/test-ggplot_rsi.R index 6214098d..4468bf61 100644 --- a/tests/testthat/test-ggplot_rsi.R +++ b/tests/testthat/test-ggplot_rsi.R @@ -29,6 +29,8 @@ test_that("ggplot_rsi works", { library(dplyr) library(ggplot2) + + pdf(NULL) # prevent Rplots.pdf being created # data should be equal expect_equal( diff --git a/tests/testthat/test-import_fn.R b/tests/testthat/test-import_fn.R index ce1fed33..0d6205f7 100644 --- a/tests/testthat/test-import_fn.R +++ b/tests/testthat/test-import_fn.R @@ -19,6 +19,8 @@ # Visit our website for more info: https://msberends.github.io/AMR. # # ==================================================================== # +context("import_fn.R") + test_that("imports work", { skip_on_cran() diff --git a/tests/testthat/test-mic.R b/tests/testthat/test-mic.R index 43764471..0c49b42f 100755 --- a/tests/testthat/test-mic.R +++ b/tests/testthat/test-mic.R @@ -34,8 +34,11 @@ test_that("mic works", { expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA) # all levels should be valid MICs - expect_silent(as.mic(levels(as.mic(1)))) - + x <- as.mic(c(2, 4)) + expect_s3_class(x[1], "mic") + expect_s3_class(x[[1]], "mic") + expect_s3_class(c(x[1], x[9]), "mic") + expect_s3_class(unique(x[1], x[9]), "mic") expect_warning(as.mic("INVALID VALUE")) pdf(NULL) # prevent Rplots.pdf being created diff --git a/tests/testthat/test-pca.R b/tests/testthat/test-pca.R index 615ea0d1..acfd5919 100644 --- a/tests/testthat/test-pca.R +++ b/tests/testthat/test-pca.R @@ -44,6 +44,8 @@ test_that("PCA works", { expect_s3_class(pca_model, "pca") + pdf(NULL) # prevent Rplots.pdf being created + ggplot_pca(pca_model, ellipse = TRUE) ggplot_pca(pca_model, arrows_textangled = FALSE) }) diff --git a/tests/testthat/test-rsi.R b/tests/testthat/test-rsi.R index b13d41bf..4f3676f8 100644 --- a/tests/testthat/test-rsi.R +++ b/tests/testthat/test-rsi.R @@ -28,6 +28,13 @@ test_that("rsi works", { expect_true(as.rsi("I") < as.rsi("R")) expect_true(is.rsi(as.rsi("S"))) + + x <- example_isolates$AMX + expect_s3_class(x[1], "rsi") + expect_s3_class(x[[1]], "rsi") + expect_s3_class(c(x[1], x[9]), "rsi") + expect_s3_class(unique(x[1], x[9]), "rsi") + pdf(NULL) # prevent Rplots.pdf being created expect_silent(barplot(as.rsi(c("S", "I", "R")))) expect_silent(plot(as.rsi(c("S", "I", "R"))))