insightsengineering / insightsengineering/teal.transform

(data_merge_module) should we provide a default main key for a single dataset

Open
#14 1 comment 0 reactions 0 assignees View on GitHub
core
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

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.