If you want to use shinyCohortBuilder with a custom source type, a set of methods needs to be defined.
Currently there exists one official extension cohortBuilder.db package that allows you to use shinyCohortBuilder (and cohortBuilder) with database connections.
The goal of this document is to explain how to create custom extensions to shinyCohortBuilder.
In general to create the custom layer you need to create an R package where:
cohortBuilder methods is implemented (see. vignettes("custom-extensions", package = "cohortBuilder")).shinyCohortBuilder are implemented.If you have cohortBuilder integration ready for the selected source type (a new package named cohortBuilder.<type>), the next step is to add shinyCohortBuilder integration.
Below we describe all the required and optional methods you need to define within the created package.
.render_filters - method used to define structure for filters rendering in a selected stepRequired parameters:
source - Source object.cohort - Cohort object.step_id - Id of the filtering step.ns - Namespace function.... - Unused, added for S3 integration only.Details:
cohort$get_step(step_id)$filters..update_data_stats method described below..render_filter method.shiny::div(class = "cb_filters", `data-step_id` = step_id).Examples:
shinyCohortBuilder - default method.render_filters.default <- function(source, cohort, step_id, ns, ...) {
step <- cohort$get_step(step_id)
shiny::tagList(
shiny::htmlOutput(ns(paste0(step_id, "-stats")), class = "scb_data_stats"),
step$filters %>%
purrr::map(~ .render_filter(.x, step_id, cohort, ns = ns)) %>%
shiny::div(class = "cb_filters", `data-step_id` = step_id)
)
}shinyCohortBuilder - tblist data class.render_filters.tblist <- function(source, cohort, step_id, ns, ...) {
step <- cohort$get_step(step_id)
group_filters(cohort$get_source(), step$filters) %>%
purrr::imap(~ dataset_filters(.x, .y, step_id, cohort, ns = ns)) %>%
shiny::div(class = "cb_filters", `data-step_id` = step_id)
}In this example we group all the defined filters by related datasets from source (group_filters), and attach a separate statistics placeholder for each dataset (dataset_filters).
cohortBuilder.db - db data classrender_filters.db <- function(source, cohort, step_id, ns) {
step <- cohort$get_step(step_id)
group_filters_db(cohort$get_source(), step$filters) %>%
purrr::imap(~ dataset_filters_db(.x, .y, step_id, cohort, ns = ns)) %>%
div(class = "cb_filters", `data-step_id` = step_id)
}.update_data_stats - logic for updating data statisticsRequired parameters:
source - Source object.step_id - Id of the filtering step.cohort - Cohort object.session - Shiny session object.... - Unused, added for S3 integration only.Details:
.render_filters.cohort$get_cache(step_id, state = "pre").cohort$attributes$stats to get displayed statistics state chosen by the user (“pre”, “post”, both or NULL)..pre_post_stats (or .pre_post_stats_text)` which returns formatted statistics output..sendOutput method (useful when sending output in loop see “tblist” source example below).Examples:
shinyCohortBuilder - default method.update_data_stats.default <- function(source, step_id, cohort, session, ...) {
ns <- session$ns
stats <- cohort$attributes$stats
session$output[[paste0(step_id, "-stats")]] <- shiny::renderUI({
previous <- cohort$get_cache(step_id, state = "pre")$n_rows
if (!previous > 0) {
return("No data selected in previous step.")
}
current <- cohort$get_cache(step_id, state = "post")$n_rows
.pre_post_stats(current, previous, percent = TRUE, stats = stats)
})
}shinyCohortBuilder - tblist data class.update_data_stats.tblist <- function(source, step_id, cohort, session, ...) {
stats <- cohort$attributes$stats
step <- cohort$get_step(step_id)
dataset_names <- names(cohort$get_source()$attributes$datasets)
data_filters <- purrr::map_chr(step$filters, get_filter_dataset)
dataset_names <- intersect(dataset_names, data_filters)
dataset_names %>% purrr::walk(
~ .sendOutput(
paste0(step_id, "-stats_", .x),
shiny::renderUI({
previous <- cohort$get_cache(step_id, state = "pre")[[.x]]$n_rows
if (!previous > 0) {
return("No data selected in previous step.")
}
current <- cohort$get_cache(step_id, state = "post")[[.x]]$n_rows
.pre_post_stats(current, previous, percent = TRUE, stats = stats)
}),
session
)
)
}cohortBuilder.dbupdate_data_stats.db <- function(source, step_id, cohort, session) {
stats <- cohort$attributes$stats
dataset_names <- source$attributes$tables
dataset_names %>% purrr::walk(
~ shinyCohortBuilder::sendOutput(
paste0(step_id, "-stats_", .x),
shiny::renderUI({
previous <- cohort$get_cache(step_id, state = "pre")[[.x]]$n_rows
if (!previous > 0) {
return("No data selected in previous step.")
}
current <- cohort$get_cache(step_id, state = "post")[[.x]]$n_rows
shinyCohortBuilder::pre_post_stats(current, previous, percent = TRUE, stats = stats)
})
)
)
}autofilter (optional) - automatically generate filters configuration based on Source dataRequired parameters:
source - Source object,attach_as - Should filters be added as the first step ("step") or as available filters for configuration panel ("meta"),... - Unused, added for S3 integration only.Details:
cohortBuilder::filter.attach_as = "step" wrap them with cohortBuilder::step and attach to the Source using add_step method.attach_as = "meta" attach filters to the available_filters Source attribute (source$attributes$available_filters).Examples:
shinyCohortBuilder - tblist data classautofilter.tblist <- function(source, attach_as = c("step", "meta"), ...) {
attach_as <- rlang::arg_match(attach_as)
step_rule <- source$dtconn %>%
purrr::imap(~filter_rules(.x, .y)) %>%
unlist(recursive = FALSE) %>%
purrr::map(~do.call(cohortBuilder::filter, .)) %>%
unname()
if (identical(attach_as, "meta")) {
source$attributes$available_filters <- step_rule
} else {
source %>%
cohortBuilder::add_step(do.call(cohortBuilder::step, step_rule))
}
return(source)
}.available_filters_choices - define choices for new step configuration panelRequired parameters:
source - Source object,cohort - Cohort object,... - Unused, added for S3 integration only.Details:
shinyWidgets::prepare_choices output.value of prepare_choices should point to filter ids.Examples:
shinyCohortBuilder - tblist data class.available_filters_choices.tblist <- function(source, cohort, ...) {
available_filters <- cohort$attributes$available_filters
choices <- purrr::map(available_filters, function(x) {
tibble::tibble(
name = as.character(
shiny::div(
`data-tooltip-z-index` = 9999,
`data-tooltip` = x$get_params("description"),
`data-tooltip-position` = "top right",
`data-tooltip-allow-html` = "true",
x$name
)
),
id = x$id,
dataset = x$get_params("dataset")
)
}) %>% dplyr::bind_rows()
shinyWidgets::prepare_choices(choices, name, id, dataset)
}.step_attrition - define how step attrition plot should be renderedRequired parameters:
source - Source object.id - Id of the attrition plot output.cohort - Cohort object.session - Shiny session object.... - Unused, added for S3 integration only.Details:
cohort$show_attrition method to generate the plot (and pass required parameters to it when needed, see “tblist” class example where dataset is needed).id parameter to as an id of plot output placeholder.Examples:
shinyCohortBuilder - default method.step_attrition.default <- function(source, id, cohort, session, ...) {
ns <- session$ns
list(
render = shiny::renderPlot({
cohort$show_attrition()
}),
output = shiny::plotOutput(id)
)
}shinyCohortBuilder - tblist data class.step_attrition.tblist <- function(source, id, cohort, session, ...) {
ns <- session$ns
choices <- names(source$attributes$datasets)
list(
render = shiny::renderPlot({
cohort$show_attrition(dataset = session$input$attrition_input)
}),
output = shiny::tagList(
shiny::selectInput(ns("attrition_input"), "Choose dataset", choices),
shiny::plotOutput(id)
)
)
}.custom_attrition - (optional) a custom method used for your own version of attrition plotThe parameters and output structure is the same as for .step_attrition. The main difference is that you should put your custom logic for generating attrition (i.e. using a specific package meant for this).
When the method is defined, the attrition will be printed inside an extra tab of attrition modal.