一些输入来自矩阵,其他输入来自矢量,如何替换2d循环?

时间:2019-06-27 11:26:33

标签: r

我有一个我不想编辑的功能。一些输入是时间相关的(在这里显示为矢量),一些输入是时间相关的,并且还取决于另一个变量Nj。

我目前正在遍历时间(Ni)并遍历Nj并分别计算每个值。据我所知,当所有输入具有相同的维数时,apply函数家族仅在这种情况下起作用。还有其他方法可以做到吗?

Ni <- 10
Nj <- 10

a <- matrix(1:100/100, Ni, Nj)
b <- matrix(runif(100)*500, Ni, Nj)
c <- runif(Ni)
d <- c + runif(Ni)
e <- runif(1)*100
f <- c(0.3, 0.7)

funky <- function(a, b, c, d, e, f) {

  firstLine <- a / b
  secondLine <- firstLine * c
  thirdLine <- (secondLine + 45) / d
  fourthLine <- thirdLine + e
  result <- c(f[1] * fourthLine, f[2] * fourthLine)

  result

}

resultMatrix1 <- matrix(numeric(), Ni, Nj)
resultMatrix2 <- matrix(numeric(), Ni, Nj)

for (i in 1:Ni) {
  for (j in 1:Nj) {

    result <- funky(a[i, j],
                    b[i, j],
                    c[i],
                    d[i],
                    e, 
                    f
    )

    resultMatrix1[i, j] <- result[1]
    resultMatrix2[i, j] <- result[2]
  }
}

这是我刚刚整理的一些组合代码,显示了我对输入尺寸的含义。问题是我正在使用的实际功能不是很快,而我正在填充的实际结果网格大约是100 * 150,并且运行大约需要半个小时。

1 个答案:

答案 0 :(得分:0)

您可以向量化其中一个循环。我将对for上的i循环进行矢量化处理。

set.seed(1234)

Ni <- 10
Nj <- 10

a <- matrix(1:100/100, Ni, Nj)
b <- matrix(runif(100)*500, Ni, Nj)
c <- runif(Ni)
d <- c + runif(Ni)
e <- runif(1)*100
f <- c(0.3, 0.7)

funky <- function(a, b, c, d, e, f) {

  firstLine <- a / b
  secondLine <- firstLine * c
  thirdLine <- (secondLine + 45) / d
  fourthLine <- thirdLine + e
  result <- c(f[1] * fourthLine, f[2] * fourthLine)

  result

}

resultMatrix1 <- matrix(numeric(), Ni, Nj)
resultMatrix2 <- matrix(numeric(), Ni, Nj)

for (i in 1:Ni) {
  for (j in 1:Nj) {

    result <- funky(a[i, j],
                    b[i, j],
                    c[i],
                    d[i],
                    e, 
                    f
    )

    resultMatrix1[i, j] <- result[1]
    resultMatrix2[i, j] <- result[2]
  }
}

resultMatrix1
resultMatrix2


funky2 <- function(a, b, c, d, e, f) {

  firstLine <- a / b
  secondLine <- firstLine * c
  thirdLine <- (secondLine + 45) / d
  fourthLine <- thirdLine + e
  result <- matrix(c(f[1] * fourthLine, f[2] * fourthLine), ncol = 2)

  result
}

rmat <- array(NA, dim = c(2, Ni, Nj))
for(j in 1:Nj) {
  result <- funky2(a[, j], b[, j], c, d, e, f)
  rmat[1, , j] <- result[, 1]
  rmat[2, , j] <- result[, 2]
}


identical(resultMatrix1, rmat[1, , ])
#[1] TRUE
identical(resultMatrix2, rmat[2, , ])
#[1] TRUE


JoePye <- function(a, b, c, d, e, f, Ni, Nj){
  resultMatrix1 <- matrix(numeric(), Ni, Nj)
  resultMatrix2 <- matrix(numeric(), Ni, Nj)

  for (i in 1:Ni) {
    for (j in 1:Nj) {

      result <- funky(a[i, j],
                      b[i, j],
                      c[i],
                      d[i],
                      e, 
                      f
      )

      resultMatrix1[i, j] <- result[1]
      resultMatrix2[i, j] <- result[2]
    }
  }

  list(Mat1 = resultMatrix1,
       Mat2 = resultMatrix2)
}
RuiB <- function(a, b, c, d, e, f, Ni, Nj){
  rmat <- array(NA, dim = c(2, Ni, Nj))
  for(j in 1:Nj) {
    result <- funky2(a[, j], b[, j], c, d, e, f)
    rmat[1, , j] <- result[, 1]
    rmat[2, , j] <- result[, 2]
  }
  rmat
}

library(microbenchmark)

mb10 <- microbenchmark(
  JoePye = JoePye(a, b, c, d, e, f, Ni, Nj),
  RuiB = RuiB(a, b, c, d, e, f, Ni, Nj)
)
mb10
#Unit: microseconds
#   expr     min       lq     mean   median       uq     max neval cld
# JoePye 473.950 479.2840 496.5165 483.6325 495.7015 758.162   100   b
#   RuiB 150.502 157.8205 174.8730 160.1100 165.2400 647.653   100  a 

速度提高了3倍。 现在使用更大的输入进行测试。

set.seed(1234)

Ni <- 1e2
Nj <- 2e1

a <- matrix(seq.int(Ni*Nj)/100, Ni, Nj)
b <- matrix(runif(Ni*Nj)*500, Ni, Nj)
c <- runif(Ni)
d <- c + runif(Ni)
e <- runif(1)*100
f <- c(0.3, 0.7)

res1 <- JoePye(a, b, c, d, e, f, Ni, Nj)
res2 <- RuiB(a, b, c, d, e, f, Ni, Nj)

identical(res1[[1]], res2[1, , ])
#[1] TRUE
identical(res1[[2]], res2[2, , ])
#[1] TRUE


mb100 <- microbenchmark(
  JoePye = JoePye(a, b, c, d, e, f, Ni, Nj),
  RuiB = RuiB(a, b, c, d, e, f, Ni, Nj),
  times = 10
)
mb100
#Unit: microseconds
#   expr      min       lq      mean   median       uq       max neval cld
# JoePye 9198.846 9248.114 9421.2359 9352.244 9426.161 10147.642    10   b
#   RuiB  478.564  490.404  533.8198  522.573  594.841   602.938    10  a 

输入越大,加速因子就提高到18倍。