如何在 R 中使用 lapply 替换嵌套循环？

Question

下午好，

我已经开发了这个 R 函数，它可以对桶中的数据进行哈希处理：

#   The used packages 
    library("pacman")
    pacman::p_load(dplyr, tidyr, devtools, MASS, pracma, mvtnorm, interval, intervals) 
    pacman::p_load(sprof, RDocumentation, helpRFunctions, foreach , philentropy , Rcpp , RcppAlgos) 


  hash<-function(v,p){
  if(dot(v,p)>0) return(1) else (0)   }

  LSH_Band<-function(data,K ){

  # We retrieve numerical columns of data 
  t<-list.df.var.types(data)
  df.r<-as.matrix(data[c(t$numeric,t$Intervals)])
  n=nrow(df.r)

  # we create K*K matrice using normal law
  rn=array(rnorm(K*K,0,1),c(K,K))
  # we create K*K matrice of integers using uniform law , integrs are unique in each column
  rd=unique.array(array(unique(ceiling(runif(K*K,0,ncol(df.r)))),c(K,K)))

  buckets<-array(NA,c(K,n)) 
    for (i in 1:K) {
      for (j in 1:n) {
        buckets[i,j]<-hash(df.r[j,][rd[,i]],rn[,i])
      }
    }   
  return(buckets)   
}
> df.r
  age height salaire.1 salaire.2
1  27    180         0      5000
2  26    178         0      5000
3  30    190      7000     10000
4  31    185      7000     10000
5  31    187      7000     10000
6  38    160     10000     15000
7  39    158     10000     15000
> LSH_Band(df.r, 3 )
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    1    1    1    1    1    1    1
[2,]    1    1    0    0    0    0    0
[3,]    0    0    0    0    0    0    0

点函数是两个向量的标量积。

• 我的 Lsh 函数需要一行我的数据，然后它需要一部分 使用 df.r[j,][rd[,i]] 获得的行。 df.r[j,] 是 j-éme 行的 数据。

• rd[,i] : rd 是一个 K*K 矩阵，由 1 到 ncol(df.r) 之间的整数组成，矩阵的每一列只包含唯一的整数。

• rn[,i] : rn 是一个 K*K 矩阵，包含 N(0,1) 定律的值。

• 在结果表中，观察以列表示。我将有 k 行。对于最后一行，我将计算df.r[j,][rd[,K]] 和rn[,K] 之间的标量积。如果标量积为正，我将获得 1。 rd[,K] 和 rn[,K] 将仅用于结果表中的最后一行以及该行中的所有观察值。

我的问题：

是否用 lapply 函数 用变量 i 和 j 替换 循环 ？

我的真实数据会很大，这就是我问这个问题的原因。

谢谢！

Answer 1

下面的评论有点太长了，所以这里有一些指针/问题/备注：

1. 首先，我不得不说我很难理解LHS_Band 的作用。也许一些背景会在这里有所帮助。

2. 我不明白某些函数的用途，例如 helpRFunctions::list.df.var.type，它似乎只是在 list 中返回 data 的列名。另请注意，t$Intervals 根据您提供的样本数据返回 NULL。所以我不确定那里发生了什么。

3. 我也看不到函数pracma::dot 的意义。两个向量之间的点积可以使用%*% 在基数 R 中计算。真的不需要额外的包。

4. 函数hash可以更简洁地写成

   hash <-  function(v, p) +(as.numeric(v %*% p) > 0)
   

   这避免了 if 条件很慢。

---

尽管我不了解您要做什么，但这里对您的代码进行了一些调整

hash <-  function(v, p) +(as.numeric(v %*% p) > 0)

LSH_Band <- function(data, K, seed = NULL) {

    # We retrieve numerical columns of data
    data <- as.matrix(data[sapply(data, is.numeric)])
    # we create K*K matrice using normal law
    if (!is.null(seed)) set.seed(seed)
    rn <- matrix(rnorm(K * K, 0, 1), nrow = K, ncol = K)
    # we create K*K matrice of integers using uniform law , integrs are unique in each column
    rd <- sapply(seq_len(K), function(col) sample.int(ncol(data), K))
    buckets <- matrix(NA, nrow = K, ncol = nrow(data))
    for (i in 1:K) {
        buckets[i, ] <- apply(data, 1, function(row) hash(row[rd[, i]], rn[, i]))
    }
    buckets
}

1. 在处理随机数时，始终添加一个选项以使用可重现的seed。这将使调试很多更容易。
2. 您可以用apply 替换至少一个for 循环（当使用MARGIN = 1 时，循环遍历matrix（或array）的行）。
3. 我已删除所有不必要的包依赖项，并用基本 R 函数替换了该功能。