導入
「川渡り問題」をプログラムで解こう。
パズルのルール（仕様）
「川渡り問題」は有名なパズルなので、各々ググって調べてください。
書くのめんどうくさい（本音）。
設計
農夫、オオカミ、ヤギ、キャベツが居る岸を
0 ... 左の川岸
1 ... 右の川岸
としてリストでモデル化します。
(0 0 0 0)
これはスタート状態です。すべて左の川岸にいることを表します。
(1 1 1 1)
これがゴールです。すべて右の川岸に渡った状態です。
さらに
単にパズルを解くだけではつまらないので、子どもが読む絵本風の物語として文章を生成します。
プログラム
プログラミング言語は Scheme を使います。ソースコード全文掲載します。
処理系に依存するライブラリなどは使ってないので、おそらくどんな Scheme 処理系でも動作します。たぶん。
;; common procedures
(define nil '())
(define (enumerate-interval low high)
(if (> low high)
nil
(cons low (enumerate-interval (+ low 1) high))))
(define (number->binary num k)
(if (= k 0)
'()
(append (number->binary (quotient num 2) (- k 1)) (list (remainder num 2)))))
(define (remove item seq)
(filter (lambda (x) (not (equal? x item))) seq))
;; the river puzzle
;; (farmer wolf goat cabbage)
;; 0 ... left
;; 1 ... right
;;
;; start goal
;; (0 0 0 0) ---> (1 1 1 1)
(define (get-farmer baggage)
(car baggage))
(define (get-wolf baggage)
(cadr baggage))
(define (get-goat baggage)
(caddr baggage))
(define (get-cabbage baggage)
(cadddr baggage))
(define (left? side)
(= side 0))
(define (right? side)
(not (left? side)))
(define (other-side side)
(if (eq? side 0) 1 0))
(define (be-eaten? baggage)
(let ((t (get-farmer baggage))
(w (get-wolf baggage))
(s (get-goat baggage))
(c (get-cabbage baggage)))
(or
(and (left? t) (right? w) (right? s))
(and (left? t) (right? s) (right? c))
(and (right? t) (left? w) (left? s))
(and (right? t) (left? s) (left? c)))))
(define (diff-baggage baggage1 baggage2)
(define (iter bag1 bag2 cnt)
(if (null? bag1)
cnt
(iter (cdr bag1) (cdr bag2) (if (eq? (car bag1) (car bag2)) cnt (+ cnt 1)))))
(iter (cdr baggage1) (cdr baggage2) 0))
(define (next-baggage farmer-side baggage)
(set! *safe-baggage-patterns* (remove baggage *safe-baggage-patterns*))
(let ((new-baggage (filter (lambda (b) (equal? (cons (other-side farmer-side) (cdr baggage)) b)) *safe-baggage-patterns*)))
;; 右岸に荷物を寄せたいため、農夫が右岸にいるときに、農夫が左岸に移動しても右岸側の荷物が安全な場合は、優先的に何も運ばずに左岸へ戻る。
;; (ただし、左岸に戻った時の荷物の配置は *safe-baggage-patterns* 中に含んでいなければならない。)
;; 該当しない場合は反対岸へ荷物を一個運ぶ。
(if (and (right? farmer-side) (not (null? new-baggage)) (not (be-eaten? (car new-baggage))))
new-baggage
(let ((baggages (filter (lambda (b) (and (not (eq? farmer-side (car b))) (= 1 (diff-baggage baggage b)))) *safe-baggage-patterns*)))
baggages))))
(define *safe-baggage-patterns* nil)
(define (initialize-safe-baggage-patterns)
(set! *safe-baggage-patterns*
(filter (lambda (b) (not (be-eaten? b)))
(map (lambda (n) (number->binary n 4)) (enumerate-interval 0 15)))))
(define (cross-river start goal)
(define (iter baggage answer)
(if (equal? baggage goal)
answer
(let ((new-baggage (car (next-baggage (get-farmer baggage) baggage))))
(iter new-baggage (append answer (list new-baggage))))))
(initialize-safe-baggage-patterns)
(iter start (list start)))
(define (make-document prev-baggage current-baggage)
(let ((pf (get-farmer prev-baggage))
(pw (get-wolf prev-baggage))
(ps (get-goat prev-baggage))
(pc (get-cabbage prev-baggage))
(cf (get-farmer current-baggage))
(cw (get-wolf current-baggage))
(cs (get-goat current-baggage))
(cc (get-cabbage current-baggage)))
(display "農夫が居る")
(display (if (left? pf) "左岸" "右岸"))
(display "には")
(display (if (= pw (if (left? pf) 0 1)) "狼、" ""))
(display (if (= ps (if (left? pf) 0 1)) "ヤギ、" ""))
(display (if (= pc (if (left? pf) 0 1)) "キャベツ" ""))
(display "が居る。")
(newline)
(display "農夫は")
(display (if (left? cf) "左岸" "右岸"))
(display "へ")
(display (cond ((not (eq? pw cw)) "狼を連れて")
((not (eq? ps cs)) "ヤギを連れて")
((not (eq? pc cc)) "キャベツを持って")
(else "")))
(display "川を渡った。")
(newline)
(if (or (= cw 0) (= cs 0) (= cc 0))
(begin
(display "農夫の居ない")
(display (if (left? pf) "左岸" "右岸"))
(display "には")
(display (if (= cw (if (left? pf) 0 1)) "狼、" ""))
(display (if (= cs (if (left? pf) 0 1)) "ヤギ、" ""))
(display (if (= cc (if (left? pf) 0 1)) "キャベツ" ""))
(display "が取り残されたが食べられてしまう事は無かった。")
(newline)
(display "農夫の居る")
(display (if (left? cf) "左岸" "右岸"))
(display "は安全である。")
(newline)
(newline)))))
(define (print-story answer)
(define (iter baggages)
(if (null? (cdr baggages))
'農夫はすべての荷物を右岸へ持っていく事ができた。めでたしめでたし。
(begin
(make-document (car baggages) (cadr baggages))
(iter (cdr baggages)))))
(iter answer))
(define (river-puzzle)
(print-story (cross-river '(0 0 0 0) '(1 1 1 1))))
;; (begin (map print (cross-river '(0 0 0 0) '(1 1 1 1))) 'done)
;; (river-puzzle)
コードの細かい解説はしません。
（面倒なので）
パズルを解く（プログラム実行）
gosh> (river-puzzle)
農夫が居る左岸には狼、ヤギ、キャベツが居る。
農夫は右岸へヤギを連れて川を渡った。
農夫の居ない左岸には狼、キャベツが取り残されたが食べられてしまう事は無かった。
農夫の居る右岸は安全である。
農夫が居る右岸にはヤギ、が居る。
農夫は左岸へ川を渡った。
農夫の居ない右岸にはヤギ、が取り残されたが食べられてしまう事は無かった。
農夫の居る左岸は安全である。
農夫が居る左岸には狼、キャベツが居る。
農夫は右岸へキャベツを持って川を渡った。
農夫の居ない左岸には狼、が取り残されたが食べられてしまう事は無かった。
農夫の居る右岸は安全である。
農夫が居る右岸にはヤギ、キャベツが居る。
農夫は左岸へヤギを連れて川を渡った。
農夫の居ない右岸にはキャベツが取り残されたが食べられてしまう事は無かった。
農夫の居る左岸は安全である。
農夫が居る左岸には狼、ヤギ、が居る。
農夫は右岸へ狼を連れて川を渡った。
農夫の居ない左岸にはヤギ、が取り残されたが食べられてしまう事は無かった。
農夫の居る右岸は安全である。
農夫が居る右岸には狼、キャベツが居る。
農夫は左岸へ川を渡った。
農夫の居ない右岸には狼、キャベツが取り残されたが食べられてしまう事は無かった。
農夫の居る左岸は安全である。
農夫が居る左岸にはヤギ、が居る。
農夫は右岸へヤギを連れて川を渡った。
農夫はすべての荷物を右岸へ持っていく事ができた。めでたしめでたし。
文章としてはかなり変だが気にしたら負け。
おわりに
基本的に総当たり解法です。コンピュータは賢くないので人間がパズルを解く時のようには思考はできません。
しかし処理スピードが速いので、総当たり解法であってもこのぐらいのパズルなら短時間で解くことができます。