[math-fun] Newman = -1/Oldman
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. Oldman is completely unnecessary! Just negate and reciprocate the last value, and Newman runs backwards: In[100]:= NestList[1/(2*Floor[#] + 1 - #) &, -3/4, 9] Out[100]= {-3/4, -4, -1/3, -3/2, -2/3, -3, -1/2, -2, -1, ComplexInfinity} (with a much louder completion announcement). Or if you prefer, Oldman runs the negative rationals forwards: In[99]:= NestList[2*Ceiling[1/#] - 1 - 1/# &, -1, 9] Out[99]= {-1, -2, -1/2, -3, -2/3, -3/2, -1/3, -4, -3/4, -5/3} obviating Newman. --rwg
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 . The "terms" are curiously self-similar. Deleting the 1s, then 2n+1->n: In[289]:= DeleteCases[(%[[2]] - 1)/2, 0] Out[289]= {2, 1, 3, 1, 2, 1, 4, 1, 2, 1, 3, 1, 2, 1, 5, 1, 2, 1, 3, 1, 2, 1, 4, 1, 2, 1, 3, 1, 2, 1, 10, 1, 2, 1} Again deleting the 1s, but this time n+1->n: In[291]:= DeleteCases[%% - 1, 0] Out[291]= {1, 2, 1, 3, 1, 2, 1, 4, 1, 2, 1, 3, 1, 2, 1, 9, 1} Continuing, In[292]:= DeleteCases[% - 1, 0] Out[292]= {1, 2, 1, 3, 1, 2, 1, 8} In[293]:= DeleteCases[% - 1, 0] Out[293]= {1, 2, 1, 7} In[294]:= DeleteCases[% - 1, 0] Out[294]= {1, 6} finally ending in {5}. This process is nearly reversible. Starting with {5}, we can recover the previous lists, modulo deciding which end(s) receive the undeleted 0. ? --rwg
Oldman is completely unnecessary!
Just negate and reciprocate the last value, and Newman runs backwards:
In[100]:= NestList[1/(2*Floor[#] + 1 - #) &, -3/4, 9]
Out[100]= {-3/4, -4, -1/3, -3/2, -2/3, -3, -1/2, -2, -1, ComplexInfinity}
(with a much louder completion announcement).
Or if you prefer, Oldman runs the negative rationals forwards:
In[99]:= NestList[2*Ceiling[1/#] - 1 - 1/# &, -1, 9]
Out[99]= {-1, -2, -1/2, -3, -2/3, -3/2, -1/3, -4, -3/4, -5/3}
obviating Newman. --rwg
On 11/17/13, 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. ...
Hypothesis: the thread topic is (distantly related to) Calkin-Wilf and Stern-Brocot trees --- see eg. http://en.wikipedia.org/wiki/Calkin%E2%80%93Wilf_tree I should be much obliged if somebody would confirm or refute this conjecture, if possible attaching relevant references. WFL
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
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
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
(Below) was the first message in a voluminous, ten day discussion of what happens when you run Newman's rational number enumerator backwards on an irrational. E.g., on coth 1 = 1 3 5 7 9 ..., it takes 242 steps to scrozzle the 7: Column@NestList[{#, ContinuedFraction[#, 9]} &@Oldman@#[[1]] &, {Coth@1, Range[1, 17, 2]}, 242] {Coth[1],{1,3,5,7,9,11,13,15,17}} {1-Tanh[1],{0,4,5,7,9,11,13,15,17}} {1/2 (17-E^2),{4,1,4,7,9,11,13,15,17}} {1+2/(-17+E^2),{0,1,3,1,4,7,9,11,13}} {(2 (-14+E^2))/(-15+E^2),{1,1,2,1,4,7,9,11,13}} {(-13+E^2)/(2 (-14+E^2)),{0,2,2,1,4,7,9,11,13}} {(-37+3 E^2)/(-13+E^2),{2,1,1,1,4,7,9,11,13}} {(2 (-12+E^2))/(-37+3 E^2),{0,1,1,1,1,1,4,7,9}} {(35-3 E^2)/(24-2 E^2),{1,2,1,1,4,7,9,11,13}} {(-11+E^2)/(-35+3 E^2),{0,3,1,1,4,7,9,11,13}} {(-42+4 E^2)/(-11+E^2),{3,2,4,7,9,11,13,15,17}} {(31-3 E^2)/(42-4 E^2),{0,1,2,2,4,7,9,11,13}} {(51-5 E^2)/(31-3 E^2),{1,1,1,2,4,7,9,11,13}} {(2 (-10+E^2))/(-51+5 E^2),{0,2,1,2,4,7,9,11,13}} {(49-5 E^2)/(20-2 E^2),{2,3,4,7,9,11,13,15,17}} {(29-3 E^2)/(49-5 E^2),{0,1,1,3,4,7,9,11,13}} {(38-4 E^2)/(29-3 E^2),{1,4,4,7,9,11,13,15,17}} {(-9+E^2)/(-38+4 E^2),{0,5,4,7,9,11,13,15,17}} {(-61+7 E^2)/(-9+E^2),{5,1,3,7,9,11,13,15,17}} {(52-6 E^2)/(61-7 E^2),{0,1,4,1,3,7,9,11,13}} [. . .] {(814-108 E^2)/(505-67 E^2),{1,1,1,1,1,3,1,7,9}} {(309-41 E^2)/(814-108 E^2),{0,2,1,1,1,3,1,7,9}} {(731-97 E^2)/(309-41 E^2),{2,2,1,3,1,7,9,11,13}} {(422-56 E^2)/(731-97 E^2),{0,1,1,2,1,3,1,7,9}} {(535-71 E^2)/(422-56 E^2),{1,3,1,3,1,7,9,11,13}} {(113-15 E^2)/(535-71 E^2),{0,4,1,3,1,7,9,11,13}} {(482-64 E^2)/(113-15 E^2),{4,4,1,7,9,11,13,15,17}} {(369-49 E^2)/(482-64 E^2),{0,1,3,4,1,7,9,11,13}} {(625-83 E^2)/(369-49 E^2),{1,1,2,4,1,7,9,11,13}} {(256-34 E^2)/(625-83 E^2),{0,2,2,4,1,7,9,11,13}} {(655-87 E^2)/(256-34 E^2),{2,1,1,4,1,7,9,11,13}} {(399-53 E^2)/(655-87 E^2),{0,1,1,1,1,4,1,7,9}} {(542-72 E^2)/(399-53 E^2),{1,2,1,4,1,7,9,11,13}} {(143-19 E^2)/(542-72 E^2),{0,3,1,4,1,7,9,11,13}} {(459-61 E^2)/(143-19 E^2),{3,5,1,7,9,11,13,15,17}} {(316-42 E^2)/(459-61 E^2),{0,1,2,5,1,7,9,11,13}} {(489-65 E^2)/(316-42 E^2),{1,1,1,5,1,7,9,11,13}} {(173-23 E^2)/(489-65 E^2),{0,2,1,5,1,7,9,11,13}} {(376-50 E^2)/(173-23 E^2),{2,6,1,7,9,11,13,15,17}} {(203-27 E^2)/(376-50 E^2),{0,1,1,6,1,7,9,11,13}} {(233-31 E^2)/(203-27 E^2),{1,7,1,7,9,11,13,15,17}} {(30-4 E^2)/(233-31 E^2),{0,8,1,7,9,11,13,15,17}} {(277-37 E^2)/(30-4 E^2),{8,8,9,11,13,15,17,19,21}} Am I the only one who failed to notice, e.g., 1+3+5 (= 3²) = 0+4+5 = 4+1+4= ... = 0+1+4+1+3 = [. . .] = 1+1+1+1+1+3+1 =...=0+8+1 ? And then, of course, 1+3+5+7 (= 4²) = 8+8 = ... . --rwg 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.
Oldman is completely unnecessary!
Just negate and reciprocate the last value, and Newman runs backwards:
In[100]:= NestList[1/(2*Floor[#] + 1 - #) &, -3/4, 9]
Out[100]= {-3/4, -4, -1/3, -3/2, -2/3, -3, -1/2, -2, -1, ComplexInfinity}
(with a much louder completion announcement).
Or if you prefer, Oldman runs the negative rationals forwards:
In[99]:= NestList[2*Ceiling[1/#] - 1 - 1/# &, -1, 9]
Out[99]= {-1, -2, -1/2, -3, -2/3, -3/2, -1/3, -4, -3/4, -5/3}
obviating Newman. --rwg
participants (2)
-
Bill Gosper -
Fred Lunnon