Question

假设我有一个包含1000个条目/行的数据框。每行都有一个ID，第二列包含一些数据，第三列也包含一些数据。

因此数据框看起来像：

ID    yesNo   Id_specific_data
1     1       4
2     0       8
3     0       43
4     1       11
5     0       9

...等等。

我现在需要执行以下操作：

n = 4

ID_range <- c(1:n)
ID_spec_data <- floor(runif(n, min=10, max=100))
yesNo_data <- sample(c(0,1), replace=TRUE, size=n)

df <- data.frame("ID" = ID_range, "yesNo" = yesNo_data, "ID_specific_data" = ID_spec_data)

m <- 1
for (i in seq(1, 100, 1)) {
    for (j in seq(0.1, 1, 0.1)) {
        log_like_list <- c()
        for (k in seq(0.1, 1, 0.1)) {
            total_ID_list <- c()
            for (l in seq(1, length(df$ID))) {

                x = (df$ID_specific_data[[l]]*k - j) / (i*j)
                calc = pnorm(x, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE)
                total_ID_list[[l]] = calc
            }

            # log likelihood function
            final_calc = sum(df$yesNo*log(total_ID_list)+(1-df$yesNo)*log(1 - total_ID_list))
            log_like_list[[m]] = final_calc

            m <- m + 1
        }

    }
}

因此，基本上，最终结果（log_like_list）应该是具有1500*200*100值的列表/向量。但是为了做到这一点，需要对数据帧中ID的数量进行相同数量的计算（在我的情况下约为500-1000）。总而言之-很多计算。

就速度而言，我知道for循环可能是最糟糕的事情，但是我什至不知道使用apply可以使它在如此众多的计算中变得超级快吗？我已经读过Rcpp，从原则上讲，它可以最大程度地减少计算时间。但是据我所知，它需要C ++的知识（我确实缺乏），而且我甚至不确定它是否适用于这里的问题？

那么，使用任何R技巧都可以大大减少计算时间，还是我只需要等一下？

Answer 1

这不会是您可以复制和粘贴的100％答案，但是我认为它将帮助您获得成功。主要是您需要考虑为什么花时间做循环，而实际上却在处理本质上恒定的值。

例如

i <- seq(1, 100, 1)
j <- seq(0.1, 1, 0.1)
ioxj <- i %o% j
df_ij <- data.frame("i" = i, "j" = j, "ioxj" = ioxj)
df_ij$ixj <- df_ij$i * df_ij$j

将为您提供i和j及其乘积的每种组合，并且没有理由使用循环来获得该基本数学结果。您可能会在某个时候使用循环遍历各列，这可能很有意义，因为i和j的值可能会发生变化。您也可以类似地使用k。

也永远没有理由做这样的事情 x = (df$ID_specific_data[[l]]*k - j) / (i*j) 在遍历数据帧中每一行的循环中，它失去了向量化的全部思想，您想以此代替最终。 x = (df$ID_specific_data*k - j) / (i*j)

您需要使用代码来完全按照所需的方式获取代码，但是值得花些时间这样做。偶尔循环可能是正确的，但我认为您最终可能会做得简单得多。

Answer 2

我认为您当前的编辑仍然有误，您可能不应该在任何循环中重新定义log_like_list。这是一种替代方案，它首先使用expand.grid分配所有参数组合，这在RAM方面有点浪费，但我认为这是可以管理的：

n <- 4L
df <- data.frame(
  ID = 1L:n,
  yesNo = sample(c(0,1), replace=TRUE, size=n),
  ID_specific_data = floor(runif(n, min=10, max=100))
)

params <- expand.grid(
  i = seq(1, 100, 1),
  j = seq(0.1, 1, 0.1),
  k = seq(0.1, 1, 0.1)
)

log_like <- sapply(1L:nrow(params), function(row_id) {
  i <- params$i[row_id]
  j <- params$j[row_id]
  k <- params$k[row_id]

  calc <- sapply(df$ID_specific_data, function(idsd) {
    x <- (idsd * k - j) / (i * j)
    pnorm(x, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE)
  })

  sum(df$yesNo * log(calc) + (1 - df$yesNo) * log(1 - calc))
})

但是，对于您的最终用例，这可能仍然太慢... 您可以尝试使用并行化，如果您有许多核心，则可能会有可接受的时间：

library(doParallel)
library(itertools)

# do NOT run these lines several times without calling stopCluster() on the created workers
workers <- makeCluster(detectCores())
registerDoParallel(workers)

n <- 1000L
df <- data.frame(
  ID = 1L:n,
  yesNo = sample(c(0,1), replace=TRUE, size=n),
  ID_specific_data = floor(runif(n, min=10, max=100))
)

params <- expand.grid(
  i = seq(1, 150, 0.1),
  j = seq(0.1, 2, 0.01),
  k = seq(0.1, 1, 0.01)
)

params_chunk <- isplitRows(params, chunks = getDoParWorkers())
log_like_par <- foreach(param = params_chunk, .combine = c, .multicombine = TRUE) %dopar% {
  # return from foreach body here
  sapply(1L:nrow(param), function(row_id) {
    i <- param$i[row_id]
    j <- param$j[row_id]
    k <- param$k[row_id]

    calc <- sapply(df$ID_specific_data, function(idsd) {
      x <- (idsd * k - j) / (i * j)
      pnorm(x, mean = 0, sd = 1, lower.tail = TRUE, log.p = FALSE)
    })

    # return from sapply body here
    sum(df$yesNo * log(calc) + (1 - df$yesNo) * log(1 - calc))
  })
}

stopCluster(workers); registerDoSEQ()

我尝试在系统（4个内核）中运行它，但几分钟后将其停止。如果您等待它，请告诉我用了多长时间。

在R（Rcpp）中嵌套4的for循环中提高速度吗？

2 个答案: