mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
263 lines
9.6 KiB
Haskell
263 lines
9.6 KiB
Haskell
{-# 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]
|