Question

我需要生成模拟数据，其中被删除的百分比不能为0或1.这就是我使用while循环的原因。问题是如果我将计数增加到10,000（而不是5），则程序非常慢。我必须用400种不同的场景重复这个，所以它非常慢。我正在试图弄清楚我可以逐个矢量化我的代码的地方。我怎样才能避免while循环并且仍能保持这种状态？

另一种方法是保持while循环并生成符合我的条件的10,000数据集列表，然后将该函数应用于列表。这里我使用汇总函数作为示例，但我的实函数同时使用X_after和delta（即mle（X_after，delta））。如果我必须使用while循环，这是一个更好的选择吗？

我的另一个问题是内存问题。在进行如此大的模拟时，如何避免耗尽内存？

mu=1 ; sigma=3 ; n=10 ; p=0.10
dset <- function (mu,sigma, n, p) {              
   Mean <- array()
   Median <- array()
   Pct_cens_array <- array()
   count = 0
   while(count < 5) { 

     lod <- quantile(rlnorm(100000, log(mu), log(sigma)), p = p)
     X_before <- rlnorm(n, log(mu), log(sigma))
     X_after <-  ifelse(X_before <= lod, lod,  X_before)
     delta <- ifelse(X_before <= lod, 1,  0) 
     pct_cens <- sum(delta)/length(delta)
     # print(pct_cens)
     if (pct_cens == 0 | pct_cens == 1 ) next
     else {
        count <-  count +1
        if (pct_cens > 0 & pct_cens < 1) {
             sumStats <- summary(X_after)
             Median[count] <- sumStats[3]
             Mean [count]<- sumStats[4]
             Pct_cens_array [count] <- pct_cens 
             print(list(pct_cens=pct_cens,X_after=X_after, delta=delta, Median=Median,Mean=Mean,Pct_cens_array=Pct_cens_array))
          }
       }
    }

          return(data.frame(Pct_cens_array=Pct_cens_array, Mean=Mean, Median=Median)) 
 }

Answer 1

我用C编程学到的第一条规则：分为统治！我的意思是你应该首先创建多个函数并将它们调用到循环中，因为这个循环会做太多不同的事情。我担心你的算法：

if (pct_cens == 0 | pct_cens == 1 ) next
            else {count <-  count +1

你有什么理由而不是为了？ while和for之间存在差异：with while，你总是有第一个循环，而不是for。

最后，关于你的问题：使用更多内存和数组来提高速度。例如：

lod <- quantile(rlnorm(100000, log(mu), log(sigma)), p = p)
            X_before <- rlnorm(n, log(mu), log(sigma))

log（mu）和log（sigma）计算两次：使用变量来存储结果，你会节省时间，但当然会花费更多的内存。

Answer 2

我对你的代码做了一些小调整而没有改变它的整体风格。注意Yoong Kim的建议并尝试将代码分解成更小的部分，以使其更具可读性和可维护性，这将是一件好事。

您的函数现在获得两个“n”参数，表示每行中有多少个样本，以及您想要多少次迭代（列）。
你在循环中增长了数组Median和Mean，这需要在重新分配内存和复制内容时遇到很多麻烦，这会减慢一切。我已预定义X_after并在循环后移动平均值和中位数计算以避免这种情况。（作为奖励，mean和median只会被调用一次而不是n_iteration次。）
并非真正需要拨打ifelse。
调用rlnorm一次，为x和lod生成足够的值比调用它两次要快一点。

这是更新的功能。

dset2 <- function (mu, sigma, n_samples, n_iterations, p) {    
  X_after <- matrix(NA_real_, nrow = n_iterations, ncol = n_samples)
  pct_cens <- numeric(n_iterations)
  count <- 1
  while(count <= n_iterations) {     
    random_values <- rlnorm(2L * n_samples, log(mu), log(sigma))
    lod <- quantile(random_values[1:n_samples], p = p)
    X_before <- random_values[(n_samples + 1L):(2L * n_samples)]
    X_after[count, ] <- pmax(X_before, lod)
    delta <- X_before <= lod
    pct_cens[count] <- mean(delta)
    if (pct_cens > 0 && pct_cens < 1 ) count <- count + 1
  }

  Median <- apply(X_after, 1, median)
  Mean <- rowMeans(X_after)
  data.frame(Pct_cens_array=pct_cens, Mean=Mean, Median=Median) 
}

比较时间，例如

mu=1
sigma=3
n_samples=10L
n_iterations = 1000L
p=0.10
system.time(dset(mu,sigma, n_samples, n_iterations, p))
system.time(dset2(mu,sigma, n_samples, n_iterations, p))

在我的机器上，速度提高了3倍。

如何在循环中重新编码以优化R中大型仿真的性能？

2 个答案: