diff --git a/DESCRIPTION b/DESCRIPTION index 2e6fe735..19211786 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.7.1.9014 -Date: 2021-07-06 +Version: 1.7.1.9015 +Date: 2021-07-07 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 861eed8f..c6e59f00 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,24 +20,20 @@ S3method("[",ab) S3method("[",disk) S3method("[",mic) S3method("[",mo) -S3method("[",taxonomic_name) S3method("[<-",ab) S3method("[<-",disk) S3method("[<-",mic) S3method("[<-",mo) S3method("[<-",rsi) -S3method("[<-",taxonomic_name) S3method("[[",ab) S3method("[[",disk) S3method("[[",mic) S3method("[[",mo) -S3method("[[",taxonomic_name) S3method("[[<-",ab) S3method("[[<-",disk) S3method("[[<-",mic) S3method("[[<-",mo) S3method("[[<-",rsi) -S3method("[[<-",taxonomic_name) S3method("^",mic) S3method("|",mic) S3method(abs,mic) @@ -51,7 +47,6 @@ S3method(any,ab_selector_any_all) S3method(any,mic) S3method(as.data.frame,ab) S3method(as.data.frame,mo) -S3method(as.data.frame,taxonomic_name) S3method(as.double,mic) S3method(as.integer,mic) S3method(as.list,custom_eucast_rules) @@ -77,7 +72,6 @@ S3method(c,disk) S3method(c,mic) S3method(c,mo) S3method(c,rsi) -S3method(c,taxonomic_name) S3method(ceiling,mic) S3method(cos,mic) S3method(cosh,mic) @@ -93,7 +87,6 @@ S3method(exp,mic) S3method(expm1,mic) S3method(floor,mic) S3method(format,bug_drug_combinations) -S3method(format,taxonomic_name) S3method(gamma,mic) S3method(hist,mic) S3method(kurtosis,data.frame) @@ -124,7 +117,6 @@ S3method(print,mo_renamed) S3method(print,mo_uncertainties) S3method(print,pca) S3method(print,rsi) -S3method(print,taxonomic_name) S3method(prod,mic) S3method(quantile,mic) S3method(range,mic) @@ -133,7 +125,6 @@ S3method(rep,disk) S3method(rep,mic) S3method(rep,mo) S3method(rep,rsi) -S3method(rep,taxonomic_name) S3method(round,mic) S3method(sign,mic) S3method(signif,mic) @@ -160,7 +151,6 @@ S3method(unique,disk) S3method(unique,mic) S3method(unique,mo) S3method(unique,rsi) -S3method(unique,taxonomic_name) export("%like%") export("%like_case%") export("%unlike%") diff --git a/NEWS.md b/NEWS.md index f6ecc759..44d78f26 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# `AMR` 1.7.1.9014 -## Last updated: 6 July 2021 +# `AMR` 1.7.1.9015 +## Last updated: 7 July 2021 ### Changed * Antibiotic class selectors (see `ab_class()`) diff --git a/R/mo.R b/R/mo.R index 30cae30d..ffac04b6 100755 --- a/R/mo.R +++ b/R/mo.R @@ -473,7 +473,7 @@ exec_as.mo <- function(x, langs <- LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"] for (l in langs) { for (i in seq_len(nrow(trns))) { - if (!is.na(trns[i, l, drop = TRUE])) { + if (!is.na(trns[i, l, drop = TRUE]) && trns[i, l, drop = TRUE] %unlike% "\\\\1") { x <- gsub(pattern = trns[i, l, drop = TRUE], replacement = trns$pattern[i], x = x, diff --git a/R/mo_property.R b/R/mo_property.R index 5cb37cbb..000e94de 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -48,8 +48,6 @@ #' #' Intrinsic resistance - [mo_is_intrinsic_resistant()] - will be determined based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.2)`. The [mo_is_intrinsic_resistant()] functions can be vectorised over arguments `x` (input for microorganisms) and over `ab` (input for antibiotics). #' -#' The functions [mo_family()], [mo_genus()], [mo_name()], [mo_fullname()] and [mo_shortname()] are returned with an additional class `taxonomic_name`, which allows italic printing in [tibbles][tibble::tibble()] and markdown tables such as with [knitr::kable()]. -#' #' All output [will be translated][translate] where possible. #' #' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. @@ -65,7 +63,6 @@ #' - A [list] in case of [mo_taxonomy()] and [mo_info()] #' - A named [character] in case of [mo_url()] #' - A [numeric] in case of [mo_snomed()] -#' - A [character] with additional class `taxonomic_name` in case of [mo_family()], [mo_genus()], [mo_name()], [mo_fullname()] and [mo_shortname()] #' - A [character] in all other cases #' @export #' @seealso Data set [microorganisms] @@ -225,8 +222,7 @@ mo_shortname <- function(x, language = get_locale(), ...) { shortnames[is.na(x.mo)] <- NA_character_ load_mo_failures_uncertainties_renamed(metadata) - out <- translate_AMR(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE) - set_clean_class(out, new_class = c("taxonomic_name", "character")) + translate_AMR(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE) } @@ -744,9 +740,6 @@ mo_validate <- function(x, property, language, ...) { if (property == "mo") { return(set_clean_class(x, new_class = c("mo", "character"))) - } else if (property %in% c("fullname", "genus", "family")) { - # shortname is considered in mo_shortname() - return(set_clean_class(x, new_class = c("taxonomic_name", "character"))) } else if (property == "snomed") { return(as.double(eval(parse(text = x)))) } else { @@ -772,111 +765,3 @@ find_mo_col <- function(fn) { stop_("argument `x` is missing and no column with info about microorganisms could be found.", call = -2) } } - -#' @method print taxonomic_name -#' @export -#' @noRd -print.taxonomic_name <- function(x, ...) { - print(unclass(x), ...) -} - -#' @method as.data.frame taxonomic_name -#' @export -#' @noRd -as.data.frame.taxonomic_name <- function(x, ...) { - nm <- deparse1(substitute(x)) - if (!"nm" %in% names(list(...))) { - as.data.frame.vector(x, ..., nm = nm) - } else { - as.data.frame.vector(x, ...) - } -} - -# will be exported using s3_register() in R/zzz.R -type_sum.taxonomic_name <- function(x, ...) { - "chr/taxon" -} - -# will be exported using s3_register() in R/zzz.R -pillar_shaft.taxonomic_name <- function(x, ...) { - out <- format(x) - hits <- tolower(x) %in% MO_lookup$fullname_lower | tolower(gsub("[^a-zA-Z ]", "", x)) %in% c(MO_lookup$g_species) - out[hits] <- font_italic(x[hits], collapse = NULL) - out[is.na(x)] <- font_na(out[is.na(x)], collapse = NULL) - create_pillar_column(out, align = "left") -} - -#' @method format taxonomic_name -#' @export -#' @noRd -format.taxonomic_name <- function(x, ...) { - # format only in case of markdown knitting - x <- unclass(x) - if (any(as.character(sys.calls()) %like% "(^|:| )kable\\(") || - tryCatch(!is.null(knitr::opts_knit$get("out.format")), error = function(e) FALSE) || - tryCatch(isTRUE(getOption('knitr.in.progress')), error = function(e) FALSE)) { - # perhaps this could be extended or better specified in the future? - hits <- tolower(x) %in% MO_lookup$fullname_lower | tolower(gsub("[^a-zA-Z ]", "", x)) %in% c(MO_lookup$g_species) - x[hits] <- paste0("*", x[hits], "*") - } - x -} - -#' @method [ taxonomic_name -#' @export -#' @noRd -"[.taxonomic_name" <- function(x, ...) { - y <- NextMethod() - attributes(y) <- attributes(x) - y -} -#' @method [[ taxonomic_name -#' @export -#' @noRd -"[[.taxonomic_name" <- function(x, ...) { - y <- NextMethod() - attributes(y) <- attributes(x) - y -} -#' @method [<- taxonomic_name -#' @export -#' @noRd -"[<-.taxonomic_name" <- function(i, j, ..., value) { - value <- set_clean_class(value, c("taxonomic_name", "character")) - y <- NextMethod() - attributes(y) <- attributes(i) - y -} -#' @method [[<- taxonomic_name -#' @export -#' @noRd -"[[<-.taxonomic_name" <- function(i, j, ..., value) { - value <- set_clean_class(value, c("taxonomic_name", "character")) - y <- NextMethod() - attributes(y) <- attributes(i) - y -} -#' @method c taxonomic_name -#' @export -#' @noRd -c.taxonomic_name <- function(...) { - set_clean_class(unlist(lapply(list(...), as.character)), c("taxonomic_name", "character")) -} - -#' @method unique taxonomic_name -#' @export -#' @noRd -unique.taxonomic_name <- function(x, incomparables = FALSE, ...) { - y <- NextMethod() - attributes(y) <- attributes(x) - y -} - -#' @method rep taxonomic_name -#' @export -#' @noRd -rep.taxonomic_name <- function(x, ...) { - y <- NextMethod() - attributes(y) <- attributes(x) - y -} diff --git a/R/zzz.R b/R/zzz.R index 8ddfaa06..da6e8ce0 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -48,13 +48,11 @@ if (utf8_supported && !is_latex) { s3_register("pillar::pillar_shaft", "rsi") s3_register("pillar::pillar_shaft", "mic") s3_register("pillar::pillar_shaft", "disk") - s3_register("pillar::pillar_shaft", "taxonomic_name") s3_register("tibble::type_sum", "ab") s3_register("tibble::type_sum", "mo") s3_register("tibble::type_sum", "rsi") s3_register("tibble::type_sum", "mic") s3_register("tibble::type_sum", "disk") - s3_register("tibble::type_sum", "taxonomic_name") # Support for frequency tables from the cleaner package s3_register("cleaner::freq", "mo") s3_register("cleaner::freq", "rsi") diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index cfa3954f..4978707f 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/data-raw/rsi.md5 b/data-raw/rsi.md5 index 695e1d8b..ee35a907 100644 --- a/data-raw/rsi.md5 +++ b/data-raw/rsi.md5 @@ -1 +1 @@ -7c7f6a0ecfc2e122c4547c0ebed09346 +1a7fe52f8185c9bb2c470712863d1887 diff --git a/data-raw/rsi_translation.dta b/data-raw/rsi_translation.dta index 3221763e..18dc43a7 100644 Binary files a/data-raw/rsi_translation.dta and b/data-raw/rsi_translation.dta differ diff --git a/data-raw/rsi_translation.rds b/data-raw/rsi_translation.rds index 84fc44e8..7c32865d 100644 Binary files a/data-raw/rsi_translation.rds and b/data-raw/rsi_translation.rds differ diff --git a/data-raw/rsi_translation.sas b/data-raw/rsi_translation.sas index 4249c002..0662a4c0 100644 Binary files a/data-raw/rsi_translation.sas and b/data-raw/rsi_translation.sas differ diff --git a/data-raw/rsi_translation.sav b/data-raw/rsi_translation.sav index 7f9e7c4b..ca4ad0cc 100644 Binary files a/data-raw/rsi_translation.sav and b/data-raw/rsi_translation.sav differ diff --git a/docs/404.html b/docs/404.html index f2c66511..e1537850 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9014 + 1.7.1.9015 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 6a916de0..8c4a16ea 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9014 + 1.7.1.9015 diff --git a/docs/articles/datasets.html b/docs/articles/datasets.html index 763b3aae..567fbd03 100644 --- a/docs/articles/datasets.html +++ b/docs/articles/datasets.html @@ -39,7 +39,7 @@ AMR (for R) - 1.7.1.9014 + 1.7.1.9015 @@ -192,7 +192,7 @@ diff --git a/docs/authors.html b/docs/authors.html index 7859cbd9..4d3fe390 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9014 + 1.7.1.9015 diff --git a/docs/index.html b/docs/index.html index 499fd70a..e9136774 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.7.1.9014 + 1.7.1.9015 diff --git a/docs/news/index.html b/docs/news/index.html index 56288c69..8ba97cde 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9014 + 1.7.1.9015 @@ -236,12 +236,12 @@ Source: NEWS.md -
-

