как рассчитать расстояние и вернуть значение определенной переменной с кратчайшим расстоянием?

Question

У меня есть два разделенных набора данных. Один содержит местоположение участников, другое содержит местоположение измерительной станции и соответствующие значения в разные моменты времени. Ниже я генерирую образцы наборов данных.

# 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) 

#

образец наборы данных, как показано ниже. Я хочу рассчитать расстояние между каждой станцией (A-F) и каждым участником (1-4) в каждый момент времени (yearmon). И присвойте значение определенного времени конкретным участникам. Я не мог назначить участников станции сначала, потому что местоположение станций может меняться в разные моменты времени (хотя оно не изменяется в наборе выборки)

I.e. если участник 1 живет ближе всего к станции А в январе 1996 года, тогда ему/ей следует назначить значение 17.03357.

Я предпочитаю расстояние по дуге большого круга, возможно рассчитать, используя сценарий, как это: rdist.earth (LOCATION1, LOCATION2, миль = FALSE, R = 6371)

head(df,10) 
    STN  lon  lat yearmon value 
1 A 114.1592 22.35694 Jan 1996 17.03357 
2 B 114.1294 22.31306 Jan 1996  NA 
3 C 114.1144 22.33000 Jan 1996 17.98293 
4 D 114.0228 22.37167 Jan 1996 15.98854 
5 E 113.9763 22.37639 Jan 1996 16.78647 
6 F 113.9431 22.45111 Jan 1996 18.89551 
7 A 114.1592 22.35694 Feb 1996  NA 
8 B 114.1294 22.31306 Feb 1996 19.9
9 C 114.1144 22.33000 Feb 1996 17.88482 
10 D 114.0228 22.37167 Feb 1996 13.80029 

participant 
    id lon.p lat.p 
1 1 114.3608 22.44500 
2 2 114.1850 22.33000 
3 3 114.1581 22.28528 
4 4 114.1683 22.37167 

В конце концов, я думаю, что это что я хотел бы вернуться. (Но с заполненной величиной)

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 

Спасибо.

Answer 1

Это способ сделать это за пару шагов. Обратите внимание, что я создал функцию naive_dist как заполнитель для метрики расстояния. Функция исходит от 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 

Очевидно, что после изменения метрика расстояния эти результаты могут измениться.

В качестве альтернативы, это вариант, который использует dplyr, я бы предпочел это решение, так как оно может быть более эффективным.

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