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