时间戳

首页 > 解决方案 > 如何根据选择的输入为代码标记着色？

r - 如何根据选择的输入为代码标记着色？

问题描述

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

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

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 个级别，所有这些都是很棒的动物。如果用户选择按“类型”为标记着色，那么现有的“getColor”函数（使用来自“cat”列的输入）将不起作用。有没有办法根据选择的列及其相关的因子水平自动填充“getColor”函数？请注意，我不想手动挑选颜色。

希望这是有道理的，非常感谢任何人可以提供的任何帮助:)

标签： rshinyleaflet

解决方案

这是我认为您所追求的解决方案。您应该记住，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)

推荐阅读