闪亮的自定义selectInput / selectizeInput

时间:2018-10-15 20:58:14

标签: javascript html css r shiny

我希望将Shiny select输入到:

  1. 没有标签
  2. 具有自定义的背景色:#2f2d57
  3. 具有占位符
  4. 使用户能够键入并选择

但是,我无法使该应用程序同时遵守上述4条规则。我的代码如下:

数据:

table <- data.frame(col1 = c(3, 4, 8, 5, 2, 6, 7))

尝试1

问题:用户无法键入内容并从selectInput中选择

ui <- fluidPage(
  uiOutput("container")
)
server <- function(input, output) {

  output$container <- renderUI({
    fluidRow(
      tags$style("#three_code_zip_selector {color: #ffffff; background-color: #2f2d57;}"),
      selectInput('three_code_zip_selector', NULL, choices = c("Please Select Desired Number" = "", table$col1), selectize = F)
    )
  })
}

shinyApp(ui = ui, server = server)

尝试2

问题:通过删除selectize = F,用户可以输入内容进行选择,但背景颜色不会更改。

ui <- fluidPage(
  uiOutput("container")
)
server <- function(input, output) {

  output$container <- renderUI({
    fluidRow(
      tags$style("#three_code_zip_selector {color: #ffffff; background-color: #2f2d57;}"),
      selectInput('three_code_zip_selector', NULL, choices = c("Please Select Desired Number" = "", table$col1))
    )
  })
}

shinyApp(ui = ui, server = server)

我也在尝试selectizeInput,但似乎仍然存在与上述相同的问题。

尝试3

问题:用户可以键入,但是背景颜色没有更改,并且selectizeInput顶部有一个我不想要的标签。

ui <- fluidPage(
  uiOutput("container")
)
server <- function(input, output) {

  output$container <- renderUI({
    fluidRow(
      tags$style(".selectize-dropdown-content .active {background: #2f2d57; !important;color: #ffffff; !important;}"),
  selectizeInput('three_code_zip_selector', "s", choices = c("Please Select Desired Number" = "", table$col1))
    )
  })
}

shinyApp(ui = ui, server = server)

有人对我如何满足这四个规则有想法吗?预先感谢!

2 个答案:

答案 0 :(得分:4)

这是一个纯粹的闪亮解决方案:

library(shiny)

table <- data.frame(col1 = c(3, 4, 8, 5, 2, 6, 7))

ui <- fluidPage(
  tags$head(tags$style(HTML('
                            #three_code_zip_selector+ div>.selectize-dropdown{background: #2f2d57; color: #ffffff;}
                            #three_code_zip_selector+ div>.selectize-input{background: #2f2d57; color: #ffffff;}
                            '))),
  selectizeInput(inputId = 'three_code_zip_selector', label = NULL, choices = table$col1, selected = NULL, multiple = TRUE, options = list('plugins' = list('remove_button'), placeholder = "Please Select Desired Number", 'create' = TRUE, 'persist' = TRUE)))


server <- function(input, output, session){}
shinyApp(ui = ui, server = server)

答案 1 :(得分:0)

以下是使用shinyWidgets软件包的示例:

library(shinyWidgets)

ui <- fluidPage(
  uiOutput("container")
)

server <- function(input, output) {
  table <- data.frame(col1 = c(3, 4, 8, 5, 2, 6, 7))
  output$container <- renderUI({
    fluidRow(
      pickerInput(
        inputId = "three_code_zip_selector",
        label = NULL, 
        choices = table$col1,
        options = list(
          title = "Please Select Desired Number",
          `live-search` = TRUE,
          style = c("background: #2f2d57; color: #ffffff;"))
      )
    )
  })
}

shinyApp(ui = ui, server = server)

编辑:在上面的代码中,我使用了问题中提供的相同代码结构,但是对于这个简单的示例,没有理由在服务器端为UI元素提供代码。这是一个替代示例:

library(shinyWidgets)

ui <- fluidPage(
  fluidRow(
    pickerInput(
      inputId = "three_code_zip_selector",
      label = NULL, 
      choices = c(3, 4, 8, 5, 2, 6, 7),
      options = list(
        title = "Please Select Desired Number",
        `live-search` = TRUE,
        style = c("background: #2f2d57; color: #ffffff;"))
    )
  )
)

server <- function(input, output) {

}

shinyApp(ui = ui, server = server)