|
| |
|
|
A226324
|
|
Array by antidiagonals: D(m,n) = distance between m and n using the graph-metric of A226247.
|
|
1
|
|
|
|
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, 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, 3, 4, 1, 3, 3, 1, 4, 3, 4, 5, 5, 4, 3, 5, 3, 3, 0, 3
(list;
table;
graph;
refs;
listen;
history;
text;
internal format)
|
|
|
|
OFFSET
|
1,4
|
|
|
COMMENTS
|
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:
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.
|
|
|
LINKS
|
|
|
|
EXAMPLE
|
Northwest corner of the distance table:
0 1 2 2 3 3 4 4 4 5
1 0 1 1 2 2 3 3 3 4
2 1 0 2 1 1 2 2 2 3
2 1 2 0 3 3 4 4 4 5
3 2 1 3 0 2 1 1 3 2
3 2 1 3 2 0 3 3 1 4
4 3 2 4 1 3 0 2 4 1
4 3 2 4 1 3 2 0 4 3
4 3 2 4 3 1 4 4 0 5
5 4 3 5 2 4 1 3 5 0
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.
|
|
|
MATHEMATICA
|
$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
Flatten[Table[d[k, n + 1 - k], {n, 1, 15}, {k, 1, n}]]
ArrayPlot[dArray, ColorFunction -> "BlueGreenYellow"]
|
|
|
CROSSREFS
|
|
|
|
KEYWORD
|
|
|
|
AUTHOR
|
|
|
|
STATUS
|
approved
|
| |
|
|
