今回は簡単なパズルを 5 問出題します。Scheme で解法プログラムを作成してください。なお、この問題は拙作のページ Prolog Programming パズルに挑戦 (2) とまったく同じです。M.Hiroi は R5RS + SRFI-1 の範囲でプログラムを作ろうと思っています。他のライブラリを使うと、もっと簡単にプログラムを作ることができるかもしれません。みなさんも Scheme らしいプログラムを考えてみてください。
1 から 9 までの数字を順番に並べ、間に + と - を補って 100 になる式を作ってください。
例：1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。たとえば、123456789 とか 321654987 のような数字です。「小町算」というものもあり、たとえば 123 + 456 + 789 とか 321 * 654 + 987 のようなものです。問題１は小町算の中でも特に有名なパズルです。
ＳＥＮＤ
＋ ＭＯＲＥ
-----------
ＭＯＮＥＹ
図：覆面算
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。使用する数字は 0 から 9 までで、最上位の桁に 0 を入れることはできません。
問題２はデュードニーが 1924 年に発表したもので、覆面算の古典といわれる有名なパズルです。
┌─┬─┬─┬─┬─┬─┬─┐
│●│●│●│ │○│○│○│ スタート
└─┴─┴─┴─┴─┴─┴─┘
┌─┬─┬─┬─┬─┬─┬─┐
│○│○│○│ │●│●│●│ ゴール
└─┴─┴─┴─┴─┴─┴─┘
図：蛙跳びゲーム
蛙跳びゲームは黒石と白石を使って遊ぶ、いわゆる「飛び石ゲーム」と呼ばれる種類のパズルです。上図のように、蛙跳びゲームは黒石と白石を入れ替えることができれば成功です。スタートからゴールまでの最短手順を求めてください。
石を動かす規則は次のとおりです。
石の跳び越しは次の図を参考にしてください。
┌───┐ ┌───┐
↓ │ │ ↓
┬─┬─┬─┬─┬ ┬─┬─┬─┬─┬
│ │●│○│ │ │ │●│○│ │
┴─┴─┴─┴─┴ ┴─┴─┴─┴─┴
白石の移動 黒石の移動
図：石の跳び越し
3 人の宣教師と 3 人の人食い人が川を渡ることになりました。川には 2 人乗りのボートが 1 そうしかありません。どのような時でも人食い人の数が宣教師の数よりも多いと、宣教師は殺されてしまいます。6 人が安全に川を渡る最短手順を求めてください。
問題４は「川渡りの問題」とか「渡船問題」と呼ばれる古典的なパズルの一種です。その中でも「宣教師と人食い人」は特に有名な問題です。
斗桶に油が 1 斗（= 10 升）あります。これを 5 升ずつ 2 つの油に分けたいのですが、手元には 7 升ますと 3 升ますが 1 つずつしかありません。この 2 つのますを使って油を二等分してください。
油分け算は江戸時代の和算書『塵劫記（じんこうき）』にある問題です。
それではプログラムを作りましょう。式は次のようにリストで表すことにします。
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 => (1 + 2 + 3 - 4 + 5 + 6 + 78 + 9)
あとは、式を生成して値を計算するだけです。式を生成するとき、リストを逆順で管理すると簡単です。次の図を見てください。
(1) => (2 + 1) => (3 + 2 + 1)
=> (3 - 2 + 1)
=> (23 + 1)
=> (2 - 1) => (3 + 2 - 1)
=> (3 - 2 - 1)
=> (23 - 1)
=> (12) => (3 + 12)
=> (3 - 12)
=> (123)
式を生成するとき、リストに数字と演算子を順番に追加していきます。数字と + と - を追加する処理は簡単です。プログラムのポイントは数字を連結する処理、たとえば 1 と 2 を連結して一つの数値 12 にする処理です。この処理はリストの先頭の数字 1 を 12 (= 1 * 10 + 2) に置き換えることで実現できます。リストが (2 + 1) であれば、数字 2 を 23 (= 2 * 10 + 3) に置き換えます。
式を生成するプログラムは次のようになります。
リスト：式の生成
(define (make-expr n expr ans)
(cond ((= n 10)
(calc-expr (reverse expr) ans))
(else
(make-expr (+ n 1) (cons n (cons + expr)) ans)
(make-expr (+ n 1) (cons n (cons - expr)) ans)
(make-expr (+ n 1) (cons (+ (* (car expr) 10) n) (cdr expr)) ans))))
make-expr の引数 n が追加する数字、expr が生成する式 (リスト)、ans が合計値です。最初に呼び出すとき、expr にはリスト (1) を渡します。n が 10 になったら関数 calc-expr で式 expr を計算します。
そうでなければ、数式を生成します。これは make-expr を再帰呼び出しするだけです。最初は n と + を追加します。次は n と - を追加します。このとき、+ と - は関数値で表すことに注意してください。最後は数字を連結する場合です。(+ (* (car expr) 10) n) を計算して、それと先頭の数字を置き換えます。
次は式を計算する関数 calc-expr を作ります。今回の問題は演算子に + と - しかないので、リストで表現した式を計算することは簡単です。次のプログラムを見てください。
リスト：式の計算 (+ と - だけ)
(define (calc-expr expr ans)
(let loop ((ls (cdr expr)) (sum (car expr)))
(cond ((null? ls)
(if (= ans sum)
(print-expr expr ans)))
(else
(loop (cddr ls) ((car ls) sum (cadr ls)))))))
先頭の数値を sum にセットし、loop で関数値 (+ または -) と数値を取り出して、sum に加算 (または減算) します。計算が終わったら sum と ans を比較し、同じ値であれば関数 print-expr で式 expr を表示します。print-expr は簡単なので説明は省略します。詳細は プログラムリスト１ をお読みください。
それでは実行結果を示します。
gosh> (solve-1) 1+2+3-4+5+6+78+9=100 1+2+34-5+67-8+9=100 1+23-4+5+6+78-9=100 1+23-4+56+7+8+9=100 12+3+4+5-6-7+89=100 12+3-4+5+67+8+9=100 12-3-4+5-6+7+89=100 123+4-5+67-89=100 123+45-67+8-9=100 123-4-5-6-7+8-9=100 123-45-67+89=100 #<undef> gosh>
全部で 11 通りの解が出力されます。
;
; 小町算
;
; Copyright (C) 2009 Makoto Hiroi
;
(use srfi-1)
; 式の表示
(define (print-expr expr ans)
(for-each
(lambda (x)
(cond ((integer? x) (display x))
((eq? + x) (display "+"))
(else (display "-"))))
expr)
(display "=")
(display ans)
(newline))
; 式の計算
(define (calc-expr expr ans)
(let loop ((ls (cdr expr)) (sum (car expr)))
(cond ((null? ls)
(if (= ans sum)
(print-expr expr ans)))
(else
(loop (cddr ls) ((car ls) sum (cadr ls)))))))
; 式の生成
(define (make-expr n expr ans)
(cond ((= n 10)
(calc-expr (reverse expr) ans))
(else
(make-expr (+ n 1) (cons n (cons + expr)) ans)
(make-expr (+ n 1) (cons n (cons - expr)) ans)
(make-expr (+ n 1) (cons (+ (* (car expr) 10) n) (cdr expr)) ans))))
(define (solve-1) (make-expr 2 '(1) 100))
それではプログラムを作ります。式 SEND + MORE = MONEY は足し算なので、M が 1 であることはすぐにわかります。ここでは、それ以外の数字を求めるプログラムを作ります。単純な生成検定法でプログラムを作ると、次のようになります。
;
; 覆面算
;
; Copyright (C) 2009 Makoto Hiroi
;
(use srfi-1)
; send + more = money
; (s e n d o r y)
; 0 1 2 3 4 5 6
; 値を求める
(define (get-value ls . args)
(fold (lambda (x a) (+ (* 10 a) (list-ref ls x))) 0 args))
; 条件を満たしているか
(define (check-money ls)
(let ((send (get-value ls 0 1 2 3))
(more (+ 1000 (get-value ls 4 5 1)))
(money (+ 10000 (get-value ls 4 2 1 6))))
(if (= (+ send more) money)
(format #t "~D + ~D = ~D~%" send more money))))
; 要素を削除する
(define (remove-item x ls)
(remove (lambda (y) (eqv? x y)) ls))
; 順列の生成
(define (permutations func n ls)
(define (perm ls n a)
(if (zero? n)
(func (reverse a))
(for-each
(lambda (x)
(perm (remove-item x ls) (- n 1) (cons x a)))
ls)))
(perm ls n '()))
; 解法
(define (solve-2)
(permutations check-money 7 '(0 2 3 4 5 6 7 8 9)))
1 を除いた 9 個の数字の中から数字を 7 個選ぶ順列を関数 permutations で生成します。permutations の説明は拙作のページ 順列と組み合わせ をお読みください。7 個の数字はリストに格納されいて、先頭から順番に s, e, n, d, o, r, y に対応します。
あとは述語 check-money で数値 send, more, money を計算して、send + more = money を満たしているかチェックします。数値の計算は関数 get-value で行います。たとえば send を計算する場合、生成した順列 ls と s, e, n, d の位置 0, 1, 2, 3 を渡します。この処理は fold を使うと簡単です。条件を満たしてれば format で値を表示します。format は R5RS, SRFI-1 の範囲外の関数ですがお許しくださいませ。
さっそく実行してみましょう。
gosh> (solve-2) 9567 + 1085 = 10652 #<undef>
答えは 9567 + 1085 = 10652 の 1 通りしかありません。実行時間は Gauche (ver 0.8.14), Windows XP, celeron 1.40 GHz で約 4.2 秒でした。興味のある方は、もっとクールな方法を考えてみてください。
それではプログラムを作りましょう。このゲームは後戻りすることができないので、単純なバックトラックで最短手順を求めることができます。盤面はリストで表して、b を黒石、w を白石、s を空き場所と定義します。蛙跳びゲームの場合、石の移動パターンは次に示す 4 通りしかありません。
この 4 通りのパターンに対応する関数を定義します。黒石の移動を行う関数 move-black と jump-black は次のようになります。
リスト : 黒石の移動
; 黒石の移動
(define (move-black ls)
(cond ((null? ls) '())
((and (eq? (car ls) 'b)
(pair? (cdr ls))
(eq? (cadr ls) 's))
(cons 's (cons 'b (cddr ls))))
(else
(cons (car ls) (move-black (cdr ls))))))
; 黒石のジャンプ
(define (jump-black ls)
(cond ((null? ls) '())
((and (eq? (car ls) 'b)
(pair? (cdr ls))
(pair? (cddr ls))
(eq? (cadr ls) 'w)
(eq? (caddr ls) 's))
(cons 's (cons 'w (cons 'b (cdddr ls)))))
(else
(cons (car ls) (jump-black (cdr ls))))))
move-black と jump-black は黒石を移動した新しいリストを作ります。黒石を移動できない場合は引数 ls をコピーしたリストを返します。新しいリストが ls と等しい場合、石は移動できなかったことがわかります。もちろん、最初に石を動かすことができるか調べてから、実際に石を動かすようにプログラムすることもできます。興味のある方はプログラムを改造してみてください。
move-black は (car ls) が黒石 b ならば、右隣 (cadr ls) が空き場所 s であることを確認します。そうであれば、その石を空き場所へ移動します。jump-black は黒石 (car ls) の右隣 (cadr ls) が白石 w で、その右隣 (caddr ls) が空き場所 s の場合、空き場所の位置に黒石を移動します。
白石を動かす場合は、(car ls) が空き場所 s であるとき、右隣とその右隣の関係を確認します。あとは単純な深さ優先探索です。とくに難しいところはないので、説明は省略いたします。詳細は プログラムリスト３ をお読みくださいませ。
それでは実行結果を示します。
gosh> (solve-3) (b b b s w w w) (b b s b w w w) (b b w b s w w) (b b w b w s w) (b b w s w b w) (b s w b w b w) (s b w b w b w) (w b s b w b w) (w b w b s b w) (w b w b w b s) (w b w b w s b) (w b w s w b b) (w s w b w b b) (w w s b w b b) (w w w b s b b) (w w w s b b b) (b b b s w w w) (b b b w s w w) (b b s w b w w) (b s b w b w w) (b w b s b w w) (b w b w b s w) (b w b w b w s) (b w b w s w b) (b w s w b w b) (s w b w b w b) (w s b w b w b) (w w b s b w b) (w w b w b s b) (w w b w s b b) (w w s w b b b) (w w w s b b b) #<undef>
15 手で解くことができました。蛙跳びゲームは 15 手よりも長い手順はありません。つまり、この回数でないと解くことができないのです。
;
; 蛙とびゲーム
;
; Copyright (C) 2009 Makoto Hiroi
;
(use srfi-1)
; 黒石の移動
(define (move-black ls)
(cond ((null? ls) '())
((and (eq? (car ls) 'b)
(pair? (cdr ls))
(eq? (cadr ls) 's))
(cons 's (cons 'b (cddr ls))))
(else
(cons (car ls) (move-black (cdr ls))))))
; 黒石のジャンプ
(define (jump-black ls)
(cond ((null? ls) '())
((and (eq? (car ls) 'b)
(pair? (cdr ls))
(pair? (cddr ls))
(eq? (cadr ls) 'w)
(eq? (caddr ls) 's))
(cons 's (cons 'w (cons 'b (cdddr ls)))))
(else
(cons (car ls) (jump-black (cdr ls))))))
; 白石の移動
(define (move-white ls)
(cond ((null? ls) '())
((and (eq? (car ls) 's)
(pair? (cdr ls))
(eq? (cadr ls) 'w))
(cons 'w (cons 's (cddr ls))))
(else
(cons (car ls) (move-white (cdr ls))))))
; 白石のジャンプ
(define (jump-white ls)
(cond ((null? ls) '())
((and (eq? (car ls) 's)
(pair? (cdr ls))
(pair? (cddr ls))
(eq? (cadr ls) 'b)
(eq? (caddr ls) 'w))
(cons 'w (cons 'b (cons 's (cdddr ls)))))
(else
(cons (car ls) (jump-white (cdr ls))))))
; 深さ優先探索
(define (solve-kaeru goal move)
(define func-list
(list move-black move-white jump-black jump-white))
;
(define (print-answer move)
(for-each
(lambda (x) (display x) (newline)) move)
(newline))
;
(if (equal? goal (car move))
(print-answer (reverse move))
(for-each
(lambda (fn)
(let ((bs (fn (car move))))
(if (not (equal? bs (car move)))
(solve-kaeru goal (cons bs move)))))
func-list)))
; 解法
(define (solve-3)
(solve-kaeru '(w w w s b b b) '((b b b s w w w))))
それではプログラムを作ります。この問題は単純な「反復深化」で解くことができます。最初にデータ構造を定義しましょう。岸の状態 (局面) は次に示すリストで表すことにします。
(boat m-left e-left m-right e-right] boat : left or right m-left : 左岸にいる宣教師の数 e-left : 左岸にいる人食い人の数 e-right : 右岸にいる宣教師の数 e-right : 右岸にいる人食い人の数
次はボートを動かして新しい局面を生成する述語 move-boat を作ります。次のリストを見てください。
リスト：ボートを動かす
; アクセス関数
(define (get-m-left ls) (second ls))
(define (get-e-left ls) (third ls))
(define (get-m-right ls) (fourth ls))
(define (get-e-right ls) (fifth ls))
; ボートの移動
(define (move-boat ls m e)
(if (eq? (car ls) 'left)
(list 'right
(- (get-m-left ls) m)
(- (get-e-left ls) e)
(+ (get-m-right ls) m)
(+ (get-e-right ls) e))
(list 'left
(+ (get-m-left ls) m)
(+ (get-e-left ls) e)
(- (get-m-right ls) m)
(- (get-e-right ls) e))))
move-boat の引数 ls は現在の局面を表すリスト、m はボートに乗る宣教師の人数、e はボートに乗る土人の人数です。ボートに乗る組み合わせを (m e) で表すと、(2 0), (0 2), (1 1), (1 0), (0 1) の 5 通りあります。ls から 5 通りの新しい状態を生成し、それが実現可能でかつ安全な状態かチェックします。今回は反復深化を使うので、同一局面のチェックは行っていません。
次は、宣教師が安全かチェックする述語 safe? と実現可能な局面かチェックする述語 possible? を作ります。次のリストを見てください。
リスト : 安全確認
; 安全か
(define (safe? ls)
(or (and (<= (get-e-left ls) (get-m-left ls))
(<= (get-e-right ls) (get-m-right ls)))
(zero? (get-m-left ls))
(zero? (get-m-right ls))))
; 実現可能な局面か
(define (possible? ls)
(every (lambda (x) (<= 0 x)) (cdr ls)))
安全な状態は「宣教師の人数 <= 土人の人数」だけではありません。この条件が成立しない場合でも、宣教師がいない場合は安全ですね。つまり、(left 3 2 0 1) のような状態は安全なわけです。したがって、(get-m-left ls) または (get-m-right ls) が 0 ならば安全と判定します。
pissible? は岸にいる人数がすべて 0 人以上であることを確認します。これは SRFI-1 の関数 every を使うと簡単です。
every pred list1 list2 ...
every は高階関数で、リストの要素に pred を適用し、すべての要素が真であれば真 (最後の要素を評価した結果) を返します。偽となる要素が一つでもあると偽 (#f) を返します。
あとは単純な反復深化なので、説明は省略いたします。詳細は プログラムリスト４ をお読みくださいませ。
それでは実行結果を示します。
---- 11 ---- (left 3 3 0 0) (right 2 2 1 1) (left 3 2 0 1) (right 3 0 0 3) (left 3 1 0 2) (right 1 1 2 2) (left 2 2 1 1) (right 0 2 3 1) (left 0 3 3 0) (right 0 1 3 2) (left 1 1 2 2) (right 0 0 3 3) #t
最短手数は 11 手になります。川渡りの問題はいろいろなバリエーションがあります。興味のある方は、拙作のページ Puzzle DE Programming の 農夫と山羊と狼とキャベツの問題 や 嫉妬深い夫の問題 をお読みくださいませ。
;
; 川渡り
;
; Copyright (C) 2009 Makoto Hiroi
;
(use srfi-1)
; アクセス関数
(define (get-m-left ls) (second ls))
(define (get-e-left ls) (third ls))
(define (get-m-right ls) (fourth ls))
(define (get-e-right ls) (fifth ls))
; ボートを動かす
(define (move-boat ls m e)
(if (eq? (car ls) 'left)
(list 'right
(- (get-m-left ls) m)
(- (get-e-left ls) e)
(+ (get-m-right ls) m)
(+ (get-e-right ls) e))
(list 'left
(+ (get-m-left ls) m)
(+ (get-e-left ls) e)
(- (get-m-right ls) m)
(- (get-e-right ls) e))))
; 安全か
(define (safe? ls)
(or (and (<= (get-e-left ls) (get-m-left ls))
(<= (get-e-right ls) (get-m-right ls)))
(zero? (get-m-left ls))
(zero? (get-m-right ls))))
; 実現可能な局面か
(define (possible? ls)
(every (lambda (x) (<= 0 x)) (cdr ls)))
; 反復深化による解法
(define (solve-river start goal)
(define (print-answer move)
(for-each
(lambda (x)
(display x) (newline))
move))
;
(define (solve-id limit n move found)
(cond ((= n limit)
(if (equal? (car move) goal)
(begin (print-answer (reverse move))
(found #t))))
(else
(for-each
(lambda (x)
(let ((state (apply move-boat (car move) x)))
(if (and (possible? state) (safe? state))
(solve-id limit (+ n 1) (cons state move) found))))
'((1 0) (0 1) (1 1) (2 0) (0 2))))))
;
(call/cc
(lambda (found)
(for-each
(lambda (x)
(format #t "---- ~D ----\n" x)
(solve-id x 0 (list start) found))
(iota 20 1)))))
; 解法
(define (solve-4)
(solve-river '(left 3 3 0 0) '(right 0 0 3 3)))
それではプログラムを作りましょう。斗桶 (a) と 7 升ます (b) と 3 升ます (c) の状態をリスト (a b c) で表すことにします。油分け算の場合、次に示す 3 通りの操作があります。
ますは 2 つあるので、操作は全部で 6 通りになります。この操作を transfer1 から transfer6 までの 6 つの関数で定義します。次のリストを見てください。
リスト：油を移す操作
; 容量の定義
(define max-a 10)
(define max-b 7)
(define max-c 3)
; アクセス関数
(define (get-oil-a ls) (car ls))
(define (get-oil-b ls) (cadr ls))
(define (get-oil-c ls) (caddr ls))
(define (get-space-a ls) (- max-a (get-oil-a ls)))
(define (get-space-b ls) (- max-b (get-oil-b ls)))
(define (get-space-c ls) (- max-c (get-oil-c ls)))
; a -> b
(define (transfer1 ls)
(let ((move-oil (min (get-space-b ls) (get-oil-a ls))))
(list (- (get-oil-a ls) move-oil)
(+ (get-oil-b ls) move-oil)
(get-oil-c ls))))
; a -> c
(define (transfer2 ls)
(let ((move-oil (min (get-space-c ls) (get-oil-a ls))))
(list (- (get-oil-a ls) move-oil)
(get-oil-b ls)
(+ (get-oil-c ls) move-oil))))
; b -> a
(define (transfer3 ls)
(list (+ (get-oil-a ls) (get-oil-b ls))
0
(get-oil-c ls)))
; b -> c
(define (transfer4 ls)
(let ((move-oil (min (get-space-c ls) (get-oil-b ls))))
(list (get-oil-a ls)
(- (get-oil-b ls) move-oil)
(+ (get-oil-c ls) move-oil))))
; c -> a
(define (transfer5 ls)
(list (+ (get-oil-a ls) (get-oil-c ls))
(get-oil-b ls)
0))
; c -> b
(define (transfer6 ls)
(let ((move-oil (min (get-space-b ls) (get-oil-c ls))))
(list (get-oil-a ls)
(+ (get-oil-b ls) move-oil)
(- (get-oil-c ls) move-oil))))
関数 get-oil-? は油の容量を求めます。関数 set-space-? は空き容量を求めます。引数 ls は各ますの状態を表すリストです。油を移すとき、たとえば a から b に移すときは、a の油の容量と b の空き容量を比較して、少ないほうが移す油の量 move-oil になります。a に油を移す場合は a の空き容量をチェックする必要はありません。また、move-oil が 0 の場合は油を移すことができません。この場合は、引数 ls と等しいリストが生成されるので、探索のときにチェックします。
あとは、幅優先探索か反復深化を使って簡単に解くことができます。今回は幅優先探索でプログラムを作りました。とくに難しいところはないので、説明は省略いたします。詳細は プログラムリスト５ をお読みくださいませ。
それでは実行結果を示します。
gosh> (solve-5) (10 0 0) (3 7 0) (3 4 3) (6 4 0) (6 1 3) (9 1 0) (9 0 1) (2 7 1) (2 5 3) (5 5 0) #<undef>
最短手数は 9 手になりました。反復深化でも簡単にプログラムを作ることができるので、興味のある方は挑戦してみてください。
;
; 油分け算
;
; Copyright (C) 2009 Makoto Hiroi
;
; 状態はリストで表す
; (a b c) a: 10, b: 7, c: 3
; 容量の定義
(define max-a 10)
(define max-b 7)
(define max-c 3)
; アクセス関数
(define (get-oil-a ls) (car ls))
(define (get-oil-b ls) (cadr ls))
(define (get-oil-c ls) (caddr ls))
(define (get-space-a ls) (- max-a (get-oil-a ls)))
(define (get-space-b ls) (- max-b (get-oil-b ls)))
(define (get-space-c ls) (- max-c (get-oil-c ls)))
; a -> b
(define (transfer1 ls)
(let ((move-oil (min (get-space-b ls) (get-oil-a ls))))
(list (- (get-oil-a ls) move-oil)
(+ (get-oil-b ls) move-oil)
(get-oil-c ls))))
; a -> c
(define (transfer2 ls)
(let ((move-oil (min (get-space-c ls) (get-oil-a ls))))
(list (- (get-oil-a ls) move-oil)
(get-oil-b ls)
(+ (get-oil-c ls) move-oil))))
; b -> a
(define (transfer3 ls)
(list (+ (get-oil-a ls) (get-oil-b ls))
0
(get-oil-c ls)))
; b -> c
(define (transfer4 ls)
(let ((move-oil (min (get-space-c ls) (get-oil-b ls))))
(list (get-oil-a ls)
(- (get-oil-b ls) move-oil)
(+ (get-oil-c ls) move-oil))))
; c -> a
(define (transfer5 ls)
(list (+ (get-oil-a ls) (get-oil-c ls))
(get-oil-b ls)
0))
; c -> b
(define (transfer6 ls)
(let ((move-oil (min (get-space-b ls) (get-oil-c ls))))
(list (get-oil-a ls)
(+ (get-oil-b ls) move-oil)
(- (get-oil-c ls) move-oil))))
; 幅優先探索
(define (solve-5)
; Queue
(define que '())
(define (enqueue x)
(set! que (append que (list x))))
(define (dequeue)
(begin0 (car que) (set! que (cdr que))))
;
(define transfer
(list transfer1 transfer2 transfer3 transfer4 transfer5 transfer6))
; 手順の表示
(define (print-answer move)
(for-each
(lambda (x)
(display x) (newline))
move))
;
(define (solve-b start goal)
(enqueue (list start))
(let loop ()
(let ((move (dequeue)))
(cond ((equal? (car move) goal)
(print-answer (reverse move)))
(else
(for-each
(lambda (fn)
(let ((state (fn (car move))))
(if (not (member state move))
(enqueue (cons state move)))))
transfer)
(loop))))))
;
(solve-b '(10 0 0) '(5 5 0)))