使用 gcIntermediate 在 R leaflet/Shiny 中映射跨越日期变更线的最短飞行路径

Mapping the shortest flight path across the date line in R leaflet/Shiny, using gcIntermediate

我正在使用 R-Leaflet 创建澳大利亚机场及其国际目的地的地图。

这是我的示例数据:

df<-data.frame("Australian_Airport" = "Brisbane", 
           "International" =  c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
           "Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
           "Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
           "International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
           "International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638,  3.139003)
           )

我认为通过 gcIntermediate 使用弯曲的飞行路径会很酷,所以我创建了一个 SpatialLines 对象:

library(rgeos)
library(geosphere)

p1<-as.matrix(df[,c(3,4)])

p2<-as.matrix(df[,c(5,6)])

df2 <-gcIntermediate(p1, p2, breakAtDateLine=F, 
                    n=100, 
                    addStartEnd=TRUE,
                    sp=T) 

然后我用 leaflet 和 Shiny 绘制了它:

server <-function(input, output) {

airportmap<- leaflet() %>% addTiles() %>% 
    addCircleMarkers(df, lng = df$Australian_lon, lat = df$Australian_lat, 
    radius = 2, label = paste(df$Australian_Airport, "Airport"))%>% 
    addPolylines(data = df2, weight = 1)

output$mymap <- renderLeaflet({airportmap}) # render the base map
  }


ui<-  navbarPage("International flight path statistics - top routes",
      tabPanel("Interactive map",

      leafletOutput('mymap',  width="100%", height=900)

         )
         )

# Run the application 
shinyApp(ui = ui, server = server)

看起来像这样:

因此,如果路径越过日期变更线,则路径不正确。将 breakAtDateLine 更改为 FALSE 不会修复它(该行消失但路径仍然断开)。在这个阶段,我怀疑我可能需要使用不同的映射系统或其他东西,但如果有人有一些建议,我将不胜感激。

提前致谢。

概览

我将最大范围和最小缩放级别设置为只显示一次世界地图。它在 RStudio 查看器中看起来不错,但在浏览器中显示时失败。我希望这有助于引发其他答案。

代码

# load necessary packages
library( leaflet )
library( geosphere )

# create data
df <- 
  data.frame("Australian_Airport" = "Brisbane", 
             "International" =  c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
             "Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
             "Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
             "International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
             "International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638,  3.139003)
             , stringsAsFactors = FALSE
  )

# create curved lines
curved.lines <-
  gcIntermediate(
    p1 = as.matrix( x = df[ , 3:4 ] )
    , p2 = as.matrix( x = df[ , 5:6 ] )
    , breakAtDateLine = TRUE
    , n = 1000
    , addStartEnd = TRUE
    , sp = TRUE
  ) 

# create leaflet
airport <-
  leaflet( options = leafletOptions( minZoom = 1) ) %>%
  setMaxBounds( lng1 = -180
                , lat1 = -89.98155760646617
                , lng2 = 180
                , lat2 = 89.99346179538875 ) %>%
  addTiles() %>% 
  addCircleMarkers( data = df
                    , lng = ~Australian_lon
                    , lat = ~Australian_lat
                    , radius = 2
                    , color = "red"
                    , label = paste( ~Australian_Airport
                                     , "Airport" )
  ) %>% 
  addCircleMarkers( data = df
                    , lng = ~International_lon
                    , lat = ~International_lat
                    , radius = 2
                    , color = "blue"
                    , label = paste( ~International
                                     , "Airport" )
  ) %>% 
  addPolylines( data = curved.lines
                , weight = 1 
                )
# display map
airport

# end of script #

如果您对另一个地图库感兴趣,那么 googleway 使用 Google 地图,根据我的经验,它更擅长处理跨越日期变更线的线路。

备注

  1. 要使用 Google 地图,您需要一个 API 密钥
  2. 目前只支持sf个对象,不支持sp
  3. 这也适用于 shiny;我这里只是给大家看基本地图
  4. 我创作了 googleway

library(sf)
library(googleway)

## convert the sp object to sf
sf <- sf::st_as_sf(df2)

set_key("your_api_key")

google_map() %>%
    add_polylines(data = sf)