Nothing
#' Check data extract specification
#'
#' @param data_extract_spec (`list`) of `data_extract_spec`.
#'
#' @return Raises an error when check fails, otherwise, it returns the `data_extract_spec`
#' parameter, invisibly and unchanged.
#'
#' @keywords internal
#'
check_data_extract_spec <- function(data_extract_spec) {
checkmate::assert_list(data_extract_spec, types = "data_extract_spec", null.ok = TRUE)
}
#' Generate id for dataset
#'
#' @param dataname (`character(1)`) the name of the dataset.
#'
#' @return `character(1)`.
#'
#' @keywords internal
#'
id_for_dataset <- function(dataname) {
paste0("dataset_", dataname, "_singleextract")
}
#' Creates a panel that displays (with filter and column selection)
#' conditionally on `input[ns("dataset")] == dataname`
#'
#' @param ns (`function`) the shiny namespace function.
#' @param single_data_extract_spec (`data_extract_spec`) the specification
#' for extraction of data during the application initialization.
#'
#' Generated by [data_extract_spec()].
#'
#' @return `shiny.tag` with the HTML code for the panel.
#'
#' @keywords internal
#'
cond_data_extract_single_ui <- function(ns, single_data_extract_spec) {
dataname <- single_data_extract_spec$dataname
conditionalPanel(
condition = paste0("input['", ns("dataset"), "'] == '", dataname, "'"),
data_extract_single_ui(
id = ns(id_for_dataset(dataname)),
single_data_extract_spec = single_data_extract_spec
)
)
}
#' `teal` data extraction module user-interface
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' @details
#' There are three inputs that will be rendered
#'
#' 1. Dataset select Optional. If more than one [data_extract_spec] is handed over
#' to the function, a shiny [shiny::selectInput] will be rendered. Else just the name
#' of the dataset is given.
#' 2. Filter Panel Optional. If the [data_extract_spec] contains a
#' filter element a shiny [shiny::selectInput] will be rendered with the options to
#' filter the dataset.
#' 3. Select panel A shiny [shiny::selectInput] to select columns from the dataset to
#' go into the analysis.
#'
#' The output can be analyzed using `data_extract_srv(...)`.
#'
#' This functionality should be used in the encoding panel of your `teal` app.
#' It will allow app-developers to specify a [data_extract_spec()] object.
#' This object should be used to `teal` module variables being filtered data
#' from CDISC datasets.
#'
#' You can use this function in the same way as any
#' [`shiny module`](https://shiny.rstudio.com/articles/modules.html) UI.
#' The corresponding server module can be found in [data_extract_srv()].
#'
#' @param id (`character`) shiny input unique identifier.
#' @param label (`character`) Label above the data extract input.
#' @param data_extract_spec (`list` of `data_extract_spec`)
#' This is the outcome of listing [data_extract_spec()] constructor calls.
#' @param is_single_dataset (`logical`) `FALSE` to display the dataset widget.
#'
#' @return Shiny [`shiny::selectInput`]`s` that allow to define how to extract data from
#' a specific dataset. The input elements will be returned inside a [shiny::div] container.
#'
#' @examples
#' library(shiny)
#' library(teal.widgets)
#'
#' adtte_filters <- filter_spec(
#' vars = c("PARAMCD", "CNSR"),
#' sep = "-",
#' choices = c("OS-1" = "OS-1", "OS-0" = "OS-0", "PFS-1" = "PFS-1"),
#' selected = "OS-1",
#' multiple = FALSE,
#' label = "Choose endpoint and Censor"
#' )
#'
#' response_spec <- data_extract_spec(
#' dataname = "ADTTE",
#' filter = adtte_filters,
#' select = select_spec(
#' choices = c("AVAL", "BMRKR1", "AGE"),
#' selected = c("AVAL", "BMRKR1"),
#' multiple = TRUE,
#' fixed = FALSE,
#' label = "Column"
#' )
#' )
#' # Call to use inside your teal module UI function
#' standard_layout(
#' output = tableOutput("table"),
#' encoding = div(
#' data_extract_ui(
#' id = "regressor",
#' label = "Regressor Variable",
#' data_extract_spec = response_spec
#' )
#' )
#' )
#'
#' @export
#'
data_extract_ui <- function(id, label, data_extract_spec, is_single_dataset = FALSE) {
ns <- NS(id)
if (inherits(data_extract_spec, "data_extract_spec")) {
data_extract_spec <- list(data_extract_spec)
}
check_data_extract_spec(data_extract_spec)
if (is.null(data_extract_spec)) {
return(helpText(sprintf("Data extraction with label '%s' is NULL. Please contact the app author.", label)))
}
stopifnot(
`more than one dataset in data_extract_spec but is_single_dataset parameter is set to TRUE` =
!is_single_dataset || length(data_extract_spec) == 1
)
dataset_names <- vapply(
data_extract_spec,
function(x) x$dataname,
character(1),
USE.NAMES = FALSE
)
stopifnot(`list contains data_extract_spec objects with the same dataset` = all(!duplicated(dataset_names)))
dataset_input <- if (is_single_dataset) {
NULL
} else {
if (length(dataset_names) == 1) {
if ((is.null(data_extract_spec[[1]]$filter)) &&
(
!is.null(data_extract_spec[[1]]$select$fixed) &&
data_extract_spec[[1]]$select$fixed == TRUE
)) {
NULL
} else {
helpText("Dataset:", tags$code(dataset_names))
}
} else {
teal.widgets::optionalSelectInput(
inputId = ns("dataset"),
label = "Dataset",
choices = dataset_names,
selected = dataset_names[1],
multiple = FALSE
)
}
}
tagList(
include_css_files(pattern = "data_extract"),
div(
class = "data-extract",
tags$label(label),
dataset_input,
if (length(dataset_names) == 1) {
data_extract_single_ui(
id = ns(id_for_dataset(dataset_names)),
single_data_extract_spec = data_extract_spec[[1]]
)
} else {
do.call(
div,
unname(lapply(
data_extract_spec,
function(x) {
cond_data_extract_single_ui(ns, x)
}
))
)
}
)
)
}
#' Function to check data_extract_specs
#'
#' Checks if `dataname` argument exists as a dataset.
#' Checks if selected or filter columns exist within the datasets. Throws a `shiny`
#' validation error if the above requirements are not met.
#'
#' @param datasets (`FilteredData`) the object created using the `teal` API.
#' @param data_extract (`list`) the output of the `data_extract` module.
#'
#' @return `NULL`.
#'
#' @keywords internal
#'
check_data_extract_spec_react <- function(datasets, data_extract) {
if (!all(unlist(lapply(data_extract, `[[`, "dataname")) %in% datasets$datanames())) {
shiny::validate(
"Error in data_extract_spec setup:\
Data extract spec contains datasets that were not handed over to the teal app."
)
}
column_return <- unlist(lapply(
data_extract,
function(data_extract_spec) {
columns_filter <- if (is.null(data_extract_spec$filter)) {
NULL
} else {
unique(unlist(lapply(
data_extract_spec$filter,
function(x) {
if (inherits(x, "filter_spec")) {
x$vars_choices
} else {
stop("Unsupported object class")
}
}
)))
}
columns_ds <- unique(c(
data_extract_spec$select$choices,
columns_filter
))
if (!all(columns_ds %in% names(datasets$get_data(data_extract_spec$dataname, filtered = FALSE)))) {
non_columns <- columns_ds[!columns_ds %in% names(
datasets$get_data(data_extract_spec$dataname, filtered = FALSE)
)]
paste0(
"Error in data_extract_spec setup: ",
"Column '",
non_columns,
"' is not inside dataset '",
data_extract_spec$dataname, "'."
)
}
}
))
if (!is.null(column_return)) shiny::validate(unlist(column_return))
NULL
}
#' Extraction of the selector(s) details
#'
#' @description
#' `r lifecycle::badge("stable")`
#'
#' Extracting details of the selection(s) in [data_extract_ui] elements.
#'
#' @inheritParams shiny::moduleServer
#' @param datasets (`FilteredData` or `list` of `reactive` or non-`reactive` `data.frame`)
#' object containing data either in the form of `FilteredData` or as a list of `data.frame`.
#' When passing a list of non-reactive `data.frame` objects, they are converted to reactive `data.frame`s internally.
#' When passing a list of reactive or non-reactive `data.frame` objects, the argument `join_keys` is required also.
#' @param data_extract_spec (`data_extract_spec` or a list of `data_extract_spec`)
#' A list of data filter and select information constructed by [data_extract_spec].
#' @param ... An additional argument `join_keys` is required when `datasets` is a list of `data.frame`.
#' It shall contain the keys per dataset in `datasets`.
#'
#' @return A reactive `list` containing following fields:
#'
#' * `filters`: A list with the information on the filters that are applied to the data set.
#' * `select`: The variables that are selected from the dataset.
#' * `always_selected`: The column names from the data set that should always be selected.
#' * `reshape`: Whether reshape long to wide should be applied or not.
#' * `dataname`: The name of the data set.
#' * `internal_id`: The `id` of the corresponding shiny input element.
#' * `keys`: The names of the columns that can be used to merge the data set.
#' * `iv`: A `shinyvalidate::InputValidator` containing `validator` for this `data_extract`.
#'
#' @references [data_extract_srv]
#'
#' @examples
#' library(shiny)
#' library(shinyvalidate)
#' library(teal.data)
#' library(teal.widgets)
#'
#' # Sample ADSL dataset
#' ADSL <- data.frame(
#' STUDYID = "A",
#' USUBJID = LETTERS[1:10],
#' SEX = rep(c("F", "M"), 5),
#' AGE = rpois(10, 30),
#' BMRKR1 = rlnorm(10)
#' )
#'
#' # Specification for data extraction
#' adsl_extract <- data_extract_spec(
#' dataname = "ADSL",
#' filter = filter_spec(vars = "SEX", choices = c("F", "M"), selected = "F"),
#' select = select_spec(
#' label = "Select variable:",
#' choices = variable_choices(ADSL, c("AGE", "BMRKR1")),
#' selected = "AGE",
#' multiple = TRUE,
#' fixed = FALSE
#' )
#' )
#'
#' # Using reactive list of data.frames
#' data_list <- list(ADSL = reactive(ADSL))
#'
#' join_keys <- join_keys(join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")))
#'
#' # App: data extraction with validation
#' ui <- fluidPage(
#' standard_layout(
#' output = verbatimTextOutput("out1"),
#' encoding = tagList(
#' data_extract_ui(
#' id = "adsl_var",
#' label = "ADSL selection",
#' data_extract_spec = adsl_extract
#' )
#' )
#' )
#' )
#' server <- function(input, output, session) {
#' adsl_reactive_input <- data_extract_srv(
#' id = "adsl_var",
#' datasets = data_list,
#' data_extract_spec = adsl_extract,
#' join_keys = join_keys,
#' select_validation_rule = sv_required("Please select a variable.")
#' )
#'
#' iv_r <- reactive({
#' iv <- InputValidator$new()
#' iv$add_validator(adsl_reactive_input()$iv)
#' iv$enable()
#' iv
#' })
#'
#' output$out1 <- renderPrint({
#' if (iv_r()$is_valid()) {
#' cat(format_data_extract(adsl_reactive_input()))
#' } else {
#' "Please fix errors in your selection"
#' }
#' })
#' }
#'
#' if (interactive()) {
#' shinyApp(ui, server)
#' }
#'
#' # App: simplified data extraction
#' ui <- fluidPage(
#' standard_layout(
#' output = verbatimTextOutput("out1"),
#' encoding = tagList(
#' data_extract_ui(
#' id = "adsl_var",
#' label = "ADSL selection",
#' data_extract_spec = adsl_extract
#' )
#' )
#' )
#' )
#'
#' server <- function(input, output, session) {
#' adsl_reactive_input <- data_extract_srv(
#' id = "adsl_var",
#' datasets = data_list,
#' data_extract_spec = adsl_extract
#' )
#'
#' output$out1 <- renderPrint(adsl_reactive_input())
#' }
#'
#' if (interactive()) {
#' shinyApp(ui, server)
#' }
#'
#' @export
#'
data_extract_srv <- function(id, datasets, data_extract_spec, ...) {
checkmate::assert_multi_class(datasets, c("FilteredData", "list"))
checkmate::assert(
checkmate::check_class(data_extract_spec, "data_extract_spec"),
checkmate::check_list(data_extract_spec, "data_extract_spec")
)
UseMethod("data_extract_srv", datasets)
}
#' @rdname data_extract_srv
#' @export
#'
data_extract_srv.FilteredData <- function(id, datasets, data_extract_spec, ...) {
checkmate::assert_class(datasets, "FilteredData")
moduleServer(
id,
function(input, output, session) {
logger::log_trace(
"data_extract_srv.FilteredData initialized with datasets: { paste(datasets$datanames(), collapse = ', ') }."
)
data_list <- sapply(X = datasets$datanames(), simplify = FALSE, FUN = function(x) {
reactive(datasets$get_data(dataname = x, filtered = TRUE))
})
join_keys <- datasets$get_join_keys()
filter_and_select_reactive <- data_extract_srv(
id = NULL,
datasets = data_list,
data_extract_spec = data_extract_spec,
join_keys = join_keys
)
filter_and_select_reactive
}
)
}
#' @rdname data_extract_srv
#'
#' @param join_keys (`join_keys` or `NULL`) of keys per dataset in `datasets`.
#' @param select_validation_rule (`NULL` or `function`)
#' Should there be any `shinyvalidate` input validation of the select parts of the `data_extract_ui`.
#'
#' You can use a validation function directly (i.e. `select_validation_rule = shinyvalidate::sv_required()`)
#' or for more fine-grained control use a function:
#'
#' `select_validation_rule = ~ if (length(.) > 2) "Error"`.
#'
#' If `NULL` then no validation will be added. See example for more details.
#' @param filter_validation_rule (`NULL` or `function`) Same as
#' `select_validation_rule` but for the filter (values) part of the `data_extract_ui`.
#' @param dataset_validation_rule (`NULL` or `function`) Same as
#' `select_validation_rule` but for the choose dataset part of the `data_extract_ui`
#' @export
#'
data_extract_srv.list <- function(id,
datasets,
data_extract_spec,
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")
},
...) {
checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
checkmate::assert_multi_class(select_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
checkmate::assert_multi_class(filter_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
checkmate::assert_multi_class(dataset_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
moduleServer(
id,
function(input, output, session) {
logger::log_trace(
"data_extract_srv.list initialized with datasets: { paste(names(datasets), collapse = ', ') }."
)
# get keys out of join_keys
if (length(join_keys)) {
keys <- sapply(names(datasets), simplify = FALSE, function(x) join_keys[x, x])
} else {
keys <- sapply(names(datasets), simplify = FALSE, function(x) character(0))
}
# convert to list of reactives
datasets <- sapply(X = datasets, simplify = FALSE, FUN = function(x) {
if (is.reactive(x)) x else reactive(x)
})
if (inherits(data_extract_spec, "data_extract_spec")) {
data_extract_spec <- list(data_extract_spec)
}
for (idx in seq_along(data_extract_spec)) {
if (inherits(data_extract_spec[[idx]]$filter, "filter_spec")) {
data_extract_spec[[idx]]$filter <- list(data_extract_spec[[idx]]$filter)
}
}
if (is.null(data_extract_spec)) {
return(reactive(NULL))
}
check_data_extract_spec(data_extract_spec = data_extract_spec)
# Each dataset needs its own shinyvalidate to make sure only the
# currently visible d-e-s's validation is used
iv <- lapply(data_extract_spec, function(x) {
iv_dataset <- shinyvalidate::InputValidator$new()
if (!is.null(dataset_validation_rule) && length(data_extract_spec) > 1) {
iv_dataset$add_rule("dataset", dataset_validation_rule)
}
iv_dataset
})
names(iv) <- lapply(data_extract_spec, `[[`, "dataname")
# also need a final iv for the case where no dataset is selected
iv[["blank_dataset_case"]] <- shinyvalidate::InputValidator$new()
if (!is.null(dataset_validation_rule) && length(data_extract_spec) > 1) {
iv[["blank_dataset_case"]]$add_rule("dataset", dataset_validation_rule)
}
filter_and_select <- lapply(data_extract_spec, function(x) {
data_extract_single_srv(
id = id_for_dataset(x$dataname),
datasets = datasets,
single_data_extract_spec = x
)
data_extract_read_srv(
id = id_for_dataset(x$dataname),
datasets = datasets,
single_data_extract_spec = x,
iv = iv[[x$dataname]],
select_validation_rule = select_validation_rule,
filter_validation_rule = filter_validation_rule
)
})
names(filter_and_select) <- sapply(data_extract_spec, function(x) x$dataname)
dataname <- reactive({
# For fixed data sets, ignore input_value
if (is.null(input$dataset) && length(data_extract_spec) < 2) {
data_extract_spec[[1]]$dataname
# For data set selectors, return NULL if NULL
} else {
input$dataset
}
})
filter_and_select_reactive <- reactive({
if (is.null(dataname())) {
list(iv = iv[["blank_dataset_case"]])
} else {
append(
filter_and_select[[dataname()]](),
list(
dataname = dataname(),
internal_id = gsub("^.*-(.+)$", "\\1", session$ns(NULL)), # parent module id
keys = keys[[dataname()]]
)
)
}
})
filter_and_select_reactive
}
)
}
#' Creates a named list of `data_extract_srv` output
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' `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.
#'
#' @inheritParams data_extract_srv
#' @param 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.
#'
#' @return 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))
#'
#' 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()) {
#' shinyApp(ui, server)
#' }
#' @export
#'
data_extract_multiple_srv <- function(data_extract, datasets, ...) {
checkmate::assert_list(data_extract, names = "named")
checkmate::assert_multi_class(datasets, c("reactive", "FilteredData", "list"))
lapply(data_extract, function(x) {
if (is.list(x) && !inherits(x, "data_extract_spec")) {
checkmate::assert_list(x, "data_extract_spec")
}
})
UseMethod("data_extract_multiple_srv", datasets)
}
#' @rdname data_extract_multiple_srv
#' @export
#'
data_extract_multiple_srv.reactive <- function(data_extract, datasets, ...) {
# convert reactive containing teal_data to list of reactives with one dataset each
datasets_new <- convert_teal_data(datasets)
data_extract_multiple_srv.list(data_extract, datasets_new, ...)
}
#' @rdname data_extract_multiple_srv
#' @export
#'
data_extract_multiple_srv.FilteredData <- function(data_extract, datasets, ...) {
checkmate::assert_class(datasets, classes = "FilteredData")
logger::log_trace(
"data_extract_multiple_srv.filteredData initialized with dataset: { paste(datasets$datanames(), collapse = ', ') }."
)
data_list <- sapply(X = datasets$datanames(), simplify = FALSE, FUN = function(x) {
reactive(datasets$get_data(dataname = x, filtered = TRUE))
})
join_keys <- datasets$get_join_keys()
data_extract_multiple_srv(data_extract = data_extract, datasets = data_list, join_keys = join_keys)
}
#' @rdname data_extract_multiple_srv
#'
#' @param join_keys (`join_keys` or `NULL`) of join keys per dataset in `datasets`.
#' @param select_validation_rule (`NULL` or `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.
#' @param filter_validation_rule (`NULL` or `function` or `named list` of `function`) Same as
#' `select_validation_rule` but for the filter (values) part of the `data_extract_ui`.
#' @param dataset_validation_rule (`NULL` or `function` or `named list` of `function`) Same as
#' `select_validation_rule` but for the choose dataset part of the `data_extract_ui`
#'
#' @export
#'
data_extract_multiple_srv.list <- function(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")
},
...) {
checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
checkmate::assert(
checkmate::check_multi_class(select_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
checkmate::check_list(select_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
)
checkmate::assert(
checkmate::check_multi_class(filter_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
checkmate::check_list(filter_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
)
checkmate::assert(
checkmate::check_multi_class(dataset_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
checkmate::check_list(dataset_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
)
logger::log_trace(
"data_extract_multiple_srv.list initialized with dataset: { paste(names(datasets), collapse = ', ') }."
)
data_extract <- Filter(Negate(is.null), data_extract)
if (is.function(select_validation_rule)) {
select_validation_rule <- sapply(
names(data_extract),
simplify = FALSE,
USE.NAMES = TRUE,
function(x) select_validation_rule
)
}
if (is.function(dataset_validation_rule)) {
dataset_validation_rule <- sapply(
names(data_extract),
simplify = FALSE,
USE.NAMES = TRUE,
function(x) dataset_validation_rule
)
}
reactive({
sapply(
X = names(data_extract),
simplify = FALSE,
USE.NAMES = TRUE,
function(x) {
data_extract_srv(
id = x,
data_extract_spec = data_extract[[x]],
datasets = datasets,
join_keys = join_keys,
select_validation_rule = select_validation_rule[[x]],
filter_validation_rule = filter_validation_rule[[x]],
dataset_validation_rule = dataset_validation_rule[[x]]
)
}
)
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.