M.Hiroi's Home Page

Functional Programming

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

[ PrevPage | Haskell | NextPage ]

ヒープ (2)

ヒープの続きです。今回は Leftist Heap と Skew Heap について説明します。

●Leftist Heap とは?

参考 URL 1, 2 によると、Leftist Heap は次の条件を満たす二分木とのことです。

  1. 親 <= 子 を満たす。左右の子に条件はない。
  2. 最も右側の子 (終端) までの経路長を求める関数を rank とすると、rank(右部分木) <= rank(左部分木) を満たす。

1 はヒープの条件です。2 の条件を満たすことにより、節の個数を N とすると Leftist Heap の rank(ルート) は log2 (N + 1) 以下になります。Leftist Heap は二つのヒープを併合する処理 merge を使って操作しますが、右部分木に対して merge を行うことで、merge は O(log N) に比例する時間で行うことができます。

Leftist Heap の簡単な例を示します。次の図を見てください。

アルファベットは節を、数字は rank の返り値を表します。これ以降 rank の返り値のことを単に rank と書くことにします。終端は省略しています。節 F, G, H, I は、左右の子が終端なので、rank は右の終端までの経路長 1 となります。D の場合、右側の子をたどると D - H - 終端 になるので、rank は 2 になります。E と C は右の子が終端なので rank は 1 になります。A と B の rank は右の子 C と E の rank を +1 した値 (2) になります。終端の rank を 0 とすると、どの部分木を見ても rank(right) <= rank(left) になっていて、Leftist Heap の条件 2 を満たしていることがわかります。

●Leftist Heap のマージ

Leftist Heap の基本的な操作は二つのヒープを併合する merge です。たとえば、データをヒープ A に追加する場合、要素が一つのヒープ B を作り、A と B を併合することで行います。最小値を削除する処理も、ルートの左右の部分木を併合することで行うことができます。

たとえば、要素が一つのヒープを併合する場合を考えて見ましょう。次の図を見てください。

ルートの値を比較すると A のほうが小さいので、A のルートが新しいヒープのルートになります (1)。次に、A の右部分木と B を併合します。A の右部分木は空の木なので、B を A の右部分木に挿入します (2)。ここで、節 4 の左右の部分木の rank を比較すると、右部分木のほうが大きくなるので、左右の部分木を交換します (3)。これで併合が完了します。

もう少し複雑な例を示しましょう。次の図を見てください。



A と B のルートを比較して、A のほうが小さいので、A が新しいヒープのルートになります (1)。次に、A の右部分木と B を併合します。この場合、B のルートの値が小さいので、A の右部分木は B に変更します (2)。次に、節 5 の右部分木と C を併合します。この場合、C のルートの値が小さいので、節 5 の右部分木は C になります (3)。次に、節 8 の右部分木 (空の木) と D を併合します (4)。

(4) の状態で、節 8 の左右の部分木の rank をチェックすると、右部分木の rank が大きいので、左右の部分木を交換します (5)。次に、節 5 の左右の部分木の rank をチェックしますが、左右の部分木の rank は等しいので交換する必要はありません (5)。最後に、節 4 の左右の部分木の rank をチェックします。右部分木の rank が大きいので左右の部分木を交換します。これでヒープの併合が完了します。

●プログラムの作成

それではプログラムを作りましましょう。まず最初にヒープを表すデータ型を定義します。

リスト : データ構造の定義

data Heap a = Empty | Heap Int a (Heap a) (Heap a) deriving Show

データ型は Heap a としました。データ構築子 Empty は空の木を表します。データ構築子 Heap の第 1 引数が rank を、第 2 引数の a が格納するデータを表します。第 3, 4 引数が左右の部分木になります。

次に、ヒープを操作する関数の仕様を示します。

この中で関数 merge が Leftist Heap を操作する中心的な役割を果たします。merge のプログラムは次のようになります。

リスト : ヒープの併合

merge :: Ord a => Heap a -> Heap a -> Heap a
merge h     Empty = h
merge Empty h     = h
merge h1@(Heap _ x left1 right1) h2@(Heap _ y left2 right2)
  | x < y     = makeHeap x left1 (merge right1 h2)
  | otherwise = makeHeap y left2 (merge right2 h1)

