r - DT::datatable 中的 SelectizeInput 只能用作 html

Question

我正在尝试在时间跟踪应用中为我的最终用户优化用户体验。本质上，它从 google calendar 的 api 中提取数据，将其安排在 tibble 中，让用户选择/取消选择/编辑 session ，并将它们分配给项目。这些项目是在我使用 selectizeInput 构建的下拉菜单中选择的，但我得到的内容类似于 selectInput

我想在 Shiny 的 DT::datatable 中使用 shiny::selectizeInput。我可以让下拉菜单开始工作。但是，我失去了 selectize 输入附带的搜索功能。在我的玩具示例中，您可以单击顶部的 selectizeInput 并输入您要查找的选项。数据表中的那个，您仍然可以这样做，但是对于复杂的名称，如果您可以看到您正在输入的内容，那么对于 UX 来说会更好。

我在 github 存储库中发现了这个问题，其中 DT 包的制造商说这样的事情可能是不可能的。然而，它已经 3 岁了，也许有人已经找到了解决方法。 https://github.com/rstudio/DT/issues/390

我也尝试过使用不同的 ui 类型 tuicalendr，它对我来说效果很好，但我遇到了同样的问题。我在 JS 方面的经验有限，所以我很难在 Shiny 中自定义 JS。

library(shiny)
library(DT)

ui <- fluidPage(
  selectizeInput("input", 
                 label = "",
                 choices = letters[1:26],
                 selected = letters[1]),
DTOutput("datatable")
)


server <- function(input, output) {

output$datatable<- renderDataTable({
  DT::datatable(data.frame(a = as.character(selectizeInput("dtinput",
                                label = "",
                                choices = letters[1:26],
                                selected = letters[1]),
             stringsAsFactors = F)),
             escape = F)
})


}

# Run the application 
shinyApp(ui = ui, server = server)

我对其他方法持开放态度，理想的做法是将数据显示在日历 View 中，并在标题下方带有一个复选框和下拉菜单。但如果我能解决这个问题，我想我可以自己调整代码以适应日历。

Answer 1

必须手动添加 javascript 功能。相应的代码将是:$('#ID').selectize()。

为了获得需要添加的html代码，你可以运行:withTags(selectInput(inputId = "mselect", label = "multi", choices = letters[1:3], multiple = TRUE) )。您可以从那里提取所需的 html 部分。

在docu中你会发现你可以用JS()传递javascript代码:JS()中包裹的字符选项将被视为文字JavaScript代码而不是普通字符串。

您想在呈现选择部分后添加 javascript 代码。这可以通过使用 initcomplete 选项来保证。

为了使用来自输入的值，您必须将输入绑定(bind)到 Shiny 的:

preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')

正如 Remko 提到的，他的链接帖子非常有帮助。几乎所有这些信息实际上都可以在帖子中找到。创建可重现的示例可能需要一些 Shiny 的经验，因此我为您添加了一个:

可重现的例子:

library(shiny)
library(DT)

ui <- fluidPage(

  selectizeInput(
    inputId = "input",
    label = "",
    choices = letters[1:26],
    selected = letters[1]
  ),

  fluidRow(
    DTOutput(outputId = "table")
  )

)

#withTags(selectInput(inputId = "mselect", label = "multi", choices = letters[1:3], 
#    multiple = TRUE))
df <- data.frame(mselect = 
  '<select id="mselect" class="form-control" multiple="multiple">
     <option value="car">car</option>
     <option value="cars">cars</option>
     <option value="dog">dog</option>
  </select>'  
)


js <- c(
  "function(settings){",
  "  $('#mselect').selectize()",
  "}"
)

server <- function(input, output, session) {

  observe({
    print(input$mselect)
  })

  output$table <- renderDT({

    datatable(
      data = df,
      escape = FALSE,
      options = 
        list(
          initComplete = JS(js),
          preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
          drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
      )
    )

  })

}

shinyApp(ui = ui, server = server)