neat sums and pattered randomness
- To: mathgroup at smc.vnet.net
- Subject: [mg52236] neat sums and pattered randomness
- From: Roger Bagula <tftn at earthlink.net>
- Date: Mon, 15 Nov 2004 20:56:51 -0500 (EST)
- Reply-to: tftn at earthlink.net
- Sender: owner-wri-mathgroup at wolfram.com
In my fractal nonlinear IFS work I have used the rational pair
(n/(n+1),1/(n+1))
to produce several new fractals.
I know that it behaves very much in IFS like a nonlinear Cantor set.
I made up Log[2] like sums alternating the pairs.
The result is two irrational numbers that are summed to one.
In the iterations based on these sum functions,
I get patterned noise, but they still give a sorted slope of one.
The result appears to be a paired noise pattern.
(* a pair of sums from rational pairs (n/(1+n),1/(n+1))*)
(*
1st=0.5224031171170045693773071024046350601893524864083449381053044765826974398161552455727317173783003561708929280568165560107397662133885113895083716587179298436322129249418632659176904330363338074199274*)
(*
2nd=0.4775968828829954306226928975953649398106475135916550618946949011157747740696740400208629046092755848038901998264701338775987548167280850721475099467997575850060913783991812218340970953593189635761664*)
(*1st+2nd=1*)
f[n_]=If[Mod[n,2]==1,1/((n+1)*2^n),n/((n+1)*2^n)]
digits=200
a=Table[N[f[n],digits],{n,1,digits}];
b=N[Apply[Plus,a],digits]
Clear[f,a,b]
f[n_]=If[Mod[n,2]==1,n/((n+1)*2^n),1/((n+1)*2^n)]
a=Table[N[f[n],digits],{n,1,digits}];
b=N[Apply[Plus,a],digits]
(* iterations based on these that have patterns in them*)
x[n_]:=x[n]=Mod[x[n-1]*2+If[Mod[n,2]==1,1/(n+1),n/(n+1)],1]
x[0]=0
Clear[a,b]
a=Table[N[x[n],digits],{n,0,digits}];
ListPlot[a,PlotJoined->True,PlotRange->All]
b=Sort[Table[N[x[n],digits],{n,0,digits}]];
ListPlot[b,PlotJoined->True,PlotRange->All]
Fit[digits*b,{1,x},x]
Clear[x]
x[n_]:=x[n]=Mod[x[n-1]*2+If[Mod[n,2]==1,n/(n+1),1/(n+1)],1]
x[0]=0
Clear[a,b]
a=Table[N[x[n],digits],{n,0,digits}];
ListPlot[a,PlotJoined->True,PlotRange->All]
b=Sort[Table[N[x[n],digits],{n,0,digits}]];
ListPlot[b,PlotJoined->True,PlotRange->All]
Fit[digits*b,{1,x},x]
Respectfully, Roger L. Bagula
tftn at earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
alternative email: rlbtftn at netscape.net
URL : http://home.earthlink.net/~tftn