module Numeric.LAPACK.Orthogonal.Householder (
   Basic.Householder,
   Basic.General,
   Basic.Tall,
   Basic.Wide,
   Basic.Square,
   Basic.mapExtent,
   fromMatrix,
   Basic.determinant,
   Basic.determinantAbsolute,
   leastSquares,
   minimumNorm,

   Mod.Transposition(..),
   Mod.Conjugation(..),
   extractQ,
   extractR,
   multiplyQ,

   tallExtractQ,
   tallExtractR,
   tallMultiplyQ,
   tallMultiplyQAdjoint,
   tallMultiplyR,
   tallSolveR,
   ) where

import qualified Numeric.LAPACK.Orthogonal.Private as Basic
import qualified Numeric.LAPACK.Matrix.Array as ArrMatrix
import qualified Numeric.LAPACK.Matrix.Extent as Extent
import qualified Numeric.LAPACK.Matrix.Modifier as Mod
import Numeric.LAPACK.Orthogonal.Private (Householder)
import Numeric.LAPACK.Matrix.Array.Triangular (Upper)
import Numeric.LAPACK.Matrix.Array (Full, Square)
import Numeric.LAPACK.Matrix.Modifier (Transposition, Conjugation)

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Shape as Shape


fromMatrix ::
   (Extent.C vert, Extent.C horiz, Shape.C height, Shape.C width,
    Class.Floating a) =>
   Full vert horiz height width a ->
   Householder vert horiz height width a
fromMatrix = Basic.fromMatrix . ArrMatrix.toVector

leastSquares ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Eq width, Shape.C nrhs,
    Class.Floating a) =>
   Householder horiz Extent.Small height width a ->
   Full vert horiz height nrhs a ->
   Full vert horiz width nrhs a
leastSquares = ArrMatrix.lift1 . Basic.leastSquares

{- |
@
HH.minimumNorm (HH.fromMatrix a) b
==
Ortho.minimumNorm (adjoint a) b
@
-}
minimumNorm ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Eq width, Shape.C nrhs,
    Class.Floating a) =>
   Householder vert Extent.Small width height a ->
   Full vert horiz height nrhs a ->
   Full vert horiz width nrhs a
minimumNorm = ArrMatrix.lift1 . Basic.minimumNorm


extractQ ::
   (Extent.C vert, Extent.C horiz, Shape.C height, Shape.C width,
    Class.Floating a) =>
   Householder vert horiz height width a -> Square height a
extractQ = ArrMatrix.lift0 . Basic.extractQ

tallExtractQ ::
   (Extent.C vert, Shape.C height, Shape.C width, Class.Floating a) =>
   Householder vert Extent.Small height width a ->
   Full vert Extent.Small height width a
tallExtractQ = ArrMatrix.lift0 . Basic.tallExtractQ


tallMultiplyQ ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Shape.C fuse, Eq fuse,
    Class.Floating a) =>
   Householder vert Extent.Small height fuse a ->
   Full vert horiz fuse width a ->
   Full vert horiz height width a
tallMultiplyQ = ArrMatrix.lift1 . Basic.tallMultiplyQ

tallMultiplyQAdjoint ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width, Shape.C fuse, Eq fuse, Class.Floating a) =>
   Householder horiz Extent.Small fuse height a ->
   Full vert horiz fuse width a ->
   Full vert horiz height width a
tallMultiplyQAdjoint = ArrMatrix.lift1 . Basic.tallMultiplyQAdjoint


multiplyQ ::
   (Extent.C vertA, Extent.C horizA, Shape.C widthA,
    Extent.C vertB, Extent.C horizB, Shape.C widthB,
    Shape.C height, Eq height, Class.Floating a) =>
   Transposition -> Conjugation ->
   Householder vertA horizA height widthA a ->
   Full vertB horizB height widthB a ->
   Full vertB horizB height widthB a
multiplyQ transposed conjugated =
   ArrMatrix.lift1 . Basic.multiplyQ transposed conjugated


extractR ::
   (Extent.C vert, Extent.C horiz, Shape.C height, Shape.C width,
    Class.Floating a) =>
   Householder vert horiz height width a ->
   Full vert horiz height width a
extractR = ArrMatrix.lift0 . Basic.extractR

tallExtractR ::
   (Extent.C vert, Shape.C height, Shape.C width, Class.Floating a) =>
   Householder vert Extent.Small height width a -> Upper width a
tallExtractR = ArrMatrix.lift0 . Basic.tallExtractR

tallMultiplyR ::
   (Extent.C vertA, Extent.C vert, Extent.C horiz, Shape.C height, Eq height,
    Shape.C heightA, Shape.C widthB, Class.Floating a) =>
   Transposition ->
   Householder vertA Extent.Small heightA height a ->
   Full vert horiz height widthB a ->
   Full vert horiz height widthB a
tallMultiplyR transposed = ArrMatrix.lift1 . Basic.tallMultiplyR transposed

tallSolveR ::
   (Extent.C vertA, Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width, Eq width, Shape.C nrhs, Class.Floating a) =>
   Transposition -> Conjugation ->
   Householder vertA Extent.Small height width a ->
   Full vert horiz width nrhs a -> Full vert horiz width nrhs a
tallSolveR transposed conjugated =
   ArrMatrix.lift1 . Basic.tallSolveR transposed conjugated