content: {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
  
  module Set5bTest where
  
  import Data.List
  import Data.Maybe
  import Test.QuickCheck
  
  import Mooc.Th
  import Mooc.Test
  
  import Set5b
  
  main = score tests
  
  tests = [(1,"valAtRoot",[ex1_valAtRoot_Nothing, ex1_valAtRoot_Just])
          ,(2,"treeSize",[ex2_treeSize])
          ,(3,"treeMax",[ex3_small, ex3_large])
          ,(4,"allValues",[ex4_small, ex4_large])
          ,(5,"mapTree",[ex5_small, ex5_large])
          ,(6,"cull",[ex6_small, ex6_large])
          ,(7,"isOrdered",[ex7_small, ex7_large])
          ,(8,"walk",[ex8_small, ex8_large])
          ,(9,"set",[ex9_small, ex9_medium, ex9_large])
          ,(10,"search",[ex10_small, ex10_large])
          ]
  
  -- -- -- -- -- -- -- --
  
  
  treeOfSize :: Arbitrary a => Int -> Gen (Tree a)
  treeOfSize 0 = return Empty
  treeOfSize siz = do
    let siz' = siz-1
    sizl <- choose (0,siz')
    let sizr = siz'-sizl
    l <- treeOfSize sizl
    r <- treeOfSize sizr
    v <- arbitrary
    return $ Node v l r
  
  ex1_valAtRoot_Nothing = $(testing [|valAtRoot (Empty :: Tree Bool)|]) (?== (Nothing :: Maybe Bool))
  
  ex1_valAtRoot_Just = property $ do
    l <- treeOfSize 2 :: Gen (Tree Integer)
    r <- treeOfSize 2 :: Gen (Tree Integer)
    v <- choose (0,10 :: Integer)
    let t = Node v l r
    return $ $(testing [|valAtRoot t|]) (?== Just v)
  
  ex2_treeSize =
    forAllShrink_ (choose (0,50)) $ \s ->
    forAllBlind (treeOfSize s :: Gen (Tree Integer)) $ \t ->
      $(testing [|treeSize t|]) (?==s)
  
  treeAndMax :: Int -> Gen (Int, Tree Int)
  treeAndMax 0 = return (0,Empty)
  treeAndMax d = do
    (lmax,l) <- treeAndMax (d-1)
    (rmax,r) <- treeAndMax (d-1)
    v <- choose (0,20)
    return (maximum [lmax,rmax,v], (Node v l r))
  
  m_ex3 depth = forAllBlind (treeAndMax depth) $ \(m,tree) ->
    $(testing [|treeMax tree|]) (?==m)
  
  ex3_small = conjoin [m_ex3 0
                      ,m_ex3 1
                      ,m_ex3 2]
  ex3_large = conjoin [m_ex3 3
                      ,m_ex3 4]
  
  tree3 a b c = Node b (Node a Empty Empty) (Node c Empty Empty)
  tree7 [a,b,c,d,e,f,g] = Node d (tree3 a b c) (tree3 e f g)
  
  
  ex4_small = property $ do
    ~[a,b,c] <- vectorOf 3 (choose (0,4::Int))
    let input = tree3 a b c
        out = all (>0) [a,b,c]
    return $ counterexample ("allValues (>0) "++show' input) $ allValues (>0) input ?== out
  
  ex4_large = property $ do
    vals <- vectorOf 7 (choose (0,8::Int))
    let input = tree7 vals
        out = all (>1) vals
    return $ counterexample ("allValues (>0) "++show' input) $ allValues (>1) input ?== out
  
  ex5_small = property $ do
    ~[a,b,c] <- vectorOf 3 (choose (0,4::Int))
    let input = tree3 a b c
        output = tree3 (a+1) (b+1) (c+1)
    return $ counterexample ("mapTree (+1) "++show' input) $ mapTree (+1) input ?== output
  
  linearLeft [] = Empty
  linearLeft (x:xs) = Node x (linearLeft xs) Empty
  
  linearRight [] = Empty
  linearRight (x:xs) = Node x Empty (linearRight xs)
  
  ex5_large = property $ do
    cs <- listOf1 (choose ('a','c'))
    ds <- listOf1 (choose ('a','c'))
    e <- choose ('a','c')
    let input = Node e (linearRight cs) (linearLeft ds)
        f = (=='a')
        output = Node (f e) (linearRight $ map f cs) (linearLeft $ map f ds)
    return $ counterexample ("mapTree (=='a') "++show' input) $ mapTree (=='a') input ?== output
  
  treeWithout :: (Eq a, Arbitrary a) => Int -> a -> Gen (Tree a)
  treeWithout 0 _ = return Empty
  treeWithout depth v = oneof [return Empty
                              ,do l <- treeWithout (depth-1) v
                                  r <- treeWithout (depth-1) v
                                  v' <- arbitrary `suchThat` (/=v)
                                  return $ Node v' l r]
  
  ex6_small = conjoin [$(testing [|cull 2 (Node 1 (Node 2 Empty Empty) (Node 0 Empty Empty))|])
                       (?==Node 1 Empty (Node 0 Empty Empty))
                      ,$(testing [|cull 3 (Node 1 (Node 2 Empty Empty) (Node 0 Empty Empty))|])
                       (?==Node 1 (Node 2 Empty Empty) (Node 0 Empty Empty))
                      ,$(testing [|cull 0 (Node 1 (Node 0 Empty (Node 2 Empty Empty)) (Node 3 Empty (Node 0 Empty Empty)))|])
                       (?==Node 1 Empty (Node 3 Empty Empty))]
  
  replaceLeaf :: Tree a -> Tree a -> Gen (Tree a)
  replaceLeaf t Empty = return t
  replaceLeaf t (Node val l r) = oneof [fmap (\l' -> Node val l' r) (replaceLeaf t l)
                                       ,fmap (\r' -> Node val l r') (replaceLeaf t r)]
  
  
  ex6_large = property $ do
    v <- arbitrary :: Gen Int
    output <- treeWithout 3 v
    ~(Node _ l r) <- treeOfSize 3
    let addition = Node v l r
    input <- replaceLeaf addition output
    input2 <- replaceLeaf addition input
    return $ conjoin [$(testing [|cull v input|]) (?==output)
                     ,$(testing [|cull v input2|]) (?==output)]
  
  orderedTree :: Int -> (Int,Int) -> Gen (Tree Int)
  orderedTree 0 _ = return Empty
  orderedTree depth (min,max)
    | min<max = frequency [(1, return Empty)
                          ,(4, do v <- choose (min,max-1)
                                  l <- orderedTree (depth-1) (min,v)
                                  r <- orderedTree (depth-1) (v+1,max)
                                  return $ Node v l r)]
  orderedTree _ _ = return Empty
  
  try :: [Gen (Maybe a)] -> Gen (Maybe a)
  try [] = return $ Nothing
  try (g:gs) = do m <- g
                  if isJust m then return m else try gs
  
  breakOrder :: Tree Int -> Gen (Maybe (Tree Int))
  breakOrder Empty = return Nothing
  breakOrder (Node v Empty Empty) = return Nothing
  breakOrder (Node v l r) = try [do ml <- breakOrder l
                                    case ml of Nothing -> return Nothing
                                               Just l' -> return $ Just $ Node v l' r
                                ,do mr <- breakOrder r
                                    case mr of Nothing -> return Nothing
                                               Just r' -> return $ Just $ Node v l r'
                                ,return (Just (Node v r l))]
  
  m_ex7 depth = forAllBlind (orderedTree depth (0,100)) $ \t ->
    forAllBlind (breakOrder t) $ \b ->
    conjoin [$(testing [|isOrdered t|]) (?==True)
            ,isJust b ==> $(testing [|isOrdered (fromJust b)|]) (?==False)]
  
  ex7_small = conjoin [$(testing [|isOrdered (Empty::Tree Int)|]) (?==True)
                      ,forAllBlind (choose (0,10::Int)) $ \i -> $(testing [|isOrdered (Node i Empty Empty)|]) (?==True)
                      ,m_ex7 2]
  
  ex7_large = conjoin [m_ex7 3
                      ,m_ex7 4
                      ,m_ex7 5]
  
  
  pathAndTree :: (Eq a, Arbitrary a) => Int -> a -> Gen ([Step],Tree a)
  pathAndTree 0 v = return ([],Node v Empty Empty)
  pathAndTree depth v = oneof [do l <- treeWithout (depth-1) v
                                  v' <- arbitrary `suchThat` (/=v)
                                  (p,r) <- pathAndTree (depth-1) v
                                  return (StepR:p,Node v' l r)
                              ,do r <- treeWithout (depth-1) v
                                  v' <- arbitrary `suchThat` (/=v)
                                  (p,l) <- pathAndTree (depth-1) v
                                  return (StepL:p,Node v' l r)
                              ,do l <- treeWithout (depth-1) v
                                  r <- treeWithout (depth-1) v
                                  return ([],Node v l r)]
  
  m_ex8 d = forAll_ $ \(v::Int) ->
    forAllBlind (pathAndTree d v) $ \(p,t) ->
    $(testing [|walk p t|]) (?==Just v)
  
  ex8_small = conjoin [$(testing [|walk [StepL] (Empty :: Tree Char)|]) (?==Nothing)
                      ,forAll_ $ \(a::Int,b::Int,c::Int) ->
                          $(testing [|walk [StepL,StepR] (Node a (Node b Empty Empty) (Node c Empty Empty))|]) (?==Nothing)
                      ,m_ex8 0
                      ,m_ex8 1
                      ,m_ex8 2]
  
  ex8_large = conjoin [m_ex8 3
                      ,m_ex8 4
                      ,m_ex8 5]
  
  
  ex9_small = conjoin [$(testing [|set ([]::[Step]) 'a' (Empty::Tree Char)|]) (?==Empty)
                      ,$(testing [|set ([]::[Step]) True (Node False Empty Empty)|]) (?==Node True Empty Empty)
                      ,$(testing [|set [StepL] True (Node False Empty Empty)|]) (?==Node False Empty Empty)
                      ,$(testing [|set [StepL] True (Node False (Node False Empty Empty) Empty)|]) (?==Node False (Node True Empty Empty) Empty)]
  
  setList xs i v = before ++ v:after
    where (before,_:after) = splitAt i xs
  
  ex9_medium = property $ do
    vals <- vectorOf 7 (choose (0,10::Int))
    (i,path) <- elements [(0,[StepL,StepL])
                         ,(1,[StepL])
                         ,(2,[StepL,StepR])
                         ,(3,[])
                         ,(4,[StepR,StepL])
                         ,(5,[StepR])
                         ,(6,[StepR,StepR])]
    new <- choose (11,20::Int)
    let inp = tree7 vals
        vals' = setList vals i new
        out = tree7 vals'
    return $ $(testing [|set path new inp|]) (?==out)
  
  ex9_large = forAllShrink (choose (1,10)) shrinkPositive $ \len -> property $ do
    (dir,mk) <- elements [(StepL,linearLeft)
                         ,(StepR,linearRight)]
    cs <- vectorOf len (choose ('a','z'))
    i <- choose (0,len - 2)
    new <- choose ('a','z')
    return $ $(testing [|set (replicate i dir) new (mk cs)|]) (?==mk (setList cs i new))
  
  m_ex10_yes depth = forAll_ $ \(val::Int) ->
    forAllBlind (pathAndTree depth val) $ \(path,tree) ->
    $(testing [|search val tree|]) (?==Just path)
  
  m_ex10_no depth = forAll_ $ \(val::Int) ->
    forAllBlind (treeWithout depth val) $ \tree ->
    $(testing [|search val tree|]) (?==Nothing)
  
  ex10_small = conjoin [m_ex10_yes 0
                       ,m_ex10_no 0
                       ,m_ex10_yes 1
                       ,m_ex10_no 1
                       ,m_ex10_yes 2
                       ,m_ex10_no 2]
  
  ex10_large = conjoin [m_ex10_yes 3
                       ,m_ex10_no 3
                       ,m_ex10_yes 4
                       ,m_ex10_no 4
                       ,m_ex10_yes 5
                       ,m_ex10_no 5]
  