Re: Re: bimodal ditribution form counting signs of Pi digits differences
- To: mathgroup at smc.vnet.net
- Subject: [mg51757] Re: [mg51741] Re: [mg51684] bimodal ditribution form counting signs of Pi digits differences
- From: Andrzej Kozlowski <andrzej at akikoz.net>
- Date: Mon, 1 Nov 2004 02:52:33 -0500 (EST)
- References: <200410290739.DAA03398@smc.vnet.net> <opsgnovyr2iz9bcq@monster.cox-internet.com> <4183B4AA.8010207@earthlink.net> <200410310617.BAA16236@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Actually, Random[Integer,{0,9}] unlike Random[] already uses the
Wolfram CA algorithm, so it will not benefit form the RandomReplacement
package.
On the other hand the Wolfram CA algorithm has undergone very demanding
testing for randomness (or rather, pseudo-randomness, which is the case
of computers is essentially the same thing) and as far as I know has
passed them all with flying colours. Therefore I find it hard to
believe that someone would find something wrong with this famous
generator using such simple methods; it's rather like finding a trivial
counterexample to a long established theorem. Still such things do
happen from time to time so if it is the case this time ... Roger
Bagula is going to be famous ;-)
Of course it is well known that Pi is an extremely good "pseudo-random"
number generator, although as far as I know nobody can prove anything
about it. There has been a long standing conjecture that the digits of
Pi give an infinity-distributed 10-ary sequence though I don't think
anybody ever managed to make any progress on this matter. However, my
knowledge of these these is very dated; in fact it goes back to volume
2 of Knuth's ACP, but I assume that if somebody may to prove something
spectacular in this area I would have heard about it. The same is true
of course about discovering non-randomness in Wolfram's CA algorithm,
though I would expect this to be a considerably easier task than
proving anything at all about the randomness of the digits of Pi.
Andrzej Kozlowski
Chiba, Japan
http://www.akikoz.net/~andrzej/
http://www.mimuw.edu.pl/~akoz/
On 31 Oct 2004, at 15:17, DrBob wrote:
>
> 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
>
>