diff --git a/DESCRIPTION b/DESCRIPTION index 0742135d..a9b2cae7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.2.0.9010 -Date: 2020-06-17 +Version: 1.2.0.9011 +Date: 2020-06-22 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index f67f79f0..2f1ebb79 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -156,6 +156,7 @@ export(mdr_tb) export(mdro) export(mo_authors) export(mo_class) +export(mo_domain) export(mo_failures) export(mo_family) export(mo_fullname) diff --git a/NEWS.md b/NEWS.md index 273753ee..c2b595a2 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,12 @@ -# AMR 1.2.0.9010 -## Last updated: 17-Jun-2020 +# AMR 1.2.0.9011 +## Last updated: 22-Jun-2020 ### New -* [Tidyverse selections](https://tidyselect.r-lib.org/reference/language.html), that help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. They can be used in any function that allows Tidyverse selections, like `dplyr::select()` and `tidyr::pivot_longer()`: +* [Tidyverse selections](https://tidyselect.r-lib.org/reference/language.html) for antibiotic classes, that help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. They can be used in any function that allows Tidyverse selections, like `dplyr::select()` and `tidyr::pivot_longer()`: ```r library(dplyr) + # Columns 'IPM' and 'MEM' are in the example_isolates data set example_isolates %>% select(carbapenems()) #> Selecting carbapenems: `IPM` (imipenem), `MEM` (meropenem) @@ -19,17 +20,20 @@ select(ab_class("mycobact")) #> Selecting antimycobacterials: `RIF` (rifampicin) ``` +* Added `mo_domain()` as an alias to `mo_kingdom()` +* Added function `filter_penicillins()` to filter isolates on a specific result in any column with a name in the antimicrobial 'penicillins' class (more specific: ATC subgroup *Beta-lactam antibacterials, penicillins*) +* Added official antimicrobial names to all `filter_ab_class()` functions, such as `filter_aminoglycosides()` +* Added antibiotics code "FOX1" for cefoxitin screening (abbreviation "cfsc") to the `antibiotics` data set ### Changed * Fixed a bug where `eucast_rules()` would not work on a tibble when the `tibble` or `dplyr` package was loaded * All `*_join_microorganisms()` functions and `bug_drug_combinations()` now return the original data class (e.g. `tibble`s and `data.table`s) * Fixed a bug where `as.ab()` would return an error on invalid input values * Fixed a bug for using grouped versions of `rsi_df()`, `proportion_df()` and `count_df()`, and fixed a bug where not all different antimicrobial results were added as rows -* Added function `filter_penicillins()` to filter isolates on a specific result in any column with a name in the antimicrobial 'penicillins' class (more specific: ATC subgroup *Beta-lactam antibacterials, penicillins*) -* Added official antimicrobial names to all `filter_ab_class()` functions, such as `filter_aminoglycosides()` -* Added antibiotics code "FOX1" for cefoxitin screening (abbreviation "cfsc") to the `antibiotics` data set * Improved auto-determination for columns of types `` and `` * Fixed a bug in `bug_drug_combinations()` for when only one antibiotic was in the input data +* Changed the summary for class ``, to highlight the %SI vs. %R +* Improved error handling, giving more useful info when functions return an error # AMR 1.2.0 diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index bea6f5b3..94d81b5a 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -179,7 +179,7 @@ search_type_in_df <- function(x, type) { found } -stopifnot_installed_package <- function(package) { +stop_ifnot_installed <- function(package) { # no "utils::installed.packages()" since it requires non-staged install since R 3.6.0 # https://developer.r-project.org/Blog/public/2019/02/14/staged-install/index.html sapply(package, function(pkg) @@ -197,16 +197,41 @@ stopifnot_installed_package <- function(package) { } import_fn <- function(name, pkg) { - stopifnot_installed_package(pkg) + stop_ifnot_installed(pkg) get(name, envir = asNamespace(pkg)) } -stopifnot_msg <- function(expr, msg) { - if (!isTRUE(expr)) { +stop_if <- function(expr, ..., call = TRUE) { + msg <- paste0(c(...), collapse = "") + if (!isFALSE(call)) { + if (isTRUE(call)) { + call <- as.character(sys.call(-1)[1]) + } else { + # so you can go back more than 1 call, as used in rsi_calc(), that now throws a reference to e.g. n_rsi() + call <- as.character(sys.call(call)[1]) + } + msg <- paste0("in ", call, "(): ", msg) + } + if (isTRUE(expr)) { stop(msg, call. = FALSE) } } +stop_ifnot <- function(expr, ..., call = TRUE) { + msg <- paste0(c(...), collapse = "") + if (!isFALSE(call)) { + if (isTRUE(call)) { + call <- as.character(sys.call(-1)[1]) + } else { + # so you can go back more than 1 call, as used in rsi_calc(), that now throws a reference to e.g. n_rsi() + call <- as.character(sys.call(call)[1]) + } + msg <- paste0("in ", call, "(): ", msg) + } + if (!isTRUE(expr)) { + stop(msg, call. = FALSE) + } +} "%or%" <- function(x, y) { if (is.null(x) | is.null(y)) { @@ -396,7 +421,7 @@ progress_estimated <- function(n = 1, n_min = 0, ...) { } } -# works exactly like round(), but rounds `round(44.55, 1)` as 44.6 instead of 44.5 +# works exactly like round(), but rounds `round2(44.55, 1)` to 44.6 instead of 44.5 # and adds decimal zeroes until `digits` is reached when force_zero = TRUE round2 <- function(x, digits = 0, force_zero = TRUE) { x <- as.double(x) diff --git a/R/ab_property.R b/R/ab_property.R index 3a021818..3b04f11f 100644 --- a/R/ab_property.R +++ b/R/ab_property.R @@ -157,9 +157,7 @@ ab_loinc <- function(x, ...) { #' @rdname ab_property #' @export ab_ddd <- function(x, administration = "oral", units = FALSE, ...) { - if (!administration %in% c("oral", "iv")) { - stop("`administration` must be 'oral' or 'iv'", call. = FALSE) - } + stop_ifnot(administration %in% c("oral", "iv"), "`administration` must be 'oral' or 'iv'") ddd_prop <- administration if (units == TRUE) { ddd_prop <- paste0(ddd_prop, "_units") @@ -215,12 +213,9 @@ ab_url <- function(x, open = FALSE, ...) { #' @rdname ab_property #' @export ab_property <- function(x, property = "name", language = get_locale(), ...) { - if (length(property) != 1L) { - stop("'property' must be of length 1.") - } - if (!property %in% colnames(antibiotics)) { - stop("invalid property: '", property, "' - use a column name of the `antibiotics` data set") - } + stop_if(length(property) != 1L, "'property' must be of length 1.") + stop_ifnot(property %in% colnames(antibiotics), + "invalid property: '", property, "' - use a column name of the `antibiotics` data set") translate_AMR(ab_validate(x = x, property = property, ...), language = language) } diff --git a/R/age.R b/R/age.R index 2337f987..f8298c9a 100755 --- a/R/age.R +++ b/R/age.R @@ -42,11 +42,8 @@ #' df age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) { if (length(x) != length(reference)) { - if (length(reference) == 1) { - reference <- rep(reference, length(x)) - } else { - stop("`x` and `reference` must be of same length, or `reference` must be of length 1.") - } + stop_if(length(reference) != 1, "`x` and `reference` must be of same length, or `reference` must be of length 1.") + reference <- rep(reference, length(x)) } x <- as.POSIXlt(x) reference <- as.POSIXlt(reference) @@ -141,9 +138,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) { #' ggplot_rsi(x = "age_group") #' } age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) { - if (!is.numeric(x)) { - stop("`x` and must be numeric, not a ", paste0(class(x), collapse = "/"), ".") - } + stop_ifnot(is.numeric(x), "`x` must be numeric, not ", paste0(class(x), collapse = "/")) if (any(x < 0, na.rm = TRUE)) { x[x < 0] <- NA warning("NAs introduced for ages below 0.") @@ -166,10 +161,7 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) { split_at <- c(0, split_at) } split_at <- split_at[!is.na(split_at)] - if (length(split_at) == 1) { - # only 0 is available - stop("invalid value for `split_at`.") - } + stop_if(length(split_at) == 1, "invalid value for `split_at`") # only 0 is available # turn input values to 'split_at' indices y <- x diff --git a/R/atc_online.R b/R/atc_online.R index a534104b..735a08b2 100644 --- a/R/atc_online.R +++ b/R/atc_online.R @@ -96,12 +96,8 @@ atc_online_property <- function(atc_code, return(rep(NA, length(atc_code))) } - if (length(property) != 1L) { - stop("`property` must be of length 1", call. = FALSE) - } - if (length(administration) != 1L) { - stop("`administration` must be of length 1", call. = FALSE) - } + stop_if(length(property) != 1L, "`property` must be of length 1") + stop_if(length(administration) != 1L, "`administration` must be of length 1") # also allow unit as property if (property %like% "unit") { @@ -115,9 +111,8 @@ atc_online_property <- function(atc_code, property <- tolower(property) valid_properties <- tolower(valid_properties) - if (!property %in% valid_properties) { - stop("Invalid `property`, use one of ", paste(valid_properties.bak, collapse = ", "), ".") - } + stop_ifnot(property %in% valid_properties, + "Invalid `property`, use one of ", paste(valid_properties.bak, collapse = ", ")) if (property == "ddd") { returnvalue <- rep(NA_real_, length(atc_code)) diff --git a/R/availability.R b/R/availability.R index 91acae5a..c4e78439 100644 --- a/R/availability.R +++ b/R/availability.R @@ -46,6 +46,7 @@ #' availability() #' } availability <- function(tbl, width = NULL) { + stop_ifnot(is.data.frame(tbl), "`tbl` must be a data.frame") x <- base::sapply(tbl, function(x) { 1 - base::sum(base::is.na(x)) / base::length(x) }) diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 0ca22df9..9bdde925 100644 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -59,21 +59,15 @@ bug_drug_combinations <- function(x, col_mo = NULL, FUN = mo_shortname, ...) { - if (!is.data.frame(x)) { - stop("`x` must be a data frame.", call. = FALSE) - } - if (!any(sapply(x, is.rsi), na.rm = TRUE)) { - stop("No columns with class found. See ?as.rsi.", call. = FALSE) - } + stop_ifnot(is.data.frame(x), "`x` must be a data frame") + stop_ifnot(any(sapply(x, is.rsi), na.rm = TRUE), "No columns with class found. See ?as.rsi.") # try to find columns based on type # -- mo if (is.null(col_mo)) { col_mo <- search_type_in_df(x = x, type = "mo") } - if (is.null(col_mo)) { - stop("`col_mo` must be set.", call. = FALSE) - } + stop_if(is.null(col_mo), "`col_mo` must be set") x_class <- class(x) x <- as.data.frame(x, stringsAsFactors = FALSE) diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 2cff1179..403df6a4 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -217,26 +217,17 @@ eucast_rules <- function(x, } } - if (!is.data.frame(x)) { - stop("`x` must be a data frame.", call. = FALSE) - } + stop_ifnot(is.data.frame(x), "`x` must be a data frame") # try to find columns based on type # -- mo if (is.null(col_mo)) { col_mo <- search_type_in_df(x = x, type = "mo") } - if (is.null(col_mo)) { - stop("`col_mo` must be set.", call. = FALSE) - } + stop_if(is.null(col_mo), "`col_mo` must be set") - if (!all(rules %in% c("breakpoints", "expert", "other", "all"))) { - stop('`rules` must be one or more of: "breakpoints", "expert", "other", "all".') - } - - if (is.null(col_mo)) { - stop("`col_mo` must be set") - } + stop_ifnot(all(rules %in% c("breakpoints", "expert", "other", "all")), + '`rules` must be one or more of: "breakpoints", "expert", "other", "all".') decimal.mark <- getOption("OutDec") big.mark <- ifelse(decimal.mark != ",", ",", ".") diff --git a/R/filter_ab_class.R b/R/filter_ab_class.R index 6a553e75..972cb756 100644 --- a/R/filter_ab_class.R +++ b/R/filter_ab_class.R @@ -71,10 +71,7 @@ filter_ab_class <- function(x, ...) { check_dataset_integrity() - - if (!is.data.frame(x)) { - stop("`x` must be a data frame.", call. = FALSE) - } + stop_ifnot(is.data.frame(x), "`x` must be a data frame") # save to return later x_class <- class(x) @@ -88,12 +85,8 @@ filter_ab_class <- function(x, # make result = "SI" works too: result <- unlist(strsplit(result, "")) - if (!all(result %in% c("S", "I", "R"))) { - stop("`result` must be one or more of: S, I, R", call. = FALSE) - } - if (!all(scope %in% c("any", "all"))) { - stop("`scope` must be one of: any, all", call. = FALSE) - } + stop_ifnot(all(result %in% c("S", "I", "R")), "`result` must be one or more of: S, I, R") + stop_ifnot(all(scope %in% c("any", "all")), "`scope` must be one of: any, all") # get all columns in data with names that resemble antibiotics ab_in_data <- suppressMessages(get_column_abx(x)) diff --git a/R/first_isolate.R b/R/first_isolate.R index 1c61cc0c..9c2d3fa6 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -156,9 +156,9 @@ first_isolate <- function(x, } } - if (!is.data.frame(x)) { - stop("`x` must be a data.frame.", call. = FALSE) - } + stop_ifnot(is.data.frame(x), "`x` must be a data.frame") + stop_if(any(dim(x) == 0), "`x` must contain rows and columns") + # remove data.table, grouping from tibbles, etc. x <- as.data.frame(x, stringsAsFactors = FALSE) @@ -166,17 +166,13 @@ first_isolate <- function(x, # -- mo if (is.null(col_mo)) { col_mo <- search_type_in_df(x = x, type = "mo") - if (is.null(col_mo)) { - stop("`col_mo` must be set.", call. = FALSE) - } + stop_if(is.null(col_mo), "`col_mo` must be set") } # -- date if (is.null(col_date)) { col_date <- search_type_in_df(x = x, type = "date") - if (is.null(col_date)) { - stop("`col_date` must be set.", call. = FALSE) - } + stop_if(is.null(col_date), "`col_date` must be set") } # convert to Date dates <- as.Date(x[, col_date, drop = TRUE]) @@ -193,9 +189,7 @@ first_isolate <- function(x, } else { col_patient_id <- search_type_in_df(x = x, type = "patient_id") } - if (is.null(col_patient_id)) { - stop("`col_patient_id` must be set.", call. = FALSE) - } + stop_if(is.null(col_patient_id), "`col_patient_id` must be set") } # -- key antibiotics @@ -216,14 +210,9 @@ first_isolate <- function(x, # check if columns exist check_columns_existance <- function(column, tblname = x) { - if (NROW(tblname) <= 1 | NCOL(tblname) <= 1) { - stop("Please check tbl for existance.") - } - if (!is.null(column)) { - if (!(column %in% colnames(tblname))) { - stop("Column `", column, "` not found.") - } + stop_ifnot(column %in% colnames(tblname), + "Column `", column, "` not found.", call = FALSE) } } diff --git a/R/ggplot_pca.R b/R/ggplot_pca.R index 6ccc4cbb..9aa91a99 100755 --- a/R/ggplot_pca.R +++ b/R/ggplot_pca.R @@ -95,22 +95,22 @@ ggplot_pca <- function(x, base_textsize = 10, ...) { - stopifnot_installed_package("ggplot2") - stopifnot_msg(length(choices) == 2, "`choices` must be of length 2") - stopifnot_msg(is.logical(scale), "`scale` must be TRUE or FALSE") - stopifnot_msg(is.logical(pc.biplot), "`pc.biplot` must be TRUE or FALSE") - stopifnot_msg(is.numeric(choices), "`choices` must be numeric") - stopifnot_msg(is.numeric(labels_textsize), "`labels_textsize` must be numeric") - stopifnot_msg(is.numeric(labels_text_placement), "`labels_text_placement` must be numeric") - stopifnot_msg(is.logical(ellipse), "`ellipse` must be TRUE or FALSE") - stopifnot_msg(is.numeric(ellipse_prob), "`ellipse_prob` must be numeric") - stopifnot_msg(is.numeric(ellipse_size), "`ellipse_size` must be numeric") - stopifnot_msg(is.numeric(ellipse_alpha), "`ellipse_alpha` must be numeric") - stopifnot_msg(is.logical(arrows), "`arrows` must be TRUE or FALSE") - stopifnot_msg(is.numeric(arrows_size), "`arrows_size` must be numeric") - stopifnot_msg(is.numeric(arrows_textsize), "`arrows_textsize` must be numeric") - stopifnot_msg(is.numeric(arrows_alpha), "`arrows_alpha` must be numeric") - stopifnot_msg(is.numeric(base_textsize), "`base_textsize` must be numeric") + stop_ifnot_installed("ggplot2") + stop_ifnot(length(choices) == 2, "`choices` must be of length 2") + stop_ifnot(is.logical(scale), "`scale` must be TRUE or FALSE") + stop_ifnot(is.logical(pc.biplot), "`pc.biplot` must be TRUE or FALSE") + stop_ifnot(is.numeric(choices), "`choices` must be numeric") + stop_ifnot(is.numeric(labels_textsize), "`labels_textsize` must be numeric") + stop_ifnot(is.numeric(labels_text_placement), "`labels_text_placement` must be numeric") + stop_ifnot(is.logical(ellipse), "`ellipse` must be TRUE or FALSE") + stop_ifnot(is.numeric(ellipse_prob), "`ellipse_prob` must be numeric") + stop_ifnot(is.numeric(ellipse_size), "`ellipse_size` must be numeric") + stop_ifnot(is.numeric(ellipse_alpha), "`ellipse_alpha` must be numeric") + stop_ifnot(is.logical(arrows), "`arrows` must be TRUE or FALSE") + stop_ifnot(is.numeric(arrows_size), "`arrows_size` must be numeric") + stop_ifnot(is.numeric(arrows_textsize), "`arrows_textsize` must be numeric") + stop_ifnot(is.numeric(arrows_alpha), "`arrows_alpha` must be numeric") + stop_ifnot(is.numeric(base_textsize), "`base_textsize` must be numeric") calculations <- pca_calculations(pca_model = x, groups = groups, diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index fb80dae3..6725dda7 100755 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -164,7 +164,7 @@ ggplot_rsi <- function(data, y.title = "Proportion", ...) { - stopifnot_installed_package("ggplot2") + stop_ifnot_installed("ggplot2") x <- x[1] facet <- facet[1] @@ -245,11 +245,8 @@ geom_rsi <- function(position = NULL, combine_IR = FALSE, ...) { - stopifnot_installed_package("ggplot2") - - if (is.data.frame(position)) { - stop("`position` is invalid. Did you accidentally use '%>%' instead of '+'?", call. = FALSE) - } + stop_ifnot_installed("ggplot2") + stop_if(is.data.frame(position), "`position` is invalid. Did you accidentally use '%>%' instead of '+'?") y <- "value" if (missing(position) | is.null(position)) { @@ -293,7 +290,7 @@ geom_rsi <- function(position = NULL, #' @export facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) { - stopifnot_installed_package("ggplot2") + stop_ifnot_installed("ggplot2") facet <- facet[1] @@ -318,7 +315,7 @@ facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) { #' @rdname ggplot_rsi #' @export scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) { - stopifnot_installed_package("ggplot2") + stop_ifnot_installed("ggplot2") if (all(breaks[breaks != 0] > 1)) { breaks <- breaks / 100 @@ -335,7 +332,7 @@ scale_rsi_colours <- function(colours = c(S = "#61a8ff", I = "#61f7ff", IR = "#ff6961", R = "#ff6961")) { - stopifnot_installed_package("ggplot2") + stop_ifnot_installed("ggplot2") # previous colour: palette = "RdYlGn" # previous colours: values = c("#b22222", "#ae9c20", "#7cfc00") @@ -353,7 +350,7 @@ scale_rsi_colours <- function(colours = c(S = "#61a8ff", #' @rdname ggplot_rsi #' @export theme_rsi <- function() { - stopifnot_installed_package("ggplot2") + stop_ifnot_installed("ggplot2") ggplot2::theme_minimal(base_size = 10) + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), @@ -372,7 +369,7 @@ labels_rsi_count <- function(position = NULL, combine_IR = FALSE, datalabels.size = 3, datalabels.colour = "gray15") { - stopifnot_installed_package("ggplot2") + stop_ifnot_installed("ggplot2") if (is.null(position)) { position <- "fill" } diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index 6d0f371e..e9877b67 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -62,9 +62,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) { if (is.null(x) & is.null(search_string)) { return(as.name("guess_ab_col")) } - if (!is.data.frame(x)) { - stop("`x` must be a data.frame") - } + stop_ifnot(is.data.frame(x), "`x` must be a data.frame") if (length(search_string) > 1) { warning("argument 'search_string' has length > 1 and only the first element will be used") diff --git a/R/join_microorganisms.R b/R/join_microorganisms.R index 2ff9bb85..93efac13 100755 --- a/R/join_microorganisms.R +++ b/R/join_microorganisms.R @@ -175,7 +175,7 @@ joins_check_df <- function(x, by) { by <- "mo" x[, "mo"] <- as.mo(x[, "mo"]) } else { - stop("Cannot join - no column found with name or class .", call. = FALSE) + stop("Cannot join - no column found with name 'mo' or with class .", call. = FALSE) } } message('Joining, by = "', by, '"') # message same as dplyr::join functions diff --git a/R/key_antibiotics.R b/R/key_antibiotics.R index 9bfc4770..bd474d3c 100755 --- a/R/key_antibiotics.R +++ b/R/key_antibiotics.R @@ -136,9 +136,7 @@ key_antibiotics <- function(x, if (is.null(col_mo)) { col_mo <- search_type_in_df(x = x, type = "mo") } - if (is.null(col_mo)) { - stop("`col_mo` must be set.", call. = FALSE) - } + stop_if(is.null(col_mo), "`col_mo` must be set") # check columns col.list <- c(universal_1, universal_2, universal_3, universal_4, universal_5, universal_6, @@ -260,9 +258,7 @@ key_antibiotics_equal <- function(y, type <- type[1] - if (length(x) != length(y)) { - stop("Length of `x` and `y` must be equal.") - } + stop_ifnot(length(x) == length(y), "length of `x` and `y` must be equal") # only show progress bar on points or when at least 5000 isolates info_needed <- info == TRUE & (type == "points" | length(x) > 5000) diff --git a/R/mdro.R b/R/mdro.R index 70be8608..45520ecb 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -106,15 +106,13 @@ mdro <- function(x, } } - if (!is.data.frame(x)) { - stop("`x` must be a data frame.", call. = FALSE) - } + stop_ifnot(is.data.frame(x), "`x` must be a data.frame") + stop_if(any(dim(x) == 0), "`x` must contain rows and columns") + # force regular data.frame, not a tibble or data.table x <- as.data.frame(x, stringsAsFactors = FALSE) - if (!is.numeric(pct_required_classes)) { - stop("`pct_required_classes` must be numeric.", call. = FALSE) - } + stop_ifnot(is.numeric(pct_required_classes), "`pct_required_classes` must be numeric") if (pct_required_classes > 1) { # allow pct_required_classes = 75 -> pct_required_classes = 0.75 pct_required_classes <- pct_required_classes / 100 @@ -124,9 +122,7 @@ mdro <- function(x, warning("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call. = FALSE) guideline <- list(...)$country } - if (length(guideline) > 1) { - stop("`guideline` must be a length one character string.", call. = FALSE) - } + stop_ifnot(length(guideline) == 1, "`guideline` must be of length 1") if (is.null(guideline)) { # default to the paper by Magiorakos et al. (2012) @@ -138,9 +134,8 @@ mdro <- function(x, if (tolower(guideline) == "de") { guideline <- "MRGN" } - if (!tolower(guideline) %in% c("brmo", "mrgn", "eucast", "tb", "cmi2012")) { - stop("invalid guideline: ", guideline, call. = FALSE) - } + stop_ifnot(tolower(guideline) %in% c("brmo", "mrgn", "eucast", "tb", "cmi2012"), + "invalid guideline: ", guideline) guideline <- list(code = tolower(guideline)) # try to find columns based on type @@ -154,9 +149,7 @@ mdro <- function(x, x$mo <- as.mo("Mycobacterium tuberculosis") col_mo <- "mo" } - if (is.null(col_mo)) { - stop("`col_mo` must be set.", call. = FALSE) - } + stop_if(is.null(col_mo), "`col_mo` must be set") if (guideline$code == "cmi2012") { guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." @@ -417,9 +410,7 @@ mdro <- function(x, RFP <- cols_ab["RFP"] abx_tb <- c(CAP, ETH, GAT, INH, PZA, RIF, RIB, RFP) abx_tb <- abx_tb[!is.na(abx_tb)] - if (guideline$code == "tb" & length(abx_tb) == 0) { - stop("No antimycobacterials found in data set.", call. = FALSE) - } + stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set") if (combine_SI == TRUE) { search_result <- "R" diff --git a/R/mo.R b/R/mo.R index a1ed429b..17b7a679 100755 --- a/R/mo.R +++ b/R/mo.R @@ -350,9 +350,8 @@ exec_as.mo <- function(x, # defined df to check for if (!is.null(reference_df)) { - if (!mo_source_isvalid(reference_df)) { - stop("`reference_df` must contain a column `mo` with values from the 'microorganisms' data set.", call. = FALSE) - } + mo_source_isvalid(reference_df) + reference_df <- reference_df %>% filter(!is.na(mo)) # keep only first two columns, second must be mo if (colnames(reference_df)[1] == "mo") { @@ -1760,9 +1759,8 @@ translate_allow_uncertain <- function(allow_uncertain) { allow_uncertain[tolower(allow_uncertain) == "none"] <- 0 allow_uncertain[tolower(allow_uncertain) == "all"] <- 3 allow_uncertain <- as.integer(allow_uncertain) - if (!allow_uncertain %in% c(0:3)) { - stop('`allow_uncertain` must be a number between 0 (or "none") and 3 (or "all"), or TRUE (= 2) or FALSE (= 0).', call. = FALSE) - } + stop_ifnot(allow_uncertain %in% c(0:3), + '`allow_uncertain` must be a number between 0 (or "none") and 3 (or "all"), or TRUE (= 2) or FALSE (= 0)', call = FALSE) } allow_uncertain } @@ -1803,7 +1801,7 @@ parse_and_convert <- function(x) { tryCatch({ if (!is.null(dim(x))) { if (NCOL(x) > 2) { - stop("A maximum of two columns is allowed.", call. = FALSE) + stop("a maximum of two columns is allowed", call. = FALSE) } else if (NCOL(x) == 2) { # support Tidyverse selection like: df %>% select(colA, colB) # paste these columns together diff --git a/R/mo_property.R b/R/mo_property.R index e52165c9..ee5fb51d 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -28,14 +28,16 @@ #' @param language language of the returned text, defaults to system language (see [get_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation. #' @param ... other parameters passed on to [as.mo()] #' @param open browse the URL using [utils::browseURL()] -#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for [mo_ref()], [mo_authors()] and [mo_year()]. This leads to the following results: -#' - `mo_name("Chlamydia psittaci")` will return `"Chlamydophila psittaci"` (with a warning about the renaming) -#' - `mo_ref("Chlamydia psittaci")` will return `"Page, 1968"` (with a warning about the renaming) -#' - `mo_ref("Chlamydophila psittaci")` will return `"Everett et al., 1999"` (without a warning) +#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for [mo_ref()], [mo_authors()] and [mo_year()]. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010: +#' - `mo_name("Escherichia blattae")` will return `"Shimwellia blattae"` (with a message about the renaming) +#' - `mo_ref("Escherichia blattae")` will return `"Burgess et al., 1973"` (with a message about the renaming) +#' - `mo_ref("Shimwellia blattae")` will return `"Priest et al., 2010"` (without a message) #' -#' The short name - [mo_shortname()] - almost always returns the first character of the genus and the full species, like *"E. coli"*. Exceptions are abbreviations of staphylococci and beta-haemolytic streptococci, like *"CoNS"* (Coagulase-Negative Staphylococci) and *"GBS"* (Group B Streptococci). +#' The short name - [mo_shortname()] - almost always returns the first character of the genus and the full species, like `"E. coli"`. Exceptions are abbreviations of staphylococci (like *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (like *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (kingdom of Bacteria) as well as *Entamoeba coli* (kingdom of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will be considered *Escherichia coli*. In other words, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`. +#' +#' Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and sometimes as 'domain', the functions [mo_kingdom()] and [mo_domain()] return the exact same results. #' -#' The Gram stain - [mo_gramstain()] - will be determined on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002) who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. +#' The Gram stain - [mo_gramstain()] - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318)), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. #' #' All output will be [translate]d where possible. #' @@ -218,6 +220,10 @@ mo_kingdom <- function(x, language = get_locale(), ...) { translate_AMR(mo_validate(x = x, property = "kingdom", ...), language = language, only_unknown = TRUE) } +#' @rdname mo_property +#' @export +mo_domain <- mo_kingdom + #' @rdname mo_property #' @export mo_type <- function(x, language = get_locale(), ...) { @@ -391,12 +397,9 @@ mo_url <- function(x, open = FALSE, ...) { #' @rdname mo_property #' @export mo_property <- function(x, property = "fullname", language = get_locale(), ...) { - if (length(property) != 1L) { - stop("'property' must be of length 1.") - } - if (!property %in% colnames(microorganisms)) { - stop("invalid property: '", property, "' - use a column name of the `microorganisms` data set") - } + stop_ifnot(length(property) == 1L, "'property' must be of length 1") + stop_ifnot(property %in% colnames(microorganisms), + "invalid property: '", property, "' - use a column name of the `microorganisms` data set") translate_AMR(mo_validate(x = x, property = property, ...), language = language, only_unknown = TRUE) } diff --git a/R/mo_source.R b/R/mo_source.R index fbcd0e1d..8d93f3b5 100644 --- a/R/mo_source.R +++ b/R/mo_source.R @@ -112,9 +112,7 @@ set_mo_source <- function(path) { file_location <- path.expand("~/mo_source.rds") - if (length(path) > 1) { - stop("`path` must be of length 1.") - } + stop_ifnot(length(path) == 1, "`path` must be of length 1") if (is.null(path) || path %in% c(FALSE, "")) { options(mo_source = NULL) @@ -126,9 +124,8 @@ set_mo_source <- function(path) { return(invisible()) } - if (!file.exists(path)) { - stop("File not found: ", path) - } + stop_ifnot(file.exists(path), + "file not found: ", path) if (path %like% "[.]rds$") { df <- readRDS(path) @@ -231,21 +228,21 @@ mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error } if (is.null(x)) { if (stop_on_error == TRUE) { - stop(refer_to_name, " cannot be NULL.", call. = FALSE) + stop(refer_to_name, " cannot be NULL", call. = FALSE) } else { return(FALSE) } } if (!is.data.frame(x)) { if (stop_on_error == TRUE) { - stop(refer_to_name, " must be a data.frame.", call. = FALSE) + stop(refer_to_name, " must be a data.frame", call. = FALSE) } else { return(FALSE) } } if (!"mo" %in% colnames(x)) { if (stop_on_error == TRUE) { - stop(refer_to_name, " must contain a column 'mo'.", call. = FALSE) + stop(refer_to_name, " must contain a column 'mo'", call. = FALSE) } else { return(FALSE) } @@ -260,7 +257,7 @@ mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error } stop("Value", plural, " ", paste0("'", invalid[, 1, drop = TRUE], "'", collapse = ", "), " found in ", tolower(refer_to_name), - ", but with invalid microorganism code", plural, " ", paste0("'", invalid$mo, "'", collapse = ", "), ".", + ", but with invalid microorganism code", plural, " ", paste0("'", invalid$mo, "'", collapse = ", "), call. = FALSE) } else { return(FALSE) diff --git a/R/pca.R b/R/pca.R index 1d656ac6..86e17321 100755 --- a/R/pca.R +++ b/R/pca.R @@ -61,9 +61,8 @@ pca <- function(x, tol = NULL, rank. = NULL) { - if (!is.data.frame(x)) { - stop("this function only takes a data.frame as input") - } + stop_ifnot(is.data.frame(x), "`x` must be a data.frame") + stop_if(any(dim(x) == 0), "`x` must contain rows and columns") # unset data.table, tibble, etc. # also removes groups made by dplyr::group_by diff --git a/R/resistance_predict.R b/R/resistance_predict.R index 29b62d3a..8022e34b 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -123,18 +123,12 @@ resistance_predict <- function(x, info = interactive(), ...) { - if (nrow(x) == 0) { - stop("This table does not contain any observations.") - } + stop_ifnot(is.data.frame(x), "`x` must be a data.frame") + stop_if(any(dim(x) == 0), "`x` must contain rows and columns") + stop_if(is.null(model), 'choose a regression model with the `model` parameter, e.g. resistance_predict(..., model = "binomial")') + stop_ifnot(col_ab %in% colnames(x), + "column `", col_ab, "` not found") - if (is.null(model)) { - stop('Choose a regression model with the `model` parameter, e.g. resistance_predict(..., model = "binomial").') - } - - if (!col_ab %in% colnames(x)) { - stop("Column ", col_ab, " not found.") - } - dots <- unlist(list(...)) if (length(dots) != 0) { # backwards compatibility with old parameters @@ -150,16 +144,12 @@ resistance_predict <- function(x, # -- date if (is.null(col_date)) { col_date <- search_type_in_df(x = x, type = "date") + stop_if(is.null(col_date), "`col_date` must be set") } - if (is.null(col_date)) { - stop("`col_date` must be set.", call. = FALSE) - } + stop_ifnot(col_date %in% colnames(x), + "column `", col_date, "` not found") - if (!col_date %in% colnames(x)) { - stop("Column ", col_date, " not found.") - } - - # no grouped tibbles, mutate will throw errors + # no grouped tibbles x <- as.data.frame(x, stringsAsFactors = FALSE) year <- function(x) { @@ -192,10 +182,8 @@ resistance_predict <- function(x, df <- subset(df, sum(df$R + df$S, na.rm = TRUE) >= minimum) df_matrix <- as.matrix(df[, c("R", "S"), drop = FALSE]) - if (NROW(df) == 0) { - stop("There are no observations.") - } - + stop_if(NROW(df) == 0, "there are no observations") + year_lowest <- min(df$year) if (is.null(year_min)) { year_min <- year_lowest @@ -248,7 +236,7 @@ resistance_predict <- function(x, se <- predictmodel$se.fit } else { - stop("No valid model selected. See ?resistance_predict.") + stop("no valid model selected. See ?resistance_predict.") } # prepare the output dataframe @@ -355,12 +343,9 @@ ggplot_rsi_predict <- function(x, main = paste("Resistance Prediction of", x_name), ribbon = TRUE, ...) { - - stopifnot_installed_package("ggplot2") - - if (!"resistance_predict" %in% class(x)) { - stop("`x` must be a resistance prediction model created with resistance_predict().") - } + + stop_ifnot_installed("ggplot2") + stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()") x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") diff --git a/R/rsi.R b/R/rsi.R index 6cbd4c91..6bfb70b1 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -209,12 +209,11 @@ as.rsi.default <- function(x, ...) { #' @rdname as.rsi #' @export as.rsi.mic <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST", uti = FALSE, ...) { - if (missing(mo)) { - stop('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', - "To transform certain columns with e.g. mutate_at(), use\n", - "`data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n\n", - "To tranform all MIC variables in a data set, use `as.rsi(data)` or `data %>% as.rsi()`.", call. = FALSE) - } + stop_if(missing(mo), + 'No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', + "To transform certain columns with e.g. mutate_at(), use\n", + "`data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n\n", + "To tranform all MIC variables in a data set, use `as.rsi(data)` or `data %>% as.rsi()`.", call = FALSE) ab_coerced <- suppressWarnings(as.ab(ab)) mo_coerced <- suppressWarnings(as.mo(mo)) @@ -246,12 +245,11 @@ as.rsi.mic <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST", #' @rdname as.rsi #' @export as.rsi.disk <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST", uti = FALSE, ...) { - if (missing(mo)) { - stop('No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', - "To transform certain columns with e.g. mutate_at(), use\n", - "`data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n\n", - "To tranform all disk diffusion zones in a data set, use `as.rsi(data)` or `data %>% as.rsi()`.", call. = FALSE) - } + stop_if(missing(mo), + 'No information was supplied about the microorganisms (missing parameter "mo"). See ?as.rsi.\n\n', + "To transform certain columns with e.g. mutate_at(), use\n", + "`data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n\n", + "To tranform all disk diffusion zones in a data set, use `as.rsi(data)` or `data %>% as.rsi()`.", call = FALSE) ab_coerced <- suppressWarnings(as.ab(ab)) mo_coerced <- suppressWarnings(as.mo(mo)) @@ -287,10 +285,9 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", uti = NULL # -- mo if (is.null(col_mo)) { col_mo <- search_type_in_df(x = x, type = "mo") + stop_if(is.null(col_mo), "`col_mo` must be set") } - if (is.null(col_mo)) { - stop("`col_mo` must be set.", call. = FALSE) - } + # -- UTIs col_uti <- uti if (is.null(col_uti)) { @@ -353,9 +350,8 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", uti = NULL } })] - if (length(ab_cols) == 0) { - stop("No columns with MIC values or disk zones found in this data set. Use as.mic() or as.disk() to transform antimicrobial columns.", call. = FALSE) - } + stop_if(length(ab_cols) == 0, + "no columns with MIC values or disk zones found in this data set. Use as.mic() or as.disk() to transform antimicrobial columns.") # set type per column types <- character(length(ab_cols)) @@ -393,11 +389,9 @@ get_guideline <- function(guideline) { guideline_param <- gsub("([a-z]+)([0-9]+)", "\\1 \\2", guideline_param, ignore.case = TRUE) } - if (!guideline_param %in% rsi_translation$guideline) { - stop(paste0("invalid guideline: '", guideline, - "'.\nValid guidelines are: ", paste0("'", unique(rsi_translation$guideline), "'", collapse = ", "), "."), - call. = FALSE) - } + stop_ifnot(guideline_param %in% rsi_translation$guideline, + "invalid guideline: '", guideline, + "'.\nValid guidelines are: ", paste0("'", unique(rsi_translation$guideline), "'", collapse = ", "), call = FALSE) guideline_param @@ -503,9 +497,8 @@ is.rsi <- function(x) { #' @rdname as.rsi #' @export is.rsi.eligible <- function(x, threshold = 0.05) { - if (NCOL(x) > 1) { - stop("`x` must be a one-dimensional vector.") - } + stop_if(NCOL(x) > 1, "`x` must be a one-dimensional vector.") + if (any(c("logical", "numeric", "integer", @@ -551,13 +544,16 @@ droplevels.rsi <- function(x, exclude = if (anyNA(levels(x))) NULL else NA, ...) #' @noRd summary.rsi <- function(object, ...) { x <- object + n <- sum(!is.na(x)) + S <- sum(x == "S", na.rm = TRUE) + I <- sum(x == "I", na.rm = TRUE) + R <- sum(x == "R", na.rm = TRUE) c( "Class" = "rsi", - "" = sum(is.na(x)), - "Sum S" = sum(x == "S", na.rm = TRUE), - "Sum IR" = sum(x %in% c("I", "R"), na.rm = TRUE), - "-Sum R" = sum(x == "R", na.rm = TRUE), - "-Sum I" = sum(x == "I", na.rm = TRUE) + "%R" = paste0(percentage(R / n), " (n=", R, ")"), + "%SI" = paste0(percentage((S + I) / n), " (n=", S + I, ")"), + "- %S" = paste0(percentage(S / n), " (n=", S, ")"), + "- %I" = paste0(percentage(I / n), " (n=", I, ")") ) } diff --git a/R/rsi_calc.R b/R/rsi_calc.R index e546083d..3d162339 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -33,23 +33,19 @@ rsi_calc <- function(..., only_all_tested = FALSE, only_count = FALSE) { + stop_ifnot(is.numeric(minimum), "`minimum` must be numeric", call = -2) + stop_ifnot(is.logical(as_percent), "`as_percent` must be logical", call = -2) + stop_ifnot(is.logical(only_all_tested), "`only_all_tested` must be logical", call = -2) + data_vars <- dots2vars(...) - - if (!is.numeric(minimum)) { - stop("`minimum` must be numeric", call. = FALSE) - } - if (!is.logical(as_percent)) { - stop("`as_percent` must be logical", call. = FALSE) - } - if (!is.logical(only_all_tested)) { - stop("`only_all_tested` must be logical", call. = FALSE) - } - + dots_df <- switch(1, ...) dots <- base::eval(base::substitute(base::alist(...))) - if ("also_single_tested" %in% names(dots)) { - stop("`also_single_tested` was replaced by `only_all_tested`. Please read Details in the help page (`?proportion`) as this may have a considerable impact on your analysis.", call. = FALSE) - } + stop_if(length(dots) == 0, "no variables selected", call = -2) + + stop_if("also_single_tested" %in% names(dots), + "`also_single_tested` was replaced by `only_all_tested`.\n", + "Please read Details in the help page (`?proportion`) as this may have a considerable impact on your analysis.", call = -2) ndots <- length(dots) if ("data.frame" %in% class(dots_df)) { @@ -164,22 +160,15 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both" combine_SI_missing = FALSE) { check_dataset_integrity() - - if (!"data.frame" %in% class(data)) { - stop(paste0("`", type, "_df` must be called on a data.frame"), call. = FALSE) - } + stop_ifnot(is.data.frame(data), "`data` must be a data.frame", call = -2) + stop_if(any(dim(data) == 0), "`data` must contain rows and columns", call = -2) + stop_ifnot(any(sapply(data, is.rsi), na.rm = TRUE), "no columns with class found. See ?as.rsi.", call = -2) + stop_if(isTRUE(combine_SI) & isTRUE(combine_IR), "either `combine_SI` or `combine_IR` can be TRUE, not both", call = -2) if (isTRUE(combine_IR) & isTRUE(combine_SI_missing)) { combine_SI <- FALSE } - if (isTRUE(combine_SI) & isTRUE(combine_IR)) { - stop("either `combine_SI` or `combine_IR` can be TRUE, not both", call. = FALSE) - } - - if (!any(sapply(data, is.rsi), na.rm = TRUE)) { - stop("No columns with class found. See ?as.rsi.", call. = FALSE) - } - + if (as.character(translate_ab) %in% c("TRUE", "official")) { translate_ab <- "name" } diff --git a/R/translate.R b/R/translate.R index 8a369f6a..70be53d1 100755 --- a/R/translate.R +++ b/R/translate.R @@ -108,11 +108,10 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) { df_trans <- translations_file # internal data file - if (!language %in% df_trans$lang) { - stop("Unsupported language: '", language, "' - use one of: ", - paste0("'", sort(unique(df_trans$lang)), "'", collapse = ", "), - call. = FALSE) - } + stop_ifnot(language %in% df_trans$lang, + "unsupported language: '", language, "' - use one of: ", + paste0("'", sort(unique(df_trans$lang)), "'", collapse = ", "), + call = FALSE) df_trans <- df_trans %>% subset(lang == language) if (only_unknown == TRUE) { diff --git a/R/zzz.R b/R/zzz.R index fdbd08f1..fc94f4d3 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -23,11 +23,11 @@ assign(x = "MO_lookup", value = create_MO_lookup(), envir = asNamespace("AMR")) - + assign(x = "MO.old_lookup", value = create_MO.old_lookup(), envir = asNamespace("AMR")) - + assign(x = "mo_codes_v0.5.0", value = make_trans_tbl(), envir = asNamespace("AMR")) @@ -47,10 +47,10 @@ create_MO_lookup <- function() { # use this paste instead of `fullname` to # work with Viridans Group Streptococci, etc. MO_lookup$fullname_lower <- tolower(trimws(paste(MO_lookup$genus, - MO_lookup$species, - MO_lookup$subspecies))) + MO_lookup$species, + MO_lookup$subspecies))) MO_lookup[MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname), "fullname_lower"] <- tolower(trimws(MO_lookup[MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname), - "fullname"])) + "fullname"])) MO_lookup$fullname_lower <- gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower) # add a column with only "e coli" like combinations diff --git a/docs/404.html b/docs/404.html index 08a08f6b..b0c0185e 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 4a2051e3..b82e2b1c 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011 diff --git a/docs/articles/AMR.html b/docs/articles/AMR.html index 0765d4b7..7406b5fa 100644 --- a/docs/articles/AMR.html +++ b/docs/articles/AMR.html @@ -39,7 +39,7 @@ AMR (for R) - 1.2.0.9008 + 1.2.0.9011 @@ -186,7 +186,7 @@

