R 向中的自定义输入控件添加搜索框

我的目标是在shiny中的自定义输入控件顶部添加一个搜索框。我想当一个用户搜索汉普郡时，例如，选择选择新罕布什尔州，这是目前不可能的，因为它只搜索第一个字母

server.R

shinyServer(function(input, output, session) {

output$main <- renderUI({
source("chooser.R")
chooserInput("mychooser","Available frobs","Selected frobs",
row.names(USArrests),c(),size=20,multiple=TRUE)})
})

source("chooser.R")

shinyUI(fluidPage(
uiOutput("main")
))

chooserInput <- function(inputId, leftLabel, rightLabel, leftChoices, rightChoices,
size = 5, multiple = FALSE) {

leftChoices <- lapply(leftChoices, tags$option)
rightChoices <- lapply(rightChoices, tags$option)

if (multiple)
  multiple <- "multiple"
else
multiple <- NULL

tagList(
singleton(tags$head(
  tags$script(src="chooser-binding.js"),
  tags$style(type="text/css",
    HTML(".chooser-container { display: inline-block; }")
  )
)),
div(id=inputId, class="chooser",
  div(class="chooser-container chooser-left-container",
    tags$select(class="left", size=size, multiple=multiple, leftChoices)
  ),
  div(class="chooser-container chooser-center-container",
    icon("arrow-circle-o-right", "right-arrow fa-3x"),
    tags$br(),
    icon("arrow-circle-o-left", "left-arrow fa-3x")
    ),
    div(class="chooser-container chooser-right-container",
    tags$select(class="right", size=size, multiple=multiple, rightChoices)
  )
)
)
}

registerInputHandler("shinyjsexamples.chooser", function(data, ...) {
if (is.null(data))
NULL
else
list(left=as.character(data$left), right=as.character(data$right))
}, force = TRUE)  

选择器.R

shinyServer(function(input, output, session) {

output$main <- renderUI({
source("chooser.R")
chooserInput("mychooser","Available frobs","Selected frobs",
row.names(USArrests),c(),size=20,multiple=TRUE)})
})

source("chooser.R")

shinyUI(fluidPage(
uiOutput("main")
))

chooserInput <- function(inputId, leftLabel, rightLabel, leftChoices, rightChoices,
size = 5, multiple = FALSE) {

leftChoices <- lapply(leftChoices, tags$option)
rightChoices <- lapply(rightChoices, tags$option)

if (multiple)
  multiple <- "multiple"
else
multiple <- NULL

tagList(
singleton(tags$head(
  tags$script(src="chooser-binding.js"),
  tags$style(type="text/css",
    HTML(".chooser-container { display: inline-block; }")
  )
)),
div(id=inputId, class="chooser",
  div(class="chooser-container chooser-left-container",
    tags$select(class="left", size=size, multiple=multiple, leftChoices)
  ),
  div(class="chooser-container chooser-center-container",
    icon("arrow-circle-o-right", "right-arrow fa-3x"),
    tags$br(),
    icon("arrow-circle-o-left", "left-arrow fa-3x")
    ),
    div(class="chooser-container chooser-right-container",
    tags$select(class="right", size=size, multiple=multiple, rightChoices)
  )
)
)
}

registerInputHandler("shinyjsexamples.chooser", function(data, ...) {
if (is.null(data))
NULL
else
list(left=as.character(data$left), right=as.character(data$right))
}, force = TRUE)  

很酷的小部件（或任何术语）。这个问题实际上已经得到了回答，所以如果答案对你有帮助的话，一定要对答案进行投票

下面是它的一个超级简单的实现（可能更好）：

选择器

chooserInput <- function(inputId, leftLabel, rightLabel, leftChoices, rightChoices,
                         size = 5, multiple = FALSE) {

  leftChoices <- lapply(leftChoices, tags$option)
  rightChoices <- lapply(rightChoices, tags$option)

  if (multiple)
    multiple <- "multiple"
  else
    multiple <- NULL

  tagList(
    singleton(tags$head(
      tags$script(src="chooser-binding.js"),
      tags$style(type="text/css",
                 HTML(".chooser-container { display: inline-block; }")
      )
    )),
    div(id=inputId, class="chooser",style="",
        div(
          div(style="min-width:100px;",
              tags$input(type="text",class="chooser-input-search",style="width:100px;")
          )
        ),
        div(style="display:table",
            div(style="min-width:100px; display:table-cell;",
                div(class="chooser-container chooser-left-container",
                    style="width:100%;",
                    tags$select(class="left", size=size, multiple=multiple, leftChoices,style="width:100%;min-width:100px")
                )
            ),
            div(style="min-width:50px; display:table-cell;vertical-align: middle;",
                div(class="chooser-container chooser-center-container",
                    style="padding:10px;",
                    icon("arrow-circle-o-right", "right-arrow fa-3x"),
                    tags$br(),
                    icon("arrow-circle-o-left", "left-arrow fa-3x")
                )
            ),
            div(style="min-width:100px; display:table-cell;",
                div(class="chooser-container chooser-right-container", style="width:100%;",
                    tags$select(class="right", size=size, multiple=multiple, rightChoices,style="width:100%;")
                )
            )
        )
    )
  )
}

registerInputHandler("shinyjsexamples.chooser", function(data, ...) {
  if (is.null(data))
    NULL
  else
    list(left=as.character(data$left), right=as.character(data$right))
}, force = TRUE) 

---

选择输入非常感谢奥斯卡。最后一个问题。我的server.R和ui.R版本与我最初发布的有点不同。你所发送的内容与我最初的帖子一致。我编辑以显示我的版本。你知道为什么我的版本会禁用搜索框吗？重要的是，我要在server.R端编写代码并将其传递给ui.R。这是因为我的代码非常糟糕，在绑定搜索函数时，DOM中绑定的元素不存在，所以我对其进行了更改，以便在初始化时绑定搜索函数。另外，我刚刚为不同的元素硬编码了一些宽度，但这可能不是方法。感谢您的回复。我不知道为什么，但是有了新的代码，搜索框就不会出现了。我终于成功了。我还有最后一个问题。我只是把它作为一个新问题贴出来，这样我就可以给你评分了。如果不占用您太多的时间，如果您能看一看，我将不胜感激。我无法想象除了你以外的任何人会试图解决这个问题。