如何使用有光泽的传单分别将折线从一个位置添加到其他位置?

时间:2015-07-09 07:40:36

标签: r shiny leaflet

我正在尝试使用传单中的addPolylines闪亮 R中的某个特定位置添加折线。但是,不是从一个位置链接到另一个位置,我只能按顺序将它们全部链接在一起。在板球车轮图中可以看到我想要实现的最好的例子:

observe({
  long.path <- c(-73.993438700, (locations$Long[1:9]))
  lat.path <- c(40.750545000, (locations$Lat[1:9]))
  proxy <- leafletProxy("map", data = locations)
  if (input$paths) {
     proxy %>% addPolylines(lng = long.path, lat = lat.path, weight = 3, fillOpacity = 0.5, 
                       layerId = ~locations, color = "red")
  }
})

它是一个反应性表达,因为我希望它们被一个复选框激活。

我真的很感激任何帮助!

3 个答案:

答案 0 :(得分:7)

注意

我知道OP要求传单答案。但是这个问题激起了我寻求替代解决方案的兴趣,所以这里有两个

示例 - mapdeck

Mapdeck(我的包)在Mapbox地图上使用Deck.gl,因此您需要一个Mapbox API密钥才能使用它。但它确实可以让你绘制2.5d弧线

适用于data.tablessp(以及sfcenter <- c(144.983546, -37.820077) df_hits$center_lon <- center[1] df_hits$center_lat <- center[2] df_hits$score <- sample(c(1:4,6), size = nrow(df_hits), replace = T) library(mapdeck) set_token("MAPBOX") mapdeck( style = mapdeck_style("satellite") ) %>% add_arc( data = df_hits , origin = c("center_lon", "center_lat") , destination = c("lon", "lat") , stroke_from = "score" , stroke_to = "score" , stroke_width = "score" , palette = "magma" ) )对象。

googleway

enter image description here

示例 - googleway

此示例使用data.frames(也是我的包,它与Google Maps API接口),也适用于data.tablessp(以及sf和{{} 1}})

诀窍在encodeCoordinates函数中,它将坐标(行)编码为Google Polyline

library(data.table)
library(googleway)
library(googlePolylines) ## gets installed when you install googleway

center <- c(144.983546, -37.820077)

setDT(df_hits)  ## data given at the end of the post

## generate a 'hit' id
df_hits[, hit := .I]

## generate a random score for each hit
df_hits[, score := sample(c(1:4,6), size = .N, replace = T)]

df_hits[
    , polyline := encodeCoordinates(c(lon, center[1]), c(lat, center[2]))
    , by = hit
]

set_key("GOOGLE_MAP_KEY") ## you need an API key to load the map

google_map() %>%
    add_polylines(
        data = df_hits
        , polyline = "polyline"
        , stroke_colour = "score"
        , stroke_weight = "score"
        , palette = viridisLite::plasma
    )

enter image description here

dplyr等价物将是

df_hits %>%
    mutate(hit = row_number(), score = sample(c(1:4,6), size = n(), replace = T)) %>%
    group_by(hit, score) %>%
    mutate(
        polyline = encodeCoordinates(c(lon, center[1]), c(lat, center[2]))
    )

数据

df_hits <- structure(list(lon = c(144.982933659011, 144.983487725258, 
144.982804912978, 144.982869285995, 144.982686895782, 144.983239430839, 
144.983293075019, 144.983529109412, 144.98375441497, 144.984103102141, 
144.984376687461, 144.984183568412, 144.984344500953, 144.984097737723, 
144.984065551215, 144.984339136535, 144.984001178199, 144.984124559814, 
144.984280127936, 144.983990449363, 144.984253305846, 144.983030218536, 
144.982896108085, 144.984022635871, 144.983786601478, 144.983668584281, 
144.983673948699, 144.983577389175, 144.983416456634, 144.983577389175, 
144.983282346183, 144.983244795257, 144.98315360015, 144.982896108085, 
144.982686895782, 144.982617158347, 144.982761997634, 144.982740539962, 
144.982837099486, 144.984033364707, 144.984494704658, 144.984146017486, 
144.984205026084), lat = c(-37.8202049841516, -37.8201201023877, 
-37.8199253045246, -37.8197812267274, -37.8197727515541, -37.8195269711051, 
-37.8197600387923, -37.8193828925304, -37.8196964749506, -37.8196583366193, 
-37.8195820598976, -37.8198956414717, -37.8200651444706, -37.8203575362288, 
-37.820196509027, -37.8201032825917, -37.8200948074554, -37.8199253045246, 
-37.8197897018997, -37.8196668118057, -37.8200566693299, -37.8203829615443, 
-37.8204295746001, -37.8205355132537, -37.8194761198756, -37.8194040805737, 
-37.819569347103, -37.8197007125418, -37.8196752869912, -37.8195015454947, 
-37.8194930702893, -37.8196286734591, -37.8197558012046, -37.8198066522414, 
-37.8198151274109, -37.8199549675656, -37.8199253045246, -37.8196964749506, 
-37.8195862974953, -37.8205143255351, -37.8200270063298, -37.8197430884399, 
-37.8195354463066)), row.names = c(NA, -43L), class = "data.frame")

