{-# LANGUAGE TypeFamilies #-}
module Numeric.LAPACK.Matrix.Special (
   Matrix.Matrix(Scale,Inverse), Scale, Inverse, inverse,
   ) where

import qualified Numeric.LAPACK.Matrix.Inverse as Inverse
import qualified Numeric.LAPACK.Matrix.Type as Matrix
import qualified Numeric.LAPACK.Matrix.Shape.Omni as Omni
import Numeric.LAPACK.Matrix.Layout.Private (Empty, Filled)

import Data.Tuple.HT (mapPair)


type Scale sh = Matrix.Quadratic Matrix.Scale () () Empty Empty sh
type Inverse typ lower upper sh =
      Matrix.Quadratic (Inverse.Inverse typ) lower upper Filled Filled sh

inverse ::
   (Omni.Strip lower, Inverse.Fill lower ~ lowerf,
    Omni.Strip upper, Inverse.Fill upper ~ upperf) =>
   Matrix.QuadraticMeas typ xl xu upper lower meas width height a ->
   Matrix.QuadraticMeas (Inverse.Inverse typ) (xl,lower) (xu,upper)
      lowerf upperf meas height width a
inverse :: QuadraticMeas typ xl xu upper lower meas width height a
-> QuadraticMeas
     (Inverse typ)
     (xl, lower)
     (xu, upper)
     lowerf
     upperf
     meas
     height
     width
     a
inverse QuadraticMeas typ xl xu upper lower meas width height a
a =
   case (StripSingleton upper -> PowerStripFact upperf,
 StripSingleton lower -> PowerStripFact lowerf)
-> (StripSingleton upper, StripSingleton lower)
-> (PowerStripFact upperf, PowerStripFact lowerf)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (StripSingleton upper -> PowerStripFact upperf
forall c. Strip c => StripSingleton c -> PowerStripFact (Fill c)
Inverse.filledPowerStripFact, StripSingleton lower -> PowerStripFact lowerf
forall c. Strip c => StripSingleton c -> PowerStripFact (Fill c)
Inverse.filledPowerStripFact) ((StripSingleton upper, StripSingleton lower)
 -> (PowerStripFact upperf, PowerStripFact lowerf))
-> (StripSingleton upper, StripSingleton lower)
-> (PowerStripFact upperf, PowerStripFact lowerf)
forall a b. (a -> b) -> a -> b
$
        QuadraticMeas typ xl xu upper lower meas width height a
-> (StripSingleton upper, StripSingleton lower)
forall lower upper typ xl xu meas vert horiz height width a.
(Strip lower, Strip upper) =>
Matrix typ xl xu lower upper meas vert horiz height width a
-> (StripSingleton lower, StripSingleton upper)
Matrix.strips QuadraticMeas typ xl xu upper lower meas width height a
a of
      (PowerStripFact upperf
Inverse.PowerStripFact, PowerStripFact lowerf
Inverse.PowerStripFact) -> QuadraticMeas typ xl xu upper lower meas width height a
-> QuadraticMeas
     (Inverse typ)
     (xl, lower)
     (xu, upper)
     lowerf
     upperf
     meas
     height
     width
     a
forall lower lowerf upper upperf typ xl xu meas width height a.
(Strip lower, Fill lower ~ lowerf, PowerStrip lowerf, Strip upper,
 Fill upper ~ upperf, PowerStrip upperf) =>
QuadraticMeas typ xl xu upper lower meas width height a
-> QuadraticMeas
     (Inverse typ)
     (xl, lower)
     (xu, upper)
     lowerf
     upperf
     meas
     height
     width
     a
Inverse.Inverse QuadraticMeas typ xl xu upper lower meas width height a
a