RWH / Drkcore

Real World Haskell 26章

Mon, 25 Oct 2010 20:25:47 +0919

ブルームフィルター

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

3,4日かけて一応buildまではしたが、テストとか動かしてない。いまいち理解も追いついてなかったのが心残りだが、一通り読み終わったのでよしとしよう。それにしてもこの本はPerl的には「続・はじめてのPerl」くらいのレベル？「実用 Perlプログラミング第2版」ではないでしょうなぁと。

みなさんこの先どうやって進んでいくんだろう？超気になるところ。

一周目は15章以降がほとんど理解できなかったけど、今回読んだら結構理解できたのでよかった。

プログラミングHaskell読書会にでて、問題もきちんと解いたってのも良かったのかも。

プログラミングHaskell
Graham Hutton
オーム社 / ￥ 2,940 ()
在庫あり。

Real World Haskell 28章

Thu, 21 Oct 2010 20:57:16 +0919

STM

この章ちょっと短い。もうちょい厚くして欲しかったかも。

STMモナドはI/Oを実行するものでも、非トランザクションの可変状態を扱えるようにするものでもない。トランザクションが保証するものを破るような操作を回避するもの
retry,orElse

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

Real World Haskell 27章

Wed, 20 Oct 2010 20:21:07 +0919

ソケットとsyslog

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

UDPの写経したら飽きたのでTCPの例はやってない。基本的にCに対応する関数が用意されているらしいので、内容はわかりやすかった。

Real World Haskell 25章

Tue, 19 Oct 2010 20:09:26 +0919

プロファイリングと最適化

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

GHCのランタイムには+RTS -RTSでランタイム専用の引数を渡せる
-fforce-recompで強制再コンパイル
ヒープの割り当て
WHNFに注意

融合

ストリーム融合というやつ

import System.Environment
import Text.Printf
import Data.Array.Vector

main = do
  [d] <- map read `fmap` getArgs
  printf "%f\n" (mean (enumFromToFracU 1 d))

data Pair = Pair !Int !Double

mean :: UArr Double -> Double
mean xs = s / fromIntegral n
    where 
      Pair n s       = foldlU k (Pair 0 0) xs
      k (Pair n s) x = Pair (n+1) (s+x)

Real World Haskell 24章 10

Sat, 16 Oct 2010 20:16:51 +0919

MapReduce、ただし、サンプルの通りでは動かない。

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

Control.Parallel.Strategiesを読むと

NFDataはControl.DeepSeqに移った。
rnfはもはやStrategyにはないのでかわりにrdeepseqを使え

とのことなのでそう書きなおしてみた。

$ time ./LineCount +RTS -N1 -RTS test.log 
test.log: 2146144

real    0m1.273s
user    0m0.709s
sys     0m0.318s
$ time ./LineCount +RTS -N2 -RTS test.log 
test.log: 2146144

real    0m0.652s
user    0m0.781s
sys     0m0.373s

お、速くなった。

MapReduce.hs

module MapReduce
    (
      mapReduce
    , simpleMapReduce
    -- exported for convenience
--    , rnf
--    , rwhnf
    ) where

import Control.Parallel (pseq)
import Control.Parallel.Strategies

simpleMapReduce
    :: (a -> b)
    -> ([b] -> c)
    -> [a]
    -> c

simpleMapReduce mapFunc reduceFunc = reduceFunc . map mapFunc

mapReduce
    :: Strategy b
    -> (a -> b)
    -> Strategy c
    -> ([b] -> c)
    -> [a]
    -> c

mapReduce mapStrat mapFunc reduceStrat reduceFunc input =
    mapResult `pseq` reduceResult
    where mapResult    = parMap mapStrat mapFunc input
          reduceResult = reduceFunc mapResult `using` reduceStrat

LineChunks.hs

module LineChunks
    (
     chunkedReadWith
    ) where

import Control.OldException (bracket, finally)
import Control.Monad (forM, liftM)
--import Control.Parallel.Strategies 
import Control.DeepSeq (NFData, rnf)
import Data.Int
import qualified Data.ByteString.Lazy.Char8 as LB
import GHC.Conc (numCapabilities)
import System.IO

data ChunkSpec = CS {
      chunkOffset :: !Int64
     ,chunkLength :: !Int64
    } deriving (Eq, Show)

withChunks :: (NFData a) =>
              (FilePath -> IO [ChunkSpec])
           -> ([LB.ByteString] -> a)
           -> FilePath
           -> IO a

