お気楽 Standard ML of New Jersey 入門

はじめに

関数型電卓プログラム fcalc の使用例として、基本的なデータ構造である「二分木」と「ハッシュ表」を作成します。そして、それらを使って「８パズル」を解いてみましょう。

●二分木

二分木の詳しい説明は拙作のページ「モジュール (2)」または Algorithms with Python「二分木とヒープ」をお読みください。

作成する関数と機能概要を下記に示します。

• make_tree(eq, lt)
  空の二分木を生成する。eq(x, y) は 2 つのキー x, y の等値を判定する述語、lt(x, y) は x < y のときに真を返す述語である。
• isEmptyTree(tree)
  二分木 tree が空であれば真を返す。
• search_tree(tree, key)
  二分木 tree からキー key を探してその値を返す。見つからない場合は nil を返す。
• search_tree_min(tree)
  二分木 tree の最小のキーとその値を求める。返り値はコンスセル (key . value) である。
• search_tree_max(tree)
  二分木 tree の最大のキーとその値を求める。返り値はコンスセル (key . value) である。
• insert_tree(tree, key, value)
  二分木 tree にキー key と値 value を登録する。
• delete_tree(tree, key)
  二分木 tree からキー key とその値を削除する。
• delete_tree_min(tree)
  二分木 tree から最小のキーとその値を削除する。
• delete_tree_max(tree)
  二分木 tree から最大のキーとその値を削除する。
• fold_tree_right(f, a, tree)
  二分木 tree の右部分木から畳み込みを行う。関数 f の引数はキー key, 値 value, 累積変数 a である。
• fold_tree_left(f, a, tree)
  二分木 tree の左部分木から畳み込みを行う。関数 f の引数はキー key, 値 value, 累積変数 a である。
• foreach_tree(f, tree)
  二分木 tree の要素に関数 f(key, value) を適用する。
• list_to_tree(eq, lt, ks, vs)
  キーを格納したリスト ks と、値を格納した vs から二分木を生成する。述語 eq と lt の仕様は make_tree と同じ。
• tree_to_list(tree)
  二分木 tree をリストに変換する。リストの要素はコンスセル (key . value) である。

簡単な使用例を示します。

Calc> load("lib.cal");

Calc> load("tree.cal");

Calc> tree = make_tree(fn(x, y) x == y end, fn(x, y) x < y end);
[(), <Function>, <Function>]
Calc> insert_tree(tree, 100, 1);

Calc> insert_tree(tree, 50, 2);

Calc> insert_tree(tree, 150, 3);

Calc> insert_tree(tree, 10, 4);

Calc> insert_tree(tree, 200, 5);

Calc> search_tree(tree, 100);
1
Calc> search_tree(tree, 200);
5
Calc> search_tree(tree, 300);

Calc> foreach_tree(fn(x, y) print(cons(x, y)) end, tree);
(10 . 4)(50 . 2)(100 . 1)(150 . 3)(200 . 5)0
Calc> delete_tree(tree, 100);

Calc> foreach_tree(fn(x, y) print(cons(x, y)) end, tree);
(10 . 4)(50 . 2)(150 . 3)(200 . 5)0
Calc> delete_tree(tree, 10);

Calc> foreach_tree(fn(x, y) print(cons(x, y)) end, tree);
(50 . 2)(150 . 3)(200 . 5)0
Calc> tree1 = list_to_tree(fn(x, y) x == y end, fn(x, y) x < y end,
list(100, 150, 50, 200, 250, 10), list(1,2,3,4,5,6));
[[100, 1, [50, 3, [10, 6, (), ()], ()], [150, 2, (), [200, 4, (), [250, 5, (), ()]]]],
 <Function>, <Function>]
Calc> tree_to_list(tree1);
((10 . 6) (50 . 3) (100 . 1) (150 . 2) (200 . 4) (250 . 5))
Calc> fold_tree_left(fn(k, v, a) cons(k, a) end, nil, tree1);
(250 200 150 100 50 10)
Calc> fold_tree_right(fn(k, v, a) cons(k, a) end, nil, tree1);
(10 50 100 150 200 250)

●プログラムリスト

#
# tree.cal : 二分探索木
#
#            Copyright (C) 2012-2021 Makoto Hiroi
#

# 節 : [key, value, left, right]

