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

jdi*_*o12 9 r leaflet shiny

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

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")
  }
})
Run Code Online (Sandbox Code Playgroud)

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

我真的很感激任何帮助!

Sym*_*xAU 7

注意

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


示例 - mapdeck

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

它适用于data.framesdata.tables(以及spsf)的对象.

center <- 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"
  )
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

示例 - googleway

这个例子使用googleway(也是我的包,它与Google Maps API接口),也适用于data.framesdata.tables(以及spsf)

诀窍在于encodeCoordinates函数,它将坐标(线)编码为Google折线

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
    )
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述


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]))
    )
Run Code Online (Sandbox Code Playgroud)

数据

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")
Run Code Online (Sandbox Code Playgroud)


Dav*_*ung 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)
                  )
Run Code Online (Sandbox Code Playgroud)

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

orig_df <- data.frame (lat = c(rep.int(40.75, nrow(dest_df))),
                   long = c(rep.int(-73.99,nrow(dest_df)))
                  )
Run Code Online (Sandbox Code Playgroud)

我这样做的原因是因为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)
Run Code Online (Sandbox Code Playgroud)

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

数据的SS

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

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

  addPolylines(
    data = poly_df,
    lng = ~lon, 
    lat = ~lat,
    weight = 3,
    opacity = 3
  ) 
Run Code Online (Sandbox Code Playgroud)

最后它应该是这样的:

传单地图的SS

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


fde*_*sch 4

这是一种基于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)
Run Code Online (Sandbox Code Playgroud)

线

只是不要对Line-to-SpatialLines过程感到困惑(请参阅?Line?SpatialLines)。