距離を計算し、最短距離の特定の変数の値を返す方法は？

Question

私は2つの分離したデータセットを持っています。 1つは参加者の位置を含み、もう1つは異なる時点での測定ステーションおよび対応する値の位置を含む。以下は、サンプルデータセットを生成します。

# 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）との間の各時刻（年令）での距離を計算したいと思います。特定の参加者に特定の時点の値を割り当てます。ステーションの位置が異なる時点で変化する可能性があるので、最初に参加者を割り当てることはできませんでした（サンプルデータセットでは変更されません）。

Ie.参加者1が1996年1月にA駅に最も近いところに住んでいれば、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