Shiny-Leaflet降雨可视化应用：三项功能实现技术问询

针对你开发的印尼降雨数据可视化应用，以下是三个需求的具体实现方案：

1. 选中省份自动缩放至边界 #

使用st_bbox()提取选中省份的边界坐标，通过Leaflet的fitBounds()方法自动适配地图视角，无需手动设置中心点和缩放级别：

• 从selected_prov_geom()返回的sf对象中获取边界框
• 在leafletProxy()中调用fitBounds()传入边界的最小/最大经纬度值

2. 多Shapefile图层叠加 #

按区县→省份→泥炭区的层级顺序添加图层（底层到上层），为每个图层设置差异化样式以区分层级：

• 区县（kabupaten_sf）：浅蓝色多边形，透明填充+细边框，作为底层基础图层
• 省份（provinsi_sf）：浅灰色多边形，棕色边框，突出选中省份范围
• 泥炭区（shp_gambut）：深绿色半透明多边形，重点显示特殊地理区域

3. 点击标记高亮切换 #

通过reactiveVal()保存当前选中的气象站WMO ID，添加标记时动态判断并设置图标颜色：

• 初始化selected_marker存储选中状态
• 点击标记时更新选中ID，支持再次点击取消高亮
• 渲染标记时，根据是否为选中ID设置红色/蓝色图标

修改后的完整代码 #

library(shiny)
library(leaflet)
library(leaflet.extras)
library(dplyr)
library(ggplot2)
library(plotly)
library(sf)

## -------------------------------
## Data 
## -------------------------------
shp_gambut <- readRDS("Gambut/gambut.rds")
provinsi_sf <- readRDS("indonesia.rds")
kabupaten_sf <- readRDS("kab.rds")
bmkg_st <- readRDS("bmkg_st.rds")

## -------------------------------
## UI
## -------------------------------
ui <- fluidPage(
  titlePanel("Monitoring Stasiun Cuaca"),
  sidebarLayout(
    sidebarPanel(
      selectInput("prov", "Select Province", choices = unique(bmkg_st$provinsi)),
      uiOutput("kabupaten_ui"),
      selectInput("scale_id", "Skala Waktu:",
                  choices = c("Harian" = "Daily", 
                              "Bulanan" = "Monthly", 
                              "Tahunan" = "Yearly"),
                  selected = "Daily")
    ),
    mainPanel(
      leafletOutput("mymap", height = "500px"),
      plotlyOutput("rainPlot", height = "300px")
    )
  )
)

## -------------------------------
## Server
## -------------------------------
server <- function(input, output, session) {
  
  # Update pilihan kabupaten berdasarkan provinsi
  output$kabupaten_ui <- renderUI({
    req(input$prov)
    kab <- bmkg_st %>% filter(provinsi == input$prov)
    selectInput("kab", "Pilih Kabupaten:", choices = unique(kab$kabupaten))
  })
  
  # Ambil geometri provinsi yang dipilih
  selected_prov_geom <- reactive({
    provinsi_sf %>% filter(name == input$prov)
  })

  # Reactive untuk menyimpan marker yang dipilih
  selected_marker <- reactiveVal(NULL)
  
  # Render peta awal dengan semua shapefile layer
  output$mymap <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      setView(lng = 108, lat = -2, zoom = 5.5) %>%
      addPolygons(data = kabupaten_sf,
                  fillColor = "lightblue",
                  color = "blue", weight = 1, fillOpacity = 0.1,
                  group = "Kabupaten") %>%
      addPolygons(data = provinsi_sf,
                  fillColor = "lightgrey",
                  color = "brown", weight = 2, fillOpacity = 0.3,
                  group = "Provinsi") %>%
      addPolygons(data = shp_gambut,
                  fillColor = "darkgreen",
                  color = "green", weight = 1, fillOpacity = 0.4,
                  group = "Gambut")
  })
  
  # Update peta ketika provinsi berubah atau marker dipilih
  observe({
    prov_geom <- selected_prov_geom()
    selected_wmo <- selected_marker()
    filtered_stations <- bmkg_st %>% filter(provinsi == input$prov)
    
    # Dapatkan bounding box provinsi yang dipilih
    bbox <- st_bbox(prov_geom)
    
    leafletProxy("mymap") %>%
      clearMarkers() %>%
      # Zoom ke area provinsi yang dipilih
      fitBounds(lng1 = bbox[["xmin"]], lat1 = bbox[["ymin"]],
                lng2 = bbox[["xmax"]], lat2 = bbox[["ymax"]]) %>%
      # Tambah marker dengan warna sesuai status terpilih
      addMarkers(data = filtered_stations,
                 lng = ~x, lat = ~y,
                 popup = ~ID,
                 layerId = ~WMO,
                 icon = ~awesomeIcons(
                   icon = 'cloud',
                   markerColor = ifelse(WMO == selected_wmo, 'red', 'blue')
                 ))
  })
  
  # Update status marker yang dipilih ketika diklik
  observeEvent(input$mymap_marker_click, {
    click <- input$mymap_marker_click
    req(click$id)
    # Toggle: klik lagi untuk membatalkan pilihan
    if (selected_marker() == as.numeric(click$id)) {
      selected_marker(NULL)
    } else {
      selected_marker(as.numeric(click$id))
    }
  })
  
  # Filter dan agregasi data sesuai skala waktu
  filtered_scaled_data <- reactive({
    req(input$prov)
    data <- bmkg_st %>% filter(provinsi == input$prov)
    
    if (input$scale_id == "Daily") {
      return(data)
    } else if (input$scale_id == "Monthly") {
      return(data %>%
               mutate(Year = format(date, "%Y"),
                      Month = format(date, "%m"),
                      Month = factor(Month, levels = sprintf("%02d", 1:12))) %>%
               group_by(Year, Month, WMO, ID) %>%
               summarise(rain = sum(rain, na.rm = TRUE), .groups = 'drop'))
    } else {
      return(data %>%
               mutate(Year = format(date, "%Y")) %>%
               group_by(Year, WMO, ID) %>%
               summarise(rain = sum(rain, na.rm = TRUE), .groups = 'drop'))
    }
  })
  
  # Tampilkan plot ketika marker diklik
  observeEvent(input$mymap_marker_click, {
    click <- input$mymap_marker_click
    req(click$id)
    
    data <- filtered_scaled_data() %>% filter(WMO == as.numeric(click$id))
    
    output$rainPlot <- renderPlotly({
      if (input$scale_id == "Daily") {
        p <- ggplot(data, aes(x = date, y = rain)) +
          geom_line() +
          labs(title = "Curah Hujan Harian", x = "Tanggal", y = "Curah Hujan (mm)") +
          theme_minimal()
      } else if (input$scale_id == "Monthly") {
        p <- ggplot(data, aes(x = Month, y = rain, group = Year, color = Year)) +
          geom_line() +
          labs(title = "Curah Hujan Bulanan", x = "Bulan", y = "Curah Hujan (mm)") +
          theme_minimal()
      } else {
        p <- ggplot(data, aes(x = Year, y = rain)) +
          geom_col(fill = "steelblue") +
          labs(title = "Curah Hujan Tahunan", x = "Tahun", y = "Curah Hujan (mm)") +
          theme_minimal()
      }
      
      ggplotly(p, tooltip = "text") %>%
        layout(
          title = list(text = "Rainfall Plot"),
          showlegend = FALSE,
          xaxis = list(title = "Date"),
          yaxis = list(title = "Rainfall (mm)")
        ) %>%
        config(displayModeBar = FALSE)
    })
  })
  
}
shinyApp(ui, server)

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