SICP 読み (207) 4.3.2 非決定性プログラムの例
問題 4.41
以前作った微妙な数え上げをベースに手続きを色々でっち上げてみた。とりあえず無理矢理でっち上げた手続きと試験を以下に。
(define (filter predicate sequence)
(cond ((null? sequence) '())
((predicate (car sequence))
(cons (car sequence)
(filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (distinct? items)
(cond ((null? items) #t)
((null? (cdr items)) #t)
((member (car items) (cdr items)) #f)
(else (distinct? (cdr items)))))
(define (multiple-dwelling-filter l)
(define baker (car l))
(define cooper (cadr l))
(define fletcher (caddr l))
(define miller (cadddr l))
(define smith (car (cddddr l)))
(and (distinct? l)
(not (= baker 5))
(not (= cooper 1))
(not (= fletcher 5))
(not (= fletcher 1))
(> miller cooper)
(not (= (abs (- smith fletcher)) 1))
(not (= (abs (- fletcher cooper)) 1))))
(define (multiple-dwelling-filter-2 l)
(define baker (car l))
(define cooper (cadr l))
(define fletcher (caddr l))
(define miller (cadddr l))
(define smith (car (cddddr l)))
(and (distinct? l)
(not (= baker 5))
(not (= cooper 1))
(not (= fletcher 5))
(not (= fletcher 1))
(> miller cooper)
(not (= (abs (- fletcher cooper)) 1))))
; (require
; (distinct? (list baker cooper fletcher miller smith)))
; (require (not (= baker 5)))
; (require (not (= cooper 1)))
; (require (not (= fletcher 5)))
; (require (not (= fletcher 1)))
; (require (> miller cooper))
; (require (not (= (abs (- smith fletcher)) 1)))
; (require (not (= (abs (- fletcher cooper)) 1)))
(define (test-enum l)
(let f ((l (cddr l)) (rslt (flatmap
(lambda (i) (map (lambda (j) (list i j))
(car l)))
(cadr l))))
(cond ((null? l) rslt)
(else
(f (cdr l) (flatmap
(lambda (i) (map (lambda (j) (append (list j) i))
(car l)))
rslt))))))
(define (test-enum-2 l)
(let f ((l (cddr l)) (rslt (flatmap
(lambda (i) (map (lambda (j) (list i j))
(filter
(lambda (j) (not (equal? i j)))
(cadr l))))
(car l))))
(cond ((null? l) rslt)
(else
(f (cdr l) (flatmap
(lambda (i)
(map (lambda (j) (append (list j) i))
(filter (lambda (j)
(let f ((j j) (i i))
(cond ((null? i) #t)
((equal? (car i) j) #f)
(else
(f j (cdr i))))))
(car l))))
rslt))))))以下が試験。
#!/usr/bin/env gosh
(use test.unit)
(require "4.41")
(define-test-suite "4.41"
("part-1"
("length"
(assert-equal 3125 (length (test-enum '((1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)))))
)
("filter"
(assert-equal 120 (length (filter distinct? (test-enum '((1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5))))))
)
("example"
(assert-equal '((3 2 4 5 1)) (filter multiple-dwelling-filter
(test-enum '((1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)))))
)
("length-2"
(assert-equal 120 (length (test-enum-2 '((1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)))))
)
("example (2)"
(assert-equal '((3 2 4 5 1)
(1 2 4 3 5)
(1 2 4 5 3))
(filter multiple-dwelling-filter-2
(test-enum '((1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)
(1 2 3 4 5)))))
)
)
)一番最後の試験にパスしない。とゆー事は以前のエントリにて出した解
((baker 1) (cooper 2) (fletcher 4) (miller 3) (smith 5)) ((baker 1) (cooper 2) (fletcher 4) (miller 5) (smith 3)) ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
はダウト、という事ッスか。とほほほ。ちなみに試験の出力は以下。
- (test suite) 4.41 -- (test case) part-1: ....F expected:<((3 2 4 5 1) (1 2 4 3 5) (1 2 4 5 3))> but was:<((1 2 4 3 5) (3 4 2 5 1) (3 2 4 5 1) (1 4 2 5 3) (1 2 4 5 3))> in example (2)
自分でも何故に_cooper が 2F、fletcher が 4F_の逆を考えなかったのか不明。それにしても数え上げな手続きは微妙。もう少し違った切り口から検討してみたいな、と。
あと、数え上げの効率を考慮した test-enum-2 との処理時間の差を見てはみたい。
追記
その場編集にプレビューが欲しい。
そりゃええんですが、微妙な数え上げを改善するヒントが 8queen にありそげな事に気づく。むむ。
