A241901 Number of nodes (partitions) in the largest 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, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 15, 18, 22, 26, 30, 35, 40, 45, 51, 57, 63, 73, 86, 101, 118, 136, 156, 178, 202, 228, 256, 286, 319, 354, 391, 431, 476, 546, 624, 710, 804, 907, 1020, 1143, 1277, 1422
Offset: 1
Examples
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). The largest component has 6 nodes, so that a(10) = 6.
Programs
-
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 *)
Comments