【问题标题】:Zip code distance R邮编距离 R
【发布时间】:2015-07-15 11:35:00
【问题描述】:

我在 R 中使用邮政编码包,我想列出每个邮政编码半径 10、20 或 X 英里范围内的所有邮政编码。从那里我会将邮政编码数据汇总到 10、20 或 X 英里的总距离。我目前正在加入每个邮政编码,每个邮政编码(所以行数平方)。然后计算每个邮政编码之间的距离。然后消除大于 10,20, X 英里的距离。有没有更好的方法在 R 中做到这一点,所以我不必计算所有可能性?我是 R 的新手。谢谢!

Code is here:
#Bringing in Zipcode database. 
library(zipcode)
data(zipcode)

#Limiting to certain states that I want to include,
SEZips <- zipcode[zipcode$state %in% c("GA","AL", "SC", "NC"),]

#Duplicating the data set to join it together
SEZips2 <- SEZips

#To code in SQL
library(sqldf)

#Creating a common match so I can join all rows from both tables together
SEZips$Match <- 1
SEZips2$Match <- 1

#attaches every zip code to each zip
ZipList <- sqldf("
                 SELECT
                 A.zip as zip1,
                 A.longitude as lon1,
                 A.latitude as lat1,
                 B.zip as zip2,
                 B.longitude as lon2,
                 B.latitude as lat2
                 From SEZips A
                 Left Join SEZips2 B
                 on A.Match = B.Match
                 ")


#to get the distance calculation, use package geosphere, 
library(geosphere)

#radius of Earth in miles, adjust for km, etc.
r = 3959
#Creating Table of the coordinates. Makes it easy to calc distance
Points1 <- cbind(ZipList$lon1,ZipList$lat1)
Points2 <- cbind(ZipList$lon2,ZipList$lat2)
distance <- distHaversine(Points1,Points2,r)

#Adding distance back on to the original ZipList
ZipList$Distance <- distance

#To limit to a certain radius.E.g. 15 for 15 miles.
z = 15
#Eliminating matches > z 
ZipList2 <- ZipList[ZipList$Distance <= z,]

#Adding data to roll up, e.g. population
ZipPayroll <- read.csv("filepath/ZipPayroll.csv")

#Changin Zip to 5 character from integer. A little bit of pain
#Essentailly code says (add 5 0's, and then grab the right 5 characters)
ZipPayroll$Zip2 <- substr(paste("00000",ZipPayroll$zip,sep=""),nchar(paste("00000",ZipPayroll$zip,sep=""))-4,nchar(paste("00000",ZipPayroll$zip,sep="")))

#Joining Payroll info to SEZips dataframe
SEZips <- sqldf("
                SELECT
                A.*,
                B.Payroll, 
                B.Employees,
                B.Establishments
                From SEZips A
                Left Join ZipPayroll B
                on A.zip = B.Zip2
                ")

#Rolling up to 15 mile level
SEZips15 <- sqldf("
                  SELECT
                  A.zip1 as Zip, 
                  Sum(B.Payroll) as PayrollArea,
                  Sum(B.Employees) as EmployeesArea,
                  Sum(B.Establishments) as EstablishmentsArea
                  From ZipList2 A
                  Left Join SEZips B
                  on A.zip2 = B.zip
                  Group By A.zip1
                  ")

#Include the oringinal Zip data 
SEZips15 <- sqldf("
                  SELECT
                  A.*,
                  B.Payroll,
                  B.Employees,
                  B.Establishments as EstablishmentsArea
                  From SEZips15 A
                  Left Join SEZips B
                  on A.zip = B.zip
                  ")

#Calculate Average Pay for Zip and Area
SEZips15$AvgPayArea <- SEZips15$PayrollArea / SEZips15$EmployeesArea
SEZips15$AvgPay <- SEZips15$Payroll / SEZips15$Employees

【问题讨论】:

  • 您当前的代码实际上将每个邮政编码与其他邮政编码进行了两次比较。 (16127 为 A,27513 为 B……然后 27513 为 A,16127 为 B。)您只需比较一次即可将工作减半。如果您将其视为二维网格或表格,您只需要从左上角到右下角的对角线上方进行匹配。此外,您可以在 1 = 1 上加入并避免创建 match 变量...
  • 另外,作为后续问题...您是否遇到性能问题?如果没有,您的解决方案可能很好......如果是这样,您可以从优化中受益......
  • 谢谢约翰!关于将所有内容进行两次比较,我认为我需要两者。例如,我需要 Zip 匹配 16127、27513 和 zip 匹配 27513,16217。这使我可以分别总结 zip 16127 和 27513 周围的所有拉链。会有重叠,这是意料之中的。
  • 我目前没有优化问题,但它只有 4 种数据状态,当我添加更多时它会呈指数增长。我是 R 的新手,所以我在 sqldf 中做了很多工作,并且很好奇在 r 或一些地理空间计算中是否有更有效的方法。感谢您提供有关比赛的提示!
  • zip 16127 到 27513 的距离与 27513 到 16127 的距离相同。如果您想节省 CPU 周期,您可以计算一次该距离,如果需要,稍后再转换数据。 (虽然转换数据的计算成本可能比进行计算要高 - 试试看)。

标签: r geospatial distance zipcode


【解决方案1】:

我在下面添加了一个使用 spatialrisk 包的解决方案。此包中的关键函数是用 C++ (Rcpp) 编写的,因此速度非常快。

函数 spatialrisk::points_in_circle() 从中心点计算半径内的观测值。请注意,距离是使用 Haversine 公式计算的。

library(spatialrisk)
library(tidyverse)

zips_within_radius <- function(x,y,z) {
  points_in_circle(SEZips, x, y, lon = longitude, lat = latitude, radius = 10000) %>% 
    mutate(source_zip = z)
 }

由于输出的每个元素都是一个数据框,因此使用 purrr::map_dfr 将它们行绑定在一起:

pmap_dfr(list(SEZips$longitude, SEZips$latitude, SEZips$zip), zips_within_radius)

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2011-04-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2019-08-19
    • 1970-01-01
    相关资源
    最近更新 更多