答案 1 :(得分:6)

我知道这是在一年前被问到的,但我有同样的问题,并想出如何在传单中这样做。

您首先必须调整数据帧,因为addPolyline只是连接序列中的所有坐标。您似乎知道自己的起始位置,并希望将其分支到9个不同的位置。我将从你的结局位置开始。由于您尚未提供,我将为此演示创建一个包含4个单独结束位置的数据框。

dest_df <- data.frame (lat = c(41.82, 46.88, 41.48, 39.14),
                   lon = c(-88.32, -124.10, -88.33, -114.90)
                  )

接下来,我将创建一个数据框,其中心位置与目标位置的大小相同(本例中为4)。我会用你原来的坐标。我会解释为什么我很快就会这样做

orig_df <- data.frame (lat = c(rep.int(40.75, nrow(dest_df))),
                   long = c(rep.int(-73.99,nrow(dest_df)))
                  )

我这样做的原因是因为addPolylines功能将连接序列中的所有坐标。为了创建你描述的图像,解决这个问题的方法是从起点开始,然后到目的地点,然后回到起点,然后到下一个目的地点。为了创建数据帧来执行此操作,我们必须通过按行放置来交织两个数据帧:

起点 - 目的地点1 - 初始点 - 目的地点2 - 等等......

我将采用的方法是为两个数据帧创建一个键。对于原始数据帧,我将从1开始,并递增2(例如,1 3 5 7)。对于目标数据帧,我将从2开始并递增2(例如,2,4,6,8)。然后,我将使用UNION all组合2个数据帧。然后我将按照我的顺序排序,使每一行成为起点。我将使用sqldf,因为这是我很满意的。可能有一种更有效的方式。

orig_df$sequence <- c(sequence = seq(1, length.out = nrow(orig_df), by=2))
dest_df$sequence <- c(sequence = seq(2, length.out = nrow(orig_df), by=2))

library("sqldf")
q <- "
SELECT * FROM orig_df
UNION ALL
SELECT * FROM dest_df
ORDER BY sequence
"
poly_df <- sqldf(q)

新数据框看起来像这样(注意原点位置如何在目的地之间交织):

SS of data

最后,你可以制作你的地图:

library("leaflet")
leaflet() %>%
  addTiles() %>%

  addPolylines(
    data = poly_df,
    lng = ~lon, 
    lat = ~lat,
    weight = 3,
    opacity = 3
  ) 

最后看起来应该是这样的:

SS of Leaflet Map

我希望这可以帮助那些希望将来做这类事情的人

答案 2 :(得分:3)

这是一种基于 mapview 包的可能方法。只需创建SpatialLines将您的起点与每个终点(存储在locations),bind中连接在一起,然后使用mapview显示数据。

library(mapview)
library(raster)

## start point
root <- matrix(c(-73.993438700, 40.750545000), ncol = 2)
colnames(root) <- c("Long", "Lat")

## end points
locations <- data.frame(Long = (-78):(-70), Lat = c(40:44, 43:40))

## create and append spatial lines
lst <- lapply(1:nrow(locations), function(i) {
  SpatialLines(list(Lines(list(Line(rbind(root, locations[i, ]))), ID = i)), 
               proj4string = CRS("+init=epsg:4326"))
})

sln <- do.call("bind", lst)

## display data
mapview(sln)

lines

请不要对Line - 至 - SpatialLines程序感到困惑(请参阅?Line?SpatialLines)。