OKlibrary  0.2.1.6
Basics.mac
Go to the documentation of this file.
```00001 /* Oliver Kullmann, 8.12.2007 (Swansea) */
00002 /* Copyright 2007, 2008, 2009, 2010, 2011 Oliver Kullmann
00003 This file is part of the OKlibrary. OKlibrary is free software; you can redistribute
00004 it and/or modify it under the terms of the GNU General Public License as published by
00005 the Free Software Foundation and included in this library; either version 3 of the
00006 License, or any later version. */
00007
00022 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/SetSystems.mac")\$
00023 oklib_include("OKlib/ComputerAlgebra/CombinatorialMatrices/Lisp/Basics.mac")\$
00024 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")\$
00025 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/HashMaps.mac")\$
00026
00027
00028 /* ***********************
00029    * Fundamental notions *
00030    ***********************
00031 */
00032
00033 /*
00034  A "hypergraph" is a pair (V,E), where V is a set and E a subset of
00035  the powerset of V.
00036 */
00037
00038 /*
00039  A "general hypergraph" is a triple (V,E,f), where V, E are sets, while
00040  f is a function such that f(e) for e in E is a subset of V.
00041 */
00042
00043 /* The "ordered versions" use repetition-free lists instead of sets. */
00044 /* The abbreviations are hg, ohg, ghg, oghg. */
00045
00046
00047 /* ************************************
00048    * Checking the defining properties *
00049    ************************************
00050 */
00051
00052 hg_p(G) := listp(G) and is(length(G)=2) and setp(G[1]) and setp(G[2]) and
00053   every_s(lambda([H],subsetp(H,G[1])),G[2])\$
00054
00055 ohg_p(G) := listp(G) and is(length(G)=2) and listnorep_p(G[1]) and
00056   listnorep_p(G[2]) and
00057   block([V : setify(G[1])], every_s(lambda([H],subsetp(H,V)),G[2]))\$
00058
00059 /* Checking whether func_ is a hyperedge function; V is a set, E is a
00060    list or a set: */
00061 hypfunc_p(func_,V,E) := block(
00062  [e : errcatch(every_s(lambda([H],subsetp(func_(H),V)), E))],
00063   not emptyp(e) and e[1])\$
00064
00065 ghg_p(G) :=  listp(G) and is(length(G)=3) and setp(G[1]) and setp(G[2]) and
00066   hypfunc_p(G[3], G[1], G[2])\$
00067
00068 oghg_p(G) := listp(G) and is(length(G)=3) and listnorep_p(G[1]) and
00069   listnorep_p(G[2]) and hypfunc_p(G[3], setify(G[1]), G[2])\$
00070
00071
00072 /* *********************
00073    * Checking equality *
00074    *********************
00075 */
00076
00077 /* Equality test for general hypergraphs: */
00078 /* RENAME: ghg_equalp */
00079 ghypequalp(G1,G2) := is(G1[1] = G2[1]) and is(G1[2] = G2[2]) and
00080  block([break : false],
00081   for e in G1[2] unless break do
00082     if G1[3](e) # G2[3](e) then break : true,
00083   return(not break))\$
00084 ghg_equalp(G1,G2) := is(G1[1] = G2[1]) and is(G1[2] = G2[2]) and
00085  block([break : false],
00086   for e in G1[2] unless break do
00087     if G1[3](e) # G2[3](e) then break : true,
00088   return(not break))\$
00089
00090
00091 /* **************
00092    * Promotions *
00093    **************
00094 */
00095
00096 hg2ohg(G) := map(listify,G)\$
00097
00098 /* RENAME: hg2ghg */
00099 promote_general_hypergraph(G) := [G[1], G[2], identity]\$
00100 hg2ghg(G) := [G[1], G[2], identity]\$
00101
00102
00103 /* *************
00104    * Downcasts *
00105    *************
00106 */
00107
00108 ohg2hg(G) := map(setify,G)\$
00109
00110 ghg2hg(G) := [G[1], map(G[3],G[2])]\$
00111 oghg2ohg(G) := [first(G), map(third(G),second(G))]\$
00112
00113
00114 /* ************* **
00115    * Conversions *
00116    ***************
00117 */
00118
00119 /* Promotes a set system to a hypergraph: */
00120 /* RENAME: ses2hg(S) */
00121 setsystem2hg(S) := [lunion(S), S]\$
00122 ses2hg(S) := setsystem2hg(S)\$
00123
00124 /* Converts a list of sets to a hypergraph: */
00125 listsets2hg(L) := setsystem2hg(setify(L))\$
00126
00127 /* Converts a list of sets to an ordered general hypergraph: */
00128 listsets2oghg(L) := [listify(lunion(L)), L, identity]\$
00129
00130
00131 /* *******************
00132    * Standardisation *
00133    *******************
00134 */
00135
00136 /* Standardising an arbitrary ordered hypergraph, using the order of
00137    the vertices to define their indices:
00138 */
00139 standardise_ohg(G) := block([h : osm2hm(l2osm_inv(G[1])), t],
00140  t : lambda([H], map(lambda([x], ev_hm(h,x)), H)),
00141  [create_list(i,i,1,length(G[1])), map(t, G[2])])\$
00142
00143 /* In the same way, standardising an ordered hypergraph whose vertices are
00144    natural numbers (>= 1), using an array (of size equal to the maximal
00145    vertex-value):
00146 */
00147 standardise_ary_ohg(G) := if emptyp(G[1]) then G else
00148  block([A : osm2ary_lt(l2osm_inv(G[1]),last(G[1]),fixnum), t],
00149   t : lambda([H], map(lambda([x], A[x]), H)),
00150   [create_list(i,i,1,length(G[1])), map(t, G[2])])\$
00151
00152
00153 /* ************
00154    * Matrices *
00155    ************
00156 */
00157
00158 /* The combinatorial (hyper)edge-vertex matrix of a hypergraph: */
00159 /* RENAME: hypver_hg2com */
00160 edge_vertex_com_hyp(G) := [G[2], G[1], lambda([H,v],
00161   if elementp(v, H) then 1 else 0)]\$
00162 edge_vertex_com_hg(G) := edge_vertex_com_hyp(G)\$
00163 hypver_hg2com(G) := edge_vertex_com_hyp(G)\$
00164 hypver_ghg2com(G) := [G[2],G[1], buildq([E:G[3]], lambda([H,v],
00165   if elementp(v, E(H)) then 1 else 0))]\$
00166
00167 /* The (hyper)edge intersection matrix (as a square combinatorial matrix)
00168    of a hypergraph: */
00169 /* RENAME: hypint_hg2scom */
00170 edge_int_com_hyp(G) := block([M : edge_vertex_com_hyp(G)],
00171  return(com2scom(prod_com(M, trans(M)))))\$
00172 edge_int_com_hg(G) := edge_int_com_hyp(G)\$
00173
00174 /* The vertex intersection matrix (as a square combinatorial matrix)
00175    of a hypergraph (for each pair of vertices the number of common
00176    occurrences): */
00177 /* RENAME: verint_hg2scom */
00178 vertex_int_com_hyp(G) := block([M : edge_vertex_com_hyp(G)],
00179  return(com2scom(prod_com(trans(M), M))))\$
00180 vertex_int_com_hg(G) := vertex_int_com_hyp(G)\$
00181
00182
00183 /* *******************
00184    * Transformations *
00185    *******************
00186 */
00187
00188 /* The k-section of a hypergraph (taking over the vertices of G, while the
00189    hyperedges are k-subsets of the old hyperedges): */
00190 /* RENAME: section_hg */
00191 section_hyp(G,k) := [G[1], family_sets_union(G[2], lambda([H], powerset(H,k)))]\$
00192 section_hg(G,k) := section_hyp(G,k)\$
00193
00194 /* The k-edge-graph, a k-graph, that is, a k-uniform hypergraph, having as
00195     vertices the hyperedges of G and as hyperedges k-sets of hyperedges of G
00196     with non-empty intersection:
00197 */
00198 /* RENAME: edge_k_hg */
00199 edge_k_hyp(G,k) :=
00200  if k=0 then if emptyp(G[1]) then [G[2],{}] else [G[2],{{}}]
00201  elseif k=1 then [G[2], singletons(disjoin({},G[2]))] else
00202  [G[2], subset(powerset(G[2],k), lambda([H], not emptyp(lintersection(H))))]\$
00203 edge_k_hg(G,k) := edge_k_hyp(G,k)\$
00204 /* The edge-graph of a hypergraph: */
00205 /* RENAME: edge_g_hg */
00206 edge_g_hyp(G) := edge_k_hyp(G,2)\$
00207 edge_g_hg(G) := edge_g_hyp(G)\$
00208
00209 /* The anti-k-edge-graph, a k-graph with vertices the hyperedges of G and as
00210    hyperedges k-sets of hyperedges of G with empty intersection:
00211 */
00212 /* RENAME: anti_edge_k_hg */
00213 anti_edge_k_hyp(G,k) :=
00214  if k=0 then if emptyp(G[1]) then [G[2],{{}}] else [G[2],{}]
00215  elseif k=1 then [G[2], singletons(intersection({{}},G[2]))] else
00216  [G[2], subset(powerset(G[2],k), lambda([H], emptyp(lintersection(H))))]\$
00217 anti_edge_k_hg(G,k) := anti_edge_k_hyp(G,k)\$
00218 /* The Kneser-graph of a hypergraph: */
00219 /* RENAME: kneser_g_hg */
00220 kneser_g_hyp(G) := anti_edge_k_hyp(G,2)\$
00221 kneser_g_hg(G) := kneser_g_hyp(G)\$
00222
00223
00224 /* *****************
00225    * Constructions *
00226    *****************
00227 */
00228
00229 /* The union of a list L of hypergraphs: */
00230 union_hg([L]) := [lunion(map(first,L)), lunion(map(second,L))]\$
00231
00232 /* The edge-wise complement of a hypergraph: */
00233 /* RENAME: ecomp_hg */
00234 ecomp_hyp(G) := [G[1], ecomp(G[2],G[1])]\$
00235 ecomp_hg(G) := ecomp_hyp(G)\$
00236
00237 /* The dual of a general hypergraph: */
00238 /* RENAME: dual_ghg */
00239 dual_general_hypergraph(G) := [G[2], G[1], buildq([V : G[2], f : G[3]],
00240  lambda([e], subset(V, lambda([v], elementp(e,f(v))))))]\$
00241 dual_ghg(G) := dual_general_hypergraph(G)\$
00242
00243
00244 /* ************************************************
00245    * Constructions related to the subset-relation *
00246    ************************************************
00247 */
00248
00249 /* Removing all non-minimal hyperedges: */
00250 min_hg(G) := [first(G), min_elements(second(G))]\$
00251 /* Removing all non-maximal hyperedges: */
00252 max_hg(G) := [first(G), max_elements(second(G))]\$
00253
00254 /* The closure under subset-formation of a hypergraph: */
00255 /* RENAME: subset_closure_hg */
00256 subset_closure_hyp(G) := [G[1], subset_closure(G[2])]\$
00257 subset_closure_hg(G) := subset_closure_hyp(G)\$
00258
00259 /* For two set-systems S1, S2 the "general subsumption hypergraph" is the
00260    general hypergraph (S1,S2,E), which has as vertices the elements of S1 and
00261    as hyperedge-labels the elements of S2, while for (hyperedge-label) H in S2
00262    its vertex set E(H) is given by the elements of S1 contained in H:
00263 */
00264 subsumption_ghg(S1,S2) :=
00265  [S1, S2, buildq([S1], lambda([H], subset(S1, lambda([S], subsetp(S,H)))))]\$
00266
00267 /* For two ordered set-systems L1, L2 the "ordered general subsumption
00268    hypergraph" has the elements of L1 as vertices and the elements of L2
00269    as hyperedge-labels, while for H in S2 the vertex set is given by the
00270    elements of L1 contained in H:
00271 */
00272 subsumption_oghg(L1,L2) :=
00273   [L1, L2,
00274    buildq([L1], lambda([H], subset(setify(L1),lambda([S],subsetp(S,H)))))]\$
00275 subsumption_ohg(L1,L2) :=
00276   oghg2ohg(subsumption_oghg(L1,L2))\$
00277 /* The standardised ordered subsumption hypergraph of two ordered set systems
00278    L1 and L2 is the ordered hypergraph (given by subsumption_ohg) where each
00279    vertex is mapped to it's position in L1. */
00280 subsumption_std_ohg(L1,L2) := standardise_ohg(subsumption_ohg(L1,L2))\$
00281
00282
00283 /* The "reduced subsumption hypergraph" for set-systems (S1,S2) is constructed
00284    as follows from subsumption_ghg(S1,S2):
00285     - let G := subsumption_ghg(S1,S2);
00286     - first subsumption-elimination is performed on G, obtaining G';
00287     - then all unit-hyperedges {v} are removed from G' together with their
00288       vertices;
00289     - finally the general hypergraph is converted into a hypergraph, and
00290       vertices not occurring in any hyperedge anymore are removed.
00291
00292 The following function computes this reduced subsumption hypergraph together
00293 with the set of sets from S1 which where eliminated by the unit-elimination:
00294 */
00295 rsubsumption_hg(S1,S2) := block(
00296  [G : ghg2hg(subsumption_ghg(S1,S2)), U,U2, V,E],
00297  E : min_elements(G[2]),
00298  U : subset(E, lambda([H], is(length(H)=1))),
00299  U2 : map(single_element,U),
00300  E : setdifference(E,U),
00301  V : lunion(E),
00302  [ [V,E], U2 ])\$
00303
00304
00305 /* *****************
00306    * Connectedness *
00307    *****************
00308 */
00309
00310 /* Computes the set-system of vertex-sets of connnected components
00311 (those minimal sets, which are pairwise disjoint while their union is
00312 the vertex-set, such that every edge is a subset of some of them): */
00313 components_hg(G) := block([S : unify_nondisjoint_elements(G[2])],
00314  union(singletons(setdifference(G[1], lunion(S))), S))\$
00315 components_ghg(G) := components_hg(ghg2hg(G))\$
00316
00317 /* Represent as hypergraph G as the disjoint union of connected hypergraphs,
00318    which are given in a lexicographically sorted list (using the vertex-sets):
00319 */
00320 disjoint_union_rep_hg(G) := block([S : components_hg(G), empty_he, A, res],
00321  empty_he : elementp({},S),
00322  S : disjoin({},S),
00323  A : l2ary(map(lambda([s], [s,[]]), listify(S))),
00324  for H in disjoin({},G[2]) do block([found : false],
00325   for i : 1 thru A[0] unless found do (
00326    found : subsetp(H,first(A[i])),
00327    if found then A[i] : [first(A[i]), cons(H,second(A[i]))]
00328  )),
00329  res : map(lambda([G], [first(G),setify(second(G))]), ary2l(A)),
00330  if empty_he then cons([{},{{}}], res) else res)\$
00331
00332 /* Whether a hypergraph is connected (can not be represented as the disjoint
00333 union of two non-trivial hypergraphs): */
00334 is_connected_hg_p(G) := is(length(components_hg(G)) <= 1)\$
00335 /* Remark: If G does not contain the empty hyperedge, then G is connected iff
00336    every two different vertices are connected by a path, while otherwise G
00337    is connected iff the vertex-set is empty.
00338 */
00339
```