Merge from main

Merge branch 'main' into 0040_hardcode_no_ct

# Conflicts:
#	DESCRIPTION
#	NAMESPACE
#	inst/WORDLIST

.github/workflows/common.yml

@@ -90,7 +90,7 @@ jobs:
     if: >
       github.event_name != 'release'
     with:
-      r-version: "4.3"
+      r-version: "release"
       # Whether to skip code coverage badge creation
       # Setting to 'false' will require you to create
       # an orphan branch called 'badges' in your repository

DESCRIPTION

@@ -24,7 +24,7 @@ Description: An EDC and Data Standard-agnostic SDTM data transformation engine
     automate the conversion of raw clinical data to SDTM through standardized
     mapping  algorithms. SDTM is one of the required standards for data
     submission to  FDA (U.S.) and PMDA (Japan). SDTM standards are implemented
-    in accordance with the SDTM Implementation guide as defined by CDISC
+    in accordance with the SDTM Implementation Guide as defined by CDISC
     <https://www.cdisc.org/standards/foundational/sdtmig>.
 Language: en-US
 License: Apache License (>= 2)
@@ -39,6 +39,7 @@ Imports:
     admiraldev,
     dplyr (>= 1.0.0),
     memoise,
+    assertthat,
     purrr (>= 0.3.3),
     rlang (>= 0.4.4),
     stringr (>= 1.4.0),

NAMESPACE

@@ -6,6 +6,7 @@ export(assign_no_ct)
 export(clear_cache)
 export(create_iso8601)
 export(ct_map)
+export(derive_study_day)
 export(fmt_cmp)
 export(hardcode_ct)
 export(hardcode_no_ct)

R/derive_study_day.R

