Memoized functions are functions which remember values they have found.
Look in the doc center for some background on this in Mathematica, if necessary.
Suppose you have the following definition
f[0] = f[1] = 1
f[x_] := f[x] = f[x - 1] + f[x - 2]
in one of your packages. A user may load the package and start asking right away f[1000].
This will trigger a $RecursionLimit::reclim error message and abort.
Even if the user then tries something smaller, say f[20], by now the definition of f is corrupt and the result is not good anymore.Of course the package developer might increase the recursion limit and warn the user, but my question is:
How can you improve the f definition so that if the user asks for f[1000] he/she gets the answer without any problem? I am interested in a way to trap the user input, analyze it and take whatever steps are necessary to evaluate f[1000].
I can easily imagine that one can change the recursion limit if the input is more than 255 (and then bring it back to the original level), but what I would really like to see is, if there is a way for the f to find out how many values it "knows" (fknownvalues) and accept any input <=fknownvalues+$RecursionLimit without problems or increase the $RecursionLimit if the input is higher.
Thank you for your help
Here is the code assuming that you can determine a value of $RecursionLimit from the value of the input argument:
Clear[f];
Module[{ff},
ff[0] = ff[1] = 1;
ff[x_] := ff[x] = ff[x - 1] + ff[x - 2];
f[x_Integer] :=f[x] =
Block[{$RecursionLimit = x + 5},
ff[x]
]]
I am using a local function ff to do the main work, while f just calls it wrapped in Block with a proper value for $RecursionLimit:
In[1552]:= f[1000]
Out[1552]= 7033036771142281582183525487718354977018126983635873274260490508715453711819693357974224
9494562611733487750449241765991088186363265450223647106012053374121273867339111198139373125
598767690091902245245323403501
EDIT
If you want to be more precise with the setting of $RecursionLimit, you can modify the part of the code above as:
f[x_Integer] :=
f[x] =
Block[{$RecursionLimit = x - Length[DownValues[ff]] + 10},
Print["Current $RecursionLimit: ", $RecursionLimit];
ff[x]]]
The Print statement is here for illustration. The value 10 is rather arbitrary - to get a lower bound on it, one has to compute the necessary depth of recursion, and take into account that the number of known results is Length[DownValues[ff]] - 2 (since ff has 2 general definitions). Here is some usage:
In[1567]:= f[500]//Short
During evaluation of In[1567]:= Current $RecursionLimit: 507
Out[1567]//Short= 22559151616193633087251269<<53>>83405015987052796968498626
In[1568]:= f[800]//Short
During evaluation of In[1568]:= Current $RecursionLimit: 308
Out[1568]//Short= 11210238130165701975392213<<116>>44406006693244742562963426
If you also want to limit the maximal $RecursionLimit possible, this is also easy to do, along the same lines. Here, for example, we will limit it to 10000 (again, this goes inside Module):
f::tooLarge =
"The parameter value `1` is too large for single recursive step. \
Try building the result incrementally";
f[x_Integer] :=
With[{reclim = x - Length[DownValues[ff]] + 10},
(f[x] =
Block[{$RecursionLimit = reclim },
Print["Current $RecursionLimit: ", $RecursionLimit];
ff[x]]) /; reclim < 10000];
f[x_Integer] := "" /; Message[f::tooLarge, x]]
For example:
In[1581]:= f[11000]//Short
During evaluation of In[1581]:= f::tooLarge: The parameter value 11000 is too
large for single recursive step. Try building the result incrementally
Out[1581]//Short= f[11000]
In[1582]:=
f[9000];
f[11000]//Short
During evaluation of In[1582]:= Current $RecursionLimit: 9007
During evaluation of In[1582]:= Current $RecursionLimit: 2008
Out[1583]//Short= 5291092912053548874786829<<2248>>91481844337702018068766626
A slight modification on Leonid's code. I guess I should post it as a comment, but the lack of comment formatting makes it impossible.
Self adaptive Recursion Limit
Clear[f];
$RecursionLimit = 20;
Module[{ff},
ff[0] = ff[1] = 1;
ff[x_] :=
ff[x] = Block[{$RecursionLimit = $RecursionLimit + 2}, ff[x - 1] + ff[x - 2]];
f[x_Integer] := f[x] = ff[x]]
f[30]
(*
-> 1346269
*)
$RecursionLimit
(*
-> 20
*)
Edit
Trying to set $RecursionLimit sparsely:
Clear[f];
$RecursionLimit = 20;
Module[{ff}, ff[0] = ff[1] = 1;
ff[x_] := ff[x] =
Block[{$RecursionLimit =
If[Length#Stack[] > $RecursionLimit - 5, $RecursionLimit + 5, $RecursionLimit]},
ff[x - 1] + ff[x - 2]];
f[x_Integer] := f[x] = ff[x]]
Not sure how useful it is ...
Related
I am a very novice Mathematica user and still can't get my head around its evaluation control, all possible constructs related to it (e.g. Hold, Unevaluated, etc.) and how they work, despite the thorough documentation and the numerous StackExchange and StackOverflow questions discussing this topic. So, apologies for any possible duplicates.
My use case is the following: I have a function (say f) defined by thousands of rules and patterns (DownValues). I want to start from an unrolled representation of f[expr] (for some expr) and get the result of applying a single, particular rule to f[expr]. I want the result to stay unrolled as well.
As a particular example, suppose we have the following:
In[1]: nat[0] := 0
In[2]: nat[n_] := 1 + nat[n - 1]
In[3]: DownValues[nat]
Out[3]: {HoldPattern[nat[0]] :> 0, HoldPattern[nat[n_]] :> 1 + nat[n - 1]}
In[4]: nat[10]
Out[4]: 10
Now, I want to start from an expression represented as nat[10] (unevaluated!) and want to specifically apply the second rule (HoldPattern[nat[n_]] :> 1 + nat[n - 1]) to obtain the expression in the form of 1 + nat[9]. Analogously, shall I wish to apply the first rule (HoldPattern[nat[0]] :> 0), I would expect the result to stay unchanged in its original form, i.e. nat[10].
Thank you for your help!
This should help with your understanding of Mathematica's method of operation.
Wolfram reference : The Ordering of Definitions
I.e. Mathematica "looks for the value of an expression of the form f[n], it tries the special case f[1] first, and only if this does not apply, it tries the general case f[n_]."
So with the functions below nat[0] is always tried first, but of course it only evaluates if the argument is 0. Then nat[n_] is tried.
nat[0] := 0
nat[n_] := 1 + nat[n - 1]
For your question as to obtaining 1 + nat[9] here is one way
Clear[nat]
nat[0] := 0
nat[n_] := HoldForm[1 + nat[o]] /. o -> n - 1
ans = nat[10]
1 + nat[9]
Do[ans = ReleaseHold[ans], 10]
ans
10
Alternatively (and better)
Clear[nat]
nat[0] := 0
nat[n_] := With[{m = n - 1}, HoldForm[1 + nat[m]]]
ans = nat[10]
1 + nat[9]
Do[ans = ReleaseHold[ans], 9]
ans
9 + (1 + nat[0])
Note this is the result after 10 iterations. The final ReleaseHold results in nat[0] evaluating to 0.
ReleaseHold[ans]
10
You might find it easier to see what is happening if you use Hold instead of HoldForm in the above demonstration.
As posted as a reply in a parallel discussion in Mathematica's StackExchange, I found a relatively more direct and straightforward way of dealing with the problem:
In[6] rules = DownValues[nat]
Out[6] {HoldPattern[nat[0]] :> 0, HoldPattern[nat[n_]] :> 1 + nat[n - 1]}
In[7] DownValues[nat] = {}
Out[7] {}
In[8] nat[10]
Out[8] nat[10]
In[9] nat[10] /. rules[[1]]
Out[9] nat[10]
In[10] nat[10] /. rules[[2]]
Out[10] 1 + nat[9]
Solving a complicated formula f(u,v)==0, where
I assign some constant value to u and then solve v.
I can solve it without for-loop, but encounter errors by adding For[] enclosing the codes,
where saying
Set::write: Tag Times in "Solve[] with exact coefficients solns is Protected.
A simple example to illustrate my idea:
For[ i = 1, i < 5, i++,
f = x^2 + y^2 - 10;
x = i;
eqn = (f == 0);
soln = Solve[eqn, y]
]
will get error:
Set::write: "Tag Times in (-9+y^2) is Protected."
Only when I add For[ ] at the outside of the code
(inner 4-line code works fine without for loop)
So it seems that there is an variable assignment permission issue in the for loop
How can I avoid it?
I no longer have Mathematica 7 installed, and your code runs (although with no printed output...) on Mathematica 10. Based on the error message, it sounds like you need to Clear[f] before trying to reassign it.
For[i = 1, i < 5, i++,
Clear[f];
f = x^2 + y^2 - 10;
x = i;
eqn = (f == 0);
soln = Solve[eqn, y];
Print[soln]
]
However, you're still really mixing things up. Consider what happens with your code as the loop executes. First it starts with i=1 and says:
Clear[f] -- or don't, this isn't the only issue
f = x^2 + y^2 - 10 -- This gives me an expression with symbols x and y
x=i -- This sets x=1 since i=1 already
At this point, the expression for f has become y^2 - 9`. Next time it comes around, it will repeat:
f = x^2 + y^2 - 10 -- But x is no longer a symbol!! So now it still treats x=1...
This becomes a nightmare. I could try to hack your code into working with the fewest changes (e.g. make it Clear[f,x] or something), but that's not really the best advice I can give.
A better overall construction would be something like:
Eqn[x_,y_]=(x^2+y^2-10==0);
For[i=1,i<5,i++,
Print[Solve[Eqn[i,y],y]];
];
Your function f is a function, so you should make it a function like f[x_,y_]=something. Better yet, just make the entire equation into a function as above. That way, you never actually modify the values of x or y and don't get caught with issues in your loop.
And before you use this new code I've given you, clear everything or just quit the Kernel.
I am using usual for-loop for computation in Mathematica:
For[i=1,i<n+1,i++, ...calculation... ]
For each i I need to define a function F_i[x_,y_]:=.... Here "i" is suuposed to be a label of the function. This is however not the corrcet Mathematica expression.
The question is, how to define multiple functions distinguished by the label i? I mean, what is the correct syntax?
Thanks a lot.
I'm not exactly sure what you are trying to do, but I have some confidence that the for loop is not the way to go in Mathematica. Mathematica already has pattern matching that likely eliminates the need for the loop.
What about something like this
f[i_][x_,y_]:= i(x+y)
or something like this
f[s_String][x_,y_]:=StringLength[s](x+y)
or even
f[s_,x_,y_]:=StringLength[s](x+y)
Here are some steps which may help. There are two versions below, the second one includes the value of i on the RHS of the function definition.
n = 2;
For[i = 1, i < n + 1, i++,
f[i][x_, y_] := (x + y)*i]
?f
Global`f
f[1][x_,y_] := (x+y) i
f[2][x_,y_] := (x+y) i
Clear[i]
f[2][2, 3]
5 i
Quit[]
n = 2;
For[i = 1, i < n + 1, i++,
With[{j = i},
f[i][x_, y_] := (x + y)*j]]
?f
Global`f
f[1][x$,y$] := (x$+y$) 1
f[2][x$,y$] := (x$+y$) 2
Clear[i]
f[2][2, 3]
10
Background. I want to print a table of convergents for 31^(1/2). I made the following recursive definition of the table. ( Exchange 31^(1/2) with the golden ratio and the table below would contain the Fibonacci series ).
cf := ContinuedFraction
tf := TableForm
p[-1] = 0; p[0] = 1; q[-1] = 1; q[0] = 0;
a[k_] := cf[Sqrt[31], k][[k]]
p[k_] := a[k]*p[k - 1] + p[k - 2]
q[k_] := a[k]*q[k - 1] + q[k - 2]
s[n_] := Timing[Table[{k, a[k], p[k], q[k]}, {k, 8, 8 n, 8}]] // tf
Timing increases exponentially fast. I had to alt+. (abort) for s[4].
Question: How to improve ( mathematica ) performance when dealing with recursive functions?
From a quick (not thorough, to admit it) look at your code, it looks like both p and q are defined recursively in terms of two previous values. This means that to calculate the nth value of p, ~2^n evaluations are needed (every step doubles the number). So yes, complexity is exponential, regardless of Mathematica or any other language being used.
If you insist on using a recursive formulation of the problem (e.g. for simplicity), then the simplest way to reduce the performance penalty is using memoization, i.e. doing something like
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
Don't forget to Clear[p] before any redefinition.
In short, memoization means having the function remember the computation result for each input, so subsequent evaluations are faster. It's very likely faster, but more complicated, to compute two values (p_(n+1) and p_(n)) from two previous values (p_(n) and p_(n-1)), then the complexity will be linear instead of exponential.
I hope this helps. I don't have Mathematica here to test right now.
Here is a small further refinement. Since this is a quadratic irrational you can also compute the a[k] coefficients more directly.
In[499]:= Clear[a, p, q, cf]
cf = ContinuedFraction[Sqrt[31]];
cf2len = Length[cf[[2]]];
a[1] = cf[[1]];
a[k_] := cf[[2, Mod[k - 1, cf2len, 1]]]
p[-1] = 0; p[0] = 1; q[-1] = 1; q[0] = 0;
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
q[k_] := q[k] = a[k]*q[k - 1] + q[k - 2]
s[n_] := Timing[Table[{k, a[k], p[k], q[k]}, {k, 8, 8 n, 8}];]
In[508]:= s[1000]
Out[508]= {0.12, Null}
In[509]:= Clear[a, p, q, cf]
cf := ContinuedFraction
p[-1] = 0; p[0] = 1; q[-1] = 1; q[0] = 0;
a[k_] := a[k] = cf[Sqrt[31], k][[k]]
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
q[k_] := q[k] = a[k]*q[k - 1] + q[k - 2]
s[n_] := Timing[Table[{k, a[k], p[k], q[k]}, {k, 8, 8 n, 8}];]
In[516]:= s[1000]
Out[516]= {6.08, Null}
Also you can get a[k] in closed form, though it is not terribly pretty.
In[586]:= Clear[a];
asoln[k_] =
FullSimplify[
a[k] /. First[
RSolve[Join[
Table[a[k] == cf[[2, Mod[k - 1, cf2len, 1]]], {k,
cf2len}], {a[k] == a[k - 8]}], a[k], k]], Assumptions -> k > 0]
Out[587]= (1/(8*Sqrt[2]))*(4*(Cos[(k*Pi)/4] + Sin[(k*Pi)/4])*
(-2*Sqrt[2] + (5 + 2*Sqrt[2])*Sin[(k*Pi)/2]) +
Sqrt[2]*(25 - 9*Cos[k*Pi] + 26*Sin[(k*Pi)/2] - 9*I*Sin[k*Pi]))
Offhand I do not know whether this can be used to get a direct solution for p[k] and q[k]. RSolve seems unable to do that.
--- edit ---
As others have mentioned, it can be cleaner to just build the list from first to last. Here is the handling of p[k], using memoization as above vs NestList.
Clear[a, p, q, cf]
cf = ContinuedFraction[Sqrt[31]];
cf2len = Length[cf[[2]]];
a[1] = cf[[1]];
a[k_] := cf[[2, Mod[k - 1, cf2len, 1]]]
p[-1] = 0; p[0] = 1;
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
s[n_] := Timing[Table[p[k], {k, n}];]
In[10]:= s[100000]
Out[10]= {1.64, Null}
In[153]:= s2[n_] := Timing[ll = Module[{k = 0},
NestList[(k++; {#[[2]], a[k]*#[[2]] + #[[1]]}) &, {0, 1},
n]][[All, 2]];]
In[154]:= s2[100000]
Out[154]= {0.78, Null}
In addition to being somewhat faster, this second approach does not keep a large number of definitions around. And you do not really need them in order to generate more elements, because this iteration can be resumed using a pair from the last elements (make sure they start at 0 and 1 modulo 8).
I will mention that one can obtain a closed form for p[k]. I found it convenient to break the solution into 8 (that is, cf2len) pieces and link them via recurrences. The reasoning behind the scenes comes from basic generating function manipulation. I did some slightly special handling of one equation and one initial condition to finesse the fact that a[1] is not part of the repeating sequence.
In[194]:= func = Array[f, cf2len];
args = Through[func[n]];
firsteqns = {f[2][n] == a[2]*f[1][n] + f[cf2len][n - 1],
f[1][n] == a[9]*f[cf2len][n - 1] + f[cf2len - 1][n - 1]};
resteqns =
Table[f[j][n] == a[j]*f[j - 1][n] + f[j - 2][n], {j, 3, cf2len}];
inits = {f[8][0] == 1, f[1][1] == 5};
eqns = Join[firsteqns, resteqns, inits];
In[200]:=
soln = FullSimplify[args /. First[RSolve[eqns, args, n]],
Assumptions -> n > 0];
In[201]:= FullSimplify[Table[soln, {n, 1, 3}]]
Out[201]= {{5, 6, 11, 39, 206, 657, 863, 1520}, {16063, 17583, 33646,
118521, 626251, 1997274, 2623525, 4620799}, {48831515, 53452314,
102283829, 360303801, 1903802834, 6071712303, 7975515137,
14047227440}}
Quick check:
In[167]:= s2[16]; ll
Out[167]= {1, 5, 6, 11, 39, 206, 657, 863, 1520, 16063, 17583, 33646, \
118521, 626251, 1997274, 2623525, 4620799}
We can now define a function from this.
In[165]:=
p2[k_Integer] := soln[[Mod[k, cf2len, 1]]] /. n -> Ceiling[k/cf2len]
In[166]:= Simplify[p2[4]]
Out[166]= 39
I do not claim that this is particularly useful, just wanted to see if I could actually get something to work.
--- end edit ---
Daniel Lichtblau
A recent SO question reminded me of some code I tried to write a while back. The aim is to make a CircularSlider[] object that can be used for angle-like variables in dynamic objects.
The framework for my solution (below) comes from the ValueThumbSlider[] defined in the Advanced Manipulate Functionality tutorial. The main difference is that in ValueThumbSlider[] the value of the slider and the position of the LocatorPlane[] are the same thing, whilst in my CircularSlider[] they are not - and this leads to problems.
The first problem is that moving the Locator will not change the slider value. This is fixed by using the 2nd argument in the Dynamic: (x = #/Abs[Complex ## #]) &.
This in turn leads to the problem that if you externally set the value of the slider (t) from outside, it will immediately revert to its previous value. This is fixed by keeping the old value (t0) and comparing to t. If they don't match then it's assumed that t has changed and so the Locator position x is updated to its new position.
CircularSlider[t_] := CircularSlider[t, {0, 1}];
CircularSlider[Dynamic[t_], {min_, max_}] /; max > min :=
With[{d = (max - min)/(2. Pi)},
DynamicModule[{td = t/d, x, t0}, x = {Cos[td], Sin[td]};
LocatorPane[
Dynamic[If[!NumberQ[t], t = min; x = {Cos[td], Sin[td]}];
If[t != t0, t0 = t; x = {Cos[td], Sin[td]}];
t = Mod[Arg[Complex ## x] d, max, min]; t0 = t;
x, (x = #/Abs[Complex ## #]) &],
Graphics[{AbsoluteThickness[1.5], Circle[],
Dynamic[{Text[NumberForm[t, {3, 2}], {0, 0}]}]}],
ImageSize -> Small]]]
So my question is: can someone make this work with out the above kludges?
As for problem#1, I wouldn't consider the use of the second argument to Dynamic as a kludge -- that is what the second argument is for. Therefore, I don't have an alternative solution for that one.
Problem #2 can be avoided if you refrain from assigning t in the first argument to Dynamic.
With this in mind, here is another implementation:
CircularSlider2[Dynamic[t_], r:{min_, max_}:{0, 1}] :=
DynamicModule[{scale, toXY, fromXY},
scale = (max - min) / (2. Pi);
toXY[a_?NumberQ] := Through#{Cos, Sin}[a / scale];
toXY[a_] := {1, 0};
fromXY[{x_, y_}] := Mod[Arg[x + I y] scale, max, min];
LocatorPane[
Dynamic[toXY[t], (t = fromXY[#])&],
Graphics[{
AbsoluteThickness[1.5], Circle[],
Dynamic[{Text[NumberForm[t, {3,2}], {0, 0}]}]
}],
ImageSize -> Small
]
]
The only material difference between this version and the original version is that the first argument to Dynamic is an expresssion that is free of side-effects.
Edit
I just stumbled across this undocumented experimental feature in Mathematica 8:
DynamicModule[{x = RandomReal[{0, 50}]},
{Experimental`AngularSlider[Dynamic#x], Dynamic#x}
]