编辑:由于我对data.table一点都不熟悉,除了切换到data.table之外,还有人对其他解决方案有什么想法吗?多谢!
我有一个很大的数据集,其中包含不同类型事件的开始日期和结束日期(每行都包含一个具有各自开始日期和结束日期的事件)。现在,我想知道在当前事件之前或之后是否直接存在相同类型的事件。棘手的事情是,事件之间的假日和周末不计算在内/不应该考虑。
示例:类型1的事件在星期三开始,在星期五结束,然后是周末,在星期一,另一个类型1的事件开始,一直持续到星期五。在这种情况下,“ incident_direct_before”对于第二个事件为true(= 1),因为这两个事件仅相隔一个周末(不应考虑),而对于第一个事件则为false(= 0),因为它是同类产品中的第一个。
我已经为此编写了一个函数,但是速度很慢。
我现在的问题是:您是否知道如何提高代码的性能?
我已经阅读了有关内存的预分配的信息,但是由于我没有任何“ for(i:1:n)”的信息,因此我不确定该怎么做。
我还尝试了编译器软件包中的cmpfun(),但是它执行的功能与原始程序大致相同(甚至稍差一些)。
由于我没有CS的背景知识,只是想深入研究代码优化主题,因此我非常乐于提供帮助,并解释了为什么某些方法在我的情况下不起作用。
包装:
library(dplyr)
library(lubridate)
示例数据:
df <- structure(list(start = structure(c(16920, 16961, 16988, 17008, 13563, 13598, 13819, 13880, 13886,
13887, 13892, 13899, 13907, 13910, 13969, 14487, 14488, 14550,
14606, 14676, 14743, 14819, 14841, 14851, 14915, 14984), class = "Date"),
end = structure(c(16927,16965, 16990, 17011, 13595, 13616, 13875, 13885, 13886, 13889,
13896, 13906, 13909, 13966, 13969, 14487, 14496, 14554, 14608,
14680, 14743, 14820, 14841, 14862, 14918, 14985), class = "Date"),
type = c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 4, 4, 4, 5, 6, 7, 8, 8, 9, 9, 9, 9, 9, 9)),
class = "data.frame", row.names = c(NA, -26L))
自定义假日矢量的示例:
holidays <- as.Date(c("2009-12-30", "2009-12-31", "2010-01-01"))
我用来检查是否有相同类型事件的函数(不包括周末和节假日):
incident_function <- function(startdate, enddate, lagstart, lagend) {
if (is.na(lagstart) ||is.na(lagend) ) {
priorincident <- 0
} else {
daycount <- 0
priorincident <- 0
day_start <- as.Date(startdate) - lubridate::duration(1, 'days')
while (day_start %in% holidays || weekdays(day_start) %in% c("Saturday", "Sunday")) {
daycount <- daycount +1
day_start <- (as.Date(day_start) - lubridate::duration(1, 'days'))
}
{ if (as.Date(day_start) %in% seq.Date(lagstart, lagend, by='days')){
priorincident <- 1
} else {
priorincident <- 0
}
}
return(priorincident)
}
}
该函数基本上执行以下操作: 1)如果它是类型中的第一个事件/滞后事件为NA,则将0分配给先验事件(=不存在相同类型的先验事件)。 2)else:以当前行的开始日期为例,看看前一天是假期还是星期六/星期日;如果是,请再回一天再检查一次(...)。如果开始日期减n天既不是假日,也不是周六/周日,也不是滞后事件的结束日期,则将0分配给先前事件,但是,如果开始日期减n天是先前事件的结束日期,则分配1表示先发事件(=之前有相同类型的先发事件)。
(由于dplyr管道中的group_by(type)而涵盖了“相同类型”方面)
然后我使用dplyr对事件类型进行分组,然后应用event_function:
df %>%
group_by(type) %>%
dplyr::mutate(incident_directly_before = mapply(incident_function, startdate=start, enddate=end, lagstart=dplyr::lag(start), lagend=dplyr::lag(end))) -> df
start end type incident_directly_before
<date> <date> <dbl> <dbl>
1 2016-04-29 2016-05-06 1 0
2 2016-06-09 2016-06-13 1 0
3 2016-07-06 2016-07-08 1 0
4 2016-07-26 2016-07-29 1 0
5 2007-02-19 2007-03-23 2 0
6 2007-03-26 2007-04-13 2 1
7 2007-11-02 2007-12-28 2 0
8 2008-01-02 2008-01-07 2 0
9 2008-01-08 2008-01-08 2 1
10 2008-01-09 2008-01-11 2 1
11 2008-01-14 2008-01-18 2 1
12 2008-01-21 2008-01-28 3 0
13 2008-01-29 2008-01-31 4 0
14 2008-02-01 2008-03-28 4 1
15 2008-03-31 2008-03-31 4 1
16 2009-08-31 2009-08-31 5 0
17 2009-09-01 2009-09-09 6 0
18 2009-11-02 2009-11-06 7 0
19 2009-12-28 2009-12-30 8 0
20 2010-03-08 2010-03-12 8 0
21 2010-05-14 2010-05-14 9 0
22 2010-07-29 2010-07-30 9 0
23 2010-08-20 2010-08-20 9 0
24 2010-08-30 2010-09-10 9 0
25 2010-11-02 2010-11-05 9 0
26 2011-01-10 2011-01-11 9 0
非常感谢您不要让我浪费生命,盯着那个甜美的红色小八角形!
答案 0 :(得分:2)
另一种data.table方法,该方法将周六和周日考虑在内...
代码
library(data.table)
setDT(df)
#get the day before and the day after, exclude saturdays and sundays
# use wday(start), sunday = 1, saturday = 7
# detrmine previous and next days..
# you can add holidays the same way...
df[ ,`:=`(id = seq.int(.N), prevDay = start - 1, nextDay = end + 1 )]
df[ wday(start) == 7, prevDay := start - 1 ]
df[ wday(start) == 1, prevDay := start - 2 ]
df[ wday(end) == 7, nextDay := start + 2 ]
df[ wday(end) == 1, nextDay := start + 1 ]
setcolorder(df, "id")
#perform join on self
df[df, overlap_id_after := i.id, on = .(type, nextDay == start)]
df[df, overlap_id_before := i.id, on = .(type, prevDay == start)]
样本数据
df <- structure(list(start = structure(c(16920, 16961, 16988, 17008, 13563, 13598, 13819, 13880, 13886,
13887, 13892, 13899, 13907, 13910, 13969, 14487, 14488, 14550,
14606, 14676, 14743, 14819, 14841, 14851, 14915, 14984), class = "Date"),
end = structure(c(16927,16965, 16990, 17011, 13595, 13616, 13875, 13885, 13886, 13889,
13896, 13906, 13909, 13966, 13969, 14487, 14496, 14554, 14608,
14680, 14743, 14820, 14841, 14862, 14918, 14985), class = "Date"),
type = c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 4, 4, 4, 5, 6, 7, 8, 8, 9, 9, 9, 9, 9, 9)),
class = "data.frame", row.names = c(NA, -26L))
答案 1 :(得分:1)
尽管还有其他方法可以使此速度更快,但我强烈建议在需要加快速度时使用data.table
。
因此,如果我只是将您的数据框更改为data.table,则时间减少了一半以上:
dt <- as.data.table(df)
dt[, incident_directly_before := mapply(incident_function,
startdate = start,
enddate=end,
lagstart=dplyr::lag(start),
lagend=dplyr::lag(end)),
by = type]
使用您的原始代码,本部分花费了我0.2451596秒。使用data.table
花了我0.1155329秒。
这是因为data.table
发生了变异,而不是创建数据的副本。