Haskell - 探索とソート(挿入ソート、選択ソートとバブルソートのパフォーマンスを比較(Data.Timeモジュール, getCurrentTime, diffUTCTime関数))

すごいHaskellたのしく学ぼう!
(オーム社)
Miran Lipovača (著)
田中 英行 村主 崇行 (翻訳)
[Kindle版]

開発環境

• OS X Mavericks - Apple(OS)
• BBEdit - Bare Bones Software, Inc., Emacs (Text Editor)
• Haskell (純粋関数型プログラミング言語)
• GHC (The Glasgow Haskell Compiler) (処理系)
• The Haskell Platform (インストール方法、モジュール等)

初めてのコンピュータサイエンス(Jennifer Campbell、Paul Gries、Jason Montojo、Greg Wilson(著)長尾 高弘(翻訳))の11章(探索とソート)、11.7(練習問題)、11-5.をHaskellで解いてみる。

その他参考書籍

• プログラミングHaskell (オーム社) Graham Hutton(著) 山本 和彦(翻訳)
• Real World Haskell―実戦で学ぶ関数型言語プログラミング (オライリージャパン) Bryan O'Sullivan John Goerzen Don Stewart(著) 山下 伸夫 伊東 勝利 株式会社タイムインターメディア(翻訳)

11.7(練習問題)、11-5.

コード(BBEdit)

Sample.hs

{-# OPTIONS -Wall -Werror #-}

import Data.Time

main :: IO ()
main  = mapM_ (\(x, y) -> do putStr $ show x ++ " "
                             let xs = take x [0..]
                             printTimes y (reverse xs) xs)
              [(a, b) | a <- [100, 200..500], b <- [selectionSort,
                                                    insertionSort,
                                                    bubbleSort,
                                                    bubbleSort1]]

printTimes :: (Ord a) => ([a] -> [a]) -> [a] -> [a] -> IO ()
printTimes s ns ms = do
    start <- getCurrentTime
    putStr $ (show $ s ns == ms) ++ " "
    stop <- getCurrentTime
    putStrLn $ show $ diffUTCTime stop start

selectionSort :: (Ord a) => [a] -> [a]
selectionSort [] = []
selectionSort ns =
    let (m, ms) = findMin ns
    in m:selectionSort ms

findMin :: (Ord a) => [a] -> (a, [a])
findMin (n:ns) = iter n ns []
findMin _ = error "エラー: findMin"

iter :: (Ord a) => a -> [a] -> [a] -> (a, [a])
iter x [] ns = (x, ns)
iter x (n:ns) ms = if n < x then iter n ns (x:ms) else iter x ns (n:ms)

insertionSort :: (Ord a) => [a] -> [a]
insertionSort ns = f ns []

f :: (Ord a) => [a] -> [a] -> [a]
f [] ns = ns
f (n:ns) [] = f ns (n:[])
f (n:ns) ms = f ns (g n ms)

g :: (Ord a) => a -> [a] -> [a]
g a [] = a:[]
g a (n:ns) = if n <= a then
                 n:g a ns
             else
                 a:n:ns

bubbleSort :: [Int] -> [Int]
bubbleSort [] = []
bubbleSort (n:ns) = h n [] ns []

h :: Int -> [Int] -> [Int] -> [Int] -> [Int]
h x [] [] ls = x:ls
h x (n:ns) [] ls = h n [] ns (x:ls)
h x ns (m:ms) ls = if x > m then
                               h x (ns ++ [m]) ms ls
                           else
                               h m (ns ++ [x]) ms ls

bubbleSort1 :: [Int] -> [Int]
bubbleSort1 [] = []
bubbleSort1 ns = i (last ns) (init ns) [] []

i :: Int -> [Int] -> [Int] -> [Int] -> [Int]
i x [] [] ls = ls ++ [x]
i x [] ms ls = i (last ms) (init ms) [] (ls ++ [x])
i x ns ms ls =
    let n = last ns
        ks = init ns
    in if x < n then
           i x ks (n:ms) ls
       else
           i n ks (x:ms) ls

入出力結果(Terminal, runghc)

$ runghc Sample.hs
100 True 0.005376s
100 True 0.000169s
100 True 0.011204s
100 True 0.011233s
200 True 0.017586s
200 True 0.000317s
200 True 0.053748s
200 True 0.056337s
300 True 0.043381s
300 True 0.000476s
300 True 0.149522s
300 True 0.150785s
400 True 0.070455s
400 True 0.000623s
400 True 0.379376s
400 True 0.32938s
500 True 0.113105s
500 True 0.000744s
500 True 0.807852s
500 True 0.587509s
$

慣れるまでは{-# OPTIONS -Wall -Werror #-}の記述を消さずに細かく型を指定していくことに。