How to conduct AMR analysis

Matthijs S. Berends

-

17 June 2020

+

22 June 2020

Source: vignettes/AMR.Rmd @@ -195,7 +195,7 @@ -

Note: values on this page will change with every website update since they are based on randomly created values and the page was written in R Markdown. However, the methodology remains unchanged. This page was generated on 17 June 2020.

+

Note: values on this page will change with every website update since they are based on randomly created values and the page was written in R Markdown. However, the methodology remains unchanged. This page was generated on 22 June 2020.

Introduction

@@ -226,21 +226,21 @@ -2020-06-17 +2020-06-22 abcd Escherichia coli S S -2020-06-17 +2020-06-22 abcd Escherichia coli S R -2020-06-17 +2020-06-22 efgh Escherichia coli R @@ -336,71 +336,71 @@ -2014-09-10 -V9 -Hospital A -Streptococcus pneumoniae -R -S -S -S -F - - -2011-09-21 -Y7 -Hospital B -Streptococcus pneumoniae -S -S -S -S -F - - -2014-05-27 -U4 -Hospital B -Klebsiella pneumoniae -S -S -S -S -F - - -2013-01-03 -I8 -Hospital B +2014-04-15 +I4 +Hospital D Escherichia coli +S R -R -R +S +S +M + + +2011-02-09 +D1 +Hospital A +Escherichia coli +S +S +S S M -2011-06-08 +2013-12-16 K4 -Hospital B -Streptococcus pneumoniae -S -S -S -R -M - - -2017-09-29 -T5 -Hospital A +Hospital C Staphylococcus aureus S -I +S +R +S +M + + +2017-08-23 +Z9 +Hospital B +Escherichia coli +S +S S S F + +2010-01-14 +N4 +Hospital A +Staphylococcus aureus +R +S +S +S +M + + +2016-01-31 +N1 +Hospital D +Staphylococcus aureus +R +S +R +S +M +

Now, let’s start the cleaning and the analysis!

@@ -432,16 +432,16 @@ Longest: 1

1 M -10,319 -51.60% -10,319 -51.60% +10,328 +51.64% +10,328 +51.64% 2 F -9,681 -48.41% +9,672 +48.36% 20,000 100.00% @@ -481,7 +481,7 @@ Longest: 1

# NOTE: Using column `bacteria` as input for `col_mo`. # NOTE: Using column `date` as input for `col_date`. # NOTE: Using column `patient_id` as input for `col_patient_id`.
-

So only 28.2% is suitable for resistance analysis! We can now filter on it with the filter() function, also from the dplyr package:

+

So only 28.3% is suitable for resistance analysis! We can now filter on it with the filter() function, also from the dplyr package:

data_1st <- data %>%
   filter(first == TRUE)

For future use, the above two syntaxes can be shortened with the filter_first_isolate() function:

@@ -491,7 +491,7 @@ Longest: 1

First weighted isolates

-

We made a slight twist to the CLSI algorithm, to take into account the antimicrobial susceptibility profile. Have a look at all isolates of patient A2, sorted on date:

+

We made a slight twist to the CLSI algorithm, to take into account the antimicrobial susceptibility profile. Have a look at all isolates of patient N3, sorted on date:

