R shiny custom icon/image in selectInput

Question

I have the following code in my shiny application to give the user the possibly to choose what pointshape they would like to use on the plot.

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

For aesthetic reasons (also practical reasons), I would like to have 4 images of the 4 plotting characters, rather than just numbers 15, 16, 17, 18.

Similarly, in this example,

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

Rather than the text names of colours, I would also like to use images of colours or a colour picker.

What I have in mind is something like below:

Thanks

Answer 1

There is also the pickerInput from shinyWidgets, that can be customized with html/css. With it you can include any image or icon into a selection widget.

However, the images must already exist with this approach.

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

Here is a working example. The aim here is to display the colours in the colour palette (rather than just the palette name) to the user in the dropdown menu. Here the images in dropdown are created during runtime. This may or may not be desirable. If the images in dropdown never change (ie; static), See SeGa's answer.

This is modified from the example shown here.

ui.R file

## 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 file

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

}

If someone understands this better, you are welcome to improve/update this answer. Even add another answer to show a different usage.

Answer 3

Not a full answer, but need formatting:

I have seen it before here: http://shiny.rstudio.com/gallery/selectize-examples.html. Look at the "Select a GitHub repo" input.

Using the I() expression within a render call:

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>';
      }
    }"),

Specifically the '<strong><img src=\"http://brianreavis.github.io/selectize.js/images/repo-' line.

The issue now is to call a unique image for each option, which should also be possible within I().