Hatena::Grouphaskell

Haskellで遊ぶよ

 | 

2009-11-30

Insertion Sort

15:46

一部で流行りの Insertion Sort をやってみる。

insertionSort :: (Ord a) => [a] -> [a]
insertionSort [] = []
insertionSort (x:xs) = insertionSort' [x] xs

insertionSort' :: (Ord a) => [a] -> [a] -> [a]
insertionSort' os [] = os
insertionSort' os us = insertionSort' os'' us''
    where
        (os', us', olast) = separateSorted us -- olast : last (rightmost) of os'
        (ls, us'') = span (< olast) us'  -- ls : all less than olast, us'' : unordered (head us'' >= olast)
        os'' = insertAll (os++os') ls

separateSorted :: (Ord a) => [a] -> ([a], [a], a)
separateSorted xs@(x:[]) = (xs, [], x)
separateSorted xs@(x:xs'@(x':_))
    | x <= x'   = (x:os, us, m)
    | otherwise = ([x], xs', x)
        where
            (os, us, m) = separateSorted xs'

insertAll :: (Ord a) => [a] -> [a] -> [a]
insertAll os [] = os
insertAll os (l:ls) = insertAll (insert os l) ls

insert :: (Ord a) => [a] -> a -> [a]
insert os u = ls ++ (u:hs)
    where
        (ls, hs) = span (< u) os -- span lows and highs

main = print $ insertionSort [3,4,5,3,2,1,4]

複雑になりすぎた気もするけど、一応結果はちゃんと出た。

insertionSort 関数はダミーで実際は insertionSort'。エレガントじゃない…

separateSorted は与えられたリストに対して、3つの要素から成るタプルを返す。すなわち、

  1. 最初から昇順で並ぶところまでのリスト
  2. それ以外のリスト
  3. 最後に昇順のもののうちで最大 (一番右側) のメンバー

久しぶりに Haskell を書いた。Snow Leopard では GHCHugs も MacPorts で入らないっぽいので、出力は全部 codepad で確認した。


比較関数

比較関数を与えられるバージョン↓も作ろうとしてみたけど、これはちょっとおかしい。比較関数として (<) を与えた場合はちゃんと昇順になるのに、(>) の場合はそもそもソートできないっぽい。

insertionSort :: (Ord a) => (a -> a -> Bool) -> [a] -> [a]
insertionSort p [] = []
insertionSort p (x:xs) = insertionSort' [x] xs
    where
        insertionSort' os [] = os
        insertionSort' os us = insertionSort' os'' us''
            where
                (os', us', olast) = separateSorted us 
                (ls, us'') = span (\x -> p x olast) us'
                os'' = insertAll (os++os') ls

        separateSorted xs@(x:[]) = (xs, [], x)
        separateSorted xs@(x:xs'@(x':_))
            | x <= x'   = (x:os, us, m)
            | otherwise = ([x], xs', x)
                where
                    (os, us, m) = separateSorted xs'

        insertAll os [] = os
        insertAll os (l:ls) = insertAll (insert os l) ls

        insert os u = ls ++ (u:hs)
            where
                (ls, hs) = span (\x -> p x u) os

main = print $ insertionSort (>) [3,4,5,3,2,1,4]

何が悪いんだろう。


foldl の存在を思い出したら一瞬でできた

insertionSort [] = []
insertionSort (x:xs) = fst $ foldl (\(os,m) n -> if m > n then ((insert os n), m) else (os++[n], n)) ([x], x) xs

insert os u = ls ++ (u:hs)
    where
        (ls, hs) = span (< u) os

main = print $ insertionSort [3,4,5,3,2,1,4]

ただ、比較関数を指定できるようにすると降順にできないのは相変わらず。

比較関数があってもちゃんとできた


インターフェイスを List の sort に合わせてみた

import List

insertionSortBy :: (a -> a -> Ordering) -> [a] -> [a]
insertionSortBy cmp [] = []
insertionSortBy cmp (x:xs) = fst $ foldl insertOrAppend ([x], x) xs
    where 
        insertOrAppend (os, x) y = case cmp x y of
            GT -> (insertBy cmp y os, x)
            _  -> (os++[y], y)

main = print $ insertionSortBy compare [3,4,5,3,2,1,4]

逆順の場合は↓みたいなのを作ればいいのかな。(要素が多くないなら reverse したほうが速いと思う)

compareReverse :: (Ord a) => a -> a -> Ordering
compareReverse x y = if x > y then LT
            else if x < y then GT
            else EQ

先人の発明をググってみた

なーるほど。頭が固かった。。

import List

insertionSort :: Ord a => [a] -> [a]
insertionSort = insertionSortBy compare

insertionSortBy :: Ord a => (a -> a -> Ordering) -> [a] -> [a]
insertionSortBy cmp [] = []
insertionSortBy cmp (x:xs) = insertBy cmp x $ insertionSortBy cmp xs

main = print $ insertionSort [3,4,5,3,2,1,4]

自分の書いてたやつだと insert するか append するかで分けないといけなかった (コスト的に) けど、後ろからソートしていくことによって全部 insert でよくなった。


こっちのがいいかも

import List

insertionSort :: Ord a => [a] -> [a]   
insertionSort = insertionSortBy compare

insertionSortBy :: Ord a => (a -> a -> Ordering) -> [a] -> [a]
insertionSortBy cmp = foldr (insertBy compare) []

main = print $ insertionSort [3,4,5,3,2,1,4]
トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20091130
 |