@@ -507,10 +507,10 @@ Longest: 1

- - + + - + @@ -518,8 +518,8 @@ Longest: 1

- - + + @@ -529,21 +529,21 @@ Longest: 1

- - + + - - - + + + - - + + - + @@ -551,8 +551,8 @@ Longest: 1

- - + + @@ -562,62 +562,62 @@ Longest: 1

- - + + - - + + - - + + - + - - + + - - - + + + - - + + - + - - + + - - + +
isolate
12010-02-14A22010-03-10N3 B_ESCHR_COLIRI S S S
22010-03-19A22010-05-11N3 B_ESCHR_COLI S S
32010-08-09A22010-05-17N3 B_ESCHR_COLISSS RSSS FALSE
42010-12-29A22010-05-18N3 B_ESCHR_COLISR S S S
52011-02-03A22010-07-30N3 B_ESCHR_COLI S S
62011-04-15A22010-09-15N3 B_ESCHR_COLI S S SSTRUERFALSE
72011-04-22A22010-10-06N3 B_ESCHR_COLI S SSR S FALSE
82011-06-10A22010-11-30N3 B_ESCHR_COLIRR SRSSS FALSE
92011-07-20A22011-01-27N3 B_ESCHR_COLI RSI S S FALSE
102011-08-06A22011-01-30N3 B_ESCHR_COLISS R SSS FALSE
-

