Function Repository Resource:

VertexCleaving

Source Notebook

Clone a vertex of a graph

Contributed by: Alejandra Ortiz Duran

ResourceFunction["VertexCleaving"][g,v]

splits the vertex v of the graph g.

ResourceFunction["VertexCleaving"][g,v,n]

splits the vertex v of the graph g with the new vertex called n.

Details

Vertex cleaving is related to vertex splitting, where one vertex becomes two and the edges of the original get split between the two new vertices.
VertexCleaving splits one vertex into two, where these two vertices are adjacent to the vertices that the original vertex was adjacent to. This is a reverse operation of vertex identification.
VertexCleaving works with undirected graphs, directed graphs, weighted graphs, multigraphs and mixed graphs.
This operation is different from edge splitting as seen in Tutte's Wheel Theorem.

Examples

Basic Examples (1) 

Split a vertex of a graph:

In[1]:=
ResourceFunction["VertexCleaving"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{3, 4, 5, 1}, {Null, 
SparseArray[
         Automatic, {4, 4}, 0, {1, {{0, 2, 4, 6, 8}, {{2}, {4}, {1}, {3}, {2}, {4}, {
            1}, {3}}}, Pattern}]}, {GraphLayout -> {"Dimension" -> 2, "VertexLayout" -> "CircularEmbedding"}, ImageSize -> {67., Automatic}, PerformanceGoal -> "Quality", VertexShapeFunction -> {"Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
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$4", Automatic, Center]}, {
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}, {
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["3", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {-1., 1.0106430996148606`*^-15}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["4", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {-7.044813998280222*^-16, 1.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["5", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1., -1.133107779529596*^-15}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["1", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {6.049014748177263*^-16, -1.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$4"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{-1.0658141036401503`*^-14, 66.}, {-38.878906249999986`, 32.265625000000014`}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FormatType->TraditionalForm,
FrameTicks->None,
ImageSize->{67., Automatic}]\), 4]
Out[1]=

Scope (5) 

Works with undirected graphs:

In[2]:=
ResourceFunction["VertexCleaving"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 3, 4, 5, 6}, {Null, {{1, 2}, {1, 5}, {2, 3}, {3, 4}, {4, 5}, {3, 6}, {
         4, 6}}}, {VertexShapeFunction -> {"Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["1", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {2.411646273071402, 0.8121065824762125}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.7309526984773034`, 1.6154665631452636`}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["3", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.7647124196053587, 1.3112048683327449`}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["4", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.7596612845255981, 0.29540037412003695`}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["5", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.733605567918051, 0.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["6", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0., 0.8156390434469147}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$6"]}, {
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$5", Automatic, Center]}, {
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}, {
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}, {
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}, {
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}, {
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}}]}}], Typeset`data}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        2, Typeset`graph, Typeset`boxes], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {}},
ImageSizeCache->{{0., 98.99999999999999}, {-40.72058321019611, 34.1073019601961}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{Typeset`data}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
ImageMargins->0.]\), 1]
Out[2]=

Directed graphs:

In[3]:=
ResourceFunction["VertexCleaving"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 5, 3, 4, 6}, {{{1, 2}, {1, 3}, {2, 4}, {4, 5}, {5, 3}, {4, 6}, {5, 6}, {6, 4}, {6, 5}, {5, 4}}, Null}, {EdgeStyle -> {
Arrowheads[0.08]}, PerformanceGoal -> "Quality", VertexCoordinates -> {{2.5250697157998934`, 0.7575043438370492}, {1.8686026289525572`, 1.514280326539965}, {1.8692822428969822`, 0.}, {
          1.208492062014356, 1.2147185278284447`}, {1.208227180246839,
           0.2994845613355314}, {0., 0.7572063797178915}}, VertexShapeFunction -> {"Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Arrowheads[0.03102368872258745], 
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], 
Arrowheads[0.08], 
ArrowBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}], 
ArrowBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], 
ArrowBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}], 
ArrowBox[
BezierCurveBox[{
DynamicLocation["VertexID$4", Automatic, Center], {
            1.3344848840593007`, 0.7570650421314713}, 
DynamicLocation["VertexID$5", Automatic, Center]}]], 
ArrowBox[
BezierCurveBox[{
DynamicLocation["VertexID$4", Automatic, Center], {0.6672942154999746,
             0.8194242956092235}, 
DynamicLocation["VertexID$6", Automatic, Center]}]], 
ArrowBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], 
ArrowBox[
BezierCurveBox[{
DynamicLocation["VertexID$5", Automatic, Center], {
            1.0822343582018943`, 0.757138047032505}, 
DynamicLocation["VertexID$4", Automatic, Center]}]], 
ArrowBox[
BezierCurveBox[{
DynamicLocation["VertexID$5", Automatic, Center], {0.5410365116875129,
             0.36184381481328354`}, 
DynamicLocation["VertexID$6", Automatic, Center]}]], 
ArrowBox[
BezierCurveBox[{
DynamicLocation["VertexID$6", Automatic, Center], {0.5411978465143815,
             1.152500611937113}, 
DynamicLocation["VertexID$4", Automatic, Center]}]], 
ArrowBox[
BezierCurveBox[{
DynamicLocation["VertexID$6", Automatic, Center], {0.6671906685593262,
             0.6948471262401396}, 
DynamicLocation["VertexID$5", Automatic, Center]}]]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["1", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {2.5250697157998934`, 0.7575043438370492}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.8686026289525572`, 1.514280326539965}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["5", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.8692822428969822`, 0.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["3", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.208492062014356, 1.2147185278284447`}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["4", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.208227180246839, 0.2994845613355314}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["6", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0., 0.7572063797178915}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$6"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{8.881784197001252*^-16, 99.}, {-37.605359863567244`,
          30.99207861356723}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
GridLinesStyle->Directive[
GrayLevel[0.5, 0.4]]]\), 1]
Out[3]=

Weighted graphs:

In[4]:=
ResourceFunction["VertexCleaving"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 5, 3, 4, 6}, {Null, {{1, 2}, {1, 3}, {2, 4}, {4, 5}, {5, 3}, {4, 6}, {
         5, 6}}}, {VertexLabels -> {6 -> Placed[4.1, Before], 3 -> Placed[1.9, Above], 5 -> Placed[3.1, Below], 4 -> Placed[2.1, Below], 2 -> Placed[10, Above], 1 -> Placed[1.6, After]}, VertexWeight -> {1.6, 10, 1.9, 2.1, 3.1, 4.1}, VertexCoordinates -> {{1.9595652573438145`, 0.5880825319731845}, {1.4502332118640586`, 1.1759717047601015`}, {1.4506626970033527`, 0.}, {
          0.6271580681226379, 0.9434230409725781}, {
          0.6269943909097138, 0.23230866903609504`}, {0., 0.5879767003984426}}}]]}, 
TagBox[GraphicsGroupBox[{
{Hue[0.6, 0.7, 0.5], Opacity[0.7], Arrowheads[0.], ArrowBox[{{{1.9595652573438145`, 0.5880825319731845}, {
           1.4502332118640586`, 1.1759717047601015`}}, {{
           1.9595652573438145`, 0.5880825319731845}, {
           1.4506626970033527`, 0.}}, {{1.4502332118640586`, 1.1759717047601015`}, {0.6271580681226379, 0.9434230409725781}}, {{1.4506626970033527`, 0.}, {
           0.6269943909097138, 0.23230866903609504`}}, {{
           0.6271580681226379, 0.9434230409725781}, {
           0.6269943909097138, 0.23230866903609504`}}, {{
           0.6271580681226379, 0.9434230409725781}, {0., 0.5879767003984426}}, {{0.6269943909097138, 0.23230866903609504`}, {0., 0.5879767003984426}}}, 0.022282533574036062`]}, 
{Hue[0.6, 0.2, 0.8], EdgeForm[{GrayLevel[0], Opacity[
          0.7]}], {
           DiskBox[{1.9595652573438145`, 0.5880825319731845}, 0.022282533574036062], InsetBox["1.6`", Offset[{2, 0}, {1.9818477909178505, 0.5880825319731845}], ImageScaled[{0, 0.5}],
BaseStyle->"Graphics"]}, {
           DiskBox[{1.4502332118640586`, 1.1759717047601015`}, 0.022282533574036062], InsetBox["10", Offset[{0, 2}, {1.4502332118640586, 1.1982542383341375}], ImageScaled[{0.5, 0}],
BaseStyle->"Graphics"]}, {
           DiskBox[{1.4506626970033527`, 0.}, 0.022282533574036062], InsetBox["3.1`", Offset[{0, -2}, {1.4506626970033527, -0.022282533574036062}], ImageScaled[{0.5, 1}],
BaseStyle->"Graphics"]}, {
           DiskBox[{0.6271580681226379, 0.9434230409725781}, 0.022282533574036062], InsetBox["1.9`", Offset[{0, 2}, {0.6271580681226379, 0.9657055745466142}], ImageScaled[{0.5, 0}],
BaseStyle->"Graphics"]}, {
           DiskBox[{0.6269943909097138, 0.23230866903609504`}, 0.022282533574036062], InsetBox["2.1`", Offset[{0, -2}, {0.6269943909097138, 0.21002613546205898}], ImageScaled[{0.5, 1}],
BaseStyle->"Graphics"]}, {
           DiskBox[{0., 0.5879767003984426}, 0.022282533574036062], InsetBox["4.1`", Offset[{-2, 0}, {-0.022282533574036062, 0.5879767003984426}], ImageScaled[{1, 0.5}],
BaseStyle->"Graphics"]}}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False]],
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
GridLinesStyle->Directive[
GrayLevel[0.5, 0.4]],
ImagePadding->15]\), 1]
Out[4]=

Multigraphs:

