insightsengineering / insightsengineering/teal.picks
[Feature Request]: Improve code reproducibility in merges
- Dominant language
- R
- Stars
- 4
- Forks
- 0
- Avg merge
- 6d 11h
- Merged PRs (30d)
- 3
Description
### 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
- [x] I agree to follow this project's Code of Conduct.
### Contribution Guidelines
- [x] I agree to follow this project's Contribution Guidelines.
### Security Policy
- [x] I agree to follow this project's Security Policy.
Contributor guide
Assessment
This issue has not been assessed yet.