## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(shinyCohortBuilder)

## -----------------------------------------------------------------------------
library(cohortBuilder)
iris_source <- set_source(tblist(iris = iris))
species_filter <- filter(
  type = "discrete", 
  id = "species",
  dataset = "iris",
  variable = "Species",
  value = "setosa"
)

## -----------------------------------------------------------------------------
evaled_filter <- species_filter(iris_source)
class(evaled_filter)

## -----------------------------------------------------------------------------
str(evaled_filter, give.attr = FALSE)

## ----eval = FALSE-------------------------------------------------------------
#  .gui_filter.discrete <- function(filter, ...) {
#    list(
#      input = function(input_id, cohort) {
#        shiny::tagList(
#          .cb_input(
#            do.call(
#              shiny::checkboxGroupInput,
#              discrete_input_params(filter, input_id, cohort, ...)
#            ),
#            filter$input_param
#          ),
#          .cb_input(
#            keep_na_input(input_id, filter, cohort),
#            "keep_na"
#          )
#        )
#      },
#      # other objects
#    )
#  }

## ----eval = FALSE-------------------------------------------------------------
#  do.call(
#    shiny::checkboxGroupInput,
#    discrete_input_params(filter, input_id, cohort, ...)
#  )

## ----eval = FALSE-------------------------------------------------------------
#  if (!cohort$get_cache(step_id, filter_id, state = "pre")$n_data) {
#    return(
#      list(inputId = input_id, choices = character(0), selected = character(0), label = NULL)
#    )
#  }

## ----eval = FALSE-------------------------------------------------------------
#  step_id <- filter$step_id
#  filter_id <- filter$id

## ----eval = FALSE-------------------------------------------------------------
#  filter_params <- filter$get_params()

## ----eval = FALSE-------------------------------------------------------------
#  filter_params[[filter$input_param]]

## ----eval = FALSE-------------------------------------------------------------
#  names(
#    cohort$get_cache(step_id, filter_id, state = "pre")$choices
#  )

## ----eval = FALSE-------------------------------------------------------------
#  names(
#    cohort$get_cache(step_id, filter_id, state = "pre")$choices
#  )

## ----eval = FALSE-------------------------------------------------------------
#  !is.null(filter_params$value_mapping)

## ----eval = FALSE-------------------------------------------------------------
#  cohort$get_source()$attributes$value_mappings[[filter_params$value_mapping]]

## ----eval = FALSE-------------------------------------------------------------
#  .pre_post_stats_text(
#    name = <choices labels names vector>,
#    current = <current step statistics vector>,
#    previous = <previous step statistics vector>,
#    stats = <"pre, post", both or NULL> # it's recommended to use `stats = cohort$attributes$stats` to inherit the option from Cohort configuration
#  )

## -----------------------------------------------------------------------------
.pre_post_stats_text(
  name = c("A", "B"),
  current = 1:2,
  previous = 3:4,
  stats = c("pre", "post")
)

## ----eval = FALSE-------------------------------------------------------------
#  .gui_filter.discrete <- function(filter, ...) {
#    list(
#      feedback = function(input_id, cohort, empty = FALSE) {
#        list(
#          plot_id = shiny::NS(input_id, "feedback_plot") ,
#          output_fun = ggiraph::girafeOutput,
#          render_fun = if (!is.null(empty)) {
#            ggiraph::renderGirafe({
#              if(empty) { # when no data in parent step
#                return(
#                  ggiraph::girafe(
#                    ggobj      = ggplot2::ggplot(),
#                    width_svg  = 10,
#                    height_svg = 0.1
#                  )
#                )
#              }
#              step_id <- filter$step_id
#              filter_id <- filter$id
#  
#              filter_cache <- cohort$get_cache(step_id, filter_id, state = "pre")
#              filter_value <- extract_selected_value(filter$get_params()$value, filter_cache$choices, FALSE)
#              plot_data <- filter_cache$choices[filter_value]
#              n_missing <- filter_cache$n_missing
#              if (identical(filter$get_params()$keep_na, FALSE)) {
#                n_missing <- 0
#              }
#  
#              plot_feedback_bar(plot_data, n_missing)
#            })
#          }
#        )
#      },
#      # other methods
#    )
#  }

## ----eval = FALSE-------------------------------------------------------------
#  step_id <- filter$step_id
#  filter_id <- filter$id

## ----eval = FALSE-------------------------------------------------------------
#  .gui_filter.discrete <- function(filter, ...) {
#    list(
#      server = function(input_id, input, output, session, cohort) {
#        shiny::observeEvent(input[[shiny::NS(input_id, "feedback_plot_selected")]], {
#          value <- input[[shiny::NS(input_id, "feedback_plot_selected")]]
#  
#          if (!is.na(value)) {
#            .trigger_action(session, "update_filter", params = list(
#              step_id = filter$step_id, filter_id = filter$id,
#              input_name = filter$input_param, input_value = value,
#              run_flow = FALSE
#            ))
#          }
#        }, ignoreInit = TRUE) %>% .save_observer(input_id, session)
#      },
#      # other methods
#    )
#  }

## ----eval = FALSE-------------------------------------------------------------
#  .gui_filter.discrete <- function(filter, ...) {
#    list(
#      update = function(session, input_id, cohort, reset = FALSE, ...) {
#        update_params <- discrete_input_params(filter, input_id, cohort, reset = reset, update = TRUE, ...)
#        do.call(
#          shiny::updateCheckboxGroupInput,
#          append(
#            list(session = session),
#            update_params
#          )
#        )
#        .update_keep_na_input(session, input_id, filter, cohort)
#      },
#      # other methods
#    )
#  }

## ----eval = FALSE-------------------------------------------------------------
#  names(
#    cohort$get_cache(step_id, filter_id, state = "pre")$choices
#  )

## ----eval = FALSE-------------------------------------------------------------
#  label = if (update) character(0) else NULL