1
$\begingroup$

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?

$\endgroup$
2
  • 1
    $\begingroup$ You may increase your performance giving up procedural programming and using Functional programming. Could you add the expression of your problem in latex to the question please. $\endgroup$ Commented Jul 10, 2016 at 15:36
  • $\begingroup$ Thank you. Expressions for process gain and transfer function added; title changed to focus on discrete dynamic programming problems using recursively tabulated values, instead of computed functions. $\endgroup$
    – nmrphys
    Commented Jul 10, 2016 at 20:45

1 Answer 1

2
$\begingroup$

If you are interested in increasing performance I would recommend using FindMaximum.

If you go through five steps you will discover at the end the original account balance (a0) is related to the five withdrawals via:

a0 == (w5 + w4 z + w3 z^2 + w2 z^3 + w1 z^4)/z^4

where w1 through w5 are the withdrawal values and z is the interest rate.

It is desired to maximize the benefits subject to the above constraint.

FindMaximum[
 {
  Total@Log[{w1, w2, w3, w4, w5}],
  a0 == (w5 + w4 z + w3 z^2 + w2 z^3 + w1 z^4)/z^4
  },
 {w1, w2, w3, w4, w5}
 ]

(* {17.8369, {w1 -> 24.6, w2 -> 29.52, w3 -> 35.424, 
  w4 -> 42.5088, w5 -> 51.0105}} *)

This is very fast and can easily be generalized to any number of steps.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.