Browse Source

(v1.3.0.9014) as.mo() speed improvement

pull/67/head
parent
commit
c4b87fe241
  1. 5
      DESCRIPTION
  2. 15
      NEWS.md
  3. 14
      R/aa_helper_functions.R
  4. 2
      R/ab.R
  5. 4
      R/ab_property.R
  6. 6
      R/atc_online.R
  7. 8
      R/availability.R
  8. 4
      R/bug_drug_combinations.R
  9. 12
      R/data.R
  10. 4
      R/disk.R
  11. 4
      R/first_isolate.R
  12. 2
      R/guess_ab_col.R
  13. 8
      R/kurtosis.R
  14. 29
      R/like.R
  15. 4
      R/mdro.R
  16. 4
      R/mic.R
  17. 75
      R/mo.R
  18. 15
      R/mo_property.R
  19. 14
      R/mo_source.R
  20. 2
      R/rsi.R
  21. 6
      R/rsi_calc.R
  22. 6
      R/skewness.R
  23. BIN
      R/sysdata.rda
  24. 46
      R/translate.R
  25. 4
      R/zzz.R
  26. 137
      _pkgdown.yml
  27. BIN
      data-raw/antibiotics.dta
  28. BIN
      data-raw/antibiotics.sas
  29. BIN
      data-raw/antibiotics.sav
  30. BIN
      data-raw/antibiotics.xlsx
  31. BIN
      data-raw/antivirals.dta
  32. BIN
      data-raw/antivirals.sas
  33. BIN
      data-raw/antivirals.sav
  34. BIN
      data-raw/antivirals.xlsx
  35. BIN
      data-raw/intrinsic_resistant.dta
  36. BIN
      data-raw/intrinsic_resistant.sas
  37. BIN
      data-raw/intrinsic_resistant.sav
  38. BIN
      data-raw/intrinsic_resistant.xlsx
  39. BIN
      data-raw/microorganisms.dta
  40. BIN
      data-raw/microorganisms.old.dta
  41. BIN
      data-raw/microorganisms.old.sas
  42. BIN
      data-raw/microorganisms.old.sav
  43. BIN
      data-raw/microorganisms.old.xlsx
  44. BIN
      data-raw/microorganisms.sas
  45. BIN
      data-raw/microorganisms.sav
  46. BIN
      data-raw/microorganisms.xlsx
  47. 3
      data-raw/reproduction_of_microorganisms.R
  48. BIN
      data-raw/rsi_translation.dta
  49. BIN
      data-raw/rsi_translation.sas
  50. BIN
      data-raw/rsi_translation.sav
  51. BIN
      data-raw/rsi_translation.xlsx
  52. 6
      data-raw/translations.tsv
  53. BIN
      data/microorganisms.rda
  54. 4
      docs/404.html
  55. 4
      docs/LICENSE-text.html
  56. 20
      docs/articles/datasets.html
  57. 4
      docs/articles/index.html
  58. 4
      docs/authors.html
  59. 5
      docs/extra.css
  60. 4
      docs/index.html
  61. 84
      docs/news/index.html
  62. 2
      docs/pkgdown.yml
  63. 16
      docs/reference/WHONET.html
  64. 10
      docs/reference/ab_property.html
  65. 10
      docs/reference/as.ab.html
  66. 14
      docs/reference/as.disk.html
  67. 14
      docs/reference/as.mic.html
  68. 25
      docs/reference/as.mo.html
  69. 10
      docs/reference/as.rsi.html
  70. 16
      docs/reference/atc_online.html
  71. 5
      docs/reference/bug_drug_combinations.html
  72. 299
      docs/reference/index.html
  73. 8
      docs/reference/like.html
  74. 10
      docs/reference/microorganisms.codes.html
  75. 18
      docs/reference/mo_property.html
  76. 11
      docs/reference/translate.html
  77. 4
      docs/survey.html
  78. 10
      man/WHONET.Rd
  79. 2
      man/ab_property.Rd
  80. 2
      man/as.ab.Rd
  81. 4
      man/as.disk.Rd
  82. 4
      man/as.mic.Rd
  83. 15
      man/as.mo.Rd
  84. 2
      man/as.rsi.Rd
  85. 12
      man/atc_online.Rd
  86. 2
      man/bug_drug_combinations.Rd
  87. 4
      man/like.Rd
  88. 2
      man/microorganisms.codes.Rd
  89. 8
      man/mo_property.Rd
  90. 8
      man/translate.Rd
  91. 5
      pkgdown/extra.css
  92. 22
      tests/testthat/test-ab_property.R
  93. 4
      vignettes/datasets.Rmd

