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

如何提高R中以下代码的性能,r,performance,for-loop,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)+

我试图根据条件将该值与同一列的前一个值相加。我的代码如下所示,但它需要永远运行。我应该如何优化它

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,]}

但当我在150000行上跑步时,这需要永远的时间。需要对其进行优化

您能否提供示例,说明您的功能是如何工作的?因为运行代码会返回:

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
  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
测试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
##更大的测试

n是
mutate
a
dplyr
实用程序?如果没有,您使用的是哪些软件包?当我测试它(在1500个样本上)时,所有这些都会被设置为
df$c
到NA everywhere.a b d c 1 3 NA 2 3 4 2 5 3 1 6 1 4 17@spacedman是的,我知道。这可能是因为我把它作为随机化的标准。但a和b不是标准。我已经更新了预期的输出。它需要自己滞后于c列。你能解释一下你在用小数据示例做什么吗?例如,当n为5时。另外,如果你编辑了你的帖子,而不是写评论,那就更好了。。更新same@tejkiran我有什么不对劲吗?你能解释一下吗?但是如果它是正确的并且对你有帮助,你应该接受它。。
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)
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)
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