M.Hiroi's Home Page

Functional Programming

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

[ PrevPage | Haskell | NextPage ]

書き換え可能な変数

Haskell は純粋な関数型言語なので、関数の引数や let で定義した局所変数の値を書き換えることはできません。ところが、Haskell には値を書き換えることができるデータ型 IORef がモジュール Data.IORef に用意されています。ただし、IORef は IO モナドの中でしか使用することができません。このほかにも、ST モナドの中で使う STRef というデータ型がありますが、本稿では取り上げません。配列や IORef を使うと、手続き型言語のように「副作用」を伴う操作を Haskell でも行うことができます。

●IORef の使い方

書き換え可能な変数のデータ型は IORef a で表されます。a は型変数です。IORef a は関数 newIORef で生成します。newIORef の型を示します。

newIORef :: a -> IO (IORef a)

newIORef x は初期値が x の IORef を生成します。返り値は IO に格納されて返されます。

データの参照と更新は関数 readIORef と writeIORef で行います。IORef の値に関数を適用して値を書き換える関数 modifyIORef もあります。

readIORef :: IORef a -> IO a
writeIORef :: IORef a -> a -> IO ()
modifyIORef :: IORef a -> (a -> a) -> IO ()

返り値は IO に格納されて返されます。簡単な使用例を示します。

Prelude> :m + Data.IORef
Prelude Data.IORef> a <- newIORef 0
Prelude Data.IORef> :t a
a :: IORef Integer
Prelude Data.IORef> readIORef a
0
Prelude Data.IORef> writeIORef a 10
Prelude Data.IORef> readIORef a
10
Prelude Data.IORef> modifyIORef a (*2)
Prelude Data.IORef> readIORef a
20

newIORef で初期値が 0 の IORef を生成します。この場合、変数 a の型は IORef Integer になります。readIORef で a の値を参照すると 0 になります。次に、writeIORef で a の値を 10 に書き換えます。再度、readIORef で a の値を参照すると 10 になり、変数の値が書き換えられていることがわかります。modifyIORef で a に関数 (*2) を適用すると、変数 a の値は 10 * 2 = 20 に書き換えられます。

●配列によるスタックの実装

Haskell の場合、スタックはリストを使って簡単に実現できます。関数型言語の場合、データ構造の主役はリストですが、配列を使ってもスタックを実装することができます。実際のところ、Haskell でこのようなスタックを使うことはないと思いますが、IORef の簡単な例題ということで、ご容赦くださいませ。

配列でスタックを実現する場合、データを格納するための配列本体と、スタックのトップを表す変数が必要になります。この変数のことを「スタックポインタ (stack pointer)」と呼びます。次の図を見てください。

まず、配列 buffer とスタックポインタ top を用意します。top の値は 0 に初期化しておきます。データをプッシュするときは buffer の top 番目にデータを格納してから、top の値をインクリメントします。逆にポップするときは、top の値をデクリメントしてから、buffer の top 番目にあるデータを取り出します。スタックを操作するたびに、top の値は上図のように変化します。

データをプッシュしていくと、top の値は配列の大きさと等しくなります。配列はリストと違って大きさに限りがあるので、これ以上データを追加することはできません。つまり、スタックは満杯となります。したがって、データをプッシュするとき、スタックに空きがあるかチェックする必要があります。また、top の値が 0 のときはスタックが空の状態なので、ポップすることはできません。このチェックも必要です。

●プログラムの作成

プログラムは次のようになります。

リスト : 配列によるスタックの実装

import Data.Array.IO
import Data.IORef

-- データ型の定義
data Stack a = S Int (IORef Int) (IOArray Int a)

-- スタックの生成
makeStack :: Int -> IO (Stack a)
makeStack n = do
  buff <- newArray_ (0, n - 1)
  cnt  <- newIORef 0
  return (S n cnt buff)

-- スタックにデータを追加する
push :: Stack a -> a -> IO ()
push (S size cnt buff) x = do
  n <- readIORef cnt
  if n >= size
    then error "Full Stack"
    else do
      writeArray buff n x
      writeIORef cnt (n + 1)

