intended_use.Rmd
In this vignette we explain how chevron
can be used in a
study setting to create many TLGs with relatively little effort. The
workflow described in this vignette is a basic one and can be adopted to
be more streamlined for a particular setting.
For this vignette we load the following packages:
library(rtables)
#> Loading required package: magrittr
#> Loading required package: formatters
library(chevron)
#> Registered S3 method overwritten by 'tern':
#> method from
#> tidy.glm broom
library(dm)
#>
#> Attaching package: 'dm'
#> The following object is masked from 'package:stats':
#>
#> filter
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(rlang)
#>
#> Attaching package: 'rlang'
#> The following object is masked from 'package:formatters':
#>
#> %||%
#> The following object is masked from 'package:magrittr':
#>
#> set_names
A list of planned outputs (LoPO) contains among other information:
tlgfname
: function that implements the outputtype
: one of graph
, listing
,
table
main_title
: main titlesubtitles
: additional titlesfilters
: patient subset definitionfilename
: file name where the output should be written
toThe information above can be stored in various data structures. For
this example we assume the information comes from a spreadsheet with one
row per output. We will use the following LoPO store in the variable
lopo
for the remainder of the vignette:
Which provides the following LoPO:
excerpt <- function(x) lapply(x, function(xi) if (length(xi) > 0) paste(substr(xi[1], 1, 8), "...") else "")
knitr::kable(lopo %>% mutate(main_title = excerpt(main_title), footnotes = excerpt(footnotes)))
tlgfname | type | extra_args | output_id | main_title | subtitles | footnotes | filters | filename |
---|---|---|---|---|---|---|---|---|
dmt01_1 | table | NULL | t_dm | Demograp … | NULL | IT | t_dm__IT.txt | |
aet02_1 | table | NULL | t_ae | Adverse … | NULL | Investig … | FATAL, SE | t_ae__FATAL_SE.txt |
aet02_1 | table | NULL | t_ae | Adverse … | NULL | Investig … | SE | t_ae__SE.txt |
aet02_1 | table | NULL | t_ae | Adverse … | NULL | Investig … | SE | t_ae__SE.txt |
dst01_1 | table | NULL | t_ds | Patient … | NULL | IT | t_ds__IT.txt | |
dst01_1 | table | NULL | t_ds | Patients … | NULL | TX, IT | t_ds__TX_IT.txt | |
lbt01_1 | table | NULL | l_lb_ctc | Listing … | NULL | Grading … | SE | l_lb_ctc__SE.txt |
lbt01_1 | table | NULL | t_lb | Listing … | NULL | Abnormal … | SE | t_lb__SE.txt |
lbt01_1 | table | NULL | l_lb_ls | Listing … | NULL | Includes … | SE | l_lb_ls__SE.txt |
Note that the first three columns are not needed for stakeholder
interactions and planning/project management. However, the GDS template
which is currently encoded in the tlgfname
is needed.
From the lopo
above we know that the
tlg-functions dmt01_1
, aet02_1
,
dst01_1
and lbt01_1
are used to create the
outputs. chevron
knows which datasets are required for the
particular TLGs
req_data(c("dmt01", "aet02_1", "dst01_1", "lbt01_1"))
#> [1] "adsl" "adae" "adlb"
So the adam_db
object needs to contain the following
datasets, we will use the scda
data:
syn_data <- syn_test_data()[c("adsl", "adae", "adlb")]
adam_study_data <- dm(adsl = syn_data$adsl, adae = syn_data$adae, adlb = syn_data$adlb) %>%
dm_add_pk(adsl, c("USUBJID", "STUDYID")) %>%
dm_add_fk(adae, c("USUBJID", "STUDYID"), ref_table = "adsl") %>%
dm_add_pk(adae, c("USUBJID", "STUDYID", "ASTDTM", "AETERM", "AESEQ")) %>%
dm_add_fk(adlb, c("USUBJID", "STUDYID"), ref_table = "adsl") %>%
dm_add_pk(adlb, c("STUDYID", "USUBJID", "PARAMCD", "BASETYPE", "AVISITN", "ATPTN", "DTYPE", "ADTM", "LBSEQ", "ASPID"))
adam_study_data
#> ── Metadata ────────────────────────────────────────────────────────────────────
#> Tables: `adsl`, `adae`, `adlb`
#> Columns: 190
#> Primary keys: 3
#> Foreign keys: 2
The lopo
contains the following filter labels:
Each label corresponds to a particular subsetting operation of a
dataset. As there is currently no R package available that implements
filter label based subsetting on dm
objects we provide a
basic approach here:
new_filter_func <- function(dataname, expr) {
e <- enquo(expr)
d <- enquo(dataname)
function(x) {
stopifnot(is_dm(x))
dm_filter(x, !!d, !!e)
}
}
# filter label functions
flf <- list(
ITT = new_filter_func("adsl", ITTFL == "Y"),
SE = new_filter_func("adsl", SAFFL == "Y"),
CTC35 = new_filter_func("adae", AETOXGR %in% c("3", "4", "5")),
FATAL = new_filter_func("adae", AESDTH == "Y"),
TX = identity
)
These filter label based system can then be used as follows, assume
we would like the data for CTC35_SE
:
adam__CTC35_SE <- adam_study_data %>% # nolint
flf$SE() %>%
flf$CTC35() %>%
dm_apply_filters()
dm_nrow(adam_study_data)
#> adsl adae adlb
#> 400 1934 8400
dm_nrow(adam__CTC35_SE)
#> adsl adae adlb
#> 322 921 6762
We now introduce the function dm_filter_with_labels
get_std_filter_label_defn <- function() flf
dm_filter_with_labels <- function(dm, filter_labels, filter_label_def = get_std_filter_label_defn()) {
stopifnot(
is_dm(dm),
is.null(filter_labels) || all(filter_labels %in% names(filter_label_def))
)
if (length(filter_labels) == 0) {
return(dm)
}
Reduce(function(f1, f2) f2(f1), filter_label_def[filter_labels], init = dm)
}
adam_study_data %>%
dm_filter_with_labels(c("CTC35", "SE"))
#> ── Metadata ────────────────────────────────────────────────────────────────────
#> Tables: `adsl`, `adae`, `adlb`
#> Columns: 190
#> Primary keys: 3
#> Foreign keys: 2
#> ── Filters ─────────────────────────────────────────────────────────────────────
#> adsl: SAFFL == "Y"
#> adae: AETOXGR %in% c("3", "4", "5")
so to get the filtered data
The title and footnotes in the lopo
are not ready for
the final output. The final titles usually have the form:
{{main_title_lopo}} -- {{population title}}
Protocol: {{protocol}}, Snapshot: {{snapshot}}, Snapshot Date: {{snapshot-date}}, Cutoff Date: {{cutoff-date}}
{{subtitles from lopo}}
We now introduce a simple templating framework based on
whiskers
. Instead of using the whiskers
R
package we define our own functionality:
render_whiskers <- function(templates, dict = character(0)) {
if (is.null(templates)) {
return(NULL)
}
stopifnot(
is.character(templates)
)
setNames(vapply(templates, render_whiskers_string, character(1), dict = dict), names(templates))
}
render_whiskers_string <- function(template, dict = character(0)) {
stopifnot(
is.character(template),
length(template) == 1,
isFALSE(is.null(as.list(dict))),
isFALSE(any(duplicated(names(as.list(dict)))))
)
if (length(dict) == 0) {
return(template)
}
ndata <- paste0("{{", names(dict), "}}")
for (i in seq_along(dict)) {
template <- gsub(ndata[i], dict[i], template, fixed = TRUE)
}
template
}
The two functions can be used as follows:
render_whiskers(
c(
"{{main_title_lopo}} -- {{population_title}}",
"Protocol: {{protocol}}, Snapshot: {{snapshot}}, Snapshot Date: {{snapshot-date}}, Cutoff Date: {{cutoff-date}}"
),
dict = c(
main_title_lopo = "Adverse Events", population_title = "All Patients",
protocol = "abc123", snapshot = "abc123.ib", "snapshot-date" = "12 March 2020", "cutoff-date" = "1 February 2020"
)
)
#> [1] "Adverse Events -- All Patients"
#> [2] "Protocol: abc123, Snapshot: abc123.ib, Snapshot Date: 12 March 2020, Cutoff Date: 1 February 2020"
We now use all the concepts for introduced above to create an output. Let’s extracting the data for an output from the lopo:
lopo_1 <- purrr::transpose(lopo[lopo$tlgfname == "aet02_1", ])[[1]]
lopo_1
#> $tlgfname
#> [1] "aet02_1"
#>
#> $type
#> [1] "table"
#>
#> $extra_args
#> NULL
#>
#> $output_id
#> [1] "t_ae"
#>
#> $main_title
#> [1] "Adverse Events Resulting in Death"
#>
#> $subtitles
#> NULL
#>
#> $footnotes
#> [1] "Investigator text for AEs is coded using MedDRA version {{medra-version}}."
#>
#> $filters
#> [1] "FATAL" "SE"
#>
#> $filename
#> [1] "t_ae__FATAL_SE.txt"
Now let’s create the output
## Decoration ---
study_dict <- c(
protocol = "abc123",
snapshot = "abc123.ib",
"snapshot-date" = "12 March 2020",
"cutoff-date" = "1 February 2020",
"medra-version" = "MEDRA v1"
)
null_as_empty_string <- function(x) {
lapply(x, function(xi) if (is.null(xi)) "" else xi)
}
deco_templ <- null_as_empty_string(list(
title = "{{main_title_lopo}} -- {{population_title}}",
subtitles = c(
"Protocol: {{protocol}}, Snapshot: {{snapshot}}, Snapshot Date: {{snapshot-date}}, Cutoff Date: {{cutoff-date}}",
lopo_1$subtitles
),
main_footer = lopo_1$footnotes
))
dict <- c(
study_dict,
main_title_lopo = lopo_1$main_title,
population_title = population_title(lopo_1$filters)
)
deco <- lapply(deco_templ, render_whiskers, dict = dict)
## Data ---
db <- adam_study_data %>%
dm_filter_with_labels(lopo_1$filters) %>%
preprocess_data(lopo_1$tlgfname)
## Output ---
tbl <- do.call(lopo_1$tlgfname, c(list(adam_db = db, deco = deco), lopo_1$extra_args))
tbl
#> Adverse Events Resulting in Death -- Safety Evaluable Population
#> Protocol: abc123, Snapshot: abc123.ib, Snapshot Date: 12 March 2020, Cutoff Date: 1 February 2020
#>
#> —————————————————————————————————————————————————————————————————————————————————————————————————————
#> MedDRA System Organ Class A: Drug X B: Placebo C: Combination
#> MedDRA Preferred Term (N=76) (N=70) (N=75)
#> —————————————————————————————————————————————————————————————————————————————————————————————————————
#> Total number of patients with at least one adverse event 76 (100%) 70 (100%) 75 (100%)
#> Overall total number of events 117 111 133
#> cl D.1
#> Total number of patients with at least one adverse event 50 (65.8%) 42 (60%) 51 (68%)
#> Total number of events 61 51 71
#> dcd D.1.1.1.1 50 (65.8%) 42 (60%) 51 (68%)
#> cl B.1
#> Total number of patients with at least one adverse event 47 (61.8%) 49 (70%) 43 (57.3%)
#> Total number of events 56 60 62
#> dcd B.1.1.1.1 47 (61.8%) 49 (70%) 43 (57.3%)
#> —————————————————————————————————————————————————————————————————————————————————————————————————————
#>
#> Investigator text for AEs is coded using MedDRA version MEDRA v1.
This table can now be paginated and saved as a .txt
file
with rtables::export_as_txt
.
Let’s create ad-hoc non-standard output and add it to the lopo and preprocessing map:
ns_dmtspecial <- function(adam_db, deco) {
adsl <- adam_db$adsl
lyt <- chevron:::basic_table_deco(deco) %>%
split_cols_by("ARM") %>%
analyze("AGE", mean)
build_table(lyt, adsl)
}
lopo_new <- rbind(
lopo,
lopo_entry(
tlgfname = "ns_dmtspecial", type = "table", output_id = "t_aaa", main_title = "Hello World",
subtitles = c("this", "is", "a test"),
footnotes = "very important stuff", filters = c("CTC35", "SE")
)
)
pmap_new <- rbind(std_pmap, pmap_row("ns_dmtspecial", req_data = "adsl"))
We now create functions that create the final outputs:
std_deco_templ <- function(lopo_row) {
tmpl <- null_as_empty_string(list(
title = "{{main_title_lopo}} -- {{population_title}}",
subtitles = c(
"Protocol: {{protocol}}, Snapshot: {{snapshot}}, Snapshot Date: {{snapshot-date}}, Cutoff Date: {{cutoff-date}}",
lopo_row$subtitles
),
main_footer = lopo_row$footnotes
))
}
create_one_tlg <- function(lopoi, adam_db, pmap = std_map(), deco_template_fun = std_deco_templ,
dict = character(), filter_label_def = get_std_filter_label_defn()) {
db <- adam_db %>%
dm_filter_with_labels(lopoi$filters) %>%
preprocess_data(lopoi$tlgfname, pmap = pmap)
tmpl <- deco_template_fun(lopoi)
dict_i <- c(
study_dict,
main_title_lopo = lopoi$main_title,
population_title = population_title(lopoi$filters)
)
deco <- lapply(tmpl, render_whiskers, dict = dict_i)
## Create Output
do.call(lopoi$tlgfname, c(list(adam_db = db, deco = deco), lopoi$extra_args))
}
create_tlg_in_lopo <- function(adam_db, lopo, pmap = std_map(), deco_template_fun = std_deco_templ,
dict = character(), filter_label_def = get_std_filter_label_defn()) {
setNames(lapply(purrr::transpose(lopo),
create_one_tlg, adam_db,
pmap = pmap,
deco_template_fun = deco_template_fun,
dict = dict, filter_label_def = filter_label_def
), lopo$filename)
}
And putting it all together
tbls <- create_tlg_in_lopo(adam_db = adam_study_data, lopo_sel, pmap_new, dict = study_dict)
names(tbls)
#> [1] "t_ae__FATAL_SE.txt" "t_ae__SE.txt" "t_ae__SE.txt"
#> [4] "t_aaa__CTC35_SE.txt"
In this vignette we have introduced
dm
pmap