r - 在自定义 R 函数中预分配内存以提高性能(使用 dplyr)

标签 r performance optimization dplyr pre-allocation

编辑:由于我对 data.table 一点也不熟悉,除了切换到 data.table 之外,还有人有其他解决方案的想法吗?非常感谢!

我有一个相当大的数据集,其中包含不同类型事件的开始日期和结束日期(每一行都包含一个具有各自开始日期和结束日期的事件)。现在我想知道在当前事件之前或之后是否发生过相同类型的事件。棘手的是,事件之间的假期和周末不计算/不应考虑。

示例:1 类事件于周三开始,周五结束,然后是周末,周一另一类 1 事件开始并持续到周五。在这种情况下,对于第二个事件,“incident_directly_before”将为 true (=1),因为这两个事件仅相隔一个周末,不应考虑周末;对于第一个事件,“incident_directly_before”将为 false (=0),因为它这是同类中的第一个。

我为此编写了一个函数,但是速度很慢。

我现在的问题是:你知道如何提高代码的性能吗?

我已经阅读了有关内存预分配的内容,但由于我没有任何“for(i in 1:n)”,我不知道该怎么做。

我还尝试了编译器包中的 cmpfun(),但它的性能或多或少与原始版本相同(甚至稍差)。

由于我没有计算机科学背景,只是为了深入研究代码优化主题,所以我真的很高兴能得到一些帮助,并解释为什么某些方法(不)适用于我的情况。

套餐:

  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:获取当前行的startdate,看看前一天是否是假期或周六/周日;如果是,请再返回一天并再次检查(...)。如果开始日期减去 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

预先非常感谢您没有让我浪费生命盯着那个可爱的小红色八角形!

最佳答案

另一种 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))

关于r - 在自定义 R 函数中预分配内存以提高性能(使用 dplyr),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/55865503/

相关文章:

r - 使用 R 分析非线性数据

R:如何使用 R 使用 Bing 免费套餐网络搜索

performance - Web 应用程序的适当页面处理时间是多少?

css - Webpack CSS 输出总是被缩小

r - 使用原始文件名的一部分在 R 中导出文件

r - R 中 data.tables 的 cut 函数的替代方案 - 因子的整数变量

performance - Oracle PL/SQL 中的延迟更新

performance - 我可以在一个监听器中查看 2 个请求的结果吗?

java - Java 中的流媒体背包

javascript - 从函数调用返回值时,最新的 JavaScript/ECMAScript 编译器是否会优化不必要的变量赋值?