if_then_else support via "conditioned" data frames

DESCRIPTION

@@ -46,9 +46,12 @@ Imports:
     tibble,
     vctrs,
     readr,
-    glue
+    glue,
+    pillar
 Suggests:
     knitr,
+    lifecycle,
+    magrittr,
     rmarkdown,
     spelling,
     testthat (>= 3.1.7)

NAMESPACE

@@ -1,10 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(ctl_new_rowid_pillar,cnd_df)
+S3method(mutate,cnd_df)
 S3method(print,iso8601)
+S3method(tbl_sum,cnd_df)
+export("%.>%")
 export(assign_ct)
 export(assign_datetime)
 export(assign_no_ct)
 export(clear_cache)
+export(condition_add)
 export(create_iso8601)
 export(ct_map)
 export(ct_spec_example)
@@ -13,9 +18,13 @@ export(derive_study_day)
 export(fmt_cmp)
 export(hardcode_ct)
 export(hardcode_no_ct)
+export(oak_id_vars)
 export(problems)
 export(read_ct_spec)
 export(read_ct_spec_example)
+importFrom(dplyr,mutate)
+importFrom(pillar,ctl_new_rowid_pillar)
+importFrom(pillar,tbl_sum)
 importFrom(rlang,"%||%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

R/assertions.R

@@ -0,0 +1,16 @@
+# Surprisingly, admiraldev doesn't provide `assert_logical_vector`.
+assert_logical_vector <- function(arg, optional = FALSE) {
+  if (optional && is.null(arg)) {
+    return(invisible(arg))
+  }
+
+  if (!is.logical(arg)) {
+    err_msg <- sprintf(
+      "`arg` must be a logical vector but is %s.",
+      admiraldev::what_is_it(arg)
+    )
+    rlang::abort(err_msg)
+  }
+
+  invisible(arg)
+}

R/assign.R

@@ -21,7 +21,7 @@
 #'   the variables indicated in `id_vars`. This parameter is optional, see
 #'   section Value for how the output changes depending on this argument value.
 #' @param id_vars Key variables to be used in the join between the raw dataset
-#'   (`raw_dat`) and the target data set (`raw_dat`).
+#'   (`raw_dat`) and the target data set (`tgt_dat`).
 #'
 #' @returns The returned data set depends on the value of `tgt_dat`:
 #' - If no target dataset is supplied, meaning that `tgt_dat` defaults to
@@ -35,13 +35,14 @@
 #'
 #' @importFrom rlang :=
 #' @keywords internal
-sdtm_assign <- function(raw_dat,
-                        raw_var,
+sdtm_assign <- function(tgt_dat = NULL,
                         tgt_var,
+                        raw_dat,
+                        raw_var,
                         ct_spec = NULL,
                         ct_clst = NULL,
-                        tgt_dat = NULL,
                         id_vars = oak_id_vars()) {
+
   admiraldev::assert_character_scalar(raw_var)
   admiraldev::assert_character_scalar(tgt_var)
   admiraldev::assert_character_vector(id_vars)
@@ -53,29 +54,19 @@ sdtm_assign <- function(raw_dat,
   assert_ct_spec(ct_spec, optional = TRUE)
   assert_ct_clst(ct_spec = ct_spec, ct_clst = ct_clst, optional = TRUE)
 
-  # Recode the raw variable following terminology.
-  tgt_val <- ct_map(raw_dat[[raw_var]], ct_spec = ct_spec, ct_clst = ct_clst)
-
-  # Apply derivation by assigning `raw_var` to `tgt_var`.
-  # `der_dat`: derived dataset.
-  der_dat <-
+  join_dat <-
     raw_dat |>
-    dplyr::select(c(id_vars, raw_var)) |>
-    dplyr::mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter()
-    dplyr::select(-rlang::sym(raw_var))
+    dplyr::select(dplyr::all_of(c(id_vars, raw_var))) |>
+    sdtm_join(tgt_dat = tgt_dat, id_vars = id_vars)
+
+  # Recode the raw variable following terminology.
+  tgt_val <- ct_map(join_dat[[raw_var]], ct_spec = ct_spec, ct_clst = ct_clst)
 
-  # If a target dataset is supplied, then join the so far derived dataset with
-  # the target dataset (`tgt_dat`), otherwise leave it be.
-  der_dat <-
-    if (!is.null(tgt_dat)) {
-      der_dat |>
-        dplyr::right_join(y = tgt_dat, by = id_vars) |>
-        dplyr::relocate(tgt_var, .after = dplyr::last_col())
-    } else {
-      der_dat
-    }
+  join_dat |>
+    mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter()
+    dplyr::select(-dplyr::any_of(setdiff(raw_var, tgt_var))) |>
+    dplyr::relocate(dplyr::all_of(tgt_var), .after = dplyr::last_col())
 
-  der_dat
 }
 
 #' Derive an SDTM variable
@@ -127,9 +118,9 @@ sdtm_assign <- function(raw_dat,
 #'   )
 #'
 #' assign_no_ct(
-#'   raw_dat = md1,
-#'   raw_var = "MDIND",
 #'   tgt_var = "CMINDC",
+#'   raw_dat = md1,
+#'   raw_var = "MDIND"
 #' )
 #'
 #' cm_inter <-
@@ -175,12 +166,12 @@ sdtm_assign <- function(raw_dat,
 #' (ct_spec <- read_ct_spec_example("ct-01-cm"))
 #'
 #' assign_ct(
+#'   tgt_dat = cm_inter,
+#'   tgt_var = "CMINDC",
 #'   raw_dat = md1,
 #'   raw_var = "MDIND",
-#'   tgt_var = "CMINDC",
 #'   ct_spec = ct_spec,
-#'   ct_clst = "C66729",
-#'   tgt_dat = cm_inter
+#'   ct_clst = "C66729"
 #' )
 #'
 #' @name assign
@@ -189,11 +180,12 @@ NULL
 #' @order 1
 #' @export
 #' @rdname assign
-assign_no_ct <- function(raw_dat,
-                         raw_var,
+assign_no_ct <- function(tgt_dat = NULL,
                          tgt_var,
-                         tgt_dat = NULL,
+                         raw_dat,
+                         raw_var,
                          id_vars = oak_id_vars()) {
+
   admiraldev::assert_character_scalar(raw_var)
   admiraldev::assert_character_scalar(tgt_var)
   admiraldev::assert_character_vector(id_vars)
@@ -204,24 +196,25 @@ assign_no_ct <- function(raw_dat,
   admiraldev::assert_data_frame(tgt_dat, required_vars = rlang::syms(id_vars), optional = TRUE)
 
   sdtm_assign(
+    tgt_dat = tgt_dat,
+    tgt_var = tgt_var,
     raw_dat = raw_dat,
     raw_var = raw_var,
-    tgt_var = tgt_var,
-    tgt_dat = tgt_dat,
     id_vars = id_vars
   )
 }
 
 #' @order 2
 #' @export
 #' @rdname assign
-assign_ct <- function(raw_dat,
-                      raw_var,
+assign_ct <- function(tgt_dat = NULL,
                       tgt_var,
+                      raw_dat,
+                      raw_var,
                       ct_spec,
                       ct_clst,
-                      tgt_dat = NULL,
                       id_vars = oak_id_vars()) {
+
   admiraldev::assert_character_scalar(raw_var)
   admiraldev::assert_character_scalar(tgt_var)
   admiraldev::assert_character_vector(id_vars)
@@ -232,10 +225,10 @@ assign_ct <- function(raw_dat,
   admiraldev::assert_data_frame(tgt_dat, required_vars = rlang::syms(id_vars), optional = TRUE)
 
   sdtm_assign(
+    tgt_dat = tgt_dat,
+    tgt_var = tgt_var,
     raw_dat = raw_dat,
     raw_var = raw_var,
-    tgt_var = tgt_var,
-    tgt_dat = tgt_dat,
     id_vars = id_vars,
     ct_spec = ct_spec,
     ct_clst = ct_clst

R/assign_datetime.R

@@ -61,11 +61,11 @@
 #' # indicating that these values are missing/unknown (unk).
 #' cm1 <-
 #'   assign_datetime(
+#'     tgt_var = "CMSTDTC",
 #'     raw_dat = md1,
 #'     raw_var = "MDBDR",
 #'     raw_fmt = "d-m-y",
-#'     raw_unk = c("UN", "UNK"),
-#'     tgt_var = "CMSTDTC"
+#'     raw_unk = c("UN", "UNK")
 #'   )
 #'
 #' cm1
@@ -120,11 +120,11 @@
 #' # data set `cm_inter`.
 #' cm2 <-
 #'   assign_datetime(
+#'     tgt_dat = cm_inter,
+#'     tgt_var = "CMSTDTC",
 #'     raw_dat = md1,
 #'     raw_var = "MDBDR",
-#'     raw_fmt = "d-m-y",
-#'     tgt_var = "CMSTDTC",
-#'     tgt_dat = cm_inter
+#'     raw_fmt = "d-m-y"
 #'   )
 #'
 #' cm2
@@ -137,11 +137,11 @@
 #' # MDETM (correspondence is by positional matching).
 #' cm3 <-
 #'   assign_datetime(
+#'     tgt_var = "CMSTDTC",
 #'     raw_dat = md1,
 #'     raw_var = c("MDEDR", "MDETM"),
 #'     raw_fmt = c("d-m-y", "H:M:S"),
-#'     raw_unk = c("UN", "UNK"),
-#'     tgt_var = "CMSTDTC"
+#'     raw_unk = c("UN", "UNK")
 #'   )
 #'
 #' cm3
@@ -151,14 +151,15 @@
 #'
 #' @export
 assign_datetime <-
-  function(raw_dat,
+  function(tgt_dat = NULL,
+           tgt_var,
+           raw_dat,
            raw_var,
            raw_fmt,
-           tgt_var,
            raw_unk = c("UN", "UNK"),
-           tgt_dat = NULL,
            id_vars = oak_id_vars(),
            .warn = TRUE) {
+
     admiraldev::assert_character_vector(raw_var)
     admiraldev::assert_character_scalar(tgt_var)
     admiraldev::assert_character_vector(id_vars)
@@ -170,27 +171,20 @@ assign_datetime <-
     admiraldev::assert_character_vector(raw_unk)
     admiraldev::assert_logical_scalar(.warn)
 
-    tgt_val <-
-      create_iso8601(!!!raw_dat[raw_var],
-        .format = raw_fmt,
-        .na = raw_unk,
-        .warn = .warn
-      )
-
-    der_dat <-
+    join_dat <-
       raw_dat |>
-      dplyr::select(c(id_vars, raw_var)) |>
-      dplyr::mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter()
-      dplyr::select(-raw_var)
+      dplyr::select(dplyr::all_of(c(id_vars, raw_var))) |>
+      sdtm_join(tgt_dat = tgt_dat, id_vars = id_vars)
 
-    der_dat <-
-      if (!is.null(tgt_dat)) {
-        der_dat |>
-          dplyr::right_join(y = tgt_dat, by = id_vars) |>
-          dplyr::relocate(tgt_var, .after = dplyr::last_col())
-      } else {
-        der_dat
-      }
+    tgt_val <-
+      create_iso8601(!!!join_dat[raw_var],
+                     .format = raw_fmt,
+                     .na = raw_unk,
+                     .warn = .warn
+      )
 
-    der_dat
+    join_dat |>
+      mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter()
+      dplyr::select(-dplyr::any_of(setdiff(raw_var, tgt_var))) |>
+      dplyr::relocate(dplyr::all_of(tgt_var), .after = dplyr::last_col())
   }