r - How to accurately estimate the start of an increasing value of a variable in time?

Question

Goal

I have brake force (kg) data for many drivers, and I want to find when the brake application started in time. Particularly, I need the time frame of brake start. Following are three examples of brake pedal force and the desired location of the brake start of time frames:

Estimating Brake start

I estimated the brake start by assuming that it is a changepoint. So, I used the changepoint package in R. But I get some of them right and others wrong (the vertical red line below represents the estimated changepoint):

You can see the changepoints for participants B and C are (almost) correct, but incorrect for participant A. In my full dataset, there are many incorrect values so manually estimating them is going to be very time consuming.

Do you have any suggestions to accurately estimate the brake start? Thank you for your time.

The data and code for the above figure are provided below.

Data and Code

Data

foo <- structure(list(participant = c("A", "A", "A", "A", "A", "A", 
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", 
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", 
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", 
"A", "A", "A", "A", "A", "A", "A", "A", "B", "B", "B", "B", "B", 
"B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B", 
"B", "B", "B", "B", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
"C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
"C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
"C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", 
"C", "C", "C", "C"), frames = c(39614, 39644, 39674, 39704, 39734, 
39764, 39794, 39824, 39854, 39884, 39914, 39944, 39974, 40004, 
40034, 40064, 40094, 40124, 40154, 40184, 40214, 40244, 40274, 
40304, 40334, 40364, 40394, 40424, 40454, 40484, 40514, 40544, 
40574, 40604, 40634, 40664, 40694, 40724, 40754, 40784, 40814, 
40844, 40874, 40904, 40934, 40964, 40994, 41024, 41054, 41084, 
41114, 41144, 41174, 45296, 45326, 45356, 45386, 45416, 45446, 
45476, 45506, 45536, 45566, 45596, 45626, 45656, 45686, 45716, 
45746, 45776, 45806, 45836, 45866, 45896, 45926, 63792, 63822, 
63852, 63882, 63912, 63942, 63972, 64002, 64032, 64062, 64092, 
64122, 64152, 64182, 64212, 64242, 64272, 64302, 64332, 64362, 
64392, 64422, 64452, 64482, 64512, 64542, 64572, 64602, 64632, 
64662, 64692, 64722, 64752, 64782, 64812, 64842, 64872, 64902, 
64932, 64962, 64992, 65022, 65052, 65082, 65112, 65142, 65172, 
65202, 65232, 65262, 65292, 65322), ED_brake_pedal_force_kg = c(0.34, 
0.34, 0.34, 0.33, 0.33, 0.34, 0.32, 0.34, 0.34, 0.34, 0.34, 0.32, 
0.34, 0.34, 0.37, 0.32, 0.32, 0.33, 0.34, 0.32, 0.33, 0.34, 0.34, 
0.72, 2.01, 2.91, 4.57, 5.73, 5.84, 5.82, 5.21, 5.23, 5.23, 4.41, 
4, 3.57, 3.09, 2.28, 1.37, 0.33, 0.33, 0.65, 1.21, 3.36, 4.91, 
5.2, 5.96, 6.24, 7.6, 14.13, 25.8, 32.37, 37.71, 0.32, 0.34, 
0.33, 0.32, 1.72, 8.93, 18.83, 22.78, 39.5, 66.63, 9.46, 2.24, 
0.33, 0.34, 1.9, 5.5, 8.55, 10.66, 12.24, 12.24, 12.24, 12.27, 
0.29, 0.29, 0.31, 0.31, 0.3, 0.29, 0.3, 0.3, 0.3, 0.29, 0.3, 
0.31, 0.3, 0.29, 0.29, 0.91, 2.79, 3.67, 4.24, 5.61, 5.91, 6.08, 
5.4, 4.46, 3.74, 3.85, 4, 4.43, 2.08, 0.7, 0.3, 0.29, 0.31, 0.32, 
0.34, 0.69, 0.83, 0.83, 0.84, 1.36, 1.68, 2.04, 3.87, 5.21, 7.28, 
9.84, 13.49, 14.83, 14.79, 14.79, 14.79, 14.71)), row.names = c(NA, 
-127L), class = c("tbl_df", "tbl", "data.frame"))  

Code

Estimation of changepoint and plotting:

library(changepoint)
library(tidyverse)
foo %>% 
  group_by(participant) %>% 
  mutate(brake_start_frame = frames[cpts(cpt.meanvar(ED_brake_pedal_force_kg, 
                                                     Q = 8, 
                                                     method = "BinSeg"))][1]) %>% 
  ungroup() %>% 
  
  
  ggplot() +
  geom_line(aes(x = frames, y = ED_brake_pedal_force_kg)) +
  geom_vline(aes(xintercept = brake_start_frame), color="red") +
  facet_wrap(~ participant, scales = "free_x")

question from:https://stackoverflow.com/questions/65650320/how-to-accurately-estimate-the-start-of-an-increasing-value-of-a-variable-in-tim

Answer 1

Since this is a time-series problem, you can explore TTR::momentum function to solve this problem. Whenever momentum will go above a particular threshold in upward direction, it will trigger the event.

library(TTR)
library(data.table)
setDT(foo)
foo[, momentum := TTR::momentum(ED_brake_pedal_force_kg, 5), by = participant]

ggplot(foo) +
  geom_line(aes(x = momentum, y = ED_brake_pedal_force_kg)) +
  facet_wrap(~ participant, scales = "free_x")