我有一个我不想编辑的功能。一些输入是时间相关的(在这里显示为矢量),一些输入是时间相关的,并且还取决于另一个变量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,并且运行大约需要半个小时。
答案 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倍。