withChunks chunkFunc process path = do
  (chunks, handles) <- chunkedRead chunkFunc path
  let r = process chunks
  (rnf r `seq` return r) `finally` mapM_ hClose handles

chunkedReadWith :: (NFData a) => 
                   ([LB.ByteString] -> a) -> FilePath -> IO a

chunkedReadWith func path =
    withChunks (lineChunks (numCapabilities * 4)) func path


chunkedRead :: (FilePath -> IO [ChunkSpec])
          -> FilePath
          -> IO ([LB.ByteString], [Handle])
chunkedRead chunkFunc path = do
  chunks <- chunkFunc path
  liftM unzip . forM chunks $ \spec -> do
                               h <- openFile path ReadMode
                               hSeek h AbsoluteSeek (fromIntegral (chunkOffset spec))
                               chunk <- LB.take (chunkLength spec) `liftM` LB.hGetContents h
                               return (chunk, h)

lineChunks :: Int -> FilePath -> IO [ChunkSpec]
lineChunks numChunks path = do
  bracket (openFile path ReadMode) hClose $ \h -> do
    totalSize <- fromIntegral `liftM` hFileSize h
    let chunkSize = totalSize `div` fromIntegral numChunks
        findChunks offset = do
          let newOffset = offset + chunkSize
          hSeek h AbsoluteSeek (fromIntegral newOffset)
          let findNewline off = do
                              eof <- hIsEOF h
                              if eof
                                 then return [CS offset (totalSize - offset)]
                                 else do
                                   bytes <- LB.hGet h 4096
                                   case LB.elemIndex '\n' bytes of
                                     Just n -> do
                                        chunks@(c:_) <- findChunks (off + n + 1)
                                        let coff = chunkOffset c
                                        return (CS offset (coff - offset):chunks)
                                     Nothing -> findNewline (off + LB.length bytes)
          findNewline newOffset
    findChunks 0

LineCount.hs

module Main where

import Control.Monad (forM_)
import Data.Int (Int64)
import qualified Data.ByteString.Lazy.Char8 as LB
import System.Environment (getArgs)
import LineChunks (chunkedReadWith)
import MapReduce (mapReduce)
import Control.Parallel.Strategies

lineCount :: [LB.ByteString] -> Int64
lineCount = mapReduce rdeepseq (LB.count '\n')
                      rdeepseq sum

main :: IO ()
main = do
  args <- getArgs
  forM_ args $ \path -> do
    numLines <- chunkedReadWith lineCount path
    putStrLn $ path ++ ": " ++ show numLines

Real World Haskell 24章 8,9

Fri, 15 Oct 2010 20:26:10 +0919

クィックソートを並列で。

正規形(NF),頭部正規形(HNF),弱頭部正規形(WHNF)を理解した。

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

module Sorting where

import Control.Parallel (par, pseq)

parSort :: (Ord a) => [a] -> [a]
parSort (x:xs) = force greater `par` (force lesser `pseq`
                                     (lesser ++x:greater))
    where lesser  = parSort [y|y <- xs, y<x]
          greater = parSort [y|y <- xs, y>=x]
parSort _ = []

force :: [a] -> ()
force xs = go xs `pseq` ()
    where go (_:xs) = go xs
          go [] = 1

sort :: (Ord a) => [a] -> [a]
sort (x:xs) = lesser ++ x:greater
    where lesser  = sort [y|y <- xs, y<x]
          greater = sort [y|y <- xs, y>=x]
sort _ = []

parSort2 :: (Ord a) => Int -> [a] -> [a]
parSort2 d list@(x:xs) 
   | d <= 0 = sort list
   | otherwise = force greater `par` (force lesser `pseq`
                                     (lesser ++x:greater))
       where lesser  = parSort2 d' [y|y <- xs, y<x]
             greater = parSort2 d' [y|y <- xs, y>=x]
             d' = d - 1
parSort2 _ _ = []

で実際に時間を測ってみると

-- parSort2
kzfm:ch24 kzfm$ ./SortMain +RTS -N2 -RTS 1000000
we have 1000000 elements to sort.
sorted all 1000000 elements.
11.419152s elapsed.

-- sort
kzfm:ch24 kzfm$ ./SortMain 1000000
we have 1000000 elements to sort.
sorted all 1000000 elements.
6.212093s elapsed.

