X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMisc.hs;h=56d33eb43c3969ce0c9c40b5efb81582d0b888b1;hb=9ecdab2b3a4bc6bdf50776a5d2092632988fa8fa;hp=57dfd433e2ffc4b72cb8daa00f19f94443813404;hpb=d2e1b5009ad0ae3595e874227586617aad068daa;p=spline3.git diff --git a/src/Misc.hs b/src/Misc.hs index 57dfd43..56d33eb 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -1,14 +1,22 @@ +{-# 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.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.HUnit -import Test.QuickCheck +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 @@ -24,11 +32,13 @@ import Test.QuickCheck -- 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. @@ -58,12 +68,13 @@ transpose_xz m = -- | 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 = - all (== first_element) other_elements - where - first_element = head xs - other_elements = tail xs +all_equal [] = True -- Vacuously +all_equal (x:xs) = all (== x) xs + -- | Returns 'True' if the vectors xs and ys are disjoint, 'False' @@ -80,6 +91,8 @@ all_equal xs = -- >>> 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 @@ -98,17 +111,17 @@ test_flatten1 = assertEqual "flatten actually works" expected_list actual_list where target = [[[1::Int]], [[2, 3]]] - expected_list = [1, 2, 3] + expected_list = [1, 2, 3] :: [Int] actual_list = flatten target -misc_tests :: Test.Framework.Test +misc_tests :: TestTree misc_tests = - testGroup "Misc Tests" [ + testGroup "Misc tests" [ testCase "flatten (1)" test_flatten1 ] -misc_properties :: Test.Framework.Test +misc_properties :: TestTree misc_properties = - testGroup "Misc Properties" [ + testGroup "Misc properties" [ testProperty "factorial greater" prop_factorial_greater ]