Generic.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
module Test.Generic where

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, approxVector, equalArray)

import qualified Numeric.LAPACK.Matrix.Shape as MatrixShape
import qualified Numeric.LAPACK.Matrix.Array as ArrMatrix
import qualified Numeric.LAPACK.Matrix.Extent as Extent
import qualified Numeric.LAPACK.Matrix as Matrix
import Numeric.LAPACK.Matrix.Array (ArrayMatrix)
import Numeric.LAPACK.Matrix (Matrix, ShapeInt, (#*|), (#+#), (#-#))
import Numeric.LAPACK.Vector (Vector, (|+|), (|-|))
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


forceOrder ::
   (MatrixShape.Packing pack, MatrixShape.Property property,
    MatrixShape.Strip lower, MatrixShape.Strip upper,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, width ~ ShapeInt,
    Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   MatrixShape.Order ->
   (ArrayMatrix pack property lower upper meas vert horiz height width a,
    Vector width a) ->
   Bool
forceOrder order (a,x) =
   let ao = Matrix.forceOrder order a
   in ArrMatrix.order ao == order
      &&
      approxVector (a #*| x) (ao #*| x)

forceOrderInverse ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, width ~ ShapeInt,
    Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   ArrayMatrix pack property lower upper meas vert horiz height width a -> Bool
forceOrderInverse a =
   let order = ArrMatrix.order a
   in equalArray a $
         Matrix.forceOrder order $
         Matrix.forceOrder (MatrixShape.flipOrder order) a


genDistribution2 ::
   (Logic.Dim height, Eq height, Logic.Dim width, Eq width, Class.Floating a) =>
   Gen.Matrix height width a matrixPair ->
   Gen.Vector height a (matrixPair, Vector width a)
genDistribution2 genPair = (,) <$> genPair <#*|> Gen.vector

genDistribution ::
   (Logic.Dim height, Eq height, Logic.Dim width, Eq width, Class.Floating a) =>
   Gen.Matrix height width a matrix ->
   Gen.Vector height a ((matrix, matrix), Vector width a)
genDistribution gen = genDistribution2 ((,) <$> gen <#=#> gen)

addDistributive, subDistributive ::
   (Matrix.MultiplyVector typ,
    Matrix.MultiplyVectorExtra typ xl, Matrix.MultiplyVectorExtra typ xu) =>
   (Matrix.Subtractive typ,
    Matrix.SubtractiveExtra typ xl, Matrix.SubtractiveExtra typ xu) =>
   (Matrix.AdditiveExtra typ xl, Matrix.AdditiveExtra typ xu) =>
   (MatrixShape.Strip lower, MatrixShape.Strip upper,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Eq width,
    Class.Floating a, RealOf a ~ ar, Class.Real ar,
    Matrix typ xl xu lower upper meas vert horiz height width a ~ matrix) =>
   ((matrix, matrix), Vector width a) -> Bool
addDistributive ((a,b),x) = approxVector ((a#+#b) #*| x) (a#*|x |+| b#*|x)
subDistributive ((a,b),x) = approxVector ((a#-#b) #*| x) (a#*|x |-| b#*|x)


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

testsDistributive ::
   (Matrix.MultiplyVector typ,
    Matrix.MultiplyVectorExtra typ xl, Matrix.MultiplyVectorExtra typ xu) =>
   (Matrix.Subtractive typ,
    Matrix.SubtractiveExtra typ xl, Matrix.SubtractiveExtra typ xu) =>
   (Matrix.AdditiveExtra typ xl, Matrix.AdditiveExtra typ xu) =>
   (MatrixShape.Strip lower, MatrixShape.Strip upper,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Logic.Dim height, Show height, Shape.C height, Eq height,
    Logic.Dim width, Show width, Shape.C width, Eq width,
    Class.Floating a, RealOf a ~ ar, Class.Real ar, Show a,
    Matrix typ xl xu lower upper meas vert horiz height width a ~ matrix,
    Show matrix) =>
   Gen.Matrix height width a matrix ->
   [(String, Tagged a QC.Property)]
testsDistributive gen =
   ("addDistributive", checkForAll (genDistribution gen) addDistributive) :
   ("subDistributive", checkForAll (genDistribution gen) subDistributive) :
   []