Encontre componentes dos k-núcleos

O Mathematica 8 permite que um grafo seja decomposto pela hierarquia em seus k-núcleos usando a função KCoreComponents.
 In[1]:= Xg = \!\(\* GraphicsBox[ NamespaceBox["NetworkGraphics", DynamicModuleBox[{Typeset`graph = HoldComplete[ Graph[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21}, { Null, {{1, 2}, {1, 3}, {1, 4}, {1, 15}, {2, 3}, {2, 4}, {3, 4}, {5, 6}, {5, 7}, {5, 8}, {6, 7}, {6, 8}, {7, 8}, {8, 9}, {8, 10}, {9, 10}, {10, 11}, {10, 12}, {10, 18}, {10, 19}, {11, 12}, {15, 16}, {16, 5}, {16, 17}}}, { VertexSize -> {Large}, VertexCoordinates -> CompressedData[" 1:eJxTTMoPSmViYGAQBWIQjQ7W+ES8qNr22v7PfxC4v38FhL+fBSz7YD97jIix 2rKNeyCqP9hDtTlA+fu1hcV2zXvL5gDW/v/7/jU3L3cfUvlkD7Hrx36I+H+Y PoZrb166Jgr9tP8HFn5ujyr/wz7725dFBp0cDjB5iDiPA0yeAeouGH/WTBDg dYDQO+1h7oLKQ+kHaOJwcAC7v1jgNMxcCM3ocPYMCPA4GIPB5/0A3uZ4bQ== "]}]], Typeset`boxes = GraphicsGroupBox[{{ Directive[ Hue[0.6, 0.2, 0.8], EdgeForm[ Directive[ GrayLevel[0], Opacity[0.7]]]], TagBox[ DiskBox[{0., 0.}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$1"], TagBox[ DiskBox[{0.8660254037844388, -0.4999999999999998}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$2"], TagBox[ DiskBox[{-0.8660254037844384, -0.5000000000000004}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$3"], TagBox[ DiskBox[{-2.4492935982947064`*^-16, 1.}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$4"], TagBox[ DiskBox[{2., -1.}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$5"], TagBox[ DiskBox[{2.866025403784439, -1.4999999999999998`}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$6"], TagBox[ DiskBox[{1.1339745962155616`, -1.5000000000000004`}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$7"], TagBox[ DiskBox[{1.9999999999999998`, 0.}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$8"], TagBox[ DiskBox[{1.5669872981077808`, 0.7499999999999998}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$9"], TagBox[ DiskBox[{1.9999999999999998`, 1.5}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$10"], TagBox[ DiskBox[{3.066987298107781, 0.7499999999999998}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$11"], TagBox[ DiskBox[{3.5, 1.5}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$12"], TagBox[ DiskBox[{-0.5, 1.5}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$13"], TagBox[ DiskBox[{3.7, 0.1}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$14"], TagBox[ DiskBox[{-1., -1.5}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$15"], TagBox[ DiskBox[{0.5, -1.}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$16"], TagBox[ DiskBox[{0., -2.}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$17"], TagBox[ DiskBox[{1., 2.}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$18"], TagBox[ DiskBox[{2.5, 2.5}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$19"], TagBox[ DiskBox[{0.1, 2.2}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$20"], TagBox[ DiskBox[{3.6, -1.2}, 0.12393136749274763`], "DynamicName", BoxID -> "VertexID\$21"]}, { Directive[ Opacity[0.7], Hue[0.6, 0.7, 0.5]], LineBox[{{ DynamicLocation["VertexID\$1", Automatic, Center], DynamicLocation["VertexID\$2", Automatic, Center]}, { DynamicLocation["VertexID\$1", Automatic, Center], DynamicLocation["VertexID\$3", Automatic, Center]}, { DynamicLocation["VertexID\$1", Automatic, Center], DynamicLocation["VertexID\$4", Automatic, Center]}, { DynamicLocation["VertexID\$1", Automatic, Center], DynamicLocation["VertexID\$15", Automatic, Center]}, { DynamicLocation["VertexID\$2", Automatic, Center], DynamicLocation["VertexID\$3", Automatic, Center]}, { DynamicLocation["VertexID\$2", Automatic, Center], DynamicLocation["VertexID\$4", Automatic, Center]}, { DynamicLocation["VertexID\$3", Automatic, Center], DynamicLocation["VertexID\$4", Automatic, Center]}, { DynamicLocation["VertexID\$5", Automatic, Center], DynamicLocation["VertexID\$6", Automatic, Center]}, { DynamicLocation["VertexID\$5", Automatic, Center], DynamicLocation["VertexID\$7", Automatic, Center]}, { DynamicLocation["VertexID\$5", Automatic, Center], DynamicLocation["VertexID\$8", Automatic, Center]}, { DynamicLocation["VertexID\$5", Automatic, Center], DynamicLocation["VertexID\$16", Automatic, Center]}, { DynamicLocation["VertexID\$6", Automatic, Center], DynamicLocation["VertexID\$7", Automatic, Center]}, { DynamicLocation["VertexID\$6", Automatic, Center], DynamicLocation["VertexID\$8", Automatic, Center]}, { DynamicLocation["VertexID\$7", Automatic, Center], DynamicLocation["VertexID\$8", Automatic, Center]}, { DynamicLocation["VertexID\$8", Automatic, Center], DynamicLocation["VertexID\$9", Automatic, Center]}, { DynamicLocation["VertexID\$8", Automatic, Center], DynamicLocation["VertexID\$10", Automatic, Center]}, { DynamicLocation["VertexID\$9", Automatic, Center], DynamicLocation["VertexID\$10", Automatic, Center]}, { DynamicLocation["VertexID\$10", Automatic, Center], DynamicLocation["VertexID\$11", Automatic, Center]}, { DynamicLocation["VertexID\$10", Automatic, Center], DynamicLocation["VertexID\$12", Automatic, Center]}, { DynamicLocation["VertexID\$10", Automatic, Center], DynamicLocation["VertexID\$18", Automatic, Center]}, { DynamicLocation["VertexID\$10", Automatic, Center], DynamicLocation["VertexID\$19", Automatic, Center]}, { DynamicLocation["VertexID\$11", Automatic, Center], DynamicLocation["VertexID\$12", Automatic, Center]}, { DynamicLocation["VertexID\$15", Automatic, Center], DynamicLocation["VertexID\$16", Automatic, Center]}, { DynamicLocation["VertexID\$16", Automatic, Center], DynamicLocation["VertexID\$17", Automatic, Center]}}]}}]}, DynamicBox[GraphComputation`NetworkGraphicsBox[ 1, Typeset`graph, Typeset`boxes], { CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {}}, ImageSizeCache->{{3.920000000000001, 242.08}, {-116.27679999999998`, 112.33726016095989`}}]]], DefaultBaseStyle->{ "NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]}, FrameTicks->None, ImageSize->{247., Automatic}]\);
 In[2]:= XcoordRules = Thread[VertexList[ g] -> (VertexCoordinates /. AbsoluteOptions[g, VertexCoordinates])];
 In[3]:= XshowCores[cores_] := Show[Append[ Graphics /@ Table[Join[{Hue[1 - k/(Length[cores] + 1), .3, .7], Thickness[0.14], CapForm["Round"]}, Line[(List @@ #) /. coordRules] & /@ EdgeList[Subgraph[g, Join @@ cores[[k]]]]], {k, 1, Length[cores]}], HighlightGraph[g, {}, VertexStyle -> EdgeForm[{White, Opacity[1]}], EdgeStyle -> Directive[Thick, Opacity[1], White]]], ImageSize -> 500];
 In[4]:= XshowCores[Table[KCoreComponents[g, k], {k, 1, 3}]]
 Out[4]=