r - 标记 lubridate::interval 类对象中的奇怪观察结果(行)

Question

引用我之前的问题: Flag rows with interval overlap in r

我有一个包含一些位置信息的数据框(1 = 位置 A，4 = 位置 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))

在这里，我们有一些观察结果(第 8 行和第 9 行)，一个人在一分钟内在两个位置之间跳跃(这是不可能的!)。我想知道，如何在我的时间间隔内标记这些奇怪的位置变化？ 我正在使用lubridate::interval()建议创建一个区间类对象:

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

这里有一个类似的方法。

首先，我向两个“...分钟”变量添加填充，以便它们明确(例如，示例数据中的 0349L 作为整数 349 读入。此步骤将其填充为文本“0349”)。然后，我将它们与日期结合起来，使用 lubridate:ymd_hm 来获取开始和结束时间。 (我假设没有跨越午夜的间隔；如果是这样，您通常会在开始和结束之间看到负的时间间隔。您可以添加一个步骤来捕获此问题并将 end_time 增加到第二天。)

然后我按 ID 和开始时间排序，并按 ID 分组。这限制了后续步骤，因此它们一次仅计算单个人的记录中的 time_elapsed 和 suspicious。在这种情况下，如果位置与之前的记录相比发生了变化，但时间还不到 10 分钟，则该记录将被标记为可疑。

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