Lösung 01 alternativ
Alternative Lösung für 3 und 4 auf Blatt 01
01MonadsSolutionAlt.hs
—
Haskell source code,
5 KB (6044 bytes)
Dateiinhalt
-- | Functional Programming, course at LMU, summer term 2012 -- Andreas Abel and Steffen Jost -- -- Exercise sheet 1, 2012-04-25 -- -- Instructions: -- -- Replace all occurrences of 'undefined' and 'Undefined' by sensible code. -- Do not change the type of functions you are asked to implement! -- Quickcheck test cases may help you finding bugs. -- -- Spell out proofs where asked for. -- -- Submit your solutions via UniWorX. ---------------------------------------------------------------------- -- Header -- -- You can add imports and LANGUAGE pragmas here. ---------------------------------------------------------------------- {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} module Monads where import Control.Monad.Error import Control.Monad.State import Control.Monad.Writer import qualified Data.Set as Set import Test.QuickCheck import Test.QuickCheck.All data Undefined ---------------------------------------------------------------------- -- Exercise 1 ---------------------------------------------------------------------- -- a) Define functoriality from a monad infixl 5 <$> -- | Map function for monads. (<$>) :: Monad m => (a -> b) -> m a -> m b f <$> m = undefined -- b) For your implementation, prove the functor laws from the monad laws {- Identity: id <$> m = m Composition: f <$> (g <$> m) = f . g <$> m -} -- Tests for Exercise 1 ---------------------------------------------- prop_mmap_identity m = id <$> m == (m :: [Int]) prop_mmap_composition f g m = f <$> (g <$> m) == f . g <$> (m :: [Int]) ---------------------------------------------------------------------- -- Exercise 2 ---------------------------------------------------------------------- -- Define the Monad and MonadPlus instances for the following -- Option type constructor. data Option a = None | Some a deriving (Show, Eq, Ord) instance Monad Option where return = undefined (>>=) = undefined instance MonadPlus Option where mzero = undefined mplus = undefined -- Tests for Exercise 2 ---------------------------------------------- instance Arbitrary a => Arbitrary (Option a) where arbitrary = frequency [(1, return None), (4, fmap Some arbitrary)] shrink _ = [] instance Show (a -> b) where show f = "<function>" -- Monad laws prop_monad_left a k = (return a >>= k) == (k a :: Option Int) prop_monad_right m = (m >>= return) == (m :: Option Int) prop_monad_assoc m k l = (m >>= \ x -> k x >>= l) == (m >>= k >>= l :: Option Int) -- MonadZero laws prop_mzero_left m = mzero `mplus` m == (m :: Option Int) prop_mzero_right m = m `mplus` mzero == (m :: Option Int) prop_mzero_assoc m1 m2 m3 = m1 `mplus` (m2 `mplus` m3) == (m1 `mplus` m2) `mplus` (m3 :: Option Int) -- MonadZero bind laws prop_zero_bind_l k = (mzero >>= k) == (mzero :: Option Int) prop_zero_bind_r m = (m >> mzero) == (mzero :: Option Int) -- Left distribution law does not hold for Option -- prop_plus_dist_l m n k = -- ((m `mplus` n) >>= k) == ((m >>= k) `mplus` (n >>= k) :: Option Int) prop_plus_dist_r m k l = (m >>= \ x -> k x `mplus` l x) == ((m >>= k) `mplus` (m >>= l) :: Option Int) ---------------------------------------------------------------------- -- Exercise 3 ---------------------------------------------------------------------- -- | Class of service monads that generate unique Integer numbers. class Monad m => MonadUnique m where unique :: m Integer newtype Unique a = Unique { un :: Integer -> (a, Integer) } {- un :: Unique a -> Integer -> (a, Integer) un (Unique m) = m -} instance Monad Unique where return a = Unique $ \ s -> (a, s) (Unique m) >>= k = Unique $ \ s -> let (a, s') = m s in un (k a) s' instance MonadUnique Unique where unique = Unique $ \ s -> (s, s+1) instance MonadState Integer Unique where get = Unique $ \ s -> (s, s) put s' = Unique $ \ s -> ((), s') runUnique :: Unique a -> a runUnique (Unique m) = fst $ m 289374 -- Tests for Exercise 3 ---------------------------------------------- -- | @uniques n@ generates a list of @n@ different @Integer@s. uniques :: Int -> [Integer] uniques n = runUnique $ forM [1..n] $ const unique -- | @allDifferent l@ checks that list @l@ does not contain duplicates. -- O(n log n), but not implemented efficiently. allDifferent :: (Eq a, Ord a) => [a] -> Bool allDifferent l = l == Set.toList (Set.fromList l) -- | Test that numbers generated by @unique@ are in fact unique. prop_unique = forAll (choose (1,100)) $ \ n -> allDifferent (uniques n) ---------------------------------------------------------------------- -- Exercise 4 Output monad ---------------------------------------------------------------------- -- Implement a monad that lets you pay for computation -- | Abstract monad for accumulating costs. class Monad m => MonadCost m where pay :: Integer -> m () newtype Cost a = Cost { unCost :: Writer (Sum Integer) a } deriving (Monad, MonadWriter (Sum Integer)) instance MonadCost Cost where pay n = tell (Sum n) runCost :: Cost a -> (a, Integer) runCost (Cost m) = let (a, Sum n) = runWriter m in (a, n) -- | @revAppSum xs acc@ reverses @xs@ onto @acc@ and 'pay's amount @x@ -- for each element @x@ of the list @xs@ that is touched. revAppSum :: MonadCost m => [Integer] -> [Integer] -> m [Integer] revAppSum xs acc = foldl (\ macc x -> pay x >> (x:) <$> macc) (return acc) xs -- | @reverseSum xs@ returns @(reverse xs, sum xs)@ which is computed -- by a call to 'revAppSum'. reverseSum :: [Integer] -> ([Integer], Integer) reverseSum xs = runCost $ revAppSum xs [] -- Tests for Exercise 4 ---------------------------------------------- prop_reverseSum xs = reverseSum xs == (reverse xs, sum xs) ---------------------------------------------------------------------- -- Haskell footer ---------------------------------------------------------------------- -- | Runs all tests starting with "prop_" in this file. runTests = $quickCheckAll
Artikelaktionen
abgelegt unter:
ÜbungFunktionaleProgrammierung