Commit 02df92e4 authored by kilian.sprotte's avatar kilian.sprotte

big update

The API resembles much more the original gecode one.
Added support for finite sets.
Can now use BAB search.

darcs-hash:c8b49fada41ba5aa80c664ef972fb715a5410588
parent 64cb1b2f
......@@ -29,67 +29,106 @@
(in-package :cl-user)
;; TODO maybe use gecol:intvar-assigned
(defun cartesian-product ()
(let ((s (gecol:create-space 3 1 3 0 0)))
(gecol:gec-branch-vars-min s)
(let ((e (gecol:create-search-engine s)))
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
(gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
(let ((e (gecol:make-dfs-space-int-int-stop s)))
(loop
for sol = (gecol:search-next e)
for sol = (gecol:dfs-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))))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun distinct ()
(let ((s (gecol:create-space 3 1 3 0 0)))
(gecol:gec-distinct s (list 0 1 2) :icl-def)
(gecol:gec-branch-vars-min s)
(let ((e (gecol:create-search-engine s)))
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
(gecol:distinct-intvarargs-intconlevel s varargs :icl-def)
(gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
(let ((e (gecol:make-dfs-space-int-int-stop s)))
(loop
for sol = (gecol:search-next e)
for sol = (gecol:dfs-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))))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun sorted ()
(let ((s (gecol:create-space 3 1 3 0 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)))
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:rel-intvar-intreltype-intvar-intconlevel s
(gecol:gecolspace-getint-int s 0)
:irt-<
(gecol:gecolspace-getint-int s 1)
:icl-def)
(gecol:rel-intvar-intreltype-intvar-intconlevel s
(gecol:gecolspace-getint-int s 1)
:irt-<
(gecol:gecolspace-getint-int s 2)
:icl-def)
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
(gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
(let ((e (gecol:make-dfs-space-int-int-stop s)))
(loop
for sol = (gecol:search-next e)
for sol = (gecol:dfs-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))))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun cartesian-product-distr-max ()
(let ((s (gecol:create-space 3 1 3 0 0)))
(gecol:gec-branch-vars-max s)
(let ((e (gecol:create-search-engine s)))
"Like cartesian-product, but using a different branching."
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
;; branching
(gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-max))
(let ((e (gecol:make-dfs-space-int-int-stop s)))
(loop
for sol = (gecol:search-next e)
for sol = (gecol:dfs-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))))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun distinct-minimal-third ()
"Like distinct, but minimizing the third variable."
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3
:bab-intvar-ind 2 :bab-intreltype :irt-<)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
(gecol:distinct-intvarargs-intconlevel s varargs :icl-def)
(gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
(let ((e (gecol:make-bab-space-int-int-stop s)))
(loop
for sol = (gecol:bab-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-bab e)
(gecol:delete-gecolspace s))))
This diff is collapsed.
......@@ -29,50 +29,26 @@
(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))))
;;; GecolSpace
(defun make-gecolspace (&key
(intnum 0)
(intmin 0)
(intmax 2)
(boolnum 0)
(setnum 0)
(bab-intvar-ind 0)
(bab-intreltype :irt->))
(%make-gecolspace intnum intmin intmax boolnum setnum bab-intvar-ind bab-intreltype))
;;; DFS
(defun make-dfs-space-int-int-stop (space &key (c-d 1) (a-d 1) (stop (cffi:null-pointer)))
(%make-dfs-space-int-int-stop space c-d a-d stop))
;;; BAB
(defun make-bab-space-int-int-stop (space &key (c-d 1) (a-d 1) (stop (cffi:null-pointer)))
(%make-bab-space-int-int-stop space c-d a-d stop))
;;; Sets
(defun gec-fs-enumerate-lower-bound (set)
(unless (zerop (gec-fs-glb-size set))
(iter
......@@ -107,3 +83,34 @@
(setf (cffi:mem-aref ,array :int i) elt))
,@body))))
(defcstruct var-arg-array
"actually a lispy version of it, made up for wrapping the original VarArgArray"
(size :int)
(array :pointer))
(export 'with-var-arg-array)
;;; TODO - we will use this /a lot/. So you should
;;; try to make the generated code as small as possible.
(defmacro with-var-arg-array ((list var &key (type :pointer)) &body body)
(check-type var symbol)
(let ((=list= (gensym "LIST")))
`(let* ((,=list= ,list)
(list-len (length ,=list=)))
(with-foreign-object (array* ,type list-len)
(iter
(for elt in ,=list=)
(for i upfrom 0)
(setf (mem-aref array* ,type i) elt))
(with-foreign-object (,var 'var-arg-array)
(with-foreign-slots ((size array) ,var var-arg-array)
(setf size list-len
array array*)
,@body))))))
(defun gec-minus (space a b c)
"a - b = c"
(with-var-arg-array ('(1 -1) coeffs :type :int)
(with-var-arg-array ((list a b) a-b)
(gecol:linear-intargs-intvarargs-intreltype-intvar-intconlevel
space coeffs a-b :irt-= c :icl-def))))
This diff is collapsed.
......@@ -30,55 +30,15 @@
(in-package :cl-user)
(defpackage :gecol
(:documentation "This is the gecol package, providing bindings to work with GECODE.")
(:documentation "Provides bindings to GECODE.")
(:use :cl :iterate :cffi)
(:export
#:create-search-engine
#:create-space
#:dispose-search-engine
#:dispose-space
#:search-next
#:space-read-int
#:space-read-bool
;; propagators
#:gec-bool-and
#:gec-bool-and-const
#:gec-bool-assigned
#:gec-bool-eq
#:gec-bool-eq-const
#:gec-bool-eqv
#:gec-bool-eqv-const
#:gec-bool-imp
#:gec-bool-imp-const
#:gec-bool-not
#:gec-bool-or
#:gec-bool-or-const
#:gec-bool-xor
#:gec-bool-xor-const
#:gec-branch-vars-max
#:gec-branch-vars-med
#:gec-branch-vars-min
#:gec-distance
#:gec-distance-const
#:gec-distinct
#:gec-dom-var
#:gec-dom-var-set
#:gec-element-const
#:gec-element-vars
#:gec-int-assigned
#:gec-linear-const
#:gec-linear-var
#:gec-max
#:gec-min
#:make-gecolspace
#:make-dfs-space-int-int-stop
#:make-bab-space-int-int-stop
;; Ints
#:gec-minus
#:gec-mod-12
#:gec-mult
#:gec-rel-const
#:gec-rel-reif
#:gec-rel-var
;; Sets
#:gec-fs-space-put
#:gec-fs-space-get
#:gec-fs-make-const
#:gec-fs-make-bounds
#:gec-fs-make-lower-bound
......@@ -99,16 +59,6 @@
#:gec-fs-enumerate-lower-bound
#:gec-fs-enumerate-upper-bound
#:gec-fs-value
#:gec-fs-cardinality-const
#:gec-fs-cardinality
#:gec-fs-rel-setvar-setreltype-setvar
#:gec-fs-rel-setvar-setreltype-setvar-boolvar
#:gec-fs-rel-intvar-setreltype-setvar
#:gec-fs-rel-intvar-setreltype-setvar-boolvar
#:gec-fs-rel-setvar-setoptype-setvar-setreltype-setvar
#:gec-fs-min
#:gec-fs-max
;;; utils
#:with-list-as-int-array
))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment