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
>
> tftn at earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
> URL : http://home.earthlink.net/~tftn
> URL : http://victorian.fortunecity.com/carmelita/435/