Question

我的数据如下：

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

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

我只用R和传单就可以绘制地图。但是，当我添加了Shiny（因为Shiny具有“ 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)

Answer 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)

如何在R宣传单闪亮应用中过滤路线的日期范围？

1 个答案: