(v1.2.0.9034) code cleaning

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.2.0.9033
-Date: 2020-07-12
+Version: 1.2.0.9034
+Date: 2020-07-13
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(role = c("aut", "cre"), 

NEWS.md

@@ -1,5 +1,5 @@
-# AMR 1.2.0.9033
-## <small>Last updated: 12-Jul-2020</small>
+# AMR 1.2.0.9034
+## <small>Last updated: 13-Jul-2020</small>
 
 ### New
 * Function `ab_from_text()` to retrieve antimicrobial drug names, doses and forms of administration from clinical texts in e.g. health care records, which also corrects for misspelling since it uses `as.ab()` internally

R/aa_helper_functions.R

@@ -493,7 +493,7 @@ percentage <- function(x, digits = NULL, ...) {
     x_formatted[!grepl(pattern = "^[0-9.,e-]+$", x = x)] <- NA_character_
     x_formatted
   }
-
+  
   # the actual working part
   x <- as.double(x)
   if (is.null(digits)) {

R/ab.R

@@ -82,16 +82,16 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
   if (is.ab(x)) {
     return(x)
   }
-
+  
   initial_search <- is.null(list(...)$initial_search)
   already_regex <- isTRUE(list(...)$already_regex)
-
+  
   if (all(toupper(x) %in% antibiotics$ab)) {
     # valid AB code, but not yet right class
     return(structure(.Data = toupper(x),
                      class = c("ab", "character")))
   }
-
+  
   x_bak <- x
   x <- toupper(x)
   # remove diacritics
@@ -117,7 +117,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
     # replace text 'and' with a slash
     x_bak_clean <- gsub(" AND ", "/", x_bak_clean)
   }
-
+  
   x <- unique(x_bak_clean)
   x_new <- rep(NA_character_, length(x))
   x_unknown <- character(0)
@@ -164,21 +164,21 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # exact ATC code
     found <- antibiotics[which(antibiotics$atc == x[i]), ]$ab
     if (length(found) > 0) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # exact CID code
     found <- antibiotics[which(antibiotics$cid == x[i]), ]$ab
     if (length(found) > 0) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # exact name
     found <- antibiotics[which(toupper(antibiotics$name) == x[i]), ]$ab
     if (length(found) > 0) {
@@ -188,13 +188,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
     
     # exact LOINC code
     loinc_found <- unlist(lapply(antibiotics$loinc,
-                                   function(s) x[i] %in% s))
+                                 function(s) x[i] %in% s))
     found <- antibiotics$ab[loinc_found == TRUE]
     if (length(found) > 0) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # exact synonym
     synonym_found <- unlist(lapply(antibiotics$synonyms,
                                    function(s) x[i] %in% toupper(s)))
@@ -203,7 +203,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # exact abbreviation
     abbr_found <- unlist(lapply(antibiotics$abbreviations,
                                 function(a) x[i] %in% toupper(a)))
@@ -212,7 +212,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # allow characters that resemble others, but only continue when having more than 3 characters
     if (nchar(x[i]) <= 3) {
       x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
@@ -242,7 +242,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
       x_spelling <- gsub("(O|0)", "(O|0)+", x_spelling)
       x_spelling <- gsub("++", "+", x_spelling, fixed = TRUE)
     }
-
+    
     # try if name starts with it
     found <- antibiotics[which(antibiotics$name %like% paste0("^", x_spelling)), ]$ab
     if (length(found) > 0) {
@@ -255,7 +255,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # and try if any synonym starts with it
     synonym_found <- unlist(lapply(antibiotics$synonyms,
                                    function(s) any(s %like% paste0("^", x_spelling))))
@@ -264,7 +264,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
-
+    
     # INITIAL SEARCH - More uncertain results ----
     
     if (initial_search == TRUE) {
@@ -351,7 +351,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
         x_new[i] <- note_if_more_than_one_found(found, i, from_text)
         next
       }
-
+      
       # first 5 except for cephalosporins, then first 7 (those cephalosporins all start quite the same!)
       found <- suppressWarnings(as.ab(substr(x[i], 1, 5), initial_search = FALSE))
       if (!is.na(found) && !ab_group(found, initial_search = FALSE) %like% "cephalosporins") {
@@ -375,7 +375,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
         x_new[i] <- note_if_more_than_one_found(found, i, from_text)
         next
       }
-  
+      
       # make all vowels facultative
       search_str <- gsub("([AEIOUY])", "\\1*", x[i])
       found <- suppressWarnings(as.ab(search_str, initial_search = FALSE, already_regex = TRUE))
@@ -429,7 +429,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
   if (initial_search == TRUE) {
     close(progress)
   }
-
+  
   # take failed ATC codes apart from rest
   x_unknown_ATCs <- x_unknown[x_unknown %like% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]"]
   x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
@@ -446,15 +446,15 @@ as.ab <- function(x, flag_multiple_results = TRUE, ...) {
             ".",
             call. = FALSE)
   }
