A366747 - OEIS

%I #10 Nov 12 2023 22:01:44

%S 0,0,1,1,1,1,1,1,1,1,1,2,1,1,1,2,2,1,1,1,2,3,1,1,1,1,1,2,3,1,2,2,1,1,

%T 1,1,2,3,1,3,2,1,2,2,1,1,1,2,3,1,3,2,2,3,2,1,3,1,1,1,1,2,3,1,3,2,3,3,

%U 2,1,2,4,1,2,2,1,1,1,2,3,1,3,2,3,3,2

%N Irregular triangular array, read by rows: T(n,k) = out-degree of k-th vertex in the distance graph of the strict partitions of n, where the parts of partitions and the list of partitions are in reverse-lexicographic order (Mathematica order).

%C See A366156 for the distance function d and A000097 for the distance graph.

%C Regarding reverse lexicographic order (Mathematica order, also called canonical order; see A080577).

%e Triangle begins:

%e   0

%e   0

%e   1

%e   1

%e   1   1

%e   1   1   1

%e   1   1   2   1

%e   1   1   2   2   1

%e   1   1   2   3   1   1   1

%e   1   1   2   3   1   2   2   1   1

%e   1   1   2   3   1   3   2   1   2   2   1

%e   1   1   2   3   1   3   2   2   3   2   1   3   1   1

%e   1   1   2   3   1   3   2   3   3   2   1   2   4   1   2   2   1

%e Enumerate the 6 strict partitions (= vertices) of 8 as follows:

%e   1: 8

%e   2: 7,1

%e   3: 6,2

%e   4: 5,3

%e   5: 5,2,1

%e   6: 4,3,1

%e Call q a neighbor of p if d(p,q)=2.

%e The set of neighbors for vertex k, for k = 1..6, is given by

%e   vertex 1: {2}  (so that vertex 1 has out-degree 1)

%e   vertex 2: {1,3}  (out-degree 1)

%e   vertex 3: {2,4,5}  (out-degree 2)

%e   vertex 4: {3,5,6} (out-degree 2)

%e   vertex 5: {3,4,6} (out degree 1)

%e   vertex 6: {4,5} (out degree 0),

%e so that row 8 is 1,1,2,2,1.

%e (Out-degrees of 0 are excluded except for n = 1 and n = 2.)

%t c[n_] := PartitionsQ[n]; q[n_, k_] := q[n, k] =

%t Select[IntegerPartitions[n], DeleteDuplicates[#] == # &][[k]];

%t r[n_, k_] := r[n, k] = Join[q[n, k], ConstantArray[0, n - Length[q[n, k]]]];

%t d[u_, v_] := Total[Abs[u - v]];

%t s[n_, k_] := Select[Range[c[n]], d[r[n, k], r[n, #]] == 2 &];

%t t = Table[s[n, k], {n, 1, 12}, {k, 1, c[n]}];

%t s1[n_, k_] := Length[Select[s[n, k], # > k &]];

%t t1 = Join[{0, 0}, Table[s1[n, k], {n, 1, 26}, {k, 1, c[n] - 1}]];

%t TableForm[t1] (* array *)

%t Flatten[t1]   (* sequence *)

%Y Cf. A000009, A096778 (row sums), A366597.

%K nonn,tabf

%O 1,12

%A _Clark Kimberling_, Oct 25 2023