if_then_else support via "conditioned" data frames

DESCRIPTION

@@ -46,7 +46,8 @@ Imports:
     tibble,
     vctrs,
     readr,
-    glue
+    glue,
+    pillar
 Suggests:
     knitr,
     rmarkdown,

NAMESPACE

@@ -1,10 +1,14 @@
 # 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(assign_ct)
 export(assign_datetime)
 export(assign_no_ct)
 export(clear_cache)
+export(condition_by)
 export(create_iso8601)
 export(ct_map)
 export(ct_spec_example)
@@ -16,6 +20,10 @@ export(hardcode_no_ct)
 export(problems)
 export(read_ct_spec)
 export(read_ct_spec_example)
+export(rm_cnd_df)
+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
@@ -53,29 +53,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

R/assign_datetime.R

@@ -170,27 +170,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())
   }