[Feature Request]: Improve code reproducibility in merges

[osenan]

Feature description

If we use teal.report to reproduce the qenv code, we find small diferences between teal.transform merging functions and teal.picks. Lets see in this example.

First an app that is using teal.transform

library(teal.modules.clinical)

custom_tm_arm_var_transform <- function(
  arm_var = teal.transform::data_extract_spec(
    dataname = "ADSL",
    select = teal.transform::select_spec(
      choices = c("ARM", "ARMCD"),
      selected = "ARM",
      multiple = FALSE,
      fixed = FALSE
    )
  ),
  term_var = teal.transform::data_extract_spec(
    dataname = "ADCM",
    select = teal.transform::select_spec(
      choices = "CMDECOD",
      selected = "CMDECOD",
      multiple = FALSE,
      fixed = TRUE
    )
  ),
  seq_var = teal.transform::data_extract_spec(
    dataname = "ADCM",
    select = teal.transform::select_spec(
      choices = "CMSEQ",
      selected = "CMSEQ",
      multiple = FALSE,
      fixed = TRUE
    )
  )
) {
  checkmate::assert_class(arm_var, "data_extract_spec")
  checkmate::assert_class(term_var, "data_extract_spec")
  checkmate::assert_class(seq_var, "data_extract_spec")

  ui_fun <- function(id, arm_var, term_var, seq_var) {
    ns <- shiny::NS(id)
    teal.widgets::standard_layout(
      output = shiny::tableOutput(ns("table")),
      encoding = shiny::tags$div(
        shiny::tags$label("Encodings", class = "text-primary"),
        shiny::tags$br(),
        teal.transform::datanames_input(list(arm_var = arm_var, term_var = term_var, seq_var = seq_var)),
        teal.transform::data_extract_ui(
          id = ns("arm_var"),
          label = "Treatment variable",
          data_extract_spec = arm_var
        ),
        teal.transform::data_extract_ui(
          id = ns("term_var"),
          label = "Term variable",
          data_extract_spec = term_var
        ),
        teal.transform::data_extract_ui(
          id = ns("seq_var"),
          label = "Sequence variable",
          data_extract_spec = seq_var
        ),
        teal.widgets::optionalSelectInput(
          inputId = ns("n_rows"),
          label = "Rows to display",
          choices = c(10, 20, 30),
          selected = 20,
          multiple = FALSE,
          fixed = FALSE
        )
      )
    )
  }

  server_fun <- function(id, data, arm_var, term_var, seq_var) {
    shiny::moduleServer(id, function(input, output, session) {
      selector_list <- teal.transform::data_extract_multiple_srv(
        data_extract = list(arm_var = arm_var, term_var = term_var, seq_var = seq_var),
        datasets = data,
        select_validation_rule = list(
          arm_var = shinyvalidate::sv_required("Please select a treatment variable")
        )
      )

      anl_inputs <- teal.transform::merge_expression_srv(
        datasets = data,
        join_keys = teal.data::join_keys(data),
        selector_list = selector_list,
        merge_function = "dplyr::left_join"
      )

      result_q <- shiny::reactive({
        obj <- data()
        teal.reporter::teal_card(obj) <- c(
          teal.reporter::teal_card(obj),
          teal.reporter::teal_card("## Module's output(s)")
        )

        obj <- teal.code::eval_code(obj, as.expression(anl_inputs()$expr))

        arm_col <- as.vector(anl_inputs()$columns_source$arm_var)
        term_col <- as.vector(anl_inputs()$columns_source$term_var)
        seq_col <- as.vector(anl_inputs()$columns_source$seq_var)
        n_rows <- as.integer(input$n_rows %||% 20)

        code <- substitute(
          expr = {
            table <- ANL %>%
              dplyr::distinct() %>%
              utils::head(n_rows)
          },
          env = list(arm_col = arm_col, term_col = term_col, seq_col = seq_col, n_rows = n_rows)
        )

        obj <- teal.code::eval_code(obj, as.expression(code))
        teal.reporter::teal_card(obj) <- c(teal.reporter::teal_card(obj), "### Table")
        obj
      })

      output$table <- shiny::renderTable(result_q()[["table"]], rownames = FALSE)

      result_q
    })
  }

  teal::module(
    label = "Custom Transform Arm Module",
    ui = ui_fun,
    ui_args = list(arm_var = arm_var, term_var = term_var, seq_var = seq_var),
    server = server_fun,
    server_args = list(arm_var = arm_var, term_var = term_var, seq_var = seq_var),
    datanames = c("ADSL", "ADCM")
  )
}

