我有ID，关闭时间和开放时间的数据。我需要将跨越一个小时的每一行分成多行，每行包含一个ID，这样每行的开放和关闭时间都不会超过一小时。理想情况下，这会留下仅在同一小时内打开和关闭时间的行。它还会在每一行中保留ID。
例如，如果我的开放时间是从上午11:55到下午1:10 - 我希望从这个相应的列中得到三行。一个是11:55 - 12,12：1和1 - 1:10。
我相信我已经提出了一个解决方案，但它很复杂：
dat <- tibble(ID = c(2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L),
open_time = structure(c( 1509378717, 1509475803, 1509460317, 1509372561, 1508445791, 1508962523, 1509483224, 1509483978, 1509483727),
tzone = "America/New_York",
class = c("POSIXct", "POSIXt")),
close_time = structure(c( 1509383226, 1509476435, 1509462052, 1509376589, 1508445791, 1508962523, 1509483543, 1509483983, 1509483727),
tzone = "America/New_York",
class = c("POSIXct", "POSIXt")))
split_by_hour <- function(open_time, close_time){
# get hours to span
hour_start <- lubridate::ceiling_date(open_time, 'hour')
hour_end <- lubridate::floor_date(close_time, 'hour')
# hour sequence to create rows
hour_seq <- seq(hour_start, hour_end, by = 'hour')
# create tibble
time_tbl <- tibble(
open_time = lubridate::ymd_hms(c(open_time, hour_seq), tz = "America/New_York"),
close_time = lubridate::ymd_hms(c(hour_seq, close_time), tz = "America/New_York")
)
time_tbl
}
row_hour_breakout <- function(rw){
if(lubridate::floor_date(rw$open_time, 'hour') != lubridate::floor_date(rw$close_time, 'hour')){
# if hours are different, use helper function and bind columns
time_splits <- split_by_hour(rw$open_time, rw$close_time)
dplyr::bind_cols(ID = rep(rw$ID, nrow(time_splits)),
time_splits)
} else{
# else return normal row
rw[, c("ID", "open_time", "close_time")]
}
}
break_tbl_hourly <- function(hour_dat){
purrr::by_row(hour_dat, row_hour_breakout, .labels = FALSE)[[1]] %>%
dplyr::bind_rows()
}
>dat
# A tibble: 9 x 3
ID open_time close_time
<int> <dttm> <dttm>
1 2 2017-10-30 11:51:57 2017-10-30 13:07:06
2 1 2017-10-31 14:50:03 2017-10-31 15:00:35
3 2 2017-10-31 10:31:57 2017-10-31 11:00:52
4 1 2017-10-30 10:09:21 2017-10-30 11:16:29
5 2 2017-10-19 16:43:11 2017-10-19 16:43:11
6 1 2017-10-25 16:15:23 2017-10-25 16:15:23
7 2 2017-10-31 16:53:44 2017-10-31 16:59:03
8 1 2017-10-31 17:06:18 2017-10-31 17:06:23
9 2 2017-10-31 17:02:07 2017-10-31 17:02:07
> break_tbl_hourly(dat)
# A tibble: 14 x 3
ID open_time close_time
<int> <dttm> <dttm>
1 2 2017-10-30 11:51:57 2017-10-30 12:00:00
2 2 2017-10-30 12:00:00 2017-10-30 13:00:00
3 2 2017-10-30 13:00:00 2017-10-30 13:07:06
4 1 2017-10-31 14:50:03 2017-10-31 15:00:00
5 1 2017-10-31 15:00:00 2017-10-31 15:00:35
6 2 2017-10-31 10:31:57 2017-10-31 11:00:00
7 2 2017-10-31 11:00:00 2017-10-31 11:00:52
8 1 2017-10-30 10:09:21 2017-10-30 11:00:00
9 1 2017-10-30 11:00:00 2017-10-30 11:16:29
10 2 2017-10-19 20:43:11 2017-10-19 20:43:11
11 1 2017-10-25 20:15:23 2017-10-25 20:15:23
12 2 2017-10-31 20:53:44 2017-10-31 20:59:03
13 1 2017-10-31 21:06:18 2017-10-31 21:06:23
14 2 2017-10-31 21:02:07 2017-10-31 21:02:07
最后，我想知道：
谢谢！
=====================================
跟进，基于上面的解决方案，我写了一个函数来做到这一点：
# break rows function
# df: data frame of interest
# begin_time_var: variable of beginning times
# end_time_var: variable of ending times
break_rows_hourly <- function(df, begin_time_var, end_time_var){
begin <- enquo(begin_time_var)
end <- enquo(end_time_var)
#######################################
#
# to be applied to each open/close time
#
#######################################
split_by_hour <- function(open_time, close_time){
# ensure open time is at least before close time
if(open_time <= close_time){
# get hours to span
hour_start <- lubridate::ceiling_date(open_time, 'hour')
hour_end <- lubridate::floor_date(close_time, 'hour')
# check if hourly difference
if(hour_start <= hour_end){
#
# if it is, then go on to create multiple rows
#
# hour sequence to create rows
hour_seq <- seq(hour_start, hour_end, by = 'hour')
# create tibble
time_tbl <- tibble(
open_time = lubridate::ymd_hms(c(open_time, hour_seq)),
close_time = lubridate::ymd_hms(c(hour_seq, close_time))
)
return(time_tbl)
} else {
#
# hour start > hour end, return 1 row
#
# create tibble
time_tbl <- tibble(
open_time = open_time,
close_time = close_time
)
return(time_tbl)
}
} else {
#
# open time greater than close time, error printed statement
#
print("Close Time Before Open Time")
}
}
#######################################
#
# applies split by row and creates a df
#
#######################################
row_hour_breakout <- function(rw){
# split row
time_splits <- split_by_hour(rw %>% select(!!begin) %>% pull(), rw %>% select(!!end) %>% pull())
# get orther columns
other_cols <- rw %>%
select(-!!begin, - !!end) %>%
map(function(x) rep(x, nrow(time_splits))) %>%
as.tibble()
dplyr::bind_cols(other_cols,
time_splits)
}
#######################################
#
# map to each row, rbind to return
#
#######################################
return_df <- purrr::by_row(df, row_hour_breakout, .labels = FALSE)[[1]] %>%
dplyr::bind_rows()
return(return_df)
}
> break_rows_hourly(dat, open_time, close_time)
# A tibble: 14 x 3
ID open_time close_time
<int> <dttm> <dttm>
1 2 2017-10-30 11:51:57 2017-10-30 12:00:00
2 2 2017-10-30 12:00:00 2017-10-30 13:00:00
3 2 2017-10-30 13:00:00 2017-10-30 13:07:06
4 1 2017-10-31 14:50:03 2017-10-31 15:00:00
5 1 2017-10-31 15:00:00 2017-10-31 15:00:35
6 2 2017-10-31 10:31:57 2017-10-31 11:00:00
7 2 2017-10-31 11:00:00 2017-10-31 11:00:52
8 1 2017-10-30 10:09:21 2017-10-30 11:00:00
9 1 2017-10-30 11:00:00 2017-10-30 11:16:29
10 2 2017-10-19 20:43:11 2017-10-19 20:43:11
11 1 2017-10-25 20:15:23 2017-10-25 20:15:23
12 2 2017-10-31 20:53:44 2017-10-31 20:59:03
13 1 2017-10-31 21:06:18 2017-10-31 21:06:23
14 2 2017-10-31 21:02:07 2017-10-31 21:02:07
答案 0 :(得分：1)
您可以使用split-apply-combine策略。在这种情况下，我们必须在dat中逐行处理每一行。所以整个事情看起来像
do.call(rbind, lapply(split(dat, seq(nrow(dat))), expand.row))
其中expand.row是一个包含数据框的函数
恰好一行并输出一个包含一行或多行的数据帧。
split(...)部分创建一行数据帧列表。 lapply(..., expand.row)将expand.row应用于列表中的每个元素，并将结果收集到不同的列表中。 do.call(rbind, ...)将第二个列表中的元素堆叠在一起，以获得结果数据框。
现在我们要做的就是写expand.row。
expand.row <- function(x) {
with(x, {
h <- trunc(open_time, 'hour') + 3600 # nearest full hour > open_time
if (h > close_time)
p <- c(open_time, close_time)
else
p <- unique(c(open_time, seq(h, close_time, 3600), close_time))
n <- length(p)
data.frame(ID = ID, open_time = p[seq(1, n - 1)],
close_time = p[seq(2, n)])
})
}
结果：
do.call(rbind, lapply(split(dat, seq(nrow(dat))), expand.row))
# ID open_time close_time
#1.1 2 2017-10-30 16:51:57 2017-10-30 17:00:00
#1.2 2 2017-10-30 17:00:00 2017-10-30 18:00:00
#1.3 2 2017-10-30 18:00:00 2017-10-30 18:07:06
#2.1 1 2017-10-31 19:50:03 2017-10-31 20:00:00
#2.2 1 2017-10-31 20:00:00 2017-10-31 20:00:35
#3.1 2 2017-10-31 15:31:57 2017-10-31 16:00:00
#3.2 2 2017-10-31 16:00:00 2017-10-31 16:00:52
#4.1 1 2017-10-30 15:09:21 2017-10-30 16:00:00
#4.2 1 2017-10-30 16:00:00 2017-10-30 16:16:29
#5 2 2017-10-19 22:43:11 2017-10-19 22:43:11
#6 1 2017-10-25 22:15:23 2017-10-25 22:15:23
#7 2 2017-10-31 21:53:44 2017-10-31 21:59:03
#8 1 2017-10-31 22:06:18 2017-10-31 22:06:23
#9 2 2017-10-31 22:02:07 2017-10-31 22:02:07