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 return []
 171 allIndexedMatrixTests :: IO Bool
 172 allIndexedMatrixTests = $(quickCheckAll)
 173