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