-- スタックからデータを取り出す
pop :: Stack a -> IO a
pop (S _ cnt buff) = do
  n <- readIORef cnt
  if n <= 0
    then error "Empty Stack"
    else do
      writeIORef cnt (n - 1)
      readArray buff (n - 1)

-- スタックは空か
isEmpty :: Stack a -> IO Bool
isEmpty (S _ cnt _) = do
  n <- readIORef cnt
  return (n == 0)

-- スタックは満杯か
isFull :: Stack a -> IO Bool
isFull (S size cnt _) = do
  n <- readIORef cnt
  return (n == size)

-- データ数を求める
len :: Stack a -> IO Int
len (S _ cnt _) = readIORef cnt

スタックのデータ型は Stack a とし、データ構築子を S としました。S の第 1 引数がスタックの大きさを表す整数値 (Int) で、第 2 引数がスタックポインタを表す変数です。値を書き換えるので IORef Int とします。なお、このプログラムでは、スタックポインタはスタックに格納されているデータ数を表すことになります。第 3 引数がスタック本体を表す配列です。

関数 makeStack n は大きさ n のスタックを生成して、IO に格納して返します。newArray_ で大きさ (0, n - 1) の配列を生成し、newIORef で初期値 0 の変数 (スタックポインタ) を生成し、それらを S に格納して返します。

関数 push s x はスタック s に x を追加します。最初に readIORef でスタックポインタの値を取り出して変数 n にセットします。n がスタックの大きさ size 以上であれば、スタックは満杯なのでエラーを送出します。そうでなければ、配列の n 番目の位置に writeArray で x を書き込み、writeIORef でスタックポインタの値を +1 します。

関数 pop s はスタックからデータを取り出して IO に格納して返します。最初にスタックポインタの値を取り出して変数 n にセットします。n が 0 以下であれば、スタックは空なのでエラーを送出します。そうでなければ、writeIORef でスタックポインタの値を -1 して、readArray で buff の n - 1 番目の値を取り出して返します。

isEmpty s はスタック s が空ならば True を返します。関数 isFull s はスタック s が満杯であれば True を返します。関数 len はスタックに格納されているデータの個数を返します。これらの関数は返り値を IO に格納して返すことに注意してください。

●実行例

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

*Main> a <- makeStack 10 :: IO (Stack Integer)
*Main> isEmpty a
True
*Main> mapM_ (push a) [1..10]
*Main> isEmpty a
False
*Main> isFull a
True
*Main> pop a
10
*Main> pop a
9
*Main> pop a
8
*Main> pop a
7
*Main> pop a
6
*Main> pop a
5
*Main> pop a
4
*Main> pop a
3
*Main> pop a
2
*Main> pop a
1
*Main> isEmpty a
True

●配列によるキューの実装

拙作のページ モジュール では、リストを使ってキュー (queue) を実現しました。キューは配列を使っても簡単に実現できます。先頭位置を示す front と末尾を示す rear を用意し、front と rear の間にあるデータをキューに格納されているデータとするのがポイントです。次の図を見てください。


                      図 : キューの動作

まずキューは空の状態で、rear, front ともに 0 です。データの追加は、rear が示す位置にデータを書き込み、rear の値をインクリメントします。データ 10, 20, 30 を追加すると、図のようにデータが追加され rear は 3 になります。このとき front は 0 のままなので、先頭のデータは 10 ということになります。

次に、データを取り出す場合、front の示すデータを取り出してから front の値をインクリメントします。この場合、front が 0 なので 10 を取り出して front の値は 1 となり、次のデータ 20 が先頭になります。データを順番に 20, 30 と取り出していくと、3 つしかデータを書き込んでいないので当然キューは空になります。このとき front は 3 になり rear と同じ値になります。このように、front と rear の値が 0 の場合だけが空の状態ではなく、front と rear の値が等しくなると、キューは空になることに注意してください。

