我试图根据条件将值加总到同一列的先前值。我的代码如下,但它需要永远运行。我该如何优化呢
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行上运行时,它需要永远。需要优化它
答案 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