Consider the following problem: Assume you have a large list of directed edges, that constitute a large graph. I would like to provide an initial subset of vertices and I need to know which additional vertices I need to select in order to
- make sure that the resulting (sub)-graph is connected
- make sure that I don't have sink/source vertices, i.e. all vertices have at least one incoming and one outgoing edge.
- minimize the number of additional vertices
I don't have a working code (at least not for V8+). But assume the following directed edges:
ex = {"9" -> "7", "4" -> "6", "1" -> "9", "3" -> "5", "10" -> "8",
"5" -> "2", "2" -> "5", "9" -> "3", "3" -> "1", "7" -> "9",
"8" -> "6", "3" -> "10", "2" -> "1", "7" -> "4", "1" -> "4",
"2" -> "7", "5" -> "6", "7" -> "2"};
gr=Graph[ex, VertexLabels -> "Name", ImagePadding -> 20]
Say, we initially choose vertices "1" and "3" and "7", then the subgraph has source/sinks:
Subgraph[gr, {"3", "1", "7"}, VertexLabels -> "Name", ImagePadding -> 20]
Now, a possible completion of the graph without sinks/sources would be:
sgr=Subgraph[gr, {"3", "1", "9", "7"}, VertexLabels -> "Name",
ImagePadding -> 20]
HighlightGraph[gr, sgr]
I understand that this problem might not have a unique solution. Any solution is fine for me. (The upgraded Graph capabilities of V8 are still mostly unexplored area for me, so I apologize for not having a working initial solution. My V7 approach stopped working so I hesitate in postin it here.)
I need to do this for a large set of directed edges (10000+) so performance might be an issue as well.
Edit(new):
Following up on Szabolcs comments & answer the following works very well.
badguys[gr_] := Union[sinks[gr], sources[gr]]
healthyGraph[gr_] := FixedPoint[VertexDelete[#, badguys[#]] &, gr]
completeNetwork::ggraphx = "At least one of the vertices `1` is a sink or source.";
completeNetworkStep[g_?GraphQ, list_] /;
And @@ (MemberQ[VertexList[g], #] & /@ list) := Module[{clist},
(* connect the vertices*)
clist = connect[g, list];
(*remove sinks*)
clist = FixedPoint[step[sinks][g, #] &, clist];
(*remove sources*)
clist = FixedPoint[step[sources][g, #] &, clist]]
completeNetwork[g_?GraphQ, list_] /;
And @@ (MemberQ[VertexList[g], #] & /@ list) := Module[{hgr},
(* clean the network from sinks/sources*)
hgr = healthyGraph[g];
(* check if list of vertices is still part of the healthy graph*)
If[
And @@ (MemberQ[VertexList[hgr], #] & /@ list),
FixedPoint[completeNetworkStep[hgr, #] &, list],
Message[completeNetwork::ggraphx, list]; {}]
]
ShowCompleteSubgraph[g_?GraphQ, list_] :=
HighlightGraph[g, Subgraph[g, completeNetwork[g, list]]]
In many instances the algorithm works very good. Some problems remain though. Consider the following setup:
vertices = {30, 43, 57, 1, 75, 24, 74, 94, 62, 47, 51, 89, 95, 87, 5,
73, 80, 91, 3, 67, 4, 8, 93, 18, 85, 49, 39, 13, 45, 79, 96, 98,
81, 19, 21, 15, 10, 60, 77, 76};
edges = {85 -> 4, 94 -> 95, 45 -> 18, 75 -> 3, 80 -> 30, 15 -> 80,
51 -> 21, 15 -> 43, 13 -> 95, 75 -> 91, 4 -> 30, 95 -> 76,
94 -> 51, 95 -> 21, 30 -> 45, 81 -> 96, 39 -> 13, 89 -> 1, 76 -> 3,
96 -> 47, 67 -> 77, 67 -> 10, 4 -> 24, 57 -> 89, 73 -> 95,
89 -> 51, 45 -> 80, 21 -> 8, 74 -> 73, 98 -> 96, 4 -> 76, 77 -> 79,
43 -> 93, 15 -> 19, 3 -> 57, 76 -> 15, 94 -> 24, 45 -> 15,
75 -> 89, 73 -> 60, 3 -> 49, 98 -> 10, 1 -> 43, 10 -> 15, 49 -> 5,
8 -> 79, 51 -> 10, 60 -> 51, 3 -> 13, 60 -> 43, 96 -> 62, 57 -> 4,
45 -> 95, 67 -> 5, 1 -> 4, 98 -> 30, 39 -> 75, 39 -> 18, 89 -> 75,
89 -> 15, 43 -> 39, 60 -> 10, 91 -> 39, 85 -> 8, 47 -> 89,
57 -> 85, 76 -> 39, 98 -> 95, 51 -> 73, 76 -> 8, 30 -> 49,
87 -> 49, 77 -> 93, 80 -> 21, 96 -> 57, 39 -> 76, 39 -> 30,
62 -> 91, 94 -> 10, 96 -> 81, 95 -> 75, 62 -> 77, 3 -> 87,
43 -> 87, 49 -> 24, 21 -> 87, 94 -> 39, 94 -> 98, 87 -> 89,
5 -> 13, 21 -> 67, 47 -> 5, 62 -> 47, 39 -> 47, 91 -> 60, 96 -> 76,
10 -> 79};
ini1 = {45, 4, 62, 15, 51};
exgr = Graph[edges, VertexLabels -> "Name"];
{{sinks@#, sources@#} &@
Subgraph[exgr, completeNetwork[exgr, ini1]], ini1,
completeNetwork[exgr, ini1]}
{{{}, {96}}, {45, 4, 62, 15, 51}, {1, 4, 15, 21, 30, 43, 45, 47, 51, 57, 62, 76, 87, 89, 96}}
You see that a source vertex (96) remains. The graph looks like
ShowCompleteSubgraph[exgr, completeNetwork[exgr, ini1]]
Apparently, vertex 62 from the initial list has only outgoing edges, except for 96->62. How can we modify the algorithm to open up routes along alternative edges?
7
, just selecting9
would have been enough. Is this correct? 2. Are you strict on condition 3, or an approximation will do? $\endgroup$Show
(e.g.Show@Graph[...]
), then you won't need theImagePadding
workaround to avoid cutting off the vertex names. (I'm still trying to come up with a solution to your question...) $\endgroup$Show@Graph
. $\endgroup$FindShortestPath
or related functions? For question 1, break the subgraph into components, then find a shortest path between two components (using an undirected version ofgr
). Include the path in the subgraph. Repeat until there's only one component in the subgraph. For question 2, find a sink/source, then find a shortest path (in the directed version ofgr
) to any other vertex of the subgraph. Include the shortest path in the subgraph, then repeat until there are no sinks/sources. It won't minimize the added nodes, but it should work ... $\endgroup$