picks

.lintr

@@ -1,5 +1,6 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
   cyclocomp_linter = NULL,
-  object_usage_linter = NULL
+  object_usage_linter = NULL,
+  pipe_consistency_linter = NULL
   )

DESCRIPTION

@@ -6,21 +6,34 @@ Date: 2026-01-07
 Authors@R:
     person("insightsengineering", , , "insightsengineering@example.com", role = c("aut", "cre"))
 Description: R package template with GitHub Actions workflows included.
-License: Apache License 2.0 | file LICENSE
+License: Apache License 2.0
 URL: https://github.com/insightsengineering/teal.picks/
 BugReports: https://github.com/insightsengineering/teal.picks/issues
 Depends:
     R (>= 3.6)
 Imports:
-    plumber,
+    bsicons,
+    checkmate,
+    dplyr,
+    htmltools,
+    logger,
+    methods,
+    rlang,
     shiny,
-    stringr
+    shinyWidgets,
+    teal,
+    teal.code,
+    teal.data,
+    teal.logger,
+    tidyselect,
+    yaml
 Suggests:
-    future,
-    httr,
     knitr,
+    rvest,
     shinytest2,
-    testthat (>= 3.0)
+    teal.transform,
+    testthat (>= 3.0),
+    tibble
 VignetteBuilder:
     knitr
 Encoding: UTF-8

NAMESPACE

@@ -0,0 +1,40 @@
+# 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(determine,datasets)
+S3method(determine,values)
+S3method(determine,variables)
+S3method(format,pick)
+S3method(format,picks)
+S3method(picks_srv,list)
+S3method(picks_srv,picks)
+S3method(picks_ui,list)
+S3method(picks_ui,picks)
+S3method(print,pick)
+S3method(print,picks)
+export(as.picks)
+export(datasets)
+export(is_categorical)
+export(merge_srv)
+export(picks)
+export(picks_srv)
+export(picks_ui)
+export(resolver)
+export(teal_transform_filter)
+export(tm_merge)
+export(values)
+export(variables)
+import(shiny)

NEWS.md

@@ -0,0 +1,16 @@
+# teal.picks 0.1.0.9211
+
+### New Features
+
+* Added `picks()`, `datasets()`, `variables()`, and `values()` functions for defining hierarchical data selections (dataset -> variable -> value).
+* Added `picks_ui()` and `picks_srv()` Shiny modules for interactive selection widgets with badge drop-down UI.
+* Added `resolver()` to resolve delayed and dynamic choices using `tidyselect` expressions and predicate functions.
+* Added `merge_srv()` for merging multiple datasets based on picks selections, with automatic join key detection and conflict resolution.
+* Added `tm_merge()` teal module for interactive dataset merging with generated R code.
+* Added `as.picks()` for converting `teal.transform::data_extract_spec` objects to picks.
+* Added `teal_transform_filter()` for creating filter transformers from picks selections.
+* Added `is_categorical()` `tidyselect` helper for selecting categorical variables with cardinality constraints.
+
+### Miscellaneous
+
+* Initial public release.

R/0-as_picks.R

@@ -0,0 +1,239 @@
+#' Convert data_extract_spec to picks
+#'
+#' @description
+#' `r lifecycle::badge("experimental")`
+#' Helper functions to ease transition between [teal.transform::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(
+#'   teal.transform::data_extract_spec(
+#'     dataname = "iris",
+#'     teal.transform::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(
+#'   teal.transform::data_extract_spec(
+#'     dataname = "iris",
+#'     teal.transform::select_spec(
+#'       choices = teal.transform::variable_choices("iris"),
+#'       selected = teal.transform::first_choice(),
+#'       multiple = TRUE,
+#'       ordered = TRUE
+#'     )
+#'   )
+#' )
+#'
+#' as.picks(
+#'   teal.transform::data_extract_spec(
+#'     dataname = "iris",
+#'     teal.transform::select_spec(
+#'       choices = teal.transform::variable_choices(
+#'         "iris",
+#'         subset = function(data) names(Filter(is.numeric, data))
+#'       ),
+#'       selected = teal.transform::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)
+      )
+    )
+    do.call(picks, args)
+  } else if (inherits(x, "select_spec")) {
+    .select_spec_to_variables(x)
+  } else if (inherits(x, "filter_spec")) {
+    # filter_spec is necessary linked with `select` (selected variables)
+    # so  in most of the cases it can't beconverted into variables/values
+    # because filter_spec can be specified on the variable(s) different than select_spec for example (pseudocode):
+    #    select_spec "AVAL"
+    #    filter_spec "PARAMCD"
+    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(
+#'   teal.transform::data_extract_spec(
+#'     dataname = "iris",
+#'     filter = teal.transform::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)
+          shiny::reactive({
+            shiny::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(
+        "teal.transform::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(
+        "teal.transform::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
+    )
+  }
+}

R/0-badge_dropdown.R

@@ -0,0 +1,39 @@
+#' Drop-down badge
+#'
+#' Drop-down button in a form of a badge with `bg-primary` as default style
+#' Clicking badge shows a drop-down containing any `HTML` element. Folded drop-down
+#' doesn't trigger display output which means that items rendered using `render*`
+#' will be recomputed only when drop-down is show.
+#'
+#' @param id (`character(1)`) shiny module's id
+#' @param label (`shiny.tag`) Label displayed on a badge.
+#' @param content (`shiny.tag`) Content of a drop-down.
+#' @keywords internal
+badge_dropdown <- function(id, label, content) {
+  ns <- shiny::NS(id)
+  htmltools::tagList(
+    htmltools::singleton(htmltools::tags$head(
+      htmltools::includeCSS(system.file("badge-dropdown", "style.css", package = "teal.picks")),
+      htmltools::includeScript(system.file("badge-dropdown", "script.js", package = "teal.picks"))
+    )),
+    htmltools::tags$div(
+      class = "badge-dropdown-wrapper",
+      htmltools::tags$span(
+        id = ns("summary_badge"),
+        class = "badge bg-primary rounded-pill badge-dropdown",
+        tags$span(class = "badge-dropdown-label", label),
+        tags$span(class = "badge-dropdown-icon", bsicons::bs_icon("caret-down-fill")),
+        onclick = sprintf("toggleBadgeDropdown('%s', '%s')", ns("summary_badge"), ns("inputs_container"))
+      ),
+      htmltools::tags$div(
+        content,
+        id = ns("inputs_container"),
+        style = paste(
+          "visibility: hidden; opacity: 0; pointer-events: none; position: absolute; background: white;",
+          "border: 1px solid #ccc; border-radius: 4px; box-shadow: 0 2px 10px rgba(0,0,0,0.1);",
+          "padding: 10px; z-index: 1000; min-width: 200px; transition: opacity 0.2s ease;"
+        )
+      )
+    )
+  )
+}