Commit dffd2290 authored by kilian.sprotte's avatar kilian.sprotte

initial import

darcs-hash:9af3205c9a070eee3260c19ca9ee1bd634d85af2
parent 4dc2cf29
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*-
;;; arch-tag: 7debdb50-4feb-4e57-b6fd-a1d1eaf6ceab
;;; Copyright (c) 2006, Kilian Sprotte. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :cl-user)
(defun cartesian-product ()
(let ((s (gecol:create-space 3 1 3 0)))
(gecol:gec-branch-vars-min s)
(let ((e (gecol:create-search-engine s)))
(loop
for sol = (gecol:search-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:space-read-int sol 0)
(gecol:space-read-int sol 1)
(gecol:space-read-int sol 2))
do (gecol:dispose-space sol))
(gecol:dispose-search-engine e)
(gecol:dispose-space s))))
(defun distinct ()
(let ((s (gecol:create-space 3 1 3 0)))
(gecol:gec-distinct s (list 0 1 2) :icl-def)
(gecol:gec-branch-vars-min s)
(let ((e (gecol:create-search-engine s)))
(loop
for sol = (gecol:search-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:space-read-int sol 0)
(gecol:space-read-int sol 1)
(gecol:space-read-int sol 2))
do (gecol:dispose-space sol))
(gecol:dispose-search-engine e)
(gecol:dispose-space s))))
(defun sorted ()
(let ((s (gecol:create-space 3 1 3 0)))
(gecol:gec-rel-var s 0 :irt-< 1 :icl-def)
(gecol:gec-rel-var s 1 :irt-< 2 :icl-def)
(gecol:gec-branch-vars-min s)
(let ((e (gecol:create-search-engine s)))
(loop
for sol = (gecol:search-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:space-read-int sol 0)
(gecol:space-read-int sol 1)
(gecol:space-read-int sol 2))
do (gecol:dispose-space sol))
(gecol:dispose-search-engine e)
(gecol:dispose-space s))))
(defun cartesian-product-distr-max ()
(let ((s (gecol:create-space 3 1 3 0)))
(gecol:gec-branch-vars-max s)
(let ((e (gecol:create-search-engine s)))
(loop
for sol = (gecol:search-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:space-read-int sol 0)
(gecol:space-read-int sol 1)
(gecol:space-read-int sol 2))
do (gecol:dispose-space sol))
(gecol:dispose-search-engine e)
(gecol:dispose-space s))))
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: GECOL; Base: 10 -*-
;;; arch-tag: 09C25807-504D-487A-B9D3-275276CF17B1
;;; Copyright (c) 2006, Kilian Sprotte. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :gecol)
(defcenum int-rel-type
:irt-= ; =
:irt-/= ; /=
:irt-<= ; <=
:irt-< ; <
:irt->= ; >=
:irt-> ; >
)
(defcenum int-con-level
:icl-val ; Value consistency (naive)
:icl-bnd ; Bounds consistency.
:icl-dom ; Domain consistency.
:icl-def ;The default consistency for a constraint.
)
(defcfun ("create_space" create-space) :pointer
(varnum :int)
(varmin :int)
(varmax :int)
(boolnum :int))
(defcfun ("dispose_space" dispose-space) :void
(space :pointer))
(defcfun ("create_search_engine" create-search-engine) :pointer
(space :pointer))
(defcfun ("dispose_search_engine" dispose-search-engine) :void
(engine :pointer))
(defcfun ("search_next" search-next) :pointer
(engine :pointer))
(defcfun space-read-int :int
(space :pointer)
(index :int))
(defcfun space-read-bool :boolean
(space :pointer)
(index :int))
(defcfun gec-branch-vars-min :void
(space :pointer))
(defcfun gec-branch-vars-med :void
(space :pointer))
(defcfun gec-branch-vars-max :void
(space :pointer))
(defcfun ("gec_rel_var" gec-rel-var) :void
(space :pointer)
(x :int)
(type int-rel-type)
(y :int)
(level int-con-level))
(defcfun ("gec_rel_const" gec-rel-const) :void
(space :pointer)
(x :int)
(type int-rel-type)
(c :int)
(level int-con-level))
(defcfun ("gec_rel_reif" gec-rel-reif) :void
(space :pointer)
(x :int)
(type int-rel-type)
(y :int)
(b :int)
(level int-con-level))
(defcfun ("gec_dom_var" gec-dom-var) :void
(space :pointer)
(x :int)
(min :int)
(max :int)
(level int-con-level))
(defcfun ("gec_dom_var_set" %gec-dom-var-set) :void
(space :pointer)
(x :int)
(dom :pointer)
(n :int)
(level int-con-level))
(defcfun ("gec_linear_var" %gec-linear-var) :void
(space :pointer)
(res :int)
(type int-rel-type)
(xs :pointer)
(n :int)
(level int-con-level))
(defcfun ("gec_linear_const" %gec-linear-const) :void
(space :pointer)
(res :int)
(type int-rel-type)
(xs :pointer)
(n :int)
(level int-con-level))
(defcfun ("gec_distinct" %gec-distinct) :void
(space :pointer)
(xs :pointer)
(n :int)
(level int-con-level))
(defcfun ("gec_distance" gec-distance) :void
(space :pointer)
(res :int)
(a :int)
(b :int))
(defcfun gec-distance-const :void
(space :pointer)
(res :int)
(a :int)
(b :int))
(defcfun ("gec_min" gec-min) :void
(space :pointer)
(res :int)
(a :int)
(b :int)
(level int-con-level))
(defcfun ("gec_max" gec-max) :void
(space :pointer)
(res :int)
(a :int)
(b :int)
(level int-con-level))
(defcfun ("gec_mult" gec-mult) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_minus" gec-minus) :void
(space :pointer)
(res :int)
(a :int)
(b :int)
(level int-con-level))
(defcfun ("gec_bool_eq" gec-bool-eq) :void
(space :pointer)
(a :int)
(b :int)
(level int-con-level))
(defcfun ("gec_bool_eq_const" gec-bool-eq-const) :void
(space :pointer)
(a :int)
(const :int)
(level int-con-level))
(defcfun ("gec_bool_not" gec-bool-not) :void
(space :pointer)
(a :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_and" gec-bool-and) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_and_const" gec-bool-and-const) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_or" gec-bool-or) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_or_const" gec-bool-or-const) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_xor" gec-bool-xor) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_xor_const" gec-bool-xor-const) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_imp" gec-bool-imp) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_imp_const" gec-bool-imp-const) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_eqv" gec-bool-eqv) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_bool_eqv_const" gec-bool-eqv-const) :void
(space :pointer)
(a :int)
(b :int)
(res :int)
(level int-con-level))
(defcfun ("gec_int_assigned" gec-int-assigned) :boolean
(space :pointer)
(x :int))
(defcfun ("gec_bool_assigned" gec-bool-assigned) :boolean
(space :pointer)
(x :int))
(defcfun ("gec_element_const" %gec-element-const) :void
(space :pointer)
(ns :pointer)
(n :int)
(x0 :int)
(x1 :int)
(level int-con-level))
(defcfun ("gec_element_vars" %gec-element-vars) :void
(space :pointer)
(xs :pointer)
(n :int)
(x0 :int)
(x1 :int)
(level int-con-level))
(defcfun ("gec_mod_12" gec-mod-12) :void
(space :pointer)
(x :int)
(m :int))
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: GECOL; Base: 10 -*-
;;; arch-tag: B2840A52-3BDD-47DB-A03F-1C700ACFF6BC
;;; Copyright (c) 2006, Kilian Sprotte. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :gecol)
(defun gec-dom-var-set (space x dom level)
(let ((n (length dom)))
(with-foreign-object (xs :int n)
(dotimes (i n)
(setf (mem-aref xs :int i) (nth i dom)))
(%gec-dom-var-set space x xs n level))))
(defun gec-linear-var (space res type list level)
(let ((n (length list)))
(with-foreign-object (xs :int n)
(dotimes (i n)
(setf (mem-aref xs :int i) (nth i list)))
(%gec-linear-var space res type xs n level))))
(defun gec-linear-const (space res type list level)
(let ((n (length list)))
(with-foreign-object (xs :int n)
(dotimes (i n)
(setf (mem-aref xs :int i) (nth i list)))
(%gec-linear-const space res type xs n level))))
(defun gec-distinct (space list level)
(let ((n (length list)))
(with-foreign-object (xs :int n)
(dotimes (i n)
(setf (mem-aref xs :int i) (nth i list)))
(%gec-distinct space xs n level))))
(defun gec-element-vars (space list ind var level)
(let ((n (length list)))
(with-foreign-object (xs :int n)
(dotimes (i n)
(setf (mem-aref xs :int i) (nth i list)))
(%gec-element-vars space xs n ind var level))))
(defun gec-element-const (space list ind var level)
(let ((n (length list)))
(with-foreign-object (xs :int n)
(dotimes (i n)
(setf (mem-aref xs :int i) (nth i list)))
(%gec-element-const space xs n ind var level))))
\ No newline at end of file
// arch-tag: DB2FEBED-DE12-4185-B2F1-225EC7A49C12
// Copyright (c) 2006, Kilian Sprotte. All rights reserved.
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// * Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// * Redistributions in binary form must reproduce the above
// copyright notice, this list of conditions and the following
// disclaimer in the documentation and/or other materials
// provided with the distribution.
// THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
// DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
// GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
// WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
// NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#include "gecode/int.hh"
#include "gecode/search.hh"
#include "gecode/minimodel.hh"
using namespace Gecode;
extern "C" {
void* create_space(int varnum, int varmin, int varmax, int boolnum);
void dispose_space(void* space);
void* create_search_engine(void* space);
void dispose_search_engine(void* engine);
void* search_next(void* engine);
bool gec_int_assigned(void* space, int x);
bool gec_bool_assigned(void* space, int x);
int space_read_int(void* space, int index);
int space_read_bool(void* space, int index);
void gec_branch_vars_min(void* space);
void gec_branch_vars_med(void* space);
void gec_branch_vars_max(void* space);
void gec_rel_var(void* space, int x, int type, int y, int level);
void gec_rel_const(void* space, int x, int type, int c, int level);
void gec_rel_reif(void* space, int x, int type, int y, int b, int level);
void gec_dom_var(void* space, int x, int min, int max, int level);
void gec_dom_var_set(void* space, int x, int* d, int n, int level);
void gec_linear_var(void* space, int res, int type, int* xs, int n, int level);
void gec_linear_const(void* space, int res, int type, int* xs, int n, int level);
void gec_distinct(void* space, int* xs, int n, int level);
void gec_distance(void* space, int res, int a, int b);
void gec_distance_const(void* space, int res, int a, int b);
void gec_min(void* space, int res, int a, int b, int level);
void gec_max(void* space, int res, int a, int b, int level);
void gec_mult(void* space, int a, int b, int res, int level);
void gec_minus(void* space, int res, int a, int b, int level);
void gec_bool_eq(void* space, int a, int b, int level);
void gec_bool_eq_const(void* space, int a, int b, int level);
void gec_bool_not(void* space, int a, int res, int level);
void gec_bool_and(void* space, int a, int b, int res, int level);
void gec_bool_and_const(void* space, int a, int b, int res, int level);
void gec_bool_or(void* space, int a, int b, int res, int level);
void gec_bool_or_const(void* space, int a, int b, int res, int level);
void gec_bool_xor(void* space, int a, int b, int res, int level);
void gec_bool_xor_const(void* space, int a, int b, int res, int level);
void gec_bool_imp(void* space, int a, int b, int res, int level);
void gec_bool_imp_const(void* space, int a, int b, int res, int level);
void gec_bool_eqv(void* space, int a, int b, int res, int level);
void gec_bool_eqv_const(void* space, int a, int b, int res, int level);
void gec_element_const(void* space, int* ns, int n, int x0, int x1, int level);
void gec_element_vars(void* space, int* xs, int n, int x0, int x1, int level);
void gec_mod_12(void* space, int x, int m);
}
class Simple : public Space {
protected:
IntVarArray vars;
BoolVarArray bools;
public:
Simple(int varnum, int varmin, int varmax,
int boolnum) : vars(this, varnum, varmin, varmax),
bools(this, boolnum, 0, 1)
{
}
/// Constructor for cloning \a s
Simple(bool share, Simple& s) : Space(share,s) {
vars.update(this, share, s.vars);
bools.update(this, share, s.bools);
}
/// Copy during cloning
virtual Space*
copy(bool share) {
return new Simple(share,*this);
}
IntVarArray* get_vars () {
return &vars;
}
IntVarArray get_vars2 () {
return vars;
}
BoolVarArray get_bools2 () {
return bools;
}
};
void* create_space(int varnum, int varmin, int varmax, int boolnum)
{
Simple* s = new Simple(varnum, varmin, varmax, boolnum);
return (void*)s;
}
void dispose_space(void* space)
{
delete (Simple*)space;
}
void* create_search_engine(void* space)
{
Simple* s = (Simple*)space;
DFS<Simple>* e = new DFS<Simple>(s,1,1);
return (void*)e;
}
void dispose_search_engine(void* engine)
{
delete (DFS<Simple>*)engine;
}
void* search_next(void* engine)
{
DFS<Simple>* e = (DFS<Simple>*)engine;
return (void*)e->next();
}
// TODO ch to get_vars2
int space_read_int(void* space, int index)
{
Simple* s = (Simple*)space;
IntVarArray* array = s->get_vars();
IntVar x = (*array)[index];
return x.val();
}
int space_read_bool(void* space, int index)
{
Simple* s = (Simple*)space;
BoolVarArray array = s->get_bools2();
BoolVar x = array[index];
return x.val();
}
void gec_branch_vars_min(void* space)
{
branch((Simple*)space,(*((Simple*)space)->get_vars()),BVAR_NONE,BVAL_MIN);
}
void gec_branch_vars_med(void* space)
{
branch((Simple*)space,(*((Simple*)space)->get_vars()),BVAR_NONE,BVAL_MED);
}
void gec_branch_vars_max(void* space)
{
branch((Simple*)space,(*((Simple*)space)->get_vars()),BVAR_NONE,BVAL_MAX);
}
void gec_rel_var(void* space, int x, int type, int y, int level)
{
Simple* s = (Simple*)space;
IntVarArray vars = s->get_vars2();
rel(s, vars[x], (IntRelType)type, vars[y], (IntConLevel)level);
}