基于数据帧内容的子集矩阵

Subsetting Matrix Based on contents of dataframe

我有一个 100X100 的相关矩阵,其中邮政编码作为列名和行名。我还有一个数据框,其中包含所有 zipcdes 的纬度和经度,以及一个根据纬度和经度计算距离的函数。

这是相关矩阵的片段

            08846       48186       90621      92602       92701       92702       92703      92705      92706      92712
08846  1.00000000 -0.18704668  0.17631080 -0.0195590 -0.08640209 -0.09109788 -0.04251868 -0.1586506 -0.0778115 -0.0572327
48186 -0.18704668  1.00000000 -0.09365048  0.1616530  0.20468051  0.17682056  0.18009911  0.1417840  0.1958971  0.1938676
90621  0.17631080 -0.09365048  1.00000000  0.5880756  0.75200501  0.74694849  0.76071605  0.6593806  0.7640519  0.7657806
92602 -0.01955900  0.16165299  0.58807565  1.0000000  0.88187818  0.88947447  0.89310793  0.9615530  0.8926566  0.8926482
92701 -0.08640209  0.20468051  0.75200501  0.8818782  1.00000000  0.99314798  0.98011569  0.9294281  0.9827633  0.9886139
92702 -0.09109788  0.17682056  0.74694849  0.8894745  0.99314798  1.00000000  0.98791442  0.9470895  0.9853157  0.9933086
92703 -0.04251868  0.18009911  0.76071605  0.8931079  0.98011569  0.98791442  1.00000000  0.9321385  0.9938496  0.9981231
92705 -0.15865058  0.14178399  0.65938061  0.9615530  0.92942815  0.94708954  0.93213849  1.0000000  0.9268797  0.9357917
92706 -0.07781150  0.19589706  0.76405191  0.8926566  0.98276329  0.98531570  0.99384961  0.9268797  1.0000000  0.9948550
92712 -0.05723270  0.19386757  0.76578065  0.8926482  0.98861389  0.99330864  0.99812312  0.9357917  0.9948550  1.0000000

这是 table 邮政编码的片段

    zip       city state latitude longitude
1 00210 Portsmouth    NH  43.0059  -71.0132
2 00211 Portsmouth    NH  43.0059  -71.0132
3 00212 Portsmouth    NH  43.0059  -71.0132
4 00213 Portsmouth    NH  43.0059  -71.0132
5 00214 Portsmouth    NH  43.0059  -71.0132
6 00215 Portsmouth    NH  43.0059  -71.0132

这是计算纬度和经度之间距离的函数。

Calc_Dist <- function (long1, lat1, long2, lat2)
{
  rad <- pi/180
  a1 <- lat1 * rad
  a2 <- long1 * rad
  b1 <- lat2 * rad
  b2 <- long2 * rad
  dlon <- b2 - a2
  dlat <- b1 - a1
  a <- (sin(dlat/2))^2 + cos(a1) * cos(b1) * (sin(dlon/2))^2
  c <- 2 * atan2(sqrt(a), sqrt(1 - a))
  R <- 6378.145
  d <- R * c
  return(d)
}

我的目标是对相关矩阵进行子集化,使其仅包含相距超过 500 英里的邮政编码(目前距离计算以公里为单位输出,但可以轻松更改并且现在不重要)。越便宜越好,因为我可能必须使用更大的相关矩阵 (~10000 x 10000) 来执行此操作。有什么建议吗?

提前致谢, 本

必须使用该距离函数是否很重要?我认为 dist 应该更有效率。

#Making your zip.table a data.table helps us with speed
library(reshape)
library(data.table)
setDT(zip.table) 

#Calculate distance matrix and put into table form
setorder(zip.dist,zip)
zip.dist <- dist(zip.table[,.(longitude=abs(longitude),latitude)])
zip.dist <- as.matrix(zip.dist)
zip.dist <- melt(zip.dist)[melt(upper.tri(zip.dist))$value,]
setDT(zip.dist)
setnames(zip.dist,c("zip1", "zip2", "distance"))

#Do a very similar procedure with your correlation matrix
#It is important that you sorted your zip.table by zip before applying `cor`
zip.corr <- as.matrix(zip.corr)
zip.corr <- melt(zip.corr)[melt(upper.tri(zip.corr))$value,]
setDT(zip.corr)
setnames(zip.corr,c("zip1", "zip2", "cor"))

#Subset zip.dist to only include zip codes more than 500 miles apart
zip.dist <- zip.dist[distance*69 > 500] #69 mile ~ 1 degreen lat/lon

#Merge together
setkey(zip.dist,zip1,zip2)
setkey(zip.corr,zip1,zip2)
result.table <- zip.dist[zip.corr, nomatch=0]

由于这些地方都非常接近彼此,我认为使用欧几里德距离不会损失太多。特别是因为它是一个lat/lon在一个大县里。