-- parSort -N2
kzfm:ch24 kzfm$ ./SortMain +RTS -N1 -RTS 1000000
we have 1000000 elements to sort.
sorted all 1000000 elements.
6.188667s elapsed.

-- parSort -N2
kzfm:ch24 kzfm$ ./SortMain +RTS -N2 -RTS 1000000
we have 1000000 elements to sort.
sorted all 1000000 elements.
35.960397s elapsed.

GCのせいかな、よくわからん。

Real World Haskell 24章 1-7

Thu, 14 Oct 2010 20:25:06 +0919

並行マルチコアプログラミング

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

import Control.Concurrent

communicate = do
  m <- newEmptyMVar
  forkIO $ do
    v <- takeMVar m
    putStrLn ("received" ++ show v)
  putStrLn "sending"
  putMVar m "wake up!"

Control.ConcurrentのforkIOを使う
同期変数型MVarを使う
- MVarはデッドロックの原因になることがある
tryTakeMVarとtakeMVarの違い
スレッド間で一度だけ通信する場合にはMVarがよい。それ以外はChan型を使う
MVar,Chanは非正格

Real World Haskell 22章

Wed, 13 Oct 2010 20:24:31 +0919

webクライアントを作る章なのだけど、一度やったことあるのでHTTPまわりだけ。

import Network.HTTP

getGoogle = (simpleHTTP $ getRequest "http://google.com/") >>= getResponseBody

実行

*Main> getGoogle
Loading package HTTP-4000.0.9 ... linking ... done.
"<HTML><HEAD><meta http-equiv=\"content-type\" content=\"text/html;charset=utf-8\">\n \
<TITLE>301 Moved</TITLE></HEAD><BODY>\n<H1>301 Moved</H1>\n \
The document has moved\n<A HREF=\"http://www.google.com/\">here</A>. \
\r\n</BODY></HTML>\r\n"

\nと\r\nが混じっておるな。

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

Real World Haskell 21章

Tue, 12 Oct 2010 20:21:39 +0919

データベース

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

前回読んだときはデータベース接続まではやったので、今回はUTF-8で出力させてみた。

import Database.HDBC
import Database.HDBC.Sqlite3
import qualified Data.ByteString as B
import Control.Monad

svToUTF8 (SqlByteString s) = B.putStrLn s

main = do
  conn <- connectSqlite3 "drkcore.db"
  res  <- quickQuery conn "select title from entries" []
  mapM_ (mapM_ svToUTF8) (take 5 res)

実行

$ ghc --make dbtest.hs
[1 of 1] Compiling Main             ( dbtest.hs, dbtest.o )
Linking dbtest ...
$ ./dbtest 
blogを変えてみた
卓次郎商店でつけ麺
かど乃やで黒びしおラーメン
drkcore
はてなスターつけたヨ

mapM_を二回適用させないとイケないのはいまいち理解していないが型のエラーがそんな感じだったので、適当に直したら動いた。いい感じ

Real World Haskell 20章

Mon, 11 Oct 2010 17:39:50 +0919

システムプログラミング

Real World Haskell―実戦で学ぶ関数型言語プログラミング
Bryan O'Sullivan,John Goerzen,Don Stewart
オライリージャパン / ￥ 3,990 ()
在庫あり。

20.5のパイプの例がmac osxでは動かなかった

*RunProcessSimple> runIO $ ("pwd", []::[String])
Loading package array-0.3.0.1 ... linking ... done.
Loading package bytestring-0.9.1.7 ... linking ... done.
Loading package containers-0.3.0.0 ... linking ... done.
Loading package syb-0.1.0.2 ... linking ... done.
Loading package base-3.0.3.2 ... linking ... done.
Loading package mtl-1.1.0.2 ... linking ... done.
Loading package regex-base-0.93.2 ... linking ... done.
Loading package regex-posix-0.94.2 ... linking ... done.
Loading package regex-compat-0.93.1 ... linking ... done.
Loading package filepath-1.1.0.4 ... linking ... done.
Loading package old-locale-1.0.0.2 ... linking ... done.
Loading package old-time-1.0.0.5 ... linking ... done.
Loading package unix-2.4.0.2 ... linking ... done.
Loading package directory-1.0.1.1 ... linking ... done.
Loading package process-1.0.1.3 ... linking ... done.
<interactive>: pwd: executeFile: unsupported operation (Operation not supported)
*** Exception: user error (Exited: Exited (ExitFailure 1))

残念な感じ。