Control.DeepSeq を使用して正格評価

Haskell

本記事はfoldのアルゴリズムに対する理解がめちゃくちゃだったんで修正記事作りました。(2012/06/25)

モンテカルロ法で円周率を計算するために多数のIOから取り出した結果の集計を行おうとした。

しかし未評価thunkによるメモリオーバーフローが発生し、インスタンス数を増やせなかった。途中でわざとprintを行なって未評価thunkを潰してメモリリークを防いでいたのだがもちろんこれは本質的な解決ではない。

また、Bang-Patternを使用して未評価thunkを潰そうとしたが、どうもthunkが潰れてくれない。

調べてみたところ、厳密な正格評価にはControl.DeepSeqが使用できることがわかったので試して見ることにした。

 

まず、リークを起こすコードの説明から。

-- Simple example for Bang-Patterns leak
import Control.Monad
import Data.Foldable ( foldr' )
import System.IO

main :: IO ()
main = do
    result <- takeStat (return 100) 10000000
    print $ "result is " ++ show result

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    foldr' (liftM2 (+)) (return 0) $ replicate count io

実行するとメモリオーバーフローで落ちる。 そこで、DeepSeqを使用したコードに修正する。

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    foldr'' (liftM2 (+)) (return 0) $ replicate count io

instance NFData a => NFData (IO a) where
    rnf x = rnf $ unsafePerformIO x

foldr''  :: NFData b => (a->b->b) -> b-> [a] -> b
foldr'' folder init           = init
foldr'' folder init (head:tail) =
    (foldr'' folder $!! (folder head init)) tail

NFDataクラスはDeepSeqモジュールの正格評価を適用できるデータのクラス。$!!はBang-Patternsにおける$!に相当する。引数を(Bang PatternsにおけるWHNFではなく、)値になるまで評価する。

foldを自分で書くクソダサさとIOを今更(しかも無理に)インスタンス化したり、無茶しまくっている、、、 でも、確かにコレで落ちない。

Bang Pattern的には下記なら大丈夫な感じがしてしまうが、やっぱりメモリ不足でおちちゃう。なぜダメなんだろうなぁ。

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    return $ foldr' (+).unsafePerformIO 0 $ replicate count $ unsafePerformIO io
参考：【まとめ】Haskellでの正格評価とWHNF
http://kamonama.blogspot.jp/2011/04/haskellwhnf.html

補足：

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.4.1
$ ghc -O Recursion.hs
[1 of 1] Compiling Main             ( Recursion.hs, Recursion.o )
Linking Recursion.exe ...

追記：

IOをインスタンス化するのはやっぱ嫌なのでどうせunsafePerformIOつかうなら下記がいいかな、、、

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    return $ foldr'' ((+).unsafePerformIO) 0 $ replicate count io

foldr''  :: NFData b => (a->b->b) -> b-> [a] -> b
foldr'' folder init           = init
foldr'' folder init (head:tail) =
    (foldr'' folder $!! folder head init) tail

追記２：

foldr'の根本にforceを挿してみたがこれもダメ。Bang Patternsがちゃんと動いていないのでは？

takeStat :: IO Int -> Int -> IO Int
takeStat io count =
    return $ (foldr' . force) ((+).unsafePerformIO) 0 $ replicate count io

正格評価がうまく動かない？

モンテカルロ法で円周率計算、みたいな話がちょろっと降ってきたので任意精度で計算できるようなコードをHaskellで書いてみたのだがループの中でどうもスペースリークしている。もう少しいうと、集計用の畳み込み関数が未評価のまま残ってしまうようだ。

    
main :: IO ()
main = do
    (count,total)  Int -> IO Stat
takeStat func count =
    let c   = \(x1,y1)(x2,y2) -> (x1+x2,y1+y2)
        f   = \ (x,_) -> if x then (1,1) else (0,1)
    in
    foldRN c (liftM f func) count (0,0)

みたくして、foldRN関数を次のように。(unsafePerformIOは見逃してw)

foldRN :: (Show a)=> (a->a->a) -> IO a -> Int -> a -> IO a
foldRN folder m count init =
    let foldRN_sub folder m count v
        | count == 0 = v
        | otherwise  =
            let r = unsafePerformIO $ do
                when ((count `mod` 100000) == 0) $ do
                    putStrLn $ "v: " ++ show v ++ " count: " ++ show count
                    hFlush stdout
                m
            in
            foldRN_sub folder m (count -1) $! folder v r
    in return $ foldRN_sub folder m count init

これ、whenがないとスペースリークで死んでしまう。 再帰関数のtail-recursionでBangによってthunkを潰してるはずなのに。。。 なぜ、、、、 あとMonoid使わねーの？という指摘がありましたら甘んじて受けます。

ガベージコレクタのアルゴリズムと実装（アルゴリズム編）のメモ

一章
ガベージコレクタの評価項目
・スループット
・停止時間
・使用効率
・局所性

二章
マークスウィープはメモリ全体を舐める
フラグメントがたまる
→BiBOP法（BigBagOfPages）
      phkmallocみたいなやり方
チャンク検索のコストが上がる
→サイズ別チャンク

単純なやり方ではコピーオンライトと仲が悪い
→ビットマップマーキング

遅延スウィープ
・全体を舐めなくて良い

三章
遅延参照カウント
・普段はルートからの参照をカウントしないが開放要否の判断時にカウントアップして帳尻を合わせる
スティッキー参照カウント
・カウントアップ式マークスウィープをへいようしてhappy
1ビット参照カウント
部分マークスウィープ
・デリファレンス時に子孫オブジェクトのリファレンスカウント分を差し引いてみて自分に帰ってきたら循環判定。ゼロなら抹殺

四章
普通のコピーGC
・再帰アルゴリズムで深さ優先
cheneyのアルゴリズム
・反復的で幅優先
擬似的深さ優先アルゴリズム
・近いものを近くに置ける

五章
コンパクションは空間効率がいいが時間効率が悪い
BiBOPとtwofingerを併用するアイディア
テーブル法
・連続オブジェクトをオフセットを使って管理する
・フォワードポインタが不要
immixGCは一旦飛ばす

六章
保守的GCには
・不明瞭なルート
・不明瞭なオブジェクト
の２つがある
前者は
・間接参照
・mostly copied
・ブラックリスト
で確実なGC相当のコピーGCを（リークを許容しながら）実現できる
後者はオブジェクトを移動できずマークスウィープ以外の選択肢はない

七章
Rememberセットには参照元を登録する
ライトバリアで旧世代ポインタの変更を拾うと実装しやすい
trainGCは一旦飛ばした

八章
Dijkstra 参照更新時、新しい参照先が未クロールならグレー（クロール対象）に塗る
Steele クロール済みオブジェクトに修正が入ったら再クロールの対象にする
Yuasa マーク開始時のリンクでマークし、ライトバリアでは旧オブジェクトをこぼさないように差分をフォローする。

BEAST attack

あまりよく理解していなかったことではあるが、、、、
CBCモードってのは選択平文攻撃にとても弱いらしい。

CSRFとかで乗っかられちゃうと、セッション内で攻撃成功すればcookieが盗まれるとおもわれる。

これって暗号強度の観点から言うと暗号の効果を否定するようなことだけど、脆弱性としては重要なのかな〜 まだちょっとわからん。

Alloyでナンプレ

nishioさんのAlloyネタを追っかけてナンプレ(数独)をAlloyで写経してみた。
sig Col extends Index
とか
one sig One,Two,Three,Four,Five,Six,Seven,Eight,Nine
あたりがダサさが極まっていてたまらない。

abstract sig Index {}
sig Col extends Index {
  cell : Index -> Index
}

one sig 
One,Two,Three,Four,Five,Six,Seven,Eight,Nine
 extends Col{}

fact{
  all c : Col , row : Index | one cell[c,row]
}

fact{
all c:Col, r1,r2:Index | (r1=r2)or(not(cell[c,r1]=cell[c,r2]))
}
fact{
all c1,c2:Col, r:Index | (c1=c2)or(not(cell[c1,r]=cell[c2,r]))
}

fact {
(cell[One,One]=Four)
// 中略…
and
(cell[Two,Nine]=Four)
}

run{} for 13

実行結果。

Executing "Run run$1 for 13"
   Solver=sat4j Bitwidth=0 MaxSeq=0 SkolemDepth=1 Symmetry=20
   72602 vars. 2201 primary vars. 137690 clauses. 1966ms.
   Instance found. Predicate is consistent. 57174ms.

コードhttps://github.com/dec9ue/alloy-example/blob/master/num_ple2.als

Pythonでは10msecくらいで解けるようなので単純比較はできないけど少なくとも5000倍の開きがあります。しかし、ルール定義がたかだか20行ぐらいで済んでしまうあたり、生産性の大きな差を感じます。
Solving Every Sudoku Puzzle


2013-04-22 <pre>タグで間延びしてたのが気になったのでちょっと修正してみた。


抽象によるソフトウェア設計−Alloyではじめる形式手法−