Lecture 12 — 2017-10-05

Do notation; QuickCheck

This lecture is written in literate Haskell; you can download the raw source.

do notation

Haskell’s do notation is a concise way of writing monadic (and therefore applicative or functorial) computations. Compare contrast:

                                 do
action1 >>= \res1 ->   VS      res1 <- action1
action2 >>                     action2
let x = g res1 in              let x = g res 1
action3 >>= \res3 ->           res3 <- action3
action4 (f g res3)             action4 (f g res3)

More concretely, here are two bits of code for swapping array cells, one in bind notation and the other in do notation.

swap arr i1 i2 =
  readArray arr i1 >>= \v1 ->
  readArray arr i2 >>= \v2 ->
  writeArray arr i1 v2 >>
  writeArray arr i2 v1

swap arr i1 i2 = do
  v1 <- readArray arr i1
  v2 <- readArray arr i2
  writeArray arr i1 v2
  writeArray arr i2 v1

QuickCheck 

import Test.QuickCheck
import System.Random

We spent the last bit class talking about QuickCheck. First, we saw the Gen monad for generating random values. The sample :: Show a => Gen a -> IO () and sample' :: Gen a -> IO [a] functions were useful here.

evenBelowTen :: Gen Int
evenBelowTen = elements [0,2,4,6,8]

fiveNums :: Gen [Int]
fiveNums = do
  n1 <- evenBelowTen
  n2 <- evenBelowTen
  n3 <- evenBelowTen
  n4 <- evenBelowTen
  n5 <- evenBelowTen
  return [n1,n2,n3,n4,n5]

Next, we wrote some properties. for example, we can check that addition is commutative by taking the following property “for all n1 and n2”:

sums_ok :: Int -> Int -> Bool
sums_ok n1 n2 = n1 + n2 == n2 + n1

and running quickCheck sums_ok.

Next we played with generating binary trees:

data BST a = Empty | Node (BST a) a (BST a) deriving (Eq, Show)

bt :: Arbitrary a => Gen (BST a)
bt = oneof [return Empty,
            Node <$> bt <*> arbitrary <*> bt]

The Arbitrary type class is the piece of magic that lets quickCheck work, by giving it a default generator of random values.

instance Arbitrary a =>  Arbitrary (BST a) where
  arbitrary = bt

We can generate arbitrary binary search trees:

isBST :: Ord a => BST a -> Bool
isBST t = isBST' Nothing Nothing t
 where isBST' lower upper Empty = True
       isBST' lower upper (Node l x r) =
           maybeBounded lower upper x &&
           isBST' lower (Just x) l &&
           isBST' (Just x) upper r
       maybeBounded Nothing Nothing x = True
       maybeBounded Nothing (Just upper) x = x < upper
       maybeBounded (Just lower) Nothing x = lower < x
       maybeBounded (Just lower) (Just upper) x = lower < x && x < upper

boundedBST :: (Arbitrary a, Ord a, Random a, Enum a) => a -> a -> Gen (BST a)
boundedBST lo hi | lo >= hi = return Empty
boundedBST lo hi =
  oneof [return Empty,
         do
           v <- choose (lo,hi)
           l <- boundedBST lo (pred v)
           r <- boundedBST (succ v) hi
           return $ Node l v r]

bsts :: (Arbitrary a, Bounded a, Ord a, Random a, Enum a) => Gen (BST a)
bsts = boundedBST minBound maxBound

We can test it out:

all_ok = forAll (bsts :: Gen (BST Int)) isBST

And then we con go further, testing some real BST functions:

insert x Empty = Node Empty x Empty
insert x (Node l y r) | x < y  = Node (insert x l) y r
                      | x == y = Node l y r
                      | x > y  = Node l y (insert x r)

delete x Empty = Empty
delete x (Node l y r)
  | x < y  = Node (delete x l) y r
  | x > y  = Node l y (delete x r)
  | x == y = case (l,r) of
               (Empty, _) -> r
               (l, Empty) -> l
               _          -> let (min, r') = deleteMin r in
                             Node l min r'
  where deleteMin Empty = error "nope"
        deleteMin (Node Empty x r) = (x,r)
        deleteMin (Node l x r) =
          let (min, l') = deleteMin l in
          (min, Node l' x r)

find _ Empty = Nothing
find v (Node l x r)
  | v < x  = v `find` l
  | v == x = Just x
  | v > x  = v `find` r

Here’s a different way of genering BSTs, as proposed by Evan in class: just use the existing functions!

bsts' :: (Arbitrary a, Ord a) => Gen (BST a)
bsts' = listOf arbitrary >>= return . foldr insert Empty

There are pros and cons to the above. The biggest negative is that if we’re not confident in our insert function, then who knows what we’ll get out. But in general, this is a great way of generating complex data structures.

here are some other BST properties we can check.

insertFind :: Int -> BST Int -> Bool
insertFind x t = (find x $ insert x t) /= Nothing

insertValid :: Int -> Property
insertValid x = forAll bt $ \t -> isBST t ==> isBST $ insert x t

insertValid' :: Int -> Property
insertValid' x = forAll bsts $ \t -> isBST $ insert x t

insertValid'' :: Int -> Property
insertValid'' x = forAll bsts' $ \t -> isBST $ insert x t