mirror of
https://github.com/iritmaximus/haskell.git
synced 2026-10-12 19:13:39 +03:00
256 lines
9.1 KiB
Haskell
256 lines
9.1 KiB
Haskell
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
|
|
|
|
module Set3aTest where
|
|
|
|
--import Control.Monad
|
|
import Data.Char
|
|
import Data.List
|
|
import Test.QuickCheck
|
|
|
|
import Mooc.Th
|
|
import Mooc.Test
|
|
|
|
import Set3a
|
|
|
|
main = score tests
|
|
|
|
tests = [(1,"maxBy",[ex1_maxBy])
|
|
,(2,"mapMaybe",[ex2_mapMaybe_Nothing, ex2_mapMaybe_Just_String, ex2_mapMaybe_Just_Int])
|
|
,(3,"mapMaybe2",[ex3_mapMaybe2])
|
|
,(4,"palindromeHalfs",[ex4_palindromeHalfs])
|
|
,(5,"capitalize",[ex5_capitalize_1, ex5_capitalize_2])
|
|
,(6,"powers",[ex6_powers_small, ex6_powers_large])
|
|
,(7,"while",[ex7_while_number, ex7_while_string])
|
|
,(8,"whileRight",[ex8_whileRight_Left, ex8_whileRight_step])
|
|
,(9,"joinToLength",[ex9_1])
|
|
,(10,"+|+",[ex10])
|
|
,(11,"sumRights",[ex11])
|
|
,(12,"multiCompose",[ex12_empty, ex12_scalability, ex12_arithmetic, ex12_strings])
|
|
,(13,"multiApp",[ex13_empty, ex13_scalability, ex13_arithmetic, ex13_strings, ex13_mixed])
|
|
,(14,"interpreter",[ex14_interpreter_1, ex14_interpreter_2])
|
|
]
|
|
|
|
-- -- -- -- -- --
|
|
|
|
letter = choose ('a','z')
|
|
word = listOf1 letter
|
|
|
|
ex1_maxBy = property $ do
|
|
t <- choose (0,20)
|
|
f <- choose (0,20) `suchThat` \f -> f/=t
|
|
let p True = t
|
|
p False = f
|
|
return $
|
|
counterexample ("let p True = "++show t++"; p False = "++show f++" in maxBy p False True") $
|
|
maxBy p False True ?== (t>f)
|
|
|
|
ex2_mapMaybe_Nothing =
|
|
$(testing' [|mapMaybe negate Nothing|]) (?==Nothing)
|
|
|
|
ex2_mapMaybe_Just_String = forAllBlind word $ \w ->
|
|
counterexample ("mapMaybe length (Just " ++ show w ++ ")") $
|
|
mapMaybe length (Just w) ?== Just (length w)
|
|
|
|
ex2_mapMaybe_Just_Int = forAll_ $ \(i::Int) ->
|
|
counterexample ("mapMaybe negate (Just " ++ show i ++ ")") $
|
|
mapMaybe negate (Just i) ?== Just (negate i)
|
|
|
|
ex3_mapMaybe2 = forAll_ $ \(Positive i,Positive j) ->
|
|
let t :: Maybe Integer -> Maybe Integer -> Maybe Integer -> Property
|
|
t a b exp = counterexample ("mapMaybe div " ++ show' a ++ " " ++ show' b) $ mapMaybe2 div a b ?== exp
|
|
in conjoin [t (Just i) (Just j) (Just (div i j))
|
|
,t Nothing (Just j) Nothing
|
|
,t (Just i) Nothing Nothing
|
|
,t Nothing Nothing Nothing]
|
|
|
|
unpalindrome = word `suchThat` \w -> w /= reverse w
|
|
|
|
ex4_palindromeHalfs = property $ do
|
|
half1 <- word
|
|
let palindrome1 = half1 ++ reverse half1
|
|
half2 <- word
|
|
let palindrome2 = half2 ++ reverse (init half2)
|
|
un1 <- listOf1 unpalindrome
|
|
un2 <- listOf1 unpalindrome
|
|
un3 <- listOf1 unpalindrome
|
|
let input = un1 ++ [palindrome1] ++ un2 ++ [palindrome2] ++ un3
|
|
let expected = [half1, half2]
|
|
let palindromeHalfs xs = map firstHalf (filter palindrome xs)
|
|
return $ $(testing [|palindromeHalfs input|]) (?==expected)
|
|
|
|
ex5_capitalize_1 = property $ do
|
|
cap <- letter
|
|
w1 <- word
|
|
w2 <- word
|
|
return $ $(testing [|capitalize (cap:w1++" "++cap:w2)|]) (?==(toUpper cap:w1++" "++toUpper cap:w2))
|
|
|
|
ex5_capitalize_2 = property $ do
|
|
ws <- listOf1 word
|
|
let input = unwords ws
|
|
let positions = init $ scanl (+) 0 $ map (succ.length) ws
|
|
p <- elements positions
|
|
q <- elements [0..length input - 1]
|
|
return . $(testing [|capitalize input|]) $ \v ->
|
|
conjoin [counterexample ("char at index "++show p) $ v !! p ?== toUpper (input !! p)
|
|
,not (elem q positions) ==> counterexample ("char at index "++show q) (v !! q ?== input !! q)]
|
|
|
|
m_powers maxlen = property $ do
|
|
n <- choose (2,5)
|
|
len <- choose (1,maxlen)
|
|
end <- choose (n^(len-1),n^len-1)
|
|
return $ $(testing [|powers n end|]) $ \p -> conjoin
|
|
[counterexample "all smaller than end" $ all (<=end) p
|
|
,counterexample "in ascending order" $ p == sort p
|
|
,counterexample "length" $ length p ?== len
|
|
,counterexample "all powers of n" $ all (check n) p]
|
|
where check n 0 = True
|
|
check n 1 = True
|
|
check n k
|
|
| k `mod` n == 0 = check n (div k n)
|
|
| otherwise = False
|
|
|
|
ex6_powers_small = m_powers 5
|
|
ex6_powers_large = m_powers 27 -- 5^27 still fits in Int
|
|
|
|
ex7_while_number = property $ do
|
|
n <- choose (0,20 :: Integer)
|
|
return $ counterexample ("while (/="++show n++") (+1) 0") $ within timeLimit $
|
|
while (/=n) (+1) 0 ?== n
|
|
|
|
ex7_while_string = property $ do
|
|
n <- word
|
|
let w = n++n
|
|
p = (/=n)
|
|
return $ counterexample ("while (/="++show n++") tail "++show w) $ within timeLimit $
|
|
while p tail w == n
|
|
|
|
ex8_whileRight_Left = forAllBlind word $ \w ->
|
|
forAllBlind (choose (1::Int,10)) $ \i ->
|
|
counterexample ("let f _ = Left " ++ show w ++ " in whileRight f " ++ show i) $ within timeLimit $
|
|
let f _ = Left w in whileRight f i ?== w
|
|
|
|
ex8_whileRight_step = property $ do
|
|
let step :: Int -> Int -> Either Int Int
|
|
step k x = if x<k then Right (2*x) else Left x
|
|
limit <- choose (1,1000)
|
|
start <- elements [1,3,5]
|
|
let log = ceiling . logBase 2 . fromIntegral
|
|
divUp x y = ceiling (fromIntegral x / fromIntegral y)
|
|
answer = start * 2 ^ (log (limit `divUp` start))
|
|
return $ counterexample ("whileRight (step " ++ show limit ++ ") " ++ show start) $ within timeLimit $
|
|
whileRight (step limit) start ?== answer
|
|
|
|
ex9_1 = property $ do
|
|
w <- word
|
|
v <- word `suchThat` diffLength w
|
|
let target = length w + length v
|
|
cruft <- listOf1 word
|
|
let input = sort $
|
|
([w,v]++) $
|
|
nubBy (\x y -> length x + length y == target) $
|
|
filter (\x -> 2 * length x /= target) $
|
|
filter (\x -> diffLength x v && diffLength x w) $
|
|
cruft
|
|
output = [w++v, v++w]
|
|
return $ $(testing [|joinToLength target input|]) (hasElements output)
|
|
where diffLength a b = length a /= length b
|
|
|
|
ex10 = $(withDefined "+|+") $ \op ->
|
|
forAll_ $ \(x::Int,y::Int,xs'::[Int],ys'::[Int]) ->
|
|
let xs = x:xs'
|
|
ys = y:ys'
|
|
in conjoin [counterexample (show xs ++ " +|+ " ++ show ys) $ op xs ys ?== [x,y]
|
|
,counterexample (show xs ++ " +|+ []") $ op xs [] ?== [x]
|
|
,counterexample ("[] +|+ " ++ show xs) $ op [] xs ?== [x]]
|
|
|
|
ex11 = property $ do
|
|
is <- listOf (choose (0,10))
|
|
es <- listOf word
|
|
input <- shuffle (map Right is ++ map Left es)
|
|
return $ $(testing [|sumRights input|]) (?==sum is)
|
|
|
|
ex12_empty = property $ do
|
|
n <- choose (0,9) :: Gen Int
|
|
let input = multiCompose [] n
|
|
output = n
|
|
return $ counterexample ("multiCompose [] " ++ show n)
|
|
$ input ?== output
|
|
|
|
ex12_scalability = property $ do
|
|
n <- choose (0,9) :: Gen Int
|
|
let input = multiCompose (replicate n (succ::Int->Int)) 0
|
|
output = n
|
|
return $ counterexample ("multiCompose (replicate " ++ show n ++ " succ) 0")
|
|
$ input ?== output
|
|
|
|
ex12_arithmetic = property $ do
|
|
n <- choose (0,5) :: Gen Int
|
|
let input = multiCompose [(3*), (^2), (+1)] n
|
|
output = ((3*) . (^2) . (+1)) n
|
|
return $ counterexample ("multiCompose [(3*), (^2), (+1)] " ++ show n)
|
|
$ input ?== output
|
|
|
|
ex12_strings = property $ do
|
|
s <- listOf letter `suchThat` (\t -> length t > 1)
|
|
let input = multiCompose [(++"xy"), reverse, tail, reverse] s
|
|
output = (++"xy") . reverse . tail . reverse $ s
|
|
return $ counterexample ("multiCompose [(++\"xy\"), reverse, tail, reverse] " ++ show s)
|
|
$ input ?== output
|
|
|
|
ex13_empty = property $ do
|
|
n <- choose (0,9) :: Gen Int
|
|
let input = multiApp id [] n
|
|
output = [] :: [Int]
|
|
return $ counterexample ("multiApp id [] " ++ show n)
|
|
$ input ?== output
|
|
|
|
ex13_scalability = property $ do
|
|
n <- choose (0,9) :: Gen Int
|
|
k <- choose (0,9) :: Gen Int
|
|
let input = multiApp (sum::[Int]->Int) (replicate n (succ::Int->Int)) k
|
|
output = n*(k+1)
|
|
return $ counterexample ("multiApp sum (replicate " ++ show n ++ " succ) " ++ show k)
|
|
$ input ?== output
|
|
|
|
ex13_arithmetic = property $ do
|
|
n <- choose (0,9) :: Gen Int
|
|
let gs = [(+1), (*2), (`div`2), (^2)]
|
|
input = multiApp (sum::[Int]->Int) gs n
|
|
output = (n + 1) + (n * 2) + (n `div` 2) + n^2
|
|
return $ counterexample ("multiApp sum [(+1), (*2), (`div`2), (^2)]" ++ show n)
|
|
$ input ?== output
|
|
|
|
ex13_strings = property $ do
|
|
words <- vectorOf 3 word
|
|
let gs = [(\xs -> [head xs]), tail, reverse]
|
|
input = multiApp id gs words
|
|
output = [[head words], tail words, reverse words]
|
|
return $ counterexample ("multiApp id [(\\xs -> [head xs]), tail, reverse]" ++ show words)
|
|
$ input ?== output
|
|
|
|
ex13_mixed = counterexample ("multiApp sum [head, last] [1,2,3,4]") $
|
|
multiApp (sum::[Int]->Int) [head, last] [1::Int,2,3,4] ?== 5
|
|
|
|
ex14_interpreter_1 = property $ do
|
|
up <- choose (0,10)
|
|
right <- choose (0,10)
|
|
down <- choose (1,3)
|
|
left <- choose (0,1)
|
|
|
|
let first = replicate up "up" ++ replicate right "right" ++ ["printY","printX"]
|
|
second = replicate down "down" ++ replicate left "left" ++ ["printY","printX"]
|
|
input = first ++ second
|
|
output = [show up, show right, show (up-down), show (right-left)]
|
|
|
|
return $ counterexample ("interpreter "++show input) $
|
|
interpreter input ?== output
|
|
|
|
ex14_interpreter_2 = property $ do
|
|
nums <- vectorOf 4 $ choose (0,10)
|
|
let diffs = zipWith (-) nums (0:nums)
|
|
f x | x<0 = replicate (negate x) "down"
|
|
| otherwise = replicate x "up"
|
|
input = concatMap (\x -> f x ++ ["printY"]) diffs
|
|
output = map show nums
|
|
return $ $(testing [|interpreter input|]) (?== output)
|