ブルームフィルター
Real World Haskell―実戦で学ぶ関数型言語プログラミング3,4日かけて一応buildまではしたが、テストとか動かしてない。いまいち理解も追いついてなかったのが心残りだが、一通り読み終わったのでよしとしよう。それにしてもこの本はPerl的には「続・はじめてのPerl」くらいのレベル？「実用 Perlプログラミング 第2版」ではないでしょうなぁと。
みなさんこの先どうやって進んでいくんだろう？超気になるところ。
一周目は15章以降がほとんど理解できなかったけど、今回読んだら結構理解できたのでよかった。
プログラミングHaskell読書会にでて、問題もきちんと解いたってのも良かったのかも。
STM
この章ちょっと短い。もうちょい厚くして欲しかったかも。
Real World Haskell―実戦で学ぶ関数型言語プログラミングソケットとsyslog
Real World Haskell―実戦で学ぶ関数型言語プログラミングUDPの写経したら飽きたのでTCPの例はやってない。基本的にCに対応する関数が用意されているらしいので、内容はわかりやすかった。
プロファイリングと最適化
Real World Haskell―実戦で学ぶ関数型言語プログラミングストリーム融合というやつ
プログラミングHaskellimport 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)
MapReduce、ただし、サンプルの通りでは動かない。
Real World Haskell―実戦で学ぶ関数型言語プログラミングControl.Parallel.Strategiesを読むと
とのことなのでそう書きなおしてみた。
$ 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
お、速くなった。
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
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
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
クィックソートを並列で。
正規形(NF),頭部正規形(HNF),弱頭部正規形(WHNF)を理解した。
Real World Haskell―実戦で学ぶ関数型言語プログラミング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―実戦で学ぶ関数型言語プログラミングimport Control.Concurrent
communicate = do
m <- newEmptyMVar
forkIO $ do
v <- takeMVar m
putStrLn ("received" ++ show v)
putStrLn "sending"
putMVar m "wake up!"
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―実戦で学ぶ関数型言語プログラミングデータベース
Real World Haskell―実戦で学ぶ関数型言語プログラミング前回読んだときはデータベース接続まではやったので、今回は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.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))
残念な感じ。