-
+  
   x_result <- data.frame(x = x_bak_clean, stringsAsFactors = FALSE) %>%
     left_join(data.frame(x = x, x_new = x_new, stringsAsFactors = FALSE), by = "x") %>%
     pull(x_new)
-
+  
   if (length(x_result) == 0) {
     x_result <- NA_character_
   }
-
+  
   structure(.Data = x_result,
             class = c("ab", "character"))
 }

R/ab_from_text.R

@@ -136,8 +136,8 @@ ab_from_text <- function(text,
                                 text_split[text_split %like_case% to_regex(names_atc)],
                                 text_split[text_split %like_case% to_regex(synonyms_part1)],
                                 text_split[text_split %like_case% to_regex(synonyms_part2)])
-                              ),
-                       ...)
+          ),
+          ...)
         )
       })
     }

R/ab_property.R

@@ -216,7 +216,7 @@ ab_property <- function(x, property = "name", language = get_locale(), ...) {
   stop_if(length(property) != 1L, "'property' must be of length 1.")
   stop_ifnot(property %in% colnames(antibiotics),
              "invalid property: '", property, "' - use a column name of the `antibiotics` data set")
-
+  
   translate_AMR(ab_validate(x = x, property = property, ...), language = language)
 }
 

R/age.R

@@ -47,13 +47,13 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) {
   }
   x <- as.POSIXlt(x)
   reference <- as.POSIXlt(reference)
-
+  
   # from https://stackoverflow.com/a/25450756/4575331
   years_gap <- reference$year - x$year
   ages <- ifelse(reference$mon < x$mon | (reference$mon == x$mon & reference$mday < x$mday),
-                  as.integer(years_gap - 1),
-                  as.integer(years_gap))
-
+                 as.integer(years_gap - 1),
+                 as.integer(years_gap))
+  
   # add decimals
   if (exact == TRUE) {
     # get dates of `x` when `x` would have the year of `reference`
@@ -69,7 +69,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) {
     # and finally add to ages
     ages <- ages + mod
   }
-
+  
   if (any(ages < 0, na.rm = TRUE)) {
     ages[ages < 0] <- NA
     warning("NAs introduced for ages below 0.")
@@ -81,7 +81,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) {
   if (isTRUE(na.rm)) {
     ages <- ages[!is.na(ages)]
   }
-
+  
   ages
 }
 
@@ -162,7 +162,7 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
   }
   split_at <- split_at[!is.na(split_at)]
   stop_if(length(split_at) == 1, "invalid value for `split_at`") # only 0 is available
-
+  
   # turn input values to 'split_at' indices
   y <- x
   labs <- split_at
@@ -171,10 +171,10 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
     # create labels
     labs[i - 1] <- paste0(unique(c(split_at[i - 1], split_at[i] - 1)), collapse = "-")
   }
-
+  
   # last category
   labs[length(labs)] <- paste0(split_at[length(split_at)], "+")
