pharmaverse#592 Updated examples to use preserve argument. Fixed some…

… formatting issues
bundfussr · Jan 7, 2022 · 33658c4 · 33658c4
1 parent b72aa32
commit 33658c4
Show file tree

Hide file tree

Showing 8 changed files with 132 additions and 10 deletions.
diff --git a/R/derive_date_vars.R b/R/derive_date_vars.R
@@ -663,6 +663,18 @@ compute_tmf <- function(dtc,
 #'   date_imputation = "first",
 #'   min_dates = vars(TRTSDTM)
 #' )
+#'
+#' # A user imputing dates as middle month/day, i.e. date_imputation = "MID" can
+#' # use preserve argument to "preserve" partial dates.  For example, "2019---07",
+#' # will be displayed as "2019-06-07" rather than 2019-06-15 with preserve = TRUE
+#'
+#' derive_vars_dtm(
+#'   mhdt,
+#'   new_vars_prefix = "AST",
+#'   dtc = MHSTDTC,
+#'   date_imputation = "MID",
+#'   preserve = TRUE
+#' )
 derive_vars_dt <- function(dataset,
                            new_vars_prefix,
                            dtc,
@@ -805,6 +817,18 @@ derive_vars_dt <- function(dataset,
 #'   time_imputation = "FIRST",
 #'   ignore_seconds_flag = TRUE
 #' )
+#'
+#' # A user imputing dates as middle month/day, i.e. date_imputation = "MID" can
+#' # use preserve argument to "preserve" partial dates.  For example, "2019---07",
+#' # will be displayed as "2019-06-07" rather than 2019-06-15 with preserve = TRUE
+#'
+#' derive_vars_dtm(
+#'   mhdt,
+#'   new_vars_prefix = "AST",
+#'   dtc = MHSTDTC,
+#'   date_imputation = "MID",
+#'   preserve = TRUE
+#' )
 derive_vars_dtm <- function(dataset,
                             new_vars_prefix,
                             dtc,
@@ -838,7 +862,8 @@ derive_vars_dtm <- function(dataset,
     date_imputation = date_imputation,
     time_imputation = time_imputation,
     min_dates = lapply(min_dates, eval_tidy, data = mask),
-    max_dates = lapply(min_dates, eval_tidy, data = mask)
+    max_dates = lapply(min_dates, eval_tidy, data = mask),
+    preserve = preserve
   )
 
   if (flag_imputation %in% c("both", "date") ||

diff --git a/man/convert_date_to_dtm.Rd b/man/convert_date_to_dtm.Rd
diff --git a/man/convert_dtc_to_dt.Rd b/man/convert_dtc_to_dt.Rd
diff --git a/man/convert_dtc_to_dtm.Rd b/man/convert_dtc_to_dtm.Rd
diff --git a/man/derive_vars_dt.Rd b/man/derive_vars_dt.Rd
diff --git a/man/derive_vars_dtm.Rd b/man/derive_vars_dtm.Rd
diff --git a/man/impute_dtc.Rd b/man/impute_dtc.Rd
diff --git a/tests/testthat/test-derive_vars_dtm.R b/tests/testthat/test-derive_vars_dtm.R
@@ -348,3 +348,43 @@ test_that("Function throws ERROR when Ignore Seconds Flag is invoked and seconds
     regexp =  "Seconds detected in data while ignore_seconds_flag is invoked")
 
 })
+
+input <- tibble::tribble(
+  ~XXSTDTC,
+  "2019-07-18T15:25:40",
+  "2019-07-18T15:25",
+  "2019-07-18T15",
+  "2019-07-18",
+  "2019-02",
+  "2019",
+  "2019---07"
+)
+
+test_that("Partial date imputation as MID and preserve = TRUE to the mid day/month", { # nolint
+
+  expected_output <- tibble::tribble(
+      ~XXSTDTC, ~ASTDTM, ~ASTDTF, ~ASTTMF,
+      "2019-07-18T15:25:40", ymd_hms("2019-07-18T15:25:40"), NA_character_, NA_character_,
+      "2019-07-18T15:25", ymd_hms("2019-07-18T15:25:00"), NA_character_, "S",
+      "2019-07-18T15", ymd_hms("2019-07-18T15:00:00"), NA_character_, "M",
+      "2019-07-18", ymd_hms("2019-07-18T00:00:00"), NA_character_, "H",
+      "2019-02", ymd_hms("2019-02-15T00:00:00"), "D", "H",
+      "2019", ymd_hms("2019-06-30T00:00:00"), "M", "H",
+      "2019---07", ymd_hms("2019-06-07T00:00:00"), "M", "H"
+    ) %>%
+      mutate(ASTDTM = as_iso_dtm(ASTDTM))
+
+    actual_output <- derive_vars_dtm(
+      input,
+      new_vars_prefix = "AST",
+      dtc = XXSTDTC,
+      date_imputation = "MID",
+      preserve = TRUE
+    )
+
+    expect_equal(
+      expected_output,
+      actual_output
+    )
+
+  })