Re: bimodal ditribution form counting signs of Pi digits differences
- To: mathgroup at smc.vnet.net
- Subject: [mg51770] Re: bimodal ditribution form counting signs of Pi digits differences
- From: Roger Bagula <tftn at earthlink.net>
- Date: Mon, 1 Nov 2004 02:53:15 -0500 (EST)
- References: <clst68$3nf$1@smc.vnet.net>
- Reply-to: tftn at earthlink.net
- Sender: owner-wri-mathgroup at wolfram.com
I did it to the maximum my version/ machine lets me using the method I
understood best.
The two lists of digits are not the same( Pi digits seem to vary more
than the Random[Integer,{0.9}] do at this level).
I'm sure somebody with a later version 5.0 and a faster machine can do
better,
but it still appears that Pi is a better pseudorandom
than the built in, I think ot at least "different" in kind.
Mathematica code I used:
Clear[rdpi,c1,c2,Digits,d1,d2,g]
Digits=50000;rdpi=RealDigits[Pi,10,Digits][[1]]
c1=Drop[FoldList[Plus,0,Sign[Drop[rdpi,1]-Drop[rdpi,-1]]],1];
ListPlot[c1,PlotJoined->True];
(* Rowe Count*)
d1=Flatten@{0,Length/@Split[Sort@c1], 0
ListPlot[d1,PlotJoined->True];
SeedRandom[123];
Clear[rdpi]
rdpi=Table[Random[Integer, {0, 9}], {n, 50000}];
c2=Drop[FoldList[Plus,0,Sign[Drop[rdpi,1]-Drop[rdpi,-1]]],1];
ListPlot[c2,PlotJoined->True];
d2=Flatten@{0,Length/@Split[Sort@c2], 0}
ListPlot[d2,PlotJoined->True];
(Dimensions[d1][[1]]-Dimensions[d2][[1]])/2
Roger Bagula wrote:
>This program is real slow on my machine.
>Show a lean toward positive differences that is "slight" at 2000 digits.
>
>Digits=2000
>$MaxExtraPrecision = Digits
>(* Sum of the sign of the differences between the first 2000 digits of Pi*)
>f[m_]=Sum[Sign[Floor[Mod[10^(n+1)*Pi,10]]-Floor[Mod[10^n*Pi,10]]],{n,0,m}]
>a=Table[{n,f[n]},{n,0,Digits-1}];
>ListPlot[a,PlotJoined->True]
>b=Table[a[[n]][[2]],{n,1,Dimensions[a][[1]]}];
>(* distribution of the noise that results*)
>c=Table[Count[b,m],{m,-12,12}]
>ListPlot[c,PlotJoined->True]
>
>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
>
>
>
--
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