R-避免嵌套循環

Question

我有以下功能，需要4個向量。 T向量具有給定的長度，而所有其他三個向量（pga，Sa5Hz和Sa1Hz）具有給定的（相同但不一定等於T）長度。

輸出是具有length（T）行和length（pga）列的矩陣。

下面的代碼似乎是不執行操作的完美示例，但是，我無法找到一種使用Apply函數對其進行優化的方法。 有人可以幫忙嗎？

designSpectrum <- function (T, pga, Sa5Hz, Sa1Hz){

  Ts <- Sa1Hz / Sa5Hz

  #By convention, if Sa5Hz is null, set Ts as 0.
  Ts[is.nan(Ts)] <- 0

  res <- matrix(NA, nrow = length(T), ncol = length(pga))

  for (i in 1:nrow(res))
  {
    for (j in 1:ncol(res))
    {
      res[i,j] <- if(T[i] <= 0) {pga[j]}
                  else if (T[i] <= 0.2 * Ts[j]) {pga[j] + T[i] * (Sa5Hz[j] - pga[j]) / (0.2 * Ts[j])}
                  else if (T[i] <= Ts[j]) {Sa5Hz[j]}
                  else Sa1Hz[j] / T[i]
      }
  }

  return(res)
}

Answer 1

不必執行double for循環並分別處理每個i和j值，您可以使用outer函數一次性處理所有這些值。 由於您現在正在同時處理多個i和j值，因此可以切換到向量化的ifelse語句，而不是非向量化的if和else語句：

designSpectrum2 <- function (T, pga, Sa5Hz, Sa1Hz) {
  Ts <- Sa1Hz / Sa5Hz
  Ts[is.nan(Ts)] <- 0
  outer(1:length(T), 1:length(pga), function(i, j) {
    ifelse(T[i] <= 0, pga[j],
      ifelse(T[i] <= 0.2 * Ts[j], pga[j] + T[i] * (Sa5Hz[j] - pga[j]) / (0.2 * Ts[j]),
        ifelse(T[i] <= Ts[j], Sa5Hz[j], Sa1Hz[j] / T[i])))
  })
}
identical(designSpectrum(T, pga, Sa5Hz, Sa1Hz), designSpectrum2(T, pga, Sa5Hz, Sa1Hz))
# [1] TRUE

數據：

T <- -1:3
pga <- 1:3
Sa5Hz <- 2:4
Sa1Hz <- 3:5

通過在相當大的向量上進行測試，您可以看到效率的提高（在這里，我將使用具有一百萬個條目的輸出矩陣）：

# Larger vectors
set.seed(144)
T2 <- runif(1000, -1, 3)
pga2 <- runif(1000, -1, 3)
Sa5Hz2 <- runif(1000, -1, 3)
Sa1Hz2 <- runif(1000, -1, 3)

# Runtime comparison
all.equal(designSpectrum(T2, pga2, Sa5Hz2, Sa1Hz2), designSpectrum2(T2, pga2, Sa5Hz2, Sa1Hz2))
# [1] TRUE
system.time(designSpectrum(T2, pga2, Sa5Hz2, Sa1Hz2))
#    user  system elapsed 
#   4.038   1.011   5.042 
system.time(designSpectrum2(T2, pga2, Sa5Hz2, Sa1Hz2))
#    user  system elapsed 
#   0.517   0.138   0.652 

使用outer的方法快了將近10倍。