我正在开展一项研究,试图根据他们的地址将颗粒物暴露给特定的个体。我有两个经度和纬度坐标的数据集。一个用于个人,一个用于pm曝光块。我想根据最接近的块为每个主题分配一个pm曝光块。
library(sp)
library(raster)
library(tidyverse)
#subject level data
subjectID<-c("A1","A2","A3","A4")
subjects<-data.frame(tribble(
~lon,~lat,
-70.9821391, 42.3769511,
-61.8668537, 45.5267133,
-70.9344039, 41.6220337,
-70.7283830, 41.7123494
))
row.names(subjects)<-subjectID
#PM Block Locations
blockID<-c("B1","B2","B3","B4","B5")
blocks<-data.frame(tribble(
~lon,~lat,
-70.9824591, 42.3769451,
-61.8664537, 45.5267453,
-70.9344539, 41.6220457,
-70.7284530, 41.7123454,
-70.7284430, 41.7193454
))
row.names(blocks)<-blockID
#Creating distance matrix
dis_matrix<-pointDistance(blocks,subjects,lonlat = TRUE)
###The above code doesnt preserve the row names. Is there a way to to do
that?
###I'm unsure about the below code
colnames(dis_matrix)<-row.names(subjects)
row.names(dis_matrix)<-row.names(blocks)
dis_data<-data.frame(dis_matrix)
###Finding nearst neighbor and coercing to usable format
getname <-function(x) {
row.names(dis_data[which.min(x),])
}
nn<-data.frame(lapply(dis_data,getname)) %>%
gather(key=subject,value=neighbor)
此代码为我提供了有意义的输出,但我不确定其有效性和效率。任何关于如何改进和修复此代码的建议都表示赞赏。我还收到错误消息:
Warning message:
attributes are not identical across measure variables;
they will be dropped
我无法确定其来源。
谢谢你看看!
答案 0 :(得分:2)
以下是一些示例数据,如何使用pointDistance
:
library(raster)
#subject level data
subjectID <- c("A1","A2","A3","A4")
subxy <- matrix(c(-65, 42, -60, 4.5, -70, 20, -75, 41 ), ncol=2, byrow=TRUE)
#PM Block Locations
blockID <- c("B1","B2","B3","B4","B5")
blockxy <- matrix(c(-68, 22, -61, 25, -70, 31, -65, 11,-63, 21), ncol=2, byrow=TRUE)
# distance of all subxy to all blockxy points
d <- pointDistance(subxy, blockxy, lonlat=TRUE)
# get the blockxy record nearest to each subxy record
r <- apply(d, 1, which.min)
r
#[1] 3 4 1 3
所以对是:
p <- data.frame(subject=subjectID, block=blockID[r])
p
# subject block
#1 A1 B3
#2 A2 B4
#3 A3 B1
#4 A4 B3
说明它有效:
plot(rbind(blockxy, subxy), ylim=c(0,45), xlab='longitude', ylab='latitude')
points(blockxy, col="red", pch=20, cex=2)
points(subxy, col="blue", pch=20, cex=2)
text(subxy, subjectID, pos=1)
text(blockxy, blockID, pos=1)
for (i in 1:nrow(subxy)) {
arrows(subxy[i,1], subxy[i,2], blockxy[r[i],1], blockxy[r[i],2])
}
答案 1 :(得分:1)
如果你有一个大数据集,你可能想要使用效率很高的nabor
包,正如this answer中@ user3507085所解释的那样。由于这个问题因为偏离主题而被关闭,我已经将下面的答案复制粘贴,因此它会保持活跃状态&#34;在这个帖子里。我不知道这是否被视为不良做法,如果有要求,我很乐意删除/修改(请注意knn
给出的距离不地理距离,但我猜他们可以通过包括arcsin的简单转换转换为球面距离:
lonlat2xyz=function (lon, lat, r)
{
lon = lon * pi/180
lat = lat * pi/180
if (missing(r))
r <- 6378.1
x <- r * cos(lat) * cos(lon)
y <- r * cos(lat) * sin(lon)
z <- r * sin(lat)
return(cbind(x, y, z))
}
lon1=runif(100,-180,180);lon2=runif(100,-180,180);lat1=runif(100,-90,90);lat2=runif(100,-90,90)
xyz1=lonlat2xyz(lon1,lat1)
xyz2=lonlat2xyz(lon2,lat2)
library(nabor)
out=knn(data=xyz1,query = xyz2,k=20)
library(maps)
map()
points(lon1,lat1,pch=16,col="black")
points(lon2[1],lat2[1],pch=16,col="red")
points(lon1[out$nn.idx[1,]],lat1[out$nn.idx[1,]],pch=16,col="blue")