1 {-# LANGUAGE BangPatterns #-}
3 -- | The Misc module contains helper functions that seem out of place
16 import qualified Data.Vector as V ( Vector, elem, empty, filter )
17 import Test.Tasty ( TestTree, testGroup )
18 import Test.Tasty.HUnit ( Assertion, assertEqual, testCase )
19 import Test.Tasty.QuickCheck ( Property, (==>), testProperty )
22 -- | The standard factorial function. See
23 -- <http://www.willamette.edu/~fruehr/haskell/evolution.html> for
24 -- possible improvements.
34 factorial :: Int -> Int
40 | otherwise = go (acc * i) (i - 1)
42 -- | Takes a three-dimensional list, and flattens it into a
43 -- one-dimensional one.
47 -- >>> flatten [ [[1,2], [3,4]], [[5,6], [7,8]] ]
50 flatten :: [[[a]]] -> [a]
51 flatten xs = concat $ concat xs
54 -- | Switch the x and z dimensions of a three-dimensional list.
55 transpose_xz :: [[[a]]] -> [[[a]]]
57 transpose_xz [[]] = [[]]
58 transpose_xz [[[]]] = [[[]]]
60 [[[ m !! x !! y !! z | x <- [0..xsize]]
64 zsize = (length m) - 1
65 ysize = length (head m) - 1
66 xsize = length (head $ head m) - 1
68 -- | Takes a list, and returns True if its elements are pairwise
69 -- equal. Returns False otherwise.
71 -- Only used in tests.
73 all_equal :: (Eq a) => [a] -> Bool
74 all_equal [] = True -- Vacuously
75 all_equal (x:xs) = all (== x) xs
79 -- | Returns 'True' if the vectors xs and ys are disjoint, 'False'
84 -- >>> let xs = Data.Vector.fromList [1,2,3]
85 -- >>> let ys = Data.Vector.fromList [4,5,6]
89 -- >>> let ys = Data.Vector.fromList [3,4,5]
93 -- Only used in tests.
95 disjoint :: (Eq a) => V.Vector a -> V.Vector a -> Bool
97 intersect xs ys == V.empty
99 intersect :: (Eq a) => V.Vector a -> V.Vector a -> V.Vector a
101 V.filter (`V.elem` zs) ws
103 prop_factorial_greater :: Int -> Property
104 prop_factorial_greater n =
105 n <= 20 ==> factorial n >= n
108 test_flatten1 :: Assertion
110 assertEqual "flatten actually works" expected_list actual_list
112 target = [[[1::Int]], [[2, 3]]]
113 expected_list = [1, 2, 3]
114 actual_list = flatten target
117 misc_tests :: TestTree
119 testGroup "Misc tests" [
120 testCase "flatten (1)" test_flatten1 ]
123 misc_properties :: TestTree
125 testGroup "Misc properties" [
126 testProperty "factorial greater" prop_factorial_greater ]