Exploring the Cohort object methods
Learning more about the source data
Having Cohort object created, you may want to use its methods for exploring underlying data.
With methods such as:
stat,plot_data,attrition
you can:
- get filter related data statistics,
- display filter related data on plot,
- display data changes across filtering steps.
stat(librarian_cohort, step_id = 1, filter_id = "program")
#> $n_data
#> [1] 6
#>
#> $choices
#> $choices$premium
#> [1] 6
#>
#>
#> $n_missing
#> [1] 0
stat(librarian_cohort, step_id = 2, filter_id = "copies")
#> $n_data
#> [1] 1
#>
#> $frequencies
#> level count l_bound u_bound
#> 1 1 1 4 4
#>
#> $n_missing
#> [1] 0
Sharing code and reproducibility
The cohortBuilder package offers some methods to make
sharing the workflow easier.
With code, you may get the reproducible code written
using methods operating on specific source (i.e. dplyr for
tblist and dbplyr for db
source):
code(librarian_cohort)
#> .pre_filtering <- function(source, data_object, step_id) {
#> for (dataset in names(data_object)) {
#> attr(data_object[[dataset]], "filtered") <- FALSE
#> }
#> return(data_object)
#> }
#> .run_binding <- function(source, binding_key, data_object_pre, data_object_post,
#> ...) {
#> binding_dataset <- binding_key$update$dataset
#> dependent_datasets <- names(binding_key$data_keys)
#> active_datasets <- data_object_post %>%
#> purrr::keep(~attr(., "filtered")) %>%
#> names()
#> if (!any(dependent_datasets %in% active_datasets)) {
#> return(data_object_post)
#> }
#> key_values <- NULL
#> common_key_names <- paste0("key_", seq_along(binding_key$data_keys[[1]]$key))
#> for (dependent_dataset in dependent_datasets) {
#> key_names <- binding_key$data_keys[[dependent_dataset]]$key
#> tmp_key_values <- dplyr::distinct(data_object_post[[dependent_dataset]][,
#> key_names, drop = FALSE]) %>%
#> stats::setNames(common_key_names)
#> if (is.null(key_values)) {
#> key_values <- tmp_key_values
#> } else {
#> key_values <- dplyr::inner_join(key_values, tmp_key_values, by = common_key_names)
#> }
#> }
#> data_object_post[[binding_dataset]] <- dplyr::inner_join(switch(as.character(binding_key$post),
#> `FALSE` = data_object_pre[[binding_dataset]], `TRUE` = data_object_post[[binding_dataset]]),
#> key_values, by = stats::setNames(common_key_names, binding_key$update$key))
#> if (binding_key$activate) {
#> attr(data_object_post[[binding_dataset]], "filtered") <- TRUE
#> }
#> return(data_object_post)
#> }
#> source <- list(dtconn = as.tblist(librarian))
#> data_object <- source$dtconn
#> step_id <- "1"
#> pre_data_object <- data_object
#> data_object <- .pre_filtering(source, data_object, "1")
#> data_object[["books"]] <- data_object[["books"]] %>%
#> dplyr::filter(author %in% c("Dan Brown", NA))
#> attr(data_object[["books"]], "filtered") <- TRUE
#> data_object[["borrowers"]] <- data_object[["borrowers"]] %>%
#> dplyr::filter(program %in% "premium")
#> attr(data_object[["borrowers"]], "filtered") <- TRUE
#> data_object <- .post_filtering(source, data_object, "1")
#> for (binding_key in binding_keys) {
#> data_object <- .run_binding(source, binding_key, pre_data_object, data_object)
#> }
#> step_id <- "2"
#> data_object <- .pre_filtering(source, data_object, "2")
#> data_object[["books"]] <- data_object[["books"]] %>%
#> dplyr::filter((copies <= 5 & copies >= -Inf) | is.na(copies))
#> attr(data_object[["books"]], "filtered") <- TRUE
#> data_object <- .post_filtering(source, data_object, "2")We can see above, the resulting code uses source object,
which creation code can be defined separately while creating it:
librarian_source <- set_source(
as.tblist(librarian),
source_code = quote({
source <- list()
source$dtconn <- as.tblist(librarian)
})
)
librarian_cohort <- librarian_source %>%
cohort(
step(
filter(
"discrete", id = "author", dataset = "books",
variable = "author", value = "Dan Brown"
),
filter(
"discrete", id = "program", dataset = "borrowers",
variable = "program", value = "premium", keep_na = FALSE
)
),
step(
filter(
"range", id = "copies", dataset = "books",
variable = "copies", range = c(-Inf, 5)
)
),
run_flow = TRUE
)
code(librarian_cohort)
#> .pre_filtering <- function(source, data_object, step_id) {
#> for (dataset in names(data_object)) {
#> attr(data_object[[dataset]], "filtered") <- FALSE
#> }
#> return(data_object)
#> }
#> .run_binding <- function(source, binding_key, data_object_pre, data_object_post,
#> ...) {
#> binding_dataset <- binding_key$update$dataset
#> dependent_datasets <- names(binding_key$data_keys)
#> active_datasets <- data_object_post %>%
#> purrr::keep(~attr(., "filtered")) %>%
#> names()
#> if (!any(dependent_datasets %in% active_datasets)) {
#> return(data_object_post)
#> }
#> key_values <- NULL
#> common_key_names <- paste0("key_", seq_along(binding_key$data_keys[[1]]$key))
#> for (dependent_dataset in dependent_datasets) {
#> key_names <- binding_key$data_keys[[dependent_dataset]]$key
#> tmp_key_values <- dplyr::distinct(data_object_post[[dependent_dataset]][,
#> key_names, drop = FALSE]) %>%
#> stats::setNames(common_key_names)
#> if (is.null(key_values)) {
#> key_values <- tmp_key_values
#> } else {
#> key_values <- dplyr::inner_join(key_values, tmp_key_values, by = common_key_names)
#> }
#> }
#> data_object_post[[binding_dataset]] <- dplyr::inner_join(switch(as.character(binding_key$post),
#> `FALSE` = data_object_pre[[binding_dataset]], `TRUE` = data_object_post[[binding_dataset]]),
#> key_values, by = stats::setNames(common_key_names, binding_key$update$key))
#> if (binding_key$activate) {
#> attr(data_object_post[[binding_dataset]], "filtered") <- TRUE
#> }
#> return(data_object_post)
#> }
#> source <- list()
#> source$dtconn <- as.tblist(librarian)
#> data_object <- source$dtconn
#> step_id <- "1"
#> pre_data_object <- data_object
#> data_object <- .pre_filtering(source, data_object, "1")
#> data_object[["books"]] <- data_object[["books"]] %>%
#> dplyr::filter(author %in% c("Dan Brown", NA))
#> attr(data_object[["books"]], "filtered") <- TRUE
#> data_object[["borrowers"]] <- data_object[["borrowers"]] %>%
#> dplyr::filter(program %in% "premium")
#> attr(data_object[["borrowers"]], "filtered") <- TRUE
#> data_object <- .post_filtering(source, data_object, "1")
#> for (binding_key in binding_keys) {
#> data_object <- .run_binding(source, binding_key, pre_data_object, data_object)
#> }
#> step_id <- "2"
#> data_object <- .pre_filtering(source, data_object, "2")
#> data_object[["books"]] <- data_object[["books"]] %>%
#> dplyr::filter((copies <= 5 & copies >= -Inf) | is.na(copies))
#> attr(data_object[["books"]], "filtered") <- TRUE
#> data_object <- .post_filtering(source, data_object, "2")What’s more, you can manipulate the output with additional arguments:
include_methods- list of methods names which definition should be printed in output,include_action- list of actions names (such as “pre_filtering”) that should be included in output,modifier- a custom modifier of data.frame storing reproducible code parts,mark_step- should step ID be presented in output.
The second option for achieving reproducibility allows to restore cohort configuration using its state. The cohort state is a list (or json) storing information about all the steps and filters configuration.
You may get the state with get_state method:
state <- get_state(librarian_cohort, json = TRUE)
state
#> [{"step":"1","filters":[{"type":"discrete","id":"author","name":"author","variable":"author","value":"Dan Brown","dataset":"books","keep_na":true,"description":null,"active":true},{"type":"discrete","id":"program","name":"program","variable":"program","value":"premium","dataset":"borrowers","keep_na":false,"description":null,"active":true}]},{"step":"2","filters":[{"type":"range","id":"copies","name":"copies","variable":"copies","range":["-Inf",5],"dataset":"books","keep_na":true,"description":null,"active":true}]}]Then, having an empty cohort, use restore to apply the
configuration:
librarian_cohort <- librarian_source %>%
cohort()
restore(librarian_cohort, state = state)
sum_up(librarian_cohort)
#> >> Step ID: 1
#> -> Filter ID: author
#> Filter Type: discrete
#> Filter Parameters:
#> dataset: books
#> variable: author
#> value: Dan Brown
#> keep_na: TRUE
#> description:
#> active: TRUE
#> -> Filter ID: program
#> Filter Type: discrete
#> Filter Parameters:
#> dataset: borrowers
#> variable: program
#> value: premium
#> keep_na: FALSE
#> description:
#> active: TRUE
#> >> Step ID: 2
#> -> Filter ID: copies
#> Filter Type: range
#> Filter Parameters:
#> dataset: books
#> variable: copies
#> range: -Inf, 5
#> keep_na: TRUE
#> description:
#> active: TRUE