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
38 go :: Int -> Int -> Int
41 | otherwise = go (acc * i) (i - 1)
43 -- | Takes a three-dimensional list, and flattens it into a
44 -- one-dimensional one.
48 -- >>> flatten [ [[1,2], [3,4]], [[5,6], [7,8]] ]
51 flatten :: [[[a]]] -> [a]
52 flatten xs = concat $ concat xs
55 -- | Switch the x and z dimensions of a three-dimensional list.
56 transpose_xz :: [[[a]]] -> [[[a]]]
58 transpose_xz [[]] = [[]]
59 transpose_xz [[[]]] = [[[]]]
61 [[[ m !! x !! y !! z | x <- [0..xsize]]
65 zsize = (length m) - 1
66 ysize = length (head m) - 1
67 xsize = length (head $ head m) - 1
69 -- | Takes a list, and returns True if its elements are pairwise
70 -- equal. Returns False otherwise.
72 -- Only used in tests.
74 all_equal :: (Eq a) => [a] -> Bool
75 all_equal [] = True -- Vacuously
76 all_equal (x:xs) = all (== x) xs
80 -- | Returns 'True' if the vectors xs and ys are disjoint, 'False'
85 -- >>> let xs = Data.Vector.fromList [1,2,3]
86 -- >>> let ys = Data.Vector.fromList [4,5,6]
90 -- >>> let ys = Data.Vector.fromList [3,4,5]
94 -- Only used in tests.
96 disjoint :: (Eq a) => V.Vector a -> V.Vector a -> Bool
98 intersect xs ys == V.empty
100 intersect :: (Eq a) => V.Vector a -> V.Vector a -> V.Vector a
102 V.filter (`V.elem` zs) ws
104 prop_factorial_greater :: Int -> Property
105 prop_factorial_greater n =
106 n <= 20 ==> factorial n >= n
109 test_flatten1 :: Assertion
111 assertEqual "flatten actually works" expected_list actual_list
113 target = [[[1::Int]], [[2, 3]]]
114 expected_list = [1, 2, 3] :: [Int]
115 actual_list = flatten target
118 misc_tests :: TestTree
120 testGroup "Misc tests" [
121 testCase "flatten (1)" test_flatten1 ]
124 misc_properties :: TestTree
126 testGroup "Misc properties" [
127 testProperty "factorial greater" prop_factorial_greater ]