{-# LANGUAGE TypeFamilies #-}
module Numeric.LAPACK.Singular.Plain (
   values,
   valuesTall,
   valuesWide,
   decompose,
   decomposeTall,
   decomposeWide,
   determinantAbsolute,
   leastSquaresMinimumNormRCond,
   pseudoInverseRCond,
   RealOf,
   ) where

import qualified Numeric.LAPACK.Matrix.Shape.Private as MatrixShape
import qualified Numeric.LAPACK.Matrix.Square.Basic as Square
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import qualified Numeric.LAPACK.Matrix.Private as Matrix
import qualified Numeric.LAPACK.Matrix.Basic as Basic
import qualified Numeric.LAPACK.Vector as Vector
import qualified Numeric.LAPACK.Shape as ExtShape
import qualified Numeric.LAPACK.Private as Private
import Numeric.LAPACK.Matrix.Hermitian.Private
         (TakeDiagonal(..), Determinant(..))
import Numeric.LAPACK.Matrix.Extent.Private (Extent)
import Numeric.LAPACK.Matrix.Square.Basic (Square)
import Numeric.LAPACK.Matrix.Shape.Private (Order(ColumnMajor), swapOnRowMajor)
import Numeric.LAPACK.Matrix.Private (Full, General)
import Numeric.LAPACK.Vector (Vector)
import Numeric.LAPACK.Scalar (RealOf, zero)
import Numeric.LAPACK.Private
         (withAutoWorkspace, peekCInt, createHigherArray,
          copyToTemp, copyToColumnMajorTemp, copyToSubColumnMajor)

import qualified Numeric.LAPACK.FFI.Complex as LapackComplex
import qualified Numeric.LAPACK.FFI.Real as LapackReal
import qualified Numeric.Netlib.Utility as Call
import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Storable.Unchecked.Monadic as ArrayIO
import qualified Data.Array.Comfort.Storable.Unchecked as Array
import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable.Unchecked (Array(Array))

import System.IO.Unsafe (unsafePerformIO)

import qualified Foreign.Marshal.Array.Guarded as ForeignArray
import qualified Foreign.Marshal.Utils as Marshal
import Foreign.C.Types (CInt, CChar)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (Storable)

import Control.Monad.Trans.Cont (evalContT)
import Control.Monad.IO.Class (liftIO)

import Data.Complex (Complex)
import Data.Tuple.HT (mapSnd)
import Data.Bool.HT (if')


values ::
   (Shape.C height, Shape.C width, Class.Floating a) =>
   General height width a -> Vector (ExtShape.Min height width) (RealOf a)
values :: General height width a -> Vector (Min height width) (RealOf a)
values = (Extent Big Big height width -> Min height width)
-> General height width a -> Vector (Min height width) (RealOf a)
forall vert horiz width height shape a.
(C vert, C horiz, C width, C height, C shape, Floating a) =>
(Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape (RealOf a)
valuesGen ((Extent Big Big height width -> Min height width)
 -> General height width a -> Vector (Min height width) (RealOf a))
-> (Extent Big Big height width -> Min height width)
-> General height width a
-> Vector (Min height width) (RealOf a)
forall a b. (a -> b) -> a -> b
$ (height -> width -> Min height width)
-> (height, width) -> Min height width
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry height -> width -> Min height width
forall sh0 sh1. sh0 -> sh1 -> Min sh0 sh1
ExtShape.Min ((height, width) -> Min height width)
-> (Extent Big Big height width -> (height, width))
-> Extent Big Big height width
-> Min height width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extent Big Big height width -> (height, width)
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> (height, width)
Extent.dimensions

valuesTall ::
   (Extent.C vert, Shape.C height, Shape.C width, Class.Floating a) =>
   Full vert Extent.Small height width a -> Vector width (RealOf a)
valuesTall :: Full vert Small height width a -> Vector width (RealOf a)
valuesTall = (Extent vert Small height width -> width)
-> Full vert Small height width a -> Vector width (RealOf a)
forall vert horiz width height shape a.
(C vert, C horiz, C width, C height, C shape, Floating a) =>
(Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape (RealOf a)
valuesGen Extent vert Small height width -> width
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> width
Extent.width

valuesWide ::
   (Extent.C horiz, Shape.C height, Shape.C width, Class.Floating a) =>
   Full Extent.Small horiz height width a -> Vector height (RealOf a)
valuesWide :: Full Small horiz height width a -> Vector height (RealOf a)
valuesWide = Full horiz Small width height a -> Vector height (RealOf a)
forall vert height width a.
(C vert, C height, C width, Floating a) =>
Full vert Small height width a -> Vector width (RealOf a)
valuesTall (Full horiz Small width height a -> Vector height (RealOf a))
-> (Full Small horiz height width a
    -> Full horiz Small width height a)
-> Full Small horiz height width a
-> Vector height (RealOf a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Full Small horiz height width a -> Full horiz Small width height a
forall vert horiz height width a.
(C vert, C horiz) =>
Full vert horiz height width a -> Full horiz vert width height a
Basic.transpose

valuesGen ::
   (Extent.C vert, Extent.C horiz, Shape.C width, Shape.C height,
    Shape.C shape, Class.Floating a) =>
   (Extent vert horiz height width -> shape) ->
   Full vert horiz height width a -> Vector shape (RealOf a)
valuesGen :: (Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape (RealOf a)
valuesGen Extent vert horiz height width -> shape
resultShape =
   TakeDiagonal (Array (Full vert horiz height width)) (Array shape) a
-> Full vert horiz height width a -> Vector shape (RealOf a)
forall (f :: * -> *) (g :: * -> *) a.
TakeDiagonal f g a -> f a -> g (RealOf a)
runTakeDiagonal (TakeDiagonal
   (Array (Full vert horiz height width)) (Array shape) a
 -> Full vert horiz height width a -> Vector shape (RealOf a))
-> TakeDiagonal
     (Array (Full vert horiz height width)) (Array shape) a
-> Full vert horiz height width a
-> Vector shape (RealOf a)
forall a b. (a -> b) -> a -> b
$
   TakeDiagonal
  (Array (Full vert horiz height width)) (Array shape) Float
-> TakeDiagonal
     (Array (Full vert horiz height width)) (Array shape) Double
-> TakeDiagonal
     (Array (Full vert horiz height width))
     (Array shape)
     (Complex Float)
-> TakeDiagonal
     (Array (Full vert horiz height width))
     (Array shape)
     (Complex Double)
-> TakeDiagonal
     (Array (Full vert horiz height width)) (Array shape) a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((Array (Full vert horiz height width) Float
 -> Array shape (RealOf Float))
-> TakeDiagonal
     (Array (Full vert horiz height width)) (Array shape) Float
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal ((Array (Full vert horiz height width) Float
  -> Array shape (RealOf Float))
 -> TakeDiagonal
      (Array (Full vert horiz height width)) (Array shape) Float)
-> (Array (Full vert horiz height width) Float
    -> Array shape (RealOf Float))
-> TakeDiagonal
     (Array (Full vert horiz height width)) (Array shape) Float
forall a b. (a -> b) -> a -> b
$ (Extent vert horiz height width -> shape)
-> Array (Full vert horiz height width) Float -> Vector shape Float
forall vert horiz width height shape a ar.
(C vert, C horiz, C width, C height, C shape, Floating a,
 RealOf a ~ ar, Storable ar) =>
(Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape ar
valuesAux Extent vert horiz height width -> shape
resultShape)
      ((Array (Full vert horiz height width) Double
 -> Array shape (RealOf Double))
-> TakeDiagonal
     (Array (Full vert horiz height width)) (Array shape) Double
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal ((Array (Full vert horiz height width) Double
  -> Array shape (RealOf Double))
 -> TakeDiagonal
      (Array (Full vert horiz height width)) (Array shape) Double)
-> (Array (Full vert horiz height width) Double
    -> Array shape (RealOf Double))
-> TakeDiagonal
     (Array (Full vert horiz height width)) (Array shape) Double
forall a b. (a -> b) -> a -> b
$ (Extent vert horiz height width -> shape)
-> Array (Full vert horiz height width) Double
-> Vector shape Double
forall vert horiz width height shape a ar.
(C vert, C horiz, C width, C height, C shape, Floating a,
 RealOf a ~ ar, Storable ar) =>
(Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape ar
valuesAux Extent vert horiz height width -> shape
resultShape)
      ((Array (Full vert horiz height width) (Complex Float)
 -> Array shape (RealOf (Complex Float)))
-> TakeDiagonal
     (Array (Full vert horiz height width))
     (Array shape)
     (Complex Float)
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal ((Array (Full vert horiz height width) (Complex Float)
  -> Array shape (RealOf (Complex Float)))
 -> TakeDiagonal
      (Array (Full vert horiz height width))
      (Array shape)
      (Complex Float))
-> (Array (Full vert horiz height width) (Complex Float)
    -> Array shape (RealOf (Complex Float)))
-> TakeDiagonal
     (Array (Full vert horiz height width))
     (Array shape)
     (Complex Float)
forall a b. (a -> b) -> a -> b
$ (Extent vert horiz height width -> shape)
-> Array (Full vert horiz height width) (Complex Float)
-> Vector shape Float
forall vert horiz width height shape a ar.
(C vert, C horiz, C width, C height, C shape, Floating a,
 RealOf a ~ ar, Storable ar) =>
(Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape ar
valuesAux Extent vert horiz height width -> shape
resultShape)
      ((Array (Full vert horiz height width) (Complex Double)
 -> Array shape (RealOf (Complex Double)))
-> TakeDiagonal
     (Array (Full vert horiz height width))
     (Array shape)
     (Complex Double)
forall (f :: * -> *) (g :: * -> *) a.
(f a -> g (RealOf a)) -> TakeDiagonal f g a
TakeDiagonal ((Array (Full vert horiz height width) (Complex Double)
  -> Array shape (RealOf (Complex Double)))
 -> TakeDiagonal
      (Array (Full vert horiz height width))
      (Array shape)
      (Complex Double))
-> (Array (Full vert horiz height width) (Complex Double)
    -> Array shape (RealOf (Complex Double)))
-> TakeDiagonal
     (Array (Full vert horiz height width))
     (Array shape)
     (Complex Double)
forall a b. (a -> b) -> a -> b
$ (Extent vert horiz height width -> shape)
-> Array (Full vert horiz height width) (Complex Double)
-> Vector shape Double
forall vert horiz width height shape a ar.
(C vert, C horiz, C width, C height, C shape, Floating a,
 RealOf a ~ ar, Storable ar) =>
(Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape ar
valuesAux Extent vert horiz height width -> shape
resultShape)

valuesAux ::
   (Extent.C vert, Extent.C horiz, Shape.C width, Shape.C height,
    Shape.C shape, Class.Floating a, RealOf a ~ ar, Storable ar) =>
   (Extent vert horiz height width -> shape) ->
   Full vert horiz height width a -> Vector shape ar
valuesAux :: (Extent vert horiz height width -> shape)
-> Full vert horiz height width a -> Vector shape ar
valuesAux Extent vert horiz height width -> shape
resultShape (Array shape :: Full vert horiz height width
shape@(MatrixShape.Full Order
_order Extent vert horiz height width
extent) ForeignPtr a
a) =
   shape -> (Int -> Ptr ar -> IO ()) -> Vector shape ar
forall sh a.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO ()) -> Array sh a
Array.unsafeCreateWithSize (Extent vert horiz height width -> shape
resultShape Extent vert horiz height width
extent) ((Int -> Ptr ar -> IO ()) -> Vector shape ar)
-> (Int -> Ptr ar -> IO ()) -> Vector shape ar
forall a b. (a -> b) -> a -> b
$ \Int
mn Ptr ar
sPtr -> do
   let (Int
m,Int
n) = Full vert horiz height width -> (Int, Int)
forall vert horiz height width.
(C vert, C horiz, C height, C width) =>
Full vert horiz height width -> (Int, Int)
MatrixShape.dimensions Full vert horiz height width
shape
   let lda :: Int
lda = Int
m
   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Ptr CChar
jobuPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'N'
      Ptr CChar
jobvtPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'N'
      Ptr CInt
mPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
m
      Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
      Ptr a
aPtr <- Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r. Storable a => Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyToTemp (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) ForeignPtr a
a
      Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
lda
      let uPtr :: Ptr a
uPtr = Ptr a
forall a. Ptr a
nullPtr
      let vtPtr :: Ptr a
vtPtr = Ptr a
forall a. Ptr a
nullPtr
      Ptr CInt
lduPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
m
      Ptr CInt
ldvtPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
      IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
         String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
"gesvd" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
infoPtr ->
         GESVD_ (RealOf a) a
forall a. Floating a => GESVD_ (RealOf a) a
gesvd Ptr CChar
jobuPtr Ptr CChar
jobvtPtr Ptr CInt
mPtr Ptr CInt
nPtr
            Ptr a
aPtr Ptr CInt
ldaPtr Ptr ar
Ptr (RealOf a)
sPtr Ptr a
forall a. Ptr a
uPtr Ptr CInt
lduPtr Ptr a
forall a. Ptr a
vtPtr Ptr CInt
ldvtPtr Int
mn Ptr CInt
infoPtr


determinantAbsolute ::
   (Shape.C height, Shape.C width, Class.Floating a) =>
   General height width a -> RealOf a
determinantAbsolute :: General height width a -> RealOf a
determinantAbsolute =
   Determinant (Array (General height width)) a
-> General height width a -> RealOf a
forall (f :: * -> *) a. Determinant f a -> f a -> RealOf a
getDeterminant (Determinant (Array (General height width)) a
 -> General height width a -> RealOf a)
-> Determinant (Array (General height width)) a
-> General height width a
-> RealOf a
forall a b. (a -> b) -> a -> b
$
   Determinant (Array (General height width)) Float
-> Determinant (Array (General height width)) Double
-> Determinant (Array (General height width)) (Complex Float)
-> Determinant (Array (General height width)) (Complex Double)
-> Determinant (Array (General height width)) a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((Array (General height width) Float -> RealOf Float)
-> Determinant (Array (General height width)) Float
forall (f :: * -> *) a. (f a -> RealOf a) -> Determinant f a
Determinant Array (General height width) Float -> RealOf Float
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Real ar) =>
General height width a -> ar
determinantAbsoluteAux)
      ((Array (General height width) Double -> RealOf Double)
-> Determinant (Array (General height width)) Double
forall (f :: * -> *) a. (f a -> RealOf a) -> Determinant f a
Determinant Array (General height width) Double -> RealOf Double
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Real ar) =>
General height width a -> ar
determinantAbsoluteAux)
      ((Array (General height width) (Complex Float)
 -> RealOf (Complex Float))
-> Determinant (Array (General height width)) (Complex Float)
forall (f :: * -> *) a. (f a -> RealOf a) -> Determinant f a
Determinant Array (General height width) (Complex Float)
-> RealOf (Complex Float)
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Real ar) =>
General height width a -> ar
determinantAbsoluteAux)
      ((Array (General height width) (Complex Double)
 -> RealOf (Complex Double))
-> Determinant (Array (General height width)) (Complex Double)
forall (f :: * -> *) a. (f a -> RealOf a) -> Determinant f a
Determinant Array (General height width) (Complex Double)
-> RealOf (Complex Double)
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Real ar) =>
General height width a -> ar
determinantAbsoluteAux)

determinantAbsoluteAux ::
   (Shape.C height, Shape.C width,
    Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   General height width a -> ar
determinantAbsoluteAux :: General height width a -> ar
determinantAbsoluteAux =
   (Full Big Small height width a -> ar)
-> (Wide height width a -> ar)
-> Either (Full Big Small height width a) (Wide height width a)
-> ar
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Vector width ar -> ar
forall sh a. (C sh, Floating a) => Vector sh a -> a
Vector.product (Vector width ar -> ar)
-> (Full Big Small height width a -> Vector width ar)
-> Full Big Small height width a
-> ar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Full Big Small height width a -> Vector width ar
forall vert height width a.
(C vert, C height, C width, Floating a) =>
Full vert Small height width a -> Vector width (RealOf a)
valuesTall) (ar -> Wide height width a -> ar
forall a b. a -> b -> a
const ar
forall a. Floating a => a
zero)
   (Either (Full Big Small height width a) (Wide height width a)
 -> ar)
-> (General height width a
    -> Either (Full Big Small height width a) (Wide height width a))
-> General height width a
-> ar
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   General height width a
-> Either (Full Big Small height width a) (Wide height width a)
forall vert horiz height width a.
(C vert, C horiz, C height, C width) =>
Full vert horiz height width a
-> Either (Tall height width a) (Wide height width a)
Basic.caseTallWide


decompose ::
   (Shape.C height, Shape.C width, Class.Floating a) =>
   General height width a ->
   (Square height a,
    Vector (ExtShape.Min height width) (RealOf a),
    Square width a)
decompose :: General height width a
-> (Square height a, Vector (Min height width) (RealOf a),
    Square width a)
decompose =
   Decompose
  (Array (General height width))
  (Array (Square height))
  (Array (Min height width))
  (Array (Square width))
  a
-> General height width a
-> (Square height a, Vector (Min height width) (RealOf a),
    Square width a)
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
Decompose m f v g a -> m a -> (f a, v (RealOf a), g a)
getDecompose (Decompose
   (Array (General height width))
   (Array (Square height))
   (Array (Min height width))
   (Array (Square width))
   a
 -> General height width a
 -> (Square height a, Vector (Min height width) (RealOf a),
     Square width a))
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     a
-> General height width a
-> (Square height a, Vector (Min height width) (RealOf a),
    Square width a)
forall a b. (a -> b) -> a -> b
$
   Decompose
  (Array (General height width))
  (Array (Square height))
  (Array (Min height width))
  (Array (Square width))
  Float
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     Double
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     (Complex Float)
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     (Complex Double)
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((Array (General height width) Float
 -> (Array (Square height) Float,
     Array (Min height width) (RealOf Float),
     Array (Square width) Float))
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     Float
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (General height width) Float
-> (Array (Square height) Float,
    Array (Min height width) (RealOf Float),
    Array (Square width) Float)
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Storable ar) =>
General height width a
-> (Square height a, Vector (Min height width) ar, Square width a)
decomposeAux)
      ((Array (General height width) Double
 -> (Array (Square height) Double,
     Array (Min height width) (RealOf Double),
     Array (Square width) Double))
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     Double
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (General height width) Double
-> (Array (Square height) Double,
    Array (Min height width) (RealOf Double),
    Array (Square width) Double)
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Storable ar) =>
General height width a
-> (Square height a, Vector (Min height width) ar, Square width a)
decomposeAux)
      ((Array (General height width) (Complex Float)
 -> (Array (Square height) (Complex Float),
     Array (Min height width) (RealOf (Complex Float)),
     Array (Square width) (Complex Float)))
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     (Complex Float)
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (General height width) (Complex Float)
-> (Array (Square height) (Complex Float),
    Array (Min height width) (RealOf (Complex Float)),
    Array (Square width) (Complex Float))
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Storable ar) =>
General height width a
-> (Square height a, Vector (Min height width) ar, Square width a)
decomposeAux)
      ((Array (General height width) (Complex Double)
 -> (Array (Square height) (Complex Double),
     Array (Min height width) (RealOf (Complex Double)),
     Array (Square width) (Complex Double)))
-> Decompose
     (Array (General height width))
     (Array (Square height))
     (Array (Min height width))
     (Array (Square width))
     (Complex Double)
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (General height width) (Complex Double)
-> (Array (Square height) (Complex Double),
    Array (Min height width) (RealOf (Complex Double)),
    Array (Square width) (Complex Double))
forall height width a ar.
(C height, C width, Floating a, RealOf a ~ ar, Storable ar) =>
General height width a
-> (Square height a, Vector (Min height width) ar, Square width a)
decomposeAux)

newtype Decompose m f v g a =
   Decompose {Decompose m f v g a -> m a -> (f a, v (RealOf a), g a)
getDecompose :: m a -> (f a, v (RealOf a), g a)}

decomposeAux ::
   (Shape.C height, Shape.C width,
    Class.Floating a, RealOf a ~ ar, Storable ar) =>
   General height width a ->
   (Square height a, Vector (ExtShape.Min height width) ar, Square width a)
decomposeAux :: General height width a
-> (Square height a, Vector (Min height width) ar, Square width a)
decomposeAux arr :: General height width a
arr@(Array shape :: General height width
shape@(MatrixShape.Full Order
order Extent Big Big height width
extent) ForeignPtr a
a) =

   let (height
height,width
width) = Extent Big Big height width -> (height, width)
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> (height, width)
Extent.dimensions Extent Big Big height width
extent
       minShape :: Min height width
minShape = height -> width -> Min height width
forall sh0 sh1. sh0 -> sh1 -> Min sh0 sh1
ExtShape.Min height
height width
width
       mn :: Int
mn = Min height width -> Int
forall sh. C sh => sh -> Int
Shape.size Min height width
minShape

   in (Bool
-> (Square height a, Vector (Min height width) ar, Square width a)
-> (Square height a, Vector (Min height width) ar, Square width a)
-> (Square height a, Vector (Min height width) ar, Square width a)
forall a. Bool -> a -> a -> a
if' (Int
mnInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)
         (General height width a -> Square height a
forall height width a.
(C height, C width, Floating a) =>
General height width a -> Square height a
Square.identityFromHeight General height width a
arr,
          Min height width -> [ar] -> Vector (Min height width) ar
forall sh a. (C sh, Storable a) => sh -> [a] -> Vector sh a
Vector.fromList Min height width
minShape [],
          General height width a -> Square width a
forall height width a.
(C height, C width, Floating a) =>
General height width a -> Square width a
Square.identityFromWidth General height width a
arr)) ((Square height a, Vector (Min height width) ar, Square width a)
 -> (Square height a, Vector (Min height width) ar, Square width a))
-> (Square height a, Vector (Min height width) ar, Square width a)
-> (Square height a, Vector (Min height width) ar, Square width a)
forall a b. (a -> b) -> a -> b
$
      (\(Square height a
u,(Vector (Min height width) ar
s,Square width a
vt)) -> (Square height a
u,Vector (Min height width) ar
s,Square width a
vt)) ((Square height a, (Vector (Min height width) ar, Square width a))
 -> (Square height a, Vector (Min height width) ar, Square width a))
-> (Square height a,
    (Vector (Min height width) ar, Square width a))
-> (Square height a, Vector (Min height width) ar, Square width a)
forall a b. (a -> b) -> a -> b
$
      Square height
-> (Int
    -> Ptr a -> IO (Vector (Min height width) ar, Square width a))
-> (Square height a,
    (Vector (Min height width) ar, Square width a))
forall sh a b.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)
Array.unsafeCreateWithSizeAndResult (Order -> height -> Square height
forall sh. Order -> sh -> Square sh
MatrixShape.square Order
order height
height) ((Int
  -> Ptr a -> IO (Vector (Min height width) ar, Square width a))
 -> (Square height a,
     (Vector (Min height width) ar, Square width a)))
