Resolves #2172: Support data.frame as choices for selectize input

[landesfeind]

The support for data.frames is very helpful when providing custom renderer for layout of the drop-down options. As the internal data structure for the server-side selectize is a data.frame anyway, this is additionally convenient (see #2172)

The test-app below is an extension of #2102 which initially dropped the support for data.frames.

library(shiny)
bigvec <- paste0("a", 1:1e5)
named_bigvec <- setNames(bigvec, bigvec)
nested_biglist <- lapply(named_bigvec, function(item) setNames(list(item), item))
data_frame <- data.frame(
  label = c("Foo", "Bar"),
  value = c("foo", "bar"),
  html = c("F<span style=\"font-weight: bold\">oo</span>", "<span style=\"font-weight: bold\">B</span>ar")
)

test_set <- list(
  "Unnamed vector" = c(1, 2),
  "Named vector" = c(a = 1, B = 2),
  "Partially named vector" = c(a = 1, B = 2, 3),
  "Unnamed list" = list(1, 2),
  "Named list" = list(a = 1, B = 2, c = 3),
  "Partially named list" = list(a = 1, B = 2, 3),
  "Nested list" = list(a = 1, B = list(B = 2, C = 4, 5), c = list(3)),
  "Data frame (server-side only)" = data_frame,
  "Data frame HTML-Label (server-side only)" = data_frame,
  "Data frame Custom Render (server-side only)" = data_frame,
  "Big unnamed vector (server-side only)" = bigvec,
  "Big named vector (server-side only)" = named_bigvec,
  "Big unnamed list (server-side only)" = as.list(bigvec),
  "Big named list (server-side only)" = as.list(named_bigvec),
  "Big nested list (server-side only)" = nested_biglist
)

ui <- fluidPage(
  sidebarPanel(
    checkboxInput("server", "Force server-side filtering"),
    selectInput("set", "Test set", names(test_set)),
    selectizeInput("select", "Select", choices = NULL)
  ),
  mainPanel(
    verbatimTextOutput("txt")
  )
)

server <- function(input, output, session) {
  use_server_side <- shiny::reactive({
    (!is.null(input$server) && input$server) ||
      grepl("server-side", input$set)
  })

  observe({
    cat("starting updateSelectizeInput... ")

    options = list()
    if (grepl("Data frame HTML-Label", input$set)) {
      options = list(labelField = "html")
    }
    if (grepl("Custom Render", input$set)) {
      options[["render"]] = I("{
              option: function(item, escape) {
                return '<div>' + item.html +'</div>';
              }
          }")
    }

    updateSelectizeInput(
      session,
      "select",
      choices = test_set[[input$set]],
      selected = NULL,
      options = options,
      server = use_server_side()
    )
    cat("done\n")
  })

  output$txt = renderPrint({
    input$select
  })
}

# Launch app with external browser because RStudio's built-in browser might
# not be as fast.
shiny::runApp(shinyApp(ui, server), launch.browser = T)

[CLAassistant]

Thank you for your submission! We really appreciate it. Like many open source projects, we ask that you sign our Contributor License Agreement before we can accept your contribution.
_{You have signed the CLA already but the status is still pending? Let us recheck it.}

[schloerke]

@landesfeind I can not manually change the base merge branch. 😞

Do you mind resubmitting the PR? Sorry for the hassle. Thank you

[landesfeind]

Hi @schloerke, after the Shiny team ignored this +4 lines PR for 3 years, I kind of mind the hassle to do it. It does not seem that there is any interest...
The code is dead simple and nothing "intellectual property"-worthy. In case someone would be interest, that person is free to just use it...