{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.HMatrix (
   toVector,
   fromVector,
   toGeneral,
   fromGeneral,
   toHermitian,
   fromHermitian,
   fromOrder,
   toOrder,
   ) where

import qualified Numeric.LAPACK.Matrix.Triangular as Triangular
import qualified Numeric.LAPACK.Matrix.Hermitian as Hermitian
import qualified Numeric.LAPACK.Matrix.Square as Square
import qualified Numeric.LAPACK.Matrix.Layout as Layout
import qualified Numeric.LAPACK.Matrix.Array as ArrMatrix
import qualified Numeric.LAPACK.Matrix as Matrix
import qualified Numeric.LAPACK.Scalar as Scalar
import qualified Numeric.Netlib.Class as Class
import Numeric.LAPACK.Matrix (ShapeInt)
import Numeric.LAPACK.Vector (Vector)

import qualified Numeric.LinearAlgebra.Devel as HMatrixDevel
import qualified Numeric.LinearAlgebra.Data as HMatrixData
import qualified Numeric.LinearAlgebra as HMatrix

import qualified Data.Array.Comfort.Storable.Unchecked as Array
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable.Unchecked (Array(Array))

import qualified Data.Vector.Storable as StVector

import Data.Functor.Compose (Compose (Compose))
import Data.Tuple.HT (mapPair)


toVector ::
   (StVector.Storable a) =>
   StVector.Vector a -> Vector ShapeInt a
toVector :: Vector a -> Vector ShapeInt a
toVector Vector a
v =
   let (ForeignPtr a
fptr,Int
n) = Vector a -> (ForeignPtr a, Int)
forall a. Storable a => Vector a -> (ForeignPtr a, Int)
StVector.unsafeToForeignPtr0 Vector a
v
   in ShapeInt -> ForeignPtr a -> Vector ShapeInt a
forall sh a. sh -> ForeignPtr a -> Array sh a
Array (Int -> ShapeInt
Matrix.shapeInt Int
n) ForeignPtr a
fptr

fromVector ::
   (Shape.C shape, StVector.Storable a) =>
   Vector shape a -> StVector.Vector a
fromVector :: Vector shape a -> Vector a
fromVector (Array shape
shape ForeignPtr a
fptr) =
   ForeignPtr a -> Int -> Vector a
forall a. Storable a => ForeignPtr a -> Int -> Vector a
StVector.unsafeFromForeignPtr0 ForeignPtr a
fptr (shape -> Int
forall sh. C sh => sh -> Int
Shape.size shape
shape)


toGeneral ::
   (Class.Floating a) =>
   HMatrix.Matrix a -> Matrix.General ShapeInt ShapeInt a
toGeneral :: Matrix a -> General ShapeInt ShapeInt a
toGeneral Matrix a
a =
   case Matrix a -> MatrixOrder
forall t. Matrix t -> MatrixOrder
HMatrixDevel.orderOf Matrix a
a of
      MatrixOrder
HMatrixDevel.RowMajor -> Matrix a -> General ShapeInt ShapeInt a
forall a. Floating a => Matrix a -> General ShapeInt ShapeInt a
toRowMajor Matrix a
a
      MatrixOrder
HMatrixDevel.ColumnMajor -> General ShapeInt ShapeInt a -> General ShapeInt ShapeInt a
forall typ xl xu meas vert horiz height width a lower upper.
(Transpose typ, TransposeExtra typ xl, TransposeExtra typ xu,
 Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> Matrix typ xu xl upper lower meas horiz vert width height a
Matrix.transpose (General ShapeInt ShapeInt a -> General ShapeInt ShapeInt a)
-> General ShapeInt ShapeInt a -> General ShapeInt ShapeInt a
forall a b. (a -> b) -> a -> b
$ Matrix a -> General ShapeInt ShapeInt a
forall a. Floating a => Matrix a -> General ShapeInt ShapeInt a
toRowMajor (Matrix a -> General ShapeInt ShapeInt a)
-> Matrix a -> General ShapeInt ShapeInt a
forall a b. (a -> b) -> a -> b
$ Matrix a -> Matrix a
forall a. Floating a => Matrix a -> Matrix a
transpose Matrix a
a

transpose :: (Class.Floating a) => HMatrix.Matrix a -> HMatrix.Matrix a
transpose :: Matrix a -> Matrix a
transpose Matrix a
a =
   case Matrix a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor Matrix a
a of
      ComplexSingleton a
Scalar.Real ->
         case Matrix a -> PrecisionSingleton a
forall a (f :: * -> *). Real a => f a -> PrecisionSingleton a
Scalar.precisionOfFunctor Matrix a
a of
            PrecisionSingleton a
Scalar.Float -> Matrix a -> Matrix a
forall m mt. Transposable m mt => m -> mt
HMatrix.tr' Matrix a
a
            PrecisionSingleton a
Scalar.Double -> Matrix a -> Matrix a
forall m mt. Transposable m mt => m -> mt
HMatrix.tr' Matrix a
a
      ComplexSingleton a
Scalar.Complex ->
         case Compose Matrix Complex a1 -> PrecisionSingleton a1
forall a (f :: * -> *). Real a => f a -> PrecisionSingleton a
Scalar.precisionOfFunctor (Compose Matrix Complex a1 -> PrecisionSingleton a1)
-> Compose Matrix Complex a1 -> PrecisionSingleton a1
forall a b. (a -> b) -> a -> b
$ Matrix (Complex a1) -> Compose Matrix Complex a1
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Matrix a
Matrix (Complex a1)
a of
            PrecisionSingleton a1
Scalar.Float -> Matrix a -> Matrix a
forall m mt. Transposable m mt => m -> mt
HMatrix.tr' Matrix a
a
            PrecisionSingleton a1
Scalar.Double -> Matrix a -> Matrix a
forall m mt. Transposable m mt => m -> mt
HMatrix.tr' Matrix a
a

toRowMajor ::
   (Class.Floating a) =>
   HMatrix.Matrix a -> Matrix.General ShapeInt ShapeInt a
toRowMajor :: Matrix a -> General ShapeInt ShapeInt a
toRowMajor Matrix a
a =
   let ((Int, Int)
dims, Vector a
b) = Matrix a -> ((Int, Int), Vector a)
forall a. Floating a => Matrix a -> ((Int, Int), Vector a)
flatten Matrix a
a
   in Array (ShapeInt, ShapeInt) a -> General ShapeInt ShapeInt a
forall height width a.
(C height, C width, Floating a) =>
Array (height, width) a -> General height width a
Matrix.fromRowMajor (Array (ShapeInt, ShapeInt) a -> General ShapeInt ShapeInt a)
-> Array (ShapeInt, ShapeInt) a -> General ShapeInt ShapeInt a
forall a b. (a -> b) -> a -> b
$
      (ShapeInt, ShapeInt)
-> Array ShapeInt a -> Array (ShapeInt, ShapeInt) a
forall sh1 sh0 a. sh1 -> Array sh0 a -> Array sh1 a
Array.reshape ((Int -> ShapeInt, Int -> ShapeInt)
-> (Int, Int) -> (ShapeInt, ShapeInt)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (Int -> ShapeInt
Matrix.shapeInt, Int -> ShapeInt
Matrix.shapeInt) (Int, Int)
dims) (Array ShapeInt a -> Array (ShapeInt, ShapeInt) a)
-> Array ShapeInt a -> Array (ShapeInt, ShapeInt) a
forall a b. (a -> b) -> a -> b
$
      Vector a -> Array ShapeInt a
forall a. Storable a => Vector a -> Vector ShapeInt a
toVector Vector a
b

flatten ::
   (Class.Floating a) => HMatrix.Matrix a -> ((Int,Int), StVector.Vector a)
flatten :: Matrix a -> ((Int, Int), Vector a)
flatten Matrix a
a =
   case Matrix a -> ComplexSingleton a
forall a (f :: * -> *). Floating a => f a -> ComplexSingleton a
Scalar.complexSingletonOfFunctor Matrix a
a of
      ComplexSingleton a
Scalar.Real ->
         case Matrix a -> PrecisionSingleton a
forall a (f :: * -> *). Real a => f a -> PrecisionSingleton a
Scalar.precisionOfFunctor Matrix a
a of
            PrecisionSingleton a
Scalar.Float -> (Matrix a -> IndexOf Matrix
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
HMatrixData.size Matrix a
a, Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
HMatrix.flatten Matrix a
a)
            PrecisionSingleton a
Scalar.Double -> (Matrix a -> IndexOf Matrix
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
HMatrixData.size Matrix a
a, Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
HMatrix.flatten Matrix a
a)
      ComplexSingleton a
Scalar.Complex ->
         case Compose Matrix Complex a1 -> PrecisionSingleton a1
forall a (f :: * -> *). Real a => f a -> PrecisionSingleton a
Scalar.precisionOfFunctor (Compose Matrix Complex a1 -> PrecisionSingleton a1)
-> Compose Matrix Complex a1 -> PrecisionSingleton a1
forall a b. (a -> b) -> a -> b
$ Matrix (Complex a1) -> Compose Matrix Complex a1
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Matrix a
Matrix (Complex a1)
a of
            PrecisionSingleton a1
Scalar.Float -> (Matrix a -> IndexOf Matrix
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
HMatrixData.size Matrix a
a, Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
HMatrix.flatten Matrix a
a)
            PrecisionSingleton a1
Scalar.Double -> (Matrix a -> IndexOf Matrix
forall (c :: * -> *) t. Container c t => c t -> IndexOf c
HMatrixData.size Matrix a
a, Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
HMatrix.flatten Matrix a
a)


fromGeneral ::
   (Shape.C height, Shape.C width, StVector.Storable a) =>
   Matrix.General height width a -> HMatrix.Matrix a
fromGeneral :: General height width a -> Matrix a
fromGeneral General height width a
a =
   MatrixOrder -> Int -> Int -> Vector a -> Matrix a
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
HMatrixDevel.matrixFromVector
      (Order -> MatrixOrder
fromOrder (Order -> MatrixOrder) -> Order -> MatrixOrder
forall a b. (a -> b) -> a -> b
$ General height width a -> Order
forall pack property lower upper meas vert horiz height width a.
ArrayMatrix
  pack property lower upper meas vert horiz height width a
-> Order
ArrMatrix.order General height width a
a)
      (height -> Int
forall sh. C sh => sh -> Int
Shape.size (height -> Int) -> height -> Int
forall a b. (a -> b) -> a -> b
$ General height width a -> height
forall typ xl xu meas vert horiz lower upper height width a.
(Box typ, BoxExtra typ xl, BoxExtra typ xu, Measure meas, C vert,
 C horiz) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> height
Matrix.height General height width a
a)
      (width -> Int
forall sh. C sh => sh -> Int
Shape.size (width -> Int) -> width -> Int
forall a b. (a -> b) -> a -> b
$ General height width a -> width
forall typ xl xu meas vert horiz lower upper height width a.
(Box typ, BoxExtra typ xl, BoxExtra typ xu, Measure meas, C vert,
 C horiz) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> width
Matrix.width General height width a
a)
      (Vector
  (Omni Unpacked Arbitrary Filled Filled Size Big Big height width) a
-> Vector a
forall shape a. (C shape, Storable a) => Vector shape a -> Vector a
fromVector (Vector
   (Omni Unpacked Arbitrary Filled Filled Size Big Big height width) a
 -> Vector a)
-> Vector
     (Omni Unpacked Arbitrary Filled Filled Size Big Big height width) a
-> Vector a
forall a b. (a -> b) -> a -> b
$ General height width a
-> Vector
     (Omni Unpacked Arbitrary Filled Filled Size Big Big height width) a
forall pack property lower upper meas vert horiz height width a.
ArrayMatrix
  pack property lower upper meas vert horiz height width a
-> OmniArray
     pack property lower upper meas vert horiz height width a
ArrMatrix.unwrap General height width a
a)


toHermitian ::
   (Class.Floating a) =>
   HMatrix.Herm a -> Matrix.Hermitian ShapeInt a
toHermitian :: Herm a -> Hermitian ShapeInt a
toHermitian =
   Array (Hermitian ShapeInt) a -> Hermitian ShapeInt a
forall pack prop lower upper meas vert horiz height width shape a.
(FromPlain pack prop lower upper meas vert horiz height width,
 Plain pack prop lower upper meas vert horiz height width ~ shape,
 Measure meas, C vert, C horiz, C height, C width, Floating a) =>
Array shape a
-> ArrayMatrix pack prop lower upper meas vert horiz height width a
ArrMatrix.fromVector (Array (Hermitian ShapeInt) a -> Hermitian ShapeInt a)
-> (Herm a -> Array (Hermitian ShapeInt) a)
-> Herm a
-> Hermitian ShapeInt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (UpperTriangular ShapeInt) a -> Array (Hermitian ShapeInt) a
forall sh a. Array (UpperTriangular sh) a -> Array (Hermitian sh) a
hermitianFromUpper (Array (UpperTriangular ShapeInt) a
 -> Array (Hermitian ShapeInt) a)
-> (Herm a -> Array (UpperTriangular ShapeInt) a)
-> Herm a
-> Array (Hermitian ShapeInt) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayMatrix
  Packed Arbitrary Empty Filled Shape Small Small ShapeInt ShapeInt a
-> Array (UpperTriangular ShapeInt) a
forall pack property lower upper meas vert horiz height width a.
ToPlain pack property lower upper meas vert horiz height width =>
ArrayMatrix
  pack property lower upper meas vert horiz height width a
-> PlainArray
     pack property lower upper meas vert horiz height width a
ArrMatrix.toVector (ArrayMatrix
   Packed Arbitrary Empty Filled Shape Small Small ShapeInt ShapeInt a
 -> Array (UpperTriangular ShapeInt) a)
-> (Herm a
    -> ArrayMatrix
         Packed
         Arbitrary
         Empty
         Filled
         Shape
         Small
         Small
         ShapeInt
         ShapeInt
         a)
-> Herm a
-> Array (UpperTriangular ShapeInt) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Unpacked
  Arbitrary Filled Filled Shape Small Small ShapeInt ShapeInt a
-> ArrayMatrix
     Packed Arbitrary Empty Filled Shape Small Small ShapeInt ShapeInt a
forall property lower meas vert height width a.
(Property property, Strip lower, Measure meas, C vert, C height,
 C width, Floating a) =>
Unpacked property lower Filled meas vert Small height width a
-> Upper width a
Triangular.takeUpper (Unpacked
   Arbitrary Filled Filled Shape Small Small ShapeInt ShapeInt a
 -> ArrayMatrix
      Packed
      Arbitrary
      Empty
      Filled
      Shape
      Small
      Small
      ShapeInt
      ShapeInt
      a)
-> (Herm a
    -> Unpacked
         Arbitrary Filled Filled Shape Small Small ShapeInt ShapeInt a)
-> Herm a
-> ArrayMatrix
     Packed Arbitrary Empty Filled Shape Small Small ShapeInt ShapeInt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Full Size Big Big ShapeInt ShapeInt a
-> Unpacked
     Arbitrary Filled Filled Shape Small Small ShapeInt ShapeInt a
forall meas vert horiz sh a.
(Measure meas, C vert, C horiz, Eq sh) =>
Full meas vert horiz sh sh a -> Square sh a
Square.fromFull (Full Size Big Big ShapeInt ShapeInt a
 -> Unpacked
      Arbitrary Filled Filled Shape Small Small ShapeInt ShapeInt a)
-> (Herm a -> Full Size Big Big ShapeInt ShapeInt a)
-> Herm a
-> Unpacked
     Arbitrary Filled Filled Shape Small Small ShapeInt ShapeInt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> Full Size Big Big ShapeInt ShapeInt a
forall a. Floating a => Matrix a -> General ShapeInt ShapeInt a
toGeneral (Matrix a -> Full Size Big Big ShapeInt ShapeInt a)
-> (Herm a -> Matrix a)
-> Herm a
-> Full Size Big Big ShapeInt ShapeInt a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Herm a -> Matrix a
forall t. Herm t -> Matrix t
HMatrix.unSym

hermitianFromUpper ::
   Array (Layout.UpperTriangular sh) a -> Array (Layout.Hermitian sh) a
hermitianFromUpper :: Array (UpperTriangular sh) a -> Array (Hermitian sh) a
hermitianFromUpper =
   (UpperTriangular sh -> Hermitian sh)
-> Array (UpperTriangular sh) a -> Array (Hermitian sh) a
forall sh0 sh1 a. (sh0 -> sh1) -> Array sh0 a -> Array sh1 a
Array.mapShape (\UpperTriangular sh
sh -> UpperTriangular sh
sh{mosaicMirror :: MirrorSingleton ConjugateMirror
Layout.mosaicMirror = MirrorSingleton ConjugateMirror
Layout.ConjugateMirror})

-- ToDo: generalize packing
fromHermitian ::
   (Shape.C sh, Class.Floating a) =>
   Matrix.Hermitian sh a -> HMatrix.Herm a
--   Matrix.HermitianP pack sh a -> HMatrix.Herm a
fromHermitian :: Hermitian sh a -> Herm a
fromHermitian =
   Matrix a -> Herm a
forall t. Matrix t -> Herm t
HMatrix.trustSym (Matrix a -> Herm a)
-> (Hermitian sh a -> Matrix a) -> Hermitian sh a -> Herm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. General sh sh a -> Matrix a
forall height width a.
(C height, C width, Storable a) =>
General height width a -> Matrix a
fromGeneral (General sh sh a -> Matrix a)
-> (Hermitian sh a -> General sh sh a)
-> Hermitian sh a
-> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Square sh a -> General sh sh a
forall meas vert horiz sh a.
(Measured meas vert, Measured meas horiz) =>
Square sh a -> Full meas vert horiz sh sh a
Square.toFull (Square sh a -> General sh sh a)
-> (Hermitian sh a -> Square sh a)
-> Hermitian sh a
-> General sh sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hermitian sh a -> Square sh a
forall pack neg zero pos sh a.
(Packing pack, C neg, C zero, C pos, C sh, Floating a) =>
FlexHermitianP pack neg zero pos sh a -> Square sh a
Hermitian.toSquare


fromOrder :: Layout.Order -> HMatrixDevel.MatrixOrder
fromOrder :: Order -> MatrixOrder
fromOrder Order
order =
   case Order
order of
      Order
Layout.RowMajor -> MatrixOrder
HMatrixDevel.RowMajor
      Order
Layout.ColumnMajor -> MatrixOrder
HMatrixDevel.ColumnMajor

toOrder :: HMatrixDevel.MatrixOrder -> Layout.Order
toOrder :: MatrixOrder -> Order
toOrder MatrixOrder
order =
   case MatrixOrder
order of
      MatrixOrder
HMatrixDevel.RowMajor -> Order
Layout.RowMajor
      MatrixOrder
HMatrixDevel.ColumnMajor -> Order
Layout.ColumnMajor