data <- teal.data::teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADCM <- tmc_ex_adcm
})
teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)]
adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
teal.data::join_keys(data)["ADCM", "ADCM"] <- adcm_keys

app <- teal::init(
  data = data,
  modules = teal::modules(
    custom_tm_arm_var_transform(
      arm_var = teal.transform::data_extract_spec(
        dataname = "ADSL",
        select = teal.transform::select_spec(
          choices = c("ARM", "ARMCD"),
          selected = "ARM",
          multiple = FALSE,
          fixed = FALSE
        )
      )
    )
  )
)

if (interactive()) {
  shiny::shinyApp(app$ui, app$server)
}

The reproducible code is:

ADSL <- tmc_ex_adsl
ADCM <- tmc_ex_adcm
stopifnot(rlang::hash(ADSL) == "a5ae18b41288b967988d7c260b5fb4f6") # @linksto ADSL
stopifnot(rlang::hash(ADCM) == "d25d56ea0b515edf76027c33b4a3eea3") # @linksto ADCM
.raw_data <- list2env(list(ADSL = ADSL, ADCM = ADCM))
lockEnvironment(.raw_data) # @linksto .raw_data
ADCM <- dplyr::inner_join(x = ADCM, y = ADSL[, c("STUDYID", "USUBJID"), drop = FALSE], by = c("STUDYID", "USUBJID"))
library(magrittr)
ANL_1 <- ADSL %>% dplyr::select(STUDYID, USUBJID, ARM)
ANL_2 <- ADCM %>% dplyr::select(STUDYID, USUBJID, CMDECOD, CMSEQ)
ANL <- ANL_1
ANL <- dplyr::left_join(ANL, ANL_2, by = c("STUDYID", "USUBJID"))
ANL <- ANL %>% teal.data::col_relabel(ARM = "Description of Planned Arm", CMDECOD = "Standardized Medication Name", CMSEQ = "Sponsor-Defined Identifier")
table <- ANL %>% dplyr::distinct() %>% utils::head(20L)

Now see a similar app using teal.picks

library(teal.modules.clinical)

