r - 在 R 中向传单地图添加交互式时间滑块

Question

我正在尝试使用传单创建美国的交互式彩色编码地图。我的目标是在移动时间滑块时让每个状态的填充发生变化。

我在 ui 中显示了地图和时间滑块，但它们没有链接。

我有 2 个数据集。一种原始数据显示州名称、日期和分类/填充（map_plot）。第二个是我从底格里斯河中提取的大型空间多边形，并与原始数据 (us_merged) 连接。

这是我到目前为止的代码。

library(shiny)
library(leaflet)
library(dplyr)

# Define UI for application that shows a map
ui <- fluidPage(

  # App title

  # Input: select date range
  sliderInput("Date",
              "Date:",
              min = today(),
              max = max(map_plot$date),
              value= today(),
              timeFormat="%Y-%m-%d"),

  # Main panel for Output
  mainPanel(
    # Output: map
    leafletOutput("map_leaflet")
  )
)

# Define server commands to draw map with data
server <- function(input, output) {

  # Reactive expression to generate dataframe for selected date and metric
  d <- reactive({

    day <- us_merged$date
    #show_metric <- us_merged$changing_status

    d <- us_merged %>% 
      subset(date == day) #%>% 
      #dplyr::select(INTPTLAT,INTPTLON,show_metric) %>%
    #  rename(selected_metric = show_metric)

  })
  # Note: the last pipeline element renames the metric column back to a neutral name

  #create the map
  output$map_leaflet <- renderLeaflet({
    leaflet(d()) %>%
      addTiles() %>%
      setView(-98.483330, 38.712046, zoom = 3.25) %>% 
      addPolygons(
        fillColor = ~pal(changing_status), 
        fillOpacity = 0.5, 
        weight = 2, 
        color = 'white',
        smoothFactor = 0.2,
        popup = popup)
  })
}

# Run app
shinyApp(ui, server)

标签： rshinyleaflet