Only 2 isolates are marked as ‘first’ according to CLSI guideline. But when reviewing the antibiogram, it is obvious that some isolates are absolutely different strains and should be included too. This is why we weigh isolates, based on their antibiogram. The key_antibiotics() function adds a vector with 18 key antibiotics: 6 broad spectrum ones, 6 small spectrum for Gram negatives and 6 small spectrum for Gram positives. These can be defined by the user.

+

Only 1 isolates are marked as ‘first’ according to CLSI guideline. But when reviewing the antibiogram, it is obvious that some isolates are absolutely different strains and should be included too. This is why we weigh isolates, based on their antibiogram. The key_antibiotics() function adds a vector with 18 key antibiotics: 6 broad spectrum ones, 6 small spectrum for Gram negatives and 6 small spectrum for Gram positives. These can be defined by the user.

If a column exists with a name like ‘key(…)ab’ the first_isolate() function will automatically use it and determine the first weighted isolates. Mind the NOTEs in below output:

data <- data %>%
   mutate(keyab = key_antibiotics(.)) %>%
@@ -643,10 +643,10 @@ Longest: 1

1 -2010-02-14 -A2 +2010-03-10 +N3 B_ESCHR_COLI -R +I S S S @@ -655,95 +655,95 @@ Longest: 1

