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