fix for as.mo and freq

.gitlab-ci.yml

@@ -13,11 +13,14 @@ R 3:
     - apt-get update
     # install dependencies for package
     - apt-get install --yes --no-install-recommends libxml2-dev libssl-dev libcurl4-openssl-dev zlib1g-dev
-    - R -e 'install.packages(c("devtools", "rlang"))'
+    - Rscript -e 'install.packages(c("devtools", "rlang"))'
-    - R -e 'devtools::install_deps(dependencies = c("Depends", "Imports", "Suggests"), repos = "https://cran.rstudio.com")'
+    - Rscript -e 'devtools::install_deps(dependencies = c("Depends", "Imports", "Suggests"), repos = "https://cran.rstudio.com")'
     # remove vignettes folder and get VignetteBuilder field out of DESCRIPTION file
     - rm -rf vignettes
-    - R -e 'd <- read.dcf("DESCRIPTION"); d[, colnames(d) == "VignetteBuilder"] <- NA; write.dcf(d, "DESCRIPTION")'
+    - Rscript -e 'd <- read.dcf("DESCRIPTION"); d[, colnames(d) == "VignetteBuilder"] <- NA; write.dcf(d, "DESCRIPTION")'
+    # set environmental variable
+    - Rscript -e 'Sys.setenv(NOT_CRAN = "true")'
+    # build package
     - R CMD build . --no-build-vignettes --no-manual
     - PKG_FILE_NAME=$(ls -1t *.tar.gz | head -n 1)
     - R CMD check "${PKG_FILE_NAME}" --no-build-vignettes --no-manual --as-cran

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 0.4.0.9013
+Version: 0.4.0.9014
-Date: 2018-11-24
+Date: 2018-11-30
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(

R/freq.R

@@ -337,7 +337,7 @@ frequency_tbl <- function(x,
     header_txt <- header_txt %>% paste0(markdown_line, '\nLongest:   ', x %>% base::nchar() %>% base::max(na.rm = TRUE))
   }
 
-  if (NROW(x) > 0 & any(class(x) == "difftime")) {
+  if (NROW(x) > 0 & any(class(x) == "difftime") & !is.hms(x)) {
     header_txt <- header_txt %>% paste0('\n')
     header_txt <- header_txt %>% paste(markdown_line, '\nUnits:    ', attributes(x)$units)
     x <- as.double(x)

R/mo.R

@@ -192,7 +192,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
   x_input <- x
   # only check the uniques, which is way faster
   x <- unique(x)
-  # remove empty values (to later fill them in again)
+  # remove empty values (to later fill them in again with NAs)
   x <- x[!is.na(x) & !is.null(x) & !identical(x, "")]
 
   # defined df to check for
@@ -270,27 +270,24 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
         # check if search term was like "A. species", then return first genus found with ^A
         if (x_backup[i] %like% "species" | x_backup[i] %like% "spp[.]?") {
           # get mo code of first hit
-          found <- microorganismsDT[fullname %like% x_withspaces_start[i], mo][[1]]
+          found <- microorganismsDT[fullname %like% x_withspaces_start[i], mo]
-          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]
+            mo_code <- found[1L] %>% strsplit("_") %>% unlist() %>% .[1:2] %>% paste(collapse = "_")
-            next
+            found <- microorganismsDT[mo == mo_code, ..property][[1]]
-          } else {
+            # return first genus that begins with x_trimmed, e.g. when "E. spp."
-            # fewer than 3 chars, add as failure
+            if (length(found) > 0) {
-            x[i] <- NA_character_
+              x[i] <- found[1L]
-            failures <- c(failures, x_backup[i])
+              next
-            next
+            }
           }
-        } else {
-          # fewer than 3 chars, add as failure
-          x[i] <- NA_character_
-          failures <- c(failures, x_backup[i])
-          next
         }
+        # fewer than 3 chars and not looked for species, add as failure
+        x[i] <- NA_character_
+        failures <- c(failures, x_backup[i])
+        next
       }
 
+
       # translate known trivial abbreviations to genus + species ----
       if (!is.na(x_trimmed[i])) {
         if (toupper(x_trimmed[i]) == 'MRSA'
@@ -377,9 +374,16 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
       }
 
       # TRY OTHER SOURCES ----
+      if (toupper(x_backup[i]) %in% microorganisms.certe[, 1]) {
+        mo_found <- microorganisms.certe[toupper(x_backup[i]) == microorganisms.certe[, 1], 2][1L]
+        if (length(mo_found) > 0) {
+          x[i] <- microorganismsDT[mo == mo_found, ..property][[1]][1L]
+          next
+        }
+      }
       if (x_backup[i] %in% microorganisms.umcg[, 1]) {
         mo_umcg <- microorganisms.umcg[microorganisms.umcg[, 1] == x_backup[i], 2]
-        mo_found <- microorganisms.certe[microorganisms.certe[, 1] == mo_umcg, 2]
+        mo_found <- microorganisms.certe[microorganisms.certe[, 1] == mo_umcg, 2][1L]
         if (length(mo_found) == 0) {
           # not found
           x[i] <- NA_character_

tests/testthat/test-eucast_rules.R

@@ -73,6 +73,10 @@ test_that("EUCAST rules work", {
       , info = FALSE))$amox,
     "S")
 
+  # also test norf
+  expect_output(suppressWarnings(eucast_rules(septic_patients %>% mutate(norf = "S", nali = "S"))))
+
+  # check verbose output
   expect_output(suppressWarnings(eucast_rules(septic_patients, verbose = TRUE)))
 
 })

tests/testthat/test-mo.R

@@ -77,6 +77,9 @@ test_that("as.mo works", {
   # too few characters
   expect_warning(as.mo("ab"))
 
+  expect_equal(suppressWarnings(as.character(as.mo(c("Qq species", "", "CRS", "K. pneu rhino", "esco")))),
+               c(NA_character_, NA_character_, "B_STNTR_MAL", "B_KLBSL_PNE_RHI", "B_ESCHR_COL"))
+
   # check for Becker classification
   expect_identical(as.character(guess_mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPI")
   expect_identical(as.character(guess_mo("S. epidermidis", Becker = TRUE)),  "B_STPHY_CNS")
@@ -202,4 +205,9 @@ test_that("as.mo works", {
                              "E. species")),
                rep("Escherichia species", 3))
 
+  # from different sources
+  expect_equal(as.character(as.mo(
+    c("PRTMIR", "bclcer", "B_ESCHR_COL"))),
+    c("B_PROTS_MIR", "B_BCLLS_CER", "B_ESCHR_COL"))
+
 })