Posted at

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


はじめに

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

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

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

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

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


実装

以下のように実装した。

産まれて初めてマージソートを書いた。


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'



使用例


普通のマージソート


Test.hs

mergeSort :: Ord a => [a] -> [a]

mergeSort xs = runIdentity $ sortByM (\x y -> return $ compare x y) xs


ghci

GHCi> mergeSort [5,2,6,21,59,24,9]

[2,5,6,9,21,24,59]

良さそう


好きなお酒ランキング

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


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 を決めることでリストをシャッフルできる


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


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]



並び順の総当たり

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


Test.hs

allPerm :: [a] -> [[a]]

allPerm xs = sortByM (\ _ _ -> [LT,GT]) xs


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モナドで表現する。

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

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


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を使ったほうが楽そうだが)

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