如何过滤 R 传单闪亮应用程序中路线的日期范围？答案

【问题标题】：How to filter date range for routes in R leaflet shiny app?如何过滤 R 传单闪亮应用程序中路线的日期范围？
【发布时间】：2019-05-30 21:18:55
【问题描述】：

我的数据如下所示：

Name    ship_date   delivery_date   ShipmentID  Dcity   Dzip    Dlong   Dlat    Route   Seq Origin  Ozip    Olong   Olat
1-0 4/13/2018   4/13/2018   FL1174_4    Alviso  95002   -121.976    37.426  1   0   Alviso  95002   -121.976    37.426
1-1 4/13/2018   4/13/2018   FL1174_4    SANTA CLARA 95050   -121.965    37.35   1   1   Alviso  95002   -121.976    37.426
1-2 4/13/2018   4/13/2018   FL1185_10   EAST PALO ALTO  94303   -122.129    37.448  1   2   Alviso  95002   -121.976    37.426
1-3 4/13/2018   4/13/2018   FL1169_10   SAN CARLOS  94070   -122.274    37.5    1   3   Alviso  95002   -121.976    37.426
1-4 4/13/2018   4/13/2018   FL1174_4    Alviso  95002   -121.976    37.426  1   4   Alviso  95002   -121.976    37.426
2-0 4/10/2018   4/10/2018   FL1174_3    Alviso  95002   -121.976    37.426  2   0   Alviso  95002   -121.976    37.426
2-1 4/10/2018   4/10/2018   FL1174_3    SANTA CLARA 95050   -121.965    37.35   2   1   Alviso  95002   -121.976    37.426
2-2 4/10/2018   4/10/2018   FL1174_3    Alviso  95002   -121.976    37.426  2   2   Alviso  95002   -121.976    37.426

我希望做的是：对于每个“Route”（“Route”列），依次连接“(Dlong, Dlat)”点，在地图上形成一条路线，并添加日期范围过滤器查看不同日期范围内的路线。每个 (Dlong, Dlat) 都是地图上的一个点。

我能够仅用 R 和传单绘制地图。但是当我添加了闪亮（因为闪亮具有“dateRangeInput”功能）时，它开始出现故障。

我使用“for”循环来“addPolylines”和传单，因为我希望每条路线都用不同的颜色绘制。

地图已显示，但过滤路线错误。有人可以帮我解决问题吗？非常感谢！

library(dplyr)
library(shiny)
library(leaflet)
library(readxl)
library(RColorBrewer)



data_dots = read_excel("routes_output.xlsx")

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

                selectInput("map_version", "Map version",
                            choices = c("Grey", "Geo"), selected = "Grey"),

                dateRangeInput("dateRange", "Date Range Input", start =  min(data_dots$ship_date), end = max(data_dots$ship_date)),


                checkboxInput("legend", "Show legend", TRUE)
  )
)


server <- function(input, output) {
  # Initiate the map
  output$map <- renderLeaflet({
    myMap = leaflet("map") %>% 
      addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
      setView(lng=-97.390,lat=37.697,zoom=5) # %>%

      # add dots
      # addCircles(data = data_dots, ~c(Olong,Dlong) , ~c(Olat,Dlat), stroke=FALSE, fillOpacity = 0.7)

  })

    filteredData <- reactive({
      x = data_dots[as.Date(data_dots$ship_date) >= input$dateRange[1] & as.Date(data_dots$ship_date) <= input$dateRange[2],]
      print(x)
    })

    route_id = reactive({ distinct(filteredData(), Route)

  })

  observe({

    for (i in route_id()$Route) {

      myMap = leafletProxy("map") %>%
        addPolylines(
          data = subset(filteredData(), filteredData()$Route == i),
          weight = 3,
          color = sample(c("red","blue", "green", "yellow", "black", "orange", "grey"), 1),
          opacity = 0.8,
          smoothFactor = 1,
          lng = ~Dlong, 
          lat = ~Dlat,
          highlight = highlightOptions(
            weight = 5,
            color = "blue",
            bringToFront = TRUE
          ),
          layerId = "all"
          # label = ~ as.character(ShipmentID),
          # popup = ~ as.character(ShipmentID),
          # group = "all"
        )


    }
    myMap


  })



}
shinyApp(ui = ui, server = server)

【问题讨论】：

myMap 不可用，因为它从未存储为变量。一般来说，观察者被用来捕捉副作用，而不是返回一些东西。您可以观察某些内容，根据该事件更新 data.frame，然后更新 UI
感谢@DSGym。我删除了 "removeShape(map = myMap, layerId = "all")" 部分。现在地图可以工作了，但是过滤后的路线不对。

标签： r shiny leaflet

【解决方案1】：

我自己想出来的。以下代码有效。

library(dplyr)
library(shiny)
library(leaflet)
library(readxl)
library(RColorBrewer)
library(maps)
library(leaflet.extras)
library(htmlwidgets)



data_dots = read_excel("routes_output.xlsx")


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


                dateRangeInput("dateRange", "Date Range Input", start =  min(data_dots$ship_date), end = max(data_dots$ship_date))


  )
)


server <- function(input, output) {

  #n <- 60
  qual_col_pals = brewer.pal.info[brewer.pal.info$category == 'qual', ]
  col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals)))


  myMap = leaflet("map") %>% 
    addTiles(group = "Base") %>%
    addProviderTiles(providers$CartoDB.Positron, group = "Grey") %>%
    addResetMapButton()


  rv <- reactiveValues(
    filteredData =data_dots,
    ids = unique(data_dots$Route)
  )

  observeEvent(input$dateRange, 
               {rv$filteredData = data_dots[as.Date(data_dots$ship_date) >= input$dateRange[1] & as.Date(data_dots$ship_date) <= input$dateRange[2],]

               rv$ids = unique(rv$filteredData$Route)
               }

  )



  # Initiate the map
  output$map <- renderLeaflet({


    for (i in rv$ids) {
      #print(i)
      myMap = myMap %>%
        addPolylines(
          data = subset(rv$filteredData, Route == i),
          weight = 3,
          color = sample(col_vector, 1),
          opacity = 0.8,
          smoothFactor = 1,
          lng = ~Dlong, 
          lat = ~Dlat,
          highlight = highlightOptions(
            weight = 5,
            color = "blue",
            bringToFront = TRUE
          ),
          label = ~ as.character(ShipmentID),
          popup = ~ as.character(ShipmentID),
          group = "test"
        )


    }
    myMap


  })


}
shinyApp(ui = ui, server = server)

【讨论】：