- Unreleased AMR 1.7.1.9014

-
+
+

+ Unreleased AMR 1.7.1.9015

+

-Last updated: 6 July 2021 +Last updated: 7 July 2021

@@ -326,7 +326,7 @@
  • Function betalactams() as additional antbiotic column selector and function filter_betalactams() as additional antbiotic column filter. The group of betalactams consists of all carbapenems, cephalosporins and penicillins.
  • -
  • A ggplot() method for resistance_predict() +
  • A ggplot() method for resistance_predict()
  • @@ -427,7 +427,7 @@ #> Filtering on oxazolidinones: value in column `LNZ` (linezolid) is either "R", "S" or "I"
  • Support for custom MDRO guidelines, using the new custom_mdro_guideline() function, please see mdro() for additional info

  • -
  • ggplot() generics for classes <mic> and <disk>

  • +
  • ggplot() generics for classes <mic> and <disk>

  • Function mo_is_yeast(), which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales:

    @@ -484,7 +484,7 @@
     
  • Plotting of MIC and disk diffusion values now support interpretation colouring if you supply the microorganism and antimicrobial agent
  • All colours were updated to colour-blind friendly versions for values R, S and I for all plot methods (also applies to tibble printing)
  • Interpretation of MIC and disk diffusion values to R/SI will now be translated if the system language is German, Dutch or Spanish (see translate)
  • -
  • Plotting is now possible with base R using plot() and with ggplot2 using ggplot() on any vector of MIC and disk diffusion values
  • +
  • Plotting is now possible with base R using plot() and with ggplot2 using ggplot() on any vector of MIC and disk diffusion values
  • Updated SNOMED codes to US Edition of SNOMED CT from 1 September 2020 and added the source to the help page of the microorganisms data set
  • @@ -836,7 +836,7 @@

    Making this package independent of especially the tidyverse (e.g. packages dplyr and tidyr) tremendously increases sustainability on the long term, since tidyverse functions change quite often. Good for users, but hard for package maintainers. Most of our functions are replaced with versions that only rely on base R, which keeps this package fully functional for many years to come, without requiring a lot of maintenance to keep up with other packages anymore. Another upside it that this package can now be used with all versions of R since R-3.0.0 (April 2013). Our package is being used in settings where the resources are very limited. Fewer dependencies on newer software is helpful for such settings.

    Negative effects of this change are:

      -
    • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
    • +
    • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
    • Printing values of class mo or rsi in a tibble will no longer be in colour and printing rsi in a tibble will show the class <ord>, not <rsi> anymore. This is purely a visual effect.
    • All functions from the mo_* family (like mo_name() and mo_gramstain()) are noticeably slower when running on hundreds of thousands of rows.
    • For developers: classes mo and ab now both also inherit class character, to support any data transformation. This change invalidates code that checks for class length == 1.
    • @@ -1168,7 +1168,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/ #> invalid microorganism code, NA generated

    This is important, because a value like "testvalue" could never be understood by e.g. mo_name(), although the class would suggest a valid microbial code.

    -
  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

  • +
  • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

  • Renamed data set septic_patients to example_isolates

  • @@ -1435,7 +1435,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • The age() function gained a new argument exact to determine ages with decimals
  • Removed deprecated functions guess_mo(), guess_atc(), EUCAST_rules(), interpretive_reading(), rsi()
  • -
  • Frequency tables (freq()): +
  • Frequency tables (freq()): @@ -1460,7 +1460,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • Added ceftazidim intrinsic resistance to Streptococci
  • Changed default settings for age_groups(), to let groups of fives and tens end with 100+ instead of 120+
  • -
  • Fix for freq() for when all values are NA +
  • Fix for freq() for when all values are NA
  • Fix for first_isolate() for when dates are missing
  • Improved speed of guess_ab_col() @@ -1699,7 +1699,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • -
  • Frequency tables (freq() function): +
  • Frequency tables (freq() function):
  • + freq(mo_genus(mo))
  • Header info is now available as a list, with the header function

  • The argument header is now set to TRUE at default, even for markdown

  • @@ -1799,7 +1799,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • Using portion_* functions now throws a warning when total available isolate is below argument minimum

  • Functions as.mo, as.rsi, as.mic, as.atc and freq will not set package name as attribute anymore

  • -

    Frequency tables - freq():

    +

    Frequency tables - freq():

    @@ -2078,13 +2078,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/ @@ -352,7 +351,6 @@

    The Gram stain - mo_gramstain() - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, PMID 11837318), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value NA. Functions mo_is_gram_negative() and mo_is_gram_positive() always return TRUE or FALSE (except when the input is NA or the MO code is UNKNOWN), thus always return FALSE for species outside the taxonomic kingdom of Bacteria.

    Determination of yeasts - mo_is_yeast() - will be based on the taxonomic kingdom and class. Budding yeasts are fungi of the phylum Ascomycetes, class Saccharomycetes (also called Hemiascomycetes). True yeasts are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are fungi and member of the taxonomic class Saccharomycetes, the function will return TRUE. It returns FALSE otherwise (except when the input is NA or the MO code is UNKNOWN).

    Intrinsic resistance - mo_is_intrinsic_resistant() - will be determined based on the intrinsic_resistant data set, which is based on 'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2 (2020). The mo_is_intrinsic_resistant() functions can be vectorised over arguments x (input for microorganisms) and over ab (input for antibiotics).

    -

    The functions mo_family(), mo_genus(), mo_name(), mo_fullname() and mo_shortname() are returned with an additional class taxonomic_name, which allows italic printing in tibbles and markdown tables such as with knitr::kable().

    All output will be translated where possible.

    The function mo_url() will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.

    SNOMED codes - mo_snomed() - are from the US Edition of SNOMED CT from 1 September 2020. See Source and the microorganisms data set for more info.

    diff --git a/docs/survey.html b/docs/survey.html index 77d54271..a694a586 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.7.1.9014 + 1.7.1.9015 diff --git a/inst/tinytest/test-ab_property.R b/inst/tinytest/test-ab_property.R index 54389985..c22a0420 100644 --- a/inst/tinytest/test-ab_property.R +++ b/inst/tinytest/test-ab_property.R @@ -25,7 +25,7 @@ expect_identical(ab_name("AMX", language = NULL), "Amoxicillin") expect_identical(ab_name("AMX", language = NULL, snake_case = TRUE), "amoxicillin") -expect_identical(as.character(ab_atc("AMX")), "J01CA04") +expect_identical(ab_atc("AMX"), "J01CA04") expect_identical(ab_cid("AMX"), as.integer(33613)) expect_inherits(ab_tradenames("AMX"), "character") diff --git a/man/mo_property.Rd b/man/mo_property.Rd index d602557f..db521e76 100644 --- a/man/mo_property.Rd +++ b/man/mo_property.Rd @@ -106,7 +106,6 @@ mo_property(x, property = "fullname", language = get_locale(), ...) \item A \link{list} in case of \code{\link[=mo_taxonomy]{mo_taxonomy()}} and \code{\link[=mo_info]{mo_info()}} \item A named \link{character} in case of \code{\link[=mo_url]{mo_url()}} \item A \link{numeric} in case of \code{\link[=mo_snomed]{mo_snomed()}} -\item A \link{character} with additional class \code{taxonomic_name} in case of \code{\link[=mo_family]{mo_family()}}, \code{\link[=mo_genus]{mo_genus()}}, \code{\link[=mo_name]{mo_name()}}, \code{\link[=mo_fullname]{mo_fullname()}} and \code{\link[=mo_shortname]{mo_shortname()}} \item A \link{character} in all other cases } } @@ -131,8 +130,6 @@ Determination of yeasts - \code{\link[=mo_is_yeast]{mo_is_yeast()}} - will be ba Intrinsic resistance - \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} - will be determined based on the \link{intrinsic_resistant} data set, which is based on \href{https://www.eucast.org/expert_rules_and_intrinsic_resistance/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.2} (2020). The \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} functions can be vectorised over arguments \code{x} (input for microorganisms) and over \code{ab} (input for antibiotics). -The functions \code{\link[=mo_family]{mo_family()}}, \code{\link[=mo_genus]{mo_genus()}}, \code{\link[=mo_name]{mo_name()}}, \code{\link[=mo_fullname]{mo_fullname()}} and \code{\link[=mo_shortname]{mo_shortname()}} are returned with an additional class \code{taxonomic_name}, which allows italic printing in \link[tibble:tibble]{tibbles} and markdown tables such as with \code{\link[knitr:kable]{knitr::kable()}}. - All output \link[=translate]{will be translated} where possible. The function \code{\link[=mo_url]{mo_url()}} will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.