From 68e6e1e329e5bc319f7a6665ac87ca8aa67e92d9 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Tue, 29 Sep 2020 10:40:25 +0200 Subject: [PATCH] (v1.3.0.9034) eucast_rules summary fix --- DESCRIPTION | 4 +-- NEWS.md | 4 +-- R/atc_online.R | 2 +- R/eucast_rules.R | 37 ++++++++++++++------------- R/rsi.R | 6 ++--- docs/404.html | 2 +- docs/LICENSE-text.html | 2 +- docs/articles/index.html | 2 +- docs/authors.html | 2 +- docs/index.html | 2 +- docs/news/index.html | 12 ++++----- docs/pkgdown.yml | 2 +- docs/reference/as.mo.html | 2 +- docs/reference/eucast_rules.html | 2 +- docs/reference/index.html | 2 +- docs/reference/mo_matching_score.html | 2 +- docs/reference/mo_property.html | 2 +- docs/survey.html | 2 +- tests/testthat/test-atc_online.R | 32 +++++++++++++++++++++++ tests/testthat/test-rsi.R | 6 +++++ 20 files changed, 83 insertions(+), 44 deletions(-) create mode 100644 tests/testthat/test-atc_online.R diff --git a/DESCRIPTION b/DESCRIPTION index 67d1666b8..320a78ed1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.3.0.9033 -Date: 2020-09-28 +Version: 1.3.0.9034 +Date: 2020-09-29 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 5b9ed41a3..62306a9e1 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# AMR 1.3.0.9033 -## Last updated: 28 September 2020 +# AMR 1.3.0.9034 +## Last updated: 29 September 2020 Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly! diff --git a/R/atc_online.R b/R/atc_online.R index d18487ab9..52e59520b 100644 --- a/R/atc_online.R +++ b/R/atc_online.R @@ -94,7 +94,7 @@ atc_online_property <- function(atc_code, } if (!has_internet()) { - message("There appears to be no internet connection.") + message("There appears to be no internet connection, returning NA.") return(rep(NA, length(atc_code))) } diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 42a71bf81..280ff1bc0 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -475,7 +475,6 @@ eucast_rules <- function(x, all_betalactams <- c(aminopenicillins, cephalosporins, carbapenems, ureidopenicillins, AMC, OXA, FLC, PEN) # nolint end - # Some helper functions --------------------------------------------------- get_antibiotic_columns <- function(x, df) { x <- trimws(unlist(strsplit(x, ",", fixed = TRUE))) @@ -547,6 +546,8 @@ eucast_rules <- function(x, suppressWarnings(as.rsi(x)) } + # Preparing the data ------------------------------------------------------ + verbose_info <- data.frame(rowid = character(0), col = character(0), mo_fullname = character(0), @@ -884,18 +885,16 @@ eucast_rules <- function(x, # Print overview ---------------------------------------------------------- if (info == TRUE) { - rownames(verbose_info) <- NULL - affected <- x.bak[which(x.bak$`.rowid` %in% x$`.rowid`), , drop = FALSE] - rows_affected <- as.integer(rownames(affected)) - verbose_info <- verbose_info %pm>% - pm_left_join(data.frame(row = rows_affected, - rowid = affected[, ".rowid", drop = TRUE], - stringsAsFactors = FALSE), - by = "rowid") %pm>% - pm_select(-rowid) %pm>% + verbose_info <- x.bak %pm>% + pm_mutate(row = pm_row_number()) %pm>% + pm_select(`.rowid`, row) %pm>% + pm_right_join(verbose_info, + by = c(".rowid" = "rowid")) %pm>% + pm_select(-`.rowid`) %pm>% pm_select(row, pm_everything()) %pm>% pm_filter(!is.na(new)) %pm>% pm_arrange(row, rule_group, rule_name, col) + rownames(verbose_info) <- NULL if (verbose == TRUE) { wouldve <- "would have " @@ -904,15 +903,17 @@ eucast_rules <- function(x, } cat(paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n")) - cat(font_bold(paste("The rules", paste0(wouldve, "affected"), - formatnr(pm_n_distinct(verbose_info$row)), + cat(paste0("The rules ", paste0(wouldve, "affected "), + font_bold(formatnr(pm_n_distinct(verbose_info$row)), "out of", formatnr(nrow(x.bak)), - "rows, making a total of", formatnr(nrow(verbose_info)), "edits\n"))) - - total_n_added <- verbose_info %pm>% pm_filter(is.na(old)) %pm>% nrow() - total_n_changed <- verbose_info %pm>% pm_filter(!is.na(old)) %pm>% nrow() - - # print added values + "rows"), + ", making a total of ", + font_bold(formatnr(nrow(verbose_info)), "edits\n"))) + +total_n_added <- verbose_info %pm>% pm_filter(is.na(old)) %pm>% nrow() +total_n_changed <- verbose_info %pm>% pm_filter(!is.na(old)) %pm>% nrow() + +# print added values if (total_n_added == 0) { colour <- cat # is function } else { diff --git a/R/rsi.R b/R/rsi.R index 11b3bf0d2..5f8cfb640 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -657,7 +657,7 @@ exec_as.rsi <- function(method, pm_filter(uti == FALSE) %pm>% # 'uti' is a column in rsi_translation pm_arrange(pm_desc(nchar(mo))) } - get_record <- get_record[1L, ] + get_record <- get_record[1L, , drop = FALSE] if (NROW(get_record) > 0) { if (is.na(x[i])) { @@ -670,7 +670,7 @@ exec_as.rsi <- function(method, isTRUE(conserve_capped_values) & mic_input %like% "^>[0-9]" ~ "R", # start interpreting: EUCAST uses <= S and > R, CLSI uses <=S and >= R isTRUE(which(levels(mic_input) == mic_input) <= which(levels(mic_S) == mic_S)) ~ "S", - guideline_coerced %like% "ECUAST" & + guideline_coerced %like% "EUCAST" & isTRUE(which(levels(mic_input) == mic_input) > which(levels(mic_R) == mic_R)) ~ "R", guideline_coerced %like% "CLSI" & isTRUE(which(levels(mic_input) == mic_input) >= which(levels(mic_R) == mic_R)) ~ "R", @@ -681,7 +681,7 @@ exec_as.rsi <- function(method, } else if (method == "disk") { new_rsi[i] <- quick_case_when(isTRUE(as.double(x[i]) >= as.double(get_record$breakpoint_S)) ~ "S", # start interpreting: EUCAST uses >= S and < R, CLSI uses >=S and <= R - guideline_coerced %like% "ECUAST" & + guideline_coerced %like% "EUCAST" & isTRUE(as.double(x[i]) < as.double(get_record$breakpoint_R)) ~ "R", guideline_coerced %like% "CLSI" & isTRUE(as.double(x[i]) <= as.double(get_record$breakpoint_R)) ~ "R", diff --git a/docs/404.html b/docs/404.html index 50ca67e0d..8edbb9514 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 81c88b82a..80114b851 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034 diff --git a/docs/articles/index.html b/docs/articles/index.html index 28d56e20e..066d66e5b 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034 diff --git a/docs/authors.html b/docs/authors.html index 8098f2e71..cdc5eabf4 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034 diff --git a/docs/index.html b/docs/index.html index 6f844d159..15efb8a78 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034 diff --git a/docs/news/index.html b/docs/news/index.html index 76ccaae99..12937ab70 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034 @@ -236,13 +236,13 @@ Source: NEWS.md -
-

