r - 成对函数每行重复 N 次

Question

我有一个数据框，其中每行包含 8 个唯一的经纬度坐标对，我希望绘制这些坐标对。如何将每对经纬度传递给 Leaflet 中的 addPolygons 函数以逐行绘制数据？

一旦在行的末尾，函数应该“停止”，然后在下一行再次“开始”。我想“停止”该函数的原因是为了防止从第 N 行到第 N+1 行的多边形数据中绘制多边形。目前，当我绘制多边形时，这会发生在我的多边形上，它将多边形绘制到下一个不需要的站点。

以下是我用来生成这些图的代码，由@HubertL 提供

m <- as.matrix(t(siteCoor), byrow=T)
dim(m) <- c(2,length(m)/2)
map <- leaflet() %>% addTiles() %>%
       addPolygons(lng=m[1,],lat=m[2,])

样本数据位于以下 link dput() 格式

> head(siteCoor, n = 12L)
   Longitude Latitude         1        2         3        4         5        6         7        8         9       10        11       12        13
1  -8.609117 52.69373 -8.609505 52.71620 -8.602948 52.71588 -8.596586 52.71487 -8.590621 52.71319 -8.585241 52.71089 -8.580617 52.70805 -8.576895
2  -8.609117 52.69373 -8.590303 52.67439 -8.596234 52.67268 -8.602573 52.67162 -8.609117 52.67127 -8.615662 52.67162 -8.622000 52.67268 -8.627931
3  -8.609117 52.69373 -8.644000 52.70119 -8.641276 52.70483 -8.637535 52.70811 -8.632894 52.71094 -8.627501 52.71323 -8.621527 52.71490 -8.615159
4  -8.609117 52.69373 -8.609458 52.71350 -8.603688 52.71323 -8.598090 52.71233 -8.592841 52.71085 -8.588107 52.70883 -8.584038 52.70633 -8.580762
5  -8.609117 52.69373 -8.592560 52.67671 -8.597780 52.67520 -8.603358 52.67428 -8.609117 52.67396 -8.614877 52.67428 -8.620454 52.67520 -8.625674
6  -8.609117 52.69373 -8.639813 52.70030 -8.637416 52.70349 -8.634123 52.70639 -8.630040 52.70888 -8.625294 52.71089 -8.620037 52.71236 -8.614434
7  -8.609117 52.69373 -8.609411 52.71081 -8.604429 52.71057 -8.599594 52.70980 -8.595061 52.70852 -8.590973 52.70677 -8.587459 52.70461 -8.584630
8  -8.609117 52.69373 -8.594817 52.67904 -8.599325 52.67773 -8.604143 52.67693 -8.609117 52.67666 -8.614092 52.67693 -8.618909 52.67773 -8.623417
9  -8.609117 52.69373 -8.635627 52.69940 -8.633556 52.70216 -8.630713 52.70466 -8.627186 52.70681 -8.623088 52.70855 -8.618547 52.70982 -8.613709
10 -8.609117 52.69373 -8.611750 52.72064 -8.603143 52.72045 -8.594761 52.71924 -8.586920 52.71708 -8.579916 52.71403 -8.574012 52.71023 -8.569431
11 -8.609117 52.69373 -8.584672 52.67124 -8.592290 52.66879 -8.600542 52.66728 -8.609117 52.66677 -8.617692 52.66728 -8.625944 52.66879 -8.633562
12 -8.609117 52.69373 -8.651647 52.70143 -8.648402 52.70627 -8.643678 52.71064 -8.637652 52.71438 -8.630550 52.71734 -8.622640 52.71941 -8.614220
         14 Longitude Latitude
1  52.70476 -8.609117 52.69373
2  52.67439 -8.609117 52.69373
3  52.71590 -8.609117 52.69373
4  52.70343 -8.609117 52.69373
5  52.67671 -8.609117 52.69373
6  52.71324 -8.609117 52.69373
7  52.70211 -8.609117 52.69373
8  52.67904 -8.609117 52.69373
9  52.71058 -8.609117 52.69373
10 52.70580 -8.609117 52.69373
11 52.67124 -8.609117 52.69373
12 52.72051 -8.609117 52.69373

Answer 1

我认为最好使用 sp::SpatialPolygons() .

library(sp); library(dplyr)

mat <- as.matrix(sample_data)

如果您想将每个由一行组成的多边形完全分开，最好创建类 Polygons。每行( leaflet() 将类 Polygons 视为独立对象)。

