[英]Calculate nearest point coordinate and distance by differing years between two data frames using sf
對於一年中數據框中的每個觀察值,我試圖在一年前的另一個數據框中找到最近的觀察值並計算它們的距離。
按照這種( https://gis.stackexchange.com/questions/349955/getting-a-new-column-with-distance-to-the-nearest-feature-in-r )方法,我編寫了以下代碼:
for(x in 2000:2020) {
R36_loc$nearest <- st_nearest_points(
R36_loc %>% ungroup() %>% filter(year == x),
mining_loc %>% ungroup() %>% filter(year == x - 1)
)
}
R36_loc$dist_near_mine = st_distance(R36_loc, mining_loc[nearest,], by_element=TRUE)
我的數據如下所示: mining_loc
:
structure(list(year = structure(c(2009, 2007, 2008, 2009, 2007,
2007, 2009, 2008, 2010, 2008, 2011, 2002, 2012, 2012, 2009, 2010,
2012, 2006, 2014, 2013, 2008, 2010, 2006, 2011, 2004, 2006, 2011,
2012, 2014, 2005), label = "year", format.stata = "%10.0g"),
geometry = structure(list(structure(c(29.6789, -3.5736), class = c("XY",
"POINT", "sfg")), structure(c(29.146988, -26.09538), class = c("XY",
"POINT", "sfg")), structure(c(0.089167, 35.93111), class = c("XY",
"POINT", "sfg")), structure(c(29.915396, -20.535308), class = c("XY",
"POINT", "sfg")), structure(c(28.01295, -26.22712), class = c("XY",
"POINT", "sfg")), structure(c(-8.88214, 31.86011), class = c("XY",
"POINT", "sfg")), structure(c(6.475727, 30.66071), class = c("XY",
"POINT", "sfg")), structure(c(-2.04396, 5.243666), class = c("XY",
"POINT", "sfg")), structure(c(27.702666, -21.358855), class = c("XY",
"POINT", "sfg")), structure(c(48.650001, -16.176654), class = c("XY",
"POINT", "sfg")), structure(c(33.23611, 28.59167), class = c("XY",
"POINT", "sfg")), structure(c(30.945726, -22.507772), class = c("XY",
"POINT", "sfg")), structure(c(22.90999, -27.175352), class = c("XY",
"POINT", "sfg")), structure(c(10.44916725, 35.54916763), class = c("XY",
"POINT", "sfg")), structure(c(-12.136052, 7.765232), class = c("XY",
"POINT", "sfg")), structure(c(32.89942, 24.09082), class = c("XY",
"POINT", "sfg")), structure(c(28.58115, -25.256046), class = c("XY",
"POINT", "sfg")), structure(c(31.673825, -28.221349), class = c("XY",
"POINT", "sfg")), structure(c(12.916667, 18.683333), class = c("XY",
"POINT", "sfg")), structure(c(8.915834, 33.53159), class = c("XY",
"POINT", "sfg")), structure(c(17.71667, -19.21667), class = c("XY",
"POINT", "sfg")), structure(c(27.88332939, -12.46667004), class = c("XY",
"POINT", "sfg")), structure(c(33.98638, 17.70217), class = c("XY",
"POINT", "sfg")), structure(c(27.302793, -25.65206), class = c("XY",
"POINT", "sfg")), structure(c(-8.10837, 6.87479), class = c("XY",
"POINT", "sfg")), structure(c(-5.03293, 31.50764), class = c("XY",
"POINT", "sfg")), structure(c(38.66667, -3.81667), class = c("XY",
"POINT", "sfg")), structure(c(27.191434, -27.390284), class = c("XY",
"POINT", "sfg")), structure(c(31.924721, -28.841876), class = c("XY",
"POINT", "sfg")), structure(c(-10.7299, 11.32676), class = c("XY",
"POINT", "sfg"))), class = c("sfc_POINT", "sfc"), precision = 0, bbox = structure(c(xmin = -12.136052,
ymin = -28.841876, xmax = 48.650001, ymax = 35.93111), class = "bbox"), crs = structure(list(
input = "EPSG:4326", wkt = "GEOGCRS[\"WGS 84\",\n ENSEMBLE[\"World Geodetic System 1984 ensemble\",\n MEMBER[\"World Geodetic System 1984 (Transit)\"],\n MEMBER[\"World Geodetic System 1984 (G730)\"],\n MEMBER[\"World Geodetic System 1984 (G873)\"],\n MEMBER[\"World Geodetic System 1984 (G1150)\"],\n MEMBER[\"World Geodetic System 1984 (G1674)\"],\n MEMBER[\"World Geodetic System 1984 (G1762)\"],\n MEMBER[\"World Geodetic System 1984 (G2139)\"],\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]],\n ENSEMBLEACCURACY[2.0]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"geodetic latitude (Lat)\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"geodetic longitude (Lon)\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n USAGE[\n SCOPE[\"Horizontal component of 3D system.\"],\n AREA[\"World.\"],\n BBOX[-90,-180,90,180]],\n ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L)), class = c("sf",
"grouped_df", "tbl_df", "tbl", "data.frame"), row.names = c(NA,
-30L), groups = structure(list(year = structure(c(2002, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014), label = "year", format.stata = "%10.0g"),
.rows = structure(list(12L, 25L, 30L, c(18L, 23L, 26L), c(2L,
5L, 6L), c(3L, 8L, 10L, 21L), c(1L, 4L, 7L, 15L), c(9L, 16L,
22L), c(11L, 24L, 27L), c(13L, 14L, 17L, 28L), 20L, c(19L,
29L)), ptype = integer(0), class = c("vctrs_list_of", "vctrs_vctr",
"list"))), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-12L), .drop = TRUE), sf_column = "geometry", agr = structure(c(year = NA_integer_), levels = c("constant",
"aggregate", "identity"), class = "factor"))
和R36_loc
:
structure(list(year = c(2012, 2013, 2008, 2005, 2012, 2013, 2005,
2013, 2008, 2005, 2012, 2012, 2008, 2005, 2005, 2009, 2008, 2012,
2005, 2006, 2012, 2005, 2008, 2012, 2012, 2005, 2008, 2008, 2008,
2005), geometry = structure(list(structure(c(29.17557, -21.20929
), class = c("XY", "POINT", "sfg")), structure(c(-13.75231, 9.4795399
), class = c("XY", "POINT", "sfg")), structure(c(-8.5474997,
6.82056), class = c("XY", "POINT", "sfg")), structure(c(-23.522779,
14.91389), class = c("XY", "POINT", "sfg")), structure(c(-2.64236,
7.8043299), class = c("XY", "POINT", "sfg")), structure(c(40.041,
-0.17200001), class = c("XY", "POINT", "sfg")), structure(c(33.48946,
-9.1142197), class = c("XY", "POINT", "sfg")), structure(c(-7.07623,
4.6770301), class = c("XY", "POINT", "sfg")), structure(c(34.116669,
-14.15), class = c("XY", "POINT", "sfg")), structure(c(35.650669,
-15.80635), class = c("XY", "POINT", "sfg")), structure(c(-11.01406,
6.6858401), class = c("XY", "POINT", "sfg")), structure(c(34.030159,
0.84144002), class = c("XY", "POINT", "sfg")), structure(c(34.191002,
1.016), class = c("XY", "POINT", "sfg")), structure(c(37.385761,
-1.94943), class = c("XY", "POINT", "sfg")), structure(c(2.23564,
7.8688698), class = c("XY", "POINT", "sfg")), structure(c(29.5,
-18.75), class = c("XY", "POINT", "sfg")), structure(c(36.803509,
-14.32926), class = c("XY", "POINT", "sfg")), structure(c(25.883329,
-24.48333), class = c("XY", "POINT", "sfg")), structure(c(26.987329,
-16.688841), class = c("XY", "POINT", "sfg")), structure(c(25.636339,
-33.974258), class = c("XY", "POINT", "sfg")), structure(c(-11.133,
6.8152399), class = c("XY", "POINT", "sfg")), structure(c(35.416672,
-4.1500001), class = c("XY", "POINT", "sfg")), structure(c(28.75,
-30), class = c("XY", "POINT", "sfg")), structure(c(57.633331,
-20.41667), class = c("XY", "POINT", "sfg")), structure(c(33.5,
-3.6666701), class = c("XY", "POINT", "sfg")), structure(c(35.27496,
-0.56010997), class = c("XY", "POINT", "sfg")), structure(c(3.30757,
6.63937), class = c("XY", "POINT", "sfg")), structure(c(-13.647,
13.605), class = c("XY", "POINT", "sfg")), structure(c(32.209759,
-2.80952), class = c("XY", "POINT", "sfg")), structure(c(36.71236,
1.78276), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT",
"sfc"), precision = 0, bbox = structure(c(xmin = -23.522779,
ymin = -33.974258, xmax = 57.633331, ymax = 14.91389), class = "bbox"), crs = structure(list(
input = "EPSG:4326", wkt = "GEOGCRS[\"WGS 84\",\n ENSEMBLE[\"World Geodetic System 1984 ensemble\",\n MEMBER[\"World Geodetic System 1984 (Transit)\"],\n MEMBER[\"World Geodetic System 1984 (G730)\"],\n MEMBER[\"World Geodetic System 1984 (G873)\"],\n MEMBER[\"World Geodetic System 1984 (G1150)\"],\n MEMBER[\"World Geodetic System 1984 (G1674)\"],\n MEMBER[\"World Geodetic System 1984 (G1762)\"],\n MEMBER[\"World Geodetic System 1984 (G2139)\"],\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]],\n ENSEMBLEACCURACY[2.0]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"geodetic latitude (Lat)\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"geodetic longitude (Lon)\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n USAGE[\n SCOPE[\"Horizontal component of 3D system.\"],\n AREA[\"World.\"],\n BBOX[-90,-180,90,180]],\n ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L)), row.names = c(NA,
-30L), class = c("sf", "tbl_df", "tbl", "data.frame"), sf_column = "geometry", agr = structure(c(year = NA_integer_), levels = c("constant",
"aggregate", "identity"), class = "factor"))
來自R36_loc
的每個觀測值都應在新變量中顯示到前一年mining_loc
中最近觀測值的距離。
我認為,我得到的第一個錯誤是由於幾年沒有任何觀察結果(UseMethod 中的錯誤(“st_as_sfc”):沒有適用於“st_as_sfc”的方法應用於 class“NULL”的 object)。
當我只遍歷現有年份時,我得到
Error:
! Assigned data `value` must be compatible with existing data.
✖ Existing data has 7207 rows.
✖ Assigned data has 352800 rows.
ℹ Only vectors of size 1 are recycled.
Backtrace:
1. base::`$<-`(`*tmp*`, nearest, value = `<GEOMETRY [°]>`)
19. tibble (local) `<fn>`(`<vctrs___>`)"
我找到了一種使用RANN
package 的方法。 我首先將幾何提取到 long 和 lat 列,然后按年份將我的數據框轉換為數據框列表:
R36_loc2 <- R36_loc %>% ungroup() %>% mutate(long = unlist(map(.$geometry,1)),
lat = unlist(map(.$geometry,2)))
st_geometry(R36_loc2) <- NULL
AB_by_year <- split(R36_loc2, f = R36_loc$year)
因為,對於第二個數據框,我需要前一年的觀察結果,所以我創建了一個新的年份變量merge_year
並將數據轉換為新變量的列表:
mining_loc$merge_year <- mining_loc$year - 1
# make list of data by merging year
mining_by_year <- split(mining_loc, f = mining_loc$merge_year)
# make ID var
mining_by_year <- mining_by_year %>% lapply(function(x) {x %>% rowid_to_column("ID")})
然后我遍歷這些年並尋找最接近每年每個觀察的我的 - merge_year - 組合,然后將兩個新列[, c(43,44)]
添加到 AB 數據幀列表中的每個年份數據幀。 這兩列將指示與 mining_list 中相應年份數據框中每個觀察值最近的礦井的 ID,稱為nn.idx
和距離,稱為nn.dists
。
for(x in wave_years) {
AB_by_year[[as.character(x)]][ , c(43,44)] <- as.data.frame(RANN::nn2(mining_by_year[[as.character(x)]][,c("lat", "long")], AB_by_year[[as.character(x)]][,c("lat", "long")], k=1)
)
}
然后我通過創建將觀察結果與地雷連接起來的地圖來檢查它是否有效。
我首先為離我最近的線路創建一個列表
lines_list <- vector(mode = "list", length = length(wave_years))
names(lines_list) <- wave_years
我將觀察結果與每個最近的地雷坐標結合起來
for(x in wave_years) {
lines_list[[as.character(x)]] <- left_join(AB_by_year[[as.character(x)]], mining_by_year[[as.character(x)]], by = c("nn.idx" = "ID"))
}
然后我需要將列表轉換回數據框:
lines <- do.call(rbind.data.frame, lines_list)
現在我遵循以下方法: 使用 sf/mapview 連接兩組坐標以創建線條
b = lines[, c("long.x", "lat.x")]
names(b) = c("long", "lat")
e = lines[, c("long.y", "lat.y")]
names(e) = c("long", "lat")
lines$geometry = do.call(
"c",
lapply(seq(nrow(b)), function(i) {
st_sfc(
st_linestring(
as.matrix(
rbind(b[i, ], e[i, ])
)
),
crs = 4326
)
}))
最后,我想以圖形方式顯示,代碼通過首先將數據轉換為 sf 對象來工作
mining_loc_geo <- st_as_sf(mining_loc, coords = c("long", "lat"), crs = 4326)
R36_loc_geo <- st_as_sf(R36_loc, coords = c("long", "lat"), crs = 4326)
然后用ggplot繪制它們。
ggplot() + geom_sf(data = boundaries_africa3, aes()) + geom_sf(data = R36_loc_geo %>% filter(year == 2005), color = "blue", aes(geometry = geometry)) + geom_sf(data = mining_loc_geo %>% filter(merge_year == 2005), color = "red", aes(geometry = geometry)) + geom_sf(data = lines %>% filter(year.x == 2005), aes(geometry = geometry))
object boundaries_africa3
是底層 map。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.