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

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

   Mosaic(..),
   Packing(..), PackingSingleton(..), Packed, Unpacked,
   Mirror(..), MirrorSingleton(..),
   autoUplo,
   Triangular,
   LowerTriangular, LowerTriangularP,
   lowerTriangular, lowerTriangularP,
   UpperTriangular, UpperTriangularP,
   upperTriangular, upperTriangularP,
   Symmetric,       SymmetricP,
   symmetric,       symmetricP,
   Hermitian,       HermitianP,
   hermitian,       hermitianP,

   Diagonal,
   diagonal,
   Banded(..),
   BandedGeneral,
   BandedSquare,
   BandedLowerTriangular,
   BandedUpperTriangular,
   BandedIndex(..),
   bandedGeneral,
   bandedSquare,
   bandedFromFull,
   UnaryProxy,
   addOffDiagonals,

   BandedHermitian(..),
   bandedHermitian,
   ) where

import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import Numeric.LAPACK.Matrix.Layout.Private


type SplitGeneral lower height width =
      Split lower Extent.Size 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 Size Big Big height width
-> SplitGeneral lower height width
forall lower meas vert horiz height width.
lower
-> Order
-> Extent meas vert horiz height width
-> Split lower meas vert horiz height width
Split lower
lowerPart Order
order (Extent Size Big Big height width
 -> SplitGeneral lower height width)
-> Extent Size Big Big height width
-> SplitGeneral lower height width
forall a b. (a -> b) -> a -> b
$ height -> width -> Extent Size Big Big height width
forall height width. height -> width -> General height width
Extent.general height
height width
width

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


diagonal :: Order -> size -> Diagonal size
diagonal :: Order -> size -> Diagonal size
diagonal Order
order = (UnaryProxy U0, UnaryProxy U0)
-> Order -> Extent Shape Small Small size size -> Diagonal size
forall sub super meas vert horiz height width.
(UnaryProxy sub, UnaryProxy super)
-> Order
-> Extent meas vert horiz height width
-> Banded sub super meas vert horiz height width
Banded (UnaryProxy U0
u0,UnaryProxy U0
u0) Order
order (Extent Shape Small Small size size -> Diagonal size)
-> (size -> Extent Shape Small Small size size)
-> size
-> Diagonal size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. size -> Extent Shape Small Small size size
forall sh. sh -> Square sh
Extent.square


bandedFromFull ::
   (UnaryProxy sub, UnaryProxy super) ->
   Full meas vert horiz height width ->
   Banded sub super meas vert horiz height width
bandedFromFull :: (UnaryProxy sub, UnaryProxy super)
-> Full meas vert horiz height width
-> Banded sub super meas vert horiz height width
bandedFromFull (UnaryProxy sub, UnaryProxy super)
offDiag (Full Order
order Extent meas vert horiz height width
extent) = (UnaryProxy sub, UnaryProxy super)
-> Order
-> Extent meas vert horiz height width
-> Banded sub super meas vert horiz height width
forall sub super meas vert horiz height width.
(UnaryProxy sub, UnaryProxy super)
-> Order
-> Extent meas vert horiz height width
-> Banded sub super meas vert horiz height width
Banded (UnaryProxy sub, UnaryProxy super)
offDiag Order
order Extent meas 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