rank :: Heap a -> Int
rank Empty          = 0
rank (Heap r _ _ _) = r

makeHeap :: a -> Heap a -> Heap a -> Heap a
makeHeap x a b =
  if ra >= rb then Heap (rb + 1) x a b else Heap (ra + 1) x b a
  where rb = rank b
        ra = rank a

空のヒープ Empty と他のヒープ h を併合すると h になります。これが再帰呼び出しの停止条件になります。次に、二つのヒープ h1, h2 の値 x, y を比較します。x が小さい場合、h1 の右部分木 right1 と h2 を merge で併合します。そうでなければ、h2 の右部分木 right2 と h1 を併合します。

関数 makeHeap はヒープに格納する要素 x と、左右の部分木 a, b を受け取り、それらを Heap に格納して返します。このとき、関数 rank を使って a と b の rank を求め、rank が短いほうを右部分木に設定します。自分自身の rank は右部分木の rank に 1 を加算した値になります。関数 rank は引数が Empty であれば 0 を、Heap であれば第 1 引数の値を返します。

ヒープの操作関数は merge を使うと簡単に定義できます。次のリストを見てください。

リスト : ヒープの操作関数

-- データの追加
insert :: Ord a => a -> Heap a -> Heap a
insert h x = merge (singleton x) h

-- ヒープから最小値を取り出す
deleteMin :: Ord a => Heap a -> (a, Heap a)
deleteMin Empty = error "Empty Heap"
deleteMin (Heap _ x a b) = (x, merge a b)

-- リストからヒープを作る
fromList :: Ord a => [a] -> Heap a
fromList = foldl insert Empty

