Checks.hs

-----------------------------------------------------------------------------
-- Copyright 2015, Open Universiteit Nederland. This file is distributed
-- under the terms of the GNU General Public License. For more information,
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------
--  $Id: Checks.hs 7527 2015-04-08 07:58:06Z bastiaan $

module Domain.LinearAlgebra.Checks (checks) where

import Data.Maybe
import Domain.LinearAlgebra hiding (getSolution)
import Domain.Math.Expr
import Domain.Math.Simplification (simplify)
import Ideas.Common.Classes
import Ideas.Common.Context
import Ideas.Common.Exercise
import Ideas.Common.Utils.TestSuite
import Test.QuickCheck

-----------------------------------------------------------
--- QuickCheck properties

checks :: TestSuite
checks = suite "Linear algebra"
   [ usePropertyWith "echelon"         thorough propEchelon
   , usePropertyWith "reduced echelon" thorough propReducedEchelon
   , usePropertyWith "sound"           thorough propSound
   , usePropertyWith "solution"        thorough propSolution
   ]
 where
   thorough = stdArgs {maxSize = 500, maxSuccess = 500}

propEchelon :: Matrix Rational -> Bool
propEchelon =
   fromMaybe False . fromContextWith inRowEchelonForm . applyD forwardPass . gaussContext

propReducedEchelon :: Matrix Rational -> Bool
propReducedEchelon =
   fromMaybe False . fromContextWith inRowReducedEchelonForm . applyD gaussianElimStrategy . gaussContext

propSound :: Matrix Rational -> Bool
propSound m =
   (fromContext . applyD gaussianElimStrategy . gaussContext) m
   == Just (fmap fromRational (reduce m))

propSolution :: Matrix Rational -> Property
propSolution m1 =
   forAll (arbSolution m1) $ \(solution, m2) ->
      let m3  = (fromContext . applyD gaussianElimStrategy . gaussContext) m2
          p r = simplify (sum (zipWith g (solution ++ [-1]) r)) == 0
          g   = (*) . fromRational
      in maybe False (all p . rows) m3

arbSolution :: (Arbitrary a, Num a) => Matrix a -> Gen ([a], Matrix a)
arbSolution m = do
   solution <- vector (snd $ dimensions m)
   let finalCol  = map (return . sum . zipWith (*) solution) (rows m)
       newMatrix = makeMatrix $ zipWith (++) (rows m) finalCol
   return (solution, newMatrix)

gaussContext :: Matrix Rational -> Context (Matrix Expr)
gaussContext = inContext gaussianElimExercise . fmap fromRational