Craft3e-0.1.0.2: Chapter4.hs
--------------------------------------------------------------------------
--
-- Haskell: The Craft of Functional Programming, 3e
-- Simon Thompson
-- (c) Addison-Wesley, 1996-2011.
--
-- Chapter 4
--
--------------------------------------------------------------------------
-- NOTE
--
-- Added HUnit and QuickCheck tests
--
-- HUnit 1.0 documentation is out of date
-- re package name.
module Chapter4 where
import Test.HUnit
import Test.QuickCheck
import PicturesSVG hiding (test2)
-- Designing a program in Haskell
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
maxThree :: Int -> Int -> Int -> Int
maxThree x y z = (x `max` y) `max` z
testMax1 = TestCase (assertEqual "for: maxThree 6 4 1" 6 (maxThree 6 4 1))
testMax2 = TestCase (assertEqual "for: maxThree 6 6 6" 6 (maxThree 6 6 6))
testMax3 = TestCase (assertEqual "for: maxThree 2 6 6" 6 (maxThree 2 6 6))
testMax4 = TestCase (assertEqual "for: maxThree 2 2 6" 6 (maxThree 2 2 6))
-- run as
-- runTestTT testsMax
testsMax = TestList [testMax1, testMax2, testMax3, testMax4]
-- NOTE
--
-- Added this type synonym so that can switch easily
-- between Integer and Int.
type MyNum = Integer
middleNumber :: MyNum -> MyNum -> MyNum -> MyNum
middleNumber x y z
| between y x z = x
| between x y z = y
| otherwise = z
-- What follows here is a dummy definition of between; you need to replace this
-- with a proper definition for the function middleNumber to work.
between :: MyNum -> MyNum -> MyNum -> Bool
-- dummy definition
-- for you to complete!
between = between
-- NOTE
--
-- HUnit tests added
--
-- To run evaluate: runTestTT tests
test1 = TestCase (assertEqual "for: between 2 3 4" True (between 2 3 4))
test2 = TestCase (assertEqual "for: between 2 3 2" False (between 2 3 2))
test3 = TestCase (assertEqual "for: between 2 3 3" True (between 2 3 3))
test4 = TestCase (assertEqual "for: between 3 3 3" True (between 3 3 3))
test5 = TestCase (assertEqual "for: between 3 2 3" False (between 3 2 3))
test6 = TestCase (assertEqual "for: between 3 2 1" True (between 3 2 1))
testsBetween = TestList [test1, test2, test3, test4, test5, test6]
-- NOTE
--
-- Interesting to vary the implementation and see which tests fail.
-- Simple form of mutation testing.
-- QuickCheck test
--
-- Does the tricky implementation of between work in the
-- same way as the case analysis?
prop_between :: MyNum -> MyNum -> MyNum -> Bool
prop_between x y z
= (between x y z) == ((x<=y)&&(y<=z))||((x>=y)&&(y>=z))
-- Unit tests as Quick Check properties
prop_between1 :: Bool
prop_between1
= between 2 3 4 == True
-- Local definitions
-- ^^^^^^^^^^^^^^^^^
-- Four ways of defining a Picture using
-- different combinations of loca definitions.
fourPics1 :: Picture -> Picture
fourPics1 pic =
left `beside` right
where
left = pic `above` invertColour pic
right = invertColour (flipV pic) `above` flipV pic
fourPics2 :: Picture -> Picture
fourPics2 pic =
left `beside` right
where
left = pic `above` invertColour pic
right = invertColour flipped `above` flipped
flipped = flipV pic
fourPics3 :: Picture -> Picture
fourPics3 pic =
left `beside` right
where
left = pic `above` invertColour pic
right = invertColour (flipV left)
fourPics4 :: Picture -> Picture
fourPics4 pic =
left `beside` right
where
stack p = p `above` invertColour p
left = stack pic
right = stack (invertColour (flipV pic))
-- Area of a triangle
triArea' :: Float -> Float -> Float -> Float
triArea' a b c
| possible = sqrt(s*(s-a)*(s-b)*(s-c))
| otherwise = 0
where
s = (a+b+c)/2
possible = possible -- dummy definition
-- Sum of squares
sumSquares :: Integer -> Integer -> Integer
sumSquares n m
= sqN + sqM
where
sqN = n*n
sqM = m*m
-- Let expressions
-- ^^^^^^^^^^^^^^^
-- Two examples which use `let'.
letEx1 :: Integer
letEx1 = let x = 3+2 in x^2 + 2*x - 4
letEx2 :: Integer
letEx2 = let x = 3+2 ; y = 5-1 in x^2 + 2*x - y
-- Scopes
isOdd, isEven :: Int -> Bool
isOdd n
| n<=0 = False
| otherwise = isEven (n-1)
isEven n
| n<0 = False
| n==0 = True
| otherwise = isOdd (n-1)
-- Defining types for ourselves
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-- Rock - Paper - Scissors
data Move = Rock |
Paper |
Scissors
deriving Eq
-- Showing Moves in an abbreviated form.
instance Show Move where
show Rock = "r"
show Paper = "p"
show Scissors = "s"
-- For QuickCheck to work over the Move type.
instance Arbitrary Move where
arbitrary = elements [Rock, Paper, Scissors]
-- Calculating the Move to beat or lose against the
-- argument Move.
beat, lose :: Move -> Move
beat Rock = Paper
beat Paper = Scissors
beat Scissors = Rock
lose Rock = Scissors
lose Paper = Rock
lose Scissors = Paper
-- Primitive recursion over Int
-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-- The factorial of n is 1*2*...*(n-1)*n, so that factorial of four is 24.
-- It is often written n!
fac :: Integer -> Integer
fac n
| n==0 = 1
| n>0 = fac (n-1) * n
| otherwise = error "fac only defined on natural numbers"
-- n
-- Raising two to a power: power2 n is 2 in mathematical notation.
power2 :: Integer -> Integer
power2 n
| n==0 = 1
| n>0 = 2 * power2 (n-1)
-- The sum of the factorials up to a particular value, 0! + 1! + ... n!.
sumFacs :: Integer -> Integer
sumFacs n
| n==0 = 1
| n>0 = sumFacs (n-1) + fac n
-- The sum of the values of a function up to a particular value:
-- f 0 + f 1 + ... f n
-- from which you can reconstruct sumFacs: sumFacs n = sumFun fac n
sumFun :: (Integer -> Integer) -> Integer -> Integer
sumFun f n
| n==0 = f 0
| n>0 = sumFun f (n-1) + f n
-- The maximum number of regions into which n lines can cut a plane.
regions :: Integer -> Integer
regions n
| n==0 = 1
| n>0 = regions (n-1) + n
-- The Fibonacci numbers 0, 1, 1, 2, 3, 5, ..., u, v, u+v, ...
fib :: Integer -> Integer
fib n
| n==0 = 0
| n==1 = 1
| n>1 = fib (n-2) + fib (n-1)
-- Division of integers
remainder :: Integer -> Integer -> Integer
remainder m n
| m<n = m
| otherwise = remainder (m-n) n
divide :: Integer -> Integer -> Integer
divide m n
| m<n = 0
| otherwise = 1 + divide (m-n) n
-- Testing
-- ^^^^^^^
-- Does this function calculate the maximum of three numbers?
mysteryMax :: Integer -> Integer -> Integer -> Integer
mysteryMax x y z
| x > y && x > z = x
| y > x && y > z = y
| otherwise = z
testMMax1 = TestCase (assertEqual "for: mysteryMax 6 4 1" 6 (mysteryMax 6 4 1))
testMMax2 = TestCase (assertEqual "for: mysteryMax 6 6 6" 6 (mysteryMax 6 6 6))
testMMax3 = TestCase (assertEqual "for: mysteryMax 2 6 6" 6 (mysteryMax 2 6 6))
testMMax4 = TestCase (assertEqual "for: mysteryMax 2 2 6" 6 (mysteryMax 2 2 6))
testMMax5 = TestCase (assertEqual "for: mysteryMax 6 6 2" 6 (mysteryMax 6 6 2))
testsMMax = TestList [testMMax1, testMMax2, testMMax3, testMMax4, testMMax5]
-- Numbers of roots
numberNDroots :: Float -> Float -> Float -> Integer
numberNDroots a b c
| bsq > fac = 2
| bsq == fac = 1
| bsq < fac = 0
where
bsq = b*b
fac = 4.0*a*c
-- Area of a triangle
triArea :: Float -> Float -> Float -> Float
triArea a b c
| possible a b c = sqrt(s*(s-a)*(s-b)*(s-c))
| otherwise = 0
where
s = (a+b+c)/2
possible :: Float -> Float -> Float -> Bool
possible a b c = True -- dummy definition
fact :: Int -> Int
fact n
| n>1 = n * fact (n-1)
| otherwise = 1
prop_fact n =
fact n > 0
-- Extended exercise
-- ^^^^^^^^^^^^^^^^^
blackSquares :: Integer -> Picture
blackSquares n
| n<=1 = black
| otherwise = black `beside` blackSquares (n-1)
blackWhite :: Integer -> Picture
blackWhite n
| n<=1 = black
| otherwise = black `beside` whiteBlack (n-1)
whiteBlack = error "exercise for you"
blackChess :: Integer -> Integer -> Picture
blackChess n m
| n<=1 = blackWhite m
| otherwise = blackWhite m `above` whiteChess (n-1) m
whiteChess n m = error "exercise for you"