如何编写这段“可用”的代码以提高性能？

Question

我有一个样本集，是从一个更大的数据集中提取出来的（25K条记录）。我注意到我的应用程序在这个部分上变慢了，我想检查一下是否可以提高性能。

背景信息：我的财务年度从7月开始，到6月结束。因此，我的记录有一个财务期间和财务年份，这与一个月和日历年份不同。我想添加额外的列，指示日历年份和月份。

财务期-财务年：01 2018 是 7 2017（2017年7月），财务期-财务年：07 2018 是 1 2018（2018年1月），等等。

可重现的例子：

dt<-data.table(FinancialPeriod =c(3,4,4,5,1,2,8,8,11,12,2,3,10,1,6), FinancialYear=c(2018), Amount=c(12,14,16,18,12))
dt$Month<-dt$FinancialPeriod + 6
dt$Year<-dt$FinancialYear
t1<-proc.time()
for(row in 1:nrow(dt)){
  if (dt[row,"Month"] > 12){
    dt[row,"Month"]<- dt[row,"Month"] -12
  } 
  else {
    dt[row,"Year"]<- dt[row,"Year"] -1
  }
}
proc.time()-t1
dt

以上的代码可以正常运行，但是运行速度较慢。我希望能够得到关于如何改进的建议。

- Philippe

Answer 1

我的建议是使用完整的日期，例如财务期间的开始。因此，我们可以使用一个FinancialDate代替FinancialPeriod-FinancialYear组合，例如OP的示例：

FinancialPeriod-FinancialYear : 01 2018

变成

FinancialDate: 2018-01-01

这种方法有几个好处：

1. 只有一个日期对象来描述该期间，而不是两个对象，更容易处理，例如聚合。如果需要，月份和年份可以轻松从日期对象中提取。
2. 我们可以利用通常的日期算术，例如lubridate包，将FinancialDate转换为CalendarDate。
3. 此外，对于日期对象，绘图效果更好。

以下是代码：

library(lubridate)
dt[, FinDate := make_date(FinancialYear, FinancialPeriod)]
dt[, CalDate := FinDate %m+% months(6)]   # convert to calendar date by adding offset
dt[, c("CalMonth", "CalYear") := list(month(CalDate), year(CalDate))]
dt

    FinancialPeriod FinancialYear Amount Month Year    FinDate    CalDate CalMonth CalYear
 1:               3          2018     12     9 2018 2018-03-01 2018-09-01        9    2018
 2:               4          2018     14    10 2018 2018-04-01 2018-10-01       10    2018
 3:               4          2018     16    10 2018 2018-04-01 2018-10-01       10    2018
 4:               5          2018     18    11 2018 2018-05-01 2018-11-01       11    2018
 5:               1          2018     12     7 2018 2018-01-01 2018-07-01        7    2018
 6:               2          2018     12     8 2018 2018-02-01 2018-08-01        8    2018
 7:               8          2018     14    14 2018 2018-08-01 2019-02-01        2    2019
 8:               8          2018     16    14 2018 2018-08-01 2019-02-01        2    2019
 9:              11          2018     18    17 2018 2018-11-01 2019-05-01        5    2019
10:              12          2018     12    18 2018 2018-12-01 2019-06-01        6    2019
11:               2          2018     12     8 2018 2018-02-01 2018-08-01        8    2018
12:               3          2018     14     9 2018 2018-03-01 2018-09-01        9    2018
13:              10          2018     16    16 2018 2018-10-01 2019-04-01        4    2019
14:               1          2018     18     7 2018 2018-01-01 2018-07-01        7    2018
15:               6          2018     12    12 2018 2018-06-01 2018-12-01       12    2018

- Uwe

---

好的方法，我在另一个项目中也是这样做的，确实是绘图更简单有效的方法。我放弃它的原因之一是，账户上的某些数额实际上是在月底而不是月初测量的，但我相信只需要一个函数就能解决这个问题。 - Philippe

表示一个月份时，可以选择该月的任何一天。但是，将一个月的第一天作为参考点会更容易处理。在打印和绘图时，必须仔细选择格式，例如 "%Y-%m"，以便“隐藏”日期。因此，无论一个月被映射到该月的第一天还是最后一天都没有关系。 - Uwe

一个月的最后一天可以通过计算来确定，例如：library(lubridate); update(x, mday = days_in_month(x))，其中x是一个日期对象。 - Uwe

Answer 2

看起来您正在使用 data.table，所以我使用了 data.table 语法。有几种解决方案，但其中一种选项是使用 ifelse： "似乎您正在使用 data.table，因此我使用了 data.table 语法。有几种解决方案，但其中一种选项是使用 ifelse："

dt[, c("Month", "Year") := list(ifelse(Month > 12, Month-12, Month), ifelse(Month <= 12, Year-1, Year))]

