---
title: "Creating custom source extension"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Creating custom source extension}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(shinyCohortBuilder)
```

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:
 
1. The custom Source extension for `cohortBuilder` methods is implemented (see. `vignettes("custom-extensions", package = "cohortBuilder")`).
1. A set of integration S3 methods for `shinyCohortBuilder` are implemented.
2. Extra filters (added in the extension) GUI layers are implemented (see [custom GUI filters](gui-filter-layer.html)).

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.

1. **`.render_filters` - method used to define structure for filters rendering in a selected step**

Required parameters:

- `source` - Source object.
- `cohort` - Cohort object.
- `step_id` - Id of the filtering step.
- `ns` - Namespace function.
- `...` - Unused, added for S3 integration only.

Details:

- The method should return HTML structure including statistics output placeholder and a list of filter renderings.
- In order to get all the filters included in the selected step use `cohort$get_step(step_id)$filters`.
- Data statistics outputs should be consistent with `.update_data_stats` method described below.
- Each filter should be rendered with usage of `.render_filter` method.
- List of filters rendering should be wrapped into ```shiny::div(class = "cb_filters", `data-step_id` = step_id)```.

Examples:

- `shinyCohortBuilder` - default method

```{r, eval = FALSE}
.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

```{r, eval = FALSE}
.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 class

```{r, eval = FALSE}
render_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)
}
```

2. **`.update_data_stats` - logic for updating data statistics**

Required 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:

- The function should define rendering output for consistent with the output placeholder stated within `.render_filters`.
- It's recommended the statistics are taken from the Cohort cache `cohort$get_cache(step_id, state = "pre")`.
- It's recommended the output performs previous step data validation (in terms of data existence) and returns descriptive message to the user.
- Use `cohort$attributes$stats` to get displayed statistics state chosen by the user ("pre", "post", both or NULL).
- For printing the statistics use `.pre_post_stats` (or `.pre_post_stats_text`)` which returns formatted statistics output.
- You may directly assign the rendering to the output or use `.sendOutput` method (useful when sending output in loop see "tblist" source example below).

Examples:

- `shinyCohortBuilder` - default method

```{r, eval = FALSE}
.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

```{r, eval = FALSE}
.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.db`

```{r, eval = FALSE}
update_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)
      })
    )
  )
}
```

3. **`autofilter` (optional) - automatically generate filters configuration based on Source data**

Required 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:

- Generate filters based on Source data (i.e. column types) using `cohortBuilder::filter`.
- When `attach_as = "step"` wrap them with `cohortBuilder::step` and attach to the Source using `add_step` method.
- When `attach_as = "meta"` attach filters to the `available_filters` Source attribute (`source$attributes$available_filters`).
- The method should return Source object.

Examples:

- `shinyCohortBuilder` - tblist data class

```{r, eval = FALSE}
autofilter.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)
}
```

4. **`.available_filters_choices` - define choices for new step configuration panel**

Required parameters:

- `source` - Source object, 
- `cohort` - Cohort object,
- `...` - Unused, added for S3 integration only.

Details:

- The function should return `shinyWidgets::prepare_choices` output.
- The argument `value` of `prepare_choices` should point to filter ids.

Examples:

- `shinyCohortBuilder` - tblist data class

```{r, eval = FALSE}
.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)
}
```

5. **`.step_attrition` - define how step attrition plot should be rendered**

Required 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:

- The method should return list of two objects, output - returning UI output placeholder (having optional user input controllers affecting the output, see "tblist" example below) and render - rendering function defining the plot generating expression.
- Within rendering function use `cohort$show_attrition` method to generate the plot (and pass required parameters to it when needed, see "tblist" class example where `dataset` is needed).
- Use provided `id` parameter to as an id of plot output placeholder.

Examples:

- `shinyCohortBuilder` - default method

```{r, eval = FALSE}
.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

```{r, eval = FALSE}
.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)
    )
  )
}
```

6. **`.custom_attrition` - (optional) a custom method used for your own version of attrition plot**

The 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.