前回はレコード型を使って二分木 (binary tree) のプログラムを作りました。今回はベクタを使ったデータ構造として、「ヒープ (heap)」と「ハッシュ法 (hashing)」を取り上げます。
「ヒープ (heap)」は「半順序木 (partial ordered tree)」をベクタで実現したデータ構造です。一般的な二分木では、親よりも左側の子のほうが小さく、親よりも右側の子が大きい、という関係を満たすように作ります。「半順序木」の場合、親は子より小さいか等しい、という関係を満たすように作ります。したがって、木の根（ベクタの添字 0）には、必ず最小値のデータが格納されます。下図にヒープとベクタの関係を示します。
0 1 2 3 4 5 6
TABLE [10 20 30 40 50 60 70]
(root)
10 (0)
／ ＼ 親の添字を k とすると
／ ＼ その子は 2*k+1, 2*k+2 になる。
20 (1) 30 (2) 子の添字を k とすると
／ ＼ ／ ＼ その親は (k - 1) / 2 になる。
40 50 60 70 親の値 <= 子の値 の関係を満たす。
(3) (4) (5) (6)
図 : ヒープとベクタの対応関係
ヒープを利用すると、最小値をすぐに見つけることができ、新しくデータを挿入する場合も、高々要素の個数 (n) の対数 (log2 n) に比例する程度の時間で済みます。
ヒープは、次の手順で作ることができます。
TABLE [＊ ＊ ＊ ＊ ＊ ＊ ＊ ＊ ＊ ＊] 最初は空
[80 ＊ ＊ ＊ ＊ ＊ ＊ ＊ ＊ ＊] 最初のデータをセット
[80 10 ＊ ＊ ＊ ＊ ＊ ＊ ＊ ＊] 次のデータをセットし親と比較
親 子 親の位置 0 = (1 - 1)/2
[10 80 ＊ ＊ ＊ ＊ ＊ ＊ ＊ ＊] 順序が違っていたら交換
[10 80 60 ＊ ＊ ＊ ＊ ＊ ＊ ＊] データをセットし比較
親 子 親の位置 0 = (2 - 1)/2
[10 80 60 20 ＊ ＊ ＊ ＊ ＊ ＊] データをセットし比較
親 子 親の位置 1 = (3 - 1)/2
[10 20 60 80 ＊ ＊ ＊ ＊ ＊ ＊] 交換する
・・・・データがなくなるまで繰り返す・・・・
図 : ヒープの構築 (1)
まず、データを最後尾に追加します。そして、このデータがヒープの条件を満たしているかチェックします。もしも、条件を満たしていなければ、親と子を入れ換えて、次の親をチェックします。これを木のルート方向 (添字 0 の方向) に向かって繰り返します。条件を満たすか、木のルート (添字 0) まで到達すれば、処理を終了します。これをデータの個数だけ繰り返します。
このアルゴリズムを Scheme でプログラムします。まず最初にヒープを定義します。
リスト : ヒープの定義 (define-record-type Heap (create-heap buff size comp) heap? (buff buff) (size size set-size!) (comp comp)) ;;; ヒープの生成 (define (make-heap n comp) (create-heap (make-vector n #f) 0 comp))
レコード型の名前は Heap としました。コンストラクタは create-heap で、フィールド変数 buff にベクタ本体を、size にはデータ数を、comp には比較関数をセットします。(comp x y) は x < y ならば負の値、x = y ならば 0 を、x > y ならば正の値を返すものとします。ヒープの生成は関数 make-heap で行います。make-vector で大きさ n のベクタを生成して、それを create-heap に渡します。
次はヒープを操作するときに使用する作業用の関数を定義します。
リスト : 作業用関数
;;; 要素の取得
(define (heap-ref hp n) (vector-ref (buff hp) n))
;;; 要素の書き換え
(define (heap-set! hp n x) (vector-set! (buff hp) n x))
;;; 要素の交換
(define (swap hp i j)
(let ((temp (heap-ref hp i)))
(heap-set! hp i (heap-ref hp j))
(heap-set! hp j temp)))
;;; 要素の比較
(define (obj=? hp i j)
(zero? ((comp hp) (heap-ref hp i) (heap-ref hp j))))
(define (obj>? hp i j)
(positive? ((comp hp) (heap-ref hp i) (heap-ref hp j))))
heap-ref は buff の n 番目の要素を取得し、heap-set! は buff の n 番目の要素をの値を x に書き換えます。swap は buff の i 番目と j 番目の要素を交換します。obj=? と obj>? は buff の i 番目と j 番目の要素を比較します。
これらの関数を使うと、ヒープを構築する関数 upheap は次のようになります。
リスト : ヒープの構築
(define (upheap hp n)
(let ((p (quotient (- n 1) 2)))
(when
(and (<= 0 p) (obj>? hp p n))
(swap hp p n)
(upheap hp p))))
関数 upheap はヒープを満たすように n 番目の要素をルート方向に向かって移動させます。0 から n - 1 番目までの要素はヒープの条件を満たしているものとします。n の親を p とすると、p は (n - 1) / 2 で求めることができます。そして、p が 0 以上で、かつ p の要素が n の要素よりも大きいのであれば、p と n の要素を交換して次の親子関係をチェックします。そうでなければ、ヒープの条件を満たしているので処理を終了します。
あとは、buff の最後尾にデータを追加して、upheap を呼び出せばいいわけです。また、データが格納されているベクタでも、次のように upheap を適用してヒープを構築することができます。
リスト : ヒープの構築 (let loop ((n 1)) (when (< n (size hp)) ; hp はヒープ (upheap hp n) (loop (+ n 1)))))
ただし、この方法はデータ数を N とすると upheap を N - 1 回呼び出すため、それほど速い方法ではありません。もう少し高速な方法はあとで説明することにしましょう。
次に、最小値を取り出したあとで新しいデータを追加し、ヒープを再構築する手順を説明します。
TABLE [10 20 30 40 50 60 70 80 90 100] ヒープを満たしている
[＊ 20 30 40 50 60 70 80 90 100] 最小値を取り出す
[66 20 30 40 50 60 70 80 90 100] 新しい値をセット
[66 20 30 40 50 60 70 80 90 100] 小さい子と比較する
^ ^ (2*0+1) < (2*0+2)
親 子 子
[20 66 30 40 50 60 70 80 90 100] 交換して次の子と比較
^ ^ (2*1+1) < (2*1+2)
親 子 子
[20 40 30 66 50 60 70 80 90 100] 交換して次の子と比較
^ ^ (2*3+1) < (2*3+2)
親 子 子 親が小さいから終了
図 : ヒープの再構築
最初に、ヒープの最小値である添字 0 の位置にあるデータを取り出します。次に、その位置に新しいデータをセットし、ヒープの条件を満たしているかチェックします。ヒープの構築とは逆に、葉の方向 (添字の大きい方向) に向かってチェックしていきます。
まず、2 つの子の中で小さい方の子を選び、それと挿入したデータを比較します。もしも、ヒープの条件を満たしていなければ、親と子を交換して、その次の子と比較します。この処理を、ヒープの条件を満たすか子がなくなるまで繰り返します。
このアルゴリズムを Scheme でプログラムすると次のようになります。
リスト : ヒープの再構築
(define (downheap hp n)
(let ((c (+ (* n 2) 1)))
(when
(< c (size hp))
(when
(and (< (+ c 1) (size hp)) (obj>? hp c (+ c 1)))
(set! c (+ c 1)))
(when
(obj>? hp n c)
(swap hp n c)
(downheap hp c)))))
関数 downheap は、ヒープ hp が条件を満たすように、n 番目の要素を葉の方向へ移動させます。n + 1 番目から最後までの要素はヒープの条件を満たしているものとします。最初に、n の子 c を求めます。これが (size hp) 以上であれば処理を終了します。もう一つの子 (c + 1) がある場合は、値が小さい方を選択します。そして、n の要素が c の要素よりも大きい場合はヒープの条件を満たしていないので、n 番目と c 番目の要素を交換して処理を繰り返します。
なお、最小値を取り出したあと新しいデータを挿入しない場合は、新しいデータのかわりにベクタ buff の最後尾のデータを先頭にセットしてヒープを再構築します。上図の例でいえば、100 を buff の 0 番目にセットして、ヒープを再構築すればいいわけです。この場合、ヒープに格納されているデータの個数は一つ減ることになります。
ところで、N 個のデータをヒープに構築する場合、N - 1 回 upheap を呼び出さなければいけません。ところが、すべてのデータをベクタに格納したあとで、ヒープを構築するうまい方法があります。次の図を見てください。
TABLE [100 90 80 70 60|50 40 30 20 10] 後ろ半分が葉に相当
[100 90 80 70|60 50 40 30 20 10] 60 を挿入する
^
[100 90 80 70|60 50 40 30 20 10] 子供と比較する
^ ^ (2*4+1), (2*4+2)
親 子
[100 90 80 70|10 50 40 30 20 60] 交換する
・・・ 70 80 90 を順番に挿入し修正する ・・・
[100|10 40 20 60 50 80 30 70 90] 90 を挿入し修正した
[100 10 40 20 60 50 80 30 70 90] 100 を挿入、比較
^ ^ ^ (2*0+1), (2*0+2)
親 子 子
[10 100 40 20 60 50 80 30 70 90] 小さい子と交換し比較
^ ^ ^ (2*1+1), (2*1+2)
親 子 子
[10 20 40 100 60 50 80 30 70 90] 小さい子と交換し比較
^ ^ ^ (2*3+1), (2*3+2)
親 子 子
[10 20 40 30 60 50 80 100 70 90] 交換して終了
図 : ヒープの構築 (2)
ベクタを前半と後半の 2 つに分けると、後半部分はデータがつながっていない葉の部分になります。つまり、後半部分の要素は互いに関係がなく、前半部分の親にあたる要素と関係しているだけなのです。したがって、後半部分だけを見れば、それはヒープを満たしていると考えることができます。
あとは、前半部分の要素に対して、葉の方向に向かってヒープの関係を満たすよう修正していけば、ベクタ全体がヒープを満たすことになります。この処理は関数 downheap を使うと次のようになります。
リスト : ヒープの構築 (2) (let loop ((n (- (quotient (size hp) 2) 1))) ; hp はヒープ (when (<= 0 n) (downheap hp n) (loop (- n 1)))))
後ろからヒープを再構築していくと考えるとわかりやすいでしょう。この方法の場合、要素 N の配列に対して、N / 2 個の要素の修正を行えばよいので、最初に説明したヒープの構築方法よりも少し速くなります。
それでは、ヒープを使って「優先度つき待ち行列 (priority queue)」を作ってみましょう。一般に、キューは先入れ先出し (FIFO : first-in, first-out) のデータ構造です。キューからデータを取り出すときは、先に挿入されたデータから取り出されます。これに対し、優先度つき待ち行列は、データに優先度をつけておいて、優先度の高いデータから取り出していきます。
優先度つき待ち行列は、優先度を基準にヒープを構築することで実現できます。今回のプログラムで作成する処理を示します。
メソッド名は enqueue!, dequeue! としてもよかったのですが、このプログラムでは heap-push!, heap-pop! としました。また、データを追加する関数を insert とし、最小値を取り出す関数を delete-min としている教科書もあります。
プログラムは次のようになります。
リスト : プライオリティーキューの操作
;;; データの追加
(define (heap-push! hp x)
(unless
(heap-full? hp)
(heap-set! hp (size hp) x)
(upheap hp (size hp))
(set-size! hp (+ (size hp) 1))))
;;; データの削除
(define (heap-pop! hp)
(unless
(heap-empty? hp)
(let ((item (heap-peek! hp)))
(set-size! hp (- (size hp) 1))
(unless
(heap-empty? hp)
(heap-set! hp 0 (heap-ref hp (size hp)))
(heap-set! hp (size hp) #f)
(downheap hp 0))
item)))
;;; 変換
(define (list->heap xs comp)
(let ((hp (create-heap (list->vector xs) (length xs) comp)))
(let loop ((n (- (quotient (size hp) 2) 1)))
(when
(<= 0 n)
(downheap hp n)
(loop (- n 1))))
hp))
heap-push! は buff の最後尾にデータをセットして upheap を呼び出します。heap-pop! は buff の先頭の要素を item に取り出して、データが残っていれば最後尾のデータを先頭に移して、downheap でヒープを再構築します。list->heap は引数のリスト xs を list->vector でベクタに変換し、それを create-heap に渡してヒープを生成します。あとはベクタの前半部分に downheap を適用してヒープを構築します。
あとのプログラムは簡単なので説明は割愛します。詳細はプログラムリスト１をお読みください。
それでは簡単な実行例を示しましょう。
リスト : 簡単なテスト
(define a (make-heap 10 (lambda (x y) (- x y))))
(for-each
(lambda (x) (heap-push! a x))
'(5 6 4 7 3 8 2 9 1 0))
(do ()
((heap-empty? a))
(display (heap-pop! a))
(newline))
(define b (list->heap '(9 8 7 6 5 4 3 2 1 0) (lambda (x y) (- x y))))
(do ()
((heap-empty? b))
(display (heap-pop! b))
(newline))
$ gosh heap.scm 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9
このように、ヒープを使うと小さなデータから順番に取り出していくことができます。
;;;
;;; heap.scm : プライオリティキュー (ヒープ)
;;;
;;; Copyright (C) 2008-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write))
;;; ヒープの定義
(define-record-type Heap
(create-heap buff size comp)
heap?
(buff buff)
(size size set-size!)
(comp comp))
;;; ヒープの生成
(define (make-heap n comp)
(create-heap (make-vector n #f) 0 comp))
;;; 要素の取得
(define (heap-ref hp n) (vector-ref (buff hp) n))
;;; 要素の書き換え
(define (heap-set! hp n x) (vector-set! (buff hp) n x))
;;; 要素の交換
(define (swap hp i j)
(let ((temp (heap-ref hp i)))
(heap-set! hp i (heap-ref hp j))
(heap-set! hp j temp)))
;;; 要素の比較
(define (obj=? hp i j)
(zero? ((comp hp) (heap-ref hp i) (heap-ref hp j))))
(define (obj>? hp i j)
(positive? ((comp hp) (heap-ref hp i) (heap-ref hp j))))
;;; ヒープの構築
(define (upheap hp n)
(let ((p (quotient (- n 1) 2)))
(when
(and (<= 0 p) (obj>? hp p n))
(swap hp p n)
(upheap hp p))))
;;; ヒープの再構築
(define (downheap hp n)
(let ((c (+ (* n 2) 1)))
(when
(< c (size hp))
(when
(and (< (+ c 1) (size hp)) (obj>? hp c (+ c 1)))
(set! c (+ c 1)))
(when
(obj>? hp n c)
(swap hp n c)
(downheap hp c)))))
;;; 空か？
(define (heap-empty? hp) (zero? (size hp)))
;;; 満杯か？
(define (heap-full? hp)
(= (size hp) (vector-length (buff hp))))
;;; データの追加
(define (heap-push! hp x)
(unless
(heap-full? hp)
(heap-set! hp (size hp) x)
(upheap hp (size hp))
(set-size! hp (+ (size hp) 1))))
;;; データの取得
(define (heap-peek! hp) (heap-ref hp 0))
;;; データの削除
(define (heap-pop! hp)
(unless
(heap-empty? hp)
(let ((item (heap-peek! hp)))
(set-size! hp (- (size hp) 1))
(unless
(heap-empty? hp)
(heap-set! hp 0 (heap-ref hp (size hp)))
(heap-set! hp (size hp) #f)
(downheap hp 0))
item)))
;;; 変換
(define (list->heap xs comp)
(let ((hp (create-heap (list->vector xs) (length xs) comp)))
(let loop ((n (- (quotient (size hp) 2) 1)))
(when
(<= 0 n)
(downheap hp n)
(loop (- n 1))))
hp))
;;; 簡単なテスト
(define a (make-heap 10 (lambda (x y) (- x y))))
(for-each
(lambda (x) (heap-push! a x))
'(5 6 4 7 3 8 2 9 1 0))
(do ()
((heap-empty? a))
(display (heap-pop! a))
(newline))
(define b (list->heap '(9 8 7 6 5 4 3 2 1 0) (lambda (x y) (- x y))))
(do ()
((heap-empty? b))
(display (heap-pop! b))
(newline))
次は高速な探索アルゴリズムである「ハッシュ法 (hashing)」を取り上げます。ハッシュ法はコンパイラやインタプリタなどで、予約語、関数名、変数名などの管理に使われている方法です。また、Perl, Python, Ruby など連想配列 (辞書) をサポートしているスクリプト言語では、その実装にハッシュ法が使われています。
ハッシュ法は、設計をうまく行えば 1 回の比較でデータを見つけることができます。実際、コンパイラの予約語のように探索するデータが固定されている場合は、そのように設計することが可能です。不特定多数のデータが探索対象になる場合は、すべてのデータを 1 回の比較で見つけることはできませんが、うまく設計すれば数回程度の比較でデータを見つけることができるようになります。
Gauche には組み込みライブラリに「ハッシュテーブル」がありますが、今回はアルゴリズムの勉強としてハッシュ法のプログラムを作ってみましょう。
ハッシュ法は「ハッシュ表 (hash table)」と呼ばれるデータを格納するベクタと、データを数値に変換する「ハッシュ関数 (hash function)」を用意します。たとえば、ハッシュ表の大きさを M とすると、ハッシュ関数はデータを 0 から M - 1 までの整数値に変換します。この値を「ハッシュ値 (hash value)」と呼びます。ハッシュ値はハッシュ表の添字に対応し、この位置にデータを格納します。つまり、ハッシュ関数によってデータを格納する位置を決める探索方法がハッシュ法なのです。
ハッシュ法で不特定多数のデータを扱う場合、異なるデータでも同じハッシュ値が生成される可能性があります。これをハッシュ値の「衝突 (collision)」といいます。つまり、データをハッシュ表に登録しようとしても、すでに先客が居座っているわけです。この場合、2 種類の解決方法があります。
第 1 の方法はハッシュ表に複数のデータを格納することです。ベクタの要素には一つのデータしか格納できないので、複数個のデータをまとめて格納する工夫が必要になります。このときよく利用されるデータ構造が「リスト」です。ハッシュ表からデータを探索する場合、まずハッシュ値を求め、そこに格納されているリストの中からデータを探索します。これを「チェイン法 (chaining)」といいます。なお、リストのほかに二分木を使う方法もあります。
第 2 の方法は空いている場所を探して、そこにデータを格納する方法です。この場合、最初とは違うハッシュ関数を用意して、新しいハッシュ値を計算して場所を決めます。この処理を空いている場所が見つかるまで繰り返します。空き場所が見つからない場合、つまりハッシュ表が満杯の場合はデータを挿入することはできません。この方法を「オープンアドレス法 (open addressing)」といいます。
今回は Lisp / Scheme で簡単に操作できるチェイン法でプログラムを作りましょう。オープンアドレス法は、拙作のページ Algorithms with Python「ハッシュ法」で詳しく説明しています。興味のある方はお読みください。
チェイン法の場合、ハッシュ表にはデータをそのまま格納しないでリストに格納します。ハッシュ表からデータを探索する場合、まずハッシュ値を求め、そこに格納されているリストの中からデータを探索します。
簡単な例を示しましょう。次の図を見てください。
hash value 0 1 2 3 4 5 6 HASH TABLE 0 [ ] -> (O H A)
-------------------------- 1 [ ] -> (B)
A B C D E F G 2 [ () ]
H I J K L M N 3 [ ] -> (Y D)
O P Q R S T U 4 [ () ]
V W X Y Z 5 [ ] -> (M F)
6 [ ] -> (G)
図 : チェイン法
たとえば、上図のようにハッシュ関数とハッシュ表が構成されているとします。データ A の場合、ハッシュ値は 0 なのでハッシュ表の 0 の位置に格納されているリストを探索します。A はリストの中に登録されているので探索は成功です。
データ C の場合、ハッシュ値は 2 ですが、ハッシュ表の要素は空リストなので探索は失敗です。データ U の場合、ハッシュ値は 6 ですが、連結リストの中に U が登録されていないので探索は失敗です。
ところで、チェイン法はハッシュ値の衝突が頻繁に発生すると、データを格納するリストが長くなるので、探索に時間がかかることになります。効率良く探索するには、うまくハッシュ値を分散させることが必要になります。
それでは、チェイン法のプログラムを作りましょう。今回のプログラムではキーと値を組にしてハッシュ表に登録することにします。この場合、連想リストにすると簡単です。CAR 部がキーで CDR 部が値とします。これでデータの探索に関数 assoc を使うことができます。
まず最初にハッシュ表を定義します。
リスト : ハッシュ表の定義 (define-record-type Hash (create-hash hash-table hash-func hash-test) hash? (hash-table hash-table) (hash-func hash-func) (hash-test hash-test)) ;;; ハッシュ表の生成 (define (make-hash-table size func test?) (create-hash (make-vector size '()) (lambda (x) (modulo (func x) size)) test?)) ;;; ハッシュ表のアクセス (define (hash-table-ref ht n) (vector-ref (hash-table ht) n)) (define (hash-table-set! ht n x) (vector-set! (hash-table ht) n x))
レコード名は Hash としました。コンストラクタは create-hash で、フィールド hash-table にベクタ (ハッシュ表本体) を、hash-func にハッシュ関数を、hash-test に等値を判定する述語を格納します。
ハッシュ表の生成は関数 make-hash-table で行います。大きさ size で初期値が空リストのベクタを make-vector で生成して create-hash に渡します。
ハッシュ関数は引数 func をそのまま使うのではありません。関数 func を呼び出して size との剰余を計算するラムダ式をハッシュ関数として使います。ところで、参考文献『Ｃ言語による最新アルゴリズム事典』ではハッシュ表の大きさを M とすると、『M を素数にしておくと安心である』 とのことです。
引数 test? は等値を判定する述語です。これはそのまま create-hash に渡します。あと、作業用の関数として hash-table のアクセス関数 hash-table-ref と hash-table-set! を用意しておきます。
今回のプログラムで実装する処理は次の 4 つです。
それでは関数 hash-find から作りましょう。次のリストを見てください。
リスト : データの探索
(define (hash-find ht key)
(let ((pair (assoc key
(hash-table-ref ht ((hash-func ht) key))
(hash-test ht))))
(and pair (cdr pair))))
関数 assoc で key と等しい CAR 部を持つ要素を探します。ハッシュ関数 (hash-func ht) に key を渡してハッシュ値を求め、hash-table-ref で hash-table からリストを取り出します。R7RS-small の assoc は第 3 引数に等値を判定する述語を渡すことができます。見つけた場合は、コンスセル cell の CDR 部に格納された値を返します。そうでなければ #f を返します。
次はハッシュ表にデータを挿入する関数 hash-set! を作ります。
リスト : データの挿入
(define (hash-set! ht key value)
(let ((i ((hash-func ht) key)))
(hash-table-set! ht
i
(cons (cons key value)
(hash-table-ref ht i)))))
最初にハッシュ関数 (hash-func ht) でハッシュ値を計算し、それを変数 i にセットします。あとは、hash-table の i 番目の連想リストの先頭に (key . value) を追加するだけです。関数 assoc は連想リストを先頭から線形探索するので、先頭に (key . value) を追加するだけで、以前に登録したキーの値を更新することができます。ただし、キーの値を更新するたびに古い値が残されるので効率的ではありません。興味のある方は、同じキーがあるときは値を書き換えるようにプログラムを改良してみてください。
データを削除する関数 hash-delete! も簡単です。次のリストを見てください。
リスト : データの削除
(define (alist-delete key xs pred)
(cond
((null? xs) '())
((pred key (caar xs))
(alist-delete key (cdr xs) pred))
(else
(cons (car xs)
(alist-delete key (cdr xs) pred)))))
(define (hash-delete! ht key)
(let ((i ((hash-func ht) key)))
(hash-table-set! ht i (alist-delete key (hash-table-ref ht i) (hash-test ht)))))
関数 alist-delete は SRFI-1 に定義されている関数ですが、今回は自分で作りました。alist-delete は連想リスト xs の中から key と等しいキーを持つ要素をすべて削除します。あとは alist-delete の返り値をハッシュ表にセットするだけです。
最後に、ハッシュ表に登録されているすべての要素に関数 fn を適用する hash-for-each を作ります。
リスト : 巡回
(define (hash-for-each fn ht)
(vector-for-each
(lambda (xs)
(for-each (lambda (p) (fn (car p) (cdr p))) xs))
(hash-table ht)))
この処理も簡単です。vector-for-each で hash-table の先頭から順番にリストを取り出して for-each に渡し、その中のラムダ式で関数 fn を呼び出します。fn の第 1 引数がキーで、第 2 引数が値になります。
これでプログラムは完成です。簡単な実行例を示しましょう。キーは文字列とします。最初にハッシュ関数を定義します。
リスト : ハッシュ関数
;;; 畳み込み
(define (foldl fn a xs)
(if (null? xs)
a
(foldl fn (fn a (car xs)) (cdr xs))))
;;; 文字列用のハッシュ関数
(define (string-hash-func str)
(foldl (lambda (a c) (+ a (char->integer c))) 0 (string->list str)))
関数 string-hash-func は文字列の文字を数値に変換してその合計値を求めます。関数 string->list は文字列をリストに変換する関数です。リストの要素は文字になります。関数 char->integer は文字を数値に変換する関数です。あとは foldl で合計値を求めるだけです。単純な関数ですが、ハッシュ表のサイズが大きくなければ、それなりの効果を発揮します。なお、文字列のハッシュ関数はいろいろ考案されているので、興味のある方は調べてみてください。
次に示す簡単なテストを実行してみました。
リスト : 簡単なテスト
;;; ハッシュ表の表示 (デバッグ用)
(define (print-hash ht)
(hash-for-each
(lambda (k v) (display "(") (display k) (display ",") (display v) (display ")"))
ht)
(newline))
(define a (make-hash-table 13 string-hash-func equal?))
(hash-set! a "foo" 1)
(hash-set! a "bar" 2)
(hash-set! a "baz" 3)
(hash-set! a "oops" 4)
(print-hash a)
(for-each
(lambda (k)
(display k) (display ": ") (display (hash-find a k)) (newline))
'("foo" "bar" "baz" "oops" "foo!" "oops!"))
(hash-set! a "foo" 10)
(hash-set! a "bar" 20)
(hash-set! a "baz" 30)
(hash-set! a "oops" 40)
(print-hash a)
(for-each
(lambda (k)
(display k) (display ": ") (display (hash-find a k)) (newline))
'("foo" "bar" "baz" "oops" "foo!" "oops!"))
(for-each
(lambda (k)
(display "delete: ") (display k) (display " ") (hash-delete! a k) (print-hash a))
'("foo!" "foo" "bar" "baz" "oops!" "oops"))
$ gosh hash.scm (baz,3)(oops,4)(bar,2)(foo,1) foo: 1 bar: 2 baz: 3 oops: 4 foo!: #f oops!: #f (baz,30)(baz,3)(oops,40)(oops,4)(bar,20)(bar,2)(foo,10)(foo,1) foo: 10 bar: 20 baz: 30 oops: 40 foo!: #f oops!: #f delete: foo! (baz,30)(baz,3)(oops,40)(oops,4)(bar,20)(bar,2)(foo,10)(foo,1) delete: foo (baz,30)(baz,3)(oops,40)(oops,4)(bar,20)(bar,2) delete: bar (baz,30)(baz,3)(oops,40)(oops,4) delete: baz (oops,40)(oops,4) delete: oops! (oops,40)(oops,4) delete: oops
正常に動作しているようです。興味のある方はいろいろ試してみてください。
;;;
;;; hash.scm : ハッシュ表
;;;
;;; Copyright (C) 2008-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write))
;;; ハッシュ表
(define-record-type Hash
(create-hash hash-table hash-func hash-test)
hash?
(hash-table hash-table)
(hash-func hash-func)
(hash-test hash-test))
;;; ハッシュ表の生成
(define (make-hash-table size func test?)
(create-hash (make-vector size '()) (lambda (x) (modulo (func x) size)) test?))
;;; ハッシュ表のアクセス
(define (hash-table-ref ht n) (vector-ref (hash-table ht) n))
(define (hash-table-set! ht n x) (vector-set! (hash-table ht) n x))
;;; 探索
(define (hash-find ht key)
(let ((pair (assoc key
(hash-table-ref ht ((hash-func ht) key))
(hash-test ht))))
(and pair (cdr pair))))
;;; 挿入
(define (hash-set! ht key value)
(let ((i ((hash-func ht) key)))
(hash-table-set! ht
i
(cons (cons key value)
(hash-table-ref ht i)))))
;;; 削除
(define (alist-delete key xs pred)
(cond
((null? xs) '())
((pred key (caar xs))
(alist-delete key (cdr xs) pred))
(else
(cons (car xs)
(alist-delete key (cdr xs) pred)))))
(define (hash-delete! ht key)
(let ((i ((hash-func ht) key)))
(hash-table-set! ht i (alist-delete key (hash-table-ref ht i) (hash-test ht)))))
;;; 巡回
(define (hash-for-each fn ht)
(vector-for-each
(lambda (xs)
(for-each (lambda (p) (fn (car p) (cdr p))) xs))
(hash-table ht)))
;;; ハッシュ表の表示 (デバッグ用)
(define (print-hash ht)
(hash-for-each
(lambda (k v) (display "(") (display k) (display ",") (display v) (display ")"))
ht)
(newline))
;;;
;;; 簡単なテスト
;;;
;;; 畳み込み
(define (foldl fn a xs)
(if (null? xs)
a
(foldl fn (fn a (car xs)) (cdr xs))))
;;; 文字列用のハッシュ関数
(define (string-hash-func str)
(foldl (lambda (a c) (+ a (char->integer c))) 0 (string->list str)))
(define a (make-hash-table 13 string-hash-func equal?))
(hash-set! a "foo" 1)
(hash-set! a "bar" 2)
(hash-set! a "baz" 3)
(hash-set! a "oops" 4)
(print-hash a)
(for-each
(lambda (k)
(display k) (display ": ") (display (hash-find a k)) (newline))
'("foo" "bar" "baz" "oops" "foo!" "oops!"))
(hash-set! a "foo" 10)
(hash-set! a "bar" 20)
(hash-set! a "baz" 30)
(hash-set! a "oops" 40)
(print-hash a)
(for-each
(lambda (k)
(display k) (display ": ") (display (hash-find a k)) (newline))
'("foo" "bar" "baz" "oops" "foo!" "oops!"))
(for-each
(lambda (k)
(display "delete: ") (display k) (display " ") (hash-delete! a k) (print-hash a))
'("foo!" "foo" "bar" "baz" "oops!" "oops"))