R Shiny中如何在selectInput中使用自定义图标/图片？

Question

R Shiny中如何在selectInput中使用自定义图标/图片？

13

我在我的shiny应用程序中有以下代码，让用户选择他们想要在图表上使用的点形状。

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

出于审美和实用的原因，我希望有4张图像代替数字15、16、17和18。

同样，在这个例子中，

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

与其使用颜色的文本名称，我更想使用颜色图片或颜色选择器。

我所想的是类似下面这样的东西：

enter image description here

谢谢

- mindlessgreen

2

你应该看看这个很棒的示例。 - SeGa

1

谢谢！这很有帮助。我下面有一个工作示例。 - mindlessgreen

3个回答

5

这是一个可行的示例。目标是在下拉菜单中向用户显示颜色调色板中的颜色（而不仅仅是调色板名称）。此处下拉菜单中的图像是在运行时创建的。这可能是需要的，也可能不需要。如果下拉菜单中的图像永远不会更改（即静态），请参见SeGa的答案。

这是从此处显示的示例进行修改。

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)
  })

}

如果有人更好地理解这个问题，欢迎您改进/更新这个答案。甚至可以添加另一个答案以展示不同的用法。

- mindlessgreen

4

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

在这里我曾经看到过：http://shiny.rstudio.com/gallery/selectize-examples.html。看看“选择一个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()函数内也应该是可能的。

- Chris

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- SeGa · Accepted Answer

还有来自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)