# アクセス関数
def getKey(node) node[0] end
def getValue(node) node[1] end
def getLeft(node) node[2] end
def getRight(node) node[3] end

def putKey(node, x) node[0] = x end
def putValue(node, value) node[1] = value end
def putLeft(node, tree) node[2] = tree end
def putRight(node, tree) node[3] = tree end

# 節の生成
def makeNode(key, value) [key, value, nil, nil] end

# 二分木の生成
# eq は ==、lt は < を判定する関数
def make_tree(eq, lt) [nil, eq, lt] end

# 木は空か
def isEmptyTree(tree) null(tree[0]) end

# 探索
def search_tree(tree, x)
  let rec
    iter = fn(node)
      if null(node) then
        nil
      else
        if (tree[1])(getKey(node), x) then
          getValue(node)
        else
          if (tree[2])(x, getKey(node)) then
            iter(getLeft(node))
          else
            iter(getRight(node))
          end
        end
      end
    end
  in
    iter(tree[0])
  end
end

# 最小値のノードを探索
def searchTreeMin(node)
  if null(getLeft(node)) then
    node
  else
    searchTreeMin(getLeft(node))
  end
end

# 最大値のノードを探索
def searchTreeMax(node)
  if null(getRight(node)) then
    node
  else
    searchTreeMax(getRight(node))
  end
end

# 最小値を求める
def search_tree_min(tree)
  if null(tree[0]) then
    nil
  else
    let
      node = searchTreeMin(tree[0])
    in
      cons(getKey(node), getValue(node))
    end
  end
end

# 最大値を求める
def search_tree_max(tree)
  if null(tree[0]) then
    nil
  else
    let
      node = searchTreeMax(tree[0])
    in
      cons(getKey(node), getValue(node))
    end
  end
end

# 挿入
def insert_tree(tree, key, value)
  let rec
    iter = fn(node)
      if null(node) then
        makeNode(key, value)
      else
        if (tree[1])(key, getKey(node)) then
          putValue(node, value)
        else
          if (tree[2])(key, getKey(node)) then
            putLeft(node, iter(getLeft(node)))
          else
            putRight(node, iter(getRight(node)))
          end
        end,
        node
      end
    end
  in
    tree[0] = iter(tree[0]),
    nil
  end
end

# 最小値のノードを削除
def deleteTreeMin(node)
  if null(getLeft(node)) then
    getRight(node)
  else
    putLeft(node, deleteTreeMin(getLeft(node))),
    node
  end
end

# 最大値のノードを削除
def deleteTreeMax(node)
  if null(getRight(node)) then
    getLeft(node)
  else
    putRight(node, deleteTreeMax(getRight(node))),
    node
  end
end

# 最小値を削除
def delete_tree_min(tree)
  if null(tree[0]) then
    nil
  else
    tree[0] = deleteTreeMin(tree[0]),
    tree
  end
end

# 最大値を削除
def delete_tree_max(tree)
  if null(tree[0]) then
    nil
  else
    tree[0] = deleteTreeMax(tree[0]),
    tree
  end
end

# 削除
def delete_tree(tree, key)
  let rec
    iter = fn(node)
      if null(node) then
        nil
      else
        if (tree[1])(key, getKey(node)) then
          if null(getLeft(node)) then
            getRight(node)
          else
            if null(getRight(node)) then
              getLeft(node)
            else
              let
                minNode = searchTreeMin(getRight(node))
              in
                putKey(node, getKey(minNode)),
                putValue(node, getValue(minNode)),
                putRight(node, deleteTreeMin(getRight(node))),
                node
              end
            end
          end
        else
          if (tree[2])(key, getKey(node)) then
            putLeft(node, iter(getLeft(node)))
          else
            putRight(node, iter(getRight(node)))
          end,
          node
        end
      end
    end
  in
    tree[0] = iter(tree[0]),
    nil
  end
end

# 畳み込み
def fold_tree_right(f, a, tree)
  let rec
    iter = fn(node, a)
      if null(node) then
        a
      else
        iter(getLeft(node),
             f(getKey(node), getValue(node), iter(getRight(node), a)))
      end
    end
  in
    iter(tree[0], a)
  end
end

def fold_tree_left(f, a, tree)
  let rec
    iter = fn(node, a)
      if null(node) then
        a
      else
        iter(getRight(node),
             f(getKey(node), getValue(node), iter(getLeft(node), a)))
      end
    end
  in
    iter(tree[0], a)
  end
