Lecture 12 — 2018-02-22

QuickCheck

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

Generators 

import Test.QuickCheck
import System.Random

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]
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]
instance Arbitrary a =>  Arbitrary (BST a) where
  arbitrary = bt

Testing properties

Check out the Testable type class.

sums_ok :: Int -> Int -> Bool
sums_ok n1 n2 = n1 + n2 == n2 + n1
sums_ok = forAll (arbitrary :: (Int,Int)) $ sum_ok
  where sum_ok :: Int -> Int -> Bool
        sum_ok (n1,n2) = n1 + n2 == n2 + n1

Size-bounded binary trees 

size :: BST a -> Int
size Empty = 0
size (Node l _ r) = 1 + size l + size r

sizedBT :: Arbitrary a => Int -> Gen (BST a)
sizedBT 0 = return Empty
sizedBT n = oneof
  [return Empty,
   Node <$> sizedBT (n `div` 2)
        <*> arbitrary
        <*> sizedBT (n `div` 2)]

bt' :: Arbitrary a => Gen (BST a)
bt' = sized sizedBT

prop_nonnegative_size :: BST a -> Bool
prop_nonnegative_size t = size t > 0

Generating BSTs

Here are the familiar BST operations.

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 x 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

We can directly generate BSTs by keeping track of their bounds.

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


maybeBounded :: Ord a => Maybe a -> Maybe a -> a -> Bool
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


isBST' :: Ord a => Maybe a -> Maybe a -> BST a -> Bool
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

isBST :: Ord a => BST a -> Bool
isBST t = isBST' Nothing Nothing t

One possible instance for Arbitrary BSTs:

instance (Ord a, Bounded a, Enum a, Random a) => Arbitrary (BST a) where
  arbitrary = boundedBST minBound maxBound

But we can do better: just reuse our BST operations to generate them.

bsts :: (Arbitrary a, Ord a) => Gen (BST a)
bsts = do
  vs <- listOf arbitrary
  return $ foldr insert Empty vs

instance (Arbitrary a, Ord a) => Arbitrary (BST a) where
  arbitrary = bsts

prop_insertFind :: Int -> BST Int -> Bool
prop_insertFind x t = find x (insert x t) == Just x

prop_insertFind' :: Property
prop_insertFind' =
  forAll arbitrary $ \x ->
  forAll bsts $ \t ->
    find x (insert x t) == Just (x::Int)