Wie berechnet man den Abstand und gibt den Wert einer bestimmten Variablen mit der kürzesten Entfernung zurück?

Question

Ich habe zwei getrennte Datensätze. Einer enthält den Ort der Teilnehmer, ein anderer enthält den Standort der Messstation und entsprechende Werte zu verschiedenen Zeitpunkten. Im Folgenden erstelle ich Beispieldatensätze.

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

#

Probe Datensätze sind als unten. Ich möchte die Entfernung zwischen jeder Station (A-F) und jedem Teilnehmer (1-4) zu jedem Zeitpunkt (Jahrmonat) berechnen. Und weisen Sie den spezifischen Teilnehmern den Wert eines bestimmten Zeitpunkts zu. Ich konnte die Teilnehmer nicht zuerst einer Station zuweisen, da sich die Position der Stationen zu verschiedenen Zeitpunkten ändern kann (obwohl sich dies im Beispieldatensatz nicht ändert)

I.e. Wenn Teilnehmer 1 im Januar 1996 am nächsten zu Station A lebt, sollte er/sie den Wert 17.03357 zuweisen.

ziehe ich die Großkreisentfernung, berechnet vielleicht Skript wie folgt verwendet: rdist.earth (location1, location2, Meilen = FALSCH, 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 

Am Ende, ich denke, das ist was ich gerne zurückgeben würde. (Aber mit dem Wert ausgefüllt)

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 

Vielen Dank.

Answer 1

Hier ist ein Weg, um es in ein paar Schritten zu tun. Beachten Sie, dass ich eine naive_dist-Funktion nur als Platzhalter für die Abstandsmetrik erstellt habe. Die Funktion kommt von 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 

Offensichtlich können sich die Ergebnisse ändern, sobald Sie die Abstandsmetrik geändert haben.

Alternativ, hier ist eine Option, die dplyr verwendet, würde ich eher diese Lösung bevorzugen, da es leistungsfähiger sein könnte.

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