end

# 巡回
def foreach_tree(f, tree)
  let rec
    iter = fn(node)
      if not null(node) then
        iter(getLeft(node)),
        f(getKey(node), getValue(node)),
        iter(getRight(node))
      end
    end
  in
    iter(tree[0])
  end
end

# list -> tree
def list_to_tree(eq, lt, ks, vs)
  foldl2(fn(k, v, a) insert_tree(a, k, v), a end, make_tree(eq, lt), ks, vs)
end

# tree -> list
def tree_to_list(tree)
  fold_tree_right(fn(k, v, a) cons(cons(k, v), a) end, nil, tree)
end

●問題「８パズル」

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

┌─┬─┬─┐    ┌─┬─┬─┐    ┌─┬─┬─┐
│８│６│７│    │６│４│７│    │１│２│３│
├─┼─┼─┤    ├─┼─┼─┤    ├─┼─┼─┤
│２│５│４│    │８│５│  │    │４│５│６│
├─┼─┼─┤    ├─┼─┼─┤    ├─┼─┼─┤
│３│  │１│    │３│２│１│    │７│８│  │
└─┴─┴─┘    └─┴─┴─┘    └─┴─┴─┘
  スタートＡ        スタートＢ          ゴール

                  図 : 8 パズル

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

●解答「８パズル」

#
# eight.cal : ８パズル
#
#             Copyright (C) 2012-2021 Makoto Hiroi
#

# 隣接行列
# 0 1 2
# 3 4 5
# 6 7 8
adjacent = [[1, 3],    [0, 2, 4],    [1, 5],
            [0, 4, 6], [1, 3, 5, 7], [2, 4, 8],
            [3, 7],    [4, 6, 8],    [5, 7]];

# state : (board prevState spacePosition)

# state のアクセス関数
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)),
  print("\n")
end

# 盤面を数値に変換
def boardtoNum(board)
  foldl(fn(x, a) a * 10 + x end, 0, board)
end

# ８パズルの解法 (単純な幅優先探索)
def solve8(start, goal)
  callcc(fn(exit)
    let
      q = makeQueue(),
      a = make_tree(fn(x, y) x == y end, fn(x, y) x < y end),
      g = boardtoNum(goal)
    in
      insert_tree(a, boardtoNum(start), 1),
      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 rec
                s1, n = list(makeBoard(getBoard(s0), getSpace(s0), x), s0, x),
                        boardtoNum(getBoard(s1))
              in
                if n == g then
                  printAnswer(s1),
                  exit(nil)
                else
                  if not search_tree(a, n) then
                    insert_tree(a, n, 1),
                    enqueue(q, s1)
                  end
                end
              end
            end,
            adjacent[getSpace(s0)]
          )
        end
      end
    end
  end)
end

def test1()
  solve8([8,6,7,2,5,4,3,0,1],[1,2,3,4,5,6,7,8,0])
end

def test2()
  solve8([6,4,7,8,5,0,3,2,1],[1,2,3,4,5,6,7,8,0])
end

実行結果を示します。

Calc> test1();
[8, 6, 7, 2, 5, 4, 3, 0, 1]
[8, 6, 7, 2, 0, 4, 3, 5, 1]
[8, 0, 7, 2, 6, 4, 3, 5, 1]

    ・・・省略・・・

[1, 2, 3, 4, 5, 6, 0, 7, 8]
[1, 2, 3, 4, 5, 6, 7, 0, 8]
[1, 2, 3, 4, 5, 6, 7, 8, 0]

Calc> test2();
[6, 4, 7, 8, 5, 0, 3, 2, 1]
[6, 4, 0, 8, 5, 7, 3, 2, 1]
[6, 0, 4, 8, 5, 7, 3, 2, 1]

    ・・・省略・・・

[1, 2, 3, 4, 0, 6, 7, 5, 8]
[1, 2, 3, 4, 5, 6, 7, 0, 8]
[1, 2, 3, 4, 5, 6, 7, 8, 0]

どちらの場合も最短手数は 31 手、これが 8 パズルの最長手数の局面になります。実行時間は、A が 49.6 秒、B が 50.2 秒でした。実行環境は Windows 10, Intel Core i5-6200U 2.30GHz, SML/NJ ver 110.98 です。

●平衡木

