diff --git a/DESCRIPTION b/DESCRIPTION index 73cbbb97..61c28a03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.8.0.9001 -Date: 2019-10-21 +Version: 0.8.0.9002 +Date: 2019-10-23 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 8877fa55..4a2e3d4a 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,11 @@ -# AMR 0.8.0.9001 -Last updated: 21-Oct-2019 - -### New +# AMR 0.8.0.9002 +Last updated: 23-Oct-2019 ### Changes -* When running `as.rsi()` over a data set, it will now print the guideline that will be used - +* When running `as.rsi()` over a data set, it will now print the guideline that will be used if it is not specified by the user +* Fix for `eucast_rules()`: *Stenotrophomonas maltophilia* not interpreted "R" to ceftazidime anymore (following EUCAST v3.1) +* Fix in taxonomic info for genera that are in multiple kingdoms, like *Proteus* +* Fix for interpreting MIC values with `as.rsi()` where the input is `NA` # AMR 0.8.0 diff --git a/R/mo.R b/R/mo.R index cc6e9427..5ee429ce 100755 --- a/R/mo.R +++ b/R/mo.R @@ -240,8 +240,8 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE, left_join(microorganismsDT, by = "fullname_lower") %>% pull(mo) - # save them to history - set_mo_history(x, y, 0, force = isTRUE(list(...)$force_mo_history), disable = isTRUE(list(...)$disable_mo_history)) + # don't save valid fullnames to history (i.e. values that are in microorganisms$fullname) + # set_mo_history(x, y, 0, force = isTRUE(list(...)$force_mo_history), disable = isTRUE(list(...)$disable_mo_history)) } else { # will be checked for mo class in validation and uses exec_as.mo internally if necessary @@ -482,6 +482,7 @@ exec_as.mo <- function(x, trimmed } + x_backup_untouched <- x x <- strip_whitespace(x, dyslexia_mode) x_backup <- x @@ -618,13 +619,24 @@ exec_as.mo <- function(x, next } } + + if (toupper(x_backup_untouched[i]) %in% microorganisms.codes$code) { + # is a WHONET code, like "HA-" + found <- microorganismsDT[mo == microorganisms.codes[which(microorganisms.codes$code == toupper(x_backup_untouched[i])), "mo"][1L], ..property][[1]] + if (length(found) > 0) { + x[i] <- found[1L] + # don't save to history, as all items are already in microorganisms.codes + next + } + } found <- reference_data_to_use[fullname_lower %in% tolower(c(x_backup[i], x_backup_without_spp[i])), ..property][[1]] # most probable: is exact match in fullname if (length(found) > 0) { x[i] <- found[1L] if (initial_search == TRUE) { - set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history) + # don't save valid fullnames to history (i.e. values that are in microorganisms$fullname) + # set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history) } next } @@ -1759,7 +1771,7 @@ pillar_shaft.mo <- function(x, ...) { out[is.na(x)] <- pillar::style_na(" NA") out[x == "UNKNOWN"] <- pillar::style_na(" UNKNOWN") - pillar::new_pillar_shaft_simple(out, align = "left", min_width = 12) + pillar::new_pillar_shaft_simple(out, align = "left", width = max(nchar(x))) } #' @exportMethod summary.mo diff --git a/R/rsi.R b/R/rsi.R index 39a5e93c..b50bf01d 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -102,10 +102,10 @@ as.rsi.default <- function(x, ...) { } else if (identical(levels(x), c("S", "I", "R"))) { structure(x, class = c("rsi", "ordered", "factor")) } else { - + x <- x %>% unlist() x.bak <- x - + na_before <- x[is.na(x) | x == ""] %>% length() # remove all spaces x <- gsub(" +", "", x) @@ -179,81 +179,6 @@ as.rsi.disk <- function(x, mo, ab, guideline = "EUCAST", ...) { guideline = guideline) } -exec_as.rsi <- function(method, x, mo, ab, guideline) { - if (method == "mic") { - x <- as.mic(x) # when as.rsi.mic is called directly - } else if (method == "disk") { - x <- as.disk(x) # when as.rsi.disk is called directly - } - - mo <- as.mo(mo) - ab <- as.ab(ab) - - mo_genus <- as.mo(mo_genus(mo)) - 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) - - guideline_param <- toupper(guideline) - if (guideline_param %in% c("CLSI", "EUCAST")) { - guideline_param <- AMR::rsi_translation %>% - filter(guideline %like% guideline_param) %>% - pull(guideline) %>% - sort() %>% - rev() %>% - .[1] - } - - if (!guideline_param %in% AMR::rsi_translation$guideline) { - stop(paste0("invalid guideline: '", guideline, - "'.\nValid guidelines are: ", paste0("'", rev(sort(unique(AMR::rsi_translation$guideline))), "'", collapse = ", ")), - call. = FALSE) - } - - new_rsi <- rep(NA_character_, length(x)) - trans <- AMR::rsi_translation %>% - filter(guideline == guideline_param) %>% - mutate(lookup = paste(mo, ab)) - - lookup_mo <- paste(mo, ab) - lookup_genus <- paste(mo_genus, ab) - lookup_family <- paste(mo_family, ab) - lookup_order <- paste(mo_order, ab) - lookup_becker <- paste(mo_becker, ab) - lookup_lancefield <- paste(mo_lancefield, ab) - - for (i in seq_len(length(x))) { - get_record <- trans %>% - filter(lookup %in% c(lookup_mo[i], - lookup_genus[i], - lookup_family[i], - lookup_order[i], - lookup_becker[i], - lookup_lancefield[i])) %>% - # be as specific as possible (i.e. prefer species over genus): - arrange(desc(nchar(mo))) %>% - .[1L, ] - - if (NROW(get_record) > 0) { - if (method == "mic") { - new_rsi[i] <- case_when(isTRUE(x[i] <= get_record$S_mic) ~ "S", - isTRUE(x[i] >= get_record$R_mic) ~ "R", - !is.na(get_record$S_mic) & !is.na(get_record$R_mic) ~ "I", - TRUE ~ NA_character_) - } else if (method == "disk") { - new_rsi[i] <- case_when(isTRUE(x[i] >= get_record$S_disk) ~ "S", - isTRUE(x[i] <= get_record$R_disk) ~ "R", - !is.na(get_record$S_disk) & !is.na(get_record$R_disk) ~ "I", - TRUE ~ NA_character_) - } - - } - } - structure(.Data = factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE), - class = c("rsi", "ordered", "factor")) -} - get_guideline <- function(guideline) { guideline_param <- toupper(guideline) if (guideline_param %in% c("CLSI", "EUCAST")) { @@ -274,17 +199,84 @@ get_guideline <- function(guideline) { guideline_param } +exec_as.rsi <- function(method, x, mo, ab, guideline) { + if (method == "mic") { + x <- as.double(as.mic(x)) # when as.rsi.mic is called directly + method_param <- "MIC" + } else if (method == "disk") { + x <- as.double(as.disk(x)) # when as.rsi.disk is called directly + method_param <- "DISK" + } + + mo <- as.mo(mo) + ab <- as.ab(ab) + + mo_genus <- as.mo(mo_genus(mo)) + 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) + + guideline_coerced <- get_guideline(guideline) + if (guideline_coerced != guideline) { + message(blue(paste0("Note: Using guideline ", bold(guideline_coerced), " as input for `guideline`."))) + } + + new_rsi <- rep(NA_character_, length(x)) + trans <- AMR::rsi_translation %>% + filter(guideline == guideline_coerced & method == method_param) %>% + mutate(lookup = paste(mo, ab)) + + lookup_mo <- paste(mo, ab) + lookup_genus <- paste(mo_genus, ab) + lookup_family <- paste(mo_family, ab) + lookup_order <- paste(mo_order, ab) + lookup_becker <- paste(mo_becker, ab) + lookup_lancefield <- paste(mo_lancefield, ab) + + for (i in seq_len(length(x))) { + get_record <- trans %>% + filter(lookup %in% c(lookup_mo[i], + lookup_genus[i], + lookup_family[i], + lookup_order[i], + lookup_becker[i], + lookup_lancefield[i])) %>% + # be as specific as possible (i.e. prefer species over genus): + arrange(desc(nchar(mo))) %>% + .[1L, ] + + if (NROW(get_record) > 0) { + if (is.na(x[i])) { + new_rsi[i] <- NA_character_ + } else if (method == "mic") { + new_rsi[i] <- case_when(isTRUE(x[i] <= get_record$breakpoint_S) ~ "S", + isTRUE(x[i] >= get_record$breakpoint_R) ~ "R", + !is.na(get_record$breakpoint_S) & !is.na(get_record$breakpoint_R) ~ "I", + TRUE ~ NA_character_) + } else if (method == "disk") { + new_rsi[i] <- case_when(isTRUE(x[i] >= get_record$breakpoint_S) ~ "S", + isTRUE(x[i] <= get_record$breakpoint_R) ~ "R", + !is.na(get_record$breakpoint_S) & !is.na(get_record$breakpoint_R) ~ "I", + TRUE ~ NA_character_) + } + } + } + structure(.Data = factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE), + class = c("rsi", "ordered", "factor")) +} + #' @rdname as.rsi #' @importFrom crayon red blue bold #' @export as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", ...) { x <- x - + ab_cols <- colnames(x)[sapply(x, function(y) is.mic(y) | is.disk(y))] if (length(ab_cols) == 0) { stop("No columns with MIC values or disk zones found in this data set. Use as.mic or as.disk to transform antimicrobial columns.", call. = FALSE) } - + # try to find columns based on type # -- mo if (is.null(col_mo)) { @@ -294,23 +286,29 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", ...) { stop("`col_mo` must be set.", call. = FALSE) } - guideline <- get_guideline(guideline) - message(blue("Interpreting using guideline", bold(guideline))) - + guideline_coerced <- get_guideline(guideline) + if (guideline_coerced != guideline) { + message(blue(paste0("Note: Using guideline ", bold(guideline_coerced), " as input for `guideline`."))) + } + # transform all MICs ab_cols <- colnames(x)[sapply(x, is.mic)] if (length(ab_cols) > 0) { for (i in seq_len(length(ab_cols))) { - if (is.na(suppressWarnings(as.ab(ab_cols[i])))) { + ab_col_coerced <- suppressWarnings(as.ab(ab_cols[i])) + if (is.na(ab_col_coerced)) { message(red(paste0("Unknown drug: `", bold(ab_cols[i]), "`. Rename this column to a drug name or code, and check the output with as.ab()."))) next } - message(blue(paste0("Interpreting column `", bold(ab_cols[i]), "` (", ab_name(ab_cols[i], tolower = TRUE), ")...")), appendLF = FALSE) + message(blue(paste0("Interpreting column `", bold(ab_cols[i]), "` (", + ifelse(ab_col_coerced != ab_cols[i], paste0(ab_col_coerced, ", "), ""), + ab_name(ab_col_coerced, tolower = TRUE), ")...")), + appendLF = FALSE) x[, ab_cols[i]] <- exec_as.rsi(method = "mic", - x = x %>% pull(ab_cols[i]), - mo = x %>% pull(col_mo), - ab = as.ab(ab_cols[i]), - guideline = guideline) + x = x %>% pull(ab_cols[i]), + mo = x %>% pull(col_mo), + ab = ab_col_coerced, + guideline = guideline_coerced) message(blue(" OK.")) } } @@ -318,20 +316,24 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", ...) { ab_cols <- colnames(x)[sapply(x, is.disk)] if (length(ab_cols) > 0) { for (i in seq_len(length(ab_cols))) { - if (is.na(suppressWarnings(as.ab(ab_cols[i])))) { + ab_col_coerced <- suppressWarnings(as.ab(ab_cols[i])) + if (is.na(ab_col_coerced)) { message(red(paste0("Unknown drug: `", bold(ab_cols[i]), "`. Rename this column to a drug name or code, and check the output with as.ab()."))) next } - message(blue(paste0("Interpreting column `", bold(ab_cols[i]), "` (", ab_name(ab_cols[i], tolower = TRUE), ")...")), appendLF = FALSE) + message(blue(paste0("Interpreting column `", bold(ab_cols[i]), "` (", + ifelse(ab_col_coerced != ab_cols[i], paste0(ab_col_coerced, ", "), ""), + ab_name(ab_col_coerced, tolower = TRUE), ")...")), + appendLF = FALSE) x[, ab_cols[i]] <- exec_as.rsi(method = "disk", - x = x %>% pull(ab_cols[i]), - mo = x %>% pull(col_mo), - ab = as.ab(ab_cols[i]), - guideline = guideline) + x = x %>% pull(ab_cols[i]), + mo = x %>% pull(col_mo), + ab = ab_col_coerced, + guideline = guideline_coerced) message(blue(" OK.")) } } - + x } @@ -435,11 +437,11 @@ plot.rsi <- function(x, if (!"R" %in% data$x) { data <- rbind(data, data.frame(x = "R", n = 0, s = 0)) } - + data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE) - + ymax <- if_else(max(data$s) > 95, 105, 100) - + plot(x = data$x, y = data$s, lwd = lwd, @@ -453,7 +455,7 @@ plot.rsi <- function(x, axis(side = 1, at = 1:n_distinct(data$x), labels = levels(data$x), lwd = 0) # y axis, 0-100% axis(side = 2, at = seq(0, 100, 5)) - + text(x = data$x, y = data$s + 4, labels = paste0(data$s, "% (n = ", data$n, ")")) @@ -473,13 +475,13 @@ barplot.rsi <- function(height, beside = TRUE, axes = beside, ...) { - + if (axes == TRUE) { par(mar = c(5, 4, 4, 2) + 0.1) } else { par(mar = c(2, 4, 4, 2) + 0.1) } - + barplot(as.matrix(table(height)), col = col, xlab = xlab, @@ -502,13 +504,14 @@ type_sum.rsi <- function(x) { } #' @importFrom pillar pillar_shaft -#' @importFrom crayon bgGreen bgYellow bgRed white black +#' @importFrom crayon bgGreen bgYellow bgRed black make_style #' @export pillar_shaft.rsi <- function(x, ...) { out <- trimws(format(x)) out[is.na(x)] <- pillar::style_subtle(" NA") - out[x == "S"] <- bgGreen(white(" S ")) + real_white <- make_style(rgb(1, 1, 1)) + out[x == "S"] <- bgGreen(real_white(" S ")) out[x == "I"] <- bgYellow(black(" I ")) - out[x == "R"] <- bgRed(white(" R ")) - pillar::new_pillar_shaft_simple(out, align = "left", min_width = 3) + out[x == "R"] <- bgRed(real_white(" R ")) + pillar::new_pillar_shaft_simple(out, align = "left", width = 3) } diff --git a/R/sysdata.rda b/R/sysdata.rda index cbb2ef76..dba065b0 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/data-raw/eucast_rules.tsv b/data-raw/eucast_rules.tsv index 8904dc1d..4bf7db34 100644 --- a/data-raw/eucast_rules.tsv +++ b/data-raw/eucast_rules.tsv @@ -137,7 +137,7 @@ fullname like ^Burkholderia (cepacia|multivorans|cenocepacia|stabilis|vietnamien genus_species is Elizabethkingia meningoseptica aminopenicillins, AMC, TIC, CZO, CTX, CRO, CAZ, FEP, ATM, ETP, IPM, MEM, polymyxins R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules genus_species is Ochrobactrum anthropi aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, CAZ, FEP, ATM, ETP R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules genus_species is Pseudomonas aeruginosa aminopenicillins, AMC, CZO, CTX, CRO, ETP, CHL, KAN, NEO, TMP, SXT, tetracyclines, TGC R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules -genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, CAZ, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules +genus_species is Stenotrophomonas maltophilia aminopenicillins, AMC, TIC, PIP, TZP, CZO, CTX, CRO, ATM, ETP, IPM, MEM, aminoglycosides, TMP, FOS, TCY R Table 02: Intrinsic resistance in non-fermentative Gram-negative bacteria Expert Rules genus one_of Haemophilus, Moraxella, Neisseria, Campylobacter glycopeptides, LIN, DAP, LNZ R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules genus_species is Haemophilus influenzae FUS, streptogramins R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules genus_species is Moraxella catarrhalis TMP R Table 03: Intrinsic resistance in other Gram-negative bacteria Expert Rules diff --git a/data-raw/internals.R b/data-raw/internals.R index 2961c350..9ad2c2a8 100644 --- a/data-raw/internals.R +++ b/data-raw/internals.R @@ -1,13 +1,7 @@ -# --------------------------------------------------------------------------------------------------- -# For editing this EUCAST reference file, these values can all be used for target antibiotics: -# all_betalactams, aminoglycosides, carbapenems, cephalosporins, cephalosporins_without_CAZ, fluoroquinolones, -# glycopeptides, macrolides, minopenicillins, 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 EUCAST guideline contains references to the 'Burkholderia cepacia complex'. All species in this group can be found in: -# LiPuma J, Curr Opin Pulm Med. 2005 Nov;11(6):528-33. (PMID 16217180). -# >>>>> IF YOU WANT TO IMPORT THIS FILE INTO YOUR OWN SOFTWARE, HAVE THE FIRST 10 LINES SKIPPED <<<<< -# --------------------------------------------------------------------------------------------------- +# Run this file to update the package ------------------------------------- +# source("data-raw/internals.R") + +# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file eucast_rules_file <- dplyr::arrange( .data = utils::read.delim(file = "data-raw/eucast_rules.tsv", skip = 10, @@ -19,6 +13,7 @@ eucast_rules_file <- dplyr::arrange( reference.rule_group, reference.rule) + # Translations ---- translations_file <- utils::read.delim(file = "data-raw/translations.tsv", sep = "\t", diff --git a/data-raw/reproduction_of_microorganisms.R b/data-raw/reproduction_of_microorganisms.R index fa031096..ae244a78 100644 --- a/data-raw/reproduction_of_microorganisms.R +++ b/data-raw/reproduction_of_microorganisms.R @@ -70,7 +70,13 @@ data_dsmz <- data_dsmz %>% # DSMZ only contains genus/(sub)species, try to find taxonomic properties based on genus and data_col ref_taxonomy <- data_col %>% filter(genus %in% data_dsmz$genus, + kingdom %in% c("Bacteria", "Chromista", "Archaea", "Protozoa", "Fungi"), family != "") %>% + mutate(kingdom = factor(kingdom, + # in the left_join following, try Bacteria first, then Chromista, ... + levels = c("Bacteria", "Chromista", "Archaea", "Protozoa", "Fungi"), + ordered = TRUE)) %>% + arrange(kingdom) %>% distinct(genus, .keep_all = TRUE) %>% select(kingdom, phylum, class, order, family, genus) @@ -197,6 +203,7 @@ MOs <- MOs %>% MOs$ref[!grepl("^d[A-Z]", MOs$ref)] <- gsub("^([a-z])", "\\U\\1", MOs$ref[!grepl("^d[A-Z]", MOs$ref)], perl = TRUE) # specific one for the French that are named dOrbigny MOs$ref[grepl("^d[A-Z]", MOs$ref)] <- gsub("^d", "d'", MOs$ref[grepl("^d[A-Z]", MOs$ref)]) +MOs <- MOs %>% mutate(ref = gsub(" +", " ", ref)) # Remove non-ASCII characters (these are not allowed by CRAN) MOs <- MOs %>% @@ -275,9 +282,15 @@ MOs <- MOs %>% by = "kingdom_fullname", suffix = c("_dsmz", "_col")) %>% mutate(col_id = col_id_col, - species_id = ifelse(!is.na(species_id_col), gsub(".*/(.*)$", "\\1", species_id_col), species_id_dsmz), - source = ifelse(!is.na(species_id_col), source_col, source_dsmz), - ref = ifelse(!is.na(species_id_col) & ref_col != "", ref_col, ref_dsmz)) %>% + species_id = ifelse(!is.na(species_id_col) & ref_col == ref_dsmz, + gsub(".*/(.*)$", "\\1", species_id_col), + species_id_dsmz), + source = ifelse(!is.na(species_id_col) & ref_col == ref_dsmz, + source_col, + source_dsmz), + ref = ifelse(!is.na(species_id_col) & ref_col == ref_dsmz, + ref_col, + ref_dsmz)) %>% select(-matches("(_col|_dsmz|kingdom_fullname)")) @@ -296,6 +309,7 @@ sum(MOs.old$fullname %in% MOs$fullname) # what characters are in the fullnames? table(sort(unlist(strsplit(x = paste(MOs$fullname, collapse = ""), split = "")))) +MOs %>% filter(!fullname %like% "^[a-z ]+$") %>% View() table(MOs$kingdom, MOs$rank) table(AMR::microorganisms$kingdom, AMR::microorganisms$rank) @@ -676,8 +690,16 @@ old_new <- MOs %>% left_join(AMR::microorganisms %>% mutate(kingdom_fullname = paste(kingdom, fullname)) %>% select(mo, kingdom_fullname), by = "kingdom_fullname", suffix = c("_new", "_old")) %>% filter(mo_new != mo_old) %>% select(mo_old, mo_new, everything()) -old_new %>% - View() + +View(old_new) +# to keep all the old IDs: +# MOs <- MOs %>% filter(!mo %in% old_new$mo_new) %>% +# rbind(microorganisms %>% +# filter(mo %in% old_new$mo_old) %>% +# select(mo, fullname) %>% +# left_join(MOs %>% +# select(-mo), by = "fullname")) + # and these codes are now missing (which will throw a unit test error): AMR::microorganisms.codes %>% filter(!mo %in% MOs$mo) AMR::rsi_translation %>% filter(!mo %in% MOs$mo) diff --git a/data-raw/reproduction_of_rsi_translation.R b/data-raw/reproduction_of_rsi_translation.R index d16ec5bf..f7a394bf 100644 --- a/data-raw/reproduction_of_rsi_translation.R +++ b/data-raw/reproduction_of_rsi_translation.R @@ -1,16 +1,16 @@ library(dplyr) -library(readxl) # Installed WHONET 2019 software on Windows (http://www.whonet.org/software.html), # opened C:\WHONET\Codes\WHONETCodes.mdb in MS Access # and exported table 'DRGLST1' to MS Excel -DRGLST1 <- read_excel("data-raw/DRGLST1.xlsx") +DRGLST1 <- readxl::read_excel("data-raw/DRGLST1.xlsx") rsi_translation <- DRGLST1 %>% # only keep CLSI and EUCAST guidelines: filter(GUIDELINES %like% "^(CLSI|EUCST)") %>% # set a nice layout: transmute(guideline = gsub("([0-9]+)$", " 20\\1", gsub("EUCST", "EUCAST", GUIDELINES)), method = TESTMETHOD, + site = SITE_INF, mo = as.mo(ORG_CODE), ab = as.ab(WHON5_CODE), ref_tbl = REF_TABLE, @@ -19,7 +19,7 @@ rsi_translation <- DRGLST1 %>% R_disk = as.disk(DISK_R), S_mic = as.mic(MIC_S), R_mic = as.mic(MIC_R)) %>% - filter(!is.na(mo) & !is.na(ab)) %>% + filter(!is.na(mo) & !is.na(ab) & !mo %in% c("UNKNOWN", "B_GRAMN", "B_GRAMP", "F_FUNGUS", "F_YEAST")) %>% arrange(desc(guideline), mo, ab) print(mo_failures()) @@ -27,27 +27,20 @@ print(mo_failures()) # create 2 tables: MIC and disk tbl_mic <- rsi_translation %>% filter(method == "MIC") %>% - select(-ends_with("_disk")) %>% - mutate(joinstring = paste(guideline, mo, ab)) + mutate(breakpoint_S = as.double(S_mic), breakpoint_R = as.double(R_mic)) tbl_disk <- rsi_translation %>% filter(method == "DISK") %>% - select(-S_mic, -R_mic) %>% - mutate(joinstring = paste(guideline, mo, ab)) %>% - select(joinstring, ends_with("_disk")) + mutate(breakpoint_S = as.double(S_disk), breakpoint_R = as.double(R_disk)) # merge them so every record is a unique combination of method, mo and ab -rsi_translation <- tbl_mic %>% - left_join(tbl_disk, - by = "joinstring") %>% - select(-joinstring, -method) %>% +rsi_translation <- bind_rows(tbl_mic, tbl_disk) %>% + rename(disk_dose = dose_disk) %>% + mutate(disk_dose = gsub("µ", "u", disk_dose)) %>% + select(-ends_with("_mic"), -ends_with("_disk")) %>% as.data.frame(stringsAsFactors = FALSE) %>% # force classes again mutate(mo = as.mo(mo), - ab = as.ab(ab), - S_mic = as.mic(S_mic), - R_mic = as.mic(R_mic), - S_disk = as.disk(S_disk), - R_disk = as.disk(R_disk)) + ab = as.ab(ab)) # save to package usethis::use_data(rsi_translation, overwrite = TRUE) diff --git a/data/microorganisms.codes.rda b/data/microorganisms.codes.rda index 39f18e9a..7cb5b155 100644 Binary files a/data/microorganisms.codes.rda and b/data/microorganisms.codes.rda differ diff --git a/data/microorganisms.rda b/data/microorganisms.rda index 41a50e9a..281bba24 100644 Binary files a/data/microorganisms.rda and b/data/microorganisms.rda differ diff --git a/data/rsi_translation.rda b/data/rsi_translation.rda index 666a6d56..0682f143 100644 Binary files a/data/rsi_translation.rda and b/data/rsi_translation.rda differ diff --git a/docs/404.html b/docs/404.html index 0148bcdc..26c10b47 100644 --- a/docs/404.html +++ b/docs/404.html @@ -84,7 +84,7 @@
diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 064bddde..6b5043e5 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -84,7 +84,7 @@ diff --git a/docs/articles/index.html b/docs/articles/index.html index 232a8fb8..fa130d77 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -84,7 +84,7 @@ diff --git a/docs/authors.html b/docs/authors.html index 2173df4b..aa0dee2c 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -84,7 +84,7 @@ diff --git a/docs/index.html b/docs/index.html index 51208a52..6fa4c622 100644 --- a/docs/index.html +++ b/docs/index.html @@ -45,7 +45,7 @@ diff --git a/docs/news/index.html b/docs/news/index.html index c26358b1..9232416b 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -84,7 +84,7 @@ @@ -231,20 +231,21 @@ -Last updated: 21-Oct-2019
- +Last updated: 23-Oct-2019
as.rsi()
over a data set, it will now print the guideline that will be usedas.rsi()
over a data set, it will now print the guideline that will be used if it is not specified by the usereucast_rules()
: Stenotrophomonas maltophilia not interpreted “R” to ceftazidime anymore (following EUCAST v3.1)as.rsi()
where the input is NA
+"testvalue"
could never be
Renamed data set septic_patients
to example_isolates
Function bug_drug_combinations()
to quickly get a data.frame
with the results of all bug-drug combinations in a data set. The column containing microorganism codes is guessed automatically and its input is transformed with mo_shortname()
at default:
also_single_tested
w
Function rsi_df()
to transform a data.frame
to a data set containing only the microbial interpretation (S, I, R), the antibiotic, the percentage of S/I/R and the number of available isolates. This is a convenient combination of the existing functions count_df()
and portion_df()
to immediately show resistance percentages and number of available isolates:
also_single_tested
w
as.rsi()
on an MIC value (created with as.mic()
), a disk diffusion value (created with the new as.disk()
) or on a complete date set containing columns with MIC or disk diffusion values.mo_name()
as alias of mo_fullname()
@@ -601,9 +602,9 @@ Please
+as.mo()
to identify an MO code.as.mo(..., allow_uncertain = 3)
AMR 0.5.0 2018-11-30
-
+
-New
+New
- Repository moved to GitLab: https://gitlab.com/msberends/AMR
@@ -955,9 +956,9 @@ Using as.mo(..., allow_uncertain = 3)
AMR 0.4.0 2018-10-01
-
+
-New
+New
- The data set
microorganisms
now contains all microbial taxonomic data from ITIS (kingdoms Bacteria, Fungi and Protozoa), the Integrated Taxonomy Information System, available via https://itis.gov. The data set now contains more than 18,000 microorganisms with all known bacteria, fungi and protozoa according ITIS with genus, species, subspecies, family, order, class, phylum and subkingdom. The new data set microorganisms.old
contains all previously known taxonomic names from those kingdoms.
- New functions based on the existing function
mo_property
:
@@ -1090,9 +1091,9 @@ Using as.mo(..., allow_uncertain = 3)
AMR 0.3.0 2018-08-14
-
+
-New
+New
-
BREAKING:
rsi_df
was removed in favour of new functions portion_R
, portion_IR
, portion_I
, portion_SI
and portion_S
to selectively calculate resistance or susceptibility. These functions are 20 to 30 times faster than the old rsi
function. The old function still works, but is deprecated.
@@ -1227,9 +1228,9 @@ Using as.mo(..., allow_uncertain = 3)
AMR 0.2.0 2018-05-03
-
+
-New
+New
- Full support for Windows, Linux and macOS
- Full support for old R versions, only R-3.0.0 (April 2013) or later is needed (needed packages may have other dependencies)
@@ -1308,7 +1309,7 @@ Using as.mo(..., allow_uncertain = 3)
Contents
diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R
index 462d61e9..52cb283f 100644
--- a/tests/testthat/test-data.R
+++ b/tests/testthat/test-data.R
@@ -43,7 +43,7 @@ test_that("data sets are valid", {
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"]
for (i in seq_len(length(datasets))) {
dataset <- get(datasets[i], envir = asNamespace("AMR"))
- expect_identical(dataset_UTF8_to_ASCII(dataset), dataset)
+ expect_identical(dataset_UTF8_to_ASCII(dataset), dataset, label = datasets[i])
}
})
diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R
index be3b2e7a..f16fed1c 100755
--- a/tests/testthat/test-mdro.R
+++ b/tests/testthat/test-mdro.R
@@ -43,7 +43,7 @@ test_that("mdro works", {
# example_isolates should have these finding using Dutch guidelines
expect_equal(outcome %>% freq() %>% pull(count),
- c(1972, 22, 6)) # 1969 neg, 25 unconfirmed, 6 pos
+ c(1969, 25, 6)) # 1969 neg, 25 unconfirmed, 6 pos
expect_equal(brmo(example_isolates, info = FALSE),
mdro(example_isolates, guideline = "BRMO", info = FALSE))