module Numeric.LAPACK.Matrix.Full (
   Full,
   Unpacked.Unpacked,
   identity,
   diagonal,
   mapExtent,
   mapHeight,
   mapWidth,
   transpose,
   adjoint,
   multiplyVector,
   multiply,
   ) where

import qualified Numeric.LAPACK.Matrix.Array.Unpacked as Unpacked
import qualified Numeric.LAPACK.Matrix.Array.Private as ArrMatrix
import qualified Numeric.LAPACK.Matrix.Basic as Basic
import qualified Numeric.LAPACK.Matrix.Plain as Plain
import qualified Numeric.LAPACK.Matrix.Extent as Extent
import Numeric.LAPACK.Matrix.Array.Private (Full)
import Numeric.LAPACK.Vector (Vector)

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Shape as Shape


identity ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C sh, Class.Floating a) =>
   sh -> Full meas vert horiz sh sh a
identity = ArrMatrix.lift0 . Plain.identity

diagonal ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   (Shape.C sh, Class.Floating a) =>
   Vector sh a -> Full meas vert horiz sh sh a
diagonal = ArrMatrix.lift0 . Plain.diagonal


mapExtent ::
   (Extent.Measure measA, Extent.C vertA, Extent.C horizA) =>
   (Extent.Measure measB, Extent.C vertB, Extent.C horizB) =>
   Extent.Map measA vertA horizA measB vertB horizB height width ->
   Full measA vertA horizA height width a ->
   Full measB vertB horizB height width a
mapExtent = Unpacked.mapExtent

{- |
The number of rows must be maintained by the height mapping function.
-}
mapHeight ::
   (Extent.C vert, Extent.C horiz,
    Shape.C heightA, Shape.C heightB, Shape.C width) =>
   (heightA -> heightB) ->
   Full Extent.Size vert horiz heightA width a ->
   Full Extent.Size vert horiz heightB width a
mapHeight = ArrMatrix.lift1 . Plain.mapHeight

{- |
The number of columns must be maintained by the width mapping function.
-}
mapWidth ::
   (Extent.C vert, Extent.C horiz,
    Shape.C widthA, Shape.C widthB, Shape.C height) =>
   (widthA -> widthB) ->
   Full Extent.Size vert horiz height widthA a ->
   Full Extent.Size vert horiz height widthB a
mapWidth = ArrMatrix.lift1 . Plain.mapWidth


transpose ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz) =>
   Full meas vert horiz height width a -> Full meas horiz vert width height a
transpose = Unpacked.transpose

{- |
conjugate transpose

Problem: @adjoint a \<\> a@ is always square,
but how to convince the type checker to choose the Square type?

Anser: Use @Hermitian.toSquare $ Hermitian.gramian a@ instead.
-}
adjoint ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width, Class.Floating a) =>
   Full meas vert horiz height width a -> Full meas horiz vert width height a
adjoint = ArrMatrix.lift1 Basic.adjoint


multiplyVector ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width, Eq width, Class.Floating a) =>
   Full meas vert horiz height width a -> Vector width a -> Vector height a
multiplyVector = Unpacked.multiplyVector

multiply ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height,
    Shape.C fuse, Eq fuse,
    Shape.C width,
    Class.Floating a) =>
   Full meas vert horiz height fuse a ->
   Full meas vert horiz fuse width a ->
   Full meas vert horiz height width a
multiply = Unpacked.multiply