A243713 Irregular triangular array of numerators of all positive rational numbers ordered as in Comments.

1, 2, 3, 4, 1, 5, 3, 2, 6, 5, 5, 3, 7, 7, 8, 7, 4, 1, 8, 9, 11, 11, 9, 4, 5, 3, 2, 9, 11, 14, 15, 14, 7, 11, 8, 7, 6, 5, 5, 3, 10, 13, 17, 19, 19, 10, 17, 13, 12, 13, 12, 13, 10, 7, 7, 8, 7, 4, 1, 11, 15, 20, 23, 24, 13, 23, 18, 17, 20, 19, 21, 17, 15, 16

Offset: 1

Author

Clark Kimberling, Jun 09 2014

Keywords

• nonn
• easy
• tabf
• frac

Comments

Decree that (row 1) = (1), (row 2) = (3), and (row 3) = (3). Thereafter, row n consists of the following numbers arranged in decreasing order: 1+x for each x in (row n-1), together with x/(x + 1) for each x in row (n-3). Every positive rational number occurs exactly once in the array. The number of numbers in (row n) is A000930(n-1), for n >= 1.

Examples

			First 8 rows of the array of all positive rationals:
1/1
2/1
3/1
4/1 ... 1/2
5/1 ... 3/2 ... 2/3
6/1 ... 5/2 ... 5/3 ... 3/4
7/1 ... 7/2 ... 8/3 ... 7/4 ... 4/5 ... 1/3
8/1 ... 9/2 ... 11/3 .. 11/4 .. 9/5 ... 4/3 ... 5/6 ... 3/5 ... 2/5
The numerators, by rows:  1,2,3,4,1,5,3,2,6,5,5,3,7,7,8,7,4,1,8,9,11,11,9,4,5,3,2,...
		

Links

• Clark Kimberling, Table of n, a(n) for n = 1..1000

Crossrefs

Cf. A243712, A243714, A243715, A000930, A243613.

Programs

Mathematica

z = 13; g[1] = {1}; f1[x_] := x + 1; f2[x_] := -1/x; h[1] = g[1]; b[n_] := b[n] = DeleteDuplicates[Union[f1[g[n - 1]], f2[g[n - 1]]]];
h[n_] := h[n] = Union[h[n - 1], g[n - 1]]; g[n_] := g[n] = Complement [b[n], Intersection[b[n], h[n]]]; u = Table[g[n], {n, 1, z}]; u1 = Delete[Flatten[u], 10]
w[1] = 0; w[2] = 1; w[3] = 1; w[n_] := w[n - 1] + w[n - 3];
u2 = Table[Drop[g[n], w[n]], {n, 1, z}];
u3 = Delete[Delete[Flatten[Map[Reverse, u2]], 4], 4]
Denominator[u3]  (* A243712 *)
Numerator[u3]    (* A243713 *)
Denominator[u1]  (* A243714 *)
Numerator[u1]    (* A243715 *)