2 -2010-03-19 -A2 +2010-05-11 +N3 B_ESCHR_COLI S S S S FALSE -TRUE +FALSE 3 -2010-08-09 -A2 +2010-05-17 +N3 B_ESCHR_COLI -S -S -S R +S +S +S FALSE TRUE 4 -2010-12-29 -A2 +2010-05-18 +N3 B_ESCHR_COLI -S +R S S S FALSE -TRUE +FALSE 5 -2011-02-03 -A2 +2010-07-30 +N3 B_ESCHR_COLI S S S S FALSE -FALSE +TRUE 6 -2011-04-15 -A2 +2010-09-15 +N3 B_ESCHR_COLI S S S -S -TRUE +R +FALSE TRUE 7 -2011-04-22 -A2 +2010-10-06 +N3 B_ESCHR_COLI S S -S +R S FALSE -FALSE +TRUE 8 -2011-06-10 -A2 +2010-11-30 +N3 B_ESCHR_COLI -R -R S -R +S +S +S FALSE TRUE 9 -2011-07-20 -A2 +2011-01-27 +N3 B_ESCHR_COLI R -S +I S S FALSE @@ -751,23 +751,23 @@ Longest: 1

10 -2011-08-06 -A2 +2011-01-30 +N3 B_ESCHR_COLI -S -S R S +S +S +FALSE FALSE -TRUE -

Instead of 2, now 8 isolates are flagged. In total, 78.6% of all isolates are marked ‘first weighted’ - 50.4% more than when using the CLSI guideline. In real life, this novel algorithm will yield 5-10% more isolates than the classic CLSI guideline.

+

Instead of 1, now 7 isolates are flagged. In total, 78.7% of all isolates are marked ‘first weighted’ - 50.4% more than when using the CLSI guideline. In real life, this novel algorithm will yield 5-10% more isolates than the classic CLSI guideline.

As with filter_first_isolate(), there’s a shortcut for this new algorithm too:

data_1st <- data %>%
   filter_first_weighted_isolate()
-

So we end up with 15,719 isolates for analysis.

+

So we end up with 15,740 isolates for analysis.

We can remove unneeded columns:

data_1st <- data_1st %>%
   select(-c(first, keyab))
@@ -775,7 +775,6 @@ Longest: 1

head(data_1st)
- @@ -792,46 +791,13 @@ Longest: 1

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - + @@ -840,51 +806,78 @@ Longest: 1

- - - + + + + + + + + + + + + + + + + + + - - + - - - - + + + - - - + + + - - - - + + + - - - - + + + + - - + + + + + + + + + + + + + + + + + @@ -906,8 +899,8 @@ Longest: 1

data_1st %>% freq(genus, species)

Frequency table

Class: character
-Length: 15,719
-Available: 15,719 (100%, NA: 0 = 0%)
+Length: 15,740
+Available: 15,740 (100%, NA: 0 = 0%)
Unique: 4

Shortest: 16
Longest: 24

@@ -924,33 +917,33 @@ Longest: 24

- - - - + + + + - - - - + + + + - - - - + + + + - - - + + + @@ -977,50 +970,50 @@ Longest: 24

