如何计算距离并返回具有最短距离的特定变量的值？

Question

I have two separated datasets. One contains the location of the participants, another contains the location of measurement station and corresponding values, at different time points. Below I generate sample datasets.

# dataset of value
yearmon <- c("Jan 1996","Jan 1996","Jan 1996","Jan 1996","Jan 1996","Jan 1996",
         "Feb 1996","Feb 1996","Feb 1996","Feb 1996","Feb 1996","Feb 1996",
         "Mar 1996","Mar 1996","Mar 1996","Mar 1996","Mar 1996","Mar 1996",
         "Apr 1996","Apr 1996","Apr 1996","Apr 1996","Apr 1996","Apr 1996",
         "May 1996","May 1996","May 1996","May 1996","May 1996","May 1996",
         "Jun 1996","Jun 1996","Jun 1996","Jun 1996","Jun 1996","Jun 1996")

lon <- c(114.1592, 114.1294, 114.1144, 114.0228, 113.9763, 113.9431)

lat <- c(22.35694, 22.31306, 22.33000, 22.37167, 22.37639, 22.45111)

STN <- c("A","B","C","D","E","F")

value <- runif(n=36, min=10, max=20)

df<- data.frame(STN,lon,lat)
df<- rbind(df,df,df,df,df,df)
df <- cbind(df,yearmon,value)
df$value[df$value < 12] <- NA


# dataset of participant location
id <- c(1,2,3,4)
lon.p <- c(114.3608, 114.1850, 114.1581, 114.1683)
lat.p <- c(22.44500, 22.33000, 22.28528, 22.37167)
participant <- data.frame(id,lon.p,lat.p)

#

sample datasets are as below. I want to calculate the distance between each station (AF) and each participant (1-4) at each time point (yearmon). And assign the value of a specific time point to the specific participants. I could not assign the participants to a station first, because the location of stations may change at different time points (although it does not change in the sample dataset)

Ie if participant 1 lives closest to Station A in Jan 1996, then he/she should be assign the value 17.03357.

I prefer the great circle distance, maybe calculate using script like this: rdist.earth(location1, location2 ,miles=FALSE, R=6371)

   id   lon.p     lat.p Apr 1996 Feb 1996 Jan 1996 Jun 1996 Mar 1996 May 1996
1   1 114.3608 22.44500 
2   2 114.1850 22.33000 
3   3 114.1581 22.28528 
4   4 114.1683 22.37167 

At the end, I think this is what I would like to return. (But with the value filled in)

  id lon.p lat.p Apr 1996 Feb 1996 Jan 1996 Jun 1996 Mar 1996 May 1996 1 1 114.3608 22.44500 2 2 114.1850 22.33000 3 3 114.1581 22.28528 4 4 114.1683 22.37167 

Thank you.

Answer 1

Here's a way to do it in a couple of steps. Note that I created a naive_dist function just as a placeholder for the distance metric. The function comes from here .

naive_dist <- function(long1, lat1, long2, lat2) {
  R <- 6371 # Earth mean radius [km]
  d <- acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
  return(d) # Distance in km
}

dist_by_id <- by(participant, participant$id, FUN = function(x) 
  #you would use your distance metric here
  naive_dist(long1 = x$lon.p, long2 = df$lon, lat1 = x$lat.p, lat2 = df$lat)
  )

#function to find the min for each yearmon, by id
find_min <- function(id, data, by_data){
  data$dist_column = by_data[[id]]
  by(data, data$yearmon, FUN = function(x) x[which.min(x$dist_column),]$value)
}
#initialize
participant[,4:9] = 0
names(participant)[4:9] = as.character(unique(df$yearmon))
#use a for loop to fill in the values
for(i in 1:4){
 participant[i,4:9] = stack(find_min(id = i, data = df, by_data = dist_by_id))[,1] 
}

participant

  id    lon.p    lat.p Jan 1996 Feb 1996 Mar 1996 Apr 1996 May 1996 Jun 1996
1  1 114.3608 22.44500 17.36620 18.88409 19.53951 19.35646 13.00518 18.45556
2  2 114.1850 22.33000 17.36620 18.88409 19.53951 19.35646 13.00518 18.45556
3  3 114.1581 22.28528 18.57447 13.85192 17.52038       NA 16.14562 18.06435
4  4 114.1683 22.37167 17.36620 18.88409 19.53951 19.35646 13.00518 18.45556

Obviously once you change the distance metric these results may change.

Alternatively, here's an option that uses dplyr , I would tend to prefer this solution since it might be more performant.

library(dplyr)
df2 <- merge(df, participant, all = T) #merge the df's
#calculate distance
df2$distance <- naive_dist(long1 = df2$lon, lat1 = df2$lat,
                           long2 = df2$lon.p, lat2 = df2$lat.p)


df3 <- df2 %>%
  group_by(yearmon, id) %>%
  filter(distance == min(distance)) %>%
  select(id, yearmon, value)

participant2 <- participant
participant2[,4:9] <- 0
names(participant2)[4:9] <- as.character(unique(df$yearmon))

for(i in 1:4){
  participant2[i,4:9] = c(subset(df3, id == i)$value)
}

participant2

  id    lon.p    lat.p Jan 1996 Feb 1996 Mar 1996 Apr 1996 May 1996 Jun 1996
1  1 114.3608 22.44500 19.53951 18.88409 13.00518 17.36620 18.45556 19.35646
2  2 114.1850 22.33000 19.53951 18.88409 13.00518 17.36620 18.45556 19.35646
3  3 114.1581 22.28528 17.52038 13.85192 16.14562 18.57447 18.06435       NA
4  4 114.1683 22.37167 19.53951 18.88409 13.00518 17.36620 18.45556 19.35646