Haskell
HaskellDay 6

Haskellにおいて遅延評価は諸刃の剣であり、注意すべきであるという話

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

リスト要素の1つがエラーとなっており、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ではキャッチすることができないときがあります。
場合によってはその関数が投げる例外を処理するために「純粋な関数に例外処理を実装する」という不可解なコードが生まれる可能性があります。

回避策

これらの回避策としては以下のものが挙げられます。

throwMaybeなど使用し、例外処理が実装可能なコードを記述するよう心がける

これに関しては以下の記事が参考になります。

部分関数は使用しない、実装しない

その場しのぎで部分関数を実装するというのはよくあります。しかし最終的にはそれらを取り除きましょう。

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