picks

DESCRIPTION

@@ -21,6 +21,7 @@ BugReports: https://github.com/insightsengineering/teal.transform/issues
 Depends:
     R (>= 3.6)
 Imports:
+    bsicons,
     checkmate (>= 2.1.0),
     dplyr (>= 1.1.0),
     htmltools,
@@ -30,19 +31,25 @@ Imports:
     shiny (>= 1.6.0),
     shinyjs (>= 2.1.0),
     shinyvalidate (>= 0.1.3),
+    shinyWidgets,
     stats,
+    teal,
+    teal.code,
     teal.data (>= 0.8.0),
     teal.logger (>= 0.4.0),
     teal.widgets (>= 0.5.0),
     tidyr (>= 1.0.0),
     tidyselect (>= 1.2.1),
-    utils
+    utils,
+    yaml
 Suggests:
     bslib (>= 0.8.0),
     knitr (>= 1.42),
     rmarkdown (>= 2.23),
+    rvest,
     roxy.shinylive (>= 1.0.0),
     testthat (>= 3.1.5),
+    tibble,
     withr (>= 2.0.0)
 VignetteBuilder:
     knitr,
@@ -58,4 +65,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3

NAMESPACE

@@ -1,16 +1,39 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(.is_delayed,default)
+S3method(.is_delayed,list)
+S3method(.is_delayed,pick)
+S3method(.picker_icon,Date)
+S3method(.picker_icon,POSIXct)
+S3method(.picker_icon,POSIXlt)
+S3method(.picker_icon,character)
+S3method(.picker_icon,data.frame)
+S3method(.picker_icon,default)
+S3method(.picker_icon,factor)
+S3method(.picker_icon,integer)
+S3method(.picker_icon,logical)
+S3method(.picker_icon,numeric)
+S3method(.picker_icon,primary_key)
 S3method(data_extract_multiple_srv,FilteredData)
 S3method(data_extract_multiple_srv,list)
 S3method(data_extract_multiple_srv,reactive)
 S3method(data_extract_srv,FilteredData)
 S3method(data_extract_srv,list)
+S3method(determine,datasets)
+S3method(determine,values)
+S3method(determine,variables)
 S3method(filter_spec_internal,default)
 S3method(filter_spec_internal,delayed_data)
+S3method(format,pick)
+S3method(format,picks)
 S3method(merge_expression_module,list)
 S3method(merge_expression_module,reactive)
 S3method(merge_expression_srv,list)
 S3method(merge_expression_srv,reactive)
+S3method(picks_srv,list)
+S3method(picks_srv,picks)
+S3method(picks_ui,list)
+S3method(picks_ui,picks)
 S3method(print,choices_labeled)
 S3method(print,delayed_choices_selected)
 S3method(print,delayed_data_extract_spec)
@@ -19,6 +42,8 @@ S3method(print,delayed_select_spec)
 S3method(print,delayed_value_choices)
 S3method(print,delayed_variable_choices)
 S3method(print,filter_spec)
+S3method(print,pick)
+S3method(print,picks)
 S3method(resolve,default)
 S3method(resolve,delayed_choices_selected)
 S3method(resolve,delayed_data_extract_spec)
@@ -36,6 +61,7 @@ S3method(variable_choices,data.frame)
 export("%>%")
 export(add_no_selected_choices)
 export(all_choices)
+export(as.picks)
 export(check_no_multiple_selection)
 export(choices_labeled)
 export(choices_selected)
@@ -45,6 +71,7 @@ export(data_extract_spec)
 export(data_extract_srv)
 export(data_extract_ui)
 export(datanames_input)
+export(datasets)
 export(filter_spec)
 export(first_choice)
 export(first_choices)
@@ -55,20 +82,30 @@ export(get_extract_datanames)
 export(get_merge_call)
 export(get_relabel_call)
 export(is.choices_selected)
+export(is_categorical)
 export(is_single_dataset)
 export(last_choice)
 export(last_choices)
 export(list_extract_spec)
 export(merge_datasets)
 export(merge_expression_module)
 export(merge_expression_srv)
+export(merge_srv)
 export(no_selected_as_NULL)
+export(picks)
+export(picks_srv)
+export(picks_ui)
 export(resolve_delayed)
