Flag strange observations (rows) within lubridate::interval class object - r

Question

Referring to my previous question here:
Flag rows with interval overlap in r
I have got a dataframe with some location information (1 = location A , 4 = location B)
:
df <- data.frame(stringsAsFactors=FALSE,
date = c("2018-09-02", "2018-09-02", "2018-09-02", "2018-09-02",
"2018-09-02", "2018-09-02", "2018-09-02", "2018-09-02",
"2018-09-02"),
ID = c("18101276-aa", "18101276-aa", "18102843-aa", "18102843-aa", "18102843-ab",
"18102843-aa", "18104148-aa", "18104148-ab", "18104148-ab"),
location = c(1L, 1L, 1L, 4L, 4L, 1L, 1L, 1L, 4L),
Start = c(111300L, 143400L, 030000L, 034900L, 064400L, 070500L, 060400L,
075100L, 081600L),
End = c(111459L, 143759L, 033059L, 035359L, 064759L, 070559L, 060459L,
81559L, 83559L),
start_hour_minute = c(1113L, 1434L, 0300L, 0349L, 0644L, 0705L, 0604L, 0751L, 0816L),
end_hour_minute = c(1114L, 1437L, 0330L, 0353L, 0647L, 0705L, 0604L, 0815L, 0835L))
Here, we have some observations (row 8 and 9) that an individual jump between two locations in a minute (it is not possible!). I was wondering, how can I flag these strange location shifts within my interval?
I am using lubridate::interval() as recommended to make an interval class object:
data_out <- df %>%
# Get the hour, minute, and second values as standalone numerics.
mutate(
date = ymd(date),
Start_Hour = floor(Start / 10000),
Start_Minute = floor((Start - Start_Hour*10000) / 100),
Start_Second = (Start - Start_Hour*10000) - Start_Minute*100,
End_Hour = floor(End / 10000),
End_Minute = floor((End - End_Hour*10000) / 100),
End_Second = (End - End_Hour*10000) - End_Minute*100,
# Use the hour, minute, second values to create a start-end timestamp.
Start_TS = ymd_hms(date + hours(Start_Hour) + minutes(Start_Minute) + seconds(Start_Second)),
End_TS = ymd_hms(date + hours(End_Hour) + minutes(End_Minute) + seconds(End_Second)),
# Create an interval object.
Watch_Interval = interval(start = Start_TS, end = End_TS))

Answer 1

Here's a similar approach.
First, I add padding to the two "...minute" variables so that they are unambiguous (e.g. 0349L in the sample data reads in as an integer 349. This step pads it to become text "0349"). Then I use those, in combination with the date, to get start and end times using lubridate:ymd_hm. (I presume there are no intervals that span midnight; if so, you'd typically see a negative interval of time between the start and end. You could add a step to catch this and increment the end_time to be the next day.)
Then I sort by ID and start time, and group by ID. This limits the subsequent steps so they only calculate time_elapsed and suspicious within records for a single individual at a time. In this case a record is flagged as suspicious if the location has changed from the prior record, but less than 10 minutes have passed.
library(lubridate); library(dplyr); library(stringr)
df2 <- df %>%
# Add lead padding zero to variables containing "minute"
mutate_at(vars(contains("minute")), funs(str_pad(., width = 4, pad = "0"))) %>%
# convert to time stamps
mutate(start_time = ymd_hm(paste(date, start_hour_minute)),
end_time = ymd_hm(paste(date, end_hour_minute))) %>%
# Sort and look separated at each individual
arrange(ID, start_time) %>%
group_by(ID) %>%
# Did location change while too little time passed?
mutate(time_elapsed = (start_time - lag(end_time)) / dminutes(1),
suspicious = (location != lag(location) & time_elapsed < 10)) %>%
ungroup()
> df2 %>% select(date, ID, location, start_time:suspicious)
# A tibble: 9 x 7
date ID location start_time end_time time_elapsed suspicious
<chr> <chr> <int> <dttm> <dttm> <dbl> <lgl>
1 2018-09-02 181012… 1 2018-09-02 11:13:00 2018-09-02 11:14:00 NA NA
2 2018-09-02 181012… 1 2018-09-02 14:34:00 2018-09-02 14:37:00 200 FALSE
3 2018-09-02 181028… 1 2018-09-02 03:00:00 2018-09-02 03:30:00 NA NA
4 2018-09-02 181028… 4 2018-09-02 03:49:00 2018-09-02 03:53:00 19 FALSE
5 2018-09-02 181028… 1 2018-09-02 07:05:00 2018-09-02 07:05:00 192 FALSE
6 2018-09-02 181028… 4 2018-09-02 06:44:00 2018-09-02 06:47:00 NA NA
7 2018-09-02 181041… 1 2018-09-02 06:04:00 2018-09-02 06:04:00 NA NA
8 2018-09-02 181041… 1 2018-09-02 07:51:00 2018-09-02 08:15:00 NA NA
9 2018-09-02 181041… 4 2018-09-02 08:16:00 2018-09-02 08:35:00 1 TRUE

Answer 2

I don't know if I got it right, but the code below will flag the jump in location + time difference less than or smaller than 1 minute. It will flag row 9 in your example data. If you want to tag both rows 8 and 9, you can make a new column containing the next location (using dplyr::lead(location)) and playing with the condition inside FLAG.
data_out <- df %>%
# Get the hour, minute, and second values as standalone numerics.
mutate(
date = ymd(date),
Start_Hour = floor(Start / 10000),
Start_Minute = floor((Start - Start_Hour*10000) / 100),
Start_Second = (Start - Start_Hour*10000) - Start_Minute*100,
End_Hour = floor(End / 10000),
End_Minute = floor((End - End_Hour*10000) / 100),
End_Second = (End - End_Hour*10000) - End_Minute*100,
# Use the hour, minute, second values to create a start-end timestamp.
Start_TS = ymd_hms(date + hours(Start_Hour) + minutes(Start_Minute) + seconds(Start_Second)),
End_TS = ymd_hms(date + hours(End_Hour) + minutes(End_Minute) + seconds(End_Second)),
Previous_End = lag(End_TS),
Previous_Loc = lag(location),
Timediff = lubridate::minutes(Start_TS - Previous_End),
FLAG = ifelse(!(location == Previous_Loc)&(Timediff <= minutes(1)), 1, 0)
)
EDIT
The snippet below won't flag cases where IDs change from one row to the next
data_out <- df %>%
# Get the hour, minute, and second values as standalone numerics.
mutate(
date = ymd(date),
Start_Hour = floor(Start / 10000),
Start_Minute = floor((Start - Start_Hour*10000) / 100),
Start_Second = (Start - Start_Hour*10000) - Start_Minute*100,
End_Hour = floor(End / 10000),
End_Minute = floor((End - End_Hour*10000) / 100),
End_Second = (End - End_Hour*10000) - End_Minute*100,
# Use the hour, minute, second values to create a start-end timestamp.
Start_TS = ymd_hms(date + hours(Start_Hour) + minutes(Start_Minute) + seconds(Start_Second)),
End_TS = ymd_hms(date + hours(End_Hour) + minutes(End_Minute) + seconds(End_Second)),
Previous_ID = lag(ID),
Previous_End = lag(End_TS),
Previous_Loc = lag(location),
Timediff = lubridate::minutes(Start_TS - Previous_End),
FLAG = ifelse(
!((location == Previous_Loc)&!(ID == Previous_ID))&(Timediff <= minutes(1)), 1, 0)
)