data-ordlist-0.4.4: test/data-list-ordered-tests.hs

module Main where

import qualified Data.List as List
import Data.List.Ordered
import Test.QuickCheck
import Test.QuickCheck.Arbitrary

prop_member :: NonNegative Int -> Positive Int -> Bool
prop_member (NonNegative n) (Positive d)
    = member n [0,d..] == (n `mod` d == 0)

prop_insertBag_sort       :: [Int] -> Bool
prop_insertBag_sort    xs = foldr insertBag [] xs == sort xs

prop_insertSet_nubSort    :: [Int] -> Bool
prop_insertSet_nubSort xs = foldr insertSet [] xs == nubSort xs

prop_nub :: OrderedList Int -> Bool
prop_nub (Ordered xs) =  List.nub xs == nub xs

prop_nub_isSorted :: [Int] -> Bool
prop_nub_isSorted xs = isSortedBy (<) (nub xs)

prop_nubSort_isSorted :: [Int] -> Bool
prop_nubSort_isSorted xs = isSortedBy (<) (nubSort xs)

prop_isect_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_isect_subset (Ordered xs) (Ordered ys)
    =  let zs = isect xs ys
        in zs `subset` xs && zs `subset` ys

prop_isect_examples
    =  isect  [1,2,3,4] [3,4,5,6]   == [3,4]
    && isect  [1,3,5]   [2,4,6]     == []
    && isect  [2,4,6,8] [3,6,9]     == [6]
    && isect  [1,2,2,2] [1,1,1,2,2] == [1,2,2]

prop_union_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_union_subset (Ordered xs) (Ordered ys)
    =  let zs = union xs ys
        in xs `subset` zs && ys `subset` zs

prop_isect_subset_union :: OrderedList Int -> OrderedList Int -> Bool
prop_isect_subset_union (Ordered xs) (Ordered ys)
    =  isect xs ys `subset` union xs ys

prop_union_examples
    =  union  [1,2,3,4] [3,4,5,6]   == [1..6]
    && union  [1,3,5]   [2,4,6]     == [1..6]
    && union  [2,4,6,8] [3,6,9]     == [2,3,4,6,8,9]
    && union  [1,2,2,2] [1,1,1,2,2] == [1,1,1,2,2,2]

prop_minus_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_minus_subset (Ordered xs) (Ordered ys)
    =  minus xs ys `subset` xs

prop_minus_examples
    =  minus  [1,2,3,4] [3,4,5,6]   == [1,2]
    && minus  [1,3,5]   [2,4,6]     == [1,3,5]
    && minus  [2,4,6,8] [3,6,9]     == [2,4,8]
    && minus  [1,2,2,2] [1,1,1,2,2] == [2]

prop_xunion_subset_union :: OrderedList Int -> OrderedList Int -> Bool
prop_xunion_subset_union (Ordered xs) (Ordered ys)
    =  xunion xs ys `subset` union xs ys

prop_merge_xunion_isect_union :: OrderedList Int -> OrderedList Int -> Bool
prop_merge_xunion_isect_union  (Ordered xs) (Ordered ys)
    = merge (xunion xs ys) (isect xs ys) == union xs ys

prop_merge_union_isect_merge :: OrderedList Int -> OrderedList Int -> Bool
prop_merge_union_isect_merge  (Ordered xs) (Ordered ys)
    = merge (union xs ys) (isect xs ys) == merge xs ys

prop_minus_merge_isect_union :: OrderedList Int -> OrderedList Int -> Bool
prop_minus_merge_isect_union (Ordered xs) (Ordered ys)
    = minus (merge xs ys) (isect xs ys) == union xs ys

prop_minus_union_isect_xunion :: OrderedList Int -> OrderedList Int -> Bool
prop_minus_union_isect_xunion (Ordered xs) (Ordered ys)
    = minus (union xs ys) (isect xs ys) == xunion xs ys

prop_xunion_examples
    =  xunion [1,2,3,4] [3,4,5,6]   == [1,2,5,6]
    && xunion [1,3,5]   [2,4,6]     == [1..6]
    && xunion [2,4,6,8] [3,6,9]     == [2,3,4,8,9]
    && xunion [1,2,2,2] [1,1,1,2,2] == [1,1,2]

