(v1.7.1.9054) mdro() update - fixes #49, first_isolate() speedup

This commit is contained in:
dr. M.S. (Matthijs) Berends 2021-11-28 23:01:26 +01:00
parent 9a2c431e16
commit 694cf5ba77
72 changed files with 780 additions and 669 deletions

View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.7.1.9053
Date: 2021-11-01
Version: 1.7.1.9054
Date: 2021-11-28
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by
@ -10,8 +10,12 @@ Authors@R: c(
person(given = c("Matthijs", "S."),
family = "Berends",
email = "m.s.berends@umcg.nl",
role = c("aut", "cre"),
role = c("aut", "cre"),
comment = c(ORCID = "0000-0001-7620-1800")),
person(given = c("Christian", "F."),
family = "Luz",
role = c("aut", "ctb"),
comment = c(ORCID = "0000-0001-5809-5995")),
person(given = "Dennis",
family = "Souverein",
role = c("aut", "ctb"),
@ -19,10 +23,6 @@ Authors@R: c(
person(given = c("Erwin", "E.", "A."),
family = "Hassing",
role = c("aut", "ctb")),
person(given = c("Christian", "F."),
family = "Luz",
role = c("aut", "ctb"),
comment = c(ORCID = "0000-0001-5809-5995")),
person(given = c("Casper", "J."),
family = "Albers",
role = "ths",
@ -30,7 +30,7 @@ Authors@R: c(
person(given = c("Judith", "M."),
family = "Fonville",
role = "ctb"),
person(given = c("Alexander", "W."),
person(given = c("Alex", "W."),
family = "Friedrich",
role = "ths",
comment = c(ORCID = "0000-0003-4881-038X")),

View File

@ -157,6 +157,9 @@ export("%like%")
export("%like_case%")
export("%unlike%")
export("%unlike_case%")
export(NA_disk_)
export(NA_mic_)
export(NA_rsi_)
export(ab_atc)
export(ab_atc_group1)
export(ab_atc_group2)

14
NEWS.md
View File

@ -1,5 +1,5 @@
# `AMR` 1.7.1.9053
## <small>Last updated: 1 November 2021</small>
# `AMR` 1.7.1.9054
## <small>Last updated: 28 November 2021</small>
### Breaking changes
* Removed `p_symbol()` and all `filter_*()` functions (except for `filter_first_isolate()`), which were all deprecated in a previous package version
@ -7,6 +7,7 @@
* Removed all previously implemented `ggplot2::ggplot()` generics for classes `<mic>`, `<disk>`, `<rsi>` and `<resistance_predict>` as they did not follow the `ggplot2` logic. They were replaced with `ggplot2::autoplot()` generics.
### New
* Support for EUCAST Intrinsic Resistance and Unusual Phenotypes v3.3 (October 2021), effective in the `eucast_rules()` function. This is now the default guideline (all other guidelines are still available).
* Function `set_ab_names()` to rename data set columns that resemble antimicrobial drugs. This allows for quickly renaming columns to official names, ATC codes, etc.
* Support for Danish, and also added missing translations of all antimicrobial drugs in Italian, French and Portuguese
@ -34,12 +35,14 @@
* Fix for using selectors multiple times in one call (e.g., using them in `dplyr::filter()` and immediately after in `dplyr::select()`)
* Added argument `only_treatable`, which defaults to `TRUE` and will exclude drugs that are only for laboratory tests and not for treating patients (such as imipenem/EDTA and gentamicin-high)
* Fixed the Gram stain (`mo_gramstain()`) determination of the taxonomic class Negativicutes within the phylum of Firmicutes - they were considered Gram-positives because of their phylum but are actually Gram-negative. This impacts 137 taxonomic species, genera and families, such as *Negativicoccus* and *Veillonella*.
* Dramatic speed improvement for `first_isolate()`
* Fix to prevent introducing `NA`s for old MO codes when running `as.mo()` on them
* Added more informative error messages when any of the `proportion_*()` and `count_*()` functions fail
* When printing a tibble with any old MO code, a warning will be thrown that old codes should be updated using `as.mo()`
* Improved automatic column selector when `col_*` arguments are left blank, e.g. in `first_isolate()`
* The right input types for `random_mic()`, `random_disk()` and `random_rsi()` are now enforced
* `as.rsi()` can now correct for textual input (such as "Susceptible", "Resistant") in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish
* `as.rsi()` has an improved algorithm and can now also correct for textual input (such as "Susceptible", "Resistant") in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish
* `as.mic()` has an improved algorithm
* When warnings are thrown because of too few isolates in any `count_*()`, `proportion_*()` function (or `resistant()` or `susceptible()`), the `dplyr` group will be shown, if available
* Fix for legends created with `scale_rsi_colours()` when using `ggplot2` v3.3.4 or higher (this is ggplot2 bug 4511, soon to be fixed)
* Fix for minor translation errors
@ -48,9 +51,12 @@
* Improved plot legends for MICs and disk diffusion values
* Improved speed of `as.ab()` and all `ab_*()` functions
* Added `fortify()` extensions for plotting methods
* `NA` values of the classes `<mic>`, `<disk>` and `<rsi>` are now exported objects of this package, e.g. `NA_mic_` is an `NA` of class `mic` (just like the base R `NA_character_` is an `NA` of class `character`)
* The `proportion_df()`, `count_df()` and `rsi_df()` functions now return with the additional S3 class 'rsi_df' so they can be extended by other packages
* The `mdro()` function now returns `NA` for all rows that have no test results
### Other
* This package is now being maintained by two epidemiologists and a data scientist from two different non-profit healthcare organisations. All functions in this package are now all considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated yearly from now on.
* This package is now being maintained by two epidemiologists and a data scientist from two different non-profit healthcare organisations. All functions in this package are now all considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated every 6 to 12 months from now on.
# AMR 1.7.1

3
R/ab.R
View File

@ -119,6 +119,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
x <- gsub('"', "", x, fixed = TRUE)
x <- gsub("(specimen|specimen date|specimen_date|spec_date|gender|^dates?$)", "", x, ignore.case = TRUE, perl = TRUE)
# penicillin is a special case: we call it so, but then mean benzylpenicillin
x[x %like_case% "^PENICILLIN" & x %unlike_case% "[ /+-]"] <- "benzylpenicillin"
x_bak_clean <- x
if (already_regex == FALSE) {
x_bak_clean <- generalise_antibiotic_name(x_bak_clean)
@ -227,6 +229,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
}
x_spelling <- x[i]
if (already_regex == FALSE) {
x_spelling <- gsub("[IY]+", "[IY]+", x_spelling, perl = TRUE)
x_spelling <- gsub("(C|K|Q|QU|S|Z|X|KS)+", "(C|K|Q|QU|S|Z|X|KS)+", x_spelling, perl = TRUE)
x_spelling <- gsub("(PH|F|V)+", "(PH|F|V)+", x_spelling, perl = TRUE)

View File

@ -26,7 +26,7 @@
#' Define Custom EUCAST Rules
#'
#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
#' @inheritSection lifecycle Maturing Lifecycle
#' @inheritSection lifecycle Stable Lifecycle
#' @param ... rules in formula notation, see *Examples*
#' @details
#' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.

View File

@ -119,6 +119,12 @@ all_valid_disks <- function(x) {
!any(is.na(x_disk)) && !all(is.na(x))
}
#' @rdname as.disk
#' @details `NA_disk_` is a missing value of the new `<disk>` class.
#' @export
NA_disk_ <- set_clean_class(as.integer(NA_real_),
new_class = c("disk", "integer"))
#' @rdname as.disk
#' @export
is.disk <- function(x) {

View File

@ -108,8 +108,8 @@ get_episode <- function(x, episode_days, ...) {
meet_criteria(x, allow_class = c("Date", "POSIXt"))
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
exec_episode(type = "sequential",
x = x,
exec_episode(x = x,
type = "sequential",
episode_days = episode_days,
... = ...)
}
@ -120,13 +120,13 @@ is_new_episode <- function(x, episode_days, ...) {
meet_criteria(x, allow_class = c("Date", "POSIXt"))
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
exec_episode(type = "logical",
x = x,
exec_episode(x = x,
type = "logical",
episode_days = episode_days,
... = ...)
}
exec_episode <- function(type, x, episode_days, ...) {
exec_episode <- function(x, type, episode_days, ...) {
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
@ -155,7 +155,7 @@ exec_episode <- function(type, x, episode_days, ...) {
# I asked on StackOverflow:
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year
exec <- function(x, episode_seconds) {
run_episodes <- function(x, episode_seconds) {
indices <- integer()
start <- x[1]
ind <- 1
@ -181,11 +181,6 @@ exec_episode <- function(type, x, episode_days, ...) {
}
}
df <- data.frame(x = x,
y = seq_len(length(x))) %pm>%
pm_arrange(x)
df$new <- exec(df$x, episode_seconds)
df %pm>%
pm_arrange(y) %pm>%
pm_pull(new)
ord <- order(x)
run_episodes(x[ord], episode_seconds)[ord]
}

View File

@ -23,6 +23,10 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# ====================================================== #
# || Change the EUCAST version numbers in R/globals.R || #
# ====================================================== #
format_eucast_version_nr <- function(version, markdown = TRUE) {
# for documentation - adds title, version number, year and url in markdown language
lst <- c(EUCAST_VERSION_BREAKPOINTS, EUCAST_VERSION_EXPERT_RULES)
@ -105,6 +109,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' Leclercq et al. **EUCAST expert rules in antimicrobial susceptibility testing.** *Clin Microbiol Infect.* 2013;19(2):141-60; \doi{https://doi.org/10.1111/j.1469-0691.2011.03703.x}
#' - EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf)
#' - EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.2, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf)
#' - EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.3, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2021/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.3_20211018.pdf)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 9.0, 2019. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_9.0_Breakpoint_Tables.xlsx)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 10.0, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_10.0_Breakpoint_Tables.xlsx)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx)
@ -159,7 +164,7 @@ eucast_rules <- function(x,
rules = getOption("AMR_eucastrules", default = c("breakpoints", "expert")),
verbose = FALSE,
version_breakpoints = 11.0,
version_expertrules = 3.2,
version_expertrules = 3.3,
ampc_cephalosporin_resistance = NA,
only_rsi_columns = FALSE,
custom_rules = NULL,
@ -316,25 +321,6 @@ eucast_rules <- function(x,
}
# Some helper functions ---------------------------------------------------
get_antibiotic_columns <- function(x, cols_ab) {
x <- trimws(unique(toupper(unlist(strsplit(x, ",")))))
x_new <- character()
for (val in x) {
if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
# antibiotic group names, as defined in data-raw/_internals.R, such as `AB_CARBAPENEMS`
val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR"))
} else if (val %in% AB_lookup$ab) {
# separate drugs, such as `AMX`
val <- as.ab(val)
} else {
stop_("unknown antimicrobial agent (group) in EUCAST rules file: ", val, call = FALSE)
}
x_new <- c(x_new, val)
}
x_new <- unique(x_new)
out <- cols_ab[match(x_new, names(cols_ab))]
out[!is.na(out)]
}
get_antibiotic_names <- function(x) {
x <- x %pm>%
strsplit(",") %pm>%
@ -580,6 +566,7 @@ eucast_rules <- function(x,
(reference.rule_group %like% "expert" & reference.version == version_expertrules))
}
# filter out AmpC de-repressed cephalosporin-resistant mutants ----
# no need to filter on version number here - the rules contain these version number, so are inherently filtered
# cefotaxime, ceftriaxone, ceftazidime
if (is.null(ampc_cephalosporin_resistance) || isFALSE(ampc_cephalosporin_resistance)) {
eucast_rules_df <- subset(eucast_rules_df,
@ -720,7 +707,7 @@ eucast_rules <- function(x,
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value),
error = function(e) integer(0))
} else {
source_antibiotics <- get_antibiotic_columns(source_antibiotics, cols_ab)
source_antibiotics <- get_ab_from_namespace(source_antibiotics, cols_ab)
if (length(source_value) == 1 & length(source_antibiotics) > 1) {
source_value <- rep(source_value, length(source_antibiotics))
}
@ -748,7 +735,7 @@ eucast_rules <- function(x,
}
}
cols <- get_antibiotic_columns(target_antibiotics, cols_ab)
cols <- get_ab_from_namespace(target_antibiotics, cols_ab)
# Apply rule on data ------------------------------------------------------
# this will return the unique number of changes

View File

@ -238,7 +238,7 @@ first_isolate <- function(x = NULL,
meet_criteria(testcodes_exclude, allow_class = "character", allow_NULL = TRUE)
meet_criteria(icu_exclude, allow_class = "logical", has_length = 1)
meet_criteria(specimen_group, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(type, allow_class = "character", has_length = 1)
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("points", "keyantimicrobials"))
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
meet_criteria(info, allow_class = "logical", has_length = 1)
@ -250,7 +250,8 @@ first_isolate <- function(x = NULL,
any_col_contains_rsi <- any(vapply(FUN.VALUE = logical(1),
X = x,
FUN = function(x) any(as.character(x) %in% c("R", "S", "I"), na.rm = TRUE),
# check only first 10,000 rows
FUN = function(x) any(as.character(x[1:10000]) %in% c("R", "S", "I"), na.rm = TRUE),
USE.NAMES = FALSE))
if (method == "phenotype-based" & !any_col_contains_rsi) {
method <- "episode-based"
@ -443,17 +444,6 @@ first_isolate <- function(x = NULL,
!is.na(x$newvar_mo)), , drop = FALSE])
# Analysis of first isolate ----
x$other_pat_or_mo <- ifelse(x$newvar_patient_id == pm_lag(x$newvar_patient_id) &
x$newvar_genus_species == pm_lag(x$newvar_genus_species),
FALSE,
TRUE)
x$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),
is_new_episode,
episode_days = episode_days),
use.names = FALSE)
if (!is.null(col_keyantimicrobials)) {
if (info == TRUE & message_not_thrown_before("first_isolate.type")) {
if (type == "keyantimicrobials") {
@ -470,23 +460,38 @@ first_isolate <- function(x = NULL,
as_note = FALSE)
}
}
type_param <- type
}
x$other_pat_or_mo <- ifelse(x$newvar_patient_id == pm_lag(x$newvar_patient_id) &
x$newvar_genus_species == pm_lag(x$newvar_genus_species),
FALSE,
TRUE)
x$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),
exec_episode, # this will skip meet_criteria() in is_new_episode(), saving time
type = "logical",
episode_days = episode_days),
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_param,
type = type,
ignore_I = ignore_I,
points_threshold = points_threshold)
# with key antibiotics
x$newvar_first_isolate <- pm_if_else(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),
TRUE,
FALSE)
} else {
# no key antibiotics
x1 <<- x$other_pat_or_mo
x2 <<- x$more_than_episode_ago
x$newvar_first_isolate <- pm_if_else(x$newvar_row_index_sorted >= row.start &
x$newvar_row_index_sorted <= row.end &
x$newvar_genus_species != "" &
@ -566,7 +571,7 @@ first_isolate <- function(x = NULL,
}
# arrange back according to original sorting again
x <- x[order(x$newvar_row_index), ]
x <- x[order(x$newvar_row_index), , drop = FALSE]
rownames(x) <- NULL
if (info == TRUE) {

View File

@ -40,6 +40,10 @@ EUCAST_VERSION_EXPERT_RULES <- list("3.1" = list(version_txt = "v3.1",
"3.2" = list(version_txt = "v3.2",
year = 2020,
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
url = "https://www.eucast.org/expert_rules_and_intrinsic_resistance/"),
"3.3" = list(version_txt = "v3.3",
year = 2021,
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
url = "https://www.eucast.org/expert_rules_and_intrinsic_resistance/"))
SNOMED_VERSION <- list(title = "Public Health Information Network Vocabulary Access and Distribution System (PHIN VADS)",

View File

@ -293,6 +293,28 @@ get_column_abx <- function(x,
out
}
get_ab_from_namespace <- function(x, cols_ab) {
# cols_ab comes from get_column_abx()
x <- trimws(unique(toupper(unlist(strsplit(x, ",")))))
x_new <- character()
for (val in x) {
if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
# antibiotic group names, as defined in data-raw/_internals.R, such as `AB_CARBAPENEMS`
val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR"))
} else if (val %in% AB_lookup$ab) {
# separate drugs, such as `AMX`
val <- as.ab(val)
} else {
stop_("unknown antimicrobial agent (group): ", val, call = FALSE)
}
x_new <- c(x_new, val)
}
x_new <- unique(x_new)
out <- cols_ab[match(x_new, names(cols_ab))]
out[!is.na(out)]
}
generate_warning_abs_missing <- function(missing, any = FALSE) {
missing <- paste0(missing, " (", ab_name(missing, tolower = TRUE, language = NULL), ")")
if (any == TRUE) {

View File

@ -26,7 +26,7 @@
#' Italicise Taxonomic Families, Genera, Species, Subspecies
#'
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italic. This function finds taxonomic names within strings and makes them italic.
#' @inheritSection lifecycle Maturing Lifecycle
#' @inheritSection lifecycle Stable Lifecycle
#' @param string a [character] (vector)
#' @param type type of conversion of the taxonomic names, either "markdown" or "ansi", see *Details*
#' @details

View File

@ -250,16 +250,16 @@ generate_antimcrobials_string <- function(df) {
if (NROW(df) == 0) {
return(character(0))
}
out <- tryCatch(
tryCatch({
do.call(paste0,
lapply(as.list(df),
function(x) {
x <- toupper(as.character(x))
x[!x %in% c("R", "S", "I")] <- "."
paste(x)
})),
error = function(e) rep(strrep(".", NCOL(df)), NROW(df)))
out
}))
},
error = function(e) rep(strrep(".", NCOL(df)), NROW(df)))
}
#' @rdname key_antimicrobials
@ -279,10 +279,20 @@ antimicrobials_equal <- function(y,
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
key2rsi <- function(val) {
as.double(as.rsi(gsub(".", NA_character_, unlist(strsplit(val, "")), fixed = TRUE)))
val <- strsplit(val, "")[[1L]]
val.int <- rep(NA_real_, length(val))
val.int[val == "S"] <- 1
val.int[val == "I"] <- 2
val.int[val == "R"] <- 3
val.int
}
y <- lapply(y, key2rsi)
z <- lapply(z, key2rsi)
# only run on uniques
uniq <- unique(c(y, z))
uniq_list <- lapply(uniq, key2rsi)
names(uniq_list) <- uniq
y <- uniq_list[match(y, names(uniq_list))]
z <- uniq_list[match(z, names(uniq_list))]
determine_equality <- function(a, b, type, points_threshold, ignore_I) {
if (length(a) != length(b)) {

View File

@ -536,6 +536,13 @@ mdro <- function(x = NULL,
only_rsi_columns = only_rsi_columns,
...)
}
if (!"AMP" %in% names(cols_ab) & "AMX" %in% names(cols_ab)) {
# ampicillin column is missing, but amoxicillin is available
if (info == TRUE) {
message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many EUCAST rules depend on it.")
}
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
}
# nolint start
AMC <- cols_ab["AMC"]
@ -738,7 +745,8 @@ mdro <- function(x = NULL,
x[rows, "columns_nonsusceptible"] <<- vapply(FUN.VALUE = character(1),
rows,
function(row, group_vct = cols) {
cols_nonsus <- vapply(FUN.VALUE = logical(1), x[row, group_vct, drop = FALSE],
cols_nonsus <- vapply(FUN.VALUE = logical(1),
x[row, group_vct, drop = FALSE],
function(y) y %in% search_result)
paste(sort(c(unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ")),
names(cols_nonsus)[cols_nonsus])),
@ -752,17 +760,20 @@ mdro <- function(x = NULL,
}
x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE]),
stringsAsFactors = FALSE))
row_filter <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) search_function(y %in% search_result, na.rm = TRUE))
row_filter <- x[which(row_filter), "row_number", drop = TRUE]
rows <- rows[rows %in% row_filter]
x[rows, "MDRO"] <<- to
x[rows, "reason"] <<- paste0(any_all,
" of the required antibiotics ",
ifelse(any_all == "any", "is", "are"),
" R",
ifelse(!isTRUE(combine_SI), " or I", ""))
rows_affected <- vapply(FUN.VALUE = logical(1),
x_transposed,
function(y) search_function(y %in% search_result, na.rm = TRUE))
rows_affected <- x[which(rows_affected), "row_number", drop = TRUE]
rows_to_change <- rows[rows %in% rows_affected]
x[rows_to_change, "MDRO"] <<- to
x[rows_to_change, "reason"] <<- paste0(any_all,
" of the required antibiotics ",
ifelse(any_all == "any", "is", "are"),
" R",
ifelse(!isTRUE(combine_SI), " or I", ""))
}
}
trans_tbl2 <- function(txt, rows, lst) {
if (info == TRUE) {
message_(txt, "...", appendLF = FALSE, as_note = FALSE)
@ -1382,16 +1393,6 @@ mdro <- function(x = NULL,
x$reason <- "PDR/MDR/XDR criteria were met"
}
if (info.bak == TRUE) {
cat(group_msg)
if (sum(!is.na(x$MDRO)) == 0) {
cat(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the guideline")))
} else {
cat(font_bold(paste0("=> Found ", sum(x$MDRO %in% c(2:5), na.rm = TRUE), " ", guideline$type, " out of ", sum(!is.na(x$MDRO)),
" isolates (", trimws(percentage(sum(x$MDRO %in% c(2:5), na.rm = TRUE) / sum(!is.na(x$MDRO)))), ")\n")))
}
}
# some more info on negative results
if (verbose == TRUE) {
if (guideline$code == "cmi2012") {
@ -1406,6 +1407,31 @@ mdro <- function(x = NULL,
}
}
if (info.bak == TRUE) {
cat(group_msg)
if (sum(!is.na(x$MDRO)) == 0) {
cat(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the guideline")))
} else {
cat(font_bold(paste0("=> Found ", sum(x$MDRO %in% c(2:5), na.rm = TRUE), " ", guideline$type, " out of ", sum(!is.na(x$MDRO)),
" isolates (", trimws(percentage(sum(x$MDRO %in% c(2:5), na.rm = TRUE) / sum(!is.na(x$MDRO)))), ")")))
}
}
# Fill in blanks ----
# for rows that have no results
x_transposed <- as.list(as.data.frame(t(x[, cols_ab, drop = FALSE]),
stringsAsFactors = FALSE))
rows_empty <- which(vapply(FUN.VALUE = logical(1),
x_transposed,
function(y) all(is.na(y))))
if (length(rows_empty) > 0) {
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 {
cat("\n")
}
# Results ----
if (guideline$code == "cmi2012") {
if (any(x$MDRO == -1, na.rm = TRUE)) {

44
R/mic.R
View File

@ -23,9 +23,26 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# these are allowed MIC values and will become [factor] levels
ops <- c("<", "<=", "", ">=", ">")
valid_mic_levels <- c(c(t(vapply(FUN.VALUE = character(9), ops,
function(x) paste0(x, "0.00", 1:9)))),
unique(c(t(vapply(FUN.VALUE = character(104), ops,
function(x) paste0(x, sort(as.double(paste0("0.0",
sort(c(1:99, 125, 128, 256, 512, 625)))))))))),
unique(c(t(vapply(FUN.VALUE = character(103), ops,
function(x) paste0(x, sort(as.double(paste0("0.",
c(1:99, 125, 128, 256, 512))))))))),
c(t(vapply(FUN.VALUE = character(10), ops,
function(x) paste0(x, sort(c(1:9, 1.5)))))),
c(t(vapply(FUN.VALUE = character(45), ops,
function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])))),
c(t(vapply(FUN.VALUE = character(15), ops,
function(x) paste0(x, sort(c(2 ^ c(7:10), 80 * c(2:12))))))))
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
#'
#' This ransforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
#' This transforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname as.mic
#' @param x a [character] or [numeric] vector
@ -117,6 +134,8 @@ as.mic <- function(x, na.rm = FALSE) {
# transform Unicode for >= and <=
x <- gsub("\u2264", "<=", x, fixed = TRUE)
x <- gsub("\u2265", ">=", x, fixed = TRUE)
# remove other invalid characters
x <- gsub("[^a-zA-Z0-9.><= ]+", "", x, perl = TRUE)
# remove space between operator and number ("<= 0.002" -> "<=0.002")
x <- gsub("(<|=|>) +", "\\1", x, perl = TRUE)
# transform => to >= and =< to <=
@ -141,27 +160,14 @@ as.mic <- function(x, na.rm = FALSE) {
x[x %like% "[.]"] <- gsub("0+$", "", x[x %like% "[.]"])
# never end with dot
x <- gsub("[.]$", "", x, perl = TRUE)
# force to be character
x <- as.character(x)
# trim it
x <- trimws(x)
## previously unempty values now empty - should return a warning later on
x[x.bak != "" & x == ""] <- "invalid"
# these are allowed MIC values and will become [factor] levels
ops <- c("<", "<=", "", ">=", ">")
lvls <- c(c(t(vapply(FUN.VALUE = character(9), ops, function(x) paste0(x, "0.00", 1:9)))),
unique(c(t(vapply(FUN.VALUE = character(104), ops, function(x) paste0(x, sort(as.double(paste0("0.0",
sort(c(1:99, 125, 128, 256, 512, 625)))))))))),
unique(c(t(vapply(FUN.VALUE = character(103), ops, function(x) paste0(x, sort(as.double(paste0("0.",
c(1:99, 125, 128, 256, 512))))))))),
c(t(vapply(FUN.VALUE = character(10), ops, function(x) paste0(x, sort(c(1:9, 1.5)))))),
c(t(vapply(FUN.VALUE = character(45), ops, function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])))),
c(t(vapply(FUN.VALUE = character(15), ops, function(x) paste0(x, sort(c(2 ^ c(7:10), 80 * c(2:12))))))))
na_before <- x[is.na(x) | x == ""] %pm>% length()
x[!x %in% lvls] <- NA
x[!x %in% valid_mic_levels] <- NA
na_after <- x[is.na(x) | x == ""] %pm>% length()
if (na_before != na_after) {
@ -175,7 +181,7 @@ as.mic <- function(x, na.rm = FALSE) {
list_missing, call = FALSE)
}
set_clean_class(factor(x, levels = lvls, ordered = TRUE),
set_clean_class(factor(x, levels = valid_mic_levels, ordered = TRUE),
new_class = c("mic", "ordered", "factor"))
}
}
@ -189,6 +195,12 @@ all_valid_mics <- function(x) {
!any(is.na(x_mic)) && !all(is.na(x))
}
#' @rdname as.mic
#' @details `NA_mic_` is a missing value of the new `<mic>` class.
#' @export
NA_mic_ <- set_clean_class(factor(NA, levels = valid_mic_levels, ordered = TRUE),
new_class = c("mic", "ordered", "factor"))
#' @rdname as.mic
#' @export
is.mic <- function(x) {

View File

@ -26,7 +26,7 @@
#' Plotting for Classes `rsi`, `mic` and `disk`
#'
#' Functions to plot classes `rsi`, `mic` and `disk`, with support for base \R and `ggplot2`.
#' @inheritSection lifecycle Maturing Lifecycle
#' @inheritSection lifecycle Stable Lifecycle
#' @inheritSection AMR Read more on Our Website!
#' @param x,object values created with [as.mic()], [as.disk()] or [as.rsi()] (or their `random_*` variants, such as [random_mic()])
#' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()]

35
R/rsi.R
View File

@ -188,6 +188,12 @@ as.rsi <- function(x, ...) {
UseMethod("as.rsi")
}
#' @rdname as.rsi
#' @details `NA_rsi_` is a missing value of the new `<rsi>` class.
#' @export
NA_rsi_ <- set_clean_class(factor(NA, levels = c("S", "I", "R"), ordered = TRUE),
new_class = c("rsi", "ordered", "factor"))
#' @rdname as.rsi
#' @export
is.rsi <- function(x) {
@ -257,12 +263,12 @@ as.rsi.default <- function(x, ...) {
return(x)
}
if (inherits(x, c("integer", "numeric", "double")) && all(x %in% c(1:3, NA))) {
x.bak <- x
x <- as.character(x) # this is needed to prevent the vctrs pkg from throwing an error
x.bak <- x
x <- as.character(x) # this is needed to prevent the vctrs pkg from throwing an error
if (inherits(x.bak, c("integer", "numeric", "double")) && all(x %in% c(1:3, NA))) {
# support haven package for importing e.g., from SPSS - it adds the 'labels' attribute
lbls <- attributes(x)$labels
lbls <- attributes(x.bak)$labels
if (!is.null(lbls) && all(c("R", "S", "I") %in% names(lbls)) && all(c(1:3) %in% lbls)) {
x[x.bak == 1] <- names(lbls[lbls == 1])
x[x.bak == 2] <- names(lbls[lbls == 2])
@ -278,9 +284,9 @@ as.rsi.default <- function(x, ...) {
if (all(x %unlike% "(R|S|I)", na.rm = TRUE)) {
# check if they are actually MICs or disks
if (all_valid_mics(x)) {
warning_("The input seems to be MIC values. Transform them with `as.mic()` before running `as.rsi()` to interpret them.")
warning_("The input seems to contain MIC values. You can transform them with `as.mic()` before running `as.rsi()` to interpret them.", call = FALSE)
} else if (all_valid_disks(x)) {
warning_("The input seems to be disk diffusion values. Transform them with `as.disk()` before running `as.rsi()` to interpret them.")
warning_("The input seems to contain disk diffusion values. You can transform them with `as.disk()` before running `as.rsi()` to interpret them.", call = FALSE)
}
}
@ -303,26 +309,17 @@ as.rsi.default <- function(x, ...) {
x[x %like% "([^a-z]|^)res(is(tant)?)?"] <- "R"
x[x %like% "([^a-z]|^)sus(cep(tible)?)?"] <- "S"
x[x %like% "([^a-z]|^)int(er(mediate)?)?|incr.*exp"] <- "I"
# remove all spaces
x <- gsub(" +", "", x)
# remove all MIC-like values: numbers, operators and periods
x <- gsub("[0-9.,;:<=>]+", "", x)
# remove everything between brackets, and 'high' and 'low'
x <- gsub("([(].*[)])", "", x)
x <- gsub("(high|low)", "", x, ignore.case = TRUE)
# remove other invalid characters
x <- gsub("[^rsiRSIHi]+", "", x, perl = TRUE)
# some labs now report "H" instead of "I" to not interfere with EUCAST prior to 2019
x <- gsub("H", "I", x, ignore.case = TRUE)
# disallow more than 3 characters
x[nchar(x) > 3] <- NA
# set to capitals
x <- toupper(x)
# remove all invalid characters
x <- gsub("[^RSI]+", "", x)
# in cases of "S;S" keep S, but in case of "S;I" make it NA
x <- gsub("^S+$", "S", x)
x <- gsub("^I+$", "I", x)
x <- gsub("^R+$", "R", x)
x[!x %in% c("S", "I", "R")] <- NA
x[!x %in% c("S", "I", "R")] <- NA_character_
na_after <- length(x[is.na(x) | x == ""])
if (!isFALSE(list(...)$warn)) { # so as.rsi(..., warn = FALSE) will never throw a warning

View File

@ -344,6 +344,7 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
}
rownames(out) <- NULL
class(out) <- c("rsi_df", class(out))
out
}

Binary file not shown.

Binary file not shown.

View File

@ -1 +1 @@
9f708801889d2eaf974c6eb85c83a8e7
f7c99b5734e4cdf37f51c55faca6ac2b

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -214,7 +214,7 @@
"GAT" 5379 "Gatifloxacin" "Quinolones" "c(\"J01MA16\", \"S01AE06\")" "Quinolone antibacterials" "Fluoroquinolones" "c(\"\", \"gati\")" "c(\"gatiflo\", \"gatifloxacin\", \"gatifloxacine\", \"gatifloxcin\", \"gatilox\", \"gatiquin\", \"gatispan\", \"tequin\", \"tequin and zymar\", \"zymaxid\")" 0.4 "g" 0.4 "g" "character(0)"
"GEM" 9571107 "Gemifloxacin" "Quinolones" "J01MA15" "Quinolone antibacterials" "Fluoroquinolones" "" "c(\"factiv\", \"factive\", \"gemifioxacin\", \"gemifloxacin\", \"gemifloxacine\", \"gemifloxacino\", \"gemifloxacinum\")" 0.32 "g" "character(0)"
"GEN" 3467 "Gentamicin" "Aminoglycosides" "c(\"D06AX07\", \"J01GB03\", \"S01AA11\", \"S02AA14\", \"S03AA06\")" "Aminoglycoside antibacterials" "Other aminoglycosides" "c(\"cn\", \"gen\", \"gent\", \"gm\")" "c(\"apogen\", \"centicin\", \"cidomycin\", \"garasol\", \"genoptic liquifilm\", \"genoptic s.o.p.\", \"gentacycol\", \"gentafair\", \"gentak\", \"gentamar\", \"gentamcin sulfate\", \"gentamicin\", \"gentamicina\", \"gentamicine\", \"gentamicins\", \"gentamicinum\", \"gentamycin\", \"gentamycins\", \"gentamycinum\", \"gentavet\", \"gentocin\", \"jenamicin\", \"lyramycin\", \"oksitselanim\", \"refobacin\", \"refobacin tm\", \"septigen\", \"uromycine\")" 0.24 "g" "c(\"13561-6\", \"13562-4\", \"15106-8\", \"22746-2\", \"22747-0\", \"31091-2\", \"31092-0\", \"31093-8\", \"35668-3\", \"3663-2\", \"3664-0\", \"3665-7\", \"39082-3\", \"47109-4\", \"59379-8\", \"80971-5\", \"88111-0\")"
"GEH" "Gentamicin-high" "Aminoglycosides" "c(\"g_h\", \"gehl\", \"genta high\", \"gentamicin high\")" "" ""
"GEH" "Gentamicin-high" "Aminoglycosides" "c(\"gehi\", \"gehl\", \"genta high\", \"gentamicin high\")" "" ""
"GEP" 25101874 "Gepotidacin" "Other antibacterials" "" "gepotidacin" "character(0)"
"GRX" 72474 "Grepafloxacin" "Quinolones" "J01MA11" "Quinolone antibacterials" "Fluoroquinolones" "c(\"\", \"grep\")" "grepafloxacin" 0.4 "g" "character(0)"
"GRI" 441140 "Griseofulvin" "Antifungals/antimycotics" "c(\"D01AA08\", \"D01BA01\")" "" "c(\"amudane\", \"curling factor\", \"delmofulvina\", \"fulcin\", \"fulcine\", \"fulvican grisactin\", \"fulvicin\", \"fulvicin bolus\", \"fulvidex\", \"fulvina\", \"fulvinil\", \"fulvistatin\", \"fungivin\", \"greosin\", \"gresfeed\", \"gricin\", \"grifulin\", \"grifulvin\", \"grifulvin v\", \"grisactin\", \"grisactin ultra\", \"grisactin v\", \"griscofulvin\", \"grise ostatin\", \"grisefuline\", \"griseo\", \"griseofulvin\", \"griseofulvin forte\", \"griseofulvina\", \"griseofulvine\", \"griseofulvinum\", \"griseomix\", \"griseostatin\", \"grisetin\", \"grisofulvin\",
@ -403,7 +403,7 @@
"SPM" "Spiramycin/metronidazole" "Other antibacterials" "J01RA04" "Combinations of antibacterials" "Combinations of antibacterials" "" "" ""
"STR" "Streptoduocin" "Aminoglycosides" "J01GA02" "Aminoglycoside antibacterials" "Streptomycins" "" "" 1 "g" ""
"STR1" 19649 "Streptomycin" "Aminoglycosides" "c(\"A07AA04\", \"J01GA01\")" "Aminoglycoside antibacterials" "Streptomycins" "c(\"s\", \"stm\", \"str\", \"stre\")" "c(\"agrept\", \"agrimycin\", \"chemform\", \"estreptomicina\", \"neodiestreptopab\", \"strepcen\", \"streptomicina\", \"streptomycin\", \"streptomycin a\", \"streptomycin spx\", \"streptomycin sulfate\", \"streptomycine\", \"streptomyzin\", \"vetstrep\")" 1 "g" "4039-4"
"STH" "Streptomycin-high" "Aminoglycosides" "c(\"s_h\", \"sthl\", \"strepto high\", \"streptomycin high\")" "" ""
"STH" "Streptomycin-high" "Aminoglycosides" "c(\"sthi\", \"sthl\", \"strepto high\", \"streptomycin high\")" "" ""
"STI" "Streptomycin/isoniazid" "Antimycobacterials" "J04AM01" "Drugs for treatment of tuberculosis" "Combinations of drugs for treatment of tuberculosis" "" "" ""
"SUL" 130313 "Sulbactam" "Beta-lactams/penicillins" "J01CG01" "Beta-lactam antibacterials, penicillins" "Beta-lactamase inhibitors" "" "c(\"betamaze\", \"sulbactam\", \"sulbactam acid\", \"sulbactam free acid\", \"sulbactamum\")" 1 "g" "character(0)"
"SBC" 20055036 "Sulbenicillin" "Beta-lactams/penicillins" "J01CA16" "Beta-lactam antibacterials, penicillins" "Penicillins with extended spectrum" "" "c(\"kedacillina\", \"sulbenicilina\", \"sulbenicilline\", \"sulbenicillinum\")" 15 "g" "character(0)"

13
data-raw/ex2.R Normal file
View File

@ -0,0 +1,13 @@
ex2 <- example_isolates
for (extra_id in seq_len(50)) {
ex2 <- ex2 %>%
bind_rows(example_isolates %>% mutate(patient_id = paste0(patient_id, extra_id)))
}
# randomly clear antibibiograms of 2%
clr <- sort(sample(x = seq_len(nrow(ex2)),
size = nrow(ex2) * 0.02))
for (row in which(is.rsi(ex2))) {
ex2[clr, row] <- NA_rsi_
}

BIN
data-raw/ex2.rds Normal file

Binary file not shown.

View File

@ -546,8 +546,8 @@ antibiotics[which(antibiotics$ab == "FEP"), "abbreviations"][[1]] <- list(c(anti
antibiotics[which(antibiotics$ab == "CTC"), "abbreviations"][[1]] <- list(c("xctl"))
antibiotics[which(antibiotics$ab == "CTX"), "abbreviations"][[1]] <- list(c(antibiotics[which(antibiotics$ab == "CTX"), "abbreviations"][[1]], "xct"))
# High level Gentamcin and Streptomycin
antibiotics[which(antibiotics$ab == "GEH"), "abbreviations"][[1]] <- list(c("gehl", "gentamicin high", "genta high"))
antibiotics[which(antibiotics$ab == "STH"), "abbreviations"][[1]] <- list(c("sthl", "streptomycin high", "strepto high"))
antibiotics[which(antibiotics$ab == "GEH"), "abbreviations"][[1]] <- list(c("gehl", "gentamicin high", "genta high", "gehi"))
antibiotics[which(antibiotics$ab == "STH"), "abbreviations"][[1]] <- list(c("sthl", "streptomycin high", "strepto high", "sthi"))
# add imi and "imipenem/cilastatine" to imipenem
antibiotics[which(antibiotics$ab == "IPM"), "abbreviations"][[1]] <- list(c("imip", "imi", "imp"))
antibiotics[which(antibiotics$ab == "IPM"), "synonyms"][[1]] <- list(sort(c(antibiotics[which(antibiotics$ab == "IPM"), "synonyms"][[1]], "imipenem/cilastatin")))

Binary file not shown.

View File

@ -1,38 +1,79 @@
<!-- Generated by pkgdown: do not edit by hand -->
<!DOCTYPE html>
<!-- Generated by pkgdown: do not edit by hand --><html lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta charset="utf-8">
<html lang="en">
<head>
<meta charset="utf-8">
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<title>Page not found (404) • AMR (for R)</title>
<!-- favicons --><link rel="icon" type="image/png" sizes="16x16" href="https://msberends.github.io/AMR/favicon-16x16.png">
<link rel="icon" type="image/png" sizes="32x32" href="https://msberends.github.io/AMR/favicon-32x32.png">
<link rel="apple-touch-icon" type="image/png" sizes="180x180" href="https://msberends.github.io/AMR/apple-touch-icon.png">
<link rel="apple-touch-icon" type="image/png" sizes="120x120" href="https://msberends.github.io/AMR/apple-touch-icon-120x120.png">
<link rel="apple-touch-icon" type="image/png" sizes="76x76" href="https://msberends.github.io/AMR/apple-touch-icon-76x76.png">
<link rel="apple-touch-icon" type="image/png" sizes="60x60" href="https://msberends.github.io/AMR/apple-touch-icon-60x60.png">
<!-- jquery --><script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.4.1/jquery.min.js" integrity="sha256-CSXorXvZcTkaix6Yvo6HppcZGetbYMGWSFlBw8HfCJo=" crossorigin="anonymous"></script><!-- Bootstrap --><link href="https://cdnjs.cloudflare.com/ajax/libs/bootswatch/3.4.0/flatly/bootstrap.min.css" rel="stylesheet" crossorigin="anonymous">
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/js/bootstrap.min.js" integrity="sha256-nuL8/2cJ5NDSSwnKD8VqreErSWHtnEP9E7AySL+1ev4=" crossorigin="anonymous"></script><!-- bootstrap-toc --><link rel="stylesheet" href="https://msberends.github.io/AMR/bootstrap-toc.css">
<script src="https://msberends.github.io/AMR/bootstrap-toc.js"></script><!-- Font Awesome icons --><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/all.min.css" integrity="sha256-mmgLkCYLUQbXn0B1SRqzHar6dCnv9oZFPEC1g1cwlkk=" crossorigin="anonymous">
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/v4-shims.min.css" integrity="sha256-wZjR52fzng1pJHwx4aV2AO3yyTOXrcDW7jBpJtTwVxw=" crossorigin="anonymous">
<!-- clipboard.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.6/clipboard.min.js" integrity="sha256-inc5kl9MA1hkeYUt+EC3BhlIgyp/2jDIyBLS6k3UxPI=" crossorigin="anonymous"></script><!-- headroom.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/headroom.min.js" integrity="sha256-AsUX4SJE1+yuDu5+mAVzJbuYNPHj/WroHuZ8Ir/CkE0=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script><!-- pkgdown --><link href="https://msberends.github.io/AMR/pkgdown.css" rel="stylesheet">
<script src="https://msberends.github.io/AMR/pkgdown.js"></script><link href="https://msberends.github.io/AMR/extra.css" rel="stylesheet">
<script src="https://msberends.github.io/AMR/extra.js"></script><meta property="og:title" content="Page not found (404)">
<meta property="og:image" content="https://msberends.github.io/AMR/logo.png">
<meta name="twitter:card" content="summary_large_image">
<meta name="twitter:creator" content="@msberends">
<meta name="twitter:site" content="@univgroningen">
<!-- mathjax --><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script><!--[if lt IE 9]>
<!-- favicons -->
<link rel="icon" type="image/png" sizes="16x16" href="https://msberends.github.io/AMR//favicon-16x16.png">
<link rel="icon" type="image/png" sizes="32x32" href="https://msberends.github.io/AMR//favicon-32x32.png">
<link rel="apple-touch-icon" type="image/png" sizes="180x180" href="https://msberends.github.io/AMR//apple-touch-icon.png" />
<link rel="apple-touch-icon" type="image/png" sizes="120x120" href="https://msberends.github.io/AMR//apple-touch-icon-120x120.png" />
<link rel="apple-touch-icon" type="image/png" sizes="76x76" href="https://msberends.github.io/AMR//apple-touch-icon-76x76.png" />
<link rel="apple-touch-icon" type="image/png" sizes="60x60" href="https://msberends.github.io/AMR//apple-touch-icon-60x60.png" />
<!-- jquery -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.4.1/jquery.min.js" integrity="sha256-CSXorXvZcTkaix6Yvo6HppcZGetbYMGWSFlBw8HfCJo=" crossorigin="anonymous"></script>
<!-- Bootstrap -->
<link href="https://cdnjs.cloudflare.com/ajax/libs/bootswatch/3.4.0/flatly/bootstrap.min.css" rel="stylesheet" crossorigin="anonymous" />
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.4.1/js/bootstrap.min.js" integrity="sha256-nuL8/2cJ5NDSSwnKD8VqreErSWHtnEP9E7AySL+1ev4=" crossorigin="anonymous"></script>
<!-- bootstrap-toc -->
<link rel="stylesheet" href="https://msberends.github.io/AMR//bootstrap-toc.css">
<script src="https://msberends.github.io/AMR//bootstrap-toc.js"></script>
<!-- Font Awesome icons -->
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/all.min.css" integrity="sha256-mmgLkCYLUQbXn0B1SRqzHar6dCnv9oZFPEC1g1cwlkk=" crossorigin="anonymous" />
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/v4-shims.min.css" integrity="sha256-wZjR52fzng1pJHwx4aV2AO3yyTOXrcDW7jBpJtTwVxw=" crossorigin="anonymous" />
<!-- clipboard.js -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.6/clipboard.min.js" integrity="sha256-inc5kl9MA1hkeYUt+EC3BhlIgyp/2jDIyBLS6k3UxPI=" crossorigin="anonymous"></script>
<!-- headroom.js -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/headroom.min.js" integrity="sha256-AsUX4SJE1+yuDu5+mAVzJbuYNPHj/WroHuZ8Ir/CkE0=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script>
<!-- pkgdown -->
<link href="https://msberends.github.io/AMR//pkgdown.css" rel="stylesheet">
<script src="https://msberends.github.io/AMR//pkgdown.js"></script>
<link href="https://msberends.github.io/AMR//extra.css" rel="stylesheet">
<script src="https://msberends.github.io/AMR//extra.js"></script>
<meta property="og:title" content="Page not found (404)" />
<meta property="og:image" content="https://msberends.github.io/AMR/logo.png" />
<meta name="twitter:card" content="summary_large_image" />
<meta name="twitter:creator" content="@msberends" />
<meta name="twitter:site" content="@univgroningen" />
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
<!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]-->
</head>
<body data-spy="scroll" data-target="#toc">
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-title-body">
<header><div class="navbar navbar-default navbar-fixed-top" role="navigation">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
<div class="container">
<div class="navbar-header">
<button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#navbar" aria-expanded="false">
@ -42,22 +83,22 @@
<span class="icon-bar"></span>
</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.7.1.9051</span>
<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.7.1.9054</span>
</span>
</div>
<div id="navbar" class="navbar-collapse collapse">
<ul class="nav navbar-nav">
<li>
<a href="https://msberends.github.io/AMR/index.html">
<li>
<a href="index.html">
<span class="fa fa-home"></span>
Home
</a>
</li>
<li class="dropdown">
<a href="https://msberends.github.io/AMR/#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-expanded="false">
<a href="#" class="dropdown-toggle" data-toggle="dropdown" role="button" aria-expanded="false">
<span class="fa fa-question-circle"></span>
How to
@ -65,78 +106,78 @@
<span class="caret"></span>
</a>
<ul class="dropdown-menu" role="menu">
<li>
<a href="https://msberends.github.io/AMR/articles/AMR.html">
<li>
<a href="articles/AMR.html">
<span class="fa fa-directions"></span>
Conduct AMR analysis
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/resistance_predict.html">
<a href="articles/resistance_predict.html">
<span class="fa fa-dice"></span>
Predict antimicrobial resistance
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/datasets.html">
<a href="articles/datasets.html">
<span class="fa fa-database"></span>
Data sets for download / own use
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/PCA.html">
<a href="articles/PCA.html">
<span class="fa fa-compress"></span>
Conduct principal component analysis for AMR
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/MDR.html">
<a href="articles/MDR.html">
<span class="fa fa-skull-crossbones"></span>
Determine multi-drug resistance (MDR)
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/WHONET.html">
<a href="articles/WHONET.html">
<span class="fa fa-globe-americas"></span>
Work with WHONET data
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/SPSS.html">
<a href="articles/SPSS.html">
<span class="fa fa-file-upload"></span>
Import data from SPSS/SAS/Stata
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/EUCAST.html">
<a href="articles/EUCAST.html">
<span class="fa fa-exchange-alt"></span>
Apply EUCAST rules
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/reference/mo_property.html">
<a href="reference/mo_property.html">
<span class="fa fa-bug"></span>
Get properties of a microorganism
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/reference/ab_property.html">
<a href="reference/ab_property.html">
<span class="fa fa-capsules"></span>
Get properties of an antibiotic
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/articles/benchmarks.html">
<a href="articles/benchmarks.html">
<span class="fa fa-shipping-fast"></span>
Other: benchmarks
@ -145,29 +186,29 @@
</ul>
</li>
<li>
<a href="https://msberends.github.io/AMR/reference/index.html">
<a href="reference/index.html">
<span class="fa fa-book-open"></span>
Manual
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/authors.html">
<a href="authors.html">
<span class="fa fa-users"></span>
Authors
</a>
</li>
<li>
<a href="https://msberends.github.io/AMR/news/index.html">
<a href="news/index.html">
<span class="far fa-newspaper"></span>
Changelog
</a>
</li>
</ul>
<ul class="nav navbar-nav navbar-right">
<li>
<ul class="nav navbar-nav navbar-right">
<li>
<a href="https://github.com/msberends/AMR">
<span class="fab fa-github"></span>
@ -175,16 +216,16 @@
</a>
</li>
</ul>
</div>
<!--/.nav-collapse -->
</div>
<!--/.container -->
</div>
<!--/.navbar -->
</div><!--/.nav-collapse -->
</div><!--/.container -->
</div><!--/.navbar -->
</header><div class="row">
</header>
<div class="row">
<div class="contents col-md-9">
<div class="page-header">
<h1>Page not found (404)</h1>
@ -195,31 +236,31 @@ Content not found. Please use links in the navbar.
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="pkgdown-sidebar">
<nav id="toc" data-toggle="toc" class="sticky-top"><h2 data-toc-skip>Contents</h2>
<nav id="toc" data-toggle="toc" class="sticky-top">
<h2 data-toc-skip>Contents</h2>
</nav>
</div>
</div>
</div>
<footer><div class="copyright">
<p></p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p>
<footer>
<div class="copyright">
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
</div>
</div>
</body>
</html>

View File

@ -57,8 +57,6 @@
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@ -70,15 +68,9 @@
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-title-body">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
@ -92,7 +84,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.7.1.9051</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -503,11 +495,11 @@ END OF TERMS AND CONDITIONS
<footer>
<div class="copyright">
<p><p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p></p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -516,8 +508,6 @@ END OF TERMS AND CONDITIONS
</body>
</html>

View File

@ -30,8 +30,6 @@
<![endif]-->
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-article">
<header><div class="navbar navbar-default navbar-fixed-top" role="navigation">
<div class="container">
@ -44,7 +42,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.7.1.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -169,7 +167,7 @@
</ul>
<ul class="nav navbar-nav navbar-right">
<li>
<a href="https://github.com/msberends/AMR" class="external-link">
<a href="https://github.com/msberends/AMR">
<span class="fab fa-github"></span>
Source Code
@ -185,15 +183,15 @@
</header><script src="SPSS_files/header-attrs-2.9/header-attrs.js"></script><div class="row">
</header><script src="SPSS_files/header-attrs-2.11/header-attrs.js"></script><div class="row">
<div class="col-md-9 contents">
<div class="page-header toc-ignore">
<h1 data-toc-skip>How to import data from SPSS / SAS / Stata</h1>
<h4 data-toc-skip class="author">Matthijs S. Berends</h4>
<h4 class="author">Matthijs S. Berends</h4>
<h4 data-toc-skip class="date">29 August 2021</h4>
<h4 class="date">28 November 2021</h4>
<small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/main/vignettes/SPSS.Rmd" class="external-link"><code>vignettes/SPSS.Rmd</code></a></small>
<small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/master/vignettes/SPSS.Rmd"><code>vignettes/SPSS.Rmd</code></a></small>
<div class="hidden name"><code>SPSS.Rmd</code></div>
</div>
@ -202,17 +200,17 @@
<div id="spss-sas-stata" class="section level2">
<h2 class="hasAnchor">
<a href="#spss-sas-stata" class="anchor" aria-hidden="true"></a>SPSS / SAS / Stata</h2>
<a href="#spss-sas-stata" class="anchor"></a>SPSS / SAS / Stata</h2>
<p>SPSS (Statistical Package for the Social Sciences) is probably the most well-known software package for statistical analysis. SPSS is easier to learn than R, because in SPSS you only have to click a menu to run parts of your analysis. Because of its user-friendliness, it is taught at universities and particularly useful for students who are new to statistics. From my experience, I would guess that pretty much all (bio)medical students know it at the time they graduate. SAS and Stata are comparable statistical packages popular in big industries.</p>
</div>
<div id="compared-to-r" class="section level2">
<h2 class="hasAnchor">
<a href="#compared-to-r" class="anchor" aria-hidden="true"></a>Compared to R</h2>
<a href="#compared-to-r" class="anchor"></a>Compared to R</h2>
<p>As said, SPSS is easier to learn than R. But SPSS, SAS and Stata come with major downsides when comparing it with R:</p>
<ul>
<li>
<p><strong>R is highly modular.</strong></p>
<p>The <a href="https://cran.r-project.org/" class="external-link">official R network (CRAN)</a> features more than 16,000 packages at the time of writing, our <code>AMR</code> package being one of them. All these packages were peer-reviewed before publication. Aside from this official channel, there are also developers who choose not to submit to CRAN, but rather keep it on their own public repository, like GitHub. So there may even be a lot more than 14,000 packages out there.</p>
<p>The <a href="https://cran.r-project.org/">official R network (CRAN)</a> features more than 16,000 packages at the time of writing, our <code>AMR</code> package being one of them. All these packages were peer-reviewed before publication. Aside from this official channel, there are also developers who choose not to submit to CRAN, but rather keep it on their own public repository, like GitHub. So there may even be a lot more than 14,000 packages out there.</p>
<p>Bottom line is, you can really extend it yourself or ask somebody to do this for you. Take for example our <code>AMR</code> package. Among other things, it adds reliable reference data to R to help you with the data cleaning and analysis. SPSS, SAS and Stata will never know what a valid MIC value is or what the Gram stain of <em>E. coli</em> is. Or that all species of <em>Klebiella</em> are resistant to amoxicillin and that Floxapen<sup>®</sup> is a trade name of flucloxacillin. These facts and properties are often needed to clean existing data, which would be very inconvenient in a software package without reliable reference data. See below for a demonstration.</p>
</li>
<li>
@ -221,27 +219,27 @@
</li>
<li>
<p><strong>R can be easily automated.</strong></p>
<p>Over the last years, <a href="https://rmarkdown.rstudio.com/" class="external-link">R Markdown</a> has really made an interesting development. With R Markdown, you can very easily produce reports, whether the format has to be Word, PowerPoint, a website, a PDF document or just the raw data to Excel. It even allows the use of a reference file containing the layout style (e.g. fonts and colours) of your organisation. I use this a lot to generate weekly and monthly reports automatically. Just write the code once and enjoy the automatically updated reports at any interval you like.</p>
<p>For an even more professional environment, you could create <a href="https://shiny.rstudio.com/" class="external-link">Shiny apps</a>: live manipulation of data using a custom made website. The webdesign knowledge needed (JavaScript, CSS, HTML) is almost <em>zero</em>.</p>
<p>Over the last years, <a href="https://rmarkdown.rstudio.com/">R Markdown</a> has really made an interesting development. With R Markdown, you can very easily produce reports, whether the format has to be Word, PowerPoint, a website, a PDF document or just the raw data to Excel. It even allows the use of a reference file containing the layout style (e.g. fonts and colours) of your organisation. I use this a lot to generate weekly and monthly reports automatically. Just write the code once and enjoy the automatically updated reports at any interval you like.</p>
<p>For an even more professional environment, you could create <a href="https://shiny.rstudio.com/">Shiny apps</a>: live manipulation of data using a custom made website. The webdesign knowledge needed (JavaScript, CSS, HTML) is almost <em>zero</em>.</p>
</li>
<li>
<p><strong>R has a huge community.</strong></p>
<p>Many R users just ask questions on websites like <a href="https://stackoverflow.com" class="external-link">StackOverflow.com</a>, the largest online community for programmers. At the time of writing, <a href="https://stackoverflow.com/questions/tagged/r?sort=votes" class="external-link">415,751 R-related questions</a> have already been asked on this platform (that covers questions and answers for any programming language). In my own experience, most questions are answered within a couple of minutes.</p>
<p>Many R users just ask questions on websites like <a href="https://stackoverflow.com">StackOverflow.com</a>, the largest online community for programmers. At the time of writing, <a href="https://stackoverflow.com/questions/tagged/r?sort=votes">427,872 R-related questions</a> have already been asked on this platform (that covers questions and answers for any programming language). In my own experience, most questions are answered within a couple of minutes.</p>
</li>
<li>
<p><strong>R understands any data type, including SPSS/SAS/Stata.</strong></p>
<p>And thats not vice versa Im afraid. You can import data from any source into R. For example from SPSS, SAS and Stata (<a href="https://haven.tidyverse.org/" class="external-link">link</a>), from Minitab, Epi Info and EpiData (<a href="https://cran.r-project.org/package=foreign" class="external-link">link</a>), from Excel (<a href="https://readxl.tidyverse.org/" class="external-link">link</a>), from flat files like CSV, TXT or TSV (<a href="https://readr.tidyverse.org/" class="external-link">link</a>), or directly from databases and datawarehouses from anywhere on the world (<a href="https://dbplyr.tidyverse.org/" class="external-link">link</a>). You can even scrape websites to download tables that are live on the internet (<a href="https://github.com/hadley/rvest" class="external-link">link</a>) or get the results of an API call and transform it into data in only one command (<a href="https://github.com/Rdatatable/data.table/wiki/Convenience-features-of-fread" class="external-link">link</a>).</p>
<p>And thats not vice versa Im afraid. You can import data from any source into R. For example from SPSS, SAS and Stata (<a href="https://haven.tidyverse.org/">link</a>), from Minitab, Epi Info and EpiData (<a href="https://cran.r-project.org/package=foreign">link</a>), from Excel (<a href="https://readxl.tidyverse.org/">link</a>), from flat files like CSV, TXT or TSV (<a href="https://readr.tidyverse.org/">link</a>), or directly from databases and datawarehouses from anywhere on the world (<a href="https://dbplyr.tidyverse.org/">link</a>). You can even scrape websites to download tables that are live on the internet (<a href="https://github.com/hadley/rvest">link</a>) or get the results of an API call and transform it into data in only one command (<a href="https://github.com/Rdatatable/data.table/wiki/Convenience-features-of-fread">link</a>).</p>
<p>And the best part - you can export from R to most data formats as well. So you can import an SPSS file, do your analysis neatly in R and export the resulting tables to Excel files for sharing.</p>
</li>
<li>
<p><strong>R is completely free and open-source.</strong></p>
<p>No strings attached. It was created and is being maintained by volunteers who believe that (data) science should be open and publicly available to everybody. SPSS, SAS and Stata are quite expensive. IBM SPSS Staticstics only comes with subscriptions nowadays, varying <a href="https://www.ibm.com/products/spss-statistics/pricing" class="external-link">between USD 1,300 and USD 8,500</a> per user <em>per year</em>. SAS Analytics Pro costs <a href="https://www.sas.com/store/products-solutions/sas-analytics-pro/prodPERSANL.html" class="external-link">around USD 10,000</a> per computer. Stata also has a business model with subscription fees, varying <a href="https://www.stata.com/order/new/bus/single-user-licenses/dl/" class="external-link">between USD 600 and USD 2,800</a> per computer per year, but lower prices come with a limitation of the number of variables you can work with. And still they do not offer the above benefits of R.</p>
<p>No strings attached. It was created and is being maintained by volunteers who believe that (data) science should be open and publicly available to everybody. SPSS, SAS and Stata are quite expensive. IBM SPSS Staticstics only comes with subscriptions nowadays, varying <a href="https://www.ibm.com/products/spss-statistics/pricing">between USD 1,300 and USD 8,500</a> per user <em>per year</em>. SAS Analytics Pro costs <a href="https://www.sas.com/store/products-solutions/sas-analytics-pro/prodPERSANL.html">around USD 10,000</a> per computer. Stata also has a business model with subscription fees, varying <a href="https://www.stata.com/order/new/bus/single-user-licenses/dl/">between USD 600 and USD 2,800</a> per computer per year, but lower prices come with a limitation of the number of variables you can work with. And still they do not offer the above benefits of R.</p>
<p>If you are working at a midsized or small company, you can save it tens of thousands of dollars by using R instead of e.g. SPSS - gaining even more functions and flexibility. And all R enthousiasts can do as much PR as they want (like I do here), because nobody is officially associated with or affiliated by R. It is really free.</p>
</li>
<li>
<p><strong>R is (nowadays) the preferred analysis software in academic papers.</strong></p>
<p>At present, R is among the world most powerful statistical languages, and it is generally very popular in science (Bollmann <em>et al.</em>, 2017). For all the above reasons, the number of references to R as an analysis method in academic papers <a href="https://r4stats.com/2014/08/20/r-passes-spss-in-scholarly-use-stata-growing-rapidly/" class="external-link">is rising continuously</a> and has even surpassed SPSS for academic use (Muenchen, 2014).</p>
<p>I believe that the thing with SPSS is, that it has always had a great user interface which is very easy to learn and use. Back when they developed it, they had very little competition, let alone from R. R didnt even had a professional user interface until the last decade (called RStudio, see below). How people used R between the nineties and 2010 is almost completely incomparable to how R is being used now. The language itself <a href="https://www.tidyverse.org/packages/" class="external-link">has been restyled completely</a> by volunteers who are dedicated professionals in the field of data science. SPSS was great when there was nothing else that could compete. But now in 2021, I dont see any reason why SPSS would be of any better use than R.</p>
<p>At present, R is among the world most powerful statistical languages, and it is generally very popular in science (Bollmann <em>et al.</em>, 2017). For all the above reasons, the number of references to R as an analysis method in academic papers <a href="https://r4stats.com/2014/08/20/r-passes-spss-in-scholarly-use-stata-growing-rapidly/">is rising continuously</a> and has even surpassed SPSS for academic use (Muenchen, 2014).</p>
<p>I believe that the thing with SPSS is, that it has always had a great user interface which is very easy to learn and use. Back when they developed it, they had very little competition, let alone from R. R didnt even had a professional user interface until the last decade (called RStudio, see below). How people used R between the nineties and 2010 is almost completely incomparable to how R is being used now. The language itself <a href="https://www.tidyverse.org/packages/">has been restyled completely</a> by volunteers who are dedicated professionals in the field of data science. SPSS was great when there was nothing else that could compete. But now in 2021, I dont see any reason why SPSS would be of any better use than R.</p>
</li>
</ul>
<p>To demonstrate the first point:</p>
@ -253,13 +251,11 @@
<span class="fu"><a href="../reference/as.mic.html">as.mic</a></span><span class="op">(</span><span class="st">"testvalue"</span><span class="op">)</span>
<span class="co"># Class &lt;mic&gt;</span>
<span class="co"># [1] &lt;NA&gt;</span>
<span class="co"># the Gram stain is available for all bacteria:</span>
<span class="fu"><a href="../reference/mo_property.html">mo_gramstain</a></span><span class="op">(</span><span class="st">"E. coli"</span><span class="op">)</span>
<span class="co"># [1] "Gram-negative"</span>
<span class="co"># Klebsiella is intrinsic resistant to amoxicillin, according to EUCAST:</span>
<span class="va">klebsiella_test</span> <span class="op">&lt;-</span> <span class="fu"><a href="https://rdrr.io/r/base/data.frame.html" class="external-link">data.frame</a></span><span class="op">(</span>mo <span class="op">=</span> <span class="st">"klebsiella"</span>,
<span class="va">klebsiella_test</span> <span class="op">&lt;-</span> <span class="fu"><a href="https://rdrr.io/r/base/data.frame.html">data.frame</a></span><span class="op">(</span>mo <span class="op">=</span> <span class="st">"klebsiella"</span>,
amox <span class="op">=</span> <span class="st">"S"</span>,
stringsAsFactors <span class="op">=</span> <span class="cn">FALSE</span><span class="op">)</span>
<span class="va">klebsiella_test</span> <span class="co"># (our original data)</span>
@ -267,8 +263,7 @@
<span class="co"># 1 klebsiella S</span>
<span class="fu"><a href="../reference/eucast_rules.html">eucast_rules</a></span><span class="op">(</span><span class="va">klebsiella_test</span>, info <span class="op">=</span> <span class="cn">FALSE</span><span class="op">)</span> <span class="co"># (the edited data by EUCAST rules)</span>
<span class="co"># mo amox</span>
<span class="co"># 1 klebsiella R</span>
<span class="co"># 1 klebsiella S</span>
<span class="co"># hundreds of trade names can be translated to a name, trade name or an ATC code:</span>
<span class="fu"><a href="../reference/ab_property.html">ab_name</a></span><span class="op">(</span><span class="st">"floxapen"</span><span class="op">)</span>
<span class="co"># [1] "Flucloxacillin"</span>
@ -281,17 +276,17 @@
</div>
<div id="import-data-from-spsssasstata" class="section level2">
<h2 class="hasAnchor">
<a href="#import-data-from-spsssasstata" class="anchor" aria-hidden="true"></a>Import data from SPSS/SAS/Stata</h2>
<a href="#import-data-from-spsssasstata" class="anchor"></a>Import data from SPSS/SAS/Stata</h2>
<div id="rstudio" class="section level3">
<h3 class="hasAnchor">
<a href="#rstudio" class="anchor" aria-hidden="true"></a>RStudio</h3>
<p>To work with R, probably the best option is to use <a href="https://www.rstudio.com/products/rstudio/" class="external-link">RStudio</a>. It is an open-source and free desktop environment which not only allows you to run R code, but also supports project management, version management, package management and convenient import menus to work with other data sources. You can also install <a href="https://www.rstudio.com/products/rstudio/" class="external-link">RStudio Server</a> on a private or corporate server, which brings nothing less than the complete RStudio software to you as a website (at home or at work).</p>
<a href="#rstudio" class="anchor"></a>RStudio</h3>
<p>To work with R, probably the best option is to use <a href="https://www.rstudio.com/products/rstudio/">RStudio</a>. It is an open-source and free desktop environment which not only allows you to run R code, but also supports project management, version management, package management and convenient import menus to work with other data sources. You can also install <a href="https://www.rstudio.com/products/rstudio/">RStudio Server</a> on a private or corporate server, which brings nothing less than the complete RStudio software to you as a website (at home or at work).</p>
<p>To import a data file, just click <em>Import Dataset</em> in the Environment tab:</p>
<p><img src="https://github.com/msberends/AMR/raw/main/docs/import1.png"></p>
<p>If additional packages are needed, RStudio will ask you if they should be installed on beforehand.</p>
<p>In the the window that opens, you can define all options (parameters) that should be used for import and youre ready to go:</p>
<p><img src="https://github.com/msberends/AMR/raw/main/docs/import2.png"></p>
<p>If you want named variables to be imported as factors so it resembles SPSS more, use <code><a href="https://haven.tidyverse.org/reference/as_factor.html" class="external-link">as_factor()</a></code>.</p>
<p>If you want named variables to be imported as factors so it resembles SPSS more, use <code><a href="https://haven.tidyverse.org/reference/as_factor.html">as_factor()</a></code>.</p>
<p>The difference is this:</p>
<div class="sourceCode" id="cb2"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="va">SPSS_data</span>
@ -328,70 +323,70 @@
</div>
<div id="base-r" class="section level3">
<h3 class="hasAnchor">
<a href="#base-r" class="anchor" aria-hidden="true"></a>Base R</h3>
<p>To import data from SPSS, SAS or Stata, you can use the <a href="https://haven.tidyverse.org/" class="external-link">great <code>haven</code> package</a> yourself:</p>
<a href="#base-r" class="anchor"></a>Base R</h3>
<p>To import data from SPSS, SAS or Stata, you can use the <a href="https://haven.tidyverse.org/">great <code>haven</code> package</a> yourself:</p>
<div class="sourceCode" id="cb3"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># download and install the latest version:</span>
<span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html" class="external-link">install.packages</a></span><span class="op">(</span><span class="st">"haven"</span><span class="op">)</span>
<span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html">install.packages</a></span><span class="op">(</span><span class="st">"haven"</span><span class="op">)</span>
<span class="co"># load the package you just installed:</span>
<span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://haven.tidyverse.org" class="external-link">haven</a></span><span class="op">)</span> </code></pre></div>
<span class="kw"><a href="https://rdrr.io/r/base/library.html">library</a></span><span class="op">(</span><span class="va"><a href="https://haven.tidyverse.org">haven</a></span><span class="op">)</span> </code></pre></div>
<p>You can now import files as follows:</p>
<div id="spss" class="section level4">
<h4 class="hasAnchor">
<a href="#spss" class="anchor" aria-hidden="true"></a>SPSS</h4>
<a href="#spss" class="anchor"></a>SPSS</h4>
<p>To read files from SPSS into R:</p>
<div class="sourceCode" id="cb4"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># read any SPSS file based on file extension (best way):</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html" class="external-link">read_spss</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html">read_spss</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="co"># read .sav or .zsav file:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html" class="external-link">read_sav</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html">read_sav</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="co"># read .por file:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html" class="external-link">read_por</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span></code></pre></div>
<p>Do not forget about <code><a href="https://haven.tidyverse.org/reference/as_factor.html" class="external-link">as_factor()</a></code>, as mentioned above.</p>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html">read_por</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span></code></pre></div>
<p>Do not forget about <code><a href="https://haven.tidyverse.org/reference/as_factor.html">as_factor()</a></code>, as mentioned above.</p>
<p>To export your R objects to the SPSS file format:</p>
<div class="sourceCode" id="cb5"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># save as .sav file:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html" class="external-link">write_sav</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html">write_sav</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="co"># save as compressed .zsav file:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html" class="external-link">write_sav</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span>, compress <span class="op">=</span> <span class="cn">TRUE</span><span class="op">)</span></code></pre></div>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_spss.html">write_sav</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span>, compress <span class="op">=</span> <span class="cn">TRUE</span><span class="op">)</span></code></pre></div>
</div>
<div id="sas" class="section level4">
<h4 class="hasAnchor">
<a href="#sas" class="anchor" aria-hidden="true"></a>SAS</h4>
<a href="#sas" class="anchor"></a>SAS</h4>
<p>To read files from SAS into R:</p>
<div class="sourceCode" id="cb6"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># read .sas7bdat + .sas7bcat files:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_sas.html" class="external-link">read_sas</a></span><span class="op">(</span>data_file <span class="op">=</span> <span class="st">"path/to/file"</span>, catalog_file <span class="op">=</span> <span class="cn">NULL</span><span class="op">)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_sas.html">read_sas</a></span><span class="op">(</span>data_file <span class="op">=</span> <span class="st">"path/to/file"</span>, catalog_file <span class="op">=</span> <span class="cn">NULL</span><span class="op">)</span>
<span class="co"># read SAS transport files (version 5 and version 8):</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_xpt.html" class="external-link">read_xpt</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span></code></pre></div>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_xpt.html">read_xpt</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span></code></pre></div>
<p>To export your R objects to the SAS file format:</p>
<div class="sourceCode" id="cb7"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># save as regular SAS file:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_sas.html" class="external-link">write_sas</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_sas.html">write_sas</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span><span class="op">)</span>
<span class="co"># the SAS transport format is an open format </span>
<span class="co"># (required for submission of the data to the FDA)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_xpt.html" class="external-link">write_xpt</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span>, version <span class="op">=</span> <span class="fl">8</span><span class="op">)</span></code></pre></div>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_xpt.html">write_xpt</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"path/to/file"</span>, version <span class="op">=</span> <span class="fl">8</span><span class="op">)</span></code></pre></div>
</div>
<div id="stata" class="section level4">
<h4 class="hasAnchor">
<a href="#stata" class="anchor" aria-hidden="true"></a>Stata</h4>
<a href="#stata" class="anchor"></a>Stata</h4>
<p>To read files from Stata into R:</p>
<div class="sourceCode" id="cb8"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># read .dta file:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_dta.html" class="external-link">read_stata</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"/path/to/file"</span><span class="op">)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_dta.html">read_stata</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"/path/to/file"</span><span class="op">)</span>
<span class="co"># works exactly the same:</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_dta.html" class="external-link">read_dta</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"/path/to/file"</span><span class="op">)</span></code></pre></div>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_dta.html">read_dta</a></span><span class="op">(</span>file <span class="op">=</span> <span class="st">"/path/to/file"</span><span class="op">)</span></code></pre></div>
<p>To export your R objects to the Stata file format:</p>
<div class="sourceCode" id="cb9"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># save as .dta file, Stata version 14:</span>
<span class="co"># (supports Stata v8 until v15 at the time of writing)</span>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_dta.html" class="external-link">write_dta</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"/path/to/file"</span>, version <span class="op">=</span> <span class="fl">14</span><span class="op">)</span></code></pre></div>
<span class="fu"><a href="https://haven.tidyverse.org/reference/read_dta.html">write_dta</a></span><span class="op">(</span>data <span class="op">=</span> <span class="va">yourdata</span>, path <span class="op">=</span> <span class="st">"/path/to/file"</span>, version <span class="op">=</span> <span class="fl">14</span><span class="op">)</span></code></pre></div>
</div>
</div>
</div>
@ -408,13 +403,11 @@
<footer><div class="copyright">
<p></p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link external-link">Matthijs S. Berends</a>, <a href="https://www.rug.nl/staff/c.f.luz/" class="external-link external-link">Christian F. Luz</a>, <a href="https://www.rug.nl/staff/a.w.friedrich/" class="external-link external-link">Alexander W. Friedrich</a>, <a href="https://www.rug.nl/staff/b.sinha/" class="external-link external-link">Bhanu N. M. Sinha</a>, <a href="https://www.rug.nl/staff/c.j.albers/" class="external-link external-link">Casper J. Albers</a>, <a href="https://www.rug.nl/staff/c.glasner/" class="external-link external-link">Corinna Glasner</a>.</p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/">Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link external-link">pkgdown</a> 1.6.1.9001.</p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -423,7 +416,5 @@
</body>
</html>

View File

@ -0,0 +1,12 @@
// Pandoc 2.9 adds attributes on both header and div. We remove the former (to
// be compatible with the behavior of Pandoc < 2.8).
document.addEventListener('DOMContentLoaded', function(e) {
var hs = document.querySelectorAll("div.section[class*='level'] > :first-child");
var i, h, a;
for (i = 0; i < hs.length; i++) {
h = hs[i];
if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6
a = h.attributes;
while (a.length > 0) h.removeAttribute(a[0].name);
}
});

View File

@ -42,7 +42,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.7.1.9053</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -188,7 +188,7 @@
<div class="page-header toc-ignore">
<h1 data-toc-skip>Data sets for download / own use</h1>
<h4 class="date">01 November 2021</h4>
<h4 class="date">28 November 2021</h4>
<small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/master/vignettes/datasets.Rmd"><code>vignettes/datasets.Rmd</code></a></small>
<div class="hidden name"><code>datasets.Rmd</code></div>
@ -493,7 +493,7 @@ If you are reading this page from within R, please <a href="https://msberends.gi
<a href="#antibiotic-agents" class="anchor"></a>Antibiotic agents</h2>
<p>A data set with 456 rows and 14 columns, containing the following column names:<br><em>ab</em>, <em>cid</em>, <em>name</em>, <em>group</em>, <em>atc</em>, <em>atc_group1</em>, <em>atc_group2</em>, <em>abbreviations</em>, <em>synonyms</em>, <em>oral_ddd</em>, <em>oral_units</em>, <em>iv_ddd</em>, <em>iv_units</em> and <em>loinc</em>.</p>
<p>This data set is in R available as <code>antibiotics</code>, after you load the <code>AMR</code> package.</p>
<p>It was last updated on 2 September 2021 11:50:06 UTC. Find more info about the structure of this data set <a href="https://msberends.github.io/AMR/reference/antibiotics.html">here</a>.</p>
<p>It was last updated on 28 November 2021 15:08:22 UTC. Find more info about the structure of this data set <a href="https://msberends.github.io/AMR/reference/antibiotics.html">here</a>.</p>
<p><strong>Direct download links:</strong></p>
<ul>
<li>Download as <a href="https://github.com/msberends/AMR/raw/main/data-raw/../data-raw/antibiotics.rds">R file</a> (32 kB)<br>
@ -1253,7 +1253,7 @@ If you are reading this page from within R, please <a href="https://msberends.gi
<footer><div class="copyright">
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/">Matthijs S. Berends</a>, Dennis Souverein, Erwin E. A. Hassing, Christian F. Luz.</p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/">Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">

View File

@ -57,8 +57,6 @@
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@ -70,15 +68,9 @@
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-article-index">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
@ -92,7 +84,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.7.1.9051</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -272,11 +264,11 @@
<footer>
<div class="copyright">
<p><p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p></p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -285,8 +277,6 @@
</body>
</html>

View File

@ -30,8 +30,6 @@
<![endif]-->
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-article">
<header><div class="navbar navbar-default navbar-fixed-top" role="navigation">
<div class="container">
@ -44,7 +42,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.7.1.9048</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -169,7 +167,7 @@
</ul>
<ul class="nav navbar-nav navbar-right">
<li>
<a href="https://github.com/msberends/AMR" class="external-link">
<a href="https://github.com/msberends/AMR">
<span class="fab fa-github"></span>
Source Code
@ -191,17 +189,17 @@
<h1 data-toc-skip>Welcome to the <code>AMR</code> package</h1>
<small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/main/vignettes/welcome_to_AMR.Rmd" class="external-link"><code>vignettes/welcome_to_AMR.Rmd</code></a></small>
<small class="dont-index">Source: <a href="https://github.com/msberends/AMR/blob/master/vignettes/welcome_to_AMR.Rmd"><code>vignettes/welcome_to_AMR.Rmd</code></a></small>
<div class="hidden name"><code>welcome_to_AMR.Rmd</code></div>
</div>
<p>Note: to keep the package as small as possible, we only included this vignette. You can read more vignettes on our website about how to conduct AMR data analysis, determine MDROs, find explanation of EUCAST rules, and much more: <a href="https://msberends.github.io/AMR/articles/" class="uri">https://msberends.github.io/AMR/articles/</a>.</p>
<p>Note: to keep the package size as small as possible, we only included this vignette on CRAN. You can read more vignettes on our website about how to conduct AMR data analysis, determine MDROs, find explanation of EUCAST rules, and much more: <a href="https://msberends.github.io/AMR/articles/" class="uri">https://msberends.github.io/AMR/articles/</a>.</p>
<hr>
<p><code>AMR</code> is a free, open-source and independent R package to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. <strong>Our aim is to provide a standard</strong> for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.</p>
<p>After installing this package, R knows ~70,000 distinct microbial species and all ~560 antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.</p>
<p><code>AMR</code> is a free, open-source and independent R package (see <a href="https://msberends.github.io/AMR/#copyright">Copyright</a>) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. <strong>Our aim is to provide a standard</strong> for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.</p>
<p>After installing this package, R knows ~71,000 distinct microbial species and all ~560 antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data. Antimicrobial names and group names are available in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish.</p>
<p>This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). <strong>It was designed to work in any setting, including those with very limited resources</strong>. Since its first public release in early 2018, this package has been downloaded from more than 160 countries.</p>
<p>This package can be used for:</p>
<ul>
@ -223,7 +221,7 @@
<li>Principal component analysis for AMR</li>
</ul>
<p>All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this <code>AMR</code> package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find <a href="https://msberends.github.io/AMR/articles/datasets.html">all download links on our website</a>, which is automatically updated with every code change.</p>
<p>The package was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the University of Groningen, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice and University Medical Center Groningen. This R package is actively maintained (see <a href="https://msberends.github.io/AMR/news/index.html">Changelog</a>) and is free software (see <a href="https://msberends.github.io/AMR/#copyright">Copyright</a>).</p>
<p>This R package was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the <a href="https://www.rug.nl">University of Groningen</a>, in collaboration with non-profit organisations <a href="https://www.certe.nl">Certe Medical Diagnostics and Advice Foundation</a> and <a href="https://www.umcg.nl">University Medical Center Groningen</a>. This R package formed the basis of two PhD theses (<a href="https://doi.org/10.33612/diss.177417131">DOI 10.33612/diss.177417131</a> and <a href="https://doi.org/10.33612/diss.192486375">DOI 10.33612/diss.177417131</a>) but is actively and durably maintained (see <a href="https://msberends.github.io/AMR/news/index.html">changelog)</a>) by two public healthcare organisations in the Netherlands.</p>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="pkgdown-sidebar">
@ -235,13 +233,11 @@
<footer><div class="copyright">
<p></p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link external-link">Matthijs S. Berends</a>, Christian F. Luz.</p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/">Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link external-link">pkgdown</a> 1.6.1.9001.</p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -250,7 +246,5 @@
</body>
</html>

View File

@ -57,8 +57,6 @@
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@ -70,15 +68,9 @@
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-citation-authors">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
@ -92,7 +84,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.7.1.9051</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -241,7 +233,7 @@
</div>
<p>Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C (2021). AMR - An R Package for Working with
Antimicrobial Resistance Data. Journal of Statistical Software (accepted for publication), https://www.biorxiv.org/content/10.1101/810622v4.</p>
Antimicrobial Resistance Data. Journal of Statistical Software (accepted for publication), https://www.biorxiv.org/content/10.1101/810622, doi: 10.1101/810622.</p>
<pre>@Article{,
title = {AMR - An R Package for Working with Antimicrobial Resistance Data},
author = {M S Berends and C F Luz and A W Friedrich and B N M Sinha and C J Albers and C Glasner},
@ -249,7 +241,7 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
journal = {Journal of Statistical Software},
pages = {Accepted for publication},
year = {2021},
url = {https://www.biorxiv.org/content/10.1101/810622v4},
url = {https://www.biorxiv.org/content/10.1101/810622},
}</pre>
<p>Berends, MS (2021). A New Instrument for Microbial Epidemiology: Empowering Antimicrobial Resistance Data Analysis (PhD thesis). University of Groningen, doi: 10.33612/diss.177417131.</p>
<pre>@PhdThesis{,
@ -258,7 +250,17 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
publisher = {University of Groningen},
school = {University of Groningen},
doi = {10.33612/diss.177417131},
pages = {288},
pages = {287},
year = {2021},
}</pre>
<p>Luz, CF (2021). Data Science for Infection Management & Antimicrobial Stewardship (PhD thesis). University of Groningen, doi: 10.33612/diss.192486375.</p>
<pre>@PhdThesis{,
title = {Data Science for Infection Management & Antimicrobial Stewardship},
author = {C F Luz},
publisher = {University of Groningen},
school = {University of Groningen},
doi = {10.33612/diss.192486375},
pages = {326},
year = {2021},
}</pre>
@ -266,7 +268,6 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
<h1>Authors</h1>
</div>
<ul class="list-unstyled">
<li>
<p><strong><a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a></strong>. Author, maintainer. <a href='https://orcid.org/0000-0001-7620-1800' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
@ -277,27 +278,27 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
</p>
</li>
<li>
<p><strong>Alexander W. Friedrich</strong>. Thesis advisor. <a href='https://orcid.org/0000-0003-4881-038X' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
<p><strong>Dennis Souverein</strong>. Author, contributor. <a href='https://orcid.org/0000-0003-0455-0336' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
</p>
</li>
<li>
<p><strong>Bhanu N. M. Sinha</strong>. Thesis advisor. <a href='https://orcid.org/0000-0003-1634-0010' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
<p><strong>Erwin E. A. Hassing</strong>. Author, contributor.
</p>
</li>
<li>
<p><strong>Casper J. Albers</strong>. Thesis advisor. <a href='https://orcid.org/0000-0002-9213-6743' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
</p>
</li>
<li>
<p><strong>Corinna Glasner</strong>. Thesis advisor. <a href='https://orcid.org/0000-0003-1241-1328' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
</p>
</li>
<li>
<p><strong>Judith M. Fonville</strong>. Contributor.
</p>
</li>
<li>
<p><strong>Erwin E. A. Hassing</strong>. Contributor.
<p><strong>Alex W. Friedrich</strong>. Thesis advisor. <a href='https://orcid.org/0000-0003-4881-038X' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
</p>
</li>
<li>
<p><strong>Corinna Glasner</strong>. Thesis advisor. <a href='https://orcid.org/0000-0003-1241-1328' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
</p>
</li>
<li>
@ -325,7 +326,7 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
</p>
</li>
<li>
<p><strong>Dennis Souverein</strong>. Contributor. <a href='https://orcid.org/0000-0003-0455-0336' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
<p><strong>Bhanu N. M. Sinha</strong>. Thesis advisor. <a href='https://orcid.org/0000-0003-1634-0010' target='orcid.widget' aria-label='ORCID'><span class='fab fa-orcid orcid' aria-hidden='true'></span></a>
</p>
</li>
<li>
@ -333,7 +334,7 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
</p>
</li>
</ul>
</div>
</div>
@ -342,11 +343,11 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
<footer>
<div class="copyright">
<p><p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p></p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -355,8 +356,6 @@ Antimicrobial Resistance Data. Journal of Statistical Software (accepted for pub
</body>
</html>

Binary file not shown.

Before

Width:  |  Height:  |  Size: 60 KiB

After

Width:  |  Height:  |  Size: 78 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.4 MiB

After

Width:  |  Height:  |  Size: 1.2 MiB

View File

@ -104,10 +104,7 @@ a pre[href], a pre[href]:hover, a pre[href]:focus {
/* syntax font */
pre, code {
font-family: 'Courier New', monospace;
font-size: 100% !important;
font-weight: bold;
/*background-color: #f4f4f4*/;
font-size: 95% !important;
}
pre code {
word-wrap: normal !important;

View File

@ -95,10 +95,12 @@ $(document).ready(function() {
function doct_tit(x) {
if (typeof(x) != "undefined") {
// authors
x = x.replace(/Author, maintainer/g, "Main developer");
x = x.replace(/Author, contributor/g, "Main contributor");
x = x.replace(/Author, maintainer/g, "Maintainer");
x = x.replace(/Author, contributor/g, "Maintainer");
x = x.replace(/Author, thesis advisor/g, "Doctoral advisor");
x = x.replace(/Thesis advisor/g, "Doctoral advisor");
x = x.replace("Matthijs", "Dr. Matthijs");
x = x.replace("Christian", "Dr. Christian");
x = x.replace("Alex", "Prof. Alex");
x = x.replace("Bhanu", "Prof. Bhanu");
x = x.replace("Casper", "Prof. Casper");

View File

@ -33,8 +33,6 @@
<![endif]-->
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-home">
<header><div class="navbar navbar-default navbar-fixed-top" role="navigation">
<div class="container">
@ -47,7 +45,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.7.1.9051</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -192,35 +190,35 @@
<div class="contents col-md-9">
<div id="amr-for-r-" class="section level1">
<div class="page-header"><h1 class="hasAnchor">
<a href="#amr-for-r-" class="anchor" aria-hidden="true"></a><code>AMR</code> (for R) <img src="./logo.png" align="right" height="120px">
<a href="#amr-for-r-" class="anchor"></a><code>AMR</code> (for R) <img src="./logo.png" align="right" height="120px">
</h1></div>
<blockquote>
<p>This package formed the basis of two PhD theses, of which the first was published and defended on 25 August 2021. Click here to read it: <a href="https://doi.org/10.33612/diss.177417131" class="external-link">DOI 10.33612/diss.177417131</a>.</p>
<p>Update: The latest EUCAST guideline for intrinsic resistance (v3.3, October 2021) is now supported, and our taxonomy tables has been updated as well (5 October 2021).</p>
</blockquote>
<div id="what-is-amr-for-r" class="section level3">
<h3 class="hasAnchor">
<a href="#what-is-amr-for-r" class="anchor" aria-hidden="true"></a>What is <code>AMR</code> (for R)?</h3>
<p><code>AMR</code> is a free, open-source and independent <a href="https://www.r-project.org" class="external-link">R package</a> to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. <strong>Our aim is to provide a standard</strong> for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.</p>
<a href="#what-is-amr-for-r" class="anchor"></a>What is <code>AMR</code> (for R)?</h3>
<p><code>AMR</code> is a free, open-source and independent <a href="https://www.r-project.org">R package</a> (see <a href="#copyright">Copyright</a>) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. <strong>Our aim is to provide a standard</strong> for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.</p>
<p>After installing this package, R knows <a href="./reference/microorganisms.html"><strong>~71,000 distinct microbial species</strong></a> and all <a href="./reference/antibiotics.html"><strong>~560 antibiotic, antimycotic and antiviral drugs</strong></a> by name and code (including ATC, EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data. Antimicrobial names and group names are available in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish.</p>
<p>This package is <a href="https://en.wikipedia.org/wiki/Dependency_hell" class="external-link">fully independent of any other R package</a> and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). <strong>It was designed to work in any setting, including those with very limited resources</strong>. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the <a href="https://www.rug.nl" class="external-link">University of Groningen</a>, in collaboration with non-profit organisations <a href="https://www.certe.nl" class="external-link">Certe Medical Diagnostics and Advice Foundation</a> and <a href="https://www.umcg.nl" class="external-link">University Medical Center Groningen</a>. This R package is <a href="./news">actively maintained</a> and is free software (see <a href="#copyright">Copyright</a>).</p>
<p>This package is <a href="https://en.wikipedia.org/wiki/Dependency_hell">fully independent of any other R package</a> and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). <strong>It was designed to work in any setting, including those with very limited resources</strong>. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the <a href="https://www.rug.nl">University of Groningen</a>, in collaboration with non-profit organisations <a href="https://www.certe.nl">Certe Medical Diagnostics and Advice Foundation</a> and <a href="https://www.umcg.nl">University Medical Center Groningen</a>. This R package formed the basis of two PhD theses (<a href="https://doi.org/10.33612/diss.177417131">DOI 10.33612/diss.177417131</a> and <a href="https://doi.org/10.33612/diss.192486375">DOI 10.33612/diss.177417131</a>) but is <a href="./news">actively and durably maintained</a> by two public healthcare organisations in the Netherlands.</p>
<div class="main-content" style="display: inline-block;">
<p>
<a href="./countries_large.png" target="_blank"><img src="./countries.png" class="countries_map"></a> <strong>Used in 162 countries</strong><br> Since its first public release in early 2018, this package has been downloaded from 162 countries. Click the map to enlarge and to see the country names.
<a href="./countries_large.png" target="_blank"><img src="./countries.png" class="countries_map"></a> <strong>Used in 175 countries</strong><br> Since its first public release in early 2018, this R package has been used in almost all countries in the world. Click the map to enlarge and to see the country names.
</p>
</div>
<div id="with-amr-for-r-theres-always-a-knowledgeable-microbiologist-by-your-side" class="section level5">
<h5 class="hasAnchor">
<a href="#with-amr-for-r-theres-always-a-knowledgeable-microbiologist-by-your-side" class="anchor" aria-hidden="true"></a>With <code>AMR</code> (for R), theres always a knowledgeable microbiologist by your side!</h5>
<a href="#with-amr-for-r-theres-always-a-knowledgeable-microbiologist-by-your-side" class="anchor"></a>With <code>AMR</code> (for R), theres always a knowledgeable microbiologist by your side!</h5>
<div class="sourceCode" id="cb1"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="co"># AMR works great with dplyr, but it's not required or neccesary</span>
<span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://github.com/msberends/AMR" class="external-link">AMR</a></span><span class="op">)</span>
<span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://dplyr.tidyverse.org" class="external-link">dplyr</a></span><span class="op">)</span>
<span class="kw"><a href="https://rdrr.io/r/base/library.html">library</a></span><span class="op">(</span><span class="va"><a href="https://msberends.github.io/AMR">AMR</a></span><span class="op">)</span>
<span class="kw"><a href="https://rdrr.io/r/base/library.html">library</a></span><span class="op">(</span><span class="va"><a href="https://dplyr.tidyverse.org">dplyr</a></span><span class="op">)</span>
<span class="va">example_isolates</span> <span class="op">%&gt;%</span>
<span class="fu"><a href="https://dplyr.tidyverse.org/reference/mutate.html" class="external-link">mutate</a></span><span class="op">(</span>bacteria <span class="op">=</span> <span class="fu"><a href="reference/mo_property.html">mo_fullname</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span> <span class="op">%&gt;%</span>
<span class="fu"><a href="https://dplyr.tidyverse.org/reference/filter.html" class="external-link">filter</a></span><span class="op">(</span><span class="fu"><a href="reference/mo_property.html">mo_is_gram_negative</a></span><span class="op">(</span><span class="op">)</span>,
<span class="fu"><a href="https://dplyr.tidyverse.org/reference/mutate.html">mutate</a></span><span class="op">(</span>bacteria <span class="op">=</span> <span class="fu"><a href="reference/mo_property.html">mo_fullname</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span> <span class="op">%&gt;%</span>
<span class="fu"><a href="https://dplyr.tidyverse.org/reference/filter.html">filter</a></span><span class="op">(</span><span class="fu"><a href="reference/mo_property.html">mo_is_gram_negative</a></span><span class="op">(</span><span class="op">)</span>,
<span class="fu"><a href="reference/mo_property.html">mo_is_intrinsic_resistant</a></span><span class="op">(</span>ab <span class="op">=</span> <span class="st">"cefotax"</span><span class="op">)</span><span class="op">)</span> <span class="op">%&gt;%</span>
<span class="fu"><a href="https://dplyr.tidyverse.org/reference/select.html" class="external-link">select</a></span><span class="op">(</span><span class="va">bacteria</span>,
<span class="fu"><a href="https://dplyr.tidyverse.org/reference/select.html">select</a></span><span class="op">(</span><span class="va">bacteria</span>,
<span class="fu"><a href="reference/antibiotic_class_selectors.html">aminoglycosides</a></span><span class="op">(</span><span class="op">)</span>,
<span class="fu"><a href="reference/antibiotic_class_selectors.html">carbapenems</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span></code></pre></div>
<p>With only having defined a row filter on Gram-negative bacteria with intrinsic resistance to cefotaxime (<code><a href="reference/mo_property.html">mo_is_gram_negative()</a></code> and <code><a href="reference/mo_property.html">mo_is_intrinsic_resistant()</a></code>) and a column selection on two antibiotic groups (<code><a href="reference/antibiotic_class_selectors.html">aminoglycosides()</a></code> and <code><a href="reference/antibiotic_class_selectors.html">carbapenems()</a></code>), the reference data about <a href="./reference/microorganisms.html">all microorganisms</a> and <a href="./reference/antibiotics.html">all antibiotics</a> in the <code>AMR</code> package make sure you get what you meant:</p>
@ -330,25 +328,25 @@
<p>A base R equivalent would be, giving the exact same results:</p>
<div class="sourceCode" id="cb2"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="va">example_isolates</span><span class="op">$</span><span class="va">bacteria</span> <span class="op">&lt;-</span> <span class="fu"><a href="reference/mo_property.html">mo_fullname</a></span><span class="op">(</span><span class="va">example_isolates</span><span class="op">$</span><span class="va">mo</span><span class="op">)</span>
<span class="va">example_isolates</span><span class="op">[</span><span class="fu"><a href="https://rdrr.io/r/base/which.html" class="external-link">which</a></span><span class="op">(</span><span class="fu"><a href="reference/mo_property.html">mo_is_gram_negative</a></span><span class="op">(</span><span class="op">)</span> <span class="op">&amp;</span>
<span class="va">example_isolates</span><span class="op">[</span><span class="fu"><a href="https://rdrr.io/r/base/which.html">which</a></span><span class="op">(</span><span class="fu"><a href="reference/mo_property.html">mo_is_gram_negative</a></span><span class="op">(</span><span class="op">)</span> <span class="op">&amp;</span>
<span class="fu"><a href="reference/mo_property.html">mo_is_intrinsic_resistant</a></span><span class="op">(</span>ab <span class="op">=</span> <span class="st">"cefotax"</span><span class="op">)</span><span class="op">)</span>,
<span class="fu"><a href="https://rdrr.io/r/base/c.html" class="external-link">c</a></span><span class="op">(</span><span class="st">"bacteria"</span>, <span class="fu"><a href="reference/antibiotic_class_selectors.html">aminoglycosides</a></span><span class="op">(</span><span class="op">)</span>, <span class="fu"><a href="reference/antibiotic_class_selectors.html">carbapenems</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span><span class="op">]</span></code></pre></div>
<span class="fu"><a href="https://rdrr.io/r/base/c.html">c</a></span><span class="op">(</span><span class="st">"bacteria"</span>, <span class="fu"><a href="reference/antibiotic_class_selectors.html">aminoglycosides</a></span><span class="op">(</span><span class="op">)</span>, <span class="fu"><a href="reference/antibiotic_class_selectors.html">carbapenems</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span><span class="op">]</span></code></pre></div>
</div>
<div id="partners" class="section level4">
<h4 class="hasAnchor">
<a href="#partners" class="anchor" aria-hidden="true"></a>Partners</h4>
<a href="#partners" class="anchor"></a>Partners</h4>
<p>The development of this package is part of, related to, or made possible by:</p>
<div align="center">
<p><a href="https://www.rug.nl" title="University of Groningen" class="external-link"><img src="./logo_rug.png" class="partner_logo"></a> <a href="https://www.umcg.nl" title="University Medical Center Groningen" class="external-link"><img src="./logo_umcg.png" class="partner_logo"></a> <a href="https://www.certe.nl" title="Certe Medical Diagnostics and Advice Foundation" class="external-link"><img src="./logo_certe.png" class="partner_logo"></a> <a href="http://www.eurhealth-1health.eu" title="EurHealth-1-Health" class="external-link"><img src="./logo_eh1h.png" class="partner_logo"></a> <a href="https://www.deutschland-nederland.eu" title="INTERREG" class="external-link"><img src="./logo_interreg.png" class="partner_logo"></a></p>
<p><a href="https://www.rug.nl" title="University of Groningen"><img src="./logo_rug.png" class="partner_logo"></a> <a href="https://www.umcg.nl" title="University Medical Center Groningen"><img src="./logo_umcg.png" class="partner_logo"></a> <a href="https://www.certe.nl" title="Certe Medical Diagnostics and Advice Foundation"><img src="./logo_certe.png" class="partner_logo"></a> <a href="http://www.eurhealth-1health.eu" title="EurHealth-1-Health"><img src="./logo_eh1h.png" class="partner_logo"></a> <a href="https://www.deutschland-nederland.eu" title="INTERREG"><img src="./logo_interreg.png" class="partner_logo"></a></p>
</div>
</div>
</div>
<div id="what-can-you-do-with-this-package" class="section level3">
<h3 class="hasAnchor">
<a href="#what-can-you-do-with-this-package" class="anchor" aria-hidden="true"></a>What can you do with this package?</h3>
<a href="#what-can-you-do-with-this-package" class="anchor"></a>What can you do with this package?</h3>
<p>This package can be used for:</p>
<ul>
<li>Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the <a href="http://www.catalogueoflife.org" class="external-link">Catalogue of Life</a> and <a href="https://lpsn.dsmz.de" class="external-link">List of Prokaryotic names with Standing in Nomenclature</a> (<a href="./reference/mo_property.html">manual</a>)</li>
<li>Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the <a href="http://www.catalogueoflife.org">Catalogue of Life</a> and <a href="https://lpsn.dsmz.de">List of Prokaryotic names with Standing in Nomenclature</a> (<a href="./reference/mo_property.html">manual</a>)</li>
<li>Interpreting raw MIC and disk diffusion values, based on the latest CLSI or EUCAST guidelines (<a href="./reference/as.rsi.html">manual</a>)</li>
<li>Retrieving antimicrobial drug names, doses and forms of administration from clinical health care records (<a href="./reference/ab_from_text.html">manual</a>)</li>
<li>Determining first isolates to be used for AMR data analysis (<a href="./reference/first_isolate.html">manual</a>)</li>
@ -368,72 +366,72 @@
</div>
<div id="get-this-package" class="section level3">
<h3 class="hasAnchor">
<a href="#get-this-package" class="anchor" aria-hidden="true"></a>Get this package</h3>
<a href="#get-this-package" class="anchor"></a>Get this package</h3>
<div id="latest-released-version" class="section level4">
<h4 class="hasAnchor">
<a href="#latest-released-version" class="anchor" aria-hidden="true"></a>Latest released version</h4>
<p><a href="https://cran.r-project.org/package=AMR" class="external-link"><img src="https://www.r-pkg.org/badges/version-ago/AMR" alt="CRAN"></a> <a href="https://cran.r-project.org/package=AMR" class="external-link"><img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR" alt="CRANlogs"></a></p>
<p>This package is available <a href="https://cran.r-project.org/package=AMR" class="external-link">here on the official R network (CRAN)</a>. Install this package in R from CRAN by using the command:</p>
<a href="#latest-released-version" class="anchor"></a>Latest released version</h4>
<p><a href="https://cran.r-project.org/package=AMR"><img src="https://www.r-pkg.org/badges/version-ago/AMR" alt="CRAN"></a> <a href="https://cran.r-project.org/package=AMR"><img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR" alt="CRANlogs"></a></p>
<p>This package is available <a href="https://cran.r-project.org/package=AMR">here on the official R network (CRAN)</a>. Install this package in R from CRAN by using the command:</p>
<div class="sourceCode" id="cb3"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html" class="external-link">install.packages</a></span><span class="op">(</span><span class="st">"AMR"</span><span class="op">)</span></code></pre></div>
<code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html">install.packages</a></span><span class="op">(</span><span class="st">"AMR"</span><span class="op">)</span></code></pre></div>
<p>It will be downloaded and installed automatically. For RStudio, click on the menu <em>Tools</em> &gt; <em>Install Packages…</em> and then type in “AMR” and press <kbd>Install</kbd>.</p>
<p><strong>Note:</strong> Not all functions on this website may be available in this latest release. To use all functions and data sets mentioned on this website, install the latest development version.</p>
</div>
<div id="latest-development-version" class="section level4">
<h4 class="hasAnchor">
<a href="#latest-development-version" class="anchor" aria-hidden="true"></a>Latest development version</h4>
<p><a href="https://codecov.io/gh/msberends/AMR?branch=main" class="external-link"><img src="https://github.com/msberends/AMR/workflows/R-code-check/badge.svg?branch=main" alt="R-code-check"></a> <a href="https://www.codefactor.io/repository/github/msberends/amr" class="external-link"><img src="https://www.codefactor.io/repository/github/msberends/amr/badge" alt="CodeFactor"></a> <a href="https://codecov.io/gh/msberends/AMR?branch=main" class="external-link"><img src="https://codecov.io/gh/msberends/AMR/branch/main/graph/badge.svg" alt="Codecov"></a></p>
<a href="#latest-development-version" class="anchor"></a>Latest development version</h4>
<p><a href="https://codecov.io/gh/msberends/AMR?branch=main"><img src="https://github.com/msberends/AMR/workflows/R-code-check/badge.svg?branch=main" alt="R-code-check"></a> <a href="https://www.codefactor.io/repository/github/msberends/amr"><img src="https://www.codefactor.io/repository/github/msberends/amr/badge" alt="CodeFactor"></a> <a href="https://codecov.io/gh/msberends/AMR?branch=main"><img src="https://codecov.io/gh/msberends/AMR/branch/main/graph/badge.svg" alt="Codecov"></a></p>
<p>The latest and unpublished development version can be installed from GitHub in two ways:</p>
<ol style="list-style-type: decimal">
<ol>
<li>
<p>Manually, using:</p>
<div class="sourceCode" id="cb4"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html" class="external-link">install.packages</a></span><span class="op">(</span><span class="st">"remotes"</span><span class="op">)</span> <span class="co"># if you haven't already</span>
<span class="fu">remotes</span><span class="fu">::</span><span class="fu"><a href="https://remotes.r-lib.org/reference/install_github.html" class="external-link">install_github</a></span><span class="op">(</span><span class="st">"msberends/AMR"</span><span class="op">)</span></code></pre></div>
<code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html">install.packages</a></span><span class="op">(</span><span class="st">"remotes"</span><span class="op">)</span> <span class="co"># if you haven't already</span>
<span class="fu">remotes</span><span class="fu">::</span><span class="fu"><a href="https://remotes.r-lib.org/reference/install_github.html">install_github</a></span><span class="op">(</span><span class="st">"msberends/AMR"</span><span class="op">)</span></code></pre></div>
</li>
<li>
<p>Automatically, using the <a href="https://ropensci.org/r-universe/" class="external-link">rOpenSci R-universe platform</a>, by adding <a href="https://msberends.r-universe.dev" class="external-link">our R-universe address</a> to your list of repositories (repos):</p>
<p>Automatically, using the <a href="https://ropensci.org/r-universe/">rOpenSci R-universe platform</a>, by adding <a href="https://msberends.r-universe.dev">our R-universe address</a> to your list of repositories (repos):</p>
<div class="sourceCode" id="cb5"><pre class="downlit sourceCode r">
<code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/base/options.html" class="external-link">options</a></span><span class="op">(</span>repos <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/base/c.html" class="external-link">c</a></span><span class="op">(</span><span class="fu"><a href="https://rdrr.io/r/base/options.html" class="external-link">getOption</a></span><span class="op">(</span><span class="st">"repos"</span><span class="op">)</span>,
<code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/base/options.html">options</a></span><span class="op">(</span>repos <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/base/c.html">c</a></span><span class="op">(</span><span class="fu"><a href="https://rdrr.io/r/base/options.html">getOption</a></span><span class="op">(</span><span class="st">"repos"</span><span class="op">)</span>,
msberends <span class="op">=</span> <span class="st">"https://msberends.r-universe.dev"</span><span class="op">)</span><span class="op">)</span></code></pre></div>
<p>After this, you can install and update this <code>AMR</code> package like any official release (e.g., using <code><a href="https://rdrr.io/r/utils/install.packages.html" class="external-link">install.packages("AMR")</a></code> or in RStudio via <em>Tools</em> &gt; <em>Check for Package Updates…</em>).</p>
<p>After this, you can install and update this <code>AMR</code> package like any official release (e.g., using <code><a href="https://rdrr.io/r/utils/install.packages.html">install.packages("AMR")</a></code> or in RStudio via <em>Tools</em> &gt; <em>Check for Package Updates…</em>).</p>
</li>
</ol>
<p>You can also download the latest build from our repository: <a href="https://github.com/msberends/AMR/raw/main/data-raw/AMR_latest.tar.gz" class="external-link uri">https://github.com/msberends/AMR/raw/main/data-raw/AMR_latest.tar.gz</a></p>
<p>You can also download the latest build from our repository: <a href="https://github.com/msberends/AMR/raw/main/data-raw/AMR_latest.tar.gz" class="uri">https://github.com/msberends/AMR/raw/main/data-raw/AMR_latest.tar.gz</a></p>
</div>
</div>
<div id="get-started" class="section level3">
<h3 class="hasAnchor">
<a href="#get-started" class="anchor" aria-hidden="true"></a>Get started</h3>
<a href="#get-started" class="anchor"></a>Get started</h3>
<p>To find out how to conduct AMR data analysis, please <a href="./articles/AMR.html">continue reading here to get started</a> or click a link in the <a href="https://msberends.github.io/AMR/articles/">How to menu</a>.</p>
</div>
<div id="short-introduction" class="section level3">
<h3 class="hasAnchor">
<a href="#short-introduction" class="anchor" aria-hidden="true"></a>Short introduction</h3>
<a href="#short-introduction" class="anchor"></a>Short introduction</h3>
<div id="microbial-taxonomic-reference-data" class="section level4">
<h4 class="hasAnchor">
<a href="#microbial-taxonomic-reference-data" class="anchor" aria-hidden="true"></a>Microbial (taxonomic) reference data</h4>
<p>This package contains the complete taxonomic tree of almost all ~70,000 microorganisms from the authoritative and comprehensive Catalogue of Life (CoL, <a href="http://www.catalogueoflife.org" class="external-link">www.catalogueoflife.org</a>), supplemented by data from the List of Prokaryotic names with Standing in Nomenclature (LPSN, <a href="https://lpsn.dsmz.de" class="external-link">lpsn.dsmz.de</a>). This supplementation is needed until the <a href="https://github.com/Sp2000/colplus" class="external-link">CoL+ project</a> is finished, which we await. With <code><a href="reference/catalogue_of_life_version.html">catalogue_of_life_version()</a></code> can be checked which version of the CoL is included in this package.</p>
<a href="#microbial-taxonomic-reference-data" class="anchor"></a>Microbial (taxonomic) reference data</h4>
<p>This package contains the complete taxonomic tree of almost all ~70,000 microorganisms from the authoritative and comprehensive Catalogue of Life (CoL, <a href="http://www.catalogueoflife.org">www.catalogueoflife.org</a>), supplemented by data from the List of Prokaryotic names with Standing in Nomenclature (LPSN, <a href="https://lpsn.dsmz.de">lpsn.dsmz.de</a>). This supplementation is needed until the <a href="https://github.com/Sp2000/colplus">CoL+ project</a> is finished, which we await. With <code><a href="reference/catalogue_of_life_version.html">catalogue_of_life_version()</a></code> can be checked which version of the CoL is included in this package.</p>
<p>Read more about which data from the Catalogue of Life <a href="./reference/catalogue_of_life.html">in our manual</a>.</p>
</div>
<div id="antimicrobial-reference-data" class="section level4">
<h4 class="hasAnchor">
<a href="#antimicrobial-reference-data" class="anchor" aria-hidden="true"></a>Antimicrobial reference data</h4>
<p>This package contains <strong>all ~550 antibiotic, antimycotic and antiviral drugs</strong> and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD, oral and IV) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <a href="https://www.whocc.no" class="external-link uri">https://www.whocc.no</a>) and the <a href="https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm" class="external-link">Pharmaceuticals Community Register of the European Commission</a>.</p>
<p><strong>NOTE: The WHOCC copyright does not allow use for commercial purposes, unlike any other info from this package. See <a href="https://www.whocc.no/copyright_disclaimer/" class="external-link uri">https://www.whocc.no/copyright_disclaimer/</a>.</strong></p>
<a href="#antimicrobial-reference-data" class="anchor"></a>Antimicrobial reference data</h4>
<p>This package contains <strong>all ~550 antibiotic, antimycotic and antiviral drugs</strong> and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD, oral and IV) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <a href="https://www.whocc.no" class="uri">https://www.whocc.no</a>) and the <a href="https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm">Pharmaceuticals Community Register of the European Commission</a>.</p>
<p><strong>NOTE: The WHOCC copyright does not allow use for commercial purposes, unlike any other info from this package. See <a href="https://www.whocc.no/copyright_disclaimer/" class="uri">https://www.whocc.no/copyright_disclaimer/</a>.</strong></p>
<p>Read more about the data from WHOCC <a href="./reference/WHOCC.html">in our manual</a>.</p>
</div>
<div id="whonet--ears-net" class="section level4">
<h4 class="hasAnchor">
<a href="#whonet--ears-net" class="anchor" aria-hidden="true"></a>WHONET / EARS-Net</h4>
<a href="#whonet--ears-net" class="anchor"></a>WHONET / EARS-Net</h4>
<p>We support WHONET and EARS-Net data. Exported files from WHONET can be imported into R and can be analysed easily using this package. For education purposes, we created an <a href="./reference/WHONET.html">example data set <code>WHONET</code></a> with the exact same structure as a WHONET export file. Furthermore, this package also contains a <a href="./reference/antibiotics.html">data set antibiotics</a> with all EARS-Net antibiotic abbreviations, and knows almost all WHONET abbreviations for microorganisms. When using WHONET data as input for analysis, all input parameters will be set automatically.</p>
<p>Read our tutorial about <a href="./articles/WHONET.html">how to work with WHONET data here</a>.</p>
</div>
<div id="overview-of-functions" class="section level4">
<h4 class="hasAnchor">
<a href="#overview-of-functions" class="anchor" aria-hidden="true"></a>Overview of functions</h4>
<a href="#overview-of-functions" class="anchor"></a>Overview of functions</h4>
<p>The <code>AMR</code> package basically does four important things:</p>
<ol style="list-style-type: decimal">
<ol>
<li>
<p>It <strong>cleanses existing data</strong> by providing new <em>classes</em> for microoganisms, antibiotics and antimicrobial results (both S/I/R and MIC). By installing this package, you teach R everything about microbiology that is needed for analysis. These functions all use intelligent rules to guess results that you would expect:</p>
<ul>
@ -446,13 +444,13 @@
<li>
<p>It <strong>enhances existing data</strong> and <strong>adds new data</strong> from data sets included in this package.</p>
<ul>
<li>Use <code><a href="reference/eucast_rules.html">eucast_rules()</a></code> to apply <a href="https://www.eucast.org/expert_rules_and_intrinsic_resistance/" class="external-link">EUCAST expert rules to isolates</a> (not the translation from MIC to R/SI values, use <code><a href="reference/as.rsi.html">as.rsi()</a></code> for that).</li>
<li>Use <code><a href="reference/first_isolate.html">first_isolate()</a></code> to identify the first isolates of every patient <a href="https://clsi.org/standards/products/microbiology/documents/m39/" class="external-link">using guidelines from the CLSI</a> (Clinical and Laboratory Standards Institute).
<li>Use <code><a href="reference/eucast_rules.html">eucast_rules()</a></code> to apply <a href="https://www.eucast.org/expert_rules_and_intrinsic_resistance/">EUCAST expert rules to isolates</a> (not the translation from MIC to R/SI values, use <code><a href="reference/as.rsi.html">as.rsi()</a></code> for that).</li>
<li>Use <code><a href="reference/first_isolate.html">first_isolate()</a></code> to identify the first isolates of every patient <a href="https://clsi.org/standards/products/microbiology/documents/m39/">using guidelines from the CLSI</a> (Clinical and Laboratory Standards Institute).
<ul>
<li>You can also identify first <em>weighted</em> isolates of every patient, an adjusted version of the CLSI guideline. This takes into account key antibiotics of every strain and compares them.</li>
</ul>
</li>
<li>Use <code><a href="reference/mdro.html">mdro()</a></code> to determine which micro-organisms are multi-drug resistant organisms (MDRO). It supports a variety of international guidelines, such as the MDR-paper by Magiorakos <em>et al.</em> (2012, <a href="https://www.ncbi.nlm.nih.gov/pubmed/?term=21793988" class="external-link">PMID 21793988</a>), the exceptional phenotype definitions of EUCAST and the WHO guideline on multi-drug resistant TB. It also supports the national guidelines of the Netherlands and Germany.</li>
<li>Use <code><a href="reference/mdro.html">mdro()</a></code> to determine which micro-organisms are multi-drug resistant organisms (MDRO). It supports a variety of international guidelines, such as the MDR-paper by Magiorakos <em>et al.</em> (2012, <a href="https://www.ncbi.nlm.nih.gov/pubmed/?term=21793988">PMID 21793988</a>), the exceptional phenotype definitions of EUCAST and the WHO guideline on multi-drug resistant TB. It also supports the national guidelines of the Netherlands and Germany.</li>
<li>The <a href="./reference/microorganisms.html">data set microorganisms</a> contains the complete taxonomic tree of ~70,000 microorganisms. Furthermore, some colloquial names and all Gram stains are available, which enables resistance analysis of e.g. different antibiotics per Gram stain. The package also contains functions to look up values in this data set like <code><a href="reference/mo_property.html">mo_genus()</a></code>, <code><a href="reference/mo_property.html">mo_family()</a></code>, <code><a href="reference/mo_property.html">mo_gramstain()</a></code> or even <code><a href="reference/mo_property.html">mo_phylum()</a></code>. Use <code><a href="reference/mo_property.html">mo_snomed()</a></code> to look up any SNOMED CT code associated with a microorganism. As all these function use <code><a href="reference/as.mo.html">as.mo()</a></code> internally, they also use the same intelligent rules for determination. For example, <code><a href="reference/mo_property.html">mo_genus("MRSA")</a></code> and <code><a href="reference/mo_property.html">mo_genus("S. aureus")</a></code> will both return <code>"Staphylococcus"</code>. They also come with support for German, Danish, Dutch, Spanish, Italian, French and Portuguese. These functions can be used to add new variables to your data.</li>
<li>The <a href="./reference/antibiotics.html">data set antibiotics</a> contains ~450 antimicrobial drugs with their EARS-Net code, ATC code, PubChem compound ID, LOINC code, official name, common LIS codes and DDDs of both oral and parenteral administration. It also contains all (thousands of) trade names found in PubChem. Use functions like <code><a href="reference/ab_property.html">ab_name()</a></code>, <code><a href="reference/ab_property.html">ab_group()</a></code>, <code><a href="reference/ab_property.html">ab_atc()</a></code>, <code><a href="reference/ab_property.html">ab_loinc()</a></code> and <code><a href="reference/ab_property.html">ab_tradenames()</a></code> to look up values. The <code>ab_*</code> functions use <code><a href="reference/as.ab.html">as.ab()</a></code> internally so they support the same intelligent rules to guess the most probable result. For example, <code><a href="reference/ab_property.html">ab_name("Fluclox")</a></code>, <code><a href="reference/ab_property.html">ab_name("Floxapen")</a></code> and <code><a href="reference/ab_property.html">ab_name("J01CF05")</a></code> will all return <code>"Flucloxacillin"</code>. These functions can again be used to add new variables to your data.</li>
</ul>
@ -460,7 +458,7 @@
<li>
<p>It <strong>analyses the data</strong> with convenient functions that use well-known methods.</p>
<ul>
<li>Calculate the microbial susceptibility or resistance (and even co-resistance) with the <code><a href="reference/proportion.html">susceptibility()</a></code> and <code><a href="reference/proportion.html">resistance()</a></code> functions, or be even more specific with the <code><a href="reference/proportion.html">proportion_R()</a></code>, <code><a href="reference/proportion.html">proportion_IR()</a></code>, <code><a href="reference/proportion.html">proportion_I()</a></code>, <code><a href="reference/proportion.html">proportion_SI()</a></code> and <code><a href="reference/proportion.html">proportion_S()</a></code> functions. Similarly, the <em>number</em> of isolates can be determined with the <code><a href="reference/count.html">count_resistant()</a></code>, <code><a href="reference/count.html">count_susceptible()</a></code> and <code><a href="reference/count.html">count_all()</a></code> functions. All these functions can be used with the <code>dplyr</code> package (e.g. in conjunction with <code><a href="https://dplyr.tidyverse.org/reference/summarise.html" class="external-link">summarise()</a></code>)</li>
<li>Calculate the microbial susceptibility or resistance (and even co-resistance) with the <code><a href="reference/proportion.html">susceptibility()</a></code> and <code><a href="reference/proportion.html">resistance()</a></code> functions, or be even more specific with the <code><a href="reference/proportion.html">proportion_R()</a></code>, <code><a href="reference/proportion.html">proportion_IR()</a></code>, <code><a href="reference/proportion.html">proportion_I()</a></code>, <code><a href="reference/proportion.html">proportion_SI()</a></code> and <code><a href="reference/proportion.html">proportion_S()</a></code> functions. Similarly, the <em>number</em> of isolates can be determined with the <code><a href="reference/count.html">count_resistant()</a></code>, <code><a href="reference/count.html">count_susceptible()</a></code> and <code><a href="reference/count.html">count_all()</a></code> functions. All these functions can be used with the <code>dplyr</code> package (e.g. in conjunction with <code><a href="https://dplyr.tidyverse.org/reference/summarise.html">summarise()</a></code>)</li>
<li>Plot AMR results with <code><a href="reference/ggplot_rsi.html">geom_rsi()</a></code>, a function made for the <code>ggplot2</code> package</li>
<li>Predict antimicrobial resistance for the nextcoming years using logistic regression models with the <code><a href="reference/resistance_predict.html">resistance_predict()</a></code> function</li>
</ul>
@ -482,7 +480,7 @@
</div>
<div id="copyright" class="section level3">
<h3 class="hasAnchor">
<a href="#copyright" class="anchor" aria-hidden="true"></a>Copyright</h3>
<a href="#copyright" class="anchor"></a>Copyright</h3>
<p>This R package is free, open-source software and licensed under the <a href="./LICENSE-text.html">GNU General Public License v2.0 (GPL-2)</a>. In a nutshell, this means that this package:</p>
<ul>
<li><p>May be used for commercial purposes</p></li>
@ -511,7 +509,7 @@
<div class="col-md-3 hidden-xs hidden-sm" id="pkgdown-sidebar">
<div class="links">
<h2 data-toc-skip>Links</h2>
<h2>Links</h2>
<ul class="list-unstyled">
<li>Download from CRAN at <br><a href="https://cloud.r-project.org/package=AMR">https://cloud.r-project.org/package=AMR</a>
</li>
@ -521,48 +519,42 @@
</li>
</ul>
</div>
<div class="license">
<h2 data-toc-skip>License</h2>
<h2>License</h2>
<ul class="list-unstyled">
<li>
<a href="https://www.r-project.org/Licenses/GPL-2">GPL-2</a> | file <a href="LICENSE-text.html">LICENSE</a>
</li>
</ul>
</div>
<div class="citation">
<h2 data-toc-skip>Citation</h2>
<h2>Citation</h2>
<ul class="list-unstyled">
<li><a href="authors.html">Citing AMR</a></li>
</ul>
</div>
<div class="developers">
<h2 data-toc-skip>Developers</h2>
<h2>Developers</h2>
<ul class="list-unstyled">
<li>
<a href="https://www.rug.nl/staff/m.s.berends/">Matthijs S. Berends</a> <br><small class="roles"> Author, maintainer </small> <a href="https://orcid.org/0000-0001-7620-1800" target="orcid.widget" aria-label="ORCID"><span class="fab fa-orcid orcid" aria-hidden="true"></span></a> </li>
<li>Christian F. Luz <br><small class="roles"> Author, contributor </small> <a href="https://orcid.org/0000-0001-5809-5995" target="orcid.widget" aria-label="ORCID"><span class="fab fa-orcid orcid" aria-hidden="true"></span></a> </li>
<li><a href="authors.html">More on authors...</a></li>
<li>Dennis Souverein <br><small class="roles"> Author, contributor </small> <a href="https://orcid.org/0000-0003-0455-0336" target="orcid.widget" aria-label="ORCID"><span class="fab fa-orcid orcid" aria-hidden="true"></span></a> </li>
<li>Erwin E. A. Hassing <br><small class="roles"> Author, contributor </small> </li>
<li><a href="authors.html">All authors...</a></li>
</ul>
</div>
</div>
</div>
<footer><div class="copyright">
<p></p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p>
<p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/">Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -571,7 +563,5 @@
</body>
</html>

View File

@ -84,7 +84,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.7.1.9053</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -232,12 +232,12 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div>
<div id="amr-1719053" class="section level1">
<h1 class="page-header" data-toc-text="1.7.1.9053">
<a href="#amr-1719053" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.7.1.9053</h1>
<div id="last-updated-1-november-2021" class="section level2">
<div id="amr-1719054" class="section level1">
<h1 class="page-header" data-toc-text="1.7.1.9054">
<a href="#amr-1719054" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.7.1.9054</h1>
<div id="last-updated-28-november-2021" class="section level2">
<h2 class="hasAnchor">
<a href="#last-updated-1-november-2021" class="anchor"></a><small>Last updated: 1 November 2021</small>
<a href="#last-updated-28-november-2021" class="anchor"></a><small>Last updated: 28 November 2021</small>
</h2>
<div id="breaking-changes" class="section level3">
<h3 class="hasAnchor">
@ -253,6 +253,7 @@
<h3 class="hasAnchor">
<a href="#new" class="anchor"></a>New</h3>
<ul>
<li>Support for EUCAST Intrinsic Resistance and Unusual Phenotypes v3.3 (October 2021), effective in the <code><a href="../reference/eucast_rules.html">eucast_rules()</a></code> function. This is now the default guideline (all other guidelines are still available).</li>
<li>Function <code><a href="../reference/ab_property.html">set_ab_names()</a></code> to rename data set columns that resemble antimicrobial drugs. This allows for quickly renaming columns to official names, ATC codes, etc.</li>
<li>Support for Danish, and also added missing translations of all antimicrobial drugs in Italian, French and Portuguese</li>
</ul>
@ -297,6 +298,8 @@
</ul>
</li>
<li>Fixed the Gram stain (<code><a href="../reference/mo_property.html">mo_gramstain()</a></code>) determination of the taxonomic class Negativicutes within the phylum of Firmicutes - they were considered Gram-positives because of their phylum but are actually Gram-negative. This impacts 137 taxonomic species, genera and families, such as <em>Negativicoccus</em> and <em>Veillonella</em>.</li>
<li>Dramatic speed improvement for <code><a href="../reference/first_isolate.html">first_isolate()</a></code>
</li>
<li>Fix to prevent introducing <code>NA</code>s for old MO codes when running <code><a href="../reference/as.mo.html">as.mo()</a></code> on them</li>
<li>Added more informative error messages when any of the <code>proportion_*()</code> and <code>count_*()</code> functions fail</li>
<li>When printing a tibble with any old MO code, a warning will be thrown that old codes should be updated using <code><a href="../reference/as.mo.html">as.mo()</a></code>
@ -305,7 +308,9 @@
</li>
<li>The right input types for <code><a href="../reference/random.html">random_mic()</a></code>, <code><a href="../reference/random.html">random_disk()</a></code> and <code><a href="../reference/random.html">random_rsi()</a></code> are now enforced</li>
<li>
<code><a href="../reference/as.rsi.html">as.rsi()</a></code> can now correct for textual input (such as “Susceptible”, “Resistant”) in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish</li>
<code><a href="../reference/as.rsi.html">as.rsi()</a></code> has an improved algorithm and can now also correct for textual input (such as “Susceptible”, “Resistant”) in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish</li>
<li>
<code><a href="../reference/as.mic.html">as.mic()</a></code> has an improved algorithm</li>
<li>When warnings are thrown because of too few isolates in any <code>count_*()</code>, <code>proportion_*()</code> function (or <code>resistant()</code> or <code>susceptible()</code>), the <code>dplyr</code> group will be shown, if available</li>
<li>Fix for legends created with <code><a href="../reference/ggplot_rsi.html">scale_rsi_colours()</a></code> when using <code>ggplot2</code> v3.3.4 or higher (this is ggplot2 bug 4511, soon to be fixed)</li>
<li>Fix for minor translation errors</li>
@ -315,13 +320,17 @@
<li>Improved plot legends for MICs and disk diffusion values</li>
<li>Improved speed of <code><a href="../reference/as.ab.html">as.ab()</a></code> and all <code>ab_*()</code> functions</li>
<li>Added <code>fortify()</code> extensions for plotting methods</li>
<li>
<code>NA</code> values of the classes <code>&lt;mic&gt;</code>, <code>&lt;disk&gt;</code> and <code>&lt;rsi&gt;</code> are now exported objects of this package, e.g. <code>NA_mic_</code> is an <code>NA</code> of class <code>mic</code> (just like the base R <code>NA_character_</code> is an <code>NA</code> of class <code>character</code>)</li>
<li>The <code><a href="../reference/proportion.html">proportion_df()</a></code>, <code><a href="../reference/count.html">count_df()</a></code> and <code><a href="../reference/proportion.html">rsi_df()</a></code> functions now return with the additional S3 class rsi_df so they can be extended by other packages</li>
<li>The <code><a href="../reference/mdro.html">mdro()</a></code> function now returns <code>NA</code> for all rows that have no test results</li>
</ul>
</div>
<div id="other" class="section level3">
<h3 class="hasAnchor">
<a href="#other" class="anchor"></a>Other</h3>
<ul>
<li>This package is now being maintained by two epidemiologists and a data scientist from two different non-profit healthcare organisations. All functions in this package are now all considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated yearly from now on.</li>
<li>This package is now being maintained by two epidemiologists and a data scientist from two different non-profit healthcare organisations. All functions in this package are now all considered to be stable. Updates to the AMR interpretation rules (such as by EUCAST and CLSI), the microbial taxonomy, and the antibiotic dosages will all be updated every 6 to 12 months from now on.</li>
</ul>
</div>
</div>
@ -2312,7 +2321,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<footer>
<div class="copyright">
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Dennis Souverein, Erwin E. A. Hassing, Christian F. Luz.</p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">

View File

@ -264,16 +264,21 @@ table {
/* Syntax highlighting ---------------------------------------------------- */
pre, pre code {
background-color: #f8f8f8;
color: #333;
white-space: pre-wrap;
word-break: break-all;
overflow-wrap: break-word;
pre {
word-wrap: normal;
word-break: normal;
border: 1px solid #eee;
}
pre {
border: 1px solid #eee;
pre, code {
background-color: #f8f8f8;
color: #333;
}
pre code {
overflow: auto;
word-wrap: normal;
white-space: pre;
}
pre .img {
@ -300,8 +305,9 @@ a.sourceLine:hover {
.kw {color: #264D66;} /* keyword */
.co {color: #888888;} /* comment */
.error {font-weight: bolder;}
.warning {font-weight: bolder;}
.message { color: black; font-weight: bolder;}
.error { color: orange; font-weight: bolder;}
.warning { color: #6A0366; font-weight: bolder;}
/* Clipboard --------------------------*/

View File

@ -80,7 +80,7 @@
$(document).ready(function() {
var copyButton = "<button type='button' class='btn btn-primary btn-copy-ex' type = 'submit' title='Copy to clipboard' aria-label='Copy to clipboard' data-toggle='tooltip' data-placement='left auto' data-trigger='hover' data-clipboard-copy><i class='fa fa-copy'></i></button>";
$("div.sourceCode").addClass("hasCopyButton");
$(".examples, div.sourceCode").addClass("hasCopyButton");
// Insert copy buttons:
$(copyButton).prependTo(".hasCopyButton");

View File

@ -1,6 +1,6 @@
pandoc: 2.11.4
pkgdown: 1.6.1.9001
pkgdown_sha: ce9781a15c7ea07df9fb17a11295ba4abec0b54b
pandoc: 2.14.0.3
pkgdown: 1.6.1
pkgdown_sha: ~
articles:
AMR: AMR.html
EUCAST: EUCAST.html
@ -12,8 +12,8 @@ articles:
datasets: datasets.html
resistance_predict: resistance_predict.html
welcome_to_AMR: welcome_to_AMR.html
last_built: 2021-10-06T11:20Z
last_built: 2021-11-28T21:59Z
urls:
reference: https://msberends.github.io/AMR/reference
article: https://msberends.github.io/AMR/articles
reference: https://msberends.github.io/AMR//reference
article: https://msberends.github.io/AMR//articles

View File

@ -58,8 +58,6 @@
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@ -71,15 +69,9 @@
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-reference-topic">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
@ -93,7 +85,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.7.1.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -238,7 +230,7 @@
<div class="col-md-9 contents">
<div class="page-header">
<h1>Transform Input to Disk Diffusion Diameters</h1>
<small class="dont-index">Source: <a href='https://github.com/msberends/AMR/blob/main/R/disk.R'><code>R/disk.R</code></a></small>
<small class="dont-index">Source: <a href='https://github.com/msberends/AMR/blob/master/R/disk.R'><code>R/disk.R</code></a></small>
<div class="hidden name"><code>as.disk.Rd</code></div>
</div>
@ -246,9 +238,11 @@
<p>This transforms a vector to a new class <code>disk</code>, which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 6 and 50.</p>
</div>
<div class="ref-usage sourceCode"><pre class='sourceCode r'><code><span class='fu'>as.disk</span><span class='op'>(</span><span class='va'>x</span>, na.rm <span class='op'>=</span> <span class='cn'>FALSE</span><span class='op'>)</span>
<pre class="usage"><span class='fu'>as.disk</span><span class='op'>(</span><span class='va'>x</span>, na.rm <span class='op'>=</span> <span class='cn'>FALSE</span><span class='op'>)</span>
<span class='fu'>is.disk</span><span class='op'>(</span><span class='va'>x</span><span class='op'>)</span></code></pre></div>
<span class='va'>NA_disk_</span>
<span class='fu'>is.disk</span><span class='op'>(</span><span class='va'>x</span><span class='op'>)</span></pre>
<h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
<table class="ref-arguments">
@ -263,12 +257,16 @@
</tr>
</table>
<h2 class="hasAnchor" id="format"><a class="anchor" href="#format"></a>Format</h2>
<p>An object of class <code>disk</code> (inherits from <code>integer</code>) of length 1.</p>
<h2 class="hasAnchor" id="value"><a class="anchor" href="#value"></a>Value</h2>
<p>An <a href='https://rdrr.io/r/base/integer.html'>integer</a> with additional class <code>disk</code></p>
<h2 class="hasAnchor" id="details"><a class="anchor" href="#details"></a>Details</h2>
<p>Interpret disk values as RSI values with <code><a href='as.rsi.html'>as.rsi()</a></code>. It supports guidelines from EUCAST and CLSI.</p>
<p><code>NA_disk_</code> is a missing value of the new <code>&lt;disk&gt;</code> class.</p>
<h2 class="hasAnchor" id="stable-lifecycle"><a class="anchor" href="#stable-lifecycle"></a>Stable Lifecycle</h2>
@ -286,7 +284,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
<div class='dont-index'><p><code><a href='as.rsi.html'>as.rsi()</a></code></p></div>
<h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2>
<div class="ref-examples sourceCode"><pre class='sourceCode r'><code><span class='co'># \donttest{</span>
<pre class="examples"><span class='co'># \donttest{</span>
<span class='co'># transform existing disk zones to the `disk` class</span>
<span class='va'>df</span> <span class='op'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a></span><span class='op'>(</span>microorganism <span class='op'>=</span> <span class='st'>"E. coli"</span>,
AMP <span class='op'>=</span> <span class='fl'>20</span>,
@ -305,7 +303,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
<span class='fu'><a href='as.rsi.html'>as.rsi</a></span><span class='op'>(</span><span class='va'>df</span><span class='op'>)</span>
<span class='co'># }</span>
</code></pre></div>
</pre>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="pkgdown-sidebar">
<nav id="toc" data-toggle="toc" class="sticky-top">
@ -317,11 +315,11 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
<footer>
<div class="copyright">
<p><p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, <a href="https://www.rug.nl/staff/c.f.luz/" class="external-link">Christian F. Luz</a>, <a href="https://www.rug.nl/staff/a.w.friedrich/" class="external-link">Alexander W. Friedrich</a>, <a href="https://www.rug.nl/staff/b.sinha/" class="external-link">Bhanu N. M. Sinha</a>, <a href="https://www.rug.nl/staff/c.j.albers/" class="external-link">Casper J. Albers</a>, <a href="https://www.rug.nl/staff/c.glasner/" class="external-link">Corinna Glasner</a>.</p></p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -330,8 +328,6 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
</body>
</html>

File diff suppressed because one or more lines are too long

View File

@ -85,7 +85,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.7.1.9053</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -240,6 +240,8 @@
<pre class="usage"><span class='fu'>as.rsi</span><span class='op'>(</span><span class='va'>x</span>, <span class='va'>...</span><span class='op'>)</span>
<span class='va'>NA_rsi_</span>
<span class='fu'>is.rsi</span><span class='op'>(</span><span class='va'>x</span><span class='op'>)</span>
<span class='fu'>is.rsi.eligible</span><span class='op'>(</span><span class='va'>x</span>, threshold <span class='op'>=</span> <span class='fl'>0.05</span><span class='op'>)</span>
@ -330,6 +332,9 @@
</tr>
</table>
<h2 class="hasAnchor" id="format"><a class="anchor" href="#format"></a>Format</h2>
<p>An object of class <code>rsi</code> (inherits from <code>ordered</code>, <code>factor</code>) of length 1.</p>
<h2 class="hasAnchor" id="value"><a class="anchor" href="#value"></a>Value</h2>
<p>Ordered <a href='https://rdrr.io/r/base/factor.html'>factor</a> with new class <code>&lt;rsi&gt;</code></p>
@ -378,6 +383,7 @@
<p>The function <code>is.rsi()</code> detects if the input contains class <code>&lt;rsi&gt;</code>. If the input is a <a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a>, it iterates over all columns and returns a <a href='https://rdrr.io/r/base/logical.html'>logical</a> vector.</p>
<p>The function <code>is.rsi.eligible()</code> returns <code>TRUE</code> when a columns contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R), and <code>FALSE</code> otherwise. The threshold of 5% can be set with the <code>threshold</code> argument. If the input is a <a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a>, it iterates over all columns and returns a <a href='https://rdrr.io/r/base/logical.html'>logical</a> vector.</p>
<p><code>NA_rsi_</code> is a missing value of the new <code>&lt;rsi&gt;</code> class.</p>
<h2 class="hasAnchor" id="interpretation-of-r-and-s-i"><a class="anchor" href="#interpretation-of-r-and-s-i"></a>Interpretation of R and S/I</h2>
@ -509,7 +515,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
<footer>
<div class="copyright">
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Dennis Souverein, Erwin E. A. Hassing, Christian F. Luz.</p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">

View File

@ -58,8 +58,6 @@
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@ -71,15 +69,9 @@
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-reference-topic">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
@ -93,7 +85,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.7.1.9040</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -238,7 +230,7 @@
<div class="col-md-9 contents">
<div class="page-header">
<h1>Define Custom EUCAST Rules</h1>
<small class="dont-index">Source: <a href='https://github.com/msberends/AMR/blob/main/R/custom_eucast_rules.R'><code>R/custom_eucast_rules.R</code></a></small>
<small class="dont-index">Source: <a href='https://github.com/msberends/AMR/blob/master/R/custom_eucast_rules.R'><code>R/custom_eucast_rules.R</code></a></small>
<div class="hidden name"><code>custom_eucast_rules.Rd</code></div>
</div>
@ -246,7 +238,7 @@
<p>Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in <code><a href='eucast_rules.html'>eucast_rules()</a></code>.</p>
</div>
<div class="ref-usage sourceCode"><pre class='sourceCode r'><code><span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>...</span><span class='op'>)</span></code></pre></div>
<pre class="usage"><span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>...</span><span class='op'>)</span></pre>
<h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
<table class="ref-arguments">
@ -267,14 +259,14 @@
<h3 class='hasAnchor' id='basics'><a class='anchor' aria-hidden='true' href='#basics'></a>Basics</h3>
<h3 class='hasAnchor' id='arguments'><a class='anchor' href='#arguments'></a>Basics</h3>
<p>If you are familiar with the <code><a href='https://dplyr.tidyverse.org/reference/case_when.html'>case_when()</a></code> function of the <code>dplyr</code> package, you will recognise the input method to set your own rules. Rules must be set using what <span style="R">R</span> considers to be the 'formula notation'. The rule itself is written <em>before</em> the tilde (<code><a href='https://rdrr.io/r/base/tilde.html'>~</a></code>) and the consequence of the rule is written <em>after</em> the tilde:</p><pre class='sourceCode r'><code><span class='va'>x</span> <span class='op'>&lt;-</span> <span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>TZP</span> <span class='op'>==</span> <span class='st'>"S"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"S"</span>,
<p>If you are familiar with the <code><a href='https://dplyr.tidyverse.org/reference/case_when.html'>case_when()</a></code> function of the <code>dplyr</code> package, you will recognise the input method to set your own rules. Rules must be set using what <span style="R">R</span> considers to be the 'formula notation'. The rule itself is written <em>before</em> the tilde (<code><a href='https://rdrr.io/r/base/tilde.html'>~</a></code>) and the consequence of the rule is written <em>after</em> the tilde:</p><pre><span class='va'>x</span> <span class='op'>&lt;-</span> <span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>TZP</span> <span class='op'>==</span> <span class='st'>"S"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"S"</span>,
<span class='va'>TZP</span> <span class='op'>==</span> <span class='st'>"R"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"R"</span><span class='op'>)</span>
</code></pre>
</pre>
<p>These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:</p><pre class='sourceCode r'><code><span class='va'>x</span>
<p>These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:</p><pre><span class='va'>x</span>
<span class='co'>#&gt; A set of custom EUCAST rules:</span>
<span class='co'>#&gt; </span>
<span class='co'>#&gt; 1. If TZP is S then set to S:</span>
@ -282,9 +274,9 @@
<span class='co'>#&gt; </span>
<span class='co'>#&gt; 2. If TZP is R then set to R:</span>
<span class='co'>#&gt; amoxicillin (AMX), ampicillin (AMP)</span>
</code></pre>
</pre>
<p>The rules (the part <em>before</em> the tilde, in above example <code>TZP == "S"</code> and <code>TZP == "R"</code>) must be evaluable in your data set: it should be able to run as a filter in your data set without errors. This means for the above example that the column <code>TZP</code> must exist. We will create a sample data set and test the rules set:</p><pre class='sourceCode r'><code><span class='va'>df</span> <span class='op'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a></span><span class='op'>(</span>mo <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"E. coli"</span>, <span class='st'>"K. pneumoniae"</span><span class='op'>)</span>,
<p>The rules (the part <em>before</em> the tilde, in above example <code>TZP == "S"</code> and <code>TZP == "R"</code>) must be evaluable in your data set: it should be able to run as a filter in your data set without errors. This means for the above example that the column <code>TZP</code> must exist. We will create a sample data set and test the rules set:</p><pre><span class='va'>df</span> <span class='op'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a></span><span class='op'>(</span>mo <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"E. coli"</span>, <span class='st'>"K. pneumoniae"</span><span class='op'>)</span>,
TZP <span class='op'>=</span> <span class='st'>"R"</span>,
amox <span class='op'>=</span> <span class='st'>""</span>,
AMP <span class='op'>=</span> <span class='st'>""</span><span class='op'>)</span>
@ -297,23 +289,23 @@
<span class='co'>#&gt; mo TZP amox AMP</span>
<span class='co'>#&gt; 1 E. coli R R R </span>
<span class='co'>#&gt; 2 K. pneumoniae R R R </span>
</code></pre>
</pre>
<h3 class='hasAnchor' id='using-taxonomic-properties-in-rules'><a class='anchor' aria-hidden='true' href='#using-taxonomic-properties-in-rules'></a>Using taxonomic properties in rules</h3>
<h3 class='hasAnchor' id='arguments'><a class='anchor' href='#arguments'></a>Using taxonomic properties in rules</h3>
<p>There is one exception in variables used for the rules: all column names of the <a href='microorganisms.html'>microorganisms</a> data set can also be used, but do not have to exist in the data set. These column names are: <code>mo</code>, <code>fullname</code>, <code>kingdom</code>, <code>phylum</code>, <code>class</code>, <code>order</code>, <code>family</code>, <code>genus</code>, <code>species</code>, <code>subspecies</code>, <code>rank</code>, <code>ref</code>, <code>species_id</code>, <code>source</code>, <code>prevalence</code> and <code>snomed</code>. Thus, this next example will work as well, despite the fact that the <code>df</code> data set does not contain a column <code>genus</code>:</p><pre class='sourceCode r'><code><span class='va'>y</span> <span class='op'>&lt;-</span> <span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>TZP</span> <span class='op'>==</span> <span class='st'>"S"</span> <span class='op'>&amp;</span> <span class='va'>genus</span> <span class='op'>==</span> <span class='st'>"Klebsiella"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"S"</span>,
<p>There is one exception in variables used for the rules: all column names of the <a href='microorganisms.html'>microorganisms</a> data set can also be used, but do not have to exist in the data set. These column names are: <code>mo</code>, <code>fullname</code>, <code>kingdom</code>, <code>phylum</code>, <code>class</code>, <code>order</code>, <code>family</code>, <code>genus</code>, <code>species</code>, <code>subspecies</code>, <code>rank</code>, <code>ref</code>, <code>species_id</code>, <code>source</code>, <code>prevalence</code> and <code>snomed</code>. Thus, this next example will work as well, despite the fact that the <code>df</code> data set does not contain a column <code>genus</code>:</p><pre><span class='va'>y</span> <span class='op'>&lt;-</span> <span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>TZP</span> <span class='op'>==</span> <span class='st'>"S"</span> <span class='op'>&amp;</span> <span class='va'>genus</span> <span class='op'>==</span> <span class='st'>"Klebsiella"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"S"</span>,
<span class='va'>TZP</span> <span class='op'>==</span> <span class='st'>"R"</span> <span class='op'>&amp;</span> <span class='va'>genus</span> <span class='op'>==</span> <span class='st'>"Klebsiella"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"R"</span><span class='op'>)</span>
<span class='fu'><a href='eucast_rules.html'>eucast_rules</a></span><span class='op'>(</span><span class='va'>df</span>, rules <span class='op'>=</span> <span class='st'>"custom"</span>, custom_rules <span class='op'>=</span> <span class='va'>y</span><span class='op'>)</span>
<span class='co'>#&gt; mo TZP amox AMP</span>
<span class='co'>#&gt; 1 E. coli R </span>
<span class='co'>#&gt; 2 K. pneumoniae R R R</span>
</code></pre>
</pre>
<h3 class='hasAnchor' id='usage-of-antibiotic-group-names'><a class='anchor' aria-hidden='true' href='#usage-of-antibiotic-group-names'></a>Usage of antibiotic group names</h3>
<h3 class='hasAnchor' id='arguments'><a class='anchor' href='#arguments'></a>Usage of antibiotic group names</h3>
<p>It is possible to define antibiotic groups instead of single antibiotics for the rule consequence, the part <em>after</em> the tilde. In above examples, the antibiotic group <code>aminopenicillins</code> is used to include ampicillin and amoxicillin. The following groups are allowed (case-insensitive). Within parentheses are the agents that will be matched when running the rule.</p><ul>
@ -348,12 +340,13 @@
</ul>
<h2 class="hasAnchor" id="maturing-lifecycle"><a class="anchor" href="#maturing-lifecycle"></a>Maturing Lifecycle</h2>
<h2 class="hasAnchor" id="stable-lifecycle"><a class="anchor" href="#stable-lifecycle"></a>Stable Lifecycle</h2>
<p><img src='figures/lifecycle_maturing.svg' style=margin-bottom:5px /> <br />
The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing</strong>. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome <a href='https://github.com/msberends/AMR/issues'>to suggest changes at our repository</a> or <a href='AMR.html'>write us an email (see section 'Contact Us')</a>.</p>
<p><img src='figures/lifecycle_stable.svg' style=margin-bottom:5px /> <br />
The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</strong>. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.</p>
<p>If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.</p>
<h2 class="hasAnchor" id="read-more-on-our-website-"><a class="anchor" href="#read-more-on-our-website-"></a>Read more on Our Website!</h2>
@ -361,7 +354,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
<p>On our website <a href='https://msberends.github.io/AMR/'>https://msberends.github.io/AMR/</a> you can find <a href='https://msberends.github.io/AMR/articles/AMR.html'>a comprehensive tutorial</a> about how to conduct AMR data analysis, the <a href='https://msberends.github.io/AMR/reference/'>complete documentation of all functions</a> and <a href='https://msberends.github.io/AMR/articles/WHONET.html'>an example analysis using WHONET data</a>.</p>
<h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2>
<div class="ref-examples sourceCode"><pre class='sourceCode r'><code><span class='va'>x</span> <span class='op'>&lt;-</span> <span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>AMC</span> <span class='op'>==</span> <span class='st'>"R"</span> <span class='op'>&amp;</span> <span class='va'>genus</span> <span class='op'>==</span> <span class='st'>"Klebsiella"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"R"</span>,
<pre class="examples"><span class='va'>x</span> <span class='op'>&lt;-</span> <span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>AMC</span> <span class='op'>==</span> <span class='st'>"R"</span> <span class='op'>&amp;</span> <span class='va'>genus</span> <span class='op'>==</span> <span class='st'>"Klebsiella"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"R"</span>,
<span class='va'>AMC</span> <span class='op'>==</span> <span class='st'>"I"</span> <span class='op'>&amp;</span> <span class='va'>genus</span> <span class='op'>==</span> <span class='st'>"Klebsiella"</span> <span class='op'>~</span> <span class='va'>aminopenicillins</span> <span class='op'>==</span> <span class='st'>"I"</span><span class='op'>)</span>
<span class='fu'><a href='eucast_rules.html'>eucast_rules</a></span><span class='op'>(</span><span class='va'>example_isolates</span>,
rules <span class='op'>=</span> <span class='st'>"custom"</span>,
@ -372,7 +365,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
<span class='va'>x2</span> <span class='op'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='va'>x</span>,
<span class='fu'>custom_eucast_rules</span><span class='op'>(</span><span class='va'>TZP</span> <span class='op'>==</span> <span class='st'>"R"</span> <span class='op'>~</span> <span class='va'>carbapenems</span> <span class='op'>==</span> <span class='st'>"R"</span><span class='op'>)</span><span class='op'>)</span>
<span class='va'>x2</span>
</code></pre></div>
</pre>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="pkgdown-sidebar">
<nav id="toc" data-toggle="toc" class="sticky-top">
@ -384,11 +377,11 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
<footer>
<div class="copyright">
<p><p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p></p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -397,8 +390,6 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
</body>
</html>

View File

@ -86,7 +86,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied
</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.7.1.9053</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -247,7 +247,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied
rules <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/options.html'>getOption</a></span><span class='op'>(</span><span class='st'>"AMR_eucastrules"</span>, default <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"breakpoints"</span>, <span class='st'>"expert"</span><span class='op'>)</span><span class='op'>)</span>,
verbose <span class='op'>=</span> <span class='cn'>FALSE</span>,
version_breakpoints <span class='op'>=</span> <span class='fl'>11</span>,
version_expertrules <span class='op'>=</span> <span class='fl'>3.2</span>,
version_expertrules <span class='op'>=</span> <span class='fl'>3.3</span>,
ampc_cephalosporin_resistance <span class='op'>=</span> <span class='cn'>NA</span>,
only_rsi_columns <span class='op'>=</span> <span class='cn'>FALSE</span>,
custom_rules <span class='op'>=</span> <span class='cn'>NULL</span>,
@ -285,7 +285,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied
</tr>
<tr>
<th>version_expertrules</th>
<td><p>the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either "3.2" or "3.1".</p></td>
<td><p>the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either "3.3", "3.2" or "3.1".</p></td>
</tr>
<tr>
<th>ampc_cephalosporin_resistance</th>
@ -321,6 +321,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied
Leclercq et al. <strong>EUCAST expert rules in antimicrobial susceptibility testing.</strong> <em>Clin Microbiol Infect.</em> 2013;19(2):141-60; doi: <a href='https://doi.org/10.1111/j.1469-0691.2011.03703.x'>10.1111/j.1469-0691.2011.03703.x</a></p></li>
<li><p>EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. <a href='https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf'>(link)</a></p></li>
<li><p>EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.2, 2020. <a href='https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf'>(link)</a></p></li>
<li><p>EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.3, 2021. <a href='https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2021/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.3_20211018.pdf'>(link)</a></p></li>
<li><p>EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 9.0, 2019. <a href='https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_9.0_Breakpoint_Tables.xlsx'>(link)</a></p></li>
<li><p>EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 10.0, 2020. <a href='https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_10.0_Breakpoint_Tables.xlsx'>(link)</a></p></li>
<li><p>EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. <a href='https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx'>(link)</a></p></li>
@ -434,7 +435,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
<footer>
<div class="copyright">
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Dennis Souverein, Erwin E. A. Hassing, Christian F. Luz.</p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">

View File

@ -84,7 +84,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.7.1.9053</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -322,19 +322,19 @@
<tr>
<td>
<p><code><a href="as.rsi.html">as.rsi()</a></code> <code><a href="as.rsi.html">is.rsi()</a></code> <code><a href="as.rsi.html">is.rsi.eligible()</a></code> </p>
<p><code><a href="as.rsi.html">as.rsi()</a></code> <code><a href="as.rsi.html">NA_rsi_</a></code> <code><a href="as.rsi.html">is.rsi()</a></code> <code><a href="as.rsi.html">is.rsi.eligible()</a></code> </p>
</td>
<td><p>Interpret MIC and Disk Values, or Clean Raw R/SI Data</p></td>
</tr><tr>
<td>
<p><code><a href="as.mic.html">as.mic()</a></code> <code><a href="as.mic.html">is.mic()</a></code> </p>
<p><code><a href="as.mic.html">as.mic()</a></code> <code><a href="as.mic.html">NA_mic_</a></code> <code><a href="as.mic.html">is.mic()</a></code> </p>
</td>
<td><p>Transform Input to Minimum Inhibitory Concentrations (MIC)</p></td>
</tr><tr>
<td>
<p><code><a href="as.disk.html">as.disk()</a></code> <code><a href="as.disk.html">is.disk()</a></code> </p>
<p><code><a href="as.disk.html">as.disk()</a></code> <code><a href="as.disk.html">NA_disk_</a></code> <code><a href="as.disk.html">is.disk()</a></code> </p>
</td>
<td><p>Transform Input to Disk Diffusion Diameters</p></td>
</tr><tr>
@ -681,7 +681,7 @@
<footer>
<div class="copyright">
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Dennis Souverein, Erwin E. A. Hassing, Christian F. Luz.</p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">

View File

@ -58,8 +58,6 @@
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@ -71,15 +69,9 @@
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-reference-topic">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
@ -93,7 +85,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.7.1.9040</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -238,7 +230,7 @@
<div class="col-md-9 contents">
<div class="page-header">
<h1>Italicise Taxonomic Families, Genera, Species, Subspecies</h1>
<small class="dont-index">Source: <a href='https://github.com/msberends/AMR/blob/main/R/italicise_taxonomy.R'><code>R/italicise_taxonomy.R</code></a></small>
<small class="dont-index">Source: <a href='https://github.com/msberends/AMR/blob/master/R/italicise_taxonomy.R'><code>R/italicise_taxonomy.R</code></a></small>
<div class="hidden name"><code>italicise_taxonomy.Rd</code></div>
</div>
@ -246,9 +238,9 @@
<p>According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italic. This function finds taxonomic names within strings and makes them italic.</p>
</div>
<div class="ref-usage sourceCode"><pre class='sourceCode r'><code><span class='fu'>italicise_taxonomy</span><span class='op'>(</span><span class='va'>string</span>, type <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"markdown"</span>, <span class='st'>"ansi"</span><span class='op'>)</span><span class='op'>)</span>
<pre class="usage"><span class='fu'>italicise_taxonomy</span><span class='op'>(</span><span class='va'>string</span>, type <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"markdown"</span>, <span class='st'>"ansi"</span><span class='op'>)</span><span class='op'>)</span>
<span class='fu'>italicize_taxonomy</span><span class='op'>(</span><span class='va'>string</span>, type <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"markdown"</span>, <span class='st'>"ansi"</span><span class='op'>)</span><span class='op'>)</span></code></pre></div>
<span class='fu'>italicize_taxonomy</span><span class='op'>(</span><span class='va'>string</span>, type <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span><span class='op'>(</span><span class='st'>"markdown"</span>, <span class='st'>"ansi"</span><span class='op'>)</span><span class='op'>)</span></pre>
<h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
<table class="ref-arguments">
@ -268,12 +260,13 @@
<p>This function finds the taxonomic names and makes them italic based on the <a href='microorganisms.html'>microorganisms</a> data set.</p>
<p>The taxonomic names can be italicised using markdown (the default) by adding <code><a href='https://rdrr.io/r/base/Arithmetic.html'>*</a></code> before and after the taxonomic names, or using ANSI colours by adding <code>\033[3m</code> before and <code>\033[23m</code> after the taxonomic names. If multiple ANSI colours are not available, no conversion will occur.</p>
<p>This function also supports abbreviation of the genus if it is followed by a species, such as "E. coli" and "K. pneumoniae ozaenae".</p>
<h2 class="hasAnchor" id="maturing-lifecycle"><a class="anchor" href="#maturing-lifecycle"></a>Maturing Lifecycle</h2>
<h2 class="hasAnchor" id="stable-lifecycle"><a class="anchor" href="#stable-lifecycle"></a>Stable Lifecycle</h2>
<p><img src='figures/lifecycle_maturing.svg' style=margin-bottom:5px /> <br />
The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing</strong>. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome <a href='https://github.com/msberends/AMR/issues'>to suggest changes at our repository</a> or <a href='AMR.html'>write us an email (see section 'Contact Us')</a>.</p>
<p><img src='figures/lifecycle_stable.svg' style=margin-bottom:5px /> <br />
The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</strong>. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.</p>
<p>If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.</p>
<h2 class="hasAnchor" id="read-more-on-our-website-"><a class="anchor" href="#read-more-on-our-website-"></a>Read more on Our Website!</h2>
@ -281,7 +274,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
<p>On our website <a href='https://msberends.github.io/AMR/'>https://msberends.github.io/AMR/</a> you can find <a href='https://msberends.github.io/AMR/articles/AMR.html'>a comprehensive tutorial</a> about how to conduct AMR data analysis, the <a href='https://msberends.github.io/AMR/reference/'>complete documentation of all functions</a> and <a href='https://msberends.github.io/AMR/articles/WHONET.html'>an example analysis using WHONET data</a>.</p>
<h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2>
<div class="ref-examples sourceCode"><pre class='sourceCode r'><code><span class='fu'>italicise_taxonomy</span><span class='op'>(</span><span class='st'>"An overview of Staphylococcus aureus isolates"</span><span class='op'>)</span>
<pre class="examples"><span class='fu'>italicise_taxonomy</span><span class='op'>(</span><span class='st'>"An overview of Staphylococcus aureus isolates"</span><span class='op'>)</span>
<span class='fu'>italicise_taxonomy</span><span class='op'>(</span><span class='st'>"An overview of S. aureus isolates"</span><span class='op'>)</span>
<span class='fu'><a href='https://rdrr.io/r/base/cat.html'>cat</a></span><span class='op'>(</span><span class='fu'>italicise_taxonomy</span><span class='op'>(</span><span class='st'>"An overview of S. aureus isolates"</span>, type <span class='op'>=</span> <span class='st'>"ansi"</span><span class='op'>)</span><span class='op'>)</span>
@ -295,7 +288,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/theme.html'>theme</a></span><span class='op'>(</span>plot.title <span class='op'>=</span> <span class='fu'>ggtext</span><span class='fu'>::</span><span class='fu'><a href='https://wilkelab.org/ggtext/reference/element_markdown.html'>element_markdown</a></span><span class='op'>(</span><span class='op'>)</span><span class='op'>)</span>
<span class='op'>}</span>
<span class='co'># }</span>
</code></pre></div>
</pre>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="pkgdown-sidebar">
<nav id="toc" data-toggle="toc" class="sticky-top">
@ -307,11 +300,11 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
<footer>
<div class="copyright">
<p><p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p></p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -320,8 +313,6 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
</body>
</html>

View File

@ -85,7 +85,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.7.1.9053</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -254,7 +254,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for mic</span>
<span class='fu'>autoplot</span><span class='op'>(</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/autoplot.html'>autoplot</a></span><span class='op'>(</span>
<span class='va'>object</span>,
mo <span class='op'>=</span> <span class='cn'>NULL</span>,
ab <span class='op'>=</span> <span class='cn'>NULL</span>,
@ -269,7 +269,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for mic</span>
<span class='fu'>fortify</span><span class='op'>(</span><span class='va'>object</span>, <span class='va'>...</span><span class='op'>)</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/fortify.html'>fortify</a></span><span class='op'>(</span><span class='va'>object</span>, <span class='va'>...</span><span class='op'>)</span>
<span class='co'># S3 method for disk</span>
<span class='fu'>plot</span><span class='op'>(</span>
@ -287,7 +287,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for disk</span>
<span class='fu'>autoplot</span><span class='op'>(</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/autoplot.html'>autoplot</a></span><span class='op'>(</span>
<span class='va'>object</span>,
mo <span class='op'>=</span> <span class='cn'>NULL</span>,
ab <span class='op'>=</span> <span class='cn'>NULL</span>,
@ -302,7 +302,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for disk</span>
<span class='fu'>fortify</span><span class='op'>(</span><span class='va'>object</span>, <span class='va'>...</span><span class='op'>)</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/fortify.html'>fortify</a></span><span class='op'>(</span><span class='va'>object</span>, <span class='va'>...</span><span class='op'>)</span>
<span class='co'># S3 method for rsi</span>
<span class='fu'>plot</span><span class='op'>(</span>
@ -314,7 +314,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for rsi</span>
<span class='fu'>autoplot</span><span class='op'>(</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/autoplot.html'>autoplot</a></span><span class='op'>(</span>
<span class='va'>object</span>,
title <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/paste.html'>paste</a></span><span class='op'>(</span><span class='st'>"Resistance Overview of"</span>, <span class='fu'><a href='https://rdrr.io/r/base/deparse.html'>deparse</a></span><span class='op'>(</span><span class='fu'><a href='https://rdrr.io/r/base/substitute.html'>substitute</a></span><span class='op'>(</span><span class='va'>object</span><span class='op'>)</span><span class='op'>)</span><span class='op'>)</span>,
xlab <span class='op'>=</span> <span class='st'>"Antimicrobial Interpretation"</span>,
@ -325,7 +325,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for rsi</span>
<span class='fu'>fortify</span><span class='op'>(</span><span class='va'>object</span>, <span class='va'>...</span><span class='op'>)</span></pre>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/fortify.html'>fortify</a></span><span class='op'>(</span><span class='va'>object</span>, <span class='va'>...</span><span class='op'>)</span></pre>
<h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
<table class="ref-arguments">
@ -381,12 +381,13 @@
<p>The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases.</p>
<p>For interpreting MIC values as well as disk diffusion diameters, supported guidelines to be used as input for the <code>guideline</code> argument are: "EUCAST 2021", "EUCAST 2020", "EUCAST 2019", "EUCAST 2018", "EUCAST 2017", "EUCAST 2016", "EUCAST 2015", "EUCAST 2014", "EUCAST 2013", "EUCAST 2012", "EUCAST 2011", "CLSI 2020", "CLSI 2019", "CLSI 2018", "CLSI 2017", "CLSI 2016", "CLSI 2015", "CLSI 2014", "CLSI 2013", "CLSI 2012", "CLSI 2011" and "CLSI 2010".</p>
<p>Simply using <code>"CLSI"</code> or <code>"EUCAST"</code> as input will automatically select the latest version of that guideline.</p>
<h2 class="hasAnchor" id="maturing-lifecycle"><a class="anchor" href="#maturing-lifecycle"></a>Maturing Lifecycle</h2>
<h2 class="hasAnchor" id="stable-lifecycle"><a class="anchor" href="#stable-lifecycle"></a>Stable Lifecycle</h2>
<p><img src='figures/lifecycle_maturing.svg' style=margin-bottom:5px /> <br />
The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing</strong>. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome <a href='https://github.com/msberends/AMR/issues'>to suggest changes at our repository</a> or <a href='AMR.html'>write us an email (see section 'Contact Us')</a>.</p>
<p><img src='figures/lifecycle_stable.svg' style=margin-bottom:5px /> <br />
The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</strong>. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.</p>
<p>If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.</p>
<h2 class="hasAnchor" id="read-more-on-our-website-"><a class="anchor" href="#read-more-on-our-website-"></a>Read more on Our Website!</h2>
@ -425,7 +426,7 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>maturing<
<footer>
<div class="copyright">
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Dennis Souverein, Erwin E. A. Hassing, Christian F. Luz.</p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">

View File

@ -1,219 +1,198 @@
<?xml version="1.0" encoding="UTF-8"?>
<urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9">
<url>
<loc>https://msberends.github.io/AMR/404.html</loc>
<loc>https://msberends.github.io/AMR//index.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/LICENSE-text.html</loc>
<loc>https://msberends.github.io/AMR//reference/AMR-deprecated.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/AMR.html</loc>
<loc>https://msberends.github.io/AMR//reference/AMR.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/EUCAST.html</loc>
<loc>https://msberends.github.io/AMR//reference/WHOCC.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/MDR.html</loc>
<loc>https://msberends.github.io/AMR//reference/WHONET.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/PCA.html</loc>
<loc>https://msberends.github.io/AMR//reference/ab_from_text.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/SPSS.html</loc>
<loc>https://msberends.github.io/AMR//reference/ab_property.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/WHONET.html</loc>
<loc>https://msberends.github.io/AMR//reference/age.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/benchmarks.html</loc>
<loc>https://msberends.github.io/AMR//reference/age_groups.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/datasets.html</loc>
<loc>https://msberends.github.io/AMR//reference/antibiotic_class_selectors.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/index.html</loc>
<loc>https://msberends.github.io/AMR//reference/antibiotics.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/resistance_predict.html</loc>
<loc>https://msberends.github.io/AMR//reference/as.ab.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/articles/welcome_to_AMR.html</loc>
<loc>https://msberends.github.io/AMR//reference/as.disk.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/authors.html</loc>
<loc>https://msberends.github.io/AMR//reference/as.mic.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/index.html</loc>
<loc>https://msberends.github.io/AMR//reference/as.mo.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/news/index.html</loc>
<loc>https://msberends.github.io/AMR//reference/as.rsi.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/AMR-deprecated.html</loc>
<loc>https://msberends.github.io/AMR//reference/atc_online.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/AMR.html</loc>
<loc>https://msberends.github.io/AMR//reference/availability.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/WHOCC.html</loc>
<loc>https://msberends.github.io/AMR//reference/bug_drug_combinations.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/WHONET.html</loc>
<loc>https://msberends.github.io/AMR//reference/catalogue_of_life.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/ab_from_text.html</loc>
<loc>https://msberends.github.io/AMR//reference/catalogue_of_life_version.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/ab_property.html</loc>
<loc>https://msberends.github.io/AMR//reference/count.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/age.html</loc>
<loc>https://msberends.github.io/AMR//reference/custom_eucast_rules.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/age_groups.html</loc>
<loc>https://msberends.github.io/AMR//reference/dosage.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/antibiotic_class_selectors.html</loc>
<loc>https://msberends.github.io/AMR//reference/eucast_rules.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/antibiotics.html</loc>
<loc>https://msberends.github.io/AMR//reference/example_isolates.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/as.ab.html</loc>
<loc>https://msberends.github.io/AMR//reference/example_isolates_unclean.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/as.disk.html</loc>
<loc>https://msberends.github.io/AMR//reference/first_isolate.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/as.mic.html</loc>
<loc>https://msberends.github.io/AMR//reference/g.test.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/as.mo.html</loc>
<loc>https://msberends.github.io/AMR//reference/get_episode.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/as.rsi.html</loc>
<loc>https://msberends.github.io/AMR//reference/ggplot_pca.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/atc_online.html</loc>
<loc>https://msberends.github.io/AMR//reference/ggplot_rsi.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/availability.html</loc>
<loc>https://msberends.github.io/AMR//reference/guess_ab_col.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/bug_drug_combinations.html</loc>
<loc>https://msberends.github.io/AMR//reference/intrinsic_resistant.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/catalogue_of_life.html</loc>
<loc>https://msberends.github.io/AMR//reference/italicise_taxonomy.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/catalogue_of_life_version.html</loc>
<loc>https://msberends.github.io/AMR//reference/join.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/count.html</loc>
<loc>https://msberends.github.io/AMR//reference/key_antimicrobials.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/custom_eucast_rules.html</loc>
<loc>https://msberends.github.io/AMR//reference/kurtosis.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/dosage.html</loc>
<loc>https://msberends.github.io/AMR//reference/lifecycle.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/eucast_rules.html</loc>
<loc>https://msberends.github.io/AMR//reference/like.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/example_isolates.html</loc>
<loc>https://msberends.github.io/AMR//reference/mdro.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/example_isolates_unclean.html</loc>
<loc>https://msberends.github.io/AMR//reference/microorganisms.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/first_isolate.html</loc>
<loc>https://msberends.github.io/AMR//reference/microorganisms.codes.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/g.test.html</loc>
<loc>https://msberends.github.io/AMR//reference/microorganisms.old.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/get_episode.html</loc>
<loc>https://msberends.github.io/AMR//reference/mo_matching_score.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/ggplot_pca.html</loc>
<loc>https://msberends.github.io/AMR//reference/mo_property.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/ggplot_rsi.html</loc>
<loc>https://msberends.github.io/AMR//reference/mo_source.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/guess_ab_col.html</loc>
<loc>https://msberends.github.io/AMR//reference/pca.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/index.html</loc>
<loc>https://msberends.github.io/AMR//reference/plot.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/intrinsic_resistant.html</loc>
<loc>https://msberends.github.io/AMR//reference/proportion.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/italicise_taxonomy.html</loc>
<loc>https://msberends.github.io/AMR//reference/random.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/join.html</loc>
<loc>https://msberends.github.io/AMR//reference/resistance_predict.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/key_antimicrobials.html</loc>
<loc>https://msberends.github.io/AMR//reference/rsi_translation.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/kurtosis.html</loc>
<loc>https://msberends.github.io/AMR//reference/skewness.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/lifecycle.html</loc>
<loc>https://msberends.github.io/AMR//reference/translate.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/like.html</loc>
<loc>https://msberends.github.io/AMR//articles/AMR.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/mdro.html</loc>
<loc>https://msberends.github.io/AMR//articles/EUCAST.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/microorganisms.codes.html</loc>
<loc>https://msberends.github.io/AMR//articles/MDR.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/microorganisms.html</loc>
<loc>https://msberends.github.io/AMR//articles/PCA.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/microorganisms.old.html</loc>
<loc>https://msberends.github.io/AMR//articles/SPSS.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/mo_matching_score.html</loc>
<loc>https://msberends.github.io/AMR//articles/WHONET.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/mo_property.html</loc>
<loc>https://msberends.github.io/AMR//articles/benchmarks.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/mo_source.html</loc>
<loc>https://msberends.github.io/AMR//articles/datasets.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/pca.html</loc>
<loc>https://msberends.github.io/AMR//articles/resistance_predict.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/plot.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/proportion.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/random.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/resistance_predict.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/rsi_translation.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/skewness.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/reference/translate.html</loc>
</url>
<url>
<loc>https://msberends.github.io/AMR/survey.html</loc>
<loc>https://msberends.github.io/AMR//articles/welcome_to_AMR.html</loc>
</url>
</urlset>

View File

@ -57,8 +57,6 @@
<!-- mathjax -->
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@ -70,15 +68,9 @@
</head>
<body data-spy="scroll" data-target="#toc">
<div class="container template-title-body">
<header>
<div class="navbar navbar-default navbar-fixed-top" role="navigation">
@ -92,7 +84,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.7.1.9051</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.7.1.9054</span>
</span>
</div>
@ -255,11 +247,11 @@
<footer>
<div class="copyright">
<p><p>Developed by <a href="https://www.rug.nl/staff/m.s.berends/" class="external-link">Matthijs S. Berends</a>, Christian F. Luz.</p></p>
<p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, Christian F. Luz, Dennis Souverein, Erwin E. A. Hassing.</p>
</div>
<div class="pkgdown">
<p><p>Site built with <a href="https://pkgdown.r-lib.org/" class="external-link">pkgdown</a> 1.6.1.9001.</p></p>
<p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.6.1.</p>
</div>
</footer>
@ -268,8 +260,6 @@
</body>
</html>

View File

@ -1,20 +1,20 @@
# `AMR` (for R) <img src="./logo.png" align="right" height="120px" />
> This package formed the basis of two PhD theses, of which the first was published and defended on 25 August 2021. Click here to read it: [DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131).
> Update: The latest EUCAST guideline for intrinsic resistance (v3.3, October 2021) is now supported, and our taxonomy tables has been updated as well (5 October 2021).
### What is `AMR` (for R)?
`AMR` is a free, open-source and independent [R package](https://www.r-project.org) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
`AMR` is a free, open-source and independent [R package](https://www.r-project.org) (see [Copyright](#copyright)) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
After installing this package, R knows [**~71,000 distinct microbial species**](./reference/microorganisms.html) and all [**~560 antibiotic, antimycotic and antiviral drugs**](./reference/antibiotics.html) by name and code (including ATC, EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data. Antimicrobial names and group names are available in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish.
This package is [fully independent of any other R package](https://en.wikipedia.org/wiki/Dependency_hell) and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl). This R package is [actively maintained](./news) and is free software (see [Copyright](#copyright)).
This package is [fully independent of any other R package](https://en.wikipedia.org/wiki/Dependency_hell) and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl). This R package formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.192486375)) but is [actively and durably maintained](./news) by two public healthcare organisations in the Netherlands.
<div class="main-content" style="display: inline-block;">
<p>
<a href="./countries_large.png" target="_blank"><img src="./countries.png" class="countries_map"></a>
<strong>Used in 162 countries</strong><br>
Since its first public release in early 2018, this package has been downloaded from 162 countries. Click the map to enlarge and to see the country names.</p>
<strong>Used in 175 countries</strong><br>
Since its first public release in early 2018, this R package has been used in almost all countries in the world. Click the map to enlarge and to see the country names.</p>
</div>
##### With `AMR` (for R), there's always a knowledgeable microbiologist by your side!

View File

@ -8,9 +8,10 @@ citEntry(
journal = "Journal of Statistical Software",
pages = "Accepted for publication",
year = 2021,
url = "https://www.biorxiv.org/content/10.1101/810622v4",
url = "https://www.biorxiv.org/content/10.1101/810622",
textVersion = "Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C (2021). AMR - An R Package for Working with
Antimicrobial Resistance Data. Journal of Statistical Software (accepted for publication), https://www.biorxiv.org/content/10.1101/810622v4.")
Antimicrobial Resistance Data. Journal of Statistical Software (accepted for publication), https://www.biorxiv.org/content/10.1101/810622, doi: 10.1101/810622."
)
citEntry(
entry = "PhdThesis",
@ -19,7 +20,19 @@ citEntry(
publisher = "University of Groningen",
school = "University of Groningen",
doi = "10.33612/diss.177417131",
pages = 288,
pages = 287,
year = 2021,
textVersion = "Berends, MS (2021). A New Instrument for Microbial Epidemiology: Empowering Antimicrobial Resistance Data Analysis (PhD thesis). University of Groningen, doi: 10.33612/diss.177417131."
)
citEntry(
entry = "PhdThesis",
title = "Data Science for Infection Management & Antimicrobial Stewardship",
author = "C F Luz",
publisher = "University of Groningen",
school = "University of Groningen",
doi = "10.33612/diss.192486375",
pages = 326,
year = 2021,
textVersion = "Luz, CF (2021). Data Science for Infection Management & Antimicrobial Stewardship (PhD thesis). University of Groningen, doi: 10.33612/diss.192486375."
)

View File

@ -1,13 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/disk.R
\docType{data}
\name{as.disk}
\alias{as.disk}
\alias{disk}
\alias{NA_disk_}
\alias{is.disk}
\title{Transform Input to Disk Diffusion Diameters}
\format{
An object of class \code{disk} (inherits from \code{integer}) of length 1.
}
\usage{
as.disk(x, na.rm = FALSE)
NA_disk_
is.disk(x)
}
\arguments{
@ -23,6 +30,8 @@ This transforms a vector to a new class \code{\link{disk}}, which is a disk diff
}
\details{
Interpret disk values as RSI values with \code{\link[=as.rsi]{as.rsi()}}. It supports guidelines from EUCAST and CLSI.
\code{NA_disk_} is a missing value of the new \verb{<disk>} class.
}
\section{Stable Lifecycle}{
@ -61,3 +70,4 @@ as.rsi(df)
\seealso{
\code{\link[=as.rsi]{as.rsi()}}
}
\keyword{datasets}

View File

@ -1,13 +1,20 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/mic.R
\docType{data}
\name{as.mic}
\alias{as.mic}
\alias{mic}
\alias{NA_mic_}
\alias{is.mic}
\title{Transform Input to Minimum Inhibitory Concentrations (MIC)}
\format{
An object of class \code{mic} (inherits from \code{ordered}, \code{factor}) of length 1.
}
\usage{
as.mic(x, na.rm = FALSE)
NA_mic_
is.mic(x)
}
\arguments{
@ -19,7 +26,7 @@ is.mic(x)
Ordered \link{factor} with additional class \code{\link{mic}}, that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a \link{numeric} value.
}
\description{
This ransforms vectors to a new class \code{\link{mic}}, which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
This transforms vectors to a new class \code{\link{mic}}, which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
}
\details{
To interpret MIC values as RSI values, use \code{\link[=as.rsi]{as.rsi()}} on MIC values. It supports guidelines from EUCAST and CLSI.
@ -55,6 +62,8 @@ subset(df, x > 4) # or with dplyr: df \%>\% filter(x > 4)
}
The following \link[=groupGeneric]{generic functions} are implemented for the MIC class: \code{!}, \code{!=}, \code{\%\%}, \code{\%/\%}, \code{&}, \code{*}, \code{+}, \code{-}, \code{/}, \code{<}, \code{<=}, \code{==}, \code{>}, \code{>=}, \code{^}, \code{|}, \code{\link[=abs]{abs()}}, \code{\link[=acos]{acos()}}, \code{\link[=acosh]{acosh()}}, \code{\link[=all]{all()}}, \code{\link[=any]{any()}}, \code{\link[=asin]{asin()}}, \code{\link[=asinh]{asinh()}}, \code{\link[=atan]{atan()}}, \code{\link[=atanh]{atanh()}}, \code{\link[=ceiling]{ceiling()}}, \code{\link[=cos]{cos()}}, \code{\link[=cosh]{cosh()}}, \code{\link[=cospi]{cospi()}}, \code{\link[=cummax]{cummax()}}, \code{\link[=cummin]{cummin()}}, \code{\link[=cumprod]{cumprod()}}, \code{\link[=cumsum]{cumsum()}}, \code{\link[=digamma]{digamma()}}, \code{\link[=exp]{exp()}}, \code{\link[=expm1]{expm1()}}, \code{\link[=floor]{floor()}}, \code{\link[=gamma]{gamma()}}, \code{\link[=lgamma]{lgamma()}}, \code{\link[=log]{log()}}, \code{\link[=log1p]{log1p()}}, \code{\link[=log2]{log2()}}, \code{\link[=log10]{log10()}}, \code{\link[=max]{max()}}, \code{\link[=mean]{mean()}}, \code{\link[=min]{min()}}, \code{\link[=prod]{prod()}}, \code{\link[=range]{range()}}, \code{\link[=round]{round()}}, \code{\link[=sign]{sign()}}, \code{\link[=signif]{signif()}}, \code{\link[=sin]{sin()}}, \code{\link[=sinh]{sinh()}}, \code{\link[=sinpi]{sinpi()}}, \code{\link[=sqrt]{sqrt()}}, \code{\link[=sum]{sum()}}, \code{\link[=tan]{tan()}}, \code{\link[=tanh]{tanh()}}, \code{\link[=tanpi]{tanpi()}}, \code{\link[=trigamma]{trigamma()}} and \code{\link[=trunc]{trunc()}}. Some functions of the \code{stats} package are also implemented: \code{\link[=median]{median()}}, \code{\link[=quantile]{quantile()}}, \code{\link[=mad]{mad()}}, \code{\link[=IQR]{IQR()}}, \code{\link[=fivenum]{fivenum()}}. Also, \code{\link[=boxplot.stats]{boxplot.stats()}} is supported. Since \code{\link[=sd]{sd()}} and \code{\link[=var]{var()}} are non-generic functions, these could not be extended. Use \code{\link[=mad]{mad()}} as an alternative, or use e.g. \code{sd(as.numeric(x))} where \code{x} is your vector of MIC values.
\code{NA_mic_} is a missing value of the new \verb{<mic>} class.
}
\section{Stable Lifecycle}{
@ -98,3 +107,4 @@ plot(mic_data, mo = "E. coli", ab = "cipro")
\seealso{
\code{\link[=as.rsi]{as.rsi()}}
}
\keyword{datasets}

View File

@ -1,17 +1,24 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rsi.R
\docType{data}
\name{as.rsi}
\alias{as.rsi}
\alias{rsi}
\alias{NA_rsi_}
\alias{is.rsi}
\alias{is.rsi.eligible}
\alias{as.rsi.mic}
\alias{as.rsi.disk}
\alias{as.rsi.data.frame}
\title{Interpret MIC and Disk Values, or Clean Raw R/SI Data}
\format{
An object of class \code{rsi} (inherits from \code{ordered}, \code{factor}) of length 1.
}
\usage{
as.rsi(x, ...)
NA_rsi_
is.rsi(x)
is.rsi.eligible(x, threshold = 0.05)
@ -125,6 +132,8 @@ The function \code{\link[=is.rsi]{is.rsi()}} detects if the input contains class
The function \code{\link[=is.rsi.eligible]{is.rsi.eligible()}} returns \code{TRUE} when a columns contains at most 5\% invalid antimicrobial interpretations (not S and/or I and/or R), and \code{FALSE} otherwise. The threshold of 5\% can be set with the \code{threshold} argument. If the input is a \link{data.frame}, it iterates over all columns and returns a \link{logical} vector.
}
\code{NA_rsi_} is a missing value of the new \verb{<rsi>} class.
}
\section{Interpretation of R and S/I}{
@ -247,3 +256,4 @@ if (require("dplyr")) {
\seealso{
\code{\link[=as.mic]{as.mic()}}, \code{\link[=as.disk]{as.disk()}}, \code{\link[=as.mo]{as.mo()}}
}
\keyword{datasets}

View File

@ -100,10 +100,12 @@ It is possible to define antibiotic groups instead of single antibiotics for the
}
}
\section{Maturing Lifecycle}{
\section{Stable Lifecycle}{
\if{html}{\figure{lifecycle_maturing.svg}{options: style=margin-bottom:5px} \cr}
The \link[=lifecycle]{lifecycle} of this function is \strong{maturing}. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome \href{https://github.com/msberends/AMR/issues}{to suggest changes at our repository} or \link[=AMR]{write us an email (see section 'Contact Us')}.
\if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:5px} \cr}
The \link[=lifecycle]{lifecycle} of this function is \strong{stable}. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.
If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
}
\section{Read more on Our Website!}{

View File

@ -11,6 +11,7 @@
Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility testing.} \emph{Clin Microbiol Infect.} 2013;19(2):141-60; \doi{https://doi.org/10.1111/j.1469-0691.2011.03703.x}
\item EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. \href{https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}{(link)}
\item EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.2, 2020. \href{https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf}{(link)}
\item EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.3, 2021. \href{https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2021/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.3_20211018.pdf}{(link)}
\item EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 9.0, 2019. \href{https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_9.0_Breakpoint_Tables.xlsx}{(link)}
\item EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 10.0, 2020. \href{https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_10.0_Breakpoint_Tables.xlsx}{(link)}
\item EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. \href{https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx}{(link)}
@ -24,7 +25,7 @@ eucast_rules(
rules = getOption("AMR_eucastrules", default = c("breakpoints", "expert")),
verbose = FALSE,
version_breakpoints = 11,
version_expertrules = 3.2,
version_expertrules = 3.3,
ampc_cephalosporin_resistance = NA,
only_rsi_columns = FALSE,
custom_rules = NULL,
@ -46,7 +47,7 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 11)
\item{version_breakpoints}{the version number to use for the EUCAST Clinical Breakpoints guideline. Can be either "11.0" or "10.0".}
\item{version_expertrules}{the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either "3.2" or "3.1".}
\item{version_expertrules}{the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either "3.3", "3.2" or "3.1".}
\item{ampc_cephalosporin_resistance}{a \link{character} value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants, defaults to \code{NA}. Currently only works when \code{version_expertrules} is \code{3.2}; '\emph{EUCAST Expert Rules v3.2 on Enterobacterales}' states that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three agents. A value of \code{NA} (the default) for this argument will remove results for these three agents, while e.g. a value of \code{"R"} will make the results for these agents resistant. Use \code{NULL} or \code{FALSE} to not alter results for these three agents of AmpC de-repressed cephalosporin-resistant mutants. Using \code{TRUE} is equal to using \code{"R"}. \cr For \emph{EUCAST Expert Rules} v3.2, this rule applies to: \emph{Citrobacter braakii}, \emph{Citrobacter freundii}, \emph{Citrobacter gillenii}, \emph{Citrobacter murliniae}, \emph{Citrobacter rodenticum}, \emph{Citrobacter sedlakii}, \emph{Citrobacter werkmanii}, \emph{Citrobacter youngae}, \emph{Enterobacter}, \emph{Hafnia alvei}, \emph{Klebsiella aerogenes}, \emph{Morganella morganii}, \emph{Providencia} and \emph{Serratia}.}

View File

@ -24,10 +24,12 @@ The taxonomic names can be italicised using markdown (the default) by adding \co
This function also supports abbreviation of the genus if it is followed by a species, such as "E. coli" and "K. pneumoniae ozaenae".
}
\section{Maturing Lifecycle}{
\section{Stable Lifecycle}{
\if{html}{\figure{lifecycle_maturing.svg}{options: style=margin-bottom:5px} \cr}
The \link[=lifecycle]{lifecycle} of this function is \strong{maturing}. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome \href{https://github.com/msberends/AMR/issues}{to suggest changes at our repository} or \link[=AMR]{write us an email (see section 'Contact Us')}.
\if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:5px} \cr}
The \link[=lifecycle]{lifecycle} of this function is \strong{stable}. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.
If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
}
\section{Read more on Our Website!}{

View File

@ -129,10 +129,12 @@ For interpreting MIC values as well as disk diffusion diameters, supported guide
Simply using \code{"CLSI"} or \code{"EUCAST"} as input will automatically select the latest version of that guideline.
}
\section{Maturing Lifecycle}{
\section{Stable Lifecycle}{
\if{html}{\figure{lifecycle_maturing.svg}{options: style=margin-bottom:5px} \cr}
The \link[=lifecycle]{lifecycle} of this function is \strong{maturing}. The unlying code of a maturing function has been roughed out, but finer details might still change. Since this function needs wider usage and more extensive testing, you are very welcome \href{https://github.com/msberends/AMR/issues}{to suggest changes at our repository} or \link[=AMR]{write us an email (see section 'Contact Us')}.
\if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:5px} \cr}
The \link[=lifecycle]{lifecycle} of this function is \strong{stable}. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.
If the unlying code needs breaking changes, they will occur gradually. For example, a argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
}
\section{Read more on Our Website!}{

View File

@ -104,10 +104,7 @@ a pre[href], a pre[href]:hover, a pre[href]:focus {
/* syntax font */
pre, code {
font-family: 'Courier New', monospace;
font-size: 100% !important;
font-weight: bold;
/*background-color: #f4f4f4*/;
font-size: 95% !important;
}
pre code {
word-wrap: normal !important;

View File

@ -95,10 +95,12 @@ $(document).ready(function() {
function doct_tit(x) {
if (typeof(x) != "undefined") {
// authors
x = x.replace(/Author, maintainer/g, "Main developer");
x = x.replace(/Author, contributor/g, "Main contributor");
x = x.replace(/Author, maintainer/g, "Maintainer");
x = x.replace(/Author, contributor/g, "Maintainer");
x = x.replace(/Author, thesis advisor/g, "Doctoral advisor");
x = x.replace(/Thesis advisor/g, "Doctoral advisor");
x = x.replace("Matthijs", "Dr. Matthijs");
x = x.replace("Christian", "Dr. Christian");
x = x.replace("Alex", "Prof. Alex");
x = x.replace("Bhanu", "Prof. Bhanu");
x = x.replace("Casper", "Prof. Casper");

Binary file not shown.

Before

Width:  |  Height:  |  Size: 60 KiB

After

Width:  |  Height:  |  Size: 78 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.4 MiB

After

Width:  |  Height:  |  Size: 1.2 MiB

View File

@ -22,13 +22,13 @@ knitr::opts_chunk$set(
)
```
Note: to keep the package as small as possible, we only included this vignette. You can read more vignettes on our website about how to conduct AMR data analysis, determine MDRO's, find explanation of EUCAST rules, and much more: <https://msberends.github.io/AMR/articles/>.
Note: to keep the package size as small as possible, we only included this vignette on CRAN. You can read more vignettes on our website about how to conduct AMR data analysis, determine MDRO's, find explanation of EUCAST rules, and much more: <https://msberends.github.io/AMR/articles/>.
----
`AMR` is a free, open-source and independent R package to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
`AMR` is a free, open-source and independent R package (see [Copyright](https://msberends.github.io/AMR/#copyright)) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
After installing this package, R knows `r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species and all `r AMR:::format_included_data_number(rbind(AMR::antibiotics[, "atc", drop = FALSE], AMR::antivirals[, "atc", drop = FALSE]))` antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
After installing this package, R knows `r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species and all `r AMR:::format_included_data_number(rbind(AMR::antibiotics[, "atc", drop = FALSE], AMR::antivirals[, "atc", drop = FALSE]))` antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data. Antimicrobial names and group names are available in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish.
This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. Since its first public release in early 2018, this package has been downloaded from more than 160 countries.
@ -53,4 +53,4 @@ This package can be used for:
All reference data sets (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) in this `AMR` package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find [all download links on our website](https://msberends.github.io/AMR/articles/datasets.html), which is automatically updated with every code change.
The package was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the University of Groningen, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice and University Medical Center Groningen. This R package is actively maintained (see [Changelog](https://msberends.github.io/AMR/news/index.html)) and is free software (see [Copyright](https://msberends.github.io/AMR/#copyright)).
This R package was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl). This R package formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.192486375)) but is actively and durably maintained (see [changelog)](https://msberends.github.io/AMR/news/index.html)) by two public healthcare organisations in the Netherlands.