Indexed.hs

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

import qualified Test.Generator as Gen
import Test.Utility (NonEmptyInt)

import qualified Numeric.LAPACK.Matrix.Shape as MatrixShape
import qualified Numeric.LAPACK.Matrix.Extent as Extent
import qualified Numeric.LAPACK.Matrix as Matrix
import qualified Numeric.LAPACK.Vector as Vector
import Numeric.LAPACK.Matrix (Matrix, (#!), (#*|))
import Numeric.LAPACK.Vector ((-*|))

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Shape as Shape

import qualified Test.QuickCheck as QC


type GenMatrixNonEmpty = Gen.Matrix NonEmptyInt NonEmptyInt

genMatrixIndexGen ::
   (Class.Floating a) =>
   (array -> [ix]) ->
   GenMatrixNonEmpty a array ->
   GenMatrixNonEmpty a (ix, array)
genMatrixIndexGen indices gen =
   flip Gen.mapQC gen $ \m -> do
      ij <- QC.elements $ indices m
      return (ij,m)

genMatrixIndex ::
   (Matrix.Indexed typ,
    Matrix.BoxExtra typ xl, Matrix.BoxExtra typ xu,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.Indexed height, Shape.Indexed width, Class.Floating a) =>
   GenMatrixNonEmpty a
      (Matrix typ xl xu lower upper meas vert horiz height width a) ->
   GenMatrixNonEmpty a
      (Shape.Index (height,width),
       Matrix typ xl xu lower upper meas vert horiz height width a)
genMatrixIndex = genMatrixIndexGen Matrix.indices

unitDot ::
   (Matrix.BoxExtra typ xl, Matrix.BoxExtra typ xu,
    Matrix.Indexed typ, Matrix.MultiplyVector typ,
    Matrix.MultiplyVectorExtra typ xl, Matrix.MultiplyVectorExtra typ xu,
    MatrixShape.Strip lower, MatrixShape.Strip upper,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.Indexed height, Eq height,
    Shape.Indexed width, Eq width,
    Class.Floating a, Eq a) =>
   (Shape.Index (height,width),
    Matrix typ xl xu lower upper meas vert horiz height width a) ->
   Bool
unitDot ((i,j),m) =
   m#!(i,j) ==
   Vector.unit (Matrix.height m) i  -*|
      (m #*| Vector.unit (Matrix.width m) j)