{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
module Numeric.LAPACK.Matrix.Shape (
   module Numeric.LAPACK.Matrix.Shape,
   Layout.Order(..),
   Layout.flipOrder,
   Omni.height,
   Omni.width,
   Omni.extent,
   Omni.squareSize,
   Omni.order,
   Omni.TriDiag,
   Omni.DiagSingleton(..),
   Omni.Property,
   Omni.PowerStrip,
   Omni.PowerStripSingleton(..),
   Omni.powerStripSingleton,
   Omni.Strip,
   Omni.StripSingleton(..),
   Omni.stripSingleton,
   Arbitrary,
   Unit,
   LayoutPriv.Filled,
   LayoutPriv.Empty,
   Bands,
   Layout.addOffDiagonals,
   Layout.Packing,
   Layout.Packed,
   Layout.Unpacked,
   ) where

import qualified Numeric.LAPACK.Matrix.Shape.Omni as Omni
import qualified Numeric.LAPACK.Matrix.Layout.Private as LayoutPriv
import qualified Numeric.LAPACK.Matrix.Layout as Layout
import Numeric.LAPACK.Matrix.Shape.Omni (Omni(..), Arbitrary, Unit)
import Numeric.LAPACK.Matrix.Layout.Private
         (Bands, UnaryProxy, Empty, Filled, Order, Packed, Unpacked)
import Numeric.LAPACK.Matrix.Extent.Private (Small, Big, Shape, Size)

import qualified Data.Array.Comfort.Shape as Shape

import qualified Type.Data.Num.Unary.Literal as TypeNum
import qualified Type.Data.Num.Unary as Unary
import Type.Base.Proxy (Proxy(Proxy))


type Full = Omni Unpacked Arbitrary Filled Filled

type General = Full Size Big Big

general :: Order -> height -> width -> General height width
general :: forall height width.
Order -> height -> width -> General height width
general Order
order height
height width
width =
   Full Size Big Big height width
-> Omni Unpacked Arbitrary Filled Filled Size Big Big height width
forall property lower upper meas vert horiz height width.
(Property property, Strip lower, Strip upper) =>
Full meas vert horiz height width
-> Omni Unpacked property lower upper meas vert horiz height width
Full (Full Size Big Big height width
 -> Omni Unpacked Arbitrary Filled Filled Size Big Big height width)
-> Full Size Big Big height width
-> Omni Unpacked Arbitrary Filled Filled Size Big Big height width
forall a b. (a -> b) -> a -> b
$ Order -> height -> width -> Full Size Big Big height width
forall height width.
Order -> height -> width -> General height width
Layout.general Order
order height
height width
width

type Tall = Full Size Big Small

tall ::
   (Shape.C height, Shape.C width) =>
   Order -> height -> width -> Tall height width
tall :: forall height width.
(C height, C width) =>
Order -> height -> width -> Tall height width
tall Order
order height
height width
width =
   Full Size Big Small height width
-> Omni
     Unpacked Arbitrary Filled Filled Size Big Small height width
forall property lower upper meas vert horiz height width.
(Property property, Strip lower, Strip upper) =>
Full meas vert horiz height width
-> Omni Unpacked property lower upper meas vert horiz height width
Full (Full Size Big Small height width
 -> Omni
      Unpacked Arbitrary Filled Filled Size Big Small height width)
-> Full Size Big Small height width
-> Omni
     Unpacked Arbitrary Filled Filled Size Big Small height width
forall a b. (a -> b) -> a -> b
$ Order -> height -> width -> Full Size Big Small height width
forall height width.
(C height, C width) =>
Order -> height -> width -> Tall height width
Layout.tall Order
order height
height width
width

type Wide = Full Size Small Big

wide ::
   (Shape.C height, Shape.C width) =>
   Order -> height -> width -> Wide height width
wide :: forall height width.
(C height, C width) =>
Order -> height -> width -> Wide height width
wide Order
order height
height width
width =
   Full Size Small Big height width
-> Omni
     Unpacked Arbitrary Filled Filled Size Small Big height width
forall property lower upper meas vert horiz height width.
(Property property, Strip lower, Strip upper) =>
Full meas vert horiz height width
-> Omni Unpacked property lower upper meas vert horiz height width
Full (Full Size Small Big height width
 -> Omni
      Unpacked Arbitrary Filled Filled Size Small Big height width)
-> Full Size Small Big height width
-> Omni
     Unpacked Arbitrary Filled Filled Size Small Big height width
forall a b. (a -> b) -> a -> b
$ Order -> height -> width -> Full Size Small Big height width
forall height width.
(C height, C width) =>
Order -> height -> width -> Wide height width
Layout.wide Order
order height
height width
width

type LiberalSquare = Full Size Small Small

liberalSquare ::
   (Shape.C height, Shape.C width) =>
   Order -> height -> width -> LiberalSquare height width
liberalSquare :: forall height width.
(C height, C width) =>
Order -> height -> width -> LiberalSquare height width
liberalSquare Order
order height
height width
width =
   Full Size Small Small height width
-> Omni
     Unpacked Arbitrary Filled Filled Size Small Small height width
forall property lower upper meas vert horiz height width.
(Property property, Strip lower, Strip upper) =>
Full meas vert horiz height width
-> Omni Unpacked property lower upper meas vert horiz height width
Full (Full Size Small Small height width
 -> Omni
      Unpacked Arbitrary Filled Filled Size Small Small height width)
-> Full Size Small Small height width
-> Omni
     Unpacked Arbitrary Filled Filled Size Small Small height width
forall a b. (a -> b) -> a -> b
$ Order -> height -> width -> Full Size Small Small height width
forall height width.
(C height, C width) =>
Order -> height -> width -> LiberalSquare height width
Layout.liberalSquare Order
order height
height width
width

type Square sh = Full Shape Small Small sh sh

square :: (Shape.C sh) => Order -> sh -> Square sh
square :: forall sh. C sh => Order -> sh -> Square sh
square Order
order sh
sh = Full Shape Small Small sh sh
-> Omni Unpacked Arbitrary Filled Filled Shape Small Small sh sh
forall property lower upper meas vert horiz height width.
(Property property, Strip lower, Strip upper) =>
Full meas vert horiz height width
-> Omni Unpacked property lower upper meas vert horiz height width
Full (Full Shape Small Small sh sh
 -> Omni Unpacked Arbitrary Filled Filled Shape Small Small sh sh)
-> Full Shape Small Small sh sh
-> Omni Unpacked Arbitrary Filled Filled Shape Small Small sh sh
forall a b. (a -> b) -> a -> b
$ Order -> sh -> Full Shape Small Small sh sh
forall sh. Order -> sh -> Square sh
Layout.square Order
order sh
sh


type Quadratic pack property lower upper size =
      QuadraticMeas pack property lower upper Shape size size
type QuadraticMeas pack property lower upper meas height width =
      Omni pack property lower upper meas Small Small height width

type Hermitian size =
      Quadratic Packed Omni.HermitianUnknownDefiniteness Filled Filled size

hermitian :: Order -> sh -> Hermitian sh
hermitian :: forall sh. Order -> sh -> Hermitian sh
hermitian Order
order sh
size = Hermitian sh
-> Omni
     Packed
     (Hermitian True True True)
     Filled
     Filled
     Shape
     Small
     Small
     sh
     sh
forall neg zero pos height.
(C neg, C zero, C pos) =>
Hermitian height
-> Omni
     Packed
     (Hermitian neg zero pos)
     Filled
     Filled
     Shape
     Small
     Small
     height
     height
Hermitian (Hermitian sh
 -> Omni
      Packed
      (Hermitian True True True)
      Filled
      Filled
      Shape
      Small
      Small
      sh
      sh)
-> Hermitian sh
-> Omni
     Packed
     (Hermitian True True True)
     Filled
     Filled
     Shape
     Small
     Small
     sh
     sh
forall a b. (a -> b) -> a -> b
$ Order -> sh -> Hermitian sh
forall size. Order -> size -> Hermitian size
Layout.hermitian Order
order sh
size


type Diagonal size = Quadratic Packed Arbitrary Empty Empty size

diagonal :: Order -> size -> Diagonal size
diagonal :: forall size. Order -> size -> Diagonal size
diagonal Order
order size
size =
   Banded U0 U0 Shape Small Small size size
-> Omni
     Packed Arbitrary (Bands U0) (Bands U0) Shape Small Small size size
forall sub super meas vert horiz height width.
(Natural sub, Natural super) =>
Banded sub super meas vert horiz height width
-> Omni
     Packed
     Arbitrary
     (Bands sub)
     (Bands super)
     meas
     vert
     horiz
     height
     width
Banded (Banded U0 U0 Shape Small Small size size
 -> Omni
      Packed Arbitrary (Bands U0) (Bands U0) Shape Small Small size size)
-> Banded U0 U0 Shape Small Small size size
-> Omni
     Packed Arbitrary (Bands U0) (Bands U0) Shape Small Small size size
forall a b. (a -> b) -> a -> b
$
   (UnaryProxy U0, UnaryProxy U0)
-> Order -> size -> Banded U0 U0 Shape Small Small size size
forall sub super size.
(UnaryProxy sub, UnaryProxy super)
-> Order -> size -> BandedSquare sub super size
Layout.bandedSquare
      (Proxy U0 -> UnaryProxy U0
forall n. Proxy n -> Proxy (Un n)
Unary.unary Proxy U0
Unary.zero, Proxy U0 -> UnaryProxy U0
forall n. Proxy n -> Proxy (Un n)
Unary.unary Proxy U0
Unary.zero) Order
order size
size

type Identity size = Quadratic Packed Unit Empty Empty size

identity :: Order -> size -> Identity size
identity :: forall size. Order -> size -> Identity size
identity Order
order size
size =
   BandedSquare U0 U0 size
-> Omni
     Packed Unit (Bands U0) (Bands U0) Shape Small Small size size
forall sub super height.
(BandedTriangular sub super, BandedTriangular super sub) =>
BandedSquare sub super height
-> Omni
     Packed
     Unit
     (Bands sub)
     (Bands super)
     Shape
     Small
     Small
     height
     height
UnitBandedTriangular (BandedSquare U0 U0 size
 -> Omni
      Packed Unit (Bands U0) (Bands U0) Shape Small Small size size)
-> BandedSquare U0 U0 size
-> Omni
     Packed Unit (Bands U0) (Bands U0) Shape Small Small size size
forall a b. (a -> b) -> a -> b
$
   (UnaryProxy U0, UnaryProxy U0)
-> Order -> size -> BandedSquare U0 U0 size
forall sub super size.
(UnaryProxy sub, UnaryProxy super)
-> Order -> size -> BandedSquare sub super size
Layout.bandedSquare
      (Proxy U0 -> UnaryProxy U0
forall n. Proxy n -> Proxy (Un n)
Unary.unary Proxy U0
Unary.zero, Proxy U0 -> UnaryProxy U0
forall n. Proxy n -> Proxy (Un n)
Unary.unary Proxy U0
Unary.zero) Order
order size
size



type UpLo lo up = (UpLoC lo up, UpLoC up lo)

class (DiagUpLoC lo up) => UpLoC lo up where
   switchUpLo :: f Empty Filled -> f Filled Empty -> f lo up

instance UpLoC Empty  Filled where switchUpLo :: forall (f :: * -> * -> *).
f (Bands U0) Filled -> f Filled (Bands U0) -> f (Bands U0) Filled
switchUpLo f (Bands U0) Filled
f f Filled (Bands U0)
_ = f (Bands U0) Filled
f
instance UpLoC Filled Empty  where switchUpLo :: forall (f :: * -> * -> *).
f (Bands U0) Filled -> f Filled (Bands U0) -> f Filled (Bands U0)
switchUpLo f (Bands U0) Filled
_ f Filled (Bands U0)
f = f Filled (Bands U0)
f


type DiagUpLo lo up = (DiagUpLoC lo up, DiagUpLoC up lo)

class (Omni.PowerStrip lo, Omni.PowerStrip up) => DiagUpLoC lo up where
   switchDiagUpLo ::
      f Empty Empty -> f Empty Filled -> f Filled Empty -> f lo up

instance DiagUpLoC Empty  Empty  where switchDiagUpLo :: forall (f :: * -> * -> *).
f (Bands U0) (Bands U0)
-> f (Bands U0) Filled
-> f Filled (Bands U0)
-> f (Bands U0) (Bands U0)
switchDiagUpLo f (Bands U0) (Bands U0)
f f (Bands U0) Filled
_ f Filled (Bands U0)
_ = f (Bands U0) (Bands U0)
f
instance DiagUpLoC Empty  Filled where switchDiagUpLo :: forall (f :: * -> * -> *).
f (Bands U0) (Bands U0)
-> f (Bands U0) Filled
-> f Filled (Bands U0)
-> f (Bands U0) Filled
switchDiagUpLo f (Bands U0) (Bands U0)
_ f (Bands U0) Filled
f f Filled (Bands U0)
_ = f (Bands U0) Filled
f
instance DiagUpLoC Filled Empty  where switchDiagUpLo :: forall (f :: * -> * -> *).
f (Bands U0) (Bands U0)
-> f (Bands U0) Filled
-> f Filled (Bands U0)
-> f Filled (Bands U0)
switchDiagUpLo f (Bands U0) (Bands U0)
_ f (Bands U0) Filled
_ f Filled (Bands U0)
f = f Filled (Bands U0)
f


data UpLoSingleton lo up where
   Lower :: UpLoSingleton Filled Empty
   Upper :: UpLoSingleton Empty Filled

autoUplo :: (UpLo lo up) => UpLoSingleton lo up
autoUplo :: forall lo up. UpLo lo up => UpLoSingleton lo up
autoUplo = UpLoSingleton (Bands U0) Filled
-> UpLoSingleton Filled (Bands U0) -> UpLoSingleton lo up
forall lo up (f :: * -> * -> *).
UpLoC lo up =>
f (Bands U0) Filled -> f Filled (Bands U0) -> f lo up
forall (f :: * -> * -> *).
f (Bands U0) Filled -> f Filled (Bands U0) -> f lo up
switchUpLo UpLoSingleton (Bands U0) Filled
Upper UpLoSingleton Filled (Bands U0)
Lower



type Triangular lo diag up size = Quadratic Packed diag lo up size

triangular ::
   (DiagUpLo lo up, Omni.TriDiag diag) =>
   Order -> size -> Triangular lo diag up size
triangular :: forall lo up diag size.
(DiagUpLo lo up, TriDiag diag) =>
Order -> size -> Triangular lo diag up size
triangular Order
order size
size =
   GenTriangularDiag lo up size Any diag -> Triangular lo diag up size
forall lo up size a diag.
GenTriangularDiag lo up size a diag -> Triangular lo diag up size
runGenTriangularDiag (GenTriangularDiag lo up size Any diag
 -> Triangular lo diag up size)
-> GenTriangularDiag lo up size Any diag
-> Triangular lo diag up size
forall a b. (a -> b) -> a -> b
$
   GenTriangularDiag lo up size Any Unit
-> GenTriangularDiag lo up size Any Arbitrary
-> GenTriangularDiag lo up size Any diag
forall diag (f :: * -> *).
TriDiag diag =>
f Unit -> f Arbitrary -> f diag
forall (f :: * -> *). f Unit -> f Arbitrary -> f diag
Omni.switchTriDiag
      (Triangular lo Unit up size -> GenTriangularDiag lo up size Any Unit
forall lo up size a diag.
Triangular lo diag up size -> GenTriangularDiag lo up size a diag
GenTriangularDiag (Triangular lo Unit up size
 -> GenTriangularDiag lo up size Any Unit)
-> Triangular lo Unit up size
-> GenTriangularDiag lo up size Any Unit
forall a b. (a -> b) -> a -> b
$ Order -> size -> Triangular lo Unit up size
forall lo up size.
DiagUpLo lo up =>
Order -> size -> Triangular lo Unit up size
unitTriangular Order
order size
size)
      (Triangular lo Arbitrary up size
-> GenTriangularDiag lo up size Any Arbitrary
forall lo up size a diag.
Triangular lo diag up size -> GenTriangularDiag lo up size a diag
GenTriangularDiag (Triangular lo Arbitrary up size
 -> GenTriangularDiag lo up size Any Arbitrary)
-> Triangular lo Arbitrary up size
-> GenTriangularDiag lo up size Any Arbitrary
forall a b. (a -> b) -> a -> b
$ Order -> size -> Triangular lo Arbitrary up size
forall lo up size.
DiagUpLo lo up =>
Order -> size -> Triangular lo Arbitrary up size
arbitraryTriangular Order
order size
size)

unitTriangular ::
   (DiagUpLo lo up) =>
   Order -> size -> Triangular lo Unit up size
unitTriangular :: forall lo up size.
DiagUpLo lo up =>
Order -> size -> Triangular lo Unit up size
unitTriangular Order
order size
size =
   GenTriangularLoUp Unit size Any lo up -> Triangular lo Unit up size
forall diag size a lo up.
GenTriangularLoUp diag size a lo up -> Triangular lo diag up size
runGenTriangularLoUp (GenTriangularLoUp Unit size Any lo up
 -> Triangular lo Unit up size)
-> GenTriangularLoUp Unit size Any lo up
-> Triangular lo Unit up size
forall a b. (a -> b) -> a -> b
$
   GenTriangularLoUp Unit size Any (Bands U0) (Bands U0)
-> GenTriangularLoUp Unit size Any (Bands U0) Filled
-> GenTriangularLoUp Unit size Any Filled (Bands U0)
-> GenTriangularLoUp Unit size Any lo up
forall lo up (f :: * -> * -> *).
DiagUpLoC lo up =>
f (Bands U0) (Bands U0)
-> f (Bands U0) Filled -> f Filled (Bands U0) -> f lo up
forall (f :: * -> * -> *).
f (Bands U0) (Bands U0)
-> f (Bands U0) Filled -> f Filled (Bands U0) -> f lo up
switchDiagUpLo
      (Triangular (Bands U0) Unit (Bands U0) size
-> GenTriangularLoUp Unit size Any (Bands U0) (Bands U0)
forall diag size a lo up.
Triangular lo diag up size -> GenTriangularLoUp diag size a lo up
GenTriangularLoUp (Triangular (Bands U0) Unit (Bands U0) size
 -> GenTriangularLoUp Unit size Any (Bands U0) (Bands U0))
-> Triangular (Bands U0) Unit (Bands U0) size
-> GenTriangularLoUp Unit size Any (Bands U0) (Bands U0)
forall a b. (a -> b) -> a -> b
$ Order -> size -> Triangular (Bands U0) Unit (Bands U0) size
forall size. Order -> size -> Identity size
identity Order
order size
size)
      (Triangular (Bands U0) Unit Filled size
-> GenTriangularLoUp Unit size Any (Bands U0) Filled
forall diag size a lo up.
Triangular lo diag up size -> GenTriangularLoUp diag size a lo up
GenTriangularLoUp (Triangular (Bands U0) Unit Filled size
 -> GenTriangularLoUp Unit size Any (Bands U0) Filled)
-> Triangular (Bands U0) Unit Filled size
-> GenTriangularLoUp Unit size Any (Bands U0) Filled
forall a b. (a -> b) -> a -> b
$ UpperTriangular size -> Triangular (Bands U0) Unit Filled size
forall property height.
TriDiag property =>
UpperTriangular height
-> Omni
     Packed property (Bands U0) Filled Shape Small Small height height
UpperTriangular (UpperTriangular size -> Triangular (Bands U0) Unit Filled size)
-> UpperTriangular size -> Triangular (Bands U0) Unit Filled size
forall a b. (a -> b) -> a -> b
$
       Order -> size -> UpperTriangular size
forall size. Order -> size -> UpperTriangular size
Layout.upperTriangular Order
order size
size)
      (Triangular Filled Unit (Bands U0) size
-> GenTriangularLoUp Unit size Any Filled (Bands U0)
forall diag size a lo up.
Triangular lo diag up size -> GenTriangularLoUp diag size a lo up
GenTriangularLoUp (Triangular Filled Unit (Bands U0) size
 -> GenTriangularLoUp Unit size Any Filled (Bands U0))
-> Triangular Filled Unit (Bands U0) size
-> GenTriangularLoUp Unit size Any Filled (Bands U0)
forall a b. (a -> b) -> a -> b
$ LowerTriangular size -> Triangular Filled Unit (Bands U0) size
forall property height.
TriDiag property =>
LowerTriangular height
-> Omni
     Packed property Filled (Bands U0) Shape Small Small height height
LowerTriangular (LowerTriangular size -> Triangular Filled Unit (Bands U0) size)
-> LowerTriangular size -> Triangular Filled Unit (Bands U0) size
forall a b. (a -> b) -> a -> b
$
       Order -> size -> LowerTriangular size
forall size. Order -> size -> LowerTriangular size
Layout.lowerTriangular Order
order size
size)

arbitraryTriangular ::
   (DiagUpLo lo up) =>
   Order -> size -> Triangular lo Arbitrary up size
arbitraryTriangular :: forall lo up size.
DiagUpLo lo up =>
Order -> size -> Triangular lo Arbitrary up size
arbitraryTriangular Order
order size
size =
   GenTriangularLoUp Arbitrary size Any lo up
-> Triangular lo Arbitrary up size
forall diag size a lo up.
GenTriangularLoUp diag size a lo up -> Triangular lo diag up size
runGenTriangularLoUp (GenTriangularLoUp Arbitrary size Any lo up
 -> Triangular lo Arbitrary up size)
-> GenTriangularLoUp Arbitrary size Any lo up
-> Triangular lo Arbitrary up size
forall a b. (a -> b) -> a -> b
$
   GenTriangularLoUp Arbitrary size Any (Bands U0) (Bands U0)
-> GenTriangularLoUp Arbitrary size Any (Bands U0) Filled
-> GenTriangularLoUp Arbitrary size Any Filled (Bands U0)
-> GenTriangularLoUp Arbitrary size Any lo up
forall lo up (f :: * -> * -> *).
DiagUpLoC lo up =>
f (Bands U0) (Bands U0)
-> f (Bands U0) Filled -> f Filled (Bands U0) -> f lo up
forall (f :: * -> * -> *).
f (Bands U0) (Bands U0)
-> f (Bands U0) Filled -> f Filled (Bands U0) -> f lo up
switchDiagUpLo
      (Triangular (Bands U0) Arbitrary (Bands U0) size
-> GenTriangularLoUp Arbitrary size Any (Bands U0) (Bands U0)
forall diag size a lo up.
Triangular lo diag up size -> GenTriangularLoUp diag size a lo up
GenTriangularLoUp (Triangular (Bands U0) Arbitrary (Bands U0) size
 -> GenTriangularLoUp Arbitrary size Any (Bands U0) (Bands U0))
-> Triangular (Bands U0) Arbitrary (Bands U0) size
-> GenTriangularLoUp Arbitrary size Any (Bands U0) (Bands U0)
forall a b. (a -> b) -> a -> b
$ Order -> size -> Triangular (Bands U0) Arbitrary (Bands U0) size
forall size. Order -> size -> Diagonal size
diagonal Order
order size
size)
      (Triangular (Bands U0) Arbitrary Filled size
-> GenTriangularLoUp Arbitrary size Any (Bands U0) Filled
forall diag size a lo up.
Triangular lo diag up size -> GenTriangularLoUp diag size a lo up
GenTriangularLoUp (Triangular (Bands U0) Arbitrary Filled size
 -> GenTriangularLoUp Arbitrary size Any (Bands U0) Filled)
-> Triangular (Bands U0) Arbitrary Filled size
-> GenTriangularLoUp Arbitrary size Any (Bands U0) Filled
forall a b. (a -> b) -> a -> b
$ Order -> size -> Triangular (Bands U0) Arbitrary Filled size
forall size. Order -> size -> UpperTriangular size
upperTriangular Order
order size
size)
      (Triangular Filled Arbitrary (Bands U0) size
-> GenTriangularLoUp Arbitrary size Any Filled (Bands U0)
forall diag size a lo up.
Triangular lo diag up size -> GenTriangularLoUp diag size a lo up
GenTriangularLoUp (Triangular Filled Arbitrary (Bands U0) size
 -> GenTriangularLoUp Arbitrary size Any Filled (Bands U0))
-> Triangular Filled Arbitrary (Bands U0) size
-> GenTriangularLoUp Arbitrary size Any Filled (Bands U0)
forall a b. (a -> b) -> a -> b
$ Order -> size -> Triangular Filled Arbitrary (Bands U0) size
forall size. Order -> size -> LowerTriangular size
lowerTriangular Order
order size
size)


newtype GenTriangularDiag lo up size a diag =
   GenTriangularDiag {
      forall lo up size a diag.
GenTriangularDiag lo up size a diag -> Triangular lo diag up size
runGenTriangularDiag :: Triangular lo diag up size
   }

newtype GenTriangularLoUp diag size a lo up =
   GenTriangularLoUp {
      forall diag size a lo up.
GenTriangularLoUp diag size a lo up -> Triangular lo diag up size
runGenTriangularLoUp :: Triangular lo diag up size
   }


type LowerTriangular size = Quadratic Packed Arbitrary Filled Empty size

lowerTriangular :: Order -> size -> LowerTriangular size
lowerTriangular :: forall size. Order -> size -> LowerTriangular size
lowerTriangular Order
order size
size =
   LowerTriangular size
-> Omni
     Packed Arbitrary Filled (Bands U0) Shape Small Small size size
forall property height.
TriDiag property =>
LowerTriangular height
-> Omni
     Packed property Filled (Bands U0) Shape Small Small height height
LowerTriangular (LowerTriangular size
 -> Omni
      Packed Arbitrary Filled (Bands U0) Shape Small Small size size)
-> LowerTriangular size
-> Omni
     Packed Arbitrary Filled (Bands U0) Shape Small Small size size
forall a b. (a -> b) -> a -> b
$ Order -> size -> LowerTriangular size
forall size. Order -> size -> LowerTriangular size
Layout.lowerTriangular Order
order size
size


type UpperTriangular size = Quadratic Packed Arbitrary Empty Filled size

upperTriangular :: Order -> size -> UpperTriangular size
upperTriangular :: forall size. Order -> size -> UpperTriangular size
upperTriangular Order
order size
size =
   UpperTriangular size
-> Omni
     Packed Arbitrary (Bands U0) Filled Shape Small Small size size
forall property height.
TriDiag property =>
UpperTriangular height
-> Omni
     Packed property (Bands U0) Filled Shape Small Small height height
UpperTriangular (UpperTriangular size
 -> Omni
      Packed Arbitrary (Bands U0) Filled Shape Small Small size size)
-> UpperTriangular size
-> Omni
     Packed Arbitrary (Bands U0) Filled Shape Small Small size size
forall a b. (a -> b) -> a -> b
$ Order -> size -> UpperTriangular size
forall size. Order -> size -> UpperTriangular size
Layout.upperTriangular Order
order size
size


type Symmetric size = Quadratic Packed Omni.Symmetric Filled Filled size

symmetric :: Order -> size -> Symmetric size
symmetric :: forall size. Order -> size -> Symmetric size
symmetric Order
order size
size = Symmetric size
-> Omni Packed Symmetric Filled Filled Shape Small Small size size
forall height.
Symmetric height
-> Omni
     Packed Symmetric Filled Filled Shape Small Small height height
Symmetric (Symmetric size
 -> Omni Packed Symmetric Filled Filled Shape Small Small size size)
-> Symmetric size
-> Omni Packed Symmetric Filled Filled Shape Small Small size size
forall a b. (a -> b) -> a -> b
$ Order -> size -> Symmetric size
forall size. Order -> size -> Symmetric size
Layout.symmetric Order
order size
size


type Banded sub super meas vert horiz =
      Omni Packed Arbitrary (Bands sub) (Bands super) meas vert horiz

bandedOffDiagonals ::
   Omni Packed property (Bands sub) (Bands super)
      meas vert horiz height width ->
   (UnaryProxy sub, UnaryProxy super)
bandedOffDiagonals :: forall property sub super meas vert horiz height width.
Omni
  Packed
  property
  (Bands sub)
  (Bands super)
  meas
  vert
  horiz
  height
  width
-> (UnaryProxy sub, UnaryProxy super)
bandedOffDiagonals Omni
  Packed
  property
  (Bands sub)
  (Bands super)
  meas
  vert
  horiz
  height
  width
_ = (Proxy (Un sub)
forall a. Proxy a
Proxy, Proxy (Un super)
forall a. Proxy a
Proxy)


type BandedGeneral sub super =
      Omni Packed Arbitrary (Bands sub) (Bands super) Size Big Big

bandedGeneral ::
   (Unary.Natural sub, Unary.Natural super,
    Shape.C height, Shape.C width) =>
   (UnaryProxy sub, UnaryProxy super) -> Order -> height -> width ->
   BandedGeneral sub super height width
bandedGeneral :: forall sub super height width.
(Natural sub, Natural super, C height, C width) =>
(UnaryProxy sub, UnaryProxy super)
-> Order -> height -> width -> BandedGeneral sub super height width
bandedGeneral (UnaryProxy sub, UnaryProxy super)
offDiag Order
order height
height width
width =
   Banded sub super Size Big Big height width
-> Omni
     Packed
     Arbitrary
     (Bands sub)
     (Bands super)
     Size
     Big
     Big
     height
     width
forall sub super meas vert horiz height width.
(Natural sub, Natural super) =>
Banded sub super meas vert horiz height width
-> Omni
     Packed
     Arbitrary
     (Bands sub)
     (Bands super)
     meas
     vert
     horiz
     height
     width
Banded (Banded sub super Size Big Big height width
 -> Omni
      Packed
      Arbitrary
      (Bands sub)
      (Bands super)
      Size
      Big
      Big
      height
      width)
-> Banded sub super Size Big Big height width
-> Omni
     Packed
     Arbitrary
     (Bands sub)
     (Bands super)
     Size
     Big
     Big
     height
     width
forall a b. (a -> b) -> a -> b
$ (UnaryProxy sub, UnaryProxy super)
-> Order
-> height
-> width
-> Banded sub super Size Big Big height width
forall sub super height width.
(UnaryProxy sub, UnaryProxy super)
-> Order -> height -> width -> BandedGeneral sub super height width
Layout.bandedGeneral (UnaryProxy sub, UnaryProxy super)
offDiag Order
order height
height width
width

type BandedTriangular sub super size =
      Quadratic Packed Arbitrary (Bands sub) (Bands super) size
type BandedLower sub size = BandedTriangular sub TypeNum.U0 size
type BandedUpper super size = BandedTriangular TypeNum.U0 super size

type BandedUnitTriangular sub super size =
      Quadratic Packed Unit (Bands sub) (Bands super) size
type BandedUnitLower sub size = BandedUnitTriangular sub TypeNum.U0 size
type BandedUnitUpper super size = BandedUnitTriangular TypeNum.U0 super size


type BandedHermitian offDiag size =
      Quadratic Packed Omni.HermitianUnknownDefiniteness
         (Bands offDiag) (Bands offDiag) size

bandedHermitian ::
   (Unary.Natural offDiag) =>
   UnaryProxy offDiag -> Order -> size -> BandedHermitian offDiag size
bandedHermitian :: forall offDiag size.
Natural offDiag =>
UnaryProxy offDiag -> Order -> size -> BandedHermitian offDiag size
bandedHermitian UnaryProxy offDiag
numOff Order
order size
size =
   BandedHermitian offDiag size
-> Omni
     Packed
     (Hermitian True True True)
     (Bands offDiag)
     (Bands offDiag)
     Shape
     Small
     Small
     size
     size
forall neg zero pos offDiag height.
(C neg, C zero, C pos, Natural offDiag) =>
BandedHermitian offDiag height
-> Omni
     Packed
     (Hermitian neg zero pos)
     (Bands offDiag)
     (Bands offDiag)
     Shape
     Small
     Small
     height
     height
BandedHermitian (BandedHermitian offDiag size
 -> Omni
      Packed
      (Hermitian True True True)
      (Bands offDiag)
      (Bands offDiag)
      Shape
      Small
      Small
      size
      size)
-> BandedHermitian offDiag size
-> Omni
     Packed
     (Hermitian True True True)
     (Bands offDiag)
     (Bands offDiag)
     Shape
     Small
     Small
     size
     size
forall a b. (a -> b) -> a -> b
$ UnaryProxy offDiag -> Order -> size -> BandedHermitian offDiag size
forall off size.
UnaryProxy off -> Order -> size -> BandedHermitian off size
Layout.bandedHermitian UnaryProxy offDiag
numOff Order
order size
size

-- | For Hermitian eigenvalues
type RealDiagonal size = BandedHermitian TypeNum.U0 size

{- | For singular values

However, diagonal matrices produced by singular value decomposition
may be non-square and Hermitian must be square.
-}
type PositiveDiagonal size =
      Quadratic Packed Omni.HermitianPositiveDefinite Empty Empty size


type
   UpperQuasitriangular size =
      Quadratic Unpacked Arbitrary (Bands TypeNum.U1) Filled size