Haskellの特徴といえば遅延評価です。
しかしその遅延評価によってパフォーマンスの低下、もしくは不可解なコードに繋がることがあります。今回はそれらについて紹介したいと思います。
遅延評価とは
すごいH本によると、遅延評価というのは「結果が必要になるまで関数を実行しない。」という性質です。
例としては以下のものが挙げられます。
> sum $ take 100 [1 ..]
5050
これは無限のリストから100個要素を取り、それらの合計値を算出しています。通常であれば無限のリストを渡せばそれを完全に評価しようとするためにプログラムが止まってしまいますが、Haskellは遅延評価のおかげでその心配がありません。
しかしその「必要になるまで関数を実行しない」ということが問題になることがあります。
パフォーマンスの低下 (遅延Map vs 正格Map)
HackageのData.Mapのページには冒頭にて以下の注意書きが記載されています
Note: You should use Data.Map.Strict instead of this module if:
- You will eventually need all the values stored.
- The stored values don't represent large virtual data structures to be lazily computed.
- An efficient implementation of ordered maps from keys to values (dictionaries).
今回は果物配達のシミュレーションを行い、遅延Mapと正格Mapのパフォーマンスを比較します。
果物配達のシミュレーション
今回は各都市に果物を配達するプログラムを作ってみました。これは各都市に果物倉庫があり、それらに果物を配達するものです。
果物倉庫Storage型は果物の種類とその数量としてMap型で表現します。
type Storage = Map Fruit Amount
またRecord型は各都市とそのStorageを表現しています。
type Record = Map Location Storage
また配達に関してはどこへ、何を、いくつ配達するのかを以下のように表現します。
-- | Delivery information
data Delivery = Delivery
{ dTo :: !Location
-- ^ Where to send
, dFruit :: !Fruit
-- ^ What to send
, dAmount :: !Amount
-- ^ How many
} deriving (Show)
果物を配達する、というのは配達情報を元にRecord型を更新する関数となるので、以下のようになります。
-- | Deliver the fruit to the city
deliverFruit :: Record -> Delivery -> Record
deliverFruit record Delivery{..} =
if M.member dTo record
then M.adjust (updateStorage dFruit dAmount) dTo record
else M.insert dTo (M.insert dFruit dAmount M.empty) record
where
updateStorage :: Fruit -> Amount -> Storage -> Storage
updateStorage fruit amount storage =
if M.member dFruit storage
then M.adjust (+ amount) fruit storage
else M.insert fruit amount storage
またランダムな配達情報を生成するためにQuickCheckライブラリを使用します。QuickCheckはテストライブラリとして有名ですが、実はランダムなデータを生成するのにも有効です。例えば以下のように型クラスArbitraryの型クラスインスタンスを定義することによってDelivery型のランダムなデータが生成可能となります。
instance Arbitrary Delivery where
arbitrary = do
location <- elements [Hokkaido .. Yokohama]
fruit <- elements [Banana .. Watermelon]
amount <- choose (1, 10)
pure $ Delivery location fruit amount
ここでコード全体をここに記載します。
{-# LANGUAGE RecordWildCards #-}
module Lib where
import Data.List (foldl')
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Semigroup ((<>))
import Test.QuickCheck (Arbitrary (..), Gen, choose, elements,
generate, vectorOf)
type Record = Map Location Storage
type Storage = Map Fruit Amount
type Amount = Int
-- | Fruit
data Fruit =
Banana
| Berry
| Grape
| GrapeFruit
| Lemon
| Orange
| Strawberry
| Watermelon
deriving (Eq, Show, Enum, Ord)
-- | Location
data Location =
Hokkaido
| Kyoto
| Nagoya
| Nara
| Osaka
| Saitama
| Tokyo
| Yokohama
deriving (Eq, Show, Enum, Ord)
-- | Delivery information
data Delivery = Delivery
{ dTo :: !Location
-- ^ Where to send
, dFruit :: !Fruit
-- ^ What to send
, dAmount :: !Amount
-- ^ How many
} deriving (Show)
instance Arbitrary Delivery where
arbitrary = do
location <- elements [Hokkaido .. Yokohama]
fruit <- elements [Banana .. Watermelon]
amount <- choose (1, 10)
pure $ Delivery location fruit amount
initialRecord :: Record
initialRecord = M.empty
-- | Deliver the fruit to the city
deliverFruit :: Record -> Delivery -> Record
deliverFruit record Delivery{..} =
if M.member dTo record
then M.adjust (updateStorage dFruit dAmount) dTo record
else M.insert dTo (M.insert dFruit dAmount M.empty) record
where
updateStorage :: Fruit -> Amount -> Storage -> Storage
updateStorage fruit amount storage =
if M.member dFruit storage
then M.adjust (+ amount) fruit storage
else M.insert fruit amount storage
-- | Deliver fruits to the cities
deliverFruits :: Record -> [Delivery] -> Record
deliverFruits = foldl' deliverFruit
-- | Print @'Record'@ into human readable format
printRecord :: Record -> IO ()
printRecord record = do
let recordList = M.toAscList record
mapM_ (uncurry printByCity) recordList
where
printByCity :: Location -> Storage -> IO ()
printByCity location storage = do
putStrLn $ "\n========== " <> show location <> " =========="
let storageList = M.toAscList storage
mapM_ (uncurry printStorage) storageList
printStorage :: Fruit -> Amount -> IO ()
printStorage fruit amount =
putStrLn $ show fruit <> ": " <> show amount
-- | Deliver given number of delivery to the city
runDelivery :: Int -> IO ()
runDelivery num = do
-- Generate list of random deliveries
randomDeliveries <- generate $ vectorOf num (arbitrary :: Gen Delivery)
-- Run computation
let updatedRecord = deliverFruits initialRecord randomDeliveries
-- Print the results
printRecord updatedRecord
putStrLn "All the fruits are delivered!!"
これでrunDelivery 10000000と実行すれば果物配達が10,000,000回行われることになります。
比較方法
遅延Mapと正格Mapは全く同じAPIを提供しています。よってインポートの部分を書き換えれば遅延Mapから正格Mapへと切り替えることが可能です。
import Data.List (foldl')
import Data.Map (Map) -- ここをData.Map.Strictに
import qualified Data.Map as M -- 書き換える
import Data.Semigroup ((<>))
またStackは実行時に+RTS -s引数を与えることでそのパフォーマンス情報を表示してくれます。
stack exec laziness-exe -- +RTS -s
それでは遅延Map,正格Mapそれぞれのパフォーマンスを比較してみましょう。
遅延Map
32,795,076,816 bytes allocated in the heap
7,991,502,912 bytes copied during GC
648,268,360 bytes maximum residency (31 sample(s))
220,104,120 bytes maximum slop
1977 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 31424 colls, 31424 par 28.038s 6.486s 0.0002s 0.0137s
Gen 1 31 colls, 30 par 30.364s 8.646s 0.2789s 1.0443s
Parallel GC work balance: 0.11% (serial 0%, perfect 100%)
TASKS: 18 (1 bound, 17 peak workers (17 total), using -N8)
SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)
INIT time 0.000s ( 0.001s elapsed)
MUT time 11.429s ( 12.717s elapsed)
GC time 58.401s ( 15.132s elapsed)
EXIT time 0.001s ( 0.001s elapsed)
Total time 69.831s ( 27.851s elapsed)
Alloc rate 2,869,535,181 bytes per MUT second
Productivity 16.4% of total user, 45.7% of total elapsed
gc_alloc_block_sync: 203963
whitehole_spin: 0
gen[0].sync: 10
gen[1].sync: 1718
正格Map
31,081,744,272 bytes allocated in the heap
222,175,104 bytes copied during GC
136,624 bytes maximum residency (2 sample(s))
88,656 bytes maximum slop
10 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 29917 colls, 29917 par 9.309s 0.442s 0.0000s 0.0040s
Gen 1 2 colls, 1 par 0.001s 0.000s 0.0001s 0.0002s
Parallel GC work balance: 0.11% (serial 0%, perfect 100%)
TASKS: 18 (1 bound, 17 peak workers (17 total), using -N8)
SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)
INIT time 0.000s ( 0.001s elapsed)
MUT time 12.408s ( 11.041s elapsed)
GC time 9.310s ( 0.442s elapsed)
EXIT time 0.001s ( 0.006s elapsed)
Total time 21.719s ( 11.491s elapsed)
Alloc rate 2,505,047,231 bytes per MUT second
Productivity 57.1% of total user, 96.1% of total elapsed
gc_alloc_block_sync: 184188
whitehole_spin: 0
gen[0].sync: 19
gen[1].sync: 2
注目すべきはtotal memory in useです。遅延Mapはなんと2GB近くのメモリを使用しているのに対し、正格Mapは10MBしか使用していません。また遅延Mapではガーベージコレクション(GC)にも大量のリソースを費やしていることもわかります。
原因
原因は遅延評価にあります。
実は遅延Mapは実際にその配達結果をコンソール出力するprintRecord関数までRecord型の評価を行いません。すると1千万回行ったdeliverFruitsの計算処理がサンクとしてメモリーに溜め込まれます。これに膨大な量のメモリーを消費しているのです。
一方正格MapではdeliveryFruit関数にてRecord型を更新するたびに評価を行います。これによってサンクを最小限に留めることができます。
回避策
このような問題を回避するために僕が従っているのは以下のルールです。
-
Map,HashMapなどはよっぽどの理由がない限り正格のものを利用する。 -
Text,ByteStringに関しても遅延バージョンを利用することに明確な意図がない、利用しているライブラリが遅延バージョンを要求しない限り、正格のものを利用する。 - レコード型のそれぞれのフィールドには必ず
!をつける。これによってそのデータ型に正格性を持たせることができる。
data User = User
{ uName :: !Text
, uAge :: !Int
}
例外をキャッチできない
haskellで開発を行う上で「えっ？」となるのがこれだと思います。
開発者としては例外が投げられた場合には何らかの例外処理を実装したいでしょう。例外処理に利用できる関数としてtryがあります。tryはアクションを引数にとり、もしそのアクションが成功した場合にはRight a,失敗するとLeft Exceptionを投げます。
eResult <- try someAction
case eResult of
Left (_ :: SomeException) -> error "Caught exception"
Right result -> doSomething result
それでは以下の例を見てみましょう。
{-# LANGUAGE ScopedTypeVariables #-}
module NoCatch where
import Control.Exception
import Control.Monad
evilFun :: IO [Int]
evilFun = do
eResult <- try $ return [1, 2, 3, error "It crashed!!"]
case eResult of
Left (_ :: SomeException) -> error "We caught the exception!"
Right result -> do
putStrLn "We couldn't catch it, we're doomed"
return result
normalFun :: IO ()
normalFun = do
someList <- evilFun
forM_ someList $ \element -> putStrLn $ "The number is: " <> show element
リスト要素の１つがエラーとなっており、try関数でそれをキャッチしようとしています。もしキャッチできればWe caught the exception!と出力されるはずです。
*Main Lib NoCatch> normalFun
We couldn't catch it, we're doomed
The number is: 1
The number is: 2
The number is: 3
The number is: *** Exception: It crashed!!
CallStack (from HasCallStack):
error, called at /home/hiroto/haskell/coding/laziness/src/NoCatch.hs:10:39 in main:NoCatch
なんと例外をキャッチできず、その関数を使用しているnormalFunにてエラーが発生しました。
原因
原因はまたしても遅延評価にあります。tryでは全てを評価せずWHNF (Weak Head Normal Form)のみを評価します。(Weak Head Normal Formに関してはこの記事が大変役に立ちます。)
上記の例ではtry関数はリストであることは評価するが、その要素までは評価しません。このためevilFunでは例外をキャッチすることができなかったのです。
部分関数
haskellには部分関数という行儀の悪い関数が存在します。これは一見純粋に見える関数が例外を投げるものです。
代表的なものとしてPreludeのheadが挙げられます。headは純粋な関数であるにもかかわらず、空のリストを与えるとエラーを投げます。
> head []
*** Exception: Prelude.head: empty list
この部分関数が投げる例外もtryではキャッチすることができないときがあります。
場合によってはその関数が投げる例外を処理するために「純粋な関数に例外処理を実装する」という不可解なコードが生まれる可能性があります。
回避策
これらの回避策としては以下のものが挙げられます。
throw、Maybeなど使用し、例外処理が実装可能なコードを記述するよう心がける
これに関しては以下の記事が参考になります。
部分関数は使用しない、実装しない
その場しのぎで部分関数を実装するというのはよくあります。しかし最終的にはそれらを取り除きましょう。
tryDeepを使用する
使用している外部ライブラリが部分関数をエクスポートしている等、どうしようもない場合にはtryDeepを使用します。
http://hackage.haskell.org/package/safe-exceptions-0.1.7.0/docs/Control-Exception-Safe.html#v:tryDeep
tryDeepは与えられたアクションを完全に評価しますが、その一方でMonadIOの制約を課す必要があり、場合によっては純粋だった関数を不純なものへ変換させる必要があります。
カスタムPreludeを使用する
実は標準で利用可能なPreludeは多くの部分関数をエクスポートしています。(head,read,div, etc)。そのような事情もあってHaskellコミュニティではこれらの関数を部分関数ではないものに取り替える、またはエクスポートしていないカスタムPreludeを提供しているグループが幾つかあります。代表的なものとしては
が挙げられます。
どれから手を付ければいいのか分からない、という場合にはFPCompleteが提供しているRIOをお勧めします。RIOに関しては日本語の記事も幾つかある上に、この中では一番とっつきやすいものだと感じました。
カスタムPreludeに関する記事に関しては以下のものをおすすめします。
コメントを残す
純粋関数のフリをしている部分関数の例外処理を実装する際には他の人のためにコメントを残してあげましょう。幸いにもHaskellにはHaddockという素晴らしいドキュメンテーション生成ツールがあります。あなたのコメントがチーム、会社の貴重な資産となるのです。
その他
もしHaskellの遅延評価に関して詳しく知りたい場合にはFPCompleteがより詳しい記事を公開しているので、それを読むことをおすすめします。
FPComplete - All about strictness