mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
207 lines
8.0 KiB
Haskell
207 lines
8.0 KiB
Haskell
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
|
|
|
module Set9aTest where
|
|
|
|
import Mooc.Test
|
|
import Mooc.Th
|
|
|
|
import Data.List
|
|
import Data.List.NonEmpty (NonEmpty)
|
|
import Test.QuickCheck
|
|
|
|
import Set9a
|
|
|
|
main = score tests
|
|
|
|
tests = [(1,"workload",[ex1_small, ex1_medium, ex1_big])
|
|
,(2,"echo",[ex2_examples, ex2_random])
|
|
,(3,"countValid",[ex3])
|
|
,(4,"repeated",[ex4_unrepeated_int, ex4_repeated_char, ex4_repeated_int])
|
|
,(5,"sumSuccess",[ex5])
|
|
,(6,"Lock",[ex6_examples, ex6_gen])
|
|
,(7,"Eq Text",[ex7])
|
|
,(8,"compose",[ex8_one_one, ex8_many_one, ex8_bijection, ex8_surjective])
|
|
,(9,"permute",[ex9_id, ex9_compose])
|
|
]
|
|
|
|
-- -- -- -- --
|
|
|
|
ex1_small = forAllBlind (choose (1,10)) $ \n ->
|
|
forAllBlind (choose (0,div 9 n)) $ \h ->
|
|
$(testing [|workload n h|]) (?=="Piece of cake!")
|
|
ex1_medium = forAllBlind (choose (1,20)) $ \n ->
|
|
forAllBlind (choose (div 10 n+1, div 99 n)) $ \h ->
|
|
counterexample (show (div 10 n+1, div 99 n)) $
|
|
$(testing [|workload n h|]) (?=="Ok.")
|
|
ex1_big = forAllBlind (choose (1,100)) $ \n ->
|
|
forAllBlind (choose (div 100 n+1,101)) $ \h ->
|
|
$(testing [|workload n h|]) (?=="Holy moly!")
|
|
|
|
ex2_examples = conjoin' [$(testing [|echo "hello!"|]) (?=="hello!, ello!, llo!, lo!, o!, !, ")
|
|
,$(testing [|echo "ECHO"|]) (?=="ECHO, CHO, HO, O, ")
|
|
,$(testing [|echo "X"|]) (?=="X, ")
|
|
,$(testing [|echo ""|]) (?=="")]
|
|
|
|
word = listOf1 (choose ('a','z'))
|
|
|
|
ex2_random = forAllBlind word $ \w ->
|
|
$(testing [|echo w|]) . was $ \v ->
|
|
conjoin [counterexample " number of ',' characters" $ (length (filter (==',') v)) ?== length w
|
|
,counterexample " length of string" $ length v ?== div (length w * (length w + 1)) 2 + 2 * length w
|
|
,let prefix = w ++ ", " ++ tail w in counterexample (" should start with "++show prefix) $ prefix `isPrefixOf` v]
|
|
|
|
|
|
digit = choose ('0','9')
|
|
|
|
valid = do
|
|
a <- digit
|
|
b <- digit
|
|
c <- digit
|
|
d <- digit
|
|
x <- digit
|
|
rest <- listOf digit
|
|
elements [a:b:x:c:x:d:rest
|
|
,a:b:c:x:d:x:rest]
|
|
|
|
invalid = do
|
|
a <- digit
|
|
b <- digit
|
|
c <- digit
|
|
d <- digit
|
|
e <- digit `suchThat` (/=c)
|
|
f <- digit `suchThat` (/=d)
|
|
rest <- listOf digit
|
|
return $ a:b:c:d:e:f:rest
|
|
|
|
ex3 = forAllShrinkBlind (listOf valid) subterms $ \vs ->
|
|
forAllShrinkBlind (listOf invalid) subterms $ \is ->
|
|
forAllBlind (shuffle (vs++is)) $ \ns ->
|
|
$(testing [|countValid ns|]) (?==length vs)
|
|
|
|
ex4_unrepeated_int = forAll_ $ \ls ->
|
|
$(testing [|repeated (nub (ls :: [Int]))|]) (?==Nothing)
|
|
|
|
ex4_repeated_char = forAllBlind (listOf1 (choose ('a','z'))) $ \cs' ->
|
|
let cs = nub cs'
|
|
in forAllBlind (choose (0,length cs - 1)) $ \i ->
|
|
let c = cs!!i
|
|
input = take i cs ++ c : drop i cs
|
|
in $(testing [|repeated input|]) (?==Just c)
|
|
|
|
ex4_repeated_int = forAll_ $ \(NonEmpty prefix') ->
|
|
forAll_ $ \suffix ->
|
|
let prefix = nub prefix'
|
|
chosen = last prefix :: Int
|
|
in $(testing [|repeated (prefix ++ chosen : suffix)|]) (?==Just chosen)
|
|
|
|
ex5 = property $ do
|
|
is <- arbitrary
|
|
ws <- listOf word
|
|
input <- shuffle (map Left ws ++ map Right is)
|
|
return $ $(testing [|sumSuccess input|]) (?==if null is then Left "no data" else Right (sum is))
|
|
|
|
ex6_examples = conjoin
|
|
[$(testing' [|isOpen aLock|]) (?== False)
|
|
,$(testing' [|isOpen (lock aLock)|]) (?== False)
|
|
,$(testing' [|isOpen (open "1234" aLock)|]) (?== True)
|
|
,$(testing' [|isOpen (lock (open "1234" aLock))|]) (?== False)
|
|
,$(testing' [|isOpen (open "1235" aLock)|]) (?== False)
|
|
,$(testing' [|isOpen (lock (open "1235" aLock))|]) (?== False)
|
|
,$(testing' [|isOpen (open "1234" (changeCode "0000" aLock))|]) (?== True)
|
|
,$(testing' [|isOpen (open "0000" (changeCode "0000" aLock))|]) (?== False)
|
|
,$(testing' [|isOpen (open "0000" (lock (changeCode "0000" (open "1234" aLock))))|]) (?== True)
|
|
,$(testing' [|isOpen (open "1234" (lock (changeCode "0000" (open "1234" aLock))))|]) (?== False)]
|
|
|
|
ex6_gen = property $ do
|
|
code <- vectorOf 5 digit
|
|
wrong <- vectorOf 5 digit `suchThat` (/=code)
|
|
return $
|
|
counterexample ("with code = " ++ show code) $
|
|
conjoin [$(testing' [|isOpen (changeCode code (open "1234" aLock))|]) (?== True)
|
|
,$(testing' [|isOpen (lock (changeCode code (open "1234" aLock)))|]) (?== False)
|
|
,$(testing' [|isOpen (lock (lock (changeCode code (open "1234" aLock))))|]) (?== False)
|
|
,$(testing' [|isOpen (open code (lock (changeCode code (open "1234" aLock))))|]) (?== True)
|
|
,$(testing' [|isOpen (open code (open code (lock (changeCode code (open "1234" aLock)))))|]) (?== True)]
|
|
.&&.
|
|
counterexample ("with wrong = " ++ show wrong)
|
|
(conjoin [$(testing' [|isOpen (open wrong (lock (changeCode code (open "1234" aLock))))|]) (?== False)
|
|
,$(testing' [|isOpen (open code (lock (changeCode code (changeCode wrong (open "1234" aLock)))))|]) (?== True)
|
|
,$(testing' [|isOpen (open wrong (lock (changeCode code (changeCode wrong (open "1234" aLock)))))|]) (?== False)
|
|
,$(testing' [|isOpen (open wrong (open code (lock (changeCode code (open "1234" aLock)))))|]) (?== True)
|
|
,$(testing' [|isOpen (open code (open wrong (lock (changeCode code (open "1234" aLock)))))|]) (?== True)])
|
|
|
|
spacify [] = elements [" ","\n",""]
|
|
spacify (c:cs) = frequency [(8, fmap (c:) (spacify cs))
|
|
,(2, fmap (' ':) (spacify (c:cs)))
|
|
,(1, fmap ('\n':) (spacify (c:cs)))]
|
|
|
|
change [] = do
|
|
c <- choose ('a','z')
|
|
return [c]
|
|
change (c:cs) = oneof [fmap (:cs) $ choose ('a','z') `suchThat` (/=c)
|
|
,fmap (c:) $ change cs]
|
|
|
|
ex7 = $(withInstance "Eq" "Text" [|(==) :: Text -> Text -> Bool|]) $ \(==) ->
|
|
property $ do
|
|
bare <- word
|
|
v1 <- spacify bare
|
|
v2 <- spacify bare
|
|
wrong <- change v2
|
|
return $ conjoin [$(testing [|Text bare == Text v1|]) (?==True)
|
|
,$(testing [|Text v1 == Text bare|]) (?==True)
|
|
,$(testing [|Text v1 == Text v1|]) (?==True)
|
|
,$(testing [|Text v1 == Text v2|]) (?==True)
|
|
,$(testing [|Text wrong == Text v2|]) (?==False)
|
|
,$(testing [|Text bare == Text wrong|]) (?==False)]
|
|
|
|
ex8_one_one = forAll_ $ \(x::Int) ->
|
|
forAll_ $ \(y::Char) ->
|
|
forAll_ $ \(z::String) ->
|
|
$(testing [|compose [(x,y)] [(y,z)]|]) (?==[(x,z)])
|
|
|
|
ex8_many_one = forAll_ $ \(x::Int) ->
|
|
forAll_ $ \(y::String) ->
|
|
forAll_ $ \(z::Int) ->
|
|
forAll_ $ \pairs ->
|
|
let pairs' = (x,y):filter (\(k,v) -> k/=x && v/=y) pairs
|
|
in forAllBlind (shuffle pairs') $ \pairs'' ->
|
|
$(testing [|compose pairs'' [(y,z)]|]) (?==[(x,z)])
|
|
|
|
ex8_bijection = forAllShrink_ (choose (1,10)) $ \n ->
|
|
forAllBlind (shuffle [1..n::Int]) $ \ys ->
|
|
forAllBlind (shuffle [1..n::Int]) $ \zs ->
|
|
forAllBlind (shuffle (zip [1..n] ys)) $ \xys ->
|
|
forAllBlind (shuffle (zip ys zs)) $ \yzs ->
|
|
$(testing [|compose xys yzs|]) (hasElements (zip [1..n] zs))
|
|
|
|
ex8_surjective = forAllShrink_ (choose (2,5)) $ \n ->
|
|
forAllShrink_ (choose (2,5)) $ \k ->
|
|
forAllBlind (vector n) $ \(output::[Int]) ->
|
|
let xs = take (n*k) ['a'..]
|
|
xys = zip xs (cycle [1..n])
|
|
yzs = zip [1..n] output
|
|
expected = zip xs (cycle output)
|
|
in forAllBlind (shuffle xys) $ \xys' ->
|
|
forAllBlind (shuffle yzs) $ \yzs' ->
|
|
$(testing [|compose xys' yzs'|]) (hasElements expected)
|
|
|
|
ex9_id = property $ do
|
|
n <- choose (1,5)
|
|
let id = [(i,i) | i <- [0..n-1]]
|
|
xs <- shuffle (take n "abcdefghij")
|
|
return $ $(testing [|permute id xs|]) (?== xs)
|
|
|
|
ex9_compose = property $ do
|
|
n <- choose (2,5)
|
|
p <- return . zip [0..n-1] =<< shuffle [0..n-1]
|
|
q <- return . zip [0..n-1] =<< shuffle [0..n-1]
|
|
xs <- shuffle (take n "abcdefghij")
|
|
return $ counterexample
|
|
("permute (compose p q) xs == permute q (permute p xs) failed:\n\
|
|
\ p was " ++ show p ++ "\n q was " ++ show q ++ ", and\n xs \
|
|
\was " ++ show xs ++ ";\n permute (compose p q) xs evaluated to " ++
|
|
show (permute (compose p q) xs) ++ ",\n while \
|
|
\permute q (permute p xs) evaluated to " ++
|
|
show (permute q (permute p xs)))
|
|
(permute (compose p q) xs == permute q (permute p xs))
|