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>
- bimodal ditribution form counting signs of Pi digits differences