R; rolling window: calculate bearing of 3 previos points and compare it to bearing of following 3 values in a dataframe

Question

Overall task that i would like to solve: using the shift function i would like to calculate the mean bearing geosphere::bearing(p1, p2,a=6378137, f=1/298.257223563) of previos 3 points (lag) and compare it to the bearing of following 3 points (lead).

That means

1. calculate bearing betwenn all 3 points (lag)

mean(bearing(point1,point2),bearing(point1,point3),bearing(point2,point3))

and between next 3 points (lead).

mean(bearing(point4,point5),bearing(point4,point6)bearing(point5,point6))

2. calculate mean value for those bearings
3. if mean bearing of first (lag) 3 points is to different (bassiclaiy abs(dif)) to next 3 (lead) points , discard the (lead) 3 points.

What is the best way to do so? It does not have to be a shift function but i thought it may be fitting. I just dont want to write loops. Here is an example path:

path<-structure(list(counter = 1:24, lon = c(11.83000844, 11.82986091, 
11.82975536, 11.82968137, 11.82966589, 11.83364579, 11.83346388, 
11.83479848, 11.83630055, 11.84026754, 11.84215965, 11.84530872, 
11.85369492, 11.85449806, 11.85479096, 11.85888555, 11.85908087, 
11.86262424, 11.86715538, 11.86814045, 11.86844252, 11.87138302, 
11.87579809, 11.87736704), lat = c(48.10980039, 48.10954023, 
48.10927434, 48.10891122, 48.10873965, 48.09824039, 48.09526792, 
48.0940306, 48.09328273, 48.09161348, 48.09097173, 48.08975325, 
48.08619985, 48.08594538, 48.08576984, 48.08370241, 48.08237208, 
48.08128785, 48.08204915, 48.08193609, 48.08186387, 48.08102563, 
48.07902278, 48.07827614)), row.names = c(NA, -24L), class = c("data.table", 
"data.frame"))

Thank you.

Answer 1

I'm not convinced this will help with the other question (R: Detect a "main" Path and remove or filter the GPS trace maybe using a kernel?) but this is a way to find the average for the following two points.

First you expand_grid to get all pairs, then you filter down to the pairs you are interested in. Then you create a new data frame which filters further such that for each counter you have the three bearings, at which point you can take the average.

First: I want to have each lat/lon pair to be matched with every other lat/lon pair. For this i use expand_grid, and want to expand our data with itself. This fails on it's face because you need unique names for each argument of expand_grid. Thus I setNames prior to the call.

Then: We only want a subset of those pairs of points. In particular, we want any case where the counter_2 is less than the counter + 2 (eg. you want counter = 1 and counter_2 %in% c(2,3), counter = 2 and counter_2 %in% c(3,4)...)

You then need to go rowwise through the dataset and calculate the bearing for each row. We call this dataframe data_tmp.

Then we do a map and filtration to get the rows needed for each value of counter.

library(tidyverse)

data_tmp <- path %>% 
  as_tibble() %>% 
  (function(X)expand_grid(X, 
                          X %>% setNames(c("counter_2", "lon_2", "lat_2")))) %>% 
  filter(counter_2 <= counter + 2 & counter_2 > counter) %>%
  rowwise() %>%
  mutate(bearing = geosphere::bearing(c(lon, lat), c(lon_2,lat_2))) %>%
  ungroup()

three_grouped <- tibble(counter = 1:max(path$counter)) %>%
  mutate(dataz = map(.x = counter, ~ data_tmp %>% 
                      slice(which(data_tmp$counter_2 %in% 
                                    data_tmp$counter_2[data_tmp$counter == .x] &
                                    data_tmp$counter <= .x + 1 &
                                    data_tmp$counter >= .x)))) 

three_grouped %>%
  mutate(average_bearing = map_dbl(dataz, ~ mean(.x$bearing)))