On Thu, Nov 21, 2013 at 5:01 AM, Bill Gosper <billgosper@gmail.com> wrote:
rwg>Maybe later today NeilB and I can find a way to speed this up, or maybe discover that it's all a bad dream. ------ Sure enough, Neil quickly realized that Adam's page http://cp4space.wordpress.com/2013/10/24/enumerating-the-rationals/ contains logarithmic-time recipes for both the forward map pos2newman(index) -> rational and newman2pos(rational)->index. Using these, the scrozzlement of the 11 term of coth 1 = 1 3 5 7 9 11 ... occurs at oldman step 16712177, which could be found by log search, if nothing else, even if Neil never writes, e.g., newmanposinterval that works on things like Coth[1], since we can work with finite CFs and generalize afterward:
Recall
In[68]:= newmanstep[n_] := 1/(2*Floor[n] + 1 - n)
In[74]:= tim[newman2pos[FromContinuedFraction[{1, 3, 5, 7, 9, 11, 2}]]]
0.000284 (seconds)
Out[74]= 206191919601
The terminal 2 could be any rational > 1. Using our log search value, minus a couple: In[75]:= tim[Divide @@ pos2newman[% - 16712179]]
0.000157 seconds
Out[75]= 577/602
Here's the magic moment, stepping forward (opposite of oldman): In[85]:= ColumnForm[ContinuedFraction /@ NestList[newmanstep, %75, 4]]
{0, 1, 23, 12, 2} {24, 12, 2} {0, 24, 1, 11, 2} {1, 23, 1, 11, 2} {0, 1, 1, 22, 1, 11, 2}
We can now simulate the effect of 206191919601-16712178 newman steps on Coth[1]:
In[79]:= {Numerator[#], Denominator[#]} &@ Convergents[{1, 3, 5, 7, 9, 11, 2}][[-2 ;; -1]]
Out[79]= {{15331, 32042}, {11676, 24403}}
In[80]:= {Numerator[#], Denominator[#]} &@ Convergents[{24, 12, 2}][[-2 ;; -1]]
Out[80]= {{289, 602}, {12, 25}}
In[81]:= %.Inverse[%%].{{Coth[1]}, {1}}
Out[81]= {{-30876 + 23515 Coth[1]}, {-1229 + 936 Coth[1]}}
In[82]:= ContinuedFraction[Divide @@ %, 6]
Out[82]= {{24, 12, 13, 15, 17, 19}}
I.e., we've back up past the 11. Step once forward.
In[83]:= Simplify[newmanstep[(Divide @@ %%)[[1]]]]
Out[83]= (-1229 + 936 Coth[1])/(-29345 + 22349 Coth[1])
In[84]:= ContinuedFraction[%, 6]
Out[84]= {0, 24, 1, 11, 13, 15}
Now it should be easy to chronicle the scrozzlements of ... 7, 9, 13,15, etc. --rwg [...]
Not completely easy--the overshot predicate can give false negatives. Here are the scrozzlings of the first few terms of coth(1) = {1,3,5,7,9,...} : Out[275]= {1, {0, 4, 5, 69}} {241, {0, 8, 1, 7, 69}} {497, {0, 16, 9, 69}} {16712177, {0, 24, 1, 11, 69}} {33489393, {0, 36, 13, 69}} {281406290723313, {0, 48, 1, 15, 69}} {562881267433969, {0, 64, 17, 69}} {1208907373433436732588529, {0, 80, 1, 19, 69}} {2417833193048065907294705, {0, 100, 21, 69}} {1329226728136733477867453629484433905, {0, 120, 1, 23, 69}} {2658454723921649350771260689764778481, {0, 144, 25, 69}} which means that after oldman step 1, {1,3,5,7,9,...} becomes {0,4,5,69} and after step 241, {0,8,1,7,9,11,...} and after step 497, {0,16,9,11,13,...}. Running each 1 more step (-1 newmans): In[276]:= % /. {n_, cf_} :> {n + 1, cfzewm[cf, -1]} Out[276]= {2, {4, 1, 4, 69}} {242, {8, 8, 69}} {498, {16, 1, 8, 69}} {16712178, {24, 12, 69}} {33489394, {36, 1, 12, 69}} {281406290723314, {48, 16, 69}} {562881267433970, {64, 1, 16, 69}} {1208907373433436732588530, {80, 20, 69}} {2417833193048065907294706, {100, 1, 20, 69}} {1329226728136733477867453629484433906, {120, 24, 69}} {2658454723921649350771260689764778482, {144, 1, 24, 69}} we see the penultimate term alternately upscrozzled after a long run or downscrozzled after a (relatively short) doubling. Instead of trying to guess the general sequence function(s) here, I switched to the simpler In[317]:= ContinuedFractionK[1, k, {k, \[Infinity]}] Out[317]= BesselI[1, 2]/BesselI[0, 2] i.e., {1,2,3,4,5,...} Out[306]= {0, {1, 2, 69}} {1, {0, 3, 3, 69}} {25, {0, 5, 1, 4, 69}} {57, {0, 10, 5, 69}} {15417, {0, 14, 1, 6, 69}} {31801, {0, 21, 7, 69}} {132152377, {0, 27, 1, 8, 69}} {266370105, {0, 36, 9, 69}} {17523732937785, {0, 44, 1, 10, 69}} {35115918982201, {0, 55, 11, 69}} {36857494466319121465, {0, 65, 1, 12, 69}} {73750982613738224697, {0, 78, 13, 69}} {1237637881581459231343672377, {0, 90, 1, 14, 69}} {2475577920866839506242796601, {0, 105, 15, 69}} {664573435548828553977895141880396857, {0, 119, 1, 16, 69}} {1329187433441286490429798672020569145, {0, 136, 17, 69}} {5708903659867095197427783744328276684889422905, {0, 152, 1, 18, 69}} {11417894430690934721660927622126257230420409401, {0, 171, 19, 69}} {784634723779399736220988131476081826687296432438576708665, {0, 189, 1, 20, 69}} {1569272440702734831700461809377040128700090862996581022777, {0, 210, 21, 69}} {1725434941194652898093349545431774267571649300435431096073764288363577, {0, 230, 1, 22, 69}} In[307]:= % /. {n_, cf_} :> {n + 1, cfzewm[cf, -1]} Out[307]= {1, {0, 3, 69}} {2, {3, 1, 2, 69}} {26, {5, 5, 69}} {58, {10, 1, 4, 69}} {15418, {14, 7, 69}} {31802, {21, 1, 6, 69}} {132152378, {27, 9, 69}} {266370106, {36, 1, 8, 69}} {17523732937786, {44, 11, 69}} {35115918982202, {55, 1, 10, 69}} {36857494466319121466, {65, 13, 69}} {73750982613738224698, {78, 1, 12, 69}} {1237637881581459231343672378, {90, 15, 69}} {2475577920866839506242796602, {105, 1, 14, 69}} {664573435548828553977895141880396858, {119, 17, 69}} {1329187433441286490429798672020569146, {136, 1, 16, 69}} {5708903659867095197427783744328276684889422906, {152, 19, 69}} {11417894430690934721660927622126257230420409402, {171, 1, 18, 69}} {784634723779399736220988131476081826687296432438576708666, {189, 21, 69}} {1569272440702734831700461809377040128700090862996581022778, {210, 1, 20, 69}} {1725434941194652898093349545431774267571649300435431096073764288363578, {230, 23, 69}} Here the long steps are at {1, 26, 15418, 132152378, 17523732937786, 36857494466319121466, ...} which has the empirical formula 2^(3*n + 2*n^2) - Sum[2^(k*(-1 + 2*k))*(-1 + 4^k), {k, 0, n}], n=0,1,2,... I'll yell if Koutschan's q-thing can do the sum. --rwg