Screamer adds support for nondeterministic and constraint programming, including backtracking and undoable side-effects.
Screamer was originally written by Jeffrey Mark Siskind and David Allen McAllester, and released under an non-DFSG-free "old school" license in 1991. It has since then been released with permission under at least GPL and MIT-licenses.
Probably the most alive version of Screamer is an MIT-licensed copy on Github, which should run on any ANSI Common Lisp and can be installed using Quicklisp.
The following Screamer code finds a 3x3 matrix of the integers between 1 and 9, such that the sums of the verticals, horizontals, and diagonals are equal.
(defun 3X3 ()
(let ((a (an-integer-betweenv 1 9))
(b (an-integer-betweenv 1 9))
(c (an-integer-betweenv 1 9))
(d (an-integer-betweenv 1 9))
(e (an-integer-betweenv 1 9))
(f (an-integer-betweenv 1 9))
(g (an-integer-betweenv 1 9))
(h (an-integer-betweenv 1 9))
(i (an-integer-betweenv 1 9)))
(assert! (/=v a b c d e f g h i))
(assert! (=v (+v a b c) (+v d e f) (+v g h i)
(+v a d g) (+v b e h) (+v c f i)
(+v a e i) (+v c e g)))
(apply #'format (append (list t "Solution: ~%~d ~d ~d~%~d ~d ~d~%~d ~d ~d")
(one-value (solution (list a b c d e f g h i)
(static-ordering #'linear-force)))))))
SCREAMER-USER 4 > (3X3)
Solution:
2 7 6
9 5 1
4 3 8
NIL There is also an extension to Screamer, called Screamer+, described in the paper Constraint Handling in Common LISP. A copy of the source code that "may be used cost-free for non-commercial use" can be found here.
Notes
Install
Buried at the bottom of screamer/README, it says you need a certain "preamble" at the top of a file in which you use it. Something like:
Trace weirdness
I could be somehow mistaken, but it seems that TRACEing a nondeterministic function (Screamer seems to replace normal DEFUN with its own) may not be completely reliable. Here's something from my code where I don't expect SOLVE-ONCE's trace to show that it returns different things:
(in-package :cl-user)
(screamer:define-screamer-package :blah
(:export :solve-once
:with-indices
:eltv
:mid))
(in-package :blah)
(defun solve-once (&rest things)
(one-value (solution things (static-ordering #'linear-force))))
(defmacro with-indices (indices &body body)
`(let* ,(loop with last-index = (1- (length indices))
for i in indices
collect `(,i (an-integer-betweenv 0 ,last-index)))
(assert! (/=v ,@indices))
,@body))
(defun eltv (&rest rest)
(applyv #'elt rest))
(defun mid (n1 n2 n3)
(let ((numbers (vector n1 n2 n3)))
(with-indices (min mid max)
(assert! (<=v (eltv numbers min)
(eltv numbers mid)
(eltv numbers max)))
(elt numbers (first (solve-once mid min max))))))
(trace solve-once)
(mid 0 1 2)
(mid 1 2 0)
Topics:
pattern matching,
language extension