insightsengineering / insightsengineering/teal.transform

[Bug]: Dropping variables when merging datasets with `merge_expression_module`

Open
#262 0 comments 0 reactions 0 assignees View on GitHub
bug core
Dominant language
R
Stars
2
Forks
3
PR merge metrics
No merged PRs in 30d

Description

### What happened?

When extracting and merging from more than two data sources with `merge_expression_module` it seems like the variables selected from the third that are not part of the primary key are dropped even if they are required/selected by the app:

Details

```r
library(shiny)
library(teal.data)
library(teal.widgets)

ADSL <- data.frame(
STUDYID = "A",
USUBJID = LETTERS[1:10],
SEX = rep(c("F", "M"), 5),
AGE = rpois(10, 30),
BMRKR1 = rlnorm(10)
)
ADLB <- expand.grid(
STUDYID = "A",
USUBJID = LETTERS[1:10],
PARAMCD = c("ALT", "CRP", "IGA"),
AVISIT = c("SCREENING", "BASELINE", "WEEK 1 DAY 8", "WEEK 2 DAY 15")
)
ADLB$AVAL <- rlnorm(120)
ADLB$CHG <- rnorm(120)

data_list <- list(
ADSL = reactive(ADSL),
ADLB = reactive(ADLB),
ADAE = reactive(teal.data::rADAE)
)

join_keys <- join_keys(
join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")),
join_key("ADSL", "ADLB", c("STUDYID", "USUBJID")),
join_key("ADSL", "ADAE", c("STUDYID", "USUBJID")),
join_key("ADLB", "ADAE", c("STUDYID", "USUBJID")),
join_key("ADAE", "ADAE", c("STUDYID", "USUBJID")),
join_key("ADLB", "ADLB", c("STUDYID", "USUBJID", "PARAMCD", "AVISIT"))
)

adsl_extract <- data_extract_spec(
dataname = "ADSL",
select = select_spec(
label = "Select variable:",
choices = c("AGE", "BMRKR1"),
selected = "AGE",
multiple = TRUE,
fixed = FALSE
)
)

adlb_extract <- data_extract_spec(
dataname = "ADLB",
filter = filter_spec(vars = "PARAMCD", choices = c("ALT", "CRP", "IGA"), selected = "ALT"),
select = select_spec(
label = "Select variable:",
choices = c("AVAL", "CHG"),
selected = "AVAL",
multiple = TRUE,
fixed = FALSE
)
)
adae_extract <- data_extract_spec(
dataname = "ADAE",
select = select_spec(
label = "Select variable:",
choices = c("RACE", "ETHNIC"),
selected = "RACE",
multiple = TRUE,
fixed = FALSE
)
)

ui <- bslib::page_fluid(
bslib::layout_sidebar(
tags$div(
verbatimTextOutput("expr"),
dataTableOutput("data")
),
sidebar = tagList(
data_extract_ui("adsl_var", label = "ADSL selection", adsl_extract),
data_extract_ui("adlb_var", label = "ADLB selection", adlb_extract),
data_extract_ui("adae_var", label = "ADAE selection", adae_extract)
)
)
)

server <- function(input, output, session) {
data_q <- qenv()

data_q <- eval_code(
data_q,
"ADSL <- data.frame(
STUDYID = 'A',
USUBJID = LETTERS[1:10],
SEX = rep(c('F', 'M'), 5),
AGE = rpois(10, 30),
BMRKR1 = rlnorm(10)
)"
)

data_q <- eval_code(
data_q,
"ADLB <- expand.grid(
STUDYID = 'A',
USUBJID = LETTERS[1:10],
PARAMCD = c('ALT', 'CRP', 'IGA'),
AVISIT = c('SCREENING', 'BASELINE', 'WEEK 1 DAY 8', 'WEEK 2 DAY 15'),
AVAL = rlnorm(120),
CHG = rlnorm(120)
)"
)

data_q <- within(data_q, {
ADAE <- teal.data::rADAE
})

merged_data <- merge_expression_module(
data_extract = list(adsl_var = adsl_extract,
adlb_var = adlb_extract,
adae_bar = adae_extract),
datasets = data_list,
join_keys = join_keys,
merge_function = "dplyr::left_join"
)

code_merge <- reactive({
for (exp in merged_data()$expr) data_q <- eval_code(data_q, exp)
data_q
})

output$expr <- renderText(paste(merged_data()$expr, collapse = "\n"))
output$data <- renderDataTable(code_merge()[["ANL"]])
}

if (interactive()) {
shinyApp(ui, server)
}
```


Code/expression generated by the function:

```r
ANL_1 <- ADSL %>% dplyr::select(STUDYID, USUBJID, AGE)
ANL_2 <- ADLB %>% dplyr::filter(PARAMCD == "ALT") %>% dplyr::select(STUDYID, USUBJID, AVAL)
ANL_3 <- ADAE %>% dplyr::select(STUDYID, USUBJID) # RACE is selected by the APP
ANL <- ANL_1
ANL <- dplyr::left_join(ANL, ANL_2, by = c("STUDYID", "USUBJID"))
ANL <- dplyr::left_join(ANL, ANL_3, by = c("STUDYID", "USUBJID"))
```

Expected code generated by the app:

```r
ANL_1 <- ADSL %>% dplyr::select(STUDYID, USUBJID, AGE)
ANL_2 <- ADLB %>% dplyr::filter(PARAMCD == "ALT") %>% dplyr::select(STUDYID, USUBJID, AVAL)
ANL_3 <- ADAE # Or %>% dplyr::select(STUDYID, USUBJID, RACE)
ANL <- ANL_1
ANL <- dplyr::left_join(ANL, ANL_2, by = c("STUDYID", "USUBJID"))
ANL <- dplyr::left_join(ANL, ANL_3, by = c("STUDYID", "USUBJID"))
```

While it is labeled as experimental I saw it first mentioned in teal.transform 0.2.0 (which I don't know how long ago it was) but it is clearly used across the framework for example in TMC modules (where I found it while developing a new module)

### sessionInfo()

```R

```

### Relevant log output

```R

```

### 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

Open the contributing guide

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.