Question

我需要加快我的R代码。我的瓶颈是需要使用选择功能的功能。它看起来像这样：

P_ni <- function(Pn,Pi,eta1,eta2,p,d=NA)
{
 if(is.na(d)) d <- 1-p
 if(Pn==Pi) output <- p^Pn
 else
 {
  if(Pi==1)seq1 <- seq_len(Pn-1)
  if(Pi>1)seq1 <- seq_len(Pn-1)[-seq_len(Pi-1)]
  output <- sum(choose((Pn-Pi-1),c(seq1-Pi))*choose(Pn,seq1)*
    (eta1/(eta1+eta2))^c(seq1-Pi)*
    (eta2/(eta1+eta2))^c(Pn-seq1)*p^seq1*d^c(Pn-seq1)
  )
 }
 return(output)
}

需要使用不同的Pn和Pi多次调用此函数。这里的问题是，Pn和Pi只能采用单个数字而不能使用向量。这是由choose（） - 函数引起的。

我现在用for-loop做这个并且效果很好，但速度很慢。 for循环看起来像这样：

for(i in 1:nrow(n_k_matrix_p)) 
{
  n_k_matrix_p[i,4] <- P_ni(n_k_matrix_p[i,1],n_k_matrix_p[i,2],eta1,eta2,p)
}

使其可重现：

eta1 <- 10
eta2 <- 5
p <- 0.4
n_k_matrix <- expand.grid(c(1:20),c(1:20))
n_k_matrix <- n_k_matrix[n_k_matrix[,1] >=n_k_matrix[,2],]
n_k_matrix <- n_k_matrix[order(n_k_matrix[,1]),]

n_k_matrix包含Pn和Pi的数字。不幸的是，循环仍然比使用apply更快。有没有人知道如何加快速度？

Answer 1

您可以重新组合或预先计算某些计算。

P_ni2 <- function(n, eta1, eta2, p, d = 1 - p) {

  res <- matrix(0, n, n)
  diag(res) <- p^seq_len(n)

  C1 <- eta1 / eta2 * p / d
  C2 <- eta2 / (eta1 + eta2) * d
  C3 <- eta1 / (eta1 + eta2)
  C2_n <- C2^seq_len(n)
  C3_n <- C3^seq_len(n)
  precomputed <- outer(0:n, 0:n, choose)

  for (j in seq_len(n)) {
    for (i in seq_len(j - 1)) {
      seq1 <- seq(i, j - 1)
      res[i, j] <- sum(
        precomputed[j-i, seq1-i+1] * precomputed[j+1, seq1+1] * C1^seq1
      ) * C2_n[j] / C3_n[i]
    }
  }

  res
}

VERIF：

> system.time({
+   n_k_matrix[[3]] <- sapply(1:nrow(n_k_matrix), function(i) {
+     P_ni(n_k_matrix[i,1], n_k_matrix[i,2], eta1, eta2, p)
+   })
+ })
utilisateur     système      écoulé 
     11.799       0.000      11.797 

> system.time({
+   test <- P_ni2(400, eta1, eta2, p)
+   n_k_matrix[[4]] <- test[as.matrix(n_k_matrix[, 2:1])]
+ })
utilisateur     système      écoulé 
      2.328       0.003       2.341


> all.equal(n_k_matrix[[3]], n_k_matrix[[4]])
[1] TRUE

请注意，我首先将结果存储在平方矩阵的上三角形中。然后，我将其转换为您的数据框格式（顺便称之为矩阵）。

此解决方案对n = 400的速度提高了5倍。我认为你可以通过在Rcpp中重新编码双循环（仅）来改进它。

R：功能选择，高效

1 个答案: