OKlibrary  0.2.1.6
Stratification.mac
Go to the documentation of this file.
```00001 /* Oliver Kullmann, 7.6.2009 (Swansea) */
00002 /* Copyright 2009 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/DataStructures/Lisp/HashMaps.mac")\$
00023 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/Statistics.mac")\$
00024 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")\$
00025 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/SetSystems.mac")\$
00026
00027
00028 /* **********************************
00029    * Strata in monotone hypergraphs *
00030    **********************************
00031 */
00032
00033 /* Given an ordered hypergraph, determine the sizes of the strata (of
00034    hyperedges) given by the same maximal element (of the hyperedges).
00035    Returned is a list of pairs [v,c], where v is a vertex occurring
00036    as a maximum of some hyperedge, while c is the count of hyperedges
00037    with this maximum; the order is ascending in v.
00038    Prerequisites:
00039     - vertices are integers
00040     - no hyperedge is empty
00041     - in the given order of hyperedges, the maximum of hyperedges is
00042       non-decreasing
00043     - the vertex list is sorted in increasing order (this is needed once
00044       indices of the elements are considered).
00045 */
00046 sizes_strata_mon_ohg(G) := if emptyp(G[2]) then []
00047  else block([m : lmax(first(G[2])), c : 1, res : []],
00048   for H in rest(G[2]) do block([nm : lmax(H)],
00049     if nm = m then c : c + 1
00050     else (
00051       res : cons([m,c], res),
00052       m : nm, c : 1
00053     )),
00054   res : cons([m,c], res),
00055   return(reverse(res)))\$
00056 /* The cumulative form: */
00057 sizes_cstrata_mon_ohg(G) := accumulate_l(sizes_strata_mon_ohg(G))\$
00058
00059 /* Now using the indices of the vertices (as given by the list G[1]): */
00060 sizes_strata_indmon_ohg(G) := if emptyp(G[2]) then []
00061  else block([m : lmax(first(G[2])), c : 1, res : [], V : il2ary(G[1]), v : first(G[1]), i : 1],
00062   while v # m do (i : i + 1, v : V[i]),
00063   for H in rest(G[2]) do block([nm : lmax(H)],
00064     if nm = m then c : c + 1
00065     else (
00066       res : cons([i,c], res),
00067       m : nm, c : 1,
00068       while v # m do (i : i + 1, v : V[i])
00069     )),
00070   res : cons([i,c], res),
00071   return(reverse(res)))\$
00072 /* Remark: sizes_strata_indmon_ohg(G) is very similar to strata_ohg(G) (see
00073    below), only that the latter considers all vertices, not just those which
00074    occur, and thus an array can be used (since the first component of the
00075    pairs is then just the position in the list).
00076 */
00077 /* The cumulative form: */
00078 sizes_cstrata_indmon_ohg(G) := accumulate_l(sizes_strata_indmon_ohg(G))\$
00079
00080
00081 /* Accumulation of a list L of pairs: computes a similar list of pairs, of the
00082    same length and coinciding with L on the first components of the pairs,
00083    while the second components are accumulated:
00084 */
00085 accumulate_l(L) := if emptyp(L) then [] else
00086  block([res : [first(L)], s : second(first(L))],
00087   for p in rest(L) do (
00088     s : s + second(p),
00089     res : cons([first(p), s], res)
00090   ),
00091   return(reverse(res)))\$
00092
00093
00094 /* *************************************
00095    * Stratifying arbitrary hypergraphs *
00096    *************************************
00097 */
00098
00099 /* For a set-system S and an ordering L of the vertices, compute an okl-array
00100    "a" of the same length as L, such that a[i] is the set of all hyperedges
00101    containing vertex L[i] and being contained in {L[1], ..., L[i]}.
00102    S can be a set or a list, while L is a list. */
00103 /* Prerequisite: L must cover all vertices occurring in S, and must not have
00104    a vertex occurring several times. */
00105 strata_ses(S,L) := block(
00106  [h : osm2hm(map("[",L,create_list(i,i,1,length(L)))),
00107   a : l2ary(create_list([],i,1,length(L)))],
00108    for H in S do block([max : 0],
00109      for x in H do block([v : ev_hm(h,x)],
00110        if v > max then max : v
00111      ),
00112      if max >= 1 then a[max] : cons(H,a[max])
00113    ),
00114   return(a))\$
00115 strata_hg(G,L) := strata_ses(G[2],L)\$
00116 /* Here using the given order: */
00117 strata_ohg(G) := strata_hg(G,G[1])\$
00118 /* Remark: If the vertices are integers, and the hyperedges are ordered
00119    by increasing largest element, then sizes_strata_indmon_ohg(G) can be
00120    used (see above).
00121 */
00122
00123 /* Creating a monotone hypergraph generator for G by stratification according
00124    to L:
00125 */
00126 hg2hgmongen(G,L) := block([a : strata_hg(G,L)],
00127   buildq([a,L], lambda([n], [setify(take_l(n,L)), lunion(create_list(setify(a[i]),i,1,n))])))\$
00128 /* Here using the given order: */
00129 ohg2hgmongen(G) := block([a : strata_ohg(G), L : G[1]],
00130   buildq([a,L], lambda([n], [setify(take_l(n,L)), lunion(create_list(setify(a[i]),i,1,n))])))\$
00131 ohg2ohgmongen(G) := block([a : strata_ohg(G), L : G[1]],
00132   buildq([a,L], lambda([n], [take_l(n,L), lappend(create_list(a[i],i,1,n))])))\$
00133
00134
00135 /* **************
00136    * Heuristics *
00137    **************
00138 */
00139
00140 /* Stratification by vertex degrees (highest first): */
00141 strata_vertexdeg_hg(G) := block([L : map(first,sorted_vertex_degrees_hg(G))],
00142  [strata_hg(G,L), L])\$
00143 strata_vertexdeg_ohg(G) := block([L : map(first,sorted_vertex_degrees_ohg(G))],
00144  [strata_ohg([L,G[2]]), L])\$
00145
00146 /* Stratification via monotone generators, by vertex degrees (highest first):
00147 */
00148 vertexdeg_hgmongen_hg(G) := block([S : strata_vertexdeg_hg(G), a, L],
00149   a : S[1], L : S[2],
00150   buildq([a,L], lambda([n], [setify(take_l(n,L)), lunion(create_list(setify(a[i]),i,1,n))])))\$
00151 vertexdeg_hgmongen_ohg(G) := block([S : strata_vertexdeg_ohg(G), a, L],
00152   a : S[1], L : S[2],
00153   buildq([a,L], lambda([n], [setify(take_l(n,L)), lunion(create_list(setify(a[i]),i,1,n))])))\$
00154 vertexdeg_ohgmongen_ohg(G) := block([S : strata_vertexdeg_ohg(G), a, L],
00155   a : S[1], L : S[2],
00156   buildq([a,L], lambda([n], [take_l(n,L), lappend(create_list(a[i],i,1,n))])))\$
00157
00158
00159
```