Merge pull request #194 from pharmaverse/189-impute_dcutdtc-missing-d…

…cutdtc

189 impute dcutdtc missing dcutdtc

NEWS.md

@@ -4,7 +4,7 @@
 - Added a "Report a bug" link to `{datacutr}` website (#182)
 
 ## Updates of Existing Functions
-- Update to `date_cut()` and  `special_dm_cut()` functions to allow for 
+- Update to `impute_dcutdtc()`, `date_cut()` and `special_dm_cut()` functions to allow for 
 datacut date to be null. In this case, all records for this patient 
 will be kept/left unchanged.
 - Warning added to `process_cut` if expected dataset `dm` is missing

R/impute_dcutdtc.R

@@ -6,7 +6,7 @@
 #' @param dsin Name of input data cut dataframe (i.e; DCUT)
 #' @param varin Name of input data cutoff variable (i.e; DCUTDTC) which must be in ISO 8601
 #' extended format (YYYY-MM-DDThh:mm:ss). All values of the data cutoff variable must be at
-#' least a complete date.
+#' least a complete date, or NA.
 #' @param varout Name of imputed output variable
 #'
 #' @return Returns the input data cut dataframe, with the additional of one extra variable (varout)
@@ -101,13 +101,14 @@ impute_dcutdtc <- function(dsin, varin, varout) {
     )
   )
 
-  # Assertion to check that all DCUTDTC values are at least a complete date
-  assert_that(all(!str_detect(imputed_dtc_1, "XYZ")),
+  # Assertion to check that all DCUTDTC values are at least a complete date or NA
+  imputed_dtc_2 <- ifelse(str_detect(imputed_dtc_1, "XYZ-XYZ-XYZ"), "", imputed_dtc_1)
+  assert_that(all(!str_detect(imputed_dtc_2, "XYZ")),
     msg = "All values of the data cutoff variable must be at least a complete date"
   )
 
   # Remove fractional seconds from the datetime
-  imputed_dtc_final <- gsub("\\..*", "", imputed_dtc_1)
+  imputed_dtc_final <- gsub("\\..*", "", imputed_dtc_2)
 
   # Add our new imputed datetime variable back to dsin + convert to datetime object
   out <- dsin %>%

renv.lock

@@ -592,7 +592,7 @@
     },
     "roxygen2": {
       "Package": "roxygen2",
-      "Version": "7.2.0",
+      "Version": "7.2.3",
       "Source": "Repository",
       "Repository": "CRAN",
       "Hash": "b390c1d54fcd977cda48588e6172daba"

tests/testthat/test-impute_dcutdtc.R

@@ -1,21 +1,21 @@
 ### Set up input data and expected results ###
 input <- data.frame(
-  USUBJID = rep(c("UXYZ123a"), 7),
+  USUBJID = rep(c("UXYZ123a"), 8),
   DCUTDTC = c(
     "2022-06-23", "2022-06-23T16", "2022-06-23T16:57", "2022-06-23T16:57:30",
-    "2022-06-23T16:57:30.123", "2022-06-23T16:-:30", "2022-06-23T-:57:30"
+    "2022-06-23T16:57:30.123", "2022-06-23T16:-:30", "2022-06-23T-:57:30", NA
   )
 )
 expected <- data.frame(
-  USUBJID = rep(c("UXYZ123a"), 7),
+  USUBJID = rep(c("UXYZ123a"), 8),
   DCUTDTC = c(
     "2022-06-23", "2022-06-23T16", "2022-06-23T16:57", "2022-06-23T16:57:30",
-    "2022-06-23T16:57:30.123", "2022-06-23T16:-:30", "2022-06-23T-:57:30"
+    "2022-06-23T16:57:30.123", "2022-06-23T16:-:30", "2022-06-23T-:57:30", NA
   ),
   DCUTDTM = ymd_hms(c(
     "2022-06-23T23:59:59", "2022-06-23T16:59:59", "2022-06-23T16:57:59",
     "2022-06-23T16:57:30", "2022-06-23T16:57:30", "2022-06-23T16:59:30",
-    "2022-06-23T23:57:30"
+    "2022-06-23T23:57:30", NA
   ))
 )
 
@@ -88,7 +88,7 @@ test_that("Test that impute_dcutdtc function errors when varin contains dates in
 ### Test with input dates that do not contain a complete date ###
 input6 <- data.frame(
   USUBJID = c("U1234567"),
-  DCUTDTC = c(NA)
+  DCUTDTC = c("2022-06")
 )
 
 test_that("Test that impute_dcutdtc function errors when varin does not contain
@@ -99,25 +99,13 @@ test_that("Test that impute_dcutdtc function errors when varin does not contain
 })
 
 input7 <- data.frame(
-  USUBJID = c("U1234567"),
-  DCUTDTC = c("2022-06")
-)
-
-test_that("Test that impute_dcutdtc function errors when varin does not contain
-          at least a complete date", {
-  expect_error(impute_dcutdtc(dsin = input7, varin = DCUTDTC, varout = DCUTDTM),
-    regexp = "All values of the data cutoff variable must be at least a complete date"
-  )
-})
-
-input8 <- data.frame(
   USUBJID = c("U1234567"),
   DCUTDTC = c("2022-06--T16:57:30")
 )
 
 test_that("Test that impute_dcutdtc function errors when varin does not contain
           at least a complete date", {
-  expect_error(impute_dcutdtc(dsin = input8, varin = DCUTDTC, varout = DCUTDTM),
+  expect_error(impute_dcutdtc(dsin = input7, varin = DCUTDTC, varout = DCUTDTM),
     regexp = "All values of the data cutoff variable must be at least a complete date"
   )
 })