基于特征筛选标记：R-Leaflet与Shiny集成技术问题咨询

Hey there! Let's tackle your three Leaflet + Shiny issues one by one, with practical fixes tailored to your code:

Your dropdown selection wasn't being integrated into the marker data logic, so markers never updated based on the chosen environment. We'll adjust the marker_data() reactive to include a filter that matches your input to the actual environment labels in your dataset:

marker_data <- reactive({
  # First filter by year range
  filtered <- site_data[site_data$Publication_Year >= input$year[1] & site_data$Publication_Year <= input$year[2],]
  
  # Apply environment filter if not "All"
  if(input$environment != "P&C"){
    # Map input codes to the full environment names in your data
    env_map <- c("SW" = "Surface Water", "WW" = "Wastewater", "Sea" = "Sea Water")
    filtered <- filtered[filtered$Aquatic_Environment_Type == env_map[input$environment],]
  }
  filtered
})

Note: Double-check that the Aquatic_Environment_Type values in your site_data match the mapped names above (adjust the mapping if your data uses shorthand like "SW" directly).

Two key issues here:

• You were using the unfiltered bounds object for country polygons, so countries without markers in the selected year range stayed highlighted.
• The year matching logic for bounds was flawed (one country can have multiple publication years). We'll rework how we filter country bounds and optimize rendering to reduce lag.

First, update the border_data() reactive to only keep countries that have valid markers in the selected year range:

border_data <- reactive({
  # Get list of countries with active markers
  valid_countries <- marker_data() %>% distinct(Country.s.) %>% pull(Country.s.)
  # Filter bounds to only these countries
  bounds[gsub("\\:.*", "", bounds$names) %in% valid_countries,]
})

Then modify the observe block for shapes to use the filtered border_data() and clean up redundant operations:

observe({
  leafletProxy("map") %>%
    clearShapes() %>%
    # Add area circles first
    addCircles(data = area_s_data(),
               lat = ~Latitude, lng = ~Longitude,
               radius = ~as.numeric(Area_Radius_Meter),
               color = "blue", weight = 1,
               highlightOptions = highlightOptions(color = "red", weight = 2, bringToFront = TRUE)) %>%
    # Add only relevant country polygons
    addPolygons(data = border_data(),
                color = "red", weight = 2, fillOpacity = 0.1,
                highlightOptions = highlightOptions(color = "black", weight = 2, bringToFront = TRUE))
})

Performance boost: By only rendering polygons for countries with active markers, we cut down on the number of shapes Leaflet has to process, which should eliminate the lag.

Absolutely! There are plenty of great alternatives to OpenStreetMap.Mapnik with English labels. Here are some popular options you can use with addProviderTiles():

• CartoDB.Positron: Clean, light-colored map with crisp English labels
• Stamen.Toner: High-contrast black-and-white map with minimal English text
• Esri.WorldStreetMap: Detailed street map from Esri with full English labeling
• OpenStreetMap.BlackAndWhite: Monochrome OpenStreetMap variant with English labels
• Hydda.Full: OpenStreetMap-based map with clear, readable English text

To use one, just replace the tile line in your renderLeaflet block:

addProviderTiles("CartoDB.Positron")

Here's the complete code with all fixes applied:

library(shiny)
library(leaflet)
library(maps)
library(htmltools)
library(htmlwidgets)
library(dplyr)

###############################
map_data <- read.csv("example1.csv", header = TRUE)
countries <- map_data %>% distinct(DOI, Country.s., .keep_all = TRUE)
area_data <- map_data %>% filter(Area.Site == "Area")
site_data <- map_data %>% filter(Area.Site == "Site")
sampling_count <- count(site_data, "Country.s.")
country_count <- count(countries, "Country.s.")
bounds <- map("world", area_data$Country.s., fill = TRUE, plot = FALSE)
bounds$studies <- country_count$freq[match(gsub("\\:.*", "", bounds$names), country_count$Country.s.)]
bounds$sampling_points <- sampling_count$freq[match(gsub("\\:.*", "", bounds$names), sampling_count$Country.s.)]

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  # Environment filter dropdown
  absolutePanel(top = 5, right = 320,
                selectInput("environment", "Sampling Source: ",
                            c("All" = "P&C", "Surface Water" = "SW", "Wastewater" = "WW", "Sea Water" = "Sea"))),
  # Year slider
  absolutePanel(bottom = 5, right = 320,
                sliderInput("year", "Publication Year(s)",
                            min(site_data$Publication_Year), max(site_data$Publication_Year),
                            value = range(site_data$Publication_Year), step = 1, sep = "", width = 500))
)

server <- function(input, output, session) {
  marker_data <- reactive({
    filtered <- site_data[site_data$Publication_Year >= input$year[1] & site_data$Publication_Year <= input$year[2],]
    # Apply environment filter
    if(input$environment != "P&C"){
      env_map <- c("SW" = "Surface Water", "WW" = "Wastewater", "Sea" = "Sea Water")
      filtered <- filtered[filtered$Aquatic_Environment_Type == env_map[input$environment],]
    }
    filtered
  })
  
  area_s_data <- reactive({
    area_data[area_data$Publication_Year >= input$year[1] & area_data$Publication_Year <= input$year[2],]
  })
  
  border_data <- reactive({
    valid_countries <- marker_data() %>% distinct(Country.s.) %>% pull(Country.s.)
    bounds[gsub("\\:.*", "", bounds$names) %in% valid_countries,]
  })
  
  output$map <- renderLeaflet({
    leaflet(map_data, options = leafletOptions(worldCopyJump = TRUE)) %>%
      # Example: using CartoDB Positron tiles
      addProviderTiles("CartoDB.Positron")
  })
  
  observe({
    leafletProxy("map", data = marker_data()) %>%
      clearMarkers() %>%
      addAwesomeMarkers(lat = ~Latitude, lng = ~Longitude, label = ~paste(Aquatic_Environment_Type))
  })
  
  observe({
    leafletProxy("map") %>%
      clearShapes() %>%
      addCircles(data = area_s_data(),
                 lat = ~Latitude, lng = ~Longitude,
                 radius = ~as.numeric(Area_Radius_Meter),
                 color = "blue", weight = 1,
                 highlightOptions = highlightOptions(color = "red", weight = 2, bringToFront = TRUE)) %>%
      addPolygons(data = border_data(),
                  color = "red", weight = 2, fillOpacity = 0.1,
                  highlightOptions = highlightOptions(color = "black", weight = 2, bringToFront = TRUE))
  })
}

shinyApp(ui, server)

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