On Sun, Nov 6, 2011 at 11:29 PM, Bill Gosper <billgosper@gmail.com> wrote:
On Sun, Nov 6, 2011 at 4:30 PM, Bill Gosper <billgosper@gmail.com> wrote:
JZucker>
Well, the Calkin-Wilf tree is still the best, of course.
Thank you, Joshua! I had somehow lived in total ignorance of Newman's amazing, useful, and tiny invention: NestList[1/(2*Floor[#] - # + 1) &, 0, 69]
1 1 3 2 1 4 3 5 2 5 3 1 5 4 7 {0, 1, -, 2, -, -, -, 3, -, -, -, -, -, -, -, 4, -, -, -, -, 2 3 2 3 4 3 5 2 5 3 4 5 4 7 3
3 8 5 7 2 7 5 8 3 7 4 1 6 5 9 4 11 -, -, -, -, -, -, -, -, -, -, -, 5, -, -, -, -, --, --, 8 5 7 2 7 5 8 3 7 4 5 6 5 9 4 11 7
7 10 3 11 8 13 5 12 7 9 2 9 7 12 5 --, --, --, --, --, --, --, --, -, -, -, -, --, --, --, 10 3 11 8 13 5 12 7 9 2 9 7 12 5 13
13 8 11 3 10 7 11 4 9 5 1 7 6 11 5 --, --, --, --, --, --, --, -, -, -, 6, -, -, --, --, --, ...} 8 11 3 10 7 11 4 9 5 6 7 6 11 5 14
(http://oeis.org/A002487). Julian derived the reverse sequence: NestList[2*Ceiling[1/#] - 1 - 1/# &, 14/9, 9]
14 5 11 6 7 1 5 9 4 {--, --, --, --, -, -, 6, -, -, -} 9 14 5 11 6 7 6 5 9
and found the waiting time from 355/113 to 0 was 67107848. I.e., intermediate swell was >>355.
Following Josh's pointer
http://mathlesstraveled.com/2009/10/18/the-hyperbinary-sequence-and-the-calk...
In[1]:= alf[1] = 1; alf[x_ /; x < 1] := 2*alf[x/(1 - x)]; alf[x_] := 1 + 2*alf[x - 1]
In[2]:= Timing[alf[355/113]]
Out[2]= {0.000129, 67107847}
As Yorgey says: Sweet. --rwg
Well, semisweet. This recursion mimics the subtractive Euclid process, with time proportional to the sum of the CF terms of x. Theoretically, the expected value of a CF term is infinite(!), so this is poor form. Practically, the length in bits of the answer will be > Sum(CF terms), so if you hit a huge term, you're screwed anyway. Nevertheless, even further speedup of alf is possible by rewriting it to take its argument as a continued fraction. Neil, by examining the binary values of alf, quickly produced a very fast version closely resembling this nonworking one, which he gave me by accident: FromDigits[Rest[Reverse[ Flatten[Table[Mod[i, 2], {i, 1, Length[#]}, {n, #[[i]]}]]]] &@ContinuedFraction[x],2] About 20 hrs later, I finally managed to debug an optimization of alf: ecf[{}] = 0; ecf[{L___, a_, 1}] = ecf[{L, a + 1}]; ecf[{0, 0, L___}] := ecf[{L}]; ecf[{x_}] := 2^x - 1; ecf[L_List] := 2^L[[1]]*(1 + 2^L[[2]]*ecf[Drop[L, 2]]) - 1 E.g., In[77]:= ecf[{3, 7, 16}] Out[77]= 67107847 Both this and Neil's (good one) are equivalent to the formula alf(x) = waiting time from 1= -1 + 2^L1 (1 + 2^L2 (-1 + ... (-1 + 2^Ln)))), n odd, -1 + 2^L1 (1 + 2^L2 (-1 + ... (1 + 2^(-1 + Ln)))), n even, where CF(x) = {L1,...Ln}. (I.e., decrement the last term if there are evenly many.) I guess people already knew this. --rwg But the real surprise came with plotting the forward sequence
starting with Sqrt[-1] in a neighborhood of the origin--the Ford Pinto circles <http:gosper.org/fordpinto.png>! (Complete with some particulate emissions.) (Using Mma's convention: Floor[z]==Floor[Re[z]]+I*Floor[Im[z]].) The reverse sequence plots the left half (mirror image). --rwg rwg>
At least one Yahoo user couldn't access this image. Try this?: http://gosper.org/fordpinto.png --rwg