diff --git a/DESCRIPTION b/DESCRIPTION index 0c120676..a5e6c939 100644 --- a/DESCRIPTION +++ b/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( diff --git a/NEWS.md b/NEWS.md index 66557e7a..70127e9f 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.6.0.9008 +# AMR 1.6.0.9009 ## Last updated: 23 April 2021 ### 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 diff --git a/R/first_isolate.R b/R/first_isolate.R index 7cd2d500..3a2c8b5c 100755 --- a/R/first_isolate.R +++ b/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 `` 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 & diff --git a/R/key_antibiotics.R b/R/key_antibiotics.R index 89bb7a30..ac8bce5a 100755 --- a/R/key_antibiotics.R +++ b/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 + + key2rsi <- function(val) { + as.double(as.rsi(gsub(".", NA_character_, unlist(strsplit(val, "")), fixed = TRUE))) + } + y <- lapply(y, key2rsi) + z <- lapply(z, key2rsi) - type <- type[1] - - # 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() + determine_equality <- function(a, b, type, points_threshold, ignore_I) { + if (length(a) != length(b)) { + # incomparable, so not equal + return(FALSE) } + # 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 (is.na(x[i])) { - x[i] <- "" - } - if (is.na(y[i])) { - y[i] <- "" - } - - if (x[i] == y[i]) { - - result[i] <- TRUE - - } else if (nchar(x[i]) != nchar(y[i])) { - - result[i] <- FALSE - + 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 } 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) - - 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 + } - close(p) - result + out } diff --git a/R/rsi.R b/R/rsi.R index f291ee23..2373e831 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -263,8 +263,8 @@ 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 if (all_valid_mics(x)) { diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index c5d908ac..876345a4 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/docs/404.html b/docs/404.html index 417534c7..1a586efc 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 8ab704f1..bcd73164 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 diff --git a/docs/articles/index.html b/docs/articles/index.html index 36000237..d33f8462 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 diff --git a/docs/authors.html b/docs/authors.html index a765239d..a8b7cb75 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 diff --git a/docs/index.html b/docs/index.html index ea587c7e..5a1b7688 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 diff --git a/docs/news/index.html b/docs/news/index.html index 7333015f..5451e266 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 @@ -236,9 +236,9 @@ Source: NEWS.md -
-

-AMR 1.6.0.9008 Unreleased +
+

+AMR 1.6.0.9009 Unreleased

@@ -287,6 +287,13 @@
  • 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" +
      • +
    +

    • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 4d38cacb..8e168e5c 100644 --- a/docs/pkgdown.yml +++ b/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 diff --git a/docs/reference/first_isolate.html b/docs/reference/first_isolate.html index d8a18b5f..9aa7102b 100644 --- a/docs/reference/first_isolate.html +++ b/docs/reference/first_isolate.html @@ -82,7 +82,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9009

    @@ -346,7 +346,7 @@ info -

    a logical to indicate whether a progress bar should be printed, defaults to TRUE only in interactive mode

    +

    a logical to indicate info should be printed, defaults to TRUE only in interactive mode

    include_unknown diff --git a/docs/reference/index.html b/docs/reference/index.html index bc624c91..f8a17ecc 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 diff --git a/docs/reference/key_antibiotics.html b/docs/reference/key_antibiotics.html index 64b1c99a..23646c27 100644 --- a/docs/reference/key_antibiotics.html +++ b/docs/reference/key_antibiotics.html @@ -82,7 +82,7 @@ AMR (for R) - 1.6.0.9007 + 1.6.0.9009 @@ -273,7 +273,9 @@ type = c("keyantibiotics", "points"), ignore_I = TRUE, points_threshold = 2, - info = FALSE + info = FALSE, + na.rm = TRUE, + ... )

    Arguments

    @@ -325,7 +327,11 @@ info -

    a logical to indicate whether a progress bar should be printed, defaults to TRUE only in interactive mode

    +

    unused - previously used to indicate whether a progress bar should print

    + + + na.rm +

    a logical to indicate whether comparison with NA should return FALSE (defaults to TRUE for backwards compatibility)

    diff --git a/docs/survey.html b/docs/survey.html index 73558a78..e98c581a 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9008 + 1.6.0.9009 diff --git a/man/first_isolate.Rd b/man/first_isolate.Rd index daf937d0..048e47c2 100755 --- a/man/first_isolate.Rd +++ b/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.} diff --git a/man/key_antibiotics.Rd b/man/key_antibiotics.Rd index 1186176d..13c3ac52 100755 --- a/man/key_antibiotics.Rd +++ b/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. diff --git a/tests/testthat/test-first_isolate.R b/tests/testthat/test-first_isolate.R index 2bfa7d63..b2e7b548 100755 --- a/tests/testthat/test-first_isolate.R +++ b/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(