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

2009-08-18

JPEG判定

04:49

これを見てて、Haskell だとどうなるんだろうなー、と思って色々調べながらコネコネしてみた。


import Char
import System
import System.IO

checkSOI (x:[]) = False
checkSOI (x:x':_) = x == 0xFF && x' == 0xD8

checkEOI (x:[]) = False
checkEOI xs = checkEOI' $ reverse xs
    where
        checkEOI' (x:x':_) = x == 0xD9 && x' == 0xFF

jpgCheck xs = checkSOI xs && checkEOI xs

main = do
        args <- getArgs
        if null args
            then putStrLn "Error! Usage : jpgCheck filename"
            else do
                h <- openBinaryFile (head args) ReadMode
                cs <- hGetContents h
                print $ jpgCheck $ map ord cs

使い方。

% runghc jpgCheck.hs image.jpg
True
% runghc jpgCheck.hs text.txt
False

バイナリファイルを開くのは import System.IO して openBinaryFile path ReadMode

Linux などでは openFile と同じらしい。たぶん OS X も。


map ord を使うのが良い方法な気がしない。ByteString とか Word8 も調べたんだけど、使い方がよくわからなかった…

突っ込み歓迎。


上の記事の続き

01:08

なるほど。ByteString はこう使うのか。

hGetContents を override して、IO String ではなくて IO ByteString を返すようにするわけですね。ここの部分がよくわからなかったので前は諦めた。

bracket も新鮮。try-finally だそうな。

System.Environment というのの中に getProgName というのもあるのね。それを使って書けばよかった。

eagletmteagletmt2009/08/20 09:28override というよりは,hGetContents :: Handle -> IO ByteString のみをインポートするかんじですね.
hGetContents :: Handle -> IO String は Prelude にはないので,明示的にインポートしなければ使えません.
プログラム中で両方使いたい場合は,例えば
import System.IO
import qualified Data.ByteString as B
などとして,hGetContents :: Handle -> IO String, B.hGetContents :: Handle -> IO ByteString のように使い分けられます.

edvakfedvakf2009/08/20 09:54丁寧にありがとうございます。
qualified とか as の意味もよくわかっていませんでしたが、たぶんわかったと思います。

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090818

2009-06-27

withの説明どこにあるの?

23:30

↓で with 式というものがあるのを知った。

でも Haskell with とかで探しても説明が見つからない。

検索エンジンで探せないものほど不便なものはないな。

eagletmteagletmt2009/06/28 13:26Hoogle はどうでしょう: http://www.haskell.org/hoogle/

edvakfedvakf2009/06/28 14:50こういうのがあるんですね。便利。
with は式じゃなくてただの関数でした。
名前が汎用すぎるのでてっきり Haskell 自身のものかと思いました。

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090627

2009-06-26

4つの異なる素数を因数に持つ数が4つ続くところを見つける

08:10

説明は面倒なのでリンク先を見てもらうとする。


import List

factors :: Integer -> [Integer]
factors n = f n (2:[3,5..])
  where
    f n (m:ms) | n <= 1         = []
               | n < m * m      = [n]
               | n `mod` m == 0 = m:f (n `div` m) (m:ms)
               | otherwise      = f n ms

dpf n = (==n) . length . nub . factors

conseq n xs = conseq' xs []
    where
        conseq' (x:xs') [] = conseq' xs' [x]
        conseq' (x:xs') ys@(y:_) = if length ys == n
                                   then reverse ys
                                   else if x == y + 1
                                        then conseq' xs' (x:ys)
                                        else conseq' xs' [x]

main = print $ conseq 4 $ filter (dpf 4) [2..]

自然数を素因数分解する関数 factors は昨日の続きでこちらから拝借。

素因数分解するのに素数のリストを求めるのは、割り算が無駄に増えるだけで効率が悪い、と言われてみればその通りだけど思いつかなかった。

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090626

2009-06-25

エラトステネスのふるいをちょっぴり速く

14:33

primes = sieve [2..]
    where
        sieve (x:xs) = x : sieve ([y| y <- xs, y `mod` x /= 0])

こう書いてたところを、こうしてみた。

primes = sieve (2:[3,5..])

速さ変わらず。(hugs)

こうしてみた。

primes = 2 : (sieve [3,5..])

速さ変わらず。(hugs)


発想を変えて、こうしてみた。

primes = sieve [2..]
    where
        sieve (x:xs) = x : sieve ([y| y <- xs, x*x > y || y `mod` x /= 0])

約3倍に速くなった。(hugs,GHCi,GHC コンパイル)

sqrt(n) までの数で割り切れなければ n は素数決定というやつ。x*x > y である場合は y `mod` x /= 0 を計算しなくていい。


しかし、一般的に速くなるとは限らないらしい。昨日の Goldbach 問題↓で試すと、hugs で実行したり GHC でコンパイルした場合は確かに速くなるのに、GHCi では逆に若干遅くなってしまう。(気にするところじゃないかもしれないけど)


まだ気になるのは、例えば7を素数と断定するときに、

  • 2の自乗より大きいかチェック -- True
  • 2で割れるかチェック -- False
  • 3の自乗より大きいかチェック -- False
  • 5の自乗より大きいかチェック -- False

という手順を踏んでいるのだけど、3の自乗より大きくない時点で5の自乗より大きくないのは分かっているので、そこを省略するにはどうしたらいいのだろう?


答えがあった

primes' :: [Integer]
primes' = 2:sieve' [3] [5,7..]

sieve' :: [Integer] -> [Integer] -> [Integer]
sieve' (p:ps) xs = p:sieve' (ps++ps') [x | x <- qs, mod x p /= 0]
  where (ps', qs) = span (<(p*p)) xs

ちょうど考えてたやつと同じような感じだった。ps++ps' のオーダーが ps のサイズであるのが惜しいけど、文句なしにこっちのほうが速い。


unwordsはO(n^2)?

14:34

unwords          :: [String] -> String
unwords []       =  ""
unwords ws       =  foldr1 (\w s -> w ++ ' ':s) ws

w は継ぎ足す度にどんどん大きくなっていく。単語の長さの平均を a とすると、w の大きさは最初が a、次が 2*a、次が 3*a、となる。全体のステップ数は

a + 2*a + 3*a + ... + n*a = a*n*(n+1)/2

で O(n^2) だと思うんだけど、print に繋げる場合などは、出来た部分から順に出力していけばいいのだから (実際そうなってる) 最適化されるのだろうか?

トラックバック - http://haskell.g.hatena.ne.jp/edvakf/20090625
|