如何使用动态选项为 Shiny selectizeInput 添加书签?

How to bookmark a Shiny selectizeInput with dynamic options?

Shiny 提供了一个包装 selectize.jsselectizeInput,它会生成一个文本输入/组合框小部件。我想延迟加载 selectizeInput 的 options/values 有几个原因:可能有很长的值列表,或者可能的值取决于其他参数。此外,我希望用户能够创建新值(例如,选择现有值或创建自己的值)。

但是在所有这些情况下,不能使用 Shiny 的服务器端书签来为 selectizeInput 的值添加书签。初始化 selectizeInput 对象时,存储在 input 中的书签值还不是有效的选项值。

是否有人有任何巧妙的解决方法来为 selectizeInput 值添加书签?

这是仅处理 create 选项的最简单示例:

library(shiny)

ui <- function(request) {
  fluidPage(

    selectizeInput("foo", "Created Values Cannot Be Bookmarked", choices=c("Choose From List or Type New Value"="", "bar", "baz"),
                   options=list(create=TRUE)),
    bookmarkButton("Update URL")

  )}

server <- function(input, output) {
  onBookmarked(function(url) {
    updateQueryString(url)
  })
}

shinyApp(ui = ui, server = server, enableBookmarking = "server")

如果您在选择框中键入新值,点击书签按钮更新浏览器地址栏中的 URL,然后点击重新加载,则创建的值将会丢失。对现有选项进行同样的尝试,当然可以。

如果延迟加载选项会变得更复杂,但问题是一样的,即在selectizeInput渲染时用户的选择无效。

这是一种解决方法,扩展了原始问题中的示例。在这个例子中,我还展示了延迟加载。

selectizeInput 的重复值存储在隐藏文本输入中。当加载书签值时,隐藏的备份值用于恢复真实值。要设置不在当前选项中的值,使用 shinyjs 将 selectize.js API 调用为 addOption 然后 addItem。请注意 input$foo 观察器上的 ignoreInit=TRUE 以便隐藏的备份不会在加载时被覆盖。另一方面,在输入 $foo.bak 观察器上设置了 once=TRUE,这样隐藏的备份仅在启动时用于更新一次真实值。请参阅 observeEvent.

的文档

selectizeInput 的选项仅在焦点位于输入上时才会异步加载,以加快初始页面加载速度。带有选择的 JSON 文件本地存储在 www/ 目录中。

这个例子也允许多选。所选项目存储在隐藏文本字段中 comma-delimited,然后在初始化期间展开。

library(shiny)
library(shinyjs)

# create JSON file with selectizeInput choices to be retrieved via ajax during load
# normally this would be run once outside of app.R
dir.create("www")
foo.choices.json <- paste('{ "cars": [\n', paste0('{ "value": "', rownames(mtcars), '", "label": "',rownames(mtcars), '" }', collapse=",\n" ), "\n]}")
writeChar(foo.choices.json, "www/foo.choices.json", eos=NULL)

# javascript to set one or more values
jsCode <- "shinyjs.setfoo = function(params){ 
  x=$('#foo')[0].selectize; 
  $.each(params.items, function(i,v) { x.addOption({value:v,label:v}); x.addItem(v) })
}"

# javascript to retrieve the choices asynchronously after focus
foo.load <- "function(query, callback) {
  if (query.length) return callback(); // not dynamic by query, just delayed load
  $.ajax({
    url: 'foo.choices.json',
    type: 'GET',
    error: function() { callback() },
    success: function(res) { callback(res.cars) }
  })
}"

ui <- function(request) {
  fluidPage(
    useShinyjs(), 
    extendShinyjs(text=jsCode),
    titlePanel("Bookmarking Created Values"),
    selectizeInput("foo", NULL, 
                   choices=c("Choose From List or Type New Value"=""),
                   multiple=TRUE,
                   options=list(create=TRUE, preload="focus", load=I(foo.load))),
    bookmarkButton("Update URL"),
    div(style="display:none", textInput("foo.bak", NULL))

  )}

server <- function(input, output, session) {
  onBookmarked(function(url) {
    updateQueryString(url)
  })
  observeEvent(input$foo, { 
    if (is.null(input$foo)) {
      updateTextInput(session, "foo.bak", value="")
    } else {
      updateTextInput(session, "foo.bak", value=input$foo)
    }
  }, ignoreInit=TRUE, ignoreNULL = FALSE)
  observeEvent(input$foo.bak, {
    js$setfoo(items=as.list(strsplit(input$foo.bak,",")[[1]]))
  }, once=TRUE)
}


shinyApp(ui = ui, server = server, enableBookmarking = "server")

这里有一个更好的解决方案,它使用服务器端对 selectize 的支持。支持 create=TRUE 选项的重要步骤是使用 onRestored 使用用户创建的新值更新选项。

library(shiny)

init.choices <- c("Choose From List or Type New Value"="")

ui <- function(request) {
  fluidPage(
    titlePanel("Bookmarking Created Values"),
    selectizeInput("foo", NULL, 
                   choices=init.choices,
                   multiple=TRUE,
                   options=list(create=TRUE)),
    bookmarkButton("Update URL")

  )}

server <- function(input, output, session) {
  updateSelectizeInput(session, "foo", choices=c(init.choices, rownames(mtcars)), server=TRUE)
  onBookmarked(function(url) {
    updateQueryString(url)
  })
  onRestored(function(state) {
    updateSelectizeInput(session, "foo", selected=state$input$foo, choices=c(init.choices, rownames(mtcars), state$input$foo), server=TRUE)
  })
}


shinyApp(ui = ui, server = server, enableBookmarking = "server")