Sprachumschaltung

Sie sind hier: Übung 01

Übung 01

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!
--
-- Spell out proofs where asked for.
--
-- Submit your solutions via UniWorX.

----------------------------------------------------------------------
--
-- You can add imports and LANGUAGE pragmas here.
----------------------------------------------------------------------

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

-- Option type constructor.

data Option a = None | Some a
deriving (Show, Eq, Ord)

return = undefined
(>>=)  = undefined

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

(return a >>= k)         == (k a :: Option Int)
(m >>= return)           == (m   :: Option Int)
(m >>= \ x -> k x >>= l) == (m >>= k >>= l :: Option Int)

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)

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.
unique :: m Integer

newtype Unique a = Unique Undefined

return = undefined
(>>=)  = undefined

unique = undefined

runUnique :: Unique a -> a
runUnique = undefined

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

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

-- Implement a monad that lets you pay for computation

-- | Abstract monad for accumulating costs.
pay :: Integer -> m ()

newtype Cost a = Cost Undefined

return a = undefined
m >>= k  = undefined

pay n = undefined

runCost :: Cost a -> (a, Integer)
runCost = undefined

-- | @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 = undefined

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

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