How to color code markers according to input selected?

Question

I have a shiny app which uses a leaflet to display point data using markers. I would like the markers to be colored according to levels of a factor from a selected column.

In the example below, the user would have chosen to color markers according to data found in the 'cat' column, which contains various types of vehicles.

library(leaflet)

# read in data and generate new, fake data

df <- quakes[1:24,]
df$cat <- NULL
df$cat <- as.factor(sample(c("Car", "Truck", "Train", "Bus"), 24, replace=TRUE))
df$type <- NULL
df$type <- as.factor(sample(c("Walrus", "Dragon", "Llama"), 24, replace=TRUE))


# create color codes according to factors of a column

getColor <- function(df) {
  sapply(df$cat, function(cat) {
    if(cat == "Car") {
      "green"
    } else if(cat == "Truck") {
      "orange"
    } else if(cat == "Train") {
      "pink"
    } else {
      "red"
    } })
}

# create awesome icons

icons <- awesomeIcons(
  icon = 'ios-close',
  iconColor = 'black',
  library = 'ion',
  markerColor = getColor(df)
)

# plot data

leaflet(df) %>% addTiles() %>%
  addAwesomeMarkers(~long, ~lat, icon=icons, label=~as.character(cat))

Essentially, what I would like to do is automatically generate the 'getColor' function based on the input column selected, and without hardcoding in any values.

Consider another hypothetical column called 'type' which contains 3 levels of a factor, all of which are awesome animals. Had the user chosen to color markers by 'type', then the existing 'getColor' function, which uses inputs from the 'cat' column, would not work. Is there a way to automatically populate the 'getColor' function based on which column is selected and its associated factor levels? Note that I would like to not have to hand pick the colors.

Answer 1

Here is a solution for what I think you are after. You should keep in mind, that for the markerColor there are only 19 colors available. You could adapt the solution and change the iconColor instead which allows you to use CSS-valid colors (accordingly you can use color-ramps / palettes).

library(shiny)
library(leaflet)
library(data.table)

# read in data and generate new, fake data
DT <- data.table(quakes[1:24,])
DT$cat <- as.factor(sample(c("Car", "Truck", "Train", "Bus"), 24, replace=TRUE))
DT$type <- as.factor(sample(c("Walrus", "Dragon", "Llama"), 24, replace=TRUE))

# 19 possible colors
markerColorPalette <- c("red", "darkred", "lightred", "orange", "beige", "green", "darkgreen", "lightgreen", "blue", "darkblue", "lightblue", "purple", "darkpurple", "pink", "cadetblue", "white", "gray", "lightgray", "black")

ui <- fluidPage(
  leafletOutput("mymap"),
  p(),
  selectInput(inputId="columnSelect", label="Select column", choices=names(DT), selected = "cat")
)

server <- function(input, output, session) {

  # create awesome icons      
  icons <- reactive({
    columnLevels <- unique(DT[[input$columnSelect]])
    colorDT <- data.table(columnLevels = columnLevels, levelColor = markerColorPalette[seq(length(columnLevels))])
    setnames(colorDT, "columnLevels", input$columnSelect)
    DT <- colorDT[DT, on = input$columnSelect]

    icons <- awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = DT$levelColor
    )

    return(icons)
  })

  output$mymap <- renderLeaflet({
    req(icons())
    leaflet(DT) %>% addTiles() %>%
      addAwesomeMarkers(~long, ~lat, icon=icons(), label=as.character(DT[[input$columnSelect]]))
  })
}

shinyApp(ui, server)