+export(resolver)
 export(select_spec)
 export(select_spec.default)
 export(select_spec.delayed_data)
 export(split_by_sep)
+export(teal_transform_filter)
+export(tm_merge)
 export(value_choices)
+export(values)
 export(variable_choices)
+export(variables)
 import(shiny)
 importFrom(dplyr,"%>%")

R/0-as_picks.R

@@ -0,0 +1,235 @@
+#' Convert data_extract_spec to picks
+#'
+#' @description
+#' `r lifecycle::badge("experimental")`
+#' Helper functions to ease transition between [data_extract_spec()] and [picks()].
+#' @inheritParams teal::teal_transform_module
+#' @param x (`data_extract_spec`, `select_spec`, `filter_spec`) object to convert to [`picks`]
+#' @details
+#' With introduction of [`picks`], [`data_extract_spec`] will no longer serve a primary tool to
+#' define variable choices and default selection in teal-modules and eventually [`data_extract_spec`]
+#' will be deprecated.
+#' To ease the transition to the new tool, we provide `as.picks` method which can handle 1:1
+#' conversion from [`data_extract_spec`] to [`picks`]. Unfortunately, when [`data_extract_spec`]
+#' contains [`filter_spec`] then `as.picks` is unable to provide reliable [`picks`] equivalent.
+#'
+#' @examples
+#' # convert des with eager select_spec
+#' as.picks(
+#'   data_extract_spec(
+#'     dataname = "iris",
+#'     select_spec(
+#'       choices = c("Sepal.Length", "Sepal.Width", "Species"),
+#'       selected = c("Sepal.Length", "Species"),
+#'       multiple = TRUE,
+#'       ordered = TRUE
+#'     )
+#'   )
+#' )
+#'
+#' # convert des with delayed select_spec
+#' as.picks(
+#'   data_extract_spec(
+#'     dataname = "iris",
+#'     select_spec(
+#'       choices = variable_choices("iris"),
+#'       selected = first_choice(),
+#'       multiple = TRUE,
+#'       ordered = TRUE
+#'     )
+#'   )
+#' )
+#'
+#' as.picks(
+#'   data_extract_spec(
+#'     dataname = "iris",
+#'     select_spec(
+#'       choices = variable_choices("iris", subset = function(data) names(Filter(is.numeric, data))),
+#'       selected = first_choice(),
+#'       multiple = TRUE,
+#'       ordered = TRUE
+#'     )
+#'   )
+#' )
+#'
+#' @export
+as.picks <- function(x) { # nolint
+  if (inherits(x, c("picks", "pick"))) {
+    x
+  } else if (checkmate::test_list(x, c("data_extract_spec", "filter_spec"))) {
+    Filter(length, lapply(x, as.picks))
+  } else if (inherits(x, "data_extract_spec")) {
+    args <- Filter(
+      length,
+      list(
+        datasets(choices = x$dataname, fixed = TRUE),
+        as.picks(x$select),
+        as.picks(x$filter)
+        # filter_spec as they are not necessary linked with `select` (selected variables)
+        #  as filter_spec can be specified on the variable(s) different than select_spec for example:
+        #  for example: #pseudocode select = select_spec(AVAL); filter = filter_spec(PARAMCD))
+      )
+    )
+    do.call(picks, args)
+  } else if (inherits(x, "select_spec")) {
+    .select_spec_to_variables(x)
+  } else if (inherits(x, "filter_spec")) {
+    # warning
+    warning(
+      "`filter_spec` are not convertible to picks - please use `transformers` argument",
+      "and create `teal_transform_module` containing necessary filter. See `?teal_transform_filter`"
+    )
+
+    NULL
+  }
+}
+
+#' @rdname as.picks
+#' @examples
+#' # teal_transform_module build on teal.transform
+#'
+#' teal_transform_filter(
+#'   data_extract_spec(
+#'     dataname = "iris",
+#'     filter = filter_spec(
+#'       vars = "Species",
+#'       choices = c("setosa", "versicolor", "virginica"),
+#'       selected = c("setosa", "versicolor")
+#'     )
+#'   )
+#' )
+#'
+#' teal_transform_filter(
+#'   picks(
+#'     datasets(choices = "iris", select = "iris"),
+#'     variables(choices = "Species", "Species"),
+#'     values(
+#'       choices = c("setosa", "versicolor", "virginica"),
+#'       selected = c("setosa", "versicolor")
+#'     )
+#'   )
+#' )
+#'
+#' @export
+teal_transform_filter <- function(x, label = "Filter") {
+  checkmate::assert_multi_class(x, c("data_extract_spec", "picks"))
+  if (inherits(x, "data_extract_spec")) {
+    lapply(.as.picks.filter(x), teal_transform_filter, label = label)
+  } else {
+    checkmate::assert_true("values" %in% names(x))
+    teal::teal_transform_module(
+      label = label,
+      ui <- function(id) {
+        ns <- NS(id)
+        picks_ui(ns("transformer"), picks = x, container = div)
+      },
+      server <- function(id, data) {
+        shiny::moduleServer(id, function(input, output, session) {
+          selector <- picks_srv("transformer", picks = x, data = data)
+          reactive({
+            req(data(), selector())
+            filter_call <- .make_filter_call(
+              datasets = selector()$datasets$selected,
+              variables = selector()$variables$selected,
+              values = selector()$values$selected
+            )
+            teal.code::eval_code(data(), filter_call)
+          })
+        })
+      }
+    )
+  }
+}
+
+.as.picks.filter <- function(x, dataname) { # nolint
+  if (inherits(x, "filter_spec")) {
+    if (inherits(x$choices, "delayed_data")) {
+      warning(
+        "filter_spec(choices) doesn't support delayed_data when using with teal_transform_filter. ",
+        "Setting to all possible choices..."
+      )
+      x$choices <- function(x) TRUE
+    }
+    if (inherits(x$selected, "delayed_data")) {
+      warning(
+        "filter_spec(selected) doesn't support delayed_data when using with teal_transform_filter. ",
+        "Setting to all possible choices..."
+      )
+      x$selected <- function(x) TRUE
+    }
+    picks(
+      datasets(choices = dataname, selected = dataname),
+      variables(choices = x$vars_choices, selected = x$vars_selected, multiple = FALSE), # can't be multiple
+      values(choices = x$choices, selected = x$selected, multiple = x$multiple)
+    )
+  } else if (checkmate::test_list(x, "filter_spec")) {
+    lapply(x, .as.picks.filter, dataname = dataname)
+  } else if (inherits(x, "data_extract_spec")) {
+    .as.picks.filter(x$filter, dataname = x$dataname)
+  } else if (checkmate::test_list(x, c("data_extract_spec", "list", "NULL"))) {
+    unlist(
+      lapply(Filter(length, x), .as.picks.filter),
+      recursive = FALSE
+    )
+  }
+}
+
+.make_filter_call <- function(datasets, variables, values) {
+  checkmate::assert_character(datasets)
+  checkmate::assert_character(variables)
+  checkmate::assert_character(values)
+  substitute(
+    dataname <- dplyr::filter(dataname, varname %in% values),
+    list(
+      dataname = as.name(datasets),
+      varname = if (length(variables) == 1) {
+        as.name(variables)
+      } else {
+        as.call(
+          c(
+            quote(paste),
+            lapply(variables, as.name),
+            list(sep = ", ")
+          )
+        )
+      },
+      values = values
+    )
+  )
+}
+
+.select_spec_to_variables <- function(x) {
+  if (length(x)) {
+    variables(
+      choices = if (inherits(x$choices, "delayed_data")) {
+        out <- x$choices$subset
+        if (is.null(out)) {
+          function(x) TRUE # same effect as tidyselect::everything
+        } else {
+          class(out) <- "des-delayed"
+          out
+        }
+      } else {
+        x$choices
+      },
+      selected = if (inherits(x$selected, "delayed_choices")) {
+        out <- x$selected
+        class(out) <- "des-delayed"
+        out
+      } else if (inherits(x$selected, "delayed_data")) {
+        out <- x$selected$subset
+        if (is.null(out)) {
+          1L
+        } else {
+          class(out) <- "des-delayed"
+          out
+        }
+      } else {
+        unname(x$selected)
+      },
+      ordered = x$ordered,
+      multiple = x$multiple,
+      fixed = x$fixed
+    )
+  }
+}