或者，如果你想跳过创建初始变量Month和Year：

最初的回答：

dt[, c("Month", "Year") := list(ifelse(FinancialPeriod + 6 > 12, FinancialPeriod -6, FinancialPeriod + 6), 
                                ifelse(FinancialPeriod + 6 <= 12, FinancialYear-1, FinancialYear))]

基准测试:

最初的数据:

Unit: microseconds
     expr     min       lq      mean   median       uq     max neval
 for_loop 21183.8 21765.90 23600.586 22169.80 22981.15 73243.2   100
   ifelse   298.7   332.05   350.509   356.35   369.10   495.8   100

更大的数据集：

data.table(sapply(dt, rep, 100))
Unit: microseconds
     expr       min      lq       mean     median        uq       max neval
 for_loop 1645857.5 1655792 1690718.78 1696271.35 1704510.1 1746731.2    10
       o1     395.4     398     425.29     425.05     446.6     462.3    10

代码：

microbenchmark::microbenchmark(
  for_loop = {
    for(row in 1:nrow(dt)){
      if (dt[row,"Month"] > 12){
        dt[row,"Month"]<- dt[row,"Month"] -12
      } 
      else {
        dt[row,"Year"]<- dt[row,"Year"] -1
      }
    }
  },
  ifelse = {
    dt[, c("Month", "Year") := list(ifelse(Month > 12, Month-12, Month), ifelse(Month <= 12, Year-1, Year))]
  },
  times = 100
)

- Andrew

---

非常感谢您的回答，如果我可以将两个答案标记为正确，我也会将您的答案添加进去。它同样完美地工作了。感谢您的努力。 - Philippe

Answer 3

另一个选择是：

最初的回答：

i <- DT1[Month > 12L, which=TRUE]
DT1[i, Month := Month - 12L][-i, Year := Year - 1L]

请注意，在rdatatable github网站上正在开发一个名为"fifelse"的功能。

使用实际dim进行计时：

# A tibble: 4 x 14
  expression      min     mean   median      max `itr/sec` mem_alloc  n_gc n_itr total_time result                  memory                 time    gc              
  <chr>      <bch:tm> <bch:tm> <bch:tm> <bch:tm>     <dbl> <bch:byt> <dbl> <int>   <bch:tm> <list>                  <list>                 <list>  <list>          
1 for_loop      1.92s    1.92s    1.92s    1.92s     0.521    4.66GB   110     1      1.92s <NULL>                  <Rprofmem [25,175 x 3~ <bch:t~ <tibble [1 x 3]>
2 mtd0         1.45ms   2.26ms    1.7ms   7.49ms   442.       6.55MB    31   221   500.02ms <data.table [25,000 x ~ <Rprofmem [67 x 3]>    <bch:t~ <tibble [221 x ~
3 mtd1       498.46us 650.79us  566.1us   2.98ms  1537.     699.56KB     6   768   499.81ms <data.table [25,000 x ~ <Rprofmem [24 x 3]>    <bch:t~ <tibble [768 x ~
4 basemtd    950.97us   1.41ms   1.02ms  50.65ms   709.       5.06MB    41   355   500.45ms <dbl [25,000]>          <Rprofmem [52 x 3]>    <bch:t~ <tibble [355 x ~

对于2.5万行数据，Base R已经非常快。

数据：

set.seed(0L)
DT <- data.table(FinancialPeriod=sample(12L, 25e3L, TRUE), 
    FinancialYear=c(2018))
DT[, c("Month","Year") := .(FinancialPeriod + 6L, FinancialYear)]
DT0 <- copy(DT)
DT1 <- copy(DT)
DF <- setDF(copy(DT))

计时代码：

bench::mark(
    for_loop = {
        for(row in 1:nrow(DF)){
            if (DF[row,"Month"] > 12){
                DF[row,"Month"]<- DF[row,"Month"] -12
            } 
            else {
                DF[row,"Year"]<- DF[row,"Year"] -1
            }
        }
    },
    mtd0=DT0[, c("Month", "Year") := list(ifelse(Month > 12, Month-12, Month), 
        ifelse(Month <= 12, Year-1, Year))],
    mtd1={
        i <- DT1[Month > 12L, which=TRUE]
        DT1[i, Month := Month - 12L][-i, Year := Year - 1L]
    },
    basemtd={
        DF0$Month <- ifelse(DF0$Month > 12L, DF0$Month - 12L, DF0$Month)  
        DF0$Year <- ifelse(DF0$Month <= 12L, DF0$Year - 1L, DF0$Year)  
    },
    check=FALSE
)

- chinsoon12

---

非常好的答案，提供了几个解决方案，并清楚地解释了为什么其中一个是最优的。我从这个答案中学到了很多东西，非常感谢！ - Philippe