Non-determinism

From: Jeffrey Mark Siskind
Subject: Re: Permutations - lisp like
Date: 1998/10/12
Newsgroups: comp.lang.lisp
 
One elegant way of generating permutations (or any other form of combinatoric
enumeration) is to write a nondeterministic description of the combinatoric
structure. This can be done with Screamer, a nondeterministic extension to
Common Lisp.
 
(defun a-split-of-internal (x y)
 (if (null? y)
     (list x y)
     (either (list x y)
             (a-split-of-internal (append x (list (first y))) (rest y)))))
 
(defun a-split-of (l) (a-split-of-internal '() l))
 
(defun a-permutation-of (l)
 (if (null l)
     l
     (let ((split (a-split-of (a-permutation-of (rest l)))))
      (append (first split) (cons (first l) (second split))))))
 
(defun permutations-of (l) (all-values (a-permutation-of l)))
 
You can get Screamer from my home page.

Using Takafumi SHIDO's "amb".  (Tested with Gauche Scheme
and Racket Scheme.)

(define (a-split-of-internal x y)
 (if (null? y)
   (list x y)
   (amb (list x y)
        (a-split-of-internal (append x (list (car y))) (cdr y)))))

(define (a-split-of l)
  (a-split-of-internal '() l))

(define (a-permutation-of l)
 (if (null? l)
   l
   (let ((split (a-split-of (a-permutation-of (cdr l)))))
    (append (car split) (cons (car l) (cadr split))))))

(define (permutations-of l)
  (amb-set-of (a-permutation-of l)))


(permutations-of '(a b c))

  ===>
((a b c) (b a c) (b c a) (a c b) (c a b) (c b a))


(permutations-of '(a b c d))

  ===>
((a b c d) (b a c d) (b c a d) (b c d a) (a c b d) (c a b d) (c b a d)
 (c b d a) (a c d b) (c a d b) (c d a b) (c d b a) (a b d c) (b a d c)
 (b d a c) (b d c a) (a d b c) (d a b c) (d b a c) (d b c a) (a d c b)
 (d a c b) (d c a b) (d c b a))


;;   Modified from the excellent code found here
;; http://www.shido.info/lisp/scheme_amb_e.html
;;   and written by
;; SHIDO, Takafumi


;; [ SHIDO's comment ]
;; Notice that you cannot use the code shown in this chapter if
;; the searching path has loops. See SICP 4.3. for detailed
;; information on this matter.


;;; This function is re-assigned in `amb-choose' and `amb-fail' itself.
(define amb-fail #f)


;;; function for nondeterminism
(define (amb-choose . ls)
  (if (null? ls)
      (amb-fail)
    (let ((fail0 amb-fail))
      (call/cc
       (lambda (cc)
          (set! amb-fail
                (lambda ()
                  (set! amb-fail fail0)
                  (cc (apply amb-choose (cdr ls)))))
          (cc (car ls)))))))

 ;;; nondeterminism macro operator
 (define-syntax amb
   (syntax-rules ()
     ((_) (amb-fail))
     ((_ a) a)
     ((_ a b ...)
      (let ((fail0 amb-fail))
        (call/cc
  (lambda (cc)
    (set! amb-fail
    (lambda ()
      (set! amb-fail fail0)
      (cc (amb b ...))))
    (cc a)))))))


;;; returning all possibilities
(define-syntax amb-set-of
  (syntax-rules ()
    ((_ s)
      (let ((acc '()))
        (amb (let ((v s))
               (set! acc (cons v acc))
               (amb-fail))
             (reverse acc))))))
;;                  (reverse! acc))))))
   

;;; if not bool backtrack
(define (amb-assert bool)
  (or bool (amb)))
   
;;; returns arbitrary number larger or equal to n
(define (amb-integer-starting-from n)
  (amb n (amb-integer-starting-from (+ 1 n))))
   
;;; returns arbitrary number between a and b
(define (amb-number-between a b)
  (let loop ((i a))
    (if (> i b)
        (amb)
      (amb i (loop (+ 1 i))))))
;;       (amb i (loop (1+ i))))))


;;; write following at the end of file
;;; initial value for amb-fail
(call/cc
  (lambda (cc)
    (set! amb-fail
       (lambda ()
         (cc 'no-choice)))))