module MoreFunctions where
import Question
geometricMeanURL = "http://en.wikipedia.org/wiki/Geometric_mean"
quadraticEquationUrl = "http://en.wikipedia.org/wiki/Quadratic_equation"
moreFunctions = do
h2 $ text "More functions"
<#>Define a function that takes two numbers as input and
computes their mean. Write the function in a new file, load it
into Hugs and test it for some different inputs.#> ?> do
fixed "mean x y = ?"
<#>Did you write a type signature for the function? If not, do
that now.#> ?> do
p <#>Either choose a numerical type you're familiar with
for the arguments, for example Double:#>
fixed "mean :: Double -> Double -> Double"
p <#>...or use the type that Hugs works out for the
function:#>
prompts "Main>"
[ ( ":t mean"
, "mean :: Fractional a => a -> a -> a"
)
]
p <#>Your choice of type signature depends on what area of use
you have in mind for the function. If you only want it to
be used for Double, choose the first type signature.
If you'd rather use it with all fractional types, choose the
other.#>
<#>Suggest a suitable property that the function should fulfil,
write down the property in the file containing the function, and
test whether the function satisfies the property.#> ?> do
p <#>The mean of two numbers should lie between the two numbers,
right?#>
fixed
"prop_meanBetween :: Double -> Double -> Bool\n\
\prop_meanBetween x y =\n\
\ (min x y <= mean x y) && (mean x y <= max x y)"
p <#>A few things can be pointed out here:#>
ul $ do
li $ p <#>To verify the soundness of a property, and
a second one at the same time, use <%= "&&"
%> (which is read as "and"). If you have not
seen "and" in the mathematics course yet you will
probably do so soon.#>
<#>Two "comparable" objects are compared with <%= "<=" %>
("less than or equal to"). What
is meant by comparable? Is it possible to compare objects in
different ways?#> .?> do
prompts "Main>"
[ ( ":i <="
, "infix 4 <=\n\
\(<=) :: Ord a => a -> a -> Bool -- class member"
)
, ( ":i Ord"
, "-- type class\n\
\infix 4 <\n\
\infix 4 <=\n\
\infix 4 >=\n\
\infix 4 >\n\
\class Eq a => Ord a where\n\
\ compare :: a -> a -> Ordering\n\
\ (<) :: a -> a -> Bool\n\
\ (<=) :: a -> a -> Bool\n\
\ (>=) :: a -> a -> Bool\n\
\ (>) :: a -> a -> Bool\n\
\ max :: a -> a -> a\n\
\ min :: a -> a -> a\n\
\\n\
\-- instances:\n\
\...\n\
\instance Ord Int\n\
\instance Ord Integer\n\
\instance Ord Float\n\
\instance Ord Double\n\
\instance Integral a => Ord (Ratio a)\n\
\instance Ord Bool\n\
\..."
)
]
li $ p <#>The functions min and max take two
arguments and return the smallest and largest one,
respectively, as result.#>
li $ do
p <#>We must give a type signature that states a precise
type. If we had given the type#>
fixed "prop_meanBetween :: (Fractional a, Ord a) =>\
\ a -> a -> Bool"
p <#>which is the type that Hugs suggests for the function,
we wouldn't have been able to test the function (property):#>
prompts "Main>"
[ ( "quickCheck prop_meanBetween"
, "ERROR - Unresolved overloading\n\
\*** Type : (Fractional a, Ord a, Arbitrary a) => \
\IO ()\n\
\*** Expression : quickCheck prop_meanBetween"
)
]
p <#>This is because we can't simultaneously test the properties
for all types that are members of the type classes
Fractional, Ord and
Arbitrary. We must choose one of the types
that satisfy all of the requirements.#>
<#>Repeat the procedure above, but now with the >geometric
mean instead of the arithmetic one.#> ?> do
fixed $ unlines
[ "geometricMean :: Floating a => a -> a -> a"
, "geometricMean x y = sqrt (x * y)"
]
fixed $ unlines
[ "prop_geometricMeanBetween :: Double -> Double -> Bool"
, "prop_geometricMeanBetween x y ="
, " (min x y <= geometricMean x y) && (geometricMean x y <= max x y)"
]
p <#>Let us try out the property. Several things can happen:#>
prompts "Main>"
[ ( "quickCheck prop_geometricMeanBetween"
, unlines [ "Falsifiable, after 2 tests:"
, "-0.2"
, "-0.4"
]
)
]
prompts "Main>"
[ ( "quickCheck prop_geometricMeanBetween"
, unlines [ "3"
, "Program error: argument out of range"
]
)
]
<#>What is the problem?#> ?> do
p <#>The geometric mean is only defined for positive numbers. We
can restrict the test to positive numbers by using (==>).#>
fixed $ unlines
[ "prop_geometricMeanBetween :: Double -> Double -> Property"
, "prop_geometricMeanBetween x y ="
, " x > 0 && y > 0 ==>"
, " (min x y <= geometricMean x y) && (geometricMean x y <= max x y)"
]
p <#>Now the test should succeed. Note that we have to change
the type of the property when using (==>).#>
<#>Write a function that solves a >quadratic equation, i.e. an equation of the form ax² + bx
+ c = 0. You can assume that a is non-zero, and that b² - 4ac is
non-negative.#> ?> do
p <#>A quadratic equation can have up to two solutions. How can a
function return two different results? By returning a pair of
results! We write the pair containing x and
y as follows: (x, y). If x and
y both have type Double, then the type of
(x, y) is (Double, Double).#>
<#>Now try the exercise again.#> ?> do
p <#>Here is a partial solution:#>
fixed $ unlines
[ "roots :: Double -> Double -> Double -> (Double, Double)"
, "roots a b c = ( ?"
, " , ?"
, " )"
, " where"
, " discriminant = b^2 - 4 * a * c"
]
p <#>We can use where to name a sub-expression. The
name discriminant can be used in the definition of
roots (where the question marks are), and writing
discriminant has the same result as writing
b^2 - 4 * a * c.#>
<#>You haven't been given the entire solution yet. Is your
function correct? It is easy to test if the two results
actually solve the equation. (But to do this you may need
to use the functions fst and snd. Play
around with them a little first.)#> ?> do
fixed $ unlines
[ "prop_roots :: Double -> Double -> Double -> Property"
, "prop_roots a b c ="
, " a /= 0 && discriminant >= 0 ==>"
, " a * (fst rs) ^ 2 + b * (fst rs) + c ~== 0"
, " &&"
, " a * (snd rs) ^ 2 + b * (snd rs) + c ~== 0"
, " where"
, " rs = roots a b c"
, " discriminant = b^2 - 4 * a * c"
]
p <#>We can get a property which is easier to read, and hence
also easier to understand, by using pattern
matching:#>
fixed $ unlines
[ "prop_roots :: Double -> Double -> Double -> Property"
, "prop_roots a b c ="
, " a /= 0 && discriminant >= 0 ==>"
, " a * r1 ^ 2 + b * r1 + c ~== 0"
, " &&"
, " a * r2 ^ 2 + b * r2 + c ~== 0"
, " where"
, " (r1, r2) = roots a b c"
, " discriminant = b^2 - 4 * a * c"
]
<#>OK, do you want to see the answer now?#> ?> do
fixed $ unlines
[ "roots :: Double -> Double -> Double -> (Double, Double)"
, "roots a b c = ( (-b + sqrt discriminant) / (2 * a)"
, " , (-b - sqrt discriminant) / (2 * a)"
, " )"
, " where"
, " discriminant = b^2 - 4 * a * c"
]