带滑块的时间滑块/R [英] time slider with leaflet/ R

问题描述

我目前在R中工作，并且我正在使用传单包对地理空间数据进行可视化处理，我想对时间进行分析并在有时间滑块的情况下显示我的地图

I am currently working in R and I am using leaflet package to vizualize geospatial data, I would like to make an analysis over the time and display my map given a time slider

R中具有美学功能，可以在其中添加带有frame选项的滑块，在传单/ggmap中具有类似的功能，或者至少可以在给定年份的情况下对地图进行分面. 我尝试使用ggmap和ggplotly进行练习，但这没有按预期工作. 任何示例/文档或启动提示都将非常有帮助

In R there is the aesthetics function where it's possible to add slider with the frame option, is there a similar function with leaflet/ggmap or at least is it possible to facet the map given different year. I try to do the exercise with ggmap and ggplotly but this doesn't work as expected. Any exemple/ document or hint to start would be very helpful

我已经使闪亮的现有代码适合我的数据库，但是我每年都不需要执行内核密度估算

I have adapt an existing code in shiny to my data base, but I don't have any to perform kernel density estimation for each year

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)

推荐答案

这是使用Shiny软件包的基本解决方案:

Here'is a basic solution using Shiny package :

    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)

这篇关于带滑块的时间滑块/R的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！