login
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.
1

%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