M.Hiroi's Home Page

Functional Programming

お気楽 Haskell プログラミング入門

[ PrevPage | Haskell | NextPage ]

二分探索木 (2)

今回は二分探索木の応用例として、連想リストのようにキーに対応する値を求める処理を作ってみましょう。

●連想配列とは?

一般に、キーと値を関連付けて格納するデータ構造を「連想配列」といいます。連想配列は多くのプログラミング言語でサポートされていて、プログラミング言語によっては、ハッシュ (hash), 辞書 (dictonary), マップ (map) などと呼ばれています。Haskell の場合、モジュール Data.Map が連想配列で、実装には平衡二分木が使われています。また、キーを整数値に限定したモジュール Data.IntMap もあります。平衡木のプログラムは難しいですが、単純な二分探索木であれば、私たちでも簡単にプログラムを作ることができます。

●データ型の定義

最初にデータ型を定義しましょう。

リスト : データ型の定義

data TreeMap k v = Nil | Node k v (TreeMap k v) (TreeMap k v) deriving Show

名前は TreeMap としました。型変数 k がキーを、v が値を表します。マップを二分探索木で実装する場合、節 Node に k と v の 2 つを格納するだけで、あとは前回作成したプログラムと同じ構造になります。

●データの挿入

次はデータを挿入する関数 insert を作ります。

リスト : データの挿入

-- 要素が一つの木
singleton :: k -> v -> TreeMap k v
singleton k v = Node k v Nil Nil

-- 挿入
insert :: Ord k => k -> v -> TreeMap k v -> TreeMap k v
insert x y Nil = singleton x y
insert x y (Node k v l r)
  | x == k    = Node x y l r
  | x < k     = Node k v (insert x y l) r
  | otherwise = Node k v l (insert x y r)

データの比較はキーを使って行うことに注意してください。したがって、型クラス制約は Ord k になります。値 v に型クラス制約は不要です。同じキーが見つかった場合、新しい値に置き換えることをお忘れなく。

●データの探索

次はキーから値を求める関数 search を作ります。

リスト : データの探索

search :: Ord k => k -> TreeMap k v -> Maybe v
search _ Nil = Nothing
search x (Node k v l r)
  | x == k    = Just v
  | x < k     = search x l
  | otherwise = search x r

等しいキーを見つけたら Just v を返します。見つからない場合は Nothing を返します。

●データの削除

次はキーと値を削除する関数 delete を作ります。

リスト : データの削除

delete :: Ord k => k -> TreeMap k v -> TreeMap k v
delete x Nil = Nil
delete x (Node k v l r)
  | x < k  = Node k v (delete x l) r
  | x > k  = Node k v l (delete x r)
  | x == k = delete' l r  where
      delete' Nil r = r
      delete' l Nil = l
      delete' l r = Node k' v' l (deleteMin r)
        where Just (k', v') = searchMin r

基本的には前回作成した関数 delete と同じです。木の途中にある節を削除する場合、searchMin で求めた右部分木の最小値のキーと値に置き換えて、deleteMin で最小値の節を削除します。

●データの変換

次は連想リストから TreeMap を生成する関数 fromList と、TreeMap を連想リストに変換する関数 toList を作ります。

リスト : データの変換

fromList :: Ord k => [(k, v)] -> TreeMap k v
fromList xs = foldl (\a (k, v) -> insert k v a) Nil xs

toList :: TreeMap k v -> [(k, v)]
toList tree = iter tree [] where
  iter Nil xs = xs
  iter (Node k v l r) xs = iter l ((k, v) : iter r xs)

fromList の引数の型は [(k, v)] です。あとは foldl で (k, v) を取り出して、insert で二分木に挿入していくだけです。toList の場合、返り値の型が [(k, v)] になります。二分木を通りがけ順で巡回して、タプル (k, v) を累積変数 xs に追加します。

●畳み込み

次は畳み込みを行う関数 fold_left と fold_right を作ります。

リスト : 畳み込み

