ランダムソート(笑)をHaskellで

Haskell 30分プログラム

30分プログラム、その527。ランダムソート(笑)をHaskellでやってみた。
なんかおもろそうだな、と気楽に始めたら意外と難しかった。

  • Haskellで乱数といえば、Stateモナドだよな
  • Stateがいるから、Data.Listのsortが使えない -> sortの再実装
  • 比較関数がStateだから、filterが使えない-> filterの再実装

みたいな感じで再実装しないといけない部分が多くて大変だった。

最終的に

randomSort :: [a] -> IO [a]

という、それっぽい型の関数が得られたので満足です。

使い方

*Main Data.List> randomSort [1..10]
[9,10,1,7,5,2,8,3,4,6]
*Main Data.List> randomSort [1..10]
[7,4,9,2,5,1,10,8,6,3]
*Main Data.List> randomSort [1..10]
[10,2,5,1,6,3,4,9,8,7]

ソースコード

import System.Random
import Control.Monad.State
import Data.List

randomCmp :: RandomGen g => a -> a -> State g Bool
randomCmp _ _ = do g <- get
                   (x,g') <- return $ random g
                   put g'
                   return x

filterS :: (a -> State b Bool) -> [a] -> State b [a]
filterS _ [] = do return []
filterS f (x:xs) = do ok <- f x
                      ys <- filterS f xs
                      if ok
                        then return (x:ys)
                        else return ys

spanS :: (a -> State b Bool) -> [a] -> State b ([a],[a])
spanS _ [] = do return ([],[])
spanS f (x:xs) = do ok <- f x
                    (ys,zs) <- spanS f xs
                    if ok
                      then return (x:ys,zs)
                      else return (ys  ,x:zs)

qsortS :: (a -> a -> State b Bool) -> [a] -> State b [a]
qsortS _ [] = do return []
qsortS less (x:xs) = do (ys,zs) <- spanS (\b -> less x b) xs
                        ys' <- qsortS less ys
                        zs' <- qsortS less zs
                        return $ ys' ++ [x] ++ zs'

randomSort xs = do g <- newStdGen
                   return $ fst $ runState (qsortS randomCmp xs) g

参考