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 @@ AMR (for R) - 0.8.0.9001 + 0.8.0.9002 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 @@ AMR (for R) - 0.8.0.9001 + 0.8.0.9002 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 @@ AMR (for R) - 0.8.0.9001 + 0.8.0.9002 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 @@ AMR (for R) - 0.8.0.9001 + 0.8.0.9002 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 @@ AMR (for R) - 0.8.0.9001 + 0.8.0.9002 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 @@ AMR (for R) - 0.8.0.9001 + 0.8.0.9002 @@ -231,20 +231,21 @@ -
+

-AMR 0.8.0.9001 Unreleased +AMR 0.8.0.9002 Unreleased

-

Last updated: 21-Oct-2019

-
-

-New

-
+

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 +
@@ -278,9 +279,9 @@ This is important, because a value like "testvalue" could never be
  • Renamed data set septic_patients to example_isolates

  • -
    +

    -New

    +New