maxitg · daneelsan · Jul 23, 2021 · Jul 24, 2021 · Jul 26, 2021 · Jul 28, 2021
diff --git a/Documentation/Images/Hypergraph.png b/Documentation/Images/Hypergraph.png
diff --git a/Documentation/Images/HypergraphCyclic.png b/Documentation/Images/HypergraphCyclic.png
diff --git a/Documentation/Images/HypergraphPartError.png b/Documentation/Images/HypergraphPartError.png
diff --git a/Documentation/SymbolsAndFunctions/Hypergraph.md b/Documentation/SymbolsAndFunctions/Hypergraph.md
@@ -0,0 +1,98 @@
+###### [Symbols and Functions](/README.md#symbols-and-functions) >
+
+# Hypergraph
+
+[HypergraphQ](#hypergraphq) | [HypergraphSymmetry](#hypergraphsymmetry)
+
+**`Hypergraph[...]`** represents a hypergraph object:
+
+```wl
+In[] := Hypergraph[{{1, 1, 2}}]
+```
+
+<img src="/Documentation/Images/Hypergraph.png" width="484.2">
+
+`Hypergraph` follows the footsteps of [Graph](http://reference.wolfram.com/language/ref/Graph.html), in that the
+`Hypergraph` symbol acts both as a constructor and as an object.
+
+The second argument of `Hypergraph` specifies the global [symmetry](#hypergraphsymmetry) of its hyperedges.
+
+```wl
+In[] := Hypergraph[{{1, 1, 2}}, "Cyclic"]
+```
+
+<img src="/Documentation/Images/HypergraphCyclic.png" width="502.2">
+
+If left unspecified, the default symmetry is `"Ordered"`:
+
+```wl
+In[] := Hypergraph[{{1, 1, 2}}] === Hypergraph[{{1, 1, 2}}, "Ordered"]
+Out[] = True
+```
+
+`Hypergraph` objects are atomic raw objects:
+
+```wl
+In[] := AtomQ[Hypergraph[{{1, 1, 1}}]]
+Out[] = True
+```
+
+Given their atomic nature, [parts](http://reference.wolfram.com/language/ref/Part.html) of a `Hypergraph` object
+cannot be extracted:
+
+```wl
+In[] := Hypergraph[{{1, 1, 1}}][[1]]
+```
+
+<img src="/Documentation/Images/HypergraphPartError.png" width="803.4">
+
+For this reason, the following accesor functions are supported:
+
+```wl
+In[] := hg = Hypergraph[{{1, 1, 2}, {2, 5, 4, 3}, {3, 6}}, "Unordered"];
+```
+
+- [`EdgeList`](http://reference.wolfram.com/language/ref/EdgeList.html) - the list of (hyper)edges in the hypergraph:
+
+  ```wl
+  In[] := EdgeList[hg]
+  Out[] = {{1, 1, 2}, {2, 5, 4, 3}, {3, 6}}
+  ```
+
+- [`VertexList`](http://reference.wolfram.com/language/ref/VertexList.html)- the list of vertices and in the
+  hypergraph:
+
+  ```wl
+  In[] := VertexList[hg]
+  Out[] = {1, 2, 5, 4, 3, 6}
+  ```
+
+- [`HypergraphSymmetry`](#hypergraphsymmetry) - the hypergraph symmetry:
+
+  ```wl
+  In[]:= HypergraphSymmetry[hg]
+  Out[]= "Unordered"
+  ```
+
+## HypergraphQ
+
+**`HypergraphQ[hg]`** returns True if `hg` is a valid [`Hypergraph`](#hypergraph) object and False otherwise:
+
+```wl
+In[] := HypergraphQ[Hypergraph[{{1, 1, 2}}]]
+Out[] = True
+```
+
+```wl
+In[] := Quiet @ HypergraphQ[Hypergraph[1]]
+Out[] = False
+```
+
+## HypergraphSymmetry
+
+A (global) hypergraph symmetry specifies the type of permutation under which each hyperedge of the hypergraph is
+considered invariant.
+
+- Ordered:
+- Unordered:
+- Cyclic:
diff --git a/Kernel/Hypergraph.m b/Kernel/Hypergraph.m
@@ -0,0 +1,135 @@
+Package["SetReplace`"]
+
+PackageImport["GeneralUtilities`"]
+
+PackageExport["Hypergraph"]
+PackageExport["HypergraphQ"]
+PackageExport["HypergraphSymmetry"]
+
+SetRelatedSymbolGroup[Hypergraph, HypergraphQ, HypergraphSymmetry, EdgeList, VertexList];
+
+(* HypergraphQ *)
+
+SetUsage @ "HypergraphQ[hg$] yields True if hg$ is a valid Hypergraph object and False otherwise.";
+
+SyntaxInformation[HypergraphQ] = {"ArgumentsPattern" -> {expr_}};
+
+HypergraphQ[expr_Hypergraph] := System`Private`HoldNoEntryQ[expr];
+HypergraphQ[_] = False;
+
+(* HypergraphSymmetry *)
+
+$hypergraphSymmetries = {"Ordered", "Unordered", "Cyclic"(*, "Directed"*)};
+
+SetUsage @ "HypergraphSymmetry[hg$] returns the symmetry of the hypergraph hg$.";
+
+SyntaxInformation[HypergraphSymmetry] = {"ArgumentsPattern" -> {hypergraph_}};
+
+HypergraphSymmetry[HoldPattern[Hypergraph[hyperedges_, symmetry_] ? HypergraphQ]] := symmetry;
+
+(* Hypergraph *)
+
+SetUsage[Hypergraph, "
+Hypergraph[{he$1, he$2, $$}] yields an ordered hypergraph with hyperedges he$j.
+Hypergraph[$$, sym$] returns a hypergraph with symmetry sym$.
+* Valid hypergraph symmetries include: " <> listToSentence[$hypergraphSymmetries] <> ".
+"];
+
+SyntaxInformation[Hypergraph] = {"ArgumentsPattern" -> {hyperedges_, symmetry_.}};
+
+With[{symmetries = $hypergraphSymmetries},
+  FE`Evaluate[FEPrivate`AddSpecialArgCompletion["Hypergraph" -> {0, symmetries}]]
+];
+
+Hypergraph /: Information`GetInformation[obj_Hypergraph ? HypergraphQ] :=
+  <|
+    "ObjectType" -> Hypergraph,
+    "Symmetry" -> HypergraphSymmetry[obj],
+    "VertexCount" -> VertexCount[obj],
+    "EdgeCount" -> EdgeCount[obj],
+    "Functions" -> Sort @ {
+      EdgeCount,
+      EdgeList,
+      HypergraphSymmetry,
+      Information,
+      Normal,
+      SameQ,
+      VertexCount,
+      VertexList
+    }
+  |>;
+
+((expr : Hypergraph[args___]) ? System`Private`HoldEntryQ) /; CheckArguments[expr, {1, 2}] :=
+  With[{
+      result = Catch[hypergraph[args],
+                     _ ? FailureQ,
+                     message[Hypergraph, #, <|"expr" -> HoldForm[expr]|>] &]
+    },
+    result /; !FailureQ[result]
+  ];
+
+hypergraph[hyperedges_] := hypergraph[hyperedges, "Ordered"];
+
+hypergraph[hyperedges : {___List}, symmetry : Alternatives @@ $hypergraphSymmetries] :=
+  System`Private`ConstructNoEntry[Hypergraph, hyperedges, symmetry];
+
+declareMessage[Hypergraph::invalidHyperedges,
+               "The argument at position 1 in `expr` should be a list of of lists."];
+
+hypergraph[hyperedges_, symmetry : Alternatives @@ $hypergraphSymmetries] :=
+  throw[Failure["invalidHyperedges", <||>]];
+
+declareMessage[Hypergraph::invalidSymmetry,
+               "The argument at position 2 in `expr` should be a supported symmetry: `symmetries`."];
+
+hypergraph[hyperedges_, symmetry_] :=
+  throw[Failure["invalidSymmetry", <|"symmetries" -> $hypergraphSymmetries|>]];
+
+(* Accessors *)
+
+Hypergraph /: EdgeList[HoldPattern[Hypergraph[hyperedges_, _] ? HypergraphQ]] := hyperedges;
+
+Hypergraph /: EdgeCount[hg_Hypergraph ? HypergraphQ] := Length[EdgeList[hg]];
+
+Hypergraph /: VertexList[hg_Hypergraph ? HypergraphQ] := DeleteDuplicates[Catenate[EdgeList[hg]]];
+
+Hypergraph /: VertexCount[hg_Hypergraph ? HypergraphQ] := Length[VertexList[hg]];
+
+(* Normal *)
+
+Hypergraph /: Normal[hg_Hypergraph ? HypergraphQ] := EdgeList[hg];
+
+(* SameQ *)
+
+Hypergraph /: SameQ[hg1_Hypergraph, hg2_Hypergraph] := Normal[hg1] === Normal[hg2];
+
+(* Boxes *)
+
+disablePlotQ = TrueQ[EdgeCount[#] > 100] &;
+
+$iconSize = Dynamic[{Automatic, 3.5` CurrentValue["FontCapHeight"]/ AbsoluteCurrentValue[Magnification]}];
+
+getIcon[hg_] /; (!disablePlotQ[hg] && MemberQ[$edgeTypes, HypergraphSymmetry[hg]]) :=
+  HypergraphPlot[EdgeList[hg], HypergraphSymmetry[hg], ImageSize -> $iconSize];
+
+getIcon[_] = style[$lightTheme][$evolutionObjectIcon];
+
+Hypergraph /: MakeBoxes[hg_Hypergraph ? HypergraphQ, fmt_] :=
+  Module[{collapsed, expanded},
+    collapsed = BoxForm`SummaryItem /@ {
+      {"VertexCount: ", VertexCount[hg]},
+      {"EdgeCount: ", EdgeCount[hg]}
+    };
+    expanded = BoxForm`SummaryItem /@ {
+      {"Symmetry: ", HypergraphSymmetry[hg]}
+    };
+    BoxForm`ArrangeSummaryBox[
+      Hypergraph,
+      hg,
+      getIcon[hg],
+      collapsed,
+      expanded,
+      fmt,
+      "Interpretable" -> True
+    ]
+  ];
diff --git a/README.md b/README.md
diff --git a/Tests/Hypergraph.wlt b/Tests/Hypergraph.wlt
@@ -0,0 +1,72 @@
+<|
+  "HypergraphPlot" -> <|
+    "init" -> (
+      Attributes[Global`testUnevaluated] = Attributes[Global`testSymbolLeak] = {HoldAll};
+      Global`testUnevaluated[args___] := SetReplace`PackageScope`testUnevaluated[VerificationTest, args];
+      Global`testSymbolLeak[args___] := SetReplace`PackageScope`testSymbolLeak[VerificationTest, args];
+
+      Global`$hypergraphSymmetries = SetReplace`Hypergraph`PackagePrivate`$hypergraphSymmetries;
+    ),
+    "tests" -> {
+      (* Argument Checks *)
+
+      (** Argument count **)
+
+      testUnevaluated[
+        Hypergraph[],
+        {Hypergraph::argt}
+      ],
+
+      testUnevaluated[
+        Hypergraph[{{1, 1, 1}}, "Ordered", 1],
+        {Hypergraph::argt}
+      ],
+
+      (** 1st argument **)
+
+      testUnevaluated[
+        Hypergraph[{1, 1, 1}],
+        {Hypergraph::invalidHyperedges}
+      ],
+
+      (** 2nd argument **)
+
+      testUnevaluated[
+        Hypergraph[{{1, 1, 1}}, "Directed"],
+        {Hypergraph::invalidSymmetry}
+      ],
+
+      (* Constructor *)
+
+      VerificationTest[HypergraphQ[Hypergraph[{{1, 1, 1}}]]],
+
+      VerificationTest[HypergraphQ[Hypergraph[{{1, {1}}, {{1}, x, y}}]]],
+
+      (* Default 2nd argument *)
+
+      VerificationTest[Hypergraph[{{1}}] === Hypergraph[{{1}}, "Ordered"]],
+
+      (* Available symmetries *)
+
+      VerificationTest[AllTrue[Hypergraph[{{1}}, #] & /@ $hypergraphSymmetries, HypergraphQ]],
+
+      (* Accessors *)
+
+      With[{hg = Hypergraph[{{1, 1, 2}, {2, 5, 4, 3}, {3, 6}}, "Unordered"]},
+        {
+            VerificationTest[VertexList[hg], {1, 2, 5, 4, 3, 6}],
+
+            VerificationTest[EdgeList[hg], {{1, 1, 2}, {2, 5, 4, 3}, {3, 6}}],
+
+            VerificationTest[Normal[hg], EdgeList[hg]],
+
+            VerificationTest[VertexCount[hg] === Length[VertexList[hg]] === 6],
+
+            VerificationTest[EdgeCount[hg] === Length[EdgeList[hg]] === 3],
+
+            VerificationTest[HypergraphSymmetry[hg], "Unordered"]
+        }
+      ]
+    }
+  |>
+|>