これは何?
(とっくにアドベントカレンダーの時期は終わっているが)最近畳み込みについて理解が深まったので言語化しておきたいと思い、筆をとった。
この記事では
-
foldlは巨大サンクを作るため使うべきでない -
foldl'は厳密な左畳み込みであるため、パフォーマンスが良くなる -
foldrは演算子が正格でないなら遅延評価の強みが活かせる
の3つについて解説する。
foldlは巨大なサンクを作ってしまう。
最後の要素以外のすべてを結合した結果を、最後の要素と再帰的に結合する方法1をfoldl(末尾再帰)と呼ぶ。
foldlを利用してリストの合計を求める例を使ってfoldlの弱点を説明する。
ghci> foldl (+) 0 [1,2,3,4]
10
foldl (+) 0 [1,2,3,4]
→ foldl (0+1) [2,3,4]
→ foldl ((0+1)+2) [3,4]
→ foldl (((0+1)+2)+3) [4]
→ foldl ((((0+1)+2)+3)+4) []
→ acc = 10
遅延評価により、accは再帰呼出しが行われるたび即時評価されないため、((((0+1)+2)+3)+4)の巨大サンクがヒープに貯まる。
巨大なサンクはスペースリークを引き起こす。
手元のマシンで以下を実行するとフリーズした。
main :: IO()
main = do
let xs = [1..1000000000]
print $ foldl (+) 0 xs
厳密な左畳み込みであるfoldl'で正格評価すると無駄なサンクを作らずにすむ
スペースリークが起きた原因は、((((0+1)+2)+3)+4)のような未評価式がサンクとして溜まったためであった。
そこで、再帰呼出しが行われる前にaccの部分を即時評価する戦略(正格評価)を行うことで、巨大なサンクを作成せずにすむ。
Haskellではfoldlでこれを実施するためのfoldl'が存在する。
ghci> foldl' (+) 0 [1,2,3,4]
10
foldl'を使うことで再帰呼出しのたびにaccが評価される。
foldl' !acc (x:xs)
→ foldl' (0+1) [2,3,4]
→ foldl' (1+2) [3,4]
→ foldl' (3+3) [4]
→ foldl' (6+4) []
→ acc = 10
先ほどスペースリークを起こしたコードをfoldl'に変更するときちんと計算を行うことができた。
import Data.List (foldl')
main :: IO()
main = do
let xs = [1..1000000000]
print $ foldl' (+) 0 xs
GHCの最適化がなるべく効かないように、runghcコマンドで実行している。
foldrは演算子がStrictでない時強い
最初の要素と残りの要素を結合した結果を再帰的に結合する1のがfoldrである
foldrは計算を途中で打ち切ることができる場合
foldlは次の再帰に進むためにf acc xを評価する必要がある。そのためリストの末尾まで必ず走査する。
-- 簡略版foldl
foldl :: (b -> a -> b) -> b -> [a] -> b
foldl _ acc [] = acc -- 累積値
foldl f acc (x : xs) = foldl f (f acc x) xs
-- let使うほうがわかりやすいかも
foldl :: (b -> a -> b) -> b -> [a] -> b
foldl _ acc [] = acc -- 累積値
foldl f acc (x : xs) =
let acc' = f acc x
in foldl f acc' xs
しかし、foldrは途中で計算を打ち切る(ショートサーキット)ことができる。
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr _ e [] = e -- 初期値
foldr f e (x : xs) = f x (foldr f e xs)
以下のように無限リストを扱うことも可能だ。
take 5 (foldr (:) [] [1..])
[1,2,3,4,5]
-- foldlにはできない
ghci> take 5 (foldl (:) [] [1..])
<interactive>:3:15: error: [GHC-25897]
• Couldn't match type ‘a’ with ‘[a]’
Expected: [a] -> [[a]] -> [a]
Actual: [a] -> [[a]] -> [[a]]
‘a’ is a rigid type variable bound by
the inferred type of it :: [a]
at <interactive>:3:1-27
• In the first argument of ‘foldl’, namely ‘(:)’
In the second argument of ‘take’, namely ‘(foldl (:) [] [1 .. ])’
In the expression: take 5 (foldl (:) [] [1 .. ])
• Relevant bindings include it :: [a] (bound at <interactive>:3:1)
これにより、foldlと比較しても劇的に実行時間が短くなる2。
2のサンプルコードの実行時間を比較してみる。
-- foldr版
import Data.List (foldl')
main :: IO()
main = do
print $ foldr (\x e -> if mod x 10==0 then 0 else (mod e 10)*x) 1 [1..10^7]
-- foldl版
import Data.List (foldl')
main :: IO()
main = do
print $ foldl' (\a e -> if mod e 10==0 then 0 else (mod e 10)*a) 1 [1..10^7]
# foldr版
time runghc foldrSample.hs
0
runghc foldrSample.hs 0.21s user 0.08s system 96% cpu 0.303 total
# foldl'版
$ time runghc foldlSample.hs
0
runghc foldlSample.hs 3.33s user 0.09s system 100% cpu 3.412 total
途中で計算結果を打ち切ることで結果が変わる場合もあるので注意が必要。2はあえて結果が同じになるサンプルを用意していると思われる。
ghci> foldr (\x e -> if mod x 10==0 then 0 else e + x) 1 [1..10^7]
45
ghci> foldl' (\x e -> if mod x 10==0 then 0 else e + x) 1 [1..10^7]
50000005000001
演算子がstrictな場合、末尾まで再帰展開が必要なため、遅い
+はstrictなのでx+yを計算するにはx、yがともに評価される必要がある。
以下の例の場合、1 + foldr 0 [2,3,4]を計算するためにはfoldr 0 [2,3,4]を展開する必要がある。
その結果1 + (2 + (3 + 4))のような 右ネストのサンクの連鎖 (thunk chain) が生成される。
この連鎖が深くなると、評価時に再帰の戻り(stack unwind)が必要になり、実装によっては スタックオーバーフロー を引き起こす。
foldr (+) 0 [1,2,3,4]
10
foldr (+) 0 [1,2,3,4]
→ 1 + foldr (+) 0 [2,3,4]
→ 1 + (2 + foldr (+) 0 [3,4])
→ 1 + (2 + (3 + foldr (+) 0 [4]))
→ 1 + (2 + (3 + (4 + foldr (+) 0 [])))
敗者復活戦! 演算子がstrictな時、foldlとfoldrならどっちがマシ?
{-# NOINLINE plus #-}
plus :: Int -> Int -> Int
plus x y = x + y
main :: IO()
main = do
let xs = map id [1..10000000]
print $ foldl plus 0 xs
{-# NOINLINE plus #-}
plus :: Int -> Int -> Int
plus x y = x + y
main :: IO()
main = do
let xs = map id [1..10000000]
print $ foldr plus 0 xs
ヒープの量などはrunghcでは閲覧できないため、なるべく最適化が聞かないように-O0でコンパイルし、ソースに手を加えている。
INLINE展開されるとGHCが
foldr plus 0 xs
↓ inline
foldr (\x acc -> x + acc) 0 xs
のような最適化を実施してしまう。
だが、INLINE展開なしだと
plusがstrictかどうかをGHCが知ることができないため、最適化ができない。
idは何もせず入力を返すだけの関数だが、idを噛ませることで[1,2,3]がid 1 : id 2 : id 3 : []となり、最適化が効かなくなる。
# foldl
ghc -O0 -rtsopts foldl.hs
./foldl +RTS -s
50000005000000
2,492,384,472 bytes allocated in the heap
3,291,653,160 bytes copied during GC
681,625,896 bytes maximum residency (10 sample(s))
8,103,640 bytes maximum slop
1362 MiB total memory in use (0 MiB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 588 colls, 0 par 0.848s 0.850s 0.0014s 0.0044s
Gen 1 10 colls, 0 par 0.844s 0.844s 0.0844s 0.3779s
INIT time 0.000s ( 0.000s elapsed)
MUT time 0.389s ( 0.382s elapsed)
GC time 1.692s ( 1.694s elapsed)
EXIT time 0.000s ( 0.004s elapsed)
Total time 2.082s ( 2.080s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 6,403,080,185 bytes per MUT second
Productivity 18.7% of total user, 18.4% of total elapsed
# foldr
ghc -O0 -rtsopts foldr.hs
./foldr +RTS -s 127
50000005000000
2,412,384,496 bytes allocated in the heap
751,397,224 bytes copied during GC
337,938,440 bytes maximum residency (9 sample(s))
29,400 bytes maximum slop
632 MiB total memory in use (0 MiB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 495 colls, 0 par 0.324s 0.324s 0.0007s 0.0036s
Gen 1 9 colls, 0 par 0.312s 0.312s 0.0346s 0.1132s
INIT time 0.000s ( 0.000s elapsed)
MUT time 0.326s ( 0.323s elapsed)
GC time 0.635s ( 0.636s elapsed)
EXIT time 0.000s ( 0.001s elapsed)
Total time 0.962s ( 0.960s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 7,403,728,774 bytes per MUT second
Productivity 33.9% of total user, 33.6% of total elapsed
注目したいのはココ。
# foldlの結果
2,492,384,472 bytes allocated in the heap
3,291,653,160 bytes copied during GC
681,625,896 bytes maximum residency (10 sample(s))
8,103,640 bytes maximum slop
1362 MiB total memory in use (0 MiB lost due to fragmentation)
# foldrの結果
2,412,384,496 bytes allocated in the heap
751,397,224 bytes copied during GC
337,938,440 bytes maximum residency (9 sample(s))
29,400 bytes maximum slop
632 MiB total memory in use (0 MiB lost due to fragmentation)
+がstrictなため、foldrでも+の右辺左辺の両方が評価済みである必要がある。そのため、foldrでもリストの末尾まで展開が必要である。
その結果、foldrもfoldlも$O(n)$サイズの式ツリー(サンク)を生成するため、allocated in the heapの値はほぼ変わらない。
-
foldlは((((0+1)+2)+3)+4)のような巨大サンク(accumulator thunk)を作る -
foldrは1 + (2 + (3 + (4 + 0)))のような右側ネストのサンクを作る
foldlは巨大サンク(accumulator thunk)はリストの走査中ずっと保持される(評価されない)のに対して、foldrの右側ネストサンクは内側から順に評価されるため、古いサンクやリスト要素が早くGC対象になる。
そのため、以下の値がfoldrのほうが小さくなっている。
copied during GCmaximum residencytotal memory in use
foldr はリスト末尾まで再帰展開したあと、スタックをunwindしながらサンクが順に評価される。 --> 再帰の中に演算がある
foldr (+) 0 [1,2,3,4]
→ 1 + foldr (+) 0 [2,3,4]
→ 1 + (2 + foldr (+) 0 [3,4])
→ 1 + (2 + (3 + foldr (+) 0 [4]))
→ 1 + (2 + (3 + (4 + foldr (+) 0 [])))
→ 1 + (2 + (3 + (4 + 0))) 再帰展開終了
→ 1 + (2 + (3 + 4)) unwindフェーズ開始。サンク1つ消費
→ 1 + (2 + 7) サンク1つ消費
→ 1 + 9 サンク1つ消費
→ 10 サンク1つ消費
foldlはリスト走査の最後でまとめてサンクを潰す --> 再帰の外に演算がある。
foldl (+) 0 [1,2,3,4]
→ foldl (0+1) [2,3,4]
→ foldl ((0+1)+2) [3,4]
→ foldl (((0+1)+2)+3) [4]
→ foldl ((((0+1)+2)+3)+4) []
→ ((((0+1)+2)+3)+4) ここでまとめてサンクを消費する
ちなみにGHCの最適化をするとfoldlが内部的にfoldl'として最適化されるため、foldlのほうがパフォーマンスがよくなった。
結果見たい人がいれば
/usr/bin/time -v ./foldl +RTS -s
50000005000000
320,051,184 bytes allocated in the heap
16,528 bytes copied during GC
44,328 bytes maximum residency (2 sample(s))
29,400 bytes maximum slop
6 MiB total memory in use (0 MiB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 75 colls, 0 par 0.000s 0.000s 0.0000s 0.0000s
Gen 1 2 colls, 0 par 0.000s 0.000s 0.0001s 0.0001s
INIT time 0.000s ( 0.000s elapsed)
MUT time 0.058s ( 0.058s elapsed)
GC time 0.000s ( 0.000s elapsed)
EXIT time 0.000s ( 0.002s elapsed)
Total time 0.059s ( 0.060s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 5,487,602,291 bytes per MUT second
Productivity 98.8% of total user, 96.7% of total elapsed
Command being timed: "./foldl +RTS -s"
User time (seconds): 0.05
System time (seconds): 0.00
Percent of CPU this job got: 95%
Elapsed (wall clock) time (h:mm:ss or m:ss): 0:00.06
Average shared text size (kbytes): 0
Average unshared data size (kbytes): 0
Average stack size (kbytes): 0
Average total size (kbytes): 0
Maximum resident set size (kbytes): 9088
...
# foldrに変えて実験
/usr/bin/time -v ./foldr +RTS -s
50000005000000
486,217,728 bytes allocated in the heap
509,684,904 bytes copied during GC
255,249,992 bytes maximum residency (5 sample(s))
29,400 bytes maximum slop
370 MiB total memory in use (0 MiB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 73 colls, 0 par 0.168s 0.169s 0.0023s 0.0066s
Gen 1 5 colls, 0 par 0.224s 0.224s 0.0448s 0.1156s
INIT time 0.000s ( 0.000s elapsed)
MUT time 0.116s ( 0.115s elapsed)
GC time 0.393s ( 0.393s elapsed)
EXIT time 0.000s ( 0.003s elapsed)
Total time 0.509s ( 0.510s elapsed)
%GC time 0.0% (0.0% elapsed)
Alloc rate 4,185,421,422 bytes per MUT second
Productivity 22.8% of total user, 22.4% of total elapsed
Command being timed: "./foldr +RTS -s"
User time (seconds): 0.38
System time (seconds): 0.14
Percent of CPU this job got: 99%
Elapsed (wall clock) time (h:mm:ss or m:ss): 0:00.53
Average shared text size (kbytes): 0
Average unshared data size (kbytes): 0
Average stack size (kbytes): 0
Average total size (kbytes): 0
Maximum resident set size (kbytes): 382592
...
timeはshellのビルトインではなく、/usr/bin/timeを使うと-vオプションが使え、詳細なデータが見られる。
まとめ
(GHCの最適化を考慮しない場合)
- 無限リストを扱いたい場合には
foldr - 有限な大規模リストを扱い、途中で計算を中断できるなら
foldr - 有限な大規模リストの末尾まで走査が必要なら
foldl' -
foldlとfoldl'で計算結果が異なる場合2などないなら、foldl'を使うほうが計算効率がいい。- (最近のGHCは最適化してくれるので、速度上がらないかも知れないが)
競技プログラミングでの応用
- なるべく
foldl'を使えるのが理想ではある。かっこいいし - (時間や実装力の関係上)自前で再帰を書く際に、末尾再帰(foldlと同じ形式の再帰)になっているなと思ったら、引数をBangPatternsで引数を正格評価にできないか検討する
- 末尾再帰でないなら正格評価にしてもメリットはない
-- 正格評価を使った自前再帰
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# OPTIONS_GHC -DATCODER #-}
import Data.ByteString.Char8 qualified as BS
import Debug.Trace (traceShowId)
#ifdef ATCODER
debug :: Bool ; debug = False
#else
debug :: Bool ; debug = True
#endif
dbgId :: (Show a) => a -> a
dbgId x
| debug = traceShowId x
| otherwise = x
readInt :: BS.ByteString -> Int
readInt bs =
case BS.readInt bs of
Just (x, _) -> x
Nothing -> error "input is not integer"
solve :: BS.ByteString -> Int
solve s = loop (0, 0, 0) s
where
-- BangPatternsで正格評価にしたら速くなった。 54 ms -> 10 ms
loop (!aN, !bN, !cN) bs = case BS.uncons bs of
Nothing -> cN
Just (b, rest)
| b == 'A' -> loop (aN + 1, bN, cN) rest
| b == 'B' ->
let bN' = min aN (bN + 1)
in loop (aN, bN', cN) rest
| b == 'C' ->
let cN' = min bN (cN + 1)
in loop (aN, bN, cN') rest
| otherwise -> error "Unexpected Inputs"
main :: IO ()
main =
-- initで改行削除
BS.interact $ \s ->
(BS.pack . show) (solve (BS.init s)) <> BS.pack "\n"
正格評価にするだけでだいぶ速くなった!
一応foldl'版も置いておく
-- foldl'バージョン
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# OPTIONS_GHC -DATCODER #-}
import Data.ByteString.Char8 qualified as BS
import Debug.Trace (traceShowId)
#ifdef ATCODER
debug :: Bool ; debug = False
#else
debug :: Bool ; debug = True
#endif
dbgId :: (Show a) => a -> a
dbgId x
| debug = traceShowId x
| otherwise = x
solve :: BS.ByteString -> Int
solve s =
let (_, _, cN) = BS.foldl' step (0, 0, 0) s
in cN
where
{-# INLINE step #-}
step (!aN, !bN, !cN) b
| b == 'A' = (aN + 1, bN, cN)
| b == 'B' = (aN, min aN (bN + 1), cN)
| b == 'C' = (aN, bN, min bN (cN + 1))
| otherwise = error "Unexpected Inputs"
main :: IO ()
main =
-- initで改行削除
BS.interact $ \s ->
(BS.pack . show) (solve (BS.init s)) <> BS.pack "\n"
すこし最適化したもの↓(理解が浅いので解説はしない) 12ms→9msになった
-- foldl'バージョン(最適化)
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# OPTIONS_GHC -DATCODER #-}
import Data.ByteString.Char8 qualified as BS
import Debug.Trace (traceShowId)
#ifdef ATCODER
debug :: Bool ; debug = False
#else
debug :: Bool ; debug = True
#endif
dbgId :: (Show a) => a -> a
dbgId x
| debug = traceShowId x
| otherwise = x
-- UNPACK付き厳密データ型を使うことでunbox化され、ポインタ関節参照が消え、メモリアクセスとGC負荷が軽減される。
data S = S {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int
solve :: BS.ByteString -> Int
solve s =
let S _ _ cN = BS.foldl' step (S 0 0 0) s
in cN
where
step (S aN bN cN) b
| b == 'A' = S (aN + 1) bN cN
| b == 'B' = S aN (min aN (bN + 1)) cN
| b == 'C' = S aN bN (min bN (cN + 1))
| otherwise = error "Unexpected Inputs"
main :: IO ()
main =
-- initで改行削除
BS.interact $ \s ->
(BS.pack . show) (solve (BS.init s)) <> BS.pack "\n"
2026年6月追記: 途中で畳み込みを打ち切るにはfoldrが使える
途中で条件を満たさないことがわかった場合に、最後まで畳み込みを実施せずに途中で打ち切りたい場合がある。
このような際には、foldrの活躍のチャンスである。
{-# OPTIONS_GHC -Wno-x-partial #-}
{-# OPTIONS_GHC -Wunused-imports #-}
solve :: Int -> [String] -> String
solve n ws
| S.size (S.fromList ws) /= n = "No" -- 重複した言葉はつかえない
| otherwise = judge . foldr (\x acc -> go acc x && acc) True $ zip ws $ tail ws -- foldrなら途中で落とせる
where
judge :: Bool -> String
judge result = if result then "Yes" else "No"
go :: Bool -> (String, String) -> Bool
go acc (prev, now)
| last prev == head now = True
| otherwise = False
main :: IO ()
main =
interact $ \inputs ->
let ls = lines inputs
n = (read :: String -> Int) $ head ls
ws = tail ls :: [String]
in (solve n ws) ++ "\n"
foldlやfoldl'の場合には左畳み込みなので、畳み込みを途中で止めることはできない。
-- 悪い例
| otherwise = judge . foldl' (\acc x -> go acc x && acc) True $ zip ws $ tail ws
Haskellにはallという全てがTrueのリストか確認する関数があるので、これを使うほうが素直かもしれない。
簡略化して書くと、allは以下のようなことを行っている。
all :: (a -> Bool) -> [a] -> Bool
all f xs = foldr (\x acc -> f x && acc) True xs
allは内部で畳み込みを行っているが、引数に対して直接畳み込みを行うわけではないので、foldrの実装から少し書き換えて以下のように実装できる。
-- foldrをallで書き直した。
{-# OPTIONS_GHC -Wno-x-partial #-}
{-# OPTIONS_GHC -Wunused-imports #-}
solve :: Int -> [String] -> String
solve n ws
| S.size (S.fromList ws) /= n = "No" -- 重複した言葉はつかえない
| otherwise = judge . all (\(prev, now) -> last prev == head now) $ zip ws $ tail ws -- foldr使うならallでいい説
where
judge :: Bool -> String
judge result = if result then "Yes" else "No"
main :: IO ()
main =
interact $ \inputs ->
let ls = lines inputs
n = (read :: String -> Int) $ head ls
ws = tail ls :: [String]
in (solve n ws) ++ "\n"
おまけ: initは畳み込みに向かない
畳み込みに向かない例としてinitという末尾の要素以外を取得する関数を紹介する。
init :: [a] -> [a]
init [] = error "empty list"
init (x : xs) = go x xs
where
go _ [] = [] -- 末尾
go y (z : zs) = y : go z zs
initは公式のソースコードでも畳み込み系を使っていない。
なぜかというと、initはリストの末尾かどうかを判定する必要があるためだ。
畳み込みの結果は、以下の2つで決まる必要がある。
-
x(現在の要素) - 畳み込んだ結果
そのため、foldrを使って実装すると以下のよう末尾かどうかを状態として持ち回す必要があり、冗長になる。
initF :: [a] -> [a]
initF xs =
case foldr step (True, []) xs of
(_, ys) -> ys
where
step x (isLast, acc)
| isLast = (False, [])
| otherwise = (False, x : acc)
initは最後じゃないことが確定するまで結果を返せない=リスト全体を見ないと安全に出力できないことから、ストリーム処理できない。
逆に末尾の要素だけを取得するlastは最後の要素を取得すればよいため、毎回新しい要素で上書きするだけで良い。これはxと畳込んだ結果のみでその要素の処理を決められるので畳み込みと相性が良い。
-- わかりやすさのためにエラー処理や最適化を省いて書いている
last :: [a] -> a
last = foldl1 (\_ x -> x)