使用distm（distVincentyEllipsoid）將點子集（相同ID）之間的平均大地測量距離並將結果存儲在R中的新數據框中

Question

我的數據庫具有以下結構：

    > 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

具有相同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中計算這些值以比較結果。 我嘗試實施上一個問題中推薦的代碼，但沒有成功。

Answer 1

考慮基數R by因為您需要在不同級別的因子（即vill_id ）上運行操作。 在by ，您可以調用定義的或匿名函數，該函數將返回一個數據框列表，您可以將其行綁定回一個數據框：

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_id和hh_id子集，請添加到因子列表中：

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

如果只需要從函數返回vill_id和mean_dist ，則更改返回值：

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)

轉換為以下內容，其中i是by函數變量：

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

Answer 2

另一種方法是使用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