Bug: slice_derivation() sometimes does not find objects when called from inside a function

[manciniedoardo]

What happened?

If slice_derivation() is called inside a custom function, and some of the arguments of slice_derivation() are passed through the custom function, then depending on where these arguments appear in the slices, the function cannot "find them". See reproducible example for an example of this. I cannot tell from the outset which arrangements will cause errors and which will not. I briefly checked and couldn't replicate this behaviour with any other of the higher order functions but it would be good to check in more detail.

Session Information

R version 4.2.2 Patched (2022-11-10 r83330)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04.6 LTS

Matrix products: default
BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
[3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
[5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
[7] LC_PAPER=en_US.UTF-8 LC_NAME=C
[9] LC_ADDRESS=C LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C

attached base packages:
[1] stats graphics grDevices datasets utils methods
[7] base

other attached packages:
[1] admiral_0.12.3.9007 dplyr_1.1.3
[3] pharmaversesdtm_0.1.1 testthat_3.1.7

loaded via a namespace (and not attached):
[1] tidyselect_1.2.0 remotes_2.4.2
[3] purrr_1.0.2 vctrs_0.6.4
[5] generics_0.1.3 miniUI_0.1.1.1
[7] usethis_2.1.6 htmltools_0.5.4
[9] utf8_1.2.4 rlang_1.1.2
[11] pkgbuild_1.4.0 urlchecker_1.0.1
[13] later_1.3.0 pillar_1.9.0
[15] glue_1.6.2 withr_2.5.2
[17] admiraldev_0.5.0.9000 sessioninfo_1.2.2
[19] lifecycle_1.0.4 stringr_1.5.1
[21] devtools_2.4.5 htmlwidgets_1.6.1
[23] memoise_2.0.1 callr_3.7.3
[25] fastmap_1.1.1 httpuv_1.6.9
[27] ps_1.7.2 fansi_1.0.5
[29] Rcpp_1.0.10 xtable_1.8-4
[31] renv_0.17.0 promises_1.2.0.1
[33] cachem_1.0.7 desc_1.4.2
[35] pkgload_1.3.2 mime_0.12
[37] fs_1.6.1 brio_1.1.3
[39] hms_1.1.3 digest_0.6.31
[41] stringi_1.8.1 processx_3.8.0
[43] shiny_1.7.4 rprojroot_2.0.3
[45] cli_3.6.1 tools_4.2.2
[47] magrittr_2.0.3 tibble_3.2.1
[49] profvis_0.3.7 crayon_1.5.2
[51] tidyr_1.3.0 pkgconfig_2.0.3
[53] ellipsis_0.3.2 prettyunits_1.1.1
[55] lubridate_1.9.3 timechange_0.2.0
[57] rstudioapi_0.14 R6_2.5.1
[59] compiler_4.2.2

Reproducible Example

library(admiral)
library(pharmaversesdtm)
library(dplyr, warn.conflicts = FALSE)

data("admiral_adsl")
data("ae")
data("ds")
data("ex")

adsl <- admiral_adsl

ds_ext <- derive_vars_dt(
  ds,
  dtc = DSSTDTC,
  new_vars_prefix = "DSST"
)

ex_ext <- ex %>%
  derive_vars_dtm(
    dtc = EXSTDTC,
    new_vars_prefix = "EXST"
  ) %>%
  derive_vars_dtm(
    dtc = EXENDTC,
    new_vars_prefix = "EXEN",
    time_imputation = "last"
  )

# Outside a function: this works
week_a = "WEEK 2"
week_b = "WEEK 24"

adsl %>% 
  slice_derivation(
    derivation = derive_vars_merged,
    args = params(
      new_vars = exprs(EOP01STT = "Completed"),
      missing_values = exprs(EOP01STT = "Ongoing"),
      by_vars = exprs(STUDYID, USUBJID)
    ),
    derivation_slice(
      filter = ACTARMCD %in% c("PBO"),
      args = params(
        dataset_add = ex_ext,
        filter_add = EXTRT %in% c("PLACEBO") & VISIT == week_a
      )
    ),
    derivation_slice(
      filter = TRUE,
      args = params(
        dataset_add = ex_ext,
        filter_add = !(EXTRT %in% c("PLACEBO")) & VISIT == c("WEEK 24") 
      )
    )
  )

adsl %>% 
  slice_derivation(
    derivation = derive_vars_merged,
    args = params(
      new_vars = exprs(EOP01STT = "Completed"),
      missing_values = exprs(EOP01STT = "Ongoing"),
      by_vars = exprs(STUDYID, USUBJID)
    ),
    derivation_slice(
      filter = ACTARMCD %in% c("PBO"),
      args = params(
        dataset_add = ex_ext,
        filter_add = EXTRT %in% c("PLACEBO") & VISIT == "WEEK 2"
      )
    ),
    derivation_slice(
      filter = TRUE,
      args = params(
        dataset_add = ex_ext,
        filter_add = !(EXTRT %in% c("PLACEBO")) & VISIT == week_b 
      )
    )
  )

# Inside a function: this also works
derive_eop01stt <- function(adsl_in, ex_in){
  
  adsl_in %>% 
    slice_derivation(
      derivation = derive_vars_merged,
      args = params(
        new_vars = exprs(EOP01STT = "Completed"),
        missing_values = exprs(EOP01STT = "Ongoing"),
        by_vars = exprs(STUDYID, USUBJID)
      ),
      derivation_slice(
        filter = ACTARMCD %in% c("PBO"),
        args = params(
          dataset_add = ex_in,
          filter_add = EXTRT %in% c("PLACEBO") & VISIT == "WEEK 2"
        )
      ),
      derivation_slice(
        filter = TRUE,
        args = params(
          dataset_add = ex_ext,
          filter_add = !(EXTRT %in% c("PLACEBO")) & VISIT == "WEEK 24"
        )
      )
    ) 
}

derive_eop01stt(adsl, ex_ext)

# Inside a function: with two parameters, this arrangement works
derive_eop01stt_1 <- function(adsl_in, ex_in, week){
  
  adsl_in %>% 
    slice_derivation(
      derivation = derive_vars_merged,
      args = params(
        new_vars = exprs(EOP01STT = "Completed"),
        missing_values = exprs(EOP01STT = "Ongoing"),
        by_vars = exprs(STUDYID, USUBJID)
      ),
      derivation_slice(
        filter = ACTARMCD %in% c("PBO"),
        args = params(
          dataset_add = ex_in,
          filter_add = EXTRT %in% c("PLACEBO") & VISIT == week
        )
      ),
      derivation_slice(
        filter = TRUE,
        args = params(
          dataset_add = ex_ext,
          filter_add = !(EXTRT %in% c("PLACEBO")) & VISIT == "WEEK 24"
        )
      )
    ) 
}

derive_eop01stt_1(adsl, ex_ext, "WEEK 2")

# Inside a function: with two parameters, this arrangement does not!
derive_eop01stt_2 <- function(adsl_in, ex_in, week){
  
  adsl_in %>% 
    slice_derivation(
      derivation = derive_vars_merged,
      args = params(
        new_vars = exprs(EOP01STT = "Completed"),
        missing_values = exprs(EOP01STT = "Ongoing"),
        by_vars = exprs(STUDYID, USUBJID)
      ),
      derivation_slice(
        filter = ACTARMCD %in% c("PBO"),
        args = params(
          dataset_add = ex_in,
          filter_add = EXTRT %in% c("PLACEBO") & VISIT == "WEEK 2"
        )
      ),
      derivation_slice(
        filter = TRUE,
        args = params(
          dataset_add = ex_ext,
          filter_add = !(EXTRT %in% c("PLACEBO")) & VISIT == week
        )
      )
    ) 
}

derive_eop01stt_2(adsl, ex_ext, "WEEK 24")

Error message:

Error in `filter()`:
ℹ In argument: `!(EXTRT %in% c("PLACEBO")) & VISIT ==
  week`.
Caused by error:
! object 'week' not found

[ddsjoberg]

Well this is complicated. A couple of thoughts:

• My guess is that the error is coming from improper environment handling, e.g. the condition contains the object week but that was defined in another env that has not been passed around with the condition at its time of evaluation. Although not sure why this would be an issue when there are 3 arguments, but not 2.
• Probably the easiest way to handle to to capture these predicate conditions as quosures rather than expressions.
• I poked around a bit, I think these lines with an update could be quosures could be the correct direction. (I did briefly try this, but started running into errors from admiraldev assertions and the cross-referencing between packages was taking a while).

The line below could be updated to args <- enquos(...) which returns a named list of quosures rather than expressions (and quosures have the correct env attached).

admiral/R/call_derivation.R

Line 230 in 5c88844

args <- eval(substitute(alist(...)))

The line below could be updated to filter = assert_filter_cond(enquo(filter)) to again capture the correct environment.

admiral/R/slice_derivation.R

Line 166 in 5c88844

filter = assert_filter_cond(enexpr(filter)),

The line below constructs a call (without an attached environment) of the function to call, followed be a call to eval(). The parent.frame() is used as the envir in the eval, but if you do ls() into that environment, the week object is not there (well, nothing it there).

admiral/R/slice_derivation.R

Line 124 in 5c88844

call <- as.call(c(substitute(derivation), c(quote(data), act_args, slices[[i]]$args)))

[ddsjoberg]

I think the params() function can be updated to return a list of quosures (expressions that have the env attached). Something like this. (We'd need to update downstream processing of this object to handle the different structure, including the print method.)

params <- function(...) {
  # capture inputs -------------------------------------------------------------
  args <- rlang::enquos(...)
  
  # check inputs ---------------------------------------------------------------
  if (length(args) == 0L) {
    abort("At least one argument must be provided")
  }
  if (!rlang::is_named(args)) {
    abort("All arguments passed to `params()` must be named")
  }
  if (any(duplicated(names(args)))) {
    err_msg <- 
      sprintf(
        "The following parameters have been specified more than once: %s",
        admiraldev::enumerate(names(args)[duplicated(names(args))])
      )
    abort(err_msg)
  }
  
  # add class and return -------------------------------------------------------
  structure(args, class = c("params", "source", class(args)))
}

params(data = ADSL, var1 = AGE) |> unclass() # unclassing because the params() print method needs to also be updated
#> $data
#> <quosure>
#> expr: ^ADSL
#> env:  global
#> 
#> $var1
#> <quosure>
#> expr: ^AGE
#> env:  global

^{Created on 2023-11-27 with reprex v2.0.2}

[github-actions]

This issue is stale because it has been open for 90 days with no activity.

[bms63]

oh no the bot got us!!

@pharmaverse/admiral anyone want to dig deep!!

[manciniedoardo]

@ddsjoberg - I was wondering if you could please spare some time to tackle this? I'm recalling some comment from you a few months ago about potentially having some time now? Would be good to finally close this one out!