Skip to main content

memoization - How to memoize a function with Options?


Consider the following modified fibonacci function:


tempHist = $History
$History = 0

ClearAll[fibon]
Options[fibon] = {k -> 1}
fibon[0] = 0;
fibon[1] = 1;
fibon[n_, OptionsPattern[]]:= fibon[n-1] + OptionValue[k] * fibon[n-2]

fibon[30] // Timing (* {4.111894, 832040} *)
fibon[30, k -> 2] // Timing (* {4.161676, 1149851} *)

The modification involves a coefficent that multiplies the second term of the recursive definition. Can the idiom f[x_]:=f[x]= ... be used to implement memoization in this case?



I tried with no luck the following naive approaches for c-aching fibon


ClearAll[cfibon]
Options[cfibon] = {k -> 1}
cfibon[0] = 0;
cfibon[1] = 1;
cfibon[n_, OptionsPattern[]]:= cfibon[n, OptionsPattern[]] = cfibon[n-1] + OptionValue[k] * cfibon[n-2]

cfibon[30] // Timing (* {2.1999999997746045*^-5, 832040} *)
cfibon[30, k -> 2] // Timing (* {2.899999999961267*^-5, 832040} *)


Something is being memoized, but this is not the wanted behavior (note that the two calls return the same value 832040, the second call is meant return 1149851). Here is another try:


ClearAll[cfibon]
Options[cfibon] = {k -> 1}
cfibon[0] = 0;
cfibon[1] = 1;
cfibon[n_, OptionsPattern[]]:= cfibon[n, k -> OptionValue[k]] = cfibon[n-1] + OptionValue[k] * cfibon[n-2]

cfibon[30] // Timing
(* {10.664260999999998, 832040} *)


cfibon[30, k -> 2] // Timing
(* {10.677505, 1149851} *)

Now, the results are as expected, by the computation is slower than the non-cached version! So...


How to memoize a function with Options?



Answer



The case at hand


Here is one possibility:


ClearAll[fibon]
Options[fibon] = {k -> 1}

fibon[0, OptionsPattern[]] = 0;
fibon[1, OptionsPattern[]] = 1;

fibon[n_, opts : OptionsPattern[]] /; ! OrderedQ[{opts}] :=
fibon[n, Sequence @@ Sort[{opts}]];
fibon[n_, opts : OptionsPattern[]] :=
fibon[n, opts] =
fibon[n - 1, opts] + OptionValue[k]*fibon[n - 2, opts]

So, for example:



fibon[30]

(* 832040 *)

fibon[30,k->2]

(* 357913941 *)

Note that I added a rule which sorts the options, and I explicitly assumed the two sets of options the same when they are only different by the order of options. This assumption could be improved by accounting for some options not present explicitly but being the same due to defaults.


General meta-programming solution



The above version has the following limitations:



  • Default option values not accounted for

  • Has to explicitly pass the options to inner calls to self

  • It is not general enough (which is ok for a specific problem, but not for a general approach). Although one can see that some of the code does not really depend on the specifics of the problem, the above form does not allow one to easily factor that out.


Here I will address these limitations of the previous version, and show how we can achieve a fairly complete automation of this task for a wide class of problems by using meta-programming and code generation.


Here is a code-generating function that would generate the full memoizing code from simpler version not involving options:


ClearAll[optionMemo];
SetAttributes[optionMemo, HoldAll];

optionMemo[sym_Symbol, {defs___}, defOptions : {___?OptionQ}] :=
Module[{},
ClearAll[sym];
Options[sym] = defOptions;
sym[args : Except[_?OptionQ] ..., opts : OptionsPattern[]] :=
With[{
newopts =
Sort @ DeleteDuplicates[
{opts}~Join~Options[sym],
First@#1 == First@#2 &]

},
sym[args, Sequence @@ newopts] /; newopts =!= {opts}
];
sym[args : Except[_?OptionQ] ..., opts : OptionsPattern[]]/;!OrderedQ[{opts}] :=
sym[args, Sequence @@ Sort[{opts}]];

sym[args : Except[_?OptionQ] ..., opts : OptionsPattern[]] :=
Block[{sym, options = Options[sym]},
Options[sym] = options;
defs;

sym[args]
]
];

It takes the name of the symbol, the list of code statements which produce the relevant definitions, and the list of options for this symbol. It works by generating the boilerplate code, but also it relies on a rather interesting technique where a function Block-s itself and creates some definitions locally inside Block. What we buy by this construct here:



  • We don't have to pass options to inner recursive calls

  • We can still globally call OptionVaulue as before, with a single argument, and this will work.

  • The memoization only happens during the computation, to speed it up, but all the memoized values are cleared by Block at the end, automatically;



So, here is how we use it: first generate the boilerplate code


optionMemo[
fibon,
{
fibon[0] = 0,
fibon[1] = 1,
fibon[m_] := fibon[m] = fibon[m - 1] + OptionValue[k]*fibon[m - 2]
},
{k -> 1, i -> 2}
]


and now use it as before:


fibon[30]

(* 832040 *)

fibon[30,k->2]

(* 357913941 *)


The optionMemo construct should be general enough to handle many similar problems.


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

list manipulation - Selecting multiple columns from a matrix?

Sample data: data = { {{2013, 1, 1}, 24.13, 167.67, 231.82}, {{2013, 1, 2}, 32.15, 170.92, 225.99}, {{2013, 1, 3}, 35.43, 172.68, 221.67}, {{2013, 1, 4}, 36.73, 173.05, 218.32}, {{2013, 1, 5}, 58.19, 165.96, 197.05}, {{2013, 1, 6}, 69.99, 163.50, 187.52}, {{2013, 1, 7}, 71.37, 154.21, 175.58}, {{2013, 1, 8}, 72.51, 149.66, 163.25}}; I want a DateListPlot with three graphs, so for a matrix formed by columns 1 and 2, one for columns 1 and 3, and 1 for columns 1 and 4. At the moment I'm using this code: data2 = Transpose[{data[[All, 1]], data[[All, 2]]}]; data3 = Transpose[{data[[All, 1]], data[[All, 3]]}]; data4 = Transpose[{data[[All, 1]], data[[All, 4]]}]; DateListPlot[{data2, data3, data4}, Joined -> True, Filling -> {3 -> {1}}] but I have a hunch that this can be done more efficiently. I don't like the Transpose s in particular. Any ideas? edit (for extra credit) What if I need to multiply the second column by 2, which in my solution is simp...

plotting - How to draw some 2D curves in a 3D plot?

I want to plot several 2D curves ( Sin[x] at y=0 , Cos[x] at y=1 ) in a 3D plot, what function should i use? f[x_, y_] := Piecewise[{{0, y 0}, {Sin[x], y == 0}}] g[x_, y_] := Piecewise[{{0, y 1}, {Cos[x], y == 1}}] Plot3D[{f[x, y], g[x, y]}, {x, 0, 10}, {y, 0, 10}] doesn't work. Any ideas? Answer ParametricPlot3D[{{Sin[u], 0, u}, {Cos[u], 1, u}}, {u, 0, 20}, BoxRatios -> 1, PlotRange -> {{-2, 2}, {-.5, 2}, {0, 20}}] === update - general thoughts === I've seen the comments to this question and a few other approaches to the waterfall (or wire) plot are given in this question: Plotting several functions . Also I cannot not mention one of my favorite Mathematica blogs - Archery with this post on the story of discovery of 1st pulsar and an its infamous graphics - code is given in the post: