(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 25195, 889]*) (*NotebookOutlinePosition[ 26269, 926]*) (* CellTagsIndexPosition[ 26225, 922]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{Cell[TextData["Time"], "Title", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Hal Varian\nApril 1992"], "Subsubtitle", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Symbolic dynamic programming"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Dynamic programming is a powerful way to solve optimization problems. We \ consider the problem described in the text here, but in order to keep things \ simple we will ignore the uncertainty. Recall that the one-period objective \ function is ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Log[c]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" and the discount factor is ", Evaluatable->False, AspectRatioFixed->True], StyleBox["alpha", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[". We use ", Evaluatable->False, AspectRatioFixed->True], StyleBox["w", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" to denote wealth and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["R", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" is the total return on savings.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Two-period case"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData[ "U[c_] := Log[c] + alpha Log[(w-c)R]\nsolution1=Solve[D[U[c],c]==0,c][[1]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {c -> w/(1 + alpha)}\ \>", "\<\ w {c -> ---------} 1 + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["Substituting back into ", Evaluatable->False, AspectRatioFixed->True], StyleBox["U[c]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ " gives us the indirect utility function. We clear c after we're done so \ it won't interfere with the calculations further on.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Simplify[U[c]/.solution1]\nClear[c]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ Log[w/(1 + alpha)] + alpha*Log[(alpha*R*w)/(1 + alpha)]\ \>", "\<\ w alpha R w Log[---------] + alpha Log[---------] 1 + alpha 1 + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Calculating the value function by recursion"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[" Let's try to program ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold", FontSlant->"Italic"], StyleBox[ " to do the dynamic programming recursion all by itself. As it turns out \ the only thing that we have to do is to make the consumption variable, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["c", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ ", \"local\" to the routine where it is being calculated. Otherwise, ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" gets confused by all the values of", Evaluatable->False, AspectRatioFixed->True], StyleBox[" c", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" that are floating around. To do this, we use the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Module", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" construction. Here's how it works for a 3-period problem.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "V3[w_,t_]:=\n Module[{c},\n Log[c] + alpha*V3[(w-c)*R,t+1]/.Solve[D[Log[c] \n\ + alpha*V3[(w-c)*R,t+1],c]==0,c][[1]]]\n\nV3[w_,3] := Log[w]\n"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["TableForm[{V3[w,3],V3[w,2],Simplify[V3[w,1]]}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ TableForm[{Log[w], Log[w/(1 + alpha)] + alpha*Log[R*(w - w/(1 + alpha))], Log[w/(1 + alpha + alpha^2)] + alpha*Log[(alpha*R*w)/(1 + alpha + alpha^2)] + alpha^2*Log[(alpha^2*R^2*w)/(1 + alpha + alpha^2)]}]\ \>", "\<\ Log[w] w w Log[---------] + alpha Log[R (w - ---------)] 1 + alpha 1 + alpha w alpha R w Log[------------------] + alpha Log[------------------] + 2 2 1 + alpha + alpha 1 + alpha + alpha 2 2 2 alpha R w alpha Log[------------------] 2 1 + alpha + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Solving for consumption"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Once we have the value function, it is easy to solve for consumption in a \ given period. \nFirst let's check that we get the same values as before one \ period before the end.\n"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData[ "V3[w,2]\nSolve[D[Log[c] + alpha*V3[(w-c)*r,3],c]==0,c][[1]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ Log[w/(1 + alpha)] + alpha*Log[R*(w - w/(1 + alpha))]\ \>", "\<\ w w Log[---------] + alpha Log[R (w - ---------)] 1 + alpha 1 + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True], Cell[OutputFormData["\<\ {c -> w/(1 + alpha)}\ \>", "\<\ w {c -> ---------} 1 + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Yep, that checks. Here's first period consumption in a 3-period problem."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Solve[D[Log[c] + alpha*V3[(w-c)*r,2],c]==0,c][[1]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {c -> w/(1 + alpha + alpha^2)}\ \>", "\<\ w {c -> ------------------} 2 1 + alpha + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "To solve for first-period consumption in, say, a 5-period problem, we have \ to go back and define a new value function for that problem."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "V5[w_,t_]:= \n Module[{c},\n Log[c] + alpha*V5[(w-c)*R,t+1]/.Solve[D[Log[c] \ \n + alpha*V5[(w-c)*R,t+1],c]==0,c][[1]]]\n\nV5[w_,5] := Log[w]\n\n"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Solve[D[Log[c] + alpha*V5[(w-c)*r,2],c]==0,c][[1]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {c -> w/(1 + alpha + alpha^2 + alpha^3 + alpha^4)}\ \>", "\<\ w {c -> ------------------------------------} 2 3 4 1 + alpha + alpha + alpha + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Note that consumption is independent of the rate of return, as we argued in \ the text."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Speeding things up"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Actually, we should define the value function a little bit differently if \ we want to use ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold", FontSlant->"Italic"], StyleBox[" efficiently. When we calculate ", Evaluatable->False, AspectRatioFixed->True], StyleBox["V[w,1]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[", we have to calculate all the other values of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["V[w,t]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[". When we calculate ", Evaluatable->False, AspectRatioFixed->True], StyleBox["V[w,2]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ " we have to calculate those values all over again. We can tell ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" to \"remember\" the values of the ", Evaluatable->False, AspectRatioFixed->True], StyleBox["V[w,t]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ " function by using the following construction. (The \"f\" stands for \ \"fast\".)", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "V5f[w_,t_]:= V5f[w,t] =\n Module[{c},\n Log[c] + \ alpha*V5f[(w-c)*R,t+1]/.Solve[D[Log[c] \n + \ alpha*V5f[(w-c)*R,t+1],c]==0,c][[1]]]\n\nV5f[w_,5] := Log[w]\n\n"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Timing[V5[w,1];]\nTiming[V5[w,2];]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {3.633333333333333*Second, Null}\ \>", "\<\ {3.63333 Second, Null}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True], Cell[OutputFormData["\<\ {1.016666666666667*Second, Null}\ \>", "\<\ {1.01667 Second, Null}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Timing[V5f[w,1];]\nTiming[V5f[w,2];]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {1.9*Second, Null}\ \>", "\<\ {1.9 Second, Null}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True], Cell[OutputFormData["\<\ {0.6333333333333333*Second, Null}\ \>", "\<\ {0.633333 Second, Null}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Note that the second way of calculating the value function is a lot \ faster."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Stochastic dynamic programming"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "One of the strengths of dynamic programming is that it is easy to handle \ stochastic problems. Consider the savings problem discussed above. Suppose \ that ", Evaluatable->False, AspectRatioFixed->True], StyleBox["R", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" ", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox["takes value ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Ru", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" with probability ", Evaluatable->False, AspectRatioFixed->True], StyleBox["p", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Rd", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" with probability ", Evaluatable->False, AspectRatioFixed->True], StyleBox["1-p", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[". Then the expected value function is", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "V3s[w_,t_]:= V3s[w,t] =\n Module[{c},\n Log[c] + alpha*(p*V3s[(w-c)*Ru,t+1]+\ \n (1-p)*V3s[(w-c)*Rd,t+1])/.Solve[D[Log[c] \n + \ alpha*(p*V3s[(w-c)*Ru,t+1]+\n \ (1-p)*V3s[(w-c)*Rd,t+1]),c]==0,c][[1]]]\nV3s[w_,3] := Log[w]"], "Input", AspectRatioFixed->True], Cell[TextData["We solve for optimal consumption in period 1:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData[ "Solve[D[Log[c] + alpha*(p*V3s[(w-c)*Ru,2]+\n \ (1-p)*V3s[(w-c)*Rd,2]),c]==0,c][[1]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {c -> w/(1 + alpha + alpha^2)}\ \>", "\<\ w {c -> ------------------} 2 1 + alpha + alpha\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox[ "Note that even in the stochastic case, consumption doesn't depend on ", Evaluatable->False, AspectRatioFixed->True], StyleBox["p.", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ " That is, optimal consumption is independent of the probability \ distribution of the rate of return.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Numeric dynamic programming"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["By the numbers"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "Of course only a few dynamic programming problems have explicit \ closed-form expressions. However, we can use exactly the same techniques to \ solve problems numerically. First we'll try the problem we've already \ investigate since we can check the numerical formula against the symbolic \ one. The ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Mathematica", Evaluatable->False, AspectRatioFixed->True, FontSlant->"Italic"], StyleBox[" function ", Evaluatable->False, AspectRatioFixed->True], StyleBox["FindMinimum[f[x],{x,x0}] ", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox["returns a list ", Evaluatable->False, AspectRatioFixed->True], StyleBox["{fmax,{x->xmax}}", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" where ", Evaluatable->False, AspectRatioFixed->True], StyleBox["fmax", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" is a (local) minimum value of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["f[x]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" starting at the valued ", Evaluatable->False, AspectRatioFixed->True], StyleBox["x0", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[".", Evaluatable->False, AspectRatioFixed->True], StyleBox["\n\n", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox["Here's the expression for the optimal consumption with wealth ", Evaluatable->False, AspectRatioFixed->True], StyleBox["w", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" at time ", Evaluatable->False, AspectRatioFixed->True], StyleBox["t ", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox["in a 3-period problem.", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "c3n[w_,t_] := c3n[w,t] =\n c/.FindMinimum[-Log[c] - \ alpha*V3n[(w-c)*R,t+1],{c,1}][[2]]\nc3n[w_,3] := w"], "Input", AspectRatioFixed->True], Cell[TextData["Here's the expression for the value function:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "V3n[w_,t_]:= V3n[w,t] =\n Log[c3n[w,t]] + \ alpha*V3n[(w-c3n[w,t])*R,t+1]\nV3n[w_,3] := N[Log[w]]\n"], "Input", AspectRatioFixed->True], Cell[TextData[ "Set the parameters so that we can do this numerically."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["R=1.5\nalpha=.9"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 1.5\ \>", "\<\ 1.5\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True], Cell[OutputFormData["\<\ 0.9\ \>", "\<\ 0.9\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["Now let's calculate"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["{V3n[100,1],V3n[100,2],V3n[100,3]}"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {10.53301974475174, 7.800395102855128, 4.605170185988092}\ \>", "\<\ {10.533, 7.8004, 4.60517}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Compare this to the values found by the symbolic calculation:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["{V3[100,1],V3[100,2],N[V3[100,3]]}"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {10.53454397644632, 7.800395102855127, 4.605170185988092}\ \>", "\<\ {10.5345, 7.8004, 4.60517}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Pretty close! Now let's try the same calculation for a 5-period problem:"], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "c5n[w_,t_] := c5n[w,t] =\n c/.FindMinimum[-Log[c] - \ alpha*V5n[(w-c)*R,t+1],{c,1}][[2]]\nc5n[w_,5] := w\nV5n[w_,t_]:= V5n[w,t] =\n \ Log[c5n[w,t]] + alpha*V5n[(w-c5n[w,t])*R,t+1]\nV5n[w_,5] := N[Log[w]]\n\ "], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["{V5n[100,3],V5n[100,4],V5n[100,5]}"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {10.53301974475174, 7.800395102855128, 4.605170185988092}\ \>", "\<\ {10.533, 7.8004, 4.60517}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[{ StyleBox["[I tried to compute ", Evaluatable->False, AspectRatioFixed->True], StyleBox["V5n[100,2]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ " but I got tired of waiting for it to finish. I don't think that it \ should take as long as it does; perhaps there is a bug somewhere...]", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Question: ", Evaluatable->False, AspectRatioFixed->True, FontWeight->"Bold"], StyleBox["Why are these the same as V", Evaluatable->False, AspectRatioFixed->True], StyleBox["3n[100,1], V3n[100,2]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" and ", Evaluatable->False, AspectRatioFixed->True], StyleBox["V3n[100,1]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox["?", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Answer"], "Subsubsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ " Because each one measures the value of having wealth of 100 0, 1, and 2 \ periods before the termination date."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["Stochastic numeric dynamic programming"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Of course you can do the stochastic programming numerically too. Here's a \ little example for a 3-period problem."], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "c3ns[w_,t_] := c3ns[w,t] =\n c/.FindMinimum[-Log[c] - \ alpha*(p*V3ns[(w-c)*Ru,t+1]\n \ +(1-p)*V3ns[(w-c)*Rd,t+1]),{c,1}][[2]]\nc3ns[w_,3] := w\nV3ns[w_,t_]:= \ V3ns[w,t] =\n Log[c3ns[w,t]] + alpha*(p*V3ns[(w-c3ns[w,t])*Ru,t+1]\n \ +(1-p)*V3ns[(w-c3ns[w,t])*Rd,t+1])\nV3ns[w_,3] := \ N[Log[w]]\n"], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[ "We compare the symbolic and the numeric calculations. Of course we have \ to provide numeric values for all parameters. (The calculation of ", Evaluatable->False, AspectRatioFixed->True], StyleBox["V3ns[100,1]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" is rather slow.)", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData["Ru=1.5;\nRd=.5;\np=.5;\nalpha=.9;"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["{N[V3s[100,3]],V3s[100,2],V3s[100,1]}"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {4.605170185988092, 7.306019572954479, 9.1502924927245}\ \>", "\<\ {4.60517, 7.30602, 9.15029}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["{V3ns[100,3],V3ns[100,2],V3ns[100,1]}"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {4.605170185988092, 7.30601957295448, 9.14846350560192}\ \>", "\<\ {4.60517, 7.30602, 9.14846}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "This is getting to be a pretty slow calculation. In practice the value \ function for a numerical stochastic dynamic programming function is typically \ approximated by a step function so that interpolation methods can be used to \ find the value function at some points. The best method of interpolation \ will vary from problem to problem. \n\nWe've only investigated problems with \ one state variable, wealth. If there are several state variables the same \ principles apply, but the calculations become unmanageable if there are more \ than 4 or 5 state variables."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]]}, Open]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 640}, {0, 460}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 365}, WindowMargins->{{4, Automatic}, {Automatic, 16}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, Magnification->1.5, MacintoshSystemPageSetup->"\<\ AVU/IFiQKFD000000V8nh09RAj0000000OXQ<097PXP0AP1Y06`0I@1^0642HSkP 0V97`0000001nR4@0TN2R000000000000000009R?^0000000000000000000000 00000000000000000000000000000000\>" ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 79, 2, 70, "Title", Evaluatable->False], Cell[1813, 55, 103, 2, 70, "Subsubtitle", Evaluatable->False], Cell[CellGroupData[{ Cell[1939, 59, 105, 2, 70, "Section", Evaluatable->False], Cell[2047, 63, 1245, 42, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[3315, 107, 95, 2, 70, "Subsection", Evaluatable->False], Cell[CellGroupData[{ Cell[3433, 111, 130, 3, 70, "Input"], Cell[3566, 116, 166, 8, 70, "Output", Evaluatable->False] }, Open ]], Cell[3744, 126, 486, 16, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[4253, 144, 88, 1, 70, "Input"], Cell[4344, 147, 270, 10, 70, "Output", Evaluatable->False] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[4655, 159, 123, 2, 70, "Subsection", Evaluatable->False], Cell[4781, 163, 1468, 48, 70, "Text", Evaluatable->False], Cell[6252, 213, 206, 4, 70, "Input"], Cell[CellGroupData[{ Cell[6481, 219, 99, 1, 70, "Input"], Cell[6583, 222, 833, 25, 70, "Output", Evaluatable->False] }, Open ]] }, Closed]], Cell[CellGroupData[{ Cell[7457, 249, 103, 2, 70, "Subsection", Evaluatable->False], Cell[7563, 253, 253, 5, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[7839, 260, 113, 2, 70, "Input"], Cell[7955, 264, 286, 10, 70, "Output", Evaluatable->False], Cell[8244, 276, 166, 8, 70, "Output", Evaluatable->False] }, Open ]], Cell[8422, 286, 151, 4, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[8596, 292, 103, 1, 70, "Input"], Cell[8702, 295, 223, 10, 70, "Output", Evaluatable->False] }, Open ]], Cell[8937, 307, 212, 4, 70, "Text", Evaluatable->False], Cell[9152, 313, 209, 4, 70, "Input"], Cell[CellGroupData[{ Cell[9384, 319, 103, 1, 70, "Input"], Cell[9490, 322, 307, 11, 70, "Output", Evaluatable->False] }, Open ]], Cell[9809, 335, 162, 4, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[10003, 341, 98, 2, 70, "Subsection", Evaluatable->False], Cell[10104, 345, 1665, 58, 70, "Text", Evaluatable->False], Cell[11772, 405, 222, 4, 70, "Input"], Cell[CellGroupData[{ Cell[12017, 411, 87, 1, 70, "Input"], Cell[12107, 414, 157, 7, 70, "Output", Evaluatable->False], Cell[12267, 423, 157, 7, 70, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[12456, 432, 89, 1, 70, "Input"], Cell[12548, 435, 139, 7, 70, "Output", Evaluatable->False], Cell[12690, 444, 159, 7, 70, "Output", Evaluatable->False] }, Open ]], Cell[12861, 453, 152, 4, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[13045, 459, 110, 2, 70, "Subsection", Evaluatable->False], Cell[13158, 463, 1432, 53, 70, "Text", Evaluatable->False], Cell[14593, 518, 306, 5, 70, "Input"], Cell[14902, 525, 119, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[15044, 529, 141, 3, 70, "Input"], Cell[15188, 534, 223, 10, 70, "Output", Evaluatable->False] }, Open ]], Cell[15423, 546, 508, 17, 70, "Text", Evaluatable->False] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell[15972, 565, 104, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[16099, 569, 94, 2, 70, "Subsection", Evaluatable->False], Cell[16196, 573, 2358, 82, 70, "Text", Evaluatable->False], Cell[18557, 657, 164, 3, 70, "Input"], Cell[18724, 662, 119, 2, 70, "Text", Evaluatable->False], Cell[18846, 666, 160, 3, 70, "Input"], Cell[19009, 671, 129, 3, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[19161, 676, 68, 1, 70, "Input"], Cell[19232, 679, 108, 6, 70, "Output", Evaluatable->False], Cell[19343, 687, 108, 6, 70, "Output", Evaluatable->False] }, Open ]], Cell[19463, 695, 93, 2, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[19579, 699, 87, 1, 70, "Input"], Cell[19669, 702, 186, 8, 70, "Output", Evaluatable->False] }, Open ]], Cell[19867, 712, 136, 3, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[20026, 717, 87, 1, 70, "Input"], Cell[20116, 720, 187, 8, 70, "Output", Evaluatable->False] }, Open ]], Cell[20315, 730, 151, 4, 70, "Text", Evaluatable->False], Cell[20469, 736, 274, 5, 70, "Input"], Cell[CellGroupData[{ Cell[20766, 743, 87, 1, 70, "Input"], Cell[20856, 746, 186, 8, 70, "Output", Evaluatable->False] }, Open ]], Cell[21054, 756, 501, 16, 70, "Text", Evaluatable->False], Cell[21558, 774, 684, 26, 70, "Text", Evaluatable->False], Cell[CellGroupData[{ Cell[22265, 802, 89, 2, 70, "Subsubsection", Evaluatable->False], Cell[22357, 806, 186, 4, 70, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[22584, 812, 118, 2, 70, "Subsection", Evaluatable->False], Cell[22705, 816, 190, 4, 70, "Text", Evaluatable->False], Cell[22898, 822, 400, 7, 70, "Input"], Cell[23301, 831, 502, 16, 70, "Text", Evaluatable->False], Cell[23806, 849, 86, 1, 70, "Input"], Cell[CellGroupData[{ Cell[23915, 852, 90, 1, 70, "Input"], Cell[24008, 855, 186, 8, 70, "Output", Evaluatable->False] }, Open ]], Cell[CellGroupData[{ Cell[24226, 865, 90, 1, 70, "Input"], Cell[24319, 868, 186, 8, 70, "Output", Evaluatable->False] }, Open ]], Cell[24517, 878, 648, 10, 70, "Text", Evaluatable->False] }, Closed]] }, Open ]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)