sp <- lapply(1:nrow(mat), function(x) matrix(mat[x,], byrow=T, ncol=2)) %>% 
  sapply(Polygon) %>%          # convert each row into list(matrices) and make list(Polygon)
  mapply(function(x, y) Polygons(list(x), ID = formatC(y, digits=3, flag="000")), x = ., y = 1:length(.)) %>% 
  SpatialPolygons()

sp %>% leaflet() %>% addTiles() %>% addPolygons()

另一种方法

当 c(lng, lat)是 c(NA, NA) , 多边形在该点处中断。

dat <- cbind(sample_data,NA, NA)

m <- as.matrix(t(dat), byrow=T)
dim(m) <- c(2,length(m)/2)
leaflet() %>% addTiles() %>%
  addPolygons(lng=m[1,],lat=m[2,])

您只想删除站点之间的多边形，只需创建一个类 Polygons有课 Polygon . (但如果您将 class Polygons 设为 par 站点，则它在某些情况下有效)。

mat2 <- rbind(mat[1:6,], mat[1:6,] + 0.04)  # example data

sp2 <- lapply(1:nrow(mat2), function(x) matrix(mat2[x,], byrow=T, ncol=2)) %>% 
  sapply(Polygon) %>% Polygons(ID = "a") %>% list() %>% SpatialPolygons()

sp2 %>% leaflet() %>% addTiles() %>% addPolygons()

【加法1:比例尺】
做大小(比例)变化时，需要临时移动所有点，将标准点改为 c(0,0) .

 ## basic idea
exam <- matrix(c(1:4, 16:19), ncol=2)   # the criterion point (the point you don't want to change) is c(1,16)
exam_scaled <- ( exam - exam[rep(1,nrow(exam)),] ) * 0.8  + exam[rep(1,nrow(exam)),]
                        # move                   size change      turn back
 ## example data
mat3 <- as.matrix(sample_data[11:12,])

s <- 0.8     # scale

sp3 <- lapply(1:nrow(mat3), function(x) matrix(mat3[x,], byrow=T, ncol=2)) %>% 
  lapply(function(x) (x - x[rep(1, nrow(x)),]) * s + x[rep(1, nrow(x)),]) %>%    # scale change
  sapply(Polygon) %>%
  mapply(function(x, y) Polygons(list(x), ID = formatCy, digits=3, flag="000")), x = ., y = as.numeric(rownames(mat3))) %>% 
  SpatialPolygons()

sp[10:12] %>% leaflet() %>% addTiles() %>% addPolygons() %>% 
  addPolygons(data = sp3, col = "red")   # 0.8 scale

【添加2:颜色】
我认为使用 SpatialPolygonsDataFrame 是个好主意(这不是必需的，但这种方法可以将所有信息保存在一个对象中)。

 # example data (change positions par 3 polygons)
mat4 <- as.matrix(sample_data) + matrix(c(rep(0, 54), rep(rep(c(0.08, 0), 9), 3), 
  rep(rep(c(0, -0.06), 9), 3), rep(rep(c(0.08, -0.06), 9), 3)), byrow = T, nrow = 12)

sp4 <- lapply(1:nrow(mat4), function(x) matrix(mat4[x,], byrow=T, ncol=2)) %>%  # the same as above code without data
  sapply(Polygon) %>% 
  mapply(function(x, y) Polygons(list(x), ID = formatC(y, digits=3, flag="000")), x = ., y = 1:length(.)) %>% 
  SpatialPolygons()

df <- data.frame(col = rep(c("red", "green", "blue", "cyan"), each = 3),  # for directl definition
                 factor = as.factor(rep(1:4, each = 3)), numeric = 1:12)  # for fanctional approach

rownames(df) <- getSpPPolygonsIDSlots(sp4)           # change rownames into sp4's ID
spdf <- SpatialPolygonsDataFrame(sp4, data = df)     # make SpatialPolygonsDataFrame
spdf@data    # data

 # for functional approach
col_fac <- colorFactor(c("red", "green3", "blue", "cyan"), domain = NULL)
col_num <- colorNumeric(colorRamp(c("white", "red")), domain = NULL)

spdf %>% leaflet() %>% addTiles() %>% addPolygons(color = spdf@data$col)
         # equivalent to addPolygons(color = rep(c("red", "green", "blue", "cyan"), each = 3))
spdf %>% leaflet() %>% addTiles() %>% addPolygons(color = col_fac(spdf@data$factor))
    # The slight color difference from the upper code might come from the difference of color name definition between leaflet and R
spdf %>% leaflet() %>% addTiles() %>% addPolygons(color = col_num(spdf@data$numeric))

 # Note: When you use some parts of SpatialPolygonsDataFrame, you need to transform 
 #       it into SpatialPolygons, such as SpatialPolygons(spdf@polygons)[1:4] %>% ...