rear, fornt ともに値は増加していく方向なので、いつかは配列の範囲をオーバーします。このため、配列を先頭と末尾がつがっているリング状と考え、rear, front が配列の範囲を超えたら 0 に戻すことにします。これを「循環配列」とか「リングバッファ」と呼びます。一般に、配列を使ってキューを実現する場合は、リングバッファとするのがふつうです。

●プログラムの作成

Haskell の場合、リングバッファを使うことはほとんどないと思いますが、配列と IORef の簡単な例題ということで、実際に作ってみることにしましょう。最初に、キューを表すデータ型を定義します。

リスト : キューの定義と生成

-- データ型の定義
data Queue a = Q Int (IORef Int) (IORef Int) (IORef Int) (IOArray Int a)

-- キューの生成
makeQueue :: Int -> IO (Queue a)
makeQueue n = do
  a <- newIORef 0
  b <- newIORef 0
  c <- newIORef 0
  d <- newArray_ (0, n - 1)
  return (Q n a b c d)

データ型は Queue a とし、データ構築子は Q としました。第 1 引数がキューの大きさを表す整数値 (Int) で、第 2, 3, 4 引数が front, rear, cnt を表します。cnt はキューに格納されているデータ数を表します。これらの変数は値を書き換えるので IORef Int を使っています。最後の引数がキュー本体を表す配列です。

配列を生成する関数 makeQueue も簡単です。newIORef で front, rear, cnt 用の変数を、newArray_ でキュー本体を生成し、それらを Q に格納して返すだけです。

次はデータを追加する関数 enqueue を作ります。

リスト : キューにデータを追加する

enqueue :: Queue a -> a -> IO ()
enqueue (Q size _ rear cnt buff) x = do
  c <- readIORef cnt
  if c >= size
    then error "Full Queue"
    else do
      r <- readIORef rear
      writeArray buff r x
      writeIORef cnt (c + 1)
      if r + 1 >= size
        then writeIORef rear 0
        else writeIORef rear (r + 1)

まず、cnt の値と readIORef で取り出して変数 c にセットします。c がキューの大きさ size 以上の場合、キューは満杯なのでエラーを送出します。そうでなければ、readIORef で rear の値を取り出して r にセットします。そして、writeArray で buff の r 番目に x を書き込み、writeIORef で cnt の値を c + 1 に書き換えます。最後に、r + 1 が size 以上になるかチェックします。その場合は rear を 0 に書き換えます。そうでなければ rear の値を +1 します。

次は、キューからデータを取り出す関数 dequeue を作ります。

リスト : キューからデータを取り出す

dequeue :: Queue a -> IO a
dequeue (Q size front _ cnt buff) = do
  c <- readIORef cnt
  if c <= 0
    then error "Empty Queue"
    else do
      f <- readIORef front
      x <- readArray buff f
      writeIORef cnt (c - 1)
      if f + 1 >= size
        then writeIORef front 0
        else writeIORef front (f + 1)
      return x

最初に readIORef で cnt の値を取り出して変数 c にセットします。c が 0 以下であればキューは空なのでエラーを送出します。そうでなければ、front の値を readIORef で取り出して変数 f にセットし、buff の f 番目のデータを readArray で取り出して変数 x にセットします。あとは、writeIORef で cnt の値を -1 して、f + 1 が size 以上になるかチェックします。そうであれば、front の値を 0 に書き換えます。そうでなければ、front の値を +1 します。最後に、x を IO に格納して返します。

あとの関数 isEmpty, isFull, clear は簡単なので説明は省略します。プログラムリストをお読みくださいませ。

リスト : キューの操作関数

-- キューは空か
isEmpty :: Queue a -> IO Bool
isEmpty (Q _ _ _ cnt _) = do
  c <- readIORef cnt
  return (c == 0)

-- キューは満杯か
isFull :: Queue a -> IO Bool
isFull (Q _ _ _ cnt _) = do
  c <- readIORef cnt
  return (c /= 0)

