(v1.6.0.9009) key_antibiotics update

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: AMR
-Version: 1.6.0.9008
+Version: 1.6.0.9009
 Date: 2021-04-23
 Title: Antimicrobial Resistance Data Analysis
 Authors@R: c(

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 1.6.0.9008
+# AMR 1.6.0.9009
 ## <small>Last updated: 23 April 2021</small>
 
 ### New
@@ -25,6 +25,9 @@
 * Fixed an installation error on R-3.0
 * Added `info` argument to `as.mo()` to turn on/off the progress bar
 * Fixed a bug that `col_mo` for some functions (esp. `eucast_rules()` and `mdro()`) could not be column names of the `microorganisms` data set as it would throw an error
+* Using `first_isolate()` with key antibiotics:
+  * Fixed a bug in the algorithm when using `type == "points"`, that now leads to inclusion of slightly more isolates
+  * Big speed improvement for `key_antibiotics_equal()` when using `type == "points"`
 
 
 # AMR 1.6.0

R/first_isolate.R

@@ -42,7 +42,7 @@
 #' @param type type to determine weighed isolates; can be `"keyantibiotics"` or `"points"`, see *Details*
 #' @param ignore_I logical to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantibiotics"`, see *Details*
 #' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when `type = "points"`, see *Details*
-#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
+#' @param info a [logical] to indicate info should be printed, defaults to `TRUE` only in interactive mode
 #' @param include_unknown logical to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
 #' @param include_untested_rsi logical to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `<rsi>` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
 #' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], or arguments passed on to [key_antibiotics()] when using [filter_first_weighted_isolate()]
@@ -402,7 +402,7 @@ first_isolate <- function(x = NULL,
                                              type = type_param,
                                              ignore_I = ignore_I,
                                              points_threshold = points_threshold,
-                                             info = info)
+                                             na.rm = TRUE)
     # with key antibiotics
     x$newvar_first_isolate <- pm_if_else(x$newvar_row_index_sorted >= row.start &
                                            x$newvar_row_index_sorted <= row.end &

R/key_antibiotics.R

@@ -286,93 +286,75 @@ key_antibiotics <- function(x = NULL,
 }
 
 #' @rdname key_antibiotics
+#' @param info unused - previously used to indicate whether a progress bar should print
+#' @param na.rm a [logical] to indicate whether comparison with `NA` should return `FALSE` (defaults to `TRUE` for backwards compatibility)
 #' @export
 key_antibiotics_equal <- function(y,
                                   z,
                                   type = c("keyantibiotics", "points"),
                                   ignore_I = TRUE,
                                   points_threshold = 2,
-                                  info = FALSE) {
+                                  info = FALSE,
+                                  na.rm = TRUE,
+                                  ...) {
   meet_criteria(y, allow_class = "character")
   meet_criteria(z, allow_class = "character")
-  meet_criteria(type, allow_class = "character", has_length = c(1, 2))
+  if (length(type) == 2) {
+    type <- type[1L]
+  }
+  meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("keyantibiotics", "points"))
   meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
   meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
   meet_criteria(info, allow_class = "logical", has_length = 1)
-  
+  meet_criteria(na.rm, allow_class = "logical", has_length = 1)
   stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
-  # y is active row, z is lag
-  x <- y
-  y <- z
 
-  type <- type[1]
+  key2rsi <- function(val) {
-  
+    as.double(as.rsi(gsub(".", NA_character_, unlist(strsplit(val, "")), fixed = TRUE)))
-  # only show progress bar on points or when at least 5000 isolates
-  info_needed <- info == TRUE & (type == "points" | length(x) > 5000)
-  
-  result <- logical(length(x))
-  
-  p <- progress_ticker(length(x), print = info_needed)
-  on.exit(close(p))
-  
-  for (i in seq_len(length(x))) {
-    
-    if (info_needed == TRUE) {
-      p$tick()
   }
+  y <- lapply(y, key2rsi)
+  z <- lapply(z, key2rsi)
   
-    if (is.na(x[i])) {
+  determine_equality <- function(a, b, type, points_threshold, ignore_I) {
-      x[i] <- ""
+    if (length(a) != length(b)) {
-    }
+      # incomparable, so not equal
-    if (is.na(y[i])) {
+      return(FALSE)
-      y[i] <- ""
     }
+    # ignore NAs on both sides
+    NA_ind <- which(is.na(a) | is.na(b))
+    a[NA_ind] <- NA_real_
+    b[NA_ind] <- NA_real_
     
-    if (x[i] == y[i]) {
+    if (type == "points") {
-      
-      result[i] <- TRUE
-      
-    } else if (nchar(x[i]) != nchar(y[i])) {
-      
-      result[i] <- FALSE
-      
-    } else {
-      
-      x_split <- strsplit(x[i], "")[[1]]
-      y_split <- strsplit(y[i], "")[[1]]
-      
-      if (type == "keyantibiotics") {
-        
-        if (ignore_I == TRUE) {
-          x_split[x_split == "I"] <- "."
-          y_split[y_split == "I"] <- "."
-        }
-        
-        y_split[x_split == "."] <- "."
-        x_split[y_split == "."] <- "."
-        
-        result[i] <- all(x_split == y_split)
-        
-      } else if (type == "points") {
       # count points for every single character:
       # - no change is 0 points
       # - I <-> S|R is 0.5 point
       # - S|R <-> R|S is 1 point
       # use the levels of as.rsi (S = 1, I = 2, R = 3)
-        
+      (sum(abs(a - b), na.rm = TRUE) / 2) < points_threshold
-        suppressWarnings(x_split <- x_split %pm>% as.rsi() %pm>% as.double())
-        suppressWarnings(y_split <- y_split %pm>% as.rsi() %pm>% as.double())
-        
-        points <- (x_split - y_split) %pm>% abs() %pm>% sum(na.rm = TRUE) / 2
-        result[i] <- points >= points_threshold
-        
     } else {
-        stop("`", type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?key_antibiotics')
+      if (ignore_I == TRUE) {
+        ind <- which(a == 2 | b == 2) # since as.double(as.rsi("I")) == 2
+        a[ind] <- NA_real_
+        b[ind] <- NA_real_
+      }
+      all(a == b, na.rm = TRUE)
     }
   }
+  out <- unlist(mapply(FUN = determine_equality,
+                       y,
+                       z,
+                       MoreArgs = list(type = type,
+                                       points_threshold = points_threshold,
+                                       ignore_I = ignore_I),
+                       SIMPLIFY = FALSE,
+                       USE.NAMES = FALSE))
+  if (na.rm == FALSE) {
+    out[is.na(y) | is.na(z)] <- NA
+  } else  {
+    # NA means not equal if `na.rm == TRUE`, as per the manual
+    out[is.na(y) | is.na(z)] <- FALSE
   }
   
-  
+  out
-  close(p)
-  result
 }

R/rsi.R

@@ -263,7 +263,7 @@ as.rsi.default <- function(x, ...) {
     x[x == 2] <- "I"
     x[x == 3] <- "R"
     
-  } else if (!all(is.na(x)) && !identical(levels(x), c("S", "I", "R"))) {
+  } else if (!all(is.na(x)) && !identical(levels(x), c("S", "I", "R")) && !all(x %in% c("R", "S", "I", NA))) {
 
     if (all(x %unlike% "(R|S|I)", na.rm = TRUE)) {
       # check if they are actually MICs or disks

docs/404.html

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

docs/LICENSE-text.html

@@ -81,7 +81,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">1.6.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 

docs/articles/index.html

@@ -81,7 +81,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">1.6.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 

docs/authors.html

@@ -81,7 +81,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">1.6.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 

docs/index.html

@@ -42,7 +42,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">1.6.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 

docs/news/index.html

@@ -81,7 +81,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">1.6.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 
@@ -236,9 +236,9 @@
       <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
     </div>
 
-    <div id="amr-1609008" class="section level1">
+    <div id="amr-1609009" class="section level1">
-<h1 class="page-header" data-toc-text="1.6.0.9008">
+<h1 class="page-header" data-toc-text="1.6.0.9009">
-<a href="#amr-1609008" class="anchor"></a>AMR 1.6.0.9008<small> Unreleased </small>
+<a href="#amr-1609009" class="anchor"></a>AMR 1.6.0.9009<small> Unreleased </small>
 </h1>
 <div id="last-updated-23-april-2021" class="section level2">
 <h2 class="hasAnchor">
@@ -287,6 +287,13 @@
 <li>Fixed an installation error on R-3.0</li>
 <li>Added <code>info</code> argument to <code><a href="../reference/as.mo.html">as.mo()</a></code> to turn on/off the progress bar</li>
 <li>Fixed a bug that <code>col_mo</code> for some functions (esp. <code><a href="../reference/eucast_rules.html">eucast_rules()</a></code> and <code><a href="../reference/mdro.html">mdro()</a></code>) could not be column names of the <code>microorganisms</code> data set as it would throw an error</li>
+<li>Using <code><a href="../reference/first_isolate.html">first_isolate()</a></code> with key antibiotics:
+<ul>
+<li>Fixed a bug in the algorithm when using <code>type == "points"</code>, that now leads to inclusion of slightly more isolates</li>
+<li>Big speed improvement for <code><a href="../reference/key_antibiotics.html">key_antibiotics_equal()</a></code> when using <code>type == "points"</code>
+</li>
+</ul>
+</li>
 </ul>
 </div>
 </div>

docs/pkgdown.yml

@@ -12,7 +12,7 @@ articles:
   datasets: datasets.html
   resistance_predict: resistance_predict.html
   welcome_to_AMR: welcome_to_AMR.html
-last_built: 2021-04-23T07:52Z
+last_built: 2021-04-23T14:13Z
 urls:
   reference: https://msberends.github.io/AMR//reference
   article: https://msberends.github.io/AMR//articles

docs/reference/first_isolate.html

@@ -82,7 +82,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">1.6.0.9007</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 
@@ -346,7 +346,7 @@
     </tr>
     <tr>
       <th>info</th>
-      <td><p>a <a href='https://rdrr.io/r/base/logical.html'>logical</a> to indicate whether a progress bar should be printed, defaults to <code>TRUE</code> only in interactive mode</p></td>
+      <td><p>a <a href='https://rdrr.io/r/base/logical.html'>logical</a> to indicate info should be printed, defaults to <code>TRUE</code> only in interactive mode</p></td>
     </tr>
     <tr>
       <th>include_unknown</th>

docs/reference/index.html

@@ -81,7 +81,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">1.6.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 

docs/reference/key_antibiotics.html

@@ -82,7 +82,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">1.6.0.9007</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 
@@ -273,7 +273,9 @@
   type <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"keyantibiotics"</span>, <span class='st'>"points"</span><span class='op'>)</span>,
   ignore_I <span class='op'>=</span> <span class='cn'>TRUE</span>,
   points_threshold <span class='op'>=</span> <span class='fl'>2</span>,
-  info <span class='op'>=</span> <span class='cn'>FALSE</span>
+  info <span class='op'>=</span> <span class='cn'>FALSE</span>,
+  na.rm <span class='op'>=</span> <span class='cn'>TRUE</span>,
+  <span class='va'>...</span>
 <span class='op'>)</span></pre>
 
     <h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
@@ -325,7 +327,11 @@
     </tr>
     <tr>
       <th>info</th>
-      <td><p>a <a href='https://rdrr.io/r/base/logical.html'>logical</a> to indicate whether a progress bar should be printed, defaults to <code>TRUE</code> only in interactive mode</p></td>
+      <td><p>unused - previously used to indicate whether a progress bar should print</p></td>
+    </tr>
+    <tr>
+      <th>na.rm</th>
+      <td><p>a <a href='https://rdrr.io/r/base/logical.html'>logical</a> to indicate whether comparison with <code>NA</code> should return <code>FALSE</code> (defaults to <code>TRUE</code> for backwards compatibility)</p></td>
     </tr>
     </table>
 

docs/survey.html

@@ -81,7 +81,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">1.6.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9009</span>
       </span>
     </div>
 

man/first_isolate.Rd

@@ -81,7 +81,7 @@ filter_first_weighted_isolate(
 
 \item{points_threshold}{points until the comparison of key antibiotics will lead to inclusion of an isolate when \code{type = "points"}, see \emph{Details}}
 
-\item{info}{a \link{logical} to indicate whether a progress bar should be printed, defaults to \code{TRUE} only in interactive mode}
+\item{info}{a \link{logical} to indicate info should be printed, defaults to \code{TRUE} only in interactive mode}
 
 \item{include_unknown}{logical to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code \code{"UNKNOWN"}, which defaults to \code{FALSE}. For WHONET users, this means that all records with organism code \code{"con"} (\emph{contamination}) will be excluded at default. Isolates with a microbial ID of \code{NA} will always be excluded as first isolate.}
 

man/key_antibiotics.Rd

@@ -36,7 +36,9 @@ key_antibiotics_equal(
   type = c("keyantibiotics", "points"),
   ignore_I = TRUE,
   points_threshold = 2,
-  info = FALSE
+  info = FALSE,
+  na.rm = TRUE,
+  ...
 )
 }
 \arguments{
@@ -62,7 +64,9 @@ key_antibiotics_equal(
 
 \item{points_threshold}{points until the comparison of key antibiotics will lead to inclusion of an isolate when \code{type = "points"}, see \emph{Details}}
 
-\item{info}{a \link{logical} to indicate whether a progress bar should be printed, defaults to \code{TRUE} only in interactive mode}
+\item{info}{unused - previously used to indicate whether a progress bar should print}
+
+\item{na.rm}{a \link{logical} to indicate whether comparison with \code{NA} should return \code{FALSE} (defaults to \code{TRUE} for backwards compatibility)}
 }
 \description{
 These function can be used to determine first isolates (see \code{\link[=first_isolate]{first_isolate()}}). Using key antibiotics to determine first isolates is more reliable than without key antibiotics. These selected isolates can then be called first 'weighted' isolates.

tests/testthat/test-first_isolate.R

@@ -50,7 +50,7 @@ test_that("first isolates work", {
                       type = "keyantibiotics",
                       info = TRUE),
         na.rm = TRUE)),
-    1395)
+    1398)
 
   # when not ignoring I
   expect_equal(
@@ -65,7 +65,7 @@ test_that("first isolates work", {
                       type = "keyantibiotics",
                       info = TRUE),
         na.rm = TRUE)),
-    1418)
+    1421)
   # when using points
   expect_equal(
     suppressWarnings(
@@ -78,7 +78,7 @@ test_that("first isolates work", {
                       type = "points",
                       info = TRUE),
         na.rm = TRUE)),
-    1398)
+    1348)
 
   # first non-ICU isolates
   expect_equal(