Generic.hs

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

import qualified Test.Generator as Gen
import qualified Test.Logic as Logic
import Test.Generator ((<#*|>), (<#=#>))
import Test.Utility (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 (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 ((<$>))


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 ::
   (MatrixShape.Packing pack, ArrMatrix.Subtractive 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,
    ArrayMatrix pack property 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)