如何使R中的双for循环更快

我尝试使用R进行以下计算。我的函数是递归的，它使用双for循环来计算“结果”矩阵的值。是否有一种方法可以更快地替换for循环或实现if条件

x<-rnorm(2400,0, 3)
y<-rnorm(400,0,3)
no_row<-length(x)
no_col<-length(y)
input<-matrix(data=1,nrow = no_row, ncol = no_col)
result<-matrix(nrow = no_row, ncol = no_col)
calculation<-function(x,y)
{  
for(i in 1:no_row)
 {
  for(j in 1:no_col)
  {
    z<-exp(x[i]-y[j])
    result[i,j]<-(z/1+z)
   }
 } 
 new_x<-x-1
 new_y<-y-1
 residual<-input-result    
 sq_sum_residulas<-sum((rowSums(residual, na.rm = T))^2)
 if(sq_sum_residulas>=1){calculation(new_x,new_y)} 
 else(return(residual))
}
output<-calculation(x,y)

---

xouter

功能是您正在寻找的工具

比较这两个只生成

结果

矩阵的函数

x<-rnorm(100,0, 3)
y<-rnorm(100,0,3)

calculation<-function(x,y)
{  
  result <- matrix(nrow = length(x), ncol = length(y))
  for(i in seq_along(x))
  {
    for(j in seq_along(y))
    {
      z<-exp(x[i]-y[j])
      result[i,j]<-(z/1+z)
    }
  } 
  result
}


calculation2 <- function(x, y){
  result <- outer(x, y, function(x, y) { z <- exp(x - y); z / 1 + z})
  result
}

library(microbenchmark)
microbenchmark(
  calculation(x, y),
  calculation2(x, y)
)

Unit: microseconds
               expr     min       lq      mean   median        uq      max neval
  calculation(x, y) 1862.40 1868.119 1941.5523 1871.490 1876.1825 8375.666   100
 calculation2(x, y)  466.26  469.192  515.3696  471.392  480.9225 4481.371   100

---

x要完成本杰明的回答，不应该使用递归函数。您应该使用带有max_iter参数的while循环

重用Benjamin函数：

calculation2 <- function(x, y){
  result <- outer(x, y, function(x, y) { z <- exp(x - y); z / 1 + z})
  result
}

calculation <- function(x, y, max_iter = 10){
  input <- matrix(data=1,nrow = length(x), ncol = length(y))
  sq_sum_residulas <- 1 # Initialize it to enter while loop
  new_x <- x            # Computation x: it will be updated at each loop
  new_y <- y            # Computation y
  n_iter <- 1           # Counter of iteration
  while(sq_sum_residulas >= 1 & n_iter < max_iter){
    result <- calculation2(new_x, new_y)
    new_x <- x - 1
    new_y <- y - 1
    residual <- input - result    
    sq_sum_residulas <- sum((rowSums(residual, na.rm = T))^2)

    n_iter <- n_iter + 1
  }
  if (n_iter == max_iter){
    stop("Didn't converge")
  }
  return(residual)
}

calculation2@Benjamin@Emmanuel Lin感谢您提供的解决方案：）我能够用您的输入解决这个问题。请在下面找到示例数据集和代码。当平方和残差小于0.01时，解收敛。这比我使用双for循环的代码快12倍多。对于问题中提供的示例数据和新的计算造成的混乱，我深表歉意

Input is a dichotomous 9x10 matrix

    X1 X2 X3 X4 X5 X6 X7 X8 X9 X10
1 NA  1  1  1  1  1  1  1  0   1
2  1  1  1  1  1  1  1  0  1   0
3  1  1  1  1  1  1  0  1  0   0
4  1  1  1  1  1  1  0  1  0   0
5  1  1  1  1  1  1  0  1  0   0
6  1  1  1  1  1  0  1  0  0   0
7  1  1  1  1  0  1  0  0  0   0
8  1  0  1  0  1  0  0  0  0   0
9  0  1  0  1  0  0  0  0  0   0



 x<-c( 2.0794415,1.3862944,0.8472979, 0.8472979, 0.8472979,0.4054651,0.0000000, -0.8472979, -1.3862944)
    y<-c(-1.4404130, -1.5739444, -1.5739444, -1.5739444, -0.7472659, -0.1876501, 1.1986443 , 0.7286407,2.5849387,2.5849387 )
    result<-matrix(nrow = length(x), ncol = length(y))
    calculation<-function(x,y)
    {
      result<-outer(x,y,function(x,y){ z<-exp(x-y);z/(1+z)})
      result[!is.finite(result)]<-NA
      variance_result<-result*(1-result)
      row_var<- (-1)*rowSums(variance_result,na.rm=T)
      col_var<- (-1)*colSums(variance_result,na.rm=T)
      residual<-input-result
      row_residual<-rowSums(residual,na.rm=T)#(not to be multiplied by -1) 
      col_residual<-(-1)*colSums(residual,na.rm=T)
      new_x<-x-(row_residual/row_var)
      new_x[!is.finite(new_x)]<-NA
      new_x<as.array(new_x)
      new_y<-y-(col_residual/col_var)
      new_y[!is.finite(new_y)]<-NA
      avg_new_y<-mean(new_y, na.rm = T)
      new_y<-new_y-avg_new_y
      new_y<-as.array(new_y)
      sq_sum_residual<-round(sum(row_residual^2),5)
      if(sq_sum_residual>=.01)
      {calculation(new_x,new_y)}
      else(return(residual))
    }
    calculation(x,y)

输入是一个二分法9x10矩阵
x1x2x3x4x5x6x7x8x9x10
1 NA 11 11 01
2  1  1  1  1  1  1  1  0  1   0
3  1  1  1  1  1  1  0  1  0   0
4  1  1  1  1  1  1  0  1  0   0
5  1  1  1  1  1  1  0  1  0   0
6  1  1  1  1  1  0  1  0  0   0
7  1  1  1  1  0  1  0  0  0   0
8  1  0  1  0  1  0  0  0  0   0
9  0  1  0  1  0  0  0  0  0   0
你能解释一下你想做什么吗？@OrhanYazar我正试图用R编写Rasch分析代码。这一部分是分析的主要部分，其中剩余矩阵是计算出来的。这是一个迭代计算，当残差的平方和小于1时停止。实际的x、y阵列和输入矩阵具有相同的维数，但值不同。我的函数太慢了，需要一个多小时才能完成计算。我正在努力使它更快谢谢你的回复。我省略了计算new_x和new_y以缩短问题的步骤，这将防止循环永远运行。我尝试使用R编写Rasch分析代码。本节是计算残差矩阵的分析的主要部分。这是一个迭代计算，当残差的平方和小于1时停止。实际的x、y阵列和输入矩阵具有相同的维数，但值不同。我的函数太慢了，需要一个多小时才能完成计算。我正在努力使它更快