Question

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

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

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”功能？请注意，我不想手动选择颜色。

希望这很有意义，非常感谢任何人都可以提供的帮助:)

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

如何根据所选输入为标记标记代码？

2 个答案: