Merge pull request #27 from Merck/26-extraction-of-parameter-related-…

…variables-in-summary-function 26 extraction of parameter related variables in summary function
Merck · Jul 10, 2024 · db19b0b · db19b0b
2 parents d75b467 + 866280c
commit db19b0b
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 10 deletions.
diff --git a/R/collect.R b/R/collect.R
@@ -62,7 +62,7 @@ collect_baseline <- function(
   par_var_lower <- metalite::collect_adam_mapping(meta, parameter)$var_lower
 
   # Obtain Data
-  pop <- metalite::collect_population_record(meta, population, var = c(par_var))
+  pop <- metalite::collect_population_record(meta, population, var = c(par_var, par_var_group, par_var_lower))
 
   # Obtain ID
   pop_id <- metalite::collect_adam_mapping(meta, population)$id

diff --git a/R/meta_sl_example.R b/R/meta_sl_example.R
@@ -71,8 +71,7 @@ meta_sl_example <- function() {
     metalite::define_population(
       name = "apat",
       group = "TRTA",
-      subset = quote(SAFFL == "Y"),
-      var = c("USUBJID", "TRTA", "SAFFL", "AGEGR1", "SEX", "RACE", "EOSSTT", "EOTSTT1", "DCSREAS", "DCTREAS", "COMP8FL", "COMP16FL", "COMP24FL")
+      subset = quote(SAFFL == "Y")
     ) |>
     metalite::define_parameter(
       name = "age",
@@ -179,8 +178,7 @@ meta_sl_exposure_example <- function() {
     metalite::define_population(
       name = "apat",
       group = "TRTA",
-      subset = quote(APERIOD==1 & AVAL>0),
-      var = c("USUBJID", "TRTA", "EXDURGR", "AVAL"),
+      subset = quote(APERIOD==1 & AVAL>0)
     ) |>
     metalite::define_parameter(
       name = "expdur",

diff --git a/R/prepare_sl_summary.R b/R/prepare_sl_summary.R
@@ -43,16 +43,26 @@ prepare_sl_summary <- function(
   # obtain variables
   pop_var <- metalite::collect_adam_mapping(meta, population)$var
   obs_var <- metalite::collect_adam_mapping(meta, observation)$var
-  par_var <- metalite::collect_adam_mapping(meta, parameter)$var
+  par_var <- do.call(c, lapply(parameters, function(x) {
+    metalite::collect_adam_mapping(meta, x)$var
+  }))
 
+  par_var_group <- do.call(c, lapply(parameters, function(x) {
+    metalite::collect_adam_mapping(meta, x)$vargroup
+  }))
+
+  par_var_lower <- do.call(c, lapply(parameters, function(x) {
+    metalite::collect_adam_mapping(meta, x)$var_lower
+  }))
+
   pop_group <- metalite::collect_adam_mapping(meta, population)$group
   obs_group <- metalite::collect_adam_mapping(meta, observation)$group
 
   pop_id <- metalite::collect_adam_mapping(meta, population)$id
   obs_id <- metalite::collect_adam_mapping(meta, observation)$id
 
   # obtain data
-  pop <- metalite::collect_population_record(meta, population, var = pop_var)
+  pop <- metalite::collect_population_record(meta, population, var = c(par_var, par_var_group, par_var_lower))
 
   # obtain group names
   group <- unique(pop[[pop_group]])
@@ -75,9 +85,7 @@ prepare_sl_summary <- function(
 
   # Get the baseline characteristics variables in adsl
   # char_var <- collect_adam_mapping(meta, analysis)$var_name
-  char_var <- do.call(c, lapply(parameters, function(x) {
-    metalite::collect_adam_mapping(meta, x)$var
-  }))
+  char_var <- par_var
 
   # Get the baseline characteristics counts
   char_n <- lapply(parameters, function(x) {