1

我的问题有一个可行的解决方案，但我无法使用它，因为它太慢了（我的计算预测整个模拟需要 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循环的总数）。

我需要第一个循环，因为我正在使用的数据来自单个文件（所以我正在加载文件，计算各种统计数据等，然后加载下一个文件并执行相同的操作）。我对第二个循环的依恋程度要低得多，但不知道如何用更快的东西替换它。

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

4

2 回答 2

8

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

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

然后在内循环

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

whereii是您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

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

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

于 2012-10-18T11:52:57.067 回答
2

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

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
于 2012-10-18T13:19:23.467 回答