big update
Annotate for file examples.lisp
2006-12-07 kilian.sprot 1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*-
21:06:18 ' 2 ;;; arch-tag: 7debdb50-4feb-4e57-b6fd-a1d1eaf6ceab
' 3
' 4 ;;; Copyright (c) 2006, Kilian Sprotte. All rights reserved.
' 5
' 6 ;;; Redistribution and use in source and binary forms, with or without
' 7 ;;; modification, are permitted provided that the following conditions
' 8 ;;; are met:
' 9
' 10 ;;; * Redistributions of source code must retain the above copyright
' 11 ;;; notice, this list of conditions and the following disclaimer.
' 12
' 13 ;;; * Redistributions in binary form must reproduce the above
' 14 ;;; copyright notice, this list of conditions and the following
' 15 ;;; disclaimer in the documentation and/or other materials
' 16 ;;; provided with the distribution.
' 17
' 18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
' 19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
' 20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
' 21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
' 22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
' 23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
' 24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
' 25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
' 26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
' 27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
' 28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
' 29
' 30 (in-package :cl-user)
' 31
2007-01-08 kilian.sprot 32 ;; TODO maybe use gecol:intvar-assigned
2006-12-07 kilian.sprot 33 (defun cartesian-product ()
2007-01-08 kilian.sprot 34 (let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
01:49:57 ' 35 (gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
' 36 varargs)
' 37 (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
' 38 (let ((e (gecol:make-dfs-space-int-int-stop s)))
2006-12-07 kilian.sprot 39 (loop
2007-01-08 kilian.sprot 40 for sol = (gecol:dfs-next e)
2007-02-06 kilian.sprot 41 until (cffi:null-pointer-p sol)
19:09:14 ' 42 do (format t "~a, ~a, ~a~%"
2007-01-08 kilian.sprot 43 (gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
01:49:57 ' 44 (gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
' 45 (gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
' 46 do (gecol:delete-gecolspace sol))
' 47 (gecol:delete-dfs e)
' 48 (gecol:delete-gecolspace s))))
2006-12-07 kilian.sprot 49
21:06:18 ' 50 (defun distinct ()
2007-01-08 kilian.sprot 51 (let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
01:49:57 ' 52 (gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
' 53 varargs)
' 54 (gecol:distinct-intvarargs-intconlevel s varargs :icl-def)
' 55 (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
' 56 (let ((e (gecol:make-dfs-space-int-int-stop s)))
2006-12-07 kilian.sprot 57 (loop
2007-01-08 kilian.sprot 58 for sol = (gecol:dfs-next e)
2007-02-06 kilian.sprot 59 until (cffi:null-pointer-p sol)
19:09:14 ' 60 do (format t "~a, ~a, ~a~%"
2007-01-08 kilian.sprot 61 (gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
01:49:57 ' 62 (gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
' 63 (gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
' 64 do (gecol:delete-gecolspace sol))
' 65 (gecol:delete-dfs e)
' 66 (gecol:delete-gecolspace s))))
2006-12-07 kilian.sprot 67
21:06:18 ' 68 (defun sorted ()
2007-01-08 kilian.sprot 69 (let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
01:49:57 ' 70 (gecol:rel-intvar-intreltype-intvar-intconlevel s
' 71 (gecol:gecolspace-getint-int s 0)
' 72 :irt-<
' 73 (gecol:gecolspace-getint-int s 1)
' 74 :icl-def)
' 75 (gecol:rel-intvar-intreltype-intvar-intconlevel s
' 76 (gecol:gecolspace-getint-int s 1)
' 77 :irt-<
' 78 (gecol:gecolspace-getint-int s 2)
' 79 :icl-def)
' 80
' 81 (gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
' 82 varargs)
' 83 (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
' 84 (let ((e (gecol:make-dfs-space-int-int-stop s)))
2006-12-07 kilian.sprot 85 (loop
2007-01-08 kilian.sprot 86 for sol = (gecol:dfs-next e)
2007-02-06 kilian.sprot 87 until (cffi:null-pointer-p sol)
19:09:14 ' 88 do (format t "~a, ~a, ~a~%"
2007-01-08 kilian.sprot 89 (gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
01:49:57 ' 90 (gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
' 91 (gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
' 92 do (gecol:delete-gecolspace sol))
' 93 (gecol:delete-dfs e)
' 94 (gecol:delete-gecolspace s))))
2006-12-07 kilian.sprot 95
21:06:18 ' 96 (defun cartesian-product-distr-max ()
2007-01-08 kilian.sprot 97 "Like cartesian-product, but using a different branching."
01:49:57 ' 98 (let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
' 99 (gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
' 100 varargs)
' 101 ;; branching
' 102 (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-max))
' 103 (let ((e (gecol:make-dfs-space-int-int-stop s)))
2006-12-07 kilian.sprot 104 (loop
2007-01-08 kilian.sprot 105 for sol = (gecol:dfs-next e)
2007-02-06 kilian.sprot 106 until (cffi:null-pointer-p sol)
19:09:14 ' 107 do (format t "~a, ~a, ~a~%"
2007-01-08 kilian.sprot 108 (gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
01:49:57 ' 109 (gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
' 110 (gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
' 111 do (gecol:delete-gecolspace sol))
' 112 (gecol:delete-dfs e)
' 113 (gecol:delete-gecolspace s))))
2006-12-07 kilian.sprot 114
2007-01-08 kilian.sprot 115 (defun distinct-minimal-third ()
01:49:57 ' 116 "Like distinct, but minimizing the third variable."
' 117 (let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3
' 118 :bab-intvar-ind 2 :bab-intreltype :irt-<)))
' 119 (gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
' 120 varargs)
' 121 (gecol:distinct-intvarargs-intconlevel s varargs :icl-def)
' 122 (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
' 123 (let ((e (gecol:make-bab-space-int-int-stop s)))
' 124 (loop
' 125 for sol = (gecol:bab-next e)
' 126 until (cffi:null-pointer-p sol)
' 127 do (format t "~a, ~a, ~a~%"
' 128 (gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
' 129 (gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
' 130 (gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
' 131 do (gecol:delete-gecolspace sol))
' 132 (gecol:delete-bab e)
' 133 (gecol:delete-gecolspace s))))
2006-12-07 kilian.sprot 134
2007-02-06 kilian.sprot 135