insightsengineering / insightsengineering/teal.transform
(data_merge_module) should we provide a default main key for a single dataset
- Dominant language
- R
- Stars
- 2
- Forks
- 3
- PR merge metrics
- No merged PRs in 30d
Description
NEST/teal.devel/issues/740
Imagine this scenario:
```r
library(random.cdisc.data)
library(teal.modules.general)
iris <- iris
app <- init(
data = teal_data(
dataset("iris", iris, code = "iris <- iris"),
check = TRUE
),
modules = root_modules(
tm_g_scatterplot(
label = "Scatterplot Choices",
x = data_extract_spec(
dataname = "iris",
select = select_spec(
label = "Select variable:",
choices = variable_choices(iris, c("Species")),
selected = "Species",
multiple = FALSE,
fixed = FALSE
),
filter = filter_spec(
vars = variable_choices("iris", subset = c("Species")),
multiple = TRUE
)
),
y = data_extract_spec(
dataname = "iris",
select = select_spec(
label = "Select variable:",
choices = variable_choices(iris, c("Petal.Length")),
selected = "Petal.Length",
multiple = FALSE,
fixed = FALSE
)
),
color_by = data_extract_spec(
dataname = "iris",
select = select_spec(
choices = variable_choices(iris),
selected = "Petal.Width",
multiple = TRUE
)
)
)
)
)
shinyApp(app$ui, app$server)
```
If we run the app, we will encounter an error about keys not being passed to the dataset, but there is only one dataset passed to the app, so the app should be able to provide a valid main key by default (e.g. row numbers).
If we implemented setting up keys automatically for a single dataset we would encounter an issue if an app developer passed a drop_keys = TRUE flag to filter_spec. This flag, when TRUE, indicates that a variable used in the filter should be dropped from keys in the proceeding join. This means the join can be performed on something different than the main key. To observe this behaviour, launch this example:
```r
unloadNamespace("teal.devel")
unloadNamespace("teal")
devtools::load_all("./teal/")
devtools::load_all("./teal.devel/")
library(shiny)
library(random.cdisc.data)
library(dplyr)
ADSL <- radsl(cached = TRUE)
ADLB <- radlb(cached = TRUE)
ADRS <- radrs(cached = TRUE)
ADTTE <- radtte(cached = TRUE)
tm_made_up_merge_pr <- function(label = "PR merge", info = NULL, dataname = NULL, data_extract, pre_output = NULL, post_output = NULL) {
args <- as.list(environment())
args$data_extract_call <- styler::style_text(
strsplit(
# Line break after every brace
gsub("\\((d|s|f)", "(\n\\1",
# Line break after each function input value definition
gsub("\\,\\s([^\\=]+\\s\\=\\s)", ",\n\\1",
paste(capture.output(match.call()$data_extract), collapse = " ")
)), split = "\n" )[[1]])
module(
label = label,
server = srv_made_up_merge_pr,
ui = ui_made_up_merge_pr,
ui_args = args,
server_args = list(dataname = dataname, data_extract = data_extract),
filters = "all"
)
}
ui_made_up_merge_pr <- function(id, ...) {
arguments <- list(...)
ns <- NS(id)
standard_layout(
output = white_small_well(
if (is.null(arguments$info)) {
NULL
} else {
tags$p(arguments$info)
},
tags$label("Merge code given in 'Show R Code':"),
tags$div(
verbatimTextOutput(ns("outtext"))
),
tags$label("Output column names:"),
tags$div(
verbatimTextOutput(ns("column_source_text"))
),
tags$label("Output keys:"),
tags$div(
verbatimTextOutput(ns("keys"))
),
tags$label("Output table (analysis data set):"),
tags$div(
dataTableOutput(ns("outtable"))
)
),
encoding = div(
lapply(
seq_along(arguments$data_extract),
function(i) {
data_extract_input(
id = ns(paste0("xyz_", i)),
label = paste0("Selector ", i),
data_extract_spec = list(arguments$data_extract[[i]])
)
}
),
# Accordion panel for specification code
panel_group(
panel_item(
"Data_extract_specification code:",
tags$pre(paste(arguments$data_extract_call, collapse = "\n"))
)
)
),
forms = div(
actionButton(ns("show_rcode"), "Show R Code", width = "100%"))
)
}
srv_made_up_merge_pr <- function(input, output, session, datasets, dataname, data_extract) {
init_chunks()
merged_data <- data_merge_module(
datasets = datasets,
data_extract = data_extract,
input_id = paste0("xyz_", seq_along(data_extract)),
merge_function = "dplyr::full_join"
)
output$column_source_text <- renderText({
source_cols <- merged_data()$columns_source
paste(unlist(lapply(names(source_cols), function (x){
paste0(x, ": ", paste(unname(source_cols[[x]]), collapse = " "),
paste0(" always_selected: ", paste(attr(source_cols[[x]],"always_selected"), collapse = " ")))
}
)), collapse = "\n")
})
output$outtext <- renderText({
merged_data()$expr
})
output$keys <- renderText({
paste(merged_data()$keys, collapse = ", ")
})
output$outtable <- renderDataTable({
print(merged_data()$data())
merged_data()$data()
})
observeEvent(input$show_rcode, {
show_rcode_modal(
title = "R Code for a Scatterplotmatrix",
rcode = get_rcode(
datasets = datasets,
merge_expression = merged_data()$expr,
title = "",
description = ""
)
)
})
}
ADLB <- mutate(ADLB, AVAL2 = 2 * AVAL)
ADTTE <- mutate(ADTTE, AVAL2 = 2 * AVAL)
app <- init(
data = cdisc_data(
cdisc_dataset("ADSL", ADSL),
cdisc_dataset("ADLB", ADLB),
cdisc_dataset("ADTTE", ADTTE),
cdisc_dataset("ADRS", ADRS)
),
modules = root_modules(
dropKeysFalse = {
tm_made_up_merge_pr(
label = "dropKeysFalse",
dataname = "ADSL",
data_extract = list(
data_extract_spec(
dataname = "ADSL",
filter = list(
filter_spec(choices_selected(variable_choices(ADSL), variable_choices(ADSL)[1], fixed = F))
),
select = select_spec(variable_choices("ADSL"))
),
data_extract_spec(
dataname = "ADSL",
select = select_spec(variable_choices("ADSL"))
)
)
)
},
dropKeysTrue = {
tm_made_up_merge_pr(
label = "dropKeysTrue",
dataname = "ADSL",
data_extract = list(
data_extract_spec(
dataname = "ADSL",
filter = list(
filter_spec(choices_selected(variable_choices(ADSL), variable_choices(ADSL)[1], fixed = F), drop_keys = T)
),
select = select_spec(variable_choices("ADSL"))
),
data_extract_spec(
dataname = "ADSL",
select = select_spec(variable_choices("ADSL"))
)
)
)
},
dropKeysIrrelevant = {
tm_made_up_merge_pr(
label = "dropKeysIrrelevant",
dataname = "ADSL",
data_extract = list(
data_extract_spec(
dataname = "ADSL",
select = select_spec(variable_choices("ADSL"))
),
data_extract_spec(
dataname = "ADSL",
select = select_spec(variable_choices("ADSL"))
)
)
)
}
)
)
shinyApp(app$ui, app$server)
```
Notice, that the join call is different in tabs dropKeysFalse and dropKeysTrue.
FALSE:
user/3166/files/87618d00-d8f0-11eb-8552-49d182be1235)
TRUE:
user/3166/files/8df00480-d8f0-11eb-88a8-4035bbea1376)
Notably, STUDYID, which is used in filter_spec is missing from the by argument.
In essence - we cannot provide the default main key if the drop_key flag is TRUE, but we can do it if the drop_key flag is FALSE. The reasoning is this:
* if the joins are always performed by the main key, we can use another main key to do them (e.g. our default)
* if the joins might be performed by something different than the main key, we cannot use another main key to do them
The discussion should probably be about:
* is it worth introducing a dummy main key in form of a row number to datasets that don't have any keys provided by a developer and if the filter_spec has the flag drop_key set to FALSE
Pros:
* we simplify the API - a developer doesn't have to pass the key argument if they just want to use a single dataset for analysis
Cons:
* we make the code more complicated
* we change the data a little bit (add a column to it)
Provenance:
```
Creator: kpagacz
```
Contributor guide
Assessment
This issue has not been assessed yet.