-
+  
   agegroups <- factor(labs[y], levels = labs, ordered = TRUE)
   
   if (isTRUE(na.rm)) {

R/atc_online.R

@@ -84,7 +84,7 @@ atc_online_property <- function(atc_code,
   html_table <- import_fn("html_table", "rvest")
   html_text <- import_fn("html_text", "rvest")
   read_html <- import_fn("read_html", "xml2")
-
+  
   check_dataset_integrity()
   
   if (!all(atc_code %in% antibiotics)) {
@@ -95,25 +95,25 @@ atc_online_property <- function(atc_code,
     message("There appears to be no internet connection.")
     return(rep(NA, length(atc_code)))
   }
-
+  
   stop_if(length(property) != 1L, "`property` must be of length 1")
   stop_if(length(administration) != 1L, "`administration` must be of length 1")
-
+  
   # also allow unit as property
   if (property %like% "unit") {
     property <- "U"
   }
-
+  
   # validation of properties
   valid_properties <- c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups")
   valid_properties.bak <- valid_properties
-
+  
   property <- tolower(property)
   valid_properties <- tolower(valid_properties)
-
+  
   stop_ifnot(property %in% valid_properties,
              "Invalid `property`, use one of ", paste(valid_properties.bak, collapse = ", "))
-
+  
   if (property == "ddd") {
     returnvalue <- rep(NA_real_, length(atc_code))
   } else if (property == "groups") {
@@ -121,22 +121,22 @@ atc_online_property <- function(atc_code,
   } else {
     returnvalue <- rep(NA_character_, length(atc_code))
   }
-
+  
   progress <- progress_estimated(n = length(atc_code), 3)
   on.exit(close(progress))
   
   for (i in seq_len(length(atc_code))) {
-
+    
     progress$tick()
-
+    
     atc_url <- sub("%s", atc_code[i], url, fixed = TRUE)
-
+    
     if (property == "groups") {
       tbl <- read_html(atc_url) %>%
         html_node("#content") %>%
         html_children() %>%
         html_node("a")
-
+      
       # get URLS of items
       hrefs <- tbl %>% html_attr("href")
       # get text of items
@@ -146,22 +146,22 @@ atc_online_property <- function(atc_code,
       # last one is antibiotics, skip it
       texts <- texts[seq_len(length(texts)) - 1]
       returnvalue <- c(list(texts), returnvalue)
-
+      
     } else {
       tbl <- read_html(atc_url) %>%
         html_nodes("table") %>%
         html_table(header = TRUE) %>%
         as.data.frame(stringsAsFactors = FALSE)
-
+      
       # case insensitive column names
       colnames(tbl) <- gsub("^atc.*", "atc", tolower(colnames(tbl)))
-
+      
       if (length(tbl) == 0) {
         warning("ATC not found: ", atc_code[i], ". Please check ", atc_url, ".", call. = FALSE)
         returnvalue[i] <- NA
         next
       }
-
+      
       if (property %in% c("atc", "name")) {
         # ATC and name are only in first row
         returnvalue[i] <- tbl[1, property]
@@ -179,11 +179,11 @@ atc_online_property <- function(atc_code,
       }
     }
   }
-
+  
   if (property == "groups" & length(returnvalue) == 1) {
     returnvalue <- returnvalue[[1]]
   }
-
+  
   returnvalue
 }
 

R/availability.R

@@ -55,7 +55,7 @@ availability <- function(tbl, width = NULL) {
   R_print <- character(length(R))
   R_print[!is.na(R)] <- percentage(R[!is.na(R)])
   R_print[is.na(R)] <- ""
-
+  
   if (is.null(width)) {
     width <- options()$width -
       (max(nchar(colnames(tbl))) +
@@ -69,19 +69,19 @@ availability <- function(tbl, width = NULL) {
          5)
     width <- width / 2
   }
-
+  
   if (length(R[is.na(R)]) == ncol(tbl)) {
     width <- width * 2 + 10
   }
-
+  
   x_chars_R <- strrep("#", round(width * R, digits = 2))
   x_chars_SI <- strrep("-", width - nchar(x_chars_R))
   vis_resistance <- paste0("|", x_chars_R, x_chars_SI, "|")
   vis_resistance[is.na(R)] <- ""
-
+  
   x_chars <- strrep("#", round(x, digits = 2) / (1 / width))
   x_chars_empty <- strrep("-", width - nchar(x_chars))
-
+  
   df <- data.frame(count = n,
                    available = percentage(x),
                    visual_availabilty = paste0("|", x_chars, x_chars_empty, "|"),

R/bug_drug_combinations.R

@@ -75,7 +75,7 @@ bug_drug_combinations <- function(x,
   x <- x[, c(col_mo, names(which(sapply(x, is.rsi)))), drop = FALSE]
   
   unique_mo <- sort(unique(x[, col_mo, drop = TRUE]))
-
+  
   out <- data.frame(
     mo = character(0),
     ab = character(0),
@@ -83,7 +83,7 @@ bug_drug_combinations <- function(x,
     I = integer(0),
     R = integer(0),
     total = integer(0))
-
+  
   for (i in seq_len(length(unique_mo))) {
     # filter on MO group and only select R/SI columns
     x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(sapply(x, is.rsi))), drop = FALSE]
@@ -101,7 +101,7 @@ bug_drug_combinations <- function(x,
                             total = merged$S + merged$I + merged$R)
     out <- rbind(out, out_group)
   }
-
+  
   structure(.Data = out, class = c("bug_drug_combinations", x_class))
 }
 
@@ -172,11 +172,11 @@ format.bug_drug_combinations <- function(x,
   
   y <- y %>% 
     create_var(txt = paste0(percentage(y$isolates / y$total, decimal.mark = decimal.mark, big.mark = big.mark), 
-                                          " (", trimws(format(y$isolates, big.mark = big.mark)), "/",
-                                          trimws(format(y$total, big.mark = big.mark)), ")")) %>% 
+                            " (", trimws(format(y$isolates, big.mark = big.mark)), "/",
+                            trimws(format(y$total, big.mark = big.mark)), ")")) %>% 
     select(ab, ab_txt, mo, txt) %>%
     arrange(mo)
-
+  
   # replace tidyr::pivot_wider() from here
   for (i in unique(y$mo)) {
     mo_group <- y[which(y$mo == i), c("ab", "txt")]
@@ -194,14 +194,14 @@ format.bug_drug_combinations <- function(x,
   select_ab_vars <- function(.data) {
     .data[, c("ab_group", "ab_txt", colnames(.data)[!colnames(.data) %in% c("ab_group", "ab_txt", "ab")])]
   }
-
+  
   y <- y %>% 
     create_var(ab_group = ab_group(y$ab, language = language)) %>% 
     select_ab_vars() %>% 
     arrange(ab_group, ab_txt)
   y <- y %>% 
     create_var(ab_group = ifelse(y$ab_group != lag(y$ab_group) | is.na(lag(y$ab_group)), y$ab_group, ""))
-
+  
   if (add_ab_group == FALSE) {
     y <- y %>% 
       select(-ab_group) %>%

R/catalogue_of_life.R

@@ -102,7 +102,7 @@ catalogue_of_life_version <- function() {
                 list(
                   n_total_species = nrow(microorganisms),
                   n_total_synonyms = nrow(microorganisms.old)))
-
+  
   structure(.Data = lst,
             class = c("catalogue_of_life_version", "list"))
 }
@@ -117,7 +117,7 @@ print.catalogue_of_life_version <- function(x, ...) {
              "  Available at: ", lst$catalogue_of_life$url, "\n",
              "  Number of included species: ", format(lst$catalogue_of_life$n, big.mark = ","), "\n",
              font_underline(paste0(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$version, " (",
-                              lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$yearmonth, ")")), "\n",
+                                   lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$yearmonth, ")")), "\n",
              "  Available at: ", lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$url, "\n",
              "  Number of included species: ", format(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$n, big.mark = ","), "\n\n",
              "=> Total number of species included:  ", format(lst$total_included$n_total_species, big.mark = ","), "\n",

R/count.R

@@ -185,7 +185,7 @@ count_df <- function(data,
                      language = get_locale(),
                      combine_SI = TRUE,
                      combine_IR = FALSE) {
-
+  
   rsi_calc_df(type = "count",
               data = data,
               translate_ab = translate_ab,

R/disk.R

@@ -59,16 +59,16 @@ as.disk <- function(x, na.rm = FALSE) {
       x <- x[!is.na(x)]
     }
     x.bak <- x
-
+    
     na_before <- length(x[is.na(x)])
-
+    
     # force it to be integer
     x <- suppressWarnings(as.integer(x))
-
+    
     # disks can never be less than 6 mm (size of smallest disk) or more than 50 mm
     x[x < 6 | x > 50] <- NA_integer_
     na_after <- length(x[is.na(x)])
-
+    
     if (na_before != na_after) {
       list_missing <- x.bak[is.na(x) & !is.na(x.bak)] %>%
         unique() %>%

R/eucast_rules.R

@@ -519,7 +519,7 @@ eucast_rules <- function(x,
     left_join_microorganisms(by = col_mo, suffix = c("_oldcols", ""))
   x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL)
   x$genus_species <- paste(x$genus, x$species)
-
+  
   if (ab_missing(AMP) & !ab_missing(AMX)) {
     # ampicillin column is missing, but amoxicillin is available
     message(font_blue(paste0("NOTE: Using column `", font_bold(AMX), "` as input for ampicillin (J01CA01) since many EUCAST rules depend on it.")))
@@ -702,8 +702,8 @@ eucast_rules <- function(x,
     
     if (info == TRUE & !rule_group_current %like% "other" & eucast_notification_shown == FALSE) {
       cat(paste0("\n", font_grey(strrep("-", options()$width - 1)),
-        "\nRules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)"),
-        "\n", font_blue("http://eucast.org/"), "\n"))
+                 "\nRules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)"),
+                 "\n", font_blue("http://eucast.org/"), "\n"))
       eucast_notification_shown <- TRUE
     }
     
@@ -843,9 +843,9 @@ eucast_rules <- function(x,
     
     cat(paste0("\n", font_grey(strrep("-", options()$width - 1)), "\n"))
     cat(font_bold(paste("The rules", paste0(wouldve, "affected"),
-                   formatnr(n_distinct(verbose_info$row)),
-                   "out of", formatnr(nrow(x_original)),
-                   "rows, making a total of", formatnr(nrow(verbose_info)), "edits\n")))
+                        formatnr(n_distinct(verbose_info$row)),
+                        "out of", formatnr(nrow(x_original)),
+                        "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()
@@ -858,8 +858,8 @@ eucast_rules <- function(x,
     }
     cat(colour(paste0("=> ", wouldve, "added ",
                       font_bold(formatnr(verbose_info %>%
-                                      filter(is.na(old)) %>%
-                                      nrow()), "test results"),
+                                           filter(is.na(old)) %>%
+                                           nrow()), "test results"),
                       "\n")))
     if (n_added > 0) {
       added_summary <- verbose_info %>%
@@ -882,8 +882,8 @@ eucast_rules <- function(x,
     }
     cat(colour(paste0("=> ", wouldve, "changed ",
                       font_bold(formatnr(verbose_info %>%
-                                      filter(!is.na(old)) %>%
-                                      nrow()), "test results"),
+                                           filter(!is.na(old)) %>%
+                                           nrow()), "test results"),
                       "\n")))
     if (n_changed > 0) {
       changed_summary <- verbose_info %>%

R/ggplot_rsi.R

@@ -387,9 +387,9 @@ labels_rsi_count <- function(position = NULL,
                      lineheight = 0.75,
                      data = function(x) {
                        transformed <- rsi_df(data = x,
-                              translate_ab = translate_ab,
-                              combine_SI = combine_SI,
-                              combine_IR = combine_IR)
+                                             translate_ab = translate_ab,
+                                             combine_SI = combine_SI,
+                                             combine_IR = combine_IR)
                        transformed$gr <- transformed[, x_name, drop = TRUE]
                        transformed %>% 
                          group_by(gr) %>% 

R/guess_ab_col.R

@@ -63,23 +63,23 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
     return(as.name("guess_ab_col"))
   }
   stop_ifnot(is.data.frame(x), "`x` must be a data.frame")
-
+  
   if (length(search_string) > 1) {
     warning("argument 'search_string' has length > 1 and only the first element will be used")
     search_string <- search_string[1]
   }
   search_string <- as.character(search_string)
-
+  
   if (search_string %in% colnames(x)) {
     ab_result <- search_string
   } else {
     search_string.ab <- suppressWarnings(as.ab(search_string))
     if (search_string.ab %in% colnames(x)) {
       ab_result <- colnames(x)[colnames(x) == search_string.ab][1L]
-
+      
     } else if (any(tolower(colnames(x)) %in% tolower(unlist(ab_property(search_string.ab, "abbreviations", language = NULL))))) {
       ab_result <- colnames(x)[tolower(colnames(x)) %in% tolower(unlist(ab_property(search_string.ab, "abbreviations", language = NULL)))][1L]
-
+      
     } else {
       # sort colnames on length - longest first
       cols <- colnames(x[, x %>% colnames() %>% nchar() %>% order() %>% rev()])
@@ -90,7 +90,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
       ab_result <- ab_result[!is.na(ab_result)][1L]
     }
   }
-
+  
   if (length(ab_result) == 0) {
     if (verbose == TRUE) {
       message(paste0("No column found as input for `", search_string,
@@ -100,7 +100,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
   } else {
     if (verbose == TRUE) {
       message(font_blue(paste0("NOTE: Using column `", font_bold(ab_result), "` as input for `", search_string,
-                          "` (", ab_name(search_string, language = NULL, tolower = TRUE), ").")))
+                               "` (", ab_name(search_string, language = NULL, tolower = TRUE), ").")))
     }
     return(ab_result)
   }
@@ -111,7 +111,7 @@ get_column_abx <- function(x,
                            hard_dependencies = NULL,
                            verbose = FALSE,
                            ...) {
-
+  
   message(font_blue("NOTE: Auto-guessing columns suitable for analysis"), appendLF = FALSE)
   
   x <- as.data.frame(x, stringsAsFactors = FALSE)
@@ -139,13 +139,13 @@ get_column_abx <- function(x,
   })
   x_columns <- x_columns[!is.na(x_columns)]
   x <- x[, x_columns, drop = FALSE] # without drop = TRUE, x will become a vector when x_columns is length 1
-
+  
   df_trans <- data.frame(colnames = colnames(x),
                          abcode = suppressWarnings(as.ab(colnames(x))))
   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 (...):
   # such as get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
   dots <- list(...)
@@ -164,7 +164,7 @@ get_column_abx <- function(x,
     # delete NAs, this will make e.g. eucast_rules(... TMP = NULL) work to prevent TMP from being used
     x <- x[!is.na(x)]
   }
-
+  
   if (length(x) == 0) {
     message(font_blue("No columns found."))
     return(x)
@@ -179,16 +179,16 @@ get_column_abx <- function(x,
   
   # succeeded with auto-guessing
   message(font_blue("OK."))
-
+  
   for (i in seq_len(length(x))) {
     if (verbose == TRUE & !names(x[i]) %in% names(duplicates)) {
       message(font_blue(paste0("NOTE: Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
-                          "` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").")))
+                               "` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").")))
     }
     if (names(x[i]) %in% names(duplicates)) {
       warning(font_red(paste0("Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
-                         "` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
-                         "), although it was matched for multiple antibiotics or columns.")), 
+                              "` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
+                              "), although it was matched for multiple antibiotics or columns.")), 
               call. = FALSE, 
               immediate. = verbose)
     }
@@ -210,8 +210,8 @@ get_column_abx <- function(x,
       # missing a soft dependency may lower the reliability
       missing <- soft_dependencies[!soft_dependencies %in% names(x)]
       missing_txt <- paste(paste0(ab_name(missing, tolower = TRUE, language = NULL), 
-                        " (", font_bold(missing, collapse = NULL), ")"), 
-                 collapse = ", ")
+                                  " (", font_bold(missing, collapse = NULL), ")"), 
+                           collapse = ", ")
       message(font_blue("NOTE: Reliability would be improved if these antimicrobial results would be available too:",
                         missing_txt))
     }

R/key_antibiotics.R

@@ -130,14 +130,14 @@ key_antibiotics <- function(x,
       warnings <- dots[which(dots.names == "info")]
     }
   }
-
+  
   # try to find columns based on type
   # -- mo
   if (is.null(col_mo)) {
     col_mo <- search_type_in_df(x = x, type = "mo")
   }
   stop_if(is.null(col_mo), "`col_mo` must be set")
-
+  
   # check columns
   col.list <- c(universal_1, universal_2, universal_3, universal_4, universal_5, universal_6,
                 GramPos_1, GramPos_2, GramPos_3, GramPos_4, GramPos_5, GramPos_6,
@@ -170,7 +170,7 @@ key_antibiotics <- function(x,
     }
     col.list
   }
-
+  
   col.list <- check_available_columns(x = x, col.list = col.list, warnings = warnings)
   universal_1 <- col.list[universal_1]
   universal_2 <- col.list[universal_2]
@@ -190,28 +190,28 @@ key_antibiotics <- function(x,
   GramNeg_4 <- col.list[GramNeg_4]
   GramNeg_5 <- col.list[GramNeg_5]
   GramNeg_6 <- col.list[GramNeg_6]
-
+  
   universal <- c(universal_1, universal_2, universal_3,
                  universal_4, universal_5, universal_6)
-
+  
   gram_positive <- c(universal,
-                    GramPos_1, GramPos_2, GramPos_3,
-                    GramPos_4, GramPos_5, GramPos_6)
+                     GramPos_1, GramPos_2, GramPos_3,
+                     GramPos_4, GramPos_5, GramPos_6)
   gram_positive <- gram_positive[!is.null(gram_positive)]
   gram_positive <- gram_positive[!is.na(gram_positive)]
   if (length(gram_positive) < 12) {
     warning("only using ", length(gram_positive), " different antibiotics as key antibiotics for Gram-positives. See ?key_antibiotics.", call. = FALSE)
   }
-
+  
   gram_negative <- c(universal,
-                    GramNeg_1, GramNeg_2, GramNeg_3,
-                    GramNeg_4, GramNeg_5, GramNeg_6)
+                     GramNeg_1, GramNeg_2, GramNeg_3,
+                     GramNeg_4, GramNeg_5, GramNeg_6)
   gram_negative <- gram_negative[!is.null(gram_negative)]
   gram_negative <- gram_negative[!is.na(gram_negative)]
   if (length(gram_negative) < 12) {
     warning("only using ", length(gram_negative), " different antibiotics as key antibiotics for Gram-negatives. See ?key_antibiotics.", call. = FALSE)
   }
-
+  
   x <- as.data.frame(x, stringsAsFactors = FALSE)
   x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE])
   x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL)
@@ -232,16 +232,16 @@ key_antibiotics <- function(x,
                                      FUN = function(x) paste(x, collapse = "")),
                                error = function(e) paste0(rep(".", 12), collapse = "")),
                       x$key_ab)
