我的数据如下所示：
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)
我自己想出来的。以下代码有效。
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)