Как отфильтровать диапазон дат для маршрутов в блестящем приложении R leaflet? - PullRequest
Новая
       21

Как отфильтровать диапазон дат для маршрутов в блестящем приложении R leaflet?

0 голосов
/ 29 мая 2019

Мои данные выглядят так: 

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)», чтобы сформировать маршрут на карте, и добавить фильтр диапазона дат, чтобы увидеть маршруты на разные диапазоны дат. Каждый (Длонг, Длат) является точкой на карте.

Мне удалось нарисовать карту только с буквой 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)

1 Ответ

0 голосов
/ 30 мая 2019

Разобрался сам. Следующий код работает. 

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