-
+  
   # format
   key_abs <- toupper(gsub("[^SIR]", ".", gsub("(NA|NULL)", ".", x$key_ab)))
   
   if (n_distinct(key_abs) == 1) {
     warning("No distinct key antibiotics determined.", call. = FALSE)
   }
-
+  
   key_abs
-
+  
 }
 
 #' @rdname key_antibiotics
@@ -255,72 +255,72 @@ key_antibiotics_equal <- function(y,
   # y is active row, z is lag
   x <- y
   y <- z
-
+  
   type <- type[1]
-
+  
   stop_ifnot(length(x) == length(y), "length of `x` and `y` must be equal")
-
+  
   # only show progress bar on points or when at least 5000 isolates
   info_needed <- info == TRUE & (type == "points" | length(x) > 5000)
-
+  
   result <- logical(length(x))
-
+  
   if (info_needed == TRUE) {
     p <- progress_estimated(length(x))
     on.exit(close(p))
   }
-
+  
   for (i in seq_len(length(x))) {
-
+    
     if (info_needed == TRUE) {
       p$tick()
     }
-
+    
     if (is.na(x[i])) {
       x[i] <- ""
     }
     if (is.na(y[i])) {
       y[i] <- ""
     }
-
+    
     if (x[i] == y[i]) {
-
+      
       result[i] <- TRUE
-
+      
     } else if (nchar(x[i]) != nchar(y[i])) {
-
+      
       result[i] <- FALSE
-
+      
     } else {
-
+      
       x_split <- strsplit(x[i], "")[[1]]
       y_split <- strsplit(y[i], "")[[1]]
-
+      
       if (type == "keyantibiotics") {
-
+        
         if (ignore_I == TRUE) {
           x_split[x_split == "I"] <- "."
           y_split[y_split == "I"] <- "."
         }
-
+        
         y_split[x_split == "."] <- "."
         x_split[y_split == "."] <- "."
-
+        
         result[i] <- all(x_split == y_split)
-
+        
       } else if (type == "points") {
         # count points for every single character:
         # - no change is 0 points
         # - I <-> S|R is 0.5 point
         # - S|R <-> R|S is 1 point
         # use the levels of as.rsi (S = 1, I = 2, R = 3)
-
+        
         suppressWarnings(x_split <- x_split %>% as.rsi() %>% as.double())
         suppressWarnings(y_split <- y_split %>% as.rsi() %>% as.double())
-
+        
         points <- (x_split - y_split) %>% abs() %>% sum(na.rm = TRUE) / 2
         result[i] <- points >= points_threshold
-
+        
       } else {
         stop("`", type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?key_antibiotics')
       }

R/like.R

@@ -96,7 +96,7 @@ like <- function(x, pattern, ignore.case = TRUE) {
       return(res)
     }
   }
-
+  
   # the regular way how grepl works; just one pattern against one or more x
   if (is.factor(x)) {
     as.integer(x) %in% base::grep(pattern, levels(x), ignore.case = FALSE, fixed = fixed)

R/mdro.R

@@ -117,7 +117,7 @@ mdro <- function(x,
     # allow pct_required_classes = 75 -> pct_required_classes = 0.75
     pct_required_classes <- pct_required_classes / 100
   }
-
+  
   if (!is.null(list(...)$country)) {
     warning("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call. = FALSE)
     guideline <- list(...)$country
@@ -145,7 +145,7 @@ mdro <- function(x,
   }
   if (is.null(col_mo) & guideline$code == "tb") {
     message(font_blue("NOTE: No column found as input for `col_mo`,",
-                 font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis."))))
+                      font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis."))))
     x$mo <- as.mo("Mycobacterium tuberculosis")
     col_mo <- "mo"
   }
@@ -470,7 +470,7 @@ mdro <- function(x,
       }
       x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE])))
       row_filter <- sapply(x_transposed, function(y) search_function(y %in% search_result, na.rm = TRUE))
-      row_filter <- x[row_filter, "row_number", drop = TRUE]
+      row_filter <- x[which(row_filter), "row_number", drop = TRUE]
       rows <- rows[rows %in% row_filter]
       x[rows, "MDRO"] <<- to
       x[rows, "reason"] <<- paste0(any_all, " of the required antibiotics ", ifelse(any_all == "any", "is", "are"), " R")
@@ -492,23 +492,23 @@ mdro <- function(x,
       
       if (verbose == TRUE) {
         x[rows, "columns_nonsusceptible"] <<- sapply(rows, 
-                                                      function(row, group_vct = lst_vector) {
-                                                        cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
-                                                        paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ")
-                                                      })
+                                                     function(row, group_vct = lst_vector) {
+                                                       cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
+                                                       paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ")
+                                                     })
       }
       x[rows, "classes_affected"] <<- sapply(rows, 
-                                            function(row, group_tbl = lst) {
-                                              sum(sapply(group_tbl, 
-                                                         function(group) {
-                                                           any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
-                                                         }),
-                                                  na.rm = TRUE) 
-                                            })
+                                             function(row, group_tbl = lst) {
+                                               sum(sapply(group_tbl, 
+                                                          function(group) {
+                                                            any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
+                                                          }),
+                                                   na.rm = TRUE) 
+                                             })
       # for PDR; all agents are R (or I if combine_SI = FALSE)
       x_transposed <- as.list(as.data.frame(t(x[rows, lst_vector, drop = FALSE])))
       row_filter <- sapply(x_transposed, function(y) all(y %in% search_result, na.rm = TRUE))
-      x[row_filter, "classes_affected"] <<- 999
+      x[which(row_filter), "classes_affected"] <<- 999
     }
     
     if (info == TRUE) {
@@ -523,7 +523,7 @@ mdro <- function(x,
   x$row_number <- seq_len(nrow(x))
   x$reason <- paste0("not covered by ", toupper(guideline$code), " guideline")
   x$columns_nonsusceptible <- ""
-
+  
   if (guideline$code == "cmi2012") {
     # CMI, 2012 ---------------------------------------------------------------
     # Non-susceptible = R and I
@@ -718,7 +718,7 @@ mdro <- function(x,
     x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3
     if (verbose == TRUE) {
       x[which(x$MDRO == 3), "reason"] <- paste0("less than 3 classes remain susceptible (", x$classes_in_guideline[which((x$classes_in_guideline - x$classes_affected) <= 2)] - x$classes_affected[which(x$MDRO == 3)],
-                                                                                       " out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)")
+                                                " out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)")
     }
     
     # PDR (=4): all agents are R 
@@ -966,7 +966,7 @@ mdro <- function(x,
         ab != "R"
       }
     }
- 
+    
     x$mono_count <- 0
     x[drug_is_R(INH), "mono_count"] <- x[drug_is_R(INH), "mono_count"] + 1
     x[drug_is_R(RIF), "mono_count"] <- x[drug_is_R(RIF), "mono_count"] + 1
@@ -1002,7 +1002,7 @@ mdro <- function(x,
   # some more info on negative results
   if (verbose == TRUE) {
     if (guideline$code == "cmi2012") {
-        x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))], " of ", x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))], " available classes contain R or I (3 required for MDR)")
+      x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))], " of ", x$classes_available[which(x$MDRO == 1 & !is.na(x$classes_affected))], " available classes contain R or I (3 required for MDR)")
     } else {
       x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
     }

