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