STM

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

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

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

ソケットとsyslog

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

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

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

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)

• 第37回　書き換え規則を使って不要な計算や中間データを除去
• 第40回　Stream Fusionによる融合変換で処理系の最適化機能を生かす
• 第41回　任意の再帰構造による処理を融合変換できるStream Fusion

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

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

正規形(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―実戦で学ぶ関数型言語プログラミング
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は非正格

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―実戦で学ぶ関数型言語プログラミング
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_を二回適用させないとイケないのはいまいち理解していないが型のエラーがそんな感じだったので、適当に直したら動いた。いい感じ

RWH 24.2はなんかいろいろハマったのでメモ。まずzlibとreadlineのパッケージをmacbookにインストール。

perlのcpanに対応するコマンドはhaskellではcabalというものがある。

cabalコマンドの使い方

Cabal は Haskell のパッケージ管理システムです。枠組みとしての Cabal と、コマンドの cabal があり、間違いやすいです。

間違ってた。

zlibをcabalでインストール

sudo cabal install zlib

続いてreadlineを。

sudo port install readline

で

sudo cabal install　readline

readlineが見つからないというエラー。仕方ないのでアーカイブをダウンロードしてきて

runhaskell Setup.hs configure \
--configure-option=--with-readline-includes="/opt/local/include" \
--configure-option=--with-readline-libraries="/opt/local/lib"
runhaskell Setup.hs build
sudo runhaskell Setup.hs install

で入れた。でもcabal に--configure-option渡してもOKな感じはする。

コードもControl.ExceptionではなくてControl.OldExceptionをインポートする。

import Control.Concurrent (forkIO)
import Control.OldException (handle)
import Control.Monad (forever)
import qualified Data.ByteString.Lazy as L
import System.Console.Readline (readline)

import Codec.Compression.GZip (compress)


main = do 
  maybeLine <- readline "Enter a file to compress> "
  case maybeLine of 
    Nothing   -> return ()
    Just ""   -> return ()
    Just name -> do
         handle print $ do
                   content <- L.readFile name
                   forkIO (compressFile name content)
                   return ()
         main
  where compressFile path = L.writeFile (path ++ ".gz") . compress

で、コンパイル

ghc --make Compressor.hs

これが動かなくて悩んだ。というかコンパイルできるんだけど、圧縮ファイルが作成されない。

なんでかなー？とReal World Haskellのコメント見てたら、-threadオプションが必要とのこと。

ghc --make -threaded Compressor.hs

で無事に動いた。

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

追記 101012

cabal install readline --configure-option=--with-readline-includes="/opt/local/include" \
--configure-option=--with-readline-libraries="/opt/local/lib"

でいけた。

でも、実行したらエラー

/Users/kzfm/.cabal/lib/readline-1.0.1.0/ghc-6.12.3/HSreadline-1.0.1.0.o: unknown symbol `_rl_basic_quote_characters'
ghc: unable to load package `readline-1.0.1.0'

システムプログラミング

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))

残念な感じ。