如何为以下代码提高 R 中的性能

Question

我正在尝试根据条件将该值与同一列的先前值相加。我的代码如下，但它需要永远运行。我应该如何优化它

df <- data.frame(a=rnorm(1:150000),
         b=rnorm(1:150000))
df$d<-lag(df$b)
df$c<-0
for(row in 1:dim(df)[1]){df[row,]<-mutate(
  df[1:row,],c=ifelse(df[1:row,2]==df[1:row,3],4,lag(c,1)+1))[row,]}

我已经尝试在具有以下代码的较小数据上执行此操作

df <- data.frame(a=c(1,2,4,3,1),
         b=c(3,3,2,1,4))
df$d<-lag(df$b)
df$c<-0

输入：

> df
  a b d c
1 1 3 NA 0
2 2 3 3 0
3 4 2 3 0
4 3 1 2 0
5 1 4 1 0


for(row in 1:dim(df)[1]){
 df[row,]<-mutate(df[1:row,], c=ifelse(
      df[1:row,2]==df[1:row,3],4,lag(c,1)+1))[row,]
 }

输出如预期：

a b d c
1 3 NA NA
2 3 3 4
4 2 3 5
3 1 2 6
1 4 1 7

但是当我在 150000 行上运行时，它需要很长时间。需要优化一下

Answer 1

你能提供一个例子来说明你的函数是如何工作的吗？因为运行你的代码会返回：

> df
  a b d c
1 1 3 3 4
2 2 3 3 4
3 4 2 2 4
4 3 1 1 4
5 1 4 4 4

您希望c 的列保持不变吗？

如果不是，那么目前我只能猜测你想要这样的东西：

df <- data.frame(a=c(1,2,4,3,1),
                 b=c(3,3,2,1,4),
                 d=c(3,1,2,0,4))
require(data.table)
dt <- as.data.table(df)
dt[, c := ifelse(b == d, T, F)]
dt[, c := cumsum(c)]
dt
   a b d c
1: 1 3 3 1
2: 2 3 1 1
3: 4 2 2 2
4: 3 1 0 2
5: 1 4 4 3

（如果 b ==d 则 c 增加 1） 或者你想要别的东西？

更新：

所以我想我得到了你想要的：

require(dplyr)
df <- data.frame(a=c(1,2,4,3,1),
                 b=c(3,3,2,1,4))
df$d<-lag(df$b)
df$c<-0
df

yourFunction <- function(df) {
  require(dplyr)
  for(row in 1:dim(df)[1]){
    cd <- df[1:row,]
    df[row,] <- mutate(cd,
                       c = ifelse(cd[,2] == cd[,3], 4, lag(c, 1) + 1))[row,]
  }
  return(df)
}
r1 <- yourFunction(df)

快速data.table 函数（也可以只使用基本函数）：

myfunction1 <- function(df) {
  require(data.table)
  dt <- as.data.table(df)
  dt[, cc := ifelse(b != d, F, T)]
  cumsum2 <- function(x) {
    x[is.na(x)] <- 0
    cumsum(x)
  }
  dt[, cc := cumsum2(cc)]
  # dt[, c := ifelse(b != d, 1, 4)]
  dt[, c := ifelse(b != d, 1L, 4L)]
  # dt[, c := cumsum2(c), by = cc]
  dt[, c := as.integer(cumsum2(c)), by = cc]

  dt[, cc := NULL]
  dt[c == 0, c := NA]
  dt[]
}

r2 <- myfunction1(df)

测试 c 列是否相等：

all.equal(r1$c, r2$c)
[1] TRUE

现在我们可以在更大的数据集上测试速度：

## larger test
n <- 1000
set.seed(10)
df <- data.frame(a = rbinom(n, 10, 0.2),
                 b = rbinom(n, 10, 0.2))
df$d<-lag(df$b)
df$c<-0

require(rbenchmark)
benchmark(r1 <- yourFunction(df),
          r2 <- myfunction1(df), replications = 5)
                        test replications elapsed relative user.self sys.self user.child sys.child
1 r1 <- yourFunction(df)            5   19.92      664     15.18     1.84         NA        NA
2  r2 <- myfunction1(df)            5    0.03        1      0.01     0.00         NA        NA
all.equal(r1$c, r2$c)
[1] TRUE