当数据在列表中时,我可以向量化代码吗？

Question

我正在优化我的代码,我遇到了一些问题.我知道R中最大的速度来自矢量化代码而不是使用循环.但是,我在列表中有我的数据,我不确定我是否可以对代码进行矢量化.我已经尝试过使用这些apply函数(比如lapply,vapply),但我读到这些函数只是为了编写更干净的代码而实际上是在引擎盖下使用循环!

这是我的代码中的三个最大瓶颈,尽管我认为第一部分没有任何事情可做.

1)读取数据

我使用尺寸为277x349的1000个矩阵批量处理.这是我脚本中最大的瓶颈,但是我通过使用该doMC软件包利用该foreach功能的多个内核来缓解了这个问题.这导致包含1000个277x349矩阵的列表.

出于问题的目的,假设我们有1000个矩阵的列表277 x 349

# Fake data
l <- list()
for(i in 1:1000) {
  l[[i]] <- matrix(rnorm(277*349), nrow=277, ncol=349)
}

2)瓶颈#1

我需要与一些参考矩阵(相同维度)进行比较.这导致将列表中的1000个矩阵与我的参考矩阵进行比较,得到1000个距离的向量.如果我知道矩阵具有相同的尺寸,我可以将此步骤向量化吗？

这是一些代码:

# The reference matrix
r <- matrix(rnorm(277*349), nrow=277, ncol=349)
# The number of non NA values in matrix. Do not need to worry about this...
K <- 277*349

# Make a function to calculate distances
distance <- function(xi, xj, K, na.rm=TRUE) {
  sqrt(sum((xi - xj)^2, na.rm=na.rm)/K)
}

# Get a vector containing all the distances
d <- vapply(l, distance, c(0), xj=r, K=K)

这个步骤使用vapply起来非常快,但它是代码中第三个最慢的部分.

3)瓶颈#2

我现在想要将J"最接近"矩阵的加权平均矩阵与我的参考矩阵进行比较.(有一个排序步骤,但d[1] < d[2] < ... < d[1000]为简单起见假设).我想得到J = 1,2,...,1000时的加权平均矩阵

# Get the weighted matrix
weightedMatrix <- function(listOfData, distances, J) {
  # Calculate weights:
  w <- d[1:J]^{-2} / sum(d[1:J]^{-2})

  # Get the weighted average matrix
  # *** I use a loop here ***
  x_bar <- matrix(0, nrow=nrow(listOfData[[1]]), ncol=ncol(listOfData[[1]]))
  for(i in 1:J) {
    x_bar <- x_bar + {listOfData[[i]] * w[i]}
  }

  return(x_bar)
}

# Oh no! Another loop...
res <- list()
for(i in 1:length(l) ) {
  res[[i]] <- weightedMatrix(l, d, J=i)
}

我有点难过.我没有看到在矩阵列表上矢量化操作的直观方法.

我写的脚本会经常被调用,所以即使有一点改进也可以加起来!

---

编辑:

RE:1)读取数据

我忘了提到我的数据是特殊格式的,所以我必须使用特殊的数据读取功能来读取R中的数据.文件是netcdf4格式的,我正在使用nc_open包中的函数ncdf4来访问文件,然后我必须使用该ncvar_get函数来读取感兴趣的变量.好处是文件中的数据可以从磁盘读取,然后我可以将数据读入内存,ncvar_get用R对它们进行操作.

话虽这么说,虽然我知道我的矩阵的大小以及我将拥有多少矩阵,但我用一个数据列表问我的问题,因为foreach能够让我做并行计算的函数输出来自并行化循环的结果一个列表.我发现使用该foreach功能,数据读取步骤的速度提高了约3倍.

我想我之后可以将数据排列为3d数组,但是分配3d数组所花费的时间可能比节省时间要多吗？我明天要试试.

---

编辑2:

以下是我对剧本的一些时间安排.

原始剧本:

[1] "Reading data to memory"
user  system elapsed 
176.063  44.070  26.611 

[1] "Calculating Distances"
user  system elapsed 
2.312   0.000   2.308 

[1] "Calculating the best 333 weighted matrices"
user  system elapsed 
63.697  28.495   9.092 

到目前为止,我做了以下改进:(1)在读取数据之前预先分配列表,(2)根据Martin Morgan的建议改进加权矩阵计算.

[1] "Reading data to memory"
user  system elapsed 
192.448  38.578  27.872 

[1] "Calculating Distances"
user  system elapsed 
2.324   0.000   2.326 

[1] "Calculating all 1000 weighted matrices"
user  system elapsed 
1.376   0.000   1.374 

一些说明:

我在foreach循环中使用12个内核来读入数据(registerDoMC(12)).在改进之前/之后,整个脚本需要大约40秒/ 36秒才能运行.

我的瓶颈#2的时机已经改善了很多.以前,我一直只计算加权矩阵的前三分之一(即333),但现在脚本只能在原始时间的一小部分内计算所有加权矩阵.

感谢您的帮助,我稍后会尝试调整我的代码,看看是否可以更改我的脚本以使用3D数组而不是列表.我现在要花一些时间来验证计算,以确保它们正常工作!

Answer 1

我的"低悬的果实"(scan;预分配和填充)似乎不相关,所以......

距离计算中的操作类似于我的矢量化.可能你可以通过对所有矩阵进行单一距离计算来挤出一些额外的速度,但这可能会使代码不易理解.

加权矩阵计算看起来有改进的余地.我们算一算吧

w <- d^(-2) / cumsum(d^(-2))

对于加权矩阵m我认为连续矩阵之间的关系仅仅是m' = m * (1 - w[i]) + l[[i]] * w[i],使

res <- vector("list", length(l))
for (i in seq_along(l))
    if (i == 1L) {
        res[[i]] = l[[i]] * w[[i]]
    } else  {
        res[[i]] = res[[i - 1]] * (1 - w[[i]])  + l[[i]] * w[[i]]
    }

这会将计算res从二次变为线性.我对优于线性表现的想法只是一种(可能也是误导的)预感; 我没有追求那个.

回到预先分配并填写和@ flodel的评论,我们有

f0 <- function(n) {
    ## good: pre-allocate and fill
    l = vector("list", n)
    for (i in seq_along(l))
        l[[i]] = 1
    l
}

f1 <- function(n) {
    ## bad: copy and append
    l = list()
    for (i in seq_len(n))
        l[[i]] = 1
    l
}

产生相同的结果

> identical(f0(100), f1(100))
[1] TRUE

但性能不同

> sapply(10^(1:5), function(i) system.time(f0(i))[3])
elapsed elapsed elapsed elapsed elapsed 
  0.000   0.000   0.002   0.014   0.134 
> sapply(10^(1:5), function(i) system.time(f1(i))[3])
elapsed elapsed elapsed elapsed elapsed 
  0.000   0.001   0.005   0.253  24.520 

尽管这与当前问题的规模无关紧要并不重要,但似乎应采用更好的预分配和填充策略以避免猜测它是否相关.更好的是,使用*apply或在这种情况下的replicate家庭,以避免不得不考虑它

l <- replicate(1000, matrix(rnorm(277*349), nrow=277, ncol=349), simplify=FALSE)