Adds interaction variable to picks

[averissimo]

Pull Request

Fixes insightsengineering/teal.picks#9

Changes description

• Adds tidyselect selector interaction_var() that allows the creation of composed variables of 2 elements.
• 2 implementation options explored:
  1. using an expression parser (very hardcoded and removed since)
  2. using a environment inside teal.transform to keep track of sideeffect

note: tests to be expanded as merge_srv is not being tested

Example app (updated)

# merge example
pkgload::load_all("teal.transform")

library(teal.transform)
library(teal.data)
library(shiny)
#'
# Prepare data with join keys
data <- teal_data()
data <- within(data, {
  ADSL <- teal.data::rADSL
  ADAE <- teal.data::rADAE
})
join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADAE")]
#'
# Create Shiny app
ui <- fluidPage(
  tags$head(
    tags$link(
      rel = "stylesheet",
      href = "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/styles/default.min.css"
    ),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.9.0/highlight.min.js"),
      ),
  #
  picks_ui("adsl", picks(datasets("ADSL"), variables())),
  picks_ui("adae", picks(datasets("ADAE"), variables(multiple = TRUE), values())),
  shiny::uiOutput("code"),
  verbatimTextOutput("vars"),
  verbatimTextOutput("result")
)
#'
server <- function(input, output, session) {
  # Create selectors
  selectors <- list(
    adsl = picks_srv("adsl",
      data = reactive(data),
      picks = picks(datasets("ADSL"), variables())
    ),
    adae = picks_srv("adae",
      data = reactive(data),
      picks = suppressWarnings(picks(
        datasets("ADAE"),
        # variables(c(AGE, my_selector(RACE, ETHNIC), ETHNIC:DTHFL, "INVID~INVNAM")),
        variables(c(AGE, RACE, interaction_vars("RACE", ETHNIC)), selected = "RACE:ETHNIC", multiple = TRUE),
        # variables(c(AGE, ETHNIC:DTHFL, "INVID~INVNAM")),
        # variables(c("AGE", "RACE:DTHFL")),
      ))
    )
  )

  # Merge datasets
  merged <- merge_srv(
    id = "merge",
    data = reactive(data),
    selectors = selectors,
    output_name = "anl",
    join_fun = "dplyr::left_join"
  )

  val <- reactiveVal()
  vars <- reactiveVal()
  result <- reactiveVal()

  observeEvent(merged$data(), {
    val(teal.code::get_code(merged$data()))
    result(merged$data()$anl)
  })
  observeEvent(merged$variables(), vars(merged$variables()))

  # Display results
  output$code <- renderUI({
    code <- req(val())
    if (is.null(code)) {
      return(NULL)
    }

    styled_code <- paste(styler::style_text(gsub("%>%", "%>%\n", code, fixed = TRUE)), collapse = "\n")
    tagList(
      tags$pre(tags$code(class = "language-r", styled_code, .noWS = "outside"), .noWS = "outside"),
      tags$script(HTML("hljs.highlightAll();"))
    )
  })
  output$vars <- renderPrint(vars())
  output$result <- renderPrint(result())
  }
shinyApp(ui, server) |> shiny::runApp()

[averissimo]

Update to PR that improves the design by using S3 dispatch to generate code and handle all modifications

For a new operator user needs to define:

• <select_helper_function_name>
  • This needs to store in select_env an object with variables that compose the operator as well as the name it should use.
  • The detection of operators present in the variables() is done via this object.
• .operator_mutate.<class>
• .operator_mutate_args.<class>

[averissimo]

Moving this to teal.picks