A248513 Rectangular array by antidiagonals: the dispersion of A181155 ("odious numbers").

1, 2, 4, 3, 8, 6, 5, 15, 12, 7, 9, 29, 23, 14, 10, 17, 57, 45, 27, 20, 11, 33, 113, 89, 53, 39, 22, 13, 65, 225, 177, 105, 77, 43, 26, 16, 129, 449, 353, 209, 153, 85, 51, 32, 18, 257, 897, 705, 417, 305, 169, 101, 63, 36, 19, 513, 1793, 1409, 833, 609, 337

Offset

1,2

Comments

Background discussion: Suppose that s is an increasing sequence of positive integers, that the complement t of s is infinite, and that t(1) = 1. The dispersion of s is the array D whose n-th row is (t(n), s(t(n)), s(s(t(n)), s(s(s(t(n)))), ...). Every positive integer occurs exactly once in D, so that, as a sequence, D is a permutation of the positive integers. The sequence u given by u(n) = (number of the row of D that contains n) is a fractal sequence, as in A248514.

The n-th term of column 1 is A001969(n) + 1, where A001969 are the "evil numbers".

References

Clark Kimberling, Fractal sequences and interspersions, Ars Combinatoria 45 (1997) 157-168.

Links

Clark Kimberling, Antidiagonals n = 1..60, flattened

Clark Kimberling, Interspersions and dispersions, Proceedings of the American Mathematical Society, 117 (1993) 313-321.

Example

Northwest corner:
1 ... 2 ... 3 ... 5 ... 9 .... 17 ... 33
4 ... 8 ... 15 .. 29 .. 57 ... 113 .. 225
6 ... 12 .. 23 .. 45 .. 89 ... 177 .. 353
7 ... 14 .. 27 .. 53 .. 105 .. 209 .. 417
10 .. 20 .. 39 .. 77 .. 153 .. 305 .. 609

Mathematica

r = 40; r1 = 10; (* r = # rows of T, r1 = # rows to show *);
c = 40; c1 = 12; (* c = # cols of T, c1 = # cols to show *);
x = GoldenRatio;
s[n_] := s[n] = If[n < 1, 0, 2 n - Mod[Total[IntegerDigits[n - 1, 2]], 2]];
mex[list_] := NestWhile[#1 + 1 &, 1, Union[list][[#1]] <= #1 &, 1,   Length[Union[list]]]; rows = {NestList[s, 1, c]};
Do[rows = Append[rows, NestList[s, mex[Flatten[rows]], r]], {r}];
t[i_, j_] := rows[[i, j]]; TableForm[Table[t[i, j], {i, 1, r1}, {j, 1, c1}]]
u = Flatten[Table[t[k, n - k + 1], {n, 1, c1}, {k, 1, n}]] (* A248513 *)
row[i_] := row[i] = Table[t[i, j], {j, 1, c}]
f[n_] := Select[Range[r], MemberQ[row[#], n] &]
v = Flatten[Table[f[n], {n, 1, 200}]]  (* A248514 *)

Crossrefs

Cf. A248514.

Sequence in context: A232563 A048672 A277517 * A266414 A245613 A260431

Adjacent sequences: A248510 A248511 A248512 * A248514 A248515 A248516

Keyword

nonn,tabl,easy

Author

Clark Kimberling, Oct 08 2014

Status

approved