|
%I #5 Mar 30 2012 18:57:44
%S 1,3,2,5,4,6,9,7,10,8,13,11,14,12,15,19,16,20,17,21,18,25,22,26,23,27,
%T 24,28,33,29,34,30,35,31,36,32,41,37,42,38,43,39,44,40,45,51,46,52,47,
%U 53,48,54,49,55,50,62,57,63,58,64,59,65,60,66,61,56,73,68,75
%N Rectangular array, by antidiagonals: row n gives the positions of n in the fractal sequence A194874; an interspersion.
%C See A194832 for a general discussion.
%e Northwest corner:
%e 1...3...5...9...13..19
%e 2...4...7...11..16..22
%e 6...10..14..20..26..34
%e 8...12..17..23..30..38
%e 15..21..27..35..43..53
%t r = -Sqrt[6];
%t t[n_] := Table[FractionalPart[k*r], {k, 1, n}];
%t f = Flatten[Table[Flatten[(Position[t[n], #1] &) /@
%t Sort[t[n], Less]], {n, 1, 20}]] (* A194874 *)
%t TableForm[Table[Flatten[(Position[t[n], #1] &) /@
%t Sort[t[n], Less]], {n, 1, 15}]]
%t row[n_] := Position[f, n];
%t u = TableForm[Table[row[n], {n, 1, 20}]]
%t g[n_, k_] := Part[row[n], k];
%t p = Flatten[Table[g[k, n - k + 1], {n, 1, 13},
%t {k, 1, n}]] (* A194875 *)
%t q[n_] := Position[p, n]; Flatten[
%t Table[q[n], {n, 1, 80}]] (* A194876 *)
%Y Cf. A194832, A194874, A194876.
%K nonn,tabl
%O 1,2
%A _Clark Kimberling_, Sep 04 2011
|
