vallog: On Lisp 非決定性

2010/06/16

On Lisp の非決定性の章がとてもわかりやすいです。以前写経した、syntax-rules 版の amb より、関数版の方がよくわかりました。

以下のコードは関数版の方です。取りあえず動かしてみました。

	;; amb - ambiguous

	;; On Lisp : P.300
	;; http://www.komaba.utmc.or.jp/~flatline/onlispjhtml/nondeterminism.html

	(define paths '())
	(define failsym '@)

	(define (choose choices)
	(if (null? choices)
	(fail)
	(call-with-current-continuation
	(lambda (cc)
	(set! paths
	(cons (lambda ()
	(cc (choose (cdr choices))))
	paths))
	(car choices)))))

	(define fail #f)

	(call-with-current-continuation
	(lambda (cc)
	(set! fail
	(lambda ()
	(if (null? paths)
	(cc failsym)
	(let ((p1 (car paths)))
	(set! paths (cdr paths))
	(p1)))))))


	(let ((x (choose '(1 2 3))))
	(if (odd? x)
	(+ x 1)
	x))
	;; 2

	(let ((x (choose '(2 3))))
	(if (odd? x)
	(choose '(a b))
	x))
	;; 2

	(let ((x (choose '(1 2))))
	(if (odd? x)
	(fail)
	x))
	;; 2

	(let ((x (choose '(1 2))))
	(if (odd? x)
	(let ((y (choose '(a b))))
	(if (eq? y 'a)
	(fail)
	y))
	x))
	;; b

	(let ((x (choose '(1 2 3 4 5 6 7 8 9 10))))
	(if (and (odd? x)
	(zero? (modulo x 3))
	(not (= x 3)))
	x
	(fail)))
	;; 9


	(define (two-numbers)
	(list (choose '(1 2 3 4 5))
	(choose '(1 2 3 4 5))))

	(define (parlor-trick sum)
	(let ((nums (two-numbers)))
	(if (= (apply + nums) sum)
	`(the sum of ,@nums)
	(fail))))

	(parlor-trick 5)
	;; (the sum of 1 4)

view raw amb2.scm hosted with ❤ by GitHub

で、少し書き換えてみました。(Gauche)

	(use gauche.parameter)

	(define paths (make-parameter '()))
	(define-constant failsym '@)

	(define (choose choices)
	(if (null? choices)
	(fail)
	(call/cc (lambda (cc)
	(paths (cons (lambda ()
	(cc (choose (cdr choices))))
	(paths)))
	(car choices)))))

	(define fail
	(call/cc (lambda (cc)
	(lambda ()
	(if (null? (paths))
	(cc failsym)
	(let ((p1 (car (paths))))
	(paths (cdr (paths)))
	(p1)))))))


	;; (define two-numbers
	;; (let ((numbers '()))
	;; (lambda nums
	;; (unless (null? nums)
	;; (set! numbers nums))
	;; (list (choose numbers)
	;; (choose numbers)))))

	;; (two-numbers 0 1 2 3 4 5 6 7 8 9)

	;; (use srfi-1)

	;; (define (make-two-numbers min max)
	;; (let ((numbers (iota max min)))
	;; (lambda ()
	;; (list (choose numbers)
	;; (choose numbers)))))

	;; (define two-numbers (make-two-numbers 1 10))

	;; (define (sum-comb sum)
	;; (let loop ((acc '())
	;; (nums (two-numbers)))
	;; (cond ((eq? nums failsym) #?=acc)
	;; ((not (= (apply + nums) sum))(fail))
	;; ((find (cut lset= eq? nums <>) acc)(fail))
	;; (else (loop (cons nums acc)
	;; (two-numbers))))))

	;; (define (sum-comb sum)
	;; (let ((nums (two-numbers)))
	;; (if (= (apply + nums) sum)
	;; nums
	;; (fail))))

	;; (let ((acc '())
	;; (comb (sum-comb 10)))
	;; (set! acc (cons comb acc))
	;; (when (find (cut lset= eq? comb <>) acc)
	;; (fail))
	;; acc)

view raw amb3.scm hosted with ❤ by GitHub

その後、自分でも思いついたサンプルを書こうとしたのですが、思ったように動きません。。わかったようでわかっていないようです・・・。

vallog