仕様はググってください。
お断り：このプログラムはすべての解を列挙するものではありません。
;; 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 (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))))
実行結果
gosh> (cross-river '(0 0 0 0) '(1 1 1 1)) ((0 0 0 0) (1 0 1 0) (0 0 1 0) (1 0 1 1) (0 0 0 1) (1 1 0 1) (0 1 0 1) (1 1 1 1))
農夫の持ち物の状態をリストで表現しています。
それぞれのリストは、(農夫 オオカミ ヤギ キャベツ) の順でどちら岸にあるかを表しています。
0 は、「こちら岸」あるいは「左岸」、1 は「あちら岸」あるいは「右岸」です。
「川渡り」を頭で想像したとき、縦に流れてる川を左右に渡るのか、横に流れてる川を上下に渡るのか、の差です。
プログラムロジック的には同じです。
gosh> (begin (map print (cross-river '(0 0 0 0) '(1 1 1 1))) 'done) (0 0 0 0) (1 0 1 0) (0 0 1 0) (1 0 1 1) (0 0 0 1) (1 1 0 1) (0 1 0 1) (1 1 1 1) done
Scheme に馴染みが無い方でも見やすいようにもうちょっと出力方法を改良した版です。
さらに実行結果から文章を生成してみます。
gosh> (river-puzzle) 農夫が居る左岸には狼、ヤギ、キャベツが居る。 農夫は右岸へヤギを連れて川を渡った。 農夫の居ない左岸には狼、キャベツが取り残されたが食べられてしまう事は無かった。 農夫の居る右岸は安全である。 農夫が居る右岸にはヤギ、が居る。 農夫は左岸へ川を渡った。 農夫の居ない右岸にはヤギ、が取り残されたが食べられてしまう事は無かった。 農夫の居る左岸は安全である。 農夫が居る左岸には狼、キャベツが居る。 農夫は右岸へキャベツを持って川を渡った。 農夫の居ない左岸には狼、が取り残されたが食べられてしまう事は無かった。 農夫の居る右岸は安全である。 農夫が居る右岸にはヤギ、キャベツが居る。 農夫は左岸へヤギを連れて川を渡った。 農夫の居ない右岸にはキャベツが取り残されたが食べられてしまう事は無かった。 農夫の居る左岸は安全である。 農夫が居る左岸には狼、ヤギ、が居る。 農夫は右岸へ狼を連れて川を渡った。 農夫の居ない左岸にはヤギ、が取り残されたが食べられてしまう事は無かった。 農夫の居る右岸は安全である。 農夫が居る右岸には狼、キャベツが居る。 農夫は左岸へ川を渡った。 農夫の居ない右岸には狼、キャベツが取り残されたが食べられてしまう事は無かった。 農夫の居る左岸は安全である。 農夫が居る左岸にはヤギ、が居る。 農夫は右岸へヤギを連れて川を渡った。 農夫はすべての荷物を右岸へ持っていく事ができた。めでたしめでたし。
所々日本語が変ですけど気にしたら負けｗ
あと食べられない解しか求めないようにしているので、
食べられてしまうケースの日本語は用意していませんｗ
小さなお子様でも安心してご利用いただけますｗｗｗ*1
こんな感じに解くことができます。
