为什么这个循环的时间复杂度是非线性的，为什么它如此慢？该循环需要~38s for N=50k,和~570s for N=200k。有更快的方法吗？ Rprof()似乎表明写入内存非常慢。
df <- data.frame(replicate(5, runif(200000)))
df[,1:3] <- round(df[,1:3])
Rprof(line.profiling = TRUE); timer <- proc.time()
x <- df; N <- nrow(df); i <- 1
ind <- df[1:(N-1),1:3] == df[2:N,1:3];
rind <- which(apply(ind,1,all))
N <- length(rind)
while(i <= N)
{
x$X4[rind[i]+1] <- x$X4[rind[i]+1] + x$X4[rind[i]]
x$X5[rind[i]+1] <- x$X4[rind[i]+1] * x$X3[rind[i]+1]
x$X5[rind[i]+1] <- trunc(x$X5[rind[i]+1]*10^8)/10^8
x$X1[rind[i]] <- NA
i <- i + 1
};x <- na.omit(x)
proc.time() - timer; Rprof(NULL)
summaryRprof(lines = "show")
此算法的目的是迭代数据框并组合在某些元素上匹配的相邻行。也就是说，它会删除其中一行，并将该行的某些值添加到另一行。结果数据帧应该少n行，其中n是原始数据帧中匹配的相邻行的数量。每次组合一对行时，源数据帧和新数据帧的索引不同步1，因为从新帧中删除/省略了一行，因此i跟踪位置在源数据框上，q跟踪新数据框的位置。
由于@joran的评论，上面的代码已更新。效果大幅提升至~5.5s for N=50k和~88s for N=200k。然而，时间复杂性仍然是非线性的，我无法理解。我需要在N = 100万或更多时运行它，所以它的速度仍然不是很快。
答案 0 :(得分：15)
只有X4列更新取决于以前的值，因此循环可以大部分进行矢量化＆＃39; （通过一些优化，避免在每次迭代中添加1到rind）
rind1 <- rind + 1L
for (i in seq_len(N))
x$X4[rind1[i]] <- x$X4[rind1[i]] + x$X4[rind[i]]
x$X5[rind1] <- x$X4[rind1] * x$X3[rind1]
x$X5[rind1] <- trunc(x$X5[rind1] * 10^8) / 10^8
x$X1[rind] <- NA
na.omit(x)
X4是一个数值，通过将其更新为向量而不是data.frame的列，可以提高更新效率
X4 <- x$X4
for (i in seq_len(N))
X4[rind1[i]] <- X4[rind1[i]] + X4[rind[i]]
x$X4 <- X4
为了比较，我们有
f0 <- function(nrow) {
set.seed(123)
df <- data.frame(replicate(5, runif(nrow)))
df[,1:3] <- round(df[,1:3])
x <- df; N <- nrow(df); i <- 1
ind <- df[1:(N-1),1:3] == df[2:N,1:3];
rind <- which(apply(ind,1,all))
N <- length(rind)
while(i <= N)
{
x$X4[rind[i]+1] <- x$X4[rind[i]+1] + x$X4[rind[i]]
x$X5[rind[i]+1] <- x$X4[rind[i]+1] * x$X3[rind[i]+1]
x$X5[rind[i]+1] <- trunc(x$X5[rind[i]+1]*10^8)/10^8
x$X1[rind[i]] <- NA
i <- i + 1
}
na.omit(x)
}
f1a <- function(nrow) {
set.seed(123)
df <- data.frame(replicate(5, runif(nrow)))
df[,1:3] <- round(df[,1:3])
x <- df; N <- nrow(df)
ind <- df[1:(N-1),1:3] == df[2:N,1:3];
rind <- which(apply(ind,1,all))
rind1 <- rind + 1L
for (i in seq_along(rind))
x$X4[rind1[i]] <- x$X4[rind1[i]] + x$X4[rind[i]]
x$X5[rind1] <- x$X4[rind1] * x$X3[rind1]
x$X5[rind1] <- trunc(x$X5[rind1] * 10^8) / 10^8
x$X1[rind] <- NA
na.omit(x)
}
f4a <- function(nrow) {
set.seed(123)
df <- data.frame(replicate(5, runif(nrow)))
df[,1:3] <- round(df[,1:3])
x <- df; N <- nrow(df)
ind <- df[1:(N-1),1:3] == df[2:N,1:3];
rind <- which(apply(ind,1,all))
rind1 <- rind + 1L
X4 <- x$X4
for (i in seq_along(rind))
X4[rind1[i]] <- X4[rind1[i]] + X4[rind[i]]
x$X4 <- X4
x$X1[rind] <- NA
x$X5[rind1] <- X4[rind1] * x$X3[rind1]
x$X5[rind1] <- trunc(x$X5[rind1] * 10^8) / 10^8
na.omit(x)
}
结果相同
> identical(f0(1000), f1a(1000))
[1] TRUE
> identical(f0(1000), f4a(1000))
[1] TRUE
加速很快（使用library(microbenchmark)）
> microbenchmark(f0(10000), f1a(10000), f4a(10000), times=10)
Unit: milliseconds
expr min lq mean median uq max neval
f0(10000) 346.35906 354.37637 361.15188 363.71627 366.74944 373.88275 10
f1a(10000) 124.71766 126.43532 127.99166 127.39257 129.51927 133.01573 10
f4a(10000) 41.70401 42.48141 42.90487 43.00584 43.32059 43.83757 10
在编译R并启用内存分析时可以看到差异的原因 -
> tracemem(x)
[1] "<0x39d93a8>"
> tracemem(x$X4)
[1] "<0x6586e40>"
> x$X4[1] <- 1
tracemem[0x39d93a8 -> 0x39d9410]:
tracemem[0x6586e40 -> 0x670d870]:
tracemem[0x39d9410 -> 0x39d9478]:
tracemem[0x39d9478 -> 0x39d94e0]: $<-.data.frame $<-
tracemem[0x39d94e0 -> 0x39d9548]: $<-.data.frame $<-
>
每行表示一个内存副本，因此更新数据框中的单元格会产生5个外部结构副本或矢量本身。相反，可以在没有任何副本的情况下更新矢量。
> tracemem(X4)
[1] "<0xdd44460>"
> X4[1] = 1
tracemem[0xdd44460 -> 0x9d26c10]:
> X4[1] = 2
>
（第一项任务很昂贵，因为它代表data.frame列的重复;后续更新是X4，只有X4是指正在更新的矢量，而矢量不需要重复）。
data.frame实现似乎非线性扩展
> microbenchmark(f1a(100), f1a(1000), f1a(10000), f1a(100000), times=10)
Unit: milliseconds
expr min lq mean median uq
f1a(100) 2.372266 2.479458 2.551568 2.524818 2.640244
f1a(1000) 10.831288 11.100009 11.210483 11.194863 11.432533
f1a(10000) 130.011104 138.686445 139.556787 141.138329 141.522686
f1a(1e+05) 4092.439956 4117.818817 4145.809235 4143.634663 4172.282888
max neval
2.727221 10
11.581644 10
147.993499 10
4216.129732 10
原因在上面的tracemem输出的第二行显而易见 - 更新行会触发整个列的副本。因此，算法会按行数进行扩展，以更新次列中的行数，大致为二次方。
f4a()似乎线性缩放
> microbenchmark(f4a(100), f4a(1000), f4a(10000), f4a(100000), f4a(1e6), times=10)
Unit: milliseconds
expr min lq mean median uq
f4a(100) 1.741458 1.756095 1.827886 1.773887 1.929943
f4a(1000) 5.286016 5.517491 5.558091 5.569514 5.671840
f4a(10000) 42.906895 43.025385 43.880020 43.928631 44.633684
f4a(1e+05) 467.698285 478.919843 539.696364 552.896109 576.707913
f4a(1e+06) 5385.029968 5521.645185 5614.960871 5573.475270 5794.307470
max neval
2.003700 10
5.764022 10
44.983002 10
644.927832 10
5823.868167 10
人们可以尝试并且聪明地对矢量化循环，但现在是否有必要？
该函数的数据处理部分的调整版本使用负索引（例如，-nrow(df)）从数据框中删除行，rowSums()而不是apply()，以及{{ 1}}以便子集操作不会携带未使用的名称：
unname()与@Khashaa建议的data.table解决方案相比
g0 <- function(df) {
ind <- df[-nrow(df), 1:3] == df[-1, 1:3]
rind <- unname(which(rowSums(ind) == ncol(ind)))
rind1 <- rind + 1L
X4 <- df$X4
for (i in seq_along(rind))
X4[rind1[i]] <- X4[rind1[i]] + X4[rind[i]]
df$X4 <- X4
df$X1[rind] <- NA
df$X5[rind1] <- trunc(df$X4[rind1] * df$X3[rind1] * 10^8) / 10^8
na.omit(df)
}
基础R版本在时间上表现良好
g1 <- function(df) {
x <- setDT(df)[, r:=rleid(X1, X2, X3),]
x <- x[, .(X1=X1[.N], X2=X2[.N], X3=X3[.N], X4=sum(X4), X5=X5[.N]), by=r]
x <- x[, X5:= trunc(X3 * X4 * 10^8)/10^8]
x
}
（f4a中的预调整版本大约需要760毫秒，因此慢两倍以上。）
data.table实现的结果不正确
> n_row <- 200000
> set.seed(123)
> df <- data.frame(replicate(5, runif(n_row)))
> df[,1:3] <- round(df[,1:3])
> system.time(g0res <- g0(df))
user system elapsed
0.247 0.000 0.247
> system.time(g1res <- g1(df))
user system elapsed
0.551 0.000 0.551
并且我还没有足够的data.table向导（几乎没有data.table用户）知道正确的配方是什么。
编译（仅从for循环中受益？）将速度提高了大约20％
> head(g0res)
X1 X2 X3 X4 X5
1 0 1 1 0.4708851 0.8631978
2 1 1 0 0.8977670 0.8311355
3 0 1 0 0.7615472 0.6002179
4 1 1 1 0.6478515 0.5616587
5 1 0 0 0.5329256 0.5805195
6 0 1 1 0.8526255 0.4913130
> head(g1res)
r X1 X2 X3 X4 X5
1: 1 0 1 1 0.4708851 0.4708851
2: 2 1 1 0 0.8977670 0.0000000
3: 3 0 1 0 0.7615472 0.0000000
4: 4 1 1 1 0.6478515 0.6478515
5: 5 1 0 0 0.5329256 0.0000000
6: 6 0 1 1 0.8526255 0.8526255
答案 1 :(得分：3)
以下只是重写@Martin Morgan的答案，利用data.table的快速子集。它比data.frame方法快约3倍。
library(data.table)
library(matrixStats) # for efficient rowAlls function
g01 <- function(df) {
setDT(df)
ind <- df[-nrow(df), 1:3, with=FALSE] == df[-1, 1:3, with=FALSE]
rind <- which(rowAlls(ind)) + 1L
X4 <- df$X4
for (i in seq_along(rind))
X4[rind[i]] <- X4[rind[i]] + X4[rind[i] - 1L]
df$X4 <- X4
df$X5[rind] <- trunc(df$X4[rind] * df$X3[rind] * 10^8) / 10^8
df[-rind + 1L,]
}
g01c <- compiler::cmpfun(g01)
n_row <- 1e6
set.seed(123)
df <- data.frame(replicate(5, runif(n_row)))
df[,1:3] <- round(df[,1:3])
# data.frame
system.time(g0(df))
# user system elapsed
# 1.14 0.00 1.14
system.time(g0c(df))
# user system elapsed
# 0.82 0.03 0.86
# data.table
system.time(g01(df))
# user system elapsed
# 0.40 0.02 0.43
system.time(g01c(df))
# user system elapsed
# 0.12 0.03 0.16