(v1.4.0.9052) replaced all sapply's with type-safe vapply's

.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}

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.4.0.9051
+Version: 1.4.0.9052
-Date: 2020-12-27
+Date: 2020-12-28
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(role = c("aut", "cre"), 

NEWS.md

@@ -1,5 +1,5 @@
-# AMR 1.4.0.9051
+# AMR 1.4.0.9052
-## <small>Last updated: 27 December 2020</small>
+## <small>Last updated: 28 December 2020</small>
 
 ### 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: <https://www.codefactor.io/repository/github/msberends/amr/>
 * Added Dr. Rogier Schade as contributor
 
 # AMR 1.4.0

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))) {
+    if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) {
-      found <- sort(colnames(x)[sapply(x, is.mo)])[1]
+      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"))))) {
+    } else if (any(vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct"))))) {
-      found <- sort(colnames(x)[sapply(x, function(x) inherits(x, c("Date", "POSIXct")))])[1]
+      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, ".",

R/ab_class_selectors.R

@@ -163,16 +163,26 @@ 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)
+      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)
   ab_in_data <- get_column_abx(vars_df, info = FALSE)
   
@@ -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,

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 {

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)]))
+  n <- vapply(FUN.VALUE = double(1), tbl, function(x) length(x[!is.na(x)]))
-  R <- sapply(tbl, function(x) ifelse(is.rsi(x), resistance(x, minimum = 0), NA))
+  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)] <- ""

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

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"

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{{",

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,7 +601,8 @@ 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)] <- "."
@@ -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)) {
+    if (any(!vapply(FUN.VALUE = logical(1), x[, cols, drop = FALSE], is.rsi), na.rm = TRUE)) {
-      track_changes$rsi_warn <- cols[!sapply(x[, cols, drop = FALSE], is.rsi)]
+      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)

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

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")
   }

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) 
+  # or already have the <rsi> class (as.rsi) 
-  # and that have no more than 50% invalid values
+  # 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) {
+  x_columns <- vapply(FUN.VALUE = character(1), colnames(x), function(col, df = x_bak) {
-    if (toupper(col) %in% vectr_antibiotics | 
+    if (toupper(col) %in% vectr_antibiotics || 
-        is.rsi(as.data.frame(df, stringsAsFactors = FALSE)[, col, drop = TRUE]) |
+        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)

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

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

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",
+        paste0(font_bold("Source:    "), guideline$source_url),
-        "\n", sep = "")
+        "\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
     }
     

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)))),
+    lvls <- c(c(t(vapply(FUN.VALUE = character(9), ops, function(x) paste0(x, "0.00", 1:9)))),
-              unique(c(t(sapply(ops, function(x) paste0(x, sort(as.double(paste0("0.0", 
+              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(vapply(FUN.VALUE = character(10), 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(vapply(FUN.VALUE = character(45), 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(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

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
 }

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

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[vapply(FUN.VALUE = logical(1), x.bak[, ab_cols, drop = FALSE], is.disk)] <- "disk"
-  types[sapply(x.bak[, ab_cols, drop = FALSE], is.mic)] <- "mic"
+  types[vapply(FUN.VALUE = logical(1), x.bak[, ab_cols, drop = FALSE], is.mic)] <- "mic"
-  types[types == "" & sapply(x[, ab_cols, drop = FALSE], all_valid_disks)] <- "disk"
+  types[types == "" & vapply(FUN.VALUE = logical(1), x[, ab_cols, drop = FALSE], all_valid_disks)] <- "disk"
-  types[types == "" & sapply(x[, ab_cols, drop = FALSE], all_valid_mics)] <- "mic"
+  types[types == "" & vapply(FUN.VALUE = logical(1), x[, ab_cols, drop = FALSE], all_valid_mics)] <- "mic"
-  types[types == "" & !sapply(x.bak[, ab_cols, drop = FALSE], is.rsi)] <- "rsi"
+  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)
+      lengths <- vapply(FUN.VALUE = double(1), vars, length)
-      when_starts_rsi <- which(names(sapply(vars, length)) == "rsi")
+      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_rsi <- vapply(FUN.VALUE = character(1), rsi_translation, function(x) paste0("<", class(x), ">", collapse = " and "))
-    class_ref <- sapply(reference_data, 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)
     }

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)))
+      numerator <- sum(vapply(FUN.VALUE = logical(1), 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)))))
+      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)

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

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

docs/404.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 

docs/LICENSE-text.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 

docs/articles/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 

docs/authors.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 

docs/index.html

@@ -43,7 +43,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 
@@ -337,7 +337,7 @@ Since you are one of our users, we would like to know how you use the package an
 <div id="latest-released-version" class="section level4">
 <h4 class="hasAnchor">
 <a href="#latest-released-version" class="anchor"></a>Latest released version</h4>
-<p><img src="https://www.r-pkg.org/badges/version-ago/AMR"><img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR"></p>
+<p><a href="https://cran.r-project.org/package=AMR"><img src="https://www.r-pkg.org/badges/version-ago/AMR" alt="CRAN"></a> <a href="https://cran.r-project.org/package=AMR"><img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR" alt="CRANlogs"></a></p>
 <p>This package is available <a href="https://cran.r-project.org/package=AMR">here on the official R network (CRAN)</a>, which has a peer-reviewed submission process. Install this package in R from CRAN by using the command:</p>
 <div class="sourceCode" id="cb2"><pre class="downlit sourceCode r">
 <code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html">install.packages</a></span><span class="op">(</span><span class="st">"AMR"</span><span class="op">)</span></code></pre></div>
@@ -347,6 +347,7 @@ Since you are one of our users, we would like to know how you use the package an
 <div id="latest-development-version" class="section level4">
 <h4 class="hasAnchor">
 <a href="#latest-development-version" class="anchor"></a>Latest development version</h4>
+<p><img src="https://github.com/msberends/AMR/workflows/R-code-check/badge.svg?branch=master" alt="R-code-check"><a href="https://www.codefactor.io/repository/github/msberends/amr"><img src="https://www.codefactor.io/repository/github/msberends/amr/badge" alt="CodeFactor"></a> <a href="https://codecov.io/gh/msberends/AMR?branch=master"><img src="https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg" alt="Codecov"></a></p>
 <p>The latest and unpublished development version can be installed from GitHub using:</p>
 <div class="sourceCode" id="cb3"><pre class="downlit sourceCode r">
 <code class="sourceCode R"><span class="fu"><a href="https://rdrr.io/r/utils/install.packages.html">install.packages</a></span><span class="op">(</span><span class="st">"remotes"</span><span class="op">)</span> 

docs/news/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 
@@ -236,13 +236,13 @@
       <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
     </div>
 
-    <div id="amr-1409051" class="section level1">
+    <div id="amr-1409052" class="section level1">
-<h1 class="page-header" data-toc-text="1.4.0.9051">
+<h1 class="page-header" data-toc-text="1.4.0.9052">
-<a href="#amr-1409051" class="anchor"></a>AMR 1.4.0.9051<small> Unreleased </small>
+<a href="#amr-1409052" class="anchor"></a>AMR 1.4.0.9052<small> Unreleased </small>
 </h1>
-<div id="last-updated-27-december-2020" class="section level2">
+<div id="last-updated-28-december-2020" class="section level2">
 <h2 class="hasAnchor">
-<a href="#last-updated-27-december-2020" class="anchor"></a><small>Last updated: 27 December 2020</small>
+<a href="#last-updated-28-december-2020" class="anchor"></a><small>Last updated: 28 December 2020</small>
 </h2>
 <div id="new" class="section level3">
 <h3 class="hasAnchor">
@@ -317,6 +317,9 @@
 <li>More extensive unit tests</li>
 <li>Internal calls to <code><a href="https://rdrr.io/r/base/options.html">options()</a></code> were all removed in favour of a new internal environment <code>pkg_env</code>
 </li>
+<li>Improved internal type setting (among other things: replaced all <code><a href="https://rdrr.io/r/base/lapply.html">sapply()</a></code> calls with <code><a href="https://rdrr.io/r/base/lapply.html">vapply()</a></code>)</li>
+<li>Added CodeFactor as a continuous code review to this package: <a href="https://www.codefactor.io/repository/github/msberends/amr/" class="uri">https://www.codefactor.io/repository/github/msberends/amr/</a>
+</li>
 <li>Added Dr. Rogier Schade as contributor</li>
 </ul>
 </div>

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

docs/reference/eucast_rules.html

@@ -83,7 +83,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9050</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 
@@ -289,7 +289,7 @@ To improve the interpretation of the antibiogram before EUCAST rules are applied
     </tr>
     <tr>
       <th>ampc_cephalosporin_resistance</th>
-      <td><p>a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to <code>NA</code>. Currently only works when <code>version_expertrules</code> is <code>3.2</code>; '<em>EUCAST Expert Rules v3.2 on Enterobacterales</em>' 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</code> for this argument will remove results for these agents, while e.g. a value of <code>"R"</code> will make the results for these agents resistant. Use <code>NULL</code> to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. <br /> For <em>EUCAST Expert Rules</em> v3.2, this rule applies to: <em>Enterobacter</em>, <em>Klebsiella aerogenes</em>, <em>Citrobacter freundii</em>, <em>Hafnia alvei</em>, <em>Serratia</em>, <em>Morganella morganii</em>, <em>Providencia</em>.</p></td>
+      <td><p>a character value that should be applied for AmpC de-repressed cephalosporin-resistant mutants, defaults to <code>NA</code>. Currently only works when <code>version_expertrules</code> is <code>3.2</code>; '<em>EUCAST Expert Rules v3.2 on Enterobacterales</em>' 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</code> for this argument will remove results for these agents, while e.g. a value of <code>"R"</code> will make the results for these agents resistant. Use <code>NULL</code> to not alter the results for AmpC de-repressed cephalosporin-resistant mutants. <br /> For <em>EUCAST Expert Rules</em> v3.2, this rule applies to: <em>Enterobacter, Klebsiella aerogenes, Citrobacter freundii, Hafnia alvei, Serratia, Morganella morganii, Providencia</em>.</p></td>
     </tr>
     <tr>
       <th>...</th>

docs/reference/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 

docs/survey.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9051</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9052</span>
       </span>
     </div>
 

index.md

@@ -88,8 +88,8 @@ This package can be used for:
 ### Get this package
 
 #### Latest released version
-<img src="https://www.r-pkg.org/badges/version-ago/AMR" />
+[![CRAN](https://www.r-pkg.org/badges/version-ago/AMR)](https://cran.r-project.org/package=AMR)
-<img src="https://cranlogs.r-pkg.org/badges/grand-total/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")

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}
 }