循环分组 RLE 计算的更快解决方案

Question

我有一个working solution 来解决我的问题，但我无法使用它，因为它太慢了（我的计算预测整个模拟需要 2-3 年！）。因此，我正在寻找更好（更快）的解决方案。这是（本质上）我正在使用的代码：

N=4
x <-NULL
for (i in 1:N) { #first loop
  v <-sample(0:1, 1000000, 1/2) #generate data
  v <-as.data.frame(v) #convert to dataframe
  v$t <-rep(1:2, each=250) #group
  v$p <-rep(1:2000, each=500) #p.number
  # second loop
  for (j in 1:2000) { #second loop
    #count rle for group 1 for each pnumber
    x <- rbind(x, table(rle(v$v[v$t==1&v$p==j])))
    #count rle for group 2 for each pnumber
    x <- rbind(x, table(rle(v$v[v$t==2&v$p==j])))
  } #end second loop
} #end first loop
#total rle counts for both group 1 & 2
y <-aggregate(x, list(as.numeric(rownames(x))), sum)

简而言之：代码生成抛硬币模拟 (v)。生成一个组因子（1 和 2）。生成一个 p.number 因子 (1:2000)。记录第 1 组和第 2 组的每个 p.number (1:2000) 的运行长度（每个 p.number 在两个组中都有运行）。在N 循环（第一个循环）之后，总运行长度显示为一个表（聚合）（即，每个组的运行长度，对于每个 p.number，超过N 循环的总和）。

我需要第一个循环，因为我正在处理的数据来自单独的文件（所以我正在加载文件，计算各种统计数据等，然后加载下一个文件并执行相同的操作）。我不太喜欢第二个循环，但不知道如何用更快的东西替换它。

可以对第二个循环做些什么来使它（希望，很多）更快？

Answer 1

您犯了在 R 中的 for() 循环中增长对象的主要罪行。不要（我重复不要）这样做。开始时为x分配足够的存储空间，然后随手填写x。

x <- matrix(nrow = N * (2000 * 2), ncol = ??)

然后在内部循环中

x[ii, ] <- table(rle(....))

其中ii 是一个循环计数器，您在第一个循环之前初始化为1，并在第二个循环内递增：

x <- matrix(nrow = N * (2000 * 2), ncol = ??)
ii <- 1
for(i in 1:N) {
    .... # stuff here
    for(j in 1:2000) {
        .... # stuff here
        x[ii, ] <- table(rle(....))
        ## increment ii
        ii <- ii + 1
        x[ii, ] <- table(rle(....))
        ## increment ii
        ii <- ii + 1
    } ##  end inner loop
} ## end outer loop

另请注意，您在 bot for()loops which will not work.iis just a normal R object and so bothfor()loops will be overwriting it as the progress. USej` 中重复使用索引 i 用于第二个循环，就像我在上面所做的那样。

先尝试这个简单的优化，看看是否能让真实模拟在可接受的时间内完成。如果没有，请返回一个显示最新代码的新 Q，我们可以考虑其他优化。上面的优化很简单，优化table() 和rle() 可能需要更多的工作。请注意，您可能会查看在 table() 中执行繁重工作的 tabulate() 函数，这可能是优化该特定步骤的一种途径。

Answer 2

如果您只想对v$t 和v$p 的值的每个组合分别运行rle 和table，则不需要第二个循环。这种方式要快得多：

values <- v$v + v$t * 10 + v$p * 100
runlength <- rle(values)
runlength$values <- runlength$values %% 2
x <- table(runlength)


y <- aggregate(unclass(x), list(as.numeric(rownames(x))), sum)

---

整个代码将如下所示。如果N 低至 4，则增长对象x 将不会是一个严重的问题。但总的来说，我同意@GavinSimpson 的观点，认为这不是一种好的编程技术。

N=4
x <-NULL
for (i in 1:N) { #first loop
  v <-sample(0:1, 1000000, 1/2) #generate data
  v <-as.data.frame(v) #convert to dataframe
  v$t <-rep(1:2, each=250) #group
  v$p <-rep(1:2000, each=500) #p.number

  values <- v$v + N * 10 + v$t * 100 + v$p * 1000
  runlength <- rle(values)
  runlength$values <- runlength$values %% 2
  x <- rbind(x, table(runlength))

} #end first loop
y <-aggregate(x, list(as.numeric(rownames(x))), sum) #tota