Lecture 16.0 — 2017-03-27

QuickCheck

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

import Test.QuickCheck
import System.Random

We spent 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 tried generating 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


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

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