How can I preserve the properties of edges of the original graph $g$ in a subgraph that doesn't include every edge of $g$?
When you have the edges you would like to keep in your sub-graph, then you can select exactly the EdgeStyle
's for those. In the following I use Select
and MemberQ
to select only the style for the edges which are in the sub-graph too. Additionally, I include all other options which were set in the original g
.
A function which creates a sub-graph by using a notation equivalent to Part
could look like this
GraphPart[g_Graph, edges_List] :=
With[{newEdges = EdgeList[g][[edges]]},
Graph[newEdges,
Sequence @@ DeleteCases[Options[g], EdgeStyle -> _],
EdgeStyle ->
Select[EdgeStyle /. Options[g, EdgeStyle],
MemberQ[newEdges, First[#]] &]
]
]
Test with your example
g = CompleteGraph[3, VertexLabels -> "Name", ImagePadding -> 10];
PropertyValue[{g, 1 \[UndirectedEdge] 2}, EdgeStyle] = Red;
PropertyValue[{g, 1 \[UndirectedEdge] 3}, EdgeStyle] = Green;
PropertyValue[{g, 2 \[UndirectedEdge] 3}, EdgeStyle] = Blue;
GraphPart[g, {1, 3}]
If you want to be able to call your function in the following way {{2,1},{2,3}}
with the meaning include the edge connecting vertices 1 and 2 and vertices 2 and 3 you can change the above implementation:
GraphPart[g_Graph, edges_List] := With[{newEdges =
Select[EdgeList[g], MemberQ[Join[edges, Reverse /@ edges], List @@ #] &]},
Graph[newEdges,
Sequence @@ DeleteCases[Options[g], EdgeStyle -> _],
EdgeStyle ->
Select[EdgeStyle /. Options[g, EdgeStyle], MemberQ[newEdges, First[#]] &]]
]
And now you can call GraphPart[g, {{2, 1}, {3, 2}}]
without paying attention to the order. The most important part is the 2nd line in the above code. This extracts all matching edges even if the are reversed.
ClearAll[f1];
f1 = EdgeDelete[#2, Complement[EdgeList[#2], #]] &;
Example:
e = {1 <-> 2, 2 <-> 3};
gA = CompleteGraph[3, VertexLabels -> "Name", ImagePadding -> 20];
gA = SetProperty[{g, 2}, {VertexStyle -> Purple,
VertexLabels -> Placed["Name", Center],
VertexSize -> .15, VertexLabelStyle -> Directive[White, Italic, 20]}];
PropertyValue[{g, 1 <-> 2}, EdgeStyle] = Directive[{Thick, Red}];
PropertyValue[{g, 1 <-> 3}, EdgeStyle] = Green;
PropertyValue[{g, 2 <-> 3}, EdgeStyle] = Blue;
Row[{gA, f1[e, gA]}, Spacer[5]]
Additional alternatives:
ClearAll[f2,f3];
f2 = Graph[#, FilterRules[Options[#2], Except[EdgeStyle]],
EdgeStyle -> FilterRules[EdgeStyle /. Options[#2, EdgeStyle], #]] &;
f3 = With[{el = #, gr = #2}, Graph[el, FilterRules[Options[gr], Except[EdgeStyle]],
EdgeStyle -> (# -> PropertyValue[{gr, #}, EdgeStyle] & /@ el)]] &;
Example:
e = {1 <-> 2, 2 <-> 3};
g = CompleteGraph[3, VertexLabels -> "Name", ImagePadding -> 10];
PropertyValue[{g, 1 <-> 2}, EdgeStyle] = Red;
PropertyValue[{g, 1 <-> 3}, EdgeStyle] = Green;
PropertyValue[{g, 2 <-> 3}, EdgeStyle] = Blue;
Row[Through@{f1, f2, f3}[e, g], Spacer[5]]