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 On Wed, Nov 20, 2013 at 4:05 AM, Bill Gosper <billgosper@gmail.com> wrote:
On Sun, Nov 17, 2013 at 6:47 AM, Bill Gosper <billgosper@gmail.com> wrote:
On Thu, Nov 14, 2013 at 3:39 AM, Bill Gosper <billgosper@gmail.com>wrote:
This must have been found by Newman himself but I only just noticed. Enumerate the nonnegative rationals by iterating "Newman's function": In[96]:= NestList[1/(2*Floor[#] + 1 - #) &, 0, 9]
Out[96]= {0, 1, 1/2, 2, 1/3, 3/2, 2/3, 3, 1/4, 4/3}
"Oldman's function" runs the sequence back to 0, counting the rationals:
In[97]:= NestList[2*Ceiling[1/#] - 1 - 1/# &, 4/3, 9]
Out[97]= {4/3, 1/4, 3, 2/3, 3/2, 1/3, 2, 1/2, 1, 0}
E.g., 0 is the zeroth rational, 4/3 is the ninth.
What happens if Oldman tries to drive an irrational to 0? In[297]:= Reap[Nest[Sow[2*Ceiling[#] - 1] - # &[1/#] &, π, 8]]
Out[297]= 1 {21 - ------------------------------, 1 1 - -------------------------- 1 3 - ---------------------- 1 1 - ------------------ 1 5 - -------------- 1 1 - ---------- 1 3 - ------ 1 1 - -- Pi
{{1, 3, 1, 5, 1, 3, 1, 21}}}
It's sort of an ultraslow CF expansion. Running 69 steps on π,
In[288]:= {ContinuedFraction[#1, 11], Reverse[#2[[1]]]} & @@ Reap[Nest[Sow[2*Ceiling[#] - 1] - # &[1/#] &,π, 69]]
Out[288]= {{0, 1, 1, 4, 4, 1, 14, 1, 292, 1, 1}, {1, 5, 1, 3, 1, 7, 1, 3, 1, 5, 1, 3, 1, 9, 1, 3, 1, 5, 1, 3, 1, 7, 1, 3, 1, 5, 1, 3, 1, 11, 1, 3, 1, 5, 1, 3, 1, 7, 1, 3, 1, 5, 1, 3, 1, 9, 1, 3, 1, 5, 1, 3, 1, 7, 1, 3, 1, 5, 1, 3, 1, 21, 1, 3, 1, 5, 1, 3, 1}}
we trash the initial 3,7,15, but still see the signature 1,292,1,1 .
Reminder: oldm[x_]:=2*Ceiling[1/x]-1-1/x .
Instead of π, whacking the much more recognizable CF Coth[1] == {1,3,5,7,9,11,...} with 666 oldmans:
In[558]:= Nest[FullSimplify[oldm[#]] &, Coth[1], 666]
Out[558]= 1/673 (2439 + 2/(-4977 + 673 E^2))
In[559]:= ContinuedFraction[%, 33]
Out[559]= {3, 1, 1, 1, 1, 1, 8, 1, 8, 11, 13, 15, 17, 19, 21, 23, 25, \ 27, 29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55, 57}
scrozzles out to the 11. How long to scrozzle the 11?
In[560]:= Timing[Nest[FullSimplify[oldm[#]] &, %558, 9999 - 666]]
Out[560]= {265.709381, (69055 - 9341 E^2)/(121957 - 16497 E^2)}
In[561]:= ContinuedFraction[%[[2]], 22]
Out[561]= {0, 1, 1, 3, 3, 1, 1, 1, 2, 1, 2, 1, 8, 11, 13, 15, 17, 19, 21, 23, 25, 27}
9999 wasn't enough.
In[562]:= Timing[Nest[FullSimplify[oldm[#]] &, %560[[2]], 90000]]
Out[562]= {2522.624247, (417405 - 56483 E^2)/(719239 - 97327 E^2)}
In[563]:= ContinuedFraction[%[[2]], 22]
Out[563]= {0, 1, 1, 2, 1, 1, 1, 1, 2, 1, 4, 1, 1, 1, 7, 11, 13, 15, 17, 19, 21, 23}
99999 wasn't enough.
In[564]:= Timing[Nest[Simplify[TrigToExp[oldm[#]]] &, %562[[2]], 100000]]
Out[564]= {418.393131, (480854 - 65072 E^2)/(819747 - 110933 E^2)}
In[565]:= ContinuedFraction[%[[2]], 22]
Out[565]= {0, 1, 1, 2, 2, 1, 1, 2, 1, 1, 6, 1, 6, 11, 13, 15, 17, 19, 21, 23, 25, 27}
199999 wasn't enough.
In[566]:= Timing[Nest[Simplify[TrigToExp[oldm[#]]] &, %564[[2]], 800000]]
Out[566]= {3186.776622, (682641 - 92383 E^2)/(1161287 - 157159 E^2)}
In[567]:= ContinuedFraction[%[[2]], 22]
Out[567]= {0, 1, 1, 2, 2, 1, 7, 1, 5, 1, 4, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31}
A million wasn't enough!
In[568]:= Timing[Nest[Simplify[oldm[#]] &, %566[[2]], 1000000]]
Out[568]= {3999.565044, (1660220 - 224682 E^2)/(2813371 - 380741 E^2)}
In[569]:= ContinuedFraction[%[[2]], 22]
Out[569]= {0, 1, 1, 2, 3, 1, 1, 1, 5, 6, 4, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31}
Nor two million.
In[570]:= Timing[Nest[Simplify[oldm[#]] &, %568[[2]], 2000000]]
Out[570]= {9079.972071, (2161821 - 292567 E^2)/(3654695 - 494603 E^2)}
In[571]:= ContinuedFraction[%[[2]], 22]
Out[571]= {0, 1, 1, 2, 4, 3, 6, 5, 3, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35}
Nor four. The timings are getting prohibitive. What is this--Goodstein? How did we get to 11 so quickly and then no further??
Maybe later today NeilB and I can find a way to speed this up, or maybe discover that it's all a bad dream. --rwg