(v0.7.1.9102) lintr

.Rbuildignore

@@ -22,3 +22,4 @@
 ^public$
 ^data-raw$
 R/aa_test.R$
+^\.lintr$

.gitignore

@@ -22,4 +22,3 @@ packrat/lib*/
 packrat/src/
 data-raw/taxon.tab
 data-raw/DSMZ_bactnames.xlsx
-R/aa_test.R

.gitlab-ci.R

@@ -29,7 +29,8 @@ install_if_needed <- function(pkg, repos, quiet) {
 
 gl_update_pkg_all <- function(repos = "https://cran.rstudio.com",
                               quiet = TRUE,
-                              install_pkgdown = FALSE) {
+                              install_pkgdown = FALSE,
+                              install_lintr = FALSE) {
   # update existing
   update.packages(ask = FALSE, repos = repos, quiet = quiet)
 
@@ -37,7 +38,10 @@ gl_update_pkg_all <- function(repos = "https://cran.rstudio.com",
   if (install_pkgdown == TRUE) {
     install_if_needed(pkg = "pkgdown", repos = repos, quiet = quiet)
   }
-
+  if (install_lintr == TRUE) {
+    install_if_needed(pkg = "lintr", repos = repos, quiet = quiet)
+  }
+  
   devtools::install_dev_deps(repos = repos, quiet = quiet, upgrade = TRUE)
 
   cat("INSTALLED:\n")

.gitlab-ci.yml

@@ -26,6 +26,7 @@ stages:
   - build
   - test
   - deploy
+  - lint
 
 image: rocker/r-base
 
@@ -131,3 +132,12 @@ pages:
   artifacts:
     paths:
       - public
+
+lintr:
+  stage: lint
+  when: on_success
+  script:
+    # install missing and outdated packages
+    - Rscript -e 'source(".gitlab-ci.R"); gl_update_pkg_all(repos = "https://cran.rstudio.com", quiet = TRUE, install_pkgdown = FALSE, install_lintr = TRUE)'
+    # check all syntax with lintr
+    - Rscript -e 'lintr::lint_package()'

.lintr

@@ -0,0 +1,2 @@
+linters: with_defaults(line_length_linter = NULL, trailing_whitespace_linter = NULL, object_name_linter = NULL, cyclocomp_linter = NULL, object_usage_linter = NULL, object_length_linter(length = 50L))
+exclusions: list("R/mo_history.R", "tests/testthat/test-mo_history.R")

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 0.7.1.9101
+Version: 0.7.1.9102
-Date: 2019-10-09
+Date: 2019-10-11
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(role = c("aut", "cre"), 
@@ -48,6 +48,7 @@ Suggests:
     covr (>= 3.0.1),
     curl,
     readxl,
+    rmarkdown,
     rstudioapi,
     rvest (>= 0.3.2),
     testthat (>= 1.0.2),

NAMESPACE

@@ -300,6 +300,7 @@ importFrom(graphics,par)
 importFrom(graphics,plot)
 importFrom(graphics,points)
 importFrom(graphics,text)
+importFrom(knitr,kable)
 importFrom(microbenchmark,microbenchmark)
 importFrom(pillar,pillar_shaft)
 importFrom(pillar,type_sum)

NEWS.md

@@ -1,5 +1,5 @@
-# AMR 0.7.1.9101
+# AMR 0.7.1.9102
-<small>Last updated: 09-Oct-2019</small>
+<small>Last updated: 11-Oct-2019</small>
 
 ### Breaking
 * Determination of first isolates now **excludes** all 'unknown' microorganisms at default, i.e. microbial code `"UNKNOWN"`. They can be included with the new parameter `include_unknown`:
@@ -126,6 +126,7 @@
 
 #### Other
 * Added Prof. Dr. Casper Albers as doctoral advisor and added Dr. Judith Fonville, Eric Hazenberg, Dr. Bart Meijer, Dr. Dennis Souverein and Annick Lenglet as contributors
+* Cleaned the coding style of every single syntax line in this package with the help of the `lintr` package
 
 # AMR 0.7.1
 

R/ab.R

@@ -79,8 +79,6 @@ as.ab <- function(x, ...) {
   x_bak_clean <- gsub("_[A-Z]{2}[0-9_]{0,3}$", "", x_bak_clean, ignore.case = TRUE)
   # remove part between brackets if that's followed by another string
   x_bak_clean <- gsub("(.*)+ [(].*[)]", "\\1", x_bak_clean)
-  # keep only a-Z, 0-9, space, slash and dash
-  # x_bak_clean <- gsub("[^A-Z0-9 /-]", "", x_bak_clean, ignore.case = TRUE)
   # keep only max 1 space
   x_bak_clean <- trimws(gsub(" +", " ", x_bak_clean, ignore.case = TRUE))
   # non-character, space or number should be a slash
@@ -93,7 +91,7 @@ as.ab <- function(x, ...) {
   x_new <- rep(NA_character_, length(x))
   x_unknown <- character(0)
 
-  for (i in 1:length(x)) {
+  for (i in seq_len(length(x))) {
     if (is.na(x[i]) | is.null(x[i])) {
       next
     }
@@ -108,28 +106,28 @@ as.ab <- function(x, ...) {
     }
 
     # exact AB code
-    found <- AMR::antibiotics[which(AMR::antibiotics$ab == toupper(x[i])),]$ab
+    found <- AMR::antibiotics[which(AMR::antibiotics$ab == toupper(x[i])), ]$ab
     if (length(found) > 0) {
       x_new[i] <- found[1L]
       next
     }
 
     # exact ATC code
-    found <- AMR::antibiotics[which(AMR::antibiotics$atc == toupper(x[i])),]$ab
+    found <- AMR::antibiotics[which(AMR::antibiotics$atc == toupper(x[i])), ]$ab
     if (length(found) > 0) {
       x_new[i] <- found[1L]
       next
     }
 
     # exact CID code
-    found <- AMR::antibiotics[which(AMR::antibiotics$cid == x[i]),]$ab
+    found <- AMR::antibiotics[which(AMR::antibiotics$cid == x[i]), ]$ab
     if (length(found) > 0) {
       x_new[i] <- found[1L]
       next
     }
 
     # exact name
-    found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) == toupper(x[i])),]$ab
+    found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) == toupper(x[i])), ]$ab
     if (length(found) > 0) {
       x_new[i] <- found[1L]
       next
@@ -163,7 +161,7 @@ as.ab <- function(x, ...) {
 
     # first >=4 characters of name
     if (nchar(x[i]) >= 4) {
-      found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) %like% paste0("^", x[i])),]$ab
+      found <- AMR::antibiotics[which(toupper(AMR::antibiotics$name) %like% paste0("^", x[i])), ]$ab
       if (length(found) > 0) {
         x_new[i] <- found[1L]
         next
@@ -193,7 +191,7 @@ as.ab <- function(x, ...) {
     x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling)
   
     # try if name starts with it
-    found <- AMR::antibiotics[which(AMR::antibiotics$name %like% paste0("^", x_spelling)),]$ab
+    found <- AMR::antibiotics[which(AMR::antibiotics$name %like% paste0("^", x_spelling)), ]$ab
     if (length(found) > 0) {
       x_new[i] <- found[1L]
       next
@@ -233,7 +231,7 @@ as.ab <- function(x, ...) {
       # transform back from other languages and try again
       x_translated <- paste(lapply(strsplit(x[i], "[^a-zA-Z0-9 ]"),
                                    function(y) {
-                                     for (i in 1:length(y)) {
+                                     for (i in seq_len(length(y))) {
                                        y[i] <- ifelse(tolower(y[i]) %in% tolower(translations_file$replacement),
                                                       translations_file[which(tolower(translations_file$replacement) == tolower(y[i]) &
                                                                                 !isFALSE(translations_file$fixed)), "pattern"],
@@ -252,7 +250,7 @@ as.ab <- function(x, ...) {
         # now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
         x_translated <- paste(lapply(strsplit(x_translated, "[^a-zA-Z0-9 ]"),
                                      function(y) {
-                                       for (i in 1:length(y)) {
+                                       for (i in seq_len(length(y))) {
                                          y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE, initial_search2 = FALSE))
                                          y[i] <- ifelse(!is.na(y_name),
                                                         y_name,
@@ -278,14 +276,14 @@ as.ab <- function(x, ...) {
   x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
   if (length(x_unknown_ATCs) > 0) {
     warning("These ATC codes are not (yet) in the antibiotics data set: ",
-            paste('"', sort(unique(x_unknown_ATCs)), '"', sep = "", collapse = ', '),
+            paste('"', sort(unique(x_unknown_ATCs)), '"', sep = "", collapse = ", "),
             ".",
             call. = FALSE)
   }
 
   if (length(x_unknown) > 0) {
     warning("These values could not be coerced to a valid antimicrobial ID: ",
-            paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ', '),
+            paste('"', sort(unique(x_unknown)), '"', sep = "", collapse = ", "),
             ".",
             call. = FALSE)
   }
@@ -319,7 +317,7 @@ print.ab <- function(x, ...) {
 #' @exportMethod as.data.frame.ab
 #' @export
 #' @noRd
-as.data.frame.ab <- function (x, ...) {
+as.data.frame.ab <- function(x, ...) {
   # same as as.data.frame.character but with removed stringsAsFactors
   nm <- paste(deparse(substitute(x), width.cutoff = 500L),
               collapse = " ")

R/ab_property.R

@@ -165,7 +165,7 @@ ab_info <- function(x, language = get_locale(), ...) {
 
 #' @rdname ab_property
 #' @export
-ab_property <- function(x, property = 'name', language = get_locale(), ...) {
+ab_property <- function(x, property = "name", language = get_locale(), ...) {
   if (length(property) != 1L) {
     stop("'property' must be of length 1.")
   }

R/age.R

@@ -175,7 +175,7 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
   # turn input values to 'split_at' indices
   y <- x
   labs <- split_at
-  for (i in 1:length(split_at)) {
+  for (i in seq_len(length(split_at))) {
     y[x >= split_at[i]] <- i
     # create labels
     labs[i - 1] <- paste0(unique(c(split_at[i - 1], split_at[i] - 1)), collapse = "-")

R/amr.R

@@ -65,6 +65,6 @@
 #' \url{https://gitlab.com/msberends/AMR/issues}
 #' @name AMR
 #' @rdname AMR
-#  # prevent NOTE on R >= 3.6
 #' @importFrom microbenchmark microbenchmark
+#' @importFrom knitr kable
 NULL

R/atc_online.R

@@ -73,8 +73,8 @@
 #' }
 atc_online_property <- function(atc_code,
                                 property,
-                                administration = 'O',
+                                administration = "O",
-                                url = 'https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no') {
+                                url = "https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no") {
 
   if (!all(c("curl", "rvest", "xml2") %in% rownames(utils::installed.packages()))) {
     stop("Packages 'xml2', 'rvest' and 'curl' are required for this function")
@@ -90,15 +90,15 @@ atc_online_property <- function(atc_code,
   }
 
   if (length(property) != 1L) {
-    stop('`property` must be of length 1', call. = FALSE)
+    stop("`property` must be of length 1", call. = FALSE)
   }
   if (length(administration) != 1L) {
-    stop('`administration` must be of length 1', call. = FALSE)
+    stop("`administration` must be of length 1", call. = FALSE)
   }
 
   # also allow unit as property
-  if (property %like% 'unit') {
+  if (property %like% "unit") {
-    property <- 'U'
+    property <- "U"
   }
 
   # validation of properties
@@ -109,12 +109,12 @@ atc_online_property <- function(atc_code,
   valid_properties <- tolower(valid_properties)
 
   if (!property %in% valid_properties) {
-    stop('Invalid `property`, use one of ', paste(valid_properties.bak, collapse = ", "), '.')
+    stop("Invalid `property`, use one of ", paste(valid_properties.bak, collapse = ", "), ".")
   }
 
-  if (property == 'ddd') {
+  if (property == "ddd") {
     returnvalue <- rep(NA_real_, length(atc_code))
-  } else if (property == 'groups') {
+  } else if (property == "groups") {
     returnvalue <- list()
   } else {
     returnvalue <- rep(NA_character_, length(atc_code))
@@ -122,11 +122,11 @@ atc_online_property <- function(atc_code,
 
   progress <- progress_estimated(n = length(atc_code))
 
-  for (i in 1:length(atc_code)) {
+  for (i in seq_len(length(atc_code))) {
 
     progress$tick()$print()
 
-    atc_url <- sub('%s', atc_code[i], url, fixed = TRUE)
+    atc_url <- sub("%s", atc_code[i], url, fixed = TRUE)
 
     if (property == "groups") {
       tbl <- xml2::read_html(atc_url) %>%
@@ -141,34 +141,34 @@ atc_online_property <- function(atc_code,
       # select only text items where URL like "code="
       texts <- texts[grepl("?code=", tolower(hrefs), fixed = TRUE)]
       # last one is antibiotics, skip it
-      texts <- texts[1:length(texts) - 1]
+      texts <- texts[seq_len(length(texts)) - 1]
       returnvalue <- c(list(texts), returnvalue)
 
     } else {
       tbl <- xml2::read_html(atc_url) %>%
-        rvest::html_nodes('table') %>%
+        rvest::html_nodes("table") %>%
         rvest::html_table(header = TRUE) %>%
         as.data.frame(stringsAsFactors = FALSE)
 
       # case insensitive column names
-      colnames(tbl) <- tolower(colnames(tbl)) %>% gsub('^atc.*', 'atc', .)
+      colnames(tbl) <- tolower(colnames(tbl)) %>% gsub("^atc.*", "atc", .)
 
       if (length(tbl) == 0) {
-        warning('ATC not found: ', atc_code[i], '. Please check ', atc_url, '.', call. = FALSE)
+        warning("ATC not found: ", atc_code[i], ". Please check ", atc_url, ".", call. = FALSE)
         returnvalue[i] <- NA
         next
       }
 
-      if (property %in% c('atc', 'name')) {
+      if (property %in% c("atc", "name")) {
         # ATC and name are only in first row
         returnvalue[i] <- tbl[1, property]
       } else {
-        if (!'adm.r' %in% colnames(tbl) | is.na(tbl[1, 'adm.r'])) {
+        if (!"adm.r" %in% colnames(tbl) | is.na(tbl[1, "adm.r"])) {
           returnvalue[i] <- NA
           next
         } else {
-          for (j in 1:nrow(tbl)) {
+          for (j in seq_len(length(tbl))) {
-            if (tbl[j, 'adm.r'] == administration) {
+            if (tbl[j, "adm.r"] == administration) {
               returnvalue[i] <- tbl[j, property]
             }
           }
@@ -195,4 +195,3 @@ atc_online_groups <- function(atc_code, ...) {
 atc_online_ddd <- function(atc_code, ...) {
   atc_online_property(atc_code = atc_code, property = "ddd", ...)
 }
-

R/availability.R

@@ -44,7 +44,9 @@
 #'   select_if(is.rsi) %>%
 #'   availability()
 availability <- function(tbl, width = NULL) {
-  x <- base::sapply(tbl, function(x) { 1 - base::sum(base::is.na(x)) / base::length(x) })
+  x <- base::sapply(tbl, function(x) {
+    1 - base::sum(base::is.na(x)) / base::length(x) 
+  })
   n <- base::sapply(tbl, function(x) base::length(x[!base::is.na(x)]))
   R <- base::sapply(tbl, function(x) base::ifelse(is.rsi(x), portion_R(x, minimum = 0), NA))
   R_print <- character(length(R))
@@ -83,7 +85,7 @@ availability <- function(tbl, width = NULL) {
                    resistant = R_print,
                    visual_resistance = vis_resistance)
   if (length(R[is.na(R)]) == ncol(tbl)) {
-    df[,1:3]
+    df[, 1:3]
   } else {
     df
   }

R/bug_drug_combinations.R

@@ -31,7 +31,7 @@
 #' @param ... arguments passed on to \code{FUN}
 #' @inheritParams rsi_df
 #' @inheritParams base::formatC
-#' @importFrom dplyr %>% rename group_by select mutate filter pull
+#' @importFrom dplyr %>% rename group_by select mutate filter summarise ungroup
 #' @importFrom tidyr spread
 # @importFrom clean freq percentage
 #' @details The function \code{format} calculates the resistance per bug-drug combination. Use \code{combine_IR = FALSE} (default) to test R vs. S+I and \code{combine_IR = TRUE} to test R+I vs. S. 
@@ -46,7 +46,7 @@
 #' \donttest{
 #' x <- bug_drug_combinations(example_isolates)
 #' x
-#' format(x)
+#' format(x, translate_ab = "name (atc)")
 #' 
 #' # Use FUN to change to transformation of microorganism codes
 #' x <- bug_drug_combinations(example_isolates, 
@@ -76,7 +76,9 @@ bug_drug_combinations <- function(x,
   
   x <- x %>%
     as.data.frame(stringsAsFactors = FALSE) %>% 
-    mutate(mo = x %>% pull(col_mo) %>% FUN(...)) %>% 
+    mutate(mo = x %>% 
+             pull(col_mo) %>% 
+             FUN(...)) %>% 
     group_by(mo) %>% 
     select_if(is.rsi) %>% 
     gather("ab", "value", -mo) %>% 
@@ -112,7 +114,7 @@ format.bug_drug_combinations <- function(x,
   if (remove_intrinsic_resistant == TRUE) {
     x <- x %>% filter(R != total)
   }
-  if (combine_IR == FALSE | combine_SI == TRUE) {
+  if (combine_SI == TRUE | combine_IR == FALSE) {
     x$isolates <- x$R
   } else {
     x$isolates <- x$R + x$I
@@ -121,7 +123,7 @@ format.bug_drug_combinations <- function(x,
   give_ab_name <- function(ab, format, language) {
     format <- tolower(format)
     ab_txt <- rep(format, length(ab))
-    for (i in 1:length(ab_txt)) {
+    for (i in seq_len(length(ab_txt))) {
       ab_txt[i] <- gsub("ab", ab[i], ab_txt[i])
       ab_txt[i] <- gsub("cid", ab_cid(ab[i]), ab_txt[i])
       ab_txt[i] <- gsub("group", ab_group(ab[i], language = language), ab_txt[i])

R/count.R

@@ -154,7 +154,7 @@ count_all <- function(..., only_all_tested = FALSE) {
 
 #' @rdname count
 #' @export
-n_rsi<- count_all
+n_rsi <- count_all
 
 #' @rdname count
 #' @export

R/data.R

@@ -203,10 +203,10 @@ dataset_UTF8_to_ASCII <- function(df) {
     iconv(vect, from = "UTF-8", to = "ASCII//TRANSLIT")
   }
   df <- as.data.frame(df, stringsAsFactors = FALSE)
-  for (i in 1:NCOL(df)) {
+  for (i in seq_len(NCOL(df))) {
     col <- df[, i]
     if (is.list(col)) {
-      for (j in 1:length(col)) {
+      for (j in seq_len(length(col))) {
         col[[j]] <- trans(col[[j]])
       }
       df[, i] <- list(col)

R/disk.R

@@ -64,14 +64,14 @@ as.disk <- function(x, na.rm = FALSE) {
       list_missing <- x.bak[is.na(x) & !is.na(x.bak)] %>%
         unique() %>%
         sort()
-      list_missing <- paste0('"', list_missing , '"', collapse = ", ")
+      list_missing <- paste0('"', list_missing, '"', collapse = ", ")
-      warning(na_after - na_before, ' results truncated (',
+      warning(na_after - na_before, " results truncated (",
               round(((na_after - na_before) / length(x)) * 100),
-              '%) that were invalid disk zones: ',
+              "%) that were invalid disk zones: ",
               list_missing, call. = FALSE)
     }
 
-    class(x) <- c('disk', 'integer')
+    class(x) <- c("disk", "integer")
     x
   }
 }
@@ -80,7 +80,7 @@ as.disk <- function(x, na.rm = FALSE) {
 #' @export
 #' @importFrom dplyr %>%
 is.disk <- function(x) {
-  class(x) %>% identical(c('disk', 'integer'))
+  class(x) %>% identical(c("disk", "integer"))
 }
 
 #' @exportMethod print.disk

R/eucast_rules.R

@@ -233,8 +233,15 @@ eucast_rules <- function(x,
   
   warned <- FALSE
   
-  txt_error <- function() { cat("", bgRed(white(" ERROR ")), "\n\n") }
+  txt_error <- function() {
-  txt_warning <- function() { if (warned == FALSE) { cat("", bgYellow(black(" WARNING "))) }; warned <<- TRUE }
+    cat("", bgRed(white(" ERROR ")), "\n\n") 
+  }
+  txt_warning <- function() {
+    if (warned == FALSE) {
+      cat("", bgYellow(black(" WARNING ")))
+    }
+    warned <<- TRUE 
+  }
   txt_ok <- function(no_added, no_changed) {
     if (warned == FALSE) {
       if (no_added + no_changed == 0) {
@@ -337,69 +344,69 @@ eucast_rules <- function(x,
                             verbose = verbose,
                             ...)
   
-  AMC <- cols_ab['AMC']
+  AMC <- cols_ab["AMC"]
-  AMK <- cols_ab['AMK']
+  AMK <- cols_ab["AMK"]
-  AMP <- cols_ab['AMP']
+  AMP <- cols_ab["AMP"]
-  AMX <- cols_ab['AMX']
+  AMX <- cols_ab["AMX"]
-  ATM <- cols_ab['ATM']
+  ATM <- cols_ab["ATM"]
-  AZL <- cols_ab['AZL']
+  AZL <- cols_ab["AZL"]
-  AZM <- cols_ab['AZM']
+  AZM <- cols_ab["AZM"]
-  CAZ <- cols_ab['CAZ']
+  CAZ <- cols_ab["CAZ"]
-  CED <- cols_ab['CED']
+  CED <- cols_ab["CED"]
-  CHL <- cols_ab['CHL']
+  CHL <- cols_ab["CHL"]
-  CIP <- cols_ab['CIP']
+  CIP <- cols_ab["CIP"]
-  CLI <- cols_ab['CLI']
+  CLI <- cols_ab["CLI"]
-  CLR <- cols_ab['CLR']
+  CLR <- cols_ab["CLR"]
-  COL <- cols_ab['COL']
+  COL <- cols_ab["COL"]
-  CRO <- cols_ab['CRO']
+  CRO <- cols_ab["CRO"]
-  CTX <- cols_ab['CTX']
+  CTX <- cols_ab["CTX"]
-  CXM <- cols_ab['CXM']
+  CXM <- cols_ab["CXM"]
-  CZO <- cols_ab['CZO']
+  CZO <- cols_ab["CZO"]
-  DAP <- cols_ab['DAP']
+  DAP <- cols_ab["DAP"]
-  DOX <- cols_ab['DOX']
+  DOX <- cols_ab["DOX"]
-  ERY <- cols_ab['ERY']
+  ERY <- cols_ab["ERY"]
-  ETP <- cols_ab['ETP']
+  ETP <- cols_ab["ETP"]
-  FEP <- cols_ab['FEP']
+  FEP <- cols_ab["FEP"]
-  FLC <- cols_ab['FLC']
+  FLC <- cols_ab["FLC"]
-  FOS <- cols_ab['FOS']
+  FOS <- cols_ab["FOS"]
-  FOX <- cols_ab['FOX']
+  FOX <- cols_ab["FOX"]
-  FUS <- cols_ab['FUS']
+  FUS <- cols_ab["FUS"]
-  GEN <- cols_ab['GEN']
+  GEN <- cols_ab["GEN"]
-  IPM <- cols_ab['IPM']
+  IPM <- cols_ab["IPM"]
-  KAN <- cols_ab['KAN']
+  KAN <- cols_ab["KAN"]
-  LIN <- cols_ab['LIN']
+  LIN <- cols_ab["LIN"]
-  LNZ <- cols_ab['LNZ']
+  LNZ <- cols_ab["LNZ"]
-  LVX <- cols_ab['LVX']
+  LVX <- cols_ab["LVX"]
-  MEM <- cols_ab['MEM']
+  MEM <- cols_ab["MEM"]
-  MEZ <- cols_ab['MEZ']
+  MEZ <- cols_ab["MEZ"]
-  MFX <- cols_ab['MFX']
+  MFX <- cols_ab["MFX"]
-  MNO <- cols_ab['MNO']
+  MNO <- cols_ab["MNO"]
-  NAL <- cols_ab['NAL']
+  NAL <- cols_ab["NAL"]
-  NEO <- cols_ab['NEO']
+  NEO <- cols_ab["NEO"]
-  NET <- cols_ab['NET']
+  NET <- cols_ab["NET"]
-  NIT <- cols_ab['NIT']
+  NIT <- cols_ab["NIT"]
-  NOR <- cols_ab['NOR']
+  NOR <- cols_ab["NOR"]
-  NOV <- cols_ab['NOV']
+  NOV <- cols_ab["NOV"]
-  OFX <- cols_ab['OFX']
+  OFX <- cols_ab["OFX"]
-  OXA <- cols_ab['OXA']
+  OXA <- cols_ab["OXA"]
-  PEN <- cols_ab['PEN']
+  PEN <- cols_ab["PEN"]
-  PIP <- cols_ab['PIP']
+  PIP <- cols_ab["PIP"]
-  PLB <- cols_ab['PLB']
+  PLB <- cols_ab["PLB"]
-  PRI <- cols_ab['PRI']
+  PRI <- cols_ab["PRI"]
-  QDA <- cols_ab['QDA']
+  QDA <- cols_ab["QDA"]
-  RID <- cols_ab['RID']
+  RID <- cols_ab["RID"]
-  RIF <- cols_ab['RIF']
+  RIF <- cols_ab["RIF"]
-  RXT <- cols_ab['RXT']
+  RXT <- cols_ab["RXT"]
-  SIS <- cols_ab['SIS']
+  SIS <- cols_ab["SIS"]
-  SXT <- cols_ab['SXT']
+  SXT <- cols_ab["SXT"]
-  TCY <- cols_ab['TCY']
+  TCY <- cols_ab["TCY"]
-  TEC <- cols_ab['TEC']
+  TEC <- cols_ab["TEC"]
-  TGC <- cols_ab['TGC']
+  TGC <- cols_ab["TGC"]
-  TIC <- cols_ab['TIC']
+  TIC <- cols_ab["TIC"]
-  TMP <- cols_ab['TMP']
+  TMP <- cols_ab["TMP"]
-  TOB <- cols_ab['TOB']
+  TOB <- cols_ab["TOB"]
-  TZP <- cols_ab['TZP']
+  TZP <- cols_ab["TZP"]
-  VAN <- cols_ab['VAN']
+  VAN <- cols_ab["VAN"]
   
   ab_missing <- function(ab) {
     all(ab %in% c(NULL, NA))
@@ -425,11 +432,11 @@ eucast_rules <- function(x,
         # insert into original table
         x_original[rows, cols] <<- to,
         warning = function(w) {
-          if (w$message %like% 'invalid factor level') {
+          if (w$message %like% "invalid factor level") {
             x_original <<- x_original %>% mutate_at(vars(cols), ~factor(x = as.character(.), levels = c(to, levels(.))))
             x <<- x %>% mutate_at(vars(cols), ~factor(x = as.character(.), levels = c(to, levels(.))))
             x_original[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.\nA better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.', call. = FALSE)
+            warning('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing factor level.\nA better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call. = FALSE)
             txt_warning()
             warned <<- FALSE
           } else {
@@ -442,8 +449,8 @@ eucast_rules <- function(x,
           txt_error()
           stop(paste0("In row(s) ", paste(rows[1:min(length(rows), 10)], collapse = ","), 
                       ifelse(length(rows) > 10, "...", ""),
-                      ' while writing value "', to, 
+                      " while writing value '", to, 
-                      '" to column(s) `', paste(cols, collapse = "`, `"), 
+                      "' to column(s) `", paste(cols, collapse = "`, `"), 
                       "`:\n", e$message),
                call. = FALSE)
         }
@@ -453,17 +460,17 @@ eucast_rules <- function(x,
         x[rows, cols] <<- x_original[rows, cols],
         error = function(e) {
           stop(paste0("In row(s) ", paste(rows[1:min(length(rows), 10)], collapse = ","),
-                      '... while writing value "', to, 
+                      "... while writing value '", to, 
-                      '" to column(s) `', paste(cols, collapse = "`, `"), 
+                      "' to column(s) `", paste(cols, collapse = "`, `"), 
                       "`:\n", e$message), call. = FALSE)
         }
       )
       
       # before_df might not be a data.frame, but a tibble or data.table instead
-      old <- as.data.frame(before_df, stringsAsFactors = FALSE)[rows,]
+      old <- as.data.frame(before_df, stringsAsFactors = FALSE)[rows, ]
       track_changes <- list(added = 0,
                             changed = 0)
-      for (i in 1:length(cols)) {
+      for (i in seq_len(length(cols))) {
         verbose_new <- data.frame(row = rows,
                                   col = cols[i],
                                   mo_fullname = x[rows, "fullname"],
@@ -530,6 +537,7 @@ eucast_rules <- function(x,
     AMP <- AMX
   }
   
+  # nolint start
   # antibiotic classes
   aminoglycosides <- c(TOB, GEN, KAN, NEO, NET, SIS)
   tetracyclines <- c(DOX, MNO, TCY) # since EUCAST v3.1 tigecycline (TGC) is set apart
@@ -544,12 +552,13 @@ eucast_rules <- function(x,
   ureidopenicillins <- c(PIP, TZP, AZL, MEZ)
   all_betalactams <- c(aminopenicillins, cephalosporins, carbapenems, ureidopenicillins, AMC, OXA, FLC, PEN)
   fluoroquinolones <- c(OFX, CIP, NOR, LVX, MFX)
+  # nolint end
   
   # Help function to get available antibiotic column names ------------------
   get_antibiotic_columns <- function(x, df) {
     x <- trimws(unlist(strsplit(x, ",", fixed = TRUE)))
     y <- character(0)
-    for (i in 1:length(x)) {
+    for (i in seq_len(length(x))) {
       if (is.function(get(x[i]))) {
         stop("Column ", x[i], " is also a function. Please create an issue on github.com/msberends/AMR/issues.")
       }
@@ -562,7 +571,7 @@ eucast_rules <- function(x,
       strsplit(",") %>%
       unlist() %>%
       trimws() %>%
-      sapply(function(x) if(x %in% AMR::antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE) else x) %>%
+      sapply(function(x) if (x %in% AMR::antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE) else x) %>%
       sort() %>%
       paste(collapse = ", ")
   }
@@ -598,14 +607,13 @@ eucast_rules <- function(x,
   eucast_rules_df <- eucast_rules_file # internal data file
   no_added <- 0
   no_changed <- 0
-  for (i in 1:nrow(eucast_rules_df)) {
+  for (i in seq_len(nrow(eucast_rules_df))) {
     
     rule_previous <- eucast_rules_df[max(1, i - 1), "reference.rule"]
     rule_current <- eucast_rules_df[i, "reference.rule"]
     rule_next <- eucast_rules_df[min(nrow(eucast_rules_df), i + 1), "reference.rule"]
     rule_group_previous <- eucast_rules_df[max(1, i - 1), "reference.rule_group"]
     rule_group_current <- eucast_rules_df[i, "reference.rule_group"]
-    rule_group_next <- eucast_rules_df[min(nrow(eucast_rules_df), i + 1), "reference.rule_group"]
     if (is.na(eucast_rules_df[i, 4])) {
       rule_text <- paste0("always report as '", eucast_rules_df[i, 7], "': ", get_antibiotic_names(eucast_rules_df[i, 6]))
     } else {
@@ -620,7 +628,6 @@ eucast_rules <- function(x,
     }
     if (i == nrow(eucast_rules_df)) {
       rule_next <- ""
-      rule_group_next <- ""
     }
     
     # don't apply rules if user doesn't want to apply them
@@ -695,7 +702,7 @@ eucast_rules <- function(x,
     if (like_is_one_of == "is") {
       mo_value <- paste0("^", eucast_rules_df[i, 3], "$")
     } else if (like_is_one_of == "one_of") {
-      # "Clostridium, Actinomyces, ..." -> "^(Clostridium|Actinomyces|...)$"
+      # so 'Clostridium, Actinomyces, ...' will turn into '^(Clostridium|Actinomyces|...)$'
       mo_value <- paste0("^(",
                          paste(trimws(unlist(strsplit(eucast_rules_df[i, 3], ",", fixed = TRUE))),
                                collapse = "|"),
@@ -774,10 +781,10 @@ eucast_rules <- function(x,
       arrange(row, rule_group, rule_name, col)
     
     cat(paste0("\n", grey(strrep("-", options()$width - 1)), "\n"))
-    cat(bold(paste('EUCAST rules', paste0(wouldve, 'affected'),
+    cat(bold(paste("EUCAST rules", paste0(wouldve, "affected"),
                    formatnr(n_distinct(verbose_info$row)),
-                   'out of', formatnr(nrow(x_original)),
+                   "out of", formatnr(nrow(x_original)),
-                   'rows, making a total of', formatnr(nrow(verbose_info)), 'edits\n')))
+                   "rows, making a total of", formatnr(nrow(verbose_info)), "edits\n")))
     
     n_added <- verbose_info %>% filter(is.na(old)) %>% nrow()
     n_changed <- verbose_info %>% filter(!is.na(old)) %>% nrow()
@@ -847,4 +854,3 @@ eucast_rules <- function(x,
     x_original
   }
 }
-

R/first_isolate.R

@@ -124,39 +124,11 @@
 #' # set key antibiotics to a new variable
 #' x$keyab <- key_antibiotics(x)
 #'
-#' x$first_isolate <-
+#' x$first_isolate <- first_isolate(x)
-#'   first_isolate(x)
 #'
-#' x$first_isolate_weighed <-
+#' x$first_isolate_weighed <- first_isolate(x, col_keyantibiotics = 'keyab')
-#'   first_isolate(x,
-#'                 col_keyantibiotics = 'keyab')
 #'
-#' x$first_blood_isolate <-
+#' x$first_blood_isolate <- first_isolate(x, specimen_group = "Blood")
-#'   first_isolate(x,
-#'                 specimen_group = 'Blood')
-#'
-#' x$first_blood_isolate_weighed <-
-#'   first_isolate(x,
-#'                 specimen_group = 'Blood',
-#'                 col_keyantibiotics = 'keyab')
-#'
-#' x$first_urine_isolate <-
-#'   first_isolate(x,
-#'                 specimen_group = 'Urine')
-#'
-#' x$first_urine_isolate_weighed <-
-#'   first_isolate(x,
-#'                 specimen_group = 'Urine',
-#'                 col_keyantibiotics = 'keyab')
-#'
-#' x$first_resp_isolate <-
-#'   first_isolate(x,
-#'                 specimen_group = 'Respiratory')
-#'
-#' x$first_resp_isolate_weighed <-
-#'   first_isolate(x,
-#'                 specimen_group = 'Respiratory',
-#'                 col_keyantibiotics = 'keyab')
 #' }
 first_isolate <- function(x,
                           col_date = NULL,
@@ -176,23 +148,23 @@ first_isolate <- function(x,
                           info = TRUE,
                           include_unknown = FALSE,
                           ...) {
-
+  
   if (!is.data.frame(x)) {
     stop("`x` must be a data.frame.", call. = FALSE)
   }
-
+  
   dots <- unlist(list(...))
   if (length(dots) != 0) {
     # backwards compatibility with old parameters
     dots.names <- dots %>% names()
-    if ('filter_specimen' %in% dots.names) {
+    if ("filter_specimen" %in% dots.names) {
-      specimen_group <- dots[which(dots.names == 'filter_specimen')]
+      specimen_group <- dots[which(dots.names == "filter_specimen")]
     }
-    if ('tbl' %in% dots.names) {
+    if ("tbl" %in% dots.names) {
-      x <- dots[which(dots.names == 'tbl')]
+      x <- dots[which(dots.names == "tbl")]
     }
   }
-
+  
   # try to find columns based on type
   # -- mo
   if (is.null(col_mo)) {
@@ -201,7 +173,7 @@ first_isolate <- function(x,
   if (is.null(col_mo)) {
     stop("`col_mo` must be set.", call. = FALSE)
   }
-
+  
   # -- date
   if (is.null(col_date)) {
     col_date <- search_type_in_df(x = x, type = "date")
@@ -213,14 +185,14 @@ first_isolate <- function(x,
   dates <- x %>% pull(col_date) %>% as.Date()
   dates[is.na(dates)] <- as.Date("1970-01-01")
   x[, col_date] <- dates
-
+  
   # -- patient id
   if (is.null(col_patient_id)) {
-    if (all(c("First name", "Last name", "Sex", "Identification number") %in% colnames(x))) {
+    if (all(c("First name", "Last name", "Sex") %in% colnames(x))) {
       # WHONET support
       x <- x %>% mutate(patient_id = paste(`First name`, `Last name`, Sex))
       col_patient_id <- "patient_id"
-      message(blue(paste0("NOTE: Using combined columns `", bold("First name"), "`, `", bold("Last name"), "` and `", bold("Sex"), "` as input for `col_patient_id`.")))
+      message(blue(paste0("NOTE: Using combined columns `", bold("First name"), "`, `", bold("Last name"), "` and `", bold("Sex"), "` as input for `col_patient_id`")))
     } else {
       col_patient_id <- search_type_in_df(x = x, type = "patient_id")
     }
@@ -228,7 +200,7 @@ first_isolate <- function(x,
   if (is.null(col_patient_id)) {
     stop("`col_patient_id` must be set.", call. = FALSE)
   }
-
+  
   # -- key antibiotics
   if (is.null(col_keyantibiotics)) {
     col_keyantibiotics <- search_type_in_df(x = x, type = "keyantibiotics")
@@ -236,7 +208,7 @@ first_isolate <- function(x,
   if (isFALSE(col_keyantibiotics)) {
     col_keyantibiotics <- NULL
   }
-
+  
   # -- specimen
   if (is.null(col_specimen) & !is.null(specimen_group)) {
     col_specimen <- search_type_in_df(x = x, type = "specimen")
@@ -244,30 +216,30 @@ first_isolate <- function(x,
   if (isFALSE(col_specimen)) {
     col_specimen <- NULL
   }
-
+  
   # check if columns exist
   check_columns_existance <- function(column, tblname = x) {
     if (NROW(tblname) <= 1 | NCOL(tblname) <= 1) {
-      stop('Please check tbl for existance.')
+      stop("Please check tbl for existance.")
     }
-
+    
     if (!is.null(column)) {
       if (!(column %in% colnames(tblname))) {
-        stop('Column `', column, '` not found.')
+        stop("Column `", column, "` not found.")
       }
     }
   }
-
+  
   check_columns_existance(col_date)
   check_columns_existance(col_patient_id)
   check_columns_existance(col_mo)
   check_columns_existance(col_testcode)
   check_columns_existance(col_icu)
   check_columns_existance(col_keyantibiotics)
-
+  
   # create new dataframe with original row index
   x <- x %>%
-    mutate(newvar_row_index = 1:nrow(x),
+    mutate(newvar_row_index = seq_len(nrow(x)),
            newvar_mo = x %>% pull(col_mo) %>% as.mo(),
            newvar_genus_species = paste(mo_genus(newvar_mo), mo_species(newvar_mo)),
            newvar_date = x %>% pull(col_date),
@@ -278,41 +250,41 @@ first_isolate <- function(x,
   }
   # remove testcodes
   if (!is.null(testcodes_exclude) & info == TRUE) {
-    cat('[Criterion] Excluded test codes:\n', toString(testcodes_exclude), '\n')
+    message(blue(paste0("[Criterion] Excluded test codes: ", toString(testcodes_exclude))))
   }
-
+  
   if (is.null(col_icu)) {
     icu_exclude <- FALSE
   } else {
     x <- x %>%
       mutate(col_icu = x %>% pull(col_icu) %>% as.logical())
   }
-
+  
   if (is.null(col_specimen)) {
     specimen_group <- NULL
   }
-
+  
   # filter on specimen group and keyantibiotics when they are filled in
   if (!is.null(specimen_group)) {
     check_columns_existance(col_specimen, x)
     if (info == TRUE) {
-      cat('[Criterion] Excluded other than specimen group \'', specimen_group, '\'\n', sep = '')
+      message(blue(paste0("[Criterion] Excluded other than specimen group '", specimen_group, "'")))
     }
   }
   if (!is.null(col_keyantibiotics)) {
     x <- x %>% mutate(key_ab = x %>% pull(col_keyantibiotics))
   }
-
+  
   if (is.null(testcodes_exclude)) {
-    testcodes_exclude <- ''
+    testcodes_exclude <- ""
   }
-
+  
   # arrange data to the right sorting
   if (is.null(specimen_group)) {
     # not filtering on specimen
     if (icu_exclude == FALSE) {
       if (info == TRUE & !is.null(col_icu)) {
-        cat('[Criterion] Included isolates from ICU.\n')
+        message(blue("[Criterion] Included isolates from ICU"))
       }
       x <- x %>%
         arrange(newvar_patient_id,
@@ -322,14 +294,14 @@ first_isolate <- function(x,
       row.end <- nrow(x)
     } else {
       if (info == TRUE) {
-        cat('[Criterion] Excluded isolates from ICU.\n')
+        message(blue("[Criterion] Excluded isolates from ICU"))
       }
       x <- x %>%
         arrange_at(c(col_icu,
                      "newvar_patient_id",
                      "newvar_genus_species",
                      "newvar_date"))
-
+      
       suppressWarnings(
         row.start <- which(x %>% pull(col_icu) == FALSE) %>% min(na.rm = TRUE)
       )
@@ -337,12 +309,12 @@ first_isolate <- function(x,
         row.end <- which(x %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE)
       )
     }
-
+    
   } else {
     # filtering on specimen and only analyse these row to save time
     if (icu_exclude == FALSE) {
       if (info == TRUE & !is.null(col_icu)) {
-        cat('[Criterion] Included isolates from ICU.\n')
+        message(blue("[Criterion] Included isolates from ICU.\n"))
       }
       x <- x %>%
         arrange_at(c(col_specimen,
@@ -357,7 +329,7 @@ first_isolate <- function(x,
       )
     } else {
       if (info == TRUE) {
-        cat('[Criterion] Excluded isolates from ICU.\n')
+        message(blue("[Criterion] Excluded isolates from ICU"))
       }
       x <- x %>%
         arrange_at(c(col_icu,
@@ -366,17 +338,19 @@ first_isolate <- function(x,
                      "newvar_genus_species",
                      "newvar_date"))
       suppressWarnings(
-        row.start <- which(x %>% pull(col_specimen) == specimen_group
+        row.start <- min(which(x %>% pull(col_specimen) == specimen_group
-                           & x %>% pull(col_icu) == FALSE) %>% min(na.rm = TRUE)
+                               & x %>% pull(col_icu) == FALSE), 
+                         na.rm = TRUE)
       )
       suppressWarnings(
-        row.end <- which(x %>% pull(col_specimen) == specimen_group
+        row.end <- max(which(x %>% pull(col_specimen) == specimen_group & 
-                         & x %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE)
+                               x %>% pull(col_icu) == FALSE),
+                       na.rm = TRUE)
       )
     }
-
+    
   }
-
+  
   # no isolates found
   if (abs(row.start) == Inf | abs(row.end) == Inf) {
     if (info == TRUE) {
@@ -386,21 +360,11 @@ first_isolate <- function(x,
   }
   
   # did find some isolates - add new index numbers of rows
-  x <- x %>% mutate(newvar_row_index_sorted = 1:nrow(.))
+  x <- x %>% mutate(newvar_row_index_sorted = seq_len(nrow(.)))
-
+  
-  # suppress warnings because dplyr wants us to use library(dplyr) when using filter(row_number())
+  scope.size <- row.end - row.start + 1
-  #suppressWarnings(
+  
-    scope.size <- row.end - row.start + 1
+  identify_new_year <- function(x, episode_days) {
-  #   x %>%
-  #     filter(
-  #       row_number() %>% between(row.start,
-  #                                row.end),
-  #       newvar_genus != "",
-  #       newvar_species != "") %>%
-  #     nrow()
-  # )
-
-  identify_new_year = function(x, episode_days) {
     # I asked on StackOverflow:
     # https://stackoverflow.com/questions/42122245/filter-one-row-every-year
     if (length(x) == 1) {
@@ -421,7 +385,7 @@ first_isolate <- function(x,
     result[indices] <- TRUE
     return(result)
   }
-
+  
   # Analysis of first isolate ----
   all_first <- x %>%
     mutate(other_pat_or_mo = if_else(newvar_patient_id == lag(newvar_patient_id)
@@ -433,21 +397,19 @@ first_isolate <- function(x,
     mutate(more_than_episode_ago = identify_new_year(x = newvar_date,
                                                      episode_days = episode_days)) %>%
     ungroup()
-
+  
-  weighted.notice <- ''
+  weighted.notice <- ""
   if (!is.null(col_keyantibiotics)) {
-    weighted.notice <- 'weighted '
+    weighted.notice <- "weighted "
     if (info == TRUE) {
-      if (type == 'keyantibiotics') {
+      if (type == "keyantibiotics") {
-        cat('[Criterion] Inclusion based on key antibiotics, ')
+        message(blue(paste0("[Criterion] Inclusion based on key antibiotics, ",
-        if (ignore_I == FALSE) {
+                            ifelse(ignore_I == FALSE, "not ", ""),
-          cat('not ')
+                            "ignoring I")))
-        }
-        cat('ignoring I.\n')
       }
-      if (type == 'points') {
+      if (type == "points") {
-        cat(paste0('[Criterion] Inclusion based on key antibiotics, using points threshold of '
+        message(blue(paste0("[Criterion] Inclusion based on key antibiotics, using points threshold of "
-                   , points_threshold, '.\n'))
+                            , points_threshold)))
       }
     }
     type_param <- type
@@ -473,24 +435,24 @@ first_isolate <- function(x,
     # no key antibiotics
     all_first <- all_first %>%
       mutate(
-          real_first_isolate =
+        real_first_isolate =
-            if_else(
+          if_else(
-              newvar_row_index_sorted %>% between(row.start, row.end)
+            newvar_row_index_sorted %>% between(row.start, row.end)
-              & newvar_genus_species != ""
+            & newvar_genus_species != ""
-              & (other_pat_or_mo | more_than_episode_ago),
+            & (other_pat_or_mo | more_than_episode_ago),
-              TRUE,
+            TRUE,
-              FALSE))
+            FALSE))
     
   }
-
+  
   # first one as TRUE
-  all_first[row.start, 'real_first_isolate'] <- TRUE
+  all_first[row.start, "real_first_isolate"] <- TRUE
   # no tests that should be included, or ICU
   if (!is.null(col_testcode)) {
-    all_first[which(all_first[, col_testcode] %in% tolower(testcodes_exclude)), 'real_first_isolate'] <- FALSE
+    all_first[which(all_first[, col_testcode] %in% tolower(testcodes_exclude)), "real_first_isolate"] <- FALSE
   }
   if (icu_exclude == TRUE) {
-    all_first[which(all_first[, col_icu] == TRUE), 'real_first_isolate'] <- FALSE
+    all_first[which(all_first[, col_icu] == TRUE), "real_first_isolate"] <- FALSE
   }
   
   decimal.mark <- getOption("OutDec")
@@ -498,26 +460,20 @@ first_isolate <- function(x,
   
   # handle empty microorganisms
   if (any(all_first$newvar_mo == "UNKNOWN", na.rm = TRUE) & info == TRUE) {
-    if (include_unknown == TRUE) {
+    message(blue(paste0("NOTE: ", ifelse(include_unknown == TRUE, "Included ", "Excluded "), 
-      message(blue(paste0("NOTE: Included ", format(sum(all_first$newvar_mo == "UNKNOWN"),
+                        format(sum(all_first$newvar_mo == "UNKNOWN"),
-                                                    decimal.mark = decimal.mark, big.mark = big.mark), 
+                               decimal.mark = decimal.mark, big.mark = big.mark), 
-                          ' isolates with a microbial ID "UNKNOWN" (column `', bold(col_mo), '`).')))
+                        " isolates with a microbial ID 'UNKNOWN' (column `", bold(col_mo), "`)")))
-    } else {
-      message(blue(paste0("NOTE: Excluded ", format(sum(all_first$newvar_mo == "UNKNOWN"),
-                                                    decimal.mark = decimal.mark, big.mark = big.mark), 
-                          ' isolates with a microbial ID "UNKNOWN" (column `', bold(col_mo), '`).')))
-      
-    }
   }
-  all_first[which(all_first$newvar_mo == "UNKNOWN"), 'real_first_isolate'] <- include_unknown
+  all_first[which(all_first$newvar_mo == "UNKNOWN"), "real_first_isolate"] <- include_unknown
   
   # exclude all NAs
   if (any(is.na(all_first$newvar_mo)) & info == TRUE) {
     message(blue(paste0("NOTE: Excluded ", format(sum(is.na(all_first$newvar_mo)),
                                                   decimal.mark = decimal.mark, big.mark = big.mark), 
-                        ' isolates with a microbial ID "NA" (column `', bold(col_mo), '`).')))
+                        " isolates with a microbial ID 'NA' (column `", bold(col_mo), "`)")))
   }
-  all_first[which(is.na(all_first$newvar_mo)), 'real_first_isolate'] <- FALSE
+  all_first[which(is.na(all_first$newvar_mo)), "real_first_isolate"] <- FALSE
   
   # arrange back according to original sorting again
   all_first <- all_first %>%
@@ -541,9 +497,9 @@ first_isolate <- function(x,
     }
     base::message(msg_txt)
   }
-
+  
   all_first
-
+  
 }
 
 #' @rdname first_isolate
@@ -580,5 +536,5 @@ filter_first_weighted_isolate <- function(x,
                                   col_mo = col_mo,
                                   col_keyantibiotics = "keyab",
                                   ...))
-  x[which(tbl_keyab$firsts == TRUE),]
+  x[which(tbl_keyab$firsts == TRUE), ]
 }

R/g.test.R

@@ -107,10 +107,10 @@
 #' # Meaning: there are significantly more left-billed birds.
 #'
 g.test <- function(x,
-                    y = NULL,
+                   y = NULL,
-                    # correct = TRUE,
+                   # correct = TRUE,
-                    p = rep(1/length(x), length(x)),
+                   p = rep(1 / length(x), length(x)),
-                    rescale.p = FALSE) {
+                   rescale.p = FALSE) {
   DNAME <- deparse(substitute(x))
   if (is.data.frame(x))
     x <- as.matrix(x)
@@ -144,11 +144,8 @@ g.test <- function(x,
     stop("all entries of 'x' must be nonnegative and finite")
   if ((n <- sum(x)) == 0)
     stop("at least one entry of 'x' must be positive")
-  # if (simulate.p.value) {
+  
-  #   setMETH <- function() METHOD <<- paste(METHOD, "with simulated p-value\n\t (based on",
+  
-  #                                          B, "replicates)")
-  #   almost.1 <- 1 - 64 * .Machine$double.eps
-  # }
   if (is.matrix(x)) {
     METHOD <- "G-test of independence"
     nr <- as.integer(nrow(x))
@@ -157,34 +154,18 @@ g.test <- function(x,
       stop("invalid nrow(x) or ncol(x)", domain = NA)
     # add fisher.test suggestion
     if (nr == 2 && nc == 2)
-      warning("`fisher.test()` is always more reliable for 2x2 tables and although must slower, often only takes seconds.")
+      warning("`fisher.test()` is always more reliable for 2x2 tables and although much slower, often only takes seconds.")
     sr <- rowSums(x)
     sc <- colSums(x)
-    E <- outer(sr, sc, "*")/n
+    E <- outer(sr, sc, "*") / n
-    v <- function(r, c, n) c * r * (n - r) * (n - c)/n^3
+    v <- function(r, c, n) c * r * (n - r) * (n - c) / n ^ 3
     V <- outer(sr, sc, v, n)
     dimnames(E) <- dimnames(x)
-    # if (simulate.p.value && all(sr > 0) && all(sc > 0)) {
+    
-    #   setMETH()
+    STATISTIC <- 2 * sum(x * log(x / E)) # sum((abs(x - E) - YATES)^2/E) for chisq.test
-    #   tmp <- .Call(chisq_sim, sr, sc, B, E, PACKAGE = "stats")
+    PARAMETER <- (nr - 1L) * (nc - 1L)
-    #   STATISTIC <- 2 * sum(x * log(x / E)) # sum(sort((x - E)^2/E, decreasing = TRUE)) for chisq.test
+    PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
-    #   PARAMETER <- NA
+    
-    #   PVAL <- (1 + sum(tmp >= almost.1 * STATISTIC))/(B +
-    #                                                     1)
-    # }
-    # else {
-      # if (simulate.p.value)
-      #   warning("cannot compute simulated p-value with zero marginals")
-      # if (correct && nrow(x) == 2L && ncol(x) == 2L) {
-      #   YATES <- min(0.5, abs(x - E))
-      #   if (YATES > 0)
-      #     METHOD <- paste(METHOD, "with Yates' continuity correction")
-      # }
-      # else YATES <- 0
-      STATISTIC <- 2 * sum(x * log(x / E)) # sum((abs(x - E) - YATES)^2/E) for chisq.test
-      PARAMETER <- (nr - 1L) * (nc - 1L)
-      PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
-   # }
   }
   else {
     if (length(dim(x)) > 2L)
@@ -197,7 +178,7 @@ g.test <- function(x,
       stop("probabilities must be non-negative.")
     if (abs(sum(p) - 1) > sqrt(.Machine$double.eps)) {
       if (rescale.p)
-        p <- p/sum(p)
+        p <- p / sum(p)
       else stop("probabilities must sum to 1.")
     }
     METHOD <- "G-test of goodness-of-fit (likelihood ratio test)"
@@ -205,30 +186,18 @@ g.test <- function(x,
     V <- n * p * (1 - p)
     STATISTIC <- 2 * sum(x * log(x / E)) # sum((x - E)^2/E) for chisq.test
     names(E) <- names(x)
-    # if (simulate.p.value) {
+    
-    #   setMETH()
+    PARAMETER <- length(x) - 1
-    #   nx <- length(x)
+    PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
-    #   sm <- matrix(sample.int(nx, B * n, TRUE, prob = p),
+    
-    #                nrow = n)
-    #   ss <- apply(sm, 2L, function(x, E, k) {
-    #     sum((table(factor(x, levels = 1L:k)) - E)^2/E)
-    #   }, E = E, k = nx)
-    #   PARAMETER <- NA
-    #   PVAL <- (1 + sum(ss >= almost.1 * STATISTIC))/(B +
-    #                                                    1)
-    # }
-    # else {
-      PARAMETER <- length(x) - 1
-      PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
-    # }
   }
   names(STATISTIC) <- "X-squared"
   names(PARAMETER) <- "df"
   if (any(E < 5) && is.finite(PARAMETER))
     warning("G-statistic approximation may be incorrect due to E < 5")
-
+  
   structure(list(statistic = STATISTIC, parameter = PARAMETER,
                  p.value = PVAL, method = METHOD, data.name = DNAME,
-                 observed = x, expected = E, residuals = (x - E)/sqrt(E),
+                 observed = x, expected = E, residuals = (x - E) / sqrt(E),
-                 stdres = (x - E)/sqrt(V)), class = "htest")
+                 stdres = (x - E) / sqrt(V)), class = "htest")
 }

R/ggplot_rsi.R

@@ -292,9 +292,9 @@ geom_rsi <- function(position = NULL,
     x <- substr(x, 2, nchar(x) - 1)
   }
 
-  if (tolower(x) %in% tolower(c('ab', 'abx', 'antibiotics'))) {
+  if (tolower(x) %in% tolower(c("ab", "abx", "antibiotics"))) {
     x <- "antibiotic"
-  } else if (tolower(x) %in% tolower(c('SIR', 'RSI', 'interpretations', 'result'))) {
+  } else if (tolower(x) %in% tolower(c("SIR", "RSI", "interpretations", "result"))) {
     x <- "interpretation"
   }
 
@@ -327,9 +327,9 @@ facet_rsi <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) {
     facet <- substr(facet, 2, nchar(facet) - 1)
   }
 
-  if (tolower(facet) %in% tolower(c('SIR', 'RSI', 'interpretations', 'result'))) {
+  if (tolower(facet) %in% tolower(c("SIR", "RSI", "interpretations", "result"))) {
     facet <- "interpretation"
-  } else if (tolower(facet) %in% tolower(c('ab', 'abx', 'antibiotics'))) {
+  } else if (tolower(facet) %in% tolower(c("ab", "abx", "antibiotics"))) {
     facet <- "antibiotic"
   }
 
@@ -358,8 +358,8 @@ scale_rsi_colours <- function(colours = c(S = "#61a8ff",
                                           IR = "#ff6961",
                                           R = "#ff6961")) {
   stopifnot_installed_package("ggplot2")
-  #ggplot2::scale_fill_brewer(palette = "RdYlGn")
+  # previous colour: palette = "RdYlGn"
-  #ggplot2::scale_fill_manual(values = c("#b22222", "#ae9c20", "#7cfc00"))
+  # previous colours: values = c("#b22222", "#ae9c20", "#7cfc00")
 
   if (!identical(colours, FALSE)) {
     original_cols <- c(S = "#61a8ff",

R/guess_ab_col.R

@@ -83,9 +83,6 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
     } else if (any(tolower(colnames(x)) %in% tolower(unlist(ab_property(search_string.ab, "abbreviations"))))) {
       ab_result <- colnames(x)[tolower(colnames(x)) %in% tolower(unlist(ab_property(search_string.ab, "abbreviations")))][1L]
 
-    # } else if (any(tolower(colnames(x)) %in% tolower(ab_tradenames(search_string.ab)))) {
-    #   ab_result <- colnames(x)[tolower(colnames(x)) %in% tolower(ab_tradenames(search_string.ab))][1L]
-
     } else {
       # sort colnames on length - longest first
       cols <- colnames(x[, x %>% colnames() %>% nchar() %>% order() %>% rev()])
@@ -128,7 +125,7 @@ get_column_abx <- function(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
-  vectr_antibiotics <- unique(toupper(unlist(AMR::antibiotics[,c("ab", "atc", "name", "abbreviations", "synonyms")])))
+  vectr_antibiotics <- unique(toupper(unlist(AMR::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 | 
@@ -144,12 +141,12 @@ get_column_abx <- function(x,
 
   df_trans <- data.frame(colnames = colnames(x),
                          abcode = suppressWarnings(as.ab(colnames(x))))
-  df_trans <- df_trans[!is.na(df_trans$abcode),]
+  df_trans <- df_trans[!is.na(df_trans$abcode), ]
   x <- as.character(df_trans$colnames)
   names(x) <- df_trans$abcode
 
   # add from self-defined dots (...):
-  # get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
+  # such as get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
   dots <- list(...)
   if (length(dots) > 0) {
     newnames <- suppressWarnings(as.ab(names(dots)))
@@ -173,12 +170,12 @@ get_column_abx <- function(x,
   x <- x[!names(x) %in% names(duplicates)]
   
   if (verbose == TRUE) {
-    for (i in 1:length(x)) {
+    for (i in seq_len(length(x))) {
       message(blue(paste0("NOTE: Using column `", bold(x[i]), "` as input for `", names(x)[i],
                           "` (", ab_name(names(x)[i], tolower = TRUE), ").")))
     }
   } else if (length(duplicates) > 0) {
-    for (i in 1:length(duplicates)) {
+    for (i in seq_len(length(duplicates))) {
       warning(red(paste0("Using column `", bold(duplicates[i]), "` as input for `", names(x[which(x == duplicates[i])]), 
                          "` (", ab_name(names(x[names(which(x == duplicates))[i]]), tolower = TRUE), 
                          "), although it was matched for multiple antibiotics or columns.")), call. = FALSE)
@@ -203,7 +200,7 @@ get_column_abx <- function(x,
         mutate(txt = paste0(bold(missing), " (", missing_names, ")")) %>%
         arrange(missing_names) %>%
         pull(txt)
-      message(blue('NOTE: Reliability might be improved if these antimicrobial results would be available too:',
+      message(blue("NOTE: Reliability might be improved if these antimicrobial results would be available too:",
                    paste(missing_txt, collapse = ", ")))
     }
   }

R/join_microorganisms.R

@@ -56,7 +56,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
     dplyr::inner_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
   )
   if (nrow(join) > nrow(x)) {
-    warning('The newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original.')
+    warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
   }
   join
 }
@@ -71,7 +71,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
     dplyr::left_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
   )
   if (nrow(join) > nrow(x)) {
-    warning('The newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original.')
+    warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
   }
   join
 }
@@ -86,7 +86,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
     dplyr::right_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
   )
   if (nrow(join) > nrow(x)) {
-    warning('The newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original.')
+    warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
   }
   join
 }
@@ -101,7 +101,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
     dplyr::full_join(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
   )
   if (nrow(join) > nrow(x)) {
-    warning('The newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original.')
+    warning("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
   }
   join
 }

R/key_antibiotics.R

@@ -118,7 +118,7 @@ key_antibiotics <- function(x,
     names(col.list) <- col.list
     col.list.bak <- col.list
     # are they available as upper case or lower case then?
-    for (i in 1:length(col.list)) {
+    for (i in seq_len(length(col.list))) {
       if (is.null(col.list[i]) | isTRUE(is.na(col.list[i]))) {
         col.list[i] <- NA
       } else if (toupper(col.list[i]) %in% colnames(x)) {
@@ -131,9 +131,9 @@ key_antibiotics <- function(x,
     }
     if (!all(col.list %in% colnames(x))) {
       if (info == TRUE) {
-        warning('Some columns do not exist and will be ignored: ',
+        warning("Some columns do not exist and will be ignored: ",
                 col.list.bak[!(col.list %in% colnames(x))] %>% toString(),
-                '.\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.',
+                ".\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.",
                 immediate. = TRUE,
                 call. = FALSE)
       }
@@ -164,7 +164,7 @@ key_antibiotics <- function(x,
   universal <- c(universal_1, universal_2, universal_3,
                  universal_4, universal_5, universal_6)
 
-  gram_positive = c(universal,
+  gram_positive <- c(universal,
                     GramPos_1, GramPos_2, GramPos_3,
                     GramPos_4, GramPos_5, GramPos_6)
   gram_positive <- gram_positive[!is.null(gram_positive)]
@@ -173,7 +173,7 @@ key_antibiotics <- function(x,
     warning("only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram-positives. See ?key_antibiotics.", call. = FALSE)
   }
 
-  gram_negative = c(universal,
+  gram_negative <- c(universal,
                     GramNeg_1, GramNeg_2, GramNeg_3,
                     GramNeg_4, GramNeg_5, GramNeg_6)
   gram_negative <- gram_negative[!is.null(gram_negative)]
@@ -211,8 +211,8 @@ key_antibiotics <- function(x,
   # format
   key_abs <- x %>%
     pull(key_ab) %>%
-    gsub('(NA|NULL)', '.', .) %>%
+    gsub("(NA|NULL)", ".", .) %>%
-    gsub('[^SIR]', '.', ., ignore.case = TRUE) %>%
+    gsub("[^SIR]", ".", ., ignore.case = TRUE) %>%
     toupper()
   
   if (n_distinct(key_abs) == 1) {
@@ -239,7 +239,7 @@ key_antibiotics_equal <- function(y,
   type <- type[1]
 
   if (length(x) != length(y)) {
-    stop('Length of `x` and `y` must be equal.')
+    stop("Length of `x` and `y` must be equal.")
   }
 
   # only show progress bar on points or when at least 5000 isolates
@@ -251,17 +251,17 @@ key_antibiotics_equal <- function(y,
     p <- dplyr::progress_estimated(length(x))
   }
 
-  for (i in 1:length(x)) {
+  for (i in seq_len(length(x))) {
 
     if (info_needed == TRUE) {
       p$tick()$print()
     }
 
     if (is.na(x[i])) {
-      x[i] <- ''
+      x[i] <- ""
     }
     if (is.na(y[i])) {
-      y[i] <- ''
+      y[i] <- ""
     }
 
     if (x[i] == y[i]) {
@@ -277,7 +277,7 @@ key_antibiotics_equal <- function(y,
       x_split <- strsplit(x[i], "")[[1]]
       y_split <- strsplit(y[i], "")[[1]]
 
-      if (type == 'keyantibiotics') {
+      if (type == "keyantibiotics") {
 
         if (ignore_I == TRUE) {
           x_split[x_split == "I"] <- "."
@@ -289,7 +289,7 @@ key_antibiotics_equal <- function(y,
 
         result[i] <- all(x_split == y_split)
 
-      } else if (type == 'points') {
+      } else if (type == "points") {
         # count points for every single character:
         # - no change is 0 points
         # - I <-> S|R is 0.5 point
@@ -303,12 +303,12 @@ key_antibiotics_equal <- function(y,
         result[i] <- points >= points_threshold
 
       } else {
-        stop('`', type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?key_antibiotics')
+        stop("`", type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?key_antibiotics')
       }
     }
   }
   if (info_needed == TRUE) {
-    cat('\n')
+    cat("\n")
   }
   result
 }

R/kurtosis.R

@@ -37,7 +37,7 @@ kurtosis <- function(x, na.rm = FALSE) {
 #' @exportMethod kurtosis.default
 #' @rdname kurtosis
 #' @export
-kurtosis.default <- function (x, na.rm = FALSE) {
+kurtosis.default <- function(x, na.rm = FALSE) {
   x <- as.vector(x)
   if (na.rm == TRUE) {
     x <- x[!is.na(x)]
@@ -50,13 +50,13 @@ kurtosis.default <- function (x, na.rm = FALSE) {
 #' @exportMethod kurtosis.matrix
 #' @rdname kurtosis
 #' @export
-kurtosis.matrix <- function (x, na.rm = FALSE) {
+kurtosis.matrix <- function(x, na.rm = FALSE) {
   base::apply(x, 2, kurtosis.default, na.rm = na.rm)
 }
 
 #' @exportMethod kurtosis.data.frame
 #' @rdname kurtosis
 #' @export
-kurtosis.data.frame <- function (x, na.rm = FALSE) {
+kurtosis.data.frame <- function(x, na.rm = FALSE) {
   base::sapply(x, kurtosis.default, na.rm = na.rm)
 }

R/like.R

@@ -69,7 +69,7 @@ like <- function(x, pattern, ignore.case = TRUE) {
     } else {
       # x and pattern are of same length, so items with each other
       res <- vector(length = length(pattern))
-      for (i in 1:length(res)) {
+      for (i in seq_len(length(res))) {
         if (is.factor(x[i])) {
           res[i] <- as.integer(x[i]) %in% base::grep(pattern[i], levels(x[i]), ignore.case = ignore.case)
         } else {

R/mdro.R

@@ -272,7 +272,7 @@ mdro <- function(x,
         row_filter <- which(x[, cols] == "R")
       } else if (any_all == "all") {
         row_filter <- x %>%
-          mutate(index = 1:nrow(.)) %>%
+          mutate(index = seq_len(nrow(.))) %>%
           filter_at(vars(cols), all_vars(. == "R")) %>%
           pull((index))
       }
@@ -452,7 +452,7 @@ mdro <- function(x,
         & !ab_missing(GEN) & !ab_missing(TOB)
         & !ab_missing(CIP)
         & !ab_missing(CAZ)
-        & !ab_missing(TZP) ) {
+        & !ab_missing(TZP)) {
       x$psae <- 0
       x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"] <- 1 + x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"]
       x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"] <- 1 + x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"]

R/mic.R

@@ -65,29 +65,29 @@ as.mic <- function(x, na.rm = FALSE) {
     x.bak <- x
 
     # comma to period
-    x <- gsub(',', '.', x, fixed = TRUE)
+    x <- gsub(",", ".", x, fixed = TRUE)
     # remove space between operator and number ("<= 0.002" -> "<=0.002")
-    x <- gsub('(<|=|>) +', '\\1', x)
+    x <- gsub("(<|=|>) +", "\\1", x)
     # transform => to >= and =< to <=
-    x <- gsub('=>', '>=', x, fixed = TRUE)
+    x <- gsub("=>", ">=", x, fixed = TRUE)
-    x <- gsub('=<', '<=', x, fixed = TRUE)
+    x <- gsub("=<", "<=", x, fixed = TRUE)
     # starting dots must start with 0
-    x <- gsub('^[.]+', '0.', x)
+    x <- gsub("^[.]+", "0.", x)
     # <=0.2560.512 should be 0.512
-    x <- gsub('.*[.].*[.]', '0.', x)
+    x <- gsub(".*[.].*[.]", "0.", x)
     # remove ending .0
-    x <- gsub('[.]+0$', '', x)
+    x <- gsub("[.]+0$", "", x)
     # remove all after last digit
-    x <- gsub('[^0-9]+$', '', x)
+    x <- gsub("[^0-9]+$", "", x)
     # keep only one zero before dot
     x <- gsub("0+[.]", "0.", x)
     # starting 00 is probably 0.0 if there's no dot yet
     x[!x %like% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
     # remove last zeroes
-    x <- gsub('([.].?)0+$', '\\1', x)
+    x <- gsub("([.].?)0+$", "\\1", x)
-    x <- gsub('(.*[.])0+$', '\\10', x)
+    x <- gsub("(.*[.])0+$", "\\10", x)
     # remove ending .0 again
-    x[x %like% "[.]"] <- gsub('0+$', '', x[x %like% "[.]"])
+    x[x %like% "[.]"] <- gsub("0+$", "", x[x %like% "[.]"])
     # force to be character
     x <- as.character(x)
     # trim it
@@ -190,23 +190,23 @@ as.mic <- function(x, na.rm = FALSE) {
               "<1024", "<=1024", "1024", ">=1024", ">1024",
               "1025")
 
-    na_before <- x[is.na(x) | x == ''] %>% length()
+    na_before <- x[is.na(x) | x == ""] %>% length()
     x[!x %in% lvls] <- NA
-    na_after <- x[is.na(x) | x == ''] %>% length()
+    na_after <- x[is.na(x) | x == ""] %>% length()
 
     if (na_before != na_after) {
-      list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ''] %>%
+      list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ""] %>%
         unique() %>%
         sort()
-      list_missing <- paste0('"', list_missing , '"', collapse = ", ")
+      list_missing <- paste0('"', list_missing, '"', collapse = ", ")
-      warning(na_after - na_before, ' results truncated (',
+      warning(na_after - na_before, " results truncated (",
               round(((na_after - na_before) / length(x)) * 100),
-              '%) that were invalid MICs: ',
+              "%) that were invalid MICs: ",
               list_missing, call. = FALSE)
     }
 
     structure(.Data = factor(x, levels = lvls, ordered = TRUE),
-              class =  c('mic', 'ordered', 'factor'))
+              class =  c("mic", "ordered", "factor"))
   }
 }
 
@@ -214,36 +214,36 @@ as.mic <- function(x, na.rm = FALSE) {
 #' @export
 #' @importFrom dplyr %>%
 is.mic <- function(x) {
-  class(x) %>% identical(c('mic', 'ordered', 'factor'))
+  class(x) %>% identical(c("mic", "ordered", "factor"))
 }
 
 #' @exportMethod as.double.mic
 #' @export
 #' @noRd
 as.double.mic <- function(x, ...) {
-  as.double(gsub('(<|=|>)+', '', as.character(x)))
+  as.double(gsub("(<|=|>)+", "", as.character(x)))
 }
 
 #' @exportMethod as.integer.mic
 #' @export
 #' @noRd
 as.integer.mic <- function(x, ...) {
-  as.integer(gsub('(<|=|>)+', '', as.character(x)))
+  as.integer(gsub("(<|=|>)+", "", as.character(x)))
 }
 
 #' @exportMethod as.numeric.mic
 #' @export
 #' @noRd
 as.numeric.mic <- function(x, ...) {
-  as.numeric(gsub('(<|=|>)+', '', as.character(x)))
+  as.numeric(gsub("(<|=|>)+", "", as.character(x)))
 }
 
 #' @exportMethod droplevels.mic
 #' @export
 #' @noRd
-droplevels.mic <- function(x, exclude = if(anyNA(levels(x))) NULL else NA, ...) {
+droplevels.mic <- function(x, exclude = ifelse(anyNA(levels(x)), NULL, NA), ...) {
   x <- droplevels.factor(x, exclude = exclude, ...)
-  class(x) <- c('mic', 'ordered', 'factor')
+  class(x) <- c("mic", "ordered", "factor")
   x
 }
 
@@ -266,7 +266,7 @@ summary.mic <- function(object, ...) {
   x <- x[!is.na(x)]
   n <- x %>% length()
   c(
-    "Class" = 'mic',
+    "Class" = "mic",
     "<NA>" = n_total - n,
     "Min." = sort(x)[1] %>% as.character(),
     "Max." = sort(x)[n] %>% as.character()
@@ -278,9 +278,9 @@ summary.mic <- function(object, ...) {
 #' @importFrom graphics barplot axis par
 #' @noRd
 plot.mic <- function(x,
-                     main = paste('MIC values of', deparse(substitute(x))),
+                     main = paste("MIC values of", deparse(substitute(x))),
-                     ylab = 'Frequency',
+                     ylab = "Frequency",
-                     xlab = 'MIC value',
+                     xlab = "MIC value",
                      axes = FALSE,
                      ...) {
   barplot(table(droplevels.factor(x)),
@@ -297,9 +297,9 @@ plot.mic <- function(x,
 #' @importFrom graphics barplot axis
 #' @noRd
 barplot.mic <- function(height,
-                        main = paste('MIC values of', deparse(substitute(height))),
+                        main = paste("MIC values of", deparse(substitute(height))),
-                        ylab = 'Frequency',
+                        ylab = "Frequency",
-                        xlab = 'MIC value',
+                        xlab = "MIC value",
                         axes = FALSE,
                         ...) {
   barplot(table(droplevels.factor(height)),

R/misc.R

@@ -67,7 +67,7 @@ search_type_in_df <- function(x, type) {
              call. = FALSE)
       }
     } else {
-      for (i in 1:ncol(x)) {
+      for (i in seq_len(ncol(x))) {
         if (any(class(x %>% pull(i)) %in% c("Date", "POSIXct"))) {
           found <- colnames(x)[i]
           break
@@ -141,7 +141,7 @@ getdecimalplaces <- function(x, minimum = 0, maximum = 3) {
   if (minimum > maximum) {
     minimum <- maximum
   }
-  max_places <- max(unlist(lapply(strsplit(sub('0+$', '', 
+  max_places <- max(unlist(lapply(strsplit(sub("0+$", "", 
                                                as.character(x * 100)), ".", fixed = TRUE),
                                   function(y) ifelse(length(y) == 2, nchar(y[2]), 0))), na.rm = TRUE)
   max(min(max_places,

R/mo.R

@@ -197,7 +197,7 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE,
       & isFALSE(Becker)
       & isFALSE(Lancefield)
       & !is.null(reference_df)
-      & all(x %in% reference_df[,1][[1]])) {
+      & all(x %in% reference_df[, 1][[1]])) {
     
     # has valid own reference_df
     # (data.table not faster here)
@@ -308,13 +308,13 @@ exec_as.mo <- function(x,
     # support tidyverse selection like: df %>% select(colA, colB)
     # paste these columns together
     x_vector <- vector("character", NROW(x))
-    for (i in 1:NROW(x)) {
+    for (i in seq_len(NROW(x))) {
-      x_vector[i] <- paste(pull(x[i,], 1), pull(x[i,], 2), sep = " ")
+      x_vector[i] <- paste(pull(x[i, ], 1), pull(x[i, ], 2), sep = " ")
     }
     x <- x_vector
   } else {
     if (NCOL(x) > 2) {
-      stop('`x` can be 2 columns at most', call. = FALSE)
+      stop("`x` can be 2 columns at most", call. = FALSE)
     }
     x[is.null(x)] <- NA
     
@@ -544,7 +544,7 @@ exec_as.mo <- function(x,
       # if the input is longer than 10 characters, allow any constant between all characters, as some might have forgotten a character
       # this will allow "Pasteurella damatis" to be correctly read as "Pasteurella dagmatis".
       constants <- paste(letters[!letters %in% c("a", "e", "i", "o", "u")], collapse = "")
-      #x[nchar(x_backup_without_spp) > 10] <- gsub("([a-z])([a-z])", paste0("\\1[", constants, "]?\\2"), x[nchar(x_backup_without_spp) > 10])
+
       x[nchar(x_backup_without_spp) > 10] <- gsub("[+]", paste0("+[", constants, "]?"), x[nchar(x_backup_without_spp) > 10])
     }
     x <- strip_whitespace(x, dyslexia_mode)
@@ -558,11 +558,11 @@ exec_as.mo <- function(x,
     x_withspaces <- gsub("[ .]+", ".* ", x)
     x <- gsub("[ .]+", ".*", x)
     # add start en stop regex
-    x <- paste0('^', x, '$')
+    x <- paste0("^", x, "$")
     
-    x_withspaces_start_only <- paste0('^', x_withspaces)
+    x_withspaces_start_only <- paste0("^", x_withspaces)
-    x_withspaces_end_only <- paste0(x_withspaces, '$')
+    x_withspaces_end_only <- paste0(x_withspaces, "$")
-    x_withspaces_start_end <- paste0('^', x_withspaces, '$')
+    x_withspaces_start_end <- paste0("^", x_withspaces, "$")
     
     if (isTRUE(debug)) {
       cat(paste0('x                       "', x, '"\n'))
@@ -579,7 +579,7 @@ exec_as.mo <- function(x,
     
     progress <- progress_estimated(n = length(x), min_time = 3)
     
-    for (i in 1:length(x)) {
+    for (i in seq_len(length(x))) {
       
       progress$tick()$print()
       
@@ -681,23 +681,6 @@ exec_as.mo <- function(x,
       # check for very small input, but ignore the O antigens of E. coli
       if (nchar(gsub("[^a-zA-Z]", "", x_trimmed[i])) < 3
           & !x_backup_without_spp[i] %like_case% "[Oo]?(26|103|104|104|111|121|145|157)") {
-        # check if search term was like "A. species", then return first genus found with ^A
-        # if (x_backup[i] %like% "[a-z]+ species" | x_backup[i] %like% "[a-z] spp[.]?") {
-        #   # get mo code of first hit
-        #   found <- microorganismsDT[fullname %like% x_withspaces_start_only[i], mo]
-        #   if (length(found) > 0) {
-        #     mo_code <- found[1L] %>% strsplit("_") %>% unlist() %>% .[1:2] %>% paste(collapse = "_")
-        #     found <- microorganismsDT[mo == mo_code, ..property][[1]]
-        #     # return first genus that begins with x_trimmed, e.g. when "E. spp."
-        #     if (length(found) > 0) {
-        #       x[i] <- found[1L]
-        #       if (initial_search == TRUE) {
-        #         set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
-        #       }
-        #       next
-        #     }
-        #   }
-        # }
         # fewer than 3 chars and not looked for species, add as failure
         x[i] <- microorganismsDT[mo == "UNKNOWN", ..property][[1]]
         if (initial_search == TRUE) {
@@ -715,17 +698,17 @@ exec_as.mo <- function(x,
       
       # translate known trivial abbreviations to genus + species ----
       if (!is.na(x_trimmed[i])) {
-        if (toupper(x_backup_without_spp[i]) %in% c('MRSA', 'MSSA', 'VISA', 'VRSA')
+        if (toupper(x_backup_without_spp[i]) %in% c("MRSA", "MSSA", "VISA", "VRSA")
             | x_backup_without_spp[i] %like_case% " (mrsa|mssa|visa|vrsa) ") {
-          x[i] <- microorganismsDT[mo == 'B_STPHY_AURS', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STPHY_AURS", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (toupper(x_backup_without_spp[i]) %in% c('MRSE', 'MSSE')
+        if (toupper(x_backup_without_spp[i]) %in% c("MRSE", "MSSE")
             | x_backup_without_spp[i] %like_case% " (mrse|msse) ") {
-          x[i] <- microorganismsDT[mo == 'B_STPHY_EPDR', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STPHY_EPDR", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
@@ -733,8 +716,8 @@ exec_as.mo <- function(x,
         }
         if (toupper(x_backup_without_spp[i]) == "VRE"
             | x_backup_without_spp[i] %like_case% " vre "
-            | x_backup_without_spp[i] %like_case% '(enterococci|enterokok|enterococo)[a-z]*?$')  {
+            | x_backup_without_spp[i] %like_case% "(enterococci|enterokok|enterococo)[a-z]*?$")  {
-          x[i] <- microorganismsDT[mo == 'B_ENTRC', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_ENTRC", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
@@ -755,39 +738,39 @@ exec_as.mo <- function(x,
         if (toupper(x_backup_without_spp[i]) %in% c("AIEC", "ATEC", "DAEC", "EAEC", "EHEC", "EIEC", "EPEC", "ETEC", "NMEC", "STEC", "UPEC")
             # also support O-antigens of E. coli: O26, O103, O104, O111, O121, O145, O157
             | x_backup_without_spp[i] %like_case% "o?(26|103|104|111|121|145|157)") {
-          x[i] <- microorganismsDT[mo == 'B_ESCHR_COLI', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_ESCHR_COLI", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (toupper(x_backup_without_spp[i]) == 'MRPA'
+        if (toupper(x_backup_without_spp[i]) == "MRPA"
             | x_backup_without_spp[i] %like_case% " mrpa ") {
           # multi resistant P. aeruginosa
-          x[i] <- microorganismsDT[mo == 'B_PSDMN_ARGN', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_PSDMN_ARGN", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (toupper(x_backup_without_spp[i]) == 'CRSM') {
+        if (toupper(x_backup_without_spp[i]) == "CRSM") {
           # co-trim resistant S. maltophilia
-          x[i] <- microorganismsDT[mo == 'B_STNTR_MLTP', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STNTR_MLTP", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (toupper(x_backup_without_spp[i]) %in% c('PISP', 'PRSP', 'VISP', 'VRSP')
+        if (toupper(x_backup_without_spp[i]) %in% c("PISP", "PRSP", "VISP", "VRSP")
             | x_backup_without_spp[i] %like_case% " (pisp|prsp|visp|vrsp) ") {
           # peni I, peni R, vanco I, vanco R: S. pneumoniae
-          x[i] <- microorganismsDT[mo == 'B_STRPT_PNMN', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STRPT_PNMN", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% '^g[abcdfghk]s$') {
+        if (x_backup_without_spp[i] %like_case% "^g[abcdfghk]s$") {
           # Streptococci, like GBS = Group B Streptococci (B_STRPT_GRPB)
           x[i] <- microorganismsDT[mo == toupper(gsub("g([abcdfghk])s", "B_STRPT_GRP\\1", x_backup_without_spp[i])), ..property][[1]][1L]
           if (initial_search == TRUE) {
@@ -795,7 +778,7 @@ exec_as.mo <- function(x,
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% '(streptococ|streptokok).* [abcdfghk]$') {
+        if (x_backup_without_spp[i] %like_case% "(streptococ|streptokok).* [abcdfghk]$") {
           # Streptococci in different languages, like "estreptococos grupo B"
           x[i] <- microorganismsDT[mo == toupper(gsub(".*(streptococ|streptokok|estreptococ).* ([abcdfghk])$", "B_STRPT_GRP\\2", x_backup_without_spp[i])), ..property][[1]][1L]
           if (initial_search == TRUE) {
@@ -803,7 +786,7 @@ exec_as.mo <- function(x,
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% 'group [abcdfghk] (streptococ|streptokok|estreptococ)') {
+        if (x_backup_without_spp[i] %like_case% "group [abcdfghk] (streptococ|streptokok|estreptococ)") {
           # Streptococci in different languages, like "Group A Streptococci"
           x[i] <- microorganismsDT[mo == toupper(gsub(".*group ([abcdfghk]) (streptococ|streptokok|estreptococ).*", "B_STRPT_GRP\\1", x_backup_without_spp[i])), ..property][[1]][1L]
           if (initial_search == TRUE) {
@@ -811,79 +794,79 @@ exec_as.mo <- function(x,
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% 'haemoly.*strept') {
+        if (x_backup_without_spp[i] %like_case% "haemoly.*strept") {
           # Haemolytic streptococci in different languages
-          x[i] <- microorganismsDT[mo == 'B_STRPT_HAEM', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STRPT_HAEM", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
         # CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese) ----
-        if (x_backup_without_spp[i] %like_case% '[ck]oagulas[ea] negatie?[vf]'
+        if (x_backup_without_spp[i] %like_case% "[ck]oagulas[ea] negatie?[vf]"
-            | x_trimmed[i] %like_case% '[ck]oagulas[ea] negatie?[vf]'
+            | x_trimmed[i] %like_case% "[ck]oagulas[ea] negatie?[vf]"
-            | x_backup_without_spp[i] %like_case% '[ck]o?ns[^a-z]?$') {
+            | x_backup_without_spp[i] %like_case% "[ck]o?ns[^a-z]?$") {
           # coerce S. coagulase negative
-          x[i] <- microorganismsDT[mo == 'B_STPHY_CONS', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STPHY_CONS", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% '[ck]oagulas[ea] positie?[vf]'
+        if (x_backup_without_spp[i] %like_case% "[ck]oagulas[ea] positie?[vf]"
-            | x_trimmed[i] %like_case% '[ck]oagulas[ea] positie?[vf]'
+            | x_trimmed[i] %like_case% "[ck]oagulas[ea] positie?[vf]"
-            | x_backup_without_spp[i] %like_case% '[ck]o?ps[^a-z]?$') {
+            | x_backup_without_spp[i] %like_case% "[ck]o?ps[^a-z]?$") {
           # coerce S. coagulase positive
-          x[i] <- microorganismsDT[mo == 'B_STPHY_COPS', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STPHY_COPS", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
         # streptococcal groups: milleri and viridans
-        if (x_trimmed[i] %like_case% 'strepto.* milleri'
+        if (x_trimmed[i] %like_case% "strepto.* milleri"
-            | x_backup_without_spp[i] %like_case% 'strepto.* milleri'
+            | x_backup_without_spp[i] %like_case% "strepto.* milleri"
-            | x_backup_without_spp[i] %like_case% 'mgs[^a-z]?$') {
+            | x_backup_without_spp[i] %like_case% "mgs[^a-z]?$") {
           # Milleri Group Streptococcus (MGS)
-          x[i] <- microorganismsDT[mo == 'B_STRPT_MILL', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STRPT_MILL", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (x_trimmed[i] %like_case% 'strepto.* viridans'
+        if (x_trimmed[i] %like_case% "strepto.* viridans"
-            | x_backup_without_spp[i] %like_case% 'strepto.* viridans'
+            | x_backup_without_spp[i] %like_case% "strepto.* viridans"
-            | x_backup_without_spp[i] %like_case% 'vgs[^a-z]?$') {
+            | x_backup_without_spp[i] %like_case% "vgs[^a-z]?$") {
           # Viridans Group Streptococcus (VGS)
-          x[i] <- microorganismsDT[mo == 'B_STRPT_VIRI', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STRPT_VIRI", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% 'gram[ -]?neg.*'
+        if (x_backup_without_spp[i] %like_case% "gram[ -]?neg.*"
-            | x_backup_without_spp[i] %like_case% 'negatie?[vf]'
+            | x_backup_without_spp[i] %like_case% "negatie?[vf]"
-            | x_trimmed[i] %like_case% 'gram[ -]?neg.*') {
+            | x_trimmed[i] %like_case% "gram[ -]?neg.*") {
           # coerce Gram negatives
-          x[i] <- microorganismsDT[mo == 'B_GRAMN', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_GRAMN", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% 'gram[ -]?pos.*'
+        if (x_backup_without_spp[i] %like_case% "gram[ -]?pos.*"
-            | x_backup_without_spp[i] %like_case% 'positie?[vf]'
+            | x_backup_without_spp[i] %like_case% "positie?[vf]"
-            | x_trimmed[i] %like_case% 'gram[ -]?pos.*') {
+            | x_trimmed[i] %like_case% "gram[ -]?pos.*") {
           # coerce Gram positives
-          x[i] <- microorganismsDT[mo == 'B_GRAMP', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_GRAMP", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
           next
         }
-        if (x_backup_without_spp[i] %like_case% 'mycoba[ck]teri.[nm]?$') {
+        if (x_backup_without_spp[i] %like_case% "mycoba[ck]teri.[nm]?$") {
           # coerce Gram positives
-          x[i] <- microorganismsDT[mo == 'B_MYCBC', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_MYCBC", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
@@ -893,14 +876,14 @@ exec_as.mo <- function(x,
         if (x_backup_without_spp[i] %like_case% "salmonella [a-z]+ ?.*") {
           if (x_backup_without_spp[i] %like_case% "salmonella group") {
             # Salmonella Group A to Z, just return S. species for now
-            x[i] <- microorganismsDT[mo == 'B_SLMNL', ..property][[1]][1L]
+            x[i] <- microorganismsDT[mo == "B_SLMNL", ..property][[1]][1L]
             if (initial_search == TRUE) {
               set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
             }
             next
           } else if (grepl("[sS]almonella [A-Z][a-z]+ ?.*", x_backup[i], ignore.case = FALSE)) {
             # Salmonella with capital letter species like "Salmonella Goettingen" - they're all S. enterica
-            x[i] <- microorganismsDT[mo == 'B_SLMNL_ENTR', ..property][[1]][1L]
+            x[i] <- microorganismsDT[mo == "B_SLMNL_ENTR", ..property][[1]][1L]
             if (initial_search == TRUE) {
               set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
             }
@@ -915,7 +898,7 @@ exec_as.mo <- function(x,
         # trivial names known to the field:
         if ("meningococcus" %like_case% x_trimmed[i]) {
           # coerce Neisseria meningitidis
-          x[i] <- microorganismsDT[mo == 'B_NESSR_MNNG', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_NESSR_MNNG", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
@@ -923,7 +906,7 @@ exec_as.mo <- function(x,
         }
         if ("gonococcus" %like_case% x_trimmed[i]) {
           # coerce Neisseria gonorrhoeae
-          x[i] <- microorganismsDT[mo == 'B_NESSR_GNRR', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_NESSR_GNRR", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
@@ -931,7 +914,7 @@ exec_as.mo <- function(x,
         }
         if ("pneumococcus" %like_case% x_trimmed[i]) {
           # coerce Streptococcus penumoniae
-          x[i] <- microorganismsDT[mo == 'B_STRPT_PNMN', ..property][[1]][1L]
+          x[i] <- microorganismsDT[mo == "B_STRPT_PNMN", ..property][[1]][1L]
           if (initial_search == TRUE) {
             set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
           }
@@ -1030,7 +1013,7 @@ exec_as.mo <- function(x,
           x_length <- nchar(g.x_backup_without_spp)
           x_split <- paste0("^",
                             g.x_backup_without_spp %>% substr(1, x_length / 2),
-                            '.* ',
+                            ".* ",
                             g.x_backup_without_spp %>% substr((x_length / 2) + 1, x_length))
           found <- data_to_check[fullname_lower %like_case% x_split, ..property][[1]]
           if (length(found) > 0) {
@@ -1050,12 +1033,12 @@ exec_as.mo <- function(x,
         # look for old taxonomic names ----
         # wait until prevalence == 2 to run the old taxonomic results on both prevalence == 1 and prevalence == 2
         found <- data.old_to_check[fullname_lower == tolower(a.x_backup)
-                                   | fullname_lower %like_case% d.x_withspaces_start_end,]
+                                   | fullname_lower %like_case% d.x_withspaces_start_end, ]
         if (NROW(found) > 0) {
           col_id_new <- found[1, col_id_new]
           # when property is "ref" (which is the case in mo_ref, mo_authors and mo_year), return the old value, so:
-          # mo_ref("Chlamydia psittaci") = "Page, 1968" (with warning)
+          # mo_ref() of "Chlamydia psittaci" will be "Page, 1968" (with warning)
-          # mo_ref("Chlamydophila psittaci") = "Everett et al., 1999"
+          # mo_ref() of "Chlamydophila psittaci" will be "Everett et al., 1999"
           if (property == "ref") {
             x[i] <- found[1, ref]
           } else {
@@ -1067,9 +1050,7 @@ exec_as.mo <- function(x,
                       ref_old = found[1, ref],
                       ref_new = microorganismsDT[col_id == found[1, col_id_new], ref],
                       mo = microorganismsDT[col_id == found[1, col_id_new], mo])
-          # if (initial_search == TRUE) {
+          # no set history on renames
-          #   set_mo_history(a.x_backup, get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
-          # }
           return(x[i])
         }
         
@@ -1119,9 +1100,7 @@ exec_as.mo <- function(x,
                                       format_uncertainty_as_df(uncertainty_level = now_checks_for_uncertainty_level,
                                                                input = a.x_backup,
                                                                result_mo = microorganismsDT[col_id == found[1, col_id_new], mo]))
-              # if (initial_search == TRUE) {
+              # no set history on renames
-              #   set_mo_history(a.x_backup, get_mo_code(x, property), 1, force = force_mo_history, disable = disable_mo_history)
-              # }
               return(x)
             }
             
@@ -1243,11 +1222,11 @@ exec_as.mo <- function(x,
             }
             x_strip <- a.x_backup %>% strsplit(" ") %>% unlist()
             if (length(x_strip) > 1) {
-              for (i in 1:(length(x_strip) - 1)) {
+              for (i in seq_len(length(x_strip) - 1)) {
                 lastword <- x_strip[length(x_strip) - i + 1]
                 lastword_half <- substr(lastword, 1, as.integer(nchar(lastword) / 2))
                 # remove last half of the second term
-                x_strip_collapsed <- paste(c(x_strip[1:(length(x_strip) - i)], lastword_half), collapse = " ")
+                x_strip_collapsed <- paste(c(x_strip[seq_len(length(x_strip) - i)], lastword_half), collapse = " ")
                 if (nchar(x_strip_collapsed) >= 4 & nchar(lastword_half) > 2) {
                   if (isTRUE(debug)) {
                     message("Running '", x_strip_collapsed, "'")
@@ -1278,8 +1257,8 @@ exec_as.mo <- function(x,
               cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (7) try to strip off one element from end and check the remains\n")
             }
             if (length(x_strip) > 1) {
-              for (i in 1:(length(x_strip) - 1)) {
+              for (i in seq_len(length(x_strip) - 1)) {
-                x_strip_collapsed <- paste(x_strip[1:(length(x_strip) - i)], collapse = " ")
+                x_strip_collapsed <- paste(x_strip[seq_len(length(x_strip) - i)], collapse = " ")
                 if (nchar(x_strip_collapsed) >= 6) {
                   if (isTRUE(debug)) {
                     message("Running '", x_strip_collapsed, "'")
@@ -1412,8 +1391,8 @@ exec_as.mo <- function(x,
               cat("\n[ UNCERTAINTY LEVEL", now_checks_for_uncertainty_level, "] (11) try to strip off one element from end and check the remains (any text size)\n")
             }
             if (length(x_strip) > 1) {
-              for (i in 1:(length(x_strip) - 1)) {
+              for (i in seq_len(length(x_strip) - 1)) {
-                x_strip_collapsed <- paste(x_strip[1:(length(x_strip) - i)], collapse = " ")
+                x_strip_collapsed <- paste(x_strip[seq_len(length(x_strip) - i)], collapse = " ")
                 if (isTRUE(debug)) {
                   message("Running '", x_strip_collapsed, "'")
                 }
@@ -1579,7 +1558,7 @@ exec_as.mo <- function(x,
                   " (covering ", percentage(total_failures / total_n),
                   ") could not be coerced and ", plural[3], " considered 'unknown'")
     if (n_distinct(failures) <= 10) {
-      msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ', '))
+      msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ", "))
     }
     msg <- paste0(msg,  ". Use mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` parameter if needed (see ?as.mo).")
     warning(red(msg),
@@ -1639,35 +1618,35 @@ exec_as.mo <- function(x,
               immediate. = TRUE)
     }
     
-    x[x %in% CoNS] <- microorganismsDT[mo == 'B_STPHY_CONS', ..property][[1]][1L]
+    x[x %in% CoNS] <- microorganismsDT[mo == "B_STPHY_CONS", ..property][[1]][1L]
-    x[x %in% CoPS] <- microorganismsDT[mo == 'B_STPHY_COPS', ..property][[1]][1L]
+    x[x %in% CoPS] <- microorganismsDT[mo == "B_STPHY_COPS", ..property][[1]][1L]
     if (Becker == "all") {
-      x[x %in% microorganismsDT[mo %like_case% '^B_STPHY_AURS', ..property][[1]]] <- microorganismsDT[mo == 'B_STPHY_COPS', ..property][[1]][1L]
+      x[x %in% microorganismsDT[mo %like_case% "^B_STPHY_AURS", ..property][[1]]] <- microorganismsDT[mo == "B_STPHY_COPS", ..property][[1]][1L]
     }
   }
   
   # Lancefield ----
   if (Lancefield == TRUE | Lancefield == "all") {
     # group A - S. pyogenes
-    x[x == microorganismsDT[mo == 'B_STRPT_PYGN', ..property][[1]][1L]] <- microorganismsDT[mo == 'B_STRPT_GRPA', ..property][[1]][1L]
+    x[x == microorganismsDT[mo == "B_STRPT_PYGN", ..property][[1]][1L]] <- microorganismsDT[mo == "B_STRPT_GRPA", ..property][[1]][1L]
     # group B - S. agalactiae
-    x[x == microorganismsDT[mo == 'B_STRPT_AGLC', ..property][[1]][1L]] <- microorganismsDT[mo == 'B_STRPT_GRPB', ..property][[1]][1L]
+    x[x == microorganismsDT[mo == "B_STRPT_AGLC", ..property][[1]][1L]] <- microorganismsDT[mo == "B_STRPT_GRPB", ..property][[1]][1L]
     # group C
     S_groupC <- microorganismsDT %>% filter(genus == "Streptococcus",
                                             species %in% c("equisimilis", "equi",
                                                            "zooepidemicus", "dysgalactiae")) %>%
       pull(property)
-    x[x %in% S_groupC] <- microorganismsDT[mo == 'B_STRPT_GRPC', ..property][[1]][1L]
+    x[x %in% S_groupC] <- microorganismsDT[mo == "B_STRPT_GRPC", ..property][[1]][1L]
     if (Lancefield == "all") {
       # all Enterococci
-      x[x %like% "^(Enterococcus|B_ENTRC)"] <- microorganismsDT[mo == 'B_STRPT_GRPD', ..property][[1]][1L]
+      x[x %like% "^(Enterococcus|B_ENTRC)"] <- microorganismsDT[mo == "B_STRPT_GRPD", ..property][[1]][1L]
     }
     # group F - S. anginosus
-    x[x == microorganismsDT[mo == 'B_STRPT_ANGN', ..property][[1]][1L]] <- microorganismsDT[mo == 'B_STRPT_GRPF', ..property][[1]][1L]
+    x[x == microorganismsDT[mo == "B_STRPT_ANGN", ..property][[1]][1L]] <- microorganismsDT[mo == "B_STRPT_GRPF", ..property][[1]][1L]
     # group H - S. sanguinis
-    x[x == microorganismsDT[mo == 'B_STRPT_SNGN', ..property][[1]][1L]] <- microorganismsDT[mo == 'B_STRPT_GRPH', ..property][[1]][1L]
+    x[x == microorganismsDT[mo == "B_STRPT_SNGN", ..property][[1]][1L]] <- microorganismsDT[mo == "B_STRPT_GRPH", ..property][[1]][1L]
     # group K - S. salivarius
-    x[x == microorganismsDT[mo == 'B_STRPT_SLVR', ..property][[1]][1L]] <- microorganismsDT[mo == 'B_STRPT_GRPK', ..property][[1]][1L]
+    x[x == microorganismsDT[mo == "B_STRPT_SLVR", ..property][[1]][1L]] <- microorganismsDT[mo == "B_STRPT_GRPK", ..property][[1]][1L]
   }
   
   # Wrap up ----------------------------------------------------------------
@@ -1886,7 +1865,7 @@ print.mo_uncertainties <- function(x, ...) {
              ", 3 = ", red("very uncertain"), ")\n"))
   
   msg <- ""
-  for (i in 1:nrow(x)) {
+  for (i in seq_len(nrow(x))) {
     if (x[i, "uncertainty"] == 1) {
       colour1 <- green
       colour2 <- function(...) bgGreen(white(...))
@@ -1929,7 +1908,7 @@ print.mo_renamed <- function(x, ...) {
   if (NROW(x) == 0) {
     return(invisible())
   }
-  for (i in 1:nrow(x)) {
+  for (i in seq_len(nrow(x))) {
     message(blue(paste0("NOTE: ", 
                         italic(x$old_name[i]), ifelse(x$old_ref[i] %in% c("", NA), "", 
                                                       paste0(" (",  gsub("et al.", italic("et al."), x$old_ref[i]), ")")),
@@ -1955,15 +1934,10 @@ unregex <- function(x) {
 }
 
 get_mo_code <- function(x, property) {
-  # don't use right now
-  # return(NULL)
-  
   if (property == "mo") {
     unique(x)
   } else {
     microorganismsDT[get(property) == x, "mo"][[1]]
-    # which is ~2.5 times faster than:
-    # AMR::microorganisms[base::which(AMR::microorganisms[, property] %in% x),]$mo
   }
 }
 

R/mo_history.R

@@ -43,11 +43,11 @@ set_mo_history <- function(x, mo, uncertainty_level, force = FALSE, disable = FA
     }
     x <- toupper(df$x)
     mo <- df$mo
-    for (i in 1:length(x)) {
+    for (i in seq_len(length(x))) {
       # save package version too, as both the as.mo() algorithm and the reference data set may change
       if (NROW(mo_hist[base::which(mo_hist$x == x[i] &
                                    mo_hist$uncertainty_level >= uncertainty_level &
-                                   mo_hist$package_version == utils::packageVersion("AMR")),]) == 0) {
+                                   mo_hist$package_version == utils::packageVersion("AMR")), ]) == 0) {
         # # Not using the file system:        
         # tryCatch(options(mo_remembered_results = rbind(mo_hist,
         #                                                data.frame(
@@ -73,7 +73,9 @@ set_mo_history <- function(x, mo, uncertainty_level, force = FALSE, disable = FA
                                    stringsAsFactors = FALSE)),
                            row.names = FALSE,
                            file = mo_history_file()),
-                 error = function(e) { warning_new_write <- FALSE; base::invisible()})
+                 error = function(e) {
+                   warning_new_write <- FALSE; base::invisible()
+                 })
       }
     }
   }
@@ -87,7 +89,7 @@ get_mo_history <- function(x, uncertainty_level, force = FALSE, disable = FALSE)
   if (isTRUE(disable)) {
     return(to_class_mo(NA))
   }
-
+  
   history <- read_mo_history(uncertainty_level = uncertainty_level, force = force)
   if (base::is.null(history)) {
     result <- NA
@@ -105,7 +107,7 @@ read_mo_history <- function(uncertainty_level = 2, force = FALSE, unfiltered = F
   if (isTRUE(disable)) {
     return(NULL)
   }
-
+  
   if ((!base::interactive() & force == FALSE)) {
     return(NULL)
   }
@@ -123,7 +125,7 @@ read_mo_history <- function(uncertainty_level = 2, force = FALSE, unfiltered = F
   # Below: filter on current package version.
   # Even current fullnames may be replaced by new taxonomic names, so new versions of
   # the Catalogue of Life must not lead to data corruption.
-
+  
   if (unfiltered == FALSE) {
     history <- history %>%
       filter(package_version == as.character(utils::packageVersion("AMR")),
@@ -133,7 +135,7 @@ read_mo_history <- function(uncertainty_level = 2, force = FALSE, unfiltered = F
       arrange(desc(uncertainty_level)) %>%
       distinct(x, mo, .keep_all = TRUE)
   }
-
+  
   if (nrow(history) == 0) {
     NULL
   } else {

R/mo_property.R

@@ -158,8 +158,8 @@ mo_shortname <- function(x, language = get_locale(), ...) {
   shortnames <- paste0(substr(mo_genus(x.mo, language = NULL), 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL)))
   
   # exceptions for Staphylococci
-  shortnames[shortnames == "S. coagulase-negative" ] <- "CoNS"
+  shortnames[shortnames == "S. coagulase-negative"] <- "CoNS"
-  shortnames[shortnames == "S. coagulase-positive" ] <- "CoPS"
+  shortnames[shortnames == "S. coagulase-positive"] <- "CoPS"
   # exceptions for Streptococci: Streptococcus Group A -> GAS
   shortnames[shortnames %like% "S. group [ABCDFGHK]"] <- paste0("G", gsub("S. group ([ABCDFGHK])", "\\1", shortnames[shortnames %like% "S. group [ABCDFGHK]"]), "S")
 
@@ -384,7 +384,7 @@ mo_url <- function(x, open = FALSE, ...) {
 #' @rdname mo_property
 #' @importFrom data.table data.table as.data.table setkey
 #' @export
-mo_property <- function(x, property = 'fullname', language = get_locale(), ...) {
+mo_property <- function(x, property = "fullname", language = get_locale(), ...) {
   if (length(property) != 1L) {
     stop("'property' must be of length 1.")
   }

R/mo_source.R

@@ -99,7 +99,7 @@
 #' @inheritSection AMR Read more on our website!
 set_mo_source <- function(path) {
 
-  file_location <- path.expand('~/mo_source.rds')
+  file_location <- path.expand("~/mo_source.rds")
 
   if (!is.character(path) | length(path) > 1) {
     stop("`path` must be a character of length 1.")
@@ -119,17 +119,17 @@ set_mo_source <- function(path) {
     stop("File not found: ", path)
   }
 
-  if (path %like% '[.]rds$') {
+  if (path %like% "[.]rds$") {
     df <- readRDS(path)
 
-  } else if (path %like% '[.]xlsx?$') {
+  } else if (path %like% "[.]xlsx?$") {
     # is Excel file (old or new)
     if (!"readxl" %in% utils::installed.packages()) {
       stop("Install the 'readxl' package first.")
     }
     df <- readxl::read_excel(path)
 
-  } else if (path %like% '[.]tsv$') {
+  } else if (path %like% "[.]tsv$") {
     df <- utils::read.table(header = TRUE, sep = "\t", stringsAsFactors = FALSE)
 
   } else {
@@ -196,7 +196,7 @@ get_mo_source <- function() {
       # set updated source
       set_mo_source(getOption("mo_source"))
     }
-    file_location <- path.expand('~/mo_source.rds')
+    file_location <- path.expand("~/mo_source.rds")
     readRDS(file_location)
   }
 }

R/read.4d.R

@@ -154,7 +154,7 @@ read.4D <- function(file,
   if (info == TRUE) {
     message("OK\nSetting original column names as label... ", appendLF = FALSE)
   }
-  for (i in 1:ncol(data_4D)) {
+  for (i in seq_len(ncol(data_4D))) {
     if (!is.na(colnames.bak[i])) {
       attr(data_4D[, i], "label") <- colnames.bak[i]
     }
@@ -163,7 +163,7 @@ read.4D <- function(file,
   if (info == TRUE) {
     message("OK\nSetting query as label to data.frame... ", appendLF = FALSE)
   }
-  qry <- readLines(con <- file(file, open="r"))[1]
+  qry <- readLines(con <- file(file, open = "r"))[1]
   close(con)
   attr(data_4D, "label") <- qry
 
@@ -173,4 +173,3 @@ read.4D <- function(file,
 
   data_4D
 }
-

R/resistance_predict.R

@@ -120,7 +120,7 @@ resistance_predict <- function(x,
                                ...) {
 
   if (nrow(x) == 0) {
-    stop('This table does not contain any observations.')
+    stop("This table does not contain any observations.")
   }
   
   if (is.null(model)) {
@@ -128,17 +128,17 @@ resistance_predict <- function(x,
   }
 
   if (!col_ab %in% colnames(x)) {
-    stop('Column ', col_ab, ' not found.')
+    stop("Column ", col_ab, " not found.")
   }
 
   dots <- unlist(list(...))
   if (length(dots) != 0) {
     # backwards compatibility with old parameters
     dots.names <- dots %>% names()
-    if ('tbl' %in% dots.names) {
+    if ("tbl" %in% dots.names) {
-      x <- dots[which(dots.names == 'tbl')]
+      x <- dots[which(dots.names == "tbl")]
     }
-    if ('I_as_R' %in% dots.names) {
+    if ("I_as_R" %in% dots.names) {
       warning("`I_as_R is deprecated - use I_as_S instead.", call. = FALSE)
     }
   }
@@ -152,7 +152,7 @@ resistance_predict <- function(x,
   }
 
   if (!col_date %in% colnames(x)) {
-    stop('Column ', col_date, ' not found.')
+    stop("Column ", col_date, " not found.")
   }
 
   if (n_groups(x) > 1) {
@@ -161,10 +161,10 @@ resistance_predict <- function(x,
   }
 
   year <- function(x) {
-    if (all(grepl('^[0-9]{4}$', x))) {
+    if (all(grepl("^[0-9]{4}$", x))) {
       x
     } else {
-      as.integer(format(as.Date(x), '%Y'))
+      as.integer(format(as.Date(x), "%Y"))
     }
   }
   
@@ -181,8 +181,8 @@ resistance_predict <- function(x,
   }
   df <- df %>% 
     filter_at(col_ab, all_vars(!is.na(.))) %>%
-    mutate(year = pull(., col_date) %>% year()) %>%
+    mutate(year = year(pull(., col_date))) %>%
-    group_by_at(c('year', col_ab)) %>%
+    group_by_at(c("year", col_ab)) %>%
     summarise(n())
 
   if (df %>% pull(col_ab) %>% n_distinct(na.rm = TRUE) < 2) {
@@ -191,7 +191,7 @@ resistance_predict <- function(x,
          call. = FALSE)
   }
 
-  colnames(df) <- c('year', 'antibiotic', 'observations')
+  colnames(df) <- c("year", "antibiotic", "observations")
   df <- df %>%
     filter(!is.na(antibiotic)) %>%
     tidyr::spread(antibiotic, observations, fill = 0) %>%
@@ -202,7 +202,7 @@ resistance_predict <- function(x,
     as.matrix()
 
   if (NROW(df) == 0) {
-    stop('There are no observations.')
+    stop("There are no observations.")
   }
 
   year_lowest <- min(df$year)
@@ -217,12 +217,12 @@ resistance_predict <- function(x,
 
   years <- list(year = seq(from = year_min, to = year_max, by = year_every))
 
-  if (model %in% c('binomial', 'binom', 'logit')) {
+  if (model %in% c("binomial", "binom", "logit")) {
     model <- "binomial"
     model_lm <- with(df, glm(df_matrix ~ year, family = binomial))
     if (info == TRUE) {
-      cat('\nLogistic regression model (logit) with binomial distribution')
+      cat("\nLogistic regression model (logit) with binomial distribution")
-      cat('\n------------------------------------------------------------\n')
+      cat("\n------------------------------------------------------------\n")
       print(summary(model_lm))
     }
 
@@ -230,12 +230,12 @@ resistance_predict <- function(x,
     prediction <- predictmodel$fit
     se <- predictmodel$se.fit
 
-  } else if (model %in% c('loglin', 'poisson')) {
+  } else if (model %in% c("loglin", "poisson")) {
     model <- "poisson"
     model_lm <- with(df, glm(R ~ year, family = poisson))
     if (info == TRUE) {
-      cat('\nLog-linear regression model (loglin) with poisson distribution')
+      cat("\nLog-linear regression model (loglin) with poisson distribution")
-      cat('\n--------------------------------------------------------------\n')
+      cat("\n--------------------------------------------------------------\n")
       print(summary(model_lm))
     }
 
@@ -243,12 +243,12 @@ resistance_predict <- function(x,
     prediction <- predictmodel$fit
     se <- predictmodel$se.fit
 
-  } else if (model %in% c('lin', 'linear')) {
+  } else if (model %in% c("lin", "linear")) {
     model <- "linear"
     model_lm <- with(df, lm((R / (R + S)) ~ year))
     if (info == TRUE) {
-      cat('\nLinear regression model')
+      cat("\nLinear regression model")
-      cat('\n-----------------------\n')
+      cat("\n-----------------------\n")
       print(summary(model_lm))
     }
 
@@ -257,7 +257,7 @@ resistance_predict <- function(x,
     se <- predictmodel$se.fit
 
   } else {
-    stop('No valid model selected. See ?resistance_predict.')
+    stop("No valid model selected. See ?resistance_predict.")
   }
 
   # prepare the output dataframe
@@ -268,7 +268,7 @@ resistance_predict <- function(x,
     mutate(se_min = value - se,
            se_max = value + se)
 
-  if (model == 'poisson') {
+  if (model == "poisson") {
     df_prediction <- df_prediction %>%
       mutate(value = value %>%
                format(scientific = FALSE) %>%

R/rsi.R

@@ -100,20 +100,17 @@ as.rsi.default <- function(x, ...) {
   if (is.rsi(x)) {
     x
   } else if (identical(levels(x), c("S", "I", "R"))) {
-    structure(x, class = c('rsi', 'ordered', 'factor'))
+    structure(x, class = c("rsi", "ordered", "factor"))
   } else {
-    # if (input_resembles_mic(x) > 0.5) {
-    #   warning("`as.rsi` is intended to clean antimicrobial interpretations - not to interpret MIC values.", call. = FALSE)
-    # }
 
     x <- x %>% unlist()
     x.bak <- x
 
-    na_before <- x[is.na(x) | x == ''] %>% length()
+    na_before <- x[is.na(x) | x == ""] %>% length()
     # remove all spaces
-    x <- gsub(' +', '', x)
+    x <- gsub(" +", "", x)
     # remove all MIC-like values: numbers, operators and periods
-    x <- gsub('[0-9.,;:<=>]+', '', x)
+    x <- gsub("[0-9.,;:<=>]+", "", x)
     # remove everything between brackets, and 'high' and 'low'
     x <- gsub("([(].*[)])", "", x)
     x <- gsub("(high|low)", "", x, ignore.case = TRUE)
@@ -122,29 +119,29 @@ as.rsi.default <- function(x, ...) {
     # set to capitals
     x <- toupper(x)
     # remove all invalid characters
-    x <- gsub('[^RSI]+', '', x)
+    x <- gsub("[^RSI]+", "", x)
     # in cases of "S;S" keep S, but in case of "S;I" make it NA
-    x <- gsub('^S+$', 'S', x)
+    x <- gsub("^S+$", "S", x)
-    x <- gsub('^I+$', 'I', x)
+    x <- gsub("^I+$", "I", x)
-    x <- gsub('^R+$', 'R', x)
+    x <- gsub("^R+$", "R", x)
-    x[!x %in% c('S', 'I', 'R')] <- NA
+    x[!x %in% c("S", "I", "R")] <- NA
-    na_after <- x[is.na(x) | x == ''] %>% length()
+    na_after <- x[is.na(x) | x == ""] %>% length()
     
     if (!isFALSE(list(...)$warn)) { # so as.rsi(..., warn = FALSE) will never throw a warning
       if (na_before != na_after) {
-        list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ''] %>%
+        list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ""] %>%
           unique() %>%
           sort()
-        list_missing <- paste0('"', list_missing , '"', collapse = ", ")
+        list_missing <- paste0('"', list_missing, '"', collapse = ", ")
-        warning(na_after - na_before, ' results truncated (',
+        warning(na_after - na_before, " results truncated (",
                 round(((na_after - na_before) / length(x)) * 100),
-                '%) that were invalid antimicrobial interpretations: ',
+                "%) that were invalid antimicrobial interpretations: ",
                 list_missing, call. = FALSE)
       }
     }
     
     structure(.Data = factor(x, levels = c("S", "I", "R"), ordered = TRUE),
-              class =  c('rsi', 'ordered', 'factor'))
+              class =  c("rsi", "ordered", "factor"))
   }
 }
 
@@ -226,7 +223,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
   lookup_becker <- paste(mo_becker, ab)
   lookup_lancefield <- paste(mo_lancefield, ab)
 
-  for (i in 1:length(x)) {
+  for (i in seq_len(length(x))) {
     get_record <- trans %>%
       filter(lookup %in% c(lookup_mo[i],
                            lookup_genus[i],
@@ -236,7 +233,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
                            lookup_lancefield[i])) %>%
       # be as specific as possible (i.e. prefer species over genus):
       arrange(desc(nchar(mo))) %>%
-      .[1L,]
+      .[1L, ]
 
     if (NROW(get_record) > 0) {
       if (method == "mic") {
@@ -254,7 +251,7 @@ exec_as.rsi <- function(method, x, mo, ab, guideline) {
     }
   }
   structure(.Data = factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
-            class =  c('rsi', 'ordered', 'factor'))
+            class =  c("rsi", "ordered", "factor"))
 }
 
 #' @rdname as.rsi
@@ -280,7 +277,7 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", ...) {
   # transform all MICs
   ab_cols <- colnames(x)[sapply(x, is.mic)]
   if (length(ab_cols) > 0) {
-    for (i in 1:length(ab_cols)) {
+    for (i in seq_len(length(ab_cols))) {
       if (is.na(suppressWarnings(as.ab(ab_cols[i])))) {
         message(red(paste0("Unknown drug: `", bold(ab_cols[i]), "`. Rename this column to a drug name or code, and check the output with as.ab().")))
         next
@@ -297,7 +294,7 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", ...) {
   # transform all disks
   ab_cols <- colnames(x)[sapply(x, is.disk)]
   if (length(ab_cols) > 0) {
-    for (i in 1:length(ab_cols)) {
+    for (i in seq_len(length(ab_cols))) {
       if (is.na(suppressWarnings(as.ab(ab_cols[i])))) {
         message(red(paste0("Unknown drug: `", bold(ab_cols[i]), "`. Rename this column to a drug name or code, and check the output with as.ab().")))
         next
@@ -319,14 +316,14 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", ...) {
 #' @export
 is.rsi <- function(x) {
   identical(class(x),
-            c('rsi', 'ordered', 'factor'))
+            c("rsi", "ordered", "factor"))
 }
 
 #' @rdname as.rsi
 #' @export
 is.rsi.eligible <- function(x, threshold = 0.05) {
   if (NCOL(x) > 1) {
-    stop('`x` must be a one-dimensional vector.')
+    stop("`x` must be a one-dimensional vector.")
   }
   if (any(c("logical",
             "numeric",
@@ -363,9 +360,9 @@ print.rsi <- function(x, ...) {
 #' @exportMethod droplevels.rsi
 #' @export
 #' @noRd
-droplevels.rsi <- function(x, exclude = if(anyNA(levels(x))) NULL else NA, ...) {
+droplevels.rsi <- function(x, exclude = if (anyNA(levels(x))) NULL else NA, ...) {
   x <- droplevels.factor(x, exclude = exclude, ...)
-  class(x) <- c('rsi', 'ordered', 'factor')
+  class(x) <- c("rsi", "ordered", "factor")
   x
 }
 
@@ -375,7 +372,7 @@ droplevels.rsi <- function(x, exclude = if(anyNA(levels(x))) NULL else NA, ...)
 summary.rsi <- function(object, ...) {
   x <- object
   c(
-    "Class" = 'rsi',
+    "Class" = "rsi",
     "<NA>" = sum(is.na(x)),
     "Sum S" = sum(x == "S", na.rm = TRUE),
     "Sum IR" = sum(x %in% c("I", "R"), na.rm = TRUE),
@@ -392,9 +389,9 @@ summary.rsi <- function(object, ...) {
 plot.rsi <- function(x,
                      lwd = 2,
                      ylim = NULL,
-                     ylab = 'Percentage',
+                     ylab = "Percentage",
-                     xlab = 'Antimicrobial Interpretation',
+                     xlab = "Antimicrobial Interpretation",
-                     main = paste('Susceptibility Analysis of', deparse(substitute(x))),
+                     main = paste("Susceptibility Analysis of", deparse(substitute(x))),
                      axes = FALSE,
                      ...) {
   suppressWarnings(
@@ -416,7 +413,7 @@ plot.rsi <- function(x,
     data <- rbind(data, data.frame(x = "R", n = 0, s = 0))
   }
 
-  data$x <- factor(data$x, levels = c('S', 'I', 'R'), ordered = TRUE)
+  data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE)
 
   ymax <- if_else(max(data$s) > 95, 105, 100)
 
@@ -436,7 +433,7 @@ plot.rsi <- function(x,
 
   text(x = data$x,
        y = data$s + 4,
-       labels = paste0(data$s, '% (n = ', data$n, ')'))
+       labels = paste0(data$s, "% (n = ", data$n, ")"))
 }
 
 
@@ -446,10 +443,10 @@ plot.rsi <- function(x,
 #' @importFrom graphics barplot axis par
 #' @noRd
 barplot.rsi <- function(height,
-                        col = c('green3', 'orange2', 'red3'),
+                        col = c("green3", "orange2", "red3"),
-                        xlab = ifelse(beside, 'Antimicrobial Interpretation', ''),
+                        xlab = ifelse(beside, "Antimicrobial Interpretation", ""),
-                        main = paste('Susceptibility Analysis of', deparse(substitute(height))),
+                        main = paste("Susceptibility Analysis of", deparse(substitute(height))),
-                        ylab = 'Frequency',
+                        ylab = "Frequency",
                         beside = TRUE,
                         axes = beside,
                         ...) {

R/rsi_calc.R

@@ -50,13 +50,13 @@ rsi_calc <- function(...,
   data_vars <- dots2vars(...)
 
   if (!is.numeric(minimum)) {
-    stop('`minimum` must be numeric', call. = FALSE)
+    stop("`minimum` must be numeric", call. = FALSE)
   }
   if (!is.logical(as_percent)) {
-    stop('`as_percent` must be logical', call. = FALSE)
+    stop("`as_percent` must be logical", call. = FALSE)
   }
   if (!is.logical(only_all_tested)) {
-    stop('`only_all_tested` must be logical', call. = FALSE)
+    stop("`only_all_tested` must be logical", call. = FALSE)
   }
 
   dots_df <- ...elt(1) # it needs this evaluation
@@ -67,8 +67,7 @@ rsi_calc <- function(...,
   ndots <- length(dots)
 
  if ("data.frame" %in% class(dots_df)) {
-   # data.frame passed with other columns, like:
+   # data.frame passed with other columns, like: example_isolates %>% portion_S(amcl, gent)
-   #   example_isolates %>% portion_S(amcl, gent)
    dots <- as.character(dots)
    dots <- dots[dots != "."]
     if (length(dots) == 0 | all(dots == "df")) {
@@ -79,13 +78,10 @@ rsi_calc <- function(...,
       x <- dots_df[, dots]
     }
   } else if (ndots == 1) {
-    # only 1 variable passed (can also be data.frame), like:
+    # only 1 variable passed (can also be data.frame), like: portion_S(example_isolates$amcl) and example_isolates$amcl %>% portion_S()
-    #   portion_S(example_isolates$amcl)
-    #   example_isolates$amcl %>% portion_S()
     x <- dots_df
   } else {
-    # multiple variables passed without pipe, like:
+    # multiple variables passed without pipe, like: portion_S(example_isolates$amcl, example_isolates$gent)
-    #   portion_S(example_isolates$amcl, example_isolates$gent)
     x <- NULL
     try(x <- as.data.frame(dots), silent = TRUE)
     if (is.null(x)) {
@@ -105,7 +101,7 @@ rsi_calc <- function(...,
 
   if (is.data.frame(x)) {
     rsi_integrity_check <- character(0)
-    for (i in 1:ncol(x)) {
+    for (i in seq_len(ncol(x))) {
       # check integrity of columns: force rsi class
       if (!is.rsi(x %>% pull(i))) {
         rsi_integrity_check <- c(rsi_integrity_check, x %>% pull(i) %>% as.character())
@@ -125,11 +121,13 @@ rsi_calc <- function(...,
                  FUN = base::min)
       numerator <- sum(as.integer(x) %in% as.integer(ab_result), na.rm = TRUE)
       denominator <- length(x) - sum(is.na(x))
-
+      
     } else {
       # THE NUMBER OF ISOLATES WHERE *ANY* ABx IS S/I/R
       other_values <- base::setdiff(c(NA, levels(ab_result)), ab_result)
-      other_values_filter <- base::apply(x, 1, function(y) { base::all(y %in% other_values) & base::any(is.na(y)) })
+      other_values_filter <- base::apply(x, 1, function(y) {
+        base::all(y %in% other_values) & base::any(is.na(y))
+      })
       numerator <- x %>% filter_all(any_vars(. %in% ab_result)) %>% nrow()
       denominator <- x %>% filter(!other_values_filter) %>% nrow()
     }

R/skewness.R

@@ -38,25 +38,25 @@ skewness <- function(x, na.rm = FALSE) {
 #' @exportMethod skewness.default
 #' @rdname skewness
 #' @export
-skewness.default <- function (x, na.rm = FALSE) {
+skewness.default <- function(x, na.rm = FALSE) {
   x <- as.vector(x)
   if (na.rm == TRUE) {
     x <- x[!is.na(x)]
   }
   n <- length(x)
-  (base::sum((x - base::mean(x))^3) / n) / (base::sum((x - base::mean(x))^2) / n)^(3/2)
+  (base::sum((x - base::mean(x))^3) / n) / (base::sum((x - base::mean(x)) ^ 2) / n) ^ (3 / 2)
 }
 
 #' @exportMethod skewness.matrix
 #' @rdname skewness
 #' @export
-skewness.matrix <- function (x, na.rm = FALSE) {
+skewness.matrix <- function(x, na.rm = FALSE) {
   base::apply(x, 2, skewness.default, na.rm = na.rm)
 }
 
 #' @exportMethod skewness.data.frame
 #' @rdname skewness
 #' @export
-skewness.data.frame <- function (x, na.rm = FALSE) {
+skewness.data.frame <- function(x, na.rm = FALSE) {
   base::sapply(x, skewness.default, na.rm = na.rm)
 }

R/translate.R

@@ -134,7 +134,7 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
     return(from)
   }
   
-  for (i in 1:nrow(df_trans)) {
+  for (i in seq_len(nrow(df_trans))) {
     from <- gsub(x = from,
                  pattern = df_trans$pattern[i],
                  replacement = df_trans$replacement[i],

R/zzz.R

@@ -42,42 +42,9 @@
          value = make_trans_tbl(),
          envir = asNamespace("AMR"))
 
-#  assign(x = "mo_history",
-#         value = data.frame(x = character(0),
-#                            mo = character(0),
-#                            uncertainty_level = integer(0),
-#                            package_v = character(0),
-#                            stringsAsFactors = FALSE),
-#         envir = asNamespace("AMR"))
-
 }
 
-
+# maybe add survey later: "https://www.surveymonkey.com/r/AMR_for_R"
-.onAttach <- function(...) {
-  # if (interactive() & !isFALSE(getOption("AMR_survey"))) {
-  #   options(AMR_survey = FALSE)
-  #   console_width <- options()$width - 1
-  #   url <- "https://www.surveymonkey.com/r/AMR_for_R"
-  #   txt <- paste0("Thanks for using the AMR package! ",
-  #                "As researchers, we are interested in how and why you use this package and if there are things you're missing from it. ",
-  #                "Please fill in our 2-minute survey at: ", url, ". ",
-  #                "This message can be turned off with: options(AMR_survey = FALSE)")
-  # 
-  #   # make it honour new lines bases on console width:
-  #   txt <- unlist(strsplit(txt, " "))
-  #   txt_new <- ""
-  #   total_chars <- 0
-  #   for (i in 1:length(txt)) {
-  #     total_chars <- total_chars + nchar(txt[i]) + 1
-  #     if (total_chars > console_width) {
-  #       txt_new <- paste0(txt_new, "\n")
-  #       total_chars <- 0
-  #     }
-  #     txt_new <- paste0(txt_new, txt[i], " ")
-  #   }
-  #   # packageStartupMessage(txt_new)
-  # }
-}
 
 #' @importFrom data.table as.data.table setkey
 make_DT <- function() {

docs/404.html

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

docs/LICENSE-text.html

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

docs/articles/index.html

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

docs/authors.html

@@ -84,7 +84,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9101</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9102</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">0.7.1.9100</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9102</span>
       </span>
     </div>
 

docs/news/index.html

@@ -84,7 +84,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9100</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9102</span>
       </span>
     </div>
 
@@ -231,11 +231,11 @@
       
     </div>
 
-    <div id="amr-0-7-1-9100" class="section level1">
+    <div id="amr-0-7-1-9102" class="section level1">
 <h1 class="page-header">
-<a href="#amr-0-7-1-9100" class="anchor"></a>AMR 0.7.1.9100<small> Unreleased </small>
+<a href="#amr-0-7-1-9102" class="anchor"></a>AMR 0.7.1.9102<small> Unreleased </small>
 </h1>
-<p><small>Last updated: 08-Oct-2019</small></p>
+<p><small>Last updated: 11-Oct-2019</small></p>
 <div id="breaking" class="section level3">
 <h3 class="hasAnchor">
 <a href="#breaking" class="anchor"></a>Breaking</h3>
@@ -267,31 +267,32 @@ This is important, because a value like <code>"testvalue"</code> could never be
 <a href="#new" class="anchor"></a>New</h3>
 <ul>
 <li>
-<p>Function <code><a href="../reference/bug_drug_combinations.html">bug_drug_combinations()</a></code> to quickly get a <code>data.frame</code> with the antimicrobial resistance of any bug-drug combination in a data set. The columns with microorganism codes is guessed automatically and its input is transformed with <code><a href="../reference/mo_property.html">mo_shortname()</a></code> at default:</p>
+<p>Function <code><a href="../reference/bug_drug_combinations.html">bug_drug_combinations()</a></code> to quickly get a <code>data.frame</code> with the results of all bug-drug combinations in a data set. The column containing microorganism codes is guessed automatically and its input is transformed with <code><a href="../reference/mo_property.html">mo_shortname()</a></code> at default:</p>
 <div class="sourceCode" id="cb3"><pre class="sourceCode r"><code class="sourceCode r"><a class="sourceLine" id="cb3-1" data-line-number="1">x &lt;-<span class="st"> </span><span class="kw"><a href="../reference/bug_drug_combinations.html">bug_drug_combinations</a></span>(example_isolates)</a>
-<a class="sourceLine" id="cb3-2" data-line-number="2"><span class="co"># </span><span class="al">NOTE</span><span class="co">: Using column `mo` as input for `col_mo`.</span></a>
+<a class="sourceLine" id="cb3-2" data-line-number="2"><span class="co">#&gt; </span><span class="al">NOTE</span><span class="co">: Using column `mo` as input for `col_mo`.</span></a>
-<a class="sourceLine" id="cb3-3" data-line-number="3">x[<span class="dv">1</span><span class="op">:</span><span class="dv">5</span>, ]</a>
+<a class="sourceLine" id="cb3-3" data-line-number="3">x[<span class="dv">1</span><span class="op">:</span><span class="dv">4</span>, ]</a>
-<a class="sourceLine" id="cb3-4" data-line-number="4"><span class="co">#&gt;     ab            mo   S  I   R total</span></a>
+<a class="sourceLine" id="cb3-4" data-line-number="4"><span class="co">#&gt;             mo  ab S I R total</span></a>
-<a class="sourceLine" id="cb3-5" data-line-number="5"><span class="co">#&gt;  1 AMC          CoNS 178  0 132   310</span></a>
+<a class="sourceLine" id="cb3-5" data-line-number="5"><span class="co">#&gt; 1 A. baumannii AMC 0 0 3     3</span></a>
-<a class="sourceLine" id="cb3-6" data-line-number="6"><span class="co">#&gt;  2 AMC       E. coli 332 74  61   467</span></a>
+<a class="sourceLine" id="cb3-6" data-line-number="6"><span class="co">#&gt; 2 A. baumannii AMK 0 0 0     0</span></a>
-<a class="sourceLine" id="cb3-7" data-line-number="7"><span class="co">#&gt;  3 AMC K. pneumoniae  49  3   6    58</span></a>
+<a class="sourceLine" id="cb3-7" data-line-number="7"><span class="co">#&gt; 3 A. baumannii AMP 0 0 3     3</span></a>
-<a class="sourceLine" id="cb3-8" data-line-number="8"><span class="co">#&gt;  4 AMC P. aeruginosa   0  0  30    30</span></a>
+<a class="sourceLine" id="cb3-8" data-line-number="8"><span class="co">#&gt; 4 A. baumannii AMX 0 0 3     3</span></a>
-<a class="sourceLine" id="cb3-9" data-line-number="9"><span class="co">#&gt;  5 AMC  P. mirabilis  28  7   1    36</span></a>
+<a class="sourceLine" id="cb3-9" data-line-number="9"><span class="co">#&gt; </span><span class="al">NOTE</span><span class="co">: Use 'format()' on this result to get a publicable/printable format.</span></a>
 <a class="sourceLine" id="cb3-10" data-line-number="10"></a>
 <a class="sourceLine" id="cb3-11" data-line-number="11"><span class="co"># change the transformation with the FUN argument to anything you like:</span></a>
 <a class="sourceLine" id="cb3-12" data-line-number="12">x &lt;-<span class="st"> </span><span class="kw"><a href="../reference/bug_drug_combinations.html">bug_drug_combinations</a></span>(example_isolates, <span class="dt">FUN =</span> mo_gramstain)</a>
-<a class="sourceLine" id="cb3-13" data-line-number="13"><span class="co"># </span><span class="al">NOTE</span><span class="co">: Using column `mo` as input for `col_mo`.</span></a>
+<a class="sourceLine" id="cb3-13" data-line-number="13"><span class="co">#&gt; </span><span class="al">NOTE</span><span class="co">: Using column `mo` as input for `col_mo`.</span></a>
 <a class="sourceLine" id="cb3-14" data-line-number="14">x[<span class="dv">1</span><span class="op">:</span><span class="dv">4</span>, ]</a>
-<a class="sourceLine" id="cb3-15" data-line-number="15"><span class="co">#&gt;     ab            mo   S  I   R total</span></a>
+<a class="sourceLine" id="cb3-15" data-line-number="15"><span class="co">#&gt;              mo  ab   S  I   R total</span></a>
-<a class="sourceLine" id="cb3-16" data-line-number="16"><span class="co">#&gt;  1 AMC Gram-negative 469 89 174   732</span></a>
+<a class="sourceLine" id="cb3-16" data-line-number="16"><span class="co">#&gt; 1 Gram-negative AMC 469 89 174   732</span></a>
-<a class="sourceLine" id="cb3-17" data-line-number="17"><span class="co">#&gt;  2 AMC Gram-positive 873  2 272  1147</span></a>
+<a class="sourceLine" id="cb3-17" data-line-number="17"><span class="co">#&gt; 2 Gram-negative AMK 251  0   2   253</span></a>
-<a class="sourceLine" id="cb3-18" data-line-number="18"><span class="co">#&gt;  3 AMK Gram-negative 251  0   2   253</span></a>
+<a class="sourceLine" id="cb3-18" data-line-number="18"><span class="co">#&gt; 3 Gram-negative AMP 227  0 405   632</span></a>
-<a class="sourceLine" id="cb3-19" data-line-number="19"><span class="co">#&gt;  4 AMK Gram-positive   0  0 100   100</span></a></code></pre></div>
+<a class="sourceLine" id="cb3-19" data-line-number="19"><span class="co">#&gt; 4 Gram-negative AMX 227  0 405   632</span></a>
+<a class="sourceLine" id="cb3-20" data-line-number="20"><span class="co">#&gt; </span><span class="al">NOTE</span><span class="co">: Use 'format()' on this result to get a publicable/printable format.</span></a></code></pre></div>
 <p>You can format this to a printable format, ready for reporting or exporting to e.g. Excel with the base R <code><a href="https://rdrr.io/r/base/format.html">format()</a></code> function:</p>
 <div class="sourceCode" id="cb4"><pre class="sourceCode r"><code class="sourceCode r"><a class="sourceLine" id="cb4-1" data-line-number="1"><span class="kw"><a href="https://rdrr.io/r/base/format.html">format</a></span>(x, <span class="dt">combine_IR =</span> <span class="ot">FALSE</span>)</a></code></pre></div>
 </li>
 <li>
-<p>Additional way to calculate co-resistance, i.e. when using multiple antimicrobials as input for <code>portion_*</code> functions or <code>count_*</code> functions. This can be used to determine the empiric susceptibily of a combination therapy. A new parameter <code>only_all_tested</code> (<strong>which defaults to <code>FALSE</code></strong>) replaces the old <code>also_single_tested</code> and can be used to select one of the two methods to count isolates and calculate portions. The difference can be seen in this example table (which is also on the <code>portion</code> and <code>count</code> help pages), where the %SI is being determined:</p>
+<p>Additional way to calculate co-resistance, i.e. when using multiple antimicrobials as input for <code>portion_*</code> functions or <code>count_*</code> functions. This can be used to determine the empiric susceptibility of a combination therapy. A new parameter <code>only_all_tested</code> (<strong>which defaults to <code>FALSE</code></strong>) replaces the old <code>also_single_tested</code> and can be used to select one of the two methods to count isolates and calculate portions. The difference can be seen in this example table (which is also on the <code>portion</code> and <code>count</code> help pages), where the %SI is being determined:</p>
 <div class="sourceCode" id="cb5"><pre class="sourceCode r"><code class="sourceCode r"><a class="sourceLine" id="cb5-1" data-line-number="1"><span class="co"># --------------------------------------------------------------------</span></a>
 <a class="sourceLine" id="cb5-2" data-line-number="2"><span class="co">#                     only_all_tested = FALSE  only_all_tested = TRUE</span></a>
 <a class="sourceLine" id="cb5-3" data-line-number="3"><span class="co">#                     -----------------------  -----------------------</span></a>
@@ -377,6 +378,7 @@ Since this is a major change, usage of the old <code>also_single_tested</code> w
 <a href="#other" class="anchor"></a>Other</h4>
 <ul>
 <li>Added Prof. Dr. Casper Albers as doctoral advisor and added Dr. Judith Fonville, Eric Hazenberg, Dr. Bart Meijer, Dr. Dennis Souverein and Annick Lenglet as contributors</li>
+<li>Cleaned the coding style of every single syntax line in this package with the help of the <code>lintr</code> package</li>
 </ul>
 </div>
 </div>
@@ -1290,7 +1292,7 @@ Using <code><a href="../reference/as.mo.html">as.mo(..., allow_uncertain = 3)</a
     <div id="tocnav">
       <h2>Contents</h2>
       <ul class="nav nav-pills nav-stacked">
-        <li><a href="#amr-0-7-1-9100">0.7.1.9100</a></li>
+        <li><a href="#amr-0-7-1-9102">0.7.1.9102</a></li>
         <li><a href="#amr-0-7-1">0.7.1</a></li>
         <li><a href="#amr-0-7-0">0.7.0</a></li>
         <li><a href="#amr-0-6-1">0.6.1</a></li>

docs/pkgdown.yml

@@ -1,4 +1,4 @@
-pandoc: []
+pandoc: 2.3.1
 pkgdown: 1.4.1
 pkgdown_sha: ~
 articles:

docs/reference/bug_drug_combinations.html

@@ -85,7 +85,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9100</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9102</span>
       </span>
     </div>
 
@@ -327,7 +327,7 @@
     <pre class="examples"><span class='co'># \donttest{</span>
 <span class='no'>x</span> <span class='kw'>&lt;-</span> <span class='fu'>bug_drug_combinations</span>(<span class='no'>example_isolates</span>)
 <span class='no'>x</span>
-<span class='fu'><a href='https://rdrr.io/r/base/format.html'>format</a></span>(<span class='no'>x</span>)
+<span class='fu'><a href='https://rdrr.io/r/base/format.html'>format</a></span>(<span class='no'>x</span>, <span class='kw'>translate_ab</span> <span class='kw'>=</span> <span class='st'>"name (atc)"</span>)
 
 <span class='co'># Use FUN to change to transformation of microorganism codes</span>
 <span class='no'>x</span> <span class='kw'>&lt;-</span> <span class='fu'>bug_drug_combinations</span>(<span class='no'>example_isolates</span>,

docs/reference/first_isolate.html

@@ -15,21 +15,25 @@
 <link rel="apple-touch-icon" type="image/png" sizes="120x120" href="../apple-touch-icon-120x120.png" />
 <link rel="apple-touch-icon" type="image/png" sizes="76x76" href="../apple-touch-icon-76x76.png" />
 <link rel="apple-touch-icon" type="image/png" sizes="60x60" href="../apple-touch-icon-60x60.png" />
+
 <!-- jquery -->
 <script src="https://cdnjs.cloudflare.com/ajax/libs/jquery/3.3.1/jquery.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
 <!-- Bootstrap -->
 <link href="https://cdnjs.cloudflare.com/ajax/libs/bootswatch/3.3.7/flatly/bootstrap.min.css" rel="stylesheet" crossorigin="anonymous" />
 
+
 <script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha256-U5ZEeKfGNOja007MMD3YBI0A3OSZOQbeG6z2f2Y0hu8=" crossorigin="anonymous"></script>
 
 <!-- Font Awesome icons -->
-<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css" integrity="sha256-eZrrJcwDc/3uDhsdt61sL2oOBY362qM3lon1gyExkL0=" crossorigin="anonymous" />
+<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/all.min.css" integrity="sha256-nAmazAk6vS34Xqo0BSrTb+abbtFlgsFK7NKSi6o7Y78=" crossorigin="anonymous" />
+<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.7.1/css/v4-shims.min.css" integrity="sha256-6qHlizsOWFskGlwVOKuns+D1nB6ssZrHQrNj1wGplHc=" crossorigin="anonymous" />
 
 <!-- clipboard.js -->
 <script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.4/clipboard.min.js" integrity="sha256-FiZwavyI2V6+EXO1U+xzLG3IKldpiTFf3153ea9zikQ=" crossorigin="anonymous"></script>
 
-<!-- sticky kit -->
+<!-- headroom.js -->
-<script src="https://cdnjs.cloudflare.com/ajax/libs/sticky-kit/1.1.3/sticky-kit.min.js" integrity="sha256-c4Rlo1ZozqTPE2RLuvbusY3+SU1pQaJC0TjuhygMipw=" crossorigin="anonymous"></script>
+<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/headroom.min.js" integrity="sha256-DJFC1kqIhelURkuza0AvYal5RxMtpzLjFhsnVIeuk+U=" crossorigin="anonymous"></script>
+<script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.9.4/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script>
 
 <!-- pkgdown -->
 <link href="../pkgdown.css" rel="stylesheet">
@@ -45,15 +49,15 @@
 
   <link href="../extra.css" rel="stylesheet">
   <script src="../extra.js"></script>
+
 <meta property="og:title" content="Determine first (weighted) isolates — first_isolate" />
-
 <meta property="og:description" content="Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type." />
-
 <meta property="og:image" content="https://msberends.gitlab.io/AMR/logo.png" />
 <meta name="twitter:card" content="summary" />
 
 
 
+
 <!-- mathjax -->
 <script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script>
 <script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script>
@@ -64,6 +68,7 @@
 <![endif]-->
 
 
+
   </head>
 
   <body>
@@ -80,7 +85,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9067</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">0.7.1.9102</span>
       </span>
     </div>
 
@@ -189,7 +194,6 @@
   </a>
 </li>
       </ul>
-      
       <ul class="nav navbar-nav navbar-right">
         <li>
   <a href="https://gitlab.com/msberends/AMR">
@@ -207,7 +211,7 @@
 </li>
       </ul>
       
-      <form class="navbar-form navbar-right" role="search">
+      <form class="navbar-form navbar-right hidden-xs hidden-sm" role="search">
         <div class="form-group">
           <input type="search" class="form-control" name="search-input" id="search-input" placeholder="Search..." aria-label="Search for..." autocomplete="off">
         </div>
@@ -218,6 +222,7 @@
 </div><!--/.navbar -->
 
       
+
       </header>
 
 <div class="row">
@@ -229,9 +234,7 @@
     </div>
 
     <div class="ref-description">
-    
     <p>Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type.</p>
-    
     </div>
 
     <pre class="usage"><span class='fu'>first_isolate</span>(<span class='no'>x</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_patient_id</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
@@ -247,7 +250,7 @@
 <span class='fu'>filter_first_weighted_isolate</span>(<span class='no'>x</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
   <span class='kw'>col_patient_id</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_mo</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
   <span class='no'>...</span>)</pre>
-    
+
     <h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
     <table class="ref-arguments">
     <colgroup><col class="name" /><col class="desc" /></colgroup>
@@ -324,15 +327,13 @@
       <td><p>parameters passed on to the <code>first_isolate</code> function</p></td>
     </tr>
     </table>
-    
+
     <h2 class="hasAnchor" id="source"><a class="anchor" href="#source"></a>Source</h2>
 
     <p>Methodology of this function is based on: <strong>M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition</strong>, 2014, <em>Clinical and Laboratory Standards Institute (CLSI)</em>. <a href='https://clsi.org/standards/products/microbiology/documents/m39/'>https://clsi.org/standards/products/microbiology/documents/m39/</a>.</p>
-    
     <h2 class="hasAnchor" id="value"><a class="anchor" href="#value"></a>Value</h2>
 
     <p>Logical vector</p>
-    
     <h2 class="hasAnchor" id="details"><a class="anchor" href="#details"></a>Details</h2>
 
     <p><strong>WHY THIS IS SO IMPORTANT</strong> <br />
@@ -351,32 +352,30 @@ To conduct an analysis of antimicrobial resistance, you should only include the
    filter(only_weighted_firsts == TRUE) %&gt;%
    select(-only_weighted_firsts)
 </pre>
-    
+
     <h2 class="hasAnchor" id="key-antibiotics"><a class="anchor" href="#key-antibiotics"></a>Key antibiotics</h2>
 
     
-    <p>There are two ways to determine whether isolates can be included as first <em>weighted</em> isolates which will give generally the same results: <br /></p>
+
+<p>There are two ways to determine whether isolates can be included as first <em>weighted</em> isolates which will give generally the same results: <br /></p>
 <p><strong>1. Using</strong> <code>type = "keyantibiotics"</code> <strong>and parameter</strong> <code>ignore_I</code> <br />
     Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With <code>ignore_I = FALSE</code>, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the <code><a href='key_antibiotics.html'>key_antibiotics</a></code> function. <br /></p>
 <p><strong>2. Using</strong> <code>type = "points"</code> <strong>and parameter</strong> <code>points_threshold</code> <br />
     A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds <code>points_threshold</code>, which default to <code>2</code>, an isolate will be (re)selected as a first weighted isolate.</p>
-    
     <h2 class="hasAnchor" id="read-more-on-our-website-"><a class="anchor" href="#read-more-on-our-website-"></a>Read more on our website!</h2>
 
     
-    <p>On our website <a href='https://msberends.gitlab.io/AMR'>https://msberends.gitlab.io/AMR</a> you can find <a href='https://msberends.gitlab.io/AMR/articles/AMR.html'>a tutorial</a> about how to conduct AMR analysis, the <a href='https://msberends.gitlab.io/AMR/reference'>complete documentation of all functions</a> (which reads a lot easier than here in R) and <a href='https://msberends.gitlab.io/AMR/articles/WHONET.html'>an example analysis using WHONET data</a>.</p>
+
-    
+<p>On our website <a href='https://msberends.gitlab.io/AMR'>https://msberends.gitlab.io/AMR</a> you can find <a href='https://msberends.gitlab.io/AMR/articles/AMR.html'>a tutorial</a> about how to conduct AMR analysis, the <a href='https://msberends.gitlab.io/AMR/reference'>complete documentation of all functions</a> (which reads a lot easier than here in R) and <a href='https://msberends.gitlab.io/AMR/articles/WHONET.html'>an example analysis using WHONET data</a>.</p>
     <h2 class="hasAnchor" id="see-also"><a class="anchor" href="#see-also"></a>See also</h2>
 
     <div class='dont-index'><p><code><a href='key_antibiotics.html'>key_antibiotics</a></code></p></div>
-    
 
     <h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2>
-    <pre class="examples"><span class='co'># NOT RUN {</span>
+    <pre class="examples"><span class='co'># `example_isolates` is a dataset available in the AMR package.</span>
-<span class='co'># `example_isolates` is a dataset available in the AMR package.</span>
 <span class='co'># See ?example_isolates.</span>
 
-<span class='fu'><a href='https://www.rdocumentation.org/packages/base/topics/library'>library</a></span>(<span class='no'>dplyr</span>)
+<span class='fu'><a href='https://rdrr.io/r/base/library.html'>library</a></span>(<span class='no'>dplyr</span>)
 <span class='co'># Filter on first isolates:</span>
 <span class='no'>example_isolates</span> <span class='kw'>%&gt;%</span>
   <span class='fu'><a href='https://dplyr.tidyverse.org/reference/mutate.html'>mutate</a></span>(<span class='kw'>first_isolate</span> <span class='kw'>=</span> <span class='fu'>first_isolate</span>(<span class='no'>.</span>,
@@ -412,76 +411,44 @@ To conduct an analysis of antimicrobial resistance, you should only include the
 
 <span class='co'>## OTHER EXAMPLES:</span>
 
-<span class='co'># }</span><span class='co'># NOT RUN {</span>
+<span class='kw'>if</span> (<span class='fl'>FALSE</span>) {
+
 <span class='co'># set key antibiotics to a new variable</span>
 <span class='no'>x</span>$<span class='no'>keyab</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='key_antibiotics.html'>key_antibiotics</a></span>(<span class='no'>x</span>)
 
-<span class='no'>x</span>$<span class='no'>first_isolate</span> <span class='kw'>&lt;-</span>
+<span class='no'>x</span>$<span class='no'>first_isolate</span> <span class='kw'>&lt;-</span> <span class='fu'>first_isolate</span>(<span class='no'>x</span>)
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>)
 
-<span class='no'>x</span>$<span class='no'>first_isolate_weighed</span> <span class='kw'>&lt;-</span>
+<span class='no'>x</span>$<span class='no'>first_isolate_weighed</span> <span class='kw'>&lt;-</span> <span class='fu'>first_isolate</span>(<span class='no'>x</span>, <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>,
-                <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
 
-<span class='no'>x</span>$<span class='no'>first_blood_isolate</span> <span class='kw'>&lt;-</span>
+<span class='no'>x</span>$<span class='no'>first_blood_isolate</span> <span class='kw'>&lt;-</span> <span class='fu'>first_isolate</span>(<span class='no'>x</span>, <span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>"Blood"</span>)
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>,
+}</pre>
-                <span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Blood'</span>)
-
-<span class='no'>x</span>$<span class='no'>first_blood_isolate_weighed</span> <span class='kw'>&lt;-</span>
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>,
-                <span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Blood'</span>,
-                <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
-
-<span class='no'>x</span>$<span class='no'>first_urine_isolate</span> <span class='kw'>&lt;-</span>
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>,
-                <span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Urine'</span>)
-
-<span class='no'>x</span>$<span class='no'>first_urine_isolate_weighed</span> <span class='kw'>&lt;-</span>
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>,
-                <span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Urine'</span>,
-                <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
-
-<span class='no'>x</span>$<span class='no'>first_resp_isolate</span> <span class='kw'>&lt;-</span>
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>,
-                <span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Respiratory'</span>)
-
-<span class='no'>x</span>$<span class='no'>first_resp_isolate_weighed</span> <span class='kw'>&lt;-</span>
-  <span class='fu'>first_isolate</span>(<span class='no'>x</span>,
-                <span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Respiratory'</span>,
-                <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
-<span class='co'># }</span></pre>
   </div>
   <div class="col-md-3 hidden-xs hidden-sm" id="sidebar">
     <h2>Contents</h2>
     <ul class="nav nav-pills nav-stacked">
       <li><a href="#arguments">Arguments</a></li>
-      
       <li><a href="#source">Source</a></li>
-
       <li><a href="#value">Value</a></li>
-
       <li><a href="#details">Details</a></li>
-
       <li><a href="#key-antibiotics">Key antibiotics</a></li>
-
       <li><a href="#read-more-on-our-website-">Read more on our website!</a></li>
-
       <li><a href="#see-also">See also</a></li>
-      
       <li><a href="#examples">Examples</a></li>
     </ul>
 
   </div>
 </div>
 
+
       <footer>
       <div class="copyright">
   <p>Developed by <a href='https://www.rug.nl/staff/m.s.berends/'>Matthijs S. Berends</a>, <a href='https://www.rug.nl/staff/c.f.luz/'>Christian F. Luz</a>, <a href='https://www.rug.nl/staff/a.w.friedrich/'>Alex W. Friedrich</a>, <a href='https://www.rug.nl/staff/b.sinha/'>Bhanu N. M. Sinha</a>, <a href='https://www.rug.nl/staff/c.j.albers/'>Casper J. Albers</a>, <a href='https://www.rug.nl/staff/c.glasner/'>Corinna Glasner</a>.</p>
 </div>
 
 <div class="pkgdown">
-  <p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.3.0.</p>
+  <p>Site built with <a href="https://pkgdown.r-lib.org/">pkgdown</a> 1.4.1.</p>
 </div>
+
       </footer>
    </div>
 
@@ -504,6 +471,8 @@ To conduct an analysis of antimicrobial resistance, you should only include the
 </script>
 
 
+
   </body>
 </html>
 
+

docs/reference/index.html

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

man/bug_drug_combinations.Rd

@@ -67,7 +67,7 @@ On our website \url{https://msberends.gitlab.io/AMR} you can find \href{https://
 \donttest{
 x <- bug_drug_combinations(example_isolates)
 x
-format(x)
+format(x, translate_ab = "name (atc)")
 
 # Use FUN to change to transformation of microorganism codes
 x <- bug_drug_combinations(example_isolates, 

man/first_isolate.Rd

@@ -150,39 +150,11 @@ B <- example_isolates \%>\%
 # set key antibiotics to a new variable
 x$keyab <- key_antibiotics(x)
 
-x$first_isolate <-
+x$first_isolate <- first_isolate(x)
-  first_isolate(x)
 
-x$first_isolate_weighed <-
+x$first_isolate_weighed <- first_isolate(x, col_keyantibiotics = 'keyab')
-  first_isolate(x,
-                col_keyantibiotics = 'keyab')
 
-x$first_blood_isolate <-
+x$first_blood_isolate <- first_isolate(x, specimen_group = "Blood")
-  first_isolate(x,
-                specimen_group = 'Blood')
-
-x$first_blood_isolate_weighed <-
-  first_isolate(x,
-                specimen_group = 'Blood',
-                col_keyantibiotics = 'keyab')
-
-x$first_urine_isolate <-
-  first_isolate(x,
-                specimen_group = 'Urine')
-
-x$first_urine_isolate_weighed <-
-  first_isolate(x,
-                specimen_group = 'Urine',
-                col_keyantibiotics = 'keyab')
-
-x$first_resp_isolate <-
-  first_isolate(x,
-                specimen_group = 'Respiratory')
-
-x$first_resp_isolate_weighed <-
-  first_isolate(x,
-                specimen_group = 'Respiratory',
-                col_keyantibiotics = 'keyab')
 }
 }
 \seealso{

tests/testthat/test-ab_property.R

@@ -37,13 +37,13 @@ test_that("ab_property works", {
   expect_identical(ab_name("Fluclox"), "Flucloxacillin")
   expect_identical(ab_name("fluklox"), "Flucloxacillin")
   expect_identical(ab_name("floxapen"), "Flucloxacillin")
-  expect_identical(ab_name(21319) , "Flucloxacillin")
+  expect_identical(ab_name(21319), "Flucloxacillin")
   expect_identical(ab_name("J01CF05"), "Flucloxacillin")
 
   expect_identical(ab_ddd("AMX", "oral"), 1)
-  expect_identical(ab_ddd("AMX", "oral", units = TRUE) , "g")
+  expect_identical(ab_ddd("AMX", "oral", units = TRUE), "g")
   expect_identical(ab_ddd("AMX", "iv"), 1)
-  expect_identical(ab_ddd("AMX", "iv", units = TRUE) , "g")
+  expect_identical(ab_ddd("AMX", "iv", units = TRUE), "g")
 
   expect_identical(ab_name(x = c("AMC", "PLB")), c("Amoxicillin/clavulanic acid", "Polymyxin B"))
   expect_identical(ab_name(x = c("AMC", "PLB"), tolower = TRUE),

tests/testthat/test-count.R

@@ -85,6 +85,6 @@ test_that("counts work", {
   expect_error(count_S("test", as_percent = "test"))
 
   expect_error(count_df(c("A", "B", "C")))
-  expect_error(count_df(example_isolates[,"date"]))
+  expect_error(count_df(example_isolates[, "date"]))
 
 })

tests/testthat/test-data.R

@@ -41,9 +41,8 @@ test_that("data sets are valid", {
 
   # there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
   datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"]
-  for (i in 1:length(datasets)) {
+  for (i in seq_len(length(datasets))) {
     dataset <- get(datasets[i], envir = asNamespace("AMR"))
-    #print(paste("testing data set", datasets[i]))
     expect_identical(dataset_UTF8_to_ASCII(dataset), dataset)
   }
 })

tests/testthat/test-first_isolate.R

@@ -33,16 +33,12 @@ test_that("first isolates work", {
       na.rm = TRUE),
     1317)
 
-  # first *weighted* isolates
+  # first weighted isolates
   expect_equal(
     suppressWarnings(
       sum(
         first_isolate(x = example_isolates %>% mutate(keyab = key_antibiotics(.)),
-                      # let syntax determine these automatically:
+                      # let syntax determine arguments automatically
-                      # col_date = "date",
-                      # col_patient_id = "patient_id",
-                      # col_mo = "mo",
-                      # col_keyantibiotics = "keyab",
                       type = "keyantibiotics",
                       info = TRUE),
         na.rm = TRUE)),
@@ -145,7 +141,7 @@ test_that("first isolates work", {
                                                 filter_specimen = "something_unexisting")))
 
   # printing of exclusion message
-  expect_output(example_isolates %>%
+  expect_message(example_isolates %>%
                   first_isolate(col_date = "date",
                                 col_mo = "mo",
                                 col_patient_id = "patient_id",

tests/testthat/test-freq.R

@@ -34,4 +34,3 @@ test_that("frequency table works", {
   library(dplyr)
   expect_true(is.freq(example_isolates %>% freq(AMX)))
 })
-

tests/testthat/test-g.test.R

@@ -60,7 +60,7 @@ test_that("G-test works", {
                         y = c(780, 1560, 780),
                         rescale.p = TRUE))
 
-  expect_error(g.test(matrix(data = c(-1, -2, -3 , -4), ncol = 2, byrow = TRUE)))
+  expect_error(g.test(matrix(data = c(-1, -2, -3, -4), ncol = 2, byrow = TRUE)))
   expect_error(g.test(matrix(data = c(0, 0, 0, 0), ncol = 2, byrow = TRUE)))
 
 })

tests/testthat/test-get_locale.R

@@ -30,7 +30,6 @@ test_that("get_locale works", {
   expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)")
   expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)")
   expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)")
-  # expect_identical(mo_fullname("CoNS", "fr"), "Staphylococcus \u00e0 coagulase n\u00e9gative (CoNS)")
   expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)")
 
 })

tests/testthat/test-ggplot_rsi.R

@@ -30,35 +30,26 @@ test_that("ggplot_rsi works", {
 
   # data should be equal
   expect_equal(
-    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi())$data %>%
+    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi())$data %>% summarise_all(portion_IR) %>% as.double(),
-      summarise_all(portion_IR) %>% as.double(),
+    example_isolates %>% select(AMC, CIP) %>% summarise_all(portion_IR) %>% as.double()
-    example_isolates %>% select(AMC, CIP) %>%
-      summarise_all(portion_IR) %>% as.double()
   )
 
   print(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "interpretation", facet = "antibiotic"))
   print(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))
 
   expect_equal(
-    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>%
+    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>% summarise_all(portion_IR) %>% as.double(),
-      summarise_all(portion_IR) %>% as.double(),
+    example_isolates %>% select(AMC, CIP) %>% summarise_all(portion_IR) %>% as.double()
-    example_isolates %>% select(AMC, CIP) %>%
-      summarise_all(portion_IR) %>% as.double()
   )
 
   expect_equal(
-    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>%
+    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% summarise_all(portion_IR) %>% as.double(),
-      summarise_all(portion_IR) %>% as.double(),
+    example_isolates %>% select(AMC, CIP) %>% summarise_all(portion_IR) %>% as.double()
-    example_isolates %>% select(AMC, CIP) %>%
-      summarise_all(portion_IR) %>% as.double()
   )
 
   expect_equal(
-    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic",
+    (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% summarise_all(count_IR) %>% as.double(),
-                                                         facet = "interpretation"))$data %>%
+    example_isolates %>% select(AMC, CIP) %>% summarise_all(count_IR) %>% as.double()
-      summarise_all(count_IR) %>% as.double(),
-    example_isolates %>% select(AMC, CIP) %>%
-      summarise_all(count_IR) %>% as.double()
   )
 
   # support for scale_type ab and mo

tests/testthat/test-mdro.R

@@ -32,11 +32,11 @@ test_that("mdro works", {
   outcome <- mdro(example_isolates)
   outcome <- eucast_exceptional_phenotypes(example_isolates, info = TRUE)
   # check class
-  expect_equal(outcome %>% class(), c('ordered', 'factor'))
+  expect_equal(outcome %>% class(), c("ordered", "factor"))
 
   outcome <- mdro(example_isolates, "nl", info = TRUE)
   # check class
-  expect_equal(outcome %>% class(), c('ordered', 'factor'))
+  expect_equal(outcome %>% class(), c("ordered", "factor"))
 
   # example_isolates should have these finding using Dutch guidelines
   expect_equal(outcome %>% freq() %>% pull(count),

tests/testthat/test-mo.R

@@ -94,7 +94,7 @@ test_that("as.mo works", {
     rep("B_STPHY_AURS", 9))
   expect_identical(
     as.character(
-      as.mo(c('EHEC', 'EPEC', 'EIEC', 'STEC', 'ATEC', 'UPEC'))),
+      as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))),
     rep("B_ESCHR_COLI", 6))
   # unprevalent MO
   expect_identical(
@@ -114,13 +114,13 @@ test_that("as.mo works", {
                c("UNKNOWN", NA_character_, "B_STNTR_MLTP", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI"))
   
   # check for Becker classification
-  expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR")
+  expect_identical(as.character(as.mo("S. epidermidis",  Becker = FALSE)), "B_STPHY_EPDR")
-  expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)),  "B_STPHY_CONS")
+  expect_identical(as.character(as.mo("S. epidermidis",  Becker = TRUE)),  "B_STPHY_CONS")
-  expect_identical(as.character(as.mo("STAEPI",         Becker = TRUE)),  "B_STPHY_CONS")
+  expect_identical(as.character(as.mo("STAEPI",          Becker = TRUE)),  "B_STPHY_CONS")
-  expect_identical(as.character(as.mo("S. intermedius", Becker = FALSE)), "B_STPHY_INTR")
+  expect_identical(as.character(as.mo("S. intermedius",  Becker = FALSE)), "B_STPHY_INTR")
-  expect_identical(as.character(as.mo("Sta intermedius",Becker = FALSE)), "B_STPHY_INTR")
+  expect_identical(as.character(as.mo("Sta intermedius", Becker = FALSE)), "B_STPHY_INTR")
-  expect_identical(as.character(as.mo("Sta intermedius",Becker = TRUE)),  "B_STPHY_COPS")
+  expect_identical(as.character(as.mo("Sta intermedius", Becker = TRUE)),  "B_STPHY_COPS")
-  expect_identical(as.character(as.mo("STAINT",         Becker = TRUE)),  "B_STPHY_COPS")
+  expect_identical(as.character(as.mo("STAINT",          Becker = TRUE)),  "B_STPHY_COPS")
   # aureus must only be influenced if Becker = "all"
   expect_identical(as.character(as.mo("STAAUR", Becker = FALSE)), "B_STPHY_AURS")
   expect_identical(as.character(as.mo("STAAUR", Becker = TRUE)),  "B_STPHY_AURS")
@@ -150,7 +150,7 @@ test_that("as.mo works", {
   
   # select with one column
   expect_identical(
-    example_isolates[1:10,] %>%
+    example_isolates[1:10, ] %>%
       left_join_microorganisms() %>%
       select(genus) %>%
       as.mo() %>%
@@ -160,9 +160,9 @@ test_that("as.mo works", {
   
   # select with two columns
   expect_identical(
-    example_isolates[1:10,] %>%
+    example_isolates[1:10, ] %>%
       pull(mo),
-    example_isolates[1:10,] %>%
+    example_isolates[1:10, ] %>%
       left_join_microorganisms() %>%
       select(genus, species) %>%
       as.mo())
@@ -260,10 +260,6 @@ test_that("as.mo works", {
   expect_null(mo_failures())
   expect_true(example_isolates %>% pull(mo) %>% is.mo())
   
-  # expect_equal(get_mo_code("test", "mo"), "test")
-  # expect_equal(length(get_mo_code("Escherichia", "genus")),
-  #              nrow(AMR::microorganisms[base::which(AMR::microorganisms[, "genus"] %in% "Escherichia"),]))
-  
   expect_error(translate_allow_uncertain(5))
   
   # very old MO codes (<= v0.5.0)

tests/testthat/test-mo_property.R

@@ -57,7 +57,7 @@ test_that("mo_property works", {
   expect_equal(mo_shortname("Streptococcus agalactiae"), "S. agalactiae")
   expect_equal(mo_shortname("Streptococcus agalactiae", Lancefield = TRUE), "GBS")
 
-  #expect_true(mo_url("Escherichia coli") %like% "www.catalogueoflife.org")
+  expect_true(mo_url("Escherichia coli") %like% "www.catalogueoflife.org")
 
   # test integrity
   MOs <- AMR::microorganisms

tests/testthat/test-portion.R

@@ -117,5 +117,5 @@ test_that("portions works", {
   )
   
   expect_error(portion_df(c("A", "B", "C")))
-  expect_error(portion_df(example_isolates[,"date"]))
+  expect_error(portion_df(example_isolates[, "date"]))
 })