Control.Arrow (3)
http://d.hatena.ne.jp/mzsms/20091120/1258666488 のつづき。
fizzbuzz関数
(|||)の使いどころが分からなかったので、次のような関数を書いてみた:
Prelude> :l FizzBuzz.hs [1 of 1] Compiling FizzBuzz ( FizzBuzz.hs, interpreted ) Ok, modules loaded: FizzBuzz. *FizzBuzz> fizzbuzz [(3, "Fizz")] [1..20] ["1","2","Fizz","4","5","Fizz","7","8","Fizz","10","11","Fizz","13","14","Fizz","16","17","Fizz","19","20"] *FizzBuzz> fizzbuzz [(5, "Buzz")] [1..20] ["1","2","3","4","Buzz","6","7","8","9","Buzz","11","12","13","14","Buzz","16","17","18","19","Buzz"] *FizzBuzz> fizzbuzz [(3, "Fizz"), (5, "Buzz")] [1..20] ["1","2","Fizz","4","Buzz","Fizz","7","8","Fizz","Buzz","11","Fizz","13","14","FizzBuzz","16","17","Fizz","19","Buzz"] *FizzBuzz> fizzbuzz [(3, "Fizz"), (5, "Buzz"), (7,"Pee")] [1..105] ["1","2","Fizz","4","Buzz","Fizz","Pee","8","Fizz","Buzz","11","Fizz","13","Pee","FizzBuzz","16","17","Fizz","19","Buzz","FizzPee","22","23","Fizz","Buzz","26","Fizz","Pee","29","FizzBuzz","31","32","Fizz","34","BuzzPee","Fizz","37","38","Fizz","Buzz","41","FizzPee","43","44","FizzBuzz","46","47","Fizz","Pee","Buzz","Fizz","52","53","Fizz","Buzz","Pee","Fizz","58","59","FizzBuzz","61","62","FizzPee","64","Buzz","Fizz","67","68","Fizz","BuzzPee","71","Fizz","73","74","FizzBuzz","76","Pee","Fizz","79","Buzz","Fizz","82","83","FizzPee","Buzz","86","Fizz","88","89","FizzBuzz","Pee","92","Fizz","94","Buzz","Fizz","97","Pee","Fizz","Buzz","101","Fizz","103","104","FizzBuzzPee"]
- (n::Int, s::String)のパラメータのリストと、数列をとって、数列の数がnで割り切れたならばsを表示する。
- 割り切れるパラメータが複数あった場合には、文字列を連結する。
- どのパラメータでも割り切れなければ、その数字を文字列にして表示する。
コードはつぎのとおり:
module FizzBuzz where
import Control.Arrow
if' b t e = if b then t else e
cy = curry
uy = uncurry
type I = Int
type S = [Char]
type E = Either I (I, S)
fizzbuzz :: [(I, S)] -> [I] -> [S]
fizzbuzz = step >>> map
-- fizzbuzz params = map step params
where step :: [(I, S)] -> I -> S
step = -- params -> n -> s
map step' -- map step' params :: [E -> E]
>>> foldl (>>>) Left
-- foldl (>>>) initial (map step' params) :: I -> E
>>> (>>> show ||| snd)
-- foldl... >>> show ||| snd :: I -> S
step' :: (I, S) -> E -> E
step' = -- (inter, msg) -> \Either n (n,s) -> ...
cy -- ((inter, msg), Either n (n,s)) -> ...
((((snd >>> id ||| fst) -- n
&&& (fst >>> fst) -- inter
>>> uy mod >>> (== 0)) -- ((n `mod` inter) == 0)
&&& ((snd &&& fst >>> second snd) -- (E n (n, s), msg)
>>> uy (stepL ||| stepR)) -- stepL n msg, stepR(n,s)msg
>>> uy if') -- if ... stepL/R...
&&& snd -- E n...
>>> app) -- if ... stepL/R... E n...
stepL :: I -> S -> E
stepL = cy -- (n, msg)
Right -- Right (n, msg)
stepR :: (I, S) -> S -> E
stepR = cy -- ((n, s), msg)
((fst >>> fst) -- n
&&& (first snd >>> uy (++)) -- s ++ msg
>>> Right) -- Right (n, s ++ msg)Arrowは使いどころが難しいけど、うまくつかえば、関数を短くできる可能性を秘めている、ということになる気がする。例えば:
step params = foldl (>>>) Left (map step' params) >>> show ||| snd
これを、純粋に引数なしに書こうとしたら大変だけど(前記のコードに含まれている)、でもArrowを使わなければ、それはそれでもっと長くなる。結局、Arrowの使いどころ、使う程度っていうのは、こういう感じなんだと思う。
階乗関数、再び
階乗関数を書き直した:
module Fac where
import Control.Arrow
if' b t e = if b then t else e
cy = curry
uy = uncurry
fac :: Int -> Int
fac = loop ((snd &&& fst >>> app) &&& (snd >>> step))
-- loop \(b, f) -> (f b, step f)
-- b :: Int
-- f b :: Int
-- f, step f :: Int -> Int
-- step :: (Int -> Int) -> Int -> Int
where step :: (Int -> Int) -> Int -> Int
step = -- \f -> \n -> ... :: (Int -> Int) -> Int -> ...
cy -- \(f, n) -> ... :: ((Int -> Int), Int) -> ...
((snd >>> (/= 1)) -- n /= 1 :: Bool
&&& ((second (flip (-) 1) >>> app) -- f (n - 1) :: Int
&&& snd -- n :: Int
>>> uy (*)) -- f (n - 1) * n :: Int
>>> uy if' -- if' (n/=1) (f n-1) * n)
>>> ($ 1)) -- if' (n/=1) (f n-1) * n) 1 :: Intもう一回、書き直し:
module Fac where
import Control.Arrow
if' b t e = if b then t else e
fac :: Int -> Int
fac =
loop -- (b, f)
( (snd &&& fst) &&& snd -- ((f, b), f)
>>> app *** step) -- (f b, step f)
-- loop (\(b, f) -> (f b, step f))
-- b :: Int
-- f b :: Int
-- f, step f :: Int -> Int
-- step :: (Int -> Int) -> Int -> Int
where step :: (Int -> Int) -> Int -> Int
step =
curry -- (f,n)
( snd &&& snd &&& fst &&& snd -- (n,(n,(f,n))
>>> id *** id *** id *** flip (-) 1 -- (n,(n,(f,n-1)))
>>> id *** id *** app -- (n,(n, f n-1))
>>> (/= 1) *** uncurry (*) -- (n/=1,n*(f n-1))
>>> uncurry if' -- if' n/=1 n*(f n-1)
>>> ($ 1)) -- if' ... ... 1
fizzbuzz関数、再び
fizzbuzz関数がもっと短く書けそうなので、試行錯誤中…
module FizzBuzz where
import Control.Arrow
if' b t e = if b then t else e
fizzbuzz :: [(Int, String)] -> [Int] -> [String]
fizzbuzz = step >>> map
step :: [(Int, String)] -> Int -> String
step = -- params -> n
curry -- (params, n)
((snd >>> Right) -- Right n
&&& (second step' >>> snd &&& fst >>> uncurry map) -- map (step' n) params
>>> uncurry (foldr con) -- folder con (Right n) (map (step' n) params)
>>> id ||| show)
step' :: Int -> (Int, String) -> Either String Int
step' = -- n (inter, msg)
curry -- (n, (inter, msg))
((second fst >>> uncurry mod >>> (== 0)) -- n `mod` inter == 0
&&& (snd >>> snd >>> Left) -- Left msg
>>> uncurry if' -- if' (n`mod`inter==0)(Left msg)
>>> ($ Right 0)) -- if' ... ... (Right 0)
con :: Either String Int -> Either String Int -> Either String Int
con = -- E s n -> E s' n'
(flip -- E s' n' -> s
((curry -- (s', s)
(snd &&& fst >>> uncurry(++) >>> Left)) -- Left s' ++ s
||| const Left)) -- n' -> s' ->... => Left s'
||| const id -- E s' n'
-- fizzbuzz :: [(Int, String)] -> [Int] -> [String]
-- fizzbuzz params list = map (step params) list
-- step :: [(Int, String)] -> Int -> String
-- step params n = (id ||| show) $ foldr con (Right n) (map (step' n) params)
-- step' :: Int -> (Int, String) -> Either String Int
-- step' n (inter, msg) = if n `mod` inter == 0 then Left msg else Right 0
-- con :: Either String Int -> Either String Int -> Either String Int
-- con (Left s) (Left s') = Left (s ++ s')
-- con (Left s) (Right _) = Left s
-- con (Right _) (Left s') = Left s'
-- con (Right _) (Right n) = Right n(つづく)
