A363995 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, 2, 3, 4, 6, 9, 5, 10, 18, 27, 7, 11, 28, 54, 81, 8, 12, 29, 82, 162, 243, 13, 15, 36, 83, 244, 486, 729, 14, 19, 45, 108, 245, 730, 1458, 2187, 16, 20, 55, 135, 324, 731, 2188, 4374, 6561, 17, 21, 56, 163, 405, 972, 2189, 6562, 13122, 19683, 22, 24, 63
Offset: 1
Examples
Corner:
1 2 4 5 7 8 13 14 16 17
3 6 10 11 12 15 19 20 21 24
9 18 28 29 36 45 55 56 63 72
27 54 82 83 108 135 163 164 189 216
81 162 244 245 324 405 487 488 567 648
243 486 730 731 972 1215 1459 1460 1701 1944
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.
Programs
-
Mathematica
d[n_] := d[n] = First[RealDigits[n, 3]]; f[w_] := FromDigits[w, 3]; s = Map[Split, Table[d[n], {n, 1, 2187}]]; x[n_] := Select[s, MemberQ[#, Table[0, n]] &]; u[n_] := Map[Flatten, x[n]]; t0 = Flatten[Table[FromDigits[#, 3] & /@ Tuples[{1, 2}, n], {n, 5}]]; t = Join[{t0}, Table[Map[f, u[n]], {n, 1, 7}]] ; TableForm[t] (* this sequence as an array *) Table[t[[n - k + 1, k]], {n, 8}, {k, n, 1, -1}] // Flatten (* this sequence *) (* Next, another program *) nwCornerD[lists_] := Quiet[Flatten[Reap[NestWhile[# + 1 &, 1, ! {} === Sow[Check[lists[[# - Binomial[Floor[1/2 + Sqrt[2*#]], 2]]][[1 - # + Binomial[Floor[3/2 + Sqrt[2*#]], 2]]], {}]] &[#] &]][[2]]]]; z = 10; radix = 3; tmp = Map[Max[Map[Count[#, 0] &, #]] &, Map[Split, IntegerDigits[Range[radix^z], radix]]]; nwCornerD[Map[Flatten[Position[tmp, #]] &, Range[0, z]]] (* Peter J. C. Moses, Aug 01 2023 *)
Comments