-- ヒープをリストに変換
toList :: Ord a => Heap a -> [a]
toList h
  | isEmpty h = []
  | otherwise = let (x, h') = deleteMin h
                in x : toList h'

関数 insert は sinleton x で要素が一つのヒープを生成し、それと引数 h のヒープを merge で併合します。関数deleteMin はルートの値 x と左右の部分木を併合したヒープをタプルに格納して返します。関数 fromList は foldl でリストの要素を取り出し insert でヒープに挿入していくだけです。関数 toList は deleteMin で最小値を取り出し、toList を再帰呼び出しした結果のリストに x を追加するだけです。

fromList と toList を組み合わせることでリストをソートすることができます。ヒープを使ったソートアルゴリズムを「ヒープソート」といいます。データ数を N とすると、ヒープソートは N * log2 N に比例する時間でデータをソートすることができます。これはあとで試してみましょう。

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

●実行例

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

*Main> a = singleton 1
*Main> a
Heap 1 1 Empty Empty
*Main> b = insert a 2
*Main> b
Heap 1 1 (Heap 1 2 Empty Empty) Empty
*Main> c = insert b 3
*Main> c
Heap 2 1 (Heap 1 2 Empty Empty) (Heap 1 3 Empty Empty)
*Main> d = insert c 4
*Main> d
Heap 2 1 (Heap 1 2 Empty Empty) (Heap 1 3 (Heap 1 4 Empty Empty) Empty)
*Main> e = insert d 5
*Main> e
Heap 2 1 (Heap 2 3 (Heap 1 4 Empty Empty) (Heap 1 5 Empty Empty)) (Heap 1 2 Empty Empty)
*Main> (v1, a1) = deleteMin e
*Main> v1
1
*Main> a1
Heap 1 2 (Heap 2 3 (Heap 1 4 Empty Empty) (Heap 1 5 Empty Empty)) Empty
*Main> (v2, a2) = deleteMin a1
*Main> v2
2
*Main> a2
Heap 2 3 (Heap 1 4 Empty Empty) (Heap 1 5 Empty Empty)
*Main> (v3, a3) = deleteMin a2
*Main> v3
3
*Main> a3
Heap 1 4 (Heap 1 5 Empty Empty) Empty
*Main> (v4, a4) = deleteMin a3
*Main> v4
4
*Main> a4
Heap 1 5 Empty Empty
*Main> (v5, a5) = deleteMin a4
*Main> v5
5
*Main> a5
Empty

*Main> a = fromList [5,6,4,7,3,8,2,9,1,0]
*Main> a
Heap 1 0 (Heap 1 1 (Heap 2 2 (Heap 2 3 (Heap 2 4 (Heap 1 5 (Heap 1 6 Empty Empty)
 Empty) (Heap 1 7 Empty Empty)) (Heap 1 8 Empty Empty)) (Heap 1 9 Empty Empty))
 Empty) Empty
*Main> toList a
[0,1,2,3,4,5,6,7,8,9]

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

●Skew Heap とは?

次は Skew Heap というヒープを説明します。Leftist Heap は節に rank の情報を付加して、rank が条件を満たすように木を修正しました。これに対し、1986 年に Sleater 氏と Tarjan 氏が提案した Skew Heap はちょっと変わっています。

Skew Heap は二つのヒープを併合する場合、Leftist Heap と同様に右部分木と他のヒープを併合します。このとき、左右の部分木を無条件に交換します。Leftist Heap のように、節に rank の情報を付加する必要はありません。

ただし、Leftist Heap のように rank が一定の範囲内に収まる保障はありません。データを挿入または削除する順番によっては、二分木のバランスが大きく崩れることがあるのです。もしそうなったとしても、その後のアクセスによって、Skew Heap はバランスを回復することが可能です。

Skew Heap はデータ数を N とすると、データの挿入または削除するときの平均実行時間が log2 N に比例するという面白い性質があります。ようするに、一回あたり長い時間がかかる処理があったとしても、全体で平均してみると O(log N) になるデータ構造というわけです。

このように、Skew Heap は一時的に二分木のバランスが崩れることがあっても、トータルとして考えると木のバランスを保つように動作します。このため、Skew Heap は「自己調整ヒープ」と呼ばれています。

今回は Skew Heap を簡単に説明して、実際にプログラムを作ってみましょう。Skew Heap の詳細は Sleater 氏と Tarjan 氏の論文 "Self adjusting Heaps" や Chris Okasaki 氏の "Fun with binary heap trees" (リンク切れ) をお読みください。

●Skew Heap のマージ

Skew Heap の基本的な操作も二つのヒープを併合する merge です。たとえば、要素が一つのヒープを併合する場合を考えて見ましょう。次の図を見てください。

ルートの値を比較すると A のほうが小さいので、A のルートが新しいヒープのルートになります (1)。次に、A の右部分木と B を併合します。A の右部分木は空の木なので、B を A の右部分木に挿入します (2)。最後に、左右の部分木を交換します (3)。これで併合が完了します。

もう少し複雑な例を示しましょう。次の図を見てください。



(1) から (4) までの操作は Leftist Heap と同じです。(5) から (7) の操作で、左右の部分木を無条件に交換します。Skew Heap の場合、rank をチェックする処理が不要なので、プログラムは Leftist Heap よりも簡単になります。

●プログラムの作成

それではプログラムを作りましましょう。まず最初にヒープを表すデータ型を定義します。

リスト : データ構造の定義

data Heap a = Empty | Heap a (Heap a) (Heap a) deriving Show

データ型は Heap a としました。データ構築子 Empty は空の木を表します。データ構築子 Heap の第 1 引数の a が格納するデータを表します。第 2, 3 引数が左右の部分木になります。

次に、ヒープを操作する関数の仕様を示します。これらの関数は Leftist Heap と同じです。

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

リスト : ヒープの併合

-- 二つのヒープを併合する
merge :: Ord a => Heap a -> Heap a -> Heap a
merge h     Empty = h
merge Empty h     = h
merge h1@(Heap x left1 right1) h2@(Heap y left2 right2) 
  | x < y     = Heap x (merge right1 h2) left1
  | otherwise = Heap y (merge right2 h1) left2

空のヒープ Empty と他のヒープ h を併合すると h になります。これが再帰呼び出しの停止条件になります。次に、二つのヒープ h1, h2 の値 x, y を比較します。x が小さい場合、h1 の右部分木 right1 と h2 を merge で併合します。そうでなければ、h2 の右部分木 right2 と h1 を併合します。そして、併合した結果を左部分木に、左部分木 left1 または left2 を右部分木に設定します。

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

●実行例

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

*Main> a = singleton 0
*Main> a
Heap 0 Empty Empty
*Main> b = insert a 1
*Main> b
Heap 0 (Heap 1 Empty Empty) Empty
*Main> c = insert b 2
*Main> c
Heap 0 (Heap 2 Empty Empty) (Heap 1 Empty Empty)
*Main> d = insert c 3
*Main> d
Heap 0 (Heap 1 (Heap 3 Empty Empty) Empty) (Heap 2 Empty Empty)
*Main> e = insert d 4
*Main> e
Heap 0 (Heap 2 (Heap 4 Empty Empty) Empty) (Heap 1 (Heap 3 Empty Empty) Empty)

*Main> (v1, a1) = deleteMin e
*Main> v1
0
*Main> a1
Heap 1 (Heap 2 (Heap 4 Empty Empty) Empty) (Heap 3 Empty Empty)
*Main> (v2, a2) = deleteMin a1
*Main> v2
1
*Main> a2
Heap 2 (Heap 3 Empty Empty) (Heap 4 Empty Empty)
*Main> (v3, a3) = deleteMin a2
*Main> v3
2
*Main> a3
Heap 3 (Heap 4 Empty Empty) Empty
*Main> (v4, a4) = deleteMin a3
*Main> v4
3
*Main> a4
Heap 4 Empty Empty
*Main> (v5, a5) = deleteMin a4
*Main> v5
4
*Main> a5
Empty

*Main> a = fromList [5,6,4,7,3,8,2,9,1,0]
*Main> a
Heap 0 (Heap 1 (Heap 2 (Heap 9 Empty Empty) (Heap 3 (Heap 8 Empty Empty) (Heap 4
 (Heap 7 Empty Empty) (Heap 5 (Heap 6 Empty Empty) Empty)))) Empty) Empty
*Main> toList a
[0,1,2,3,4,5,6,7,8,9]

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

●リストのソート

それでは、Leftist Heap と Skew Heap を使ってリストをソートするプログラムを作ってみましょう。比較のために、挿入ソート、クイックソート、マージソートも試してみましょう。プログラムは次のようになります。

リスト : リストのソート

import System.Random
import qualified Heap1 as H1
import qualified Heap2 as H2

-- 挿入ソート
insert_element :: Ord a => (a, [a]) -> [a]
insert_element (x, []) = [x]
insert_element (x, xs@(y:ys))
  | x <= y    = x:xs
  | otherwise = y : insert_element (x, ys)

insert_sort :: Ord a => [a] -> [a]
insert_sort []     = []
insert_sort (x:xs) = insert_element(x, insert_sort xs)

-- クイックソート
quick_sort :: Ord a => [a] -> [a]
quick_sort [] = []
quick_sort (x:xs) = quick_sort [y | y <- xs, y < x]
                 ++ [x]
                 ++ quick_sort [y | y <- xs, y >= x]

-- リストのマージ
merge_list :: Ord a => [a] -> [a] -> [a]
merge_list [] ys = ys
merge_list xs [] = xs
merge_list a@(x:xs) b@(y:ys)
  | x <= y    = x : merge_list xs b
  | otherwise = y : merge_list a ys

-- マージソート
merge_sort :: Ord a => Int -> [a] -> [a]
merge_sort _ []      = []
merge_sort 1 (x:_)   = [x]
merge_sort 2 (x:y:_) = if x > y then [y, x] else [x, y]
merge_sort n xs      =
  merge_list (merge_sort m xs) (merge_sort (n - m) (drop m xs))
    where m = div n 2

-- ヒープソート
-- Leftist Heap
heap_sort1 :: Ord a => [a] -> [a]
heap_sort1 xs = H1.toList $ H1.fromList xs

-- Skew Heap
heap_sort2 :: Ord a => [a] -> [a]
heap_sort2 xs = H2.toList $ H2.fromList xs

乱数を生成するため、モジュール System.Random をインポートします。System.Random が見つからない場合は stack を使ってパッケージ random をインストールしてください。乱数の使い方は次回以降に詳しく説明する予定です。heap_sort1 は Leftist Heap を使ったソートで、heap_sort2 は Skew Heap を使ったソートです。

それでは実行結果を示します。

*Main> a = take 10000 (randoms (mkStdGen 11) :: [Int])
(0.01 secs, 35,040 bytes)
*Main> take 10 a
[5260538044923710387,4361398698747678847,-8221315287270277529,7278185606566790575,1652507602255180489,
 6207436798600535810,2828579254075873640,-3624220446475129215,-866363518444507197,-2767556111145761201]
(0.01 secs, 232,608 bytes)
*Main> last a
-6066609824646539162
(0.02 secs, 16,104,104 bytes)
*Main> last $ insert_sort a
9220771782574569190
(10.66 secs, 7,739,877,352 bytes)
*Main> last $ quick_sort a
9220771782574569190
(0.12 secs, 40,233,048 bytes)
*Main> last $ merge_sort 10000 a
9220771782574569190
(0.10 secs, 30,028,240 bytes)
*Main> last $ heap_sort1 a
9220771782574569190
(0.49 secs, 137,794,224 bytes)
*Main> last $ heap_sort2 a
9220771782574569190
(0.17 secs, 56,651,992 bytes)
表 : 実行結果 (データ数 10000, 単位 : 秒)

         : 乱数 : 昇順 : 降順 : 山型
  -----------------------------------
  insert : 11.2 : 0.01 : 19.7 :  9.9
  quick  : 0.12 : 34.7 : 45.9 : 18.2
  merge  : 0.09 : 0.07 : 0.05 : 0.07
  Leftist: 0.43 : 0.44 : 0.05 : 0.45
  Skew   : 0.15 : 0.16 : 0.03 : 0.16

乱数 : take 10000 (randoms (mkStdGen 11) :: [Int])
昇順 : [1..10000]
降順 : [10000,9999..1]
山型 : [1..5000] ++ [5000,4999..1]

実行環境 : Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz

挿入ソートは昇順のデータに対しては極めて高速にソートすることができます。今回のクイックソートは、枢軸にリストの先頭要素を選んでいるため、乱数以外のデータはとても遅くなります。マージソートはリストのソートに適していて、どのようなデータに対しても高速にソートすることができます。

Leftist Heap と Skew Heap を使ったヒープソートは、クイックソートやマージソートにはかないませんが、どのようなデータに対しても十分な性能を発揮するようです。とくに、降順のデータはどちらも高速ですね。Leftist Heap と Skew Heap を比べると、降順のデータ以外では Skew Heap のほうが 2 倍以上高速になりました。処理が単純な分だけ Skew Heap のほうが高速に動作するようです。

なお、これらの結果はインタプリタ ghci 上で実行した場合です。GHC でコンパイルすると、異なる結果になるかもしれません。興味のある方は試してみてください。

●クイックソートの改良

クイックソートの実行時間は、データ数を N とすると平均して N * log2 N に比例します。ところが、枢軸の選び方によっては、最悪で N の 2 乗に比例するところまで劣化します。このため、クイックソートをプログラムする場合、枢軸の選び方を工夫するのが一般的です。

たとえば、データの中からいくつかの要素を選び、その中で中央の値を持つ要素を枢軸に選びます。たくさんの要素を選ぶとそれだけ最悪の枢軸を選ぶ危険性は減少しますが、中央値を選ぶのに時間がかかってしまいます。実際には、3 つから 5 つの要素を選んで、その中で中央値を枢軸とする場合が多いようです。

リストをクイックソートする場合、後ろにあるデータほどアクセスするのに時間がかかるので、この改良方法は不向きですが、今回はあえてこの方法を試してみましょう。

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

リスト : クイックソートの改良

-- リストを三分割する
partition3 :: Ord a => a -> [a] -> ([a],[a],[a])
partition3 _ [] = ([],[],[])
partition3 x (y:ys) =
  if x == y then (a, y:b, c)
  else if x < y then (a, b, y:c)
  else (y:a, b, c)
  where (a, b, c) = partition3 x ys

-- 中央値を選ぶ
median3 :: Ord a => Int -> [a] -> a
median3 n xs =
  if a < b
    then if b < c then b
         else if a < c then c else a
    else if a < c then a
         else if b < c then c else b
  where m = n `div` 2
        a = head xs
        b = xs !! m
        c = xs !! (m + m `div` 2)

quick_sort' :: Ord a => [a] -> [a]
quick_sort' [] = []
quick_sort' xs =
  if n < 32 then insert_sort xs
  else quick_sort' a ++ b ++ quick_sort' c
  where n = length xs
        (a, b, c) = partition3 (median3 n xs) xs

関数 partition3 はリストを枢軸 x より小さいもの、x と等しいもの、x より大きいものの 3 つに分割します。median3 はリストの先頭の要素、真ん中にある要素、3 / 4 の位置にある要素を取り出し、その中央値を返します。

なお、要素の選び方を、先頭、中央、最後尾とすると、山型のデータで実行速度が極端に遅くなります。もちろん、今回の選び方でも最悪のケースが存在するので、スタックオーバーフローする危険性があります。要素数が少ないリストからソートするとスタックオーバーフローを防ぐことができますが、今回はやっていません。

quick_sort' は、要素数が少なくなったらクイックソートから挿入ソートへ切り替えます。データ数が少ない場合は、クイックソートよりも単純なソートアルゴリズムの方が高速です。

それでは実行結果を示します。

表 : 実行結果 (データ数 10000, 単位 : 秒)

         : 乱数 : 昇順 : 降順 : 山型
  -----------------------------------
  merge  : 0.09 : 0.07 : 0.05 : 0.07
  quick  : 0.12 : 34.7 : 45.9 : 18.2
  quick' : 0.21 : 0.17 : 0.21 : 0.17

乱数 : take 10000 (randoms (mkStdGen 11) :: [Int])
昇順 : [1..10000]
降順 : [10000,9999..1]
山型 : [1..5000] ++ [5000,4999..1]

実行環境 : Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz

乱数の場合、単純なクイックソートよりも遅くなりましたが、他のデータは高速にソートすることができました。しかしながら、マージソートより遅くなるので、やっぱりクイックソートはリストに不向きなアルゴリズムだと思います。配列のように O(1) で要素にアクセスできるデータ構造でなければ、クイックソートはその真価を発揮することができないのでしょう。配列のソートは次回以降に取り上げる予定です。

●クイックソートの改良 (2)

もう一つ、クイックソートの改良方法を紹介しましょう。それは再帰呼び出しが深くなったら違うソートアルゴリズムに切り替える方法です。参考 URL 4 によると、『イントロソート(英: introsort)は、David Musser が1997年に設計したソートアルゴリズムである。最初はクイックソートを行い、再帰のレベルがソートされた要素数(の対数)を超えるとヒープソートに切り替える。』 とのことです。

配列をソートする場合、ヒープソートの実行速度はクイックソートやマージソートよりも遅くなります。ところが、マージソートが作業用のメモリ領域を必要とするのに対し、ヒープソートは作業用のメモリ領域を必要としない、という長所があります。大きな配列をソートする場合、ヒープソートに切り替えたほうが都合がよいわけです。

Haskell でリストをクイックソートする場合、ヒープソート以外のソートに切り替えてもかまいませんが、今回は heap_sort2 に切り替えることにしましょう。プログラムは次のようになります。

リスト : イントロソート (超簡易版)

log2 :: Int -> Int
log2 1 = 0
log2 n = 1 + log2 (n `div` 2)

intro_sort :: Ord a => [a] -> [a]
intro_sort xs = sort (2 * (log2 (length xs))) xs
  where sort _ [] = []
        sort d ls@(x:xs) =
          if d == 0 then heap_sort2 ls
          else sort (d - 1) [y | y <- xs, y < x]
               ++ [x]
               ++ sort (d - 1) [y | y <- xs, y >= x]

ヒープソートに切り替えるタイミングですが、今回は単純に再帰呼び出しの深さが 2 * log2N (N : データ数) を超えたときとします。それ以外のクイックソートは単純な quick_sort と同じで、リストの先頭要素を枢軸として選びます。

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

表 : 実行結果 (データ数 10000, 単位 : 秒)

         : 乱数 : 昇順 : 降順 : 山型 : 山型'
  -------------------------------------------
  merge  : 0.09 : 0.07 : 0.05 : 0.07 : 0.06
  quick  : 0.12 : 34.7 : 45.9 : 18.2 : 17.7
  quick' : 0.21 : 0.17 : 0.21 : 0.17 : 31.7
  intro  : 0.18 : 0.37 : 0.24 : 0.32 : 0.33

乱数  : take 10000 (randoms (mkStdGen 11) :: [Int])
昇順  : [1..10000]
降順  : [10000,9999..1]
山型  : [1..5000] ++ [5000,4999..1]
山型' : [1..5000] ++ [1,3..4999] ++ [4999,4997..1]

実行環境 : Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz

今回の intro_sort は再帰呼び出しの深さでヒープソートに切り替える単純なものですが、それでも効果は十分にあるようです。quick_sort' が苦手のデータでも高速にソートすることができました。

●参考 URL

  1. Leftist tree - Wikipedia (英)
  2. Leftist Heaps - Wellesley College (PDF,英)
  3. Skew heap - Wikipedia (英)
  4. イントロソート - Wikipedia

●プログラムリスト1

--
-- Heap1.hs : ヒープ (leftist heap)
--
--           Copyright (C) 2013-2021 Makoto Hiroi
--
module Heap1 where

-- データ構造の定義
data Heap a = Empty | Heap Int a (Heap a) (Heap a) deriving Show

-- 空のヒープ
empty = Empty

-- 要素が一つのヒープを作る
singleton :: a -> Heap a
singleton x = Heap 1 x Empty Empty

-- ヒープの併合
merge :: Ord a => Heap a -> Heap a -> Heap a
merge h     Empty = h
merge Empty h     = h
merge h1@(Heap _ x left1 right1) h2@(Heap _ y left2 right2)
  | x < y     = makeHeap x left1 (merge right1 h2)
  | otherwise = makeHeap y left2 (merge right2 h1)

rank :: Heap a -> Int
rank Empty          = 0
rank (Heap r _ _ _) = r

makeHeap :: a -> Heap a -> Heap a -> Heap a
makeHeap x a b =
  if ra >= rb then Heap (rb + 1) x a b else Heap (ra + 1) x b a
  where rb = rank b
        ra = rank a

-- データの追加
insert :: Ord a => Heap a -> a -> Heap a
insert h x = merge (singleton x) h

-- リストからヒープを作る
fromList :: Ord a => [a] -> Heap a
fromList = foldl insert Empty

-- ヒープをリストに変換
toList :: Ord a => Heap a -> [a]
toList h
  | isEmpty h = []
  | otherwise = let (x, h') = deleteMin h
                in x : toList h'

-- ヒープから最小値を取り出す
deleteMin :: Ord a => Heap a -> (a, Heap a)
deleteMin Empty = error "Empty Heap"
deleteMin (Heap _ x a b) = (x, merge a b)

-- ヒープの最小値を求める
findMin :: Heap a -> a
findMin Empty = error "Empty Heap"
findMin (Heap _ x _ _) = x

-- ヒープは空か
isEmpty :: Heap a -> Bool
isEmpty Empty = True
isEmpty _     = False

●プログラムリスト2

--
-- Heap2.hs : ヒープ (Skew Heap)
--
--            Copyright (C) 2013-2021 Makoto Hiroi
--
module Heap2 where

-- データ型の定義
data Heap a = Empty | Heap a (Heap a) (Heap a) deriving Show

-- 空のヒープ
empty = Empty

-- 要素が一つのヒープを生成する
singleton :: a -> Heap a
singleton x = Heap x Empty Empty

-- 二つのヒープを併合する
merge :: Ord a => Heap a -> Heap a -> Heap a
merge h     Empty = h
merge Empty h     = h
merge h1@(Heap x left1 right1) h2@(Heap y left2 right2) 
  | x < y     = Heap x (merge right1 h2) left1
  | otherwise = Heap y (merge right2 h1) left2

-- データの挿入
insert :: Ord a => Heap a -> a -> Heap a
insert h x = merge (singleton x) h

-- リストからヒープを作る
fromList :: Ord a => [a] -> Heap a
fromList = foldl insert Empty

-- ヒープをリストに変換する
toList :: Ord a => Heap a -> [a]
toList h
  | isEmpty h = []
  | otherwise = let (x, h') = deleteMin h
                in x : toList h'

-- ヒープから最小値を取り出す
deleteMin :: Ord a => Heap a -> (a, Heap a)
deleteMin Empty = error "Empty Heap"
deleteMin (Heap x left right) = (x, merge left right)

-- ヒープの最小値を求める
findMin :: Heap a -> a
findMin Empty = error "Empty Heap"
findMin (Heap x _ _) = x

-- ヒープは空か
isEmpty :: Heap a -> Bool
isEmpty Empty = True
isEmpty _     = False

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

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

[ PrevPage | Haskell | NextPage ]