{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE EmptyDataDecls #-}
module Numeric.LAPACK.Matrix.Inverse where

import qualified Numeric.LAPACK.Matrix.Type as Type
import qualified Numeric.LAPACK.Matrix.Class as MatrixClass
import qualified Numeric.LAPACK.Matrix.Divide as Divide
import qualified Numeric.LAPACK.Matrix.Multiply as Multiply
import Numeric.LAPACK.Matrix.Divide ((#\|), (-/#))


data Inverse typ
newtype instance Type.Matrix (Inverse typ) a = Inverse (Type.Matrix typ a)


instance (Type.MultiplySame typ) => Type.MultiplySame (Inverse typ) where
   multiplySame (Inverse a) (Inverse b) = Inverse $ Type.multiplySame b a

instance (Type.Box typ) => Type.Box (Inverse typ) where
   type HeightOf (Inverse typ) = Type.HeightOf typ
   type WidthOf (Inverse typ) = Type.WidthOf typ
   height (Inverse m) = Type.height m
   width (Inverse m) = Type.width m

instance (MatrixClass.Complex typ) => MatrixClass.Complex (Inverse typ) where
   conjugate (Inverse m) = Inverse $ MatrixClass.conjugate m
   fromReal (Inverse m) = Inverse $ MatrixClass.fromReal m
   toComplex (Inverse m) = Inverse $ MatrixClass.toComplex m


instance (Divide.Solve typ) => Multiply.MultiplyVector (Inverse typ) where
   matrixVector (Inverse a) x = a#\|x
   vectorMatrix x (Inverse a) = x-/#a

instance (Divide.Solve typ) => Multiply.MultiplySquare (Inverse typ) where
   transposableSquare trans (Inverse a) b = Divide.solve trans a b
   squareFull (Inverse a) b = Divide.solveRight a b
   fullSquare b (Inverse a) = Divide.solveLeft b a

instance (Multiply.Power typ) => Multiply.Power (Inverse typ) where
   square (Inverse a) = Inverse $ Multiply.square a
   power n (Inverse a) = Inverse $ Multiply.power n a


instance (Divide.Determinant typ) => Divide.Determinant (Inverse typ) where
   determinant (Inverse a) = recip $ Divide.determinant a

instance (Multiply.MultiplySquare typ) => Divide.Solve (Inverse typ) where
   solve trans (Inverse a) b = Multiply.transposableSquare trans a b
   solveRight (Inverse a) b = Multiply.squareFull a b
   solveLeft b (Inverse a) = Multiply.fullSquare b a

instance
   (Divide.Inverse typ, Multiply.MultiplySquare typ) =>
      Divide.Inverse (Inverse typ) where
   inverse (Inverse a) = Inverse $ Divide.inverse a