関数型電卓プログラム fcalc の使用例として、前回作成した簡単なライブラリを使ってパズルの解法プログラムを作成します。
1 から 9 までの数字を順番に並べ、間に + と - を補って 100 になる式を作ってください。
例 : 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。たとえば、123456789 とか 321654987 のような数字です。「小町算」というものもあり、たとえば 123 + 456 + 789 とか 321 * 654 + 987 のようなものです。問題１は小町算の中でも特に有名なパズルです。
S E N D
+ M O R E
-------------
M O N E Y
図 : 覆面算
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。使用する数字は 0 から 9 までで、最上位の桁に 0 を入れることはできません。問題２はデュードニーが 1924 年に発表したもので、覆面算の古典といわれる有名なパズルです。
８クイーンは、8 行 8 列のチェスの升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。コンピュータに解かせるパズルの中でもとくに有名な問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を次に示します。
列
0 1 2 3 4 5 6 7
*-----------------*
0 | Q . . . . . . . |
1 | . . . . Q . . . |
2 | . . . . . . . Q |
行 3 | . . . . . Q . . |
4 | . . Q . . . . . |
5 | . . . . . . Q . |
6 | . Q . . . . . . |
7 | . . . Q . . . . |
*-----------------*
図 : 8 クイーンの解答例
８クイーンの解をすべて求めてください。
┌─┬─┬─┐ 式
│Ａ│Ｂ│Ｃ│ A + B + C = N, A + E + I = N
├─┼─┼─┤ D + E + F = N, C + E + G = N
│Ｄ│Ｅ│Ｆ│ G + H + I = N
├─┼─┼─┤ A + D + G = N
│Ｇ│Ｈ│Ｉ│ B + E + H = N
└─┴─┴─┘ C + F + I = N
図 : 魔方陣
上図の A から I の場所に 1 から 9 までの数字をひとつずつ配置します。縦横斜めの合計が等しくなるように数字を配置してください。
「マスターマインド」は 0 から 9 までの重複しない 4 つの数字からなる隠しコードを当てるゲームです。数字は合っているが位置が間違っている個数を cows で表し、数字も位置も合っている個数を bulls で表します。bulls が 4 になると正解です。
(6 2 8 1) : 正解
---------------------------------
1. (0 1 2 3) : cows 2 : bulls 0
2. (1 0 4 5) : cows 1 : bulls 0
3. (2 3 5 6) : cows 2 : bulls 0
4. (3 2 7 4) : cows 0 : bulls 1
5. (3 6 0 8) : cows 2 : bulls 0
6. (6 2 8 1) : cows 0 : bulls 4
図 : マスターマインドの動作例
マスターマインドを解くプログラムを作成してください。
┌─┬─┬─┬─┬─┬─┬─┐
│●│●│●│ │○│○│○│ スタート
└─┴─┴─┴─┴─┴─┴─┘
┌─┬─┬─┬─┬─┬─┬─┐
│○│○│○│ │●│●│●│ ゴール
└─┴─┴─┴─┴─┴─┴─┘
図 : 蛙跳びゲーム
蛙跳びゲームは黒石と白石を使って遊ぶ、いわゆる「飛び石ゲーム」と呼ばれる種類のパズルです。上図のように、蛙跳びゲームは黒石と白石を入れ替えることができれば成功です。スタートからゴールまでの最短手順を求めてください。
石を動かす規則は次のとおりです。
石の跳び越しは次の図を参考にしてください。
┌───┐ ┌───┐
↓ │ │ ↓
┬─┬─┬─┬─┬ ┬─┬─┬─┬─┬
│ │●│○│ │ │ │●│○│ │
┴─┴─┴─┴─┴ ┴─┴─┴─┴─┴
白石の移動 黒石の移動
図 : 石の跳び越し
ペグ・ソリテアは、盤上に配置されたペグ (駒) を、最後にはひとつ残るように取り除いていく古典的なパズルです。ペグは次のルールに従って移動し、除去することができます。
盤は今までに多数考案されていますが、33 穴英国盤、37 穴フランス盤、41 穴盤が有名でしょう。33 穴英国盤と Hoppers を図に示します。Hoppers は芦ヶ原伸之氏が考案されたペグ・ソリテアです。
●─●─●
│ │ │
●─●─● ●───●───●
│ │ │ │＼ ／│＼ ／│
●─●─●─●─●─●─● │ ● │ ● │
│ │ │ │ │ │ │ │／ ＼│／ ＼│
●─●─●─○─●─●─● ●───○───●
│ │ │ │ │ │ │ │＼ ／│＼ ／│
●─●─●─●─●─●─● │ ● │ ● │
│ │ │ │／ ＼│／ ＼│
●─●─● ●───●───●
│ │ │
●─●─● (2) Hoppers
(1) 33 穴英国盤
図 : ペグ・ソリテア
それぞれのマスにペグがありますが、そこからひとつペグを取り除いてゲームを始めます。図では黒丸でペグを表し、白丸で空き場所を表しています。ルールに従ってペグを移動し、最後にひとつだけ残ればクリアとなります。ただし、ペグを取り除く位置によって、解けない場合もあるので注意してください。
それでは問題です。図 (2) に示したように、Hoppers の中央のペグを取り除きます。この状態から始めて、最後のペグが中央の位置に残る跳び方の最小手数を求めてください。
大きな容器に水が入っています。目盛の付いていない 8 リットルと 5 リットルの容器を使って、大きな容器から 4 リットルの水を汲み出してください。4 リットルの水は、どちらの容器に入れてもかまいません。水をはかる最短手順を求めてください。なお、水の総量に制限はありません。
「15 パズル」でお馴染みのスライドパズルです。それでは問題です。
┌─┬─┬─┐ ┌─┬─┬─┐
│４│５│ │ │１│２│３│
├─┼─┼─┤ ├─┼─┼─┤
│１│２│３│ │４│５│ │
└─┴─┴─┘ └─┴─┴─┘
スタート ゴール
図 : 5 パズル
スタートからゴールまでの最短手順を求めてください。
9 行 9 列盤の「ナンバープレース (数独) 」を解くプログラムを作ってください。
リスト : 小町算
def komachi(n)
let rec
# 式の計算
calc, iter = fn(expr, a)
if null(expr) then
a
else
if equal(car(expr), "+") then
calc(cddr(expr), a + cadr(expr))
else
calc(cddr(expr), a - cadr(expr))
end
end
end,
# 式の組み立て
fn(xs, expr)
if null(xs) then
let e = reverse(expr) in
if calc(cdr(e), car(e)) == n then
print(reverse(expr)),
print(" = "),
print(n),
putc(10)
end
end
else
iter(cdr(xs), cons(car(xs), cons("+", expr))),
iter(cdr(xs), cons(car(xs), cons("-", expr))),
iter(cdr(xs), cons(car(expr) * 10 + car(xs), cdr(expr)))
end
end
in
iter(iota(2, 9), list(1))
end
end
Calc> komachi(100); (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 0
解は全部で 11 通りあります。
リスト : 覆面算
def hukumen()
# 0 1 2 3 4 5 6
# s e n d o r y
# m = 1
permutation(fn(xs)
let
n1 = nth(xs,0) * 1000 + nth(xs,1) * 100 + nth(xs,2) * 10 + nth(xs,3),
n2 = 1000 + nth(xs,4) * 100 + nth(xs,5) * 10 + nth(xs, 1),
n3 = 10000 + nth(xs,4) * 1000 + nth(xs,2) * 100 + nth(xs,1) * 10 + nth(xs,6)
in
if n1 + n2 == n3 then
print(n1), print(" + "), print(n2), print(" = "), print(n3),
print("\n")
end
end
end,
7,
list(0,2,3,4,5,6,7,8,9))
end
Calc> hukumen(); 9567 + 1085 = 10652
答えは 9567 + 1085 = 10652 の 1 通りしかありません。
リスト : ８クイーン
def attack(x, xs)
let rec
iter = fn(n, ys)
if null(ys) then
1
else
if x == car(ys) + n or x == car(ys) - n then
0
else
iter(n + 1, cdr(ys))
end
end
end
in
iter(1, xs)
end
end
def queen(n)
let rec
iter = fn(nums, board)
if null(nums) then
print(board), print("\n")
else
foreach(fn(x)
if attack(x, board) then
iter(remove(fn(y) x == y end, nums), cons(x, board))
end
end,
nums
)
end
end
in
iter(iota(1, n), nil)
end
end
Calc> queen(8); (4 2 7 3 6 8 5 1) (5 2 4 7 3 8 6 1) (3 5 2 8 6 4 7 1) (3 6 4 2 8 5 7 1) ・・・省略・・・ (6 3 5 7 1 4 2 8) (6 4 7 1 3 5 2 8) (4 7 5 2 6 1 3 8) (5 7 2 6 3 1 4 8)
重複解 (鏡像解や回転解) を除かない場合、解は全部で 92 通りあります。
リスト : 魔方陣
def magic()
let
lineNum = fn(xs, ls) foldl(fn(x, a) nth(xs, x) + a end, 0, ls) end,
line = list(list(0, 1, 2), list(3, 4, 5), list(6, 7, 8),
list(0, 3, 6), list(1, 4, 7), list(2, 5, 8),
list(0, 4, 8), list(2, 4, 6))
in
permutation(fn(xs)
let
ns = map(fn(ls) lineNum(xs, ls) end, line)
in
if every(fn(x) car(ns) == x end, cdr(ns)) then
print(xs), putc(10)
end
end
end,
9,
iota(1, 9)
)
end
end
Calc> magic(); (2 7 6 9 5 1 4 3 8) (2 9 4 7 5 3 6 1 8) (4 3 8 9 5 1 2 7 6) (4 9 2 3 5 7 8 1 6) (6 1 8 7 5 3 2 9 4) (6 7 2 1 5 9 8 3 4) (8 1 6 3 5 7 4 9 2) (8 3 4 1 5 9 6 7 2)
解は 8 通り出力されましたが、重複解を取り除くと解は一通りしかありません。重複解のチェックは面倒だと思われる方もいるでしょう。ところが、下図のように四隅の大小関係を利用すると簡単です。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│
├─┼─┼─┤ A < C < G
│Ｄ│Ｅ│Ｆ│
├─┼─┼─┤ A < I
│Ｇ│Ｈ│Ｉ│
└─┴─┴─┘
図 : 対称解のチェック
魔方陣の場合、回転解が 4 種類あって、鏡像解が 2 種類あります。四隅の大小関係をチェックすることで、これらの対称解を排除することができます。また、順列を生成するとき、重複解のチェックを入れると枝刈りと同じ効果を得ることができます。興味のある方は試してみてください。
リスト : マスターマインドの解法
def countBulls(xs, ys)
foldl2(fn(x, y, a) if x == y then a + 1 else a end end, 0, xs, ys)
end
def countSameNum(xs, ys)
foldl(fn(x, a) if member(x, ys) then a + 1 else a end end, 0, xs)
end
# query = ((code bulls cows) ...)
def checkQuery(code, query)
every(fn(xs)
let
newBulls = countBulls(code, car(xs)),
newSames = countSameNum(code, car(xs))
in
newBulls == second(xs) and newSames - newBulls == third(xs)
end
end,
query)
end
def mastermind(code)
let
query = nil
in
callcc(fn(k)
permutation(fn(xs)
if checkQuery(xs, query) then
let
bulls = countBulls(code, xs),
sames = countSameNum(code, xs)
in
print(xs), print(" : bulls = "), print(bulls),
print(", cows = "), print(sames - bulls), putc(10),
if bulls == 4 then k(nil) end,
query = cons(list(xs, bulls, sames - bulls), query)
end
end
end,
4,
iota(0, 9)
)
end)
end
end
Calc> mastermind(list(6,7,8,9)); (0 1 2 3) : bulls = 0, cows = 0 (4 5 6 7) : bulls = 0, cows = 2 (5 4 8 9) : bulls = 2, cows = 0 (6 7 8 9) : bulls = 4, cows = 0 Calc> mastermind(list(9,8,7,6)); (0 1 2 3) : bulls = 0, cows = 0 (4 5 6 7) : bulls = 0, cows = 2 (5 4 8 9) : bulls = 0, cows = 2 (6 7 9 8) : bulls = 0, cows = 4 (8 9 7 6) : bulls = 2, cows = 2 (9 8 7 6) : bulls = 4, cows = 0 Calc> mastermind(list(9,4,3,1)); (0 1 2 3) : bulls = 0, cows = 2 (1 0 4 5) : bulls = 0, cows = 2 (2 3 5 4) : bulls = 0, cows = 2 (3 4 0 6) : bulls = 1, cows = 1 (3 5 6 1) : bulls = 1, cows = 1 (6 5 0 2) : bulls = 0, cows = 0 (7 4 3 1) : bulls = 3, cows = 0 (8 4 3 1) : bulls = 3, cows = 0 (9 4 3 1) : bulls = 4, cows = 0
肝心の質問回数ですが、5, 6 回で当たる場合が多いようです。実際に、5040 個のコードをすべて試してみたところ、平均は 5.56 回になりました。質問回数の最大値は 9 回で、そのときのコードは (9 4 3 1), (9 2 4 1), (5 2 9 3), (9 2 0 4), (9 2 1 4) でした。
リスト : 蛙飛びゲーム
B = 1;
W = 2;
S = 0;
def solve(s, goal, move)
if equal(car(move), goal) then
foreach(fn(x) print(x), print("\n") end, reverse(move)),
print("\n")
else
let newboard = copy(car(move)) in
if s > 0 and newboard[s - 1] == B then
newboard[s] = B,
newboard[s - 1] = S,
solve(s - 1, goal, cons(newboard, move)),
newboard[s] = S,
newboard[s - 1] = B
end,
if s > 1 and newboard[s - 2] == B and newboard[s - 1] == W then
newboard[s] = B,
newboard[s - 2] = S,
solve(s - 2, goal, cons(newboard, move)),
newboard[s] = S,
newboard[s - 2] = B
end,
if s < 6 and newboard[s + 1] == W then
newboard[s] = W,
newboard[s + 1] = S,
solve(s + 1, goal, cons(newboard, move)),
newboard[s] = S,
newboard[s + 1] = W
end,
if s < 5 and newboard[s + 2] == W and newboard[s + 1] == B then
newboard[s] = W,
newboard[s + 2] = S,
solve(s + 2, goal, cons(newboard, move)),
newboard[s] = S,
newboard[S + 2] = W
end
end
end
end
Calc> solve(3, [2,2,2,0,1,1,1], list([1,1,1,0,2,2,2])); [1, 1, 1, 0, 2, 2, 2] [1, 1, 0, 1, 2, 2, 2] [1, 1, 2, 1, 0, 2, 2] [1, 1, 2, 1, 2, 0, 2] [1, 1, 2, 0, 2, 1, 2] [1, 0, 2, 1, 2, 1, 2] [0, 1, 2, 1, 2, 1, 2] [2, 1, 0, 1, 2, 1, 2] [2, 1, 2, 1, 0, 1, 2] [2, 1, 2, 1, 2, 1, 0] [2, 1, 2, 1, 2, 0, 1] [2, 1, 2, 0, 2, 1, 1] [2, 0, 2, 1, 2, 1, 1] [2, 2, 0, 1, 2, 1, 1] [2, 2, 2, 1, 0, 1, 1] [2, 2, 2, 0, 1, 1, 1] [1, 1, 1, 0, 2, 2, 2] [1, 1, 1, 2, 0, 2, 2] [1, 1, 0, 2, 1, 2, 2] [1, 0, 1, 2, 1, 2, 2] [1, 2, 1, 0, 1, 2, 2] [1, 2, 1, 2, 1, 0, 2] [1, 2, 1, 2, 1, 2, 0] [1, 2, 1, 2, 0, 2, 1] [1, 2, 0, 2, 1, 2, 1] [0, 2, 1, 2, 1, 2, 1] [2, 0, 1, 2, 1, 2, 1] [2, 2, 1, 0, 1, 2, 1] [2, 2, 1, 2, 1, 0, 1] [2, 2, 1, 2, 0, 1, 1] [2, 2, 0, 2, 1, 1, 1] [2, 2, 2, 0, 1, 1, 1] 0
蛙飛びゲームは後戻りができないので、単純な「深さ優先探索」で解くことができます。
リスト : ペグ・ソリテア
# 跳び先表
jump_table = [
[[1,2],[3,6],[5,10]],
[[3,5],[4,7],[6,11]],
[[1,0],[4,6],[7,12]],
[[6,9]],
[[6,8]],
[[3,1],[6,7],[8,11]],
[[3,0],[4,2],[8,10],[9,12]],
[[4,1],[6,5],[9,11]],
[[6,4]],
[[6,3]],
[[5,0],[8,6],[11,12]],
[[6,1],[8,5],[9,7]],
[[7,2],[9,6],[11,10]]
];
# 反復深化による解法
def peg13()
let
board = makeVector(13, 1),
i = 0,
MAX_JUMP = 11, # 12 個のペグが 1 つになるまで跳ぶ
GOAL = 6,
SIZE = 13,
cnt = 0
in
let rec
ids = fn(jc, limit, move)
if jc <= limit then
if length(move) == MAX_JUMP then
if board[GOAL] then
print(reverse(move)), print("\n"), cnt = cnt + 1
end
else
let j = 0 in
while j < SIZE do
if board[j] then
foreach(
fn(x)
let
del = x[0], to = x[1]
in
if board[del] and not board[to] then
board[j] = 0, board[del] = 0, board[to] = 1,
ids(if j == cdar(move) then jc else jc + 1 end,
limit,
cons(cons(j, to), move)),
board[j] = 1, board[del] = 1, board[to] = 0
end
end
end,
jump_table[j]
)
end,
j = j + 1
end
end
end
end
end
in
# 初手を 0 -> 6 に限定
board[0] = 0, board[3] = 0,
i = 2,
while i <= MAX_JUMP and cnt == 0 do
print("move = "), print(i), print("\n"),
ids(1, i, cons(cons(0, 6), nil)),
i = i + 1
end
end
end
end
Calc> peg13(); move = 2 move = 3 move = 4 move = 5 move = 6 move = 7 ((0 . 6) (9 . 3) (2 . 0) (0 . 6) (11 . 1) (10 . 0) (0 . 2) (2 . 6) (8 . 4) (12 . 2) (2 . 6)) ((0 . 6) (9 . 3) (2 . 0) (0 . 6) (11 . 1) (10 . 6) (4 . 8) (12 . 2) (2 . 0) (0 . 10) (10 . 6)) ((0 . 6) (9 . 3) (2 . 0) (0 . 6) (11 . 1) (12 . 2) (2 . 6) (8 . 4) (10 . 0) (0 . 2) (2 . 6)) ((0 . 6) (9 . 3) (2 . 6) (8 . 4) (10 . 0) (0 . 2) (2 . 6) (7 . 5) (12 . 10) (10 . 0) (0 . 6)) ((0 . 6) (9 . 3) (2 . 6) (8 . 4) (10 . 0) (0 . 2) (2 . 6) (11 . 1) (12 . 2) (2 . 0) (0 . 6)) ((0 . 6) (9 . 3) (2 . 6) (8 . 4) (10 . 0) (0 . 6) (7 . 5) (12 . 10) (10 . 0) (0 . 2) (2 . 6)) ((0 . 6) (9 . 3) (2 . 6) (8 . 4) (12 . 2) (2 . 0) (0 . 6) (5 . 7) (10 . 12) (12 . 2) (2 . 6)) ((0 . 6) (9 . 3) (2 . 6) (8 . 4) (12 . 2) (2 . 0) (0 . 6) (11 . 1) (10 . 0) (0 . 2) (2 . 6)) ((0 . 6) (9 . 3) (2 . 6) (8 . 4) (12 . 2) (2 . 6) (5 . 7) (10 . 12) (12 . 2) (2 . 0) (0 . 6)) ((0 . 6) (9 . 3) (10 . 0) (0 . 6) (7 . 5) (2 . 0) (0 . 10) (10 . 6) (4 . 8) (12 . 10) (10 . 6)) ((0 . 6) (9 . 3) (10 . 0) (0 . 6) (7 . 5) (2 . 6) (8 . 4) (12 . 10) (10 . 0) (0 . 2) (2 . 6)) ((0 . 6) (9 . 3) (10 . 0) (0 . 6) (7 . 5) (12 . 10) (10 . 6) (4 . 8) (2 . 0) (0 . 10) (10 . 6)) ((0 . 6) (9 . 3) (10 . 6) (4 . 8) (2 . 0) (0 . 6) (11 . 1) (12 . 2) (2 . 0) (0 . 10) (10 . 6)) ((0 . 6) (9 . 3) (10 . 6) (4 . 8) (2 . 0) (0 . 10) (10 . 6) (7 . 5) (12 . 10) (10 . 0) (0 . 6)) ((0 . 6) (9 . 3) (10 . 6) (4 . 8) (2 . 0) (0 . 10) (10 . 6) (11 . 1) (12 . 2) (2 . 0) (0 . 6)) ((0 . 6) (9 . 3) (10 . 6) (4 . 8) (12 . 10) (10 . 0) (0 . 6) (1 . 11) (2 . 12) (12 . 10) (10 . 6)) ((0 . 6) (9 . 3) (10 . 6) (4 . 8) (12 . 10) (10 . 0) (0 . 6) (7 . 5) (2 . 0) (0 . 10) (10 . 6)) ((0 . 6) (9 . 3) (10 . 6) (4 . 8) (12 . 10) (10 . 6) (1 . 11) (2 . 12) (12 . 10) (10 . 0) (0 . 6)) 0
7 手で解くことができました。解は全部で 18 通りになりました。最近のパソコンは高性能なので、穴の数が少ない盤面であれば、単純な反復深化でも高速に解くことができます。
リスト : 水差し問題
maxA = 8;
maxB = 5;
def getA(s) car(s) end
def getB(s) cdr(s) end
action = list(fn(s) cons(maxA, getB(s)) end, # A を満杯
fn(s) cons(0, getB(s)) end, # A を空
fn(s) let w = maxB - getB(s) in # A -> B
if getA(s) <= w then
cons(0, getB(s) + getA(s))
else
cons(getA(s) - w, getB(s) + w)
end
end
end,
fn(s) cons(getA(s), maxB) end, # B を満杯
fn(s) cons(getA(s), 0) end, # B を空
fn(s) let w = maxA - getA(s) in # B -> A
if getB(s) <= w then
cons(getA(s) + getB(s), 0)
else
cons(getA(s) + w, getB(s) - w)
end
end
end);
def water(goal)
callcc(fn(k)
let q = makeQueue() in
enqueue(q, list(cons(0, 0))),
while not isEmptyQueue(q) do
let move = dequeue(q) in
if getA(car(move)) == goal or getB(car(move)) == goal then
print(reverse(move)), putc(10),
k(nil)
else
foreach(fn(act) let ns = act(car(move)) in
if not find(fn(s) equal(s, ns) end, move) then
enqueue(q, cons(ns, move))
end
end
end,
action)
end
end
end
end
end)
end
Calc> water(4); ((0 . 0) (0 . 5) (5 . 0) (5 . 5) (8 . 2) (0 . 2) (2 . 0) (2 . 5) (7 . 0) (7 . 5) (8 . 4))
最短手数は 10 手になります。今回は「幅優先探索」で解きましたが、「反復深化」でも簡単に解けると思います。興味のある方は挑戦してみてください。
リスト : 5 パズル
# 隣接リスト
adjacent = [[1, 3], [0, 2, 4], [1, 5],
[0, 4], [1, 3, 5], [2, 4]];
# state = (board, prevState, spacePosition)
def getBoard(state) first(state) end
def getPrev(state) second(state) end
def getSpace(state) third(state) end
def makeBoard(b, s, p)
let
n = copy(b)
in
n[s] = n[p],
n[p] = 0,
n
end
end
def printAnswer(state)
if getPrev(state) then printAnswer(getPrev(state)) end,
print(getBoard(state)),
putc(10)
end
def solve5(start, goal)
callcc(fn(exit)
let
q = makeQueue(), a = nil
in
a = cons(start, a),
enqueue(q, list(start, nil, position(fn(x) x == 0 end, start))),
while not isEmptyQueue(q) do
let
s0 = dequeue(q)
in
foreach(fn(x)
let
s1 = list(makeBoard(getBoard(s0), getSpace(s0), x), s0, x)
in
if equal(getBoard(s1), goal) then
printAnswer(s1),
exit(nil)
else
if not find(fn(b) equal(b, getBoard(s1)) end, a) then
a = cons(getBoard(s1), a),
enqueue(q, s1)
end
end
end
end,
adjacent[getSpace(s0)]
)
end
end
end
end)
end
Calc> solve5([4,5,0,1,2,3],[1,2,3,4,5,0]); [4, 5, 0, 1, 2, 3] [4, 0, 5, 1, 2, 3] [0, 4, 5, 1, 2, 3] [1, 4, 5, 0, 2, 3] [1, 4, 5, 2, 0, 3] [1, 0, 5, 2, 4, 3] [1, 5, 0, 2, 4, 3] [1, 5, 3, 2, 4, 0] [1, 5, 3, 2, 0, 4] [1, 5, 3, 0, 2, 4] [0, 5, 3, 1, 2, 4] [5, 0, 3, 1, 2, 4] [5, 2, 3, 1, 0, 4] [5, 2, 3, 1, 4, 0] [5, 2, 0, 1, 4, 3] [5, 0, 2, 1, 4, 3] [0, 5, 2, 1, 4, 3] [1, 5, 2, 0, 4, 3] [1, 5, 2, 4, 0, 3] [1, 0, 2, 4, 5, 3] [1, 2, 0, 4, 5, 3] [1, 2, 3, 4, 5, 0]
最短手数は 21 手、これが最長手数の局面です。ご参考までに、最長手数の局面を求めるプログラムを示します。
リスト : 最長手数の局面を求める
def solve5_max()
let
start = list([1,2,3,4,5,0], 0, 5),
q = makeQueue(), a = nil,
in
a = cons(start, a),
enqueue(q, start),
while not isEmptyQueue(q) do
let
s0 = dequeue(q)
in
foreach(fn(x)
let
s1 = list(makeBoard(getBoard(s0), getSpace(s0), x), second(s0) + 1, x)
in
if not find(fn(b) equal(getBoard(b), getBoard(s1)) end, a) then
a = cons(s1, a),
enqueue(q, s1)
end
end
end,
adjacent[getSpace(s0)]
)
end
end,
let max_move = second(car(a)) in
print("max = "),
print(max_move),
print("\n"),
while max_move == second(car(a)) do
print(getBoard(car(a))),
print("\n"),
a = cdr(a)
end
end
end
end
Calc> solve5_max(); max = 21 [4, 5, 0, 1, 2, 3] 0
リスト : ナンバープレース
# 大域変数
size = 9;
board = nil;
xflag = nil;
yflag = nil;
gflag = nil;
# 初期化
def initialize()
board = makeVector(size * size, 0),
xflag = makeVector(size, nil),
yflag = makeVector(size, nil),
gflag = makeVector(size, nil),
let i = 0 in
while i < size do
xflag[i] = iota(1, 9),
yflag[i] = iota(1, 9),
gflag[i] = iota(1, 9),
i = i + 1
end
end
end
# グループ番号の取得
def get_group(x, y)
3 * (x / 3) + y / 3
end
# 可能性のある数字を求める
def get_numbers(x, y)
let g = get_group(x, y) in
intersection(intersection(xflag[x], yflag[y]), gflag[g])
end
end
# 数字のセット
def set_number(x, y, n)
let g = get_group(x, y) in
board[x * size + y] = n,
xflag[x] = remove(fn(z) n == z end, xflag[x]),
yflag[y] = remove(fn(z) n == z end, yflag[y]),
gflag[g] = remove(fn(z) n == z end, gflag[g])
end
end
# 数字を取り消す
def del_number(x, y, n)
let g = get_group(x, y) in
board[x * size + y] = 0,
xflag[x] = cons(n, xflag[x]),
yflag[y] = cons(n, yflag[y]),
gflag[g] = cons(n, gflag[g])
end
end
# 盤面の表示
def print_board(board)
let i = 0, k = size * size in
while i < k do
print(board[i]),
if i % size == size - 1 then print("\n") else print(" ") end,
i = i + 1
end,
print("\n")
end
end
# データの読み込み
def read_data(qs)
let i = 0, k = size * size in
while i < k do
if qs[i] > 0 then
let
x = i / size,
y = i % size
in
set_number(x, y, qs[i])
end
end,
i = i + 1
end
end
end
# ナンバープレースの解法
def number_place(qs)
let rec
solve = fn(x, y)
if y == size then
print_board(board)
else
if x == size then
solve(0, y + 1)
else
if board[x * size + y] == 0 then
foreach(
fn(n)
set_number(x, y, n),
solve(x + 1, y),
del_number(x, y, n)
end,
get_numbers(x, y)
)
else
solve(x + 1, y)
end
end
end
end
in
initialize(),
read_data(qs),
solve(0, 0)
end
end
# 問題 (出典: 数独 - Wikipedia の問題例)
qs = [5, 3, 0, 0, 7, 0, 0, 0, 0,
6, 0, 0, 1, 9, 5, 0, 0, 0,
0, 9, 8, 0, 0, 0, 0, 6, 0,
8, 0, 0, 0, 6, 0, 0, 0, 3,
4, 0, 0, 8, 0, 3, 0, 0, 1,
7, 0, 0, 0, 2, 0, 0, 0, 6,
0, 6, 0, 0, 0, 0, 2, 8, 0,
0, 0, 0, 4, 1, 9, 0, 0, 5,
0, 0, 0, 0, 8, 0, 0, 7, 9]
Calc> number_place(qs); 5 3 4 6 7 8 9 1 2 6 7 2 1 9 5 3 4 8 1 9 8 3 4 2 5 6 7 8 5 9 7 6 1 4 2 3 4 2 6 8 5 3 7 9 1 7 1 3 9 2 4 8 5 6 9 6 1 5 3 7 2 8 4 2 8 7 4 1 9 6 3 5 3 4 5 2 8 6 1 7 9
盤面が 9 * 9 の場合、単純なバックトラック法だけで簡単に解くことができました。