在 lubridate::interval 类对象中标记奇怪的观察（行）答案

【问题标题】：Flag strange observations (rows) within lubridate::interval class object在 lubridate::interval 类对象中标记奇怪的观察（行）
【发布时间】：2018-10-27 12:12:32
【问题描述】：

在这里参考我之前的问题： 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))

【问题讨论】：

我认为您不需要所有中间时间变量，也不需要间隔。只需立即创建一个适当的日期时间变量，例如as.POSIXct(paste(date, sprintf("%06d", Start)), format = "%Y-%m-%d %H%M%S")，然后像例如这里计算时差：Calculate time difference (difftime) between columns of different rows。检查时间差异是否 > 1 分钟。结合检查滞后的“位置”（以类似方式创建）是否与当前位置不同。

标签： r intervals tidyverse lubridate

【解决方案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

【讨论】：

【解决方案2】：

我不知道我是否正确，但下面的代码将标记位置+时差小于或小于1分钟的跳转。它将在您的示例数据中标记第 9 行。如果要标记第 8 行和第 9 行，可以创建一个包含下一个位置的新列（使用 dplyr::lead(location)）并使用 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)
        )

编辑

下面的 sn-p 不会标记 ID 从一行更改为下一行的情况

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)
    )

【讨论】：

您的 sn-p 是有效的并且可以处理虚拟数据，但它忽略了 ID 变量并混合了个人观察位置并标记了错误的行。想象第 n 行是位置 1 的个体 A，第 n+1 行是位置 4 的个体 B。数据是正确的，但 sn-p 会标记它。
是的，我忘记了您的数据中有不同的 ID。如果您 group_by ID 并在之后计算 FLAG，它应该可以工作。
我已经更新了代码，希望这次能正常运行。它假定您的数据按 ID 和日期排序。