-- キューを空にする
clear :: Queue a -> IO ()
clear (Q _ front rear cnt _) = do
  writeIORef front 0
  writeIORef rear  0
  writeIORef cnt   0

●実行例

これでプログラムは完成です。それでは、簡単な実行例を示しましょう。

*Main> a <- makeQueue 8 :: IO (Queue Integer)
*Main> isEmpty a
True
*Main> isFull a
False
*Main> mapM_ (enqueue a) [1..8]
*Main> isEmpty a
False
*Main> isFull a
True
*Main> dequeue a
1
*Main> dequeue a
2
*Main> dequeue a
3
*Main> dequeue a
4
*Main> dequeue a
5
*Main> dequeue a
6
*Main> dequeue a
7
*Main> dequeue a
8
*Main> isEmpty a
True
*Main> isFull a
False

makeQueue でキューを作成して変数 a にセットします。mapM_ でキューにデータを 8 個セットします。これでキューは満杯になるので、これ以上データを追加することはできません。次に、dequeue でデータを取り出します。先に入れたデータから順番に取り出されていることがわかりますね。これでキューは空の状態になります。


初版 2013 年 5 月 5 日
改訂 2021 年 8 月 8 日

ヒープ

「ヒープ (heap)」は「半順序木 (partial ordered tree)」と呼ばれる木構造の一種で、普通は二分木を使った二分ヒープのことを指します。ヒープを利用すると、最小値をすぐに見つけることができ、新しくデータを挿入する場合も、高々要素の個数 (n) の対数 (log2 n) に比例する程度の時間で済みます。

ヒープは配列を使って簡単に実装することができます。また、二分木を使ったヒープの実装では Leftist Heap と Skew Heap というアルゴリズムがあります。Haskell の場合、配列の操作は副作用を伴うので、木構造である Leftist Heap や Skew Heap の方が扱いやすいと思います。今回は配列によるヒープの実装を説明し、Leftist Heap と Skew Heap は次回以降に説明します。

●配列によるヒープの実装

一般的な二分木では、親よりも左側の子のほうが小さく、親よりも右側の子が大きい、という関係を満たすように作ります。「半順序木」の場合、親は子より小さいか等しい、という関係を満たすように作ります。このとき、葉はすべて同じ高さになるか、そうでなければ、葉は左から右へ順番に埋めていきます。このような二分木は配列で表すことができます。ヒープの場合、木の根を配列の添字 0 とすると、0 番目には必ず最小値のデータが格納されます。

下図にヒープと配列の関係を示します。


      図 : ヒープと配列の対応関係

●ヒープの構築 (1)

ヒープは、次の手順で作ることができます。

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) まで到達すれば、処理を終了します。これをデータの個数だけ繰り返します。

このアルゴリズムを Haskell でプログラムすると、次のようになります。

リスト : ヒープの構築 (1)

-- 要素の比較
compItem :: Ord a => IOArray Int a -> Int -> Int -> IO Ordering
compItem buff i j = liftM2 (compare) (readArray buff i) (readArray buff j)

-- 要素の交換
swapItem :: IOArray Int a -> Int -> Int -> IO ()
swapItem buff i j = do
  a <- readArray buff i
  b <- readArray buff j
  writeArray buff i b
  writeArray buff j a

-- ルート方向に向かってヒープを構築
upheap :: Ord a => IOArray Int a -> Int -> IO ()
upheap buff n = do
  when (n > 0) $ do
    let p = (n - 1) `div` 2
    t <- compItem buff p n
    when (t == GT) $ do
      swapItem buff p n
      upheap buff p

関数 compItem は配列の要素を比較します。関数 swapItem は配列の要素を交換します。Ordering は大小関係を表すデータ型です。

data Ordering = LT | EQ | GT

関数 compare x y は x < y であれば LT を、x == y であれば EQ を、x > y であれば GT を返します。Ordering は大小関係 LT < EQ < GT が定義されているので、たとえば compare x y の返り値を t とすると、x <= y は t <= EQ で調べることができます。

