带传单/ R的时间滑块

Question

我目前在 R 工作，我正在使用传单包来可视化地理空间数据，我想随着时间的推移进行分析并在给定时间滑块的情况下显示我的地图

在 R 中有美学功能，可以在其中添加带有frame选项的滑块，是否有与传单/ggmap 类似的功能，或者至少可以在给定不同年份的地图上进行分面。我尝试使用 ggmap 和 ggplotly 进行练习，但这并没有按预期工作。任何示例/文档或开始的提示都会非常有帮助

我已经将现有的代码改写到我的数据库中，但我没有任何每年执行内核密度估计的代码

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,

    sliderInput("range", "Magnitudes", min(FINAL$UWY), max(FINAL$UWY),
      value = range(FINAL$UWY), step = 1,
      animate =
                    animationOptions(interval = 500, loop = TRUE)

    ),        

    #sliderInput("animation", "Looping Animation:",
    #              min = min(FINAL$UWY), max = max(FINAL$UWY),
    #              value = range(FINAL$UWY), step = 1,
    #              animate =
    #                animationOptions(interval = 300, loop = TRUE)

    #),
    selectInput("colors", "Color Scheme",
      rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
    ),
    checkboxInput("legend", "Show legend", TRUE)
  )
)

server <- function(input, output, session) {

  # Reactive expression for the data subsetted to what the user selected
  filteredData <- reactive({
    FINAL[FINAL$UWY >= input$range[1] & FINAL$UWY <= input$range[2],]
  })

  # This reactive expression represents the palette function,
  # which changes as the user makes selections in UI.
  colorpal <- reactive({
    colorNumeric(input$colors, FINAL$UWY)
  })

  output$map <- renderLeaflet({
    # Use leaflet() here, and only include aspects of the map that
    # won't need to change dynamically (at least, not unless the
    # entire map is being torn down and recreated).
    leaflet(FINAL) %>% addTiles() %>%
      fitBounds(~min(longitude), ~min(latitude), ~max(longitude), ~max(latitude))
  })

  # Incremental changes to the map (in this case, replacing the
  # circles when a new color is chosen) should be performed in
  # an observer. Each independent set of things that can change
  # should be managed in its own observer.
  observe({
    pal <- colorpal()

    leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addCircles(radius = ~amount_claims/10, weight = 1, color = "#777777",
        fillColor = ~pal(amount_claims), fillOpacity = 0.7, popup = ~paste(Country.EN)
      )
  })

  # Use a separate observer to recreate the legend as needed.
  observe({
    proxy <- leafletProxy("map", data = FINAL)

    # Remove any existing legend, and only if the legend is
    # enabled, create a new one.
    proxy %>% clearControls()
    if (input$legend) {
      pal <- colorpal()
      proxy %>% addLegend(position = "bottomright",
        pal = pal, values = ~amount_claims
      )
    }
  })
}

shinyApp(ui, server)

Answer 1

这是使用 Shiny 包的基本解决方案：

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

    # Fake data
    df <- data.frame(lng = c(-5, -5, -5, -5, -15, -15, -10),
                     lat = c(8, 8, 8, 8, 33, 33, 20),
                     year = c(2018, 2018, 2018, 2017, 2017, 2017, 2016),
                     stringsAsFactors = FALSE)

    ui <- bootstrapPage(
      tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
      leafletOutput("map", width = "100%", height = "100%"),
      absolutePanel(top = 10, right = 10,
                    style="z-index:500;", # legend over my map (map z = 400)
                    tags$h3("map"), 
                    sliderInput("periode", "Chronology",
                                min(df$year),
                                max(df$year),
                                value = range(df$year),
                                step = 1,
                                sep = ""
                    )
    )
    )

    server <- function(input, output, session) {

      # reactive filtering data from UI

      reactive_data_chrono <- reactive({
        df %>%
          filter(year >= input$periode[1] & year <= input$periode[2])
      })


      # static backround map
      output$map <- renderLeaflet({
        leaflet(df) %>%
          addTiles() %>%
          fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
      })  

      # reactive circles map
      observe({
        leafletProxy("map", data = reactive_data_chrono()) %>%
          clearShapes() %>%
          addMarkers(lng=~lng,
                     lat=~lat,
                     layerId = ~id) # Assigning df id to layerid
      })
    }

    shinyApp(ui, server)