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">
maxitg · Jan 22, 2021 · d829db6 · d829db6
1 parent 021f360
commit d829db6
Show file tree

Hide file tree

Showing 6 changed files with 169 additions and 0 deletions.
diff --git a/Documentation/Images/AcyclicGraphTakeInput.png b/Documentation/Images/AcyclicGraphTakeInput.png
diff --git a/Documentation/Images/AcyclicGraphTakeOutput.png b/Documentation/Images/AcyclicGraphTakeOutput.png
diff --git a/Documentation/SymbolsAndFunctions/UtilityFunctions/AcyclicGraphTake.md b/Documentation/SymbolsAndFunctions/UtilityFunctions/AcyclicGraphTake.md
@@ -0,0 +1,21 @@
+###### [Symbols and Functions](/README.md#symbols-and-functions) > Utility Functions >
+
+# AcyclicGraphTake
+
+**`AcyclicGraphTake`** gives the intersectiom of the out-component of the first vertex
+with the in-component of the second vertex:
+
+```wl
+In[] := graph = BlockRandom[
+  DirectedGraph[RandomGraph[{10, 10}], "Acyclic", VertexLabels -> Automatic],
+  RandomSeeding -> 2
+]
+```
+
+<img src="/Documentation/Images/AcyclicGraphTakeInput.png" width="478.2">
+
+```wl
+In[] := AcyclicGraphTake[graph, {1, 9}]
+```
+
+<img src="/Documentation/Images/AcyclicGraphTakeOutput.png" width="232.2">
diff --git a/Kernel/AcyclicGraphTake.m b/Kernel/AcyclicGraphTake.m
@@ -0,0 +1,52 @@
+Package["SetReplace`"]
+
+PackageImport["GeneralUtilities`"]
+
+PackageExport["AcyclicGraphTake"]
+
+(* Utility function to check for directed, acyclic graphs *)
+dagQ[graph_] := AcyclicGraphQ[graph] && DirectedGraphQ[graph] && LoopFreeGraphQ[graph]
+
+(* Documentation *)
+SetUsage @ "
+AcyclicGraphTake[gr$, vrts$] gives the intersection in graph gr$ of the in-component of the first vertex in vrts$ \
+with the out-component of the second vertex in vrts$.
+";
+
+(* SyntaxInformation *)
+SyntaxInformation[AcyclicGraphTake] =
+  {"ArgumentsPattern" -> {_, _}};
+
+(* Argument count *)
+AcyclicGraphTake[args___] := 0 /;
+  !Developer`CheckArgumentCount[AcyclicGraphTake[args], 2, 2] && False;
+
+(* main *)
+expr : AcyclicGraphTake[graph_, vertices_] := ModuleScope[
+  res = Catch[acyclicGraphTake[HoldForm @ expr, graph, vertices]];
+  res /; res =!= $Failed
+];
+
+(* Normal form *)
+acyclicGraphTake[_, graph_ ? dagQ, {startVertex_, endVertex_}] /;
+    VertexQ[graph, startVertex] && VertexQ[graph, endVertex] := ModuleScope[
+  Subgraph[graph, Intersection[
+    VertexInComponent[graph, endVertex], VertexOutComponent[graph, startVertex]]]
+]
+
+(* Incorrect arguments messages *)
+AcyclicGraphTake::invalidGraph = "The argument at position `1` in `2` should be a directed, acyclic graph.";
+acyclicGraphTake[expr_, graph_ ? (Not @* dagQ), _] :=
+  (Message[AcyclicGraphTake::invalidGraph, 1, HoldForm @ expr];
+  Throw[$Failed]);
+
+AcyclicGraphTake::invalidVertexList = "The argument at position `1` in `2` should be a list of two vertices.";
+acyclicGraphTake[expr_, _, Except[{_, _}]] :=
+  (Message[AcyclicGraphTake::invalidVertexList, 2, HoldForm @ expr];
+  Throw[$Failed]);
+
+AcyclicGraphTake::invalidVertex = "The argument `1` is not a valid vertex in `2`.";
+acyclicGraphTake[expr_, graph_Graph, {startVertex_, endVertex_}] /;
+    (Not @ (VertexQ[graph, startVertex] && VertexQ[graph, endVertex])) :=
+  (Message[AcyclicGraphTake::invalidVertex, If[VertexQ[graph, startVertex], endVertex, startVertex], HoldForm @ expr];
+  Throw[$Failed]);
diff --git a/README.md b/README.md
@@ -203,6 +203,7 @@ ideas. So, if you are interested, please join!
 * [HypergraphPlot](Documentation/SymbolsAndFunctions/HypergraphPlot.md)
 * [RulePlot of WolframModel](Documentation/SymbolsAndFunctions/RulePlotOfWolframModel.md)
 * Utility Functions
+  * [AcyclicGraphTake](Documentation/SymbolsAndFunctions/UtilityFunctions/AcyclicGraphTake.md)
   * [IndexHypergraph](Documentation/SymbolsAndFunctions/UtilityFunctions/IndexHypergraph.md)
   * [IsomorphicHypergraphQ](Documentation/SymbolsAndFunctions/UtilityFunctions/IsomorphicHypergraphQ.md)
   * [HypergraphToGraph](Documentation/SymbolsAndFunctions/UtilityFunctions/HypergraphToGraph.md)

diff --git a/Tests/AcyclicGraphTake.wlt b/Tests/AcyclicGraphTake.wlt
@@ -0,0 +1,95 @@
+<|
+  "AcyclicGraphTake" -> <|
+    "init" -> (
+      Attributes[Global`testUnevaluated] = {HoldAll};
+      Global`testUnevaluated[args___] := SetReplace`PackageScope`testUnevaluated[VerificationTest, args];
+    ),
+    "tests" -> {
+      (* Verification tests *)
+      VerificationTest[
+        EdgeList[AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 2 -> 4, 3 -> 4, 4 -> 5, 5 -> 6}], {2, 5}]],
+        EdgeList[Graph[{2 -> 3, 2 -> 4, 3 -> 4, 4 -> 5}]]
+      ],
+
+      VerificationTest[
+        EdgeList[AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5}], {2, 5}]],
+        EdgeList[Graph[{2 -> 3, 3 -> 4, 4 -> 5}]]
+      ],
+
+      VerificationTest[
+        AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 3 -> 4}], {1, 1}],
+        Graph[{1}, {}]
+      ],
+
+      VerificationTest[
+        EdgeList[AcyclicGraphTake[Graph[{1 -> 2, 2 -> 3, 4 -> 3}], {1, 4}]],
+        {}
+      ],
+
+      (* unevaluated *)
+
+      (* argument count *)
+      With[{
+        dag = Graph[{1 -> 2, 2 -> 3}],
+        loopGraph = Graph[{1 -> 1, 1 -> 2}],
+        undirectedGraph = Graph[{1 <-> 2, 2 <-> 3}],
+        cyclicGraph = Graph[{1 -> 2, 2 -> 1}]
+      },
+      {
+        testUnevaluated[
+          AcyclicGraphTake[],
+          {AcyclicGraphTake::argrx}
+        ],
+
+        testUnevaluated[
+          AcyclicGraphTake[x],
+          {AcyclicGraphTake::argr}
+        ],
+
+        (* first argument: graph *)
+        testUnevaluated[
+          AcyclicGraphTake[x, ],
+          {AcyclicGraphTake::invalidGraph}
+        ],
+
+        testUnevaluated[
+          AcyclicGraphTake[loopGraph, x],
+          {AcyclicGraphTake::invalidGraph}
+        ],
+
+        testUnevaluated[
+          AcyclicGraphTake[undirectedGraph, x],
+          {AcyclicGraphTake::invalidGraph}
+        ],
+
+        testUnevaluated[
+          AcyclicGraphTake[cyclicGraph, x],
+          {AcyclicGraphTake::invalidGraph}
+        ],
+
+        (* second argument: vertex list *)
+        testUnevaluated[
+          AcyclicGraphTake[dag, x],
+          {AcyclicGraphTake::invalidVertexList}
+        ],
+
+        testUnevaluated[
+          AcyclicGraphTake[dag, {x, y, z}],
+          {AcyclicGraphTake::invalidVertexList}
+        ],
+
+        testUnevaluated[
+          AcyclicGraphTake[dag, {6, 1}],
+          {AcyclicGraphTake::invalidVertex}
+        ],
+
+        testUnevaluated[
+          AcyclicGraphTake[dag, {1, 6}],
+          {AcyclicGraphTake::invalidVertex}
+        ]
+        }
+      ]
+    },
+    "options" -> <|"Parallel" -> False|>
+  |>
+|>