如何在下面的代码中提高R的性能

时间:2017-08-04 10:37:22

标签: r performance for-loop

我试图根据条件将值加总到同一列的先前值。我的代码如下,但它需要永远运行。我该如何优化呢

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行上运行时,它需要永远。需要优化它

1 个答案:

答案 0 :(得分: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