二分木は左右の部分木のバランスが崩れると性能が劣化します。二分木の場合、最下層にあるデータを探す場合が最悪で、木の高さ分だけ比較が行われます。したがって、木の高さを低く抑えた方が探索効率も良くなります。このため、木のバランスを一定の範囲に収める「平衡木」が考案されています。有名なところでは AVL 木、赤黒木 (2 色木)、2-3 木、B 木、B* 木などがあります。この中で 2-3 木、B 木、B* 木は多分木、AVL 木、赤黒木は二分木を使用します。今回は簡単に実装できる AA 木を作ってみましょう。AA 木の詳しい説明は拙作のページ Algorithms with Python 「AA 木」をお読みください。

作成する関数は二分木と同じですが、終端を表す節を巡回的な構造でプログラムしているため、節を表示すると無限ループになります。ご注意くださいませ。

簡単な実行例を示します。

Calc> load("lib.cal");

Calc> load("aatree.cal");

Calc> begin tree = make_tree(fn(x, y) x == y end, fn(x, y) x < y end), nil end;

Calc> insert_tree(tree, 100, 1);

Calc> insert_tree(tree, 50, 2);

Calc> insert_tree(tree, 150, 3);

Calc> insert_tree(tree, 10, 4);

Calc> insert_tree(tree, 200, 5);

Calc> insert_tree(tree, 250, 6);

Calc> search_tree(tree, 10);
4
Calc> search_tree(tree, 100);
1
Calc> search_tree(tree, 250);
6
Calc> delete_tree(tree, 100);

Calc> delete_tree(tree, 10);

Calc> delete_tree(tree, 250);

Calc> search_tree(tree, 10);

Calc> search_tree(tree, 100);

Calc> search_tree(tree, 250);

Calc> begin tree1 = list_to_tree(fn(x, y) x == y end, fn(x, y) x < y end,
list(10, 20,30,40,50,60,70), list(1,2,3,4,5,6,7)), nil end;

Calc> foreach_tree(fn(k, v) print(cons(k, v)) end, tree1);
(10 . 1)(20 . 2)(30 . 3)(40 . 4)(50 . 5)(60 . 6)(70 . 7)0
Calc> print_tree(tree1);
    10
  20
    30
40
    50
  60
    70

●プログラムリスト

#
# aatree.cal : 平衡二分木 (AA tree)
#
#              Copyright (C) 2012-2021 Makoto Hiroi
#

# 節 : [key, value, left, right, height]

# 終端の生成
begin
  Null = [nil, nil, nil, nil, 0],
  Null[2] = Null,
  Null[3] = Null,
  nil
end;

# 終端の判定
def endp(node) node[4] == 0 end

# アクセス関数
def getKey(node) node[0] end
def getValue(node) node[1] end
def getLeft(node) node[2] end
def getRight(node) node[3] end
def getHeight(node) node[4] end

def putKey(node, x) node[0] = x end
def putValue(node, value) node[1] = value end
def putLeft(node, tree) node[2] = tree end
def putRight(node, tree) node[3] = tree end
def putHeight(node, n) node[4] = n end

def incHeight(node) node[4] = node[4] + 1 end
def decHeight(node) node[4] = node[4] - 1 end

# 節の生成
def makeNode(key, value)
  [key, value, Null, Null, 1]
 end

# AA 木の生成
# eq は ==、lt は < を判定する関数
def make_tree(eq, lt) [Null, eq, lt] end

# 空の木か
def isEmptyTree(tree) endp(tree[0]) end

# 右回転
def rotate_right(node)
  let
    left_node = getLeft(node)
  in
    putLeft(node, getRight(left_node)),
    putRight(left_node, node),
    left_node
  end
end

# 左回転
def rotate_left(node)
  let
    right_node = getRight(node)
  in
    putRight(node, getLeft(right_node)),
    putLeft(right_node, node),
    right_node
  end
end

# 左の子が赤の場合
def skew(node)
  if getHeight(getLeft(node)) == getHeight(node) then
    node = rotate_right(node)
  end,
  node
end

# 右の孫節が赤の場合
def split(node)
  if getHeight(node) == getHeight(getRight(getRight(node))) then
    node = rotate_left(node),
    incHeight(node)
  end,
  node
end

