(v1.2.0.9034) code cleaning

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.2.0.9033
+Version: 1.2.0.9034
-Date: 2020-07-12
+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
+# AMR 1.2.0.9034
-## <small>Last updated: 12-Jul-2020</small>
+## <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/ab.R

@@ -188,7 +188,7 @@ 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)

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/age.R

@@ -51,8 +51,8 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE) {
   # 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 - 1),
-                  as.integer(years_gap))
+                 as.integer(years_gap))
   
   # add decimals
   if (exact == TRUE) {

R/bug_drug_combinations.R

@@ -172,8 +172,8 @@ 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$isolates, big.mark = big.mark)), "/",
-                                          trimws(format(y$total, big.mark = big.mark)), ")")) %>% 
+                            trimws(format(y$total, big.mark = big.mark)), ")")) %>% 
     select(ab, ab_txt, mo, txt) %>%
     arrange(mo)
   

R/catalogue_of_life.R

@@ -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/eucast_rules.R

@@ -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)"),
+                 "\nRules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)"),
-        "\n", font_blue("http://eucast.org/"), "\n"))
+                 "\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)),
+                        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()
@@ -858,8 +858,8 @@ eucast_rules <- function(x,
     }
     cat(colour(paste0("=> ", wouldve, "added ",
                       font_bold(formatnr(verbose_info %>%
-                                      filter(is.na(old)) %>%
+                                           filter(is.na(old)) %>%
-                                      nrow()), "test results"),
+                                           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)) %>%
+                                           filter(!is.na(old)) %>%
-                                      nrow()), "test results"),
+                                           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,
+                                             translate_ab = translate_ab,
-                              combine_SI = combine_SI,
+                                             combine_SI = combine_SI,
-                              combine_IR = combine_IR)
+                                             combine_IR = combine_IR)
                        transformed$gr <- transformed[, x_name, drop = TRUE]
                        transformed %>% 
                          group_by(gr) %>% 

R/guess_ab_col.R

@@ -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)
   }
@@ -183,12 +183,12 @@ get_column_abx <- function(x,
   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),
+                              "` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
-                         "), although it was matched for multiple antibiotics or columns.")), 
+                              "), 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), ")"), 
+                                  " (", font_bold(missing, collapse = NULL), ")"), 
-                 collapse = ", ")
+                           collapse = ", ")
       message(font_blue("NOTE: Reliability would be improved if these antimicrobial results would be available too:",
                         missing_txt))
     }

R/key_antibiotics.R

