# Return to Answer

 5 added 52 characters in body edited Aug 11 '15 at 17:58 Passing By 15622 bronze badges I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This does not yieldUpdate As kindly suggested by halmir below, the nice pictureresulting graph can be displayed just as in your example. It is therefore hard to verify if using the answer is correct by looking at it. Some vertices seem to have more then 3 edges (for instance 1). You can check however withoption VertexDegreeGraphLayout -> "TutteEmbedding" that all vertices have indeed 3 edges. g = Graph[{1 <-> 2, 1 <-> 3, 1 <-> 4, 2 <-> 3, 2 <-> 4, 3 <-> 4}, VertexLabels -> "Name", GraphLayout -> "TutteEmbedding"]; replaceTripods[g]  I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This does not yield the nice picture as in your example. It is therefore hard to verify if the answer is correct by looking at it. Some vertices seem to have more then 3 edges (for instance 1). You can check however with VertexDegree that all vertices have indeed 3 edges. I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. Update As kindly suggested by halmir below, the resulting graph can be displayed just as in your example using the option GraphLayout -> "TutteEmbedding". g = Graph[{1 <-> 2, 1 <-> 3, 1 <-> 4, 2 <-> 3, 2 <-> 4, 3 <-> 4}, VertexLabels -> "Name", GraphLayout -> "TutteEmbedding"]; replaceTripods[g] 4 deleted 5 characters in body edited Aug 9 '15 at 19:40 Passing By 15622 bronze badges I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This does not yield the nice picture as in your example. It is therefore hard to verify if the answer is correct by looking at it. Some vertices seem to have more then 3 edges (for instance 1). You can check however with VertexDegree that all vertices have indeed 3 edges. I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This does not yield the nice picture as in your example. It is therefore hard to verify if the answer is correct by looking at it. I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This does not yield the nice picture as in your example. It is therefore hard to verify if the answer is correct by looking at it. Some vertices seem to have more then 3 edges (for instance 1). You can check however with VertexDegree that all vertices have indeed 3 edges. 3 deleted 5 characters in body edited Aug 9 '15 at 19:34 Passing By 15622 bronze badges I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This yields adoes not soyield the nice a picture as in your example. It is therefore hard to verify if the answer is correct by looking at it. I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This yields a not so nice a picture as in your example. It is hard to verify if the answer is correct. I have used the functions EdgeDelete and EdgeAdd to expand the graph. The code generates new vertex names by incrementing the largest vertex name in the graph. nextVertexNames[g_] := Max[VertexList[g]] + {{1, 2, 3}, {4, 5, 6}} replaceTripod[g_, v_] := Module[{ oldNeighbors = DeleteCases[VertexComponent[g, v, 1], v], newNeighbors = nextVertexNames[g], go = g }, EdgeAdd[ EdgeDelete[go, v <-> _], Flatten@{ UndirectedEdge[v, #] & /@ First[newNeighbors], UndirectedEdge @@@ Partition[Riffle @@ newNeighbors, {2}, 1, 1], UndirectedEdge @@@ Thread[{Last@newNeighbors, oldNeighbors}]} ] ] replaceTripods[g_] := Fold[replaceTripod, g, Extract[VertexList[g], Position[VertexDegree[g], 3]]];  For your case, use replaceTripods[g] to replace all tripods in the graph g. This does not yield the nice picture as in your example. It is therefore hard to verify if the answer is correct by looking at it. 2 added 194 characters in body edited Aug 9 '15 at 19:26 Passing By 15622 bronze badges 1 answered Aug 9 '15 at 19:20 Passing By 15622 bronze badges