Browse Source

(v0.8.0.9002) eucast_rules() fix for S. maltophilia

main
parent
commit
3e5ab53209
  1. 4
      DESCRIPTION
  2. 12
      NEWS.md
  3. 20
      R/mo.R
  4. 159
      R/rsi.R
  5. BIN
      R/sysdata.rda
  6. 2
      data-raw/eucast_rules.tsv
  7. 15
      data-raw/internals.R
  8. 32
      data-raw/reproduction_of_microorganisms.R
  9. 27
      data-raw/reproduction_of_rsi_translation.R
  10. BIN
      data/microorganisms.codes.rda
  11. BIN
      data/microorganisms.rda
  12. BIN
      data/rsi_translation.rda
  13. 2
      docs/404.html
  14. 2
      docs/LICENSE-text.html
  15. 2
      docs/articles/index.html
  16. 2
      docs/authors.html
  17. 2
      docs/index.html
  18. 53
      docs/news/index.html
  19. 2
      docs/reference/index.html
  20. 2
      tests/testthat/test-data.R
  21. 2
      tests/testthat/test-mdro.R

4
DESCRIPTION

@ -1,6 +1,6 @@ @@ -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"),

12
NEWS.md

@ -1,11 +1,11 @@ @@ -1,11 +1,11 @@
# AMR 0.8.0.9001
<small>Last updated: 21-Oct-2019</small>
### New
# AMR 0.8.0.9002
<small>Last updated: 23-Oct-2019</small>
### 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

20
R/mo.R

@ -240,8 +240,8 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE, @@ -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, @@ -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, @@ -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, ...) { @@ -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

159
R/rsi.R

@ -102,10 +102,10 @@ as.rsi.default <- function(x, ...) { @@ -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,22 +179,7 @@ as.rsi.disk <- function(x, mo, ab, guideline = "EUCAST", ...) { @@ -179,22 +179,7 @@ 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)
get_guideline <- function(guideline) {
guideline_param <- toupper(guideline)
if (guideline_param %in% c("CLSI", "EUCAST")) {
guideline_param <- AMR::rsi_translation %>%
@ -204,16 +189,42 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) { @@ -204,16 +189,42 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
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)
}
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_param) %>%
filter(guideline == guideline_coerced & method == method_param) %>%
mutate(lookup = paste(mo, ab))
lookup_mo <- paste(mo, ab)
@ -222,7 +233,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) { @@ -222,7 +233,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
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],
@ -234,57 +245,38 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) { @@ -234,57 +245,38 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
# 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",
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$S_disk) ~ "S",
isTRUE(x[i] <= get_record$R_disk) ~ "R",
!is.na(get_record$S_disk) & !is.na(get_record$R_disk) ~ "I",
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"))
}
get_guideline <- function(guideline) {
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)
}
guideline_param
}
#' @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", ...) { @@ -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", ...) { @@ -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, @@ -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, @@ -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, @@ -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) { @@ -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)
}

BIN
R/sysdata.rda

Binary file not shown.

2
data-raw/eucast_rules.tsv

@ -137,7 +137,7 @@ fullname like ^Burkholderia (cepacia|multivorans|cenocepacia|stabilis|vietnamien @@ -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

Can't render this file because it contains an unexpected character in line 6 and column 96.

15
data-raw/internals.R

@ -1,13 +1,7 @@ @@ -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( @@ -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",

32
data-raw/reproduction_of_microorganisms.R

@ -70,7 +70,13 @@ data_dsmz <- data_dsmz %>% @@ -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 %>% @@ -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 %>% @@ -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) @@ -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 %>% @@ -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)

27
data-raw/reproduction_of_rsi_translation.R

@ -1,16 +1,16 @@ @@ -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 %>% @@ -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()) @@ -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)

BIN
data/microorganisms.codes.rda

Binary file not shown.

BIN
data/microorganisms.rda

Binary file not shown.

BIN
data/rsi_translation.rda

Binary file not shown.

2
docs/404.html

@ -84,7 +84,7 @@ @@ -84,7 +84,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="https://msberends.gitlab.io/AMR/index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9001</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9002</span>
</span>
</div>

2
docs/LICENSE-text.html

@ -84,7 +84,7 @@ @@ -84,7 +84,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9001</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9002</span>
</span>
</div>

2
docs/articles/index.html

@ -84,7 +84,7 @@ @@ -84,7 +84,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9001</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9002</span>
</span>
</div>

2
docs/authors.html

@ -84,7 +84,7 @@ @@ -84,7 +84,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9001</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9002</span>
</span>
</div>

2
docs/index.html

@ -45,7 +45,7 @@ @@ -45,7 +45,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9001</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9002</span>
</span>
</div>

53
docs/news/index.html

