如何提高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
adplyr
实用程序?如果没有,您使用的是哪些软件包?当我测试它(在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