module Numeric.LAPACK.Matrix.Shape (
   General,
   Tall,
   Wide,
   Square,
   Full(..), fullHeight, fullWidth,
   Order(..), flipOrder,
   general,
   square,
   wide,
   tall,

   Split,
   SplitGeneral,
   Triangle(..),
   Reflector(..),
   splitGeneral,
   splitFromFull,

   Hermitian(..),
   hermitian,

   Triangular(..),
   Identity,
   Diagonal,
   LowerTriangular,
   UpperTriangular,
   Symmetric,
   diagonal,
   lowerTriangular,
   upperTriangular,
   symmetric,
   autoDiag,
   autoUplo,
   DiagUpLo,
   switchDiagUpLo,
   switchDiagUpLoSym,
   TriDiag,
   switchTriDiag,
   Unit(Unit),
   NonUnit(NonUnit),

   Banded(..),
   BandedGeneral,
   BandedSquare,
   BandedLowerTriangular,
   BandedUpperTriangular,
   BandedDiagonal,
   BandedIndex(..),
   bandedGeneral,
   bandedSquare,
   bandedFromFull,
   UnaryProxy,
   addOffDiagonals,
   Content,

   BandedHermitian(..),
   bandedHermitian,

   Box.Box, Box.HeightOf, Box.WidthOf, Box.height, Box.width,
   ) where

import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import qualified Numeric.LAPACK.Matrix.Shape.Box as Box
import Numeric.LAPACK.Matrix.Shape.Private


type SplitGeneral lower height width =
      Split lower Extent.Big Extent.Big height width

splitGeneral ::
   lower -> Order -> height -> width -> SplitGeneral lower height width
splitGeneral :: lower
-> Order -> height -> width -> SplitGeneral lower height width
splitGeneral lower
lowerPart Order
order height
height width
width =
   lower
-> Order
-> Extent Big Big height width
-> SplitGeneral lower height width
forall lower vert horiz height width.
lower
-> Order
-> Extent vert horiz height width
-> Split lower vert horiz height width
Split lower
lowerPart Order
order (Extent Big Big height width -> SplitGeneral lower height width)
-> Extent Big Big height width -> SplitGeneral lower height width
forall a b. (a -> b) -> a -> b
$ height -> width -> Extent Big Big height width
forall height width. height -> width -> General height width
Extent.general height
height width
width

splitFromFull ::
   lower ->
   Full vert horiz height width ->
   Split lower vert horiz height width
splitFromFull :: lower
-> Full vert horiz height width
-> Split lower vert horiz height width
splitFromFull lower
lowerPart (Full Order
order Extent vert horiz height width
extent) = lower
-> Order
-> Extent vert horiz height width
-> Split lower vert horiz height width
forall lower vert horiz height width.
lower
-> Order
-> Extent vert horiz height width
-> Split lower vert horiz height width
Split lower
lowerPart Order
order Extent vert horiz height width
extent


diagonal :: Order -> size -> Triangular Empty NonUnit Empty size
diagonal :: Order -> size -> Triangular Empty NonUnit Empty size
diagonal = NonUnit
-> (Empty, Empty)
-> Order
-> size
-> Triangular Empty NonUnit Empty size
forall lo diag up size.
diag -> (lo, up) -> Order -> size -> Triangular lo diag up size
Triangular NonUnit
NonUnit (Empty, Empty)
forall lo up. (Content lo, Content up) => (lo, up)
autoUplo

lowerTriangular :: Order -> size -> LowerTriangular NonUnit size
lowerTriangular :: Order -> size -> LowerTriangular NonUnit size
lowerTriangular = NonUnit
-> (Filled, Empty) -> Order -> size -> LowerTriangular NonUnit size
forall lo diag up size.
diag -> (lo, up) -> Order -> size -> Triangular lo diag up size
Triangular NonUnit
NonUnit (Filled, Empty)
forall lo up. (Content lo, Content up) => (lo, up)
autoUplo

upperTriangular :: Order -> size -> UpperTriangular NonUnit size
upperTriangular :: Order -> size -> UpperTriangular NonUnit size
upperTriangular = NonUnit
-> (Empty, Filled) -> Order -> size -> UpperTriangular NonUnit size
forall lo diag up size.
diag -> (lo, up) -> Order -> size -> Triangular lo diag up size
Triangular NonUnit
NonUnit (Empty, Filled)
forall lo up. (Content lo, Content up) => (lo, up)
autoUplo

symmetric :: Order -> size -> Symmetric size
symmetric :: Order -> size -> Symmetric size
symmetric = NonUnit -> (Filled, Filled) -> Order -> size -> Symmetric size
forall lo diag up size.
diag -> (lo, up) -> Order -> size -> Triangular lo diag up size
Triangular NonUnit
NonUnit (Filled, Filled)
forall lo up. (Content lo, Content up) => (lo, up)
autoUplo

hermitian :: Order -> size -> Hermitian size
hermitian :: Order -> size -> Hermitian size
hermitian = Order -> size -> Hermitian size
forall size. Order -> size -> Hermitian size
Hermitian


bandedFromFull ::
   (UnaryProxy sub, UnaryProxy super) ->
   Full vert horiz height width ->
   Banded sub super vert horiz height width
bandedFromFull :: (UnaryProxy sub, UnaryProxy super)
-> Full vert horiz height width
-> Banded sub super vert horiz height width
bandedFromFull (UnaryProxy sub, UnaryProxy super)
offDiag (Full Order
order Extent vert horiz height width
extent) = (UnaryProxy sub, UnaryProxy super)
-> Order
-> Extent vert horiz height width
-> Banded sub super vert horiz height width
forall sub super vert horiz height width.
(UnaryProxy sub, UnaryProxy super)
-> Order
-> Extent vert horiz height width
-> Banded sub super vert horiz height width
Banded (UnaryProxy sub, UnaryProxy super)
offDiag Order
order Extent vert horiz height width
extent


bandedHermitian :: UnaryProxy off -> Order -> size -> BandedHermitian off size
bandedHermitian :: UnaryProxy off -> Order -> size -> BandedHermitian off size
bandedHermitian = UnaryProxy off -> Order -> size -> BandedHermitian off size
forall off size.
UnaryProxy off -> Order -> size -> BandedHermitian off size
BandedHermitian