A258247 - OEIS

%I #4 Jun 11 2015 10:36:30

%S 0,2,1,8,3,5,25,11,16,9,73,4,6,28,33,48,26,209,19,10,12,14,17,76,82,

%T 96,138,74,593,7,36,42,50,56,27,29,31,34,49,212,217,234,274,393,210,

%U 1680,13,15,18,20,22,84,90,98,104,121,144,161,75,77,79,83,97

%N Irregular triangle (Beatty tree for sqrt(8)) as determined in Comments; a permutation of the nonnegative integers.

%C The Beatty tree for an irrational number r > 1 (such as r = sqrt(8)), is formed as follows.  To begin, let s = r/(r-1), so that the sequences defined u and v defined by u(n) = floor(r*n) and v(n) = floor(s*n), for n >=1 are the Beatty sequences of r and s, and u and v partition the positive integers.

%C The tree T has root 0 with an edge to 2, and all other edges are determined as follows:  if x is in u(v), then there is an edge from x to floor(r + r*x) and an edge from x to ceiling(x/r); otherwise there is an edge from x to floor(r + r*x).  (Thus, the only branchpoints are the numbers in u(v).)

%C Another way to form T is by "backtracking" to the root 0.  Let b(x) = floor[x/r] if x is in (u(n)), and b(x) = floor[r*x] if x is in (v(n)).  Starting at any vertex x, repeated applications of b eventually reach 0.  The number of steps to reach 0 is the number of the generation of T that contains x.  (See Example for x = 13).

%C See A258212 for a guide to Beatty trees for various choices of r.

%e Rows (or generations, or levels) of T:

%e 0

%e 2

%e 1   8

%e 3   5   25

%e 11  16  9   73

%e 4   6   28  33  48  26  209

%e 19  10  12  14  16  76  82  96  138  74  593

%e Generations 0 to 8 of the tree are drawn by the Mathematica program.  In T, the path from 0 to 13 is (0,2,8,3,11,33,12,36,13).  The path obtained by backtracking (i.e., successive applications of the mapping b in Comments) is (13,36,12,33,11,3,8,2,0).

%t r = Sqrt[8]; k = 2000; w = Map[Floor[r #] &, Range[k]];

%t f[x_] := f[x] = If[MemberQ[w, x], Floor[x/r], Floor[r*x]];

%t b := NestWhileList[f, #, ! # == 0 &] &;

%t bs = Map[Reverse, Table[b[n], {n, 0, k}]];

%t generations = Table[DeleteDuplicates[Map[#[[n]] &, Select[bs, Length[#] > n - 1 &]]], {n, 9}]

%t paths = Sort[Map[Reverse[b[#]] &, Last[generations]]]

%t graph = DeleteDuplicates[Flatten[Map[Thread[Most[#] -> Rest[#]] &, paths]]]

%t TreePlot[graph, Top, 0, VertexLabeling -> True, ImageSize -> 900]

%t Map[DeleteDuplicates, Transpose[paths]] (* _Peter J. C. Moses_,May 21 2015 *)

%Y Cf. A022842, A258248 (path-length, 0 to n), A258212.

%K nonn,tabf,easy

%O 1,2

%A _Clark Kimberling_, Jun 08 2015