Ссылаясь на мой предыдущий вопрос здесь: Строки флагов с перекрытием интервалов в 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))
Я не знаю, правильно ли я понял, но в приведенном ниже коде будет отмечен скачок местоположения + разница во времени меньше или меньше 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)
)
РЕДАКТИРОВАТЬ
В приведенном ниже фрагменте не будут отмечены случаи, когда идентификаторы меняются от одной строки к другой.
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)
)
ваш фрагмент действителен и работает с фиктивными данными, но он игнорирует переменную ID и смешивает места наблюдения за людьми, а также отмечает неправильные строки. Представьте, что строка n - это отдельный элемент A с местоположением 1, а строка n + 1 - это отдельный элемент B с местоположением 4. Данные верны, но фрагмент помечает это.
Да, я забыл, что в ваших данных были разные идентификаторы. Если вы ID group_by
и вычислите ФЛАГ после этого, он должен работать.
Я обновил код, надеюсь, на этот раз он работает нормально. Предполагается, что ваши данные упорядочены по идентификатору и дате.
Вот похожий подход.
Во-первых, я добавляю заполнение к двум переменным «... минута», чтобы они были однозначными (например, 0349L в образце данных считывается как целое число 349. На этом шаге его дополняет текст «0349»). Затем я использую их в сочетании с датой, чтобы получить время начала и окончания с помощью lubridate:ymd_hm
. (Я полагаю, что нет интервалов, охватывающих полночь; в таком случае вы обычно видите отрицательный интервал времени между началом и концом. Вы можете добавить шаг, чтобы уловить это, и увеличить end_time до следующего дня.)
Затем я сортирую по идентификатору и времени начала и группирую по идентификатору. Это ограничивает последующие шаги, поэтому они вычисляют только 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
Я не думаю, что вам нужны ни все промежуточные временные переменные, ни интервал. Просто сразу же создайте правильную переменную даты и времени, например
as.POSIXct(paste(date, sprintf("%06d", Start)), format = "%Y-%m-%d %H%M%S")
, затем действуйте как, например, здесь для расчета разницы во времени: Вычислить разницу во времени (difftime) между столбцами разных строк. Убедитесь, что разница во времени> 1 мин. Совместите с проверкой, если запаздывающее «местоположение» (созданное аналогичным образом) отличается от текущего местоположения.