fold_left :: (a -> (k, v) -> a) -> a -> TreeMap k v -> a
fold_left _ a Nil = a
fold_left f a (Node k v l r) = fold_left f (f (fold_left f a l) (k, v)) r

fold_right :: ((k, v) -> b -> b) -> b -> TreeMap k v -> b
fold_right _ a Nil = a
fold_right f a (Node k v l r) = fold_right f (f (k, v) (fold_right f a r)) l

今回はキーと値をタプルに格納して関数に渡すことにします。したがって、fold_left に渡す関数の型は a -> (k, v) -> a となり、fold_right の場合は (k, v) -> b -> b になります。

あとは特に難しいところはないと思います。説明は割愛しますので、詳細は プログラムリスト1 をお読みください。

●実行例1

それでは簡単な実行例を示します。

*TreeMap> a = fromList $ zip ['d','b','a','c','f','e','g'] [1..7]
*TreeMap> a
Node 'd' 1 (Node 'b' 2 (Node 'a' 3 Nil Nil) (Node 'c' 4 Nil Nil)) (Node 'f' 5 (Node 'e' 6 Nil Nil)
 (Node 'g' 7 Nil Nil))
*TreeMap> toList a
[('a',3),('b',2),('c',4),('d',1),('e',6),('f',5),('g',7)]

*TreeMap> search 'a' a
Just 3
*TreeMap> search 'g' a
Just 7
*TreeMap> search 'c' a
Just 4
*TreeMap> searchMin a
Just ('a',3)
*TreeMap> searchMax a
Just ('g',7)

*TreeMap> delete 'd' a
Node 'e' 6 (Node 'b' 2 (Node 'a' 3 Nil Nil) (Node 'c' 4 Nil Nil)) (Node 'f' 5 Nil (Node 'g' 7 Nil Nil))
*TreeMap> delete 'c' a
Node 'd' 1 (Node 'b' 2 (Node 'a' 3 Nil Nil) Nil) (Node 'f' 5 (Node 'e' 6 Nil Nil) (Node 'g' 7 Nil Nil))
*TreeMap> foldl (flip delete) a ['a'..'g']
Nil

*TreeMap> fold_left (flip (:)) [] a
[('g',7),('f',5),('e',6),('d',1),('c',4),('b',2),('a',3)]
*TreeMap> fold_right (:) [] a
[('a',3),('b',2),('c',4),('d',1),('e',6),('f',5),('g',7)]
*TreeMap> keys = fold_right (\(k, _) a -> k:a) []
*TreeMap> keys a
"abcdefg"
*TreeMap> values = fold_right (\(_, v) a -> v:a) []
*TreeMap> values a
[3,2,4,1,6,5,7]

正常に動作していますね。

●Tree を使って TreeMap を実装する

今回は TreeMap を最初から実装しましたが、前回作成した二分木 Tree.hs を使ってマップを実装することもできます。次のリストを見てください。

リスト : データ型の定義

module TreeMap1 (
  TreeMap,
  insert, emptyTree, singleton,
  search, searchMin, searchMax,
  delete, deleteMin, deleteMax,
  toList, fromList, isEmptyTree,
  fold_left, fold_right
) where

import qualified Tree as T

-- データ型の定義
data Item k v = Item k v | Item' k deriving Show
type TreeMap k v = T.Tree (Item k v)

