アルゴリズムクイックリファレンス第2版をHaskellで書く修行
アルゴリズムクイックリファレンス第2版に載っている, 約40のアルゴリズムをHaskellで実装していきます.
ソースはここに置いています.
注意
以下の点に注意して下さい.
- 最適解ではないものが多く含まれるかと思います(より良い書き方があれば是非教えて下さい)
- 主に配列ではなくリストを用います
- 基本的にnot-in-placeな処理を書きます(WikipediaのIn-placeアルゴリズムにある通り, 関数型プログラミングではin-placeアルゴリズムを推奨していない事が多いため)
- アルゴリズムによっては条件が諸説あるものもあるかと思いますが, 基本的にアルゴリズムクイックリファレンス第2版の記載に準拠するものとします
- それぞれのアルゴリズムの説明は時間がある時に書きます
- 気分の赴くままの順番で書いていきます
目次
以下随時追加
整列
挿入ソート
挿入ソートは,
- 未整列リストの先頭要素を読み込む
- 読み込んだ要素を整列済みのリストの正しい位置に挿入する
- 未整列リストに対して1, 2の処理を再帰的に行う
というソートアルゴリズムです.
最良計算量はO(n), 平均計算量と最悪計算量はO(n^2)となります.
Haskellには今回したい処理にピッタリなinsert関数がありました.
これとfoldr関数を組み合わせる事で挿入ソートが実現できます.
module Sort.InsertionSort where
import Data.List
insertionSort :: Ord a => [a] -> [a]
insertionSort = foldr insert []
以上のようになります.
foldrがどう動くのかが慣れるまでは分かり辛いですが, 今回の場合は以下のようになります.
リストは[4, 1, 3, 5, 2]とします.
insertionSort [4, 1, 3, 5, 2]
↓
4 `insert` 1 `insert` 3 `insert` 5 `insert` 2 `insert` []
↓
4 `insert` 1 `insert` 3 `insert` 5 `insert` [2]
↓
4 `insert` 1 `insert` 3 `insert` [2, 5]
↓
4 `insert` 1 `insert` [2, 3, 5]
↓
4 `insert` [1, 2, 3, 5]
↓
[1, 2, 3, 4, 5]
選択ソート
選択ソートは,
- 未整列リストの最小値を整列済みリストの最後尾に移動させる
- 未整列リストに対して1の処理を再帰的に行う
というソートアルゴリズムです.
最良計算量, 平均計算量, 最悪計算量はO(n^2)となります.
module Sort.SelectionSort where
import Data.List
selectionSort :: Ord a => [a] -> [a]
selectionSort [] = []
selectionSort list = minX : selectionSort (delete minX list)
where
minX = minimum list
@as_capablさんにアドバイスを頂いた, unfoldを用いたバージョンです.
但し, minimumとdeleteで走査を2回行っている点はまだ改善できていません.
separateMinimum :: Ord a => [a] -> Maybe (a, [a])
separateMinimum [] = Nothing
separateMinimum list = Just (x, xs)
where
x = minimum list
xs = delete x list
selectionSort' :: Ord a => [a] -> [a]
selectionSort' = unfoldr separateMinimum
ヒープソート
ヒープソートは,
- 2分ヒープ木を作る
- 根の要素を整列済みデータに移動する
- 根を除いた残りのデータに対し, 上記を再帰的に行う
というソートアルゴリズムです.
最良計算量, 平均計算量, 最悪計算量は全てO(n log n)となります.
このソートアルゴリズムは, 2分ヒープ木の根が常に最大値となる性質を利用しています.
※ソートとしては正しく動作していますが, これが本当に正しい実装である自信はありません. 指摘がありましたら是非教えていただきたいです. また, 他のソートアルゴリズムと違い整列順が逆順になっています. こちらも思い付き次第修正したいと思います.
module HeapSort where
import Data.Maybe
import Data.List
data Heap a = Leaf (Maybe a)
| Node (Heap a) a (Heap a)
deriving ( Show
, Eq)
mkHeap :: (Foldable t, Ord a) => t a -> Heap a
mkHeap = foldr push (Leaf Nothing)
push :: Ord a => a -> Heap a -> Heap a
push x h@(Node l e r) | x < e = if r == Leaf Nothing
then Node l
e
(push x r)
else Node (push x l)
e
r
| otherwise = Node h
x
(Leaf Nothing)
push x (Leaf e) = case e of
Just n -> Node (Leaf (Just (min n x)))
(max n x)
(Leaf Nothing)
Nothing -> Leaf (Just x)
toList (Leaf e) = case e of
Just n -> [n]
Nothing -> []
toList (Node l e r) = toList l ++ e : toList r
root (Node _ e _) = Just e
root (Leaf l) = l
heapsort [] = []
heapsort [x] = [x]
heapsort xs = rt : heapsort (delete rt xs)
where rt = (fromJust . root . mkHeap) xs
クイックソート
クイックソートは,
- リストの要素から1つピボットを選ぶ
- その要素と比較して小さい要素のリストと大きい要素のリストに分割し, 連結する
- それぞれのリストに対し1, 2の処理を再帰的に行う.
というソートアルゴリズムです.
最良計算量, 平均計算量はO(n log n), 最悪計算量はO(n^2)となります.
一般に最速と言われていますが, ピボットの選択の仕方によっては最悪計算量はO(n^2)になります.
本来はなるべくピボットが中央値になるように選ぶべきなのですが, あくまでもアルゴリズムをHaskellで実装する事が目的なのでピボットはリストの先頭要素としています.
気が向けばその辺を調整したバージョンを書くかも知れません.
module Sort.QuickSort where
import Data.List
quickSort :: Ord a => [a] -> [a]
quickSort [] = []
quickSort (x : xs) = quickSort lesser ++ x : quickSort greater
where
(lesser, greater) = partition (<x) xs
1個目のAppendを消し去る方法募集中
並列処理版を書きました。
アルゴリズム自体の見通しがかなり良いままで書き換えられたので良いですね。Haskell最高。
module ParallelQuickSort where
import Data.List
import Control.Parallel.Strategies ( runEval
, rpar)
pqsort :: Ord a => [a] -> [a]
pqsort [] = []
pqsort (x : xs) = runEval $ do sls <- (rpar . pqsort) lesser
sgs <- (rpar . pqsort) greater
return $ sls ++ x : sgs
where (lesser, greater) = partition (< x) xs
結果
stack exec -- SerialQSort +RTS -N8
66.50s user
52.06s system
382% cpu
31.018 total
stack exec -- ParallelQSort +RTS -N8
74.28s user
15.48s system
607% cpu
14.786 total
環境:Windows10 Intel corei7 4790K(4コア8スレッド)
Userが長いのがよくわかりませんが、"user > real なのでOSスレッドを複数使ったことがわかる。"らしいのできっと成功しています。
バケツソート
バケツソート(※訳注より:バケットソートと訳される事が多い)は,
- 要素の種類(以上)の大きさの配列(=バケツ)を用意
- 該当のバケツにデータを放り込む
- バケツを畳み込む
というソートアルゴリズムです.
最良計算量はO(n), 平均計算量はO(n + k), 最悪計算量はO(n^2)となります.
module Bucketsort where
import Data.Array.ST
import Data.Array
bsort :: (Ix a, Foldable t) => t a -> [a]
bsort xs = concatMap (\x -> replicate (snd x) (fst x)) .
assocs $ runSTArray $
do bucket <- newArray (minimum xs, maximum xs) 0
mapM_ (\i -> (+ 1) <$> readArray bucket i >>=
writeArray bucket i)
xs
return bucket
必要以上に型クラスを要求してしまっているのがちょっと如何なものかなあとは思っています。
マージソート
マージソートは,
- リストを分割する(等分であることが望ましい)
- リストが処理しやすい大きさになるまで1の処理を再帰的に行う
- それぞれのリストをソートする
- それぞれのリストを再帰的にマージする
というソートアルゴリズムです.
今回はリストの要素が1つになるまで分割を行いました.
module Sort.MergeSort where
import Data.List
merge :: Ord a => [a] -> [a] -> [a]
merge [] y = y
merge x [] = x
merge (x : xs) (y : ys)
| x <= y = x : merge xs (y : ys)
| otherwise = y : merge (x : xs) ys
halve :: [a] -> ([a], [a])
halve list = (take lsLength list, drop lsLength list)
where
lsLength = div (length list) 2
mergeSort :: Ord a => [a] -> [a]
mergeSort [] = []
mergeSort [x] = [x]
mergeSort list = merge (mergeSort $ fst hlist) (mergeSort $ snd hlist)
where
hlist = halve list
探索
逐次探索(線形探索)
module SequentialSearch where
sequentialSearch :: Eq a => [a] -> a -> Bool
sequentialSearch [] _ = False
sequentialSearch (x : xs) target
| x == target = True
| otherwise = sequentialSearch xs target
二分探索
module BinarySearch where
isSorted :: Ord a => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted (x1 : x2 : xs)
| x1 <= x2 = isSorted (x2 : xs)
| otherwise = False
data SearchError = Unsorted deriving (Show)
showError :: SearchError -> String
showError Unsorted = "This list is unsorted."
binarySearch :: Ord a => [a] -> a -> Either SearchError Bool
binarySearch [] _ = Right False
binarySearch list target
| not $ isSorted list = Left $ Unsorted
| midVal == target = Right True
| midVal < target = binarySearch (drop (mid + 1) list) target
| midVal > target = binarySearch (take mid list) target
where
mid = div (length list) 2
midVal = list !! mid
アルゴリズムクイックリファレンスでは, 整列済み配列が渡される前提になっていました.
ですので, もう2パターン書いてみました.
まずは, 本の通り"整列済みリストが渡される前提"の二分探索です.
これだと, 未整列のリストが渡された場合には間違った結果を返す事があります.
binarySearch' :: Ord a => [a] -> a -> Bool
binarySearch' [] _ = False
binarySearch' list target
| midVal == target = True
| midVal < target = binarySearch' (drop (mid + 1) list) target
| midVal > target = binarySearch' (take mid list) target
where
mid = div (length list) 2
midVal = list !! mid
次に, "未整列のリストが渡された場合、整列処理を行ってから探索を開始する"二分探索です.
今回は整列にクイックソートを用いましたが, "整列は最終確認であって基本的に殆ど整列されているリストが渡される"はずだとするのであれば挿入ソートにした方が良かったのかなとも思ったりしています.
この場合最適な整列アルゴリズムはどれなのかどなたか教えて頂けると有り難いです.
binarySearch'' :: Ord a => [a] -> a -> Bool
binarySearch'' [] _ = False
binarySearch'' list target
| not $ isSorted list = binarySearch'' (quickSort list) target
| midVal == target = True
| midVal < target = binarySearch'' (drop (mid + 1) list) target
| midVal > target = binarySearch'' (take mid list) target
where
mid = div (length list) 2
midVal = list !! mid