Warning: mysqli::__construct(): (HY000/1203): User howardkn already has more than 'max_user_connections' active connections in D:\Inetpub\vhosts\howardknight.net\al.howardknight.net\includes\artfuncs.php on line 21
Failed to connect to MySQL: (1203) User howardkn already has more than 'max_user_connections' active connectionsPath: ...!news.mixmin.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym"
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:
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)))))