OFFSET
1,3
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.
EXAMPLE
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.
MATHEMATICA
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 *)
CROSSREFS
KEYWORD
nonn,easy,tabf
AUTHOR
Clark Kimberling, May 01 2014
STATUS
approved