add tests using testthat

R/EUCAST.R

@@ -188,7 +188,7 @@ EUCAST_rules <- function(tbl,
                 teic, tetr, tica, tige, tobr, trim, trsu, vanc)
   col.list <- col.list[!is.na(col.list)]
   col.list.bak <- col.list
-  # are they available as upper case then?
+  # are they available as upper case or lower case then?
   for (i in 1:length(col.list)) {
     if (toupper(col.list[i]) %in% colnames(tbl)) {
       col.list[i] <- toupper(col.list[i])
@@ -708,7 +708,7 @@ mo_property <- function(bactid, property = 'fullname') {
       result = tryCatch({
         mocode[i] <-
           AMR::microorganisms %>%
-          filter(bactid == bactid) %>%
+          filter(bactid == bug) %>%
           select(property) %>%
           unlist() %>%
           as.character()

R/classes.R

@@ -364,7 +364,7 @@ summary.mic <- function(object, ...) {
   x <- x[!is.na(x)]
   n <- x %>% length()
   return(c("Mode" = 'mic',
-           "NA" = n_total - n,
+           "<NA>" = n_total - n,
            "Min." = sort(x)[1] %>% as.character(),
            "Max." = sort(x)[n] %>% as.character()
   ))

R/clipboard.R

@@ -7,6 +7,7 @@
 #' @inheritParams utils::write.table
 #' @param startrow \emph{n}th row to start importing from. For \code{clipboard_import}, when \code{header = TRUE} the import will start on row \code{startrow} \emph{below} the header.
 #' @param as_vector a logical value indicating whether data consisting of only one column should be imported as vector using \code{\link[dplyr]{pull}}. This will strip off the header.
+#' @param info print info about copying
 #' @keywords clipboard clipboard_import clipboard_export import export
 #' @importFrom dplyr %>% pull as_tibble
 #' @importFrom utils read.delim write.table object.size
@@ -54,7 +55,8 @@ clipboard_export <- function(x,
                              sep = '\t',
                              dec = ".",
                              na = "",
-                             header = TRUE) {
+                             header = TRUE,
+                             info = TRUE) {
   
   x <- deparse(substitute(x))
   size <- x %>%
@@ -75,6 +77,7 @@ clipboard_export <- function(x,
               dec = dec,
               quote = FALSE)
 
-  cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n")
-  
+  if (info == TRUE) {
+    cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n")
+  }
 }

R/first_isolates.R

@@ -448,6 +448,8 @@ key_antibiotics <- function(tbl,
                 clin, clox, doxy, gent, line, mero, peni,
                 pita, rifa, teic, trsu, vanc)
   col.list <- col.list[!is.na(col.list)]
+  col.list.bak <- col.list
+  # are they available as upper case or lower case then?
   for (i in 1:length(col.list)) {
     if (toupper(col.list[i]) %in% colnames(tbl)) {
       col.list[i] <- toupper(col.list[i])
@@ -459,8 +461,8 @@ key_antibiotics <- function(tbl,
   }
   if (!all(col.list %in% colnames(tbl))) {
     if (info == TRUE) {
-      warning('These columns do not exist and will be ignored:\n',
-              col.list[!(col.list %in% colnames(tbl))] %>% toString(),
+      warning('These columns do not exist and will be ignored: ',
+              col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(),
               immediate. = TRUE,
               call. = FALSE)
     }
@@ -647,9 +649,13 @@ guess_bactid <- function(x) {
   
   for (i in 1:length(x)) {
     if (tolower(x[i]) == '^e.*coli$') {
-      # avoid detection of Entamoeba coli in case of Escherichia coli
+      # avoid detection of Entamoeba coli in case of E. coli
       x[i] <- 'Escherichia coli'
     }
+    if (tolower(x[i]) == '^h.*influenzae$') {
+      # avoid detection of Haematobacter influenzae in case of H. influenzae
+      x[i] <- 'Haemophilus influenzae'
+    }
     if (tolower(x[i]) == '^st.*au$'
         | tolower(x[i]) == '^stau$'
         | tolower(x[i]) == '^staaur$') {

R/join.R

@@ -96,7 +96,11 @@ full_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...)
   } else {
     joinby <- by
   }
-  dplyr::full_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
+  join <- dplyr::full_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...)
+  if (nrow(join) > nrow(x)) {
+    warning('the newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original')
+  }
+  join
 }
 
 #' @rdname join

R/rsi_analysis.R

@@ -67,7 +67,7 @@ rsi_df <- function(tbl,
     stop('Invalid `interpretation`; must be "S", "SI", "I", "IR", or "R".')
   }
   if ('is_ic' %in% colnames(tbl)) {
-    if (n_distinct(tbl$is_ic) > 1) {
+    if (n_distinct(tbl$is_ic) > 1 & warning == TRUE) {
       warning('Dataset contains isolates from the Intensive Care. Exclude them from proper epidemiological analysis.')
     }
   }
@@ -280,8 +280,7 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA
 #'            first_isolate(.,
 #'                          "date",
 #'                          "patient_id",
-#'                          "genus",
-#'                          "species",
+#'                          "bactid",
 #'                          col_specimen = NA,
 #'                          col_icu = NA)) %>% 
 #'   # filter on first E. coli isolates
@@ -304,6 +303,10 @@ rsi_predict <- function(tbl,
                         preserve_measurements = TRUE,
                         info = TRUE) {
   
+  if (nrow(tbl) == 0) {
+    stop('This table does not contain any observations.')
+  }
+  
   col_ab <- quasiquotate(deparse(substitute(col_ab)), col_ab)
   if (!col_ab %in% colnames(tbl)) {
     stop('Column ', col_ab, ' not found.')