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

时间:2018-10-27 12:12:33

标签: r intervals tidyverse lubridate

在这里引用我的上一个问题: 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))

2 个答案:

答案 0 :(得分:3)

这是一种类似的方法。

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

然后我按ID和开始时间排序,并按ID分组。这限制了后续步骤,因此它们一次只计算单个人的记录中的time_elapsedsuspicious。在这种情况下,如果位置已从先前的记录更改,但已过了不到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  

答案 1 :(得分: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)
        )

编辑

下面的代码段不会标记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)
    )