Добавление интерактивного ползунка времени на карту листовки в R - PullRequest
Новая
       7

Добавление интерактивного ползунка времени на карту листовки в R

1 голос
/ 09 апреля 2020

Я пытаюсь создать интерактивную карту цвета США с использованием листовки. Моя цель - заполнить каждое изменение состояния при перемещении ползунка времени.

У меня есть карта и ползунок времени, отображаемый в пользовательском интерфейсе, но они не связаны.

У меня есть 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)
...