X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMisc.hs;h=56d33eb43c3969ce0c9c40b5efb81582d0b888b1;hb=9ecdab2b3a4bc6bdf50776a5d2092632988fa8fa;hp=fd6dd392bdb3c6e1247d2271f1aeedfa766f43a7;hpb=5973e31fd84d4a91578185f649b3783fdae8a882;p=spline3.git diff --git a/src/Misc.hs b/src/Misc.hs index fd6dd39..56d33eb 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -1,30 +1,127 @@ +{-# LANGUAGE BangPatterns #-} + -- | The Misc module contains helper functions that seem out of place -- anywhere else. -module Misc +-- +module Misc ( + all_equal, + disjoint, + factorial, + flatten, + misc_properties, + misc_tests, + transpose_xz ) where +import qualified Data.Vector as V ( Vector, elem, empty, filter ) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( Assertion, assertEqual, testCase ) +import Test.Tasty.QuickCheck ( Property, (==>), testProperty ) + -- | The standard factorial function. See -- for -- possible improvements. +-- +-- Examples: +-- +-- >>> factorial 0 +-- 1 +-- +-- >>> factorial 4 +-- 24 +-- factorial :: Int -> Int -factorial n - | n <= 1 = 1 - | n > 20 = error "integer overflow in factorial function" - | otherwise = product [1..n] - +factorial !n = + go 1 n + where + go :: Int -> Int -> Int + go !acc !i + | i <= 1 = acc + | otherwise = go (acc * i) (i - 1) -- | Takes a three-dimensional list, and flattens it into a -- one-dimensional one. +-- +-- Examples: +-- +-- >>> flatten [ [[1,2], [3,4]], [[5,6], [7,8]] ] +-- [1,2,3,4,5,6,7,8] +-- flatten :: [[[a]]] -> [a] flatten xs = concat $ concat xs +-- | Switch the x and z dimensions of a three-dimensional list. +transpose_xz :: [[[a]]] -> [[[a]]] +transpose_xz [] = [] +transpose_xz [[]] = [[]] +transpose_xz [[[]]] = [[[]]] +transpose_xz m = + [[[ m !! x !! y !! z | x <- [0..xsize]] + | y <- [0..ysize]] + | z <- [0..zsize]] + where + zsize = (length m) - 1 + ysize = length (head m) - 1 + xsize = length (head $ head m) - 1 + -- | Takes a list, and returns True if its elements are pairwise -- equal. Returns False otherwise. +-- +-- Only used in tests. +-- all_equal :: (Eq a) => [a] -> Bool -all_equal xs = - and $ map (== first_element) other_elements +all_equal [] = True -- Vacuously +all_equal (x:xs) = all (== x) xs + + + +-- | Returns 'True' if the vectors xs and ys are disjoint, 'False' +-- otherwise. +-- +-- Examples: +-- +-- >>> let xs = Data.Vector.fromList [1,2,3] +-- >>> let ys = Data.Vector.fromList [4,5,6] +-- >>> disjoint xs ys +-- True +-- +-- >>> let ys = Data.Vector.fromList [3,4,5] +-- >>> disjoint xs ys +-- False +-- +-- Only used in tests. +-- +disjoint :: (Eq a) => V.Vector a -> V.Vector a -> Bool +disjoint xs ys = + intersect xs ys == V.empty + where + intersect :: (Eq a) => V.Vector a -> V.Vector a -> V.Vector a + intersect ws zs = + V.filter (`V.elem` zs) ws + +prop_factorial_greater :: Int -> Property +prop_factorial_greater n = + n <= 20 ==> factorial n >= n + + +test_flatten1 :: Assertion +test_flatten1 = + assertEqual "flatten actually works" expected_list actual_list where - first_element = head xs - other_elements = tail xs + target = [[[1::Int]], [[2, 3]]] + expected_list = [1, 2, 3] :: [Int] + actual_list = flatten target + + +misc_tests :: TestTree +misc_tests = + testGroup "Misc tests" [ + testCase "flatten (1)" test_flatten1 ] + + +misc_properties :: TestTree +misc_properties = + testGroup "Misc properties" [ + testProperty "factorial greater" prop_factorial_greater ]