-> (Int
    -> Ptr a -> IO (Vector (Min height width) ar, Square width a))
-> (Square height a,
    (Vector (Min height width) ar, Square width a))
forall a b. (a -> b) -> a -> b
$
         \ Int
_ Ptr a
uPtr0 ->
      Min height width
-> (Int -> Ptr ar -> IO (Square width a))
-> IO (Vector (Min height width) ar, Square width a)
forall (m :: * -> *) sh a b.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)
ArrayIO.unsafeCreateWithSizeAndResult Min height width
minShape ((Int -> Ptr ar -> IO (Square width a))
 -> IO (Vector (Min height width) ar, Square width a))
-> (Int -> Ptr ar -> IO (Square width a))
-> IO (Vector (Min height width) ar, Square width a)
forall a b. (a -> b) -> a -> b
$ \ Int
_ Ptr ar
sPtr ->
      Square width -> (Ptr a -> IO ()) -> IO (Square width a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> m (Array sh a)
ArrayIO.unsafeCreate (Order -> width -> Square width
forall sh. Order -> sh -> Square sh
MatrixShape.square Order
order width
width) ((Ptr a -> IO ()) -> IO (Square width a))
-> (Ptr a -> IO ()) -> IO (Square width a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
vtPtr0 ->

   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      let (Int
m,Int
n) = General height width -> (Int, Int)
forall vert horiz height width.
(C vert, C horiz, C height, C width) =>
Full vert horiz height width -> (Int, Int)
MatrixShape.dimensions General height width
shape
      let (Ptr a
uPtr,Ptr a
vtPtr) = Order -> (Ptr a, Ptr a) -> (Ptr a, Ptr a)
forall a. Order -> (a, a) -> (a, a)
swapOnRowMajor Order
order (Ptr a
uPtr0,Ptr a
vtPtr0)
      let lda :: Int
lda = Int
m
      Ptr CChar
jobuPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'A'
      Ptr CChar
jobvtPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'A'
      Ptr CInt
mPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
m
      Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
      Ptr a
aPtr <- Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r. Storable a => Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyToTemp (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) ForeignPtr a
a
      Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
lda
      Ptr CInt
lduPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
m
      Ptr CInt
ldvtPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
n
      IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
         String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
"gesvd" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
infoPtr ->
         GESVD_ (RealOf a) a
forall a. Floating a => GESVD_ (RealOf a) a
gesvd Ptr CChar
jobuPtr Ptr CChar
jobvtPtr Ptr CInt
mPtr Ptr CInt
nPtr
            Ptr a
aPtr Ptr CInt
ldaPtr Ptr ar
Ptr (RealOf a)
sPtr Ptr a
uPtr Ptr CInt
lduPtr Ptr a
vtPtr Ptr CInt
ldvtPtr Int
mn Ptr CInt
infoPtr


decomposeWide ::
   (Extent.C horiz, Shape.C height, Shape.C width, Class.Floating a) =>
   Full Extent.Small horiz height width a ->
   (Square height a, Vector height (RealOf a),
      Full Extent.Small horiz height width a)
decomposeWide :: Full Small horiz height width a
-> (Square height a, Vector height (RealOf a),
    Full Small horiz height width a)
decomposeWide Full Small horiz height width a
a =
   let (Full horiz Small width height a
u,Vector height (RealOf a)
s,Square height a
vt) = Full horiz Small width height a
-> (Full horiz Small width height a, Vector height (RealOf a),
    Square height a)
forall vert height width a.
(C vert, C height, C width, Floating a) =>
Full vert Small height width a
-> (Full vert Small height width a, Vector width (RealOf a),
    Square width a)
decomposeTall (Full horiz Small width height a
 -> (Full horiz Small width height a, Vector height (RealOf a),
     Square height a))
-> Full horiz Small width height a
-> (Full horiz Small width height a, Vector height (RealOf a),
    Square height a)
forall a b. (a -> b) -> a -> b
$ Full Small horiz height width a -> Full horiz Small width height a
forall vert horiz height width a.
(C vert, C horiz) =>
Full vert horiz height width a -> Full horiz vert width height a
Basic.transpose Full Small horiz height width a
a
   in  (Square height a -> Square height a
forall sh a. Square sh a -> Square sh a
Square.transpose Square height a
vt, Vector height (RealOf a)
s, Full horiz Small width height a -> Full Small horiz height width a
forall vert horiz height width a.
(C vert, C horiz) =>
Full vert horiz height width a -> Full horiz vert width height a
Basic.transpose Full horiz Small width height a
u)

decomposeTall ::
   (Extent.C vert, Shape.C height, Shape.C width, Class.Floating a) =>
   Full vert Extent.Small height width a ->
   (Full vert Extent.Small height width a,
      Vector width (RealOf a), Square width a)
decomposeTall :: Full vert Small height width a
-> (Full vert Small height width a, Vector width (RealOf a),
    Square width a)
decomposeTall =
   Decompose
  (Array (Full vert Small height width))
  (Array (Full vert Small height width))
  (Array width)
  (Array (Square width))
  a
-> Full vert Small height width a
-> (Full vert Small height width a, Vector width (RealOf a),
    Square width a)
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
Decompose m f v g a -> m a -> (f a, v (RealOf a), g a)
getDecompose (Decompose
   (Array (Full vert Small height width))
   (Array (Full vert Small height width))
   (Array width)
   (Array (Square width))
   a
 -> Full vert Small height width a
 -> (Full vert Small height width a, Vector width (RealOf a),
     Square width a))
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     a
-> Full vert Small height width a
-> (Full vert Small height width a, Vector width (RealOf a),
    Square width a)
forall a b. (a -> b) -> a -> b
$
   Decompose
  (Array (Full vert Small height width))
  (Array (Full vert Small height width))
  (Array width)
  (Array (Square width))
  Float
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     Double
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     (Complex Float)
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     (Complex Double)
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((Array (Full vert Small height width) Float
 -> (Array (Full vert Small height width) Float,
     Array width (RealOf Float), Array (Square width) Float))
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     Float
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (Full vert Small height width) Float
-> (Array (Full vert Small height width) Float,
    Array width (RealOf Float), Array (Square width) Float)
forall vert height width a ar.
(C vert, C height, C width, Floating a, RealOf a ~ ar,
 Storable ar) =>
Full vert Small height width a
-> (Full vert Small height width a, Vector width ar,
    Square width a)
decomposeThin)
      ((Array (Full vert Small height width) Double
 -> (Array (Full vert Small height width) Double,
     Array width (RealOf Double), Array (Square width) Double))
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     Double
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (Full vert Small height width) Double
-> (Array (Full vert Small height width) Double,
    Array width (RealOf Double), Array (Square width) Double)
forall vert height width a ar.
(C vert, C height, C width, Floating a, RealOf a ~ ar,
 Storable ar) =>
Full vert Small height width a
-> (Full vert Small height width a, Vector width ar,
    Square width a)
decomposeThin)
      ((Array (Full vert Small height width) (Complex Float)
 -> (Array (Full vert Small height width) (Complex Float),
     Array width (RealOf (Complex Float)),
     Array (Square width) (Complex Float)))
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     (Complex Float)
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (Full vert Small height width) (Complex Float)
-> (Array (Full vert Small height width) (Complex Float),
    Array width (RealOf (Complex Float)),
    Array (Square width) (Complex Float))
forall vert height width a ar.
(C vert, C height, C width, Floating a, RealOf a ~ ar,
 Storable ar) =>
Full vert Small height width a
-> (Full vert Small height width a, Vector width ar,
    Square width a)
decomposeThin)
      ((Array (Full vert Small height width) (Complex Double)
 -> (Array (Full vert Small height width) (Complex Double),
     Array width (RealOf (Complex Double)),
     Array (Square width) (Complex Double)))
-> Decompose
     (Array (Full vert Small height width))
     (Array (Full vert Small height width))
     (Array width)
     (Array (Square width))
     (Complex Double)
forall (m :: * -> *) (f :: * -> *) (v :: * -> *) (g :: * -> *) a.
(m a -> (f a, v (RealOf a), g a)) -> Decompose m f v g a
Decompose Array (Full vert Small height width) (Complex Double)
-> (Array (Full vert Small height width) (Complex Double),
    Array width (RealOf (Complex Double)),
    Array (Square width) (Complex Double))
forall vert height width a ar.
(C vert, C height, C width, Floating a, RealOf a ~ ar,
 Storable ar) =>
Full vert Small height width a
-> (Full vert Small height width a, Vector width ar,
    Square width a)
decomposeThin)

decomposeThin ::
   (Extent.C vert, Shape.C height, Shape.C width,
    Class.Floating a, RealOf a ~ ar, Storable ar) =>
   Full vert Extent.Small height width a ->
   (Full vert Extent.Small height width a, Vector width ar, Square width a)
decomposeThin :: Full vert Small height width a
-> (Full vert Small height width a, Vector width ar,
    Square width a)
decomposeThin (Array (MatrixShape.Full Order
order Extent vert Small height width
extent) ForeignPtr a
a) =
   let (height
height,width
width) = Extent vert Small height width -> (height, width)
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> (height, width)
Extent.dimensions Extent vert Small height width
extent
   in (\(Full vert Small height width a
u,(Vector width ar
s,Square width a
vt)) -> (Full vert Small height width a
u,Vector width ar
s,Square width a
vt)) ((Full vert Small height width a,
  (Vector width ar, Square width a))
 -> (Full vert Small height width a, Vector width ar,
     Square width a))
-> (Full vert Small height width a,
    (Vector width ar, Square width a))
-> (Full vert Small height width a, Vector width ar,
    Square width a)
forall a b. (a -> b) -> a -> b
$
      Full vert Small height width
-> (Int -> Ptr a -> IO (Vector width ar, Square width a))
-> (Full vert Small height width a,
    (Vector width ar, Square width a))
forall sh a b.
(C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)
Array.unsafeCreateWithSizeAndResult (Order
-> Extent vert Small height width -> Full vert Small height width
forall vert horiz height width.
Order
-> Extent vert horiz height width -> Full vert horiz height width
MatrixShape.Full Order
order Extent vert Small height width
extent) ((Int -> Ptr a -> IO (Vector width ar, Square width a))
 -> (Full vert Small height width a,
     (Vector width ar, Square width a)))
-> (Int -> Ptr a -> IO (Vector width ar, Square width a))
-> (Full vert Small height width a,
    (Vector width ar, Square width a))
forall a b. (a -> b) -> a -> b
$
         \ Int
_ Ptr a
uPtr0 ->
      width
-> (Int -> Ptr ar -> IO (Square width a))
-> IO (Vector width ar, Square width a)
forall (m :: * -> *) sh a b.
(PrimMonad m, C sh, Storable a) =>
sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)
ArrayIO.unsafeCreateWithSizeAndResult width
width ((Int -> Ptr ar -> IO (Square width a))
 -> IO (Vector width ar, Square width a))
-> (Int -> Ptr ar -> IO (Square width a))
-> IO (Vector width ar, Square width a)
forall a b. (a -> b) -> a -> b
$ \ Int
_ Ptr ar
sPtr ->
      Square width -> (Ptr a -> IO ()) -> IO (Square width a)
forall (m :: * -> *) sh a.
(PrimMonad m, C sh, Storable a) =>
sh -> (Ptr a -> IO ()) -> m (Array sh a)
ArrayIO.unsafeCreate (Order -> width -> Square width
forall sh. Order -> sh -> Square sh
MatrixShape.square Order
order width
width) ((Ptr a -> IO ()) -> IO (Square width a))
-> (Ptr a -> IO ()) -> IO (Square width a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
vtPtr0 ->

   ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> IO ()) -> ContT () IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      let ((Int
m,Ptr a
uPtr),(Int
n,Ptr a
vtPtr)) =
            Order
-> ((Int, Ptr a), (Int, Ptr a)) -> ((Int, Ptr a), (Int, Ptr a))
forall a. Order -> (a, a) -> (a, a)
swapOnRowMajor Order
order
               ((height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height, Ptr a
uPtr0), (width -> Int
forall sh. C sh => sh -> Int
Shape.size width
width, Ptr a
vtPtr0))
      let mn :: Int
mn = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m Int
n
      let lda :: Int
lda = Int
m
      Ptr CChar
jobuPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'S'
      Ptr CChar
jobvtPtr <- Char -> FortranIO () (Ptr CChar)
forall r. Char -> FortranIO r (Ptr CChar)
Call.char Char
'S'
      Ptr CInt
mPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
m
      Ptr CInt
nPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
      Ptr a
aPtr <- Int -> ForeignPtr a -> ContT () IO (Ptr a)
forall a r. Storable a => Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyToTemp (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) ForeignPtr a
a
      Ptr CInt
ldaPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
lda
      Ptr CInt
lduPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
m
      Ptr CInt
ldvtPtr <- Int -> FortranIO () (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
mn
      IO () -> ContT () IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$
         String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
"gesvd" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
infoPtr ->
         GESVD_ (RealOf a) a
forall a. Floating a => GESVD_ (RealOf a) a
gesvd Ptr CChar
jobuPtr Ptr CChar
jobvtPtr Ptr CInt
mPtr Ptr CInt
nPtr
            Ptr a
aPtr Ptr CInt
ldaPtr Ptr ar
Ptr (RealOf a)
sPtr Ptr a
uPtr Ptr CInt
lduPtr Ptr a
vtPtr Ptr CInt
ldvtPtr Int
mn Ptr CInt
infoPtr


type GESVD_ ar a =
   Ptr CChar -> Ptr CChar -> Ptr CInt -> Ptr CInt ->
   Ptr a -> Ptr CInt -> Ptr ar ->
   Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt -> Int -> Ptr CInt -> IO ()

newtype GESVD a = GESVD {GESVD a -> GESVD_ (RealOf a) a
getGESVD :: GESVD_ (RealOf a) a}

gesvd :: Class.Floating a => GESVD_ (RealOf a) a
gesvd :: GESVD_ (RealOf a) a
gesvd =
   GESVD a -> GESVD_ (RealOf a) a
forall a. GESVD a -> GESVD_ (RealOf a) a
getGESVD (GESVD a -> GESVD_ (RealOf a) a) -> GESVD a -> GESVD_ (RealOf a) a
forall a b. (a -> b) -> a -> b
$
   GESVD Float
-> GESVD Double
-> GESVD (Complex Float)
-> GESVD (Complex Double)
-> GESVD a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      (GESVD_ (RealOf Float) Float -> GESVD Float
forall a. GESVD_ (RealOf a) a -> GESVD a
GESVD GESVD_ (RealOf Float) Float
forall a. Real a => GESVD_ a a
gesvdReal)
      (GESVD_ (RealOf Double) Double -> GESVD Double
forall a. GESVD_ (RealOf a) a -> GESVD a
GESVD GESVD_ (RealOf Double) Double
forall a. Real a => GESVD_ a a
gesvdReal)
      (GESVD_ (RealOf (Complex Float)) (Complex Float)
-> GESVD (Complex Float)
forall a. GESVD_ (RealOf a) a -> GESVD a
GESVD GESVD_ (RealOf (Complex Float)) (Complex Float)
forall a. Real a => GESVD_ a (Complex a)
gesvdComplex)
      (GESVD_ (RealOf (Complex Double)) (Complex Double)
-> GESVD (Complex Double)
forall a. GESVD_ (RealOf a) a -> GESVD a
GESVD GESVD_ (RealOf (Complex Double)) (Complex Double)
forall a. Real a => GESVD_ a (Complex a)
gesvdComplex)

gesvdReal :: (Class.Real a) => GESVD_ a a
gesvdReal :: GESVD_ a a
gesvdReal Ptr CChar
jobuPtr Ptr CChar
jobvtPtr Ptr CInt
mPtr Ptr CInt
nPtr
      Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
sPtr Ptr a
uPtr Ptr CInt
lduPtr Ptr a
vtPtr Ptr CInt
ldvtPtr Int
_mn Ptr CInt
infoPtr =
   (Ptr a -> Ptr CInt -> IO ()) -> IO ()
forall a. Floating a => (Ptr a -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspace ((Ptr a -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr a -> Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
workPtr Ptr CInt
lworkPtr ->
   Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackReal.gesvd Ptr CChar
jobuPtr Ptr CChar
jobvtPtr
      Ptr CInt
mPtr Ptr CInt
nPtr Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
sPtr Ptr a
uPtr Ptr CInt
lduPtr Ptr a
vtPtr Ptr CInt
ldvtPtr
      Ptr a
workPtr Ptr CInt
lworkPtr Ptr CInt
infoPtr

gesvdComplex :: (Class.Real a) => GESVD_ a (Complex a)
gesvdComplex :: GESVD_ a (Complex a)
gesvdComplex Ptr CChar
jobuPtr Ptr CChar
jobvtPtr
      Ptr CInt
mPtr Ptr CInt
nPtr Ptr (Complex a)
aPtr Ptr CInt
ldaPtr Ptr a
sPtr Ptr (Complex a)
uPtr Ptr CInt
lduPtr Ptr (Complex a)
vtPtr Ptr CInt
ldvtPtr Int
mn Ptr CInt
infoPtr =
   Int -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca (Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
mn) ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
rworkPtr ->
   (Ptr (Complex a) -> Ptr CInt -> IO ()) -> IO ()
forall a. Floating a => (Ptr a -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspace ((Ptr (Complex a) -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr (Complex a) -> Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Complex a)
workPtr Ptr CInt
lworkPtr ->
   Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CChar
-> Ptr CChar
-> Ptr CInt
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
LapackComplex.gesvd Ptr CChar
jobuPtr Ptr CChar
jobvtPtr
      Ptr CInt
mPtr Ptr CInt
nPtr Ptr (Complex a)
aPtr Ptr CInt
ldaPtr Ptr a
sPtr Ptr (Complex a)
uPtr Ptr CInt
lduPtr Ptr (Complex a)
vtPtr Ptr CInt
ldvtPtr
      Ptr (Complex a)
workPtr Ptr CInt
lworkPtr Ptr a
rworkPtr Ptr CInt
infoPtr


leastSquaresMinimumNormRCond ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Shape.C nrhs, Class.Floating a) =>
   RealOf a ->
   Full horiz vert height width a ->
   Full vert horiz height nrhs a ->
   (Int, Full vert horiz width nrhs a)
leastSquaresMinimumNormRCond :: RealOf a
-> Full horiz vert height width a
-> Full vert horiz height nrhs a
-> (Int, Full vert horiz width nrhs a)
leastSquaresMinimumNormRCond RealOf a
rcond
      (Array (MatrixShape.Full Order
orderA Extent horiz vert height width
extentA) ForeignPtr a
a)
      (Array (MatrixShape.Full Order
orderB Extent vert horiz height nrhs
extentB) ForeignPtr a
b) =
   case Extent vert horiz width height
-> Extent vert horiz height nrhs
-> Maybe (Extent vert horiz width nrhs)
forall vert horiz fuse height width.
(C vert, C horiz, Eq fuse) =>
Extent vert horiz height fuse
-> Extent vert horiz fuse width
-> Maybe (Extent vert horiz height width)
Extent.fuse (Extent horiz vert height width -> Extent vert horiz width height
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> Extent horiz vert width height
Extent.transpose Extent horiz vert height width
extentA) Extent vert horiz height nrhs
extentB of
      Maybe (Extent vert horiz width nrhs)
Nothing -> String -> (Int, Full vert horiz width nrhs a)
forall a. HasCallStack => String -> a
error String
"leastSquaresMinimumNorm: height shapes mismatch"
      Just Extent vert horiz width nrhs
extent ->
         let widthA :: width
widthA = Extent horiz vert height width -> width
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> width
Extent.width Extent horiz vert height width
extentA
             (height
height,nrhs
widthB) = Extent vert horiz height nrhs -> (height, nrhs)
forall vert horiz height width.
(C vert, C horiz) =>
Extent vert horiz height width -> (height, width)
Extent.dimensions Extent vert horiz height nrhs
extentB
             shapeX :: Full vert horiz width nrhs
shapeX = Order -> Extent vert horiz width nrhs -> Full vert horiz width nrhs
forall vert horiz height width.
Order
-> Extent vert horiz height width -> Full vert horiz height width
MatrixShape.Full Order
ColumnMajor Extent vert horiz width nrhs
extent
             m :: Int
m = height -> Int
forall sh. C sh => sh -> Int
Shape.size height
height
             n :: Int
n = width -> Int
forall sh. C sh => sh -> Int
Shape.size width
widthA
             nrhs :: Int
nrhs = nrhs -> Int
forall sh. C sh => sh -> Int
Shape.size nrhs
widthB
         in if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
               then (Int
0, Full vert horiz width nrhs -> Full vert horiz width nrhs a
forall sh a. (C sh, Floating a) => sh -> Vector sh a
Vector.zero Full vert horiz width nrhs
shapeX)
               else
                  if Int
nrhs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                     then
                        ((Int, Array (General width ()) a) -> Int
forall a b. (a, b) -> a
fst ((Int, Array (General width ()) a) -> Int)
-> (Int, Array (General width ()) a) -> Int
forall a b. (a -> b) -> a -> b
$ IO (Int, Array (General width ()) a)
-> (Int, Array (General width ()) a)
forall a. IO a -> a
unsafePerformIO (IO (Int, Array (General width ()) a)
 -> (Int, Array (General width ()) a))
-> IO (Int, Array (General width ()) a)
-> (Int, Array (General width ()) a)
forall a b. (a -> b) -> a -> b
$
                         case height -> Vector height a
forall sh a. (C sh, Floating a) => sh -> Vector sh a
Vector.zero height
height of
                           Array height
_ ForeignPtr a
b1 ->
                              RealOf a
-> General width ()
-> Order
-> ForeignPtr a
-> Order
-> ForeignPtr a
-> Int
-> Int
-> Int
-> IO (Int, Array (General width ()) a)
forall sh a.
(C sh, Floating a) =>
RealOf a
-> sh
-> Order
-> ForeignPtr a
-> Order
-> ForeignPtr a
-> Int
-> Int
-> Int
-> IO (Int, Array sh a)
leastSquaresMinimumNormIO RealOf a
rcond
                                 (Order -> width -> () -> General width ()
forall height width.
Order -> height -> width -> General height width
MatrixShape.general Order
ColumnMajor width
widthA ())
                                 Order
orderA ForeignPtr a
a Order
orderB ForeignPtr a
b1 Int
m Int
n Int
1,
                         Full vert horiz width nrhs -> Full vert horiz width nrhs a
forall sh a. (C sh, Floating a) => sh -> Vector sh a
Vector.zero Full vert horiz width nrhs
shapeX)
                     else
                        IO (Int, Full vert horiz width nrhs a)
-> (Int, Full vert horiz width nrhs a)
forall a. IO a -> a
unsafePerformIO (IO (Int, Full vert horiz width nrhs a)
 -> (Int, Full vert horiz width nrhs a))
-> IO (Int, Full vert horiz width nrhs a)
-> (Int, Full vert horiz width nrhs a)
forall a b. (a -> b) -> a -> b
$
                        RealOf a
-> Full vert horiz width nrhs
-> Order
-> ForeignPtr a
-> Order
-> ForeignPtr a
-> Int
-> Int
-> Int
-> IO (Int, Full vert horiz width nrhs a)
forall sh a.
(C sh, Floating a) =>
RealOf a
-> sh
-> Order
-> ForeignPtr a
-> Order
-> ForeignPtr a
-> Int
-> Int
-> Int
-> IO (Int, Array sh a)
leastSquaresMinimumNormIO RealOf a
rcond Full vert horiz width nrhs
shapeX
                           Order
orderA ForeignPtr a
a Order
orderB ForeignPtr a
b Int
m Int
n Int
nrhs

leastSquaresMinimumNormIO ::
   (Shape.C sh, Class.Floating a) =>
   RealOf a -> sh ->
   Order -> ForeignPtr a ->
   Order -> ForeignPtr a ->
   Int -> Int -> Int -> IO (Int, Array sh a)
leastSquaresMinimumNormIO :: RealOf a
-> sh
-> Order
-> ForeignPtr a
-> Order
-> ForeignPtr a
-> Int
-> Int
-> Int
-> IO (Int, Array sh a)
leastSquaresMinimumNormIO RealOf a
rcond sh
shapeX Order
orderA ForeignPtr a
a Order
orderB ForeignPtr a
b Int
m Int
n Int
nrhs =
   sh
-> Int
-> Int
-> Int
-> ((Ptr a, Int) -> IO Int)
-> IO (Int, Array sh a)
forall sh a rank.
(C sh, Floating a) =>
sh
-> Int
-> Int
-> Int
-> ((Ptr a, Int) -> IO rank)
-> IO (rank, Array sh a)
createHigherArray sh
shapeX Int
m Int
n Int
nrhs (((Ptr a, Int) -> IO Int) -> IO (Int, Array sh a))
-> ((Ptr a, Int) -> IO Int) -> IO (Int, Array sh a)
forall a b. (a -> b) -> a -> b
$ \(Ptr a
tmpPtr,Int
ldtmp) -> do

   let mn :: Int
mn = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
m Int
n
   let lda :: Int
lda = Int
m
   ContT Int IO Int -> IO Int
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Int IO Int -> IO Int) -> ContT Int IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
      Ptr CInt
mPtr <- Int -> FortranIO Int (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
m
      Ptr CInt
nPtr <- Int -> FortranIO Int (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
n
      Ptr CInt
nrhsPtr <- Int -> FortranIO Int (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.cint Int
nrhs
      Ptr a
aPtr <- Order -> Int -> Int -> ForeignPtr a -> ContT Int IO (Ptr a)
forall a r.
Floating a =>
Order -> Int -> Int -> ForeignPtr a -> ContT r IO (Ptr a)
copyToColumnMajorTemp Order
orderA Int
m Int
n ForeignPtr a
a
      Ptr CInt
ldaPtr <- Int -> FortranIO Int (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
lda
      Ptr CInt
ldtmpPtr <- Int -> FortranIO Int (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
Call.leadingDim Int
ldtmp
      IO () -> ContT Int IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT Int IO ()) -> IO () -> ContT Int IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
b ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
bPtr ->
         Order -> Int -> Int -> Ptr a -> Int -> Ptr a -> IO ()
forall a.
Floating a =>
Order -> Int -> Int -> Ptr a -> Int -> Ptr a -> IO ()
copyToSubColumnMajor Order
orderB Int
m Int
nrhs Ptr a
bPtr Int
ldtmp Ptr a
tmpPtr

      Ptr CInt
rankPtr <- FortranIO Int (Ptr CInt)
forall a r. Storable a => FortranIO r (Ptr a)
Call.alloca
      IO () -> ContT Int IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT Int IO ()) -> IO () -> ContT Int IO ()
forall a b. (a -> b) -> a -> b
$
         String -> (Ptr CInt -> IO ()) -> IO ()
withInfo String
"gelss" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
infoPtr ->
         GELSS_ (RealOf a) a
forall a. Floating a => GELSS_ (RealOf a) a
gelss Ptr CInt
mPtr Ptr CInt
nPtr Ptr CInt
nrhsPtr Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
tmpPtr Ptr CInt
ldtmpPtr RealOf a
rcond
            Ptr CInt
rankPtr Int
mn Ptr CInt
infoPtr

      IO Int -> ContT Int IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ContT Int IO Int) -> IO Int -> ContT Int IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO Int
peekCInt Ptr CInt
rankPtr


type GELSS_ ar a =
   Ptr CInt -> Ptr CInt -> Ptr CInt ->
   Ptr a -> Ptr CInt -> Ptr a -> Ptr CInt ->
   ar -> Ptr CInt -> Int -> Ptr CInt -> IO ()

newtype GELSS a = GELSS {GELSS a -> GELSS_ (RealOf a) a
getGELSS :: GELSS_ (RealOf a) a}

gelss :: Class.Floating a => GELSS_ (RealOf a) a
gelss :: GELSS_ (RealOf a) a
gelss =
   GELSS a -> GELSS_ (RealOf a) a
forall a. GELSS a -> GELSS_ (RealOf a) a
getGELSS (GELSS a -> GELSS_ (RealOf a) a) -> GELSS a -> GELSS_ (RealOf a) a
forall a b. (a -> b) -> a -> b
$
   GELSS Float
-> GELSS Double
-> GELSS (Complex Float)
-> GELSS (Complex Double)
-> GELSS a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      (GELSS_ (RealOf Float) Float -> GELSS Float
forall a. GELSS_ (RealOf a) a -> GELSS a
GELSS GELSS_ (RealOf Float) Float
forall a. Real a => GELSS_ a a
gelssReal)
      (GELSS_ (RealOf Double) Double -> GELSS Double
forall a. GELSS_ (RealOf a) a -> GELSS a
GELSS GELSS_ (RealOf Double) Double
forall a. Real a => GELSS_ a a
gelssReal)
      (GELSS_ (RealOf (Complex Float)) (Complex Float)
-> GELSS (Complex Float)
forall a. GELSS_ (RealOf a) a -> GELSS a
GELSS GELSS_ (RealOf (Complex Float)) (Complex Float)
forall a. Real a => GELSS_ a (Complex a)
gelssComplex)
      (GELSS_ (RealOf (Complex Double)) (Complex Double)
-> GELSS (Complex Double)
forall a. GELSS_ (RealOf a) a -> GELSS a
GELSS GELSS_ (RealOf (Complex Double)) (Complex Double)
forall a. Real a => GELSS_ a (Complex a)
gelssComplex)

gelssReal :: (Class.Real a) => GELSS_ a a
gelssReal :: GELSS_ a a
gelssReal Ptr CInt
mPtr Ptr CInt
nPtr Ptr CInt
nrhsPtr Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
bPtr Ptr CInt
ldbPtr a
rcond
      Ptr CInt
rankPtr Int
mn Ptr CInt
infoPtr =
   a -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with a
rcond ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
rcondPtr ->
   Int -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
mn ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
sPtr ->
   (Ptr a -> Ptr CInt -> IO ()) -> IO ()
forall a. Floating a => (Ptr a -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspace ((Ptr a -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr a -> Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
workPtr Ptr CInt
lworkPtr ->
   Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> Ptr CInt
-> IO ()
LapackReal.gelss
      Ptr CInt
mPtr Ptr CInt
nPtr Ptr CInt
nrhsPtr Ptr a
aPtr Ptr CInt
ldaPtr Ptr a
bPtr Ptr CInt
ldbPtr Ptr a
sPtr Ptr a
rcondPtr
      Ptr CInt
rankPtr Ptr a
workPtr Ptr CInt
lworkPtr Ptr CInt
infoPtr

gelssComplex :: (Class.Real a) => GELSS_ a (Complex a)
gelssComplex :: GELSS_ a (Complex a)
gelssComplex Ptr CInt
mPtr Ptr CInt
nPtr Ptr CInt
nrhsPtr Ptr (Complex a)
aPtr Ptr CInt
ldaPtr Ptr (Complex a)
bPtr Ptr CInt
ldbPtr a
rcond
      Ptr CInt
rankPtr Int
mn Ptr CInt
infoPtr =
   a -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with a
rcond ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
rcondPtr ->
   Int -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca Int
mn ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
sPtr ->
   Int -> (Ptr a -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
ForeignArray.alloca (Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
mn) ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
rworkPtr ->
   (Ptr (Complex a) -> Ptr CInt -> IO ()) -> IO ()
forall a. Floating a => (Ptr a -> Ptr CInt -> IO ()) -> IO ()
withAutoWorkspace ((Ptr (Complex a) -> Ptr CInt -> IO ()) -> IO ())
-> (Ptr (Complex a) -> Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Complex a)
workPtr Ptr CInt
lworkPtr ->
   Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
forall a.
Real a =>
Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr a
-> Ptr CInt
-> Ptr (Complex a)
-> Ptr CInt
-> Ptr a
-> Ptr CInt
-> IO ()
LapackComplex.gelss
      Ptr CInt
mPtr Ptr CInt
nPtr Ptr CInt
nrhsPtr Ptr (Complex a)
aPtr Ptr CInt
ldaPtr Ptr (Complex a)
bPtr Ptr CInt
ldbPtr Ptr a
sPtr Ptr a
rcondPtr
      Ptr CInt
rankPtr Ptr (Complex a)
workPtr Ptr CInt
lworkPtr Ptr a
rworkPtr Ptr CInt
infoPtr


pseudoInverseRCond ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Eq width, Class.Floating a) =>
   RealOf a ->
   Full vert horiz height width a ->
   (Int, Full horiz vert width height a)
pseudoInverseRCond :: RealOf a
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
pseudoInverseRCond =
   PseudoInverseRCond
  (Array (Full vert horiz height width))
  (Array (Full horiz vert width height))
  a
-> RealOf a
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
forall (f :: * -> *) (g :: * -> *) a.
PseudoInverseRCond f g a -> RealOf a -> f a -> (Int, g a)
getPseudoInverseRCond (PseudoInverseRCond
   (Array (Full vert horiz height width))
   (Array (Full horiz vert width height))
   a
 -> RealOf a
 -> Full vert horiz height width a
 -> (Int, Full horiz vert width height a))
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     a
-> RealOf a
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
forall a b. (a -> b) -> a -> b
$
   PseudoInverseRCond
  (Array (Full vert horiz height width))
  (Array (Full horiz vert width height))
  Float
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     Double
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     (Complex Float)
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     (Complex Double)
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((RealOf Float
 -> Array (Full vert horiz height width) Float
 -> (Int, Array (Full horiz vert width height) Float))
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     Float
forall (f :: * -> *) (g :: * -> *) a.
(RealOf a -> f a -> (Int, g a)) -> PseudoInverseRCond f g a
PseudoInverseRCond RealOf Float
-> Array (Full vert horiz height width) Float
-> (Int, Array (Full horiz vert width height) Float)
forall vert horiz height width a ar.
(C vert, C horiz, C height, Eq height, C width, Eq width,
 Floating a, RealOf a ~ ar, Real ar) =>
ar
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
pseudoInverseRCondAux)
      ((RealOf Double
 -> Array (Full vert horiz height width) Double
 -> (Int, Array (Full horiz vert width height) Double))
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     Double
forall (f :: * -> *) (g :: * -> *) a.
(RealOf a -> f a -> (Int, g a)) -> PseudoInverseRCond f g a
PseudoInverseRCond RealOf Double
-> Array (Full vert horiz height width) Double
-> (Int, Array (Full horiz vert width height) Double)
forall vert horiz height width a ar.
(C vert, C horiz, C height, Eq height, C width, Eq width,
 Floating a, RealOf a ~ ar, Real ar) =>
ar
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
pseudoInverseRCondAux)
      ((RealOf (Complex Float)
 -> Array (Full vert horiz height width) (Complex Float)
 -> (Int, Array (Full horiz vert width height) (Complex Float)))
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     (Complex Float)
forall (f :: * -> *) (g :: * -> *) a.
(RealOf a -> f a -> (Int, g a)) -> PseudoInverseRCond f g a
PseudoInverseRCond RealOf (Complex Float)
-> Array (Full vert horiz height width) (Complex Float)
-> (Int, Array (Full horiz vert width height) (Complex Float))
forall vert horiz height width a ar.
(C vert, C horiz, C height, Eq height, C width, Eq width,
 Floating a, RealOf a ~ ar, Real ar) =>
ar
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
pseudoInverseRCondAux)
      ((RealOf (Complex Double)
 -> Array (Full vert horiz height width) (Complex Double)
 -> (Int, Array (Full horiz vert width height) (Complex Double)))
-> PseudoInverseRCond
     (Array (Full vert horiz height width))
     (Array (Full horiz vert width height))
     (Complex Double)
forall (f :: * -> *) (g :: * -> *) a.
(RealOf a -> f a -> (Int, g a)) -> PseudoInverseRCond f g a
PseudoInverseRCond RealOf (Complex Double)
-> Array (Full vert horiz height width) (Complex Double)
-> (Int, Array (Full horiz vert width height) (Complex Double))
forall vert horiz height width a ar.
(C vert, C horiz, C height, Eq height, C width, Eq width,
 Floating a, RealOf a ~ ar, Real ar) =>
ar
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
pseudoInverseRCondAux)

newtype PseudoInverseRCond f g a =
   PseudoInverseRCond {
      PseudoInverseRCond f g a -> RealOf a -> f a -> (Int, g a)
getPseudoInverseRCond :: RealOf a -> f a -> (Int, g a)
   }

pseudoInverseRCondAux ::
   (Extent.C vert, Extent.C horiz,
    Shape.C height, Eq height, Shape.C width, Eq width,
    Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   ar ->
   Full vert horiz height width a ->
   (Int, Full horiz vert width height a)
pseudoInverseRCondAux :: ar
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
pseudoInverseRCondAux ar
rcond =
   PseudoInverseExtent height width a vert horiz
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
forall height width a vert horiz.
PseudoInverseExtent height width a vert horiz
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
getPseudoInverseExtent (PseudoInverseExtent height width a vert horiz
 -> Full vert horiz height width a
 -> (Int, Full horiz vert width height a))
-> PseudoInverseExtent height width a vert horiz
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
forall a b. (a -> b) -> a -> b
$
   PseudoInverseExtent height width a Small Small
-> PseudoInverseExtent height width a Small Big
-> PseudoInverseExtent height width a Big Small
-> PseudoInverseExtent height width a Big Big
-> PseudoInverseExtent height width a vert horiz
forall vert horiz (f :: * -> * -> *).
(C vert, C horiz) =>
f Small Small
-> f Small Big -> f Big Small -> f Big Big -> f vert horiz
Extent.switchTagPair
      ((Full Small Small height width a
 -> (Int, Full Small Small width height a))
-> PseudoInverseExtent height width a Small Small
forall height width a vert horiz.
(Full vert horiz height width a
 -> (Int, Full horiz vert width height a))
-> PseudoInverseExtent height width a vert horiz
PseudoInverseExtent ((Full Small Small height width a
  -> (Int, Full Small Small width height a))
 -> PseudoInverseExtent height width a Small Small)
-> (Full Small Small height width a
    -> (Int, Full Small Small width height a))
-> PseudoInverseExtent height width a Small Small
forall a b. (a -> b) -> a -> b
$ RealOf a
-> Full Small Small height width a
-> (Int, Full Small Small width height a)
forall horiz height width a ar.
(C horiz, C height, Eq height, C width, Eq width, Floating a,
 RealOf a ~ ar, Real ar) =>
RealOf a
-> Full Small horiz height width a
-> (Int, Full horiz Small width height a)
pseudoInverseRCondWide ar
RealOf a
rcond)
      ((Full Small Big height width a
 -> (Int, Full Big Small width height a))
-> PseudoInverseExtent height width a Small Big
forall height width a vert horiz.
(Full vert horiz height width a
 -> (Int, Full horiz vert width height a))
-> PseudoInverseExtent height width a vert horiz
PseudoInverseExtent ((Full Small Big height width a
  -> (Int, Full Big Small width height a))
 -> PseudoInverseExtent height width a Small Big)
-> (Full Small Big height width a
    -> (Int, Full Big Small width height a))
-> PseudoInverseExtent height width a Small Big
forall a b. (a -> b) -> a -> b
$ RealOf a
-> Full Small Big height width a
-> (Int, Full Big Small width height a)
forall horiz height width a ar.
(C horiz, C height, Eq height, C width, Eq width, Floating a,
 RealOf a ~ ar, Real ar) =>
RealOf a
-> Full Small horiz height width a
-> (Int, Full horiz Small width height a)
pseudoInverseRCondWide ar
RealOf a
rcond)
      ((Full Big Small height width a
 -> (Int, Full Small Big width height a))
-> PseudoInverseExtent height width a Big Small
forall height width a vert horiz.
(Full vert horiz height width a
 -> (Int, Full horiz vert width height a))
-> PseudoInverseExtent height width a vert horiz
PseudoInverseExtent ((Full Big Small height width a
  -> (Int, Full Small Big width height a))
 -> PseudoInverseExtent height width a Big Small)
-> (Full Big Small height width a
    -> (Int, Full Small Big width height a))
-> PseudoInverseExtent height width a Big Small
forall a b. (a -> b) -> a -> b
$ RealOf a
-> Full Big Small height width a
-> (Int, Full Small Big width height a)
forall vert height width a ar.
(C vert, C height, Eq height, C width, Eq width, Floating a,
 RealOf a ~ ar, Real ar) =>
RealOf a
-> Full vert Small height width a
-> (Int, Full Small vert width height a)
pseudoInverseRCondTall ar
RealOf a
rcond)
      ((Full Big Big height width a -> (Int, Full Big Big width height a))
-> PseudoInverseExtent height width a Big Big
forall height width a vert horiz.
(Full vert horiz height width a
 -> (Int, Full horiz vert width height a))
-> PseudoInverseExtent height width a vert horiz
PseudoInverseExtent ((Full Big Big height width a
  -> (Int, Full Big Big width height a))
 -> PseudoInverseExtent height width a Big Big)
-> (Full Big Big height width a
    -> (Int, Full Big Big width height a))
-> PseudoInverseExtent height width a Big Big
forall a b. (a -> b) -> a -> b
$
         (Full Big Small height width a
 -> (Int, Full Big Big width height a))
-> (Full Small Big height width a
    -> (Int, Full Big Big width height a))
-> Either
     (Full Big Small height width a) (Full Small Big height width a)
-> (Int, Full Big Big width height a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            ((Full Small Big width height a -> Full Big Big width height a)
-> (Int, Full Small Big width height a)
-> (Int, Full Big Big width height a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd Full Small Big width height a -> Full Big Big width height a
forall vert horiz height width a.
(C vert, C horiz) =>
Full vert horiz height width a -> General height width a
Matrix.fromFull ((Int, Full Small Big width height a)
 -> (Int, Full Big Big width height a))
-> (Full Big Small height width a
    -> (Int, Full Small Big width height a))
-> Full Big Small height width a
-> (Int, Full Big Big width height a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealOf a
-> Full Big Small height width a
-> (Int, Full Small Big width height a)
forall vert height width a ar.
(C vert, C height, Eq height, C width, Eq width, Floating a,
 RealOf a ~ ar, Real ar) =>
RealOf a
-> Full vert Small height width a
-> (Int, Full Small vert width height a)
pseudoInverseRCondTall ar
RealOf a
rcond)
            ((Full Big Small width height a -> Full Big Big width height a)
-> (Int, Full Big Small width height a)
-> (Int, Full Big Big width height a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd Full Big Small width height a -> Full Big Big width height a
forall vert horiz height width a.
(C vert, C horiz) =>
Full vert horiz height width a -> General height width a
Matrix.fromFull ((Int, Full Big Small width height a)
 -> (Int, Full Big Big width height a))
-> (Full Small Big height width a
    -> (Int, Full Big Small width height a))
-> Full Small Big height width a
-> (Int, Full Big Big width height a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealOf a
-> Full Small Big height width a
-> (Int, Full Big Small width height a)
forall horiz height width a ar.
(C horiz, C height, Eq height, C width, Eq width, Floating a,
 RealOf a ~ ar, Real ar) =>
RealOf a
-> Full Small horiz height width a
-> (Int, Full horiz Small width height a)
pseudoInverseRCondWide ar
RealOf a
rcond)
         (Either
   (Full Big Small height width a) (Full Small Big height width a)
 -> (Int, Full Big Big width height a))
-> (Full Big Big height width a
    -> Either
         (Full Big Small height width a) (Full Small Big height width a))
-> Full Big Big height width a
-> (Int, Full Big Big width height a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Full Big Big height width a
-> Either
     (Full Big Small height width a) (Full Small Big height width a)
forall vert horiz height width a.
(C vert, C horiz, C height, C width) =>
Full vert horiz height width a
-> Either (Tall height width a) (Wide height width a)
Basic.caseTallWide)

newtype PseudoInverseExtent height width a vert horiz =
   PseudoInverseExtent {
      PseudoInverseExtent height width a vert horiz
-> Full vert horiz height width a
-> (Int, Full horiz vert width height a)
getPseudoInverseExtent ::
         Full vert horiz height width a ->
         (Int, Full horiz vert width height a)
   }

pseudoInverseRCondWide ::
   (Extent.C horiz, Shape.C height, Eq height, Shape.C width, Eq width,
    Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   RealOf a ->
   Full Extent.Small horiz height width a ->
   (Int, Full horiz Extent.Small width height a)
pseudoInverseRCondWide :: RealOf a
-> Full Small horiz height width a
-> (Int, Full horiz Small width height a)
pseudoInverseRCondWide RealOf a
rcond Full Small horiz height width a
a =
   let (Square height a
u,Array height ar
s,Full Small horiz height width a
vt) = Full Small horiz height width a
-> (Square height a, Vector height (RealOf a),
    Full Small horiz height width a)
forall horiz height width a.
(C horiz, C height, C width, Floating a) =>
Full Small horiz height width a
-> (Square height a, Vector height (RealOf a),
    Full Small horiz height width a)
decomposeWide Full Small horiz height width a
a
       (Int
rank,Array height ar
recipS) = ar -> Array height ar -> (Int, Array height ar)
forall sh a. (C sh, Real a) => a -> Array sh a -> (Int, Array sh a)
recipSigma ar
RealOf a
rcond Array height ar
s
   in  (Int
rank,
        Full horiz Small width height a
-> Full horiz Small height height a
-> Full horiz Small width height a
forall vert horiz height fuse width a.
(C vert, C horiz, C height, C fuse, Eq fuse, C width,
 Floating a) =>
Full vert horiz height fuse a
-> Full vert horiz fuse width a -> Full vert horiz height width a
Basic.multiply (Full Small horiz height width a -> Full horiz Small width height a
forall vert horiz height width a.
(C vert, C horiz, C height, C width, Floating a) =>
Full vert horiz height width a -> Full horiz vert width height a
Basic.adjoint Full Small horiz height width a
vt) (Full horiz Small height height a
 -> Full horiz Small width height a)
-> Full horiz Small height height a
-> Full horiz Small width height a
forall a b. (a -> b) -> a -> b
$
        Vector height (RealOf a)
-> Full horiz Small height height a
-> Full horiz Small height height a
forall vert horiz height width a.
(C vert, C horiz, C height, Eq height, C width, Floating a) =>
Vector height (RealOf a)
-> Full vert horiz height width a -> Full vert horiz height width a
Basic.scaleRowsReal Array height ar
Vector height (RealOf a)
recipS (Full horiz Small height height a
 -> Full horiz Small height height a)
-> Full horiz Small height height a
-> Full horiz Small height height a
forall a b. (a -> b) -> a -> b
$ Square height a -> Full horiz Small height height a
forall vert horiz sh a.
(C vert, C horiz) =>
Square sh a -> Full vert horiz sh sh a
Square.toFull (Square height a -> Full horiz Small height height a)
-> Square height a -> Full horiz Small height height a
forall a b. (a -> b) -> a -> b
$ Square height a -> Square height a
forall sh a. (C sh, Floating a) => Square sh a -> Square sh a
Square.adjoint Square height a
u)

pseudoInverseRCondTall ::
   (Extent.C vert, Shape.C height, Eq height, Shape.C width, Eq width,
    Class.Floating a, RealOf a ~ ar, Class.Real ar) =>
   RealOf a ->
   Full vert Extent.Small height width a ->
   (Int, Full Extent.Small vert width height a)
pseudoInverseRCondTall :: RealOf a
-> Full vert Small height width a
-> (Int, Full Small vert width height a)
pseudoInverseRCondTall RealOf a
rcond Full vert Small height width a
a =
   let (Full vert Small height width a
u,Array width ar
s,Square width a
vt) = Full vert Small height width a
-> (Full vert Small height width a, Vector width (RealOf a),
    Square width a)
forall vert height width a.
(C vert, C height, C width, Floating a) =>
Full vert Small height width a
-> (Full vert Small height width a, Vector width (RealOf a),
    Square width a)
decomposeTall Full vert Small height width a
a
       (Int
rank,Array width ar
recipS) = ar -> Array width ar -> (Int, Array width ar)
forall sh a. (C sh, Real a) => a -> Array sh a -> (Int, Array sh a)
recipSigma ar
RealOf a
rcond Array width ar
s
   in  (Int
rank,
        Full Small vert width width a
-> Full Small vert width height a -> Full Small vert width height a
forall vert horiz height fuse width a.
(C vert, C horiz, C height, C fuse, Eq fuse, C width,
 Floating a) =>
Full vert horiz height fuse a
-> Full vert horiz fuse width a -> Full vert horiz height width a
Basic.multiply (Square width a -> Full Small vert width width a
forall vert horiz sh a.
(C vert, C horiz) =>
Square sh a -> Full vert horiz sh sh a
Square.toFull (Square width a -> Full Small vert width width a)
-> Square width a -> Full Small vert width width a
forall a b. (a -> b) -> a -> b
$ Square width a -> Square width a
forall sh a. (C sh, Floating a) => Square sh a -> Square sh a
Square.adjoint Square width a
vt) (Full Small vert width height a -> Full Small vert width height a)
-> Full Small vert width height a -> Full Small vert width height a
forall a b. (a -> b) -> a -> b
$
        Vector width (RealOf a)
-> Full Small vert width height a -> Full Small vert width height a
forall vert horiz height width a.
(C vert, C horiz, C height, Eq height, C width, Floating a) =>
Vector height (RealOf a)
-> Full vert horiz height width a -> Full vert horiz height width a
Basic.scaleRowsReal Array width ar
Vector width (RealOf a)
recipS (Full Small vert width height a -> Full Small vert width height a)
-> Full Small vert width height a -> Full Small vert width height a
forall a b. (a -> b) -> a -> b
$ Full vert Small height width a -> Full Small vert width height a
forall vert horiz height width a.
(C vert, C horiz, C height, C width, Floating a) =>
Full vert horiz height width a -> Full horiz vert width height a
Basic.adjoint Full vert Small height width a
u)


recipSigma ::
   (Shape.C sh, Class.Real a) => a -> Array sh a -> (Int, Array sh a)
recipSigma :: a -> Array sh a -> (Int, Array sh a)
recipSigma a
rcond Array sh a
sigmas =
   case Array sh a -> [a]
forall sh a. (C sh, Storable a) => Array sh a -> [a]
Array.toList Array sh a
sigmas of
      [] -> (Int
0, Array sh a
sigmas)
      a
0:[a]
_ -> (Int
0, Array sh a
sigmas)
      xs :: [a]
xs@(a
x:[a]
_) ->
         let smin :: a
smin = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
rcond
         in ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
smin) [a]
xs),
             (a -> a) -> Array sh a -> Array sh a
forall sh a b.
(C sh, Storable a, Storable b) =>
(a -> b) -> Array sh a -> Array sh b
Array.map (\a
s -> if a
sa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
smin then a -> a
forall a. Fractional a => a -> a
recip a
s else a
0) Array sh a
sigmas)


withInfo :: String -> (Ptr CInt -> IO ()) -> IO ()
withInfo :: String -> (Ptr CInt -> IO ()) -> IO ()
withInfo = String -> String -> (Ptr CInt -> IO ()) -> IO ()
Private.withInfo String
"%d superdiagonals did not converge"