Links und Funktionen
Sprachumschaltung

Navigationspfad
Sie sind hier: Startseite / Lehre / SS 2012 / Funktionale Programmierung / Übungen / Lösung 01


Inhaltsbereich

Lösung 01

Lösung zu Blatt 01

Haskell source code icon 01MonadsSolution.hs — Haskell source code, 4 KB (4854 bytes)

Dateiinhalt

-- | Functional Programming, course at LMU, summer term 2012
--   Andreas Abel and Steffen Jost
--
-- Exercise sheet 1, 2012-04-24

{-# LANGUAGE TemplateHaskell, GeneralizedNewtypeDeriving #-}

module Monads where

import Control.Monad.Error
import Control.Monad.State

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 <$>

(<$>) :: Monad m => (a -> b) -> m a -> m b
f <$> m = m >>= return . f

-- b) For your implementation, prove the functor laws from the monad laws

{-
Identity:
  id <$> m
    = m >>= return . id
    = m >>= return
    = m

Composition:
  f <$> (g <$> m)
    = m >>= return . g >>= return . f
    = m >>= \ x -> return (g x) >>= \ y -> return (f y)
    = m >>= \ x -> return (f (g x))
    = m >>= return . f . g
    = 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 = Some
  None   >>= k = None
  Some a >>= k = k a

instance MonadPlus Option where
  mzero = None
  mplus None     m = m
  mplus (Some a) m = Some a

-- 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
-- Define a service monad that generates unique Integer numbers

class Monad m => MonadUnique m where
  unique :: m Integer

newtype Unique a = Unique { un :: State Integer a }
  deriving (Functor, Monad, MonadState Integer)

instance MonadUnique Unique where
  unique = Unique $ do
    s <- get
    put $ s + 1
    return s

runUnique :: Unique a -> a
runUnique (Unique m) = evalState m 0

test :: StateT Bool (State Integer) ()
test = do
  put 5
  put True
  x <- not <$> get
  put x

-- 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

class Monad m => MonadCost m where
  pay :: Integer -> m ()

newtype Cost a = Cost { runCost :: (a, Integer) }

instance Monad Cost where
  return a = Cost (a, 0)
  m >>= k  = Cost $
    let (a, i) = runCost m
        (b, j) = runCost (k a)
    in  (b, i + j)

instance MonadCost Cost where
  pay n = Cost ((), 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 []     acc = return acc
revAppSum (x:xs) acc = do
  pay x
  revAppSum xs (x:acc)

-- | @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)

----------------------------------------------------------------------

runTests = $quickCheckAll
Verweise
Übung 01

Artikelaktionen


Funktionsleiste