如何在Shiny Leaflet应用中根据其他变量修改圆形标记颜色

问题根因 #

• 过滤数据集时使用的是仅包含竞品的pharmacy数据集，没有用到合并了自有+竞品的all_stores，导致永远不会展示Tim's药房点位
• 没有配置my_store字段到颜色的映射逻辑，所有点位固定为红色
• my_store字段生成逻辑有误：自有药房的Label取值是Tim's，原代码判断条件写为Tim's Pharmacy，匹配失败会导致所有行的my_store都为0
• 初始地图边界计算用的是仅含竞品的pharmacy数据集，可能漏掉自有药房的点位范围
• 下拉选框的描述与实际功能不符，实际筛选维度是州，原label写为「选择门店品牌」

修复后完整代码 #

library(shiny)
library(leaflet)
library(dplyr)
library(readxl) # 原代码漏了加载readxl，读取xlsx需要这个包
library(leaflet.extras)

pharmacy <- read_excel("~/pharmacy.xlsx")
My_Pharmacy <- read_excel("~/My_Pharmacy.xlsx")

all_stores <- rbind(pharmacy, My_Pharmacy)
all_stores <-
  all_stores %>%
  # 修改匹配条件，适配自有药房Label取值
  mutate(my_store = if_else(Label == "Tim's", 1, 0))

# Define UI 
ui <- fluidPage(
  titlePanel("药房点位地图"),
  mainPanel(
    leafletOutput(outputId = "map_pharmacy"),
    # 修改选框label，同时用all_stores的州列表做选项
    selectInput(inputId = "State",
                label = "选择州",
                choices = unique(all_stores$State))
  )
)

server <- function(input, output, session) {
  filteredData <- reactive({
    # 改用合并后的全量数据集做过滤
    all_stores %>%
      filter(State == input$State)
  })
  
  output$map_pharmacy <- renderLeaflet({
    # 初始地图改用全量数据集计算边界
    leaflet(all_stores) %>% 
      addTiles() %>%
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat))
  })
  
  observe({
    leafletProxy("map_pharmacy", data = filteredData()) %>%
      clearShapes() %>%
      # 根据my_store字段匹配颜色：自有为绿，竞品为红
      addCircles(color = ~ifelse(my_store == 1, "green", "red"), 
                 weight = 10,
                 # 可选：添加弹窗显示门店名称
                 popup = ~Label)
  })
}

shinyApp(ui = ui, server = server)

核心修改说明 #

• 所有涉及数据集的操作统一使用合并后的all_stores，确保自有药房点位可以正常渲染
• 修正了my_store字段的匹配规则，保证自有药房可以被正确识别
• 在addCircles中通过ifelse实现颜色映射，符合「自有绿、竞品红」的需求
• 补全了readxl包的加载逻辑，避免读取Excel文件时报错
• 修正了下拉选框的文案和选项范围，功能与实际逻辑匹配

内容的提问来源于stack exchange，提问作者HITHERE