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/