R- Subtract values of all rows in a group from previous row in different group and filter out rows-CodePudding

In R say I had the data frame:

data

frame object  x      y
1     6       150    100
2     6       149    99
3     6       148    98
3     6       140    90
4     6       148.5  97    
4     6       142    93
5     6       147    96    
5     6       138    92
5     6       135    90
6     6       146.5  99
1     7       125    200
2     7       126    197
3     7       127    202
3     7       119    185
4     7       117    183    
4     7       123    199
5     7       115    190    
5     7       124    202
5     7       118    192
6     7       124.5  199

I want to output the object which is the closest in the previous frame based on the (x,y) coordinates and filter out the other objects. I want to find the difference in the x and y between all the objects in a given frame and the single object in the previous frame and keep the closest object while removing the rest. The object that is kept would then serve as reference for the next frame. The frames with only one object would be left as is. The output should be one object per frame:

data

frame object  x      y
1     6       150    100
2     6       149    99
3     6       148    98
4     6       148.5  97    
5     6       147    96    
6     6       146.5  99
1     7       125    200
2     7       126    197
3     7       127    202    
4     7       123    199    
5     7       124    202
6     7       124.5  199

CodePudding user response：

This is a cumulative operation, so it'll take an iterative approach. Here's a simple function to do one operation, assuming it's for only one object.

fun <- function(Z, fr) {
  prevZ <- head(subset(Z, frame == (fr-1)), 1)
  thisZ <- subset(Z, frame == fr)
  if (nrow(prevZ) < 1 || nrow(thisZ) < 2) return(Z)
  ind <- which.min( abs(thisZ$x - prevZ$x)   abs(thisZ$y - prevZ$y) )
  rbind(subset(Z, frame != fr), thisZ[ind,])
}

fun(subset(dat, object == 6), 3)
#    frame object     x   y
# 1      1      6 150.0 100
# 2      2      6 149.0  99
# 5      4      6 148.5  97
# 6      4      6 142.0  93
# 7      5      6 147.0  96
# 8      5      6 138.0  92
# 9      5      6 135.0  90
# 10     6      6 146.5  99
# 3      3      6 148.0  98

(The order is not maintained, it can easily be sorted back into place as needed.)

Now we can Reduce this for each object within the data.

out <- do.call(rbind,
  lapply(split(dat, dat$object),
         function(X) Reduce(fun, seq(min(X$frame) 1, max(X$frame)), init=X)))
out <- out[order(out$object, out$frame),]
out
#      frame object     x   y
# 6.1      1      6 150.0 100
# 6.2      2      6 149.0  99
# 6.3      3      6 148.0  98
# 6.5      4      6 148.5  97
# 6.7      5      6 147.0  96
# 6.10     6      6 146.5  99
# 7.11     1      7 125.0 200
# 7.12     2      7 126.0 197
# 7.13     3      7 127.0 202
# 7.16     4      7 123.0 199
# 7.18     5      7 124.0 202
# 7.20     6      7 124.5 199

CodePudding user response：

We can create a for loop that applies the criteria to a single object, and then use group_by %>% summarize to apply it to every object:

library(dplyr)

keep_closest_frame = function(data) {
  frames = split(data, dd$frame)
  for(i in seq_along(frames)) {
    if(nrow(frames[[i]]) != 1 & i == 1) {
      stop("First frame must have exactly 1 row")
    }
    if(nrow(frames[[i]]) == 1) next
    dists = with(frames[[i]], abs(x - frames[[i - 1]][["x"]])   abs(y - frames[[i - 1]][["y"]]))
    frames[[i]] = frames[[i]][which.min(dists), ]
  }
  bind_rows(frames)
}


data %>%
  group_by(object) %>%
  summarize(keep_closest_frame(across()))
# # A tibble: 12 × 4
# # Groups:   object [2]
#    object frame     x     y
#     <int> <int> <dbl> <int>
#  1      6     1  150    100
#  2      6     2  149     99
#  3      6     3  148     98
#  4      6     4  148.    97
#  5      6     5  147     96
#  6      6     6  146.    99
#  7      7     1  125    200
#  8      7     2  126    197
#  9      7     3  127    202
# 10      7     4  123    199
# 11      7     5  124    202
# 12      7     6  124.   199