関数 upheap はヒープを満たすように n 番目の要素をルート方向に向かって移動させます。0 から n - 1 番目までの要素はヒープの条件を満たしているとします。n が 0 の場合、ルートまでたどったので処理を終了します。n の親を p とすると、p は (n - 1) / 2 で求めることができます。そして、親 p が子 n よりも大きい場合、ヒープの条件を満たさないので p 番目と n 番目の要素を swapItem で交換し、upheap を再帰呼び出しして次の親子関係をチェックします。そうでなければ、ヒープの条件を満たしているので処理を終了します。

実際にヒープを構築する場合は、配列の最後尾にデータを追加して、upheap を呼び出せばいいわけです。また、データが格納されている配列でも、upheap を適用してヒープを構築することができます。簡単な例を示します。

*Main> a <- newListArray (0,9) [5,6,4,7,3,8,2,9,1,0] :: IO (IOArray Int Int)
*Main> mapM_ (upheap a) [1..9]
*Main> getElems a
[0,1,3,4,2,8,5,9,7,6]

ただし、この方法はデータ数を 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 つの子の中で小さい方の子を選び、それと挿入したデータを比較します。もしも、ヒープの条件を満たしていなければ、親と子を交換し、その次の子供と比較します。これを、条件を満たすか、子供がなくなるまで繰り返します。

このアルゴリズムを Haskell でプログラムすると次のようになります。

リスト : ヒープの再構築

downheap :: Ord a => IOArray Int a -> Int -> Int -> IO ()
downheap buff n h = iter n h
  where
    selectChild c1 h = do
      let c2 = c1 + 1
      if c2 > h
        then return c1
        else do
          t <- compItem buff c1 c2
          if t == GT
            then return c2
            else return c1
    iter n h = do
      let c1 = 2 * n + 1
      when (c1 <= h) $ do
        c <- selectChild c1 h
        t <- compItem buff n c
        when (t == GT) $ do
          swapItem buff n c
          iter c h

関数 downheap はヒープを満たすように n 番目の要素を葉の方向へ移動させます。n + 1 番目から最後までの要素はヒープを満たしているとします。引数 h は最後の要素の位置を表します。実際の処理は局所関数 iter で行います。

最初に、n の子 c1 を求めます。これが h よりも大きければ処理を終了します。そして、もう一つの子 (c + 1) がある場合は、小さい子を選択します。この処理を局所関数 selectChild で行っています。もう一つの子を c2 とすると、c2 が h より大きければ c1 を返します。そうでなければ、compItem で c1 と c2 を比較して小さな子を選びます。

次に、selectChild で選んだ子 c と親 n を比較し、親が大きい場合は swapItem で親と子を交換します。それから、iter を再帰呼び出しして次の親子関係をチェックします。親が子以下の場合はヒープの条件を満たしているので処理を終了します。

最小値を取り出したあと新しいデータを挿入しない場合は、新しいデータの代わりに配列 buff の最後尾のデータを buff の 0 番目にセットしてヒープを再構築します。上図の例でいえば、100 を buff[0] にセットして、ヒープを再構築すればいいわけです。この場合、ヒープに格納されているデータの個数は一つ減ることになります。

●ヒープの構築 (2)

ところで、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 を使うと次のように簡単にプログラムできます。

*Main> a <- newListArray (0,9) [5,6,4,7,3,8,2,9,1,0] :: IO (IOArray Int Int)
*Main> mapM_ (\x -> downheap a x 9) [4,3,2,1,0]
*Main> getElems a
[0,1,2,5,3,8,4,9,7,6]

後ろからヒープを再構築していくと考えるとわかりやすいでしょう。この方法の場合、要素 n の配列に対して、n / 2 個の要素の修正を行えばよいので、最初に説明したヒープの構築方法よりも速くなります。

●優先度つき待ち行列

