src/Misc.hs

   1 {-# LANGUAGE BangPatterns #-}
   2
   3 -- | The Misc module contains helper functions that seem out of place
   4 --   anywhere else.
   5 --
   6 module Misc (
   7   all_equal,
   8   disjoint,
   9   factorial,
  10   flatten,
  11   misc_properties,
  12   misc_tests,
  13   transpose_xz )
  14 where
  15
  16 import qualified Data.Vector as V ( Vector, elem, empty, filter )
  17 import Test.Framework ( Test, testGroup )
  18 import Test.Framework.Providers.HUnit ( testCase )
  19 import Test.Framework.Providers.QuickCheck2 ( testProperty )
  20 import Test.HUnit ( Assertion, assertEqual )
  21 import Test.QuickCheck ( Property, (==>) )
  22
  23
  24 -- | The standard factorial function. See
  25 --   <http://www.willamette.edu/~fruehr/haskell/evolution.html> for
  26 --   possible improvements.
  27 --
  28 --   Examples:
  29 --
  30 --   >>> factorial 0
  31 --   1
  32 --
  33 --   >>> factorial 4
  34 --   24
  35 --
  36 factorial :: Int -> Int
  37 factorial !n =
  38   go 1 n
  39   where
  40     go !acc !i
  41       | i <= 1    = acc
  42       | otherwise = go (acc * i) (i - 1)
  43
  44 -- | Takes a three-dimensional list, and flattens it into a
  45 --   one-dimensional one.
  46 --
  47 --  Examples:
  48 --
  49 --  >>> flatten [ [[1,2], [3,4]], [[5,6], [7,8]] ]
  50 --  [1,2,3,4,5,6,7,8]
  51 --
  52 flatten :: [[[a]]] -> [a]
  53 flatten xs = concat $ concat xs
  54
  55
  56 -- | Switch the x and z dimensions of a three-dimensional list.
  57 transpose_xz :: [[[a]]] -> [[[a]]]
  58 transpose_xz [] = []
  59 transpose_xz [[]] = [[]]
  60 transpose_xz [[[]]] = [[[]]]
  61 transpose_xz m =
  62     [[[ m !! x !! y !! z | x <- [0..xsize]]
  63                       | y <- [0..ysize]]
  64                       | z <- [0..zsize]]
  65     where
  66       zsize = (length m) - 1
  67       ysize = length (head m) - 1
  68       xsize = length (head $ head m) - 1
  69
  70 -- | Takes a list, and returns True if its elements are pairwise
  71 --   equal. Returns False otherwise.
  72 --
  73 --   Only used in tests.
  74 --
  75 all_equal :: (Eq a) => [a] -> Bool
  76 all_equal [] = True -- Vacuously
  77 all_equal (x:xs) = all (== x) xs
  78
  79
  80
  81 -- | Returns 'True' if the vectors xs and ys are disjoint, 'False'
  82 --   otherwise.
  83 --
  84 --   Examples:
  85 --
  86 --   >>> let xs = Data.Vector.fromList [1,2,3]
  87 --   >>> let ys = Data.Vector.fromList [4,5,6]
  88 --   >>> disjoint xs ys
  89 --   True
  90 --
  91 --   >>> let ys = Data.Vector.fromList [3,4,5]
  92 --   >>> disjoint xs ys
  93 --   False
  94 --
  95 --   Only used in tests.
  96 --
  97 disjoint :: (Eq a) => V.Vector a -> V.Vector a -> Bool
  98 disjoint xs ys =
  99   intersect xs ys == V.empty
 100   where
 101     intersect :: (Eq a) => V.Vector a -> V.Vector a -> V.Vector a
 102     intersect ws zs =
 103       V.filter (`V.elem` zs) ws
 104
 105 prop_factorial_greater :: Int -> Property
 106 prop_factorial_greater n =
 107     n <= 20 ==> factorial n >= n
 108
 109
 110 test_flatten1 :: Assertion
 111 test_flatten1 =
 112     assertEqual "flatten actually works" expected_list actual_list
 113     where
 114       target = [[[1::Int]], [[2, 3]]]
 115       expected_list = [1, 2, 3]
 116       actual_list = flatten target
 117
 118
 119 misc_tests :: Test.Framework.Test
 120 misc_tests =
 121     testGroup "Misc Tests" [
 122       testCase "flatten (1)" test_flatten1 ]
 123
 124
 125 misc_properties :: Test.Framework.Test
 126 misc_properties =
 127     testGroup "Misc Properties" [
 128       testProperty "factorial greater" prop_factorial_greater ]