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

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 0.8.0.9001
+Version: 0.8.0.9002
-Date: 2019-10-21
+Date: 2019-10-23
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(role = c("aut", "cre"), 

NEWS.md

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

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
+    # 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))
+    # 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

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)
+  guideline_coerced <- get_guideline(guideline)
-  message(blue("Interpreting using guideline", bold(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]),
+                                     x = x %>% pull(ab_cols[i]),
-                                        mo = x %>% pull(col_mo),
+                                     mo = x %>% pull(col_mo),
-                                        ab = as.ab(ab_cols[i]),
+                                     ab = ab_col_coerced,
-                                        guideline = guideline)
+                                     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]),
+                                     x = x %>% pull(ab_cols[i]),
-                                        mo = x %>% pull(col_mo),
+                                     mo = x %>% pull(col_mo),
-                                        ab = as.ab(ab_cols[i]),
+                                     ab = ab_col_coerced,
-                                        guideline = guideline)
+                                     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 "))
+  out[x == "R"] <- bgRed(real_white(" R "))
-  pillar::new_pillar_shaft_simple(out, align = "left", min_width = 3)
+  pillar::new_pillar_shaft_simple(out, align = "left", width = 3)
 }

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

data-raw/internals.R

@@ -1,13 +1,7 @@
-# ---------------------------------------------------------------------------------------------------
+# Run this file to update the package -------------------------------------
-# For editing this EUCAST reference file, these values can all be used for target antibiotics:
+# source("data-raw/internals.R")
-# all_betalactams, aminoglycosides, carbapenems, cephalosporins, cephalosporins_without_CAZ, fluoroquinolones, 
+
-# glycopeptides, macrolides, minopenicillins, polymyxins, streptogramins, tetracyclines, ureidopenicillins
+# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
-# 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 <<<<<
-# ---------------------------------------------------------------------------------------------------
 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",

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),
+         species_id = ifelse(!is.na(species_id_col) & ref_col == ref_dsmz, 
-         source = ifelse(!is.na(species_id_col), source_col, source_dsmz), 
+                             gsub(".*/(.*)$", "\\1", species_id_col), 
-         ref = ifelse(!is.na(species_id_col) & ref_col != "", ref_col, ref_dsmz)) %>% 
+                             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)

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(breakpoint_S = as.double(S_mic), breakpoint_R = as.double(R_mic))
-  mutate(joinstring = paste(guideline, mo, ab))
 tbl_disk <- rsi_translation %>%
   filter(method == "DISK") %>%
-  select(-S_mic, -R_mic) %>%
+  mutate(breakpoint_S = as.double(S_disk), breakpoint_R = as.double(R_disk))
-  mutate(joinstring = paste(guideline, mo, ab)) %>%
-  select(joinstring, ends_with("_disk"))
 
 # merge them so every record is a unique combination of method, mo and ab
-rsi_translation <- tbl_mic %>%
+rsi_translation <- bind_rows(tbl_mic, tbl_disk) %>%
-  left_join(tbl_disk,
+  rename(disk_dose = dose_disk) %>% 
-            by = "joinstring") %>%
+  mutate(disk_dose = gsub("µ", "u", disk_dose)) %>% 
-  select(-joinstring, -method) %>%
+  select(-ends_with("_mic"), -ends_with("_disk")) %>%
   as.data.frame(stringsAsFactors = FALSE) %>%
   # force classes again
   mutate(mo = as.mo(mo),
-         ab = as.ab(ab),
+         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))
 
 # save to package
 usethis::use_data(rsi_translation, overwrite = TRUE)

docs/404.html

@@ -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>
 

docs/LICENSE-text.html

@@ -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>
 

docs/articles/index.html

@@ -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>
 

docs/authors.html

@@ -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>
 

docs/index.html

@@ -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>
 

docs/news/index.html

@@ -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 @@
       
     </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>
+<p><small>Last updated: 23-Oct-2019</small></p>
-<div id="new" class="section level3">
-<h3 class="hasAnchor">
-<a href="#new" class="anchor"></a>New</h3>
-</div>
 <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
 <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
 <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
 <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
 <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
 <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
 <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
 <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
 <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
     <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>

docs/reference/index.html

@@ -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>
 

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])
   }
 })
 

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))