それでは、ヒープを使って「優先度つき待ち行列 (priority queue)」を作ってみましょう。一般に、キューは先入れ先出し (FIFO : first-in, first-out) のデータ構造です。キューからデータを取り出すときは、先に挿入されたデータから取り出されます。これに対し、優先度つき待ち行列は、データに優先度をつけておいて、優先度の高いデータから取り出していきます。

優先度つき待ち行列は、優先度を基準にヒープを構築することで実現できます。最初に作成する関数を示します。

プログラムは次のようになります。

リスト : 優先度つき待ち行列

-- データ型の定義
data Heap a = Heap Int (IORef Int) (IOArray Int a)

-- ヒープの生成
makeHeap :: Int -> IO (Heap a)
makeHeap n = do
  a <- newArray_ (0, n - 1)
  b <- newIORef 0
  return (Heap n b a)

-- リストからヒープを生成する
fromList :: Ord a => [a] -> IO (Heap a)
fromList xs = do
  let n = length xs
      m = n `div` 2 - 1
  a <- newListArray (0, n - 1) xs
  b <- newIORef n
  mapM_ (\x -> downheap a x (n - 1)) [m, m-1 .. 0]
  return (Heap n b a)

データ型は Heap a とし、データ構築子を Heap としました。第 1 引数が配列 (ヒープ) の大きさ (Int)、第 2 引数が要素の個数 (IORef Int)、第 3 引数が配列を表します。関数 makeHeap n は大きさが n の空のヒープを生成します。配列と IORef を生成して Heap に格納して返すだけです。

関数 fromList はリストからヒープを生成します。リスト xs の要素数を length で求めて変数 n にセットし、n / 2 - 1 の値を変数 m にセットします。配列本体は newListArray で生成し、mapM_ で m 番目から 0 番目の要素に downheap を適用してヒープを構築します。

次はデータを追加する関数 insert を作ります。

リスト : データの追加

insert :: Ord a => Heap a -> a -> IO ()
insert (Heap size cnt buff) x = do
  c <- readIORef cnt
  if c >= size
    then error "Full Heap"
    else do
      writeArray buff c x
      writeIORef cnt (c + 1)
      upheap buff c

最初にヒープに格納されているデータ数を求めて変数 c にセットします。c がヒープの大きさ size 以上の場合、ヒープは満杯なのでエラーを送出します。そうでなければ、配列の c 番目に x を挿入し、upheap でヒープを再構築します。データの個数 cnt を +1 することをお忘れなく。

次は最小値を取り出す関数 deleteMin を作ります。

リスト : 最小値の取り出し

deleteMin :: Ord a => Heap a -> IO a
deleteMin (Heap _ cnt buff) = do
  c <- readIORef cnt
  if c <= 0 
    then error "Empty Heap"
    else do
      x <- readArray buff 0
      let c1 = c - 1
      writeIORef cnt c1
      when (c1 > 0) $ do
        swapItem buff 0 c1
        downheap buff 0 (c1 - 1)
      return x

最初にデータの個数を求めて変数 c にセットします。c が 0 以下の場合、ヒープは空なのでエラーを送出します。そうでなければ、配列 buff の 0 番目の要素を取り出して変数 x にセットします。次に、データの個数を -1 します。データが残ってる場合じはヒープを再構築します。最後尾の要素と 0 番目の要素を swapItem で交換し、downheap でヒープを再構築します。最後に x を return で IO に格納して返します。

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

●実行例

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

*Main> a <- makeHeap 8 :: IO (Heap Int)
*Main> isEmpty a
True
*Main> isFull a
False
*Main> mapM_ (insert a) [7, 6 .. 0]
*Main> deleteMin a
0
*Main> deleteMin a
1
*Main> deleteMin a
2
*Main> deleteMin a
3
*Main> deleteMin a
4
*Main> deleteMin a
5
*Main> deleteMin a
6
*Main> deleteMin a
7
*Main> isEmpty a
True

