R 使用循环顺序更新data.table列
我使用data.table实现了一个简单的动态编程示例,希望它能像矢量化代码一样快R 使用循环顺序更新data.table列,r,data.table,R,Data.table,我使用data.table实现了一个简单的动态编程示例,希望它能像矢量化代码一样快 library(data.table) B=100; M=50; alpha=0.5; beta=0.9; n = B + M + 1 m = M + 1 u <- function(c)c^alpha dt <- data.table(s = 0:(B+M))[, .(a = 0:min(s, M)), s] # State Space and corresponging Action Space
library(data.table)
B=100; M=50; alpha=0.5; beta=0.9;
n = B + M + 1
m = M + 1
u <- function(c)c^alpha
dt <- data.table(s = 0:(B+M))[, .(a = 0:min(s, M)), s] # State Space and corresponging Action Space
dt[, u := (s-a)^alpha,] # rewards r(s, a)
dt <- dt[, .(s_next = a:(a+B), u = u), .(s, a)] # all possible (s') for each (s, a)
dt[, p := 1/(B+1), s] # transition probs
# s a s_next u p
# 1: 0 0 0 0 0.009901
# 2: 0 0 1 0 0.009901
# 3: 0 0 2 0 0.009901
# 4: 0 0 3 0 0.009901
# 5: 0 0 4 0 0.009901
# ---
#649022: 150 50 146 10 0.009901
#649023: 150 50 147 10 0.009901
#649024: 150 50 148 10 0.009901
#649025: 150 50 149 10 0.009901
#649026: 150 50 150 10 0.009901
令我沮丧的是,data.table
解决方案甚至比下面高度非矢量化的解决方案还要慢。作为一个邋遢的data.table用户,我肯定缺少了一些data.table
功能。有什么方法可以改进吗,或者,数据。表
不适合这些类型的计算
S <- 0:(n-1) # StateSpace
VFI <- function(V){
out <- rep(0, length(V))
for(s in S){
x <- -Inf
for(a in 0:min(s, M)){
s_next <- a:(a+B) # (s')
x <- max(x, u(s-a) + beta * sum(V[s_next + 1]/(B+1)))
}
out[s+1] <- x
}
out
}
system.time({
V <- rep(0, n) # initial guess for Value function
i <- 1
tol <- 1
while(tol > 0.0001){
Vnew <- VFI(V)
tol <- max(abs(V - Vnew))
V <- Vnew
i <- i + 1
}
})
# user system elapsed
# 3.81 0.00 3.81
S以下是我将如何做到这一点
DT = CJ(s = seq_len(n)-1L, a = seq_len(m)-1L, s_next = seq_len(n)-1L)
DT[ , p := 0]
#p is 0 unless this is true
DT[between(s_next, a, a + B), p := 1/(B+1)]
#may as well subset to eliminate irrelevant states
DT = DT[p>0 & s>=a]
DT[ , util := u(s - a)]
#don't technically need by, but just to be careful
DT[ , V0 := rep(0, n), by = .(a, s_next)]
while(TRUE) {
#for each s, maximize given past value;
# within each s, have to sum over s_nexts,
# to do so, sum by a
DT[ , V1 := max(.SD[ , util[1L] + beta*sum(V0*p), by = a],
na.rm = TRUE), by = s]
if (DT[ , max(abs(V0 - V1))] < 1e-4) break
DT[ , V0 := V1]
}
DT=CJ(s=seq_len(n)-1L,a=seq_len(m)-1L,s_next=seq_len(n)-1L)
DT[,p:=0]
#p是0,除非这是真的
DT[s_next,a,a+B),p:=1/(B+1)]
#也可以使用子集来消除不相关的状态
DT=DT[p>0&s>=a]
DT[,util:=u(s-a)]
#技术上不需要,但要小心
DT[,V0:=rep(0,n),by=(a,s_下一步)]
while(TRUE){
#对于每个s,最大化给定的过去值;
#在每个s中,必须对s_nexts求和,
#要做到这一点,请按a求和
DT[,V1:=max(.SD[,util[1L]+beta*和(V0*p),by=a],
na.rm=TRUE),by=s]
如果(DT[,max(abs(V0-V1))]<1e-4)断裂
DT[,V0:=V1]
}
在我的机器上,这大约需要15秒(不太好)。。。但也许这会给你一些想法。例如,这个data.table
太大了,因为实际上最终只有n
唯一的V
值。请参阅。有人可能会抽出时间来解决这个问题,但将问题简化为最简单的演示(在您的案例中,data.table的缓慢使用)将从我们这里得到更好的结果。如果您问题的主旨是如何提高data.table方法的性能,那么也许其他人可以提供帮助。但如果你只是在寻找提高这类动态模型性能的方法,那么我个人总是使用RCpp来实现这类功能。对动态模型进行矢量化通常很棘手,而且常常是不可能的。如果需要速度,RCpp通常是最好的选择。我不想打架,但我似乎很清楚:@JackWasey的第1点,你发现缺少什么?工作数据集位于问题的开头。。。所做的努力显示,并显示了一个可比的版本,以证明该问题。。。我不想打架,但我真的不明白是什么让你觉得这个问题遗漏了什么。由于效率问题,我不知道如何减少代码。
DT = CJ(s = seq_len(n)-1L, a = seq_len(m)-1L, s_next = seq_len(n)-1L)
DT[ , p := 0]
#p is 0 unless this is true
DT[between(s_next, a, a + B), p := 1/(B+1)]
#may as well subset to eliminate irrelevant states
DT = DT[p>0 & s>=a]
DT[ , util := u(s - a)]
#don't technically need by, but just to be careful
DT[ , V0 := rep(0, n), by = .(a, s_next)]
while(TRUE) {
#for each s, maximize given past value;
# within each s, have to sum over s_nexts,
# to do so, sum by a
DT[ , V1 := max(.SD[ , util[1L] + beta*sum(V0*p), by = a],
na.rm = TRUE), by = s]
if (DT[ , max(abs(V0 - V1))] < 1e-4) break
DT[ , V0 := V1]
}