mirror of https://github.com/msberends/AMR
(v1.3.0.9014) as.mo() speed improvement
parent
18e52f2725
commit
c4b87fe241
|
@ -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:
|
|||
microbenchmark,
|
||||
readxl,
|
||||
rmarkdown,
|
||||
rstudioapi,
|
||||
rvest,
|
||||
testthat,
|
||||
tidyr,
|
||||
|
|
15
NEWS.md
15
NEWS.md
|
@ -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 @@
|
|||
```
|
||||
|
||||
### 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 @@
|
|||
#> 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 @@
|
|||
* 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
|
||||
|
|
|
@ -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, ...) {
|
|||
}
|
||||
|
||||
# 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, ...) {
|
|||
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
2
R/ab.R
|
@ -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
|
||||
|
|
|
@ -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, ...) {
|
|||
#' @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),
|
||||
|
|
|
@ -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 @@
|
|||
#' - `"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!
|
||||
|
|
|
@ -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)] <- ""
|
||||
|
|
|
@ -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,
|
|||
|
||||
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
12
R/data.R
|
@ -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(
|
|||
|
||||
#' 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
4
R/disk.R
|
@ -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
|
||||
|
|
|
@ -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")),
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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
29
R/like.R
|
@ -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) {
|
|||
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) {
|
|||
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) {
|
|||
|
||||
# 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
4
R/mdro.R
|
@ -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
4
R/mic.R
|
@ -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
75
R/mo.R
|
@ -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 @@
|
|||
#' 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 @@
|
|||
#' @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 @@
|
|||
#' 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,
|
|||
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,
|
|||
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,
|
|||
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,
|
|||
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,
|
|||
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,
|
|||
# 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,
|
|||
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) {
|
|||
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) {
|
|||
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, ...)
|
||||
}
|
||||
|
|
|
@ -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(), ...) {
|
|||
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, ...) {
|
|||
|
||||
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)) {
|
||||
|
|
|
@ -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) {
|
|||
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
2
R/rsi.R
|
@ -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
|
||||
|
|
|
@ -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(...,
|
|||
# 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)))))
|
||||
}
|
||||
|
|
|
@ -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
BIN
R/sysdata.rda
Binary file not shown.
|
@ -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 @@
|
|||
#' #> "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) {
|
|||
}
|
||||
|
||||
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) {
|
|||
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) {
|
|||
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
4
R/zzz.R
|
@ -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")
|
||||
|
|
147
_pkgdown.yml
147
_pkgdown.yml
|
@ -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:
|
|||
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,67 +89,7 @@ navbar:
|
|||
href: "survey.html"
|
||||
|
||||
reference:
|
||||
- title: "Cleaning your 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/).
|
||||
contents:
|
||||
- starts_with("as.")
|
||||
- "`eucast_rules`"
|
||||
- "`ab_from_text`"
|
||||
- "`guess_ab_col`"
|
||||
- "`mo_source`"
|
||||
- title: "Enhancing your data"
|
||||
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.
|
||||
contents:
|
||||
- "`ab_property`"
|
||||
- "`age_groups`"
|
||||
- "`age`"
|
||||
- "`atc_online_property`"
|
||||
- "`first_isolate`"
|
||||
- "`join`"
|
||||
- "`key_antibiotics`"
|
||||
- "`mdro`"
|
||||
- "`mo_property`"
|
||||
- "`p_symbol`"
|
||||
- title: "Analysing your data"
|
||||
desc: >
|
||||
Functions for conducting AMR analysis, like counting isolates, calculating
|
||||
resistance or susceptibility, or make plots.
|
||||
contents:
|
||||
- "`proportion`"
|
||||
- "`count`"
|
||||
- "`availability`"
|
||||
- "`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"
|
||||
- title: "Background information on included data"
|
||||
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.
|
||||
|
@ -159,7 +99,66 @@ reference:
|
|||
- "`catalogue_of_life_version`"
|
||||
- "`WHOCC`"
|
||||
- "`lifecycle`"
|
||||
- title: "Other functions"
|
||||
- "`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: "Preparing data: antibiotics"
|
||||
desc: >
|
||||
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`"
|
||||
- "`ab_from_text`"
|
||||
- "`atc_online_property`"
|
||||
|
||||
- title: "Preparing data: antimicrobial resistance"
|
||||
desc: >
|
||||
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`"
|
||||
- "`first_isolate`"
|
||||
- "`key_antibiotics`"
|
||||
- "`mdro`"
|
||||
- "`count`"
|
||||
- "`ggplot_rsi`"
|
||||
- "`bug_drug_combinations`"
|
||||
- "`antibiotic_class_selectors`"
|
||||
- "`filter_ab_class`"
|
||||
- "`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:
|
|||
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
|
||||
|
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
@ -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:
|
||||
|
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
@ -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
|
|||
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
|
|||
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
|
|||
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
|
|||
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.
|
Binary file not shown.
|
@ -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 @@
|
|||
<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>
|
||||
|
|
|
@ -81,7 +81,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<a class="navbar-link" href="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 @@
|
|||
<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>
|
||||
|
|
|
@ -39,7 +39,7 @@
|
|||
</button>
|
||||
<span class="navbar-brand">
|
||||
<a class="navbar-link" href="../index.html">AMR (for R)</a>
|
||||