foldr のすごさを体験してみた
Real World Haskell にはこんなコードが載ってます。
myFoldl :: (a -> b -> a) -> a -> [b] -> a myFoldl f z xs = foldr step id xs z where step x g a = g (f a x)Real World Haskell p100 4.6.8 右からの畳み込み
foldl は foldr を使って書けるという例です。
こんな風にほとんどのリスト処理は再帰を使わなくても foldr を使えば書けるらしい*1ので、どこまでできるのか確認するために Prelude にある Data.List の関数を再定義してみました。
ルールは、
- 再定義した関数は直接的または間接的に再帰していてはならない（foldr は除く）
- 再帰しないで作った関数を他の関数で使うのは OK
- 再定義した関数は元の関数と同じ計算量で同じ結果を返さなければならない
という感じです。
こんな風になりました。
import Prelude hiding ( -- List operations map,(++),filter,head,last,tail,init,null,length,(!!),reverse, ---- Reducing lists (folds) foldl,foldl1,{-foldr,-}foldr1, ------ Special folds and,or,any,all,sum,product,concat,concatMap,maximum,minimum, ---- Building lists ------ Scans scanl,scanl1,scanr,scanr1, ---- Infinite lists {-iterate,-}repeat,replicate,cycle, ---- Sublists take,drop,splitAt,takeWhile,dropWhile,span,break, ---- Searching lists elem,notElem,lookup, ---- Zipping and unzipping lists zip,zip3,zipWith,zipWith3,unzip,unzip3, ---- Functions on strings lines,words,unlines,unwords) import Data.Maybe (fromJust) -- List operations map :: (a -> b) -> [a] -> [b] map f = foldr ((:).f) [] (++) :: [a] -> [a] -> [a] (++) = flip (foldr (:)) filter :: (a -> Bool) -> [a] -> [a] filter p = foldr f [] where f x xs | p x = x:xs | otherwise = xs head :: [a] -> a head (x:_) = x last :: [a] -> a last = foldr1 (flip const) tail :: [a] -> [a] tail (_:xs) = xs init :: [a] -> [a] init (x:xs) = foldr f (const []) xs x where f x g = (:g x) null :: [a] -> Bool null [] = True null _ = False length :: [a] -> Int length = foldr (curry ((+1).snd)) 0 (!!) :: [a] -> Int -> a (!!) xs n | n < 0 = error "out of index" | otherwise = foldr f (error "out of index") xs n where f x g 0 = x f x g n = g (n-1) reverse :: [a] -> [a] reverse = foldl (flip (:)) [] ---- Reducing lists (folds) foldl :: (a -> b -> a) -> a -> [b] -> a foldl f init xs = foldr step id xs init where step x g a = g (f a x) foldl1 :: (a -> a -> a) -> [a] -> a foldl1 f (x:xs) = foldl f x xs --foldr :: (a -> b -> b) -> b -> [a] -> b foldr1 :: (a -> a -> a) -> [a] -> a foldr1 f (x:xs) = foldr step id xs x where step x g = flip f (g x) ------ Special folds and :: [Bool] -> Bool and = foldr (&&) False or :: [Bool] -> Bool or = foldr (||) False any :: (a -> Bool) -> [a] -> Bool any p = foldr ((||).p) False all :: (a -> Bool) -> [a] -> Bool all p = foldr ((&&).p) True sum :: Num a => [a] -> a sum = foldr (+) 0 product :: Num a => [a] -> a product = foldr (*) 1 concat :: [[a]] -> [a] concat = foldr (++) [] concatMap :: (a -> [b]) -> [a] -> [b] concatMap f = foldr ((++).f) [] maximum :: Ord a => [a] -> a maximum = foldr1 max minimum :: Ord a => [a] -> a minimum = foldr1 min ---- Building lists ------ Scans scanl :: (a -> b -> a) -> a -> [b] -> [a] scanl f x xs = foldr step (:[]) xs x where step x g a = a:g (f a x) scanl1 :: (a -> a -> a) -> [a] -> [a] scanl1 f (x:xs) = scanl f x xs scanr :: (a -> b -> b) -> b -> [a] -> [b] scanr f x xs = foldr step (:[]) xs x where step x g a = f x a:g a scanr1 :: (a -> a -> a) -> [a] -> [a] scanr1 f (x:xs) = foldr step (:[]) xs x where step x g a = f a x:g x ---- Infinite lists --iterate :: (a -> a) -> a -> [a] repeat :: a -> [a] repeat = iterate id replicate :: Int -> a -> [a] replicate n = take n . repeat cycle :: [a] -> [a] cycle = concat . repeat ---- Sublists take :: Int -> [a] -> [a] take n xs = foldr f (const []) xs n where f x g 0 = [] f x g n = x:g (n-1) drop :: Int -> [a] -> [a] drop n xs = foldr f (const []) xs n where f x g 0 = x:g 0 f x g n = g (n-1) splitAt :: Int -> [a] -> ([a],[a]) splitAt n xs = (take n xs,drop n xs) takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile p = foldr f [] where f x xs | p x = x:xs | otherwise = [] dropWhile :: (a -> Bool) -> [a] -> [a] dropWhile p xs = foldr f (const []) xs True where f x g True | p x = g True | otherwise = x:g False f x g False = x:g False span :: (a -> Bool) -> [a] -> ([a],[a]) span p xs = (takeWhile p xs,dropWhile p xs) break :: (a -> Bool) -> [a] -> ([a],[a]) break p = span (not . p) ---- Searching lists elem :: Eq a => a -> [a] -> Bool elem x = any (==x) notElem :: Eq a => a -> [a] -> Bool notElem x = not . elem x lookup :: Eq a => a -> [(a, b)] -> Maybe b lookup x = foldr f Nothing where f (a,b) mb | x==a = Just b | otherwise = mb ---- Zipping and unzipping lists zip :: [a] -> [b] -> [(a,b)] zip = zipWith (,) zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] zip3 = zipWith3 (,,) zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith f = foldr g (const []) where g x h [] = [] g x h (y:ys) = f x y:h ys zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] zipWith3 f = foldr g (\_ _->[]) where g x h [] _ = [] g x h _ [] = [] g x h (y:ys) (z:zs) = f x y z:h ys zs unzip :: [(a, b)] -> ([a], [b]) unzip = foldr f ([],[]) where f (x,y) ~(xs,ys) = (x:xs,y:ys) unzip3 :: [(a, b, c)] -> ([a], [b], [c]) unzip3 = foldr f ([],[],[]) where f (x,y,z) ~(xs,ys,zs) = (x:xs,y:ys,z:zs) ---- Functions on strings lines :: String -> [String] lines str = snd $ foldr f first str '\n' where f c g = uncurry second (g c) first '\n' = ("",[]) first c = ([c],[]) second str strs '\n' = ("",str:strs) second str strs c = (c:str,strs) words :: String -> [String] words str = snd $ foldr f (g "" []) str ' ' where f c g' = uncurry g (g' c) g str strs ' ' | null str = ("",strs) | otherwise = ("",str:strs) g str strs c = (c:str,strs) unlines :: [String] -> String unlines = concatMap (++"\n") unwords :: [String] -> String unwords [] = [] unwords xs = foldr1 f xs where f x y = x++(' ':y)
foldr 以外は再帰しないとか言ってましたが、 iterate 関数は無限の入力が無いと無理なので諦めました。
あと計算量についても、微妙に無駄があったり*2とかしてうぬぬという感じですが、とりあえず無限リストに対しても無駄なサンクを作ったりすることなく同じ動作をするようには心がけました。
iterate 関数と、それを使って実装している repeat, replicate, cycle 関数、それから head といった元々リスト処理が不要な関数は foldr では書けません（書きません）でしたが、それ以外は全部 foldr あるいは foldr を間接的に利用している関数を使って書くことができました。
zip あたりとか無理じゃね？と思っていたのですが、id:uskz 先生に教えてもらいつつ何とか実装できました。foldr すごいです。
個人的には scan の実装がいい感じにできたかなと思います。
逆に words や lines はもっと改善できそうな気がするのですが、うまい方法が思いつかなかったです。
