r - Shiny 的下拉输入(selectizeInput)，带有超赞的图标

Question

我想包括 Font Awesome Shiny 项目中的图标 selectizeInput .我怎么办？

Answer 1

这是一个函数，selectInputWithIcons ，这就完成了。

library(shiny)
library(fontawesome)
library(htmltools)


selectInputWithIcons <- function(
  inputId, inputLabel, labels, values, icons, iconStyle = NULL,
  selected = NULL, multiple = FALSE, width = NULL
){
  options <- mapply(function(label, value, icon){
    list(
      "label" = label,
      "value" = value,
      "icon"  = as.character(fa_i(icon, style = iconStyle))
    )
  }, labels, values, icons, SIMPLIFY = FALSE, USE.NAMES = FALSE)
  render <- paste0(
    "{",
    "  item: function(item, escape) {", 
    "    return '<span>' + item.icon + '&nbsp;' + item.label + '</span>';", 
    "  },",
    "  option: function(item, escape) {", 
    "    return '<span>' + item.label + '</span>';", 
    "  }",
    "}"
  )
  widget <- selectizeInput(
    inputId  = inputId, 
    label    = inputLabel,
    choices  = NULL, 
    selected = selected,
    multiple = multiple,
    width    = width,
    options  = list( 
      "options"    = options,
      "valueField" = "value", 
      "labelField" = "label",
      "render"     = I(render),
      "items"     = as.list(selected)
    )
  )
  attachDependencies(widget, fa_html_dependency(), append = TRUE)
}


ui <- fluidPage(
  br(),
  selectInputWithIcons(
    "slctz",
    "Select an animal:",
    labels    = c("I want a dog", "I want a cat"),
    values    = c("dog", "cat"),
    icons     = c("dog", "cat"),
    iconStyle = "font-size: 3rem; vertical-align: middle;",
    selected  = "cat"
  )
)

server <- function(input, output, session){
  
  observe({
    print(input[["slctz"]])
  })
  
}


shinyApp(ui, server)