mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 10:31:53 +02:00
prepare for CRAN
This commit is contained in:
@ -106,8 +106,8 @@ TAXONOMY_VERSION <- list(
|
||||
url = "https://phinvads.cdc.gov"
|
||||
),
|
||||
LOINC = list(
|
||||
accessed_date = as.Date("2022-10-30"),
|
||||
citation = "Logical Observation Identifiers Names and Codes (LOINC), Version 2.73 (8 August, 2022).",
|
||||
accessed_date = as.Date("2023-10-19"),
|
||||
citation = "Logical Observation Identifiers Names and Codes (LOINC), Version 2.76 (18 September, 2023).",
|
||||
url = "https://loinc.org"
|
||||
)
|
||||
)
|
||||
|
||||
0
R/aa_helper_functions.R
Executable file → Normal file
0
R/aa_helper_functions.R
Executable file → Normal file
8
R/data.R
8
R/data.R
@ -45,10 +45,10 @@
|
||||
#' - `oral_units`\cr Units of `oral_ddd`
|
||||
#' - `iv_ddd`\cr Defined Daily Dose (DDD), parenteral (intravenous) treatment, currently available for `r sum(!is.na(antibiotics$iv_ddd))` drugs
|
||||
#' - `iv_units`\cr Units of `iv_ddd`
|
||||
#' - `loinc`\cr All LOINC codes (Logical Observation Identifiers Names and Codes) associated with the name of the antimicrobial drug. Use [ab_loinc()] to retrieve them quickly, see [ab_property()].
|
||||
#' - `loinc`\cr All codes associated with the name of the antimicrobial drug from `r TAXONOMY_VERSION$LOINC$citation` Use [ab_loinc()] to retrieve them quickly, see [ab_property()].
|
||||
#'
|
||||
#' ### For the [antivirals] data set: a [tibble][tibble::tibble] with `r nrow(antivirals)` observations and `r ncol(antivirals)` variables:
|
||||
#' - `av`\cr Antibiotic ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. *This is a unique identifier.*
|
||||
#' - `av`\cr Antiviral ID as used in this package (such as `ACI`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. *This is a unique identifier.* Combinations are codes that contain a `+` to indicate this, such as `ATA+COBI` for atazanavir/cobicistat.
|
||||
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO. *This is a unique identifier.*
|
||||
#' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC
|
||||
#' - `cid`\cr Compound ID as found in PubChem. *This is a unique identifier.*
|
||||
@ -58,7 +58,7 @@
|
||||
#' - `oral_units`\cr Units of `oral_ddd`
|
||||
#' - `iv_ddd`\cr Defined Daily Dose (DDD), parenteral treatment
|
||||
#' - `iv_units`\cr Units of `iv_ddd`
|
||||
#' - `loinc`\cr All LOINC codes (Logical Observation Identifiers Names and Codes) associated with the name of the antimicrobial drug.
|
||||
#' - `loinc`\cr All codes associated with the name of the antiviral drug from `r TAXONOMY_VERSION$LOINC$citation` Use [av_loinc()] to retrieve them quickly, see [av_property()].
|
||||
#' @details Properties that are based on an ATC code are only available when an ATC is available. These properties are: `atc_group1`, `atc_group2`, `oral_ddd`, `oral_units`, `iv_ddd` and `iv_units`.
|
||||
#'
|
||||
#' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and consequently only available where a CID is available.
|
||||
@ -91,7 +91,7 @@
|
||||
#' - `status` \cr Status of the taxon, either `r vector_or(microorganisms$status)`
|
||||
#' - `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism
|
||||
#' - `rank`\cr Text of the taxonomic rank of the microorganism, such as `"species"` or `"genus"`
|
||||
#' - `ref`\cr Author(s) and year of related scientific publication. This contains only the *first surname* and year of the *latest* authors, e.g. "Wallis *et al.* 2006 *emend.* Smith and Jones 2018" becomes "Smith *et al.*, 2018". This field is directly retrieved from the source specified in the column `source`. Moreover, accents were removed to comply with CRAN that only allows ASCII characters, e.g. "V`r "\u00e1\u0148ov\u00e1"`" becomes "Vanova".
|
||||
#' - `ref`\cr Author(s) and year of related scientific publication. This contains only the *first surname* and year of the *latest* authors, e.g. "Wallis *et al.* 2006 *emend.* Smith and Jones 2018" becomes "Smith *et al.*, 2018". This field is directly retrieved from the source specified in the column `source`. Moreover, accents were removed to comply with CRAN that only allows ASCII characters.
|
||||
#' - `lpsn`\cr Identifier ('Record number') of the List of Prokaryotic names with Standing in Nomenclature (LPSN). This will be the first/highest LPSN identifier to keep one identifier per row. For example, *Acetobacter ascendens* has LPSN Record number 7864 and 11011. Only the first is available in the `microorganisms` data set.
|
||||
#' - `oxygen_tolerance` \cr Oxygen tolerance, either `r vector_or(microorganisms$oxygen_tolerance)`. These data were retrieved from BacDive (see *Source*). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently `r round(length(microorganisms$oxygen_tolerance[which(!is.na(microorganisms$oxygen_tolerance))]) / nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]))` bacteria in the data set contain an oxygen tolerance.
|
||||
#' - `lpsn_parent`\cr LPSN identifier of the parent taxon
|
||||
|
||||
97
R/first_isolate.R
Executable file → Normal file
97
R/first_isolate.R
Executable file → Normal file
@ -347,8 +347,8 @@ first_isolate <- function(x = NULL,
|
||||
|
||||
# create original row index
|
||||
x$newvar_row_index <- seq_len(nrow(x))
|
||||
x$newvar_mo <- as.mo(x[, col_mo, drop = TRUE])
|
||||
x$newvar_genus_species <- paste(mo_genus(x$newvar_mo), mo_species(x$newvar_mo))
|
||||
x$newvar_mo <- as.mo(x[, col_mo, drop = TRUE], keep_synonyms = TRUE, info = FALSE)
|
||||
x$newvar_genus_species <- paste(mo_genus(x$newvar_mo, keep_synonyms = TRUE, info = FALSE), mo_species(x$newvar_mo, keep_synonyms = TRUE, info = FALSE))
|
||||
x$newvar_date <- x[, col_date, drop = TRUE]
|
||||
x$newvar_patient_id <- as.character(x[, col_patient_id, drop = TRUE])
|
||||
|
||||
@ -443,7 +443,7 @@ first_isolate <- function(x = NULL,
|
||||
# did find some isolates - add new index numbers of rows
|
||||
x$newvar_row_index_sorted <- seq_len(nrow(x))
|
||||
|
||||
scope.size <- nrow(x[which(x$newvar_row_index_sorted %in% c(row.start + 1:row.end) &
|
||||
scope.size <- nrow(x[which(x$newvar_row_index_sorted %in% seq(row.start, row.end, 1) &
|
||||
!is.na(x$newvar_mo)), , drop = FALSE])
|
||||
|
||||
# Analysis of first isolate ----
|
||||
@ -467,41 +467,45 @@ first_isolate <- function(x = NULL,
|
||||
|
||||
x$other_pat_or_mo <- !(x$newvar_patient_id == pm_lag(x$newvar_patient_id) & x$newvar_genus_species == pm_lag(x$newvar_genus_species))
|
||||
|
||||
x$episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species)
|
||||
|
||||
x$newvar_episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species)
|
||||
|
||||
x$more_than_episode_ago <- unlist(
|
||||
lapply(
|
||||
split(
|
||||
x$newvar_date,
|
||||
x$episode_group
|
||||
x$newvar_episode_group
|
||||
),
|
||||
is_new_episode,
|
||||
episode_days = episode_days
|
||||
episode_days = episode_days,
|
||||
drop = FALSE
|
||||
),
|
||||
use.names = FALSE
|
||||
)
|
||||
|
||||
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
# with key antibiotics
|
||||
x$other_key_ab <- !antimicrobials_equal(
|
||||
y = x$newvar_key_ab,
|
||||
z = pm_lag(x$newvar_key_ab),
|
||||
type = type,
|
||||
ignore_I = ignore_I,
|
||||
points_threshold = points_threshold
|
||||
# using phenotypes
|
||||
x$different_antibiogram <- !unlist(
|
||||
lapply(
|
||||
split(
|
||||
x$newvar_key_ab,
|
||||
x$newvar_episode_group
|
||||
),
|
||||
duplicated_antibiogram,
|
||||
points_threshold = points_threshold,
|
||||
ignore_I = ignore_I,
|
||||
type = type
|
||||
),
|
||||
use.names = FALSE
|
||||
)
|
||||
x$newvar_first_isolate <- x$newvar_row_index_sorted >= row.start &
|
||||
x$newvar_row_index_sorted <= row.end &
|
||||
x$newvar_genus_species != "" &
|
||||
(x$other_pat_or_mo | x$more_than_episode_ago | x$other_key_ab)
|
||||
} else {
|
||||
# no key antibiotics
|
||||
x$newvar_first_isolate <- x$newvar_row_index_sorted >= row.start &
|
||||
x$newvar_row_index_sorted <= row.end &
|
||||
x$newvar_genus_species != "" &
|
||||
(x$other_pat_or_mo | x$more_than_episode_ago)
|
||||
x$different_antibiogram <- FALSE
|
||||
}
|
||||
|
||||
x$newvar_first_isolate <- x$newvar_row_index_sorted >= row.start &
|
||||
x$newvar_row_index_sorted <= row.end &
|
||||
x$newvar_genus_species != "" &
|
||||
(x$other_pat_or_mo | x$more_than_episode_ago | x$different_antibiogram)
|
||||
|
||||
decimal.mark <- getOption("OutDec")
|
||||
big.mark <- ifelse(decimal.mark != ",", ",", " ")
|
||||
|
||||
@ -664,3 +668,48 @@ coerce_method <- function(method) {
|
||||
method[method %like% "^(i$|iso)"] <- "isolate-based"
|
||||
method
|
||||
}
|
||||
|
||||
duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type) {
|
||||
if (length(antibiogram) == 1) {
|
||||
# fast return, only 1 isolate
|
||||
return(FALSE)
|
||||
}
|
||||
out <- rep(NA, length(antibiogram))
|
||||
out[1] <- FALSE
|
||||
out[2] <- antimicrobials_equal(antibiogram[1], antibiogram[2],
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type)
|
||||
if (length(antibiogram) == 2) {
|
||||
# fast return, no further check required
|
||||
return(out)
|
||||
}
|
||||
|
||||
# sort after the second one (since we already determined AB equality of the first two)
|
||||
original_sort <- c(1, 2, rank(antibiogram[3:length(antibiogram)]) + 2)
|
||||
antibiogram.bak <- antibiogram
|
||||
antibiogram <- c(antibiogram[1:2], sort(antibiogram[3:length(antibiogram)]))
|
||||
|
||||
# we can skip the duplicates - they are never unique antibiograms of course
|
||||
duplicates <- duplicated(antibiogram)
|
||||
out[3:length(out)][duplicates[3:length(out)] == TRUE] <- TRUE
|
||||
if (all(duplicates[3:length(out)] == TRUE, na.rm = TRUE)) {
|
||||
# fast return, no further check required
|
||||
return(c(out[1:2], rep(TRUE, length(out) - 2)))
|
||||
}
|
||||
|
||||
for (na in antibiogram[is.na(out)]) {
|
||||
# check if this antibiogram has any change with other antibiograms
|
||||
out[which(antibiogram == na)] <- all(
|
||||
vapply(FUN.VALUE = logical(1),
|
||||
antibiogram[!is.na(out) & antibiogram != na],
|
||||
function(y) antimicrobials_equal(y = y, z = na,
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type)))
|
||||
}
|
||||
|
||||
out <- out[original_sort]
|
||||
# rerun duplicated again
|
||||
duplicates <- duplicated(antibiogram.bak)
|
||||
out[duplicates == TRUE] <- TRUE
|
||||
out
|
||||
}
|
||||
|
||||
10
R/get_episode.R
Executable file → Normal file
10
R/get_episode.R
Executable file → Normal file
@ -221,11 +221,11 @@ exec_episode <- function(x, episode_days, case_free_days, ...) {
|
||||
|
||||
# running as.double() on a POSIXct object will return its number of seconds since 1970-01-01
|
||||
x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes
|
||||
|
||||
|
||||
# since x is now in seconds, get seconds from episode_days as well
|
||||
episode_seconds <- episode_days * 60 * 60 * 24
|
||||
case_free_seconds <- case_free_days * 60 * 60 * 24
|
||||
|
||||
|
||||
if (length(x) == 1) { # this will also match 1 NA, which is fine
|
||||
return(1)
|
||||
} else if (length(x) == 2 && all(!is.na(x))) {
|
||||
@ -241,7 +241,7 @@ exec_episode <- function(x, episode_days, case_free_days, ...) {
|
||||
}
|
||||
}
|
||||
|
||||
run_episodes <- function(x, episode_seconds, case_free) {
|
||||
run_episodes <- function(x, episode_sec, case_free_sec) {
|
||||
NAs <- which(is.na(x))
|
||||
x[NAs] <- 0
|
||||
|
||||
@ -250,8 +250,8 @@ exec_episode <- function(x, episode_days, case_free_days, ...) {
|
||||
ind <- 1
|
||||
indices[ind] <- 1
|
||||
for (i in 2:length(x)) {
|
||||
if ((length(episode_seconds) > 0 && (x[i] - start) >= episode_seconds) ||
|
||||
(length(case_free_seconds) > 0 && (x[i] - x[i - 1]) >= case_free_seconds)) {
|
||||
if ((length(episode_sec) > 0 && (x[i] - start) >= episode_sec) ||
|
||||
(length(case_free_sec) > 0 && (x[i] - x[i - 1]) >= case_free_sec)) {
|
||||
ind <- ind + 1
|
||||
start <- x[i]
|
||||
}
|
||||
|
||||
8
R/mdro.R
8
R/mdro.R
@ -203,7 +203,7 @@ mdro <- function(x = NULL,
|
||||
}
|
||||
|
||||
info.bak <- info
|
||||
# don't thrown info's more than once per call
|
||||
# don't throw info's more than once per call
|
||||
if (isTRUE(info)) {
|
||||
info <- message_not_thrown_before("mdro")
|
||||
}
|
||||
@ -1611,10 +1611,12 @@ mdro <- function(x = NULL,
|
||||
function(y) all(is.na(y))
|
||||
))
|
||||
if (length(rows_empty) > 0) {
|
||||
cat(font_italic(paste0(" (", length(rows_empty), " isolates had no test results)\n")))
|
||||
if (isTRUE(info.bak)) {
|
||||
cat(font_italic(paste0(" (", length(rows_empty), " isolates had no test results)\n")))
|
||||
}
|
||||
x[rows_empty, "MDRO"] <- NA
|
||||
x[rows_empty, "reason"] <- "none of the antibiotics have test results"
|
||||
} else {
|
||||
} else if (isTRUE(info.bak)) {
|
||||
cat("\n")
|
||||
}
|
||||
|
||||
|
||||
413
R/mic.R
Executable file → Normal file
413
R/mic.R
Executable file → Normal file
@ -462,399 +462,46 @@ quantile.mic <- function(x, probs = seq(0, 1, 0.25), na.rm = FALSE,
|
||||
quantile(as.double(x), probs = probs, na.rm = na.rm, names = names, type = type, ...)
|
||||
}
|
||||
|
||||
# Math (see ?groupGeneric) ----------------------------------------------
|
||||
# Math (see ?groupGeneric) ------------------------------------------------
|
||||
|
||||
#' @method abs mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
abs.mic <- function(x) {
|
||||
abs(as.double(x))
|
||||
}
|
||||
#' @method sign mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sign.mic <- function(x) {
|
||||
sign(as.double(x))
|
||||
}
|
||||
#' @method sqrt mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sqrt.mic <- function(x) {
|
||||
sqrt(as.double(x))
|
||||
}
|
||||
#' @method floor mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
floor.mic <- function(x) {
|
||||
floor(as.double(x))
|
||||
}
|
||||
#' @method ceiling mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
ceiling.mic <- function(x) {
|
||||
ceiling(as.double(x))
|
||||
}
|
||||
#' @method trunc mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
trunc.mic <- function(x, ...) {
|
||||
trunc(as.double(x), ...)
|
||||
}
|
||||
#' @method round mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
round.mic <- function(x, digits = 0, ...) {
|
||||
round(as.double(x), digits = digits, ...)
|
||||
}
|
||||
#' @method signif mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
signif.mic <- function(x, digits = 6) {
|
||||
signif(as.double(x), digits = digits)
|
||||
}
|
||||
#' @method exp mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
exp.mic <- function(x) {
|
||||
exp(as.double(x))
|
||||
}
|
||||
#' @method log mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log.mic <- function(x, base = exp(1)) {
|
||||
log(as.double(x), base = base)
|
||||
}
|
||||
#' @method log10 mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log10.mic <- function(x) {
|
||||
log10(as.double(x))
|
||||
}
|
||||
#' @method log2 mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log2.mic <- function(x) {
|
||||
log2(as.double(x))
|
||||
}
|
||||
#' @method expm1 mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
expm1.mic <- function(x) {
|
||||
expm1(as.double(x))
|
||||
}
|
||||
#' @method log1p mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
log1p.mic <- function(x) {
|
||||
log1p(as.double(x))
|
||||
}
|
||||
#' @method cos mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cos.mic <- function(x) {
|
||||
cos(as.double(x))
|
||||
}
|
||||
#' @method sin mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sin.mic <- function(x) {
|
||||
sin(as.double(x))
|
||||
}
|
||||
#' @method tan mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
tan.mic <- function(x) {
|
||||
tan(as.double(x))
|
||||
}
|
||||
#' @method cospi mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cospi.mic <- function(x) {
|
||||
cospi(as.double(x))
|
||||
}
|
||||
#' @method sinpi mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sinpi.mic <- function(x) {
|
||||
sinpi(as.double(x))
|
||||
}
|
||||
#' @method tanpi mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
tanpi.mic <- function(x) {
|
||||
tanpi(as.double(x))
|
||||
}
|
||||
#' @method acos mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
acos.mic <- function(x) {
|
||||
acos(as.double(x))
|
||||
}
|
||||
#' @method asin mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
asin.mic <- function(x) {
|
||||
asin(as.double(x))
|
||||
}
|
||||
#' @method atan mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
atan.mic <- function(x) {
|
||||
atan(as.double(x))
|
||||
}
|
||||
#' @method cosh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cosh.mic <- function(x) {
|
||||
cosh(as.double(x))
|
||||
}
|
||||
#' @method sinh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sinh.mic <- function(x) {
|
||||
sinh(as.double(x))
|
||||
}
|
||||
#' @method tanh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
tanh.mic <- function(x) {
|
||||
tanh(as.double(x))
|
||||
}
|
||||
#' @method acosh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
acosh.mic <- function(x) {
|
||||
acosh(as.double(x))
|
||||
}
|
||||
#' @method asinh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
asinh.mic <- function(x) {
|
||||
asinh(as.double(x))
|
||||
}
|
||||
#' @method atanh mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
atanh.mic <- function(x) {
|
||||
atanh(as.double(x))
|
||||
}
|
||||
#' @method lgamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
lgamma.mic <- function(x) {
|
||||
lgamma(as.double(x))
|
||||
}
|
||||
#' @method gamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
gamma.mic <- function(x) {
|
||||
gamma(as.double(x))
|
||||
}
|
||||
#' @method digamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
digamma.mic <- function(x) {
|
||||
digamma(as.double(x))
|
||||
}
|
||||
#' @method trigamma mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
trigamma.mic <- function(x) {
|
||||
trigamma(as.double(x))
|
||||
}
|
||||
#' @method cumsum mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cumsum.mic <- function(x) {
|
||||
cumsum(as.double(x))
|
||||
}
|
||||
#' @method cumprod mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cumprod.mic <- function(x) {
|
||||
cumprod(as.double(x))
|
||||
}
|
||||
#' @method cummax mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cummax.mic <- function(x) {
|
||||
cummax(as.double(x))
|
||||
}
|
||||
#' @method cummin mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
cummin.mic <- function(x) {
|
||||
cummin(as.double(x))
|
||||
Math.mic <- function(x, ...) {
|
||||
x <- as.double(x)
|
||||
# set class to numeric, because otherwise NextMethod will be factor (since mic is a factor)
|
||||
.Class <- class(x)
|
||||
NextMethod(.Generic)
|
||||
}
|
||||
|
||||
# Ops (see ?groupGeneric) -----------------------------------------------
|
||||
# Ops (see ?groupGeneric) -------------------------------------------------
|
||||
|
||||
is_greater <- function(el) {
|
||||
el %like_case% ">[0-9]"
|
||||
}
|
||||
is_lower <- function(el) {
|
||||
el %like_case% "<[0-9]"
|
||||
#' @export
|
||||
Ops.mic <- function(e1, e2) {
|
||||
e1 <- as.double(e1)
|
||||
if (!missing(e2)) {
|
||||
# when e1 is `!`, e2 is missing
|
||||
e2 <- as.double(e2)
|
||||
}
|
||||
# set class to numeric, because otherwise NextMethod will be factor (since mic is a factor)
|
||||
.Class <- class(e1)
|
||||
NextMethod(.Generic)
|
||||
}
|
||||
|
||||
#' @method + mic
|
||||
# Complex (see ?groupGeneric) ---------------------------------------------
|
||||
|
||||
#' @export
|
||||
#' @noRd
|
||||
`+.mic` <- function(e1, e2) {
|
||||
as.double(e1) + as.double(e2)
|
||||
Complex.mic <- function(z) {
|
||||
z <- as.double(z)
|
||||
# set class to numeric, because otherwise NextMethod will be factor (since mic is a factor)
|
||||
.Class <- class(z)
|
||||
NextMethod(.Generic)
|
||||
}
|
||||
|
||||
#' @method - mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`-.mic` <- function(e1, e2) {
|
||||
as.double(e1) - as.double(e2)
|
||||
}
|
||||
# Summary (see ?groupGeneric) ---------------------------------------------
|
||||
|
||||
#' @method * mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`*.mic` <- function(e1, e2) {
|
||||
as.double(e1) * as.double(e2)
|
||||
}
|
||||
|
||||
#' @method / mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`/.mic` <- function(e1, e2) {
|
||||
as.double(e1) / as.double(e2)
|
||||
}
|
||||
|
||||
#' @method ^ mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`^.mic` <- function(e1, e2) {
|
||||
as.double(e1)^as.double(e2)
|
||||
}
|
||||
|
||||
#' @method %% mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`%%.mic` <- function(e1, e2) {
|
||||
as.double(e1) %% as.double(e2)
|
||||
}
|
||||
|
||||
#' @method %/% mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`%/%.mic` <- function(e1, e2) {
|
||||
as.double(e1) %/% as.double(e2)
|
||||
}
|
||||
|
||||
#' @method & mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`&.mic` <- function(e1, e2) {
|
||||
as.double(e1) & as.double(e2)
|
||||
}
|
||||
|
||||
#' @method | mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`|.mic` <- function(e1, e2) {
|
||||
as.double(e1) | as.double(e2)
|
||||
}
|
||||
|
||||
#' @method ! mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`!.mic` <- function(x) {
|
||||
!as.double(x)
|
||||
}
|
||||
|
||||
#' @method == mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`==.mic` <- function(e1, e2) {
|
||||
as.double(e1) == as.double(e2)
|
||||
}
|
||||
|
||||
#' @method != mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`!=.mic` <- function(e1, e2) {
|
||||
as.double(e1) != as.double(e2)
|
||||
}
|
||||
|
||||
#' @method < mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`<.mic` <- function(e1, e2) {
|
||||
as.double(e1) < as.double(e2)
|
||||
}
|
||||
|
||||
#' @method <= mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`<=.mic` <- function(e1, e2) {
|
||||
as.double(e1) <= as.double(e2)
|
||||
}
|
||||
|
||||
#' @method >= mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`>=.mic` <- function(e1, e2) {
|
||||
as.double(e1) >= as.double(e2)
|
||||
}
|
||||
|
||||
#' @method > mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
`>.mic` <- function(e1, e2) {
|
||||
as.double(e1) > as.double(e2)
|
||||
# doesn't work...
|
||||
# nolint start
|
||||
# as.double(e1) > as.double(e2) |
|
||||
# (as.double(e1) == as.double(e2) & is_lower(e2) & !is_lower(e1)) |
|
||||
# (as.double(e1) == as.double(e2) & is_greater(e1) & !is_greater(e2))
|
||||
# nolint end
|
||||
}
|
||||
|
||||
# Summary (see ?groupGeneric) -------------------------------------------
|
||||
|
||||
#' @method all mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
all.mic <- function(..., na.rm = FALSE) {
|
||||
all(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method any mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
any.mic <- function(..., na.rm = FALSE) {
|
||||
any(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method sum mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sum.mic <- function(..., na.rm = FALSE) {
|
||||
sum(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method prod mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
prod.mic <- function(..., na.rm = FALSE) {
|
||||
prod(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method min mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
min.mic <- function(..., na.rm = FALSE) {
|
||||
min(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method max mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
max.mic <- function(..., na.rm = FALSE) {
|
||||
max(as.double(c(...)), na.rm = na.rm)
|
||||
}
|
||||
#' @method range mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
range.mic <- function(..., na.rm = FALSE) {
|
||||
range(as.double(c(...)), na.rm = na.rm)
|
||||
Summary.mic <- function(..., na.rm = FALSE) {
|
||||
# NextMethod() cannot be called from an anonymous function (`...`), so we get() the generic directly:
|
||||
fn <- get(.Generic, envir = .GenericCallEnv)
|
||||
fn(as.double(c(...)),
|
||||
na.rm = na.rm)
|
||||
}
|
||||
|
||||
6
R/proportion.R
Executable file → Normal file
6
R/proportion.R
Executable file → Normal file
@ -46,13 +46,13 @@
|
||||
#' @param collapse a [logical] to indicate whether the output values should be 'collapsed', i.e. be merged together into one value, or a character value to use for collapsing
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @details
|
||||
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set with one of the four available algorithms.
|
||||
#'
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
|
||||
#'
|
||||
#' Use [sir_confidence_interval()] to calculate the confidence interval, which relies on [binom.test()], i.e., the Clopper-Pearson method. This function returns a vector of length 2 at default for antimicrobial *resistance*. Change the `side` argument to "left"/"min" or "right"/"max" to return a single value, and change the `ab_result` argument to e.g. `c("S", "I")` to test for antimicrobial *susceptibility*, see Examples.
|
||||
#'
|
||||
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set with one of the four available algorithms.
|
||||
#'
|
||||
#' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to `count_susceptible() / count_all()`. *Low counts can influence the outcome - the `proportion` functions may camouflage this, since they only return the proportion (albeit being dependent on the `minimum` argument).*
|
||||
#' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count_*()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to [count_susceptible()]` / `[count_all()]. *Low counts can influence the outcome - the `proportion_*()` functions may camouflage this, since they only return the proportion (albeit dependent on the `minimum` argument).*
|
||||
#'
|
||||
#' The function [proportion_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and calculates the proportions S, I, and R. It also supports grouped variables. The function [sir_df()] works exactly like [proportion_df()], but adds the number of isolates.
|
||||
#' @section Combination Therapy:
|
||||
|
||||
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
@ -66,17 +66,12 @@
|
||||
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
|
||||
#'
|
||||
#' # setting another language
|
||||
#' set_AMR_locale("Spanish")
|
||||
#' set_AMR_locale("Dutch")
|
||||
#' ab_name("Ciprofloxacin")
|
||||
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
|
||||
#'
|
||||
#' # setting yet another language
|
||||
#' set_AMR_locale("Greek")
|
||||
#' ab_name("Ciprofloxacin")
|
||||
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
|
||||
#'
|
||||
#' # setting yet another language
|
||||
#' set_AMR_locale("Ukrainian")
|
||||
#' set_AMR_locale("German")
|
||||
#' ab_name("Ciprofloxacin")
|
||||
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
|
||||
#'
|
||||
@ -266,7 +261,7 @@ translate_into_language <- function(from,
|
||||
# a kind of left join to get all results back
|
||||
out <- from_unique_translated[match(from.bak, from_unique)]
|
||||
|
||||
if (!identical(from.bak, out) && get_AMR_locale() == lang && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
|
||||
if (!identical(from.bak, out) && get_AMR_locale() == lang && is.null(getOption("AMR_locale", default = NULL)) && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
|
||||
message(word_wrap(
|
||||
"Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
|
||||
LANGUAGES_SUPPORTED_NAMES[[lang]]$endonym, ") for the AMR package. See `set_AMR_locale()` to change this or to silence this once-per-session note.",
|
||||
|
||||
Reference in New Issue
Block a user