OKlibrary  0.2.1.6
Hindman.mac
Go to the documentation of this file.
00001 /* Oliver Kullmann, 12.7.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/TermSystems/Lisp/Conversions.mac")$
00023 oklib_include("OKlib/ComputerAlgebra/Hypergraphs/Lisp/SetSystems.mac")$
00024 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")$
00025 
00026 
00027 /* ***********************
00028    * Hindman quads (k=2) *
00029    ***********************
00030 */
00031 
00032 /* The hypergraph with vertex set {1, ..., n} and as hyperedges all possible
00033    subsets {x,y,x+y,x*y}:
00034 */
00035 hindman_a1k2_ohg(n) :=
00036  [create_list(i,i,1,n),
00037   append(create_list({1,y,1+y},y,1,n-1),
00038     create_list({x,y,x+y,x*y}, x,2,floor(sqrt(n)), y,x,floor(n/x)))]$
00039 
00040 nver_hindman_a1k2_ohg(n) := n$
00041 nhyp_hindman_a1k2_ohg(n) :=
00042  if n <= 1 then 0 else block([s : floor(sqrt(n))],
00043  n-1 - (s-1)*s/2 + sum(floor(n/x), x,2,s))$
00044 /* By definition: nhyp_hindman_a1k2_ohg(n) = 
00045      n-1 + sum(floor(n/x) - x + 1, x, 2, floor(sqrt(n)))
00046 */
00047 /* We have nhyp_hindman_a1k2_ohg(n) = count_quadintsol_bydef(1,n)
00048    (see ComputerAlgebra/NumberTheory/Lisp/Quadratics.mac).
00049 */
00050 
00051 /* The "injective" version, not allowing x=y: */
00052 hindmani_a1k2_ohg(n) :=
00053  [create_list(i,i,1,n),
00054   append(create_list({1,y,1+y},y,2,n-1),
00055     create_list({x,y,x+y,x*y}, x,2,floor(sqrt(n)), y,x+1,floor(n/x)))]$
00056 
00057 nver_hindmani_a1k2_ohg(n) := n$
00058 nhyp_hindmani_a1k2_ohg(n) :=
00059  if n <= 2 then 0 else block([s : floor(sqrt(n))],
00060  n-1 - (s+1)*s/2 + sum(floor(n/x), x,2,s))$
00061 /* nhyp_hindmani_a1k2_ohg(n) = 
00062      n-2 + sum(floor(n/x) - x, x, 2, floor(sqrt(n))) = 
00063      nhyp_hindman_a1k2_ohg(n) - floor(sqrt(n))
00064 */
00065 
00066 /* Instead of vertex set {1, ..., n} now {a, ..., n} is considered. */
00067 /* Prerequisite: a >= 1. */
00068 hindman_k2_ohg(a,n) := [create_list(i,i,a,n),
00069  block([M : create_list({x,y,x+y,x*y}, x,max(a,2),floor(sqrt(n)), y,x,floor(n/x))],
00070   if a >= 2 then M else
00071    append(create_list({1,y,1+y},y,1,n-1),M))]$
00072 
00073 nver_hindman_k2_ohg(a,n) := max(n-a+1,0)$
00074 nhyp_hindman_k2_ohg(a,n) := if a=1 then nhyp_hindman_a1k2_ohg(n) else
00075   block([s : floor(sqrt(n))], if a>s then 0 else
00076     (s-a+1)*(1-(s+a)/2)+sum(floor(n/x), x,a,s))$
00077 
00078 /* Again, only allowing x <> y: */
00079 hindmani_k2_ohg(a,n) := [create_list(i,i,a,n),
00080  block([M : create_list({x,y,x+y,x*y}, x,max(a,2),floor(sqrt(n)), y,x+1,floor(n/x))],
00081   if a >= 2 then M else
00082    append(create_list({1,y,1+y},y,2,n-1),M))]$
00083 
00084 nver_hindmani_k2_ohg(a,n) := max(n-a+1,0)$
00085 nhyp_hindmani_k2_ohg(a,n) := if a=1 then nhyp_hindmani_a1k2_ohg(n) else
00086   block([s : floor(sqrt(n))], if a>s then 0 else
00087     -(s-a+1)*(s+a)/2+sum(floor(n/x), x,a,s))$
00088 
00089 
00090 /* ********************
00091    * The general case *
00092    ********************
00093 */
00094 
00095 /* First trivial implementations (for correctness checking). */
00096 
00097 /* Prerequisites: a >= 1, k >= 0, n >= 0 (all natural numbers). */
00098 
00099 /* The order on the hyperedges {x_1,...,x_k, ... } is induced by
00100    the lexicographical order on the tuples [x_1, ..., x_k].
00101    For k >= 3 duplicates can occur, and then the first in the list
00102    is kept (all others are removed).
00103 */
00104 hindman_ohg_0(a,k,n) := block(
00105  [V : create_list(i,i,a,n),
00106   Var : create_list(indexed_symbol(i),i,1,k),
00107   T, H],
00108   T : all_ord_tuples_l(V,k),
00109   H : union(
00110    map(sum_l,map(listify,disjoin({},powerset(setify(Var))))),
00111    map(prod_l,map(listify,disjoin({},powerset(setify(Var)))))),
00112   [V, stable_unique(sublist(
00113     map(lambda([t], at(H, map("=", Var,t))), T),
00114     lambda([S], subsetp(S,setify(V)))))])$
00115 
00116 hindmani_ohg_0(a,k,n) := block(
00117  [V : create_list(i,i,a,n),
00118   Var : create_list(indexed_symbol(i),i,1,k),
00119   T, H],
00120   T : map(listify,listify(powerset(setify(V),k))),
00121   H : union(
00122    map(sum_l,map(listify,disjoin({},powerset(setify(Var))))),
00123    map(prod_l,map(listify,disjoin({},powerset(setify(Var)))))),
00124   [V, sublist(
00125     map(lambda([t], at(H, map("=", Var,t))), T),
00126     lambda([S], subsetp(S,setify(V))))])$
00127