Re: bimodal ditribution form counting signs of Pi digits differences

*To*: mathgroup at smc.vnet.net*Subject*: [mg51741] Re: [mg51684] bimodal ditribution form counting signs of Pi digits differences*From*: DrBob <drbob at bigfoot.com>*Date*: Sun, 31 Oct 2004 01:17:00 -0500 (EST)*References*: <200410290739.DAA03398@smc.vnet.net> <opsgnovyr2iz9bcq@monster.cox-internet.com> <4183B4AA.8010207@earthlink.net>*Reply-to*: drbob at bigfoot.com*Sender*: owner-wri-mathgroup at wolfram.com

Like the digits of Pi, Random[Integer,{0,9}] is not random--it's pseudo-random at best. Google for Andrzej Kozlowski's RandomReplacement, go to his web-page, download the package, and see if it helps your situation. Meanwhile, here's an improvement on Don Taylor's method: digits = 100000; h = Rest@# - Most@# &; Timing[rdpi = RealDigits[Pi, 10, digits][[1]]; frdpi = Drop[rdpi, -1]; lrdpi = Drop[rdpi, 1]; s = Drop[FoldList[Plus, 0, Sign[Thread[Subtract[lrdpi, frdpi]]]], 1]; taylor = Table[{n, s[[n + 1]]}, {n, 0, digits - 2}];] Timing[brt4 = Transpose@{ Range[0, digits - 2], Rest@FoldList[Plus, 0, Sign@h@First@RealDigits[Pi, 10, digits]]};] brt4 == taylor {0.469 Second,Null} {0.171 Second,Null} True On Sat, 30 Oct 2004 08:35:06 -0700, Roger Bagula <tftn at earthlink.net> wrote: > Dear Dr. Bob, > Don Taylor already improved the timoing with this: > Timing[rdpi=RealDigits[Pi,10,Digits][[1]]; > frdpi=Drop[rdpi,-1]; > lrdpi=Drop[rdpi,1]; > s=Drop[FoldList[Plus,0,Sign[Thread[Subtract[lrdpi,frdpi]]]],1]; > Table[{n,s[[n+1]]},{n,0,Digits-2}]] > rdpi=RealDigits[Pi,10,Digits][[1]];frdpi=Drop[rdpi,-1];lrdpi=Drop[rdpi,1]; > Drop[FoldList[Plus,{-1,0},Map[{1,#}&,Sign[Thread[Subtract[lrdpi,frdpi]]]]],1] > > The problem is when I use > Random[Integer,{0,9}] > as a simulation of the Pi digits array, > I get a "worse" distribution ... less like what I should get theoretically > for a truly random distribution of digits. > The Pi digits are more like what probability predicts. > That's what I asked you help with. > You definitely know more about statitical distriubutions in some ways > than I do. > Don and I think it may be that the ca Random of Mathematica isn't > working right > in this case. > Do tried simulationg the Sign[] difference as > Random[Integer,{-1,1}] > but that cuts out the bimodal/ trimodal {a,b} probability. > > But thanks for replying anyway. > You are an extremely good Mathematica programmer. > > DrBob wrote: > >> Below I've provided a version of your program using Dynamic >> Programming, plus another method of my own. Your code recalculates the >> same summands repeatedly. The first difference >> Floor@Mod[10Pi,10]-Floor@Mod[Pi,10] is calculated 2000 times to get >> {f[1],..., f[2000]. Dynamic programming eliminates the duplications. >> >> In addition, there's a tremendous amount of waste involved because, >> for instance, calculating the 2000th term requires computing Pi to >> 2000 digits (or so), but getting the 1999th term required computing >> only one fewer digits. The two computations are completely separate, >> each of them starting from scratch. My method eliminates THAT wasted >> effort. (It assumes you know in advance how far you'll go, of course.) >> >> Here's a timing directly after Quit. Calculating again will give >> faster times (because Mathematica caches certain results, I suppose). >> >> ClearAll[f, g] >> n = 5000; >> Timing[mine = >> Rest@FoldList[Plus, 0, Sign /@ ListCorrelate[{-1, >> 1}, First@RealDigits[Pi, 10, n + 2]]];] >> Timing[yours = Block[{$MaxExtraPrecision = n}, >> g[i_] := Sign[Floor@Mod[10^(i + 1)*Pi, 10] - >> Floor@Mod[10^i*Pi, 10]]; >> f[0] = g[0]; >> f[m_] := f[m] = f[m - 1] + g@m; >> f /@ Range[0, n] >> ];] >> mine == yours >> >> {3.797 Second,Null} >> >> {0.016 Second,Null} >> >> True >> >> The original code's Table statement took 10.4 seconds for 500 terms, >> 44 seconds for 1000, 103.6 seconds for 1500, and 195.2 seconds for >> 2000. I didn't take it to 5000, as I did in the timing above. >> >> It's all a waste of time, but at least you can waste a lot LESS time. >> >> Bobby >> >> On Fri, 29 Oct 2004 03:39:06 -0400 (EDT), Roger Bagula >> <tftn at earthlink.net> 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 >>> >>> >>> >>> >> >> >> > -- DrBob at bigfoot.com www.eclecticdreams.net

**References**:**bimodal ditribution form counting signs of Pi digits differences***From:*Roger Bagula <tftn@earthlink.net>