Re: bimodal ditribution form counting signs of Pi digits differences
- To: mathgroup at smc.vnet.net
- Subject: [mg51735] Re: [mg51684] bimodal ditribution form counting signs of Pi digits differences
- From: DrBob <drbob at bigfoot.com>
- Date: Sat, 30 Oct 2004 03:49:16 -0400 (EDT)
- References: <200410290739.DAA03398@smc.vnet.net>
- Reply-to: drbob at bigfoot.com
- Sender: owner-wri-mathgroup at wolfram.com
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