custom_tm_arm_var_picks <- function(
  arm_var = teal.picks::variables(choices = c("ARM", "ARMCD"), selected = "ARM"),
  term_var = teal.picks::variables(choices = "CMDECOD", selected = "CMDECOD", fixed = TRUE),
  seq_var = teal.picks::variables(choices = "CMSEQ", selected = "CMSEQ", fixed = TRUE)
) {
  checkmate::assert_class(arm_var, "variables")
  checkmate::assert_class(term_var, "variables")
  checkmate::assert_class(seq_var, "variables")

  arm_var <- create_picks_helper(teal.picks::datasets("ADSL", "ADSL"), arm_var)
  term_var <- create_picks_helper(teal.picks::datasets("ADCM", "ADCM"), term_var)
  seq_var <- create_picks_helper(teal.picks::datasets("ADCM", "ADCM"), seq_var)

  ui_fun <- function(id, arm_var, term_var, seq_var) {
    ns <- shiny::NS(id)
    teal.widgets::standard_layout(
      output = shiny::tableOutput(ns("table")),
      encoding = shiny::tags$div(
        shiny::tags$label("Encodings", class = "text-primary"),
        shiny::tags$br(),
        shiny::tags$label("Treatment variable"),
        teal.picks::picks_ui(ns("arm_var"), arm_var),
        shiny::tags$label("Term variable"),
        teal.picks::picks_ui(ns("term_var"), term_var),
        shiny::tags$label("Sequence variable"),
        teal.picks::picks_ui(ns("seq_var"), seq_var)
      )
    )
  }

  server_fun <- function(id, data, arm_var, term_var, seq_var) {
    shiny::moduleServer(id, function(input, output, session) {
      selectors <- teal.picks::picks_srv(
        id = "",
        picks = list(arm_var = arm_var, term_var = term_var, seq_var = seq_var),
        data = data
      )

      data_with_card <- shiny::reactive({
        obj <- data()
        teal.reporter::teal_card(obj) <- c(
          teal.reporter::teal_card(obj),
          teal.reporter::teal_card("## Module's output(s)")
        )
        obj
      })

      merged <- teal.picks::merge_srv(
        id = "merge_anl",
        data = data_with_card,
        selectors = selectors,
        output_name = "ANL"
      )

      result_q <- shiny::reactive({
        obj <- merged$data()
        arm_col <- selectors$arm_var()$variables$selected
        term_col <- selectors$term_var()$variables$selected
        seq_col <- selectors$seq_var()$variables$selected

        shiny::validate(shiny::need(length(arm_col) == 1L, "Please select one treatment variable."))

        code <- substitute(
          expr = {
            table <- ANL %>%
              dplyr::distinct() %>%
              utils::head(20)
          },
          env = list(arm_col = arm_col, term_col = term_col, seq_col = seq_col)
        )

        obj <- teal.code::eval_code(obj, as.expression(code))
        teal.reporter::teal_card(obj) <- c(teal.reporter::teal_card(obj), "### Table")
        obj
      })

      output$table <- shiny::renderTable(result_q()[["table"]], rownames = FALSE)

      result_q
    })
  }

  teal::module(
    label = "Custom Picks Arm Module",
    ui = ui_fun,
    ui_args = list(arm_var = arm_var, term_var = term_var, seq_var = seq_var),
    server = server_fun,
    server_args = list(arm_var = arm_var, term_var = term_var, seq_var = seq_var),
    datanames = c("ADSL", "ADCM")
  )
}

data <- teal.data::teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADCM <- tmc_ex_adcm
})
teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[names(data)]
adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
teal.data::join_keys(data)["ADCM", "ADCM"] <- adcm_keys

app <- teal::init(
  data = data,
  modules = teal::modules(
    custom_tm_arm_var_picks(
      arm_var = teal.picks::variables(choices = c("ARM", "ARMCD"), selected = "ARM")
    )
  )
)

if (interactive()) {
  shiny::shinyApp(app$ui, app$server)
}

The reproducible code is:

ADSL <- tmc_ex_adsl
ADCM <- tmc_ex_adcm
stopifnot(rlang::hash(ADSL) == "a5ae18b41288b967988d7c260b5fb4f6") # @linksto ADSL
stopifnot(rlang::hash(ADCM) == "d25d56ea0b515edf76027c33b4a3eea3") # @linksto ADCM
.raw_data <- list2env(list(ADSL = ADSL, ADCM = ADCM))
lockEnvironment(.raw_data) # @linksto .raw_data
ADCM <- dplyr::inner_join(x = ADCM, y = ADSL[, c("STUDYID", "USUBJID"), drop = FALSE], by = c("STUDYID", "USUBJID"))
ANL <- dplyr::select(ADSL, STUDYID, USUBJID, ARM) %>% dplyr::inner_join(y = dplyr::select(ADCM, STUDYID, USUBJID, CMDECOD, CMSEQ), by = c(STUDYID = "STUDYID", USUBJID = "USUBJID"), suffix = c("", "_ADCM"))
table <- ANL %>% dplyr::distinct() %>% utils::head(20)

There are differences in the call to magrittr library. This might done that the code fails if the pipe operator is not loaded.

Code of Conduct

• I agree to follow this project's Code of Conduct.

Contribution Guidelines

• I agree to follow this project's Contribution Guidelines.

Security Policy

• I agree to follow this project's Security Policy.

[llrs-roche]

What you are saying is that the code generated should have a library("magrittr") call or that there are some other differences on the code that make it not reproducible (inner_join then left_join vs inner_join then inner_join on teal.picks approach)?

[m7pr]

@llrs-roche

ANL <- ANL %>% teal.data::col_relabel(ARM = "Description of Planned Arm", CMDECOD = "Standardized Medication Name", CMSEQ = "Sponsor-Defined Identifier")

is missing from the second part.
@osenan you should make it more highlighted