如何在 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 函数需要一行我的 data ，然后它使用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 函数替换了该功能。