在selectInput中R闪亮的自定义图标/图像

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

还有pickerInputfrom shinyWidgets，可以使用 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)

Answer 2

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

}

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