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

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

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

import qualified Numeric.LAPACK.Orthogonal.Plain as Plain
import qualified Numeric.LAPACK.Matrix.Array.Unpacked as Unpacked
import qualified Numeric.LAPACK.Matrix.Array.Private as ArrMatrix
import qualified Numeric.LAPACK.Matrix.Extent.Strict as ExtentStrict
import qualified Numeric.LAPACK.Matrix.Extent as Extent
import qualified Numeric.LAPACK.Matrix.Modifier as Mod
import qualified Numeric.LAPACK.Shape as ExtShape
import Numeric.LAPACK.Orthogonal.Plain (Householder)
import Numeric.LAPACK.Matrix.Array.Mosaic (Upper)
import Numeric.LAPACK.Matrix.Array.Private (Full, Square)
import Numeric.LAPACK.Matrix.Modifier (Transposition, Conjugation)

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Shape as Shape


mapExtent ::
   (Extent.Measure measA, Extent.C vertA, Extent.C horizA) =>
   (Extent.Measure measB, Extent.C vertB, Extent.C horizB) =>
   Extent.Map measA vertA horizA measB vertB horizB height width ->
   Householder measA vertA horizA height width a ->
   Householder measB vertB horizB height width a
mapExtent = Plain.mapExtent . ExtentStrict.apply


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

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

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


extractQ ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    ExtShape.Permutable height, Shape.C width, Class.Floating a) =>
   Householder meas vert horiz height width a -> Square height a
extractQ = ArrMatrix.lift0 . Plain.extractQ

tallExtractQ ::
   (Extent.Measure meas, Extent.C vert,
    Shape.C height, ExtShape.Permutable width, Class.Floating a) =>
   Householder meas vert Extent.Small height width a ->
   Full meas vert Extent.Small height width a
tallExtractQ = ArrMatrix.lift0 . Plain.tallExtractQ


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

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


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


extractR ::
   (Extent.Measure meas, Extent.C vert, Extent.C horiz,
    ExtShape.Permutable height, Shape.C width, Class.Floating a) =>
   Householder meas vert horiz height width a ->
   Unpacked.UpperTrapezoid meas vert horiz height width a
extractR = ArrMatrix.liftUnpacked0 . Plain.extractR

tallExtractR ::
   (Extent.Measure meas, Extent.C vert,
    Shape.C height, ExtShape.Permutable width, Class.Floating a) =>
   Householder meas vert Extent.Small height width a -> Upper width a
tallExtractR = ArrMatrix.lift0 . Plain.tallExtractR

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

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