Birthday dates using pi continued fractions

Source: https://community.wolfram.com/groups/-/m/t/1581809

Author: Bill Gosper

For π Day. 2015, WRI stirred up publicity with
https://blog.stephenwolfram.com/2015/03/pi-or-pie-celebrating-pi-day-of-the-centuryand-how-to-get-your-very-own-piece-of-pi/
Off-list I grumbled that no self-respecting Deity would bother sending clues to worshipers dumb enough to use decimal instead of continued fractions. However, in 2019 we’re barely able to afford a full CF version of Wolfram’s birthday games.
Assuming Gauss–Kuzmin distribution, define

cfprob[L_List]:=Abs@Log[2,(1+1/FromContinuedFraction@L)/(1+1/FromContinuedFraction@MapAt[#+1&,L,-1])]
In[]:=
cfprob[r:(Integer_|Rational_)]:=cfprob@ContinuedFraction@r
In[]:=

Then

cfprob/@Range@3
In[]:=
Log
4
3
Log[2]
,
Log
9
8
Log[2]
,
Log
16
15
Log[2]
Out[]=
N@%
In[]:=
{0.415037,0.169925,0.0931094}
Out[]=

I.e, 41.5% of terms should be 1, 17% should be 2, etc.
​
But cfprob also gives us the probabilities of term sequences:

cfprob/@{{1,2,3},1+1/(2+1/3),{3,2,1},{2,1,3}}
{Log[221/220]/Log[2],Log[221/220]/Log[2],Log[221/220]/Log[2],Log[210/209]/Log[2]}
N@%
In[]:=
{0.415037,0.169925,0.0931094}
Out[]=

(Invariant under reversal but not shuffling.)

This says to expect about six 1,2,3’s in every burst of 1000 terms:

SequencePosition[ContinuedFraction[π,10^3],{1,2,3}]//tim
In[]:=
0.00044,6
{{47,49},{293,295},{512,514},{542,544},{841,843},{987,989}}
Out[]=

Try a million :

SequencePosition[ContinuedFraction[π,10^6],{1,2,3}]//tim
In[]:=
0.440412,6561
{47,49},{293,295},{512,514},{542,544},{841,843},{987,989},{1026,1028},{1199,1201},{1237,1239},{1459,1461},{1569,1571},
⋯6539⋯
,{998779,998781},{998991,998993},{999141,999143},{999146,999148},{999179,999181},{999580,999582},{999592,999594},{999689,999691},{999708,999710},{999749,999751},{999810,999812}
large output
show less
show more
show all
set size limit...
Out[]=

(0.5 seconds for a million terms. Have I actually lived to see this?)

3^8
In[]:=
6561
Out[]=
SequencePosition[ContinuedFraction[π,10^6],{3,2,1}]//tim;0;
In[]:=
0.448478,6477

Continued fractions accommodate fancier date formats:

cfprob@{3,14,15}
In[]:=
Log
593569
593568
Log[2]
Out[]=
N@%
In[]:=
2.43055×10
-6
Out[]=
SequencePosition[ContinuedFraction[π,10^6],{3,14,15}]//tim
In[]:=
0.443411,2
{{415314,415316},{607114,607116}}
Out[]=

Sure enough, there were two of them.
​
But for really fancy dates,

cfprob@{14,3,2015}//N
In[]:=
1.79491×10
-10
Out[]=

we’ll need Eric Weisstein's record π CF calculation.

Utility functions

These are the definitions of the utility function tim you will need for the above evaluations:

Clear[tim];​​​​tim[xp_]:=(Print[#[[1]],",",Length[#[[2]]]];​​If[#[[1]]>69,Speak[#[[1]]]];#[[2]])&@AbsoluteTiming[xp]​​SetAttributes[tim,HoldAll]
In[]:=