[Added an exercise based on quadratic equations.
Nils Anders Danielsson <nad@cs.chalmers.se>**20050901103550
 Suggested by Andreas Farre.
] {
hunk ./MoreFunctions.ws 6
+quadraticEquationUrl = "http://en.wikipedia.org/wiki/Quadratic_equation"
hunk ./MoreFunctions.ws 178
+
+  <#>Write a function that solves a <a href=<% quadraticEquationUrl
+     %>>quadratic equation</a>, 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 <tt>x</tt> and
+         <tt>y</tt> as follows: <tt>(x, y)</tt>. If <tt>x</tt> and
+         <tt>y</tt> both have type <tt>Double</tt>, then the type of
+         <tt>(x, y)</tt> is <tt>(Double, Double)</tt>.</#>
+
+    <#>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 <tt>where</tt> to name a sub-expression. The
+           name <tt>discriminant</tt> can be used in the definition of
+           <tt>roots</tt> (where the question marks are), and writing
+           <tt>discriminant</tt> has the same result as writing
+           <tt>b^2 - 4 * a * c</tt>.</#>
+
+      <#>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 <tt>fst</tt> and <tt>snd</tt>. 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 <em>pattern
+             matching</em>:</#>
+
+        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"
+            ]
addfile ./QuadraticEquation.hs
hunk ./QuadraticEquation.hs 1
+import QuickCheck
+
+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
+
+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
+
+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
+
+infix 4 ~==
+(~==) :: Double -> Double -> Bool
+x ~== y = abs (x-y) < 5e-8
}