mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
add Set5a, Set5b, Set6, Set7
This commit is contained in:
Joel Kaasinen
@@ -0,0 +1,260 @@
|
||||
-- Exercise set 5a
|
||||
--
|
||||
-- * defining algebraic datatypes
|
||||
-- * recursive datatypes
|
||||
|
||||
|
||||
module Set5a where
|
||||
|
||||
import Mooc.Todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 1: Define the type Vehicle that has four constructors: Bike,
|
||||
-- Bus, Tram and Train.
|
||||
--
|
||||
-- The constructors don't need any fields.
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 2: Define the type BusTicket that can represent values like these:
|
||||
-- - SingleTicket
|
||||
-- - MonthlyTicket "January"
|
||||
-- - MonthlyTicket "December"
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 3: Here's the definition for a datatype ShoppingEntry that
|
||||
-- represents an entry in a shopping basket. It has an item name (a
|
||||
-- String), an item price (a Double) and a count (Int). You'll also
|
||||
-- find two examples of ShoppingEntry values.
|
||||
--
|
||||
-- Implement the functions totalPrice and buyOneMore below.
|
||||
|
||||
data ShoppingEntry = MkShoppingEntry String Double Int
|
||||
deriving Show
|
||||
|
||||
threeApples :: ShoppingEntry
|
||||
threeApples = MkShoppingEntry "Apple" 0.5 3
|
||||
|
||||
twoBananas :: ShoppingEntry
|
||||
twoBananas = MkShoppingEntry "Banana" 1.1 2
|
||||
|
||||
-- totalPrice should return the total price for an entry
|
||||
--
|
||||
-- Hint: you'll probably need fromIntegral to convert the Int into a
|
||||
-- Double
|
||||
--
|
||||
-- Examples:
|
||||
-- totalPrice threeApplies ==> 1.5
|
||||
-- totalPrice twoBananas ==> 2.2
|
||||
|
||||
totalPrice :: ShoppingEntry -> Double
|
||||
totalPrice = todo
|
||||
|
||||
-- buyOneMore should increment the count in an entry buy one
|
||||
--
|
||||
-- Example:
|
||||
-- buyOneMore twoBananas ==> MkShoppingEntry "Banana" 1.1 3
|
||||
|
||||
buyOneMore :: ShoppingEntry -> ShoppingEntry
|
||||
buyOneMore = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 4: define a datatype Person, which should contain the age (an
|
||||
-- Int) and the name (a String) of a person.
|
||||
--
|
||||
-- Also define a Person value fred, and the functions getAge, getName,
|
||||
-- setAge and setName (see below).
|
||||
|
||||
data Person = PersonUndefined
|
||||
deriving Show
|
||||
|
||||
-- fred is a person whose name is Fred and age is 90
|
||||
fred :: Person
|
||||
fred = todo
|
||||
|
||||
-- getName returns the name of the person
|
||||
getName :: Person -> String
|
||||
getName p = todo
|
||||
|
||||
-- getAge returns the age of the person
|
||||
getAge :: Person -> Int
|
||||
getAge p = todo
|
||||
|
||||
-- setName takes a person and returns a new person with the name changed
|
||||
setName :: String -> Person -> Person
|
||||
setName name p = todo
|
||||
|
||||
-- setAge does likewise for age
|
||||
setAge :: Int -> Person -> Person
|
||||
setAge age p = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 5: define a datatype Position which contains two Int values, x
|
||||
-- and y. Also define the functions below for operating on a Position.
|
||||
--
|
||||
-- Examples:
|
||||
-- getY (up (up origin)) ==> 2
|
||||
-- getX (up (right origin)) ==> 1
|
||||
|
||||
data Position = PositionUndefined
|
||||
|
||||
-- origin is a Position value with x and y set to 0
|
||||
origin :: Position
|
||||
origin = todo
|
||||
|
||||
-- getX returns the x of a Position
|
||||
getX :: Position -> Int
|
||||
getX = todo
|
||||
|
||||
-- getY returns the y of a position
|
||||
getY :: Position -> Int
|
||||
getY = todo
|
||||
|
||||
-- up increases the y value of a position by one
|
||||
up :: Position -> Position
|
||||
up = todo
|
||||
|
||||
-- right increases the x value of a position by one
|
||||
right :: Position -> Position
|
||||
right = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 6: Here's a datatype that represents a student. A student can
|
||||
-- either be a freshman, a nth year student, or graduated.
|
||||
|
||||
data Student = Freshman | NthYear Int | Graduated
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- Implement the function study, which changes a Freshman into a 1st
|
||||
-- year student, a 1st year student into a 2nd year student, and so
|
||||
-- on. A 7th year student gets changed to a graduated student. A
|
||||
-- graduated student stays graduated even if he studies.
|
||||
|
||||
study :: Student -> Student
|
||||
study = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 7: define a datatype UpDown that represents a counter that can
|
||||
-- either be in incresing or decreasing mode. Also implement the
|
||||
-- functions zero, toggle, tick and get below.
|
||||
--
|
||||
-- NB! Define _two_ constructors for your datatype (feel free to name the
|
||||
-- constructors however you want)
|
||||
--
|
||||
-- Examples:
|
||||
--
|
||||
-- get (tick zero)
|
||||
-- ==> 1
|
||||
-- get (tick (tick zero))
|
||||
-- ==> 2
|
||||
-- get (tick (tick (toggle (tick zero))))
|
||||
-- ==> -1
|
||||
|
||||
data UpDown = UpDownUndefined1 | UpDownUndefined2
|
||||
|
||||
-- zero is an increasing counter with value 0
|
||||
zero :: UpDown
|
||||
zero = todo
|
||||
|
||||
-- get returns the counter value
|
||||
get :: UpDown -> Int
|
||||
get ud = todo
|
||||
|
||||
-- tick increases an increasing counter by one or decreases a
|
||||
-- decreasing counter by one
|
||||
tick :: UpDown -> UpDown
|
||||
tick ud = todo
|
||||
|
||||
-- toggle changes an increasing counter into a decreasing counter and
|
||||
-- vice versa
|
||||
toggle :: UpDown -> UpDown
|
||||
toggle ud = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 8: you'll find a Color datatype below. It has the three basic
|
||||
-- colours Red, Green and Blue, and two color transformations, Mix and
|
||||
-- Invert.
|
||||
--
|
||||
-- Mix means the average of the two colors in each rgb channel.
|
||||
--
|
||||
-- Invert means subtracting all rgb values from 1.
|
||||
--
|
||||
-- Implement the function rgb :: Color -> [Double] that returns a list
|
||||
-- of length three that represents the rgb value of the given color.
|
||||
--
|
||||
-- Examples:
|
||||
--
|
||||
-- rgb Red ==> [1,0,0]
|
||||
-- rgb Green ==> [0,1,0]
|
||||
-- rgb Blue ==> [0,0,1]
|
||||
--
|
||||
-- rgb (Mix Red Green) ==> [0.5,0.5,0]
|
||||
-- rgb (Mix Red (Mix Red Green)) ==> [0.75,0.25,0]
|
||||
-- rgb (Invert Red) ==> [0,1,1]
|
||||
-- rgb (Invert (Mix Red (Mix Red Green))) ==> [0.25,0.75,1]
|
||||
-- rgb (Mix (Invert Red) (Invert Green)) ==> [0.5,0.5,1]
|
||||
|
||||
data Color = Red | Green | Blue | Mix Color Color | Invert Color
|
||||
deriving Show
|
||||
|
||||
rgb :: Color -> [Double]
|
||||
rgb col = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 9: define a parameterized datatype OneOrTwo that contains one or
|
||||
-- two values of the given type. The constructors should be called One and Two.
|
||||
--
|
||||
-- Examples:
|
||||
-- One True :: OneOrTwo Bool
|
||||
-- Two "cat" "dog" :: OneOrTwo String
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 10: define a recursive datatype KeyVals for storing a set of
|
||||
-- key-value pairs. There should be two constructors: Empty and Pair.
|
||||
--
|
||||
-- Empty represents an empty collection. It should have no fields.
|
||||
--
|
||||
-- Pair should have three fields, one for the key, one for the value,
|
||||
-- and one for the rest of the collection (of type KeyVals)
|
||||
--
|
||||
-- The KeyVals datatype is parameterized by the key type k and
|
||||
-- the value type v.
|
||||
--
|
||||
-- For example:
|
||||
--
|
||||
-- Pair "cat" True (Pair "dog" False Empty) :: KeyVals String Bool
|
||||
--
|
||||
-- Also define the functions toList and fromList that convert between
|
||||
-- KeyVals and lists of pairs.
|
||||
|
||||
data KeyVals k v = KeyValsUndefined
|
||||
deriving Show
|
||||
|
||||
toList :: KeyVals k v -> [(k,v)]
|
||||
toList = todo
|
||||
|
||||
fromList :: [(k,v)] -> KeyVals k v
|
||||
fromList = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Exercise 11: The data type Nat is the so called Peano
|
||||
-- representation for natural numbers. Define functions fromNat and
|
||||
-- toNat that convert natural numbers to Ints and vice versa.
|
||||
--
|
||||
-- Examples:
|
||||
-- toNat 3 ==> Just (PlusOne (PlusOne (PlusOne Zero)))
|
||||
-- toNat (-3) ==> Nothing
|
||||
-- fromNat (PlusOne (PlusOne (PlusOne Zero))) ==> 3
|
||||
--
|
||||
|
||||
data Nat = Zero | PlusOne Nat
|
||||
deriving (Show,Eq)
|
||||
|
||||
fromNat :: Nat -> Int
|
||||
fromNat n = todo
|
||||
|
||||
toNat :: Int -> Maybe Nat
|
||||
toNat z = todo
|
||||
|
||||
@@ -0,0 +1,187 @@
|
||||
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
||||
|
||||
module Set5aTest where
|
||||
|
||||
import Data.List
|
||||
import Test.QuickCheck
|
||||
|
||||
import Mooc.Th
|
||||
import Mooc.Test
|
||||
|
||||
import Set5a
|
||||
|
||||
main = score tests
|
||||
|
||||
tests = [(1,"Vehicle",[ex1])
|
||||
,(2,"BusTicket",[ex2])
|
||||
,(3,"ShippingEntry",[ex3_totalPrice, ex3_buyOneMore])
|
||||
,(4,"Person",[ex4_name, ex4_age])
|
||||
,(5,"Position",[ex5_simple, ex5_generate])
|
||||
,(6,"Student",[ex6_freshman, ex6_nth, ex6_graduated, ex6_graduate])
|
||||
,(7,"UpDown",[ex7_type, ex7_simple, ex7_generate])
|
||||
,(8,"Color",[ex8_red, ex8_green, ex8_blue, ex8_simple, ex8_complicated])
|
||||
,(9,"OneOrTwo",[ex9])
|
||||
,(10,"KeyVals",[ex10_type, ex10_string_bool, ex10_int_int])
|
||||
,(11,"Nat",[ex11_to, ex11_from, ex11_just, ex11_nothing])
|
||||
]
|
||||
|
||||
-- -- -- -- -- -- -- --
|
||||
|
||||
assertNormalConstructor (Constructor _ _) = property True
|
||||
assertNormalConstructor (Weird n) = counterexample (" constructor "++n++" is weird. Make it normal.") False
|
||||
|
||||
assertNoFields (Constructor n vs) = counterexample (" constructor "++n++" should have no fields") $ null vs
|
||||
assertNoFields _ = property True
|
||||
|
||||
assertFields exp (Constructor n vs) = counterexample (" constructor "++n++" field types") $ vs ?== exp
|
||||
assertFields _ _ = property True
|
||||
|
||||
ex1 = $(reifyType "Vehicle") $ \(DataType vars cs) ->
|
||||
conjoin [counterexample " should have no type parameters" $ vars == []
|
||||
,counterexample " should have 4 constructors" $ length cs ?== 4
|
||||
,conjoin $ map assertNormalConstructor cs
|
||||
,conjoin $ map assertNoFields cs
|
||||
,counterexample " constructor names" $
|
||||
hasElements ["Bike","Bus","Train","Tram"] [n | Constructor n _ <- cs]
|
||||
]
|
||||
|
||||
ex2 = $(reifyType "BusTicket") $ \(DataType vars cs) ->
|
||||
conjoin [counterexample " should have no type parameters" $ vars == []
|
||||
,counterexample " should have 2 constructors" $ length cs ?== 2
|
||||
,counterexample " constructor names" $
|
||||
hasElements ["SingleTicket", "MonthlyTicket"] [n | Constructor n _ <- cs]
|
||||
,conjoin $ map assertNormalConstructor cs
|
||||
,counterexample " should have a constructor SingleTicket with no fields" $
|
||||
any (==Constructor "SingleTicket" []) cs
|
||||
,counterexample " should have a constructor MonthlyTicket with a String field" $
|
||||
any (==Constructor "MonthlyTicket" [SimpleType "String"]) cs
|
||||
]
|
||||
|
||||
word = listOf1 (choose ('a','z'))
|
||||
|
||||
ex3_totalPrice = forAllBlind word $ \name ->
|
||||
forAll_ $ \count ->
|
||||
forAllBlind (elements [0.1,0.25..2.0]) $ \price ->
|
||||
$(testing [|totalPrice (MkShoppingEntry name price count)|]) (?~=price * fromIntegral count)
|
||||
|
||||
eq (MkShoppingEntry n p c) (MkShoppingEntry n' p' c') = and [n==n',p==p',c==c']
|
||||
|
||||
ex3_buyOneMore = forAllBlind word $ \name -> forAll_ $ \(price,count) ->
|
||||
let exp = MkShoppingEntry name price (succ count)
|
||||
in $(testing [|buyOneMore (MkShoppingEntry name price count)|]) (\v -> expectation exp v (eq exp v))
|
||||
|
||||
ex4_name = property $ do
|
||||
n <- word
|
||||
return $ counterexample ("getName (setName "++show n++" fred)") $
|
||||
getName (setName n fred) === n
|
||||
|
||||
ex4_age = property $ do
|
||||
a <- choose (0,89)
|
||||
return $ counterexample ("getAge (setAge "++show a++" fred)") $
|
||||
getAge (setAge a fred) === a
|
||||
|
||||
ex5_simple = conjoin [$(testing' [|getX origin|]) (?==0)
|
||||
,$(testing' [|getY origin|]) (?==0)
|
||||
,$(testing' [|getX (right origin)|]) (?==1)
|
||||
,$(testing' [|getY (up origin)|]) (?==1)]
|
||||
|
||||
ex5_generate = forAllShrink_ (choose (0,20)) $ \a ->
|
||||
forAllShrink_ (choose (0,20)) $ \b' ->
|
||||
let b = a+b'
|
||||
pos0 = iterate (right . up) origin !! a
|
||||
pos1 = iterate up pos0 !! b'
|
||||
in counterexample ("After starting from origin and going right "++show a++" times and up "++show b++" times:") $
|
||||
conjoin [counterexample "getX" (getX pos1 ?== a)
|
||||
,counterexample "getY" (getY pos1 ?== b)]
|
||||
|
||||
ex6_freshman = $(testing [|study Freshman|]) (?==NthYear 1)
|
||||
ex6_nth = forAllBlind (choose (1,6)) $ \i -> $(testing [|study (NthYear i)|]) (?==NthYear (i+1))
|
||||
ex6_graduate = $(testing [|study (NthYear 7)|]) (?==Graduated)
|
||||
ex6_graduated = $(testing [|study Graduated|]) (?==Graduated)
|
||||
|
||||
ex7_type = $(reifyType "UpDown") $ \(DataType vars cs) ->
|
||||
conjoin [counterexample " should have no type parameters" $ vars == []
|
||||
,counterexample " should have 2 constructors" $ length cs ?== 2
|
||||
,conjoin $ map (assertFields [SimpleType "Int"]) cs
|
||||
]
|
||||
|
||||
ex7_simple = conjoin [$(testing' [|get zero|]) (?== 0)
|
||||
,$(testing' [|get (tick zero)|]) (?== 1)
|
||||
,$(testing' [|get (tick (toggle zero))|]) (?== negate 1)
|
||||
,$(testing' [|get (toggle (tick (zero)))|]) (?== 1)]
|
||||
|
||||
ex7_generate =
|
||||
forAllShrink_ (choose (0,20)) $ \a ->
|
||||
forAllShrink_ (choose (0,20)) $ \b ->
|
||||
let tc0 = iterate tick zero !! a
|
||||
tc1 = iterate tick (toggle tc0) !! b
|
||||
in counterexample ("Did "++show a++" ticks, a toggle, and "++show b++" ticks:") $
|
||||
counterexample "get:" (get tc1 ?== a-b)
|
||||
|
||||
ex8_red = $(testing [|rgb Red|]) (?==[1,0,0])
|
||||
ex8_green = $(testing [|rgb Green|]) (?==[0,1,0])
|
||||
ex8_blue = $(testing [|rgb Blue|]) (?==[0,0,1])
|
||||
|
||||
fcmp expected actual =
|
||||
expectation expected actual (diff < eps)
|
||||
where diff = sum . map abs $ zipWith (-) actual expected
|
||||
eps = 0.01
|
||||
|
||||
ex8_simple = property $ do
|
||||
~[c1,c2,c3,c4] <- shuffle [Red,Red,Red,Green]
|
||||
return $ conjoin [$(testing [|rgb (Mix (Mix c1 c2) (Mix c3 c4))|]) (fcmp [0.75,0.25,0])
|
||||
,$(testing [|rgb (Invert (Mix (Mix c1 c2) (Mix c3 c4)))|]) (fcmp [0.25,0.75,1.0])]
|
||||
|
||||
ex8_complicated = property $ do
|
||||
cs <- vectorOf 4 (elements [Red,Invert Red,Green,Invert Green,Blue,Invert Blue])
|
||||
let ~[c1,c2,c3,c4] = cs
|
||||
r = fromIntegral $ length $ filter (has Red) cs
|
||||
g = fromIntegral $ length $ filter (has Green) cs
|
||||
b = fromIntegral $ length $ filter (has Blue) cs
|
||||
return $ $(testing [|rgb (Mix (Mix c1 c2) (Mix c3 c4))|]) (fcmp [r/4, g/4, b/4])
|
||||
where has Red Red = True
|
||||
has Blue Blue = True
|
||||
has Green Green = True
|
||||
has x (Invert c) = not (has x c)
|
||||
has _ _ = False
|
||||
|
||||
ex9 = $(reifyType "OneOrTwo") $ \(DataType vars cs) ->
|
||||
conjoin [counterexample " should have one type parameter" $ length vars ?== 1
|
||||
,counterexample " should have 2 constructors" $ length cs ?== 2
|
||||
,counterexample " constructor names" $
|
||||
hasElements ["One", "Two"] [n | Constructor n _ <- cs]
|
||||
,conjoin $ map assertNormalConstructor cs
|
||||
,counterexample " should have a constructor One with one field of the parameter type" $
|
||||
any ((==) $ Constructor "One" $ map SimpleType vars) cs
|
||||
,counterexample " should have a constructor Two with two fields of the parameter type" $
|
||||
any ((==) $ Constructor "Two" $ map SimpleType $ vars++vars) cs
|
||||
]
|
||||
|
||||
ex10_type = $(reifyType "KeyVals") $ \(DataType vars cs) ->
|
||||
conjoin [counterexample " type parameters" $ ["k","v"] ?== vars
|
||||
,counterexample " should have 2 constructors" $ length cs ?== 2
|
||||
,conjoin $ map assertNormalConstructor cs
|
||||
,counterexample " constructor names" $
|
||||
hasElements ["Empty", "Pair"] [n | Constructor n _ <- cs]
|
||||
,counterexample " should have a constructor Empty with no fields" $
|
||||
any (==Constructor "Empty" []) cs
|
||||
,counterexample " should have a constructor Pair with the right fields" $
|
||||
any (==Constructor "Pair" [SimpleType "k",SimpleType "v",SimpleType "KeyVals k v"]) cs
|
||||
]
|
||||
|
||||
m_ex10 vs = counterexample ("toList (fromList "++show vs++"))") $ vs ==? toList (fromList vs)
|
||||
|
||||
ex10_string_bool = forAll_ $ \(kvs::[(String,Bool)]) -> m_ex10 kvs
|
||||
|
||||
ex10_int_int = forAll_ $ \(kvs::[(Int,Int)]) -> m_ex10 kvs
|
||||
|
||||
instance Arbitrary Nat where
|
||||
arbitrary = oneof $ map return $ take 20 $ iterate PlusOne Zero
|
||||
|
||||
ex11_to = $(testing [| toNat 0 |]) (?== Just Zero)
|
||||
ex11_from = $(testing [| fromNat Zero |]) (?== 0)
|
||||
ex11_just = forAll_ $ \(n :: Nat) ->
|
||||
counterexample (" toNat (fromNat " ++ show n ++ ")")
|
||||
(toNat (fromNat n) ?== Just n)
|
||||
ex11_nothing = forAll_ $ \(Negative (z :: Int)) ->
|
||||
$(testing [|toNat z|]) (?== Nothing)
|
||||
@@ -0,0 +1,208 @@
|
||||
-- Exercise set 5b: playing with binary trees
|
||||
|
||||
|
||||
module Set5b where
|
||||
|
||||
import Mooc.Todo
|
||||
|
||||
-- These next exercises use the binary tree type defined like this:
|
||||
|
||||
data Tree a = Empty | Node a (Tree a) (Tree a)
|
||||
deriving (Show, Eq)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 1: implement the function valAtRoot which returns the value at
|
||||
-- the root (top-most node) of the tree. The return value is Maybe a
|
||||
-- because the tree might be empty (i.e. just a Empty)
|
||||
|
||||
valAtRoot :: Tree a -> Maybe a
|
||||
valAtRoot t = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 2: compute the size of a tree, that is, the number of Node
|
||||
-- constructors in it
|
||||
--
|
||||
-- Examples:
|
||||
-- treeSize (Node 3 (Node 7 Empty Empty) Empty) ==> 2
|
||||
-- treeSize (Node 3 (Node 7 Empty Empty) (Node 1 Empty Empty)) ==> 3
|
||||
|
||||
treeSize :: Tree a -> Int
|
||||
treeSize t = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 3: get the largest value in a tree of positive Ints. The
|
||||
-- largest value of an empty tree should be 0.
|
||||
--
|
||||
-- Examples:
|
||||
-- treeMax Empty ==> 0
|
||||
-- treeMax (Node 3 (Node 5 Empty Empty) (Node 4 Empty Empty)) ==> 5
|
||||
|
||||
treeMax :: Tree Int -> Int
|
||||
treeMax = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 4: implement a function that checks if all tree values satisfy a
|
||||
-- condition.
|
||||
--
|
||||
-- Examples:
|
||||
-- allValues (>0) Empty ==> True
|
||||
-- allValues (>0) (Node 1 (Node 2 Empty Empty)) ==> True
|
||||
-- allValues (>0) (Node 1 (Node 0 Empty Empty)) ==> False
|
||||
|
||||
allValues :: (a -> Bool) -> Tree a -> Bool
|
||||
allValues condition tree = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 5: implement map for trees.
|
||||
--
|
||||
-- Examples:
|
||||
--
|
||||
-- mapTree (+1) Empty ==> Empty
|
||||
-- mapTree (+2) (Node 0 (Node 1 Empty Empty) (Node 2 Empty Empty))
|
||||
-- ==> (Node 2 (Node 3 Empty Empty) (Node 4 Empty Empty))
|
||||
|
||||
mapTree :: (a -> b) -> Tree a -> Tree b
|
||||
mapTree f t = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 6: given a value and a tree, build a new tree that is the same,
|
||||
-- except all nodes that contain the value have been removed. Also
|
||||
-- remove the subnodes of the removed noded.
|
||||
--
|
||||
-- Examples:
|
||||
--
|
||||
-- 1 1
|
||||
-- / \ ==> \
|
||||
-- 2 0 0
|
||||
--
|
||||
-- cull 2 (Node 1 (Node 2 Empty Empty)
|
||||
-- (Node 0 Empty Empty))
|
||||
-- ==> (Node 1 Empty
|
||||
-- (Node 0 Empty Empty))
|
||||
--
|
||||
-- 1 1
|
||||
-- / \ \
|
||||
-- 2 0 ==> 0
|
||||
-- / \
|
||||
-- 3 4
|
||||
--
|
||||
-- cull 2 (Node 1 (Node 2 (Node 3 Empty Empty)
|
||||
-- (Node 4 Empty Empty))
|
||||
-- (Node 0 Empty Empty))
|
||||
-- ==> (Node 1 Empty
|
||||
-- (Node 0 Empty Empty)
|
||||
--
|
||||
-- 1 1
|
||||
-- / \ \
|
||||
-- 0 3 ==> 3
|
||||
-- \ \
|
||||
-- 2 0
|
||||
--
|
||||
-- cull 0 (Node 1 (Node 0 Empty
|
||||
-- (Node 2 Empty Empty))
|
||||
-- (Node 3 Empty
|
||||
-- (Node 0 Empty Empty)))
|
||||
-- ==> (Node 1 Empty
|
||||
-- (Node 3 Empty Empty))
|
||||
|
||||
cull :: Eq a => a -> Tree a -> Tree a
|
||||
cull val tree = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 7: check if a tree is ordered. A tree is ordered if:
|
||||
-- * all values to the left of the root are smaller than the root value
|
||||
-- * all of the values to the right of the root are larger than the root value
|
||||
-- * and the left and right subtrees are ordered.
|
||||
--
|
||||
-- Hint: allValues will help you here!
|
||||
--
|
||||
-- Examples:
|
||||
-- 1
|
||||
-- / \ is ordered:
|
||||
-- 0 2
|
||||
-- isOrdered (Node 1 (Node 0 Empty Empty)
|
||||
-- (Node 2 Empty Empty)) ==> True
|
||||
--
|
||||
-- 1
|
||||
-- / \ is not ordered:
|
||||
-- 2 3
|
||||
-- isOrdered (Node 1 (Node 2 Empty Empty)
|
||||
-- (Node 3 Empty Empty)) ==> False
|
||||
--
|
||||
-- 2
|
||||
-- / \
|
||||
-- 1 3 is not ordered:
|
||||
-- \
|
||||
-- 0
|
||||
-- isOrdered (Node 2 (Node 1 Empty
|
||||
-- (Node 0 Empty Empty))
|
||||
-- (Node 3 Empty Empty)) ==> False
|
||||
--
|
||||
-- 2
|
||||
-- / \
|
||||
-- 0 3 is ordered:
|
||||
-- \
|
||||
-- 1
|
||||
-- isOrdered (Node 2 (Node 0 Empty
|
||||
-- (Node 1 Empty Empty))
|
||||
-- (Node 3 Empty Empty)) ==> True
|
||||
|
||||
isOrdered :: Ord a => Tree a -> Bool
|
||||
isOrdered = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 8: a path in a tree can be represented as a list of steps that
|
||||
-- go either left or right.
|
||||
|
||||
data Step = StepL | StepR
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- Define a function walk that takes a tree and a list of steps, and
|
||||
-- returns the value at that point. Return Nothing if you fall of the
|
||||
-- tree (i.e. hit a Empty).
|
||||
--
|
||||
-- Examples:
|
||||
-- walk [] (Node 1 (Node 2 Empty Empty)) ==> Just 1
|
||||
-- walk [StepL] (Node 1 (Node 2 Empty Empty)) ==> Just 2
|
||||
-- walk [StepL,StepL] (Node 1 (Node 2 Empty Empty)) ==> Nothing
|
||||
|
||||
walk :: [Step] -> Tree a -> Maybe a
|
||||
walk = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 9: given a tree, a path and a value, set the value at the end of
|
||||
-- the path to the given value. Since Haskell datastructures are
|
||||
-- immutable, you'll need to build a new tree.
|
||||
--
|
||||
-- If the path falls off the tree, do nothing.
|
||||
--
|
||||
-- Examples:
|
||||
-- set [] 1 (Node 0 Empty Empty) ==> (Node 1 Empty Empty)
|
||||
-- set [StepL,StepL] 1 (Node (Node 0 (Node 0 Empty Empty)
|
||||
-- (Node 0 Empty Empty))
|
||||
-- (Node 0 Empty Empty))
|
||||
-- ==> (Node (Node 0 (Node 1 Empty Empty)
|
||||
-- (Node 0 Empty Empty))
|
||||
-- (Node 0 Empty Empty))
|
||||
--
|
||||
-- set [StepL,StepR] 1 (Node 0 Empty Empty) ==> (Node 0 Empty Empty)
|
||||
|
||||
set :: [Step] -> a -> Tree a -> Tree a
|
||||
set path val tree = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 10: given a value and a tree, return a path that goes from the
|
||||
-- root to the value. If the value doesn't exist in the tree, return Nothing.
|
||||
--
|
||||
-- If the value occurs in the tree multiple times, prefer the leftmost value.
|
||||
--
|
||||
-- Examples:
|
||||
-- search 1 (Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty)) ==> Just [StepL]
|
||||
-- search 1 (Node 2 (Node 4 Empty Empty) (Node 3 Empty Empty)) ==> Nothing
|
||||
-- search 1 (Node 2 (Node 1 Empty Empty) (Node 1 Empty Empty)) ==> Just [StepL]
|
||||
-- search 1 (Node 2 (Node 3 (Node 4 Empty Empty)
|
||||
-- (Node 1 Empty Empty))
|
||||
-- (Node 5 Empty Empty)) ==> Just [StepL,StepR]
|
||||
|
||||
search :: Eq a => a -> Tree a -> Maybe [Step]
|
||||
search = todo
|
||||
@@ -0,0 +1,262 @@
|
||||
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
||||
|
||||
module Set5bTest where
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Test.QuickCheck
|
||||
|
||||
import Mooc.Th
|
||||
import Mooc.Test
|
||||
|
||||
import Set5b
|
||||
|
||||
main = score tests
|
||||
|
||||
tests = [(1,"valAtRoot",[ex1_valAtRoot_Nothing, ex1_valAtRoot_Just])
|
||||
,(2,"treeSize",[ex2_treeSize])
|
||||
,(3,"treeMax",[ex3_small, ex3_large])
|
||||
,(4,"allValues",[ex4_small, ex4_large])
|
||||
,(5,"mapTree",[ex5_small, ex5_large])
|
||||
,(6,"cull",[ex6_small, ex6_large])
|
||||
,(7,"isOrdered",[ex7_small, ex7_large])
|
||||
,(8,"walk",[ex8_small, ex8_large])
|
||||
,(9,"set",[ex9_small, ex9_medium, ex9_large])
|
||||
,(10,"search",[ex10_small, ex10_large])
|
||||
]
|
||||
|
||||
-- -- -- -- -- -- -- --
|
||||
|
||||
|
||||
treeOfSize :: Arbitrary a => Int -> Gen (Tree a)
|
||||
treeOfSize 0 = return Empty
|
||||
treeOfSize siz = do
|
||||
let siz' = siz-1
|
||||
sizl <- choose (0,siz')
|
||||
let sizr = siz'-sizl
|
||||
l <- treeOfSize sizl
|
||||
r <- treeOfSize sizr
|
||||
v <- arbitrary
|
||||
return $ Node v l r
|
||||
|
||||
ex1_valAtRoot_Nothing = $(testing [|valAtRoot (Empty :: Tree Bool)|]) (?== (Nothing :: Maybe Bool))
|
||||
|
||||
ex1_valAtRoot_Just = property $ do
|
||||
l <- treeOfSize 2 :: Gen (Tree Integer)
|
||||
r <- treeOfSize 2 :: Gen (Tree Integer)
|
||||
v <- choose (0,10 :: Integer)
|
||||
let t = Node v l r
|
||||
return $ $(testing [|valAtRoot t|]) (?== Just v)
|
||||
|
||||
ex2_treeSize =
|
||||
forAllShrink_ (choose (0,50)) $ \s ->
|
||||
forAllBlind (treeOfSize s :: Gen (Tree Integer)) $ \t ->
|
||||
$(testing [|treeSize t|]) (?==s)
|
||||
|
||||
treeAndMax :: Int -> Gen (Int, Tree Int)
|
||||
treeAndMax 0 = return (0,Empty)
|
||||
treeAndMax d = do
|
||||
(lmax,l) <- treeAndMax (d-1)
|
||||
(rmax,r) <- treeAndMax (d-1)
|
||||
v <- choose (0,20)
|
||||
return (maximum [lmax,rmax,v], (Node v l r))
|
||||
|
||||
m_ex3 depth = forAllBlind (treeAndMax depth) $ \(m,tree) ->
|
||||
$(testing [|treeMax tree|]) (?==m)
|
||||
|
||||
ex3_small = conjoin [m_ex3 0
|
||||
,m_ex3 1
|
||||
,m_ex3 2]
|
||||
ex3_large = conjoin [m_ex3 3
|
||||
,m_ex3 4]
|
||||
|
||||
tree3 a b c = Node b (Node a Empty Empty) (Node c Empty Empty)
|
||||
tree7 [a,b,c,d,e,f,g] = Node d (tree3 a b c) (tree3 e f g)
|
||||
|
||||
|
||||
ex4_small = property $ do
|
||||
~[a,b,c] <- vectorOf 3 (choose (0,4::Int))
|
||||
let input = tree3 a b c
|
||||
out = all (>0) [a,b,c]
|
||||
return $ counterexample ("allValues (>0) "++show' input) $ allValues (>0) input ?== out
|
||||
|
||||
ex4_large = property $ do
|
||||
vals <- vectorOf 7 (choose (0,8::Int))
|
||||
let input = tree7 vals
|
||||
out = all (>1) vals
|
||||
return $ counterexample ("allValues (>0) "++show' input) $ allValues (>1) input ?== out
|
||||
|
||||
ex5_small = property $ do
|
||||
~[a,b,c] <- vectorOf 3 (choose (0,4::Int))
|
||||
let input = tree3 a b c
|
||||
output = tree3 (a+1) (b+1) (c+1)
|
||||
return $ counterexample ("mapTree (+1) "++show' input) $ mapTree (+1) input ?== output
|
||||
|
||||
linearLeft [] = Empty
|
||||
linearLeft (x:xs) = Node x (linearLeft xs) Empty
|
||||
|
||||
linearRight [] = Empty
|
||||
linearRight (x:xs) = Node x Empty (linearRight xs)
|
||||
|
||||
ex5_large = property $ do
|
||||
cs <- listOf1 (choose ('a','c'))
|
||||
ds <- listOf1 (choose ('a','c'))
|
||||
e <- choose ('a','c')
|
||||
let input = Node e (linearRight cs) (linearLeft ds)
|
||||
f = (=='a')
|
||||
output = Node (f e) (linearRight $ map f cs) (linearLeft $ map f ds)
|
||||
return $ counterexample ("mapTree (=='a') "++show' input) $ mapTree (=='a') input ?== output
|
||||
|
||||
treeWithout :: (Eq a, Arbitrary a) => Int -> a -> Gen (Tree a)
|
||||
treeWithout 0 _ = return Empty
|
||||
treeWithout depth v = oneof [return Empty
|
||||
,do l <- treeWithout (depth-1) v
|
||||
r <- treeWithout (depth-1) v
|
||||
v' <- arbitrary `suchThat` (/=v)
|
||||
return $ Node v' l r]
|
||||
|
||||
ex6_small = conjoin [$(testing [|cull 2 (Node 1 (Node 2 Empty Empty) (Node 0 Empty Empty))|])
|
||||
(?==Node 1 Empty (Node 0 Empty Empty))
|
||||
,$(testing [|cull 3 (Node 1 (Node 2 Empty Empty) (Node 0 Empty Empty))|])
|
||||
(?==Node 1 (Node 2 Empty Empty) (Node 0 Empty Empty))
|
||||
,$(testing [|cull 0 (Node 1 (Node 0 Empty (Node 2 Empty Empty)) (Node 3 Empty (Node 0 Empty Empty)))|])
|
||||
(?==Node 1 Empty (Node 3 Empty Empty))]
|
||||
|
||||
replaceLeaf :: Tree a -> Tree a -> Gen (Tree a)
|
||||
replaceLeaf t Empty = return t
|
||||
replaceLeaf t (Node val l r) = oneof [fmap (\l' -> Node val l' r) (replaceLeaf t l)
|
||||
,fmap (\r' -> Node val l r') (replaceLeaf t r)]
|
||||
|
||||
|
||||
ex6_large = property $ do
|
||||
v <- arbitrary :: Gen Int
|
||||
output <- treeWithout 3 v
|
||||
~(Node _ l r) <- treeOfSize 3
|
||||
let addition = Node v l r
|
||||
input <- replaceLeaf addition output
|
||||
input2 <- replaceLeaf addition input
|
||||
return $ conjoin [$(testing [|cull v input|]) (?==output)
|
||||
,$(testing [|cull v input2|]) (?==output)]
|
||||
|
||||
orderedTree :: Int -> (Int,Int) -> Gen (Tree Int)
|
||||
orderedTree 0 _ = return Empty
|
||||
orderedTree depth (min,max)
|
||||
| min<max = frequency [(1, return Empty)
|
||||
,(4, do v <- choose (min,max-1)
|
||||
l <- orderedTree (depth-1) (min,v)
|
||||
r <- orderedTree (depth-1) (v+1,max)
|
||||
return $ Node v l r)]
|
||||
orderedTree _ _ = return Empty
|
||||
|
||||
try :: [Gen (Maybe a)] -> Gen (Maybe a)
|
||||
try [] = return $ Nothing
|
||||
try (g:gs) = do m <- g
|
||||
if isJust m then return m else try gs
|
||||
|
||||
breakOrder :: Tree Int -> Gen (Maybe (Tree Int))
|
||||
breakOrder Empty = return Nothing
|
||||
breakOrder (Node v Empty Empty) = return Nothing
|
||||
breakOrder (Node v l r) = try [do ml <- breakOrder l
|
||||
case ml of Nothing -> return Nothing
|
||||
Just l' -> return $ Just $ Node v l' r
|
||||
,do mr <- breakOrder r
|
||||
case mr of Nothing -> return Nothing
|
||||
Just r' -> return $ Just $ Node v l r'
|
||||
,return (Just (Node v r l))]
|
||||
|
||||
m_ex7 depth = forAllBlind (orderedTree depth (0,100)) $ \t ->
|
||||
forAllBlind (breakOrder t) $ \b ->
|
||||
conjoin [$(testing [|isOrdered t|]) (?==True)
|
||||
,isJust b ==> $(testing [|isOrdered (fromJust b)|]) (?==False)]
|
||||
|
||||
ex7_small = conjoin [$(testing [|isOrdered (Empty::Tree Int)|]) (?==True)
|
||||
,forAllBlind (choose (0,10::Int)) $ \i -> $(testing [|isOrdered (Node i Empty Empty)|]) (?==True)
|
||||
,m_ex7 2]
|
||||
|
||||
ex7_large = conjoin [m_ex7 3
|
||||
,m_ex7 4
|
||||
,m_ex7 5]
|
||||
|
||||
|
||||
pathAndTree :: (Eq a, Arbitrary a) => Int -> a -> Gen ([Step],Tree a)
|
||||
pathAndTree 0 v = return ([],Node v Empty Empty)
|
||||
pathAndTree depth v = oneof [do l <- treeWithout (depth-1) v
|
||||
v' <- arbitrary `suchThat` (/=v)
|
||||
(p,r) <- pathAndTree (depth-1) v
|
||||
return (StepR:p,Node v' l r)
|
||||
,do r <- treeWithout (depth-1) v
|
||||
v' <- arbitrary `suchThat` (/=v)
|
||||
(p,l) <- pathAndTree (depth-1) v
|
||||
return (StepL:p,Node v' l r)
|
||||
,do l <- treeWithout (depth-1) v
|
||||
r <- treeWithout (depth-1) v
|
||||
return ([],Node v l r)]
|
||||
|
||||
m_ex8 d = forAll_ $ \(v::Int) ->
|
||||
forAllBlind (pathAndTree d v) $ \(p,t) ->
|
||||
$(testing [|walk p t|]) (?==Just v)
|
||||
|
||||
ex8_small = conjoin [$(testing [|walk [StepL] (Empty :: Tree Char)|]) (?==Nothing)
|
||||
,forAll_ $ \(a::Int,b::Int,c::Int) ->
|
||||
$(testing [|walk [StepL,StepR] (Node a (Node b Empty Empty) (Node c Empty Empty))|]) (?==Nothing)
|
||||
,m_ex8 0
|
||||
,m_ex8 1
|
||||
,m_ex8 2]
|
||||
|
||||
ex8_large = conjoin [m_ex8 3
|
||||
,m_ex8 4
|
||||
,m_ex8 5]
|
||||
|
||||
|
||||
ex9_small = conjoin [$(testing [|set ([]::[Step]) 'a' (Empty::Tree Char)|]) (?==Empty)
|
||||
,$(testing [|set ([]::[Step]) True (Node False Empty Empty)|]) (?==Node True Empty Empty)
|
||||
,$(testing [|set [StepL] True (Node False Empty Empty)|]) (?==Node False Empty Empty)
|
||||
,$(testing [|set [StepL] True (Node False (Node False Empty Empty) Empty)|]) (?==Node False (Node True Empty Empty) Empty)]
|
||||
|
||||
setList xs i v = before ++ v:after
|
||||
where (before,_:after) = splitAt i xs
|
||||
|
||||
ex9_medium = property $ do
|
||||
vals <- vectorOf 7 (choose (0,10::Int))
|
||||
(i,path) <- elements [(0,[StepL,StepL])
|
||||
,(1,[StepL])
|
||||
,(2,[StepL,StepR])
|
||||
,(3,[])
|
||||
,(4,[StepR,StepL])
|
||||
,(5,[StepR])
|
||||
,(6,[StepR,StepR])]
|
||||
new <- choose (11,20::Int)
|
||||
let inp = tree7 vals
|
||||
vals' = setList vals i new
|
||||
out = tree7 vals'
|
||||
return $ $(testing [|set path new inp|]) (?==out)
|
||||
|
||||
ex9_large = forAllShrink (choose (1,10)) shrinkPositive $ \len -> property $ do
|
||||
(dir,mk) <- elements [(StepL,linearLeft)
|
||||
,(StepR,linearRight)]
|
||||
cs <- vectorOf len (choose ('a','z'))
|
||||
i <- choose (0,len - 2)
|
||||
new <- choose ('a','z')
|
||||
return $ $(testing [|set (replicate i dir) new (mk cs)|]) (?==mk (setList cs i new))
|
||||
|
||||
m_ex10_yes depth = forAll_ $ \(val::Int) ->
|
||||
forAllBlind (pathAndTree depth val) $ \(path,tree) ->
|
||||
$(testing [|search val tree|]) (?==Just path)
|
||||
|
||||
m_ex10_no depth = forAll_ $ \(val::Int) ->
|
||||
forAllBlind (treeWithout depth val) $ \tree ->
|
||||
$(testing [|search val tree|]) (?==Nothing)
|
||||
|
||||
ex10_small = conjoin [m_ex10_yes 0
|
||||
,m_ex10_no 0
|
||||
,m_ex10_yes 1
|
||||
,m_ex10_no 1
|
||||
,m_ex10_yes 2
|
||||
,m_ex10_no 2]
|
||||
|
||||
ex10_large = conjoin [m_ex10_yes 3
|
||||
,m_ex10_no 3
|
||||
,m_ex10_yes 4
|
||||
,m_ex10_no 4
|
||||
,m_ex10_yes 5
|
||||
,m_ex10_no 5]
|
||||
@@ -0,0 +1,158 @@
|
||||
-- Exercise set 6: defining classes and instances
|
||||
|
||||
|
||||
module Set6 where
|
||||
|
||||
import Mooc.Todo
|
||||
import Data.Char (toLower)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 1: define an Eq instance for the type Country below. You'll need
|
||||
-- to use pattern matching.
|
||||
|
||||
data Country = Finland | Switzerland | Norway
|
||||
deriving Show
|
||||
|
||||
instance Eq Country where
|
||||
(==) = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 2: implement an Ord instance for Country so that
|
||||
-- Finland < Norway < Switzerland
|
||||
--
|
||||
-- Remember minimal complete definitions!
|
||||
|
||||
instance Ord Country where
|
||||
compare = todo -- implement me?
|
||||
(<=) = todo -- and me?
|
||||
min = todo -- and me?
|
||||
max = todo -- and me?
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 3: Implement an Eq instance for the type Name which contains a String.
|
||||
-- The Eq instance should ignore capitalization.
|
||||
--
|
||||
-- Hint: use the function Data.Char.toLower that has been imported for you.
|
||||
--
|
||||
-- Examples:
|
||||
-- Name "Pekka" == Name "pekka" ==> True
|
||||
-- Name "Pekka!" == Name "pekka" ==> False
|
||||
|
||||
data Name = Name String
|
||||
deriving Show
|
||||
|
||||
instance Eq Name where
|
||||
(==) = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 4: here is a list type parameterized over the type it contains.
|
||||
-- Implement an instance "Eq (List a)" that compares the lists element
|
||||
-- by element.
|
||||
--
|
||||
-- Note how the instance needs an Eq a constraint. What happens if you
|
||||
-- remove it?
|
||||
|
||||
data List a = Empty | LNode a (List a)
|
||||
deriving Show
|
||||
|
||||
instance Eq a => Eq (List a) where
|
||||
(==) = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 5: below you'll find two datatypes, Egg and Milk. Implement a
|
||||
-- type class Price, containing a function price. The price function
|
||||
-- should return an Int representing the price of the item in a store.
|
||||
--
|
||||
-- The prices should be as follows:
|
||||
-- * chicken eggs cost 20
|
||||
-- * chocolate eggs cost 30
|
||||
-- * milk costs 15 per liter
|
||||
|
||||
data Egg = ChickenEgg | ChocolateEgg
|
||||
deriving Show
|
||||
data Milk = Milk Int -- amount in litres
|
||||
deriving Show
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 6: define the necessary instances in order to be able to compute these:
|
||||
--
|
||||
-- price [Just (ChocolateEgg), Nothing, Just (ChickenEgg)] ==> 50
|
||||
-- price [Nothing, Nothing, Just (Milk 1), Just (Milk 2)] ==> 45
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 7: below you'll find the datatype Number, which is either an
|
||||
-- Integer, or a special value Infinite.
|
||||
--
|
||||
-- Implement an Ord instance so that finite Numbers compare normally,
|
||||
-- and Infinite is larger than any other value.
|
||||
|
||||
data Number = Finite Integer | Infinite
|
||||
deriving (Show,Eq)
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 8: rational numbers have a numerator and a denominator that are
|
||||
-- integers, usually separated by a horizontal bar or a slash:
|
||||
--
|
||||
-- numerator
|
||||
-- ------------- == numerator / denominator
|
||||
-- denominator
|
||||
--
|
||||
-- You may remember from school that two rationals a/b and c/d are
|
||||
-- equal when a*d == b*c. Implement the Eq instance for rationals
|
||||
-- using this definition.
|
||||
--
|
||||
-- You may assume in all exercises that the denominator is always
|
||||
-- positive and nonzero.
|
||||
--
|
||||
-- Examples:
|
||||
-- RationalNumber 4 5 == RationalNumber 4 5 ==> True
|
||||
-- RationalNumber 12 15 == RationalNumber 4 5 ==> True
|
||||
-- RationalNumber 13 15 == RationalNumber 4 5 ==> False
|
||||
|
||||
data RationalNumber = RationalNumber Integer Integer
|
||||
deriving Show
|
||||
|
||||
instance Eq RationalNumber where
|
||||
p == q = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 9: the purpose of the simplfy function is to turn a rational number into
|
||||
-- its simplest form, i.e.
|
||||
--
|
||||
-- ca a
|
||||
-- ---- ==> ---.
|
||||
-- cb b
|
||||
--
|
||||
-- As a concrete example,
|
||||
--
|
||||
-- 12 3 * 4 4
|
||||
-- ---- == ------- ==> ---.
|
||||
-- 15 3 * 5 5
|
||||
--
|
||||
-- Hint: Remember the function gcd?
|
||||
|
||||
simplify :: RationalNumber -> RationalNumber
|
||||
simplify p = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 10: implement the typeclass Num for RationalNumber. The results
|
||||
-- of addition an multiplication must be simplified.
|
||||
--
|
||||
-- Examples:
|
||||
-- RationalNumber 1 2 - RationalNumber 1 3 ==> RationalNumber 1 6
|
||||
-- RationalNumber 1 3 * RationalNumber 3 1 ==> RationalNumber 1 1
|
||||
-- fromInteger 17 :: RationalNumber ==> RationalNumber 17 1
|
||||
-- abs (RationalNumber (-3) 2) ==> RationalNumber 3 2
|
||||
-- signum (RationalNumber (-3) 2) ==> RationalNumber (-1) 1
|
||||
-- signum (RationalNumber 0 0) ==> RationalNumber 0 0
|
||||
|
||||
instance Num RationalNumber where
|
||||
p + q = todo
|
||||
p * q = todo
|
||||
abs q = todo
|
||||
signum q = todo
|
||||
fromInteger x = todo
|
||||
negate q = todo
|
||||
@@ -0,0 +1,237 @@
|
||||
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
||||
|
||||
module Set6Test where
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Char (toUpper)
|
||||
import Language.Haskell.TH.Syntax (lift,isInstance,mkName)
|
||||
import Test.QuickCheck
|
||||
|
||||
import Mooc.Th
|
||||
import Mooc.Test
|
||||
|
||||
import Set6
|
||||
|
||||
main = score tests
|
||||
|
||||
tests = [(1,"Eq Country",[ex1])
|
||||
,(2,"Ord Country",[ex2])
|
||||
,(3,"Eq Name",[ex3])
|
||||
,(4,"Eq List",[ex4_eq, ex4_neq])
|
||||
,(5,"Price",[ex5_egg, ex5_milk])
|
||||
,(6,"Price List",[ex6_egg, ex6_milk])
|
||||
,(7,"Ord Number",[ex7_eq_check, ex7_finite, ex7_infinite])
|
||||
,(8,"Eq RationalNumber",[ex8_refl, ex8_eq])
|
||||
,(9,"simplify",[ex9_prime, ex9_eq])
|
||||
,(10,"Num RationalNumber",[ex10_add_zero, ex10_add_commut, ex10_add_whole, ex10_add
|
||||
,ex10_multiply_one, ex10_multiply_commut, ex10_multiply_inverse, ex10_multiply
|
||||
,ex10_abs
|
||||
,ex10_signum_abs
|
||||
,ex10_fromInteger
|
||||
,ex10_negate
|
||||
])
|
||||
]
|
||||
|
||||
-- -- -- -- -- -- -- --
|
||||
|
||||
testEquals x y exp = $(testing [|x == y|]) (?==exp)
|
||||
|
||||
ex1 = conjoin [testEquals Finland Finland True
|
||||
,testEquals Norway Norway True
|
||||
,testEquals Switzerland Switzerland True
|
||||
,testEquals Finland Norway False
|
||||
,testEquals Finland Switzerland False
|
||||
,testEquals Norway Finland False
|
||||
,testEquals Norway Switzerland False
|
||||
,testEquals Switzerland Finland False
|
||||
,testEquals Switzerland Norway False]
|
||||
|
||||
ex2 = conjoin
|
||||
[Finland ?<= Finland, Finland ?<= Norway, Finland ?<= Switzerland
|
||||
,Norway ?<= Norway, Norway ?<= Switzerland
|
||||
,Switzerland ?<= Switzerland
|
||||
,Norway ?> Finland
|
||||
,Switzerland ?> Norway, Switzerland ?> Finland
|
||||
,$(testing [|compare Norway Switzerland|]) (?==LT)
|
||||
,$(testing [|compare Finland Finland|]) (?==EQ)
|
||||
,$(testing [|min Switzerland Norway|]) (?==Norway)
|
||||
,$(testing [|max Norway Finland|]) (?==Norway)]
|
||||
where x ?<= y = $(testing [|x <= y|]) (?==True)
|
||||
x ?> y = $(testing [|x > y|]) (?==True)
|
||||
|
||||
word = listOf1 (choose ('a','z'))
|
||||
|
||||
capitalizeOne :: String -> Gen String
|
||||
capitalizeOne [c] = return [toUpper c]
|
||||
capitalizeOne (c:cs) = oneof [return (toUpper c:cs)
|
||||
,(c:) <$> capitalizeOne cs]
|
||||
|
||||
ex3 = property $ do
|
||||
name <- word
|
||||
diff <- word `suchThat` (/=name)
|
||||
namev1 <- Name <$> capitalizeOne name
|
||||
namev2 <- Name <$> capitalizeOne name
|
||||
diffv1 <- Name <$> capitalizeOne diff
|
||||
return $ conjoin [testEquals namev1 namev2 True
|
||||
,testEquals namev1 diffv1 False]
|
||||
|
||||
fromList = foldr LNode Empty
|
||||
|
||||
ex4_eq = forAll_ $ \(xs::[Bool]) -> testEquals (fromList xs) (fromList xs) True
|
||||
|
||||
ex4_neq = forAll_ $ \(xs::[Int],ys) -> testEquals (fromList xs) (fromList ys) (xs == ys)
|
||||
|
||||
ex5_egg = $(withInstance "Price" "Egg" [|price|]) $ \price -> conjoin [$(testing [|price ChocolateEgg|]) (?==30)
|
||||
,$(testing [|price ChickenEgg|]) (?==20)]
|
||||
|
||||
|
||||
ex5_milk = $(withInstance "Price" "Milk" [|price|]) $ \price ->
|
||||
forAllBlind (choose (0,100)) $ \l ->
|
||||
$(testing [|price (Milk l)|]) (?==(15*l))
|
||||
|
||||
ex6_egg =
|
||||
$(withInstance "Price" "Egg" [|price :: Egg -> Int|]) $ \_ ->
|
||||
$(withInstance1 "Price" "[]" [|price :: [Egg] -> Int|]) $ \_ ->
|
||||
$(withInstance1 "Price" "Maybe" [|price|]) $ \price ->
|
||||
conjoin [$(testing [|price [Just ChocolateEgg, Nothing, Just ChickenEgg]|]) (?==50)
|
||||
,$(testing [|price [Nothing, Nothing, Nothing :: Maybe Egg]|]) (?==0)]
|
||||
|
||||
|
||||
ex6_milk =
|
||||
$(withInstance "Price" "Milk" [|price :: Milk -> Int|]) $ \_ ->
|
||||
$(withInstance1 "Price" "[]" [|price :: [Milk] -> Int|]) $ \_ ->
|
||||
$(withInstance1 "Price" "Maybe" [|price|]) $ \price ->
|
||||
forAllBlind (choose (0,10)) $ \milk1 ->
|
||||
forAllBlind (choose (0,10)) $ \milk2 ->
|
||||
conjoin [$(testing [|price [Just (Milk milk1), Nothing, Just (Milk milk2)]|]) (?==(15*milk1+15*milk2))
|
||||
,$(testing [|price [Nothing, Nothing, Nothing :: Maybe Milk]|]) (?==0)]
|
||||
|
||||
ex7_eq_check =
|
||||
$(withInstance "Eq" "Number" [|(==) :: Number -> Number -> Bool|]) $ \(==) ->
|
||||
forAll_ $ \i ->
|
||||
forAll_ $ \j ->
|
||||
conjoin [$(testing [|Finite i == Finite j|]) (?==(i Prelude.== j))
|
||||
,$(testing [|Finite i == Infinite|]) (?==False)
|
||||
,$(testing [|Infinite == Infinite|]) (?==True)]
|
||||
|
||||
ex7_finite =
|
||||
$(withInstance "Ord" "Number" [|max :: Number -> Number -> Number|]) $ \max ->
|
||||
forAll_ $ \i ->
|
||||
forAll_ $ \j ->
|
||||
$(testing [|max (Finite i) (Finite j)|]) (?==Finite (Prelude.max i j))
|
||||
|
||||
ex7_infinite =
|
||||
$(withInstance "Ord" "Number" [|max :: Number -> Number -> Number|]) $ \max ->
|
||||
forAll_ $ \i ->
|
||||
conjoin [$(testing [|max (Finite i) Infinite|]) (?==Infinite)
|
||||
,$(testing [|max Infinite (Finite i)|]) (?==Infinite)
|
||||
,$(testing [|max Infinite Infinite|]) (?==Infinite)]
|
||||
|
||||
instance Arbitrary RationalNumber where
|
||||
arbitrary = do num <- arbitrary
|
||||
(Positive den) <- arbitrary
|
||||
return (RationalNumber num den)
|
||||
|
||||
ex8_refl =
|
||||
$(withInstance "Eq" "RationalNumber" [|(==) :: RationalNumber -> RationalNumber -> Bool|]) $ \(==) ->
|
||||
forAll_ $ \r ->
|
||||
$(testing [|r == r|]) (?==True)
|
||||
|
||||
ex8_eq = $(withInstance "Eq" "RationalNumber" [|(==) :: RationalNumber -> RationalNumber -> Bool|]) $ \(==) ->
|
||||
forAll_ $ \r@(RationalNumber p q) ->
|
||||
forAll_ $ \(NonZero i) ->
|
||||
forAll_ $ \(NonZero j) ->
|
||||
conjoin [$(testing [|r == (RationalNumber (i*p) (i*q))|]) (?==True)
|
||||
,$(testing [|r == (RationalNumber (i*p+j) (i*q))|]) (?==False)]
|
||||
|
||||
primes = nubBy (\x y -> mod y x == 0) [2..]
|
||||
genPrime = elements $ take 100 primes
|
||||
|
||||
identical :: RationalNumber -> RationalNumber -> Bool
|
||||
identical (RationalNumber a b) (RationalNumber c d) = a==c && b==d
|
||||
|
||||
exactly should was = expectation should was (identical should was)
|
||||
|
||||
genSimpl = do
|
||||
q <- genPrime
|
||||
p <- choose (1,q-1)
|
||||
return $ RationalNumber p q
|
||||
|
||||
ex9_prime = forAllBlind genSimpl $ \(RationalNumber p q) ->
|
||||
forAll_ $ \(Positive i) ->
|
||||
$(testing [|simplify (RationalNumber (i*p) (i*q))|]) (exactly (RationalNumber p q))
|
||||
|
||||
ex9_eq = forAll_ $ \r@(RationalNumber p q) ->
|
||||
forAll_ $ \(Positive i) ->
|
||||
let s = RationalNumber (i*p) (i*q)
|
||||
in $(testing [|simplify r|]) . was $ \r' ->
|
||||
$(testing [|simplify s|]) . was $ \s' ->
|
||||
counterexample " Should be the same" (identical r' s')
|
||||
|
||||
ex10_add_zero = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
||||
forAllBlind genSimpl $ \r ->
|
||||
forAll_ $ \(Positive q) ->
|
||||
$(testing [|r + (RationalNumber 0 q)|]) (exactly r)
|
||||
|
||||
ex10_add_commut = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
||||
forAll_ $ \r ->
|
||||
forAll_ $ \s ->
|
||||
$(testing [|r + s|]) . was $ \was1 ->
|
||||
$(testing [|s + r|]) . was $ \was2 ->
|
||||
counterexample " Should be the same" (identical was1 was2)
|
||||
|
||||
ex10_add_whole = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
||||
forAll_ $ \(Positive q) ->
|
||||
forAll_ $ \(i,j) ->
|
||||
$(testing [|RationalNumber (q*i) q + RationalNumber (q*j) q|]) (exactly (RationalNumber (i Prelude.+ j) 1))
|
||||
|
||||
ex10_add = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
|
||||
forAll_ $ \(Positive n) ->
|
||||
$(testing [|RationalNumber 1 (n Prelude.+ 1) + RationalNumber 1 (n*(n Prelude.+ 1))|]) (exactly (RationalNumber 1 n))
|
||||
|
||||
ex10_multiply_one = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
||||
forAllBlind genSimpl $ \r ->
|
||||
forAll_ $ \(Positive q) ->
|
||||
$(testing [|r * (RationalNumber q q)|]) (exactly r)
|
||||
|
||||
ex10_multiply_commut = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
||||
forAll_ $ \r ->
|
||||
forAll_ $ \s ->
|
||||
$(testing [|r * s|]) . was $ \was1 ->
|
||||
$(testing [|s * r|]) . was $ \was2 ->
|
||||
counterexample " Should be the same" (identical was1 was2)
|
||||
|
||||
ex10_multiply_inverse = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
||||
forAllBlind genPrime $ \p ->
|
||||
forAllBlind genPrime $ \q ->
|
||||
$(testing [|RationalNumber p q * RationalNumber q p|]) (exactly (RationalNumber 1 1))
|
||||
|
||||
ex10_multiply = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
|
||||
forAllBlind genPrime $ \p ->
|
||||
forAllBlind genPrime $ \q ->
|
||||
forAllBlind genPrime $ \r ->
|
||||
nub [p,q,r] == [p,q,r] ==>
|
||||
forAll_ $ \(Positive i) ->
|
||||
$(testing [|RationalNumber (i Prelude.* p) q * RationalNumber q (r Prelude.* i)|]) (exactly (RationalNumber p r))
|
||||
|
||||
ex10_abs = $(withInstance "Num" "RationalNumber" [|abs :: RationalNumber -> RationalNumber|]) $ \abs ->
|
||||
forAllBlind genSimpl $ \r@(RationalNumber p q) ->
|
||||
conjoin [$(testing [|abs (RationalNumber (-p) q)|]) (exactly r)
|
||||
,$(testing [|abs r|]) (exactly r)]
|
||||
|
||||
ex10_signum_abs = $(withInstance "Num" "RationalNumber" [|abs :: RationalNumber -> RationalNumber|]) $ \abs ->
|
||||
forAll_ $ \r ->
|
||||
counterexample "signum r * abs r == r" $
|
||||
counterexample (" failed with r = " ++ show r) $
|
||||
signum r * abs r == r
|
||||
|
||||
ex10_fromInteger = $(withInstance "Num" "RationalNumber" [|fromInteger :: Integer -> RationalNumber|]) $ \fromInteger ->
|
||||
forAll_ $ \(i,j) ->
|
||||
counterexample ("fromIntegral "++show i++" + fromIntegral "++show j) $
|
||||
exactly (RationalNumber (i+j) 1) (fromIntegral i + fromIntegral j)
|
||||
|
||||
ex10_negate = $(withInstance "Num" "RationalNumber" [|negate :: RationalNumber -> RationalNumber|]) $ \negate ->
|
||||
forAll_ $ \r ->
|
||||
counterexample ("("++show r++") + negate ("++show r++")") $
|
||||
exactly (RationalNumber 0 1) (r + negate r)
|
||||
@@ -0,0 +1,248 @@
|
||||
-- Exercise set 7
|
||||
|
||||
module Set7 where
|
||||
|
||||
import Mooc.Todo
|
||||
import Data.List
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 1: you'll find below the types Time, Distance and Velocity,
|
||||
-- which represent time, distance and velocity in seconds, meters and
|
||||
-- meters per second.
|
||||
--
|
||||
-- Implement the functions below.
|
||||
|
||||
data Distance = Distance Double
|
||||
deriving (Show,Eq)
|
||||
|
||||
data Time = Time Double
|
||||
deriving (Show,Eq)
|
||||
|
||||
data Velocity = Velocity Double
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- velocity computes a velocity given a distance and a time
|
||||
velocity :: Distance -> Time -> Velocity
|
||||
velocity = todo
|
||||
|
||||
-- travel computes a distance given a velocity and a time
|
||||
travel :: Velocity -> Time -> Distance
|
||||
travel = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 2: let's implement a simple Set datatype. A Set is a list of
|
||||
-- unique elements. The set is always kept ordered.
|
||||
--
|
||||
-- Implement the functions below. You might need to add class
|
||||
-- constraints to the functions' types.
|
||||
--
|
||||
-- Examples:
|
||||
-- member 'a' (Set ['a','b','c']) ==> True
|
||||
-- add 2 (add 3 (add 1 emptySet)) ==> Set [1,2,3]
|
||||
-- add 1 (add 1 emptySet) ==> Set [1]
|
||||
|
||||
data Set a = Set [a]
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- emptySet is a set with no elements
|
||||
emptySet :: Set a
|
||||
emptySet = todo
|
||||
|
||||
-- member tests if an element is in a set
|
||||
member :: Eq a => a -> Set a -> Bool
|
||||
member = todo
|
||||
|
||||
-- add a member to a set
|
||||
add :: a -> Set a -> Set a
|
||||
add = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 3: a state machine for baking a cake. The type Event represents
|
||||
-- things that can happen while baking a cake. The type State is meant
|
||||
-- to represent the states a cake can be in.
|
||||
--
|
||||
-- Your job is to
|
||||
--
|
||||
-- * add new states to the State type
|
||||
-- * and implement the step function
|
||||
--
|
||||
-- so that they have the following behaviour:
|
||||
--
|
||||
-- * Baking starts in the Start state
|
||||
-- * A successful cake (reperesented by the Finished value) is baked
|
||||
-- by first adding eggs, then adding flour and sugar (in which ever
|
||||
-- order), then mixing, and finally baking.
|
||||
-- * If the order of Events differs from this, the result is an Error cake.
|
||||
-- No Events can save an Error cake.
|
||||
-- * Once a cake is Finished, it stays Finished even if additional Events happen.
|
||||
--
|
||||
-- The function bake just calls step repeatedly. It's used for the
|
||||
-- examples below. Don't modify it.
|
||||
--
|
||||
-- Examples:
|
||||
-- bake [AddEggs,AddFlour,AddSugar,Mix,Bake] ==> Finished
|
||||
-- bake [AddEggs,AddFlour,AddSugar,Mix,Bake,AddSugar,Mix] ==> Finished
|
||||
-- bake [AddFlour] ==> Error
|
||||
-- bake [AddEggs,AddFlour,Mix] ==> Error
|
||||
|
||||
data Event = AddEggs | AddFlour | AddSugar | Mix | Bake
|
||||
deriving (Eq,Show)
|
||||
|
||||
data State = Start | Error | Finished
|
||||
deriving (Eq,Show)
|
||||
|
||||
step = todo
|
||||
|
||||
-- do not edit this
|
||||
bake :: [Event] -> State
|
||||
bake events = go Start events
|
||||
where go state [] = state
|
||||
go state (e:es) = go (step state e) es
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 4: remember how the average function from Set4 couldn't really
|
||||
-- work on empty lists? Now we can reimplement average for NonEmpty
|
||||
-- lists and avoid the edge case.
|
||||
--
|
||||
-- Examples:
|
||||
-- average (1.0 :| []) ==> 1.0
|
||||
-- average (1.0 :| [2.0,3.0]) ==> 2.0
|
||||
|
||||
average :: Fractional a => NonEmpty a -> a
|
||||
average = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 5: reverse a NonEmpty list.
|
||||
--
|
||||
-- Hint! You'll probably need to handle two cases.
|
||||
|
||||
reverseNonEmpty :: NonEmpty a -> NonEmpty a
|
||||
reverseNonEmpty = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 6: implement Semigroup instances for the Distance, Time and
|
||||
-- Velocity types from exercise 1. The instances should perform
|
||||
-- addition.
|
||||
--
|
||||
-- When you've defined the instances you can do things like this:
|
||||
--
|
||||
-- velocity (Distance 50 <> Distance 10) (Time 1 <> Time 2)
|
||||
-- ==> Velocity 20
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 7: implement a Monoid instance for the Set type from exercise 2.
|
||||
-- The (<>) operation should be the union of sets.
|
||||
--
|
||||
-- What's the right definition for mempty?
|
||||
--
|
||||
-- What are the class constraints for the instances?
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 8: below you'll find two different ways of representing
|
||||
-- calculator operations. The type Operation1 is a closed abstraction,
|
||||
-- while the class Operation2 is an open abstraction.
|
||||
--
|
||||
-- Your task is to add:
|
||||
-- * a multiplication case to Operation1 and Operation2
|
||||
-- (named Multiply1 and Multiply2, respectively)
|
||||
-- * functions show1 and show2 that render values of
|
||||
-- Operation1 and Operation2 to strings
|
||||
--
|
||||
-- Examples:
|
||||
-- compute1 (Multiply1 2 3) ==> 6
|
||||
-- compute2 (Multiply2 2 3) ==> 6
|
||||
-- show1 (Add1 2 3) ==> "2+3"
|
||||
-- show1 (Multiply1 4 5) ==> "4*5"
|
||||
-- show2 (Subtract2 2 3) ==> "2-3"
|
||||
-- show2 (Multiply2 4 5) ==> "4*5"
|
||||
|
||||
data Operation1 = Add1 Int Int
|
||||
| Subtract1 Int Int
|
||||
deriving Show
|
||||
|
||||
compute1 :: Operation1 -> Int
|
||||
compute1 (Add1 i j) = i+j
|
||||
compute1 (Subtract1 i j) = i-j
|
||||
|
||||
|
||||
data Add2 = Add2 Int Int
|
||||
deriving Show
|
||||
data Subtract2 = Subtract2 Int Int
|
||||
deriving Show
|
||||
|
||||
class Operation2 op where
|
||||
compute2 :: op -> Int
|
||||
|
||||
instance Operation2 Add2 where
|
||||
compute2 (Add2 i j) = i+j
|
||||
|
||||
instance Operation2 Subtract2 where
|
||||
compute2 (Subtract2 i j) = i-j
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 9: validating passwords. Below you'll find a type
|
||||
-- PasswordRequirement describing possible requirements for passwords.
|
||||
--
|
||||
-- Implement the function passwordAllowed that checks whether a
|
||||
-- password is allowed.
|
||||
--
|
||||
-- Examples:
|
||||
-- passwordAllowed "short" (MinimumLength 8) ==> False
|
||||
-- passwordAllowed "veryLongPassword" (MinimumLength 8) ==> True
|
||||
-- passwordAllowed "password" (ContainsSome "0123456789") ==> False
|
||||
-- passwordAllowed "p4ssword" (ContainsSome "0123456789") ==> True
|
||||
-- passwordAllowed "password" (DoesNotContain "0123456789") ==> True
|
||||
-- passwordAllowed "p4ssword" (DoesNotContain "0123456789") ==> False
|
||||
-- passwordAllowed "p4ssword" (And (ContainsSome "1234") (MinimumLength 5)) ==> True
|
||||
-- passwordAllowed "p4ss" (And (ContainsSome "1234") (MinimumLength 5)) ==> False
|
||||
-- passwordAllowed "p4ss" (Or (ContainsSome "1234") (MinimumLength 5)) ==> True
|
||||
|
||||
data PasswordRequirement =
|
||||
MinimumLength Int
|
||||
| ContainsSome String -- contains at least one of given characters
|
||||
| DoesNotContain String -- does not contain any of the given characters
|
||||
| And PasswordRequirement PasswordRequirement -- or'ing two requirements
|
||||
| Or PasswordRequirement PasswordRequirement -- and'ing
|
||||
deriving Show
|
||||
|
||||
passwordAllowed :: String -> PasswordRequirement -> Bool
|
||||
passwordAllowed = todo
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Ex 10: a DSL for simple arithmetic expressions with addition and
|
||||
-- multiplication. Define the type Arithmetic so that it can express
|
||||
-- expressions like this. Define the functions literal and operation
|
||||
-- for creating Arithmetic values.
|
||||
--
|
||||
-- Define two interpreters for Arithmetic: evaluate should compute the
|
||||
-- expression, and render should show the expression as a string.
|
||||
--
|
||||
-- Examples:
|
||||
-- evaluate (literal 3) ==> 3
|
||||
-- render (literal 3) ==> "3"
|
||||
-- evaluate (operation "+" (literal 3) (literal 4)) ==> 7
|
||||
-- render (operation "+" (literal 3) (literal 4)) ==> "(3+4)"
|
||||
-- evaluate (operation "*" (literal 3) (operation "+" (literal 1) (literal 1)))
|
||||
-- ==> 6
|
||||
-- render (operation "*" (literal 3) (operation "+" (literal 1) (literal 1)))
|
||||
-- ==> "(3*(1+1))"
|
||||
--
|
||||
|
||||
data Arithmetic = Todo
|
||||
deriving Show
|
||||
|
||||
literal :: Integer -> Arithmetic
|
||||
literal = todo
|
||||
|
||||
operation :: String -> Arithmetic -> Arithmetic -> Arithmetic
|
||||
operation = todo
|
||||
|
||||
evaluate :: Arithmetic -> Integer
|
||||
evaluate = todo
|
||||
|
||||
render :: Arithmetic -> String
|
||||
render = todo
|
||||
@@ -0,0 +1,266 @@
|
||||
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, StandaloneDeriving, DeriveGeneric #-}
|
||||
|
||||
module Set7Test where
|
||||
|
||||
import Data.List
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
import GHC.Generics (Generic)
|
||||
import Generic.Random
|
||||
import Test.QuickCheck
|
||||
|
||||
import Mooc.Th
|
||||
import Mooc.Test
|
||||
|
||||
import Set7 hiding (bake)
|
||||
|
||||
main = score tests
|
||||
|
||||
tests = [(1,"travel",[ex1_travel, ex1_velocity])
|
||||
,(2,"Set",[ex2_member, ex2_add, ex2_empty_add])
|
||||
,(3,"bake",[ex3_ok, ex3_finished, ex3_error, ex3_type])
|
||||
,(4,"average NonEmpty",[ex4])
|
||||
,(5,"reverseNonEmpty",[ex5_one, ex5_many])
|
||||
,(6,"Semigroup x3",[ex6_Distance, ex6_Time, ex6_Velocity])
|
||||
,(7,"Monoid Set",[ex7_combine, ex7_mempty])
|
||||
,(8,"Operation1&2",[ex8_multiply1, ex8_multiply2, ex8_show1, ex8_show1_multiply1, ex8_show2, ex8_show2_multiply2])
|
||||
,(9,"PasswordRequirement",[ex9_basics, ex9_either_both, ex9_large])
|
||||
,(10,"Arithmetic",[ex10_examples, ex10_large])
|
||||
]
|
||||
|
||||
--
|
||||
|
||||
ex1_velocity = forAll_ $ \d ->
|
||||
forAll_ $ \(Positive t) ->
|
||||
$(testing [|velocity (Distance d) (Time t)|]) (?==Velocity (d/t))
|
||||
|
||||
ex1_travel = forAll_ $ \(v,t) ->
|
||||
$(testing [|travel (Velocity v) (Time t)|]) (?==Distance (v*t))
|
||||
|
||||
instance (Ord a, Arbitrary a) => Arbitrary (Set a) where
|
||||
arbitrary = fmap (Set . nub) orderedList
|
||||
|
||||
m2_member example = forAll_ $ \(Set xs) ->
|
||||
not (null xs) ==>
|
||||
forAllBlind (elements (xs`asTypeOf`example)) $ \x ->
|
||||
conjoin [$(testing [|member x (Set xs)|]) (?==True)
|
||||
,$(testing [|member x (Set (delete x xs))|]) (?==False)]
|
||||
|
||||
ex2_member = conjoin [m2_member [True,False]
|
||||
,m2_member [1::Int,2,3]]
|
||||
|
||||
m2_add example = forAll_ $ \(Set xs) ->
|
||||
not (null xs) ==>
|
||||
forAllBlind (elements (xs`asTypeOf`example)) $ \x ->
|
||||
conjoin [$(testing [|add x (Set xs)|]) (?==(Set xs))
|
||||
,$(testing [|add x (Set (delete x xs))|]) (?==(Set xs))]
|
||||
|
||||
ex2_add = conjoin [m2_add [Just (1::Integer)]
|
||||
,m2_add [1::Int,2,3]]
|
||||
|
||||
ex2_empty_add = conjoin
|
||||
[forAll_ $ \(i::Integer) -> counterexample ("add "++show i++" emptySet") (add i emptySet ?== Set [i])
|
||||
,forAll_ $ \(b::Bool) -> counterexample ("add " ++show b++"(add "++show b++" emptySet)")
|
||||
(add b (add b emptySet) ?== Set [b])]
|
||||
|
||||
deriving instance Generic Event
|
||||
instance Arbitrary Event where
|
||||
arbitrary = genericArbitrary uniform
|
||||
|
||||
ex3_good = [[AddEggs,AddFlour,AddSugar,Mix,Bake]
|
||||
,[AddEggs,AddSugar,AddFlour,Mix,Bake]]
|
||||
|
||||
canFinish ev = any (\g -> ev `isPrefixOf` g) ex3_good
|
||||
finished ev = any (\g -> g `isPrefixOf` ev) ex3_good
|
||||
|
||||
bake :: [Event] -> State
|
||||
bake events = go Start events
|
||||
where go state [] = state
|
||||
go state (e:es) = go (step state e) es
|
||||
|
||||
ex3_ok = forAllBlind (elements ex3_good) $ \events ->
|
||||
$(testing [|bake events|]) (?==Finished)
|
||||
|
||||
ex3_finished = forAll_ $ \(ev::Event) ->
|
||||
$(testing [|step Finished ev|]) (?==Finished)
|
||||
|
||||
genBad = do
|
||||
g <- elements ex3_good
|
||||
i <- choose (0,length g - 1)
|
||||
let pre = take i g
|
||||
x <- arbitrary `suchThat` (\x -> not (canFinish (pre++[x]) || finished (pre++[x])))
|
||||
return $ pre++[x]
|
||||
|
||||
ex3_error = forAllBlind (genBad) $ \events ->
|
||||
$(testing [|bake events|]) (?==Error)
|
||||
|
||||
ex3_type = $(reifyType "State") $ \(DataType vars cs) ->
|
||||
conjoin [counterexample " should have no type parameters" $ vars == []
|
||||
,conjoin $ map ok cs]
|
||||
where ok (Constructor _ []) = property True
|
||||
ok (Constructor n _) = counterexample (" constructor "++show n++" should have no fields") $ property False
|
||||
ok (Weird n) = counterexample (" constructor "++show n++" is weird. Make it normal.") $ property False
|
||||
|
||||
ex4 = conjoin [forAll_ $ \(Small i) -> $(testing [|average ((fromIntegral i :: Float) :| [])|]) (?==fromIntegral i)
|
||||
,forAllBlind (choose (1,10)) $ \n -> forAll_ $ \(i::Rational) ->
|
||||
$(testing [|average (i:|(replicate n i))|]) (?==i)
|
||||
,forAll_ $ \(Small i) -> let f = fromIntegral i in $(testing [|average ((f-1):|[f,f+1])|]) (?==f)
|
||||
,forAll_ $ \(Small i,Small j) ->
|
||||
let x = fromIntegral i :: Double
|
||||
y = fromIntegral j :: Double
|
||||
in $(testing [|average (x:|(replicate 9 x ++ replicate 10 y))|]) (?~=(x+y)/2)]
|
||||
|
||||
ex5_one = forAll_ $ \(x::Bool) -> $(testing [|reverseNonEmpty (x:|[])|]) (?==(x:|[]))
|
||||
|
||||
ex5_many = forAllBlind (choose (0,10)) $ \(i::Int) ->
|
||||
forAllBlind (choose (2,10)) $ \(n::Int) ->
|
||||
$(testing [|reverseNonEmpty (i:|[i+1..i+n])|]) (?==((i+n):|[i+n-1,i+n-2..i]))
|
||||
|
||||
ex6_Distance = $(withInstance "Semigroup" "Distance" [|(<>)|]) $ \(<>) ->
|
||||
forAll_ $ \(x,y) ->
|
||||
$(testing [|(Distance x) <> (Distance y)|]) (?==Distance (x+y))
|
||||
|
||||
ex6_Time = $(withInstance "Semigroup" "Time" [|(<>)|]) $ \(<>) ->
|
||||
forAll_ $ \(x,y) ->
|
||||
$(testing [|(Time x) <> (Time y)|]) (?==Time (x+y))
|
||||
|
||||
ex6_Velocity = $(withInstance "Semigroup" "Velocity" [|(<>)|]) $ \(<>) ->
|
||||
forAll_ $ \(x,y) ->
|
||||
$(testing [|(Velocity x) <> (Velocity y)|]) (?==Velocity (x+y))
|
||||
|
||||
split [] = return ([],[])
|
||||
split (x:xs) = do
|
||||
(as,bs) <- split xs
|
||||
oneof [return (x:as,bs)
|
||||
,return (as,x:bs)
|
||||
,return (x:as,x:bs)]
|
||||
|
||||
ex7_combine = $(withInstance1 "Monoid" "Set" [|(<>)|]) $ \(<>) ->
|
||||
forAll_ $ \(Set (xs :: [Integer])) ->
|
||||
forAllBlind (split xs) $ \(as,bs) ->
|
||||
$(testing [|(Set as) <> (Set bs)|]) (?==(Set xs))
|
||||
|
||||
ex7_mempty = $(withInstance1 "Monoid" "Set" [|((<>),mempty)|]) $ \((<>),mempty) ->
|
||||
forAll_ $ \(Set (xs :: [Char])) ->
|
||||
conjoin [counterexample (show (Set xs) ++ " <> mempty") ((Set xs <> mempty) ?== Set xs)
|
||||
,counterexample ("mempty <> " ++ show (Set xs)) ((mempty <> Set xs) ?== Set xs)]
|
||||
|
||||
smallInt = choose (0,100::Int)
|
||||
|
||||
ex8_multiply1 = $(hasType "Multiply1" [t|Int -> Int -> Operation1|]) $ \mul1 ->
|
||||
forAllBlind smallInt $ \i ->
|
||||
forAllBlind smallInt $ \j ->
|
||||
$(testing [|compute1 (mul1 i j)|]) (?==(i*j))
|
||||
|
||||
ex8_multiply2 =
|
||||
$(withInstance "Operation2" "Multiply2" [|compute2|]) $ \compute2 ->
|
||||
$(withDefined "Multiply2") $ \mul2 ->
|
||||
forAllBlind smallInt $ \i ->
|
||||
forAllBlind smallInt $ \j ->
|
||||
-- no Show instance available...
|
||||
counterexample ("compute2 (Multiply2 " ++ show i ++ " " ++ show j ++ ")") $
|
||||
compute2 (mul2 i j) ?== (i*j)
|
||||
|
||||
ex8_show1 =
|
||||
$(hasType "show1" [t|Operation1 -> [Char]|]) $ \show1 ->
|
||||
forAllBlind smallInt $ \i ->
|
||||
forAllBlind smallInt $ \j ->
|
||||
conjoin [$(testing [|show1 (Add1 i j)|]) (?==show i++"+"++show j)
|
||||
,$(testing [|show1 (Subtract1 i j)|]) (?==show i++"-"++show j)]
|
||||
|
||||
ex8_show1_multiply1 =
|
||||
$(hasType "Multiply1" [t|Int -> Int -> Operation1|]) $ \mul1 ->
|
||||
$(hasType "show1" [t|Operation1 -> [Char]|]) $ \show1 ->
|
||||
forAllBlind smallInt $ \i ->
|
||||
forAllBlind smallInt $ \j ->
|
||||
counterexample ("show1 (Multiply1 " ++ show i ++ " " ++ show j ++ ")") $
|
||||
show1 (mul1 i j) ?== show i++"*"++show j
|
||||
|
||||
ex8_show2 =
|
||||
conjoin [$(withDefined "show2") $ \show2 ->
|
||||
forAllBlind smallInt $ \i ->
|
||||
forAllBlind smallInt $ \j ->
|
||||
$(testing [|show2 (Add2 i j)|]) (?==show i++"+"++show j)
|
||||
,$(withDefined "show2") $ \show2 ->
|
||||
forAllBlind smallInt $ \i ->
|
||||
forAllBlind smallInt $ \j ->
|
||||
$(testing [|show2 (Subtract2 i j)|]) (?==show i++"-"++show j)]
|
||||
|
||||
ex8_show2_multiply2 =
|
||||
$(withDefined "show2") $ \show2 ->
|
||||
$(withDefined "Multiply2") $ \mul2 ->
|
||||
forAllBlind (choose (0,100::Int)) $ \i ->
|
||||
forAllBlind (choose (0,100::Int)) $ \j ->
|
||||
$(testing [|show2 (Add2 i j)|]) (?==show i++"+"++show j)
|
||||
|
||||
ex9_basics =
|
||||
conjoin [$(testing [|passwordAllowed "short" (MinimumLength 8)|]) (?==False)
|
||||
,$(testing [|passwordAllowed "veryLongPassword" (MinimumLength 8)|]) (?==True)
|
||||
,$(testing [|passwordAllowed "password" (ContainsSome "0123456789")|]) (?==False)
|
||||
,$(testing [|passwordAllowed "p4ssword" (ContainsSome "0123456789")|]) (?==True)
|
||||
,$(testing [|passwordAllowed "password" (DoesNotContain "0123456789")|]) (?==True)
|
||||
,$(testing [|passwordAllowed "p4ssword" (DoesNotContain "0123456789")|]) (?==False)
|
||||
]
|
||||
|
||||
ex9_either_both = property $ do
|
||||
~limits@[a,b,c,d] <- vectorOf 4 (choose (3,12))
|
||||
password <- vectorOf 24 (choose ('a','z'))
|
||||
let or = Or (Or (MinimumLength a) (MinimumLength b)) (Or (MinimumLength c) (MinimumLength d))
|
||||
and = And (And (MinimumLength a) (MinimumLength b)) (And (MinimumLength c) (MinimumLength d))
|
||||
low = minimum limits
|
||||
hi = maximum limits
|
||||
return $
|
||||
(low < hi) ==> do med <- choose (low,hi-1)
|
||||
return $
|
||||
conjoin [$(testing [|passwordAllowed (take (low-1) password) or|]) (?==False)
|
||||
,$(testing [|passwordAllowed (take (low-1) password) and|]) (?==False)
|
||||
,$(testing [|passwordAllowed (take med password) or|]) (?==True)
|
||||
,$(testing [|passwordAllowed (take med password) and|]) (?==False)
|
||||
,$(testing [|passwordAllowed (take hi password) or|]) (?==True)
|
||||
,$(testing [|passwordAllowed (take hi password) and|]) (?==True)]
|
||||
|
||||
tree leaf node [] = MinimumLength 0
|
||||
tree leaf node cs
|
||||
| length cs <= 2 = leaf cs
|
||||
tree leaf node cs = node (tree leaf node lefts) (tree leaf node rights)
|
||||
where (lefts,rights) = splitAt (length cs `div` 2) cs
|
||||
|
||||
special = elements "0123456789!#%&/()="
|
||||
|
||||
ex9_large = forAllShrink_ (listOf special) $ \forbidden ->
|
||||
forAllShrink_ (listOf special) $ \required' ->
|
||||
forAllShrink_ (listOf (choose ('a','z'))) $ \base ->
|
||||
let required = filter (not . flip elem forbidden) required'
|
||||
rules = And (tree ContainsSome Or required) (tree DoesNotContain And forbidden)
|
||||
in not (null required) ==>
|
||||
not (null forbidden) ==>
|
||||
forAllBlind (elements required) $ \req ->
|
||||
forAllBlind (elements forbidden) $ \forb ->
|
||||
conjoin [$(testing [|passwordAllowed base rules|]) (?==False)
|
||||
,forAllBlind (shuffle (req:base)) $ \pw ->
|
||||
$(testing [|passwordAllowed pw rules|]) (?==True)
|
||||
,forAllBlind (shuffle (forb:req:base)) $ \pw ->
|
||||
$(testing [|passwordAllowed pw rules|]) (?==False)]
|
||||
|
||||
ex10_examples = conjoin [$(testing [|evaluate (literal 3)|]) (?==3)
|
||||
,$(testing [|render (literal 3)|]) (?=="3")
|
||||
,$(testing [|evaluate (operation "+" (literal 3) (literal 4))|]) (?==7)
|
||||
,$(testing [|render (operation "+" (literal 3) (literal 4))|]) (?=="(3+4)")
|
||||
,$(testing [|evaluate (operation "*" (literal 3) (operation "+" (literal 1) (literal 1)))|]) (?==6)
|
||||
,$(testing [|render (operation "*" (literal 3) (operation "+" (literal 1) (literal 1)))|]) (?=="(3*(1+1))")]
|
||||
|
||||
gen_arithmetic :: Integer -> Gen (Integer,Arithmetic,String,String)
|
||||
gen_arithmetic 0 = do
|
||||
i <- choose (0,10)
|
||||
return (i,literal i,show i,"(literal "++show i++")")
|
||||
gen_arithmetic i = do
|
||||
(lval,lexp,lshow,lcode) <- gen_arithmetic (i-1)
|
||||
(rval,rexp,rshow,rcode) <- gen_arithmetic (i-1)
|
||||
elements [(lval+rval,operation "+" lexp rexp,"("++lshow++"+"++rshow++")","(operation \"+\" "++lcode++" "++rcode++")")
|
||||
,(lval*rval,operation "*" lexp rexp,"("++lshow++"*"++rshow++")","(operation \"*\" "++lcode++" "++rcode++")")]
|
||||
|
||||
m_ex10 level = forAllShrink_ (choose (1,level)) $ \l ->
|
||||
forAllBlind (gen_arithmetic level) $ \(val,exp,show,code) ->
|
||||
conjoin [counterexample ("evaluate "++code) $ evaluate exp ?== val
|
||||
,counterexample ("render "++code) $ render exp ?== show]
|
||||
|
||||
ex10_large = conjoin [m_ex10 level | level <- [1..5]]
|
||||
Reference in New Issue
Block a user