-AMR 1.3.0.9033 Unreleased +
+

+AMR 1.3.0.9034 Unreleased

-
+

-Last updated: 28 September 2020 +Last updated: 29 September 2020

Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt to. We are those reviewers very grateful for going through our code so thoroughly!

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 69506ae36..e89ab12ac 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -2,7 +2,7 @@ pandoc: 2.7.3 pkgdown: 1.5.1.9000 pkgdown_sha: eae56f08694abebf93cdfc0dd8e9ede06d8c815f articles: [] -last_built: 2020-09-28T09:00Z +last_built: 2020-09-29T08:40Z urls: reference: https://msberends.github.io/AMR/reference article: https://msberends.github.io/AMR/articles diff --git a/docs/reference/as.mo.html b/docs/reference/as.mo.html index 5ddfb2c64..0a01d8590 100644 --- a/docs/reference/as.mo.html +++ b/docs/reference/as.mo.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034
diff --git a/docs/reference/eucast_rules.html b/docs/reference/eucast_rules.html index 1a7ad6b52..b18abc3f9 100644 --- a/docs/reference/eucast_rules.html +++ b/docs/reference/eucast_rules.html @@ -83,7 +83,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied AMR (for R) - 1.3.0.9033 + 1.3.0.9034
diff --git a/docs/reference/index.html b/docs/reference/index.html index c4492f080..c6cebf8e7 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034
diff --git a/docs/reference/mo_matching_score.html b/docs/reference/mo_matching_score.html index dd3407184..8eb4b745c 100644 --- a/docs/reference/mo_matching_score.html +++ b/docs/reference/mo_matching_score.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034
diff --git a/docs/reference/mo_property.html b/docs/reference/mo_property.html index a9fcddb1e..ea45d73cb 100644 --- a/docs/reference/mo_property.html +++ b/docs/reference/mo_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034

diff --git a/docs/survey.html b/docs/survey.html index a029d79a8..ba8108018 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.3.0.9033 + 1.3.0.9034 diff --git a/tests/testthat/test-atc_online.R b/tests/testthat/test-atc_online.R new file mode 100644 index 000000000..46d88a98d --- /dev/null +++ b/tests/testthat/test-atc_online.R @@ -0,0 +1,32 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Analysis # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2020 Berends MS, Luz CF et al. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# Visit our website for more info: https://msberends.github.io/AMR. # +# ==================================================================== # + +context("atc_online.R") + +test_that("atc_online works", { + skip_on_cran() + skip_if_not(curl::has_internet()) + + expect_gte(length(atc_online_groups(ab_atc("AMX"))), 1) + expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "O"), 1.5) + expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "P"), 3) + expect_warning(atc_online_ddd(ab_atc("Novobiocin"), administration = "P")) +}) diff --git a/tests/testthat/test-rsi.R b/tests/testthat/test-rsi.R index dc4a398ef..4a3255f52 100644 --- a/tests/testthat/test-rsi.R +++ b/tests/testthat/test-rsi.R @@ -97,6 +97,12 @@ test_that("mic2rsi works", { guideline = "EUCAST")), "I") + # cutoffs at MIC = 8 + expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"), + as.rsi("S")) + expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"), + as.rsi("R")) + expect_true(example_isolates %>% mutate(amox_mic = as.mic(2)) %>% select(mo, amox_mic) %>%