sortByMを実装して、ぼくの好きなお酒ランキングを作る

#はじめに
`Control.Monad` には、`mapM` `foldM` `filterM` `zipWithM` など、モナドを使った便利な高階関数がたくさん定義されている。

しかし、この中に `sortByM` という関数が定義されていないことに気が付いた。

つまり、このような型の関数がない。

```hs
sortByM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a]
```

これがあれば便利な気がしたので実装して遊んでみる。

# 実装
以下のように実装した。
産まれて初めてマージソートを書いた。

```hs:Sort.hs
module Sort where

sortByM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a]
sortByM cmp xs = mergeAllM cmp . map pure $ xs

-- 複数のリストを再帰的にマージする
mergeAllM :: Monad m => (a -> a -> m Ordering) -> [[a]] -> m [a]
mergeAllM _ [xs] = return xs
mergeAllM cmp xss = mergeAllM cmp =<< (sequence $ merge2M cmp <$> splitAtEach 2 xss)

-- 1つか2つのリストをマージして1つのリストにする
merge2M :: Monad m => (a -> a -> m Ordering) -> [[a]] -> m [a]
merge2M _ [xs1]     = return xs1
merge2M _ [xs1, []] = return xs1
merge2M _ [[], xs2] = return xs2
merge2M cmp [(x1:xs1),(x2:xs2)] = do
    ord <- cmp x1 x2
    case ord of
        LT -> (x1 :) <$> merge2M cmp [xs1, x2:xs2]
        GT -> (x2 :) <$> merge2M cmp [x1:xs1, xs2]
        EQ -> (x1 :) <$> (x2 :) <$> merge2M cmp [xs1, xs2]

-- リストをn個ごとに区切る
splitAtEach :: Int -> [a] -> [[a]]
splitAtEach n [] = []
splitAtEach 0 _ = error "split 0 _ is invalid"
splitAtEach n xs =
    let (x, xs') = splitAt n xs in
        x : splitAtEach n xs'
```

# 使用例
## 普通のマージソート
```hs:Test.hs
mergeSort :: Ord a => [a] -> [a]
mergeSort xs = runIdentity $ sortByM (\x y -> return $ compare x y) xs
```

```hs:ghci
GHCi> mergeSort [5,2,6,21,59,24,9]
[2,5,6,9,21,24,59]
```

良さそう

## 好きなお酒ランキング
`sortByM` に IO Ordering を返すような関数を渡すことで、インタラクティブに好きなお酒ランキングを作る関数が定義できる。

```hs:Test.hs
data Drink = Beer |Wine |Sake |Cider |Mead |Brandy |Gin |Tequila |Rum |Vodka
    deriving (Show, Enum)

drinks :: [Drink]
drinks = [Beer .. Vodka]

myRank :: Show a => [a] -> IO [a]
myRank xs = sortByM cmp xs
  where
    cmp x y = do
        putStrLn "Which do you like better? [1 or 2]"
        putStr "    1 : "
        print x
        putStr "    2 : "
        print y
        putStr "Answer> "
        hFlush stdout
        usrinput <- reads <$> getLine
        case usrinput of
            [(1, "")] -> putStrLn "" >> return LT
            [(2, "")] -> putStrLn "" >> return GT
            otherwise -> do
                putStrLn "¥n  !! Please input 1 or 2 !!¥n"
                cmp x y

```

ghciから実行してみる。

```:ghci
GHCi> myRank drink

Which do you like better? [1 or 2]
    1 : Beer
    2 : Wine
Answer> 1

Which do you like better? [1 or 2]
    1 : Sake
    2 : Cider
Answer> 2

中略

Which do you like better? [1 or 2]
    1 : Brandy
    2 : Vodka
Answer> 2

[Tequila,Beer,Cider,Sake,Gin,Mead,Rum,Wine,Vodka,Brandy]
```

ブランデーが最下位となったが、飲んだことがないだけであり、嫌いなわけではない

## リストのシャッフル
ランダムに Ordering を決めることでリストをシャッフルできる

```hs:Test.hs
shuffle :: [a] -> IO [a]
shuffle xs = sortByM cmp xs
  where
    cmp _ _ = do
        f <- randomIO :: IO Bool
        if f then
            return LT
        else
            return GT
```

```hs:ghci
GHCi> shuffle [1..10]
[10,7,5,9,3,4,1,2,8,6]

GHCi> shuffle [1..10]
[2,8,7,4,9,10,3,5,6,1]
```

## 並び順の総当たり
こんな感じに使うとリストの並び順の総当たりができる。

```hs:Test.hs
allPerm :: [a] -> [[a]]
allPerm xs = sortByM (\ _ _ -> [LT,GT]) xs
```

```hs:ghci
GHCi> allPerm [1..4]
[[1,2,3,4],[1,3,2,4],[1,3,4,2],[3,1,2,4],[3,1,4,2],[3,4,1,2],[1,2,4,3],[1,4,2,3],[1,4,3,2],[4,1,2,3],[4,1,3,2],[4,3,1,2],[2,1,3,4],[2,3,1,4],[2,3,4,1],[3,2,1,4],[3,2,4,1],[3,4,2,1],[2,1,4,3],[2,4,1,3],[2,4,3,1],[4,2,1,3],[4,2,3,1],[4,3,2,1]]
```

## 半順序集合の元に対するソート
半順序集合の上での比較は失敗することがある。
これをMaybeモナドで表現する。

集合に対して包含関係を順序とする例と、自然数に対して整除関係を順序とする例を以下に示す。

```hs:
class PartialOrd a where
    comparePartial :: a -> a -> Maybe Ordering

instance Ord a => PartialOrd (Set a) where
    comparePartial s1 s2
        |s1 == s2 = Just EQ
        |s1 `isSubsetOf` s2 = Just LT
        |s2 `isSubsetOf` s1 = Just GT
        |otherwise = Nothing

instance PartialOrd Int where
    comparePartial x y
        |x == y         = Just EQ
        |y `mod` x == 0 = Just LT
        |x `mod` y == 0 = Just GT
        |otherwise      = Nothing

sortPartial :: PartialOrd s => [s] -> Maybe [s]
sortPartial ss = sortByM comparePartial ss
```

```hs:ghci
GHCi> sortPartial [15, 1, 30, 5] :: Maybe [Int]
Just [1,5,15,30]

GHCi> sortPartial [15, 1, 30, 5, 3] :: Maybe [Int]
Nothing
```

#まとめ
自分は意外とシードルが好きだということに初めて気付かされた。

ここで挙げた以外にも、Stateモナドを使って「現在の各プレイヤーの得点から順位を決めてプレイヤーをソートする」みたいなこともできそう。（`on`を使ったほうが楽そうだが）

他にも何か面白い使い方を思いつきましたら、ぜひ教えてください