From 2ed5f138806fcd27806ac73cd5a398a4ae97a92a Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Sun, 28 Aug 2022 21:13:26 +0200 Subject: [PATCH] Fixes #57 --- .github/prehooks/pre-commit | 11 +++++------ .github/workflows/check.yaml | 2 +- DESCRIPTION | 2 +- NEWS.md | 3 ++- R/ab.R | 15 +++++++++++---- R/ab_property.R | 6 +++++- 6 files changed, 25 insertions(+), 14 deletions(-) diff --git a/.github/prehooks/pre-commit b/.github/prehooks/pre-commit index 7f3c615b..d8f9058f 100755 --- a/.github/prehooks/pre-commit +++ b/.github/prehooks/pre-commit @@ -3,29 +3,28 @@ echo "Running pre-commit hook..." # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -echo ">> Updating R documentation..." if command -v Rscript > /dev/null; then if [ "$(Rscript -e 'cat(all(c('"'pkgload'"', '"'devtools'"', '"'dplyr'"', '"'styler'"') %in% rownames(installed.packages())))')" = "TRUE" ]; then Rscript -e "source('data-raw/_pre_commit_hook.R')" currentpkg=`Rscript -e "cat(pkgload::pkg_name())"` - echo ">> Adding all files in folders 'data-raw', 'inst', 'man', and 'R' to this git commit" + echo "-> Adding all files in folders 'data-raw', 'inst', 'man', and 'R' to this git commit" git add data-raw/* git add inst/* git add man/* git add R/* else - echo ">> R package 'pkgload', 'devtools', 'dplyr', or 'styler' not installed!" + echo "- R package 'pkgload', 'devtools', 'dplyr', or 'styler' not installed!" currentpkg="your" fi else - echo ">> R is not available on your system!" + echo "- R is not available on your system!" currentpkg="your" fi -echo ">> " +echo "" # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -echo ">> Updating semantic versioning and date..." +echo ">> Updating semantic versioning and date..." # get tags from remote, and remove tags not on remote: git fetch origin --prune --prune-tags --quiet diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 21381de7..75c8cf16 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -130,7 +130,7 @@ jobs: _R_CHECK_LENGTH_1_CONDITION_: verbose _R_CHECK_LENGTH_1_LOGIC2_: verbose # no check for old R versions - these packages require higher R versions - _R_CHECK_RD_XREFS_: {{ matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2' && matrix.config.r != '3.3' && matrix.config.r != '3.4' }} + _R_CHECK_RD_XREFS_: ${{ matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2' && matrix.config.r != '3.3' && matrix.config.r != '3.4' }} _R_CHECK_FORCE_SUGGESTS_: false R_CHECK_CONSTANTS: 5 R_JIT_STRATEGY: 3 diff --git a/DESCRIPTION b/DESCRIPTION index 6103ea2b..fc7e05f5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 1.8.1.9042 +Version: 1.8.1.9043 Date: 2022-08-28 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NEWS.md b/NEWS.md index e5ffd8c1..3b608e55 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.8.1.9042 +# AMR 1.8.1.9043 ### New * EUCAST 2022 and CLSI 2022 guidelines have been added for `as.rsi()`. EUCAST 2022 is now the new default guideline for all MIC and disks diffusion interpretations. @@ -21,6 +21,7 @@ * All data sets in this package are now exported as `tibble`, instead of base R `data.frame`s. Older R versions are still supported. * Automatic language determination will give a note once a session * For all interpretation guidelines using `as.rsi()` on amoxicillin, the rules for ampicillin will be used if amoxicillin rules are not available +* Fix for using `ab_atc()` on non-existing ATC codes ### Other * New website to make use of the new Bootstrap 5 and pkgdown v2.0. The website now contains results for all examples and will be automatically regenerated with every change to our repository, using GitHub Actions diff --git a/R/ab.R b/R/ab.R index e10db2dd..a6e5784d 100755 --- a/R/ab.R +++ b/R/ab.R @@ -125,6 +125,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { x <- unique(x_bak_clean) # this means that every x is in fact generalise_antibiotic_name(x) x_new <- rep(NA_character_, length(x)) x_unknown <- character(0) + x_unknown_ATCs <- character(0) note_if_more_than_one_found <- function(found, index, from_text) { if (initial_search == TRUE & isTRUE(length(from_text) > 1)) { @@ -183,6 +184,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1]) next } + if (x[i] %like_case% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]") { + # seems an ATC code, but the available ones are in `already_known`, so: + x_unknown <- c(x_unknown, x[i]) + x_unknown_ATCs <- c(x_unknown_ATCs, x[i]) + x_new[i] <- NA_character_ + next + } if (fast_mode == FALSE && flag_multiple_results == TRUE && x[i] %like% "[ ]") { from_text <- tryCatch(suppressWarnings(ab_from_text(x[i], initial_search = FALSE, translate_ab = FALSE)[[1]]), @@ -474,16 +482,15 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { } # take failed ATC codes apart from rest - x_unknown_ATCs <- x_unknown[x_unknown %like% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]"] - x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs] - if (length(x_unknown_ATCs) > 0 & fast_mode == FALSE) { + if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) { warning_( "in `as.ab()`: these ATC codes are not (yet) in the antibiotics data set: ", vector_and(x_unknown_ATCs), "." ) } + x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs] - if (length(x_unknown) > 0 & fast_mode == FALSE) { + if (length(x_unknown) > 0 && fast_mode == FALSE) { warning_( "in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ", vector_and(x_unknown), "." diff --git a/R/ab_property.R b/R/ab_property.R index c9f81856..67cd9e81 100644 --- a/R/ab_property.R +++ b/R/ab_property.R @@ -457,7 +457,11 @@ ab_validate <- function(x, property, ...) { if (!all(x %in% AB_lookup[, property, drop = TRUE])) { x <- as.ab(x, ...) - x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE] + if (all(is.na(x)) && is.list(AB_lookup[, property, drop = TRUE])) { + x <- rep(NA_character_, length(x)) + } else { + x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE] + } } }