By using dynamical programming, we can save intermediate steps for recursive relations, as in
f[n_]:= f[n] = f[n-1] + f[n-2]
However, this only stores definitions for explicit values of n
. But I need to be able to store function definitions, where the number of parameters of the function depends on each step. More specifically, I have something like
$$
t^{a_1 \cdots a_n} = A \, t^{a_1 \cdots a_{n-2}} + B \, t^{a_2 \cdots a_n} \\
t^a = C^a \\
t^{ab} = D^{ab}
$$
Where all $a_i$ are indices with unspecified values. This recursive definition allows me to express any $t^{a_1 \cdots a_n}$ as a combination of $C$'s and $D$'s. It's easy to implement this in mathematica:
t[a_]:= c[a]
t[a_,b_]:= d[a,b]
t[a__]:= A t@@Most[Most[{a}]] + B t@@Rest[{a}]
but for high $n$, calculation times become very long (and especially because my function is a bit more complicated than this). This is where we normally would use dynamic programming, something like:
t[a__]:= t[a] = A t@@Most[Most[{a}]] + B t@@Rest[{a}]
but this is not what we need, because if I execute
t[a,b,c]
it only makes a definition for a
, b
and c
literally, meaning that t[b,a,c]
will have to be recalculated recursively. This is because it is stored as Set
, and not a SetDelayed
:
t[a,b,c] = A c[a] + B d[b,c]
What I would need is some kind of magic dynamic programming that stores function definitions as in
t[a__]:= Magic.... =A t@@Most[Most[{a}]] + B t@@Rest[{a}]
such that when I execute
t[a,b,c]
it stores
t[a_,b_,c_] := A c[a] + B d[b,c]
etcetera.
I've looked into Leonid's answer for this question, but I can't easily see how to adapt it for a growing number of arguments.
Any ideas? Many thanks in advance!
EDIT
Thanks to Leonid's answer, I now understand a bit how this can be solved. Unfortunately, the way I'd need it, is a bit more complicated. I have several function definitions, with Condition
, PatternTest
, Optional
and next to the recursive ('growing') variables I also have some that aren't.
At first I thought I'd figure it out myself based on Leonid's answer (hence the accept), but I didn't. The idea is to make a wrapper memoize
, which I wrap around my function definition such that it memorises the function definitions. An example in pseudocode:
memoize[
t[dot[a__], b_?EvenQ, c_:1]/;b!=c := .... some recursive function of t ...
]
The first thing I tried is to retrieve all patternames, and replace them with Unique[]
ones:
ClearAll@memoize
SetAttributes[memoize, HoldAllComplete]
memoize[expr_SetDelayed] :=
(* first we retrieve the lhs and rhs *)
With[{funcLHS = Hold[expr] /. Hold[SetDelayed[x_, y_]] :> Hold[x] ,
funcRHS = Hold[expr] /. Hold[SetDelayed[x_, y_]] :> Hold[y]},
(* next we retrieve the names of the patterns used *)
With[{patternNames = First /@ Cases[funcLHS, _Pattern, Infinity]},
(* we make some locally scoped patterns *)
With[{varsExt = Table[Unique[], {Length[patternNames]}]},
(* and we express the lhs and rhs in function of the former locally scoped patterns *)
With[{lhs = funcLHS /. Rule @@@ Transpose[{patternNames, varsExt}],
rhs = funcRHS /. Rule @@@ Transpose[{patternNames, varsExt}]},
{lhs,rhs}/.{Hold[x_],Hold[y_]}:>SetDelayed[x,y]
]]]]
And this works, but it doesn't do anything useful. Now I would need to replace the central part with Leonid's answer somehow, which means I have to inject vars
into lhs
and rhs
, with the additional difficulty that Length[vars]
won't equal Length[varsExt]
. So this is what I tried:
ClearAll@memoize
SetAttributes[memoize, HoldAllComplete]
memoize[expr_SetDelayed] :=
With[{funcLHS = Hold[expr] /. Hold[SetDelayed[x_, y_]] :> Hold[x] ,
funcRHS = Hold[expr] /. Hold[SetDelayed[x_, y_]] :> Hold[y]},
With[{patternNames = First /@ Cases[funcLHS, _Pattern, Infinity]},
With[{varsExt = Table[Unique[], {Length[patternNames]}]},
With[{lhs = funcLHS /. Rule @@@ Transpose[{patternNames, varsExt}],
rhs = funcRHS /. Rule @@@ Transpose[{patternNames, varsExt}]},
{lhs, Hold[
With[{vars = Table[Unique[], {Length[{#}]}] & /@ varsExt},
With[{pts = (Pattern[#1, _] &) /@ vars},
{lhs/.MapThread[ Pattern[#1, _] -> Sequence @@ (Function[x, Pattern[x, _]] /@ #2) & , {varsExt, vars} ]
,
rhs/.MapThread[ #1 -> Sequence @@ #2 & , {varsExt, vars} ]
}/.{Hold[x_],Hold[y_]}:>Set[x,y] ;
lhs/.x_Pattern:>x[[1]]
]]]
} /. {Hold[x_], Hold[y_]} :> SetDelayed[x, y]
]]]]
But the pattern replacing on lhs
doesn't work, and it doesn't take care of Condition
, Optional
and PatternTest
. So I'm totally stuck, although I have the feeling that it's only a few changes to make it work..