OKlibrary  0.2.1.6
Homomorphisms.mac
Go to the documentation of this file.
```00001 /* Oliver Kullmann, 2.11.2011 (Swansea) */
00002 /* Copyright 2011, 2012 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/Lists.mac")\$
00023 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/SetSystems.mac")\$
00024 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/HashMaps.mac")\$
00025 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/Basics.mac")\$
00026
00027
00028 /* *****************
00029    * Basic notions *
00030    *****************
00031 */
00032
00033 /* Testing whether f is a homomorphism from G1 to G2: */
00034 homomorphism_bydef_hg(f,G1,G2) := subsetp(map(f,G1[1]),G2[1]) and
00035  every_s(lambda([H], elementp(map(f,H), G2[2])), G1[2])\$
00036
00037 /* Testing whether f is a automorphism of G: */
00038 automorphism_bydef_hg(f,G) := is(map(f,G[1]) = G[1]) and
00039  every_s(lambda([H], elementp(map(f,H), G[2])), G[2])\$
00040
00041
00042 /* Testing whether f is a sup-homomorphism from G1 to G2 (the images of
00043    hyperedges are supersets of some hyperedge in the image): */
00044 suphomomorphism_bydef_hg(f,G1,G2) := subsetp(map(f,G1[1]),G2[1]) and
00045  every_s(lambda([H], r1l_subsetp(G2[2], map(f,H))), G1[2])\$
00046
00047
00048 /* For a map f defined on the vertices of G, transport G to its image (i.e.,
00049    compute the image):
00050 */
00051 transport_hg(f,G) := [map(f,G[1]), map(lambda([H],map(f,H)),G[2])]\$
00052 /* Performing subsumption-elimination to the result: */
00053 transportmin_hg(f,G) := min_hg(transport_hg(f,G))\$
00054
00055
00056 /* **************************
00057    * Special transport-maps *
00058    **************************
00059 */
00060
00061 /* Consider an okl-array A, and let n := A[0] (the length of A).
00062    It is assumed that A represents a permutation of {1,...,n}.
00063    Now a map f from {1,...,n} to {1,...,ceiling(n/m)} is computed as follows:
00064     - A[1], ..., A[m] is mapped to 1
00065     - A[m+1],...,A[2m] is mapped to 2
00066     - and so on.
00067    Additionally we have f(0) = n.
00068 */
00069 colouring_blocks(A,m) := block([M:okl_make_array(fixnum,A[0])],
00070  for i : 1 thru A[0] do M[A[i]] : ceiling(i/m),
00071  buildq([M], lambda([x], M[x])))\$
00072
00073 /* Producing a map from {1,...,n} to {1,...,ceiling(n/m)} which based on a
00074    random permutation of [1,...,n], mapping the first m elements to 1, the
00075    next m elements to 2, and so on:
00076 */
00077 random_colouring(n,m) :=
00078  colouring_blocks(l2ary(random_permutation(create_list(i,i,1,n))),m)\$
00079
00080 /* Randomly projecting a standardised hypergraph G such that m vertices in G
00081    get collapsed to one new vertex (the projection is also standardised):
00082 */
00083 random_projection_hg(G,m) := block(
00084  [cm : colouring_blocks(l2ary(random_permutation(listify(first(G)))), m)],
00085   transport_hg(cm,G))\$
00086 random_projection_min_hg(G,m) := min_hg(random_projection_hg(G,m))\$
00087
00088 /* Projecting vertex i to (i-1 mod m) + 1 for m >= 1 (especially for
00089    standardised hypergraphs, and hypergraphs of integers, based on {1,...,m},
00090    not on {0,...,m-1}):
00091 */
00092 modulo_colouring(m) := buildq([m], lambda([x], mod(x-1,m)+1))\$
00093 modulo_projection_hg(G,m) := transport_hg(modulo_colouring(m), G)\$
00094
00095 /* For k, n natural numbers >= 0, where k is the "folding-depth", and n is
00096    the size of the base vertex-set, computes function f(x) defined for natural
00097    numbers x by k-fold iteration of mirrorfold_vdw (initially used with n).
00098    f(x) is a map from NN to {1,...,ceiling(n/2^k)}, and is periodic with
00099    period n.
00100 */
00101 mirrorfold(k,n) := if k=0 then buildq([n],lambda([x], mod(x-1,n)+1))
00102  elseif k=1 then
00103   if evenp(n) then
00104    buildq([n, d:n/2], lambda([x], x : x-1,
00105      if evenp(floor(x/d)) then mod(x,d)+1
00106      else d - mod(x,d)))
00107   else
00108    buildq([n, d:(n+1)/2], lambda([x], x : mod(x-1,n),
00109      if evenp(floor(x/d)) then mod(x,d)+1
00110      else d - mod(x,d)-1))
00111  else buildq([fp_ : mirrorfold(k-1,ceiling(n/2)), f1_ : mirrorfold(1,n)],
00112    lambda([x], fp_(f1_(x))))\$
00113 /* Remarks:
00114  - mirrorfold(1,n) is the same map as mirrorfold_vdw(n) when only considering
00115    arguments 1 <= x <= n.
00116 */
00117
00118 mirrorfold_projection_hg(G,k) :=
00119   transport_hg(mirrorfold(k,length(first(G))), G)\$
00120
00121 /* Given a colouring of the folded problem, reconstruct a solution of the
00122    original problem, by computing a function which takes argument x, which
00123    is a list of length ceiling(n/2^k):
00124 */
00125 mirrorexpand(k,n) := block([leven : []],
00126   thru k do (leven : cons(evenp(n),leven), n : ceiling(n/2)),
00127   buildq([leven], lambda([x],
00128     for b in leven do
00129       if b then x : append(x,reverse(x))
00130       else x : append(x,rest(reverse(x))),
00131     x)))\$
00132 /* We have
00133    create_list(mirrorfold(k,n)(i),i,1,n) = mirrorexpand(k,n)(create_list(i,i,1,ceiling(n/2^k))).
00134 */
00135
00136
00137 /* ***********************************
00138    * Translations to non-boolean SAT *
00139    ***********************************
00140 */
00141
00142 /* Given two hypergraphs G1, G2, the question is the existence of a
00143    homomorphism from G1 to G2.
00144 */
00145
00146 /* The "direct, negative" translation to non-boolean clause-sets, from
00147    "Constraint Satisfaction Problems in Clausal Form I: Autarkies and
00148     Deficiency" http://cs.swan.ac.uk/~csoliver/papers.html#ClausalFormI .
00149 */
00150
00151 hyphom_dirneg_ohg2nbfcsud(G1,G2) :=
00152  [G1[1], lunion(
00153   map(lambda([H], map(lambda([u], setify(map("[",listify(H),u))),
00154                       subset(all_tuples(G2[1], length(H)), lambda([t], not elementp(setify(t), G2[2]))))),
00155       G1[2])),
00156   G2[1]]\$
00157
```