prop_merge_subset :: OrderedList Int -> OrderedList Int -> Bool
prop_merge_subset (Ordered xs) (Ordered ys)
    =  union xs ys `subset` merge xs ys

prop_merge_examples
    =  merge [1,2,3,4] [3,4,5,6]   == [1,2,3,3,4,4,5,6]
    && merge [1,3,5]   [2,4,6]     == [1,2,3,4,5,6]
    && merge [2,4,6,8] [3,6,9]     == [2,3,4,6,6,8,9]
    && merge [1,2,2,2] [1,1,1,2,2] == [1,1,1,1,2,2,2,2,2]

prop_nub_examples
    =  nub [1,1,1,2,2] == [1,2]
    && nub [2,0,1,3,3] == [2,3]

safeHead []    = Nothing
safeHead (a:_) = Just a

newtype HeadOrderedLists x = HeadOrdered [[x]] deriving (Eq, Ord, Show, Read)

instance (Ord a, Arbitrary a) => Arbitrary (HeadOrderedLists a) where
   arbitrary =  (HeadOrdered . sortOn' safeHead . map sort) `fmap` arbitrary
   shrink _ = []

prop_mergeAll :: HeadOrderedLists Int -> Bool
prop_mergeAll (HeadOrdered xss)
    = foldr merge [] xss == mergeAll xss

approxEq xs ys = take n xs == take n ys
  where n = 1000

triangle n = replicate n n ++ triangle (n+1)

prop_mergeAll_productive = mergeAll [ [n..] | n <- [1..] ] `approxEq` triangle 1

prop_unionAll :: HeadOrderedLists Int -> Bool
prop_unionAll (HeadOrdered xss)
    = foldr union [] xss == unionAll xss

prop_unionAll_productive = unionAll [ [n..] | n <- [1..] ] `approxEq` [1..]

quickCheckOnce = quickCheckWith (stdArgs {maxSuccess = 1})

main = do
   putStr "\nprop_member\n"
   quickCheck prop_member

   putStr "\nprop_insertBag_sort\n"
   quickCheck prop_insertBag_sort

   putStr "\nprop_insertSet_nubSort\n"
   quickCheck prop_insertSet_nubSort

   putStr "\nprop_nub\n"
   quickCheck prop_nub

   putStr "\nprop_nub_isSorted\n"
   quickCheck prop_nub_isSorted

   putStr "\nprop_nubSort_isSorted\n"
   quickCheck prop_nubSort_isSorted

   putStr "\nprop_isect_subset\n"
   quickCheck prop_isect_subset

   putStr "\nprop_isect_examples\n"
   quickCheckOnce prop_isect_examples

   putStr "\nprop_union_subset\n"
   quickCheck prop_union_subset

   putStr "\nprop_isect_subset_union\n"
   quickCheck prop_isect_subset_union

   putStr "\nprop_union_examples\n"
   quickCheckOnce prop_union_examples

   putStr "\nprop_minus_subset\n"
   quickCheck prop_minus_subset

   putStr "\nprop_minus_examples\n"
   quickCheckOnce prop_minus_examples

   putStr "\nprop_xunion_subset_union\n"
   quickCheck prop_xunion_subset_union

   putStr "\nprop_merge_xunion_isect_union\n"
   quickCheck prop_merge_xunion_isect_union

   putStr "\nprop_merge_union_isect_merge\n"
   quickCheck prop_merge_union_isect_merge

   putStr "\nprop_minus_merge_isect_union\n"
   quickCheck prop_minus_merge_isect_union

   putStr "\nprop_minus_union_isect_xunion\n"
   quickCheck prop_minus_union_isect_xunion

   putStr "\nprop_xunion_examples\n"
   quickCheckOnce prop_xunion_examples

   putStr "\nprop_merge_subset\n"
   quickCheck prop_merge_subset

   putStr "\nprop_merge_examples\n"
   quickCheckOnce prop_merge_examples

   putStr "\nprop_nub_examples\n"
   quickCheckOnce prop_nub_examples

   putStr "\nprop_mergeAll\n"
   quickCheck prop_mergeAll

   putStr "\nprop_mergeAll_productive\n"
   quickCheckOnce  prop_mergeAll_productive

   putStr "\nprop_unionAll\n"
   quickCheck prop_unionAll

   putStr "\nprop_unionAll_productive\n"
   quickCheckOnce prop_unionAll_productive