diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 43c44478..b328e2e0 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -58,8 +58,8 @@ jobs: - {os: ubuntu-16.04, r: '4.0', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - {os: ubuntu-16.04, r: '3.6', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - {os: ubuntu-16.04, r: '3.5', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - - {os: ubuntu-16.04, r: '3.4', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - - {os: ubuntu-16.04, r: '3.3', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} + # - {os: ubuntu-16.04, r: '3.4', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} + # - {os: ubuntu-16.04, r: '3.3', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true diff --git a/DESCRIPTION b/DESCRIPTION index 181b065e..d96ec232 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.4.0.9000 -Date: 2020-10-15 +Version: 1.4.0.9001 +Date: 2020-10-19 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 92eff153..0eadd0cb 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -150,6 +150,8 @@ export(is.mic) export(is.mo) export(is.rsi) export(is.rsi.eligible) +export(is_gram_negative) +export(is_gram_positive) export(key_antibiotics) export(key_antibiotics_equal) export(kurtosis) diff --git a/NEWS.md b/NEWS.md index 83f43cea..0e089b0e 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ -# AMR 1.4.0.9000 -## Last updated: 15 October 2020 +# AMR 1.4.0.9001 +## Last updated: 19 October 2020 + +### New +* Functions `is_gram_negative()` and `is_gram_positive()` as wrappers around `mo_gramstain()`. They always return `TRUE` or `FALSE`, thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria. + +### Changed +* For all function parameters in the code, it is now defined what the exact type of user input should be (inspired by the [`typed`](https://github.com/moodymudskipper/typed) package). If the user input for a certain function does not meet the requirements for a specific parameter (such as the class or length), an informative error will be thrown. This makes the package more robust and the use of it more reproducible and reliable. In total, more than 400 arguments were defined. +* Deprecated function `p_symbol()` that not really fits the scope of this package. It will be removed in a future version. See [here](https://github.com/msberends/AMR/blob/v1.4.0/R/p_symbol.R) for the source code to preserve it. ### Other * More extensive unit tests diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index ff79c8ec..448da7a2 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -329,6 +329,89 @@ create_ab_documentation <- function(ab) { out } +# a check for every single argument in all functions +meet_criteria <- function(object, + allow_class = NULL, + has_length = NULL, + looks_like = NULL, + is_in = NULL, + contains_column_class = NULL, + allow_NULL = FALSE, + allow_NA = FALSE, + ignore.case = FALSE, + .call_depth = 0) { # depth in calling + + obj_name <- deparse(substitute(object)) + call_depth <- -2 - abs(.call_depth) + + if (is.null(object)) { + stop_if(allow_NULL == FALSE, "argument `", obj_name, "` must not be NULL", call = call_depth) + return(invisible()) + } + if (is.null(dim(object)) && length(object) == 1 && is.na(object)) { + stop_if(allow_NA == FALSE, "argument `", obj_name, "` must not be NA", call = call_depth) + return(invisible()) + } + + vector_or <- function(v, quotes) { + if (length(v) == 1) { + return(paste0(ifelse(quotes, '"', ""), v, ifelse(quotes, '"', ""))) + } + # all commas except for last item, so will become '"val1", "val2", "val3" or "val4"' + paste0(paste0(ifelse(quotes, '"', ""), v[seq_len(length(v) - 1)], ifelse(quotes, '"', ""), collapse = ", "), + " or ", paste0(ifelse(quotes, '"', ""), v[length(v)], ifelse(quotes, '"', ""))) + } + + if (!is.null(allow_class)) { + stop_ifnot(inherits(object, allow_class), "argument `", obj_name, + "` must ", # ifelse(allow_NULL, "be NULL or must ", ""), + "be of class ", vector_or(allow_class, quotes = TRUE), + ", not \"", paste(class(object), collapse = "/"), "\"", + call = call_depth) + # check data.frames for data + if (inherits(object, "data.frame")) { + stop_if(any(dim(object) == 0), + "the data provided in argument `", obj_name, + "` must contain rows and columns (current dimensions: ", + paste(dim(object), collapse = " x "), ")", + call = call_depth) + } + } + if (!is.null(has_length)) { + stop_ifnot(length(object) %in% has_length, "argument `", obj_name, + "` must ", # ifelse(allow_NULL, "be NULL or must ", ""), + "be of length ", vector_or(has_length, quotes = FALSE), + ", not ", length(object), + call = call_depth) + } + if (!is.null(looks_like)) { + stop_ifnot(object %like% looks_like, "argument `", obj_name, + "` must ", # ifelse(allow_NULL, "be NULL or must ", ""), + "resemble the regular expression \"", looks_like, "\"", + call = call_depth) + } + if (!is.null(is_in)) { + if (ignore.case == TRUE) { + object <- tolower(object) + is_in <- tolower(is_in) + } + stop_ifnot(all(object %in% is_in, na.rm = TRUE), "argument `", obj_name, + "` must be ", + ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1, "one of: ", ""), + vector_or(is_in, quotes = TRUE), + ", not ", paste0("\"", object, "\"", collapse = "/"), "", + call = call_depth) + } + if (!is.null(contains_column_class)) { + stop_ifnot(any(sapply(object, function(col, columns_class = contains_column_class) inherits(col, columns_class)), na.rm = TRUE), + "the data provided in argument `", obj_name, + "` must contain at least one column of class <", contains_column_class, ">. ", + "See ?as.", contains_column_class, ".", + call = call_depth) + } + return(invisible()) +} + has_colour <- function() { # this is a base R version of crayon::has_color enabled <- getOption("crayon.enabled") diff --git a/R/ab.R b/R/ab.R index 4c8639d3..1b61fb49 100755 --- a/R/ab.R +++ b/R/ab.R @@ -82,6 +82,9 @@ #' ab_name("J01FA01") # "Erythromycin" #' ab_name("eryt") # "Erythromycin" as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(flag_multiple_results, allow_class = "logical", has_length = 1) + meet_criteria(info, allow_class = "logical", has_length = 1) check_dataset_integrity() diff --git a/R/ab_class_selectors.R b/R/ab_class_selectors.R index 0272b4db..1687ddfb 100644 --- a/R/ab_class_selectors.R +++ b/R/ab_class_selectors.R @@ -54,7 +54,7 @@ #' #' # get bug/drug combinations for only macrolides in Gram-positives: #' example_isolates %>% -#' filter(mo_gramstain(mo) %like% "pos") %>% +#' filter(mo %>% is_gram_positive()) %>% #' select(mo, macrolides()) %>% #' bug_drug_combinations() %>% #' format() @@ -148,9 +148,12 @@ tetracyclines <- function() { } ab_selector <- function(ab_class, function_name) { + meet_criteria(ab_class, allow_class = "character", has_length = 1, .call_depth = 1) + meet_criteria(function_name, allow_class = "character", has_length = 1, .call_depth = 1) + peek_vars_tidyselect <- import_fn("peek_vars", "tidyselect") vars_vct <- peek_vars_tidyselect(fn = function_name) - vars_df <- data.frame(as.list(vars_vct))[0, , drop = FALSE] + vars_df <- data.frame(as.list(vars_vct))[1, , drop = FALSE] colnames(vars_df) <- vars_vct ab_in_data <- get_column_abx(vars_df, info = FALSE) diff --git a/R/ab_from_text.R b/R/ab_from_text.R index 9b87df36..d12e4af9 100644 --- a/R/ab_from_text.R +++ b/R/ab_from_text.R @@ -92,12 +92,17 @@ ab_from_text <- function(text, translate_ab = FALSE, thorough_search = NULL, ...) { - if (missing(type)) { type <- type[1L] } + + meet_criteria(text) + meet_criteria(type, allow_class = "character", has_length = 1) + meet_criteria(collapse, has_length = 1, allow_NULL = TRUE) + meet_criteria(translate_ab, allow_NULL = FALSE) # get_translate_ab() will be more informative about what's allowed + meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE) + type <- tolower(trimws(type)) - stop_if(length(type) != 1, "`type` must be of length 1") text <- tolower(as.character(text)) text_split_all <- strsplit(text, "[ ;.,:\\|]") diff --git a/R/ab_property.R b/R/ab_property.R index b4526eed..4df2a9a9 100644 --- a/R/ab_property.R +++ b/R/ab_property.R @@ -89,6 +89,10 @@ #' ab_atc("cephthriaxone") #' ab_atc("seephthriaaksone") ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(tolower, allow_class = "logical", has_length = 1) + x <- translate_AMR(ab_validate(x = x, property = "name", ...), language = language) if (tolower == TRUE) { # use perl to only transform the first character @@ -102,18 +106,21 @@ ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) { #' @aliases ATC #' @export ab_atc <- function(x, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) ab_validate(x = x, property = "atc", ...) } #' @rdname ab_property #' @export ab_cid <- function(x, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) ab_validate(x = x, property = "cid", ...) } #' @rdname ab_property #' @export ab_synonyms <- function(x, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) syns <- ab_validate(x = x, property = "synonyms", ...) names(syns) <- x if (length(syns) == 1) { @@ -126,30 +133,38 @@ ab_synonyms <- function(x, ...) { #' @rdname ab_property #' @export ab_tradenames <- function(x, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) ab_synonyms(x, ...) } #' @rdname ab_property #' @export ab_group <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) translate_AMR(ab_validate(x = x, property = "group", ...), language = language) } #' @rdname ab_property #' @export ab_atc_group1 <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) translate_AMR(ab_validate(x = x, property = "atc_group1", ...), language = language) } #' @rdname ab_property #' @export ab_atc_group2 <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) translate_AMR(ab_validate(x = x, property = "atc_group2", ...), language = language) } #' @rdname ab_property #' @export ab_loinc <- function(x, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) loincs <- ab_validate(x = x, property = "loinc", ...) names(loincs) <- x if (length(loincs) == 1) { @@ -162,7 +177,10 @@ ab_loinc <- function(x, ...) { #' @rdname ab_property #' @export ab_ddd <- function(x, administration = "oral", units = FALSE, ...) { - stop_ifnot(administration %in% c("oral", "iv"), "`administration` must be 'oral' or 'iv'") + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1) + meet_criteria(units, allow_class = "logical", has_length = 1) + ddd_prop <- administration if (units == TRUE) { ddd_prop <- paste0(ddd_prop, "_units") @@ -175,6 +193,9 @@ ab_ddd <- function(x, administration = "oral", units = FALSE, ...) { #' @rdname ab_property #' @export ab_info <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x <- as.ab(x, ...) list(ab = as.character(x), atc = ab_atc(x), @@ -194,6 +215,9 @@ ab_info <- function(x, language = get_locale(), ...) { #' @rdname ab_property #' @export ab_url <- function(x, open = FALSE, ...) { + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(open, allow_class = "logical", has_length = 1) + ab <- as.ab(x = x, ... = ...) u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", ab_atc(ab), "&showdescription=no") u[is.na(ab_atc(ab))] <- NA_character_ @@ -218,10 +242,9 @@ ab_url <- function(x, open = FALSE, ...) { #' @rdname ab_property #' @export ab_property <- function(x, property = "name", language = get_locale(), ...) { - 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") - + meet_criteria(x, allow_class = c("character", "numeric", "integer")) + meet_criteria(property, is_in = colnames(antibiotics), has_length = 1) + meet_criteria(language, is_in = c(LANGUAGES_SUPPORTED, ""), has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) translate_AMR(ab_validate(x = x, property = property, ...), language = language) } diff --git a/R/age.R b/R/age.R index f755dbee..0183e59f 100755 --- a/R/age.R +++ b/R/age.R @@ -28,9 +28,11 @@ #' Calculates age in years based on a reference date, which is the sytem date at default. #' @inheritSection lifecycle Stable lifecycle #' @param x date(s), will be coerced with [as.POSIXlt()] -#' @param reference reference date(s) (defaults to today), will be coerced with [as.POSIXlt()] and cannot be lower than `x` +#' @param reference reference date(s) (defaults to today), will be coerced with [as.POSIXlt()] #' @param exact a logical to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366). #' @param na.rm a logical to indicate whether missing values should be removed +#' @param ... parameters passed on to [as.POSIXlt()], such as `origin` +#' @details Ages below 0 will be returned as `NA` with a warning. Ages above 120 will only give a warning. #' @return An [integer] (no decimals) if `exact = FALSE`, a [double] (with decimals) otherwise #' @seealso To split ages into groups, use the [age_groups()] function. #' @inheritSection AMR Read more on our website! @@ -44,13 +46,18 @@ #' df$age_exact <- age(df$birth_date, exact = TRUE) #' #' df -age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) { +age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) { + meet_criteria(x, allow_class = c("character", "Date", "POSIXt")) + meet_criteria(reference, allow_class = c("character", "Date", "POSIXt")) + meet_criteria(exact, allow_class = "logical", has_length = 1) + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + if (length(x) != length(reference)) { 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) + x <- as.POSIXlt(x, ...) + reference <- as.POSIXlt(reference, ...) # from https://stackoverflow.com/a/25450756/4575331 years_gap <- reference$year - x$year @@ -98,13 +105,13 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) { #' @param na.rm a [logical] to indicate whether missing values should be removed #' @details To split ages, the input for the `split_at` parameter can be: #' -#' * A numeric vector. A vector of e.g. `c(10, 20)` will split on 0-9, 10-19 and 20+. A value of only `50` will split on 0-49 and 50+. +#' * A numeric vector. A value of e.g. `c(10, 20)` will split `x` on 0-9, 10-19 and 20+. A value of only `50` will split `x` on 0-49 and 50+. #' The default is to split on young children (0-11), youth (12-24), young adults (25-54), middle-aged adults (55-74) and elderly (75+). #' * A character: #' - `"children"` or `"kids"`, equivalent of: `c(0, 1, 2, 4, 6, 13, 18)`. This will split on 0, 1, 2-3, 4-5, 6-12, 13-17 and 18+. #' - `"elderly"` or `"seniors"`, equivalent of: `c(65, 75, 85)`. This will split on 0-64, 65-74, 75-84, 85+. -#' - `"fives"`, equivalent of: `1:20 * 5`. This will split on 0-4, 5-9, 10-14, ..., 90-94, 95-99, 100+. -#' - `"tens"`, equivalent of: `1:10 * 10`. This will split on 0-9, 10-19, 20-29, ..., 80-89, 90-99, 100+. +#' - `"fives"`, equivalent of: `1:20 * 5`. This will split on 0-4, 5-9, ..., 95-99, 100+. +#' - `"tens"`, equivalent of: `1:10 * 10`. This will split on 0-9, 10-19, ..., 90-99, 100+. #' @return Ordered [factor] #' @seealso To determine ages, based on one or more reference dates, use the [age()] function. #' @export @@ -127,12 +134,11 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) { #' age_groups(ages, split_at = "fives") #' #' # split specifically for children -#' age_groups(ages, "children") -#' # same: #' age_groups(ages, c(1, 2, 4, 6, 13, 17)) +#' age_groups(ages, "children") #' #' \donttest{ -#' # resistance of ciprofloxacine per age group +#' # resistance of ciprofloxacin per age group #' library(dplyr) #' example_isolates %>% #' filter_first_isolate() %>% @@ -142,7 +148,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) { #' ggplot_rsi(x = "age_group", minimum = 0) #' } age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) { - stop_ifnot(is.numeric(x), "`x` must be numeric, not ", paste0(class(x), collapse = "/")) + meet_criteria(x, allow_class = c("numeric", "integer")) + meet_criteria(split_at, allow_class = c("numeric", "integer", "character")) + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + if (any(x < 0, na.rm = TRUE)) { x[x < 0] <- NA warning("NAs introduced for ages below 0.") @@ -169,17 +178,17 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) { # turn input values to 'split_at' indices y <- x - labs <- split_at + lbls <- split_at for (i in seq_len(length(split_at))) { y[x >= split_at[i]] <- i # create labels - labs[i - 1] <- paste0(unique(c(split_at[i - 1], split_at[i] - 1)), collapse = "-") + lbls[i - 1] <- paste0(unique(c(split_at[i - 1], split_at[i] - 1)), collapse = "-") } # last category - labs[length(labs)] <- paste0(split_at[length(split_at)], "+") + lbls[length(lbls)] <- paste0(split_at[length(split_at)], "+") - agegroups <- factor(labs[y], levels = labs, ordered = TRUE) + agegroups <- factor(lbls[y], levels = lbls, ordered = TRUE) if (isTRUE(na.rm)) { agegroups <- agegroups[!is.na(agegroups)] diff --git a/R/atc_online.R b/R/atc_online.R index f27d3d92..d379b119 100644 --- a/R/atc_online.R +++ b/R/atc_online.R @@ -78,6 +78,11 @@ atc_online_property <- function(atc_code, administration = "O", url = "https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no", url_vet = "https://www.whocc.no/atcvet/atcvet_index/?code=%s&showdescription=no") { + meet_criteria(atc_code, allow_class = "character") + meet_criteria(property, allow_class = "character", has_length = 1, is_in = c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups"), ignore.case = TRUE) + meet_criteria(administration, allow_class = "character", has_length = 1) + meet_criteria(url, allow_class = "character", has_length = 1, looks_like = "https?://") + meet_criteria(url_vet, allow_class = "character", has_length = 1, looks_like = "https?://") has_internet <- import_fn("has_internet", "curl") html_attr <- import_fn("html_attr", "rvest") @@ -99,24 +104,12 @@ atc_online_property <- function(atc_code, return(rep(NA, length(atc_code))) } - 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") { property <- "U" } - # validation of properties - valid_properties <- c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups") - valid_properties.bak <- valid_properties - property <- tolower(property) - valid_properties <- tolower(valid_properties) - - 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)) } else if (property == "groups") { @@ -199,11 +192,13 @@ atc_online_property <- function(atc_code, #' @rdname atc_online #' @export atc_online_groups <- function(atc_code, ...) { + meet_criteria(atc_code, allow_class = "character") atc_online_property(atc_code = atc_code, property = "groups", ...) } #' @rdname atc_online #' @export atc_online_ddd <- function(atc_code, ...) { + meet_criteria(atc_code, allow_class = "character") atc_online_property(atc_code = atc_code, property = "ddd", ...) } diff --git a/R/availability.R b/R/availability.R index afdecd7f..7381665e 100644 --- a/R/availability.R +++ b/R/availability.R @@ -43,7 +43,9 @@ #' availability() #' } availability <- function(tbl, width = NULL) { - stop_ifnot(is.data.frame(tbl), "`tbl` must be a data.frame") + meet_criteria(tbl, allow_class = "data.frame") + meet_criteria(width, allow_class = "numeric", allow_NULL = TRUE) + x <- sapply(tbl, function(x) { 1 - sum(is.na(x)) / length(x) }) diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 882c6ec2..c30a9a80 100644 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -31,8 +31,8 @@ #' @param combine_IR logical to indicate whether values R and I should be summed #' @param add_ab_group logical to indicate where the group of the antimicrobials must be included as a first column #' @param remove_intrinsic_resistant logical to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table -#' @param FUN the function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()] -#' @param translate_ab a character of length 1 containing column names of the [antibiotics] data set +#' @param FUN function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()] +#' @param translate_ab character of length 1 containing column names of the [antibiotics] data set #' @param ... arguments passed on to `FUN` #' @inheritParams rsi_df #' @inheritParams base::formatC @@ -61,9 +61,10 @@ bug_drug_combinations <- function(x, col_mo = NULL, FUN = mo_shortname, ...) { - 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.") - + meet_criteria(x, allow_class = "data.frame", contains_column_class = "rsi") + meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), has_length = 1, allow_NULL = TRUE) + meet_criteria(FUN, allow_class = "function", has_length = 1) + # try to find columns based on type # -- mo if (is.null(col_mo)) { @@ -121,6 +122,17 @@ format.bug_drug_combinations <- function(x, decimal.mark = getOption("OutDec"), big.mark = ifelse(decimal.mark == ",", ".", ","), ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(combine_SI, allow_class = "logical", has_length = 1) + meet_criteria(combine_IR, allow_class = "logical", has_length = 1) + meet_criteria(add_ab_group, allow_class = "logical", has_length = 1) + meet_criteria(remove_intrinsic_resistant, allow_class = "logical", has_length = 1) + meet_criteria(decimal.mark, allow_class = "character", has_length = 1) + meet_criteria(big.mark, allow_class = "character", has_length = 1) + x <- as.data.frame(x, stringsAsFactors = FALSE) x <- subset(x, total >= minimum) diff --git a/R/count.R b/R/count.R index 6c0a9fea..a81b306e 100755 --- a/R/count.R +++ b/R/count.R @@ -189,7 +189,6 @@ count_df <- function(data, language = get_locale(), combine_SI = TRUE, combine_IR = FALSE) { - rsi_calc_df(type = "count", data = data, translate_ab = translate_ab, diff --git a/R/deprecated.R b/R/deprecated.R index 7373124f..2096be94 100755 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -30,4 +30,18 @@ #' @inheritSection AMR Read more on our website! #' @keywords internal #' @name AMR-deprecated -# @export +#' @export +p_symbol <- function(p, emptychar = " ") { + .Deprecated(package = "AMR") + + p <- as.double(p) + s <- rep(NA_character_, length(p)) + + s[p <= 1] <- emptychar + s[p <= 0.100] <- "." + s[p <= 0.050] <- "*" + s[p <= 0.010] <- "**" + s[p <= 0.001] <- "***" + + s +} diff --git a/R/disk.R b/R/disk.R index 97ead089..0e5964d1 100644 --- a/R/disk.R +++ b/R/disk.R @@ -58,6 +58,9 @@ #' as.rsi(df) #' } as.disk <- function(x, na.rm = FALSE) { + meet_criteria(x, allow_class = c("disk", "character", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + if (!is.disk(x)) { x <- x %pm>% unlist() if (na.rm == TRUE) { @@ -109,6 +112,9 @@ as.disk <- function(x, na.rm = FALSE) { } all_valid_disks <- function(x) { + if (!inherits(x, c("disk", "character", "numeric", "integer"))) { + return(FALSE) + } x_disk <- suppressWarnings(as.disk(x[!is.na(x)])) !any(is.na(x_disk)) & !all(is.na(x)) } diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 70682c73..0691f81b 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -134,6 +134,13 @@ eucast_rules <- function(x, version_breakpoints = 10.0, version_expertrules = 3.2, ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE) + meet_criteria(info, allow_class = "logical", has_length = 1) + meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4), is_in = c("breakpoints", "expert", "other", "all")) + meet_criteria(verbose, allow_class = "logical", has_length = 1) + meet_criteria(version_breakpoints, allow_class = "numeric", has_length = 1) + meet_criteria(version_expertrules, allow_class = "numeric", has_length = 1) x_deparsed <- deparse(substitute(x)) if (length(x_deparsed) > 1 || !all(x_deparsed %like% "[a-z]+")) { @@ -172,18 +179,12 @@ eucast_rules <- function(x, } } - 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", info = info) } stop_if(is.null(col_mo), "`col_mo` must be set") - stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found") - - 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 != ",", ",", ".") @@ -576,7 +577,7 @@ eucast_rules <- function(x, # big speed gain! only analyse unique rows: pm_distinct(`.rowid`, .keep_all = TRUE) %pm>% as.data.frame(stringsAsFactors = FALSE) - x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE]) + x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE])) x <- x %pm>% left_join_microorganisms(by = col_mo, suffix = c("_oldcols", "")) x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL) diff --git a/R/filter_ab_class.R b/R/filter_ab_class.R index ea6b6bcc..987c14ca 100644 --- a/R/filter_ab_class.R +++ b/R/filter_ab_class.R @@ -80,16 +80,22 @@ filter_ab_class <- function(x, result = NULL, scope = "any", ...) { - + .call_depth <- list(...)$`.call_depth` + if (is.null(.call_depth)) { + .call_depth <- 0 + } + meet_criteria(x, allow_class = "data.frame", .call_depth = .call_depth) + meet_criteria(ab_class, allow_class = "character", has_length = 1, .call_depth = .call_depth) + meet_criteria(result, allow_class = "character", has_length = c(1, 2, 3), allow_NULL = TRUE, .call_depth = .call_depth) + meet_criteria(scope, allow_class = "character", has_length = 1, is_in = c("all", "any"), .call_depth = .call_depth) + check_dataset_integrity() - stop_ifnot(is.data.frame(x), "`x` must be a data frame") - + # save to return later x_class <- class(x) x.bak <- x x <- as.data.frame(x, stringsAsFactors = FALSE) - scope <- scope[1L] if (is.null(result)) { result <- c("S", "I", "R") } @@ -174,6 +180,7 @@ filter_aminoglycosides <- function(x, ab_class = "aminoglycoside", result = result, scope = scope, + .call_depth = 1, ...) } @@ -187,6 +194,7 @@ filter_carbapenems <- function(x, ab_class = "carbapenem", result = result, scope = scope, + .call_depth = 1, ...) } @@ -200,6 +208,7 @@ filter_cephalosporins <- function(x, ab_class = "cephalosporin", result = result, scope = scope, + .call_depth = 1, ...) } @@ -213,6 +222,7 @@ filter_1st_cephalosporins <- function(x, ab_class = "cephalosporins (1st gen.)", result = result, scope = scope, + .call_depth = 1, ...) } @@ -226,6 +236,7 @@ filter_2nd_cephalosporins <- function(x, ab_class = "cephalosporins (2nd gen.)", result = result, scope = scope, + .call_depth = 1, ...) } @@ -239,6 +250,7 @@ filter_3rd_cephalosporins <- function(x, ab_class = "cephalosporins (3rd gen.)", result = result, scope = scope, + .call_depth = 1, ...) } @@ -252,6 +264,7 @@ filter_4th_cephalosporins <- function(x, ab_class = "cephalosporins (4th gen.)", result = result, scope = scope, + .call_depth = 1, ...) } @@ -265,6 +278,7 @@ filter_5th_cephalosporins <- function(x, ab_class = "cephalosporins (5th gen.)", result = result, scope = scope, + .call_depth = 1, ...) } @@ -278,6 +292,7 @@ filter_fluoroquinolones <- function(x, ab_class = "fluoroquinolone", result = result, scope = scope, + .call_depth = 1, ...) } @@ -291,6 +306,7 @@ filter_glycopeptides <- function(x, ab_class = "glycopeptide", result = result, scope = scope, + .call_depth = 1, ...) } @@ -304,6 +320,7 @@ filter_macrolides <- function(x, ab_class = "macrolide", result = result, scope = scope, + .call_depth = 1, ...) } @@ -317,6 +334,7 @@ filter_penicillins <- function(x, ab_class = "penicillin", result = result, scope = scope, + .call_depth = 1, ...) } @@ -330,6 +348,7 @@ filter_tetracyclines <- function(x, ab_class = "tetracycline", result = result, scope = scope, + .call_depth = 1, ...) } diff --git a/R/first_isolate.R b/R/first_isolate.R index 2e12767a..51e72fdf 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -139,6 +139,23 @@ first_isolate <- function(x, info = interactive(), include_unknown = FALSE, ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_testcode, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_specimen, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_icu, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1) + 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(ignore_I, allow_class = "logical", has_length = 1) + meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(info, allow_class = "logical", has_length = 1) + meet_criteria(include_unknown, allow_class = "logical", has_length = 1) dots <- unlist(list(...)) if (length(dots) != 0) { @@ -352,20 +369,20 @@ first_isolate <- function(x, info = info) # 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) + 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 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), - TRUE, - FALSE) + x$newvar_row_index_sorted <= row.end & + x$newvar_genus_species != "" & + (x$other_pat_or_mo | x$more_than_episode_ago), + TRUE, + FALSE) } # first one as TRUE @@ -442,6 +459,10 @@ filter_first_isolate <- function(x, col_patient_id = NULL, col_mo = NULL, ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) subset(x, first_isolate(x = x, col_date = col_date, col_patient_id = col_patient_id, @@ -457,6 +478,11 @@ filter_first_weighted_isolate <- function(x, col_mo = NULL, col_keyantibiotics = NULL, ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) + meet_criteria(col_keyantibiotics, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x)) y <- x if (is.null(col_keyantibiotics)) { # first try to look for it diff --git a/R/ggplot_pca.R b/R/ggplot_pca.R index 2cd98d63..7f640453 100755 --- a/R/ggplot_pca.R +++ b/R/ggplot_pca.R @@ -53,9 +53,10 @@ #' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were: #' 1. Rewritten code to remove the dependency on packages `plyr`, `scales` and `grid` #' 2. Parametrised more options, like arrow and ellipse settings -#' 3. Added total amount of explained variance as a caption in the plot -#' 4. Cleaned all syntax based on the `lintr` package and added integrity checks -#' 5. Updated documentation +#' 3. Hardened all input possibilities by defining the exact type of user input for every parameter +#' 4. Added total amount of explained variance as a caption in the plot +#' 5. Cleaned all syntax based on the `lintr` package, fixed grammatical errors and added integrity checks +#' 6. Updated documentation #' @details The colours for labels and points can be changed by adding another scale layer for colour, like `scale_colour_viridis_d()` or `scale_colour_brewer()`. #' @rdname ggplot_pca #' @export @@ -85,7 +86,7 @@ #' } ggplot_pca <- function(x, choices = 1:2, - scale = TRUE, + scale = 1, pc.biplot = TRUE, labels = NULL, labels_textsize = 3, @@ -107,22 +108,27 @@ ggplot_pca <- function(x, ...) { stop_ifnot_installed("ggplot2") - stop_ifnot(length(choices) == 2, "`choices` must be of length 2") - stop_ifnot(is.logical(arrows), "`arrows` must be TRUE or FALSE") - stop_ifnot(is.logical(arrows_textangled), "`arrows_textangled` must be TRUE or FALSE") - stop_ifnot(is.logical(ellipse), "`ellipse` must be TRUE or FALSE") - stop_ifnot(is.logical(pc.biplot), "`pc.biplot` must be TRUE or FALSE") - stop_ifnot(is.logical(scale), "`scale` must be TRUE or FALSE") - stop_ifnot(is.numeric(arrows_alpha), "`arrows_alpha` must be numeric") - 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(base_textsize), "`base_textsize` must be numeric") - stop_ifnot(is.numeric(choices), "`choices` must be numeric") - stop_ifnot(is.numeric(ellipse_alpha), "`ellipse_alpha` must be numeric") - 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(labels_text_placement), "`labels_text_placement` must be numeric") - stop_ifnot(is.numeric(labels_textsize), "`labels_textsize` must be numeric") + meet_criteria(x, allow_class = c("prcomp", "princomp", "PCA", "lda")) + meet_criteria(choices, allow_class = c("numeric", "integer"), has_length = 2) + meet_criteria(scale, allow_class = c("numeric", "integer", "logical"), has_length = 1) + meet_criteria(pc.biplot, allow_class = "logical", has_length = 1) + meet_criteria(labels, allow_class = "character", allow_NULL = TRUE) + meet_criteria(labels_textsize, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(labels_text_placement, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(groups, allow_class = "character", allow_NULL = TRUE) + meet_criteria(ellipse, allow_class = "logical", has_length = 1) + meet_criteria(ellipse_prob, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(ellipse_size, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(ellipse_alpha, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(points_size, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(points_alpha, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(arrows, allow_class = "logical", has_length = 1) + meet_criteria(arrows_colour, allow_class = "character", has_length = 1) + meet_criteria(arrows_size, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(arrows_textsize, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(arrows_textangled, allow_class = "logical", has_length = 1) + meet_criteria(arrows_alpha, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(base_textsize, allow_class = c("numeric", "integer"), has_length = 1) calculations <- pca_calculations(pca_model = x, groups = groups, @@ -302,7 +308,7 @@ pca_calculations <- function(pca_model, v <- pca_model$scaling d.total <- sum(d ^ 2) } else { - stop("Expected a object of class prcomp, princomp, PCA, or lda") + stop("Expected an object of class prcomp, princomp, PCA, or lda") } # Scores diff --git a/R/ggplot_rsi.R b/R/ggplot_rsi.R index 59fe3852..413f3ebd 100755 --- a/R/ggplot_rsi.R +++ b/R/ggplot_rsi.R @@ -171,10 +171,29 @@ ggplot_rsi <- function(data, ...) { stop_ifnot_installed("ggplot2") - - x <- x[1] - facet <- facet[1] - + meet_criteria(data, allow_class = "data.frame", contains_column_class = "rsi") + meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE) + meet_criteria(x, allow_class = "character", has_length = 1) + meet_criteria(fill, allow_class = "character", has_length = 1) + meet_criteria(facet, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(breaks, allow_class = c("numeric", "integer")) + meet_criteria(limits, allow_class = c("numeric", "integer"), has_length = 2, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE) + meet_criteria(combine_SI, allow_class = "logical", has_length = 1) + meet_criteria(combine_IR, allow_class = "logical", has_length = 1) + meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE) + meet_criteria(colours, allow_class = "character") + meet_criteria(datalabels, allow_class = "logical", has_length = 1) + meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(datalabels.colour, allow_class = "character", has_length = 1) + meet_criteria(title, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(subtitle, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(caption, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(x.title, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(y.title, allow_class = "character", has_length = 1, allow_NULL = TRUE) + # we work with aes_string later on x_deparse <- deparse(substitute(x)) if (x_deparse != "x") { @@ -256,7 +275,15 @@ geom_rsi <- function(position = NULL, ...) { stop_ifnot_installed("ggplot2") - stop_if(is.data.frame(position), "`position` is invalid. Did you accidentally use '%pm>%' instead of '+'?") + stop_if(is.data.frame(position), "`position` is invalid. Did you accidentally use '%>%' instead of '+'?") + meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE) + meet_criteria(x, allow_class = "character", has_length = 1) + meet_criteria(fill, allow_class = "character", has_length = 1) + meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE) + meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(combine_SI, allow_class = "logical", has_length = 1) + meet_criteria(combine_IR, allow_class = "logical", has_length = 1) y <- "value" if (missing(position) | is.null(position)) { @@ -300,10 +327,10 @@ geom_rsi <- function(position = NULL, #' @rdname ggplot_rsi #' @export facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) { - - stop_ifnot_installed("ggplot2") - facet <- facet[1] + stop_ifnot_installed("ggplot2") + meet_criteria(facet, allow_class = "character", has_length = 1) + meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE) # we work with aes_string later on facet_deparse <- deparse(substitute(facet)) @@ -327,6 +354,8 @@ facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) { #' @export scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) { stop_ifnot_installed("ggplot2") + meet_criteria(breaks, allow_class = c("numeric", "integer")) + meet_criteria(limits, allow_class = c("numeric", "integer"), has_length = 2, allow_NULL = TRUE, allow_NA = TRUE) if (all(breaks[breaks != 0] > 1)) { breaks <- breaks / 100 @@ -344,6 +373,8 @@ scale_rsi_colours <- function(colours = c(S = "#61a8ff", IR = "#ff6961", R = "#ff6961")) { stop_ifnot_installed("ggplot2") + meet_criteria(colours, allow_class = "character") + # previous colour: palette = "RdYlGn" # previous colours: values = c("#b22222", "#ae9c20", "#7cfc00") @@ -383,6 +414,16 @@ labels_rsi_count <- function(position = NULL, datalabels.size = 3, datalabels.colour = "gray15") { stop_ifnot_installed("ggplot2") + meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE) + meet_criteria(x, allow_class = "character", has_length = 1) + meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE) + meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(combine_SI, allow_class = "logical", has_length = 1) + meet_criteria(combine_IR, allow_class = "logical", has_length = 1) + meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(datalabels.colour, allow_class = "character", has_length = 1) + if (is.null(position)) { position <- "fill" } diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index 441f498c..86068abb 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -30,7 +30,7 @@ #' @param x a [data.frame] #' @param search_string a text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x` #' @param verbose a logical to indicate whether additional info should be printed -#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic. **Longer columns names take precendence over shorter column names.** +#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic. **Longer columns names take precedence over shorter column names.** #' @return A column name of `x`, or `NULL` when no result is found. #' @export #' @inheritSection AMR Read more on our website! @@ -63,16 +63,13 @@ #' guess_ab_col(df, "ampicillin") #' # [1] "AMP_ED20" guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) { + meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(verbose, allow_class = "logical", has_length = 1) + if (is.null(x) & is.null(search_string)) { return(as.name("guess_ab_col")) } - 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") - search_string <- search_string[1] - } - search_string <- as.character(search_string) if (search_string %in% colnames(x)) { ab_result <- search_string @@ -116,6 +113,11 @@ get_column_abx <- function(x, verbose = FALSE, info = TRUE, ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(soft_dependencies, allow_class = "character", allow_NULL = TRUE) + meet_criteria(hard_dependencies, allow_class = "character", allow_NULL = TRUE) + meet_criteria(verbose, allow_class = "logical", has_length = 1) + meet_criteria(info, allow_class = "logical", has_length = 1) if (info == TRUE) { message(font_blue("NOTE: Auto-guessing columns suitable for analysis"), appendLF = FALSE) diff --git a/R/join_microorganisms.R b/R/join_microorganisms.R index 78fa72d4..659c980c 100755 --- a/R/join_microorganisms.R +++ b/R/join_microorganisms.R @@ -61,8 +61,12 @@ #' } #' } inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { + meet_criteria(x, allow_class = c("data.frame", "character")) + meet_criteria(by, allow_class = "character", allow_NULL = TRUE) + meet_criteria(suffix, allow_class = "character", has_length = 2) + check_dataset_integrity() - check_groups_before_join(x, "inner_join_microorganisms") + x <- check_groups_before_join(x, "inner_join_microorganisms") checked <- joins_check_df(x, by) x_class <- get_prejoined_class(x) x <- checked$x @@ -88,8 +92,12 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { #' @rdname join #' @export left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { + meet_criteria(x, allow_class = c("data.frame", "character")) + meet_criteria(by, allow_class = "character", allow_NULL = TRUE) + meet_criteria(suffix, allow_class = "character", has_length = 2) + check_dataset_integrity() - check_groups_before_join(x, "left_join_microorganisms") + x <- check_groups_before_join(x, "left_join_microorganisms") checked <- joins_check_df(x, by) x_class <- get_prejoined_class(x) x <- checked$x @@ -115,8 +123,12 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { #' @rdname join #' @export right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { + meet_criteria(x, allow_class = c("data.frame", "character")) + meet_criteria(by, allow_class = "character", allow_NULL = TRUE) + meet_criteria(suffix, allow_class = "character", has_length = 2) + check_dataset_integrity() - check_groups_before_join(x, "right_join_microorganisms") + x <- check_groups_before_join(x, "right_join_microorganisms") checked <- joins_check_df(x, by) x_class <- get_prejoined_class(x) x <- checked$x @@ -142,8 +154,12 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { #' @rdname join #' @export full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { + meet_criteria(x, allow_class = c("data.frame", "character")) + meet_criteria(by, allow_class = "character", allow_NULL = TRUE) + meet_criteria(suffix, allow_class = "character", has_length = 2) + check_dataset_integrity() - check_groups_before_join(x, "full_join_microorganisms") + x <- check_groups_before_join(x, "full_join_microorganisms") checked <- joins_check_df(x, by) x_class <- get_prejoined_class(x) x <- checked$x @@ -169,8 +185,11 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { #' @rdname join #' @export semi_join_microorganisms <- function(x, by = NULL, ...) { + meet_criteria(x, allow_class = c("data.frame", "character")) + meet_criteria(by, allow_class = "character", allow_NULL = TRUE) + check_dataset_integrity() - check_groups_before_join(x, "semi_join_microorganisms") + x <- check_groups_before_join(x, "semi_join_microorganisms") x_class <- get_prejoined_class(x) checked <- joins_check_df(x, by) x <- checked$x @@ -193,8 +212,11 @@ semi_join_microorganisms <- function(x, by = NULL, ...) { #' @rdname join #' @export anti_join_microorganisms <- function(x, by = NULL, ...) { + meet_criteria(x, allow_class = c("data.frame", "character")) + meet_criteria(by, allow_class = "character", allow_NULL = TRUE) + check_dataset_integrity() - check_groups_before_join(x, "anti_join_microorganisms") + x <- check_groups_before_join(x, "anti_join_microorganisms") checked <- joins_check_df(x, by) x_class <- get_prejoined_class(x) x <- checked$x @@ -255,6 +277,10 @@ get_prejoined_class <- function(x) { check_groups_before_join <- function(x, fn) { if (is.data.frame(x) && !is.null(attributes(x)$groups)) { - warning("Groups are dropped, since the ", fn, "() function relies on merge() from base R, not on join() from dplyr.", call. = FALSE) + x <- pm_ungroup(x) + attr(x, "groups") <- NULL + class(x) <- class(x)[!class(x) %like% "group"] + warning("Groups are dropped, since the ", fn, "() function relies on merge() from base R if dplyr is not installed.", call. = FALSE) } + x } diff --git a/R/key_antibiotics.R b/R/key_antibiotics.R index b7fb8b2e..e08807e6 100755 --- a/R/key_antibiotics.R +++ b/R/key_antibiotics.R @@ -27,14 +27,14 @@ #' #' These function can be used to determine first isolates (see [first_isolate()]). Using key antibiotics to determine first isolates is more reliable than without key antibiotics. These selected isolates will then be called first *weighted* isolates. #' @inheritSection lifecycle Stable lifecycle -#' @param x table with antibiotics coloms, like `AMX` or `amox` -#' @param y,z characters to compare +#' @param x a data.frame with antibiotics columns, like `AMX` or `amox` +#' @param y,z character vectors to compare #' @inheritParams first_isolate -#' @param universal_1,universal_2,universal_3,universal_4,universal_5,universal_6 column names of **broad-spectrum** antibiotics, case-insensitive. At default, the columns containing these antibiotics will be guessed with [guess_ab_col()]. -#' @param GramPos_1,GramPos_2,GramPos_3,GramPos_4,GramPos_5,GramPos_6 column names of antibiotics for **Gram-positives**, case-insensitive. At default, the columns containing these antibiotics will be guessed with [guess_ab_col()]. -#' @param GramNeg_1,GramNeg_2,GramNeg_3,GramNeg_4,GramNeg_5,GramNeg_6 column names of antibiotics for **Gram-negatives**, case-insensitive. At default, the columns containing these antibiotics will be guessed with [guess_ab_col()]. -#' @param warnings give warning about missing antibiotic columns, they will anyway be ignored -#' @param ... other parameters passed on to function +#' @param universal_1,universal_2,universal_3,universal_4,universal_5,universal_6 column names of **broad-spectrum** antibiotics, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]). +#' @param GramPos_1,GramPos_2,GramPos_3,GramPos_4,GramPos_5,GramPos_6 column names of antibiotics for **Gram-positives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]). +#' @param GramNeg_1,GramNeg_2,GramNeg_3,GramNeg_4,GramNeg_5,GramNeg_6 column names of antibiotics for **Gram-negatives**, case-insensitive. See details for which antibiotics will be used at default (which are guessed with [guess_ab_col()]). +#' @param warnings give a warning about missing antibiotic columns (they will be ignored) +#' @param ... other parameters passed on to functions #' @details The function [key_antibiotics()] returns a character vector with 12 antibiotic results for every isolate. These isolates can then be compared using [key_antibiotics_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antibiotics()] and ignored by [key_antibiotics_equal()]. #' #' The [first_isolate()] function only uses this function on the same microbial species from the same patient. Using this, e.g. an MRSA will be included after a susceptible *S. aureus* (MSSA) is found within the same patient episode. Without key antibiotic comparison it would not. See [first_isolate()] for more info. @@ -127,6 +127,27 @@ key_antibiotics <- function(x, GramNeg_6 = guess_ab_col(x, "meropenem"), warnings = TRUE, ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(universal_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(universal_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(universal_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(universal_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(universal_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(universal_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramPos_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramPos_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramPos_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramPos_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramPos_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramPos_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramNeg_1, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramNeg_2, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramNeg_3, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramNeg_4, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramNeg_5, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(GramNeg_6, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE) + meet_criteria(warnings, allow_class = "logical", has_length = 1) dots <- unlist(list(...)) if (length(dots) != 0) { @@ -258,14 +279,20 @@ key_antibiotics_equal <- function(y, ignore_I = TRUE, points_threshold = 2, info = FALSE) { + meet_criteria(y, allow_class = "character") + meet_criteria(z, allow_class = "character") + meet_criteria(type, allow_class = "character", has_length = c(1, 2)) + meet_criteria(ignore_I, allow_class = "logical", has_length = 1) + meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(info, allow_class = "logical", has_length = 1) + + stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal") # y is active row, z is lag x <- y y <- z type <- type[1] - 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/kurtosis.R b/R/kurtosis.R index 7efbd0ee..e5d0be77 100755 --- a/R/kurtosis.R +++ b/R/kurtosis.R @@ -35,6 +35,8 @@ #' @inheritSection AMR Read more on our website! #' @export kurtosis <- function(x, na.rm = FALSE, excess = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + meet_criteria(excess, allow_class = "logical", has_length = 1) UseMethod("kurtosis") } @@ -42,6 +44,8 @@ kurtosis <- function(x, na.rm = FALSE, excess = FALSE) { #' @rdname kurtosis #' @export kurtosis.default <- function(x, na.rm = FALSE, excess = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + meet_criteria(excess, allow_class = "logical", has_length = 1) x <- as.vector(x) if (na.rm == TRUE) { x <- x[!is.na(x)] @@ -56,6 +60,8 @@ kurtosis.default <- function(x, na.rm = FALSE, excess = FALSE) { #' @rdname kurtosis #' @export kurtosis.matrix <- function(x, na.rm = FALSE, excess = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + meet_criteria(excess, allow_class = "logical", has_length = 1) apply(x, 2, kurtosis.default, na.rm = na.rm, excess = excess) } @@ -63,5 +69,7 @@ kurtosis.matrix <- function(x, na.rm = FALSE, excess = FALSE) { #' @rdname kurtosis #' @export kurtosis.data.frame <- function(x, na.rm = FALSE, excess = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + meet_criteria(excess, allow_class = "logical", has_length = 1) sapply(x, kurtosis.default, na.rm = na.rm, excess = excess) } diff --git a/R/like.R b/R/like.R index 2224a170..177e67be 100755 --- a/R/like.R +++ b/R/like.R @@ -68,6 +68,10 @@ #' } #' } like <- function(x, pattern, ignore.case = TRUE) { + meet_criteria(x, allow_NA = TRUE) + meet_criteria(pattern, allow_class = "character") + meet_criteria(ignore.case, allow_class = "logical", has_length = 1) + # set to fixed if no regex found fixed <- !any(is_possibly_regex(pattern)) if (ignore.case == TRUE) { @@ -79,6 +83,10 @@ like <- function(x, pattern, ignore.case = TRUE) { if (length(pattern) > 1 & length(x) == 1) { x <- rep(x, length(pattern)) } + + if (all(is.na(x))) { + return(rep(FALSE, length(x))) + } if (length(pattern) > 1) { res <- vector(length = length(pattern)) @@ -137,18 +145,24 @@ like <- function(x, pattern, ignore.case = TRUE) { #' @rdname like #' @export "%like%" <- function(x, pattern) { + meet_criteria(x, allow_NA = TRUE) + meet_criteria(pattern, allow_class = "character") like(x, pattern, ignore.case = TRUE) } #' @rdname like #' @export "%like_case%" <- function(x, pattern) { + meet_criteria(x, allow_NA = TRUE) + meet_criteria(pattern, allow_class = "character") like(x, pattern, ignore.case = FALSE) } # don't export his one, it's just for convenience in eucast_rules() # match all Klebsiella and Raoultella, but not K. aerogenes: fullname %like_perl% "^(Klebsiella(?! aerogenes)|Raoultella)" "%like_perl%" <- function(x, pattern) { + meet_criteria(x) + meet_criteria(pattern, allow_class = "character") grepl(x = tolower(x), pattern = tolower(pattern), perl = TRUE, diff --git a/R/mdro.R b/R/mdro.R index 99604b9d..e72e4ca5 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -93,6 +93,13 @@ mdro <- function(x, combine_SI = TRUE, verbose = FALSE, ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(guideline, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE) + meet_criteria(info, allow_class = "logical", has_length = 1) + meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1) + meet_criteria(combine_SI, allow_class = "logical", has_length = 1) + meet_criteria(verbose, allow_class = "logical", has_length = 1) check_dataset_integrity() @@ -128,9 +135,8 @@ mdro <- function(x, warning("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call. = FALSE) guideline <- list(...)$country } - stop_ifnot(length(guideline) == 1, "`guideline` must be of length 1") - - guideline.bak <- guideline + + guideline.bak <- guideline guideline <- tolower(gsub("[^a-zA-Z0-9.]+", "", guideline)) if (is.null(guideline)) { # default to the paper by Magiorakos et al. (2012) @@ -631,7 +637,7 @@ mdro <- function(x, } } - x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE]) + x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE])) # join to microorganisms data set x <- left_join_microorganisms(x, by = col_mo) x$MDRO <- ifelse(!is.na(x$genus), 1, NA_integer_) @@ -1243,29 +1249,39 @@ mdro <- function(x, #' @rdname mdro #' @export brmo <- function(x, guideline = "BRMO", ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(guideline, allow_class = "character", has_length = 1) mdro(x, guideline = "BRMO", ...) } #' @rdname mdro #' @export mrgn <- function(x, guideline = "MRGN", ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(guideline, allow_class = "character", has_length = 1) mdro(x = x, guideline = "MRGN", ...) } #' @rdname mdro #' @export mdr_tb <- function(x, guideline = "TB", ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(guideline, allow_class = "character", has_length = 1) mdro(x = x, guideline = "TB", ...) } #' @rdname mdro #' @export mdr_cmi2012 <- function(x, guideline = "CMI2012", ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(guideline, allow_class = "character", has_length = 1) mdro(x = x, guideline = "CMI2012", ...) } #' @rdname mdro #' @export eucast_exceptional_phenotypes <- function(x, guideline = "EUCAST", ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(guideline, allow_class = "character", has_length = 1) mdro(x = x, guideline = "EUCAST", ...) } diff --git a/R/mic.R b/R/mic.R index dc9c23ba..720d34a5 100755 --- a/R/mic.R +++ b/R/mic.R @@ -56,6 +56,9 @@ #' plot(mic_data) #' barplot(mic_data) as.mic <- function(x, na.rm = FALSE) { + meet_criteria(x, allow_class = c("mic", "character", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(na.rm, allow_class = "logical", has_length = 1) + if (is.mic(x)) { x } else { @@ -134,6 +137,9 @@ as.mic <- function(x, na.rm = FALSE) { } all_valid_mics <- function(x) { + if (!inherits(x, c("mic", "character", "factor", "numeric", "integer"))) { + return(FALSE) + } x_mic <- tryCatch(suppressWarnings(as.mic(x[!is.na(x)])), error = function(e) NA) !any(is.na(x_mic)) & !all(is.na(x)) @@ -221,6 +227,11 @@ plot.mic <- function(x, xlab = "MIC value", axes = FALSE, ...) { + meet_criteria(main, allow_class = "character", has_length = 1) + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(axes, allow_class = "logical", has_length = 1) + barplot(table(droplevels.factor(x)), ylab = ylab, xlab = xlab, @@ -240,6 +251,11 @@ barplot.mic <- function(height, xlab = "MIC value", axes = FALSE, ...) { + meet_criteria(main, allow_class = "character", has_length = 1) + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(axes, allow_class = "logical", has_length = 1) + barplot(table(droplevels.factor(height)), ylab = ylab, xlab = xlab, diff --git a/R/mo.R b/R/mo.R index 7475929a..97f064e3 100755 --- a/R/mo.R +++ b/R/mo.R @@ -158,6 +158,13 @@ as.mo <- function(x, ignore_pattern = getOption("AMR_ignore_pattern"), language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(Becker, allow_class = c("logical", "character"), has_length = 1) + meet_criteria(Lancefield, allow_class = c("logical", "character"), has_length = 1) + meet_criteria(allow_uncertain, allow_class = c("logical", "numeric", "integer"), has_length = 1) + meet_criteria(reference_df, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(ignore_pattern, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) check_dataset_integrity() @@ -268,6 +275,20 @@ exec_as.mo <- function(x, actual_uncertainty = 1, actual_input = NULL, language = get_locale()) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(Becker, allow_class = c("logical", "character"), has_length = 1) + meet_criteria(Lancefield, allow_class = c("logical", "character"), has_length = 1) + meet_criteria(allow_uncertain, allow_class = c("logical", "numeric", "integer"), has_length = 1) + meet_criteria(reference_df, allow_class = "data.frame", allow_NULL = TRUE) + meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(microorganisms)) + meet_criteria(initial_search, allow_class = "logical", has_length = 1) + meet_criteria(dyslexia_mode, allow_class = "logical", has_length = 1) + meet_criteria(debug, allow_class = "logical", has_length = 1) + meet_criteria(ignore_pattern, allow_class = "character", has_length = 1, allow_NULL = TRUE) + meet_criteria(reference_data_to_use, allow_class = "data.frame") + meet_criteria(actual_uncertainty, allow_class = "numeric", has_length = 1) + meet_criteria(actual_input, allow_class = "character", allow_NULL = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) check_dataset_integrity() @@ -1607,8 +1628,8 @@ get_skimmers.mo <- function(column) { sfl( skim_type = "mo", unique_total = ~pm_n_distinct(., na.rm = TRUE), - gram_negative = ~sum(mo_gramstain(stats::na.omit(.), language = NULL) == "Gram-negative", na.rm = TRUE), - gram_positive = ~sum(mo_gramstain(stats::na.omit(.), language = NULL) == "Gram-positive", na.rm = TRUE), + gram_negative = ~sum(is_gram_negative(stats::na.omit(.))), + gram_positive = ~sum(is_gram_positive(stats::na.omit(.))), top_genus = ~names(sort(-table(mo_genus(stats::na.omit(.), language = NULL))))[1L], top_species = ~names(sort(-table(mo_name(stats::na.omit(.), language = NULL))))[1L] ) diff --git a/R/mo_matching_score.R b/R/mo_matching_score.R index 92e4676e..1311c164 100755 --- a/R/mo_matching_score.R +++ b/R/mo_matching_score.R @@ -53,6 +53,9 @@ #' mo_matching_score(x = "E. coli", #' n = c("Escherichia coli", "Entamoeba coli")) mo_matching_score <- function(x, n) { + meet_criteria(x, allow_class = c("character", "data.frame", "list")) + meet_criteria(n, allow_class = "character") + x <- parse_and_convert(x) # no dots and other non-whitespace characters x <- gsub("[^a-zA-Z0-9 \\(\\)]+", "", x) diff --git a/R/mo_property.R b/R/mo_property.R index 466300a6..b12fbcc5 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -27,7 +27,7 @@ #' #' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. Please see *Examples*. #' @inheritSection lifecycle Stable lifecycle -#' @param x any (vector of) text that can be coerced to a valid microorganism code with [as.mo()] +#' @param x any character (vector) that can be coerced to a valid microorganism code with [as.mo()] #' @param property one of the column names of the [microorganisms] data set or `"shortname"` #' @param language language of the returned text, defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation. #' @param ... other parameters passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern' @@ -41,7 +41,7 @@ #' #' 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](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`. +#' 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`. Functions [is_gram_negative()] and [is_gram_positive()] always return `TRUE` or `FALSE`, even for species outside the kingdom of Bacteria. #' #' All output will be [translate]d where possible. #' @@ -146,6 +146,9 @@ #' mo_info("E. coli") #' } mo_name <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "fullname", language = language, ...), language = language, only_unknown = FALSE) } @@ -156,6 +159,9 @@ mo_fullname <- mo_name #' @rdname mo_property #' @export mo_shortname <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x.mo <- as.mo(x, language = language, ...) metadata <- get_mo_failures_uncertainties_renamed() @@ -186,48 +192,72 @@ mo_shortname <- function(x, language = get_locale(), ...) { #' @rdname mo_property #' @export mo_subspecies <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "subspecies", language = language, ...), language = language, only_unknown = TRUE) } #' @rdname mo_property #' @export mo_species <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "species", language = language, ...), language = language, only_unknown = TRUE) } #' @rdname mo_property #' @export mo_genus <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "genus", language = language, ...), language = language, only_unknown = TRUE) } #' @rdname mo_property #' @export mo_family <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "family", language = language, ...), language = language, only_unknown = TRUE) } #' @rdname mo_property #' @export mo_order <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "order", language = language, ...), language = language, only_unknown = TRUE) } #' @rdname mo_property #' @export mo_class <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "class", language = language, ...), language = language, only_unknown = TRUE) } #' @rdname mo_property #' @export mo_phylum <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "phylum", language = language, ...), language = language, only_unknown = TRUE) } #' @rdname mo_property #' @export mo_kingdom <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = TRUE) } @@ -238,12 +268,18 @@ mo_domain <- mo_kingdom #' @rdname mo_property #' @export mo_type <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = FALSE) } #' @rdname mo_property #' @export mo_gramstain <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x.mo <- as.mo(x, language = language, ...) metadata <- get_mo_failures_uncertainties_renamed() @@ -272,21 +308,46 @@ mo_gramstain <- function(x, language = get_locale(), ...) { translate_AMR(x, language = language, only_unknown = FALSE) } +#' @rdname mo_property +#' @export +is_gram_negative <- function(x, ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + grams <- mo_gramstain(x, language = NULL, ...) + "Gram-negative" == grams & !is.na(grams) +} + +#' @rdname mo_property +#' @export +is_gram_positive <- function(x, ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + grams <- mo_gramstain(x, language = NULL, ...) + "Gram-positive" == grams & !is.na(grams) +} + #' @rdname mo_property #' @export mo_snomed <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + mo_validate(x = x, property = "snomed", language = language, ...) } #' @rdname mo_property #' @export mo_ref <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + mo_validate(x = x, property = "ref", language = language, ...) } #' @rdname mo_property #' @export mo_authors <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x <- mo_validate(x = x, property = "ref", language = language, ...) # remove last 4 digits and presumably the comma and space that preceed them x[!is.na(x)] <- gsub(",? ?[0-9]{4}", "", x[!is.na(x)]) @@ -296,6 +357,9 @@ mo_authors <- function(x, language = get_locale(), ...) { #' @rdname mo_property #' @export mo_year <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x <- mo_validate(x = x, property = "ref", language = language, ...) # get last 4 digits x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)]) @@ -305,12 +369,18 @@ mo_year <- function(x, language = get_locale(), ...) { #' @rdname mo_property #' @export mo_rank <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + mo_validate(x = x, property = "rank", language = language, ...) } #' @rdname mo_property #' @export mo_taxonomy <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x <- as.mo(x, language = language, ...) metadata <- get_mo_failures_uncertainties_renamed() @@ -330,6 +400,9 @@ mo_taxonomy <- function(x, language = get_locale(), ...) { #' @rdname mo_property #' @export mo_synonyms <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x <- as.mo(x, language = language, ...) metadata <- get_mo_failures_uncertainties_renamed() @@ -356,6 +429,9 @@ mo_synonyms <- function(x, language = get_locale(), ...) { #' @rdname mo_property #' @export mo_info <- function(x, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + x <- as.mo(x, language = language, ...) metadata <- get_mo_failures_uncertainties_renamed() @@ -379,6 +455,10 @@ mo_info <- function(x, language = get_locale(), ...) { #' @rdname mo_property #' @export mo_url <- function(x, open = FALSE, language = get_locale(), ...) { + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(open, allow_class = "logical", has_length = 1) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + mo <- as.mo(x = x, language = language, ... = ...) mo_names <- mo_name(mo) metadata <- get_mo_failures_uncertainties_renamed() @@ -408,15 +488,14 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) { #' @rdname mo_property #' @export mo_property <- function(x, property = "fullname", language = get_locale(), ...) { - 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") - + meet_criteria(x, allow_class = c("character", "data.frame", "list", "numeric", "integer"), allow_NA = TRUE) + meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(microorganisms)) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE) + translate_AMR(mo_validate(x = x, property = property, language = language, ...), language = language, only_unknown = TRUE) } mo_validate <- function(x, property, language, ...) { - check_dataset_integrity() if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo) & length(list(...)) == 0, error = function(e) FALSE)) { diff --git a/R/mo_source.R b/R/mo_source.R index a1d2c718..3f04dbb7 100644 --- a/R/mo_source.R +++ b/R/mo_source.R @@ -115,12 +115,12 @@ #' @export #' @inheritSection AMR Read more on our website! set_mo_source <- function(path) { + meet_criteria(path, allow_class = "character", has_length = 1) file_location <- path.expand("~/mo_source.rds") stop_ifnot(interactive(), "This function can only be used in interactive mode, since it must ask for the user's permission to write a file to their home folder.") - stop_ifnot(length(path) == 1, "`path` must be of length 1") - + if (is.null(path) || path %in% c(FALSE, "")) { options(mo_source = NULL) options(mo_source_timestamp = NULL) @@ -131,8 +131,7 @@ set_mo_source <- function(path) { return(invisible()) } - stop_ifnot(file.exists(path), - "file not found: ", path) + stop_ifnot(file.exists(path), "file not found: ", path) if (path %like% "[.]rds$") { df <- readRDS(path) @@ -237,7 +236,6 @@ get_mo_source <- function() { } mo_source_isvalid <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) { - check_dataset_integrity() if (deparse(substitute(x)) == "get_mo_source()") { diff --git a/R/p_symbol.R b/R/p_symbol.R deleted file mode 100755 index 1be98e46..00000000 --- a/R/p_symbol.R +++ /dev/null @@ -1,48 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2020 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -#' Symbol of a p-value -#' -#' Return the symbol related to the p-value: 0 '`***`' 0.001 '`**`' 0.01 '`*`' 0.05 '`.`' 0.1 ' ' 1. Values above `p = 1` will return `NA`. -#' @inheritSection lifecycle Questioning lifecycle -#' @param p p value -#' @param emptychar text to show when `p > 0.1` -#' @details **NOTE**: this function will be moved to the `cleaner` package when a new version is being published on CRAN. -#' @return Text -#' @inheritSection AMR Read more on our website! -#' @export -p_symbol <- function(p, emptychar = " ") { - - p <- as.double(p) - s <- rep(NA_character_, length(p)) - - s[p <= 1] <- emptychar - s[p <= 0.100] <- "." - s[p <= 0.050] <- "*" - s[p <= 0.010] <- "**" - s[p <= 0.001] <- "***" - - s -} diff --git a/R/pca.R b/R/pca.R index 87e99199..37c49e43 100755 --- a/R/pca.R +++ b/R/pca.R @@ -66,9 +66,12 @@ pca <- function(x, scale. = TRUE, tol = NULL, rank. = NULL) { - - stop_ifnot(is.data.frame(x), "`x` must be a data.frame") - stop_if(any(dim(x) == 0), "`x` must contain rows and columns") + meet_criteria(x, allow_class = "data.frame") + meet_criteria(retx, allow_class = "logical", has_length = 1) + meet_criteria(center, allow_class = "logical", has_length = 1) + meet_criteria(scale., allow_class = "logical", has_length = 1) + meet_criteria(tol, allow_class = "numeric", has_length = 1, allow_NULL = TRUE) + meet_criteria(rank., allow_class = "numeric", has_length = 1, allow_NULL = TRUE) # unset data.table, tibble, etc. # also removes groups made by dplyr::group_by diff --git a/R/proportion.R b/R/proportion.R index b5ac10ab..bd130438 100755 --- a/R/proportion.R +++ b/R/proportion.R @@ -266,7 +266,6 @@ proportion_df <- function(data, as_percent = FALSE, combine_SI = TRUE, combine_IR = FALSE) { - rsi_calc_df(type = "proportion", data = data, translate_ab = translate_ab, diff --git a/R/resistance_predict.R b/R/resistance_predict.R index 081db72b..d6ba79af 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -126,13 +126,20 @@ resistance_predict <- function(x, preserve_measurements = TRUE, info = interactive(), ...) { + meet_criteria(x, allow_class = "data.frame") + meet_criteria(col_ab, allow_class = "character", has_length = 1, is_in = colnames(x)) + meet_criteria(col_date, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE) + meet_criteria(year_min, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE) + meet_criteria(year_max, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE) + meet_criteria(year_every, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(model, allow_class = c("character", "function"), has_length = 1, allow_NULL = TRUE) + meet_criteria(I_as_S, allow_class = "logical", has_length = 1) + meet_criteria(preserve_measurements, allow_class = "logical", has_length = 1) + meet_criteria(info, allow_class = "logical", has_length = 1) - 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") - + dots <- unlist(list(...)) if (length(dots) != 0) { # backwards compatibility with old parameters @@ -300,6 +307,7 @@ rsi_predict <- resistance_predict #' @rdname resistance_predict plot.resistance_predict <- function(x, main = paste("Resistance Prediction of", x_name), ...) { x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") + meet_criteria(main, allow_class = "character", has_length = 1) if (attributes(x)$I_as_S == TRUE) { ylab <- "%R" @@ -342,11 +350,13 @@ ggplot_rsi_predict <- function(x, main = paste("Resistance Prediction of", x_name), ribbon = TRUE, ...) { + x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") + meet_criteria(main, allow_class = "character", has_length = 1) + meet_criteria(ribbon, allow_class = "logical", has_length = 1) 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, ")") if (attributes(x)$I_as_S == TRUE) { ylab <- "%R" diff --git a/R/rsi.R b/R/rsi.R index c8fd5762..e76f4768 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -31,7 +31,7 @@ #' @param x vector of values (for class [`mic`]: an MIC value in mg/L, for class [`disk`]: a disk diffusion radius in millimetres) #' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()], will be determined automatically if the `dplyr` package is installed #' @param ab any (vector of) text that can be coerced to a valid antimicrobial code with [as.ab()] -#' @param uti (Urinary Tract Infection) A vector with [logical]s (`TRUE` or `FALSE`) to specify whether a UTI specific interpretation from the guideline should be chosen. For using [as.rsi()] on a [data.frame], this can also be a column containing [logical]s or when left blank, the data set will be search for a 'specimen' and rows containing 'urin' in that column will be regarded isolates from a UTI. See *Examples*. +#' @param uti (Urinary Tract Infection) A vector with [logical]s (`TRUE` or `FALSE`) to specify whether a UTI specific interpretation from the guideline should be chosen. For using [as.rsi()] on a [data.frame], this can also be a column containing [logical]s or when left blank, the data set will be searched for a 'specimen' and rows containing 'urin' (such as 'urine', 'urina') in that column will be regarded isolates from a UTI. See *Examples*. #' @inheritParams first_isolate #' @param guideline defaults to the latest included EUCAST guideline, see Details for all options #' @param conserve_capped_values a logical to indicate that MIC values starting with `">"` (but not `">="`) must always return "R" , and that MIC values starting with `"<"` (but not `"<="`) must always return "S" @@ -193,6 +193,8 @@ is.rsi <- function(x) { #' @rdname as.rsi #' @export is.rsi.eligible <- function(x, threshold = 0.05) { + meet_criteria(threshold, allow_class = "numeric", has_length = 1) + stop_if(NCOL(x) > 1, "`x` must be a one-dimensional vector.") if (any(c("logical", "numeric", @@ -293,6 +295,13 @@ as.rsi.mic <- function(x, conserve_capped_values = FALSE, add_intrinsic_resistance = FALSE, ...) { + meet_criteria(x) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character")) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(uti, allow_class = "logical", has_length = c(1, length(x))) + meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1) + meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1) # for dplyr's across() cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE) @@ -323,6 +332,9 @@ as.rsi.mic <- function(x, "`data %>% mutate_at(vars(...), as.rsi, mo = .$x)`, where x is your column with microorganisms.\n\n", "To tranform all MIC values in a data set, use `data %>% as.rsi()` or data %>% mutate_if(is.mic, as.rsi).", call = FALSE) } + if (length(ab) == 1 && ab %like% "as.mic") { + stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE) + } ab_coerced <- suppressWarnings(as.ab(ab)) mo_coerced <- suppressWarnings(as.mo(mo)) @@ -364,6 +376,12 @@ as.rsi.disk <- function(x, uti = FALSE, add_intrinsic_resistance = FALSE, ...) { + meet_criteria(x) + meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE) + meet_criteria(ab, allow_class = c("ab", "character")) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(uti, allow_class = "logical", has_length = c(1, length(x))) + meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1) # for dplyr's across() cur_column_dplyr <- import_fn("cur_column", "dplyr", error_on_fail = FALSE) @@ -394,6 +412,9 @@ as.rsi.disk <- function(x, "`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 `data %>% as.rsi()` or data %>% mutate_if(is.disk, as.rsi).", call = FALSE) } + if (length(ab) == 1 && ab %like% "as.disk") { + stop_('No unambiguous name was supplied about the antibiotic (parameter "ab"). See ?as.rsi.', call = FALSE) + } ab_coerced <- suppressWarnings(as.ab(ab)) mo_coerced <- suppressWarnings(as.mo(mo)) @@ -433,6 +454,12 @@ as.rsi.data.frame <- function(x, uti = NULL, conserve_capped_values = FALSE, add_intrinsic_resistance = FALSE) { + meet_criteria(x, allow_class = "data.frame") # will also check for dimensions > 0 + meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1) + meet_criteria(uti, allow_class = "logical", has_length = c(1, nrow(x)), allow_NULL = TRUE) + meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1) + meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1) # -- UTIs col_uti <- uti @@ -731,6 +758,14 @@ type_sum.rsi <- function(x, ...) { freq.rsi <- function(x, ...) { x_name <- deparse(substitute(x)) x_name <- gsub(".*[$]", "", x_name) + if (x_name %in% c("x", ".")) { + # try again going through system calls + x_name <- na.omit(sapply(sys.calls(), + function(call) { + call_txt <- as.character(call) + ifelse(call_txt[1] %like% "freq$", call_txt[length(call_txt)], character(0)) + }))[1L] + } ab <- suppressMessages(suppressWarnings(as.ab(x_name))) freq.default <- import_fn("freq.default", "cleaner", error_on_fail = FALSE) digits <- list(...)$digits @@ -850,6 +885,13 @@ plot.rsi <- function(x, main = paste("Resistance Overview of", deparse(substitute(x))), axes = FALSE, ...) { + meet_criteria(lwd, allow_class = c("numeric", "integer"), has_length = 1) + meet_criteria(ylim, allow_class = c("numeric", "integer"), allow_NULL = TRUE) + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(main, allow_class = "character", has_length = 1) + meet_criteria(axes, allow_class = "logical", has_length = 1) + data <- as.data.frame(table(x), stringsAsFactors = FALSE) colnames(data) <- c("x", "n") data$s <- round((data$n / sum(data$n)) * 100, 1) @@ -901,6 +943,12 @@ barplot.rsi <- function(height, beside = TRUE, axes = beside, ...) { + meet_criteria(col, allow_class = "character", has_length = 3) + meet_criteria(xlab, allow_class = "character", has_length = 1) + meet_criteria(main, allow_class = "character", has_length = 1) + meet_criteria(ylab, allow_class = "character", has_length = 1) + meet_criteria(beside, allow_class = "logical", has_length = 1) + meet_criteria(axes, allow_class = "logical", has_length = 1) if (axes == TRUE) { par(mar = c(5, 4, 4, 2) + 0.1) diff --git a/R/rsi_calc.R b/R/rsi_calc.R index 50c1fd82..230b329d 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -36,10 +36,11 @@ rsi_calc <- function(..., as_percent = FALSE, 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) + meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1, 2, 3), .call_depth = 1) + meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, .call_depth = 1) + meet_criteria(as_percent, allow_class = "logical", has_length = 1, .call_depth = 1) + meet_criteria(only_all_tested, allow_class = "logical", has_length = 1, .call_depth = 1) + meet_criteria(only_count, allow_class = "logical", has_length = 1, .call_depth = 1) data_vars <- dots2vars(...) @@ -177,17 +178,21 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both" combine_SI = TRUE, combine_IR = FALSE, combine_SI_missing = FALSE) { + meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1, .call_depth = 1) + meet_criteria(data, allow_class = "data.frame", contains_column_class = "rsi", .call_depth = 1) + meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE, .call_depth = 1) + meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE, .call_depth = 1) + meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, .call_depth = 1) + meet_criteria(as_percent, allow_class = "logical", has_length = 1, .call_depth = 1) + meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = 1) + meet_criteria(combine_SI_missing, allow_class = "logical", has_length = 1, .call_depth = 1) check_dataset_integrity() - 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) + if (isTRUE(combine_IR) & isTRUE(combine_SI_missing)) { combine_SI <- FALSE } stop_if(isTRUE(combine_SI) & isTRUE(combine_IR), "either `combine_SI` or `combine_IR` can be TRUE, not both", call = -2) - stop_ifnot(is.numeric(minimum), "`minimum` must be numeric", call = -2) - stop_ifnot(is.logical(as_percent), "`as_percent` must be logical", call = -2) translate_ab <- get_translate_ab(translate_ab) diff --git a/R/rsi_df.R b/R/rsi_df.R index 80e7ea85..50fa711f 100644 --- a/R/rsi_df.R +++ b/R/rsi_df.R @@ -32,7 +32,6 @@ rsi_df <- function(data, as_percent = FALSE, combine_SI = TRUE, combine_IR = FALSE) { - rsi_calc_df(type = "both", data = data, translate_ab = translate_ab, diff --git a/R/skewness.R b/R/skewness.R index 00173e20..c34ad3cb 100755 --- a/R/skewness.R +++ b/R/skewness.R @@ -36,6 +36,7 @@ #' @inheritSection AMR Read more on our website! #' @export skewness <- function(x, na.rm = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) UseMethod("skewness") } @@ -43,6 +44,7 @@ skewness <- function(x, na.rm = FALSE) { #' @rdname skewness #' @export skewness.default <- function(x, na.rm = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) x <- as.vector(x) if (na.rm == TRUE) { x <- x[!is.na(x)] @@ -55,6 +57,7 @@ skewness.default <- function(x, na.rm = FALSE) { #' @rdname skewness #' @export skewness.matrix <- function(x, na.rm = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) apply(x, 2, skewness.default, na.rm = na.rm) } @@ -62,5 +65,6 @@ skewness.matrix <- function(x, na.rm = FALSE) { #' @rdname skewness #' @export skewness.data.frame <- function(x, na.rm = FALSE) { + meet_criteria(na.rm, allow_class = "logical", has_length = 1) sapply(x, skewness.default, na.rm = na.rm) } diff --git a/R/translate.R b/R/translate.R index 57abc10d..655ce655 100755 --- a/R/translate.R +++ b/R/translate.R @@ -73,7 +73,7 @@ #' mo_name("CoNS", language = "pt") #' #> "Staphylococcus coagulase negativo (CoNS)" get_locale <- function() { - # AMR versions prior to 1.3.0 used the environmental variable: + # AMR versions 1.3.0 and prior used the environmental variable: if (!identical("", Sys.getenv("AMR_locale"))) { options(AMR_locale = Sys.getenv("AMR_locale")) } @@ -101,20 +101,20 @@ get_locale <- function() { coerce_language_setting <- function(lang) { # grepl() with ignore.case = FALSE is faster than %like% - if (grepl("^(English|en_|EN_)", lang, ignore.case = FALSE)) { + if (grepl("^(English|en_|EN_)", lang, ignore.case = FALSE, perl = TRUE)) { # as first option to optimise speed "en" - } else if (grepl("^(German|Deutsch|de_|DE_)", lang, ignore.case = FALSE)) { + } else if (grepl("^(German|Deutsch|de_|DE_)", lang, ignore.case = FALSE, perl = TRUE)) { "de" - } else if (grepl("^(Dutch|Nederlands|nl_|NL_)", lang, ignore.case = FALSE)) { + } else if (grepl("^(Dutch|Nederlands|nl_|NL_)", lang, ignore.case = FALSE, perl = TRUE)) { "nl" - } else if (grepl("^(Spanish|Espa.+ol|es_|ES_)", lang, ignore.case = FALSE)) { + } else if (grepl("^(Spanish|Espa.+ol|es_|ES_)", lang, ignore.case = FALSE, perl = TRUE)) { "es" - } else if (grepl("^(Italian|Italiano|it_|IT_)", lang, ignore.case = FALSE)) { + } else if (grepl("^(Italian|Italiano|it_|IT_)", lang, ignore.case = FALSE, perl = TRUE)) { "it" - } else if (grepl("^(French|Fran.+ais|fr_|FR_)", lang, ignore.case = FALSE)) { + } else if (grepl("^(French|Fran.+ais|fr_|FR_)", lang, ignore.case = FALSE, perl = TRUE)) { "fr" - } else if (grepl("^(Portuguese|Portugu.+s|pt_|PT_)", lang, ignore.case = FALSE)) { + } else if (grepl("^(Portuguese|Portugu.+s|pt_|PT_)", lang, ignore.case = FALSE, perl = TRUE)) { "pt" } else { # other language -> set to English diff --git a/docs/404.html b/docs/404.html index 8086240f..46071773 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 5517d2cb..74a69438 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 diff --git a/docs/articles/index.html b/docs/articles/index.html index abc93919..6985cace 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 diff --git a/docs/authors.html b/docs/authors.html index 4f70c17e..4cc5ba93 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 diff --git a/docs/index.html b/docs/index.html index b5376c2c..cf92ad40 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 diff --git a/docs/news/index.html b/docs/news/index.html index b9994ee5..811e112d 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 @@ -236,14 +236,29 @@ Source: NEWS.md -
-

-AMR 1.4.0.9000 Unreleased +
+

+AMR 1.4.0.9001 Unreleased

-
+

-Last updated: 15 October 2020 +Last updated: 19 October 2020

+
+

+New

+ +
+
+

+Changed

+
    +
  • For all function parameters in the code, it is now defined what the exact type of user input should be (inspired by the typed package). If the user input for a certain function does not meet the requirements for a specific parameter (such as the class or length), an informative error will be thrown. This makes the package more robust and the use of it more reproducible and reliable. In total, more than 400 arguments were defined.
    • +
  • Deprecated function p_symbol() that not really fits the scope of this package. It will be removed in a future version. See here for the source code to preserve it.
    • +
+

Other

@@ -258,9 +273,9 @@ AMR 1.4.0 2020-10-08

Note: some changes in this version were suggested by anonymous reviewers from the journal we submitted our manuscipt about this package to. We are those reviewers very grateful for going through our code so thoroughly!

-
+

-New

+New

  • Support for ‘EUCAST Expert Rules’ / ‘EUCAST Intrinsic Resistance and Unusual Phenotypes’ version 3.2 of May 2020. With this addition to the previously implemented version 3.1 of 2016, the eucast_rules() function can now correct for more than 180 different antibiotics and the mdro() function can determine multidrug resistance based on more than 150 different antibiotics. All previously implemented versions of the EUCAST rules are now maintained and kept available in this package. The eucast_rules() function consequently gained the parameters version_breakpoints (at the moment defaults to v10.0, 2020) and version_expertrules (at the moment defaults to v3.2, 2020). The example_isolates data set now also reflects the change from v3.1 to v3.2. The mdro() function now accepts guideline == "EUCAST3.1" and guideline == "EUCAST3.2".

  • A new vignette and website page with info about all our public and freely available data sets, that can be downloaded as flat files or in formats for use in R, SPSS, SAS, Stata and Excel: https://msberends.github.io/AMR/articles/datasets.html

    • @@ -279,9 +294,9 @@

  • Support for skimming classes <rsi>, <mic>, <disk> and <mo> with the skimr package

-
+

-Changed

+Changed

  • Although advertised that this package should work under R 3.0.0, we still had a dependency on R 3.6.0. This is fixed, meaning that our package should now work under R 3.0.0.

  • @@ -359,9 +374,9 @@

    AMR 1.3.0 2020-07-31

    -
    +

    -New

    +New

    • Function ab_from_text() to retrieve antimicrobial drug names, doses and forms of administration from clinical texts in e.g. health care records, which also corrects for misspelling since it uses as.ab() internally

    • @@ -382,9 +397,9 @@

    • Added parameter conserve_capped_values to as.rsi() for interpreting MIC values - it makes sure that values starting with “<” (but not “<=”) will always return “S” and values starting with “>” (but not “>=”) will always return “R”. The default behaviour of as.rsi() has not changed, so you need to specifically do as.rsi(..., conserve_capped_values = TRUE).

    -
    +

    -Changed

    +Changed

    • Big speed improvement for using any function on microorganism codes from earlier package versions (prior to AMR v1.2.0), such as as.mo(), mo_name(), first_isolate(), eucast_rules(), mdro(), etc.

      @@ -450,7 +465,7 @@

      Making this package independent of especially the tidyverse (e.g. packages dplyr and tidyr) tremendously increases sustainability on the long term, since tidyverse functions change quite often. Good for users, but hard for package maintainers. Most of our functions are replaced with versions that only rely on base R, which keeps this package fully functional for many years to come, without requiring a lot of maintenance to keep up with other packages anymore. Another upside it that this package can now be used with all versions of R since R-3.0.0 (April 2013). Our package is being used in settings where the resources are very limited. Fewer dependencies on newer software is helpful for such settings.

      Negative effects of this change are:

        -
      • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
        • +
      • Function freq() that was borrowed from the cleaner package was removed. Use cleaner::freq(), or run library("cleaner") before you use freq().
      • Printing values of class mo or rsi in a tibble will no longer be in colour and printing rsi in a tibble will show the class <ord>, not <rsi> anymore. This is purely a visual effect.
      • All functions from the mo_* family (like mo_name() and mo_gramstain()) are noticeably slower when running on hundreds of thousands of rows.
      • For developers: classes mo and ab now both also inherit class character, to support any data transformation. This change invalidates code that checks for class length == 1.
        • @@ -458,9 +473,9 @@
    -
    +

    -Changed

    +Changed
    • Taxonomy:
        @@ -495,7 +510,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

        Other

          -
        • Removed previously deprecated function p.symbol() - it was replaced with p_symbol() +
        • Removed previously deprecated function p.symbol() - it was replaced with p_symbol()
        • Removed function read.4d(), that was only useful for reading data from an old test database.
        @@ -505,17 +520,17 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

        AMR 1.1.0 2020-04-15

        -
        +

        -New

        +New
        • Support for easy principal component analysis for AMR, using the new pca() function
        • Plotting biplots for principal component analysis using the new ggplot_pca() function
        -
        +

        -Changed

        +Changed
        • Improvements for the algorithm used by as.mo() (and consequently all mo_* functions, that use as.mo() internally):
            @@ -547,9 +562,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

            AMR 1.0.1 2020-02-23

            -
            +

            -Changed

            +Changed

            • Fixed important floating point error for some MIC comparisons in EUCAST 2020 guideline

            • @@ -572,9 +587,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/ AMR 1.0.0 2020-02-17

              This software is now out of beta and considered stable. Nonetheless, this package will be developed continually.

              -
              +

              -New

              +New
              • Support for the newest EUCAST Clinical Breakpoint Tables v.10.0, valid from 1 January 2020. This affects translation of MIC and disk zones using as.rsi() and inferred resistance and susceptibility using eucast_rules().
              • The repository of this package now contains a clean version of the EUCAST and CLSI guidelines from 2011-2020 to translate MIC and disk diffusion values to R/SI: https://github.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt. This allows for machine reading these guidelines, which is almost impossible with the Excel and PDF files distributed by EUCAST and CLSI. This file used to process the EUCAST Clinical Breakpoints Excel file can be found here.
                • @@ -666,9 +681,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
              -
              +

              -New

              +New

              • Functions susceptibility() and resistance() as aliases of proportion_SI() and proportion_R(), respectively. These functions were added to make it more clear that “I” should be considered susceptible and not resistant.

                @@ -778,13 +793,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/ #> invalid microorganism code, NA generated

              This is important, because a value like "testvalue" could never be understood by e.g. mo_name(), although the class would suggest a valid microbial code.

              • -

            • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

              • +

            • Function freq() has moved to a new package, clean (CRAN link), since creating frequency tables actually does not fit the scope of this package. The freq() function still works, since it is re-exported from the clean package (which will be installed automatically upon updating this AMR package).

            • Renamed data set septic_patients to example_isolates

            -
            +

            -New

            +New

            • Function bug_drug_combinations() to quickly get a data.frame with the results of all bug-drug combinations in a data set. The column containing microorganism codes is guessed automatically and its input is transformed with mo_shortname() at default:

              @@ -845,9 +860,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
            -
            +

            -Changed

            +Changed
            • Many algorithm improvements for as.mo() (of which some led to additions to the microorganisms data set). Many thanks to all contributors that helped improving the algorithms.
                @@ -889,7 +904,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
              • Improved filter_ab_class() to be more reliable and to support 5th generation cephalosporins
              • Function availability() now uses portion_R() instead of portion_IR(), to comply with EUCAST insights
              • Functions age() and age_groups() now have a na.rm parameter to remove empty values
                • -
              • Renamed function p.symbol() to p_symbol() (the former is now deprecated and will be removed in a future version)
                • +
              • Renamed function p.symbol() to p_symbol() (the former is now deprecated and will be removed in a future version)
              • Using negative values for x in age_groups() will now introduce NAs and not return an error anymore
              • Fix for determining the system’s language
              • Fix for key_antibiotics() on foreign systems
                • @@ -912,9 +927,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                AMR 0.7.1 2019-06-23

                -
                +

                -New

                +New

                • Function rsi_df() to transform a data.frame to a data set containing only the microbial interpretation (S, I, R), the antibiotic, the percentage of S/I/R and the number of available isolates. This is a convenient combination of the existing functions count_df() and portion_df() to immediately show resistance percentages and number of available isolates:

                  @@ -956,9 +971,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                • Function mo_synonyms() to get all previously accepted taxonomic names of a microorganism

                -
                +

                -Changed

                +Changed
                • Column names of output count_df() and portion_df() are now lowercase
                • Fixed bug in translation of microorganism names
                  • @@ -995,9 +1010,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                  AMR 0.7.0 2019-06-03

                  -
                  +

                  -New

                  +New
                  • Support for translation of disk diffusion and MIC values to RSI values (i.e. antimicrobial interpretations). Supported guidelines are EUCAST (2011 to 2019) and CLSI (2011 to 2019). Use as.rsi() on an MIC value (created with as.mic()), a disk diffusion value (created with the new as.disk()) or on a complete date set containing columns with MIC or disk diffusion values.
                  • Function mo_name() as alias of mo_fullname() @@ -1005,9 +1020,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                  • Added guidelines of the WHO to determine multi-drug resistance (MDR) for TB (mdr_tb()) and added a new vignette about MDR. Read this tutorial here on our website.
                  -
                  +

                  -Changed

                  +Changed
                  • Fixed a critical bug in first_isolate() where missing species would lead to incorrect FALSEs. This bug was not present in AMR v0.5.0, but was in v0.6.0 and v0.6.1.
                  • Fixed a bug in eucast_rules() where antibiotics from WHONET software would not be recognised
                    • @@ -1041,7 +1056,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                  • The age() function gained a new parameter exact to determine ages with decimals
                  • Removed deprecated functions guess_mo(), guess_atc(), EUCAST_rules(), interpretive_reading(), rsi()
                    • -
                  • Frequency tables (freq()): +
                  • Frequency tables (freq()):

                    • speed improvement for microbial IDs

                    • fixed factor level names for R Markdown

                      • @@ -1050,12 +1065,12 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                      support for boxplots:

                       septic_patients %>% 
-  freq(age) %>% 
+  freq(age) %>% 
   boxplot()
 # grouped boxplots:
 septic_patients %>% 
   group_by(hospital_id) %>% 
-  freq(age) %>%
+  freq(age) %>%
   boxplot()
                    @@ -1065,7 +1080,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                  • Added ceftazidim intrinsic resistance to Streptococci
                  • Changed default settings for age_groups(), to let groups of fives and tens end with 100+ instead of 120+
                    • -
                  • Fix for freq() for when all values are NA +
                  • Fix for freq() for when all values are NA
                  • Fix for first_isolate() for when dates are missing
                  • Improved speed of guess_ab_col() @@ -1091,9 +1106,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                    AMR 0.6.1 2019-03-29

                    -
                    +

                    -Changed

                    +Changed
                    • Fixed a critical bug when using eucast_rules() with verbose = TRUE
                      • @@ -1111,9 +1126,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                    • Contains the complete manual of this package and all of its functions with an explanation of their parameters
                    • Contains a comprehensive tutorial about how to conduct antimicrobial resistance analysis, import data from WHONET or SPSS and many more.
                    -
                    +

                    -New

                    +New

                    • BREAKING: removed deprecated functions, parameters and references to ‘bactid’. Use as.mo() to identify an MO code.

                    • @@ -1205,9 +1220,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                    • New vignettes about how to conduct AMR analysis, predict antimicrobial resistance, use the G-test and more. These are also available (and even easier readable) on our website: https://msberends.gitlab.io/AMR.

                    -
                    +

                    -Changed

                    +Changed
                    • Function eucast_rules():
                        @@ -1297,7 +1312,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                      • -
                    • Frequency tables (freq() function): +
                    • Frequency tables (freq() function):

                      • Support for tidyverse quasiquotation! Now you can create frequency tables of function outcomes:

                        @@ -1306,15 +1321,15 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/ # OLD WAY septic_patients %>% mutate(genus = mo_genus(mo)) %>% - freq(genus) + freq(genus) # NEW WAY septic_patients %>% - freq(mo_genus(mo)) + freq(mo_genus(mo)) # Even supports grouping variables: septic_patients %>% group_by(gender) %>% - freq(mo_genus(mo))
                    + freq(mo_genus(mo))

                  • Header info is now available as a list, with the header function

                  • The parameter header is now set to TRUE at default, even for markdown

                    • @@ -1347,9 +1362,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                    AMR 0.5.0 2018-11-30

                    -
                    +

                    -New

                    +New
                    • Repository moved to GitLab
                    • Function count_all to get all available isolates (that like all portion_* and count_* functions also supports summarise and group_by), the old n_rsi is now an alias of count_all @@ -1360,9 +1375,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                    • Functions mo_authors and mo_year to get specific values about the scientific reference of a taxonomic entry
                    -
                    +

                    -Changed

                    +Changed

                    • Functions MDRO, BRMO, MRGN and EUCAST_exceptional_phenotypes were renamed to mdro, brmo, mrgn and eucast_exceptional_phenotypes

                    • EUCAST_rules was renamed to eucast_rules, the old function still exists as a deprecated function

                      • @@ -1396,20 +1411,20 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                    • Using portion_* functions now throws a warning when total available isolate is below parameter minimum

                    • Functions as.mo, as.rsi, as.mic, as.atc and freq will not set package name as attribute anymore

                    • -

                      Frequency tables - freq():

                      +

                      Frequency tables - freq():

                      • Support for grouping variables, test with:

                         septic_patients %>% 
   group_by(hospital_id) %>% 
-  freq(gender)
                        + freq(gender)

                  • Support for (un)selecting columns:

                     septic_patients %>% 
-  freq(hospital_id) %>% 
+  freq(hospital_id) %>% 
   select(-count, -cum_count) # only get item, percent, cum_percent

                  • Check for hms::is.hms

                    • @@ -1427,7 +1442,7 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                  • Removed diacritics from all authors (columns microorganisms$ref and microorganisms.old$ref) to comply with CRAN policy to only allow ASCII characters

                  • Fix for mo_property not working properly

                  • Fix for eucast_rules where some Streptococci would become ceftazidime R in EUCAST rule 4.5

                    • -

                  • Support for named vectors of class mo, useful for top_freq()

                    • +

                  • Support for named vectors of class mo, useful for top_freq()

                  • ggplot_rsi and scale_y_percent have breaks parameter

                  • AI improvements for as.mo:

                    @@ -1468,9 +1483,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                    AMR 0.4.0 2018-10-01

                    -
                    +

                    -New

                    +New

                    • The data set microorganisms now contains all microbial taxonomic data from ITIS (kingdoms Bacteria, Fungi and Protozoa), the Integrated Taxonomy Information System, available via https://itis.gov. The data set now contains more than 18,000 microorganisms with all known bacteria, fungi and protozoa according ITIS with genus, species, subspecies, family, order, class, phylum and subkingdom. The new data set microorganisms.old contains all previously known taxonomic names from those kingdoms.

                    • @@ -1544,9 +1559,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                    • Renamed septic_patients$sex to septic_patients$gender

                    -
                    +

                    -Changed

                    +Changed

                    • Added three antimicrobial agents to the antibiotics data set: Terbinafine (D01BA02), Rifaximin (A07AA11) and Isoconazole (D01AC05)

                    • @@ -1588,12 +1603,12 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                      Support for types (classes) list and matrix for freq

                       my_matrix = with(septic_patients, matrix(c(age, gender), ncol = 2))
-freq(my_matrix)
                      +freq(my_matrix)

                    For lists, subsetting is possible:

                     my_list = list(age = septic_patients$age, gender = septic_patients$gender)
-my_list %>% freq(age)
-my_list %>% freq(gender)
                    +my_list %>% freq(age) +my_list %>% freq(gender)
                  @@ -1609,9 +1624,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                  AMR 0.3.0 2018-08-14

                  -
                  +

                  -New

                  +New
                  • BREAKING: rsi_df was removed in favour of new functions portion_R, portion_IR, portion_I, portion_SI and portion_S to selectively calculate resistance or susceptibility. These functions are 20 to 30 times faster than the old rsi function. The old function still works, but is deprecated. @@ -1667,13 +1682,13 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                    • A vignette to explain its usage
                    • Support for rsi (antimicrobial resistance) to use as input
                      • -
                    • Support for table to use as input: freq(table(x, y)) +
                    • Support for table to use as input: freq(table(x, y))
                    • Support for existing functions hist and plot to use a frequency table as input: hist(freq(df$age))
                    • Support for as.vector, as.data.frame, as_tibble and format
                      • -
                    • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn) +
                    • Support for quasiquotation: freq(mydata, mycolumn) is the same as mydata %>% freq(mycolumn)
                    • Function top_freq function to return the top/below n items as vector
                    • Header of frequency tables now also show Mean Absolute Deviaton (MAD) and Interquartile Range (IQR)
                      • @@ -1682,9 +1697,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                  -
                  +

                  -Changed

                  +Changed
                  • Improvements for forecasting with resistance_predict and added more examples
                  • More antibiotics added as parameters for EUCAST rules
                    • @@ -1746,9 +1761,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/

                    AMR 0.2.0 2018-05-03

                    -
                    +

                    -New

                    +New
                    • Full support for Windows, Linux and macOS
                    • Full support for old R versions, only R-3.0.0 (April 2013) or later is needed (needed packages may have other dependencies)
                      • @@ -1768,9 +1783,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
                    • New print format for tibbles and data.tables
                    -
                    +

                    -Changed

                    +Changed
                    • Fixed rsi class for vectors that contain only invalid antimicrobial interpretations
                    • Renamed dataset ablist to antibiotics diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index c488103b..3c3a246a 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -12,7 +12,7 @@ articles: datasets: datasets.html resistance_predict: resistance_predict.html welcome_to_AMR: welcome_to_AMR.html -last_built: 2020-10-15T07:41Z +last_built: 2020-10-19T15:08Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/AMR-deprecated.html b/docs/reference/AMR-deprecated.html index 52b674c7..a36f0183 100644 --- a/docs/reference/AMR-deprecated.html +++ b/docs/reference/AMR-deprecated.html @@ -50,7 +50,7 @@ - + @@ -82,7 +82,7 @@ AMR (for R) - 1.3.0.9015 + 1.4.0.9001
                    @@ -242,17 +242,7 @@

                    These functions are so-called 'Deprecated'. They will be removed in a future release. Using the functions will give a warning with the name of the function it has been replaced by (if there is one).

                    - 
                    portion_R(...)
-
-portion_IR(...)
-
-portion_I(...)
-
-portion_SI(...)
-
-portion_S(...)
-
-portion_df(...)
                    + 
                    p_symbol(p, emptychar = " ")

                    Retired lifecycle

                    @@ -265,7 +255,7 @@ The lifecycle of this function is retiredOn our website https://msberends.github.io/AMR you can find a comprehensive tutorial about how to conduct AMR analysis, the complete documentation of all functions (which reads a lot easier than here in R) and an example analysis using WHONET data. As we would like to better understand the backgrounds and needs of our users, please participate in our survey!

                    +

                    On our website https://msberends.github.io/AMR/ you can find a comprehensive tutorial about how to conduct AMR analysis, the complete documentation of all functions and an example analysis using WHONET data. As we would like to better understand the backgrounds and needs of our users, please participate in our survey!

                    @@ -242,7 +242,7 @@

                    Calculates age in years based on a reference date, which is the sytem date at default.

                  - 
                  age(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE)
                  + 
                  age(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...)

                  Arguments

                  @@ -253,7 +253,7 @@ - + @@ -263,11 +263,18 @@ + + + +
                  reference

                  reference date(s) (defaults to today), will be coerced with as.POSIXlt() and cannot be lower than x

                  reference date(s) (defaults to today), will be coerced with as.POSIXlt()
                  exactna.rm

                  a logical to indicate whether missing values should be removed
                  ...

                  parameters passed on to as.POSIXlt(), such as origin

                  Value

                  An integer (no decimals) if exact = FALSE, a double (with decimals) otherwise

                  +

                  Details

                  + +

                  Ages below 0 will be returned as NA with a warning. Ages above 120 will only give a warning.

                  Stable lifecycle

                  diff --git a/docs/reference/age_groups.html b/docs/reference/age_groups.html index a43010ca..b8c07046 100644 --- a/docs/reference/age_groups.html +++ b/docs/reference/age_groups.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
                  @@ -267,13 +267,13 @@

                  Details

                  To split ages, the input for the split_at parameter can be:

                    -

                  • A numeric vector. A vector of e.g. c(10, 20) will split on 0-9, 10-19 and 20+. A value of only 50 will split on 0-49 and 50+. +

                  • A numeric vector. A value of e.g. c(10, 20) will split x on 0-9, 10-19 and 20+. A value of only 50 will split x on 0-49 and 50+. The default is to split on young children (0-11), youth (12-24), young adults (25-54), middle-aged adults (55-74) and elderly (75+).

                  • A character:

                    • "children" or "kids", equivalent of: c(0, 1, 2, 4, 6, 13, 18). This will split on 0, 1, 2-3, 4-5, 6-12, 13-17 and 18+.

                    • "elderly" or "seniors", equivalent of: c(65, 75, 85). This will split on 0-64, 65-74, 75-84, 85+.

                      • -

                    • "fives", equivalent of: 1:20 * 5. This will split on 0-4, 5-9, 10-14, ..., 90-94, 95-99, 100+.

                      • -

                    • "tens", equivalent of: 1:10 * 10. This will split on 0-9, 10-19, 20-29, ..., 80-89, 90-99, 100+.

                      • +

                    • "fives", equivalent of: 1:20 * 5. This will split on 0-4, 5-9, ..., 95-99, 100+.

                      • +

                    • "tens", equivalent of: 1:10 * 10. This will split on 0-9, 10-19, ..., 90-99, 100+.

                  @@ -311,12 +311,11 @@ The lifecycle of this function is stableage_groups(ages, split_at = "fives") # split specifically for children -age_groups(ages, "children") -# same: age_groups(ages, c(1, 2, 4, 6, 13, 17)) +age_groups(ages, "children") # \donttest{ -# resistance of ciprofloxacine per age group +# resistance of ciprofloxacin per age group library(dplyr) example_isolates %>% filter_first_isolate() %>% diff --git a/docs/reference/antibiotic_class_selectors.html b/docs/reference/antibiotic_class_selectors.html index 50f8ada8..74776212 100644 --- a/docs/reference/antibiotic_class_selectors.html +++ b/docs/reference/antibiotic_class_selectors.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
                  @@ -315,7 +315,7 @@ # get bug/drug combinations for only macrolides in Gram-positives: example_isolates %>% - filter(mo_gramstain(mo) %like% "pos") %>% + filter(mo %>% is_gram_positive()) %>% select(mo, macrolides()) %>% bug_drug_combinations() %>% format() diff --git a/docs/reference/as.rsi.html b/docs/reference/as.rsi.html index eb7b2ba7..7b4d7d40 100644 --- a/docs/reference/as.rsi.html +++ b/docs/reference/as.rsi.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
                  @@ -311,7 +311,7 @@ uti -

                  (Urinary Tract Infection) A vector with logicals (TRUE or FALSE) to specify whether a UTI specific interpretation from the guideline should be chosen. For using as.rsi() on a data.frame, this can also be a column containing logicals or when left blank, the data set will be search for a 'specimen' and rows containing 'urin' in that column will be regarded isolates from a UTI. See Examples.

                  +

                  (Urinary Tract Infection) A vector with logicals (TRUE or FALSE) to specify whether a UTI specific interpretation from the guideline should be chosen. For using as.rsi() on a data.frame, this can also be a column containing logicals or when left blank, the data set will be searched for a 'specimen' and rows containing 'urin' (such as 'urine', 'urina') in that column will be regarded isolates from a UTI. See Examples.

                  conserve_capped_values diff --git a/docs/reference/bug_drug_combinations.html b/docs/reference/bug_drug_combinations.html index 403ecaf3..1a483cac 100644 --- a/docs/reference/bug_drug_combinations.html +++ b/docs/reference/bug_drug_combinations.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
                  @@ -272,7 +272,7 @@ FUN -

                  the function to call on the mo column to transform the microorganism IDs, defaults to mo_shortname()

                  +

                  function to call on the mo column to transform the microorganism IDs, defaults to mo_shortname()

                  ... @@ -280,7 +280,7 @@ translate_ab -

                  a character of length 1 containing column names of the antibiotics data set

                  +

                  character of length 1 containing column names of the antibiotics data set

                  language diff --git a/docs/reference/ggplot_pca.html b/docs/reference/ggplot_pca.html index 75762079..f030146e 100644 --- a/docs/reference/ggplot_pca.html +++ b/docs/reference/ggplot_pca.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0 + 1.4.0.9001
                @@ -242,30 +242,30 @@

                Produces a ggplot2 variant of a so-called biplot for PCA (principal component analysis), but is more flexible and more appealing than the base R biplot() function.

                - 
                ggplot_pca(
-  x,
-  choices = 1:2,
-  scale = TRUE,
-  pc.biplot = TRUE,
-  labels = NULL,
-  labels_textsize = 3,
-  labels_text_placement = 1.5,
-  groups = NULL,
-  ellipse = TRUE,
-  ellipse_prob = 0.68,
-  ellipse_size = 0.5,
-  ellipse_alpha = 0.5,
-  points_size = 2,
-  points_alpha = 0.25,
-  arrows = TRUE,
-  arrows_colour = "darkblue",
-  arrows_size = 0.5,
-  arrows_textsize = 3,
-  arrows_textangled = TRUE,
-  arrows_alpha = 0.75,
-  base_textsize = 10,
-  ...
-)
                + 
                ggplot_pca(
+  x,
+  choices = 1:2,
+  scale = 1,
+  pc.biplot = TRUE,
+  labels = NULL,
+  labels_textsize = 3,
+  labels_text_placement = 1.5,
+  groups = NULL,
+  ellipse = TRUE,
+  ellipse_prob = 0.68,
+  ellipse_size = 0.5,
+  ellipse_alpha = 0.5,
+  points_size = 2,
+  points_alpha = 0.25,
+  arrows = TRUE,
+  arrows_colour = "darkblue",
+  arrows_size = 0.5,
+  arrows_textsize = 3,
+  arrows_textangled = TRUE,
+  arrows_alpha = 0.75,
+  base_textsize = 10,
+  ...
+)

                Arguments

                @@ -375,8 +375,9 @@

                As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were:

                1. Rewritten code to remove the dependency on packages plyr, scales and grid

                2. Parametrised more options, like arrow and ellipse settings

                  3. +

                3. Hardened all input possibilities by defining the exact type of user input for every parameter

                4. Added total amount of explained variance as a caption in the plot

                  5. -

                5. Cleaned all syntax based on the lintr package and added integrity checks

                  6. +

                6. Cleaned all syntax based on the lintr package, fixed grammatical errors and added integrity checks

                7. Updated documentation

                @@ -395,25 +396,25 @@ The lifecycle of this function is maturing< # See ?example_isolates. # See ?pca for more info about Principal Component Analysis (PCA). -if (require("dplyr")) { - pca_model <- example_isolates %>% - filter(mo_genus(mo) == "Staphylococcus") %>% - group_by(species = mo_shortname(mo)) %>% - summarise_if (is.rsi, resistance) %>% - pca(FLC, AMC, CXM, GEN, TOB, TMP, SXT, CIP, TEC, TCY, ERY) +if (require("dplyr")) { + pca_model <- example_isolates %>% + filter(mo_genus(mo) == "Staphylococcus") %>% + group_by(species = mo_shortname(mo)) %>% + summarise_if (is.rsi, resistance) %>% + pca(FLC, AMC, CXM, GEN, TOB, TMP, SXT, CIP, TEC, TCY, ERY) # old (base R) - biplot(pca_model) + biplot(pca_model) # new - ggplot_pca(pca_model) + ggplot_pca(pca_model) - if (require("ggplot2")) { - ggplot_pca(pca_model) + - scale_colour_viridis_d() + - labs(title = "Title here") - } -} + if (require("ggplot2")) { + ggplot_pca(pca_model) + + scale_colour_viridis_d() + + labs(title = "Title here") + } +}
                -

                Site built with pkgdown 1.5.1.9000.

                +

                Site built with pkgdown 1.6.1.

                diff --git a/docs/reference/guess_ab_col.html b/docs/reference/guess_ab_col.html index 5e494859..8d6433eb 100644 --- a/docs/reference/guess_ab_col.html +++ b/docs/reference/guess_ab_col.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 @@ -266,7 +266,7 @@

                A column name of x, or NULL when no result is found.

                Details

                -

                You can look for an antibiotic (trade) name or abbreviation and it will search x and the antibiotics data set for any column containing a name or code of that antibiotic. Longer columns names take precendence over shorter column names.

                +

                You can look for an antibiotic (trade) name or abbreviation and it will search x and the antibiotics data set for any column containing a name or code of that antibiotic. Longer columns names take precedence over shorter column names.

                Stable lifecycle

                diff --git a/docs/reference/index.html b/docs/reference/index.html index 6a90f7cc..9b99eaad 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001 @@ -361,7 +361,7 @@                 @@ -630,9 +630,9 @@ - +
                -

                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()

                +

                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() is_gram_negative() is_gram_positive() mo_snomed() mo_ref() mo_authors() mo_year() mo_rank() mo_taxonomy() mo_synonyms() mo_info() mo_url() mo_property()

                Get properties of a microorganism
                -

                p_symbol()

                +

                p_symbol()

                Symbol of a p-value

                Deprecated functions
                diff --git a/docs/reference/key_antibiotics.html b/docs/reference/key_antibiotics.html index 5223b3bf..14e314da 100644 --- a/docs/reference/key_antibiotics.html +++ b/docs/reference/key_antibiotics.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
                @@ -281,7 +281,7 @@ x -

                table with antibiotics coloms, like AMX or amox

                +

                a data.frame with antibiotics columns, like AMX or amox

                col_mo @@ -289,27 +289,27 @@ universal_1, universal_2, universal_3, universal_4, universal_5, universal_6 -

                column names of broad-spectrum antibiotics, case-insensitive. At default, the columns containing these antibiotics will be guessed with guess_ab_col().

                +

                column names of broad-spectrum antibiotics, case-insensitive. See details for which antibiotics will be used at default (which are guessed with guess_ab_col()).

                GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6 -

                column names of antibiotics for Gram-positives, case-insensitive. At default, the columns containing these antibiotics will be guessed with guess_ab_col().

                +

                column names of antibiotics for Gram-positives, case-insensitive. See details for which antibiotics will be used at default (which are guessed with guess_ab_col()).

                GramNeg_1, GramNeg_2, GramNeg_3, GramNeg_4, GramNeg_5, GramNeg_6 -

                column names of antibiotics for Gram-negatives, case-insensitive. At default, the columns containing these antibiotics will be guessed with guess_ab_col().

                +

                column names of antibiotics for Gram-negatives, case-insensitive. See details for which antibiotics will be used at default (which are guessed with guess_ab_col()).

                warnings -

                give warning about missing antibiotic columns, they will anyway be ignored

                +

                give a warning about missing antibiotic columns (they will be ignored)

                ... -

                other parameters passed on to function

                +

                other parameters passed on to functions

                y, z -

                characters to compare

                +

                character vectors to compare

                type diff --git a/docs/reference/mo_property.html b/docs/reference/mo_property.html index 918f08c7..2aadafd4 100644 --- a/docs/reference/mo_property.html +++ b/docs/reference/mo_property.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
            @@ -270,6 +270,10 @@ mo_gramstain(x, language = get_locale(), ...) +is_gram_negative(x, ...) + +is_gram_positive(x, ...) + mo_snomed(x, language = get_locale(), ...) mo_ref(x, language = get_locale(), ...) @@ -295,7 +299,7 @@ x -

            any (vector of) text that can be coerced to a valid microorganism code with as.mo()

            +

            any character (vector) that can be coerced to a valid microorganism code with as.mo()

            language @@ -336,7 +340,7 @@

            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.

            +

            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. Functions is_gram_negative() and is_gram_positive() always return TRUE or FALSE, even for species outside the kingdom of Bacteria.

            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/plot.html b/docs/reference/plot.html index 22800a21..a234a888 100644 --- a/docs/reference/plot.html +++ b/docs/reference/plot.html @@ -82,7 +82,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
            diff --git a/docs/sitemap.xml b/docs/sitemap.xml index be793da0..ec5ac538 100644 --- a/docs/sitemap.xml +++ b/docs/sitemap.xml @@ -3,6 +3,9 @@ https://msberends.github.io/AMR//index.html + + https://msberends.github.io/AMR//reference/AMR-deprecated.html + https://msberends.github.io/AMR//reference/AMR.html @@ -129,9 +132,6 @@ https://msberends.github.io/AMR//reference/mo_source.html - - https://msberends.github.io/AMR//reference/p_symbol.html - https://msberends.github.io/AMR//reference/pca.html diff --git a/docs/survey.html b/docs/survey.html index 2613bece..0d95ba7d 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9000 + 1.4.0.9001
            diff --git a/man/AMR-deprecated.Rd b/man/AMR-deprecated.Rd new file mode 100644 index 00000000..86e9d21d --- /dev/null +++ b/man/AMR-deprecated.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/deprecated.R +\name{AMR-deprecated} +\alias{AMR-deprecated} +\alias{p_symbol} +\title{Deprecated functions} +\usage{ +p_symbol(p, emptychar = " ") +} +\description{ +These functions are so-called '\link{Deprecated}'. They will be removed in a future release. Using the functions will give a warning with the name of the function it has been replaced by (if there is one). +} +\section{Retired lifecycle}{ + +\if{html}{\figure{lifecycle_retired.svg}{options: style=margin-bottom:5px} \cr} +The \link[=lifecycle]{lifecycle} of this function is \strong{retired}. A retired function is no longer under active development, and (if appropiate) a better alternative is available. No new arguments will be added, and only the most critical bugs will be fixed. In a future version, this function will be removed. +} + +\section{Read more on our website!}{ + +On our website \url{https://msberends.github.io/AMR/} you can find \href{https://msberends.github.io/AMR/articles/AMR.html}{a comprehensive tutorial} about how to conduct AMR analysis, the \href{https://msberends.github.io/AMR/reference/}{complete documentation of all functions} and \href{https://msberends.github.io/AMR/articles/WHONET.html}{an example analysis using WHONET data}. As we would like to better understand the backgrounds and needs of our users, please \href{https://msberends.github.io/AMR/survey.html}{participate in our survey}! +} + +\keyword{internal} diff --git a/man/age.Rd b/man/age.Rd index 1c7c047f..7e99f68d 100644 --- a/man/age.Rd +++ b/man/age.Rd @@ -4,16 +4,18 @@ \alias{age} \title{Age in years of individuals} \usage{ -age(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) +age(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) } \arguments{ \item{x}{date(s), will be coerced with \code{\link[=as.POSIXlt]{as.POSIXlt()}}} -\item{reference}{reference date(s) (defaults to today), will be coerced with \code{\link[=as.POSIXlt]{as.POSIXlt()}} and cannot be lower than \code{x}} +\item{reference}{reference date(s) (defaults to today), will be coerced with \code{\link[=as.POSIXlt]{as.POSIXlt()}}} \item{exact}{a logical to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of \href{https://en.wikipedia.org/wiki/Year-to-date}{year-to-date} (YTD) of \code{x} by the number of days in the year of \code{reference} (either 365 or 366).} \item{na.rm}{a logical to indicate whether missing values should be removed} + +\item{...}{parameters passed on to \code{\link[=as.POSIXlt]{as.POSIXlt()}}, such as \code{origin}} } \value{ An \link{integer} (no decimals) if \code{exact = FALSE}, a \link{double} (with decimals) otherwise @@ -21,6 +23,9 @@ An \link{integer} (no decimals) if \code{exact = FALSE}, a \link{double} (with d \description{ Calculates age in years based on a reference date, which is the sytem date at default. } +\details{ +Ages below 0 will be returned as \code{NA} with a warning. Ages above 120 will only give a warning. +} \section{Stable lifecycle}{ \if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:5px} \cr} diff --git a/man/age_groups.Rd b/man/age_groups.Rd index 60d007e3..d0ad6c16 100644 --- a/man/age_groups.Rd +++ b/man/age_groups.Rd @@ -22,14 +22,14 @@ Split ages into age groups defined by the \code{split} parameter. This allows fo \details{ To split ages, the input for the \code{split_at} parameter can be: \itemize{ -\item A numeric vector. A vector of e.g. \code{c(10, 20)} will split on 0-9, 10-19 and 20+. A value of only \code{50} will split on 0-49 and 50+. +\item A numeric vector. A value of e.g. \code{c(10, 20)} will split \code{x} on 0-9, 10-19 and 20+. A value of only \code{50} will split \code{x} on 0-49 and 50+. The default is to split on young children (0-11), youth (12-24), young adults (25-54), middle-aged adults (55-74) and elderly (75+). \item A character: \itemize{ \item \code{"children"} or \code{"kids"}, equivalent of: \code{c(0, 1, 2, 4, 6, 13, 18)}. This will split on 0, 1, 2-3, 4-5, 6-12, 13-17 and 18+. \item \code{"elderly"} or \code{"seniors"}, equivalent of: \code{c(65, 75, 85)}. This will split on 0-64, 65-74, 75-84, 85+. -\item \code{"fives"}, equivalent of: \code{1:20 * 5}. This will split on 0-4, 5-9, 10-14, ..., 90-94, 95-99, 100+. -\item \code{"tens"}, equivalent of: \code{1:10 * 10}. This will split on 0-9, 10-19, 20-29, ..., 80-89, 90-99, 100+. +\item \code{"fives"}, equivalent of: \code{1:20 * 5}. This will split on 0-4, 5-9, ..., 95-99, 100+. +\item \code{"tens"}, equivalent of: \code{1:10 * 10}. This will split on 0-9, 10-19, ..., 90-99, 100+. } } } @@ -64,12 +64,11 @@ age_groups(ages, 1:20 * 5) age_groups(ages, split_at = "fives") # split specifically for children -age_groups(ages, "children") -# same: age_groups(ages, c(1, 2, 4, 6, 13, 17)) +age_groups(ages, "children") \donttest{ -# resistance of ciprofloxacine per age group +# resistance of ciprofloxacin per age group library(dplyr) example_isolates \%>\% filter_first_isolate() \%>\% diff --git a/man/antibiotic_class_selectors.Rd b/man/antibiotic_class_selectors.Rd index dab9fe1b..ec087d35 100644 --- a/man/antibiotic_class_selectors.Rd +++ b/man/antibiotic_class_selectors.Rd @@ -85,7 +85,7 @@ if (require("dplyr")) { # get bug/drug combinations for only macrolides in Gram-positives: example_isolates \%>\% - filter(mo_gramstain(mo) \%like\% "pos") \%>\% + filter(mo \%>\% is_gram_positive()) \%>\% select(mo, macrolides()) \%>\% bug_drug_combinations() \%>\% format() diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index 6b65b034..e33a6ffb 100755 --- a/man/as.rsi.Rd +++ b/man/as.rsi.Rd @@ -60,7 +60,7 @@ is.rsi.eligible(x, threshold = 0.05) \item{guideline}{defaults to the latest included EUCAST guideline, see Details for all options} -\item{uti}{(Urinary Tract Infection) A vector with \link{logical}s (\code{TRUE} or \code{FALSE}) to specify whether a UTI specific interpretation from the guideline should be chosen. For using \code{\link[=as.rsi]{as.rsi()}} on a \link{data.frame}, this can also be a column containing \link{logical}s or when left blank, the data set will be search for a 'specimen' and rows containing 'urin' in that column will be regarded isolates from a UTI. See \emph{Examples}.} +\item{uti}{(Urinary Tract Infection) A vector with \link{logical}s (\code{TRUE} or \code{FALSE}) to specify whether a UTI specific interpretation from the guideline should be chosen. For using \code{\link[=as.rsi]{as.rsi()}} on a \link{data.frame}, this can also be a column containing \link{logical}s or when left blank, the data set will be searched for a 'specimen' and rows containing 'urin' (such as 'urine', 'urina') in that column will be regarded isolates from a UTI. See \emph{Examples}.} \item{conserve_capped_values}{a logical to indicate that MIC values starting with \code{">"} (but not \code{">="}) must always return "R" , and that MIC values starting with \code{"<"} (but not \code{"<="}) must always return "S"} diff --git a/man/bug_drug_combinations.Rd b/man/bug_drug_combinations.Rd index c3e950c2..cb6ddce1 100644 --- a/man/bug_drug_combinations.Rd +++ b/man/bug_drug_combinations.Rd @@ -29,11 +29,11 @@ bug_drug_combinations(x, col_mo = NULL, FUN = mo_shortname, ...) \item{col_mo}{column name of the IDs of the microorganisms (see \code{\link[=as.mo]{as.mo()}}), defaults to the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.} -\item{FUN}{the function to call on the \code{mo} column to transform the microorganism IDs, defaults to \code{\link[=mo_shortname]{mo_shortname()}}} +\item{FUN}{function to call on the \code{mo} column to transform the microorganism IDs, defaults to \code{\link[=mo_shortname]{mo_shortname()}}} \item{...}{arguments passed on to \code{FUN}} -\item{translate_ab}{a character of length 1 containing column names of the \link{antibiotics} data set} +\item{translate_ab}{character of length 1 containing column names of the \link{antibiotics} data set} \item{language}{language of the returned text, defaults to system language (see \code{\link[=get_locale]{get_locale()}}) and can also be set with \code{getOption("AMR_locale")}. Use \code{language = NULL} or \code{language = ""} to prevent translation.} diff --git a/man/ggplot_pca.Rd b/man/ggplot_pca.Rd index a822f2c6..e8ea5ac7 100644 --- a/man/ggplot_pca.Rd +++ b/man/ggplot_pca.Rd @@ -10,8 +10,9 @@ As per their GPL-2 licence that demands documentation of code changes, the chang \enumerate{ \item Rewritten code to remove the dependency on packages \code{plyr}, \code{scales} and \code{grid} \item Parametrised more options, like arrow and ellipse settings +\item Hardened all input possibilities by defining the exact type of user input for every parameter \item Added total amount of explained variance as a caption in the plot -\item Cleaned all syntax based on the \code{lintr} package and added integrity checks +\item Cleaned all syntax based on the \code{lintr} package, fixed grammatical errors and added integrity checks \item Updated documentation } } @@ -19,7 +20,7 @@ As per their GPL-2 licence that demands documentation of code changes, the chang ggplot_pca( x, choices = 1:2, - scale = TRUE, + scale = 1, pc.biplot = TRUE, labels = NULL, labels_textsize = 3, diff --git a/man/guess_ab_col.Rd b/man/guess_ab_col.Rd index 98b03634..d0d1fb72 100644 --- a/man/guess_ab_col.Rd +++ b/man/guess_ab_col.Rd @@ -20,7 +20,7 @@ A column name of \code{x}, or \code{NULL} when no result is found. This tries to find a column name in a data set based on information from the \link{antibiotics} data set. Also supports WHONET abbreviations. } \details{ -You can look for an antibiotic (trade) name or abbreviation and it will search \code{x} and the \link{antibiotics} data set for any column containing a name or code of that antibiotic. \strong{Longer columns names take precendence over shorter column names.} +You can look for an antibiotic (trade) name or abbreviation and it will search \code{x} and the \link{antibiotics} data set for any column containing a name or code of that antibiotic. \strong{Longer columns names take precedence over shorter column names.} } \section{Stable lifecycle}{ diff --git a/man/key_antibiotics.Rd b/man/key_antibiotics.Rd index 8b3f88d7..51607a9e 100755 --- a/man/key_antibiotics.Rd +++ b/man/key_antibiotics.Rd @@ -40,21 +40,21 @@ key_antibiotics_equal( ) } \arguments{ -\item{x}{table with antibiotics coloms, like \code{AMX} or \code{amox}} +\item{x}{a data.frame with antibiotics columns, like \code{AMX} or \code{amox}} \item{col_mo}{column name of the IDs of the microorganisms (see \code{\link[=as.mo]{as.mo()}}), defaults to the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.} -\item{universal_1, universal_2, universal_3, universal_4, universal_5, universal_6}{column names of \strong{broad-spectrum} antibiotics, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link[=guess_ab_col]{guess_ab_col()}}.} +\item{universal_1, universal_2, universal_3, universal_4, universal_5, universal_6}{column names of \strong{broad-spectrum} antibiotics, case-insensitive. See details for which antibiotics will be used at default (which are guessed with \code{\link[=guess_ab_col]{guess_ab_col()}}).} -\item{GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6}{column names of antibiotics for \strong{Gram-positives}, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link[=guess_ab_col]{guess_ab_col()}}.} +\item{GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6}{column names of antibiotics for \strong{Gram-positives}, case-insensitive. See details for which antibiotics will be used at default (which are guessed with \code{\link[=guess_ab_col]{guess_ab_col()}}).} -\item{GramNeg_1, GramNeg_2, GramNeg_3, GramNeg_4, GramNeg_5, GramNeg_6}{column names of antibiotics for \strong{Gram-negatives}, case-insensitive. At default, the columns containing these antibiotics will be guessed with \code{\link[=guess_ab_col]{guess_ab_col()}}.} +\item{GramNeg_1, GramNeg_2, GramNeg_3, GramNeg_4, GramNeg_5, GramNeg_6}{column names of antibiotics for \strong{Gram-negatives}, case-insensitive. See details for which antibiotics will be used at default (which are guessed with \code{\link[=guess_ab_col]{guess_ab_col()}}).} -\item{warnings}{give warning about missing antibiotic columns, they will anyway be ignored} +\item{warnings}{give a warning about missing antibiotic columns (they will be ignored)} -\item{...}{other parameters passed on to function} +\item{...}{other parameters passed on to functions} -\item{y, z}{characters to compare} +\item{y, z}{character vectors to compare} \item{type}{type to determine weighed isolates; can be \code{"keyantibiotics"} or \code{"points"}, see Details} diff --git a/man/mo_property.Rd b/man/mo_property.Rd index 9e5e3960..ecfd8cf2 100644 --- a/man/mo_property.Rd +++ b/man/mo_property.Rd @@ -16,6 +16,8 @@ \alias{mo_domain} \alias{mo_type} \alias{mo_gramstain} +\alias{is_gram_negative} +\alias{is_gram_positive} \alias{mo_snomed} \alias{mo_ref} \alias{mo_authors} @@ -55,6 +57,10 @@ mo_type(x, language = get_locale(), ...) mo_gramstain(x, language = get_locale(), ...) +is_gram_negative(x, ...) + +is_gram_positive(x, ...) + mo_snomed(x, language = get_locale(), ...) mo_ref(x, language = get_locale(), ...) @@ -76,7 +82,7 @@ mo_url(x, open = FALSE, language = get_locale(), ...) mo_property(x, property = "fullname", language = get_locale(), ...) } \arguments{ -\item{x}{any (vector of) text that can be coerced to a valid microorganism code with \code{\link[=as.mo]{as.mo()}}} +\item{x}{any character (vector) that can be coerced to a valid microorganism code with \code{\link[=as.mo]{as.mo()}}} \item{language}{language of the returned text, defaults to system language (see \code{\link[=get_locale]{get_locale()}}) and can be overwritten by setting the option \code{AMR_locale}, e.g. \code{options(AMR_locale = "de")}, see \link{translate}. Use \code{language = NULL} or \code{language = ""} to prevent translation.} @@ -110,7 +116,7 @@ The short name - \code{\link[=mo_shortname]{mo_shortname()}} - almost always ret 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}. +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}. Functions \code{\link[=is_gram_negative]{is_gram_negative()}} and \code{\link[=is_gram_positive]{is_gram_positive()}} always return \code{TRUE} or \code{FALSE}, even for species outside the kingdom of Bacteria. All output will be \link{translate}d where possible. diff --git a/man/p_symbol.Rd b/man/p_symbol.Rd deleted file mode 100644 index da3ee666..00000000 --- a/man/p_symbol.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/p_symbol.R -\name{p_symbol} -\alias{p_symbol} -\title{Symbol of a p-value} -\usage{ -p_symbol(p, emptychar = " ") -} -\arguments{ -\item{p}{p value} - -\item{emptychar}{text to show when \code{p > 0.1}} -} -\value{ -Text -} -\description{ -Return the symbol related to the p-value: 0 '\verb{***}' 0.001 '\verb{**}' 0.01 '\code{*}' 0.05 '\code{.}' 0.1 ' ' 1. Values above \code{p = 1} will return \code{NA}. -} -\details{ -\strong{NOTE}: this function will be moved to the \code{cleaner} package when a new version is being published on CRAN. -} -\section{Questioning lifecycle}{ - -\if{html}{\figure{lifecycle_questioning.svg}{options: style=margin-bottom:5px} \cr} -The \link[=lifecycle]{lifecycle} of this function is \strong{questioning}. This function might be no longer be optimal approach, or is it questionable whether this function should be in this \code{AMR} package at all. -} - -\section{Read more on our website!}{ - -On our website \url{https://msberends.github.io/AMR/} you can find \href{https://msberends.github.io/AMR/articles/AMR.html}{a comprehensive tutorial} about how to conduct AMR analysis, the \href{https://msberends.github.io/AMR/reference/}{complete documentation of all functions} and \href{https://msberends.github.io/AMR/articles/WHONET.html}{an example analysis using WHONET data}. As we would like to better understand the backgrounds and needs of our users, please \href{https://msberends.github.io/AMR/survey.html}{participate in our survey}! -} - diff --git a/tests/testthat/test-_deprecated.R b/tests/testthat/test-_deprecated.R index 89a83a14..829c606f 100644 --- a/tests/testthat/test-_deprecated.R +++ b/tests/testthat/test-_deprecated.R @@ -27,5 +27,6 @@ context("deprecated.R") test_that("deprecated functions work", { skip_on_cran() - # if some functions get deprecated, put the tests here + expect_identical(suppressWarnings(p_symbol(c(0.001, 0.01, 0.05, 0.1, 1, NA, 3))), + c("***", "**", "*", ".", " ", NA, NA)) }) diff --git a/tests/testthat/test-mo_property.R b/tests/testthat/test-mo_property.R index 650d2de0..88af6221 100644 --- a/tests/testthat/test-mo_property.R +++ b/tests/testthat/test-mo_property.R @@ -112,4 +112,9 @@ test_that("mo_property works", { stringsAsFactors = FALSE) expect_equal(nrow(subset(x, f1 != f2)), 0) + # is gram pos/neg (also return FALSE for all non-bacteria) + expect_equal(is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")), + c(TRUE, FALSE, FALSE)) + expect_equal(is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")), + c(FALSE, TRUE, FALSE)) }) diff --git a/tests/testthat/test-p_symbol.R b/tests/testthat/test-p_symbol.R deleted file mode 100644 index fa33b1f4..00000000 --- a/tests/testthat/test-p_symbol.R +++ /dev/null @@ -1,32 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2020 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("p_symbol.R") - -test_that("P symbol works", { - skip_on_cran() - expect_identical(p_symbol(c(0.001, 0.01, 0.05, 0.1, 1, NA, 3)), - c("***", "**", "*", ".", " ", NA, NA)) -})