# 探索
def search_tree(tree, x)
  let rec
    iter = fn(node)
      if endp(node) then
        nil
      else
        if (tree[1])(getKey(node), x) then
          getValue(node)
        else
          if (tree[2])(x, getKey(node)) then
            iter(getLeft(node))
          else
            iter(getRight(node))
          end
        end
      end
    end
  in
    iter(tree[0])
  end
end

# 最小値のノードを探索
def searchTreeMin(node)
  if endp(getLeft(node)) then
    node
  else
    searchTreeMin(getLeft(node))
  end
end

# 最大値のノードを探索
def searchTreeMax(node)
  if endp(getRight(node)) then
    node
  else
    searchTreeMax(getRight(node))
  end
end

# 最小値を求める
def search_tree_min(tree)
  if endp(tree[0]) then
    nil
  else
    let
      node = searchTreeMin(tree[0])
    in
      cons(getKey(node), getValue(node))
    end
  end
end

# 最大値を求める
def search_tree_max(tree)
  if endp(tree[0]) then
    nil
  else
    let
      node = searchTreeMax(tree[0])
    in
      cons(getKey(node), getValue(node))
    end
  end
end

# 挿入
def insert_tree(tree, key, value)
  let rec
    iter = fn(node)
      if endp(node) then
        makeNode(key, value)
      else
        if (tree[1])(getKey(node), key) then
          putValue(node, value),
          node
        else
          if (tree[2])(key, getKey(node)) then
            putLeft(node, iter(getLeft(node)))
          else
            putRight(node, iter(getRight(node)))
          end,
          split(skew(node))
        end
      end
    end
  in
    tree[0] = iter(tree[0]),
    nil
  end
end

# バランスのチェック
def check_balance(node)
  if getHeight(getLeft(node)) < getHeight(node) - 1 or
     getHeight(getRight(node)) < getHeight(node) - 1 then
    decHeight(node),
    if getHeight(getRight(node)) > getHeight(node) then
      putHeight(getRight(node), getHeight(node))
    end,
    node = skew(node),
    putRight(node, skew(getRight(node))),
    putRight(getRight(node), skew(getRight(getRight(node)))),
    node = split(node),
    putRight(node, split(getRight(node)))
  end,
  node
end

# 最小値のノードを削除
def deleteTreeMin(node)
  if endp(getLeft(node)) then
    getRight(node)
  else
    putLeft(node, deleteTreeMin(getLeft(node))),
    check_balance(node)
  end
end

# 最大値のノードを削除
def deleteTreeMax(node)
  if endp(getRight(node)) then
    getLeft(node)
  else
    putRight(node, deleteTreeMax(getRight(node))),
    check_balance(node)
  end
end

# 最小値を削除
def delete_tree_min(tree)
  if endp(tree[0]) then
    nil
  else
    tree[0] = deleteTreeMin(tree[0]),
    nil
  end
end

# 最大値を削除
def delete_tree_max(tree)
  if endp(tree[0]) then
    nil
  else
    tree[0] = deleteTreeMax(tree[0]),
    nil
  end
end

# 削除
def delete_tree(tree, key)
  let rec
    iter = fn(node)
      if endp(node) then
        node
      else
        if (tree[1])(key, getKey(node)) then
          if endp(getLeft(node)) then
            getRight(node)
          else
            if endp(getRight(node)) then
              getLeft(node)
            else
              let
                minNode = searchTreeMin(getRight(node))
              in
                putKey(node, getKey(minNode)),
                putValue(node, getValue(minNode)),
                putRight(node, deleteTreeMin(getRight(node))),
                check_balance(node)
              end
            end
          end
        else
          if (tree[2])(key, getKey(node)) then
            putLeft(node, iter(getLeft(node)))
          else
            putRight(node, iter(getRight(node)))
          end,
          check_balance(node)
        end
      end
    end
  in
    tree[0] = iter(tree[0]),
    nil
  end
end

# 畳み込み
def fold_tree_right(f, a, tree)
  let rec
    iter = fn(node, a)
      if endp(node) then
        a
      else
        iter(getLeft(node),
             f(getKey(node), getValue(node), iter(getRight(node), a)))
      end
    end
  in
    iter(tree[0], a)
  end
end

def fold_tree_left(f, a, tree)
  let rec
    iter = fn(node, a)
      if endp(node) then
        a
      else
        iter(getRight(node),
             f(getKey(node), getValue(node), iter(getLeft(node), a)))
      end
    end
  in
    iter(tree[0], a)
  end
end

