Creates a named list of data_extract_srv output — data_extract_multiple

data_extract_multiple_srv loops over the list of data_extract given and runs data_extract_srv for each one returning a list of reactive objects. This is suitable as input for data_merge_srv().

Usage

data_extract_multiple_srv(data_extract, datasets, ...)

# S3 method for FilteredData
data_extract_multiple_srv(data_extract, datasets, ...)

# S3 method for list
data_extract_multiple_srv(
  data_extract,
  datasets,
  join_keys = NULL,
  select_validation_rule = NULL,
  filter_validation_rule = NULL,
  dataset_validation_rule = if (is.null(select_validation_rule) &&
    is.null(filter_validation_rule)) {
     NULL
 } else {
    
    shinyvalidate::sv_required("Please select a dataset")
 },
  ...
)

Arguments

data_extract: (named list of data_extract_spec objects) the list data_extract_spec objects. The names of the elements in the list need to correspond to the ids passed to data_extract_ui. See example for details.
datasets: (FilteredData or list of reactive or non-reactive data.frame)
object containing data either in the form of teal.slice::FilteredData or as a list of data.frame. When passing a list of non-reactive data.frame objects, they are converted to reactive data.frames internally. When passing a list of reactive or non-reactive data.frame objects, the argument join_keys is required also.
...: an additional argument join_keys is required when datasets is a list of data.frame. It shall contain the keys per dataset in datasets.
join_keys: (JoinKeys or NULL) of join keys per dataset in datasets.
select_validation_rule: (NULL, function or named list of function) Should there be any shinyvalidate input validation of the select parts of the data_extract_ui If all data_extract require the same validation function then this can be used directly ( i.e. select_validation_rule = shinyvalidate::sv_required()). For more fine-grained control use a list: select_validation_rule = list(extract_1 = sv_required(), extract2 = ~ if (length(.) > 2) "Error"). If NULL then no validation will be added. See example for more details.
filter_validation_rule: (NULL, function or named list of function) Same as select_validation_rule but for the filter (values) part of the data_extract_ui.
dataset_validation_rule: (NULL, function or named list of function) Same as select_validation_rule but for the choose dataset part of the data_extract_ui

Value

reactive named list containing outputs from data_extract_srv(). Output list names are the same as data_extract input argument.

Examples

library(shiny)
library(shinyvalidate)
library(shinyjs)
library(teal.widgets)

iris_select <- data_extract_spec(
  dataname = "iris",
  select = select_spec(
    label = "Select variable:",
    choices = variable_choices(iris, colnames(iris)),
    selected = "Sepal.Length",
    multiple = TRUE,
    fixed = FALSE
  )
)

iris_filter <- data_extract_spec(
  dataname = "iris",
  filter = filter_spec(
    vars = "Species",
    choices = c("setosa", "versicolor", "virginica"),
    selected = "setosa",
    multiple = TRUE
  )
)

data_list <- list(iris = reactive(iris))

app <- shinyApp(
  ui = fluidPage(
    useShinyjs(),
    standard_layout(
      output = verbatimTextOutput("out1"),
      encoding = tagList(
        data_extract_ui(
          id = "x_var",
          label = "Please select an X column",
          data_extract_spec = iris_select
        ),
        data_extract_ui(
          id = "species_var",
          label = "Please select 2 Species",
          data_extract_spec = iris_filter
        )
      )
    )
  ),
  server = function(input, output, session) {
    exactly_2_validation <- function(msg) {
      ~ if (length(.) != 2) msg
    }


    selector_list <- data_extract_multiple_srv(
      list(x_var = iris_select, species_var = iris_filter),
      datasets = data_list,
      select_validation_rule = list(
        x_var = sv_required("Please select an X column")
      ),
      filter_validation_rule = list(
        species_var = compose_rules(
          sv_required("Exactly 2 Species must be chosen"),
          exactly_2_validation("Exactly 2 Species must be chosen")
        )
      )
    )
    iv_r <- reactive({
      iv <- InputValidator$new()
      compose_and_enable_validators(
        iv,
        selector_list,
        validator_names = NULL
      )
    })

    output$out1 <- renderPrint({
      if (iv_r()$is_valid()) {
        ans <- lapply(selector_list(), function(x) {
          cat(format_data_extract(x()), "\n\n")
        })
      } else {
        "Please fix errors in your selection"
      }
    })
  }
)
if (interactive()) {
  runApp(app)
}