RandomHypergraph (#511)

## Changes * Close #510. * Implements `RandomHypergraph` function. ## Comments * Missing option `"Connected" -> True` to specifically generate random connected hypergraphs. ## Examples ```wl In[] := SeedRandom[2]; RandomHypergraph[8] Out[] = {{2, 3}, {8}, {1, 6}, {7, 7}, {1}} In[] := RandomHypergraph[8, 10] Out[] = {{3, 7, 7}, {1, 7}, {10, 2, 6}} In[] := RandomHypergraph[{5, 2}] Out[] = {{5, 1}, {10, 7}, {9, 3}, {3, 2}, {4, 6}} In[] := RandomHypergraph[{{5, 2}, {4, 3}}, 2] Out[] = {{1, 1}, {1, 1}, {2, 2}, {1, 1}, {1, 2}, {1, 2, 2}, {1, 1, 2}, {1, 2, 2}, {2, 1, 1}} ``` ```wl In[]:= SeedRandom[111]; Grid[Partition[ Table[Labeled[WolframModelPlot@#, # -> i] &[ RandomHypergraph[i]], {i, 1, 12}], 3, 3, 1], Frame -> All] ``` ![image](https://user-images.githubusercontent.com/40190339/98330685-e886ca00-1fc8-11eb-92ab-1aca157be21c.png) ## Documentation ![image](https://user-images.githubusercontent.com/40190339/98401650-05a4b280-2034-11eb-9ae3-fd2b14f17c46.png)  --- This change is [<img src="https://reviewable.io/review_button.svg" height="34" align="absmiddle" alt="Reviewable"/>](https://reviewable.io/reviews/maxitg/setreplace/511)
maxitg · Nov 9, 2020 · d3e9126 · d3e9126
1 parent ccb52a0
commit d3e9126
Show file tree

Hide file tree

Showing 4 changed files with 290 additions and 1 deletion.
diff --git a/Documentation/SymbolsAndFunctions/UtilityFunctions/RandomHypergraph.md b/Documentation/SymbolsAndFunctions/UtilityFunctions/RandomHypergraph.md
@@ -0,0 +1,41 @@
+###### [Symbols and Functions](/README.md#symbols-and-functions) > Utility Functions >
+
+# RandomHypergraph
+
+**`RandomHypergraph`** generates a random hypergraph. The first argument specifies either the hypergraph "complexity" or its signature. The second (optional) argument is the maximum possible number of distinct vertices of said hypergraph.
+
+Pass a positive integer `n` to generate a hypergraph where the total of all hyperedge arities is `n`:
+
+```wl
+In[] := RandomHypergraph[15]
+Out[] = {{5, 14, 13}, {8}, {4}, {7, 13}, {15}, {13, 12, 4, 14}, {14, 2}, {12}}
+```
+
+```wl
+In[] := Total[Length /@ %]
+Out[] = 15
+```
+
+Generate a random hypergraph with the same complexity but with at most 20 distinct vertices:
+```wl
+In[] := RandomHypergraph[15, 20]
+Out[] = {{14, 17, 11, 10}, {6}, {13, 12, 17}, {1}, {1, 12}, {3, 20, 12, 17}}
+```
+
+Pass `sig` to generate a hypergraph with `sig` as its signature:
+```wl
+In[] := RandomHypergraph[{5, 2}]
+Out[] = {{4, 3}, {2, 8}, {5, 7}, {9, 5}, {4, 7}}
+```
+
+A signature with multiple arities also works:
+```wl
+In[] := RandomHypergraph[{{5, 2}, {4, 3}}]
+Out[] = {{10, 22}, {18, 6}, {3, 19}, {1, 14}, {21, 2}, {11, 19, 20}, {11, 8, 3}, {18, 20, 3}, {3, 17, 17}}
+```
+
+Restrict this hypergraph to have `{1, 2}` as its vertex list:
+```wl
+In[] := RandomHypergraph[{{5, 2}, {4, 3}}, 2]
+Out[] = {{1, 1}, {1, 2}, {1, 2}, {2, 1}, {2, 1}, {2, 2, 2}, {1, 1, 2}, {1, 1, 2}, {1, 1, 1}}
+```
diff --git a/Kernel/RandomHypergraph.m b/Kernel/RandomHypergraph.m
@@ -0,0 +1,80 @@
+Package["SetReplace`"]
+
+PackageImport["GeneralUtilities`"]
+
+PackageExport["RandomHypergraph"]
+
+(* Documentation *)
+RandomHypergraph::usage = "\
+RandomHypergraph[n$] generates a random hypergraph, where n$ is the total of its hyperedge arities.
+RandomHypergraph[{e$, a$}] generates a random hypergraph with e$ hyperedges of arity a$.
+RandomHypergraph[{{e$(1), a$(1)}, {e$(2), a$(2)}, $$}] generates a random hypergraph with e$(i) hyperedges \
+of arity a$(i).
+RandomHypergraph[sig$, max$] generates a random hypergraph with at most max$ vertices.";
+
+SetUsage[RandomHypergraph, RandomHypergraph::usage];
+
+(* SyntaxInformation *)
+SyntaxInformation[RandomHypergraph] =
+  {"ArgumentsPattern" -> {_, _.}};
+
+(* Argument count *)
+RandomHypergraph[args___] := 0 /;
+  !Developer`CheckArgumentCount[RandomHypergraph[args], 1, 2] && False
+
+(* Main entry *)
+expr : RandomHypergraph[sig_, max_ : Automatic] := ModuleScope[
+  res = Catch[randomHypergraph[HoldForm @ expr, sig, max]];
+  res /; res =!= $Failed
+]
+
+(* Error messages *)
+RandomHypergraph::invalidSig = "\
+The argument at position `2` in `1` should be a positive integer or a hypergraph signature.";
+
+(* Support functions *)
+randomPartition[n_] :=
+  randomPartition[n, RandomInteger[{1, n}]]
+randomPartition[n_Integer ? Positive, nparts_Integer ? Positive] :=
+  RandomVariate @ MultinomialDistribution[n, ConstantArray[1 / nparts, nparts]]
+
+$signaturePattern = {_Integer ? NonNegative, _Integer ? NonNegative};
+
+(*
+In[]:= RandomHypergraph[8]
+Out[]= {{4, 4, 3}, {2, 7}, {5, 6}, {8}}
+*)
+randomHypergraph[caller_, complexity_Integer ? Positive, n : (_Integer ? Positive | Automatic)] :=
+  With[{max = Replace[n, Automatic -> complexity]},
+    RandomInteger[{1, max}, #] & /@ DeleteCases[randomPartition @ complexity, 0]
+  ]
+
+(*
+In[]:= RandomHypergraph[{{5, 2}, {4, 3}}, 10]
+Out[]= {{1, 2}, {2, 9}, {6, 1}, {3, 3}, {10, 10}, {1, 8, 8}, {5, 7, 9}, {5, 7, 6}, {5, 3, 3}}
+*)
+randomHypergraph[caller_, sig : {$signaturePattern ..}, n : (_Integer ? Positive | Automatic)] :=
+  ModuleScope[
+    If[n === Automatic,
+      (* Maximum possible number of atoms *)
+      max = Total[Times @@@ sig],
+      max = n
+    ];
+    Catenate[RandomInteger[{1, max}, #] & /@ sig]
+  ]
+
+(*
+In[]:= RandomHypergraph[{5, 2}, 10]
+Out[]= {{5, 4}, {7, 8}, {7, 6}, {7, 1}, {4, 9}}
+*)
+randomHypergraph[caller_, sig : $signaturePattern, n_] :=
+  randomHypergraph[caller, {sig}, n]
+
+(* Incorrect arguments messages *)
+randomHypergraph[caller_, sig : Except[$signaturePattern | {$signaturePattern ..} | _Integer ? Positive], _] :=
+  (Message[RandomHypergraph::invalidSig, caller, 1];
+  Throw[$Failed])
+
+randomHypergraph[caller_, sig_, max_] :=
+  (Message[RandomHypergraph::intpa, caller, 2];
+  Throw[$Failed])
diff --git a/README.md b/README.md
@@ -169,8 +169,9 @@ We have a [Discord server](https://discord.setreplace.org). If you would like to
 - [RulePlot of WolframModel](Documentation/SymbolsAndFunctions/RulePlotOfWolframModel.md)
 - Utility Functions
   - [IndexHypergraph](Documentation/SymbolsAndFunctions/UtilityFunctions/IndexHypergraph.md)
-  - [HypergraphToGraph](Documentation/SymbolsAndFunctions/UtilityFunctions/HypergraphToGraph.md)
   - [IsomorphicHypergraphQ](Documentation/SymbolsAndFunctions/UtilityFunctions/IsomorphicHypergraphQ.md)
+  - [HypergraphToGraph](Documentation/SymbolsAndFunctions/UtilityFunctions/HypergraphToGraph.md)
+  - [RandomHypergraph](Documentation/SymbolsAndFunctions/UtilityFunctions/RandomHypergraph.md)
   - [Subhypergraph](Documentation/SymbolsAndFunctions/UtilityFunctions/Subhypergraph.md)
   - [WolframModelRuleValue](Documentation/SymbolsAndFunctions/UtilityFunctions/WolframModelRuleValue.md)
   - [GeneralizedGridGraph](Documentation/SymbolsAndFunctions/UtilityFunctions/GeneralizedGridGraph.md)

diff --git a/Tests/RandomHypergraph.wlt b/Tests/RandomHypergraph.wlt
@@ -0,0 +1,167 @@
+<|
+  "RandomHypergraph" -> <|
+    "init" -> (
+      Attributes[Global`testUnevaluated] = {HoldAll};
+      Global`testUnevaluated[args___] := SetReplace`PackageScope`testUnevaluated[VerificationTest, args];
+
+      distinctHypergraphQ[hypergraphs_] := Length[Tally[Map[Sort, hypergraphs, {1, 2}]]] > 1;
+      validVertexRangeQ[range_, hypergraph_] := SubsetQ[range, Flatten @ hypergraph];
+    ),
+    "tests" -> {
+
+      (* unevaluated *)
+
+      (** argument count **)
+      testUnevaluated[
+        RandomHypergraph[],
+        {RandomHypergraph::argt}
+      ],
+
+      testUnevaluated[
+        RandomHypergraph[1, 2, 3],
+        {RandomHypergraph::argt}
+      ],
+
+      (** invalid 1st argument **)
+      testUnevaluated[
+        RandomHypergraph[-1],
+        {RandomHypergraph::invalidSig}
+      ],
+
+      testUnevaluated[
+        RandomHypergraph[-1, 10],
+        {RandomHypergraph::invalidSig}
+      ],
+
+      testUnevaluated[
+        RandomHypergraph[{-3, 2}],
+        {RandomHypergraph::invalidSig}
+      ],
+
+      testUnevaluated[
+        RandomHypergraph[{{3, -2}}],
+        {RandomHypergraph::invalidSig}
+      ],
+
+      (** invalid 2nd argument **)
+      testUnevaluated[
+        RandomHypergraph[8, -3],
+        {RandomHypergraph::intpa}
+      ],
+
+      testUnevaluated[
+        RandomHypergraph[{3, 2}, -3],
+        {RandomHypergraph::intpa}
+      ],
+
+      testUnevaluated[
+        RandomHypergraph[{{3, 2}}, -3],
+        {RandomHypergraph::intpa}
+      ],
+
+      (* "Complexity" *)
+      VerificationTest[
+        SeedRandom[123];
+        AllTrue[
+          Table[RandomHypergraph[8], 100],
+          Total[Length /@ #] === 8 &]
+      ],
+      VerificationTest[
+        SeedRandom[123];
+        AllTrue[
+          Table[RandomHypergraph[8, 20], 100],
+          Total[Length /@ #] === 8 &]
+      ],
+
+      (** All generated hypergraphs should not be the same **)
+      VerificationTest[
+        SeedRandom[123];
+        distinctHypergraphQ @ Table[RandomHypergraph[8], 100]
+      ],
+      VerificationTest[
+        SeedRandom[123];
+        distinctHypergraphQ @ Table[RandomHypergraph[8, 20], 100]
+      ],
+
+      (** Verify all vertices are in the correct range **)
+      VerificationTest[
+        SeedRandom[123];
+        validVertexRangeQ[Range[1, 8], Table[RandomHypergraph[8], 100]]
+      ],
+      VerificationTest[
+        SeedRandom[123];
+        validVertexRangeQ[Range[1, 20], Table[RandomHypergraph[8, 20], 100]]
+      ],
+
+      (* Signature *)
+      (*** Hypergraph signature **)
+      VerificationTest[
+        SeedRandom[124];
+        AllTrue[
+          Table[RandomHypergraph[{5, 2}], 100],
+          MatchQ[#, {Repeated[{_, _}, {5}]}] &]
+      ],
+      VerificationTest[
+        SeedRandom[124];
+        AllTrue[
+          Table[RandomHypergraph[{5, 2}, 20], 100],
+          MatchQ[#, {Repeated[{_, _}, {5}]}] &]
+      ],
+
+      (** All generated hypergraphs should not be the same **)
+      VerificationTest[
+        SeedRandom[124];
+        distinctHypergraphQ @ Table[RandomHypergraph[{5, 2}], 100]
+      ],
+      VerificationTest[
+        SeedRandom[124];
+        distinctHypergraphQ @ Table[RandomHypergraph[{5, 2}, 20], 100]
+      ],
+
+      (** Verify all vertices are in the correct range **)
+      VerificationTest[
+        SeedRandom[124];
+        validVertexRangeQ[Range[1, 10], Table[RandomHypergraph[{5, 2}], 100]]
+      ],
+      VerificationTest[
+        SeedRandom[124];
+        validVertexRangeQ[Range[1, 20], Table[RandomHypergraph[{5, 2}, 20], 100]]
+      ],
+
+      (* Signature(s) *)
+      (*** Hypergraph signature **)
+      VerificationTest[
+        SeedRandom[125];
+        AllTrue[
+          Table[RandomHypergraph[{{5, 2}, {2, 3}}], 100],
+          MatchQ[#, {Repeated[{_, _}, {5}], Repeated[{_, _, _}, {2}]}] &]
+      ],
+      VerificationTest[
+        SeedRandom[125];
+        AllTrue[
+          Table[RandomHypergraph[{{5, 2}, {2, 3}}, 20], 100],
+          MatchQ[#, {Repeated[{_, _}, {5}], Repeated[{_, _, _}, {2}]}] &]
+      ],
+
+      (** All generated hypergraphs should not be the same **)
+      VerificationTest[
+        SeedRandom[125];
+        distinctHypergraphQ @ Table[RandomHypergraph[{{5, 2}, {2, 3}}], 100]
+      ],
+      VerificationTest[
+        SeedRandom[125];
+        distinctHypergraphQ @ Table[RandomHypergraph[{{5, 2}, {2, 3}}, 20], 100]
+      ],
+
+      (** Verify all vertices are in the correct range **)
+      VerificationTest[
+        SeedRandom[125];
+        validVertexRangeQ[Range[1, 16], Table[RandomHypergraph[{{5, 2}, {2, 3}}], 100]]
+      ],
+      VerificationTest[
+        SeedRandom[125];
+        validVertexRangeQ[Range[1, 20], Table[RandomHypergraph[{{5, 2}, {2, 3}}, 20], 100]]
+      ]
+    }
+  |>
+|>