# 巡回
def foreach_tree(f, tree)
  let rec
    iter = fn(node)
      if not endp(node) then
        iter(getLeft(node)),
        f(getKey(node), getValue(node)),
        iter(getRight(node))
      end
    end
  in
    iter(tree[0])
  end
end

# list -> tree
def list_to_tree(eq, lt, ks, vs)
  foldl2(fn(k, v, a) insert_tree(a, k, v), a end, make_tree(eq, lt), ks, vs)
end

# tree -> list
def tree_to_list(tree)
  fold_tree_right(fn(k, v, a) cons(cons(k, v), a) end, nil, tree)
end

# debug 用表示ルーチン
def print_tree(tree)
  let rec
    iter = fn(node, x)
      if not endp(node) then
        iter(getLeft(node), x),
        let i = x - getHeight(node) in
          while i > 0 do
            print("  "), i = i - 1
          end,
          print(getKey(node)),
          print("\n")
        end,
        iter(getRight(node), x)
      end
    end
  in
    iter(tree[0], getHeight(tree[0])),
    print("\n")
  end
end

●８パズルの実行結果

AA 木を使うと、８パズルの実行時間は二分木よりも速くなります。

        | 二分木 | AA 木
--------+--------+-------
test1() | 49.6 s | 38.7 s
test2() | 50.2 s | 40.6 s

実行環境 : Windows 10, Intel Core i5-6200U 2.30GHz, SML/NJ ver 110.98

●ハッシュ表

ハッシュ表の詳しい説明は、拙作のページ「ハッシュ法」または Algorithms with Python 「ハッシュ法」をお読みください。

作成する関数と機能概要を下記に示します。

• make_hash(size, eq, hv)
  ハッシュ表を生成する。size はハッシュ表の大きさ、eq(x, y) はキー x, y が等しい場合に真を返す述語、hv はキーを数値に変換するハッシュ関数を指定する。
• search_hash(ht, key)
  ハッシュ表 ht からキー key を探索する。見つけた場合はその値を返す。見つからない場合は nil を返す。
• insert_hash(ht, key, value)
  ハッシュ表 ht にキー key とその値 vlaue を登録する。
• delete_hash(ht, key)
  ハッシュ表 ht からキー key とその値を削除する。
• hold_hash(f, a, ht)
  ハッシュ表 ht の畳み込みを行う。関数 f に渡される引数は順番にキー key, 値 value, 累積変数 a である。
• foreach_hash(f, ht)
  ハッシュ表 ht の要素に関数 f(k, v) を適用する。引数 k にキー、v に値が渡される。
• list_to_hash(size, eq, hv, ks, vs)
  リスト ks, vs からハッシュ表を生成する。ks はキーを格納したリスト、vs は値を格納したリスト、size, eq, hv は make_hash の引数と同じ。
• hash_to_list(ht)
  ハッシュ表 ht の要素をリストに格納して返す。要素はコンスセル (key . value) である。

簡単な使用例を示します。

Calc> h = make_hash(16, equal, fn(xs) foldl(fn(x, a) a * 10 + x end, 0, xs) end);
[[(), (), (), (), (), (), (), (), (), (), (), (), (), (), (), ()], <Function>, 
<Function>]
Calc> insert_hash(h, [1,2,3], 1);
(([1, 2, 3] . 1))
Calc> insert_hash(h, [4,5,6], 2);
(([4, 5, 6] . 2))
Calc> insert_hash(h, [7,8,9], 3);
(([7, 8, 9] . 3))
Calc> insert_hash(h, [10,11,12], 4);
(([10, 11, 12] . 4))
Calc> insert_hash(h, [13,14,15], 5);
(([13, 14, 15] . 5))
Calc> h;
[[(), (), (([10, 11, 12] . 4)), (), (), (([7, 8, 9] . 3)), (), (), (([4, 5, 6] .
 2)), (), (), (([1, 2, 3] . 1)), (), (), (), (([13, 14, 15] . 5))], 
<Function>,<Function>]
Calc> search_hash(h, [1,2,3]);
1
Calc> search_hash(h, [13,14,15]);
5
Calc> search_hash(h, [3,2,1]);

Calc> delete_hash(h, [1,2,3]);

Calc> search_hash(h, [1,2,3]);

Calc> delete_hash(h, [4,5,6]);

Calc> search_hash(h, [4,5,6]);

