A226324 - OEIS

%I #11 Feb 13 2014 13:16:40

%S 0,1,1,2,0,2,2,1,1,2,3,1,0,1,3,3,2,2,2,2,3,4,2,1,0,1,2,4,4,3,1,3,3,1,

%T 3,4,4,3,2,3,0,3,2,3,4,5,3,2,4,2,2,4,2,3,5,5,4,2,4,1,0,1,4,2,4,5,5,4,

%U 3,4,1,3,3,1,4,3,4,5,5,4,3,5,3,3,0,3

%N Array by antidiagonals:  D(m,n) = distance between m and n using the graph-metric of A226247.

%C Let S be the set of numbers defined by these rules:  0 is in S; if x is in S, then x+1 is in S, and if nonzero x is in S, then -1/x is in S.  Then S is the set of all rational numbers, produced in generations as follows:

%C g(1) = (0), g(2) = (1), g(3) = (2, -1), g(4) = (3, -1/2), g(5) = (4,-1/3,1/2),... For n > 2, once g(n-1) = (c(1),...,c(z)) is defined, g(n) is formed from the vector (c(1)+1, -1/c(1), c(2)+1, -1/c(2),...,c(z)+1, -1/c(z)) by deleting previously generated elements.  This order of generation matches a tree with (0,1), (1,2), (1,-1), (2,3), (2,-1/2), (3,4), (4,-1/3), (-1/2,1/2), etc.  Replace each node by the order in which it is generated, so that the nodes labeled (0,1,2,-1,3,-1/2,4,-1/3,...) get new labels (1,2,3,4,5,6,...), respectively.  If m and n are positive integers, then D(m,n) is the number of edges between m and n.

%H Clark Kimberling, <a href="/A226324/b226324.txt">Antidiagonals n=1..60, flattened</a>

%e Northwest corner of the distance table:

%e 0 1 2 2 3 3 4 4 4 5

%e 1 0 1 1 2 2 3 3 3 4

%e 2 1 0 2 1 1 2 2 2 3

%e 2 1 2 0 3 3 4 4 4 5

%e 3 2 1 3 0 2 1 1 3 2

%e 3 2 1 3 2 0 3 3 1 4

%e 4 3 2 4 1 3 0 2 4 1

%e 4 3 2 4 1 3 2 0 4 3

%e 4 3 2 4 3 1 4 4 0 5

%e 5 4 3 5 2 4 1 3 5 0

%e Row 5, column 4 is occupied by 3, meaning that D(5,4) = 3, a count of edges in the subgraph 5 -> 3 -> 2 -> 4.

%t $MaxExtraPrecision = Infinity; g[1] := {1}; g[2] := {1, 0}; g[3] := {1, 0, 0}; g[test_] := Module[{topRow, len, tmp = test, noOfTerms = Ceiling[Log[test]/Log[1.465571231876768026656731]] - 1}, topRow = Flatten[{1, LinearRecurrence[{1, 0, 1}, {2, 3, 5}, noOfTerms]}]; If[First[#] == 0, Rest[#], #] &[Table[If[# >= 0, tmp = #; 1, 0] &[tmp - topRow[[n]]], {n, noOfTerms, 1, -1}]]]; d[n1_, n2_] := Module[{z1 = g[n1], z2 = g[n2]}, Length[z1] + Length[z2] - 2(NestWhile[# + 1 &, 1, z1[[#]] == z2[[#]] &, 1, Min[{Length[z1], Length[z2]}]] - 1)]; (dArray = Table[d[m, n], {m, 1, #}, {n, 1, #}] &[15]) // TableForm

%t   Flatten[Table[d[k, n + 1 - k], {n, 1, 15}, {k, 1, n}]]

%t   ArrayPlot[dArray, ColorFunction -> "BlueGreenYellow"]

%t (* _Peter J. C. Moses_, Jun 02 2013 *)

%Y Cf. A226080, A226207, A226247.

%K nonn,tabl,easy

%O 1,4

%A _Clark Kimberling_, Jun 04 2013