@@ -0,0 +1,132 @@
+#' `derive_study_day` performs study day calculation
+#' @description
+#' This function takes the an input data frame and a reference data frame (which
+#' is DM domain in most cases), and calculate the study day from reference date
+#' and target date. In case of unexpected conditions like reference date is not
+#' unique for each patient, or reference and input dates are not actual dates,
+#' NA will be returned for those records.
+#'
+#' @param sdtm_in Input data frame that contains the target date.
+#' @param dm_domain Reference date frame that contains the reference date.
+#' @param tgdt Target date from `sdtm_in` that will be used to calculate the study
+#' day.
+#' @param refdt Reference date from `dm_domain` that will be used as reference to
+#' calculate the study day.
+#' @param study_day_var New study day variable name in the output. For
+#' example, AESTDY for AE domain and CMSTDY for CM domain.
+#' @param merge_key Character to represent the merging key between `sdtm_in` and
+#' `dm_domain`.
+#'
+#' @return Data frame that takes all columns from `sdtm_in` and a new variable
+#' to represent the calculated study day.
+#'
+#' @export
+#'
+#' @examples
+#' ae <- data.frame(
+#'   USUBJID = c("study123-123", "study123-124", "study123-125"),
+#'   AESTDTC = c("2012-01-01", "2012-04-14", "2012-04-14")
+#' )
+#' dm <- data.frame(
+#'   USUBJID = c("study123-123", "study123-124", "study123-125"),
+#'   RFSTDTC = c("2012-02-01", "2012-04-14", NA)
+#' )
+#' ae$AESTDTC <- as.Date(ae$AESTDTC)
+#' dm$RFSTDTC <- as.Date(dm$RFSTDTC)
+#' derive_study_day(ae, dm, "AESTDTC", "RFSTDTC", "AESTDY")
+#'
+derive_study_day <- function(sdtm_in,
+                             dm_domain,
+                             tgdt,
+                             refdt,
+                             study_day_var,
+                             merge_key = "USUBJID") {
+  assertthat::assert_that(is.data.frame(sdtm_in))
+  assertthat::assert_that(is.data.frame(dm_domain))
+  assertthat::assert_that(
+    utils::hasName(dm_domain, refdt),
+    msg = "dm_domain needs to have the variable of refdt."
+  )
+  assertthat::assert_that(
+    utils::hasName(sdtm_in, tgdt),
+    msg = "sdtm_in needs to have the variable of tgdt."
+  )
+  assertthat::assert_that(
+    utils::hasName(dm_domain, merge_key),
+    msg = "dm_domain needs to have the variable of merge_key."
+  )
+  assertthat::assert_that(
+    utils::hasName(sdtm_in, merge_key),
+    msg = "sdtm_in needs to have the variable of merge_key."
+  )
+  assertthat::assert_that(is.character(study_day_var))
+  # check tgdt and study_day_var matching, for example, CMSTDTC matches CMSTDY
+  if (gsub("DTC", "", tgdt, fixed = TRUE) != gsub("DY", "", study_day_var, fixed = TRUE)) {
+    warning(
+      "Target date and the returned study day doesn't match. ",
+      "Expecting matching date and study day, for example, CMENDTC and CMENDY"
+    )
+  }
+
+  original_variables <- names(sdtm_in)
+
+  if (!identical(sdtm_in, dm_domain)) {
+    dm_domain <- unique(dm_domain[c(merge_key, refdt)])
+
+    check_refdt_uniqueness <- dm_domain |>
+      dplyr::group_by(dplyr::pick({{ merge_key }})) |>
+      dplyr::filter(dplyr::n() > 1L)
+    if (nrow(check_refdt_uniqueness) > 0L) {
+      warning(
+        "Reference date is not unique for each patient! ",
+        "Patient without unique reference date will be ingored. ",
+        "NA will be returned for such records."
+      )
+      dm_domain <- dm_domain[
+        !dm_domain[[merge_key]] %in% check_refdt_uniqueness[[merge_key]],
+      ]
+    }
+
+    sdtm_in <- sdtm_in |>
+      dplyr::left_join(
+        dm_domain,
+        by = merge_key
+      )
+  }
+
+  # refdt/tgdt should be in ISO format, otherwise throw warning
+  sdtm_in[[refdt]] <- tryCatch(
+    as.Date(sdtm_in[[refdt]], "%Y-%m-%d"),
+    error = function(e) {
+      warning(
+        "Encountered errors when converting refdt to dates. ",
+        "The warning message is ",
+        e$message,
+        call. = FALSE
+      )
+      NA
+    }
+  )
+  sdtm_in[[tgdt]] <- tryCatch(
+    as.Date(sdtm_in[[tgdt]], "%Y-%m-%d"),
+    error = function(e) {
+      warning(
+        "Encountered errors when converting tgdt to dates. ",
+        "The warning message is ",
+        e$message,
+        call. = FALSE
+      )
+      NA
+    }
+  )
+
+  ref <- sdtm_in[[refdt]]
+  tgt <- sdtm_in[[tgdt]]
+
+  # SDTMIG 4.4.4 Use of the Study Day Variables
+  res <- ifelse(tgt >= ref, tgt - ref + 1L, tgt - ref)
+
+  sdtm_in <- sdtm_in[original_variables]
+  sdtm_in[study_day_var] <- as.integer(res)
+  return(sdtm_in)
+}

README.Rmd

@@ -13,7 +13,7 @@ knitr::opts_chunk$set(
 )
 ```
 
-# sdtm.oak
+# sdtm.oak <a href="https://pharmaverse.github.io/sdtm.oak"><img src="man/figures/logo.svg" align="right" height="139" /></a>
 
 <!-- badges: start -->
 [![CRAN status](https://www.r-pkg.org/badges/version/sdtm.oak)](https://CRAN.R-project.org/package=sdtm.oak)

README.md

@@ -1,7 +1,7 @@
 
 <!-- README.md is generated from README.Rmd. Please edit that file -->
 
-# sdtm.oak
+# sdtm.oak <a href="https://pharmaverse.github.io/sdtm.oak"><img src="man/figures/logo.svg" align="right" height="139" /></a>
 
 <!-- badges: start -->
 

inst/WORDLIST

@@ -7,6 +7,8 @@ dtc
 funder
 vectorized
 ORCID
+PMDA
+CDISC
 iso
 hardcoded
 CDISC
@@ -19,3 +21,7 @@ tibble
 codelist
 Memoised
 memoised
+AE
+AESTDY
+CMSTDY
+DM