Closes #2112 add type to functions downstream of compute_duration() (…

…#2118) * feat: #2112 add type to fxns downstream of compute_duration * feat: #2112 add test type argument for derive_vars_duration * styler and lintr * chore: #2112 adopt feedback * chore: #2112 add upversion on DESCRIPTION * chore: #2112 try inheritParams * chore: #2112 remove mention of default --------- Co-authored-by: Zelos Zhu <[email protected]>
pharmaverse · Sep 22, 2023 · b3dabbd · b3dabbd
1 parent 86c3da9
commit b3dabbd
Show file tree

Hide file tree

Showing 7 changed files with 172 additions and 31 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: admiral
 Type: Package
 Title: ADaM in R Asset Library
-Version: 0.12.0
+Version: 0.12.1
 Authors@R: c(
     person("Ben", "Straub", email = "[email protected]", role = c("aut", "cre")),
     person("Stefan", "Bundfuss", role = "aut"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,22 +1,12 @@
-# admiral 1.0.0
-
-## New Features
-
-## Updates of Existing Functions
-
-- Template `ad_adpp.R` updated to replace `left_join()` with `derive_vars_merged()` (#2109).
-
-## Breaking Changes
-
-## Documentation
-
-## Various
-
 # admiral 0.12.1
 
 - `derive_extreme_records()` no longer fails if `dataset_add` is specified and a
 variable specified for `order` is not in `dataset`. (#2113)
 
+- The `type` argument in `compute_duration()` changed the underlying default behavior in `derive_vars_duration()` without allowing the user to toggle between `"duration"` and `"interval"` as originally intended. This was fixed by adding the `type` argument for `derive_vars_duration()` and a wrapper function `derive_vars_aage()` such that it gets passed through `compute_duration()` appropriately (#2112)
+
+- Template `ad_adpp.R` updated to replace `left_join()` with `derive_vars_merged()` (#2109).
+
 # admiral 0.12.0
 
 ## New Features

diff --git a/R/derive_vars_aage.R b/R/derive_vars_aage.R
@@ -4,6 +4,8 @@
 #'
 #' **Note:** This is a wrapper function for the more generic `derive_vars_duration()`.
 #'
+#' @inheritParams derive_vars_duration
+#'
 #' @param dataset Input dataset
 #'
 #'   The columns specified by the `start_date` and the `end_date` parameter are
@@ -37,12 +39,28 @@
 #'
 #' @param unit *Deprecated*, please use `age_unit` instead.
 #'
-#' @details The age is derived as the integer part of the duration from start to
-#'   end date in the specified unit. When 'years' or 'months' are specified in the `out_unit`
-#'   parameter, because of the underlying `lubridate::time_length()` function that is used
-#'   here, results are calculated based on the actual calendar length of months or years
-#'   rather than assuming equal days every month (30.4375 days) or every year (365.25 days).
+#' @details The duration is derived as time from start to end date in the
+#'   specified output unit. If the end date is before the start date, the duration
+#'   is negative. The start and end date variable must be present in the specified
+#'   input dataset.
+#'
+#'   The [lubridate](https://lubridate.tidyverse.org/) package calculates two
+#'   types of spans between two dates: duration and interval.
+#'   While these calculations are largely the same, when the unit of the time period
+#'   is month or year the result can be slightly different.
+#'
+#'   The difference arises from the ambiguity in the length of `"1 month"` or
+#'   `"1 year"`.
+#'   Months may have 31, 30, 28, or 29 days, and years are 365 days and 366 during leap years.
+#'   Durations and intervals help solve the ambiguity in these measures.
+#'
+#'   The **interval** between `2000-02-01` and `2000-03-01` is `1` (i.e. one month).
+#'   The **duration** between these two dates is `0.95`, which accounts for the fact
+#'   that the year 2000 is a leap year, February has 29 days, and the average month
+#'   length is `30.4375`, i.e. `29 / 30.4375 = 0.95`.
 #'
+#'   For additional details, review the
+#'   [lubridate time span reference page](https://lubridate.tidyverse.org/reference/timespan.html).
 #'
 #' @return The input dataset with ``AAGE`` and ``AAGEU`` added
 #'
@@ -67,7 +85,8 @@ derive_vars_aage <- function(dataset,
                              start_date = BRTHDT,
                              end_date = RANDDT,
                              unit = "years",
-                             age_unit = "years") {
+                             age_unit = "years",
+                             type = "interval") {
   if (!missing(unit)) {
     deprecate_warn("0.12.0", "derive_vars_aage(unit = )", "derive_vars_aage(age_unit = )")
     age_unit <- unit
@@ -89,7 +108,8 @@ derive_vars_aage <- function(dataset,
     end_date = !!end_date,
     out_unit = age_unit,
     add_one = FALSE,
-    trunc_out = TRUE
+    trunc_out = TRUE,
+    type = type
   )
 }
 

diff --git a/R/derive_vars_duration.R b/R/derive_vars_duration.R
@@ -72,11 +72,35 @@
 #'
 #'   Permitted Values: `TRUE`, `FALSE`
 #'
+#' @param type lubridate duration type.
+#'
+#'   See below for details.
+#'
+#'   Permitted Values: `"duration"`, `"interval"`
+#'
 #' @details The duration is derived as time from start to end date in the
 #'   specified output unit. If the end date is before the start date, the duration
 #'   is negative. The start and end date variable must be present in the specified
 #'   input dataset.
 #'
+#' The [lubridate](https://lubridate.tidyverse.org/) package calculates two
+#' types of spans between two dates: duration and interval.
+#' While these calculations are largely the same, when the unit of the time period
+#' is month or year the result can be slightly different.
+#'
+#' The difference arises from the ambiguity in the length of `"1 month"` or
+#' `"1 year"`.
+#' Months may have 31, 30, 28, or 29 days, and years are 365 days and 366 during leap years.
+#' Durations and intervals help solve the ambiguity in these measures.
+#'
+#' The **interval** between `2000-02-01` and `2000-03-01` is `1` (i.e. one month).
+#' The **duration** between these two dates is `0.95`, which accounts for the fact
+#' that the year 2000 is a leap year, February has 29 days, and the average month
+#' length is `30.4375`, i.e. `29 / 30.4375 = 0.95`.
+#'
+#' For additional details, review the
+#' [lubridate time span reference page](https://lubridate.tidyverse.org/reference/timespan.html).
+#'
 #'
 #' @return The input dataset with the duration and unit variable added
 #'
@@ -174,7 +198,8 @@ derive_vars_duration <- function(dataset,
                                  out_unit = "days",
                                  floor_in = TRUE,
                                  add_one = TRUE,
-                                 trunc_out = FALSE) {
+                                 trunc_out = FALSE,
+                                 type = "duration") {
   new_var <- assert_symbol(enexpr(new_var))
   new_var_unit <- assert_symbol(enexpr(new_var_unit), optional = TRUE)
   start_date <- assert_symbol(enexpr(start_date))
@@ -206,7 +231,8 @@ derive_vars_duration <- function(dataset,
         out_unit = out_unit,
         floor_in = floor_in,
         add_one = add_one,
-        trunc_out = trunc_out
+        trunc_out = trunc_out,
+        type = type
       )
     )
 

diff --git a/man/derive_vars_aage.Rd b/man/derive_vars_aage.Rd
diff --git a/man/derive_vars_duration.Rd b/man/derive_vars_duration.Rd
diff --git a/tests/testthat/test-derive_vars_duration.R b/tests/testthat/test-derive_vars_duration.R
@@ -1,3 +1,5 @@
+# derive_vars_duration ----
+## Test 1: Duration and unit variable are added ----
 test_that("derive_vars_duration Test 1: Duration and unit variable are added", {
   input <- tibble::tribble(
     ~USUBJID, ~BRTHDT, ~RANDDT,
@@ -23,6 +25,7 @@ test_that("derive_vars_duration Test 1: Duration and unit variable are added", {
   expect_dfs_equal(actual_output, expected_output, keys = "USUBJID")
 })
 
+## Test 2: Duration and unit variable are added ----
 test_that("derive_vars_duration Test 2: Duration and unit variable are added", {
   input <- tibble::tribble(
     ~USUBJID, ~ASTDT, ~AENDT,
@@ -48,6 +51,7 @@ test_that("derive_vars_duration Test 2: Duration and unit variable are added", {
   expect_dfs_equal(actual_output, expected_output, keys = "USUBJID")
 })
 
+## Test 3: Duration and unit variable are added ----
 test_that("derive_vars_duration Test 3: Duration and unit variable are added", {
   input <- tibble::tribble(
     ~USUBJID, ~ADTM, ~TRTSDTM,
@@ -74,3 +78,55 @@ test_that("derive_vars_duration Test 3: Duration and unit variable are added", {
 
   expect_dfs_equal(actual_output, expected_output, keys = "USUBJID")
 })
+
+## Test 4: type argument works for interval ----
+test_that("derive_vars_duration Test 4: type argument works for interval", {
+  input <- tibble::tribble(
+    ~USUBJID, ~TRTSDTM, ~TRTEDTM,
+    "P01", ymd_hms("2019-02-01T00:00:00"), ymd_hms("2019-03-01T00:00:00"),
+    "P02", ymd_hms("2020-02-01T00:00:00"), ymd_hms("2020-03-01T00:00:00")
+  )
+  actual_output <- derive_vars_duration(
+    input,
+    new_var = ADURN,
+    new_var_unit = ADURU,
+    start_date = TRTSDTM,
+    end_date = TRTEDTM,
+    in_unit = "months",
+    out_unit = "months",
+    add_one = FALSE,
+    type = "interval"
+  )
+  expected_output <- dplyr::mutate(
+    input,
+    ADURN = c(1, 1),
+    ADURU = c("MONTHS", "MONTHS")
+  )
+  expect_dfs_equal(actual_output, expected_output, keys = "USUBJID")
+})
+
+## Test 5: type argument works for duration ----
+test_that("derive_vars_duration Test 5: type argument works for duration", {
+  input <- tibble::tribble(
+    ~USUBJID, ~TRTSDTM, ~TRTEDTM,
+    "P01", ymd_hms("2019-02-01T00:00:00"), ymd_hms("2019-03-01T00:00:00"),
+    "P02", ymd_hms("2020-02-01T00:00:00"), ymd_hms("2020-03-01T00:00:00")
+  )
+  actual_output <- derive_vars_duration(
+    input,
+    new_var = ADURN,
+    new_var_unit = ADURU,
+    start_date = TRTSDTM,
+    end_date = TRTEDTM,
+    in_unit = "months",
+    out_unit = "months",
+    add_one = FALSE,
+    type = "duration"
+  )
+  expected_output <- dplyr::mutate(
+    input,
+    ADURN = c((28 / (365.25 / 12)), (29 / (365.25 / 12))),
+    ADURU = c("MONTHS", "MONTHS")
+  )
+  expect_dfs_equal(actual_output, expected_output, keys = "USUBJID")
+})