In[5]:=
ResourceFunction["VertexCleaving"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 5, 3, 4, 6}, {Null, {{1, 2}, {1, 2}, {1, 2}, {1, 3}, {2, 4}, {4, 5}, {
         4, 5}, {5, 3}, {4, 6}, {5, 6}}}, {PerformanceGoal -> "Quality", VertexShapeFunction -> {"Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], FontFamily -> "Arial", 
BezierCurveBox[{
DynamicLocation["VertexID$1", Automatic, Center], {2.091759444786367, 1.0457453609716316`}, 
DynamicLocation["VertexID$2", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}], 
BezierCurveBox[{
DynamicLocation["VertexID$1", Automatic, Center], {2.300473686698988, 1.2265700073078933`}, 
DynamicLocation["VertexID$2", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$3", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}], 
BezierCurveBox[{
DynamicLocation["VertexID$4", Automatic, Center], {0.9339810990703828,
            0.757213318680422}, 
DynamicLocation["VertexID$5", Automatic, Center]}], 
BezierCurveBox[{
DynamicLocation["VertexID$4", Automatic, Center], {0.6815190638396575,
            0.7572714278734384}, 
DynamicLocation["VertexID$5", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], FontFamily -> "Arial", 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["1", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {2.524157226398363, 0.7575214794381879}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.8680759050869926`, 1.514793888841337}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["5", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.868629133928909, 0.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["3", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.8078554994854354, 1.2152430634790714`}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["4", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.8076446634246047, 0.2992416830747889}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["6", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0., 0.757385155560652}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$6"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{0., 98.99999999999999}, {-37.624019192495915`, 31.01073794249593}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
BaseStyle->(FontFamily -> "Arial"),
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
GridLinesStyle->Directive[
GrayLevel[0.5, 0.4]],
LabelStyle->{FontFamily -> "Arial"}]\), 1]
Out[5]=

Mixed graphs:

In[6]:=
ResourceFunction["VertexCleaving"][\!\(\*
GraphicsBox[
NamespaceBox["NetworkGraphics",
DynamicModuleBox[{Typeset`graph = HoldComplete[
Graph[{1, 2, 5, 3, 4, 6}, {{{1, 2}, {1, 3}, {2, 4}, {5, 3}}, {{4, 5}, {4, 6}, {5, 6}}}, {EdgeStyle -> {
Arrowheads[0.08]}, PerformanceGoal -> "Quality", VertexShapeFunction -> {"Name"}}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{
Arrowheads[0.03102368872258745], 
Directive[
Opacity[0.7], 
Hue[0.6, 0.7, 0.5]], FontFamily -> "Arial", 
Arrowheads[0.08], 
ArrowBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$2", Automatic, Center]}], 
ArrowBox[{
DynamicLocation["VertexID$1", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}], 
ArrowBox[{
DynamicLocation["VertexID$2", Automatic, Center], 
DynamicLocation["VertexID$4", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$5", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$4", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}], 
LineBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$6", Automatic, Center]}], 
ArrowBox[{
DynamicLocation["VertexID$5", Automatic, Center], 
DynamicLocation["VertexID$3", Automatic, Center]}]}, {
Directive[
Hue[0.6, 0.2, 0.8], 
EdgeForm[
Directive[
GrayLevel[0], 
Opacity[0.7]]]], FontFamily -> "Arial", 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["1", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {2.5250697157998934`, 0.7575043438370492}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$1"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["2", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.8686026289525572`, 1.514280326539965}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$2"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["5", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {1.8692822428969822`, 0.}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$3"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["3", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.8084920620143559, 1.2147185278284447`}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$4"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["4", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0.808227180246839, 0.2994845613355314}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$5"], 
TagBox[
InsetBox[
BoxData[
FormBox[
PaneBox["6", Alignment -> Center, ImageMargins -> 2], TraditionalForm]], {0., 0.7572063797178915}, BaseStyle -> "Graphics"], "DynamicName", BoxID -> "VertexID$6"]}}], $CellContext`flag}, 
TagBox[
DynamicBox[GraphComputation`NetworkGraphicsBox[
        3, Typeset`graph, Typeset`boxes, $CellContext`flag], {CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}},
ImageSizeCache->{{8.881784197001252*^-16, 93.}, {-35.80626459455571, 29.192983344555692`}}],
MouseAppearanceTag["NetworkGraphics"]],
AllowKernelInitialization->False,
UnsavedVariables:>{$CellContext`flag}]],
BaseStyle->(FontFamily -> "Arial"),
DefaultBaseStyle->{"NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]},
FrameTicks->None,
GridLinesStyle->Directive[
GrayLevel[0.5, 0.4]],
ImageSize->{94., Automatic},
LabelStyle->{FontFamily -> "Arial"}]\), 1]
Out[6]=

Applications (1) 

Consider a network comprising the Florentine families. Following a divorce, a family will bifurcate into two entities, each retaining connections to the same links:

In[7]:=
g = ResourceData["Florentine Families Network"];
In[8]:=
ResourceFunction["VertexCleaving"][g, "Strozzi", "Strozzi2"]
Out[8]=

Requirements

Wolfram Language 13.0 (December 2021) or above

Version History

  • 1.0.0 – 09 December 2024

Related Resources

License Information