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

Posted 2021-05-03

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

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)

我不想使用颜色的文字名称，而是使用颜色图像或颜色选择器。

我想到的是如下所示：

谢谢

答案

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

我之前见过它：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()中。

另一答案

这里的目的是在下拉菜单中向用户显示调色板中的颜色（而不仅仅是调色板名称）。这是从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)
  })

}

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

另一答案

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