diff --git a/.github/workflows/lintr.yaml b/.github/workflows/lintr.yaml index ded45ef9..1cfd27df 100644 --- a/.github/workflows/lintr.yaml +++ b/.github/workflows/lintr.yaml @@ -66,5 +66,5 @@ jobs: shell: Rscript {0} - name: Lint - run: lintr::lint_package(linters = lintr::with_defaults(line_length_linter = NULL, trailing_whitespace_linter = NULL, object_name_linter = NULL, cyclocomp_linter = NULL, object_usage_linter = NULL, object_length_linter = lintr::object_length_linter(length = 50L)), exclusions = list("R/aa_helper_pm_functions.R")) + run: lintr::lint_package(linters = lintr::with_defaults(line_length_linter = NULL, trailing_whitespace_linter = NULL, object_name_linter = NULL, cyclocomp_linter = NULL, object_length_linter = lintr::object_length_linter(length = 50L)), exclusions = list("R/aa_helper_pm_functions.R")) shell: Rscript {0} diff --git a/DESCRIPTION b/DESCRIPTION index a2c25f10..e40deb16 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.4.0.9051 -Date: 2020-12-27 +Version: 1.4.0.9052 +Date: 2020-12-28 Title: Antimicrobial Resistance Analysis Authors@R: c( person(role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 3317aa13..3adf7533 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# AMR 1.4.0.9051 -## Last updated: 27 December 2020 +# AMR 1.4.0.9052 +## Last updated: 28 December 2020 ### New * Functions `get_episode()` and `is_new_episode()` to determine (patient) episodes which are not necessarily based on microorganisms. The `get_episode()` function returns the index number of the episode per group, while the `is_new_episode()` function returns values `TRUE`/`FALSE` to indicate whether an item in a vector is the start of a new episode. They also support `dplyr`s grouping (i.e. using `group_by()`): @@ -53,6 +53,8 @@ * All messages and warnings thrown by this package now break sentences on whole words * More extensive unit tests * Internal calls to `options()` were all removed in favour of a new internal environment `pkg_env` +* Improved internal type setting (among other things: replaced all `sapply()` calls with `vapply()`) +* Added CodeFactor as a continuous code review to this package: * Added Dr. Rogier Schade as contributor # AMR 1.4.0 diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index c3d5b55a..baea8652 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -119,8 +119,8 @@ search_type_in_df <- function(x, type, info = TRUE) { # -- mo if (type == "mo") { - if (any(sapply(x, is.mo))) { - found <- sort(colnames(x)[sapply(x, is.mo)])[1] + if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) { + found <- sort(colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)])[1] } else if ("mo" %in% colnames(x) & suppressWarnings( all(x$mo %in% c(NA, @@ -152,8 +152,8 @@ search_type_in_df <- function(x, type, info = TRUE) { "`, but this column contains no valid dates. Transform its values to valid dates first.")), call. = FALSE) } - } else if (any(sapply(x, function(x) inherits(x, c("Date", "POSIXct"))))) { - found <- sort(colnames(x)[sapply(x, function(x) inherits(x, c("Date", "POSIXct")))])[1] + } else if (any(vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct"))))) { + found <- sort(colnames(x)[vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct")))])[1] } } # -- patient id @@ -202,7 +202,7 @@ search_type_in_df <- function(x, type, info = TRUE) { } is_possibly_regex <- function(x) { - tryCatch(sapply(strsplit(x, ""), + tryCatch(vapply(FUN.VALUE = character(1), strsplit(x, ""), function(y) any(y %in% c("$", "(", ")", "*", "+", "-", ".", "?", "[", "]", "^", "{", "|", "}", "\\"), na.rm = TRUE)), error = function(e) rep(TRUE, length(x))) } @@ -210,7 +210,7 @@ is_possibly_regex <- function(x) { stop_ifnot_installed <- function(package) { # no "utils::installed.packages()" since it requires non-staged install since R 3.6.0 # https://developer.r-project.org/Blog/public/2019/02/14/staged-install/index.html - sapply(package, function(pkg) + vapply(FUN.VALUE = character(1), package, function(pkg) tryCatch(get(".packageName", envir = asNamespace(pkg)), error = function(e) { if (package == "rstudioapi") { @@ -260,7 +260,8 @@ word_wrap <- function(..., if (msg %like% "\n") { # run word_wraps() over every line here, bind them and return again - return(paste0(sapply(trimws(unlist(strsplit(msg, "\n")), which = "right"), + return(paste0(vapply(FUN.VALUE = character(1), + trimws(unlist(strsplit(msg, "\n")), which = "right"), word_wrap, add_fn = add_fn, as_note = FALSE, @@ -512,7 +513,11 @@ meet_criteria <- function(object, 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), + stop_ifnot(any(vapply(FUN.VALUE = logical(1), + 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, ".", diff --git a/R/ab_class_selectors.R b/R/ab_class_selectors.R index 1324b4a0..18bc9ffb 100644 --- a/R/ab_class_selectors.R +++ b/R/ab_class_selectors.R @@ -163,14 +163,24 @@ ab_selector <- function(ab_class, function_name) { meet_criteria(function_name, allow_class = "character", has_length = 1, .call_depth = 1) for (i in seq_len(length(sys.frames()))) { + # dplyr? + if (".data" %in% names(sys.frames()[[i]])) { + vars_df <- sys.frames()[[i]]$`.data` + if (is.data.frame(vars_df)) { + break + } + } + # then try base R - an element `x` will be in the system call stack vars_df <- tryCatch(sys.frames()[[i]]$x, error = function(e) NULL) if (!is.null(vars_df) && is.data.frame(vars_df)) { # when using e.g. example_isolates[, carbapenems()] or example_isolates %>% select(carbapenems()) break } else if (!is.null(vars_df) && is.list(vars_df)) { # when using e.g. example_isolates %>% filter(across(carbapenems(), ~. == "R")) - vars_df <- as.data.frame(vars_df, stringsAsFactors = FALSE) - break + vars_df <- tryCatch(as.data.frame(vars_df, stringsAsFactors = FALSE), error = function(e) NULL) + if (!is.null(vars_df)) { + break + } } } stop_ifnot(is.data.frame(vars_df), "this function must be used inside dplyr selection verbs or within a data.frame call.", call = -2) @@ -199,7 +209,7 @@ ab_selector <- function(ab_class, function_name) { message_("No antimicrobial agents of class ", ab_group, " found", examples, ".") } else { message_("Selecting ", ab_group, ": ", - paste(paste0("'", font_bold(agents, collapse = NULL), + paste(paste0("column '", font_bold(agents, collapse = NULL), "' (", ab_name(names(agents), tolower = TRUE, language = NULL), ")"), collapse = ", "), as_note = FALSE, diff --git a/R/ab_from_text.R b/R/ab_from_text.R index 7c7d0b6a..948922da 100644 --- a/R/ab_from_text.R +++ b/R/ab_from_text.R @@ -115,7 +115,7 @@ ab_from_text <- function(text, translate_ab <- get_translate_ab(translate_ab) if (isTRUE(thorough_search) | - (isTRUE(is.null(thorough_search)) & max(sapply(text_split_all, length), na.rm = TRUE) <= 3)) { + (isTRUE(is.null(thorough_search)) & max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) { text_split_all <- text_split_all[nchar(text_split_all) >= 4 & grepl("[a-z]+", text_split_all)] result <- lapply(text_split_all, function(text_split) { progress$tick() @@ -203,7 +203,7 @@ ab_from_text <- function(text, # collapse text if needed if (!is.null(collapse)) { - result <- sapply(result, function(x) { + result <- vapply(FUN.VALUE = character(1), result, function(x) { if (length(x) == 1 & all(is.na(x))) { NA_character_ } else { diff --git a/R/availability.R b/R/availability.R index 8ace775c..f6d556b0 100644 --- a/R/availability.R +++ b/R/availability.R @@ -46,11 +46,11 @@ availability <- function(tbl, width = NULL) { meet_criteria(tbl, allow_class = "data.frame") meet_criteria(width, allow_class = "numeric", allow_NULL = TRUE) - x <- sapply(tbl, function(x) { + x <- vapply(FUN.VALUE = double(1), tbl, function(x) { 1 - sum(is.na(x)) / length(x) }) - n <- sapply(tbl, function(x) length(x[!is.na(x)])) - R <- sapply(tbl, function(x) ifelse(is.rsi(x), resistance(x, minimum = 0), NA)) + n <- vapply(FUN.VALUE = double(1), tbl, function(x) length(x[!is.na(x)])) + R <- vapply(FUN.VALUE = double(1), tbl, function(x) ifelse(is.rsi(x), resistance(x, minimum = 0), NA_real_)) R_print <- character(length(R)) R_print[!is.na(R)] <- percentage(R[!is.na(R)]) R_print[is.na(R)] <- "" diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index a9b3a51b..667cdf17 100644 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -75,7 +75,7 @@ bug_drug_combinations <- function(x, x_class <- class(x) x <- as.data.frame(x, stringsAsFactors = FALSE) x[, col_mo] <- FUN(x[, col_mo, drop = TRUE], ...) - x <- x[, c(col_mo, names(which(sapply(x, is.rsi)))), drop = FALSE] + x <- x[, c(col_mo, names(which(vapply(FUN.VALUE = logical(1), x, is.rsi)))), drop = FALSE] unique_mo <- sort(unique(x[, col_mo, drop = TRUE])) @@ -89,7 +89,7 @@ bug_drug_combinations <- function(x, for (i in seq_len(length(unique_mo))) { # filter on MO group and only select R/SI columns - x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(sapply(x, is.rsi))), drop = FALSE] + x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(vapply(FUN.VALUE = logical(1), x, is.rsi))), drop = FALSE] # turn and merge everything pivot <- lapply(x_mo_filter, function(x) { m <- as.matrix(table(x)) @@ -165,7 +165,7 @@ format.bug_drug_combinations <- function(x, remove_NAs <- function(.data) { cols <- colnames(.data) - .data <- as.data.frame(sapply(.data, function(x) ifelse(is.na(x), "", x), simplify = FALSE), + .data <- as.data.frame(lapply(.data, function(x) ifelse(is.na(x), "", x)), stringsAsFactors = FALSE) colnames(.data) <- cols .data @@ -235,7 +235,7 @@ format.bug_drug_combinations <- function(x, } if (remove_intrinsic_resistant == TRUE) { - y <- y[, !sapply(y, function(col) all(col %like% "100", na.rm = TRUE) & !any(is.na(col))), drop = FALSE] + y <- y[, !vapply(FUN.VALUE = logical(1), y, function(col) all(col %like% "100", na.rm = TRUE) & !any(is.na(col))), drop = FALSE] } rownames(y) <- NULL diff --git a/R/data.R b/R/data.R index db8aee53..ab2a733d 100755 --- a/R/data.R +++ b/R/data.R @@ -178,7 +178,7 @@ catalogue_of_life <- list( #' - `gender`\cr gender of the patient #' - `patient_id`\cr ID of the patient #' - `mo`\cr ID of microorganism created with [as.mo()], see also [microorganisms] -#' - `PEN:RIF`\cr `r sum(sapply(example_isolates, is.rsi))` different antibiotics with class [`rsi`] (see [as.rsi()]); these column names occur in the [antibiotics] data set and can be translated with [ab_name()] +#' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.rsi))` different antibiotics with class [`rsi`] (see [as.rsi()]); these column names occur in the [antibiotics] data set and can be translated with [ab_name()] #' @inheritSection AMR Reference data publicly available #' @inheritSection AMR Read more on our website! "example_isolates" @@ -225,7 +225,7 @@ catalogue_of_life <- list( #' - `Inducible clindamycin resistance`\cr Clindamycin can be induced? #' - `Comment`\cr Other comments #' - `Date of data entry`\cr Date this data was entered in WHONET -#' - `AMP_ND10:CIP_EE`\cr `r sum(sapply(WHONET, is.rsi))` different antibiotics. You can lookup the abbreviations in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.rsi()]. +#' - `AMP_ND10:CIP_EE`\cr `r sum(vapply(FUN.VALUE = logical(1), WHONET, is.rsi))` different antibiotics. You can lookup the abbreviations in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.rsi()]. #' @inheritSection AMR Reference data publicly available #' @inheritSection AMR Read more on our website! "WHONET" diff --git a/R/disk.R b/R/disk.R index a297692e..324c4aa1 100644 --- a/R/disk.R +++ b/R/disk.R @@ -69,13 +69,13 @@ as.disk <- function(x, na.rm = FALSE) { na_before <- length(x[is.na(x)]) - # heavily based on the function from our cleaner package: + # heavily based on cleaner::clean_double(): clean_double2 <- function(x, remove = "[^0-9.,-]", fixed = FALSE) { x <- gsub(",", ".", x) # remove ending dot/comma x <- gsub("[,.]$", "", x) # only keep last dot/comma - reverse <- function(x) sapply(lapply(strsplit(x, NULL), rev), paste, collapse = "") + reverse <- function(x) vapply(FUN.VALUE = character(1), lapply(strsplit(x, NULL), rev), paste, collapse = "") x <- sub("{{dot}}", ".", gsub(".", "", reverse(sub(".", "}}tod{{", diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 6983cc47..4544bd90 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -64,7 +64,8 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time. #' @param version_breakpoints the version number to use for the EUCAST Clinical Breakpoints guideline. Currently supported: `r paste0(names(EUCAST_VERSION_BREAKPOINTS), collapse = ", ")`. #' @param version_expertrules the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Currently supported: `r paste0(names(EUCAST_VERSION_EXPERT_RULES), collapse = ", ")`. -#' @param ampc_cephalosporin_resistance a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to `NA`. Currently only works when `version_expertrules` is `3.2`; '*EUCAST Expert Rules v3.2 on Enterobacterales*' states that susceptible (S) results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of `NA` for this argument will remove results for these agents, while e.g. a value of `"R"` will make the results for these agents resistant. Use `NULL` to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: *`r gsub("|", "*, *", gsub("[)(^)]", "", eucast_rules_file[which(eucast_rules_file$reference.version == 3.2 & eucast_rules_file$reference.rule %like% "ampc"), "this_value"][1]), fixed = TRUE)`*. +#' @param ampc_cephalosporin_resistance a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to `NA`. Currently only works when `version_expertrules` is `3.2`; '*EUCAST Expert Rules v3.2 on Enterobacterales*' states that susceptible (S) results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of `NA` for this argument will remove results for these agents, while e.g. a value of `"R"` will make the results for these agents resistant. Use `NULL` to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: *`r gsub("[)(^]", "", gsub("|", ", ", eucast_rules_file[which(eucast_rules_file$reference.version == 3.2 & eucast_rules_file$reference.rule %like% "ampc"), "this_value"][1], fixed = TRUE))`*. +#' #' @param ... column name of an antibiotic, please see section *Antibiotics* below #' @inheritParams first_isolate #' @details @@ -537,7 +538,7 @@ eucast_rules <- function(x, strsplit(",") %pm>% unlist() %pm>% trimws() %pm>% - sapply(function(x) if (x %in% antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE) else x) %pm>% + vapply(FUN.VALUE = character(1), function(x) if (x %in% antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE) else x) %pm>% sort() %pm>% paste(collapse = ", ") x <- gsub("_", " ", x, fixed = TRUE) @@ -600,13 +601,14 @@ eucast_rules <- function(x, x <- as.data.frame(x, stringsAsFactors = FALSE) # no tibbles, data.tables, etc. rownames(x) <- NULL # will later be restored with old_attributes # create unique row IDs - combination of the MO and all ABx columns (so they will only run once per unique combination) - x$`.rowid` <- sapply(as.list(as.data.frame(t(x[, c(col_mo, cols_ab), drop = FALSE]), + x$`.rowid` <- vapply(FUN.VALUE = character(1), + as.list(as.data.frame(t(x[, c(col_mo, cols_ab), drop = FALSE]), stringsAsFactors = FALSE)), function(x) { x[is.na(x)] <- "." paste0(x, collapse = "") }) - + # save original table, with the new .rowid column x.bak <- x # keep only unique rows for MO and ABx @@ -1093,18 +1095,18 @@ edit_rsi <- function(x, if (length(rows) > 0 & length(cols) > 0) { new_edits <- x - if (any(!sapply(x[, cols, drop = FALSE], is.rsi), na.rm = TRUE)) { - track_changes$rsi_warn <- cols[!sapply(x[, cols, drop = FALSE], is.rsi)] + if (any(!vapply(FUN.VALUE = logical(1), x[, cols, drop = FALSE], is.rsi), na.rm = TRUE)) { + track_changes$rsi_warn <- cols[!vapply(FUN.VALUE = logical(1), x[, cols, drop = FALSE], is.rsi)] } tryCatch( # insert into original table new_edits[rows, cols] <- to, warning = function(w) { if (w$message %like% "invalid factor level") { - xyz <- sapply(cols, function(col) { + xyz <- vapply(FUN.VALUE = logical(1), cols, function(col) { new_edits[, col] <<- factor(x = as.character(pm_pull(new_edits, col)), levels = unique(c(to, levels(pm_pull(new_edits, col))))) - invisible() + TRUE }) suppressWarnings(new_edits[rows, cols] <<- to) warning_('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing factor level. A better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call = FALSE) diff --git a/R/filter_ab_class.R b/R/filter_ab_class.R index 96ade2f5..b7ae5eb1 100644 --- a/R/filter_ab_class.R +++ b/R/filter_ab_class.R @@ -165,7 +165,7 @@ filter_ab_class <- function(x, collapse = scope_txt), operator, toString(result), as_note = FALSE) x_transposed <- as.list(as.data.frame(t(x[, agents, drop = FALSE]), stringsAsFactors = FALSE)) - filtered <- sapply(x_transposed, function(y) scope_fn(y %in% result, na.rm = TRUE)) + filtered <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) scope_fn(y %in% result, na.rm = TRUE)) x <- x[which(filtered), , drop = FALSE] class(x) <- x_class x diff --git a/R/ggplot_pca.R b/R/ggplot_pca.R index d05c6624..83ab7332 100755 --- a/R/ggplot_pca.R +++ b/R/ggplot_pca.R @@ -306,7 +306,6 @@ pca_calculations <- function(pca_model, d <- pca_model$svd u <- predict(pca_model)$x / nobs.factor v <- pca_model$scaling - d.total <- sum(d ^ 2) } else { stop("Expected an object of class prcomp, princomp, PCA, or lda") } diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index a0efe158..2eead452 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -139,13 +139,13 @@ get_column_abx <- function(x, } x_bak <- x # only check columns that are a valid AB code, ATC code, name, abbreviation or synonym, - # or already have the rsi class (as.rsi) - # and that have no more than 50% invalid values + # or already have the class (as.rsi) + # and that they have no more than 50% invalid values vectr_antibiotics <- unique(toupper(unlist(antibiotics[, c("ab", "atc", "name", "abbreviations", "synonyms")]))) vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3] - x_columns <- sapply(colnames(x), function(col, df = x_bak) { - if (toupper(col) %in% vectr_antibiotics | - is.rsi(as.data.frame(df, stringsAsFactors = FALSE)[, col, drop = TRUE]) | + x_columns <- vapply(FUN.VALUE = character(1), colnames(x), function(col, df = x_bak) { + if (toupper(col) %in% vectr_antibiotics || + is.rsi(as.data.frame(df, stringsAsFactors = FALSE)[, col, drop = TRUE]) || is.rsi.eligible(as.data.frame(df, stringsAsFactors = FALSE)[, col, drop = TRUE], threshold = 0.5)) { return(col) diff --git a/R/kurtosis.R b/R/kurtosis.R index 9e944de2..e32b8afa 100755 --- a/R/kurtosis.R +++ b/R/kurtosis.R @@ -71,5 +71,5 @@ kurtosis.matrix <- function(x, na.rm = FALSE, excess = FALSE) { 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) + vapply(FUN.VALUE = double(1), x, kurtosis.default, na.rm = na.rm, excess = excess) } diff --git a/R/like.R b/R/like.R index 5923e290..f87494a9 100755 --- a/R/like.R +++ b/R/like.R @@ -102,7 +102,7 @@ like <- function(x, pattern, ignore.case = TRUE) { res[i] <- grepl(pattern[i], x[i], ignore.case = FALSE, fixed = fixed) } } - res <- sapply(pattern, function(pttrn) grepl(pttrn, x, ignore.case = FALSE, fixed = fixed)) + res <- vapply(FUN.VALUE = logical(1), pattern, function(pttrn) grepl(pttrn, x, ignore.case = FALSE, fixed = fixed)) res2 <- as.logical(rowSums(res)) # get only first item of every hit in pattern res2[duplicated(res)] <- FALSE diff --git a/R/mdro.R b/R/mdro.R index 5b0388b5..51ed7a54 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -193,28 +193,28 @@ mdro <- function(x, guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." guideline$author <- "Magiorakos AP, Srinivasan A, Carey RB, ..., Vatopoulos A, Weber JT, Monnet DL" guideline$version <- NA - guideline$source <- "Clinical Microbiology and Infection 18:3, 2012. DOI: 10.1111/j.1469-0691.2011.03570.x" + guideline$source_url <- "Clinical Microbiology and Infection 18:3, 2012. DOI: 10.1111/j.1469-0691.2011.03570.x" guideline$type <- "MDRs/XDRs/PDRs" } else if (guideline$code == "eucast3.1") { guideline$name <- "EUCAST Expert Rules, \"Intrinsic Resistance and Exceptional Phenotypes Tables\"" guideline$author <- "EUCAST (European Committee on Antimicrobial Susceptibility Testing)" guideline$version <- "3.1, 2016" - guideline$source <- "https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf" + guideline$source_url <- "https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf" guideline$type <- "EUCAST Exceptional Phenotypes" } else if (guideline$code == "eucast3.2") { guideline$name <- "EUCAST Expert Rules, \"Intrinsic Resistance and Unusual Phenotypes\"" guideline$author <- "EUCAST (European Committee on Antimicrobial Susceptibility Testing)" guideline$version <- "3.2, 2020" - guideline$source <- "https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf" + guideline$source_url <- "https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf" guideline$type <- "EUCAST Unusual Phenotypes" } else if (guideline$code == "tb") { guideline$name <- "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis" guideline$author <- "WHO (World Health Organization)" guideline$version <- "WHO/HTM/TB/2014.11, 2014" - guideline$source <- "https://www.who.int/tb/publications/pmdt_companionhandbook/en/" + guideline$source_url <- "https://www.who.int/tb/publications/pmdt_companionhandbook/en/" guideline$type <- "MDR-TB's" # support per country: @@ -222,14 +222,14 @@ mdro <- function(x, guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms" guideline$author <- "M\u00fcller J, Voss A, K\u00f6ck R, ..., Kern WV, Wendt C, Friedrich AW" guideline$version <- NA - guideline$source <- "Antimicrobial Resistance and Infection Control 4:7, 2015. DOI: 10.1186/s13756-015-0047-6" + guideline$source_url <- "Antimicrobial Resistance and Infection Control 4:7, 2015. DOI: 10.1186/s13756-015-0047-6" guideline$type <- "MRGNs" } else if (guideline$code == "brmo") { guideline$name <- "WIP-Richtlijn Bijzonder Resistente Micro-organismen (BRMO)" guideline$author <- "RIVM (Rijksinstituut voor de Volksgezondheid)" guideline$version <- "Revision as of December 2017" - guideline$source <- "https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH" + guideline$source_url <- "https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH" guideline$type <- "BRMOs" } else { stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE) @@ -413,6 +413,7 @@ mdro <- function(x, ...) } + # nolint start AMC <- cols_ab["AMC"] AMK <- cols_ab["AMK"] AMP <- cols_ab["AMP"] @@ -555,6 +556,7 @@ mdro <- function(x, abx_tb <- c(CAP, ETH, GAT, INH, PZA, RIF, RIB, RFP) abx_tb <- abx_tb[!is.na(abx_tb)] stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set") + # nolint end if (combine_SI == TRUE) { search_result <- "R" @@ -574,8 +576,8 @@ mdro <- function(x, ifelse(!is.na(guideline$version), paste0(word_wrap(paste0(font_bold("Version: "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"), ""), - word_wrap(paste0(font_bold("Source: "), guideline$source), extra_indent = 11, as_note = FALSE), "\n", - "\n", sep = "") + paste0(font_bold("Source: "), guideline$source_url), + "\n\n", sep = "") } ab_missing <- function(ab) { @@ -585,9 +587,8 @@ mdro <- function(x, x[!is.na(x)] } - verbose_df <- NULL - # antibiotic classes + # nolint start aminoglycosides <- c(TOB, GEN) cephalosporins <- c(CDZ, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR) cephalosporins_1st <- c(CAC, CFR, RID, CTZ, CZD, CZO, CRD, CTL, LEX, CEP, HAP, CED) @@ -595,6 +596,7 @@ mdro <- function(x, cephalosporins_3rd <- c(CDZ, CDR, DIT, CAT, CFM, CMX, DIZ, CFP, CSL, CTX, CPM, CPD, CFS, CAZ, CCV, CTB, CZX, CRO, LTM) carbapenems <- c(DOR, ETP, IPM, MEM, MEV) fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA) + # nolint end # helper function for editing the table trans_tbl <- function(to, rows, cols, any_all) { @@ -604,9 +606,10 @@ mdro <- function(x, x[, cols] <- as.data.frame(lapply(x[, cols, drop = FALSE], function(col) as.rsi(col)), stringsAsFactors = FALSE) - x[rows, "columns_nonsusceptible"] <<- sapply(rows, + x[rows, "columns_nonsusceptible"] <<- vapply(FUN.VALUE = character(1), + rows, function(row, group_vct = cols) { - cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], + cols_nonsus <- vapply(FUN.VALUE = logical(1), x[row, group_vct, drop = FALSE], function(y) y %in% search_result) paste(sort(c(unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ")), names(cols_nonsus)[cols_nonsus])), @@ -620,7 +623,7 @@ mdro <- function(x, } x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE]), stringsAsFactors = FALSE)) - row_filter <- sapply(x_transposed, function(y) search_function(y %in% search_result, na.rm = TRUE)) + row_filter <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) search_function(y %in% search_result, na.rm = TRUE)) row_filter <- x[which(row_filter), "row_number", drop = TRUE] rows <- rows[rows %in% row_filter] x[rows, "MDRO"] <<- to @@ -638,21 +641,27 @@ mdro <- function(x, function(col) as.rsi(col)), stringsAsFactors = FALSE) x[rows, "classes_in_guideline"] <<- length(lst) - x[rows, "classes_available"] <<- sapply(rows, + x[rows, "classes_available"] <<- vapply(FUN.VALUE = double(1), + rows, function(row, group_tbl = lst) { - sum(sapply(group_tbl, function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% c("S", "I", "R")))) + sum(vapply(FUN.VALUE = logical(1), + group_tbl, + function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% c("S", "I", "R")))) }) if (verbose == TRUE) { - x[rows, "columns_nonsusceptible"] <<- sapply(rows, + x[rows, "columns_nonsusceptible"] <<- vapply(FUN.VALUE = character(1), + rows, function(row, group_vct = lst_vector) { - cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% search_result) + cols_nonsus <- vapply(FUN.VALUE = logical(1), x[row, group_vct, drop = FALSE], function(y) y %in% search_result) paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ") }) } - x[rows, "classes_affected"] <<- sapply(rows, + x[rows, "classes_affected"] <<- vapply(FUN.VALUE = double(1), + rows, function(row, group_tbl = lst) { - sum(sapply(group_tbl, + sum(vapply(FUN.VALUE = logical(1), + group_tbl, function(group) { any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE) }), @@ -661,7 +670,7 @@ mdro <- function(x, # for PDR; all agents are R (or I if combine_SI = FALSE) x_transposed <- as.list(as.data.frame(t(x[rows, lst_vector, drop = FALSE]), stringsAsFactors = FALSE)) - row_filter <- sapply(x_transposed, function(y) all(y %in% search_result, na.rm = TRUE)) + row_filter <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) all(y %in% search_result, na.rm = TRUE)) x[which(row_filter), "classes_affected"] <<- 999 } diff --git a/R/mic.R b/R/mic.R index 7053d706..6dd89bc6 100755 --- a/R/mic.R +++ b/R/mic.R @@ -107,14 +107,14 @@ as.mic <- function(x, na.rm = FALSE) { # these are allowed MIC values and will become factor levels ops <- c("<", "<=", "", ">=", ">") - lvls <- c(c(t(sapply(ops, function(x) paste0(x, "0.00", 1:9)))), - unique(c(t(sapply(ops, function(x) paste0(x, sort(as.double(paste0("0.0", + lvls <- c(c(t(vapply(FUN.VALUE = character(9), ops, function(x) paste0(x, "0.00", 1:9)))), + unique(c(t(vapply(FUN.VALUE = character(104), ops, function(x) paste0(x, sort(as.double(paste0("0.0", sort(c(1:99, 125, 128, 256, 512, 625)))))))))), - unique(c(t(sapply(ops, function(x) paste0(x, sort(as.double(paste0("0.", + unique(c(t(vapply(FUN.VALUE = character(103), ops, function(x) paste0(x, sort(as.double(paste0("0.", c(1:99, 125, 128, 256, 512))))))))), - c(t(sapply(ops, function(x) paste0(x, sort(c(1:9, 1.5)))))), - c(t(sapply(ops, function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])))), - c(t(sapply(ops, function(x) paste0(x, sort(c(2 ^ c(7:10), 80 * c(2:12)))))))) + c(t(vapply(FUN.VALUE = character(10), ops, function(x) paste0(x, sort(c(1:9, 1.5)))))), + c(t(vapply(FUN.VALUE = character(45), ops, function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])))), + c(t(vapply(FUN.VALUE = character(15), ops, function(x) paste0(x, sort(c(2 ^ c(7:10), 80 * c(2:12)))))))) na_before <- x[is.na(x) | x == ""] %pm>% length() x[!x %in% lvls] <- NA diff --git a/R/pca.R b/R/pca.R index e5960488..558184d1 100755 --- a/R/pca.R +++ b/R/pca.R @@ -97,7 +97,7 @@ pca <- function(x, } x <- as.data.frame(new_list, stringsAsFactors = FALSE) - if (any(sapply(x, function(y) !is.numeric(y)))) { + if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) { warning_("Be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. Please see Examples in ?pca.") } @@ -106,21 +106,21 @@ pca <- function(x, error = function(e) warning("column names could not be set")) # keep only numeric columns - x <- x[, sapply(x, function(y) is.numeric(y))] + x <- x[, vapply(FUN.VALUE = logical(1), x, function(y) is.numeric(y))] # bind the data set with the non-numeric columns - x <- cbind(x.bak[, sapply(x.bak, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE], x) + x <- cbind(x.bak[, vapply(FUN.VALUE = logical(1), x.bak, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE], x) } x <- pm_ungroup(x) # would otherwise select the grouping vars x <- x[rowSums(is.na(x)) == 0, ] # remove columns containing NAs - pca_data <- x[, which(sapply(x, function(x) is.numeric(x)))] + pca_data <- x[, which(vapply(FUN.VALUE = logical(1), x, function(x) is.numeric(x)))] message_("Columns selected for PCA: ", paste0(font_bold(colnames(pca_data)), collapse = "/"), ". Total observations available: ", nrow(pca_data), ".") pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol, rank. = rank.) - attr(pca_model, "non_numeric_cols") <- x[, sapply(x, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE] + attr(pca_model, "non_numeric_cols") <- x[, vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE] class(pca_model) <- c("pca", class(pca_model)) pca_model } diff --git a/R/resistance_predict.R b/R/resistance_predict.R index 13cf8bd6..4318e885 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -192,7 +192,9 @@ resistance_predict <- function(x, rownames(df) <- NULL df <- subset(df, sum(df$R + df$S, na.rm = TRUE) >= minimum) + # nolint start df_matrix <- as.matrix(df[, c("R", "S"), drop = FALSE]) + # nolint end stop_if(NROW(df) == 0, "there are no observations") diff --git a/R/rsi.R b/R/rsi.R index 025a3ef1..8dfb0841 100755 --- a/R/rsi.R +++ b/R/rsi.R @@ -544,7 +544,7 @@ as.rsi.data.frame <- function(x, sel <- sel[sel != col_mo] } - ab_cols <- colnames(x)[sapply(x, function(y) { + ab_cols <- colnames(x)[vapply(FUN.VALUE = logical(1), x, function(y) { i <<- i + 1 check <- is.mic(y) | is.disk(y) ab <- colnames(x)[i] @@ -571,11 +571,11 @@ as.rsi.data.frame <- function(x, "no columns with MIC values, disk zones or antibiotic column names found in this data set. Use as.mic() or as.disk() to transform antimicrobial columns.") # set type per column types <- character(length(ab_cols)) - types[sapply(x.bak[, ab_cols, drop = FALSE], is.disk)] <- "disk" - types[sapply(x.bak[, ab_cols, drop = FALSE], is.mic)] <- "mic" - types[types == "" & sapply(x[, ab_cols, drop = FALSE], all_valid_disks)] <- "disk" - types[types == "" & sapply(x[, ab_cols, drop = FALSE], all_valid_mics)] <- "mic" - types[types == "" & !sapply(x.bak[, ab_cols, drop = FALSE], is.rsi)] <- "rsi" + types[vapply(FUN.VALUE = logical(1), x.bak[, ab_cols, drop = FALSE], is.disk)] <- "disk" + types[vapply(FUN.VALUE = logical(1), x.bak[, ab_cols, drop = FALSE], is.mic)] <- "mic" + types[types == "" & vapply(FUN.VALUE = logical(1), x[, ab_cols, drop = FALSE], all_valid_disks)] <- "disk" + types[types == "" & vapply(FUN.VALUE = logical(1), x[, ab_cols, drop = FALSE], all_valid_mics)] <- "mic" + types[types == "" & !vapply(FUN.VALUE = logical(1), x.bak[, ab_cols, drop = FALSE], is.rsi)] <- "rsi" if (any(types %in% c("mic", "disk"), na.rm = TRUE)) { # now we need an mo column stop_if(is.null(col_mo), "`col_mo` must be set") @@ -861,7 +861,8 @@ freq.rsi <- function(x, ...) { x_name <- gsub(".*[$]", "", x_name) if (x_name %in% c("x", ".")) { # try again going through system calls - x_name <- stats::na.omit(sapply(sys.calls(), + x_name <- stats::na.omit(vapply(FUN.VALUE = character(1), + sys.calls(), function(call) { call_txt <- as.character(call) ifelse(call_txt[1] %like% "freq$", call_txt[length(call_txt)], character(0)) @@ -906,8 +907,8 @@ get_skimmers.rsi <- function(column) { if (is.null(vars) | is.null(i)) { NA_character_ } else { - lengths <- sapply(vars, length) - when_starts_rsi <- which(names(sapply(vars, length)) == "rsi") + lengths <- vapply(FUN.VALUE = double(1), vars, length) + when_starts_rsi <- which(names(vapply(FUN.VALUE = double(1), vars, length)) == "rsi") offset <- sum(lengths[c(1:when_starts_rsi - 1)]) var <- vars$rsi[i - offset] if (!isFALSE(var == "data")) { @@ -1115,8 +1116,8 @@ unique.rsi <- function(x, incomparables = FALSE, ...) { check_reference_data <- function(reference_data) { if (!identical(reference_data, AMR::rsi_translation)) { - class_rsi <- sapply(rsi_translation, function(x) paste0("<", class(x), ">", collapse = " and ")) - class_ref <- sapply(reference_data, function(x) paste0("<", class(x), ">", collapse = " and ")) + class_rsi <- vapply(FUN.VALUE = character(1), rsi_translation, function(x) paste0("<", class(x), ">", collapse = " and ")) + class_ref <- vapply(FUN.VALUE = character(1), reference_data, function(x) paste0("<", class(x), ">", collapse = " and ")) if (!all(names(class_rsi) == names(class_ref))) { stop_("`reference_data` must have the same column names as the 'rsi_translation' data set.", call = -2) } diff --git a/R/rsi_calc.R b/R/rsi_calc.R index 3c7b05c1..d9ec0dd8 100755 --- a/R/rsi_calc.R +++ b/R/rsi_calc.R @@ -129,12 +129,12 @@ rsi_calc <- function(..., MARGIN = 1, FUN = min) numerator <- sum(as.integer(y) %in% as.integer(ab_result), na.rm = TRUE) - denominator <- sum(sapply(x_transposed, function(y) !(any(is.na(y))))) + denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(any(is.na(y))))) } else { # may contain NAs in any column other_values <- setdiff(c(NA, levels(ab_result)), ab_result) - numerator <- sum(sapply(x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE))) - denominator <- sum(sapply(x_transposed, function(y) !(all(y %in% other_values) & any(is.na(y))))) + numerator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE))) + denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(all(y %in% other_values) & any(is.na(y))))) } } else { # x is not a data.frame @@ -207,10 +207,10 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both" if (inherits(data, "grouped_df")) { data_has_groups <- TRUE groups <- setdiff(names(attributes(data)$groups), ".rows") - data <- data[, c(groups, colnames(data)[sapply(data, is.rsi)]), drop = FALSE] + data <- data[, c(groups, colnames(data)[vapply(FUN.VALUE = logical(1), data, is.rsi)]), drop = FALSE] } else { data_has_groups <- FALSE - data <- data[, colnames(data)[sapply(data, is.rsi)], drop = FALSE] + data <- data[, colnames(data)[vapply(FUN.VALUE = logical(1), data, is.rsi)], drop = FALSE] } data <- as.data.frame(data, stringsAsFactors = FALSE) diff --git a/R/skewness.R b/R/skewness.R index c40a91d9..52ea69ad 100755 --- a/R/skewness.R +++ b/R/skewness.R @@ -66,5 +66,5 @@ skewness.matrix <- function(x, na.rm = FALSE) { #' @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) + vapply(FUN.VALUE = double(1), x, skewness.default, na.rm = na.rm) } diff --git a/R/sysdata.rda b/R/sysdata.rda index 88761872..1ad11c86 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/data-raw/eucast_rules.tsv b/data-raw/eucast_rules.tsv index 2e2a6b7c..880522e3 100644 --- a/data-raw/eucast_rules.tsv +++ b/data-raw/eucast_rules.tsv @@ -300,6 +300,6 @@ genus_species is Moraxella catarrhalis NAL S fluoroquinolones S Expert Rules on genus_species is Moraxella catarrhalis NAL R fluoroquinolones R Expert Rules on Moraxella catarrhalis Expert Rules 3.2 genus is Campylobacter ERY S CLR, AZM S Expert Rules on Campylobacter Expert Rules 3.2 genus_species is Campylobacter ERY R CLR, AZM R Expert Rules on Campylobacter Expert Rules 3.2 -fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter freundii|Hafnia alvei|Serratia|Morganella morganii|Providencia) CTX S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument -fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter freundii|Hafnia alvei|Serratia|Morganella morganii|Providencia) CRO S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument -fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter freundii|Hafnia alvei|Serratia|Morganella morganii|Providencia) CAZ S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument +fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter (braakii|freundii|gillenii|murliniae|rodenticum|sedlakii|werkmanii|youngae)|Hafnia alvei|Serratia|Morganella morganii|Providencia) CTX S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument +fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter (braakii|freundii|gillenii|murliniae|rodenticum|sedlakii|werkmanii|youngae)|Hafnia alvei|Serratia|Morganella morganii|Providencia) CRO S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument +fullname like ^(Enterobacter|Klebsiella aerogenes|Citrobacter (braakii|freundii|gillenii|murliniae|rodenticum|sedlakii|werkmanii|youngae)|Hafnia alvei|Serratia|Morganella morganii|Providencia) CAZ S CTX, CRO, CAZ Expert Rules on Enterobacterales (AmpC de-repressed cephalosporins) Expert Rules 3.2 This is rule 3 and 4 of EUCAST Expert Rules v3.2 on Enterobacterales, result will be set with the 'ampc_derepressed_cephalosporins' argument diff --git a/docs/404.html b/docs/404.html index 770cecc6..e87d8651 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9051 + 1.4.0.9052 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 7f4b9e53..c139382d 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9051 + 1.4.0.9052 diff --git a/docs/articles/index.html b/docs/articles/index.html index 0a74bef6..ee482346 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9051 + 1.4.0.9052 diff --git a/docs/authors.html b/docs/authors.html index cada70bf..bcd08a4b 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9051 + 1.4.0.9052 diff --git a/docs/index.html b/docs/index.html index e6614614..513736a6 100644 --- a/docs/index.html +++ b/docs/index.html @@ -43,7 +43,7 @@ AMR (for R) - 1.4.0.9051 + 1.4.0.9052 @@ -337,7 +337,7 @@ Since you are one of our users, we would like to know how you use the package an

Latest released version

-

+

CRAN CRANlogs

This package is available here on the official R network (CRAN), which has a peer-reviewed submission process. Install this package in R from CRAN by using the command:

@@ -347,6 +347,7 @@ Since you are one of our users, we would like to know how you use the package an

Latest development version

+

R-code-checkCodeFactor Codecov

The latest and unpublished development version can be installed from GitHub using:

 install.packages("remotes") 
diff --git a/docs/news/index.html b/docs/news/index.html
index 30ea0c4b..2c955b9f 100644
--- a/docs/news/index.html
+++ b/docs/news/index.html
@@ -81,7 +81,7 @@
       
       
         AMR (for R)
-        1.4.0.9051
+        1.4.0.9052
@@ -236,13 +236,13 @@ Source: NEWS.md
-
-

-AMR 1.4.0.9051 Unreleased +
+

+AMR 1.4.0.9052 Unreleased

-
+

-Last updated: 27 December 2020 +Last updated: 28 December 2020

@@ -317,6 +317,9 @@
  • More extensive unit tests
  • Internal calls to options() were all removed in favour of a new internal environment pkg_env
    • +
  • Improved internal type setting (among other things: replaced all sapply() calls with vapply())
    • +
  • Added CodeFactor as a continuous code review to this package: https://www.codefactor.io/repository/github/msberends/amr/ +
  • Added Dr. Rogier Schade as contributor

    • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 0cf34fb6..0c905352 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-12-27T22:17Z +last_built: 2020-12-28T21:24Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/eucast_rules.html b/docs/reference/eucast_rules.html index ea173fc7..19dc97f5 100644 --- a/docs/reference/eucast_rules.html +++ b/docs/reference/eucast_rules.html @@ -83,7 +83,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied AMR (for R) - 1.4.0.9050 + 1.4.0.9052
    @@ -289,7 +289,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied ampc_cephalosporin_resistance -

    a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to NA. Currently only works when version_expertrules is 3.2; 'EUCAST Expert Rules v3.2 on Enterobacterales' states that susceptible (S) results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of NA for this argument will remove results for these agents, while e.g. a value of "R" will make the results for these agents resistant. Use NULL to not alter the results for AmpC de-repressed cephalosporin-resistant mutants.
    For EUCAST Expert Rules v3.2, this rule applies to: Enterobacter, Klebsiella aerogenes, Citrobacter freundii, Hafnia alvei, Serratia, Morganella morganii, Providencia.

    +

    a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to NA. Currently only works when version_expertrules is 3.2; 'EUCAST Expert Rules v3.2 on Enterobacterales' states that susceptible (S) results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of NA for this argument will remove results for these agents, while e.g. a value of "R" will make the results for these agents resistant. Use NULL to not alter the results for AmpC de-repressed cephalosporin-resistant mutants.
    For EUCAST Expert Rules v3.2, this rule applies to: Enterobacter, Klebsiella aerogenes, Citrobacter freundii, Hafnia alvei, Serratia, Morganella morganii, Providencia.

    ... diff --git a/docs/reference/index.html b/docs/reference/index.html index 63f2beaa..0ccbdb49 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9051 + 1.4.0.9052
    diff --git a/docs/survey.html b/docs/survey.html index 618bd197..67690079 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.4.0.9051 + 1.4.0.9052
    diff --git a/index.md b/index.md index a56be8b5..bb2a0324 100644 --- a/index.md +++ b/index.md @@ -88,8 +88,8 @@ This package can be used for: ### Get this package #### Latest released version - - +[![CRAN](https://www.r-pkg.org/badges/version-ago/AMR)](https://cran.r-project.org/package=AMR) +[![CRANlogs](https://cranlogs.r-pkg.org/badges/grand-total/AMR)](https://cran.r-project.org/package=AMR) This package is available [here on the official R network (CRAN)](https://cran.r-project.org/package=AMR), which has a peer-reviewed submission process. Install this package in R from CRAN by using the command: @@ -102,8 +102,12 @@ It will be downloaded and installed automatically. For RStudio, click on the men **Note:** Not all functions on this website may be available in this latest release. To use all functions and data sets mentioned on this website, install the latest development version. #### Latest development version +![R-code-check](https://github.com/msberends/AMR/workflows/R-code-check/badge.svg?branch=master) +[![CodeFactor](https://www.codefactor.io/repository/github/msberends/amr/badge)](https://www.codefactor.io/repository/github/msberends/amr) +[![Codecov](https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg)](https://codecov.io/gh/msberends/AMR?branch=master) The latest and unpublished development version can be installed from GitHub using: + ```r install.packages("remotes") remotes::install_github("msberends/AMR") diff --git a/man/eucast_rules.Rd b/man/eucast_rules.Rd index 89d571db..852671b3 100644 --- a/man/eucast_rules.Rd +++ b/man/eucast_rules.Rd @@ -42,7 +42,7 @@ eucast_rules( \item{version_expertrules}{the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Currently supported: 3.1, 3.2.} -\item{ampc_cephalosporin_resistance}{a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to \code{NA}. Currently only works when \code{version_expertrules} is \code{3.2}; '\emph{EUCAST Expert Rules v3.2 on Enterobacterales}' states that susceptible (S) results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of \code{NA} for this argument will remove results for these agents, while e.g. a value of \code{"R"} will make the results for these agents resistant. Use \code{NULL} to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. \cr For \emph{EUCAST Expert Rules} v3.2, this rule applies to: \emph{Enterobacter}, \emph{Klebsiella aerogenes}, \emph{Citrobacter freundii}, \emph{Hafnia alvei}, \emph{Serratia}, \emph{Morganella morganii}, \emph{Providencia}.} +\item{ampc_cephalosporin_resistance}{a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to \code{NA}. Currently only works when \code{version_expertrules} is \code{3.2}; '\emph{EUCAST Expert Rules v3.2 on Enterobacterales}' states that susceptible (S) results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these agents. A value of \code{NA} for this argument will remove results for these agents, while e.g. a value of \code{"R"} will make the results for these agents resistant. Use \code{NULL} to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. \cr For \emph{EUCAST Expert Rules} v3.2, this rule applies to: \emph{Enterobacter, Klebsiella aerogenes, Citrobacter freundii, Hafnia alvei, Serratia, Morganella morganii, Providencia}.} \item{...}{column name of an antibiotic, please see section \emph{Antibiotics} below} }