Mosaic.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
module Test.Mosaic (
   testsVar,
   Property(..),
   genIdentity,
   repack,
   ) where

import qualified Test.Multiply as Multiply
import qualified Test.Generator as Gen
import qualified Test.Logic as Logic
import qualified Test.Utility as Util
import Test.Generator ((<-*#>), (<#*|>), (<#*#>))
import Test.Utility (Tagged)

import qualified Numeric.LAPACK.Matrix.Array as ArrMatrix
import qualified Numeric.LAPACK.Matrix.Shape.Omni as Omni
import qualified Numeric.LAPACK.Matrix.Shape as MatrixShape
import qualified Numeric.LAPACK.Matrix.Layout as Layout
import qualified Numeric.LAPACK.Matrix as Matrix
import Numeric.LAPACK.Matrix (ShapeInt)
import Numeric.LAPACK.Scalar (RealOf)

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Shape as Shape

import Control.Applicative ((<$>))

import qualified Test.QuickCheck as QC



data Property property lower upper where
   Symmetric ::
      Property Omni.Symmetric MatrixShape.Filled MatrixShape.Filled
   Hermitian ::
      Property Omni.HermitianUnknownDefiniteness
         MatrixShape.Filled MatrixShape.Filled
   Diagonal ::
      (MatrixShape.TriDiag diag) =>
      Property diag MatrixShape.Empty MatrixShape.Empty
   Lower ::
      (MatrixShape.TriDiag diag) =>
      Property diag MatrixShape.Filled MatrixShape.Empty
   Upper ::
      (MatrixShape.TriDiag diag) =>
      Property diag MatrixShape.Empty MatrixShape.Filled

genMosaic ::
   (Logic.Dim sh, Shape.Indexed sh, Shape.Index sh ~ ix, Eq ix,
    Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   Property prop lo up ->
   Layout.PackingSingleton pack ->
   Gen.Square sh a (ArrMatrix.Quadratic pack prop lo up sh a)
genMosaic prop p =
   case prop of
      Symmetric -> repack p <$> Gen.symmetric
      Hermitian -> repack p <$> Gen.hermitian
      Diagonal  -> repack p <$> Gen.triangular
      Lower     -> repack p <$> Gen.triangular
      Upper     -> repack p <$> Gen.triangular

genIdentity ::
   (sh ~ ShapeInt, Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   Property prop lo up ->
   Layout.PackingSingleton pack ->
   Gen.Square sh a (ArrMatrix.Quadratic pack prop lo up sh a)
genIdentity prop p =
   case prop of
      Symmetric -> repack p <$> Gen.identity `asTypeOf` Gen.symmetric
      Hermitian -> repack p <$> Gen.identity `asTypeOf` Gen.hermitian
      Diagonal  -> repack p <$> Gen.triangularIdentity
      Lower     -> repack p <$> Gen.identity `asTypeOf` Gen.triangular
      Upper     -> repack p <$> Gen.identity `asTypeOf` Gen.triangular


checkForAll ::
   (Show a, QC.Testable test) =>
   Gen.T dim tag a -> (a -> test) -> Tagged tag QC.Property
checkForAll gen = Util.checkForAll (Gen.run gen 3 5)

checkForAllExtra ::
   (Show a, Show b, QC.Testable test) =>
   QC.Gen a -> Gen.T dim tag b ->
   (a -> b -> test) -> Tagged tag QC.Property
checkForAllExtra = Gen.withExtra checkForAll


repack ::
   (Shape.C sh, Class.Floating a) =>
   Layout.PackingSingleton pack ->
   ArrMatrix.Quadratic Layout.Packed prop lo up sh a ->
   ArrMatrix.Quadratic pack prop lo up sh a
repack pack m =
   case pack of
      Layout.Packed -> m
      Layout.Unpacked -> Matrix.unpack m

testsVar ::
   (MatrixShape.Property prop,
    MatrixShape.PowerStrip lo, MatrixShape.PowerStrip up) =>
   (Layout.Packing pack) =>
   (Show a, Class.Floating a, Eq a, RealOf a ~ ar, Class.Real ar) =>
   Property prop lo up ->
   Layout.PackingSingleton pack ->
   [(String, Tagged a QC.Property)]
testsVar prop p =
   ("multiplySquare",
      checkForAll (genMosaic prop p) Multiply.multiplySquare) :
   ("squareSquare",
      checkForAll (genMosaic prop p) Multiply.squareSquare) :
   ("power",
      checkForAllExtra (QC.choose (0,10)) (genMosaic prop p) Multiply.power) :

   ("multiplyIdentityVector",
      checkForAll
         ((,) <$> genIdentity prop p <#*|> Gen.vector)
         Multiply.multiplyIdentityVector) :
   ("multiplyIdentityFull",
      checkForAll
         ((,) <$> genIdentity prop p <#*#> Gen.matrix)
         Multiply.multiplyIdentityFull) :
   ("multiplyVector",
      checkForAll ((,) <$> genMosaic prop p <#*|> Gen.vector)
         Multiply.multiplyVector) :
   ("multiplyFull",
      checkForAll ((,) <$> genMosaic prop p <#*#> Gen.matrix)
         Multiply.multiplyFull) :
   ("multiplyVectorLeft",
      checkForAll
         ((,) <$> Gen.vector <-*#> genMosaic prop p)
         Multiply.multiplyVectorLeft) :
   ("multiplyVectorRight",
      checkForAll
         ((,) <$> genMosaic prop p <#*|> Gen.vector)
         Multiply.multiplyVectorRight) :
   ("multiplyLeft",
      checkForAll
         ((,) <$> Gen.matrix <#*#> genMosaic prop p)
         Multiply.multiplyLeft) :
   ("multiplyRight",
      checkForAll
         ((,) <$> genMosaic prop p <#*#> Gen.matrix)
         Multiply.multiplyRight) :
   []