如何根据所选的输入对代码标记进行颜色标记？

Question

我有一个闪亮的应用程序，它使用传单来使用标记显示点数据。我希望标记根据所选列中的因子水平进行着色。

在下面的示例中，用户将根据“猫”列中找到的数据选择标记颜色，该列包含各种类型的车辆。

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

本质上，我想做的是根据所选的输入列自动生成“getColor”函数，而不需要硬编码任何值。

考虑另一个名为“类型”的假设列，其中包含 3 个级别的因素，所有这些都是很棒的动物。如果用户选择按“type”为标记着色，则使用“cat”列输入的现有“getColor”函数将无法工作。有没有一种方法可以根据选择的列及其关联的因子级别自动填充“getColor”函数？请注意，我不想手动挑选颜色。

Answer 1

这是我认为您所追求的解决方案。您应该记住，markerColor 只有 19 种颜色可用。您可以调整解决方案并更改 iconColor，这样您就可以使用 CSS 有效的颜色（因此您可以使用颜色渐变/调色板）。

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)

Answer 2

# only 19 colors are available (see help)
pal <- c("red", "darkred", "lightred", "orange", "beige", "green", "darkgreen", "lightgreen", "blue", "darkblue", "lightblue", "purple", "darkpurple", "pink", "cadetblue", "white", "gray", "lightgray", "black")

# create awesome icons and assign a color to each of 
# the levels of your input factor
icons <- awesomeIcons(
 icon = 'ios-close',
 iconColor = 'black',
 library = 'ion',
 markerColor = pal[1:length(levels(df$type))]
)

# plot data

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