OKlibrary  0.2.1.6
VanderWaerden.mac
Go to the documentation of this file.
```00001 /* Oliver Kullmann, 23.10.2010 (Swansea) */
00002 /* Copyright 2010, 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/Hypergraphs/Lisp/SetSystems.mac")\$
00023 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/Basics.mac")\$
00024 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")\$
00025 oklib_include("OKlib/ComputerAlgebra/Combinatorics/Lisp/Enumeration/Order.mac")\$
00026
00027
00028 /* ***************************
00029    * Arithmetic progressions *
00030    ***************************
00031 */
00032
00033 /* The arithmetic progression of length k and slope d, starting with a: */
00034 arpr(k,a,d) := create_list(a + i*d, i,0,k-1)\$
00035 /* If d = 0, then the progression is degenerated. */
00036
00037 /* Testing whether the list L represents an arithmetic progression: */
00038 arithmetic_progression_p(L) := if length(L) <= 1 then true
00039   else arithmetic_progression_d_p(rest(L),L[2] - L[1])\$
00040 /* Testing whether the list L represents an arithmetic progression with
00041    (constant) difference d: */
00042 arithmetic_progression_d_p(L,d) := if length(L) <= 1 then true
00043   else is(second(L) - first(L) = d) and arithmetic_progression_d_p(rest(L),d)\$
00044
00045
00046 /* ***************************************************
00047    * Standard hypergraphs of arithmetic progressions *
00048    ***************************************************
00049 */
00050
00051 /* The list of arithmetic progressions of length k, ending in vertex n
00052    for n, k >= 1, smallest start-vertex first:
00053 */
00054 arithprog_finish(k,n) :=
00055  if k=1 then [{n}] else
00056   reverse(create_list(setify(create_list(n-d*i,i,0,k-1)), d,1,floor((n-1)/(k-1))))\$
00057
00058
00059 /* The hypergraph of all arithmetic progressions of size k in {1,...,n}.
00060    The order of hyperedges: Sorted by increasing last vertex, and inside such
00061    a segment by decreasing slope. This amounts to colexicographical
00062    ordering.
00063    Prerequisites: n,k are natural numbers >= 0.
00064 */
00065 arithprog_ohg(k,n) := if k=0 then [create_list(i,i,1,n),[{}]]
00066  elseif n=0 then [[],[]] else
00067  [create_list(i,i,1,n),
00068   lappend(create_list(arithprog_finish(k,i),i,1,n))]\$
00069 arithprog_hg(k,n) := ohg2hg(arithprog_ohg(k,n))\$
00070
00071 /* Statistics functions: */
00072
00073 nver_arithprog_hg(k,n) := n\$
00074 nver_arithprog_ohg(k,n) := n\$
00075
00076 nhyp_arithprog_hg(k,n) :=
00077  if k=0 then 1
00078  elseif k=1 then n
00079  elseif n < k then 0
00080  else block([q : floor((n-1)/(k-1))], q * (n - 1/2*(k-1)*(q+1)))\$
00081 nhyp_arithprog_ohg(k,n) := nhyp_arithprog_hg(k,n)\$
00082
00083
00084 /* Statefree iteration through all arithmetic progressions of length k
00085    in the natural numbers, in colexicographical order.
00086 */
00087 /* Prerequisite: k natural number >= 0: */
00088 first_colex_arithprog(k) := create_list(i,i,1,k)\$
00089 /* Prerequisite: P ascending arithmetic progression of natural numbers >= 1: */
00090 next_colex_arithprog(P) := block([k : length(P)],
00091  if k=0 then done
00092  elseif k=1 then [first(P)+1]
00093  else block([d : second(P) - first(P), l : last(P)],
00094   if d>1 then d : d-1
00095   else (d : floor(l/(k-1)), l : l+1),
00096   reverse(create_list(l-i*d,i,0,k-1))
00097  ))\$
00098
00099
00100 /* ******************************************************
00101    * Generalised hypergraphs of arithmetic progressions *
00102    ******************************************************
00103 */
00104
00105 /* The list of all arithmetic progressions of length k for the sorted list L
00106    (following the order of L, first all progressions starting with the
00107    first vertex, then with the second, ...). This amounts to lexicographical
00108    ordering.
00109    Prerequisites: k natural number >= 0, L ascending w.r.t. ">".
00110 */
00111 arithmetic_progressions(L,k) :=
00112  if k = 0 then [[]]
00113  elseif k = 1 then map("[",L)
00114  else block([l : length(L)],
00115    if l <= 1 then return([]),
00116    block([x : first(L), res_without, res_with : []],
00117      L : rest(L), l : l - 1,
00118      res_without : arithmetic_progressions(L,k),
00119      /* Computing all arithmetic progressions starting with x: */
00120      while l > 0 do block([y : first(L), d, P, lp],
00121        L : rest(L), l : l - 1,
00122        d : y - x,
00123        P : [x,y], lp : 2,
00124        block([prev_el : y],
00125          for z in L unless lp = k or z - prev_el > d do
00126            if z - prev_el = d then (
00127              P : endcons(z,P), lp : lp + 1, prev_el : z
00128            )
00129        ),
00130        if lp = k then res_with : cons(P,res_with)
00131      ),
00132      return(append(reverse(res_with),res_without))))\$
00133
00134 /* The hypergraph of all arithmetic progressions of size k in the
00135    list L of different integers: */
00136 arithprog_list_ohg(k,L) := [L,map(setify,arithmetic_progressions(L,k))]\$
00137 arithprog_list_hg(k,L) := ohg2hg(arithprog_list_ohg(k,L))\$
00138
00139 /* Testing whether the set S contains an arithmetic progressions of size k.
00140    Works if S is a set of integers. In general we need +,- and order, while
00141    the precise general assumptions have to be investigated.
00142 */
00143 has_arithprog(S,k) :=
00144  if k<0 then false
00145  elseif k=0 then true
00146  elseif length(S) < k then false
00147  elseif k<=2 then true
00148  else block([x : first_element(S)],
00149    S : disjoin(x,S),
00150    some_s(lambda([y], subsetp(setify(rest(arpr(k,x,y-x),2)), S)), S)
00151    or has_arithprog(S,k))\$
00152
00153
00154 /* ************
00155    * Symmetry *
00156    ************
00157 */
00158
00159 /* VdW-hypergraphs G have the mirror symmetry m, defined as reflection on the
00160    middle point of the vertex-set. Now for an ordered vdW-hypergraph G we
00161    enforce that all colourings f are symmetric w.r.t. m, that is,
00162      f(v) = f(m(v)).
00163    More precisely:
00164    Let n be the number of vertices in G (so the vertices are 1, ..., n).
00165    Then m_n(v) = n-v+1. m is a bijection from {1,...,floor(n/2)} to
00166    {ceil(n/2)+1,...,n}, while for odd n the vertex floor(n/2)+1=ceil(n/2)
00167    is fixed by m.
00168    Now the function palindromise_vdw_(o)hg(G) replaces every vertex v >= n/2+1
00169    by its mirror image m(v). The new vertices are 1, ..., ceil(n/2).
00170    Furthermore all subsumed clauses are removed from the obtained list of
00171    hyperedges, sorting the clauses then in colexicographical order.
00172
00173    This amounts to considering for colourings of G only the palindromic
00174    colourings (those colourings which read forward and backward the same).
00175 */
00176
00177 /* First the function which creates that choice function which w.r.t. the
00178    equivalence relation created by a~b iff m_n(a) = b chooses as representative
00179    of {a,b} the smaller element. mirrorfold_vdw(n) is a function from {1,...,n}
00180    to {1,...,ceiling(n/2)} for natural numbers n >= 0.
00181 */
00182 mirrorfold_vdw(n) := buildq([n,div:ceiling(n/2)],
00183   lambda([v], if v >= div+1 then n-v+1 else v))\$
00184
00185 /* Now the palindromisation of vdW-hypergraphs (colexicographical order, with
00186    subsumption-elimination): */
00187 palindromise_vdw_ohg(G) :=
00188  if emptyp(first(G)) then G
00189  else block([n : last(first(G)), div, V],
00190   div : ceiling(n/2),
00191   V : create_list(i,i,1,div),
00192   if emptyp(second(G)) or emptyp(first(second(G))) then return([V,second(G)])
00193   else return(
00194   [V,
00195    map(setify,
00196        sort(map(listify,
00197               min_elements_l(unique(
00198                 map(lambda([H], map(mirrorfold_vdw(n), H)),
00199                     sublist(second(G), lambda([H], is(first(H) < div+1))))))),
00200             colex_lessp_l))]))\$
00201 palindromise_vdw_hg(G) :=
00202  if emptyp(first(G)) then G
00203  else block([n : last(first(G)), div, V],
00204   div : ceiling(n/2),
00205   V : setn(div),
00206   if emptyp(second(G)) or emptyp(first(second(G))) then return([V,second(G)])
00207   else return(
00208   [V,
00209    min_elements(
00210     map(
00211       lambda([H], map(mirrorfold_vdw(n), H)),
00212       subset(second(G), lambda([H], is(first(H) < div+1)))))]))\$
00213 /* Comment: both functions use that first(X), last(X) is the smallest/largest
00214    element of set X. */
00215
00216 /* Now the direct computation of palindromise_vdw_ohg(arithprog_ohg(k,n))
00217    and palindromise_vdw_hg(arithprog_hg(k,n)):
00218 */
00219 arithprog_pd_hg(k,n) := block([div:ceiling(n/2),V,p1,G,mf,A],
00220   V : setn(div),
00221   if n<k then return([V,{}])
00222   elseif n=k then return([V,{V}])
00223   elseif k=0 then return([V,{{}}])
00224   elseif k=1 then return([V,singletons(V)])
00225   elseif k=2 then return([V,singletons(setn(floor(n/2)))]),
00226   p1 : lambda([x],x+1),
00227   G : map(lambda([H],map(p1,H)),listify(second(arithprog_pd_hg(k,n-2)))),
00228   mf : mirrorfold_vdw(n),
00229   A : sublist(map(lambda([H],map(mf,H)),arithprog_finish(k,n)),
00230              lambda([H], every_s(lambda([E], not subsetp(E,H)), G))),
00231   A : min_elements_l(A),
00232   return([V, setify(append(G,A))]))\$
00233
```