Re: problem with very slow matrix function

• To: mathgroup at smc.vnet.net
• Subject: [mg50943] Re: problem with very slow matrix function
• From: drbob at bigfoot.com (Bobby R. Treat)
• Date: Wed, 29 Sep 2004 03:15:04 -0400 (EDT)
• References: <cj86j8\$782\$1@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```A simple dynamic programming trick speeds this up by about 1,000 to one:

digits=19;
M={{0,1},{1,1}};
Det[M];
Clear[a,b]
a[n_]:=If[Max@Eigenvalues@a[n-1]<12,M.a[n-1],a[Floor[(n-1)/2]]];
a[0]:={{0,1},{1,1}};
b[n_]:=b[n]=If[Max@Eigenvalues@b[n-1]<12,M.b[n-1],b[Floor[(n-1)/2]]];
b[0]:={{0,1},{1,1}};
Timing[c=Flatten[Table[a[n],{n,0,digits}]]]
Timing[d=Flatten[Table[b[n],{n,0,digits}]]]
c==d
First@%%%/First@%%

{17.437 Second,{0,1,1,1,1,1,1,
2,1,2,2,3,2,3,3,5,3,5,5,8,5,8,8,13,1,2,2,3,2,3,3,5,3,5,5,8,5,8,8,13,3,5,5,
8,5,8,8,13,5,8,8,13,1,2,2,3,2,3,3,5,3,5,5,8,5,8,8,13,3,5,5,8,5,8,8,13,5,8,
8,13}}

{0.016 Second,{0,1,1,1,1,1,1,2,1,2,2,3,2,3,3,5,3,5,5,8,5,8,8,13,1,2,2,3,2,3,3,
5,3,5,5,8,5,8,8,13,3,5,5,8,5,8,8,13,5,8,8,13,1,2,2,3,2,3,3,5,3,5,5,8,5,8,
8,13,3,5,5,8,5,8,8,13,5,8,8,13}}

True

1089.81

Bobby

Roger Bagula <tftn at earthlink.net> wrote in message news:<cj86j8\$782\$1 at smc.vnet.net>...
> Mathematica will do this function, but only very slowly...
> Thsat limits the number of values and how big I can make my critical point.
> I'd like a better , faster expression to do this kind of matrix
> switching function.
> I'm also looking for a way to make the switch depend on a random
> level as well (&& / And).
> I tried a version and it ignorred the second "and" implicit
> and did it on only the first implicit expression.
> As I want to do this on higher matrix level Bonacci/ Pisot
> systems, I would appreciate any help.
>
> (*  2by2 Markov sequence Critical Eigenvalue collapse of   golden mean*)
> digits=19
> M={{0,1},{1,1}}
> Det[M]
> A[n_]:=If[(Max[Eigenvalues[A[n-1]]])<12, M.A[n-1],A[Floor[(n-1)/2]]];
> A[0]:={{0,1},{1,1}};
> (* Critical Eigenvalue collapse at 12 of 2by2 matrices made with  golden
> mean  recurrence*)
> b=Flatten[Table[A[n],{n,0,digits}]]
> ListPlot[b,PlotJoined->True,PlotRange->All]
>
> {0,1,1,1,1,1,1,2,1,2,2,3,2,3,3,5,3,5,5,8,5,8,8,13,1,2,2,3,2,3,3,5,3,5,5,8,5,8,
>
> 8,13,3,5,5,8,5,8,8,13,5,8,8,13,1,2,2,3,2,3,3,5,3,5,5,8,5,8,8,13,3,5,5,8,5,8,
>   8,13,5,8,8,13}
> Respectfully, Roger L. Bagula
>