A241900 Irregular triangular array: T(n,k) = number of partitions (nodes) in the k-th component of the graph G'(n) obtained from the partition graph G(n) by deleting all partitions having repeated parts; G and G' are defined in Comments.

1, 1, 2, 2, 2, 1, 2, 2, 3, 2, 4, 2, 5, 2, 1, 6, 2, 2, 7, 3, 2, 8, 5, 2, 9, 7, 2, 10, 9, 2, 1, 12, 11, 2, 2, 15, 12, 3, 2, 18, 13, 5, 2, 22, 14, 8, 2, 26, 15, 11, 2, 30, 16, 15, 2, 1, 35, 20, 17, 2, 2, 40, 26, 18, 3, 2, 45, 33, 19, 5, 2, 51, 41, 20, 8, 2, 57

Offset: 1

Author

Clark Kimberling, May 01 2014

Keywords

• nonn
• easy
• tabf

Comments

The partition graph G(n) is defined at A241150 as follows: the nodes are the partitions of n, and nodes p and q have an edge if one of them can be obtained from the other by a substitution x -> x-1,1 for some part x. Let R be the set of partitions (nodes) of n that contain a repeated part and let E be the set of edges of G(n) that have a node in R. Removing R and E from G(n) leaves a graph G'(n) whose nodes are the strict partitions of n, as in A000009. For n >= 5, G'(n) is disconnected.

Examples

			The first 18 rows of T are represented here:
row 1:  1
row 2:  1
row 3:  2
row 4:  2
row 5:  2 1
row 6:  2 2
row 7:  3 2
row 8:  4 2
row 9:  5 2 1
row 10:  6 2 2
row 11:  7 3 2
row 12:  8 5 2
row 13:  9 7 2
row 14:  10 9 2 1
row 15:  12 11 2 2
row 16:  15 12 3 2
row 17:  18 13 5 2
row 18:  22 14 8 2
The 10 nodes and 7 edges of G'(10) are shown here:  [10] - [9,1], [8,2] - [7,2,1], [7,3] - [6,3,1], [7,3] - [7,2,1], [6,4] - [5,4,1], [6,4] - [6,3,1], [5,3,2] - [4,3,2,1]; the three components are as follows:  [8,2] - [7,2,1] - [7,3] - [6,3,1] - [6,4] - [5,4,1]  (6 nodes); [4,3,2,1] - [5,3,2] (2 nodes); [9,1] - [10]] (2 nodes).  Thus, row 10 of the array is 6 2 2.
		

Crossrefs

Cf. A241901, A241150, A000041, A000009.

Programs

Mathematica

(* The first program generates terms of A241900 and A241901. *)
z = 30;  spawn[part_] := Map[Reverse[Sort[Flatten[ReplacePart[part, {# - 1, 1}, Position[part, #, 1, 1][[1]][[1]]]]]] &, DeleteCases[DeleteDuplicates[part], 1]]; findComponent[start_] := Reap[BreadthFirstScan[g, start, {"DiscoverVertex" -> ((PropertyValue[{g, #1}, "Visited"] = True; Sow[#1]) &)}]][[2, 1]]; subGLengths = Join[{{1}}, Table[parts = Select[IntegerPartitions[k], DeleteDuplicates[#] == # &]; graph = Flatten[Table[part = parts[[n]]; Map[{part, #} &, Select[spawn[part], DeleteDuplicates[#] == # &]], {n, 1, Length[parts]}], 1]; isolated = Map[{#, #} &, Map[#[[1]] &, Cases[Map[{#, MemberQ[Flatten[graph, 1], #]} &, parts], {{_}, False}]]]; graph = Join[graph, isolated]; {graph, isolated} = Map[Map[FromDigits[#[[1]]] <-> FromDigits[#[[2]]] &, #] &, {graph, isolated}]; g = Graph[graph]; Do[PropertyValue[{g, v}, "Visited"] = False, {v, VertexList[g]}];
vlists = Reap[Do[If[! PropertyValue[{g, start}, "Visited"], Sow[findComponent[start]]], {start, VertexList[g]}]][[2, 1]]; Reverse[Sort[Map[Length, vlists]]], {k, 2, z}]]; Flatten[%] (* A241900 *)
Map[#[[1]] &, subGLengths] (* A241901, Peter J. C. Moses, Apr 30 2014 *)
(* The next program shows the graph G'(z) for user-chosen z. *)
z = 18; spawn[part_] := Map[Reverse[Sort[Flatten[ReplacePart[part, {# - 1, 1}, Position[part, #, 1, 1][[1]][[1]]]]]] &, DeleteCases[DeleteDuplicates[part], 1]]; findComponent[start_] := Reap[BreadthFirstScan[g, start, {"DiscoverVertex" -> ((PropertyValue[{g, #1}, "Visited"] = True; Sow[#1]) &)}]][[2, 1]]; parts = Select[IntegerPartitions[z], DeleteDuplicates[#] == # &]; graph = Flatten[Table[part = parts[[n]]; Map[{part, #} &, Select[spawn[part], DeleteDuplicates[#] == # &]], {n, 1, Length[parts]}], 1]; isolated = Map[{#, #} &, Map[#[[1]] &, Cases[Map[{#, MemberQ[Flatten[graph, 1], #]} &, parts], {{_}, False}]]]; graph = Join[graph, isolated]; graph = Map[FromDigits[#[[1]]] <-> FromDigits[#[[2]]] &, graph]; isolated = Map[FromDigits[#[[1]]] <-> FromDigits[#[[2]]] &, isolated]; g = Graph[graph, VertexLabels -> "Name", ImageSize -> 500, ImagePadding -> 20, If[Length[isolated] > 0, Apply[EdgeStyle -> {# -> White} &, isolated], EdgeStyle -> "Default"], GraphLayout -> "SpringElectricalEmbedding"] (* Peter J. C. Moses, Apr 30 2014 *)