Znk audit

DESCRIPTION

@@ -3,11 +3,21 @@ Title: Tools to Import and Tidy Case Linelist Data
 Version: 0.0.35.9000
 Authors@R: c(person("Thibaut", "Jombart", email = "[email protected]", role = c("aut", "cre")),
     person("Zhian N.", "Kamvar", email = "[email protected]", role = c("aut")))
-Description: A collection of wrappers for importing case linelist data from usual formats, and tools for cleaning data, detecting dates, and storing meta-information on the content of the resulting data frame.  
+Description: A collection of wrappers for importing case linelist data from
+  usual formats, and tools for standardizing variable names, dictionary-based
+  value standardization, and date detection.
 Depends: R (>= 3.0.0)
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
+Imports:
+  lubridate,
+  rlang,
+  epitrix,
+  forcats,
+  utils,
+  stats,
+  crayon
 Suggests:
   outbreaks,
   incidence,
@@ -19,14 +29,6 @@ Suggests:
   dplyr,
   magrittr
 RoxygenNote: 6.1.1
-Imports:
-  lubridate,
-  rlang,
-  epitrix,
-  forcats,
-  utils,
-  stats,
-  crayon
 URL: https://github.com/reconhub/linelist
 BugReports: https://github.com/reconhub/linelist/issues
 VignetteBuilder: knitr

R/guess_dates.R

@@ -239,18 +239,24 @@ guess_dates <- function(x, error_tolerance = 0.1, first_date = NULL,
     # only test the dates if the previous run wasn't successful or the user doesn't want to
     # keep <- if (!fast || i == 1) TRUE else keep & is.na(res[[i - 1]])
 
-    res[[i]] <- find_and_constrain_date(x, orders[[i]], keep = TRUE, first_date, last_date, baddies)
+    res[[i]] <- find_and_constrain_date(x, 
+                                        orders  = orders[[i]],
+                                        keep    = TRUE,
+                                        dmin    = first_date,
+                                        dmax    = last_date,
+                                        baddies = baddies
+                                       )
 
   }
 
   ## if lubridate fails to do the job, then we should use thibaut's parser.  
   x_rescued <- rescue_lubridate_failures(data.frame(res),
-                                         original_dates = x, 
-                                         mxl = modern_excel,
-                                         dmin = first_date,
-                                         dmax = last_date,
-                                         baddies = baddies
-                                         )
+                                         original_dates = x,
+                                         mxl            = modern_excel,
+                                         dmin           = first_date,
+                                         dmax           = last_date,
+                                         baddies        = baddies
+                                        )
 
   # process dates that were not parsed -----------------------------------------
 
@@ -260,8 +266,8 @@ guess_dates <- function(x, error_tolerance = 0.1, first_date = NULL,
     bd     <- utils::stack(bd)     # make a data frame with ind and values
     bd$ind <- as.character(bd$ind) # convert ind to char
     bd     <- unique(bd)           # only consider unique values
-    bd     <- bd[!is.na(bd[[1]]) | !is.na(bd[[2]]), ] # remove NA rows
-    bd     <- bd[order(bd[[1]]), ] # sort by value
+    bd     <- bd[!is.na(bd[[1]]) | !is.na(bd[[2]]), , drop = FALSE] # remove NA rows
+    bd     <- bd[order(bd[[1]]), , drop = FALSE] # sort by value
     misses <- sprintf("  %s  |  %s", 
                       format(c("original", "--------", bd$values)), 
                       format(c("parsed",   "------  ", bd$ind))

tests/testthat/test-guess_dates.R

@@ -110,3 +110,18 @@ test_that("passing a non-date as first_date throws an error", {
   expect_failure(expect_error(guess_dates(x, last_date = "2019-01-01"), "first_date and last_date must be Date objects."))
 
 })
+
+
+test_that("thibaut's guesser works", {
+
+  # This is a bug in lubridate: https://github.com/tidyverse/lubridate/issues/752
+  the_test     <- c("something_2019-01-01_report.xlsx", "it's the year 3030")
+  the_expected <- c(as.Date("2019-01-01"), as.Date(NA))
+
+  lstring      <- guess_dates(the_test, e = 1)
+  tstring      <- as.Date(vapply(the_test, i_extract_date_string, character(1)))
+  expect_equal(lstring, the_expected)
+  expect_equal(tstring, the_expected)
+
+
+})