5
DESCRIPTION

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
Package: AMR
Version: 1.3.0.9013
Date: 2020-08-29
Version: 1.3.0.9014
Date: 2020-09-03
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(role = c("aut", "cre"),
@ -49,6 +49,7 @@ Suggests: @@ -49,6 +49,7 @@ Suggests:
microbenchmark,
readxl,
rmarkdown,
rstudioapi,
rvest,
testthat,
tidyr,

15
NEWS.md

@ -1,5 +1,7 @@ @@ -1,5 +1,7 @@
# AMR 1.3.0.9013
## <small>Last updated: 29 August 2020</small>
# AMR 1.3.0.9014
## <small>Last updated: 3 September 2020</small>
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!
### New
* A new vignette and website page with info about all our public and freely available data sets, that can be downloaded as flat files or in formats for use in R, SPSS, SAS, Stata and Excel: https://msberends.github.io/AMR/articles/datasets.html
@ -16,6 +18,7 @@ @@ -16,6 +18,7 @@
```
### Changed
* Although advertised that this package should work under R 3.0.0, we still had a dependency on R 3.6.0. This is fixed, meaning that our package should now work under R 3.0.0.
* Improvements for `as.rsi()`:
* Support for using `dplyr`'s `across()` to interpret MIC values or disk zone diameters, which also automatically determines the column with microorganism names or codes.
```r
@ -35,6 +38,10 @@ @@ -35,6 +38,10 @@
#> Class <disk>
#> [1] 24 24
```
* Improvements for `as.mo()`:
* Big speed improvement for already valid microorganism ID. This also means an significant speed improvement for using `mo_*` functions like `mo_name()` on microoganism IDs.
* Added parameter `ignore_pattern` to `as.mo()` which can also be given to `mo_*` functions like `mo_name()`, to exclude known non-relevant input from analysing. This can also be set with the option `AMR_ignore_pattern`.
* `get_locale()` now uses `Sys.getlocale()` instead of `Sys.getlocale("LC_COLLATE")`
* Speed improvement for `eucast_rules()`
* Overall speed improvement by tweaking joining functions
* Function `mo_shortname()` now returns the genus for input where the species is unknown
@ -42,6 +49,10 @@ @@ -42,6 +49,10 @@
* Added a feature from AMR 1.1.0 and earlier again, but now without other package dependencies: `tibble` printing support for classes `<rsi>`, `<mic>`, `<disk>`, `<ab>` and `<mo>`. When using `tibble`s containing antimicrobial columns (class `<rsi>`), "S" will print in green, "I" will print in yellow and "R" will print in red. Microbial IDs (class `<mo>`) will emphasise on the genus and species, not on the kingdom.
* Names of antiviral agents in data set `antivirals` now have a starting capital letter, like it is the case in the `antibiotics` data set
### Other
* Removed unnecessary references to the `base` package
* Added packages that could be useful for some functions to the `Suggests` field of the `DESCRIPTION` file
# AMR 1.3.0
### New

14
R/aa_helper_functions.R

@ -48,7 +48,7 @@ distinct.default <- function(.data, ..., .keep_all = FALSE) { @@ -48,7 +48,7 @@ distinct.default <- function(.data, ..., .keep_all = FALSE) {
distinct.grouped_data <- function(.data, ..., .keep_all = FALSE) {
apply_grouped_function(.data, "distinct", ..., .keep_all = .keep_all)
}
# faster implementation of left_join than using base::merge() by poorman - we use base::match():
# faster implementation of left_join than using merge() by poorman - we use match():
left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
if (is.null(by)) {
by <- intersect(names(x), names(y))[1L]
@ -606,7 +606,7 @@ percentage <- function(x, digits = NULL, ...) { @@ -606,7 +606,7 @@ percentage <- function(x, digits = NULL, ...) {
}
# prevent dependency on package 'backports'
# these functions were not available in previous versions of R (last checked: R 4.0.0)
# these functions were not available in previous versions of R (last checked: R 4.0.2)
# see here for the full list: https://github.com/r-lib/backports
strrep <- function(x, times) {
x <- as.character(x)
@ -636,8 +636,14 @@ deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) { @@ -636,8 +636,14 @@ deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) {
paste(deparse(expr, width.cutoff, ...), collapse = collapse)
}
file.size <- function(...) {
base::file.info(...)$size
file.info(...)$size
}
file.mtime <- function(...) {
base::file.info(...)$mtime
file.info(...)$mtime
}
str2lang <- function(s) {
stopifnot(length(s) == 1L)
ex <- parse(text = s, keep.source=FALSE)
stopifnot(length(ex) == 1L)
ex[[1L]]
}

2
R/ab.R

@ -19,7 +19,7 @@ @@ -19,7 +19,7 @@
# Visit our website for more info: https://msberends.github.io/AMR. #
# ==================================================================== #
#' Transform to antibiotic ID
#' Transform input to an antibiotic ID
#'
#' Use this function to determine the antibiotic code of one or more antibiotics. The data set [antibiotics] will be searched for abbreviations, official names and synonyms (brand names).
#' @inheritSection lifecycle Maturing lifecycle

4
R/ab_property.R

@ -19,7 +19,7 @@ @@ -19,7 +19,7 @@
# Visit our website for more info: https://msberends.github.io/AMR. #
# ==================================================================== #
#' Property of an antibiotic
#' Get properties of an antibiotic
#'
#' Use these functions to return a specific property of an antibiotic from the [antibiotics] data set. All input values will be evaluated internally with [as.ab()].
#' @inheritSection lifecycle Stable lifecycle
@ -172,7 +172,7 @@ ab_ddd <- function(x, administration = "oral", units = FALSE, ...) { @@ -172,7 +172,7 @@ ab_ddd <- function(x, administration = "oral", units = FALSE, ...) {
#' @export
ab_info <- function(x, language = get_locale(), ...) {
x <- as.ab(x, ...)
base::list(ab = as.character(x),
list(ab = as.character(x),
atc = ab_atc(x),
cid = ab_cid(x),
name = ab_name(x, language = language),

6
R/atc_online.R

@ -21,10 +21,8 @@ @@ -21,10 +21,8 @@
#' Get ATC properties from WHOCC website
#'
#' @inheritSection lifecycle Questioning lifecycle
#' @inheritSection lifecycle Stable lifecycle
#' @description Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit.
#'
#' **This function requires an internet connection.**
#' @param atc_code a character or character vector with ATC code(s) of antibiotic(s)
#' @param property property of an ATC code. Valid values are `"ATC"`, `"Name"`, `"DDD"`, `"U"` (`"unit"`), `"Adm.R"`, `"Note"` and `groups`. For this last option, all hierarchical groups of an ATC code will be returned, see Examples.
#' @param administration type of administration when using `property = "Adm.R"`, see Details
@ -54,6 +52,8 @@ @@ -54,6 +52,8 @@
#' - `"MU"` = million units
#' - `"mmol"` = millimole
#' - `"ml"` = milliliter (e.g. eyedrops)
#'
#' **N.B. This function requires an internet connection and only works if the following packages are installed: `curl`, `rvest`, `xml2`.**
#' @export
#' @rdname atc_online
#' @inheritSection AMR Read more on our website!

8
R/availability.R

@ -47,11 +47,11 @@ @@ -47,11 +47,11 @@
#' }
availability <- function(tbl, width = NULL) {
stop_ifnot(is.data.frame(tbl), "`tbl` must be a data.frame")
x <- base::sapply(tbl, function(x) {
1 - base::sum(base::is.na(x)) / base::length(x)
x <- sapply(tbl, function(x) {
1 - sum(is.na(x)) / length(x)
})
n <- base::sapply(tbl, function(x) base::length(x[!base::is.na(x)]))
R <- base::sapply(tbl, function(x) base::ifelse(is.rsi(x), resistance(x, minimum = 0), NA))
n <- sapply(tbl, function(x) length(x[!is.na(x)]))
R <- sapply(tbl, function(x) ifelse(is.rsi(x), resistance(x, minimum = 0), NA))
R_print <- character(length(R))
R_print[!is.na(R)] <- percentage(R[!is.na(R)])
R_print[is.na(R)] <- ""

4
R/bug_drug_combinations.R

@ -33,8 +33,6 @@ @@ -33,8 +33,6 @@
#' @inheritParams rsi_df
#' @inheritParams base::formatC
#' @details The function [format()] calculates the resistance per bug-drug combination. Use `combine_IR = FALSE` (default) to test R vs. S+I and `combine_IR = TRUE` to test R+I vs. S.
#'
#' The language of the output can be overwritten with `options(AMR_locale)`, please see [translate].
#' @export
#' @rdname bug_drug_combinations
#' @return The function [bug_drug_combinations()] returns a [`data.frame`] with columns "mo", "ab", "S", "I", "R" and "total".
@ -71,7 +69,7 @@ bug_drug_combinations <- function(x, @@ -71,7 +69,7 @@ bug_drug_combinations <- function(x,
x_class <- class(x)
x <- as.data.frame(x, stringsAsFactors = FALSE)
x[, col_mo] <- FUN(x[, col_mo, drop = TRUE])
x[, col_mo] <- FUN(x[, col_mo, drop = TRUE], ...)
x <- x[, c(col_mo, names(which(sapply(x, is.rsi)))), drop = FALSE]
unique_mo <- sort(unique(x[, col_mo, drop = TRUE]))

12
R/data.R

@ -149,7 +149,7 @@ catalogue_of_life <- list( @@ -149,7 +149,7 @@ catalogue_of_life <- list(
#' @seealso [as.mo()] [mo_property()] [microorganisms]
"microorganisms.old"
#' Translation table with `r format(nrow(microorganisms.codes), big.mark = ",")` common microorganism codes
#' Data set with `r format(nrow(microorganisms.codes), big.mark = ",")` common microorganism codes
#'
#' A data set containing commonly used codes for microorganisms, from laboratory systems and WHONET. Define your own with [set_mo_source()]. They will all be searched when using [as.mo()] and consequently all the [`mo_*`][mo_property()] functions.
#' @format A [`data.frame`] with `r format(nrow(microorganisms.codes), big.mark = ",")` observations and `r ncol(microorganisms.codes)` variables:
@ -194,17 +194,17 @@ catalogue_of_life <- list( @@ -194,17 +194,17 @@ catalogue_of_life <- list(
#' Data set with `r format(nrow(WHONET), big.mark = ",")` isolates - WHONET example
#'
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The data itself was based on our [example_isolates] data set.
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are based on our [example_isolates] data set. All patient names are created using online surname generators and are only in place for practice purposes.
#' @format A [`data.frame`] with `r format(nrow(WHONET), big.mark = ",")` observations and `r ncol(WHONET)` variables:
#' - `Identification number`\cr ID of the sample
#' - `Specimen number`\cr ID of the specimen
#' - `Organism`\cr Name of the microorganism. Before analysis, you should transform this to a valid microbial class, using [as.mo()].
#' - `Country`\cr Country of origin
#' - `Laboratory`\cr Name of laboratory
#' - `Last name`\cr Last name of patient
#' - `First name`\cr Initial of patient
#' - `Sex`\cr Gender of patient
#' - `Age`\cr Age of patient
#' - `Last name`\cr Fictitious last name of patient
#' - `First name`\cr Fictitious initial of patient
#' - `Sex`\cr Fictitious gender of patient
#' - `Age`\cr Fictitious age of patient
#' - `Age category`\cr Age group, can also be looked up using [age_groups()]
#' - `Date of admission`\cr Date of hospital admission
#' - `Specimen date`\cr Date when specimen was received at laboratory

4
R/disk.R

@ -19,9 +19,9 @@ @@ -19,9 +19,9 @@
# Visit our website for more info: https://msberends.github.io/AMR. #
# ==================================================================== #
#' Class 'disk'
#' Transform input to disk diffusion diameters
#'
#' This transforms a vector to a new class [`disk`], which is a growth zone size (around an antibiotic disk) in millimetres between 6 and 50.
#' This transforms a vector to a new class [`disk`], which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 6 and 50.
#' @inheritSection lifecycle Stable lifecycle
#' @rdname as.disk
#' @param x vector

4
R/first_isolate.R

@ -411,11 +411,11 @@ first_isolate <- function(x, @@ -411,11 +411,11 @@ first_isolate <- function(x,
rownames(x) <- NULL
if (info == TRUE) {
n_found <- base::sum(x$newvar_first_isolate, na.rm = TRUE)
n_found <- sum(x$newvar_first_isolate, na.rm = TRUE)
p_found_total <- percentage(n_found / nrow(x[which(!is.na(x$newvar_mo)), , drop = FALSE]))
p_found_scope <- percentage(n_found / scope.size)
# mark up number of found
n_found <- base::format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
n_found <- format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
if (p_found_total != p_found_scope) {
msg_txt <- paste0("=> Found ",
font_bold(paste0(n_found, " first ", weighted.notice, "isolates")),

2
R/guess_ab_col.R

@ -172,7 +172,7 @@ get_column_abx <- function(x, @@ -172,7 +172,7 @@ get_column_abx <- function(x,
# sort on name
x <- x[order(names(x), x)]
duplicates <- c(x[base::duplicated(x)], x[base::duplicated(names(x))])
duplicates <- c(x[duplicated(x)], x[duplicated(names(x))])
duplicates <- duplicates[unique(names(duplicates))]
x <- c(x[!names(x) %in% names(duplicates)], duplicates)
x <- x[order(names(x), x)]

8
R/kurtosis.R

@ -42,20 +42,20 @@ kurtosis.default <- function(x, na.rm = FALSE) { @@ -42,20 +42,20 @@ kurtosis.default <- function(x, na.rm = FALSE) {
x <- x[!is.na(x)]
}
n <- length(x)
n * base::sum((x - base::mean(x, na.rm = na.rm))^4, na.rm = na.rm) /
(base::sum((x - base::mean(x, na.rm = na.rm))^2, na.rm = na.rm)^2)
n * sum((x - mean(x, na.rm = na.rm))^4, na.rm = na.rm) /
(sum((x - mean(x, na.rm = na.rm))^2, na.rm = na.rm)^2)
}
#' @method kurtosis matrix
#' @rdname kurtosis
#' @export
kurtosis.matrix <- function(x, na.rm = FALSE) {
base::apply(x, 2, kurtosis.default, na.rm = na.rm)
apply(x, 2, kurtosis.default, na.rm = na.rm)
}
#' @method kurtosis data.frame
#' @rdname kurtosis
#' @export
kurtosis.data.frame <- function(x, na.rm = FALSE) {
base::sapply(x, kurtosis.default, na.rm = na.rm)
sapply(x, kurtosis.default, na.rm = na.rm)
}

29
R/like.R

@ -32,14 +32,14 @@ @@ -32,14 +32,14 @@
#' @export
#' @details
#' The `%like%` function:
#' * Is case insensitive (use `%like_case%` for case-sensitive matching)
#' * Is case-insensitive (use `%like_case%` for case-sensitive matching)
#' * Supports multiple patterns
#' * Checks if `pattern` is a regular expression and sets `fixed = TRUE` if not, to greatly improve speed
#' * Tries again with `perl = TRUE` if regex fails
#'
#' Using RStudio? This function can also be inserted from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`).
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/master/R/like.R)
#' @seealso [base::grep()]
#' @seealso [grep()]
#' @inheritSection AMR Read more on our website!
#' @examples
#' # simple test
@ -71,13 +71,25 @@ like <- function(x, pattern, ignore.case = TRUE) { @@ -71,13 +71,25 @@ like <- function(x, pattern, ignore.case = TRUE) {
pattern <- tolower(pattern)
}
if (length(pattern) > 1 & length(x) == 1) {
x <- rep(x, length(pattern))
}
if (length(pattern) > 1) {
res <- vector(length = length(pattern))
if (length(x) != length(pattern)) {
if (length(x) == 1) {
x <- rep(x, length(pattern))
}
# return TRUE for every 'x' that matches any 'pattern', FALSE otherwise
res <- sapply(pattern, function(pttrn) base::grepl(pttrn, x, ignore.case = FALSE, fixed = fixed))
for (i in seq_len(length(res))) {
if (is.factor(x[i])) {
res[i] <- as.integer(x[i]) %in% grep(pattern[i], levels(x[i]), ignore.case = FALSE, fixed = fixed)
} else {
res[i] <- grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed)
}
}
res <- sapply(pattern, function(pttrn) grepl(pttrn, x, ignore.case = FALSE, fixed = fixed))
res2 <- as.logical(rowSums(res))
# get only first item of every hit in pattern
res2[duplicated(res)] <- FALSE
@ -85,12 +97,11 @@ like <- function(x, pattern, ignore.case = TRUE) { @@ -85,12 +97,11 @@ like <- function(x, pattern, ignore.case = TRUE) {
return(res2)
} else {
# x and pattern are of same length, so items with each other
res <- vector(length = length(pattern))
for (i in seq_len(length(res))) {
if (is.factor(x[i])) {
res[i] <- as.integer(x[i]) %in% base::grep(pattern[i], levels(x[i]), ignore.case = FALSE, fixed = fixed)
res[i] <- as.integer(x[i]) %in% grep(pattern[i], levels(x[i]), ignore.case = FALSE, fixed = fixed)
} else {
res[i] <- base::grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed)
res[i] <- grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed)
}
}
return(res)
@ -99,13 +110,13 @@ like <- function(x, pattern, ignore.case = TRUE) { @@ -99,13 +110,13 @@ like <- function(x, pattern, ignore.case = TRUE) {
# the regular way how grepl works; just one pattern against one or more x
if (is.factor(x)) {
as.integer(x) %in% base::grep(pattern, levels(x), ignore.case = FALSE, fixed = fixed)
as.integer(x) %in% grep(pattern, levels(x), ignore.case = FALSE, fixed = fixed)
} else {
tryCatch(base::grepl(pattern, x, ignore.case = FALSE, fixed = fixed),
tryCatch(grepl(pattern, x, ignore.case = FALSE, fixed = fixed),
error = function(e) {
if (grepl("invalid reg(ular )?exp", e$message, ignore.case = TRUE)) {
# try with perl = TRUE:
return(base::grepl(pattern = pattern,
return(grepl(pattern = pattern,
x = x,
ignore.case = FALSE,
fixed = fixed,

4
R/mdro.R

@ -728,10 +728,10 @@ mdro <- function(x, @@ -728,10 +728,10 @@ mdro <- function(x,
}
# not enough classes available
x[which(x$MDRO %in% c(1, 3) & x$classes_available < base::floor(x$classes_in_guideline * pct_required_classes)), "MDRO"] <- -1
x[which(x$MDRO %in% c(1, 3) & x$classes_available < floor(x$classes_in_guideline * pct_required_classes)), "MDRO"] <- -1
if (verbose == TRUE) {
x[which(x$MDRO == -1), "reason"] <- paste0("not enough classes available: ", x$classes_available[which(x$MDRO == -1)],
" of required ", (base::floor(x$classes_in_guideline * pct_required_classes))[which(x$MDRO == -1)],
" of required ", (floor(x$classes_in_guideline * pct_required_classes))[which(x$MDRO == -1)],
" (~", percentage(pct_required_classes), " of ", x$classes_in_guideline[which(x$MDRO == -1)], ")")
}

4
R/mic.R

@ -19,9 +19,9 @@ @@ -19,9 +19,9 @@
# Visit our website for more info: https://msberends.github.io/AMR. #
# ==================================================================== #
#' Class 'mic'
#' Transform input to minimum inhibitory concentrations
#'
#' This transforms a vector to a new class [`mic`], which is an ordered [`factor`] with valid MIC values as levels. Invalid MIC values will be translated as `NA` with a warning.
#' This transforms a vector to a new class [`mic`], which is an ordered [`factor`] with valid minimum inhibitory concentrations (MIC) as levels. Invalid MIC values will be translated as `NA` with a warning.
#' @inheritSection lifecycle Stable lifecycle
#' @rdname as.mic
#' @param x vector

75
R/mo.R

@ -19,7 +19,7 @@ @@ -19,7 +19,7 @@
# Visit our website for more info: https://msberends.github.io/AMR. #
# ==================================================================== #
#' Transform to microorganism ID
#' Transform input to a microorganism ID
#'
#' Use this function to determine a valid microorganism ID ([`mo`]). Determination is done using intelligent rules and the complete taxonomic kingdoms Bacteria, Chromista, Protozoa, Archaea and most microbial species from the kingdom Fungi (see Source). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (like `"S. aureus"`), an abbreviation known in the field (like `"MRSA"`), or just a genus. Please see *Examples*.
#' @inheritSection lifecycle Stable lifecycle
@ -32,6 +32,7 @@ @@ -32,6 +32,7 @@
#' This excludes *Enterococci* at default (who are in group D), use `Lancefield = "all"` to also categorise all *Enterococci* as group D.
#' @param allow_uncertain a number between `0` (or `"none"`) and `3` (or `"all"`), or `TRUE` (= `2`) or `FALSE` (= `0`) to indicate whether the input should be checked for less probable results, please see *Details*
#' @param reference_df a [`data.frame`] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
#' @param ignore_pattern a regular expression (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the option `AMR_ignore_pattern`, e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
#' @param ... other parameters passed on to functions
#' @rdname as.mo
#' @aliases mo
@ -39,7 +40,7 @@ @@ -39,7 +40,7 @@
#' @details
#' ## General info
#'
#' A microorganism ID from this package (class: [`mo`]) typically looks like these examples:
#' A microorganism ID from this package (class: [`mo`]) is human readable and typically looks like these examples:
#' ```
#' Code Full name
#' --------------- --------------------------------------
@ -48,10 +49,10 @@ @@ -48,10 +49,10 @@
#' B_KLBSL_PNMN_RHNS Klebsiella pneumoniae rhinoscleromatis
#' | | | |
#' | | | |
#' | | | ---> subspecies, a 4-5 letter acronym
#' | | ----> species, a 4-5 letter acronym
#' | ----> genus, a 5-7 letter acronym
#' ----> taxonomic kingdom: A (Archaea), AN (Animalia), B (Bacteria),
#' | | | \---> subspecies, a 4-5 letter acronym
#' | | \----> species, a 4-5 letter acronym
#' | \----> genus, a 5-7 letter acronym
#' \----> taxonomic kingdom: A (Archaea), AN (Animalia), B (Bacteria),
#' C (Chromista), F (Fungi), P (Protozoa)
#' ```
#'
@ -172,7 +173,8 @@ as.mo <- function(x, @@ -172,7 +173,8 @@ as.mo <- function(x,
Becker = FALSE,
Lancefield = FALSE,
allow_uncertain = TRUE,
reference_df = get_mo_source(),
reference_df = get_mo_source(),
ignore_pattern = getOption("AMR_ignore_pattern"),
...) {
check_dataset_integrity()
@ -181,10 +183,12 @@ as.mo <- function(x, @@ -181,10 +183,12 @@ as.mo <- function(x,
x <- parse_and_convert(x)
# replace mo codes used in older package versions
x <- replace_old_mo_codes(x, property = "mo")
# ignore cases that match the ignore pattern
x <- replace_ignore_pattern(x, ignore_pattern)
# WHONET: xxx = no growth
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
# Laboratory systems: remove entries like "no growth" etc
# Laboratory systems: remove entries like "no growth", etc.
x[trimws2(x) %like% "(no .*growth|keine? .*wachtstum|geen .*groei|no .*crecimientonon|sem .*crescimento|pas .*croissance)"] <- NA_character_
x[trimws2(x) %like% "^(no|not|kein|geen|niet|non|sem) [a-z]+"] <- "UNKNOWN"
@ -226,6 +230,7 @@ as.mo <- function(x, @@ -226,6 +230,7 @@ as.mo <- function(x,
y <- mo_validate(x = x, property = "mo",
Becker = Becker, Lancefield = Lancefield,
allow_uncertain = uncertainty_level, reference_df = reference_df,
ignore_pattern = ignore_pattern,
...)
}
@ -257,6 +262,7 @@ exec_as.mo <- function(x, @@ -257,6 +262,7 @@ exec_as.mo <- function(x,
initial_search = TRUE,
dyslexia_mode = FALSE,
debug = FALSE,
ignore_pattern = getOption("AMR_ignore_pattern"),
reference_data_to_use = MO_lookup) {
check_dataset_integrity()
@ -294,6 +300,8 @@ exec_as.mo <- function(x, @@ -294,6 +300,8 @@ exec_as.mo <- function(x,
x <- parse_and_convert(x)
# replace mo codes used in older package versions
x <- replace_old_mo_codes(x, property)
# ignore cases that match the ignore pattern
x <- replace_ignore_pattern(x, ignore_pattern)
# WHONET: xxx = no growth
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
@ -360,37 +368,31 @@ exec_as.mo <- function(x, @@ -360,37 +368,31 @@ exec_as.mo <- function(x,
# all in reference df
colnames(reference_df)[1] <- "x"
suppressWarnings(
x <- data.frame(x = x, stringsAsFactors = FALSE) %>%
left_join(reference_df, by = "x") %>%
left_join(microorganisms, by = "mo") %>%
pull(property)
x <- MO_lookup[match(reference_df[match(x, reference_df$x), "mo", drop = TRUE], MO_lookup$mo), property, drop = TRUE]
)
} else if (all(x %in% reference_data_to_use$mo)) {
x <- data.frame(mo = x, stringsAsFactors = FALSE) %>%
left_join_microorganisms(by = "mo") %>%
pull(property)
x <- MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE]
} else if (all(tolower(x) %in% reference_data_to_use$fullname_lower)) {
# we need special treatment for very prevalent full names, they are likely!
# e.g. as.mo("Staphylococcus aureus")
x <- data.frame(fullname_lower = tolower(x), stringsAsFactors = FALSE) %>%
left_join_MO_lookup(by = "fullname_lower") %>%
pull(property)
x <- MO_lookup[match(tolower(x), MO_lookup$fullname_lower), property, drop = TRUE]
} else if (all(x %in% reference_data_to_use$fullname)) {
# we need special treatment for very prevalent full names, they are likely!
# e.g. as.mo("Staphylococcus aureus")
x <- data.frame(fullname = x, stringsAsFactors = FALSE) %>%
left_join_MO_lookup(by = "fullname") %>%
pull(property)
x <- MO_lookup[match(x, MO_lookup$fullname), property, drop = TRUE]
} else if (all(toupper(x) %in% microorganisms.codes$code)) {
# commonly used MO codes
x <- data.frame(code = toupper(x), stringsAsFactors = FALSE) %>%
left_join(microorganisms.codes, by = "code") %>%
left_join_MO_lookup(by = "mo") %>%
pull(property)
x <- MO_lookup[match(microorganisms.codes[match(toupper(x),
microorganisms.codes$code),
"mo",
drop = TRUE],
MO_lookup$mo),
property,
drop = TRUE]
} else if (!all(x %in% microorganisms[, property])) {
@ -1466,7 +1468,7 @@ exec_as.mo <- function(x, @@ -1466,7 +1468,7 @@ exec_as.mo <- function(x,
df_input <- data.frame(input = as.character(x_input),
stringsAsFactors = FALSE)
# super fast using base::match() which is a lot faster than base::merge()
# super fast using match() which is a lot faster than merge()
x <- df_found$found[match(df_input$input, df_found$input)]
if (property == "mo") {
@ -1800,11 +1802,11 @@ levenshtein_fraction <- function(input, output) { @@ -1800,11 +1802,11 @@ levenshtein_fraction <- function(input, output) {
levenshtein <- double(length = length(input))
for (i in seq_len(length(input))) {
# determine Levenshtein distance, but maximise to nchar of output
levenshtein[i] <- base::min(base::as.double(utils::adist(input[i], output[i], ignore.case = TRUE)),
base::nchar(output[i]))
levenshtein[i] <- min(as.double(utils::adist(input[i], output[i], ignore.case = TRUE)),
nchar(output[i]))
}
# self-made score between 0 and 1 (for % certainty, so 0 means huge distance, 1 means no distance)
(base::nchar(output) - 0.5 * levenshtein) / nchar(output)
(nchar(output) - 0.5 * levenshtein) / nchar(output)
}
trimws2 <- function(x) {
@ -1850,6 +1852,19 @@ replace_old_mo_codes <- function(x, property) { @@ -1850,6 +1852,19 @@ replace_old_mo_codes <- function(x, property) {
x
}
replace_ignore_pattern <- function(x, ignore_pattern) {
if (!is.null(ignore_pattern) && !identical(trimws2(ignore_pattern), "")) {
ignore_cases <- x %like% ignore_pattern
if (sum(ignore_cases) > 0) {
message(font_blue(paste0("NOTE: the following input was ignored by `ignore_pattern = \"", ignore_pattern, "\"`: ",
paste0("'", sort(unique(x[x %like% ignore_pattern])), "'", collapse = ", "),
collapse = ", ")))
x[x %like% ignore_pattern] <- NA_character_
}
}
x
}
left_join_MO_lookup <- function(x, ...) {
left_join(x = x, y = MO_lookup, ...)
}

15
R/mo_property.R

@ -19,14 +19,14 @@ @@ -19,14 +19,14 @@
# Visit our website for more info: https://msberends.github.io/AMR. #
# ==================================================================== #
#' Property of a microorganism
#' Get properties of a microorganism
#'
#' Use these functions to return a specific property of a microorganism. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. Please see *Examples*.
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. Please see *Examples*.
#' @inheritSection lifecycle Stable lifecycle
#' @param x any (vector of) text that can be coerced to a valid microorganism code with [as.mo()]
#' @param property one of the column names of the [microorganisms] data set or `"shortname"`
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation.
#' @param ... other parameters passed on to [as.mo()]
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
#' @param ... other parameters passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
#' @param open browse the URL using [utils::browseURL()]
#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for [mo_ref()], [mo_authors()] and [mo_year()]. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
#' - `mo_name("Escherichia blattae")` will return `"Shimwellia blattae"` (with a message about the renaming)
@ -309,7 +309,7 @@ mo_taxonomy <- function(x, language = get_locale(), ...) { @@ -309,7 +309,7 @@ mo_taxonomy <- function(x, language = get_locale(), ...) {
x <- as.mo(x, ...)
metadata <- get_mo_failures_uncertainties_renamed()
result <- base::list(kingdom = mo_kingdom(x, language = language),
result <- list(kingdom = mo_kingdom(x, language = language),
phylum = mo_phylum(x, language = language),
class = mo_class(x, language = language),
order = mo_order(x, language = language),
@ -414,6 +414,11 @@ mo_validate <- function(x, property, ...) { @@ -414,6 +414,11 @@ mo_validate <- function(x, property, ...) {
check_dataset_integrity()
if (tryCatch(all(x %in% MO_lookup$mo) & length(list(...)) == 0, error = function(e) FALSE)) {
# special case for mo_* functions where class is already <mo>
return(MO_lookup[match(x, MO_lookup$mo), property, drop = TRUE])
}
dots <- list(...)
Becker <- dots$Becker
if (is.null(Becker)) {

14
R/mo_source.R

@ -112,6 +112,7 @@ set_mo_source <- function(path) { @@ -112,6 +112,7 @@ set_mo_source <- function(path) {
file_location <- path.expand("~/mo_source.rds")
stop_ifnot(interactive(), "This function can only be used in interactive mode, since it must ask for the user's permission to write a file to their home folder.")
stop_ifnot(length(path) == 1, "`path` must be of length 1")
if (is.null(path) || path %in% c(FALSE, "")) {
@ -176,6 +177,19 @@ set_mo_source <- function(path) { @@ -176,6 +177,19 @@ set_mo_source <- function(path) {
action <- "Updated"
} else {
action <- "Created"
# only ask when file is created, not when it is updated
txt <- paste0("This will write create the new file '",
file_location,
"', for which your permission is needed.\n\nDo you agree that this file will be created? ")
if ("rsasdtudioapi" %in% rownames(utils::installed.packages())) {
showQuestion <- import_fn("showQuestion", "rstudioapi")
q_continue <- showQuestion("Create new file in home directory", txt)
} else {
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
}
if (q_continue %in% c(FALSE, 2)) {
return(invisible())
}
}
saveRDS(df, file_location)
options(mo_source = path)

2
R/rsi.R

@ -19,7 +19,7 @@ @@ -19,7 +19,7 @@
# Visit our website for more info: https://msberends.github.io/AMR. #
# ==================================================================== #
#' Class 'rsi'
#' Interpret MIC and disk, or clean raw R/SI data
#'
#' Interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI, or clean up existing R/SI values. This transforms the input to a new class [`rsi`], which is an ordered factor with levels `S < I < R`. Values that cannot be interpreted will be returned as `NA` with a warning.
#' @inheritSection lifecycle Stable lifecycle

6
R/rsi_calc.R

@ -45,7 +45,7 @@ rsi_calc <- function(..., @@ -45,7 +45,7 @@ rsi_calc <- function(...,
dots_df <- as.data.frame(dots_df, stringsAsFactors = FALSE)
}
dots <- base::eval(base::substitute(base::alist(...)))
dots <- eval(substitute(alist(...)))
stop_if(length(dots) == 0, "no variables selected", call = -2)
stop_if("also_single_tested" %in% names(dots),
@ -118,12 +118,12 @@ rsi_calc <- function(..., @@ -118,12 +118,12 @@ rsi_calc <- function(...,
# no NAs in any column
y <- apply(X = as.data.frame(lapply(x, as.integer), stringsAsFactors = FALSE),
MARGIN = 1,
FUN = base::min)
FUN = min)
numerator <- sum(as.integer(y) %in% as.integer(ab_result), na.rm = TRUE)
denominator <- sum(sapply(x_transposed, function(y) !(any(is.na(y)))))
} else {
# may contain NAs in any column
other_values <- base::setdiff(c(NA, levels(ab_result)), ab_result)
other_values <- setdiff(c(NA, levels(ab_result)), ab_result)
numerator <- sum(sapply(x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE)))
denominator <- sum(sapply(x_transposed, function(y) !(all(y %in% other_values) & any(is.na(y)))))
}

6
R/skewness.R

@ -44,19 +44,19 @@ skewness.default <- function(x, na.rm = FALSE) { @@ -44,19 +44,19 @@ skewness.default <- function(x, na.rm = FALSE) {
x <- x[!is.na(x)]
}
n <- length(x)
(base::sum((x - base::mean(x))^3) / n) / (base::sum((x - base::mean(x)) ^ 2) / n) ^ (3 / 2)
(sum((x - mean(x))^3) / n) / (sum((x - mean(x)) ^ 2) / n) ^ (3 / 2)
}
#' @method skewness matrix
#' @rdname skewness
#' @export
skewness.matrix <- function(x, na.rm = FALSE) {
base::apply(x, 2, skewness.default, na.rm = na.rm)
apply(x, 2, skewness.default, na.rm = na.rm)
}
#' @method skewness data.frame
#' @rdname skewness
#' @export
skewness.data.frame <- function(x, na.rm = FALSE) {
base::sapply(x, skewness.default, na.rm = na.rm)
sapply(x, skewness.default, na.rm = na.rm)
}

BIN
R/sysdata.rda

Binary file not shown.

46
R/translate.R

@ -23,15 +23,13 @@ @@ -23,15 +23,13 @@
#'
#' For language-dependent output of AMR functions, like [mo_name()], [mo_gramstain()], [mo_type()] and [ab_name()].
#' @inheritSection lifecycle Stable lifecycle
#' @details Strings will be translated to foreign languages if they are defined in a local translation file. Additions to this file can be suggested at our repository. The file can be found here: <https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv>.
#' @details Strings will be translated to foreign languages if they are defined in a local translation file. Additions to this file can be suggested at our repository. The file can be found here: <https://github.com/msberends/AMR/blob/master/data-raw/translations.tsv>. This file will be read by all functions where a translated output can be desired, like all [mo_property()] functions ([mo_name()], [mo_gramstain()], [mo_type()], etc.).
#'
#' Currently supported languages are (besides English): `r paste(sort(gsub(";.*", "", ISOcodes::ISO_639_2[which(ISOcodes::ISO_639_2$Alpha_2 %in% unique(AMR:::translations_file$lang)), "Name"])), collapse = ", ")`. Please note that currently not all these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#' Currently supported languages are: `r paste(sort(gsub(";.*", "", ISOcodes::ISO_639_2[which(ISOcodes::ISO_639_2$Alpha_2 %in% LANGUAGES_SUPPORTED), "Name"])), collapse = ", ")`. Please note that currently not all these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#'
#' Please suggest your own translations [by creating a new issue on our repository](https://github.com/msberends/AMR/issues/new?title=Translations).
#'
#' This file will be read by all functions where a translated output can be desired, like all [mo_property()] functions ([mo_name()], [mo_gramstain()], [mo_type()], etc.).
#'
#' The system language will be used at default, if that language is supported. The system language can be overwritten with `Sys.setenv(AMR_locale = yourlanguage)`.
#' The system language will be used at default (as returned by [Sys.getlocale()]), if that language is supported. The language to be used can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`.
#' @inheritSection AMR Read more on our website!
#' @rdname translate
#' @name translate
@ -66,10 +64,16 @@ @@ -66,10 +64,16 @@
#' #> "Staphylococcus coagulase negativo (CoNS)"
get_locale <- function() {
if (!is.null(getOption("AMR_locale", default = NULL))) {
return(getOption("AMR_locale"))
if (!language %in% LANGUAGES_SUPPORTED) {
stop_("unsupported language: '", language, "' - use one of: ",
paste0("'", LANGUAGES_SUPPORTED, "'", collapse = ", "),
call = FALSE)
} else {
return(getOption("AMR_locale"))
}
}
lang <- Sys.getlocale("LC_COLLATE")
lang <- Sys.getlocale()
# Check the locale settings for a start with one of these languages:
@ -107,10 +111,13 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) { @@ -107,10 +111,13 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
}
df_trans <- translations_file # internal data file
from.bak <- from
from_unique <- unique(from)
from_unique_translated <- from_unique
stop_ifnot(language %in% df_trans$lang,
stop_ifnot(language %in% LANGUAGES_SUPPORTED,
"unsupported language: '", language, "' - use one of: ",
paste0("'", sort(unique(df_trans$lang)), "'", collapse = ", "),
paste0("'", LANGUAGES_SUPPORTED, "'", collapse = ", "),
call = FALSE)
df_trans <- subset(df_trans, lang == language)
@ -124,7 +131,7 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) { @@ -124,7 +131,7 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
df_trans$fixed[is.na(df_trans$fixed)] <- TRUE
# check if text to look for is in one of the patterns
any_form_in_patterns <- tryCatch(any(from %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")),
any_form_in_patterns <- tryCatch(any(from_unique %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")),
error = function(e) {
warning("Translation not possible. Please open an issue on GitHub (https://github.com/msberends/AMR/issues).", call. = FALSE)
return(FALSE)
@ -133,15 +140,16 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) { @@ -133,15 +140,16 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
return(from)
}
for (i in seq_len(nrow(df_trans))) {
from <- gsub(x = from,
pattern = df_trans$pattern[i],
replacement = df_trans$replacement[i],
fixed = df_trans$fixed[i],
ignore.case = df_trans$ignore.case[i])
}
lapply(seq_len(nrow(df_trans)),
function(i) from_unique_translated <<- gsub(pattern = df_trans$pattern[i],
replacement = df_trans$replacement[i],
x = from_unique_translated,
ignore.case = df_trans$ignore.case[i],
fixed = df_trans$fixed[i]))
# force UTF-8 for diacritics
base::enc2utf8(from)
from_unique_translated <- enc2utf8(from_unique_translated)
# a kind of left join to get all results back
from_unique_translated[match(from.bak, from_unique)]
}

4
R/zzz.R

@ -28,6 +28,10 @@ @@ -28,6 +28,10 @@
value = create_MO.old_lookup(),
envir = asNamespace("AMR"))
assign(x = "LANGUAGES_SUPPORTED",
value = sort(c("en", unique(AMR:::translations_file$lang))),
envir = asNamespace("AMR"))
# support for tibble headers (type_sum) and tibble columns content (pillar_shaft)
# without the need to depend on other packages
s3_register("pillar::pillar_shaft", "ab")

137
_pkgdown.yml

@ -44,7 +44,7 @@ navbar: @@ -44,7 +44,7 @@ navbar:
- text: "Predict antimicrobial resistance"
icon: "fa-dice"
href: "articles/resistance_predict.html"
- text: "Download our reference data sets for own use"
- text: "Data sets for download / own use"
icon: "fa-database"
href: "articles/datasets.html"
- text: "Conduct principal component analysis for AMR"
@ -64,10 +64,10 @@ navbar: @@ -64,10 +64,10 @@ navbar:
href: "articles/EUCAST.html"
- text: "Get properties of a microorganism"
icon: "fa-bug"
href: "reference/mo_property.html" # reference instead of article
href: "reference/mo_property.html" # reference instead of an article
- text: "Get properties of an antibiotic"
icon: "fa-capsules"
href: "reference/ab_property.html" # reference instead of article
href: "reference/ab_property.html" # reference instead of an article
- text: "Other: benchmarks"
icon: "fa-shipping-fast"
href: "articles/benchmarks.html"
@ -89,77 +89,76 @@ navbar: @@ -89,77 +89,76 @@ navbar:
href: "survey.html"
reference:
- title: "Cleaning your data"
- title: "Background information on included data"
desc: >
Functions for cleaning and optimising your data, to be able to add
variables later on (like taxonomic properties) or to fix and extend
antibiotic interpretations by applying [EUCAST rules](http://www.eucast.org/expert_rules_and_intrinsic_resistance/).
Some pages about our package and its external sources. Be sure to read our [How To's](./../articles/index.html)
for more information about how to work with functions in this package.
contents:
- starts_with("as.")
- "`eucast_rules`"
- "`ab_from_text`"
- "`guess_ab_col`"
- "`AMR`"
- "`catalogue_of_life`"
- "`catalogue_of_life_version`"
- "`WHOCC`"
- "`lifecycle`"
- "`microorganisms`"
- "`antibiotics`"
- "`intrinsic_resistant`"
- "`example_isolates`"
- "`example_isolates_unclean`"
- "`rsi_translation`"
- "`microorganisms.codes`"
- "`microorganisms.old`"
- "`WHONET`"
- title: "Preparing data: microorganisms"
desc: >
These functions are meant to get taxonomically valid properties of microorganisms from any input.
Use `mo_source()` to teach this package how to translate your own codes to valid microorganism codes.
contents:
- "`as.mo`"
- "`mo_property`"
- "`mo_source`"
- title: "Enhancing your data"
- title: "Preparing data: antibiotics"
desc: >
Functions to add new data to your existing data, such as the determination
of first isolates, multi-drug resistant microorganisms (MDRO), getting
properties of microorganisms or antibiotics and determining the age of
patients or divide ages into age groups.
Use these functions to get valid properties of antibiotics from any input or to clean your input.
You can even retrieve drug names and doses from clinical text records, using `ab_from_text()`.
contents:
- "`as.ab`"
- "`ab_property`"
- "`age_groups`"
- "`age`"
- "`ab_from_text`"
- "`atc_online_property`"
- "`first_isolate`"
- "`join`"
- "`key_antibiotics`"
- "`mdro`"
- "`mo_property`"
- "`p_symbol`"
- title: "Analysing your data"
- title: "Preparing data: antimicrobial resistance"
desc: >
Functions for conducting AMR analysis, like counting isolates, calculating
resistance or susceptibility, or make plots.
With `as.mic()` and `as.disk()` you can transform your raw input to valid MIC or disk diffusion values.
Use `as.rsi()` for cleaning raw data to let it only contain "R", "I" and "S", or to interpret MIC or disk diffusion values as R/SI based on the lastest EUCAST and CLSI guidelines.
Afterwards, you can extend antibiotic interpretations by applying [EUCAST rules](http://www.eucast.org/expert_rules_and_intrinsic_resistance/) with `eucast_rules()`.
contents:
- "`as.rsi`"
- "`as.mic`"
- "`as.disk`"
- "`eucast_rules`"
- title: "Analysing data: antimicrobial resistance"
desc: >
Use these function for the analysis part. You can use `susceptibility()` or `resistance()` on any antibiotic column.
Be sure to first select the isolates that are appropiate for analysis, by using `first_isolate()`.
You can also filter your data on certain resistance in certain antibiotic classes (`filter_ab_class()`), or determine multi-drug resistant microorganisms (MDRO, `mdro()`).
contents:
- "`proportion`"
- "`count`"
- "`availability`"
- "`first_isolate`"
- "`key_antibiotics`"
- "`mdro`"
- "`count`"
- "`ggplot_rsi`"
- "`bug_drug_combinations`"
- "`resistance_predict`"
- "`pca`"
- "`antibiotic_class_selectors`"
- "`filter_ab_class`"
- "`g.test`"
- "`ggplot_rsi`"
- "`ggplot_pca`"
- "`kurtosis`"
- "`skewness`"
- title: "Included data sets"
desc: >
Scientifically reliable references for microorganisms and
antibiotics, and example data sets to use for practise.
contents:
- "`microorganisms`"
- "`antibiotics`"
- "`intrinsic_resistant`"
- "`example_isolates`"
- "`example_isolates_unclean`"
- "`rsi_translation`"
- "`microorganisms.codes`"
- "`microorganisms.old`"
- "`WHONET`"
- title: "Background information"
desc: >
Some pages about our package and its external sources. Be sure to read our [How To's](./../articles/index.html)
for more information about how to work with functions in this package.
contents:
- "`AMR`"
- "`catalogue_of_life`"
- "`catalogue_of_life_version`"
- "`WHOCC`"
- "`lifecycle`"
- title: "Other functions"
- "`resistance_predict`"
- "`guess_ab_col`"
- title: "Other: miscellaneous functions"
desc: >
These functions are mostly for internal use, but some of
them may also be suitable for your analysis. Especially the
@ -167,7 +166,23 @@ reference: @@ -167,7 +166,23 @@ reference:
contents:
- "`get_locale`"
- "`like`"
- title: "Deprecated functions"
- "`age_groups`"
- "`age`"
- "`join`"
- "`availability`"
- "`pca`"
- "`ggplot_pca`"
- title: "Other: statistical tests"
desc: >
Some statistical tests or methods are not part of base R and are added to this package for convenience.
contents:
- "`g.test`"
- "`kurtosis`"
- "`skewness`"
- "`p_symbol`"
- title: "Other: deprecated functions"
desc: >
These functions are deprecated, meaning that they will still
work but show a warning with every use and will be removed

BIN
data-raw/antibiotics.dta

Binary file not shown.

BIN
data-raw/antibiotics.sas

Binary file not shown.

BIN
data-raw/antibiotics.sav

Binary file not shown.

BIN
data-raw/antibiotics.xlsx

Binary file not shown.

BIN
data-raw/antivirals.dta

Binary file not shown.

BIN
data-raw/antivirals.sas

Binary file not shown.

BIN
data-raw/antivirals.sav

Binary file not shown.

BIN
data-raw/antivirals.xlsx

Binary file not shown.

BIN
data-raw/intrinsic_resistant.dta

Binary file not shown.

BIN
data-raw/intrinsic_resistant.sas

Binary file not shown.

BIN
data-raw/intrinsic_resistant.sav

Binary file not shown.

BIN
data-raw/intrinsic_resistant.xlsx

Binary file not shown.

BIN
data-raw/microorganisms.dta

Binary file not shown.

BIN
data-raw/microorganisms.old.dta

Binary file not shown.

BIN
data-raw/microorganisms.old.sas

Binary file not shown.

BIN
data-raw/microorganisms.old.sav

Binary file not shown.

BIN
data-raw/microorganisms.old.xlsx

Binary file not shown.

BIN
data-raw/microorganisms.sas

Binary file not shown.

BIN
data-raw/microorganisms.sav

Binary file not shown.

BIN
data-raw/microorganisms.xlsx

Binary file not shown.

3
data-raw/reproduction_of_microorganisms.R

@ -955,11 +955,10 @@ microorganisms <- microorganisms %>% @@ -955,11 +955,10 @@ microorganisms <- microorganisms %>%
class(microorganisms$mo) <- c("mo", "character")
microorganisms.old <- microorganisms.old %>% filter(fullname != "Mycobacterium tuberculosis")
usethis::use_data(microorganisms, overwrite = TRUE, version = 2)
usethis::use_data(microorganisms, overwrite = TRUE, version = 2, compress = "xz")
usethis::use_data(microorganisms.old, overwrite = TRUE, version = 2)
# OLD CODE ----------------------------------------------------------------
# to keep all the old IDs:

BIN
data-raw/rsi_translation.dta

Binary file not shown.

BIN
data-raw/rsi_translation.sas

Binary file not shown.

BIN
data-raw/rsi_translation.sav

Binary file not shown.

BIN
data-raw/rsi_translation.xlsx

Binary file not shown.

6
data-raw/translations.tsv

@ -26,6 +26,8 @@ de biotype Biotyp FALSE FALSE @@ -26,6 +26,8 @@ de biotype Biotyp FALSE FALSE
de vegetative vegetativ FALSE FALSE
de ([([ ]*?)group \\1Gruppe FALSE FALSE
de ([([ ]*?)Group \\1Gruppe FALSE FALSE
de no .*growth keine? .*wachstum FALSE TRUE
nl Coagulase-negative Staphylococcus Coagulase-negatieve Staphylococcus FALSE FALSE
nl Coagulase-positive Staphylococcus Coagulase-positieve Staphylococcus FALSE FALSE
nl Beta-haemolytic Streptococcus Beta-hemolytische Streptococcus FALSE FALSE
@ -56,6 +58,7 @@ nl antibiotic antibioticum FALSE FALSE @@ -56,6 +58,7 @@ nl antibiotic antibioticum FALSE FALSE
nl Antibiotic Antibioticum FALSE FALSE
nl Drug Middel FALSE FALSE
nl drug middel FALSE FALSE
es Coagulase-negative Staphylococcus Staphylococcus coagulasa negativo FALSE FALSE
es Coagulase-positive Staphylococcus Staphylococcus coagulasa positivo FALSE FALSE
es Beta-haemolytic Streptococcus Streptococcus Beta-hemolítico FALSE FALSE
@ -83,6 +86,7 @@ es biotype biotipo FALSE FALSE @@ -83,6 +86,7 @@ es biotype biotipo FALSE FALSE
es vegetative vegetativo FALSE FALSE
es ([([ ]*?)group \\1grupo FALSE FALSE
es ([([ ]*?)Group \\1Grupo FALSE FALSE
it Coagulase-negative Staphylococcus Staphylococcus negativo coagulasi FALSE FALSE
it Coagulase-positive Staphylococcus Staphylococcus positivo coagulasi FALSE FALSE
it Beta-haemolytic Streptococcus Streptococcus Beta-emolitico FALSE FALSE
@ -108,6 +112,7 @@ it biotype biotipo FALSE FALSE @@ -108,6 +112,7 @@ it biotype biotipo FALSE FALSE
it vegetative vegetativo FALSE FALSE
it ([([ ]*?)group \\1gruppo FALSE FALSE
it ([([ ]*?)Group \\1Gruppo FALSE FALSE
fr Coagulase-negative Staphylococcus Staphylococcus à coagulase négative FALSE FALSE
fr Coagulase-positive Staphylococcus Staphylococcus à coagulase positif FALSE FALSE
fr Beta-haemolytic Streptococcus Streptococcus Bêta-hémolytique FALSE FALSE
@ -132,6 +137,7 @@ fr biogroup biogroupe FALSE FALSE @@ -132,6 +137,7 @@ fr biogroup biogroupe FALSE FALSE
fr vegetative végétatif FALSE FALSE
fr ([([ ]*?)group \\1groupe FALSE FALSE
fr ([([ ]*?)Group \\1Groupe FALSE FALSE
pt Coagulase-negative Staphylococcus Staphylococcus coagulase negativo FALSE FALSE
pt Coagulase-positive Staphylococcus Staphylococcus coagulase positivo FALSE FALSE
pt Beta-haemolytic Streptococcus Streptococcus Beta-hemolítico FALSE FALSE

Can't render this file because it has a wrong number of fields in line 59.

BIN
data/microorganisms.rda

Binary file not shown.

4
docs/404.html

@ -81,7 +81,7 @@ @@ -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.3.0.9013</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.3.0.9014</span>
</span>
</div>
@ -121,7 +121,7 @@ @@ -121,7 +121,7 @@
<a href="articles/datasets.html">
<span class="fa fa-database"></span>
Download our reference data sets for own use
Data sets for download / own use
</a>
</li>
<li>

4
docs/LICENSE-text.html

@ -81,7 +81,7 @@ @@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">