@@ -195,8 +195,8 @@ key_antibiotics <- function(x,
                  universal_4, universal_5, universal_6)
   
   gram_positive <- c(universal,
-                    GramPos_1, GramPos_2, GramPos_3,
+                     GramPos_1, GramPos_2, GramPos_3,
-                    GramPos_4, GramPos_5, GramPos_6)
+                     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) {
@@ -204,8 +204,8 @@ key_antibiotics <- function(x,
   }
   
   gram_negative <- c(universal,
-                    GramNeg_1, GramNeg_2, GramNeg_3,
+                     GramNeg_1, GramNeg_2, GramNeg_3,
-                    GramNeg_4, GramNeg_5, GramNeg_6)
+                     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) {

R/mdro.R

@@ -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) {
+                                                     function(row, group_vct = lst_vector) {
-                                                        cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
+                                                       cols_nonsus <- sapply(x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
-                                                        paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ")
+                                                       paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ")
-                                                      })
+                                                     })
       }
       x[rows, "classes_affected"] <<- sapply(rows, 
-                                            function(row, group_tbl = lst) {
+                                             function(row, group_tbl = lst) {
-                                              sum(sapply(group_tbl, 
+                                               sum(sapply(group_tbl, 
-                                                         function(group) {
+                                                          function(group) {
-                                                           any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
+                                                            any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
-                                                         }),
+                                                          }),
-                                                  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) {
@@ -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 
@@ -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/mo_property.R

@@ -304,13 +304,13 @@ mo_taxonomy <- function(x, language = get_locale(),  ...) {
   metadata <- get_mo_failures_uncertainties_renamed()
   
   result <- base::list(kingdom = mo_kingdom(x, language = language),
-             phylum = mo_phylum(x, language = language),
+                       phylum = mo_phylum(x, language = language),
-             class = mo_class(x, language = language),
+                       class = mo_class(x, language = language),
-             order = mo_order(x, language = language),
+                       order = mo_order(x, language = language),
-             family = mo_family(x, language = language),
+                       family = mo_family(x, language = language),
-             genus = mo_genus(x, language = language),
+                       genus = mo_genus(x, language = language),
-             species = mo_species(x, language = language),
+                       species = mo_species(x, language = language),
-             subspecies = mo_subspecies(x, language = language))
+                       subspecies = mo_subspecies(x, language = language))
   
   load_mo_failures_uncertainties_renamed(metadata)
   result

R/resistance_predict.R

@@ -127,7 +127,7 @@ resistance_predict <- function(x,
   stop_if(any(dim(x) == 0), "`x` must contain rows and columns")
   stop_if(is.null(model), 'choose a regression model with the `model` parameter, e.g. resistance_predict(..., model = "binomial")')
   stop_ifnot(col_ab %in% colnames(x),
-               "column `", col_ab, "` not found")
+             "column `", col_ab, "` not found")
   
   dots <- unlist(list(...))
   if (length(dots) != 0) {

R/rsi.R

@@ -232,8 +232,8 @@ as.rsi.mic <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST",
   }
   
   message(font_blue(paste0("=> Interpreting MIC values of `", font_bold(ab), "` (",
-                      ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
+                           ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
-                      ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
+                           ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
           appendLF = FALSE)
   result <- exec_as.rsi(method = "mic",
                         x = x,
@@ -268,8 +268,8 @@ as.rsi.disk <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST"
   }
   
   message(font_blue(paste0("=> Interpreting disk zones of `", font_bold(ab), "` (",
-                      ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
+                           ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
-                      ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
+                           ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
           appendLF = FALSE)
   result <- exec_as.rsi(method = "disk",
                         x = x,
@@ -319,9 +319,9 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", uti = NULL
         plural <- c("", "s", "a ")
       }
       message(font_blue(paste0("NOTE: Assuming value", plural[1], " ", 
-              paste(paste0('"', values, '"'), collapse = ", "),
+                               paste(paste0('"', values, '"'), collapse = ", "),
-              " in column `", font_bold(col_specimen),
+                               " in column `", font_bold(col_specimen),
-              "` reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1], ".\n  Use `as.rsi(uti = FALSE)` to prevent this.")))
+                               "` reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1], ".\n  Use `as.rsi(uti = FALSE)` to prevent this.")))
     } else {
       # no data about UTI's found
       uti <- FALSE
@@ -339,13 +339,13 @@ as.rsi.data.frame <- function(x, col_mo = NULL, guideline = "EUCAST", uti = NULL
       return(FALSE)
     } else if (!check & all_valid_mics(y)) {
       message(font_blue(paste0("NOTE: Assuming column `", ab, "` (",
-                          ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
+                               ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
-                          ab_name(ab_coerced, tolower = TRUE), ") contains MIC values.")))
+                               ab_name(ab_coerced, tolower = TRUE), ") contains MIC values.")))
       return(TRUE)
     } else if (!check & all_valid_disks(y)) {
       message(font_blue(paste0("NOTE: Assuming column `", ab, "` (",
-                          ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
+                               ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
-                          ab_name(ab_coerced, tolower = TRUE), ") contains disk zones.")))
+                               ab_name(ab_coerced, tolower = TRUE), ") contains disk zones.")))
       return(TRUE)
     } else {
       return(check)

codecov.yml

@@ -21,6 +21,7 @@
 
 codecov:
   require_ci_to_pass: no # allow fail
+  branch: master
 
 comment: no
 

docs/404.html

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

docs/LICENSE-text.html

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

docs/articles/index.html

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

docs/authors.html

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

docs/index.html

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

docs/news/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9033</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.2.0.9034</span>
       </span>
     </div>
 
@@ -229,13 +229,13 @@
       <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
     </div>
 
-    <div id="amr-1209033" class="section level1">
+    <div id="amr-1209034" class="section level1">
-<h1 class="page-header" data-toc-text="1.2.0.9033">
+<h1 class="page-header" data-toc-text="1.2.0.9034">
-<a href="#amr-1209033" class="anchor"></a>AMR 1.2.0.9033<small> Unreleased </small>
+<a href="#amr-1209034" class="anchor"></a>AMR 1.2.0.9034<small> Unreleased </small>
 </h1>
-<div id="last-updated-12-jul-2020" class="section level2">
+<div id="last-updated-13-jul-2020" class="section level2">
 <h2 class="hasAnchor">
-<a href="#last-updated-12-jul-2020" class="anchor"></a><small>Last updated: 12-Jul-2020</small>
+<a href="#last-updated-13-jul-2020" class="anchor"></a><small>Last updated: 13-Jul-2020</small>
 </h2>
 <div id="new" class="section level3">
 <h3 class="hasAnchor">

docs/pkgdown.yml

@@ -10,7 +10,7 @@ articles:
   WHONET: WHONET.html
   benchmarks: benchmarks.html
   resistance_predict: resistance_predict.html
-last_built: 2020-07-12T09:42Z
+last_built: 2020-07-13T07:17Z
 urls:
   reference: https://msberends.github.io/AMR/reference
   article: https://msberends.github.io/AMR/articles

docs/reference/index.html

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