使用R中的传单映射总线路由

Question

我最近发现了纽约公交线路shape file of NYC bus routes (zip file)的这个形状文件，我有兴趣用R中的传单包绘图。

当我尝试这样做时，某些路线不会显示在地图上。我可以告诉他们丢失了因为我覆盖了公交车站数据而有些人没有与路线对齐。

当我在形状文件中读到时，我注意到创建的空间线数据框具有嵌套列表，我认为传单不是映射。

我需要做什么才能让传单读取这些缺失路线的坐标？下面是我用来生成缺少路线的地图的代码：

bus <- readOGR(dsn = path.expand("bus_route_shapefile"), layer = "bus_route_shapefile")
bus.pj <- spTransform(bus, CRS("+proj=longlat +datum=WGS84"))
bus.st <- readOGR(dsn = path.expand("bus_stop_shapefile"), layer = "bus_stop_shapefile")
bus.st.pj <- spTransform(bus.st, CRS("+proj=longlat +datum=WGS84"))

bus_map <- leaflet() %>%
  setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
  addPolylines(data = bus.pj, color = "black", opacity = 1) %>%
  addCircles(data=bus.st.pj@data,~stop_lon, ~stop_lat, color = "red") %>%
  addTiles()
bus_map

Answer 1

如果您不仅提供bus_routes而且提供bus_stop (zip file)，那么帮助您会更容易。您可以将bus.pj转换为新的SpatialLinesxxx obj来解决此问题，其中每个班级Lines只有一个班级Line。代码下面的SLDF由于未知而没有bus.pj@data$trip_heads。

library(dplyr); library(sp); library(leaflet)

  ## resolve bus.pj@lines into list(Line.objs)   (Don't worry about warnings)
Line_list <- lapply(bus.pj@lines, getLinesLinesSlot) %>% unlist()

       ## If you want just Lines infromation, finish with this line.
     SL <- sapply(1:length(Line_list), function(x) Lines(Line_list[[x]], ID = x)) %>% 
       SpatialLines()

  ## make new ids (originalID_nth)
ori_id <- getSLLinesIDSlots(bus.pj)                         # get original ids
LinLS <- sapply(bus.pj@lines, function(x) length(x@Lines))  # how many Line.obj does each Lines.obj has
new_id <- sapply(1:length(LinLS), function(x) paste0(x, "_", seq.int(LinLS[[x]]))) %>% 
  unlist()

  ## make a new data.frame (only route_id)
df <- data.frame(route_id = rep(bus.pj@data$route_id, times = LinLS))
rownames(df) <- new_id

  ## integrate Line.objs, ids and a data.frame into SpatialLinesDataFrame.obj
SLDF <- mapply(function(x, y) Lines(x, ID = y), x = Line_list, y = new_id) %>% 
  SpatialLines() %>% SpatialLinesDataFrame(data = df)


leaflet() %>%
  setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
  addPolylines(data = SLDF, color = "black", opacity = 1, weight = 1) %>% 
  addCircles(data=bus.st.pj@data,~stop_lon, ~stop_lat, color = "red", weight = 0.3)