*Main> a <- fromList [5,6,4,7,3,8,2,9,1,0]
*Main> isFull a
True
*Main> isEmpty a
False
*Main> deleteMin a
0
*Main> deleteMin a
1
*Main> deleteMin a
2
*Main> deleteMin a
3
*Main> deleteMin a
4
*Main> deleteMin a
5
*Main> deleteMin a
6
*Main> deleteMin a
7
*Main> deleteMin a
8
*Main> deleteMin a
9
*Main> isEmpty a
True

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


●プログラムリスト

--
-- heap.hs : 配列を使ったヒープの実装
--
--            Copyright (C) 2013-2021 Makoto Hiroi
--
import Data.Array.IO
import Data.IORef
import Control.Monad

-- データ型の定義
data Heap a = Heap Int (IORef Int) (IOArray Int a)

-- 要素の比較
compItem :: Ord a => IOArray Int a -> Int -> Int -> IO Ordering
compItem buff i j = liftM2 (compare) (readArray buff i) (readArray buff j)

-- 要素の交換
swapItem :: IOArray Int a -> Int -> Int -> IO ()
swapItem buff i j = do
  a <- readArray buff i
  b <- readArray buff j
  writeArray buff i b
  writeArray buff j a

-- ルート方向に向かってヒープを構築
upheap :: Ord a => IOArray Int a -> Int -> IO ()
upheap buff n = do
  when (n > 0) $ do
    let p = (n - 1) `div` 2
    t <- compItem buff p n
    when (t == GT) $ do
      swapItem buff p n
      upheap buff p

-- 葉の方向に向かってヒープを構築
downheap :: Ord a => IOArray Int a -> Int -> Int -> IO ()
downheap buff n h = iter n h
  where
    selectChild c1 h = do
      let c2 = c1 + 1
      if c2 > h
        then return c1
        else do
          t <- compItem buff c1 c2
          if t == GT
            then return c2
            else return c1
    iter n h = do
      let c1 = 2 * n + 1
      when (c1 <= h) $ do
        c <- selectChild c1 h
        t <- compItem buff n c
        when (t == GT) $ do
          swapItem buff n c
          iter c h

-- ヒープの生成
makeHeap :: Int -> IO (Heap a)
makeHeap n = do
  a <- newArray_ (0, n - 1)
  b <- newIORef 0
  return (Heap n b a)

-- リストからヒープを生成する
fromList :: Ord a => [a] -> IO (Heap a)
fromList xs = do
  let n = length xs
      m = n `div` 2 - 1
  a <- newListArray (0, n - 1) xs
  b <- newIORef n
  mapM_ (\x -> downheap a x (n - 1)) [m, m-1 .. 0]
  return (Heap n b a)

-- データの追加
insert :: Ord a => Heap a -> a -> IO ()
insert (Heap size cnt buff) x = do
  c <- readIORef cnt
  if c >= size
    then error "Full Heap"
    else do
      writeArray buff c x
      writeIORef cnt (c + 1)
      upheap buff c

-- 最小値を取り出す
deleteMin :: Ord a => Heap a -> IO a
deleteMin (Heap _ cnt buff) = do
  c <- readIORef cnt
  if c <= 0 
    then error "Empty Heap"
    else do
      x <- readArray buff 0
      let c1 = c - 1
      writeIORef cnt c1
      when (c1 > 0) $ do
        swapItem buff 0 c1
        downheap buff 0 (c1 - 1)
      return x

-- 最小値を求める
findMin :: Ord a => Heap a -> IO a
findMin (Heap _ cnt buff) = do
  c <- readIORef cnt
  if c <= 0
    then error "Empty Heap"
    else readArray buff 0

-- ヒープは空か
isEmpty :: Heap a -> IO Bool
isEmpty (Heap _ cnt _) = do
  c <- readIORef cnt
  return (c == 0)

-- ヒープは満杯か
isFull :: Heap a -> IO Bool
isFull (Heap size cnt _) = do
  c <- readIORef cnt
  return (c == size)
初版 2013 年 5 月 5 日
改訂 2021 年 8 月 8 日

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

[ PrevPage | Haskell | NextPage ]