instance Eq k => Eq (Item k v) where
  (Item k1 _) == (Item k2 _) = k1 == k2
  (Item k1 _) == (Item' k2)  = k1 == k2
  (Item' k1)  == (Item k2 _) = k1 == k2
  (Item' k1)  == (Item' k2)  = k1 == k2

instance Ord k => Ord (Item k v) where
  (Item k1 _) `compare` (Item k2 _) = k1 `compare` k2
  (Item k1 _) `compare` (Item' k2)  = k1 `compare` k2
  (Item' k1)  `compare` (Item k2 _) = k1 `compare` k2
  (Item' k1)  `compare` (Item' k2)  = k1 `compare` k2

モジュール名は TreeMap1 としました。モジュール Tree を qualified 付きでインポートし、T という別名を付けます。プログラムのポイントは Tree に格納するデータ型を定義して、型クラス Eq と Ord のインスタンスにするところです。型 Item を定義すると、マップのデータ型は T.Tree (Item k v) で表すことができます。type 宣言を使って、このデータ型に別名 TreeMap を付けます。type 宣言についてはあとで説明します。

Item のデータ構築子には Item と Item' の 2 つを用意します。Item はキーと値を格納します。Item' はキーだけを格納します。これはデータの探索や削除をするときに使用し、二分木の中に格納されることはありません。もちろん、型構築子 Item とそのデータ構築子は「非公開」とします。

Eq と Ord のインスタンスにする場合、データの比較はキーだけで行います。Item だけではなく Item' との比較も必要になります。なお、今回のプログラムでは Item' 同士の比較は不要ですが、4 通りのパターンをすべて定義しています。これで二分木 Tree が動作します。

●type 宣言

type 宣言はデータ型 (型構築子) に別名を付ける機能です。たとえば、[Char] には String とう別名がありますが、これは type 宣言を使って次のように定義されています。

type String = [Char]

type 宣言で型変数を使ってもかまいません。今回の TreeMap は、キーを表す型変数 k と値を表す型変数 v を使って定義しています。

type TreeMap k v = T.Tree (Item k v)

TreeMap を使ってキーの型を特定したマップも簡単に定義することができます。

type IntegerMap v = TreeMap Integer v
type StringMap v  = TreeMap String v

type 宣言は新しいデータ型を定義するのではなく、既存のデータ型に対して別名を付けることに注意してください。

●データの探索

あとは、基本的に Tree の関数を呼び出すだけですが、データを探索する search, searchMin, searchMax は返り値の型が Just (Item k v) になるので、次に示すようなデータの変換が必要になります。

search    : Just (Item k v) -> Just v
searchMin : Just (Item k v) -> Just (k, v)
searchMax : Just (Item k v) -> Just (k, v)

単純にプログラムを作ると、次のようになります。

リスト : データの探索

search :: Ord k => k -> TreeMap k v -> Maybe v
search x tree =
  case T.search (Item' x) tree of
    Nothing -> Nothing
    Just (Item _ v) -> Just v

キー x を Item' に格納して T.search に渡して呼び出します。その返り値を case 式でパターンマッチングして、Just (Item _ v) から値 v を取り出して Just v を返します。ここで、Nothing なら Nothing を返し、Just x ならば x に関数を適用して、その結果をJust に格納して返す処理があると、case 式でパターンマッチングしなくても済むはずです。実は、このような処理が Haskell には用意されていて、名前を「ファンクタ (Functor)」といいます。

●ファンクタ

ここで簡単に「ファンクタ」について説明しましょう。Haskell のファンクタは型クラス Functor のことで、汎用のマップ関数 fmap が定義されています。fmap の型を示します。

fmap :: Functor f => (a -> b) -> f a -> f b

最初の引数が関数 a -> b で、a を b に変換する関数であることがわかります。次の引数 f a は型変数 a をひとつ持っているので、f は a を格納する型構築子であることがわかります。そして、最後の引数が f b なので、f a からデータを取り出し、それを関数 a -> b に適用し、その結果を f に格納して返すことがわかります。それから、型クラス制約 Functor f があるので、当然ですが型 f は Functor のインスタンスでなければいけません。

fmap の定義は map の定義と良く似ています。

map :: (a -> b) -> [a] -> [b]

リストの型 [a] は [ ] a のことなので、次のように書き直すことができます。

map :: (a -> b) -> [] a -> [] b

つまり、fmap は汎用のマップ関数なのです。Maybe とリストは Functor のインスタンスなので fmap を適用することができます。

簡単な実行例を示しましょう。

Prelude> fmap (*2) [1,2,3,4,5]
[2,4,6,8,10]
Prelude> fmap (*2) []
[]
Prelude> fmap (*2) (Just 10)
Just 20
Prelude> fmap (*2) Nothing
Nothing

リストのファンクタは関数 map と同じ動作になります。Maybe のファンクタは、Just からデータを取り出して、それに関数を適用して返り値を Just に格納して返します。Nothing の場合はデータを格納していないので Nothing をそのまま返します。

なお、ファンクタの詳しい説明は次回以降に行う予定です。

fmap を使うと、データの探索は次のようになります。

リスト : データの探索

-- 値を取り出す
getValue :: Item k v -> v
getValue (Item _ v) = v

-- タプルに変換する
toPair :: Item k v -> (k, v)
toPair (Item k v) = (k, v)

-- 探索
search :: Ord k => k -> TreeMap k v -> Maybe v
search x tree = fmap getValue $ T.search (Item' x) tree

searchMin :: TreeMap k v -> Maybe (k, v)
searchMin tree = fmap toPair $ T.searchMin tree

searchMax :: TreeMap k v -> Maybe (k, v)
searchMax tree = fmap toPair $ T.searchMax tree

search は T.search の返り値に fmap で関数 getValue を適用します。これで Just から値を取り出して getValue に渡し、その返り値を Just に格納して返すことができます。searchMin, SearchMax の場合、T.serachMin, T.SearchMax の返り値に fmap で関数 toPari を適用します。これで Item k v をタプル (k, v) に変換し、それを Just に格納して返すことができます。

あとのプログラムは簡単なので説明は割愛します。詳細は プログラムリスト2 をお読みください。

●実行例2

それでは実行してみましょう。

Prelude> :l TreeMap1
[1 of 2] Compiling Tree             ( Tree.hs, interpreted )
[2 of 2] Compiling TreeMap1         ( TreeMap1.hs, interpreted )
Ok, modules loaded: TreeMap1, Tree.
*TreeMap1> a = fromList $ zip ['d','b','a','c','f','e','g'] [1..7]
*TreeMap1> a
Node (Item 'd' 1) (Node (Item 'b' 2) (Node (Item 'a' 3) Nil Nil) (Node (Item 'c' 4) Nil Nil))
(Node (Item 'f' 5) (Node (Item 'e' 6) Nil Nil) (Node (Item 'g' 7) Nil Nil))
*TreeMap1> toList a
[('a',3),('b',2),('c',4),('d',1),('e',6),('f',5),('g',7)]

*TreeMap1> search 'a' a
Just 3
*TreeMap1> search 'g' a
Just 7
*TreeMap1> search 'd' a
Just 1
*TreeMap1> searchMin a
Just ('a',3)
*TreeMap1> searchMax a
Just ('g',7)

*TreeMap1> delete 'd' a
Node (Item 'e' 6) (Node (Item 'b' 2) (Node (Item 'a' 3) Nil Nil) (Node (Item 'c' 4) Nil Nil))
(Node (Item 'f' 5) Nil (Node (Item 'g' 7) Nil Nil))
*TreeMap1> delete 'b' a
Node (Item 'd' 1) (Node (Item 'c' 4) (Node (Item 'a' 3) Nil Nil) Nil) (Node (Item 'f' 5)
(Node (Item 'e' 6) Nil Nil) (Node (Item 'g' 7) Nil Nil))
*TreeMap1> delete 'f' a
Node (Item 'd' 1) (Node (Item 'b' 2) (Node (Item 'a' 3) Nil Nil) (Node (Item 'c' 4) Nil Nil))
(Node (Item 'g' 7) (Node (Item 'e' 6) Nil Nil) Nil)

*TreeMap1> foldl (flip delete) a ['a'..'g']
Nil
*TreeMap1> deleteMin a
Node (Item 'd' 1) (Node (Item 'b' 2) Nil (Node (Item 'c' 4) Nil Nil)) (Node (Item 'f' 5)
(Node (Item 'e' 6) Nil Nil) (Node (Item 'g' 7) Nil Nil))
*TreeMap1> deleteMax a
Node (Item 'd' 1) (Node (Item 'b' 2) (Node (Item 'a' 3) Nil Nil) (Node (Item 'c' 4) Nil Nil))
(Node (Item 'f' 5) (Node (Item 'e' 6) Nil Nil) Nil)

*TreeMap1> fold_left (flip (:)) [] a
[('g',7),('f',5),('e',6),('d',1),('c',4),('b',2),('a',3)]
*TreeMap1> fold_right (:) [] a
[('a',3),('b',2),('c',4),('d',1),('e',6),('f',5),('g',7)]
*TreeMap1> fold_right (const (+1)) 0 a
7

正常に動作していますね。

●Tree, TreeMap の欠点

今まで作成した二分木 Tree, TreeMap は、左右の部分木のバランスが崩れると性能が劣化します。二分木の場合、最下層にあるデータを探す場合が最悪で、木の高さ分だけ比較が行われます。したがって、木の高さを低く抑えた方が探索効率も良くなります。

二分木の高さはデータ数を N とすると、データがランダムに挿入されれば log2 N 程度に収まります。しかし、昇順にソートされたデータを挿入していくと、右側の部分木にだけデータが追加されていくことになり、けっきょく連結リストを線形探索することと同じになってしまいます。二分木の性能を十分に発揮させるには、左右の部分木のバランスが重要なのです。

そこで、木のバランスを一定の範囲に収める平衡木が考案されています。有名なところでは AVL 木、赤黒木 (red-black tree)、2-3 木、B 木、B* 木などがあります。この中で 2-3 木、B 木、B* 木は多分木、AVL 木、赤黒木は二分木を使用します。

Haskell のマニュアルによると、モジュール Data.Map と Data.Set は "size balanced binary trees (or trees of bounded balance)" という平衡二分木が使われているそうです。Data.Set は集合を取り扱うモジュールですが、二分探索木として使うこともできます。実用的なプログラムを作るのであれば Data.Set や Data.Map を使ったほうがよいでしょう。そこで、Data.Set と Data.Map の使い方を簡単に説明しておきます。

●Data.Set の使い方

Data.Set に定義されている集合のデータ型は Set a です。基本的な操作関数を表に示します。

表 : Data.Set の基本的な操作関数
関数名機能
null Set a -> Bool 空集合か
size Set k v -> Int 集合に格納されている要素数を返す
member Ord a => a -> Set a -> Bool 集合に要素 a が存在するか
empty Set a 空集合
singleton a -> Set a 要素を一つ持つ集合を生成する
insert Ord a => a -> Set a -> Set a 集合に要素を挿入する
delete Ord a => a -> Set a -> Set a 集合から要素を削除する
union Ord a => Set a -> Set a -> Set a 2 つの集合の和を求める
intersection Ord a => Set a -> Set a -> Set a 2 つの集合の積を求める
difference (\\) Ord a => Set a -> Set a -> Set a 2 つの集合の差を求める
foldr (b -> a -> a) -> a -> Map b -> a 畳み込み
foldl (a -> b -> a) -> a -> Map b -> a 畳み込み
toList Set a -> [a] 集合をリストに変換する
fromList Ord a => [a] -> Set a リストから集合を生成する
findMin Set a -> a 最小値を求める
findMax Set a -> a 最大値を求める
deleteMin Set a -> Set a 最小値を削除する
deleteMax Set a -> Set a 最大値を削除する

関数 size は二分木を巡回することなく O(1) で要素数を求めることができます。

それでは簡単な実行例を示します。

Prelude> :m + Data.Set
Prelude Data.Set> a = fromList [1..10]
Prelude Data.Set> a
fromList [1,2,3,4,5,6,7,8,9,10]
Prelude Data.Set> member 1 a
True
Prelude Data.Set> member 11 a
False
Prelude Data.Set> insert 11 a
fromList [1,2,3,4,5,6,7,8,9,10,11]
Prelude Data.Set> delete 5 a
fromList [1,2,3,4,6,7,8,9,10]

Prelude Data.Set> b = fromList [6..15]
Prelude Data.Set> b
fromList [6,7,8,9,10,11,12,13,14,15]
Prelude Data.Set> union a b
fromList [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
Prelude Data.Set> intersection a b
fromList [6,7,8,9,10]
Prelude Data.Set> difference a b
fromList [1,2,3,4,5]
Prelude Data.Set> a \\ b
fromList [1,2,3,4,5]

Prelude Data.Set> Data.Set.foldl (flip (:)) [] a
[10,9,8,7,6,5,4,3,2,1]
Prelude Data.Set> Data.Set.foldr (:) [] a
[1,2,3,4,5,6,7,8,9,10]
Prelude Data.Set> toList a
[1,2,3,4,5,6,7,8,9,10]
Prelude Data.Set> findMin a
1
Prelude Data.Set> findMax a
10
Prelude Data.Set> deleteMin a
fromList [2,3,4,5,6,7,8,9,10]
Prelude Data.Set> deleteMax a
fromList [1,2,3,4,5,6,7,8,9]

集合は "fromList リスト" の形式で表示されます。

このほかにも Data.Set には便利な関数が多数用意されています。詳細は Haskell のマニュアルをお読みください。

●Data.Map の使い方

Data.Map に定義されているマップのデータ型は Map k v です。k がキーで v が値を表す型変数です。基本的な操作関数を表に示します。

表 : Data.Map の基本的な操作関数
関数名機能
null Map k v -> Bool マップは空か
size Map k v -> Int マップに格納されている要素数を返す
! Ord k => Map k v -> k -> v キー k に対応する値 v を求める
member Ord k => Map k v -> k -> Bool マップにキー k が存在するか
lookup Ord k => Map k v -> k -> Maybe v キー k に対応する値 v を求める
empty Map k v 空のマップ
singleton k -> v -> Map k v 要素を一つ持つマップを生成する
insert Ord k => k -> v -> Map k v -> Map k v マップにデータを挿入する
delete Ord k => k -> Map k v -> Map k v マップからデータを削除する
foldr (v -> a -> a) -> a -> Map k v -> a 畳み込み
foldl (a -> v -> a) -> a -> Map k v -> a 畳み込み
toList Map k v -> [(k, v)] マップをリストに変換する
fromList Ord k => [(k, v)] -> Map k v リストからマップを生成する
findMin Map k v -> (k, v) 最小値を求める
findMax Map k v -> (k, v) 最大値を求める
deleteMin Map k v -> Map k v 最小値を削除する
deleteMax Map k v -> Map k v 最大値を削除する
elems Map k v -> [v] すべての値をリストに格納して返す
keys Map k v -> [k] すべてのキーをリストに格納して返す

関数 size は二分木を巡回することなく O(1) で要素数を求めることができます。演算子 ! はキーが見つからない場合はエラーを送出します。なお、畳み込み foldr と foldl は値に対してのみ動作します。ご注意くださいませ。

それでは簡単な実行例を示します。

Prelude> :m Data.Map
Prelude Data.Map> a = fromList $ zip ['a' .. 'g'] [1 .. 7]
Prelude Data.Map> a
fromList [('a',1),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7)]
Prelude Data.Map> toList a
[('a',1),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7)]

Prelude Data.Map> a ! 'a'
1
Prelude Data.Map> Data.Map.lookup 'a' a
Just 1
Prelude Data.Map> Data.Map.lookup 'h' a
Nothing
Prelude Data.Map> member 'a' a
True
Prelude Data.Map> member 'g' a
True
Prelude Data.Map> member 'h' a
False

Prelude Data.Map> insert 'h' 8 a
fromList [('a',1),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7),('h',8)]
Prelude Data.Map> insert 'a' 10 a
fromList [('a',10),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7)]

Prelude Data.Map> delete 'a' a
fromList [('b',2),('c',3),('d',4),('e',5),('f',6),('g',7)]
Prelude Data.Map> delete 'd' a
fromList [('a',1),('b',2),('c',3),('e',5),('f',6),('g',7)]
Prelude Data.Map> delete 'h' a
fromList [('a',1),('b',2),('c',3),('d',4),('e',5),('f',6),('g',7)]

Prelude Data.Map> Data.Map.foldr (:) [] a
[1,2,3,4,5,6,7]
Prelude Data.Map> Data.Map.foldl (flip (:)) [] a
[7,6,5,4,3,2,1]

マップは "fromList 連想リスト" の形式で表示されます。

このほかにも Data.Map には便利な関数が多数用意されています。詳細は Haskell のマニュアルをお読みください。


●プログラムリスト1

--
-- TreeMap.hs : 二分探索木
--
--              Copyright (C) 2013-2021 Makoto Hiroi
--
module TreeMap (
  TreeMap,
  emptyTree, singleton, insert,
  search, searchMin, searchMax,
  delete, deleteMin, deleteMax,
  toList, fromList,
  fold_left, fold_right, isEmptyTree
) where

-- データ型の定義
data TreeMap k v = Nil | Node k v (TreeMap k v) (TreeMap k v) deriving Show

-- 空の木
emptyTree :: TreeMap k v
emptyTree = Nil

-- 要素が一つの木
singleton :: k -> v -> TreeMap k v
singleton k v = Node k v Nil Nil

-- 挿入
insert :: Ord k => k -> v -> TreeMap k v -> TreeMap k v
insert x y Nil = singleton x y
insert x y (Node k v l r)
  | x == k    = Node x y l r
  | x < k     = Node k v (insert x y l) r
  | otherwise = Node k v l (insert x y r)

-- 探索
search :: Ord k => k -> TreeMap k v -> Maybe v
search _ Nil = Nothing
search x (Node k v l r)
  | x == k    = Just v
  | x < k     = search x l
  | otherwise = search x r

-- 最小値の探索
searchMin :: TreeMap k v -> Maybe (k, v)
searchMin Nil = Nothing
searchMin (Node k v Nil _) = Just (k, v)
searchMin (Node _ _ l   _) = searchMin l

-- 最大値の探索
searchMax :: TreeMap k v -> Maybe (k, v)
searchMax Nil = Nothing
searchMax (Node k v _ Nil) = Just (k, v)
searchMax (Node _ _ _ r)   = searchMax r

-- 最小値の削除
deleteMin :: TreeMap k v -> TreeMap k v
deleteMin Nil = Nil
deleteMin (Node _ _ Nil r) = r
deleteMin (Node k v l   r) = Node k v (deleteMin l) r

-- 最大値の削除
deleteMax :: TreeMap k v -> TreeMap k v
deleteMax Nil = Nil
deleteMax (Node _ _ l Nil) = l
deleteMax (Node k v l r)   = Node k v l (deleteMax r)

-- 削除
delete :: Ord k => k -> TreeMap k v -> TreeMap k v
delete x Nil = Nil
delete x (Node k v l r)
  | x < k  = Node k v (delete x l) r
  | x > k  = Node k v l (delete x r)
  | x == k = delete' l r  where
      delete' Nil r = r
      delete' l Nil = l
      delete' l r = Node k' v' l (deleteMin r)
        where Just (k', v') = searchMin r

-- データの変換
fromList :: Ord k => [(k, v)] -> TreeMap k v
fromList xs = foldl (\a (k, v) -> insert k v a) Nil xs

toList :: TreeMap k v -> [(k, v)]
toList tree = iter tree [] where
  iter Nil xs = xs
  iter (Node k v l r) xs = iter l ((k, v) : iter r xs)

-- 畳み込み
fold_left :: (a -> (k, v) -> a) -> a -> TreeMap k v -> a
fold_left _ a Nil = a
fold_left f a (Node k v l r) = fold_left f (f (fold_left f a l) (k, v)) r

fold_right :: ((k, v) -> b -> b) -> b -> TreeMap k v -> b
fold_right _ a Nil = a
fold_right f a (Node k v l r) = fold_right f (f (k, v) (fold_right f a r)) l

-- 木は空か
isEmptyTree :: TreeMap k v -> Bool
isEmptyTree Nil = True
isEmptyTree _   = False

●プログラムリスト2

--
-- TreeMap1.hs : Tree を使って Map を実装する場合
--
--               Copyright (C) 2013-2021 Makoto Hiroi
--
module TreeMap1 (
  TreeMap,
  insert, emptyTree, singleton,
  search, searchMin, searchMax,
  delete, deleteMin, deleteMax,
  toList, fromList, isEmptyTree,
  fold_left, fold_right
) where

import qualified Tree as T

-- データ型の定義
data Item k v = Item k v | Item' k deriving Show
type TreeMap k v = T.Tree (Item k v)

instance Eq k => Eq (Item k v) where
  (Item k1 _) == (Item k2 _) = k1 == k2
  (Item k1 _) == (Item' k2)  = k1 == k2
  (Item' k1)  == (Item k2 _) = k1 == k2
  (Item' k1)  == (Item' k2)  = k1 == k2

instance Ord k => Ord (Item k v) where
  (Item k1 _) `compare` (Item k2 _) = k1 `compare` k2
  (Item k1 _) `compare` (Item' k2)  = k1 `compare` k2
  (Item' k1)  `compare` (Item k2 _) = k1 `compare` k2
  (Item' k1)  `compare` (Item' k2)  = k1 `compare` k2

-- 値を取り出す
getValue :: Item k v -> v
getValue (Item _ v) = v

-- タプルに変換する
toPair :: Item k v -> (k, v)
toPair (Item k v) = (k, v)

-- 空の木
emptyTree :: TreeMap k v
emptyTree = T.emptyTree

-- 要素が一つの木
singleton :: k -> v -> TreeMap k v
singleton k v = T.singleton (Item k v)

-- 探索
search :: Ord k => k -> TreeMap k v -> Maybe v
search x tree = fmap getValue $ T.search (Item' x) tree

searchMin :: TreeMap k v -> Maybe (k, v)
searchMin tree = fmap toPair $ T.searchMin tree

searchMax :: TreeMap k v -> Maybe (k, v)
searchMax tree = fmap toPair $ T.searchMax tree

-- 挿入
insert :: Ord k => k -> v -> TreeMap k v -> TreeMap k v
insert k v tree = T.insert (Item k v) tree

-- 削除
deleteMin :: TreeMap k v -> TreeMap k v
deleteMin tree = T.deleteMin tree

deleteMax :: TreeMap k v -> TreeMap k v
deleteMax tree = T.deleteMax tree

delete :: Ord k => k -> TreeMap k v -> TreeMap k v
delete k tree = T.delete (Item' k) tree

-- データの変換
fromList :: Ord k => [(k, v)] -> TreeMap k v
fromList xs = foldl (\a (k, v) -> insert k v a) emptyTree xs

toList :: TreeMap k v -> [(k, v)]
toList tree = map toPair $ T.toList tree

-- 畳み込み
fold_left :: (a -> (k, v) -> a) -> a -> TreeMap k v -> a
fold_left f a tree = T.fold_left (\b x -> f b (toPair x)) a tree

fold_right :: ((k, v) -> a -> a) -> a -> TreeMap k v -> a
fold_right f a tree = T.fold_right (\x b -> f (toPair x) b) a tree

-- 空の木か
isEmptyTree :: TreeMap k v -> Bool
isEmptyTree tree = T.isEmptyTree tree

初版 2013 年 2 月 24 日
改訂 2021 年 1 月 17 日

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

[ PrevPage | Haskell | NextPage ]