extrapolate position of vehicle by adding new rows to tibbles-CodePudding

I have time t, speed v and position x of a vehicle along with other informations: info1, info2, status

How can I extend the tibble by linearly extrapolating the position based on last speed (v = 14) for given timestamps. So the added rows are copy of the last row except with the predicted positions and status changed to "predicted"`.

Is it possible to do it without using loop.


tbl <- tibble(info1 = rep("a", 3),
              info2 = rep("b", 3),
              t = c(1, 2, 3),
              v = c(12, 13, 14),
              x = c(12, 24, 37), 
              status = rep("real", 3))

timestamps <- c(4, 5, 6, 8) # timestamps does not linearly increase

# desired output
tbl_desired <- tibble(info1 = rep("a", 7),
                      info2 = rep("b", 7),
                      t = c(1, 2, 3, 4, 5, 6, 8),
                      v = c(12, 13, 14, 14, 14, 14, 14),
                      x = c(12, 24, 37, 51, 65, 79, 107), 
                      status = c(rep("real", 3), rep("predicted", 4)))

CodePudding user response：

The conditions are not clear especially the predicted values in 'x'. Below code works in the following way

Extracts the last row (slice_tail, n = 1)
update the columns 't', 'v', 'x' (summarise)
Bind the rows from the original data (bind_rows)

library(dplyr)
tbl %>% 
   slice_tail(n = 1) %>% 
   summarise(info1, info2, t = timestamps, v = v, 
     x =  (x   cumsum(c(1, diff(t)) * 
      rep(last(v), length(t)))), status = 'predicted') %>% 
   bind_rows(tbl, .)

-output

# A tibble: 7 × 6
  info1 info2     t     v     x status   
  <chr> <chr> <dbl> <dbl> <dbl> <chr>    
1 a     b         1    12    12 real     
2 a     b         2    13    24 real     
3 a     b         3    14    37 real     
4 a     b         4    14    51 predicted
5 a     b         5    14    65 predicted
6 a     b         6    14    79 predicted
7 a     b         8    14   107 predicted

If there are many columns, after sliceing the last row, use mutate to update only the columns that needs to be changed and wrap in a list whereever the length is greater than 1, then unnest the list column

library(tidyr)
tbl %>% 
   slice_tail(n = 1) %>%
   mutate(t = list(timestamps), v = v,
    x = list((x   cumsum(c(1, diff(timestamps)) * 
      rep(last(v), length(timestamps))))), status = 'predicted') %>% 
   unnest(where(is.list)) %>% 
   bind_rows(tbl, .)

-output

# A tibble: 7 × 6
  info1 info2     t     v     x status   
  <chr> <chr> <dbl> <dbl> <dbl> <chr>    
1 a     b         1    12    12 real     
2 a     b         2    13    24 real     
3 a     b         3    14    37 real     
4 a     b         4    14    51 predicted
5 a     b         5    14    65 predicted
6 a     b         6    14    79 predicted
7 a     b         8    14   107 predicted

Or use add_row and then fill the NA rows with previous non-NA for those columns not specified in the add_row

library(tibble)
tbl %>% 
   add_row(t = timestamps, v = last(.$v), 
    x = (last(.$x)   cumsum(c(1, diff(timestamps)) * 
       rep(last(.$v), length(timestamps)))), status = 'predicted') %>% 
   fill(everything())

-output

# A tibble: 7 × 6
  info1 info2     t     v     x status   
  <chr> <chr> <dbl> <dbl> <dbl> <chr>    
1 a     b         1    12    12 real     
2 a     b         2    13    24 real     
3 a     b         3    14    37 real     
4 a     b         4    14    51 predicted
5 a     b         5    14    65 predicted
6 a     b         6    14    79 predicted
7 a     b         8    14   107 predicted