selectInput 中的 R 闪亮自定义 icon/image

Question

我闪亮的应用程序中有以下代码，让用户可以选择他们想在绘图上使用的点形。

selectInput("pch", "Point shape",c("15","16","17","18"),selectize = TRUE,multiple=F)

出于美学原因（也是实际原因），我想要 4 个绘图字符的 4 张图像，而不仅仅是数字 15、16、17、18。

同样，在这个例子中，

selectInput("col", "Colour",colours(),selectize = TRUE,multiple=F)

除了颜色的文本名称，我还想使用颜色图像或颜色选择器。

我的想法如下：

谢谢

Answer 1

不是完整答案，但需要格式化：

我以前在这里看到过：http://shiny.rstudio.com/gallery/selectize-examples.html。查看 "Select a GitHub repo" 输入。

在渲染调用中使用 I() 表达式：

selectizeInput('github', 'Select a Github repo', choices = '', options = list(
        valueField = 'url',
        labelField = 'name',
        searchField = 'name',
        options = list(),
        create = FALSE,
        render = I("{
      option: function(item, escape) {
        return '<div>' +
               '<strong><img src=\"http://brianreavis.github.io/selectize.js/images/repo-' + (item.fork ? 'forked' : 'source') + '.png\" width=20 />' + escape(item.name) + '</strong>:' +
               ' <em>' + escape(item.description) + '</em>' +
               ' (by ' + escape(item.username) + ')' +
            '<ul>' +
                (item.language ? '<li>' + escape(item.language) + '</li>' : '') +
                '<li><span>' + escape(item.watchers) + '</span> watchers</li>' +
                '<li><span>' + escape(item.forks) + '</span> forks</li>' +
            '</ul>' +
        '</div>';
      }
    }"),

特别是 '<strong><img src=\"http://brianreavis.github.io/selectize.js/images/repo-' 行。

现在的问题是为每个选项调用一个唯一的图像，这在I()内应该也是可能的。

Answer 2

这是一个工作示例。这里的目的是在下拉菜单中向用户显示调色板中的颜色（而不仅仅是调色板名称）。这里下拉列表中的图像是在运行时创建的。这可能是可取的，也可能不是可取的。如果下拉列表中的图像永远不会改变（即；静态），请参阅 SeGa 的回答。

这是根据显示的示例 here 修改而来的。

ui.R 文件

## UI.R

fluidPage(
  title='Plots in Selectize Input',
  tags$h2('Plots in Selectize Input'),
  fluidRow(
    column(4,
           selectizeInput('palette',label="Palette",choices=NULL,options=list(
             placeholder='Select a colour palette',maxOptions=4)
           )),
    column(8,
      plotOutput('plot')
      )
    )
  )

server.R 文件

## SERVER.R

library(ggplot2)

data(diamonds)
len <- length(levels(diamonds$cut))
clist <- list("rainbow"=rainbow(len),"topo"=topo.colors(len),
              "terrain"=terrain.colors(len),"cm"=cm.colors(len))

function(input,output,session) {

  paletteurl <- session$registerDataObj(

    name='uniquename1',
    data=clist,
    filter=function(data,req) {

      query <- parseQueryString(req$QUERY_STRING)
      palette <- query$palette
      cols <- clist[[palette]]

      image <- tempfile()
      tryCatch({
        png(image,width=100,height=50,bg='transparent')
        par(mar=c(0,0,0,0))
        barplot(rep(1,length(cols)),col=cols,axes=F)
      },finally = dev.off())

      shiny:::httpResponse(
        200,'image/png',readBin(image,'raw',file.info(image)[,'size'])
      )
    }
  )

  updateSelectizeInput(
    session,'palette',server=TRUE,
    choices=names(clist),
    selected=1,
    options=list(render=I(sprintf(
      "{
        option: function(item, escape) {
        return '<div><img width=\"100\" height=\"50\" ' +
        'src=\"%s&palette=' + escape(item.value) + '\" />' +
        escape(item.value) + '</div>';
        }
      }",
      paletteurl
    )))
    )

  output$plot <- renderPlot({
    shiny::req(input$palette)

    cols <- clist[[input$palette]]
    ggplot(diamonds,aes(x=carat,y=price,colour=cut))+
      geom_point()+
      scale_colour_manual(values=cols)+
      theme_minimal(base_size=18)
  })

}

如果有人对此有更好的理解，欢迎您improve/update回答这个问题。甚至添加另一个答案以显示不同的用法。

Answer 3

还有 shinyWidgets 中的 pickerInput，可以用 html/css 自定义。有了它，您可以将任何图像或图标包含到选择小部件中。

但是，使用此方法的图像必须已经存在。

library(shiny)
library(shinyWidgets)

df <- data.frame(
  val = c("pal1","pal2", "pal3", "pal4")
)

df$img = c(
  sprintf("<img src='https://d9np3dj86nsu2.cloudfront.net/image/eaf97ff8dcbc7514d1c1cf055f2582ad' width=30px><div class='jhr'>%s</div></img>", df$val[1]),
  sprintf("<img src='https://www.color-hex.com/palettes/33187.png' width=30px><div class='jhr'>%s</div></img>", df$val[2]),
  sprintf("<img src='https://www.color-hex.com/palettes/16042.png' width=30px><div class='jhr'>%s</div></img>", df$val[3]),
  sprintf("<img src='https://www.stlawrencegallery.com/wp-content/uploads/2018/09/unique-navy-blue-color-palette-five-stunning-palettes-for-weddings-dark.jpg' width=30px><div class='jhr'>%s</div></img>", df$val[4])
  )


ui <- fluidPage(
  tags$head(tags$style("
                       .jhr{
                       display: inline;
                       vertical-align: middle;
                       padding-left: 10px;
                       }")),
 pickerInput(inputId = "Id0109",
             label = "pickerInput Palettes",
             choices = df$val,
             choicesOpt = list(content = df$img))

  )

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

selectInput 中的 R 闪亮自定义 icon/image

R shiny custom icon/image in selectInput

r

shiny