- - - - + + + + - - - - + + + + - + - - + + - + - - + + - - + + - - - + + +
date patient_id hospital
12014-09-10V9Hospital AB_STRPT_PNMNRRSRFGram-positiveStreptococcuspneumoniaeTRUE
32014-05-27U4Hospital BB_KLBSL_PNMNRSSSFGram-negativeKlebsiellapneumoniaeTRUE
42013-01-03I8Hospital B2014-04-15I4Hospital D B_ESCHR_COLI R RRS S M Gram-negative TRUE
62017-09-29T52011-02-09D1 Hospital AB_ESCHR_COLISSSSMGram-negativeEscherichiacoliTRUE
2013-12-16K4Hospital C B_STPHY_AURS S SR SSFM Gram-positive Staphylococcus aureus TRUE
82012-07-08B2
2017-08-23Z9 Hospital B B_ESCHR_COLIR S SRMSSF Gram-negative Escherichia coli TRUE
92014-01-07G7
2010-01-14N4 Hospital AB_STRPT_PNMNRRRB_STPHY_AURS RSSS M Gram-positiveStreptococcuspneumoniaeStaphylococcusaureusTRUE
2016-01-31N1Hospital DB_STPHY_AURSRSRSMGram-positiveStaphylococcusaureus TRUE
1 Escherichia coli7,90650.30%7,90650.30%7,93850.43%7,93850.43%
2 Staphylococcus aureus3,89824.80%11,80475.09%3,88324.67%11,82175.10%
3 Streptococcus pneumoniae2,33014.82%14,13489.92%2,31714.72%14,13889.82%
4 Klebsiella pneumoniae1,58510.08%15,7191,60210.18%15,740 100.00%
E. coli AMX378424438787906380823638947938
E. coli AMC625227413807906622331713987938
E. coli CIP60286050 01878790618887938
E. coli GEN71767130 073079068087938
K. pneumoniae AMX 0 01585158516021602
K. pneumoniae AMC 1241602841585613001602
@@ -1043,34 +1036,34 @@ Longest: 24

E. coli CIP -6028 +6050 0 -1878 -7906 +1888 +7938 K. pneumoniae CIP -1223 +1218 0 -362 -1585 +384 +1602 S. aureus CIP -2961 +2967 0 -937 -3898 +916 +3883 S. pneumoniae CIP -1777 +1756 0 -553 -2330 +561 +2317 @@ -1082,7 +1075,7 @@ Longest: 24

The functions resistance() and susceptibility() can be used to calculate antimicrobial resistance or susceptibility. For more specific analyses, the functions proportion_S(), proportion_SI(), proportion_I(), proportion_IR() and proportion_R() can be used to determine the proportion of a specific antimicrobial outcome.

As per the EUCAST guideline of 2019, we calculate resistance as the proportion of R (proportion_R(), equal to resistance()) and susceptibility as the proportion of S and I (proportion_SI(), equal to susceptibility()). These functions can be used on their own:

data_1st %>% resistance(AMX)
-# [1] 0.5382022
+# [1] 0.535324

Or can be used in conjuction with group_by() and summarise(), both from the dplyr package:

data_1st %>%
   group_by(hospital) %>%
@@ -1096,19 +1089,19 @@ Longest: 24

Hospital A -0.5410830 +0.5322921 Hospital B -0.5318994 +0.5393839 Hospital C -0.5342585 +0.5327529 Hospital D -0.5477099 +0.5348690 @@ -1127,23 +1120,23 @@ Longest: 24

Hospital A -0.5410830 -4783 +0.5322921 +4738 Hospital B -0.5318994 -5486 +0.5393839 +5421 Hospital C -0.5342585 -2306 +0.5327529 +2412 Hospital D -0.5477099 -3144 +0.5348690 +3169 @@ -1164,27 +1157,27 @@ Longest: 24

Escherichia -0.8254490 -0.9076651 -0.9864660 +0.8238851 +0.8982111 +0.9840010 Klebsiella -0.8208202 -0.9015773 -0.9892744 +0.8127341 +0.8951311 +0.9818976 Staphylococcus -0.8134941 -0.9214982 -0.9858902 +0.8246201 +0.9260881 +0.9863508 Streptococcus -0.5454936 +0.5463962 0.0000000 -0.5454936 +0.5463962 diff --git a/docs/articles/AMR_files/figure-html/plot 1-1.png b/docs/articles/AMR_files/figure-html/plot 1-1.png index 976c1028..a71b113d 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 1-1.png and b/docs/articles/AMR_files/figure-html/plot 1-1.png differ diff --git a/docs/articles/AMR_files/figure-html/plot 3-1.png b/docs/articles/AMR_files/figure-html/plot 3-1.png index 758e69c8..0d88e289 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 3-1.png and b/docs/articles/AMR_files/figure-html/plot 3-1.png differ diff --git a/docs/articles/AMR_files/figure-html/plot 4-1.png b/docs/articles/AMR_files/figure-html/plot 4-1.png index 46d8e39c..caff3eb9 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 4-1.png and b/docs/articles/AMR_files/figure-html/plot 4-1.png differ diff --git a/docs/articles/AMR_files/figure-html/plot 5-1.png b/docs/articles/AMR_files/figure-html/plot 5-1.png index cb65db17..fb3520ab 100644 Binary files a/docs/articles/AMR_files/figure-html/plot 5-1.png and b/docs/articles/AMR_files/figure-html/plot 5-1.png differ diff --git a/docs/articles/index.html b/docs/articles/index.html index fff50eda..1634e029 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011
diff --git a/docs/authors.html b/docs/authors.html index 96b42882..57272522 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011
diff --git a/docs/index.html b/docs/index.html index 27e8cfa2..d87a86f2 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011 diff --git a/docs/news/index.html b/docs/news/index.html index 45ddff3f..652c8e3f 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011 @@ -229,22 +229,23 @@ Source: NEWS.md -
-

-AMR 1.2.0.9010 Unreleased +
+

+AMR 1.2.0.9011 Unreleased

-
+

-Last updated: 17-Jun-2020 +Last updated: 22-Jun-2020

New

  • -

    Tidyverse selections, that help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. They can be used in any function that allows Tidyverse selections, like dplyr::select() and tidyr::pivot_longer():

    +

    Tidyverse selections for antibiotic classes, that help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. They can be used in any function that allows Tidyverse selections, like dplyr::select() and tidyr::pivot_longer():

    library(dplyr)
     
    +# Columns 'IPM' and 'MEM' are in the example_isolates data set
     example_isolates %>%
       select(carbapenems())
     #> Selecting carbapenems: `IPM` (imipenem), `MEM` (meropenem)
    @@ -258,6 +259,10 @@
       select(ab_class("mycobact"))
     #> Selecting antimycobacterials: `RIF` (rifampicin)
  • +
  • Added mo_domain() as an alias to mo_kingdom()

  • +
  • Added function filter_penicillins() to filter isolates on a specific result in any column with a name in the antimicrobial ‘penicillins’ class (more specific: ATC subgroup Beta-lactam antibacterials, penicillins)

  • +
  • Added official antimicrobial names to all filter_ab_class() functions, such as filter_aminoglycosides()

  • +
  • Added antibiotics code “FOX1” for cefoxitin screening (abbreviation “cfsc”) to the antibiotics data set

