{-# LANGUAGE TypeOperators #-}
{- |
Matrices that are assembled from smaller matrices.

We can nest block matrices,
but we still not have appropriate type classes for their multiplications.
E.g. a Square matrix with more than 2x2 blocks would have
the top-level structure:

> Quadratic   Block.Beside
> Block.Above Block.Square

Thus we would need
e.g. multiplication Beside times Above with Quadratic result
and multiplication Beside times Square with Above result.
-}
module Numeric.LAPACK.Matrix.Block (
   Matrix(Diagonal, Above, Beside, Square, Upper, Lower, Symmetric),
   Diagonal,
   Above, Beside, Block.aboveFromFull, Block.besideFromFull,
   Square,
   LowerTriangular, UpperTriangular,
   Symmetric, Block.squareFromSymmetric, Block.schurComplement,
   ) where

import qualified Numeric.LAPACK.Matrix.Block.Private as Block
import Numeric.LAPACK.Matrix.Type.Private (Matrix, Quadratic)
import Numeric.LAPACK.Matrix.Layout.Private (Filled)
import Numeric.LAPACK.Matrix.Extent.Private (Size, Big)

import Data.Array.Comfort.Shape ((::+))

import qualified Type.Data.Bool as TBool


type Diagonal typ0 xl0 xu0 typ1 xl1 xu1 lower upper sh0 sh1 =
      Quadratic
         (Block.Diagonal typ0 typ1) (xl0,xl1) (xu0,xu1)
         lower upper (sh0::+sh1)

type Square typ00 xl00 xu00 typ01 xl01 xu01 typ10 xl10 xu10 typ11 xl11 xu11
         measOff vertOff horizOff sh0 sh1 =
      Quadratic
         (Block.Square typ00 measOff vertOff horizOff typ11)
         (xl00,xl11,(typ10,xl10,xu10))
         (xu00,xu11,(typ01,xu01,xl01))
         Filled Filled (sh0::+sh1)

type Above typ0 xl0 xu0 typ1 xl1 xu1 horiz height0 height1 width =
      Matrix
         (Block.Append typ0 typ1 height0 height1)
         (xl0,xl1,TBool.False) (xu0,xu1,TBool.True)
         Filled Filled Size Big horiz (height0::+height1) width

type Beside typ0 xl0 xu0 typ1 xl1 xu1 vert height width0 width1 =
      Matrix
         (Block.Append typ0 typ1 width0 width1)
         (xl0,xl1,TBool.True) (xu0,xu1,TBool.False)
         Filled Filled Size vert Big height (width0::+width1)

type UpperTriangular typ0 xl0 xu0 typOff xlOff xuOff typ1 xl1 xu1
         lower sh0 sh1 =
      Quadratic
         (Block.Triangular typ0 typOff typ1)
         (xl0,xlOff,xl1,TBool.False) (xu0,xuOff,xu1,TBool.True)
         lower Filled (sh0::+sh1)

type LowerTriangular typ0 xl0 xu0 typOff xlOff xuOff typ1 xl1 xu1
         upper sh0 sh1 =
      Quadratic
         (Block.Triangular typ0 typOff typ1)
         (xl0,xlOff,xl1,TBool.True) (xu0,xuOff,xu1,TBool.False)
         Filled upper (sh0::+sh1)

type Symmetric typ0 xl0 xu0 typOff xlOff xuOff typ1 xl1 xu1 sh0 sh1 =
      Quadratic
         (Block.Symmetric typ0 typOff xlOff xuOff typ1)
         (xl0,xl1) (xu0,xu1)
         Filled Filled (sh0::+sh1)