-- | Tests for dynamic word vectors
{-# LANGUAGE CPP, BangPatterns, ForeignFunctionInterface #-}
module Tests.WordVec where
--------------------------------------------------------------------------------
import Control.Monad
import Data.Word
import Data.Bits
import Data.Maybe
import Data.List as L
import Data.Vector.Compact.WordVec as V
import Data.Vector.Compact.Blob as B
import Foreign.C.Types
import Test.Tasty
import Test.Tasty.HUnit
import System.Random
import System.IO.Unsafe as Unsafe
--------------------------------------------------------------------------------
-- the fuck, we are almost writing 2020 here, why am i doing this?!....
#ifdef x86_64_HOST_ARCH
arch_bits = 64
#elif i386_HOST_ARCH
arch_bits = 32
#elif i686_HOST_ARCH
arch_bits = 32
#elif aarch64_HOST_ARCH
arch_bits = 64
#else
arch_bits = 32
#endif
--------------------------------------------------------------------------------
-- helper functions
listMax :: [Word] -> Word
listMax [] = 0
listMax xs = L.maximum xs
listLongZipWith :: (Word -> Word -> a) -> [Word] -> [Word] -> [a]
listLongZipWith f = go where
go (x:xs) (y:ys) = f x y : go xs ys
go (x:xs) [] = f x 0 : go xs []
go [] (y:ys) = f 0 y : go [] ys
go [] [] = []
--------------------------------------------------------------------------------
cmpStrict_naive :: WordVec -> WordVec -> Ordering
cmpStrict_naive x y = case compare (vecLen x) (vecLen y) of
LT -> LT
GT -> GT
EQ -> compare (toList x) (toList y)
cmpExtZero_naive :: WordVec -> WordVec -> Ordering
cmpExtZero_naive x y = go (toList x) (toList y) where
go (x:xs) (y:ys) = case compare x y of
LT -> LT
GT -> GT
EQ -> go xs ys
go (x:xs) [] = go (x:xs) [0]
go [] (y:ys) = go [0] (y:ys)
go [] [] = EQ
--------------------------------------------------------------------------------
bitsNeededForHs :: Word -> Int
bitsNeededForHs = roundBits . bitsNeededForHs'
bitsNeededForHs' :: Word -> Int
bitsNeededForHs' bound
| bound == 0 = 1 -- this is handled incorrectly by the formula below
| bound+1 == 0 = arch_bits -- MACHINE_WORD_BITS -- and this handled incorrectly because of overflow
| otherwise = ceilingLog2 (bound + 1) -- for example, if maximum is 16, log2 = 4 but we need 5 bits
where
-- | Smallest integer @k@ such that @2^k@ is larger or equal to @n@
ceilingLog2 :: Word -> Int
ceilingLog2 0 = 0
ceilingLog2 n = 1 + go (n-1) where
go 0 = -1
go k = 1 + go (shiftR k 1)
-- apparently, the C implementation is _not_ faster...
bitsNeededForC :: Word -> Int
bitsNeededForC = fromIntegral . export_required_bits . fromIntegral
bitsNeededForC' :: Word -> Int
bitsNeededForC' = fromIntegral . export_required_bits_not_rounded . fromIntegral
foreign import ccall unsafe "export_required_bits_not_rounded" export_required_bits_not_rounded :: Word64 -> CInt
foreign import ccall unsafe "export_required_bits" export_required_bits :: Word64 -> CInt
--------------------------------------------------------------------------------
-- * Naive, reference implementations
-- | Another implementation of 'toList', for testing purposes only
toList_extract :: WordVec -> [Word]
toList_extract dynvec@(WordVec blob) =
case isSmall of
True -> [ B.extractSmallWord bits blob ( 8 + bits*i) | i<-[0..len-1] ]
False -> [ B.extractSmallWord bits blob (32 + bits*i) | i<-[0..len-1] ]
where
(isSmall, Shape len bits) = vecShape' dynvec
--------------------------------------------------------------------------------
tail_v1 :: WordVec -> WordVec
tail_v1 dynvec
| len == 0 = empty
| otherwise = fromList' (Shape (len-1) bits) (L.tail $ toList dynvec)
where
(Shape len bits) = vecShape dynvec
uncons_v1 :: WordVec -> Maybe (Word,WordVec)
uncons_v1 vec
| len == 0 = Nothing
| otherwise = Just $ case toList vec of { (w:ws) -> (w , fromList' (Shape (len-1) bits) ws) }
where
(Shape len bits) = vecShape vec
cons_v1 :: Word -> WordVec -> WordVec
cons_v1 w vec = fromList' shape' (w : toList vec) where
(Shape len bits) = vecShape vec
bits' = max bits (bitsNeededFor w)
shape' = Shape (len+1) bits'
snoc_v1 :: WordVec -> Word -> WordVec
snoc_v1 vec w = fromList' shape' (toList vec ++ [w]) where
(Shape len bits) = vecShape vec
bits' = max bits (bitsNeededFor w)
shape' = Shape (len+1) bits'
tail_v2 = V.tail
cons_v2 = V.cons
snoc_v2 = V.snoc
uncons_v2 = V.uncons
--------------------------------------------------------------------------------
null_naive :: WordVec -> Bool
null_naive v = (vecLen v == 0)
tail_naive :: WordVec -> WordVec
tail_naive vec = if V.null vec
then empty
else fromList $ L.tail $ V.toList vec
-- | For testing purposes only
uncons_naive :: WordVec -> Maybe (Word,WordVec)
uncons_naive vec = if V.null vec
then Nothing
else Just (V.head vec, tail_naive vec)
add_naive :: WordVec -> WordVec -> WordVec
add_naive vec1 vec2 = V.fromList $ listLongZipWith (+) (V.toList vec1) (V.toList vec2)
sub_naive :: WordVec -> WordVec -> Maybe WordVec
sub_naive vec1 vec2 = case and (listLongZipWith (>=) (V.toList vec1) (V.toList vec2)) of
True -> Just $ V.fromList $ listLongZipWith (-) (V.toList vec1) (V.toList vec2)
False -> Nothing
scale_naive :: Word -> WordVec -> WordVec
scale_naive s = V.fromList . L.map (*s) . V.toList
partialSums_naive :: WordVec -> WordVec
partialSums_naive = V.fromList . L.tail . L.scanl' (+) 0 . V.toList
--------------------------------------------------------------------------------
all_tests = testGroup "tests for WordVec-s"
[ tests_unit
, tests_small
, tests_rnd
, tests_bighead
]
tests_unit = testGroup "misc unit tests"
[ testCase "equality with different bit sizes" $ assertBool "failed" $ check_eq_bitsizes
, testCase "head of empty == 0" $ assertBool "failed" $ (V.head V.empty == 0)
, testCase "last of empty == 0" $ assertBool "failed" $ (V.last V.empty == 0)
, testCase "tail of empty == empty" $ assertBool "failed" $ (V.tail V.empty == V.empty)
, testCase "bitsNeededFor C vs. ref" $ forall_ around_powers_of_two (\k -> bitsNeededForHs k == bitsNeededForC k)
, testCase "bitsNeededFor' C vs. ref" $ forall_ around_powers_of_two (\k -> bitsNeededForHs' k == bitsNeededForC' k)
, testCase "cons_v2 crash (left-shift) is fixed" $ assertBool "failed" $ cons_v2_crash
]
-- [ k | k<-around_powers_of_two, bitsNeededFor' k /= bitsNeededForReference' k ]
tests_small = testGroup "unit tests for small dynamic word vectors"
[ testGroup "conversion, basic operations (small)"
[ testCase "toList . fromList == id" $ forall_ small_Lists prop_from_to_list
, testCase "fromList . toList == id" $ forall_ small_Vecs prop_to_from_vec
, testCase "fromList vs. indexing" $ forall_ small_Lists prop_fromlist_vs_index
, testCase "toList vs. naive" $ forall_ small_Vecs prop_tolist_vs_naive
, testCase "toRevList == reverse . toList" $ forall_ small_Vecs prop_toRevList
, testCase "vec head vs. list head" $ forall_ small_NELists prop_head_of_list
, testCase "vec last vs. list last" $ forall_ small_NELists prop_last_of_list
, testCase "vec tail vs. list tail" $ forall_ small_NEVecs prop_tail_of_list
, testCase "tail_v1 vs. tail_v2" $ forall_ small_Vecs prop_tail_v1_vs_v2
, testCase "cons_v1 vs. cons_v2" $ forall_ small_cons prop_cons_v1_vs_v2
, testCase "snoc_v1 vs. snoc_v2" $ forall_ small_cons prop_snoc_v1_vs_v2
, testCase "uncons_v1 vs. uncons_v2" $ forall_ small_Vecs prop_uncons_v1_vs_v2
, testCase "head vs. indexing" $ forall_ small_NEVecs prop_head_vs_index
, testCase "cons . uncons == id" $ forall_ small_NEVecs prop_cons_uncons
, testCase "uncons . cons == id" $ forall_ small_cons prop_uncons_cons
, testCase "uncons vs. naive" $ forall_ small_Vecs prop_uncons_vs_naive
, testCase "uncons vs. list" $ forall_ small_Vecs prop_uncons_vs_list
, testCase "cons vs. list" $ forall_ small_cons prop_cons_vs_list
, testCase "snoc vs. list" $ forall_ small_cons prop_snoc_vs_list
]
, testGroup "\"advanced\" operations (small)"
[ testCase "sum vs. list" $ forall_ small_Vecs prop_sum_vs_list
, testCase "max vs. list" $ forall_ small_Vecs prop_max_vs_list
, testCase "strict equality vs. list" $ forall_ small_pairs prop_strict_eq_vs_list
, testCase "strict comparison vs. list" $ forall_ small_pairs prop_strict_cmp_vs_list
, testCase "ext0 equality vs. list" $ forall_ small_pairs prop_ext0_eq_vs_list
, testCase "ext0 comparison vs. list" $ forall_ small_pairs prop_ext0_cmp_vs_list
, testCase "less or equal vs. list" $ forall_ small_pairs prop_less_or_equal_vs_list
, testCase "add vs. naive" $ forall_ small_pairs prop_add_vs_naive
, testCase "sub vs. naive" $ forall_ small_pairs prop_sub_vs_naive
, testCase "add is commutative" $ forall_ small_pairs prop_add_commutative
, testCase "partial sums vs. naive" $ forall_ small_Vecs prop_psums_vs_naive
, testCase "scale 3 vs. naive" $ forall_ small_Vecs (prop_scale_vs_naive 3)
, testCase "scale 14 vs. naive" $ forall_ small_Vecs (prop_scale_vs_naive 14)
, testCase "scale 254 vs. naive" $ forall_ small_Vecs (prop_scale_vs_naive 254)
, testCase "scale 65000 vs. naive" $ forall_ small_Vecs (prop_scale_vs_naive 65000)
]
]
tests_rnd = testGroup "tests for random dynamic word vectors"
[ testGroup "conversion, basic operations (random)"
[ testCase "toList . fromList == id" $ forall_ rnd_Lists prop_from_to_list
, testCase "fromList . toList == id" $ forall_ rnd_Vecs prop_to_from_vec
, testCase "fromList vs. indexing" $ forall_ rnd_Lists prop_fromlist_vs_index
, testCase "toList vs. naive" $ forall_ rnd_Vecs prop_tolist_vs_naive
, testCase "toRevList == reverse . toList" $ forall_ rnd_Vecs prop_toRevList
, testCase "vec head vs. list head" $ forall_ rnd_NELists prop_head_of_list
, testCase "vec last vs. list last" $ forall_ rnd_NELists prop_last_of_list
, testCase "vec tail vs. list tail" $ forall_ rnd_NEVecs prop_tail_of_list
, testCase "tail_v1 vs. tail_v2" $ forall_ rnd_Vecs prop_tail_v1_vs_v2
, testCase "cons_v1 vs. cons_v2" $ forall_ rnd_cons prop_cons_v1_vs_v2
, testCase "snoc_v1 vs. snoc_v2" $ forall_ rnd_cons prop_snoc_v1_vs_v2
, testCase "uncons_v1 vs. uncons_v2" $ forall_ rnd_Vecs prop_uncons_v1_vs_v2
, testCase "head vs. indexing" $ forall_ rnd_NEVecs prop_head_vs_index
, testCase "cons . uncons == id" $ forall_ rnd_NEVecs prop_cons_uncons
, testCase "uncons . cons == id" $ forall_ rnd_cons prop_uncons_cons
, testCase "uncons vs. naive" $ forall_ rnd_Vecs prop_uncons_vs_naive
, testCase "uncons vs. list" $ forall_ rnd_Vecs prop_uncons_vs_list
, testCase "cons vs. list" $ forall_ rnd_cons prop_cons_vs_list
, testCase "snoc vs. list" $ forall_ rnd_cons prop_snoc_vs_list
]
, testGroup "\"advanced\" operations (random)"
[ testCase "sum vs. list" $ forall_ rnd_Vecs prop_sum_vs_list
, testCase "max vs. list" $ forall_ rnd_Vecs prop_max_vs_list
, testCase "strict equality vs. list" $ forall_ rnd_pairs prop_strict_eq_vs_list
, testCase "strict comparison vs. list" $ forall_ rnd_pairs prop_strict_cmp_vs_list
, testCase "ext0 equality vs. list" $ forall_ rnd_pairs prop_ext0_eq_vs_list
, testCase "ext0 comparison vs. list " $ forall_ rnd_pairs prop_ext0_cmp_vs_list
, testCase "less or equal vs. list" $ forall_ rnd_pairs prop_less_or_equal_vs_list
, testCase "add vs. naive" $ forall_ rnd_pairs prop_add_vs_naive
, testCase "sub vs. naive" $ forall_ rnd_pairs prop_sub_vs_naive
, testCase "add is commutative" $ forall_ rnd_pairs prop_add_commutative
, testCase "partial sums vs. naive" $ forall_ rnd_Vecs prop_psums_vs_naive
, testCase "scale 3 vs. naive" $ forall_ rnd_Vecs (prop_scale_vs_naive 3)
, testCase "scale 14 vs. naive" $ forall_ rnd_Vecs (prop_scale_vs_naive 14)
, testCase "scale 254 vs. naive" $ forall_ rnd_Vecs (prop_scale_vs_naive 254)
, testCase "scale 65000 vs. naive" $ forall_ rnd_Vecs (prop_scale_vs_naive 65000)
]
]
tests_bighead = testGroup "unit tests for small dynamic word vectors with big heads"
[ testGroup "conversion, basic operations (big head)"
[ testCase "toList . fromList == id" $ forall_ bighead_Lists prop_from_to_list
, testCase "fromList . toList == id" $ forall_ bighead_Vecs prop_to_from_vec
, testCase "fromList vs. indexing" $ forall_ bighead_Lists prop_fromlist_vs_index
, testCase "toList vs. naive" $ forall_ bighead_Vecs prop_tolist_vs_naive
, testCase "toRevList == reverse . toList" $ forall_ bighead_Vecs prop_toRevList
, testCase "vec head vs. list head" $ forall_ bighead_NELists prop_head_of_list
, testCase "vec last vs. list last" $ forall_ bighead_NELists prop_last_of_list
, testCase "vec tail vs. list tail" $ forall_ bighead_NEVecs prop_tail_of_list
, testCase "tail_v1 vs. tail_v2" $ forall_ bighead_Vecs prop_tail_v1_vs_v2
, testCase "cons_v1 vs. cons_v2" $ forall_ bighead_cons prop_cons_v1_vs_v2
, testCase "snoc_v1 vs. snoc_v2" $ forall_ bighead_cons prop_snoc_v1_vs_v2
, testCase "uncons_v1 vs. uncons_v2" $ forall_ bighead_Vecs prop_uncons_v1_vs_v2
, testCase "head vs. indexing" $ forall_ bighead_NEVecs prop_head_vs_index
, testCase "cons . uncons == id" $ forall_ bighead_NEVecs prop_cons_uncons
, testCase "uncons . cons == id" $ forall_ bighead_cons prop_uncons_cons
, testCase "uncons vs. naive" $ forall_ bighead_Vecs prop_uncons_vs_naive
, testCase "uncons vs. list" $ forall_ bighead_Vecs prop_uncons_vs_list
, testCase "cons vs. list" $ forall_ bighead_cons prop_cons_vs_list
, testCase "snoc vs. list" $ forall_ bighead_cons prop_snoc_vs_list
]
, testGroup "\"advanced\" operations (big head)"
[ testCase "sum vs. list" $ forall_ bighead_Vecs prop_sum_vs_list
, testCase "max vs. list" $ forall_ bighead_Vecs prop_max_vs_list
, testCase "strict equality vs. list" $ forall_ bighead_pairs prop_strict_eq_vs_list
, testCase "strict comparison vs. list" $ forall_ bighead_pairs prop_strict_cmp_vs_list
, testCase "ext0 equality vs. list" $ forall_ bighead_pairs prop_ext0_eq_vs_list
, testCase "ext0 comparison vs. list " $ forall_ bighead_pairs prop_ext0_cmp_vs_list
, testCase "less or equal vs. list" $ forall_ bighead_pairs prop_less_or_equal_vs_list
, testCase "add vs. naive" $ forall_ bighead_pairs prop_add_vs_naive
, testCase "sub vs. naive" $ forall_ bighead_pairs prop_sub_vs_naive
, testCase "add is commutative" $ forall_ bighead_pairs prop_add_commutative
, testCase "partial sums vs. naive" $ forall_ bighead_Vecs prop_psums_vs_naive
, testCase "scale 3 vs. naive" $ forall_ bighead_Vecs (prop_scale_vs_naive 3)
, testCase "scale 14 vs. naive" $ forall_ bighead_Vecs (prop_scale_vs_naive 14)
, testCase "scale 254 vs. naive" $ forall_ bighead_Vecs (prop_scale_vs_naive 254)
, testCase "scale 65000 vs. naive" $ forall_ bighead_Vecs (prop_scale_vs_naive 65000)
]
]
forall_ :: [a] -> (a -> Bool) -> Assertion
forall_ xs cond = assertBool "failed" (and (map cond xs))
--------------------------------------------------------------------------------
-- * inputs
randomSublistIO :: Double -> [a] -> IO [a]
randomSublistIO prob xs = catMaybes <$> mapM f xs where
f !x = do
s <- randomRIO (0,1)
if (s < prob)
then return (Just x)
else return Nothing
{-# NOINLINE randomSublist #-}
randomSublist :: Double -> [a] -> [a]
randomSublist prob xs = Unsafe.unsafePerformIO (randomSublistIO prob xs)
newtype List = List [Word] deriving Show
newtype NEList = NEList [Word] deriving Show
newtype Vec = Vec WordVec deriving Show
newtype NEVec = NEVec WordVec deriving Show
small_Lists :: [List]
small_Lists = List [] : [ List xs | NEList xs <- small_NELists ]
small_NELists :: [NEList]
small_NELists = [ NEList [ofs..ofs+len-1] | ofs<-[0..25] , len<-[1..65] ]
small_Vecs :: [Vec]
small_Vecs = [ Vec (V.fromList xs) | List xs <- small_Lists ]
small_NEVecs :: [NEVec]
small_NEVecs = [ NEVec (V.fromList xs) | NEList xs <- small_NELists ]
small_cons :: [(Word,Vec)]
small_cons = [ (x, Vec (V.fromList xs)) | NEList (x:xs) <- small_NELists ]
smaller_Vecs :: [Vec]
smaller_Vecs = randomSublist 0.25 small_Vecs
small_pairs :: [(Vec,Vec)]
small_pairs = [ (u,v) | u <- smaller_Vecs , v <- smaller_Vecs ]
--------------------------------------------------------------------------------
randomVec :: Int -> Int -> IO Vec
randomVec maxlen maxbits = do
len <- randomRIO (0,maxlen )
bits <- randomRIO (0,maxbits)
let bnd = 2^bits - 1
xs <- replicateM len (randomRIO (0,bnd))
-- print (bnd,xs)
return $ Vec $ V.fromListN len bnd xs
{-# NOINLINE rnd_Vecs #-}
rnd_Vecs :: [Vec]
rnd_Vecs = L.concat $ L.concat $ Unsafe.unsafePerformIO $ do
forM [1,5..100] $ \len -> do
forM [4,8..64] $ \maxbits -> do
let k = maxbits -- for smaller bit depths, we need less test cases
replicateM k (randomVec len maxbits)
rnd_Lists = [ List (V.toList vec) | Vec vec <- rnd_Vecs ]
rnd_NELists = [ NEList l | List l <- rnd_Lists , not (L.null l) ]
rnd_NEVecs = [ NEVec v | Vec v <- rnd_Vecs , not (V.null v) ]
rnd_cons = [ (x, Vec (V.fromList xs)) | NEList (x:xs) <- rnd_NELists ]
smaller_rnd_Vecs :: [Vec]
smaller_rnd_Vecs = randomSublist 0.025 rnd_Vecs
rnd_pairs :: [(Vec,Vec)]
rnd_pairs = [ (u,v) | u <- smaller_rnd_Vecs , v <- smaller_rnd_Vecs ]
--------------------------------------------------------------------------------
add_bighead :: List -> [List]
add_bighead (List xs) =
[ List (2^k-1 : xs) | k<-[1..arch_bits-1] ] ++
[ List (2^k : xs) | k<-[1..arch_bits-1] ] ++
[ List (2^k+1 : xs) | k<-[1..arch_bits-1] ]
bighead_Lists_orig = concatMap add_bighead small_Lists :: [List]
bighead_Lists = randomSublist 0.25 bighead_Lists_orig :: [List]
bighead_Vecs = [ Vec (V.fromList xs) | List xs <- bighead_Lists ] :: [Vec]
bighead_NELists = [ NEList xs | List xs <- bighead_Lists ] :: [NEList]
bighead_NEVecs = [ NEVec v | Vec v <- bighead_Vecs ] :: [NEVec]
bighead_cons = [ (x, Vec (V.fromList xs)) | NEList (x:xs) <- bighead_NELists ]
smaller_bighead_Vecs :: [Vec]
smaller_bighead_Vecs = randomSublist 0.01 bighead_Vecs
bighead_pairs :: [(Vec,Vec)]
bighead_pairs = [ (u,v) | u <- smaller_bighead_Vecs , v <- smaller_bighead_Vecs ]
--------------------------------------------------------------------------------
-- * misc tests
-- cons fatal error (caused by non-strict left shift of blobs):
cons_v2_crash = V.toList (cons_v2 x xs) == [159407,244557,137175,96511,42979] where
(x, Vec xs) = (159407, Vec (fromList' (Shape {shapeLen = 4, shapeBits = 20}) [244557,137175,96511,42979]))
check_eq_bitsizes = and
[ V.fromList [k] == V.fromList' (Shape 1 b) [k]
| k<-[0..15]
, b<-[4..31]
]
around_powers_of_two :: [Word]
around_powers_of_two = [0..7] ++ stuff ++ [2^nn-i | i<-[1..8] ] where
stuff = [ 2^i + fromIntegral ofs | i<-[2..nn-1] , ofs <- [-2..2::Int] ]
nn = {- 64 -} arch_bits
--------------------------------------------------------------------------------
-- * properties
prop_from_to_list (List list) = V.toList (V.fromList list) == list
prop_to_from_vec (Vec vec ) = V.fromList (V.toList vec ) == vec
prop_tolist_vs_naive (Vec vec) = (V.toList vec == toList_extract vec)
prop_toRevList (Vec vec) = V.toRevList vec == reverse (V.toList vec)
prop_fromlist_vs_index (List list) = [ unsafeIndex i vec | i<-[0..n-1] ] == list where
vec = V.fromList list
n = V.vecLen vec
prop_head_of_list (NEList list) = V.head (V.fromList list) == L.head list
prop_last_of_list (NEList list) = V.last (V.fromList list) == L.last list
prop_tail_of_list (NEVec vec ) = V.toList (V.tail vec) == L.tail (V.toList vec)
prop_head_vs_index (NEVec vec ) = V.head vec == unsafeIndex 0 vec
prop_cons_uncons (NEVec vec) = liftM (uncurry V.cons) (V.uncons vec) == Just vec
prop_uncons_cons (w,Vec vec) = V.uncons (V.cons w vec) == Just (w,vec)
prop_uncons_vs_naive (Vec vec) = V.uncons vec == uncons_naive vec
prop_uncons_vs_list (Vec vec) = unconsToList (V.uncons vec) == L.uncons (V.toList vec)
prop_cons_vs_list (w,Vec vec) = V.toList (V.cons w vec) == w : (V.toList vec)
prop_snoc_vs_list (w,Vec vec) = V.toList (V.snoc vec w) == (V.toList vec) ++ [w]
unconsToList mb = case mb of
Nothing -> Nothing
Just (w,vec) -> Just (w, V.toList vec)
--------------------------------------------------------------------------------
prop_tail_v1_vs_v2 (Vec vec) = tail_v1 vec == tail_v2 vec
prop_cons_v1_vs_v2 (y,(Vec vec)) = cons_v1 y vec == cons_v2 y vec
prop_snoc_v1_vs_v2 (y,(Vec vec)) = snoc_v1 vec y == snoc_v2 vec y
prop_uncons_v1_vs_v2 (Vec vec ) = uncons_v1 vec == uncons_v2 vec
{-
bad_tail = [ vec | Vec vec <- bighead_Vecs , tail_v1 vec /= tail_v2 vec ]
bad_cons = [ (y,vec) | (y,Vec vec) <- bighead_cons , cons_v1 y vec /= cons_v2 y vec ]
bad_cons_uncons = [ vec | NEVec vec <- bighead_NEVecs , liftM (uncurry V.cons) (V.uncons vec) /= Just vec ]
-}
bad_snoc = [ (y,vec) | (y,Vec vec) <- small_cons , snoc_v1 vec y /= snoc_v2 vec y ]
--------------------------------------------------------------------------------
prop_max_vs_list (Vec vec) = V.maximum vec == listMax (V.toList vec)
prop_sum_vs_list (Vec vec) = V.sum vec == L.sum (V.toList vec)
{-
bad_max = [ vec | v@(Vec vec) <- bighead_Vecs , not (prop_max_vs_list v) ]
bad_sum = [ vec | v@(Vec vec) <- bighead_Vecs , not (prop_sum_vs_list v) ]
-}
--------------------------------------------------------------------------------
-- TODO: randomized tests for these
eqListExt0 :: [Word] -> [Word] -> Bool
eqListExt0 xs ys = and (listLongZipWith (==) xs ys)
leListExt0 :: [Word] -> [Word] -> Bool
leListExt0 xs ys = and (listLongZipWith (<=) xs ys)
prop_strict_eq_vs_list (Vec vec1 , Vec vec2) = eqStrict vec1 vec2 == (V.toList vec1 == V.toList vec2)
prop_strict_cmp_vs_list (Vec vec1 , Vec vec2) = cmpStrict vec1 vec2 == (vec1 `cmpStrict_naive` vec2)
prop_ext0_eq_vs_list (Vec vec1 , Vec vec2) = eqExtZero vec1 vec2 == eqListExt0 (V.toList vec1) (V.toList vec2)
prop_ext0_cmp_vs_list (Vec vec1 , Vec vec2) = cmpExtZero vec1 vec2 == (vec1 `cmpExtZero_naive` vec2)
prop_less_or_equal_vs_list (Vec vec1 , Vec vec2) = lessOrEqual vec1 vec2 == leListExt0 (V.toList vec1) (V.toList vec2)
--------------------------------------------------------------------------------
prop_add_commutative (Vec vec1 , Vec vec2) = V.add vec1 vec2 == V.add vec2 vec1
prop_add_vs_naive (Vec vec1 , Vec vec2) = V.add vec1 vec2 == add_naive vec1 vec2
prop_sub_vs_naive (Vec vec1 , Vec vec2) = V.subtract vec1 vec2 == sub_naive vec1 vec2
-- bad_add = [ (bad1,bad2) | (Vec bad1, Vec bad2) <- bighead_pairs , not (prop_add_vs_naive (Vec bad1 , Vec bad2)) ]
prop_psums_vs_naive (Vec vec) = V.partialSums vec == partialSums_naive vec
prop_scale_vs_naive s (Vec vec) = V.scale s vec == scale_naive s vec
bad_psums = [ bad | Vec bad <- bighead_Vecs , not (prop_psums_vs_naive (Vec bad)) ]
bad_scale3 = [ bad | Vec bad <- bighead_Vecs , not (prop_scale_vs_naive 3 (Vec bad)) ]
--------------------------------------------------------------------------------