Path: ...!news.mixmin.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Non-determinism
Date: Tue, 23 Jul 2024 22:44:48 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 146
Message-ID: <v7pboq$1d67r$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Wed, 24 Jul 2024 00:44:48 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="797cc67a814b886922527dba050c3ff4";
	logging-data="1480955"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18khxJzdHDue1M0nYEopy5J"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:aaQ1waV2XEi30aC4dNugFDCKuFg=
Bytes: 4678

> 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)))))