使用 distm(distVincentyEllipsoid) 的点子集(相同 ID)之间的平均大地距离,并将结果存储在 R 中的新数据框中

Average geodetic distance between subsets of points (same ID) using distm(distVincentyEllipsoid) and storing the results in a new dataframe in R

我的数据库结构如下:

    > long <- c(13.2345, 14.2478, 16.2001, 11.2489, 17.4784, 27.6478, 14.2500, 12.2100, 11.2014, 12.2147)
    > lat <- c(47.1247, 48.2013, 41.2547, 41.2147, 40.3247, 46.4147, 42.4786, 41.2478, 48.2147, 47.2157)
    > hh_id <- 1:10
    > vill_id <- c(rep(100, 4), rep(101, 3), rep(102, 2), 103)

    > df <- matrix(c(long, lat, hh_id, vill_id), nrow = 10, ncol = 4)
    > colnames(df) <- c("longitude", "latitude", "hh_id", "vill_id") 
    > df <- as.data.frame(df)
    > df
       longitude latitude hh_id vill_id
       13.2345  47.1247     1     100
       14.2478  48.2013     2     100
       16.2001  41.2547     3     100
       11.2489  41.2147     4     100
       17.4784  40.3247     5     101
       27.6478  46.4147     6     101
       14.2500  42.4786     7     101
       12.2100  41.2478     8     102
       11.2014  48.2147     9     102
       12.2147  47.2157    10     103

hh_id - 家庭 ID

vill_id - 村庄 ID

同一户口同村

我的目标:计算具有相同vill_id的所有点之间的平均距离并将结果存储在新的数据框中:

vill_id    mean_dist
100        587553.5
101        …………………
102        …………………
103        ………………

我的做法: 为了计算点之间的大地距离,我使用了 geosphere 包中的 distm 命令(distVincentyEllipsoid 应该是最准确的)

> library(geosphere)
> df_100 <- df[df$vill_id == 100, ]
> dist_100 <- distm(df_100, fun = distVincentyEllipsoid)
Error in .pointsToMatrix(p1) : Wrong length for a vector, should be 2 --> 
> df_100_2 <- df_100[, c(1, 2)]
> dist_100_2 <- distm(df_100_2, fun = distVincentyEllipsoid)
> dist_100_2
         [,1]     [,2]     [,3]     [,4]
[1,]      0.0 141844.7 693867.8 675556.9
[2,] 141844.7      0.0 787217.4 811777.4
[3,] 693867.8 787217.4      0.0 415056.6
[4,] 675556.9 811777.4 415056.6      0.0

因此生成了所有点的对称距离矩阵 vill_id = 100。 要计算平均距离,我需要分解此矩阵(或删除所有对角线值 (0))。

> diag(dist_100_2) = NA
> dist_100_2_final <- dist_100_2[!is.na(dist_100_2)]
> dist_100_2_final
 [1] 141844.7 693867.8 675556.9 141844.7 787217.4 811777.4 693867.8 787217.4 415056.6 675556.9
[11] 811777.4 415056.6
> mean(dist_100_2_final)
[1] 587553.5 (in m)

到目前为止一切顺利。 现在我需要创建一个新的数据框,它存储具有相同 ID 的所有子集的平均距离(我的原始数据库有 200 多个村庄(vill_id)和近 2000 个家庭(hh_id))。 你能帮我完成代码吗?我想我必须使用循环(或者也许有另一个包来解决这个问题)? 非常感谢您的帮助。

昨天我发布了类似的问题,不同之处在于 mean_dist 已经是我原始数据框的一部分(在 ArcGIS 中计算),但现在我想在 R 中计算这些以比较结果。 我已尝试实施我上一个问题中推荐的代码,但没有成功。

考虑基数 R 的 by,因为您需要 运行 跨不同因素水平的操作(即 vill_id)。在 by 中,您可以调用一个已定义或匿名函数,该函数将 return 一个数据帧列表,您可以将这些数据帧行绑定回一个数据帧:

dfList <- by(df, df[c("vill_id")], FUN = function(i){
     sub <- i[, c(1, 2)]
     tmp <- distm(sub, fun = distVincentyEllipsoid)
     diag(tmp) = NA
     i$mean_dist <- mean(tmp[!is.na(tmp)])                  # NEW COLUMN ADDED
     return(i)
})

finaldf <- do.call(rbind, dfList)

如果你需要vill_idhh_id子集,添加到因子列表:

dfList <- by(df, df[c("vill_id", "hh_id")], FUN = function(i){ ... })

如果你只需要 vill_idmean_dist return 函数,更改 return 值:

newdf <- unique(i[c("vill_id", "mean_dist")]
return(newdf)

具体来说,如下代码块:

df_100 <- df[df$vill_id == 100, ]                            # BY REPLACES THIS LINE
df_100_2 <- df_100[, c(1, 2)]
dist_100_2 <- distm(df_100_2, fun = distVincentyEllipsoid)                 
diag(dist_100_2) = NA
dist_100_2_final <- dist_100_2[!is.na(dist_100_2)]
mean(dist_100_2_final)

翻译如下 其中iby函数变量:

sub <- i[,c(1, 2)]
tmp <- distm(sub, fun = distVincentyEllipsoid)
diag(tmp) = NA
i$mean_dist <- mean(tmp[!is.na(tmp)])

另一种方法是使用 lapply()。我基本上修改了你的代码。我添加的一件事是将您的数据按 vill_id 拆分并创建一个列表。然后,我应用了您的代码块来计算 lapply() 中每个分割数据帧的距离。最后,我创建了一个具有平均值的数据框。

library(geosphere)

mylist <- split(df, f = df$vill_id)

unlist(lapply(mylist, function(x){

        foo <- x[, 1:2]
        foo <- distm(foo, fun = distVincentyEllipsoid)
        diag(foo) = NA
        out <- foo[!is.na(foo)]
        average <- mean(out)
        average
      })
) -> mean_dist

data.frame(vill_id = unique(df$vill_id),
           mean_dist = mean_dist)

#    vill_id mean_dist
#100     100  587553.5
#101     101  858785.6
#102     102  778299.1
#103     103       NaN