module Main where
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Data.List
import Data.Ord
import qualified Data.Set as S
import qualified Data.PartialOrd as PO
import Test.HUnit ((@?=))
main :: IO ()
main = defaultMain tests
tests :: [Test.Framework.Test]
tests =
[ testGroup "Number Properties"
[
testProperty "Int"
(prop_num :: Integer -> Integer -> Bool)
, testProperty "Integer"
(prop_num :: Int -> Int -> Bool)
, testProperty "Double"
(prop_num :: Double -> Double -> Bool)
, testProperty "Float"
(prop_num :: Float -> Float -> Bool)
]
, testGroup "List Properties"
[
testProperty "=="
(\ a b -> compareBinFuns (equal isSublistOf) (PO.==)
(a :: [Int]) (b :: [Int]))
, testProperty "== (sort)"
(\ a -> let a' = sort a :: [Int]
in compareBinFuns (equal isSublistOf) (PO.==)
(reverse a') a')
, testProperty "/="
(\ a b -> compareBinFuns (notEqual isSublistOf) (PO./=)
(a :: [Int]) (b :: [Int]))
, testProperty "<="
(\ a b -> compareBinFuns isSublistOf (PO.<=)
(a :: [Int]) (b :: [Int]))
, testProperty ">="
(\ a b -> compareBinFuns (geq isSublistOf) (PO.>=)
(a :: [Int]) (b :: [Int]))
, testProperty "<"
(\ a b -> compareBinFuns (less isSublistOf) (PO.<)
(a :: [Int]) (b :: [Int]))
, testProperty ">"
(\ a b -> compareBinFuns (greater isSublistOf) (PO.>)
(a :: [Int]) (b :: [Int]))
, testProperty "transitivity"
(\ a b c -> prop_trans (a :: [Int])
(b :: [Int])
(c :: [Int]))
, testProperty "antisymmetry"
(\ a b -> prop_antisymmetry (a :: [Int]) (b :: [Int]))
]
, testGroup "Set Properties"
[
testProperty "=="
(\ a b -> compareBinFuns (equal S.isSubsetOf) (PO.==)
(a :: S.Set Int) (b :: S.Set Int))
, testProperty "/="
(\ a b -> compareBinFuns (notEqual S.isSubsetOf) (PO./=)
(a :: S.Set Int) (b :: S.Set Int))
, testProperty "<="
(\ a b -> compareBinFuns S.isSubsetOf (PO.<=)
(a :: S.Set Int) (b :: S.Set Int))
, testProperty ">="
(\ a b -> compareBinFuns (geq S.isSubsetOf) (PO.>=)
(a :: S.Set Int) (b :: S.Set Int))
, testProperty "<"
(\ a b -> compareBinFuns (less S.isSubsetOf) (PO.<)
(a :: S.Set Int) (b :: S.Set Int))
, testProperty ">"
(\ a b -> compareBinFuns (greater S.isSubsetOf) (PO.>)
(a :: S.Set Int) (b :: S.Set Int))
, testProperty "transitivity"
(\ a b c -> prop_trans (a :: S.Set Int)
(b :: S.Set Int)
(c :: S.Set Int))
, testProperty "antisymmetry"
(\ a b -> prop_antisymmetry (a :: S.Set Int) (b :: S.Set Int))
]
, testGroup "Maxima & Minima"
[
testProperty "maxima exist"
(prop_extrema_exist (PO.maxima :: [Int] -> [Int]))
, testProperty "minima exist"
(prop_extrema_exist (PO.minima :: [Int] -> [Int]))
, testProperty "minima are minimal"
(prop_extrema_extremal (PO.minima :: [[Int]] -> [[Int]]) isSuplistOf)
, testProperty "maxima are maximal"
(prop_extrema_extremal (PO.maxima :: [[Int]] -> [[Int]]) isSublistOf)
, testProperty "Unique maximum for Ord types"
(prop_unique_extremum (PO.maxima :: [Int] -> [Int]) maximum)
, testProperty "Unique minimum for Ord types"
(prop_unique_extremum (PO.minima :: [Int] -> [Int]) minimum)
]
, testGroup "Known Extrema"
(map (\ (idx, extrema) ->
let label = "extremal cases (" ++ show idx ++ ")"
in testCase label (test_known_extrema extrema))
(zip [1..] knownExtrema))
]
test_known_extrema :: PO.PartialOrd a => ([a], [a], [a]) -> IO ()
test_known_extrema (as, asMax, asMin) =
((equal isSublistOf) (PO.maxima as) asMax
&& (equal isSublistOf) (PO.minima as) asMin) @?= True
knownExtrema :: [([[Int]], [[Int]], [[Int]])]
knownExtrema = [ ( [ [], [1, 2, 3], [4, 5], [], [4, 5]
, [3, 4], [0], [0, 1, 2, 3, 4, 6] ]
, [ [ 0, 1, 2, 3, 4, 6], [4, 5] ]
, [ [] ] )
, ( [ [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] ]
, [ [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] ]
, [ [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] ] )
, ( []
, []
, [] )
, ( [ [ 1, 2 ], [ 2, 1 ] ]
, [ [ 1, 2 ] ]
, [ [ 1, 2 ] ] )
, ( [ [ 1, 2 ], [ 2, 3 ] ]
, [ [ 1, 2 ], [ 2, 3 ] ]
, [ [ 1, 2 ], [ 2, 3 ] ] )
, ( [ [ 0 ], [ 0, 0 ] ]
, [ [ 0 ] ]
, [ [ 0 ] ] )
, ( [ [ 1 ], [ 1 ], [ 1 ] ]
, [ [ 1 ] ]
, [ [ 1 ] ] )
, ( [ [ ], [ -1, -2, -3 ] ]
, [ [ -3, -2, -1 ] ]
, [ [ ] ] )
]
prop_trans :: PO.PartialOrd a => a -> a -> a -> Bool
prop_trans a b c =
case (a PO.<= b, b PO.<= c) of
(True, True) -> a PO.<= c
_ -> True
prop_antisymmetry :: PO.PartialOrd a => a -> a -> Bool
prop_antisymmetry a b =
if a PO.<= b
then a PO.== b || not (a PO.>= b)
else True
prop_unique_extremum :: Ord a => ([a] -> [a]) -> ([a] -> a) -> [a] -> Bool
prop_unique_extremum _ _ [] = True
prop_unique_extremum computeExtrema computeExtremum as =
case computeExtrema as of
[extremum] -> extremum == computeExtremum as
_ -> False
prop_extrema_extremal :: Eq a =>
([a] -> [a]) -> (a -> a -> Bool) -> [a] -> Bool
prop_extrema_extremal computeExtrema relation as =
let extrema = computeExtrema as
extrema' = filter (isBiggerExtremum extrema) as
in null extrema'
where -- Returns True if a < a' where a' is in extrema.
isBiggerExtremum extrema a =
notNull $ filter (\ e -> (less relation) e a) extrema
notNull = not . null
prop_extrema_exist :: Eq a => ([a] -> [a]) -> [a] -> Bool
prop_extrema_exist f as =
null as || (not . null) (f as)
prop_num :: (Num a, Ord a) => a -> a -> Bool
prop_num x y =
case x `compare` y of
LT -> x < y
GT -> x > y
EQ -> x == y
-- Check if two given binary functions agree on the given input.
compareBinFuns :: Eq c =>
(a -> b -> c) -> (a -> b -> c) -> a -> b -> Bool
compareBinFuns f g a b = (a `f` b) == (a `g` b)
-- Implement equality given less-or-equal relation.
equal :: (a -> a -> Bool) -> a -> a -> Bool
equal leq a b = a `leq` b && b `leq` a
-- Implement inequality given less-or-equal relation.
notEqual :: (a -> a -> Bool) -> a -> a -> Bool
notEqual leq a b = not $ equal leq a b
-- Implement greater-or-equal given a less-or-equal relation.
geq :: (a -> a -> Bool) -> a -> a -> Bool
geq = flip
-- Implement strictly-less given a less or-equal relation.
less :: (a -> a -> Bool) -> a -> a -> Bool
less leq a b = (a `leq` b) && notEqual leq a b
-- Implement strictly-greater given less-or-equal relation.
greater :: (a -> a -> Bool) -> a -> a -> Bool
greater leq a b = less leq b a
-- Check if each element of the first list is also an element of the
-- second list.
isSublistOf :: PO.PartialOrd a => [a] -> [a] -> Bool
isSublistOf [] bs = True
isSublistOf (a:as) bs = a `PO.elem` bs && as `isSublistOf` bs
-- Check if each element of the second list is also an element of the
-- first list.
isSuplistOf :: PO.PartialOrd a => [a] -> [a] -> Bool
isSuplistOf = flip isSublistOf