闪亮的下拉输入selectizeInput，带有超赞的图标

问题描述

我想在 Shiny selectizeInput 的项目中包含 font-awesome 图标。我该怎么办？

解决方法

这是一个函数，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))
    )
  },SIMPLIFY = FALSE,USE.NAMES = FALSE)
  render <- paste0(
    "{","  item: function(item,escape) {","    return '<span>' + item.icon + '&nbsp;' + item.label + '</span>';","  },","  option: function(item,"    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",iconStyle = "font-size: 3rem; vertical-align: middle;",selected  = "cat"
  )
)

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


shinyApp(ui,server)