@ -84,7 +84,7 @@ @@ -84,7 +84,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9001</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9002</span>
</span>
</div>
@ -231,20 +231,21 @@ @@ -231,20 +231,21 @@
</div>
<div id="amr-0-8-0-9001" class="section level1">
<div id="amr-0-8-0-9002" class="section level1">
<h1 class="page-header">
<a href="#amr-0-8-0-9001" class="anchor"></a>AMR 0.8.0.9001<small> Unreleased </small>
<a href="#amr-0-8-0-9002" class="anchor"></a>AMR 0.8.0.9002<small> Unreleased </small>
</h1>
<p><small>Last updated: 21-Oct-2019</small></p>
<div id="new" class="section level3">
<h3 class="hasAnchor">
<a href="#new" class="anchor"></a>New</h3>
</div>
<p><small>Last updated: 23-Oct-2019</small></p>
<div id="changes" class="section level3">
<h3 class="hasAnchor">
<a href="#changes" class="anchor"></a>Changes</h3>
<ul>
<li>When running <code><a href="../reference/as.rsi.html">as.rsi()</a></code> over a data set, it will now print the guideline that will be used</li>
<li>When running <code><a href="../reference/as.rsi.html">as.rsi()</a></code> over a data set, it will now print the guideline that will be used if it is not specified by the user</li>
<li>Fix for <code><a href="../reference/eucast_rules.html">eucast_rules()</a></code>: <em>Stenotrophomonas maltophilia</em> not interpreted “R” to ceftazidime anymore (following EUCAST v3.1)</li>
<li>Fix in taxonomic info for genera that are in multiple kingdoms, like <em>Proteus</em>
</li>
<li>Fix for interpreting MIC values with <code><a href="../reference/as.rsi.html">as.rsi()</a></code> where the input is <code>NA</code>
</li>
</ul>
</div>
</div>
@ -278,9 +279,9 @@ This is important, because a value like <code>"testvalue"</code> could never be @@ -278,9 +279,9 @@ This is important, because a value like <code>"testvalue"</code> could never be
<li><p>Renamed data set <code>septic_patients</code> to <code>example_isolates</code></p></li>
</ul>
</div>
<div id="new-1" class="section level3">
<div id="new" class="section level3">
<h3 class="hasAnchor">
<a href="#new-1" class="anchor"></a>New</h3>
<a href="#new" class="anchor"></a>New</h3>
<ul>
<li>
<p>Function <code><a href="../reference/bug_drug_combinations.html">bug_drug_combinations()</a></code> to quickly get a <code>data.frame</code> 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 <code><a href="../reference/mo_property.html">mo_shortname()</a></code> at default:</p>
@ -403,9 +404,9 @@ Since this is a major change, usage of the old <code>also_single_tested</code> w @@ -403,9 +404,9 @@ Since this is a major change, usage of the old <code>also_single_tested</code> w
<h1 class="page-header">
<a href="#amr-0-7-1" class="anchor"></a>AMR 0.7.1<small> 2019-06-23 </small>
</h1>
<div id="new-2" class="section level4">
<div id="new-1" class="section level4">
<h4 class="hasAnchor">
<a href="#new-2" class="anchor"></a>New</h4>
<a href="#new-1" class="anchor"></a>New</h4>
<ul>
<li>
<p>Function <code><a href="../reference/portion.html">rsi_df()</a></code> to transform a <code>data.frame</code> 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 <code><a href="../reference/count.html">count_df()</a></code> and <code><a href="../reference/portion.html">portion_df()</a></code> to immediately show resistance percentages and number of available isolates:</p>
@ -484,9 +485,9 @@ Since this is a major change, usage of the old <code>also_single_tested</code> w @@ -484,9 +485,9 @@ Since this is a major change, usage of the old <code>also_single_tested</code> w
<h1 class="page-header">
<a href="#amr-0-7-0" class="anchor"></a>AMR 0.7.0<small> 2019-06-03 </small>
</h1>
<div id="new-3" class="section level4">
<div id="new-2" class="section level4">
<h4 class="hasAnchor">
<a href="#new-3" class="anchor"></a>New</h4>
<a href="#new-2" class="anchor"></a>New</h4>
<ul>
<li>Support for translation of disk diffusion and MIC values to RSI values (i.e. antimicrobial interpretations). Supported guidelines are EUCAST (2011 to 2019) and CLSI (2011 to 2019). Use <code><a href="../reference/as.rsi.html">as.rsi()</a></code> on an MIC value (created with <code><a href="../reference/as.mic.html">as.mic()</a></code>), a disk diffusion value (created with the new <code><a href="../reference/as.disk.html">as.disk()</a></code>) or on a complete date set containing columns with MIC or disk diffusion values.</li>
<li>Function <code><a href="../reference/mo_property.html">mo_name()</a></code> as alias of <code><a href="../reference/mo_property.html">mo_fullname()</a></code>
@ -601,9 +602,9 @@ Please <a href="https://gitlab.com/msberends/AMR/issues/new?issue%5Btitle%5D=EUC @@ -601,9 +602,9 @@ Please <a href="https://gitlab.com/msberends/AMR/issues/new?issue%5Btitle%5D=EUC
<li>Contains the complete manual of this package and all of its functions with an explanation of their parameters</li>
<li>Contains a comprehensive tutorial about how to conduct antimicrobial resistance analysis, import data from WHONET or SPSS and many more.</li>
</ul>
<div id="new-4" class="section level4">
<div id="new-3" class="section level4">
<h4 class="hasAnchor">
<a href="#new-4" class="anchor"></a>New</h4>
<a href="#new-3" class="anchor"></a>New</h4>
<ul>
<li>
<strong>BREAKING</strong>: removed deprecated functions, parameters and references to ‘bactid’. Use <code><a href="../reference/as.mo.html">as.mo()</a></code> to identify an MO code.</li>
@ -828,9 +829,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a @@ -828,9 +829,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a
<h1 class="page-header">
<a href="#amr-0-5-0" class="anchor"></a>AMR 0.5.0<small> 2018-11-30 </small>
</h1>
<div id="new-5" class="section level4">
<div id="new-4" class="section level4">
<h4 class="hasAnchor">
<a href="#new-5" class="anchor"></a>New</h4>
<a href="#new-4" class="anchor"></a>New</h4>
<ul>
<li>Repository moved to GitLab: <a href="https://gitlab.com/msberends/AMR" class="uri">https://gitlab.com/msberends/AMR</a>
</li>
@ -955,9 +956,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a @@ -955,9 +956,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a
<h1 class="page-header">
<a href="#amr-0-4-0" class="anchor"></a>AMR 0.4.0<small> 2018-10-01 </small>
</h1>
<div id="new-6" class="section level4">
<div id="new-5" class="section level4">
<h4 class="hasAnchor">
<a href="#new-6" class="anchor"></a>New</h4>
<a href="#new-5" class="anchor"></a>New</h4>
<ul>
<li>The data set <code>microorganisms</code> now contains <strong>all microbial taxonomic data from ITIS</strong> (kingdoms Bacteria, Fungi and Protozoa), the Integrated Taxonomy Information System, available via <a href="https://itis.gov" class="uri">https://itis.gov</a>. 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 <code>microorganisms.old</code> contains all previously known taxonomic names from those kingdoms.</li>
<li>New functions based on the existing function <code>mo_property</code>:
@ -1090,9 +1091,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a @@ -1090,9 +1091,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a
<h1 class="page-header">
<a href="#amr-0-3-0" class="anchor"></a>AMR 0.3.0<small> 2018-08-14 </small>
</h1>
<div id="new-7" class="section level4">
<div id="new-6" class="section level4">
<h4 class="hasAnchor">
<a href="#new-7" class="anchor"></a>New</h4>
<a href="#new-6" class="anchor"></a>New</h4>
<ul>
<li>
<strong>BREAKING</strong>: <code>rsi_df</code> was removed in favour of new functions <code>portion_R</code>, <code>portion_IR</code>, <code>portion_I</code>, <code>portion_SI</code> and <code>portion_S</code> to selectively calculate resistance or susceptibility. These functions are 20 to 30 times faster than the old <code>rsi</code> function. The old function still works, but is deprecated.
@ -1227,9 +1228,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a @@ -1227,9 +1228,9 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a
<h1 class="page-header">
<a href="#amr-0-2-0" class="anchor"></a>AMR 0.2.0<small> 2018-05-03 </small>
</h1>
<div id="new-8" class="section level4">
<div id="new-7" class="section level4">
<h4 class="hasAnchor">
<a href="#new-8" class="anchor"></a>New</h4>
<a href="#new-7" class="anchor"></a>New</h4>
<ul>
<li>Full support for Windows, Linux and macOS</li>
<li>Full support for old R versions, only R-3.0.0 (April 2013) or later is needed (needed packages may have other dependencies)</li>
@ -1308,7 +1309,7 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a @@ -1308,7 +1309,7 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a
<div id="tocnav">
<h2>Contents</h2>
<ul class="nav nav-pills nav-stacked">
<li><a href="#amr-0-8-0-9001">0.8.0.9001</a></li>
<li><a href="#amr-0-8-0-9002">0.8.0.9002</a></li>
<li><a href="#amr-0-8-0">0.8.0</a></li>
<li><a href="#amr-0-7-1">0.7.1</a></li>
<li><a href="#amr-0-7-0">0.7.0</a></li>

2
docs/reference/index.html

@ -84,7 +84,7 @@ @@ -84,7 +84,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9001</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.8.0.9002</span>
</span>
</div>

2
tests/testthat/test-data.R

@ -43,7 +43,7 @@ test_that("data sets are valid", { @@ -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])
}
})

2
tests/testthat/test-mdro.R

@ -43,7 +43,7 @@ test_that("mdro works", { @@ -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))

Loading…
Cancel
Save