R/mic.R

@@ -60,7 +60,7 @@ as.mic <- function(x, na.rm = FALSE) {
       x <- x[!is.na(x)]
     }
     x.bak <- x
-
+    
     # comma to period
     x <- gsub(",", ".", x, fixed = TRUE)
     # transform Unicode for >= and <=
@@ -97,7 +97,7 @@ as.mic <- function(x, na.rm = FALSE) {
     
     ## previously unempty values now empty - should return a warning later on
     x[x.bak != "" & x == ""] <- "invalid"
-
+    
     # these are allowed MIC values and will become factor levels
     ops <- c("<", "<=", "", ">=", ">")
     lvls <- c(c(t(sapply(ops, function(x) paste0(x, "0.00", 1:9)))),
@@ -108,11 +108,11 @@ as.mic <- function(x, na.rm = FALSE) {
               c(t(sapply(ops, function(x) paste0(x, sort(c(1:9, 1.5)))))),
               c(t(sapply(ops, function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])))),
               c(t(sapply(ops, function(x) paste0(x, sort(c(2 ^ c(7:10), 80 * c(2:12))))))))
-
+    
     na_before <- x[is.na(x) | x == ""] %>% length()
     x[!x %in% lvls] <- NA
     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 != ""] %>%
         unique() %>%
