Skip to content

Commit d829db6

Browse files
santiagoginerosantiagoginero
authored
Acyclic graph take (#601)
## Changes * Created the function AcyclicGraphTake which accepts a directed, acyclic graph and a list of two vertices, returning the intersection of the in-component of the first vertex (i.e. start vertex) with the out-component of the second vertex (i.e. end vertex). * Function definition, tests, and documentation are all provided. ## Error checking * The function checks for invalid inputs of the form of the graph not being directed and acyclic, the vertices not being part of the graph, incorrect argument count, among others. ## Examples <img width="696" alt="2021-01-22" src="https://user-images.githubusercontent.com/70669841/105517964-10bfc400-5cae-11eb-8a39-49d12c3e3d56.png"> <img width="215" alt="2021-01-22 (1)" src="https://user-images.githubusercontent.com/70669841/105518136-49f83400-5cae-11eb-80b0-21102bec01ca.png">
1 parent 021f360 commit d829db6

File tree

6 files changed

+169
-0
lines changed

6 files changed

+169
-0
lines changed

‎Documentation/Images/AcyclicGraphTakeInput.png‎

26.1 KB
Loading

‎Documentation/Images/AcyclicGraphTakeOutput.png‎

18.1 KB
Loading

‎Documentation/SymbolsAndFunctions/UtilityFunctions/AcyclicGraphTake.md‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
###### [Symbols and Functions](/README.md#symbols-and-functions) > Utility Functions >
2+
3+
# AcyclicGraphTake
4+
5+
**`AcyclicGraphTake`** gives the intersectiom of the out-component of the first vertex
6+
with the in-component of the second vertex:
7+
8+
```wl
9+
In[] := graph = BlockRandom[
10+
DirectedGraph[RandomGraph[{10, 10}], "Acyclic", VertexLabels -> Automatic],
11+
RandomSeeding -> 2
12+
]
13+
```
14+
15+
<img src="/Documentation/Images/AcyclicGraphTakeInput.png" width="478.2">
16+
17+
```wl
18+
In[] := AcyclicGraphTake[graph, {1, 9}]
19+
```
20+
21+
<img src="/Documentation/Images/AcyclicGraphTakeOutput.png" width="232.2">

‎Kernel/AcyclicGraphTake.m‎

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
Package["SetReplace`"]
2+
3+
PackageImport["GeneralUtilities`"]
4+
5+
PackageExport["AcyclicGraphTake"]
6+
7+
(* Utility function to check for directed, acyclic graphs *)
8+
dagQ[graph_] := AcyclicGraphQ[graph] && DirectedGraphQ[graph] && LoopFreeGraphQ[graph]
9+
10+
(* Documentation *)
11+
SetUsage @ "
12+
AcyclicGraphTake[gr$, vrts$] gives the intersection in graph gr$ of the in-component of the first vertex in vrts$ \
13+
with the out-component of the second vertex in vrts$.
14+
";
15+
16+
(* SyntaxInformation *)
17+
SyntaxInformation[AcyclicGraphTake] =
18+
{"ArgumentsPattern" -> {_, _}};
19+
20+
(* Argument count *)
21+
AcyclicGraphTake[args___] := 0 /;
22+
!Developer`CheckArgumentCount[AcyclicGraphTake[args], 2, 2] && False;
23+
24+
(* main *)
25+
expr : AcyclicGraphTake[graph_, vertices_] := ModuleScope[
26+
res = Catch[acyclicGraphTake[HoldForm @ expr, graph, vertices]];
27+
res /; res =!= $Failed
28+
];
29+
30+
(* Normal form *)
31+
acyclicGraphTake[_, graph_ ? dagQ, {startVertex_, endVertex_}] /;
32+
VertexQ[graph, startVertex] && VertexQ[graph, endVertex] := ModuleScope[
33+
Subgraph[graph, Intersection[
34+
VertexInComponent[graph, endVertex], VertexOutComponent[graph, startVertex]]]
35+
]
36+
37+
(* Incorrect arguments messages *)
38+
AcyclicGraphTake::invalidGraph = "The argument at position `1` in `2` should be a directed, acyclic graph.";
39+
acyclicGraphTake[expr_, graph_ ? (Not @* dagQ), _] :=
40+
(Message[AcyclicGraphTake::invalidGraph, 1, HoldForm @ expr];
41+
Throw[$Failed]);
42+
43+
AcyclicGraphTake::invalidVertexList = "The argument at position `1` in `2` should be a list of two vertices.";
44+
acyclicGraphTake[expr_, _, Except[{_, _}]] :=
45+
(Message[AcyclicGraphTake::invalidVertexList, 2, HoldForm @ expr];
46+
Throw[$Failed]);
47+
48+
AcyclicGraphTake::invalidVertex = "The argument `1` is not a valid vertex in `2`.";
49+
acyclicGraphTake[expr_, graph_Graph, {startVertex_, endVertex_}] /;
50+
(Not @ (VertexQ[graph, startVertex] && VertexQ[graph, endVertex])) :=
51+
(Message[AcyclicGraphTake::invalidVertex, If[VertexQ[graph, startVertex], endVertex, startVertex], HoldForm @ expr];
52+
Throw[$Failed]);

‎README.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -203,6 +203,7 @@ ideas. So, if you are interested, please join!
203203
* [HypergraphPlot](Documentation/SymbolsAndFunctions/HypergraphPlot.md)
204204
* [RulePlot of WolframModel](Documentation/SymbolsAndFunctions/RulePlotOfWolframModel.md)
205205
* Utility Functions
206+
* [AcyclicGraphTake](Documentation/SymbolsAndFunctions/UtilityFunctions/AcyclicGraphTake.md)
206207
* [IndexHypergraph](Documentation/SymbolsAndFunctions/UtilityFunctions/IndexHypergraph.md)
207208
* [IsomorphicHypergraphQ](Documentation/SymbolsAndFunctions/UtilityFunctions/IsomorphicHypergraphQ.md)
208209
* [HypergraphToGraph](Documentation/SymbolsAndFunctions/UtilityFunctions/HypergraphToGraph.md)

‎Tests/AcyclicGraphTake.wlt‎

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
<|
2+
"AcyclicGraphTake" -> <|
3+
"init" -> (
4+
Attributes[Global`testUnevaluated] = {HoldAll};
5+
Global`testUnevaluated[args___] := SetReplace`PackageScope`testUnevaluated[VerificationTest, args];
6+
),
7+
"tests" -> {
8+
(* Verification tests *)
9+
VerificationTest[
10+
EdgeList[AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 2 -> 4, 3 -> 4, 4 -> 5, 5 -> 6}], {2, 5}]],
11+
EdgeList[Graph[{2 -> 3, 2 -> 4, 3 -> 4, 4 -> 5}]]
12+
],
13+
14+
VerificationTest[
15+
EdgeList[AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5}], {2, 5}]],
16+
EdgeList[Graph[{2 -> 3, 3 -> 4, 4 -> 5}]]
17+
],
18+
19+
VerificationTest[
20+
AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 3 -> 4}], {1, 1}],
21+
Graph[{1}, {}]
22+
],
23+
24+
VerificationTest[
25+
EdgeList[AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 4 -> 3}], {1, 4}]],
26+
{}
27+
],
28+
29+
(* unevaluated *)
30+
31+
(* argument count *)
32+
With[{
33+
dag = Graph[{1 -> 2, 2 -> 3}],
34+
loopGraph = Graph[{1 -> 1, 1 -> 2}],
35+
undirectedGraph = Graph[{1 <-> 2, 2 <-> 3}],
36+
cyclicGraph = Graph[{1 -> 2, 2 -> 1}]
37+
},
38+
{
39+
testUnevaluated[
40+
AcyclicGraphTake[],
41+
{AcyclicGraphTake::argrx}
42+
],
43+
44+
testUnevaluated[
45+
AcyclicGraphTake[x],
46+
{AcyclicGraphTake::argr}
47+
],
48+
49+
(* first argument: graph *)
50+
testUnevaluated[
51+
AcyclicGraphTake[x, ],
52+
{AcyclicGraphTake::invalidGraph}
53+
],
54+
55+
testUnevaluated[
56+
AcyclicGraphTake[loopGraph, x],
57+
{AcyclicGraphTake::invalidGraph}
58+
],
59+
60+
testUnevaluated[
61+
AcyclicGraphTake[undirectedGraph, x],
62+
{AcyclicGraphTake::invalidGraph}
63+
],
64+
65+
testUnevaluated[
66+
AcyclicGraphTake[cyclicGraph, x],
67+
{AcyclicGraphTake::invalidGraph}
68+
],
69+
70+
(* second argument: vertex list *)
71+
testUnevaluated[
72+
AcyclicGraphTake[dag, x],
73+
{AcyclicGraphTake::invalidVertexList}
74+
],
75+
76+
testUnevaluated[
77+
AcyclicGraphTake[dag, {x, y, z}],
78+
{AcyclicGraphTake::invalidVertexList}
79+
],
80+
81+
testUnevaluated[
82+
AcyclicGraphTake[dag, {6, 1}],
83+
{AcyclicGraphTake::invalidVertex}
84+
],
85+
86+
testUnevaluated[
87+
AcyclicGraphTake[dag, {1, 6}],
88+
{AcyclicGraphTake::invalidVertex}
89+
]
90+
}
91+
]
92+
},
93+
"options" -> <|"Parallel" -> False|>
94+
|>
95+
|>

0 commit comments

Comments
 (0)