A bank account has starting balance, which shall be completely withdrawn in n steps, such that the sum of benefits of withdrawals is maximum. Remaining balance yield interest between steps such that account refills between drawings. Benefits depend on withdrawal height.
Benefit generated from withdrawal is $$\text{benefit}(\text{w$\_$})\text{:=}\text{benefit}(w)=\log (w)$$ Balance reduced by withdrawals yield interest and transfer the account to the next step $$\text{transfer}(\text{x$\_$},\text{w$\_$},\text{z$\_$})\text{:=}\text{transfer}(x,w,z)=z (x-w)$$ with $x$ the account balance, $w$ the withdrawal, and $z$ the interest rate.
Starting balance is $x0$, $n$ the number of periods, and $dx$ the discretization step size to limit the amount of values to memoize.
The following Mathematica code solves this problem numerically, using functions with memoization for remembering optimal solutions from prior solved subproblems which are worked through in reverse:
benefit[w_] := benefit[w] = Log[w];(* benefit for withdrawal w on each process step *)
transfer[x_, w_, z_] := transfer[x, w, z] = (x - w) z ;(* transfer account balance x to next process step *)
x0 = 123;(* starting account balance *)
z = 1.2; (* interest rate *)
n = 5; (* number of periods *)
dx = 0.1;(* discretization step size *)
h[k_, x_] := h[k, x] = If[
k == n,
result = Select[(benefit[#] & /@ Range[0, x, dx]), NumberQ];
If[Length[result] > 0, {Max@result,
a = dx Ordering[result, -1][[1]], Log[a]}, {0, 0, 0}],
result =
Select[((benefit[#] +
h[k + 1, Round[transfer[x, #, z], dx]][[1]]) & /@
Range[0, x, dx]), NumberQ];
If[Length[result] > 0, {Max@result,
a = dx Ordering[result, -1][[1]], Log[a]}, {0, 0, 0}]
];(* define functions employing memoization to serve as tables *)
Do[h[k, x0], {k, n, 1, -1}];(* fill tables with optimal withdrawals for account balance x, for n steps *)
as[1] = x0;(* set starting value for account value series as *)
Do[
w[k] = h[k, as[k]][[2]];
Print["withdrawal ", k, ". step: ", w[k], " with benefit: ",Log[w[k]]];
as[k + 1] = (as[k] - w[k]) z;
Print["account balance after ", k,
". withdrawal and following interest yield: ", as[k + 1]],
{k, 1, n, 1}
];
Print["sum of all withdrawals: ", Sum[w[k], {k, 1, n, 1}]];
Print["sum of all benefits: ", Sum[Log[w[k]], {k, 1, n, 1}]];
with output:
(*
withdrawal 1. step: 24.7 with benefit: 3.2068
account balance after 1. withdrawal and following interest yield: 117.96
withdrawal 2. step: 29.5 with benefit: 3.38439
account balance after 2. withdrawal and following interest yield: 106.152
withdrawal 3. step: 35.6 with benefit: 3.57235
account balance after 3. withdrawal and following interest yield: 84.6624
withdrawal 4. step: 42.2 with benefit: 3.74242
account balance after 4. withdrawal and following interest yield: 50.9549
withdrawal 5. step: 50.9 with benefit: 3.92986
account balance after 5. withdrawal and following interest yield: 0.065856
sum of all withdrawals: 182.9
sum of all benefits: 17.8358
*)
Question:
Is there another Mathematica concept for tabulation of recursively calculated values which is better suited for discrete dynamic programming problems, in terms of actual performance?