我有以下我要优化的代码，但是我目前不确定如何做到这一点。首先，让我为您介绍这个问题。
test.data包含大约20万行，这使得下面的实现在R中极其缓慢。我试图做的第一件事是优化功能并删除尽可能多的测试（{{1} }语句），但是在下面的代码中，我无法在两个实例中执行此操作。
if第二，我试图对代码进行矢量化处理，但是我认为这是不可行的，因为library(data.table)
test.data <- data.table(person = c("A", "B", "C"),
duration = c(120,50,30),
time = c(159, 231, 312),
savings = c(140000, 200000, 300000),
ren = c(0.0037, 0.0011, 0.0015),
res = c(55, 10, 30))
set.seed(35)
# Deduction series, note that in this example, they are arbitrary.
# They do not follow a pattern. I believe, this is the core of the problem.
# Which makes it extremely difficult to vectorise, since this would result in
# no closed solution.
c_a <- round(runif(max(test.data$duration)), 2) / 10
# Put in as a constant, but it can vary arbitrary.
c_b <- rep(round((8.5 / 12)/100, digits = 4), max(test.data$duration))
rnew <- 0.25
result <- matrix(0, nrow = 6, ncol = 120)
for(j in 1:nrow(test.data)){
savings <- test.data$savings[j]
duration <- test.data$duration[j]
time <- test.data$time[j]
res <- test.data$res[j]
m <- matrix(nrow = 6, ncol = duration)
for(i in 1:duration){
m[1,i] <- ifelse(i == 1, savings, m[6, i-1])
m[2,i] <- -m[1,i] * c_a[i]
m[3,i] <- -(m[1,i] + m[2,i]) * c_b[i]
m[4,i] <- ifelse(i == duration, -(m[1,i] + m[2,i] + m[3,i]), -(m[1,i] + m[2,i]) / (time + 1 - i))
if(i == res & res < time){
m[5, i] <- -(m[1,i] + m[2,i]) * (1 - rnew)
} else {
m[5, i] <- 0
}
m[6, i] <- m[1,i] + m[2,i] + m[3,i] + m[4,i] + m[5,i]
}
m <- cbind(m, matrix(0, ncol = ncol(result) - ncol(m), nrow = nrow(result)))
result <- matrix(mapply(sum, result, m, MoreArgs=list(na.rm=T)),ncol=ncol(result))
}
和c_a是随机值，因此，我不能简单地将其提升为一定的幂。我相信，为了能够对代码进行矢量化处理，我需要能够编写一个封闭形式的函数，但是我无法做到这一点。
我遇到的第三个问题是内存大小，如果我将所有中间结果存储在内存中，那将导致所有内容爆炸到c_b中，在我看来这是一个相当大的内存增加，因此我被迫这样做做到“一次”。
此外，我已经尝试过3 * 120 * 6，但是不幸的是，内存限制使我无法使用2个以上的内核（16GB的内存）。
现在我想知道的是，还有什么优化技术不存在到RCpp之内。
答案 0 :(得分：0)
我唯一能建议的就是只初始化一次m，其尺寸与result相同，
并替换外循环的最后两行，如下所示。
这样可以避免重新分配* m和用sum完成元素方式的mapply。
result <- matrix(0, nrow = 6, ncol = 120)
m <- result
for (j in 1:nrow(test.data)) {
savings <- test.data$savings[j]
duration <- test.data$duration[j]
time <- test.data$time[j]
res <- test.data$res[j]
for (i in 1:duration) {
m[1,i] <- ifelse(i == 1, savings, m[6, i-1])
m[2,i] <- -m[1,i] * c_a[i]
m[3,i] <- -(m[1,i] + m[2,i]) * c_b[i]
m[4,i] <- ifelse(i == duration, -(m[1,i] + m[2,i] + m[3,i]), -(m[1,i] + m[2,i]) / (time + 1 - i))
if (i == res & res < time) {
m[5, i] <- -(m[1,i] + m[2,i]) * (1 - rnew)
} else {
m[5, i] <- 0
}
m[6, i] <- m[1,i] + m[2,i] + m[3,i] + m[4,i] + m[5,i]
}
result[, 1:duration] <- result[, 1:duration] + m[, 1:duration]
}
您的内部循环对先前迭代的结果有复杂的依赖性， 所以我不知道它是否可以利用操作向量化。
*从技术上讲，由于修改时复制的语义，R在每次修改矩阵时都会复制矩阵。
我认为R在其内存管理方面做了一些特殊的事情，因此每个副本不一定等同于新的内存分配，
但该副本仍然代表开销。
由于您要进行元素操作，
那很可能是您的瓶颈，
并最好用Rcpp迁移到C或C ++。
答案 1 :(得分：0)
一种可能的方法来计算未付金额的总和（即OP的结果在第1行中）。如果需要，可以轻松计算所有中间值（m[2,j]，m[3,j]，m[4,j]，m[5,j]）。警告：我没有用实际的暗淡时间来计时
library(data.table)
calcAmor <- function(ca, cb, rnew, dur, S0, tau, res) {
amortize <- function(S, ca.t) S - ca.t[1L]*S - (1-ca.t[1L])*cb*S - (S - ca.t[1L]*S) / (tau + 1 - ca.t[2L])
ans <- Reduce(amortize,
split(cbind(ca, seq_along(ca)), seq_along(ca)),
init=S0,
accumulate=TRUE)[-(dur+1L)]
ix <- min(res+1L, dur):dur
tmp <- Reduce(amortize,
split(cbind(ca[ix], ix), seq_along(ix)),
init=amortize(ans[res], c(ca[res], res)) - (ans[res] - ans[res]*ca[res])*(1-rnew),
accumulate=TRUE)
ans[ix] <- tmp[-length(tmp)]
ans
}
set.seed(35)
test.data <- data.table(person = c("A", "B", "C"),
duration = c(120,50,30),
time = c(159, 231, 312),
savings = c(140000, 200000, 300000),
res = c(55, 10, 30))
maxd <- test.data[, max(duration)]
c_a <- round(runif(maxd), 2) / 10
rnew <- 0.25
cb <- round((8.5 / 12)/100, digits = 4)
test.data[, .(
dur=seq_len(duration),
S=calcAmor(ca=c_a[seq_len(duration)], cb, rnew, dur=duration, S0=savings, tau=time, res=res)),
by=.(person)][, sum(S), by=.(dur)]
输出：
dur V1
1: 1 6.400000e+05
2: 2 5.783318e+05
3: 3 5.711966e+05
4: 4 5.336450e+05
5: 5 4.774502e+05
---
116: 116 7.075169e+00
117: 117 6.788631e+00
118: 118 6.339002e+00
119: 119 5.639335e+00
120: 120 5.297898e+00