Test/IndexedMatrix.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 module Test.IndexedMatrix where
   3 import Control.Applicative ((<$>), (<*>))
   4 import Data.Eq.Approximate
   5 import Data.Function (on)
   6 import Data.Maybe (fromJust, isJust, isNothing)
   7 import Data.Set (Set)
   8 import qualified Data.Set as Set
   9 import IndexedMatrix
  10 import Numeric.Matrix (MatrixElement)
  11 import qualified Numeric.Matrix as Matrix
  12 import Test.QuickCheck
  13 import Test.QuickCheck.All
  14 import Test.Set
  15 import TypeLevel.NaturalNumber
  16 import Util.Function ((.:))
  17 import Util.Set (allSet)
  18
  19 type ApproximateDouble = AbsolutelyApproximateValue (Digits Eight) Double
  20 wrapAD :: Double -> ApproximateDouble
  21 wrapAD = AbsolutelyApproximateValue
  22 unwrapAD :: ApproximateDouble -> Double
  23 unwrapAD = unwrapAbsolutelyApproximateValue
  24
  25 infix 4 ~=
  26 class ApproxEq a where
  27   (~=) :: a -> a -> Bool
  28
  29 instance ApproxEq Double where
  30   (~=) = (==) `on` wrapAD
  31
  32 instance ApproxEq a => ApproxEq (Maybe a) where
  33   Nothing ~= Nothing  = True
  34   Just x  ~= Just y   = x ~= y
  35   _       ~= _        = False
  36
  37 instance (Ord r, Ord c, MatrixElement e, ApproxEq e) =>
  38   ApproxEq (IndexedMatrix r c e) where
  39   a ~= b =
  40     let
  41       rs = rowIndices a
  42       cs = columnIndices a
  43     in rowIndices b == rs
  44     && columnIndices b == cs
  45     && (flip allSet rs $ \r -> flip allSet cs $ \c -> at a r c ~= at b r c)
  46
  47 instance
  48   ( Arbitrary r, CoArbitrary r, Ord r
  49   , Arbitrary c, CoArbitrary c, Ord c
  50   , Arbitrary e, MatrixElement e
  51   ) => Arbitrary (IndexedMatrix r c e) where
  52   arbitrary = indexedMatrix
  53     <$> arbitrarySetOfSizeSqrt
  54     <*> arbitrarySetOfSizeSqrt
  55     <*> arbitrary
  56
  57 arbitrarySquareMatrix ::
  58   ( Arbitrary r, CoArbitrary r, Ord r
  59   , Arbitrary c, CoArbitrary c, Ord c
  60   , Arbitrary e, MatrixElement e
  61   ) => Gen (IndexedMatrix r c e)
  62 arbitrarySquareMatrix = do
  63   rs <- arbitrarySetOfSizeSqrt
  64   cs <- arbitrarySetOfExactSize $ Set.size rs
  65   indexedMatrix rs cs <$> arbitrary
  66
  67 prop_valid_indexedMatrix :: (Ord r, Ord c, MatrixElement e) =>
  68   IndexedMatrix r c e -> Bool
  69 prop_valid_indexedMatrix m = let m' = stripIndices m
  70   in Set.size (rowIndices m) == Matrix.numRows m'
  71   && Set.size (columnIndices m) == Matrix.numCols m'
  72   && m == indexedMatrix (rowIndices m) (columnIndices m) (at' m)
  73
  74 withIndicesIn :: (Ord r, Show r, Ord c, Show c, Testable p) =>
  75   IndexedMatrix r c e -> (r -> c -> p) -> Property
  76 withIndicesIn m f = withArbitraryElement (rowIndices m) $
  77   withArbitraryElement (columnIndices m) . f
  78
  79 prop_at_in :: (Ord r, Show r, Ord c, Show c, MatrixElement e) =>
  80   IndexedMatrix r c e -> Property
  81 prop_at_in m = withIndicesIn m $ isJust .: at m
  82
  83 prop_at_out :: (Ord r, Ord c, MatrixElement e) =>
  84   IndexedMatrix r c e -> r -> c -> Property
  85 prop_at_out m r c =
  86   not (Set.member r (rowIndices m) && Set.member c (columnIndices m)) ==>
  87     isNothing $ at m r c
  88
  89 prop_firstMinorMatrix_valid_indexedMatrix ::
  90   (Ord r, Show r, Ord c, Show c, MatrixElement e) =>
  91   IndexedMatrix r c e -> Property
  92 prop_firstMinorMatrix_valid_indexedMatrix m = withIndicesIn m $
  93   (prop_valid_indexedMatrix . fromJust) .: firstMinorMatrix m
  94
  95 prop_firstMinorMatrix_size :: (Ord r, Show r, Ord c, Show c, MatrixElement e) =>
  96   IndexedMatrix r c e -> Property
  97 prop_firstMinorMatrix_size m = withIndicesIn m $ \r c ->
  98   let m' = fromJust $ firstMinorMatrix m r c in
  99   rowIndices m' == Set.delete r (rowIndices m) &&
 100     columnIndices m' == Set.delete c (columnIndices m)
 101
 102 prop_firstMinorMatrix_entries ::
 103   (Ord r, Show r, Ord c, Show c, MatrixElement e) =>
 104   IndexedMatrix r c e -> Property
 105 prop_firstMinorMatrix_entries m = withIndicesIn m $ \r c ->
 106   let m' = fromJust $ firstMinorMatrix m r c in
 107   withIndicesIn m' $ \r' c'
 108     -> at m' r' c' == at m r' c'
 109     && (isJust $ at m' r' c')
 110     && (isNothing $ at m' r c')
 111     && (isNothing $ at m' r' c)
 112     && (isNothing $ at m' r c)
 113
 114 squareMatrixTest ::
 115   ( Arbitrary r, CoArbitrary r, Ord r, Show r
 116   , Arbitrary c, CoArbitrary c, Ord c, Show c
 117   , Arbitrary e, MatrixElement e, Show e
 118   , Testable p
 119   ) => (IndexedMatrix r c e -> p) -> Property
 120 squareMatrixTest = forAll arbitrarySquareMatrix
 121
 122 squareMatrixTestDouble :: Testable p =>
 123   (IndexedMatrix Integer Integer Double -> p) -> Property
 124 squareMatrixTestDouble = squareMatrixTest
 125
 126 squareMatrixTestRational :: Testable p =>
 127   (IndexedMatrix Integer Integer Rational -> p) -> Property
 128 squareMatrixTestRational = squareMatrixTest
 129
 130 prop_invertible_Double :: Property
 131 prop_invertible_Double = squareMatrixTestDouble invertible
 132
 133 prop_invertible_Rational :: Property
 134 prop_invertible_Rational = squareMatrixTestRational invertible
 135
 136 inverse_valid_indexedMatrix :: (Ord r, Ord c, MatrixElement e) =>
 137   IndexedMatrix r c e -> Property
 138 inverse_valid_indexedMatrix m =
 139   invertible m ==> prop_valid_indexedMatrix $ fromJust $ inverse m
 140
 141 prop_inverse_valid_indexedMatrix_Double :: Property
 142 prop_inverse_valid_indexedMatrix_Double =
 143   squareMatrixTestDouble inverse_valid_indexedMatrix
 144
 145 prop_inverse_valid_indexedMatrix_Rational :: Property
 146 prop_inverse_valid_indexedMatrix_Rational =
 147   squareMatrixTestRational inverse_valid_indexedMatrix
 148
 149 inverse_times_eq_id :: (Eq r, Eq c, MatrixElement e) =>
 150   IndexedMatrix r c e -> Property
 151 inverse_times_eq_id m = invertible m
 152   ==> m `times` m' == Just (identity $ rowIndices m)
 153   &&  m' `times` m == Just (identity $ columnIndices m)
 154   where m' = fromJust $ inverse m
 155
 156 inverse_times_approxeq_id :: (Ord r, Ord c, MatrixElement e, ApproxEq e) =>
 157   IndexedMatrix r c e -> Property
 158 inverse_times_approxeq_id m = invertible m
 159   ==> m `times` m' ~= Just (identity $ rowIndices m)
 160   &&  m' `times` m ~= Just (identity $ columnIndices m)
 161   where m' = fromJust $ inverse m
 162
 163 prop_inverse_times_approxeq_id_Double :: Property
 164 prop_inverse_times_approxeq_id_Double =
 165   squareMatrixTestDouble inverse_times_approxeq_id
 166
 167 prop_inverse_times_eq_id_Rational :: Property
 168 prop_inverse_times_eq_id_Rational = squareMatrixTestRational inverse_times_eq_id
 169
 170 allIndexedMatrixTests :: IO Bool
 171 allIndexedMatrixTests = $(quickCheckAll)
 172