SetReplace/Kernel/Hypergraph.m at 5bd3dba7e313fc55e137f55973b65022aa61a035 · maxitg/SetReplace · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Package["SetReplace`"]

PackageImport["GeneralUtilities`"]

PackageExport["Hypergraph"]
PackageExport["HypergraphQ"]
PackageExport["HypergraphOrderedQ"]

SetRelatedSymbolGroup[Hypergraph, HypergraphQ, HypergraphOrderedQ, EdgeList, VertexList];

(* HypergraphQ *)

SetUsage @ "HypergraphQ[hg$] yields True if hg$ is a valid Hypergraph object and False otherwise.";

SyntaxInformation[HypergraphQ] = {"ArgumentsPattern" -> {expr_}};

HypergraphQ[hypergraph_Hypergraph] := System`Private`HoldNoEntryQ[hypergraph];
HypergraphQ[_] = False;

(* HypergraphOrderedQ *)

SetUsage @ "HypergraphOrderedQ[hg$] yields True if hg$ is a ordered Hypergraph object and False otherwise.";

SyntaxInformation[HypergraphOrderedQ] = {"ArgumentsPattern" -> {hypergraph_}};

HypergraphOrderedQ[HoldPattern[Hypergraph[_, orderedQ_] ? HypergraphQ]] := orderedQ;

HypergraphOrderedQ[_] = False;

(* Hypergraph *)

SetUsage @ "
Hypergraph[{he$1, he$2, $$}] yields a hypergraph with hyperedges he$j.
Hypergraph[$$, ord$] returns an ordered hypergraph if ord$ is True, and an unordered hypergraph if False.
";

SyntaxInformation[Hypergraph] = {"ArgumentsPattern" -> {hyperedges_, orderedQ_.}};

Hypergraph[hyperedges_, orderedQ : (True | False) : False] ? System`Private`HoldEntryQ :=
  If[hypergraphQ[hyperedges],
    System`Private`ConstructNoEntry[Hypergraph, Hyperedge @@@ hyperedges, orderedQ]
  ,
    $Failed
  ];

hypergraphQ = MatchQ[{(_List | _Hyperedge) ...}];

(* EdgeList, EdgeCount, VertexList, VertexCount *)

Hypergraph /: EdgeList[HoldPattern[Hypergraph[hyperedgeList_, _] ? HypergraphQ]] :=
  hyperedgeList;

Hypergraph /: EdgeCount[hypergraph_Hypergraph ? HypergraphQ] :=
  Length[EdgeList[hypergraph]];

Hypergraph /: VertexList[hypergraph_Hypergraph ? HypergraphQ] :=
  DeleteDuplicates[Catenate[Cases[EdgeList[hypergraph], Hyperedge[x___] :> {x}, {1}]]];

Hypergraph /: VertexCount[hypergraph_Hypergraph ? HypergraphQ] :=
  Length[VertexList[hypergraph]];

(* Normal *)

Hypergraph /: Normal[hypergraph_Hypergraph ? HypergraphQ] := List @@@ EdgeList[hypergraph];

(* SameQ *)

Hypergraph /: SameQ[hg1_Hypergraph, hg2_Hypergraph] := Normal[hg1] === Normal[hg2];

(* HypergraphPlot *)

Hypergraph /: HypergraphPlot[hypergraph_Hypergraph ? HypergraphQ, opts___] := HypergraphPlot[Normal[hypergraph], opts];

(* Boxes *)

Hypergraph /: MakeBoxes[hypergraph_Hypergraph, fmt_] /; HypergraphQ[hypergraph] :=
  Module[{collapsed, expanded},
    collapsed = BoxForm`SummaryItem /@ {
      {"VertexCount: ", VertexCount[hypergraph]},
      {"EdgeCount: ", EdgeCount[hypergraph]}
    };
    expanded = BoxForm`SummaryItem /@ {
      {"OrderedQ: ", HypergraphOrderedQ[hypergraph]}
    };
    BoxForm`ArrangeSummaryBox[
      Hypergraph,
      hypergraph,
      HypergraphPlot[hypergraph, ImageSize -> {29, 29}],
      collapsed,
      expanded,
      fmt,
      "Interpretable" -> True
    ]
  ];

(* WolframModel *)

Hypergraph /: WolframModel[rule_, hypergraph_Hypergraph, args___] :=
  WolframModel[rule, Normal[hypergraph], args];

(* HypergraphToGraph *)

Hypergraph /: HypergraphToGraph[hypergraph_Hypergraph, args___] :=
  HypergraphToGraph[Normal[hypergraph], args];

(*
(* CanonicalHypergraph *)

(* ::Text:: *)
(*Does CanonicalHypergraph take into consideration if the hypergraph is ordered?*)

Hypergraph /: (func : ResourceFunction["CanonicalHypergraph"])[hypergraph_Hypergraph ? HypergraphQ] :=
  Hypergraph[func[Normal[hypergraph]]]

(*AdjacencyTensor*)

AdjacencyTensor = ResourceFunction["AdjacencyTensor"][Normal[#], "OrderedHyperedges" -> HypergraphOrderedQ[#]] &;

Hypergraph /: (func : ResourceFunction["AdjacencyTensor"])[hypergraph_Hypergraph ? HypergraphQ, opts : OptionsPattern[]] :=
  func[Normal[hypergraph], opts, "OrderedHyperedges" -> HypergraphOrderedQ[hypergraph]]

(*KirchhoffTensor*)

Hypergraph /: (func : ResourceFunction["KirchhoffTensor"])[hypergraph_Hypergraph ? HypergraphQ, opts : OptionsPattern[]] :=
  func[Normal[hypergraph], opts, "OrderedHyperedges" -> HypergraphOrderedQ[hypergraph]]
*)