[Haskell-beginners] Monadic Project Euler 1
Daniel Fischer
daniel.is.fischer at googlemail.com
Thu Feb 17 23:41:02 CET 2011
On Thursday 17 February 2011 22:02:58, Javier M Mora wrote:
> Yes, I'm trying to learn/practice Design Patterns in Haskell making
> euler problems three times:
>
> 1. Non Monad
That's easy for this one. And I don't think this problem lends itself well
to a monadic approach (it can be done okay enough with a State and/or
Writer, but it still seems artificial to use those).
> 2. Ad-hoc Monad
The problem is too specialised to fit a custom Monad to it, I think.
There's only one (base) type involved, so you have not enough to find out
how (>>=) :: m a -> (a -> m b) -> m b should work.
> 3. Standard Monad
State 1:
import Data.List (partition)
multiples :: Integral a => a -> State [a] [a]
multiples k = state (partition (\m -> m `mod` k == 0))
-- if you use mtl-1.*, replace the lowercase state with State
-- could also be any Integral type
euler1M :: [Integer] -> State [Integer] Integer
euler1M nums = do
mlists <- mapM multiples nums
return (sum $ concat mlists)
-- or, special and not general
-- euler1 :: State [Integer] Integer
-- euler1M = do
-- m3 <- multiples 3
-- m5 <- multiples 5
-- return (sum m3 + sum m5)
euler1 :: [Integer] -> Integer -> Integer
euler1 nums limit = evalState (euler1M nums) [1 .. limit-1]
answer = euler1 [3,5] 1000
State 2:
import Data.List (partition)
multiples :: Integral a => a -> State ([a],[a]) ()
multiples k = state $ \(v,c) ->
let (nv,nc) = partition (\m -> m `mod` k == 0) c
in ((), (nv ++ v, nc))
validSum :: Num a => State ([a],[a]) a
validSum = state $ \s@(v,_) -> (sum v, s)
euler1M :: Integral a => [a] -> State ([a],[a]) a
euler1M nums = do
mapM_ multiples nums
validSum
Writer:
import Data.List (partition)
multiples :: Integral a => [a] -> a -> Writer [a] [a]
multiples candidates k =
writer (partition (\m -> m `mod` k /= 0) candidates
-- For mtl-1.*, that has to be Writer
euler1M :: Integral a => [a] -> [a] -> Writer [a] [a]
euler1M = foldM multiples
euler1 :: [Integer] -> Integer -> Integer
euler1 nums limit = sum . execWriter $ euler1M [1 .. limit-1] nums
Really, there are problems that lend themselves better to a monadic
approach.
>
> Thank you for help me in the 3rd Stage. I was trying to solve 2nd Stage.
> :-(
More information about the Beginners
mailing list