Áreas de aplicación

Encuentre componentes de núcleo K 

In[2]:=

X g = \!\(\* 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[3]:=

X coordRules = Thread[VertexList[ g] -> (VertexCoordinates /. AbsoluteOptions[g, VertexCoordinates])];

In[4]:=

X showCores[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[5]:=

X showCores[Table[KCoreComponents[g, k], {k, 1, 3}]]

Out[1]=

Out[5]=