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
In[]:=
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
Then
In[]:=
cfprob/@Range@3
Out[]=

Log
4
3

Log[2]
,
Log
9
8

Log[2]
,
Log
16
15

Log[2]

In[]:=
N@%
Out[]=
{0.415037,0.169925,0.0931094}
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]}
In[]:=
N@%
Out[]=
{0.415037,0.169925,0.0931094}
(Invariant under reversal but not shuffling.)
This says to expect about six 1,2,3’s in every burst of 1000 terms:
In[]:=
SequencePosition[ContinuedFraction[π,10^3],{1,2,3}]//tim
0.00044,6
Out[]=
{{47,49},{293,295},{512,514},{542,544},{841,843},{987,989}}
Try a million :
In[]:=
SequencePosition[ContinuedFraction[π,10^6],{1,2,3}]//tim
0.440412,6561
Out[]=
{{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...
(0.5 seconds for a million terms. Have I actually lived to see this?)
In[]:=
3^8
Out[]=
6561
In[]:=
SequencePosition[ContinuedFraction[π,10^6],{3,2,1}]//tim;0;
0.448478,6477
Continued fractions accommodate fancier date formats:
In[]:=
cfprob@{3,14,15}
Out[]=
Log
593569
593568

Log[2]
In[]:=
N@%
Out[]=
2.43055×
-6
10
In[]:=
SequencePosition[ContinuedFraction[π,10^6],{3,14,15}]//tim
0.443411,2
Out[]=
{{415314,415316},{607114,607116}}
Sure enough, there were two of them.
​
But for really fancy dates,
In[]:=
cfprob@{14,3,2015}//N
Out[]=
1.79491×
-10
10
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:
In[]:=
Clear[tim];​​​​tim[xp_]:=(Print[#[[1]],",",Length[#[[2]]]];​​If[#[[1]]>69,Speak[#[[1]]]];#[[2]])&@AbsoluteTiming[xp]​​SetAttributes[tim,HoldAll]