%I #12 Aug 02 2023 11:48:54
%S 1,2,3,4,6,9,5,10,18,27,7,11,28,54,81,8,12,29,82,162,243,13,15,36,83,
%T 244,486,729,14,19,45,108,245,730,1458,2187,16,20,55,135,324,731,2188,
%U 4374,6561,17,21,56,163,405,972,2189,6562,13122,19683,22,24,63
%N Rectangular array by descending antidiagonals: row n consists of the numbers k such that n = 1 + maximal runlength of 0's in the ternary representation of k.
%C Every positive integer occurs exactly once.
%e Corner:
%e 1 2 4 5 7 8 13 14 16 17
%e 3 6 10 11 12 15 19 20 21 24
%e 9 18 28 29 36 45 55 56 63 72
%e 27 54 82 83 108 135 163 164 189 216
%e 81 162 244 245 324 405 487 488 567 648
%e 243 486 730 731 972 1215 1459 1460 1701 1944
%e Let r(n) = maximal runlength of 0s in the ternary representation of n, for n >=1, so that (r(n)) = (0,0,1,0,0,1,0,0,2,...). Thus, r(9)=2, so that the first term in row 3 of the array is 9.
%t d[n_] := d[n] = First[RealDigits[n, 3]]; f[w_] := FromDigits[w, 3];
%t s = Map[Split, Table[d[n], {n, 1, 2187}]];
%t x[n_] := Select[s, MemberQ[#, Table[0, n]] &];
%t u[n_] := Map[Flatten, x[n]];
%t t0 = Flatten[Table[FromDigits[#, 3] & /@ Tuples[{1, 2}, n], {n, 5}]];
%t t = Join[{t0}, Table[Map[f, u[n]], {n, 1, 7}]] ;
%t TableForm[t] (* this sequence as an array *)
%t Table[t[[n - k + 1, k]], {n, 8}, {k, n, 1, -1}] // Flatten (* this sequence *)
%t (* Next, another program *)
%t nwCornerD[lists_] := Quiet[Flatten[Reap[NestWhile[# + 1 &, 1, ! {} ===
%t Sow[Check[lists[[# - Binomial[Floor[1/2 + Sqrt[2*#]], 2]]][[1 - # +
%t Binomial[Floor[3/2 + Sqrt[2*#]], 2]]], {}]] &[#] &]][[2]]]];
%t z = 10; radix = 3;
%t tmp = Map[Max[Map[Count[#, 0] &, #]] &,
%t Map[Split, IntegerDigits[Range[radix^z], radix]]];
%t nwCornerD[Map[Flatten[Position[tmp, #]] &, Range[0, z]]]
%t (* _Peter J. C. Moses_, Aug 01 2023 *)
%Y Cf. A000244 (column 1), A032924 (row 1), A363996.
%K nonn,tabl,base
%O 1,2
%A _Clark Kimberling_, Jul 01 2023