@@ -123,7 +123,7 @@ as.mic <- function(x, na.rm = FALSE) {
               "%) that were invalid MICs: ",
               list_missing, call. = FALSE)
     }
-
+    
     structure(.Data = factor(x, levels = lvls, ordered = TRUE),
               class =  c("mic", "ordered", "factor"))
   }

R/mo.R

@@ -554,7 +554,7 @@ exec_as.mo <- function(x,
       if (initial_search == TRUE) {
         progress$tick()
       }
-
+      
       # valid MO code ----
       found <- lookup(mo == toupper(x_backup[i]))
       if (!is.na(found)) {
@@ -1511,7 +1511,7 @@ exec_as.mo <- function(x,
   if (property == "mo") {
     x <- to_class_mo(x)
   }
-
+  
   if (length(mo_renamed()) > 0) {
     print(mo_renamed())
   }

R/mo_property.R

@@ -151,9 +151,9 @@ mo_fullname <- mo_name
 #' @export
 mo_shortname <- function(x, language = get_locale(), ...) {
   x.mo <- as.mo(x, ...)
-
+  
   metadata <- get_mo_failures_uncertainties_renamed()
-
+  
   replace_empty <- function(x) {
     x[x == ""] <- "spp."
     x
@@ -161,13 +161,13 @@ mo_shortname <- function(x, language = get_locale(), ...) {
   
   # get first char of genus and complete species in English
   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-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")
-
+  
   load_mo_failures_uncertainties_renamed(metadata)
   translate_AMR(shortnames, language = language, only_unknown = FALSE)
 }
@@ -235,7 +235,7 @@ mo_type <- function(x, language = get_locale(), ...) {
 mo_gramstain <- function(x, language = get_locale(), ...) {
   x.mo <- as.mo(x, ...)
   metadata <- get_mo_failures_uncertainties_renamed()
-
+  
   x.phylum <- mo_phylum(x.mo)
   # DETERMINE GRAM STAIN FOR BACTERIA
   # Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097
@@ -256,7 +256,7 @@ mo_gramstain <- function(x, language = get_locale(), ...) {
                     "Firmicutes",
                     "Tenericutes")
     | x.mo == "B_GRAMP"] <- "Gram-positive"
-
+  
   load_mo_failures_uncertainties_renamed(metadata)
   translate_AMR(x, language = language, only_unknown = FALSE)
 }
@@ -302,16 +302,16 @@ mo_rank <- function(x, ...) {
 mo_taxonomy <- function(x, language = get_locale(),  ...) {
   x <- as.mo(x, ...)
   metadata <- get_mo_failures_uncertainties_renamed()
-
+  
   result <- base::list(kingdom = mo_kingdom(x, language = language),
-             phylum = mo_phylum(x, language = language),
-             class = mo_class(x, language = language),
-             order = mo_order(x, language = language),
-             family = mo_family(x, language = language),
-             genus = mo_genus(x, language = language),
-             species = mo_species(x, language = language),
-             subspecies = mo_subspecies(x, language = language))
-
+                       phylum = mo_phylum(x, language = language),
+                       class = mo_class(x, language = language),
+                       order = mo_order(x, language = language),
+                       family = mo_family(x, language = language),
+                       genus = mo_genus(x, language = language),
+                       species = mo_species(x, language = language),
+                       subspecies = mo_subspecies(x, language = language))
+