アルゴリズムクイックリファレンス第2版をHaskellで書く修行 #Haskell

# アルゴリズムクイックリファレンス第2版をHaskellで書く修行

アルゴリズムクイックリファレンス第2版に載っている, 約40のアルゴリズムをHaskellで実装していきます.
ソースは[ここ](https://github.com/Tatsuki-I/algos-hs)に置いています.

## 注意

以下の点に注意して下さい.

- 最適解ではないものが多く含まれるかと思います(より良い書き方があれば是非教えて下さい)
- 主に配列ではなくリストを用います
- 基本的にnot-in-placeな処理を書きます([WikipediaのIn-placeアルゴリズム](https://ja.wikipedia.org/wiki/In-place%E3%82%A2%E3%83%AB%E3%82%B4%E3%83%AA%E3%82%BA%E3%83%A0#.E9.96.A2.E6.95.B0.E5.9E.8B.E3.83.97.E3.83.AD.E3.82.B0.E3.83.A9.E3.83.9F.E3.83.B3.E3.82.B0)にある通り, 関数型プログラミングではin-placeアルゴリズムを推奨していない事が多いため)
- アルゴリズムによっては条件が諸説あるものもあるかと思いますが, 基本的にアルゴリズムクイックリファレンス第2版の記載に準拠するものとします
- それぞれのアルゴリズムの説明は時間がある時に書きます
- 気分の赴くままの順番で書いていきます

## 目次

- [整列](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E6%95%B4%E5%88%97)
  - [挿入ソート](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E6%8C%BF%E5%85%A5%E3%82%BD%E3%83%BC%E3%83%88)
  - [選択ソート](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E9%81%B8%E6%8A%9E%E3%82%BD%E3%83%BC%E3%83%88)
  - [ヒープソート](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E3%83%92%E3%83%BC%E3%83%97%E3%82%BD%E3%83%BC%E3%83%88)
  - [クイックソート](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E3%82%AF%E3%82%A4%E3%83%83%E3%82%AF%E3%82%BD%E3%83%BC%E3%83%88)
  - [バケツソート](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E3%83%90%E3%82%B1%E3%83%84%E3%82%BD%E3%83%BC%E3%83%88)
  - [マージソート](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E3%83%9E%E3%83%BC%E3%82%B8%E3%82%BD%E3%83%BC%E3%83%88)

- [探索](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E6%8E%A2%E7%B4%A2)
 - [逐次探索(線形探索)](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E9%80%90%E6%AC%A1%E6%8E%A2%E7%B4%A2%E7%B7%9A%E5%BD%A2%E6%8E%A2%E7%B4%A2)
 - [二分探索](http://qiita.com/Tatsuki-I/items/75b28a17419956ea6f8d#%E4%BA%8C%E5%88%86%E6%8E%A2%E7%B4%A2)
 - ハッシュに基づいた探索
 - ブルームフィルタ
 - 二分探索木

以下随時追加

## 整列

### 挿入ソート

挿入ソートは, 

1. 未整列リストの先頭要素を読み込む
2. 読み込んだ要素を整列済みのリストの正しい位置に挿入する
3. 未整列リストに対して1, 2の処理を再帰的に行う

というソートアルゴリズムです.
最良計算量はO(n), 平均計算量と最悪計算量はO(n^2)となります.

Haskellには今回したい処理にピッタリなinsert関数がありました.
これとfoldr関数を組み合わせる事で挿入ソートが実現できます. 

```InsertionSort.hs
module Sort.InsertionSort where

import Data.List

insertionSort :: Ord a => [a] -> [a]
insertionSort = foldr insert []
```

以上のようになります.
foldrがどう動くのかが慣れるまでは分かり辛いですが, 今回の場合は以下のようになります.
リストは`[4, 1, 3, 5, 2]`とします.

```hs 
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. 未整列リストの最小値を整列済みリストの最後尾に移動させる
2. 未整列リストに対して1の処理を再帰的に行う

というソートアルゴリズムです.
最良計算量, 平均計算量, 最悪計算量はO(n^2)となります.

```SelectionSort.hs
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](http://qiita.com/as_capabl)さんにアドバイスを頂いた, unfoldを用いたバージョンです.
但し, minimumとdeleteで走査を2回行っている点はまだ改善できていません.

```SelectionSort.hs
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
```

### ヒープソート

ヒープソートは,

1. 2分ヒープ木を作る
1. 根の要素を整列済みデータに移動する
1. 根を除いた残りのデータに対し, 上記を再帰的に行う

というソートアルゴリズムです.
最良計算量, 平均計算量, 最悪計算量は全てO(n log n)となります.

このソートアルゴリズムは, 2分ヒープ木の根が常に最大値となる性質を利用しています.

※ソートとしては正しく動作していますが, これが本当に正しい実装である自信はありません. 指摘がありましたら是非教えていただきたいです. また, 他のソートアルゴリズムと違い整列順が逆順になっています. こちらも思い付き次第修正したいと思います.

```HeapSort.hs
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. その要素と比較して小さい要素のリストと大きい要素のリストに分割し, 連結する
3. それぞれのリストに対し1, 2の処理を再帰的に行う.

というソートアルゴリズムです.
最良計算量, 平均計算量はO(n log n), 最悪計算量はO(n^2)となります.

一般に最速と言われていますが, ピボットの選択の仕方によっては最悪計算量はO(n^2)になります.
本来はなるべくピボットが中央値になるように選ぶべきなのですが, あくまでもアルゴリズムをHaskellで実装する事が目的なのでピボットはリストの先頭要素としています.
気が向けばその辺を調整したバージョンを書くかも知れません.

```QuickSort.hs
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最高。

```ParallelQuickSort.hs
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
```

結果

```shell
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スレッドを複数使ったことがわかる。"](http://tomitake3.hatenablog.com/entry/2019/01/22/205753)らしいのできっと成功しています。

### バケツソート

バケツソート(※訳注より:バケットソートと訳される事が多い)は,

1. 要素の種類(以上)の大きさの配列(=バケツ)を用意
1. 該当のバケツにデータを放り込む
1. バケツを畳み込む

というソートアルゴリズムです.
最良計算量はO(n), 平均計算量はO(n + k), 最悪計算量はO(n^2)となります.


```BucketSort.hs
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. リストを分割する(等分であることが望ましい)
2. リストが処理しやすい大きさになるまで1の処理を再帰的に行う
3. それぞれのリストをソートする
4. それぞれのリストを再帰的にマージする

というソートアルゴリズムです.
今回はリストの要素が1つになるまで分割を行いました.

```MergeSort.hs
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
```

## 探索

### 逐次探索(線形探索)

```SequentialSearch.hs
module SequentialSearch where

sequentialSearch :: Eq a => [a] -> a -> Bool
sequentialSearch [] _ = False
sequentialSearch (x : xs) target
        | x == target = True
        | otherwise   = sequentialSearch xs target
```

### 二分探索

```BinarySearch.hs
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.hs
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.hs
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
```

### ハッシュに基づいた探索

### ブルームフィルタ

### 二分探索木