@@ -268,13 +273,11 @@
  • All *_join_microorganisms() functions and bug_drug_combinations() now return the original data class (e.g. tibbles and data.tables)
  • Fixed a bug where as.ab() would return an error on invalid input values
  • Fixed a bug for using grouped versions of rsi_df(), proportion_df() and count_df(), and fixed a bug where not all different antimicrobial results were added as rows
  • -
  • Added function filter_penicillins() to filter isolates on a specific result in any column with a name in the antimicrobial ‘penicillins’ class (more specific: ATC subgroup Beta-lactam antibacterials, penicillins)
  • -
  • Added official antimicrobial names to all filter_ab_class() functions, such as filter_aminoglycosides() -
  • -
  • Added antibiotics code “FOX1” for cefoxitin screening (abbreviation “cfsc”) to the antibiotics data set
  • Improved auto-determination for columns of types <mo> and <Date>
  • Fixed a bug in bug_drug_combinations() for when only one antibiotic was in the input data
  • +
  • Changed the summary for class <mo>, to highlight the %SI vs. %R
  • +
  • Improved error handling, giving more useful info when functions return an error
  • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 8034fc21..65ed51a2 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -10,7 +10,7 @@ articles: WHONET: WHONET.html benchmarks: benchmarks.html resistance_predict: resistance_predict.html -last_built: 2020-06-17T19:33Z +last_built: 2020-06-22T09:16Z urls: reference: https://msberends.gitlab.io/AMR/reference article: https://msberends.gitlab.io/AMR/articles diff --git a/docs/reference/antibiotic_class_selectors.html b/docs/reference/antibiotic_class_selectors.html index cf1a4595..204dae2b 100644 --- a/docs/reference/antibiotic_class_selectors.html +++ b/docs/reference/antibiotic_class_selectors.html @@ -82,7 +82,7 @@ AMR (for R) - 1.2.0.9008 + 1.2.0.9011
    diff --git a/docs/reference/as.mo.html b/docs/reference/as.mo.html index 261dcf76..54b93605 100644 --- a/docs/reference/as.mo.html +++ b/docs/reference/as.mo.html @@ -82,7 +82,7 @@ AMR (for R) - 1.2.0.9008 + 1.2.0.9011
    diff --git a/docs/reference/filter_ab_class.html b/docs/reference/filter_ab_class.html index 2dd575ba..36a19be3 100644 --- a/docs/reference/filter_ab_class.html +++ b/docs/reference/filter_ab_class.html @@ -82,7 +82,7 @@ AMR (for R) - 1.2.0.9007 + 1.2.0.9011

    diff --git a/docs/reference/index.html b/docs/reference/index.html index a1f84f38..9bb0888a 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011 @@ -360,7 +360,7 @@ -

    mo_name() mo_fullname() mo_shortname() mo_subspecies() mo_species() mo_genus() mo_family() mo_order() mo_class() mo_phylum() mo_kingdom() mo_type() mo_gramstain() mo_snomed() mo_ref() mo_authors() mo_year() mo_rank() mo_taxonomy() mo_synonyms() mo_info() mo_url() mo_property()

    +

    mo_name() mo_fullname() mo_shortname() mo_subspecies() mo_species() mo_genus() mo_family() mo_order() mo_class() mo_phylum() mo_kingdom() mo_domain() mo_type() mo_gramstain() mo_snomed() mo_ref() mo_authors() mo_year() mo_rank() mo_taxonomy() mo_synonyms() mo_info() mo_url() mo_property()

    Property of a microorganism

    diff --git a/docs/reference/join.html b/docs/reference/join.html index 46ee985a..2f7f8a22 100644 --- a/docs/reference/join.html +++ b/docs/reference/join.html @@ -82,7 +82,7 @@ AMR (for R) - 1.2.0.9010 + 1.2.0.9011 diff --git a/docs/reference/lifecycle.html b/docs/reference/lifecycle.html index cb52b428..1e413d34 100644 --- a/docs/reference/lifecycle.html +++ b/docs/reference/lifecycle.html @@ -84,7 +84,7 @@ This page contains a section for every lifecycle (with text borrowed from the af AMR (for R) - 1.2.0.9008 + 1.2.0.9011 diff --git a/docs/reference/mo_property.html b/docs/reference/mo_property.html index b3e0590f..53d40444 100644 --- a/docs/reference/mo_property.html +++ b/docs/reference/mo_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.2.0 + 1.2.0.9011 @@ -257,6 +257,8 @@ mo_kingdom(x, language = get_locale(), ...) +mo_domain(x, language = get_locale(), ...) + mo_type(x, language = get_locale(), ...) mo_gramstain(x, language = get_locale(), ...) @@ -319,14 +321,15 @@

    Details

    -

    All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for mo_ref(), mo_authors() and mo_year(). This leads to the following results:

      -
    • mo_name("Chlamydia psittaci") will return "Chlamydophila psittaci" (with a warning about the renaming)

    • -
    • mo_ref("Chlamydia psittaci") will return "Page, 1968" (with a warning about the renaming)

    • -
    • mo_ref("Chlamydophila psittaci") will return "Everett et al., 1999" (without a warning)

    • +

      All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for mo_ref(), mo_authors() and mo_year(). Please refer to this example, knowing that Escherichia blattae was renamed to Shimwellia blattae in 2010:

        +
      • mo_name("Escherichia blattae") will return "Shimwellia blattae" (with a message about the renaming)

      • +
      • mo_ref("Escherichia blattae") will return "Burgess et al., 1973" (with a message about the renaming)

      • +
      • mo_ref("Shimwellia blattae") will return "Priest et al., 2010" (without a message)

      -

      The short name - mo_shortname() - almost always returns the first character of the genus and the full species, like "E. coli". Exceptions are abbreviations of staphylococci and beta-haemolytic streptococci, like "CoNS" (Coagulase-Negative Staphylococci) and "GBS" (Group B Streptococci).

      -

      The Gram stain - mo_gramstain() - will be determined on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002) who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value NA.

      +

      The short name - mo_shortname() - almost always returns the first character of the genus and the full species, like "E. coli". Exceptions are abbreviations of staphylococci (like "CoNS", Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (like "GBS", Group B Streptococci). Please bear in mind that e.g. E. coli could mean Escherichia coli (kingdom of Bacteria) as well as Entamoeba coli (kingdom of Protozoa). Returning to the full name will be done using as.mo() internally, giving priority to bacteria and human pathogens, i.e. "E. coli" will be considered Escherichia coli. In other words, mo_fullname(mo_shortname("Entamoeba coli")) returns "Escherichia coli".

      +

      Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and sometimes as 'domain', the functions mo_kingdom() and mo_domain() return the exact same results.

      +

      The Gram stain - mo_gramstain() - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, PMID 11837318), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value NA.

      All output will be translated where possible.

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

      Stable lifecycle

      diff --git a/docs/reference/proportion.html b/docs/reference/proportion.html index 86290947..9bd826a5 100644 --- a/docs/reference/proportion.html +++ b/docs/reference/proportion.html @@ -83,7 +83,7 @@ resistance() should be used to calculate resistance, susceptibility() should be AMR (for R) - 1.2.0.9008 + 1.2.0.9011 diff --git a/man/mo_property.Rd b/man/mo_property.Rd index eee9640b..cd7e95fe 100644 --- a/man/mo_property.Rd +++ b/man/mo_property.Rd @@ -13,6 +13,7 @@ \alias{mo_class} \alias{mo_phylum} \alias{mo_kingdom} +\alias{mo_domain} \alias{mo_type} \alias{mo_gramstain} \alias{mo_snomed} @@ -48,6 +49,8 @@ mo_phylum(x, language = get_locale(), ...) mo_kingdom(x, language = get_locale(), ...) +mo_domain(x, language = get_locale(), ...) + mo_type(x, language = get_locale(), ...) mo_gramstain(x, language = get_locale(), ...) @@ -96,16 +99,18 @@ mo_property(x, property = "fullname", language = get_locale(), ...) Use these functions to return a specific property of a microorganism. All input values will be evaluated internally with \code{\link[=as.mo]{as.mo()}}, which makes it possible to use microbial abbreviations, codes and names as input. Please see \emph{Examples}. } \details{ -All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for \code{\link[=mo_ref]{mo_ref()}}, \code{\link[=mo_authors]{mo_authors()}} and \code{\link[=mo_year]{mo_year()}}. This leads to the following results: +All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for \code{\link[=mo_ref]{mo_ref()}}, \code{\link[=mo_authors]{mo_authors()}} and \code{\link[=mo_year]{mo_year()}}. Please refer to this example, knowing that \emph{Escherichia blattae} was renamed to \emph{Shimwellia blattae} in 2010: \itemize{ -\item \code{mo_name("Chlamydia psittaci")} will return \code{"Chlamydophila psittaci"} (with a warning about the renaming) -\item \code{mo_ref("Chlamydia psittaci")} will return \code{"Page, 1968"} (with a warning about the renaming) -\item \code{mo_ref("Chlamydophila psittaci")} will return \code{"Everett et al., 1999"} (without a warning) +\item \code{mo_name("Escherichia blattae")} will return \code{"Shimwellia blattae"} (with a message about the renaming) +\item \code{mo_ref("Escherichia blattae")} will return \code{"Burgess et al., 1973"} (with a message about the renaming) +\item \code{mo_ref("Shimwellia blattae")} will return \code{"Priest et al., 2010"} (without a message) } -The short name - \code{\link[=mo_shortname]{mo_shortname()}} - almost always returns the first character of the genus and the full species, like \emph{"E. coli"}. Exceptions are abbreviations of staphylococci and beta-haemolytic streptococci, like \emph{"CoNS"} (Coagulase-Negative Staphylococci) and \emph{"GBS"} (Group B Streptococci). +The short name - \code{\link[=mo_shortname]{mo_shortname()}} - almost always returns the first character of the genus and the full species, like \code{"E. coli"}. Exceptions are abbreviations of staphylococci (like \emph{"CoNS"}, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (like \emph{"GBS"}, Group B Streptococci). Please bear in mind that e.g. \emph{E. coli} could mean \emph{Escherichia coli} (kingdom of Bacteria) as well as \emph{Entamoeba coli} (kingdom of Protozoa). Returning to the full name will be done using \code{\link[=as.mo]{as.mo()}} internally, giving priority to bacteria and human pathogens, i.e. \code{"E. coli"} will be considered \emph{Escherichia coli}. In other words, \code{mo_fullname(mo_shortname("Entamoeba coli"))} returns \code{"Escherichia coli"}. -The Gram stain - \code{\link[=mo_gramstain]{mo_gramstain()}} - will be determined on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002) who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value \code{NA}. +Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and sometimes as 'domain', the functions \code{\link[=mo_kingdom]{mo_kingdom()}} and \code{\link[=mo_domain]{mo_domain()}} return the exact same results. + +The Gram stain - \code{\link[=mo_gramstain]{mo_gramstain()}} - will be determined based on the taxonomic kingdom and phylum. According to Cavalier-Smith (2002, \href{https://pubmed.ncbi.nlm.nih.gov/11837318}{PMID 11837318}), who defined subkingdoms Negibacteria and Posibacteria, only these phyla are Posibacteria: Actinobacteria, Chloroflexi, Firmicutes and Tenericutes. These bacteria are considered Gram-positive - all other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value \code{NA}. All output will be \link{translate}d where possible. diff --git a/tests/testthat/test-mo_property.R b/tests/testthat/test-mo_property.R index 908e6682..d2e4d6dd 100644 --- a/tests/testthat/test-mo_property.R +++ b/tests/testthat/test-mo_property.R @@ -26,6 +26,7 @@ test_that("mo_property works", { skip_on_cran() expect_equal(mo_kingdom("Escherichia coli"), "Bacteria") + expect_equal(mo_kingdom("Escherichia coli"), mo_domain("Escherichia coli")) expect_equal(mo_phylum("Escherichia coli"), "Proteobacteria") expect_equal(mo_class("Escherichia coli"), "Gammaproteobacteria") expect_equal(mo_order("Escherichia coli"), "Enterobacterales")