Calc> h;
[[(), (), (([10, 11, 12] . 4)), (), (), (([7, 8, 9] . 3)), (), (), (), (), (), 
(), (), (), (), (([13, 14, 15] . 5))], <Function>, <Function>]
Calc> h1 = list_to_hash(16, fn(x, y) x == y end, fn(x) x end,
list(10,20,30,40,50,60), list(1,2,3,4,5,6));
[[(), (), ((50 . 5)), (), ((20 . 2)), (), (), (), ((40 . 4)), (), ((10 . 1)), (),
 ((60 . 6)), (), ((30 . 3)), ()], <Function>, <Function>]
Calc> hash_to_list(h1);
((30 . 3) (60 . 6) (10 . 1) (40 . 4) (20 . 2) (50 . 5))
Calc> foreach_hash(fn(k, v) print(cons(k, v)) end, h1);
(50 . 5)(20 . 2)(40 . 4)(10 . 1)(60 . 6)(30 . 3)
Calc> fold_hash(fn(k, v, a) cons(cons(k, v), a) end, nil, h1);
((30 . 3) (60 . 6) (10 . 1) (40 . 4) (20 . 2) (50 . 5))

●プログラムリスト

#
# hash.cal : ハッシュ表
#
#            Copyright (C) 2012-2021 Makoto Hiroi
#

# ハッシュ表の生成
def make_hash(size, eq, hv)
  [makeVector(size, nil), eq, hv]
end

# ハッシュ表の位置を求める
def getIndex(ht, key)
  (ht[2])(key) % len(ht[0])
end

# 探索
def search_hash(ht, key)
  let
    v = find(fn(x) (ht[1])(car(x), key) end, ht[0][getIndex(ht, key)])
  in
    if null(v) then nil else cdr(v) end
  end
end

# 挿入
def insert_hash(ht, key, value)
  let rec
    idx, v = getIndex(ht, key),
             find(fn(x) (ht[1])(car(x), key) end, ht[0][idx])
  in
    if null(v) then
      ht[0][idx] = cons(cons(key, value), ht[0][idx])
    else
      setCdr(v, value)
    end
  end
end

# 削除
def delete_hash(ht, key)
  let
    idx = getIndex(ht, key)
  in
     ht[0][idx] = remove(fn(x) (ht[1])(car(x), key) end, ht[0][idx])
  end
end

# 畳み込み
def fold_hash(f, a, ht)
  foldl(fn(xs, b) foldl(fn(x, c) f(car(x), cdr(x), c) end, b, xs) end, a, ht[0])
end

# 巡回
def foreach_hash(f, ht)
  foreach(fn(xs) foreach(fn(x) f(car(x), cdr(x)) end, xs) end, ht[0])
end

# list -> hash
def list_to_hash(size, eq, hv, ks, vs)
  foldl2(fn(k, v, a) insert_hash(a, k, v), a end, make_hash(size, eq, hv), ks, vs)
end

# hash -> list
def hash_to_list(ht)
  fold_hash(fn(k, v, a) cons(cons(k, v), a) end, nil, ht)
end

●ハッシュ表による「８パズル」の解法

ハッシュ表を使った８パズルの解法プログラムを示します。

リスト : ハッシュ表を使った８パズルの解法

def solve8(start, goal)
  callcc(fn(exit)
    let
      q = makeQueue(),
      # 262144, 262147
      a = make_hash(262147, fn(x, y) x == y end, fn(x) x end),
      g = boardtoNum(goal)
    in
      insert_hash(a, boardtoNum(start), 1),
      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 rec
                s1, n = list(makeBoard(getBoard(s0), getSpace(s0), x), s0, x),
                        boardtoNum(getBoard(s1))
              in
                if n == g then
                  printAnswer(s1),
                  exit(nil)
                else
                  if not search_hash(a, n) then
                    insert_hash(a, n, 1),
                    enqueue(q, s1)
                  end
                end
              end
            end,
            adjacent[getSpace(s0)]
          )
        end
      end
    end
  end)
end

実行結果は次のようになりました。

        | 二分木 | AA 木  | Hash
--------+--------+--------+-------
test1() | 49.6 s | 38.7 s | 15.2 s
test2() | 50.2 s | 40.6 s | 15.6 s

実行環境 : Windows 10, Intel Core i5-6200U 2.30GHz, SML/NJ ver 110.98