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