M.Hiroi's Home Page

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

関数型電卓プログラムの改良 (付録B)

関数型電卓プログラム fcalc の使用例として、前回作成した簡単なライブラリを使ってパズルの解法プログラムを作成します。

●問題1「小町算」

1 から 9 までの数字を順番に並べ、間に + と - を補って 100 になる式を作ってください。

例:1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100

パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。たとえば、123456789 とか 321654987 のような数字です。「小町算」というものもあり、たとえば 123 + 456 + 789 とか 321 * 654 + 987 のようなものです。問題1は小町算の中でも特に有名なパズルです。

解答

●問題2「覆面算」

      S E N D
  +   M O R E
 -------------
    M O N E Y

  図 : 覆面算

計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。使用する数字は 0 から 9 までで、最上位の桁に 0 を入れることはできません。問題2はデュードニーが 1924 年に発表したもので、覆面算の古典といわれる有名なパズルです。

解答

●問題3「8クイーン」

8クイーンは、8 行 8 列のチェスの升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。コンピュータに解かせるパズルの中でもとくに有名な問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を次に示します。


      図 : 8 クイーンの解答例

8クイーンの解をすべて求めてください。

解答

●問題4「魔方陣」


              図 : 魔方陣

上図の A から I の場所に 1 から 9 までの数字をひとつずつ配置します。縦横斜めの合計が等しくなるように数字を配置してください。

解答

●問題5「マスターマインド」

「マスターマインド」は 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

  図 : マスターマインドの動作例

マスターマインドを解くプログラムを作成してください。

解答

●問題6「蛙跳びゲーム」


        図 : 蛙跳びゲーム

蛙跳びゲームは黒石と白石を使って遊ぶ、いわゆる「飛び石ゲーム」と呼ばれる種類のパズルです。上図のように、蛙跳びゲームは黒石と白石を入れ替えることができれば成功です。スタートからゴールまでの最短手順を求めてください。

石を動かす規則は次のとおりです。

石の跳び越しは次の図を参考にしてください。


              図 : 石の跳び越し

解答

●問題7「ペグ・ソリテア」

ペグ・ソリテアは、盤上に配置されたペグ (駒) を、最後にはひとつ残るように取り除いていく古典的なパズルです。ペグは次のルールに従って移動し、除去することができます。

盤は今までに多数考案されていますが、33 穴英国盤、37 穴フランス盤、41 穴盤が有名でしょう。33 穴英国盤と Hoppers を図に示します。Hoppers は芦ヶ原伸之氏が考案されたペグ・ソリテアです。


        (1) 33 穴英国盤

     (2) Hoppers

     図 : ペグ・ソリテア

それぞれのマスにペグがありますが、そこからひとつペグを取り除いてゲームを始めます。図では黒丸でペグを表し、白丸で空き場所を表しています。ルールに従ってペグを移動し、最後にひとつだけ残ればクリアとなります。ただし、ペグを取り除く位置によって、解けない場合もあるので注意してください。

それでは問題です。図 (2) に示したように、Hoppers の中央のペグを取り除きます。この状態から始めて、最後のペグが中央の位置に残る跳び方の最小手数を求めてください。

解答

●問題8「水差し問題」

大きな容器に水が入っています。目盛の付いていない 8 リットルと 5 リットルの容器を使って、大きな容器から 4 リットルの水を汲み出してください。4 リットルの水は、どちらの容器に入れてもかまいません。水をはかる最短手順を求めてください。なお、水の総量に制限はありません。

解答

●問題9「5パズル」

「15 パズル」でお馴染みのスライドパズルです。それでは問題です。

スタートからゴールまでの最短手順を求めてください。

解答

●問題10「ナンバープレース」

9 行 9 列盤の「ナンバープレース (数独) 」を解くプログラムを作ってください。

解答


●解答1「小町算」

リスト : 小町算

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 通りあります。

●解答2「覆面算」

リスト : 覆面算

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 通りしかありません。

●解答3「8クイーン」

リスト : 8クイーン

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 通りあります。

●解答4「魔方陣」

リスト : 魔方陣

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 通り出力されましたが、重複解を取り除くと解は一通りしかありません。重複解のチェックは面倒だと思われる方もいるでしょう。ところが、下図のように四隅の大小関係を利用すると簡単です。


      図 : 対称解のチェック

魔方陣の場合、回転解が 4 種類あって、鏡像解が 2 種類あります。四隅の大小関係をチェックすることで、これらの対称解を排除することができます。また、順列を生成するとき、重複解のチェックを入れると枝刈りと同じ効果を得ることができます。興味のある方は試してみてください。

●解答5「マスターマインド」

リスト : マスターマインドの解法

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) でした。

●解答6「蛙飛びゲーム」

リスト : 蛙飛びゲーム

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

蛙飛びゲームは後戻りができないので、単純な「深さ優先探索」で解くことができます。

●解答7「ペグ・ソリテア」

リスト : ペグ・ソリテア

# 跳び先表
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 通りになりました。最近のパソコンは高性能なので、穴の数が少ない盤面であれば、単純な反復深化でも高速に解くことができます。

●解答8「水差し問題」

リスト : 水差し問題

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 手になります。今回は「幅優先探索」で解きましたが、「反復深化」でも簡単に解けると思います。興味のある方は挑戦してみてください。

●解答9「5パズル」

リスト : 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

●解答10「ナンバープレース」

リスト : ナンバープレース

# 大域変数
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 の場合、単純なバックトラック法だけで簡単に解くことができました。


初版 2012 年 9 月 29 日
改訂 2021 年 6 月 5 日

Copyright (C) 2012-2021 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]