{-# LANGUAGE TypeFamilies #-}
module Numeric.LAPACK.Matrix.Permutation (
   Permutation,
   size,
   identity,
   Mod.Inversion(NonInverted,Inverted),
   Perm.inversionFromTransposition,
   fromPermutation,
   toPermutation,
   toMatrix,
   determinant,
   transpose,
   multiplyVector,
   multiplyFull,
   ) where

import qualified Numeric.LAPACK.Matrix.Array as ArrMatrix
import qualified Numeric.LAPACK.Matrix.Shape.Private as MatrixShape
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import qualified Numeric.LAPACK.Matrix.Modifier as Mod
import qualified Numeric.LAPACK.Permutation as Perm
import Numeric.LAPACK.Permutation (Permutation)
import Numeric.LAPACK.Matrix.Type (Matrix(Permutation))
import Numeric.LAPACK.Vector (Vector)

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Shape as Shape


size :: Matrix (Permutation sh) a -> sh
size :: Matrix (Permutation sh) a -> sh
size (Permutation perm) = Permutation sh -> sh
forall sh. Permutation sh -> sh
Perm.size Permutation sh
perm

identity :: (Shape.C sh) => sh -> Matrix (Permutation sh) a
identity :: sh -> Matrix (Permutation sh) a
identity = Permutation sh -> Matrix (Permutation sh) a
forall sh a. Permutation sh -> Matrix (Permutation sh) a
Permutation (Permutation sh -> Matrix (Permutation sh) a)
-> (sh -> Permutation sh) -> sh -> Matrix (Permutation sh) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Permutation sh
forall sh. C sh => sh -> Permutation sh
Perm.identity

fromPermutation ::
   (Shape.C sh) => Perm.Permutation sh -> Matrix (Permutation sh) a
fromPermutation :: Permutation sh -> Matrix (Permutation sh) a
fromPermutation = Permutation sh -> Matrix (Permutation sh) a
forall sh a. Permutation sh -> Matrix (Permutation sh) a
Permutation

toPermutation ::
   (Shape.C sh) => Matrix (Permutation sh) a -> Perm.Permutation sh
toPermutation :: Matrix (Permutation sh) a -> Permutation sh
toPermutation (Permutation perm) = Permutation sh
perm

determinant :: (Shape.C sh, Class.Floating a) => Matrix (Permutation sh) a -> a
determinant :: Matrix (Permutation sh) a -> a
determinant (Permutation perm) = Sign -> a
forall a. Floating a => Sign -> a
Perm.numberFromSign (Sign -> a) -> Sign -> a
forall a b. (a -> b) -> a -> b
$ Permutation sh -> Sign
forall sh. C sh => Permutation sh -> Sign
Perm.determinant Permutation sh
perm


transpose ::
   (Shape.C sh) => Matrix (Permutation sh) a -> Matrix (Permutation sh) a
transpose :: Matrix (Permutation sh) a -> Matrix (Permutation sh) a
transpose (Permutation perm) = Permutation sh -> Matrix (Permutation sh) a
forall sh a. Permutation sh -> Matrix (Permutation sh) a
Permutation (Permutation sh -> Matrix (Permutation sh) a)
-> Permutation sh -> Matrix (Permutation sh) a
forall a b. (a -> b) -> a -> b
$ Permutation sh -> Permutation sh
forall sh. C sh => Permutation sh -> Permutation sh
Perm.transpose Permutation sh
perm

toMatrix ::
   (Shape.C sh, Class.Floating a) =>
   Matrix (Permutation sh) a -> ArrMatrix.Square sh a
toMatrix :: Matrix (Permutation sh) a -> Square sh a
toMatrix (Permutation perm) = Permutation sh -> Square sh a
forall sh a. (C sh, Floating a) => Permutation sh -> Square sh a
Perm.toMatrix Permutation sh
perm

multiplyVector ::
   (Shape.C size, Eq size, Class.Floating a) =>
   Mod.Inversion -> Matrix (Permutation size) a ->
   Vector size a -> Vector size a
multiplyVector :: Inversion
-> Matrix (Permutation size) a -> Vector size a -> Vector size a
multiplyVector Inversion
inverted (Permutation perm) =
   Order
-> (General size () a -> General size () a)
-> Vector size a
-> Vector size a
forall height0 a height1 b.
Order
-> (General height0 () a -> General height1 () b)
-> Vector height0 a
-> Vector height1 b
ArrMatrix.unliftColumn Order
MatrixShape.ColumnMajor (Inversion
-> Permutation size -> General size () a -> General size () a
forall vert horiz height width a.
(C vert, C horiz, C height, Eq height, C width, Floating a) =>
Inversion
-> Permutation height
-> Full vert horiz height width a
-> Full vert horiz height width a
Perm.apply Inversion
inverted Permutation size
perm)

multiplyFull ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Class.Floating a) =>
   Mod.Inversion -> Matrix (Permutation height) a ->
   ArrMatrix.Full vert horiz height width a ->
   ArrMatrix.Full vert horiz height width a
multiplyFull :: Inversion
-> Matrix (Permutation height) a
-> Full vert horiz height width a
-> Full vert horiz height width a
multiplyFull Inversion
inverted (Permutation perm) = Inversion
-> Permutation height
-> Full vert horiz height width a
-> Full vert horiz height width a
forall vert horiz height width a.
(C vert, C horiz, C height, Eq height, C width, Floating a) =>
Inversion
-> Permutation height
-> Full vert horiz height width a
-> Full vert horiz height width a
Perm.apply Inversion
inverted Permutation height
perm