Отметить странные наблюдения (строки) в объекте класса lubridate :: interval

Question

Ссылаясь на мой предыдущий вопрос здесь: Пометить строки с перекрытием интервалов в 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

Вот похожий подход.

Сначала я добавляю заполнение к двум переменным "... minute", чтобы они были однозначными (например, 0349L в данных примера читается как целое число 349. Этот шаг дополняет его до текста "0349")).Затем я использую их в сочетании с датой, чтобы получить время начала и окончания, используя lubridate:ymd_hm.(Я предполагаю, что нет интервалов, которые охватывают полночь; если это так, вы обычно видите отрицательный интервал времени между началом и концом. Вы можете добавить шаг, чтобы поймать это, и увеличить конечное время на следующий день.)

Затем я сортирую по идентификатору и времени начала и группирую по идентификатору.Это ограничивает последующие шаги, поэтому они рассчитывают только 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  

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

EDIT

Фрагмент ниже не будет отмечать случаи, когда идентификаторы меняются от одной строки к следующей

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