{-# LANGUAGE TypeFamilies #-} module Numeric.LAPACK.Matrix.BandedHermitian.Eigen ( values, decompose, ) where import Numeric.LAPACK.Matrix.BandedHermitian.Basic (BandedHermitian) import qualified Numeric.LAPACK.Matrix.Shape.Private as MatrixShape import qualified Numeric.LAPACK.Matrix.Private as Matrix import Numeric.LAPACK.Matrix.Hermitian.Private (TakeDiagonal(..)) import Numeric.LAPACK.Matrix.Shape.Private (Order(ColumnMajor), uploFromOrder) import Numeric.LAPACK.Matrix.Modifier (conjugatedOnRowMajor) import Numeric.LAPACK.Vector (Vector) import Numeric.LAPACK.Scalar (RealOf) import Numeric.LAPACK.Private (copyToTemp, copyCondConjugateToTemp, withInfo, eigenMsg) 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 Type.Data.Num.Unary as Unary import Type.Data.Num (integralFromProxy) 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 Foreign.C.Types (CInt, CChar) 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) values :: (Unary.Natural offDiag, Shape.C sh, Class.Floating a) => BandedHermitian offDiag sh a -> Vector sh (RealOf a) values :: BandedHermitian offDiag sh a -> Vector sh (RealOf a) values = TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) a -> BandedHermitian offDiag sh a -> Vector sh (RealOf a) forall (f :: * -> *) (g :: * -> *) a. TakeDiagonal f g a -> f a -> g (RealOf a) runTakeDiagonal (TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) a -> BandedHermitian offDiag sh a -> Vector sh (RealOf a)) -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) a -> BandedHermitian offDiag sh a -> Vector sh (RealOf a) forall a b. (a -> b) -> a -> b $ TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) Float -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) Double -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) (Complex Float) -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) (Complex Double) -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) a forall a (f :: * -> *). Floating a => f Float -> f Double -> f (Complex Float) -> f (Complex Double) -> f a Class.switchFloating ((Array (BandedHermitian offDiag sh) Float -> Array sh (RealOf Float)) -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) Float forall (f :: * -> *) (g :: * -> *) a. (f a -> g (RealOf a)) -> TakeDiagonal f g a TakeDiagonal Array (BandedHermitian offDiag sh) Float -> Array sh (RealOf Float) forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => BandedHermitian offDiag sh a -> Vector sh ar valuesAux) ((Array (BandedHermitian offDiag sh) Double -> Array sh (RealOf Double)) -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) Double forall (f :: * -> *) (g :: * -> *) a. (f a -> g (RealOf a)) -> TakeDiagonal f g a TakeDiagonal Array (BandedHermitian offDiag sh) Double -> Array sh (RealOf Double) forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => BandedHermitian offDiag sh a -> Vector sh ar valuesAux) ((Array (BandedHermitian offDiag sh) (Complex Float) -> Array sh (RealOf (Complex Float))) -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) (Complex Float) forall (f :: * -> *) (g :: * -> *) a. (f a -> g (RealOf a)) -> TakeDiagonal f g a TakeDiagonal Array (BandedHermitian offDiag sh) (Complex Float) -> Array sh (RealOf (Complex Float)) forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => BandedHermitian offDiag sh a -> Vector sh ar valuesAux) ((Array (BandedHermitian offDiag sh) (Complex Double) -> Array sh (RealOf (Complex Double))) -> TakeDiagonal (Array (BandedHermitian offDiag sh)) (Array sh) (Complex Double) forall (f :: * -> *) (g :: * -> *) a. (f a -> g (RealOf a)) -> TakeDiagonal f g a TakeDiagonal Array (BandedHermitian offDiag sh) (Complex Double) -> Array sh (RealOf (Complex Double)) forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => BandedHermitian offDiag sh a -> Vector sh ar valuesAux) valuesAux :: (Unary.Natural offDiag, Shape.C sh, Class.Floating a, RealOf a ~ ar, Storable ar) => BandedHermitian offDiag sh a -> Vector sh ar valuesAux :: BandedHermitian offDiag sh a -> Vector sh ar valuesAux (Array (MatrixShape.BandedHermitian UnaryProxy offDiag numOff Order order sh size) ForeignPtr a a) = sh -> (Int -> Ptr ar -> IO ()) -> Vector sh ar forall sh a. (C sh, Storable a) => sh -> (Int -> Ptr a -> IO ()) -> Array sh a Array.unsafeCreateWithSize sh size ((Int -> Ptr ar -> IO ()) -> Vector sh ar) -> (Int -> Ptr ar -> IO ()) -> Vector sh ar forall a b. (a -> b) -> a -> b $ \Int n Ptr ar wPtr -> 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 k :: Int k = UnaryProxy offDiag -> Int forall x y. (Integer x, Num y) => Proxy x -> y integralFromProxy UnaryProxy offDiag numOff let lda :: Int lda = Int kInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1 Ptr CChar jobzPtr <- Char -> FortranIO () (Ptr CChar) forall r. Char -> FortranIO r (Ptr CChar) Call.char Char 'N' Ptr CChar uploPtr <- Char -> FortranIO () (Ptr CChar) forall r. Char -> FortranIO r (Ptr CChar) Call.char (Char -> FortranIO () (Ptr CChar)) -> Char -> FortranIO () (Ptr CChar) forall a b. (a -> b) -> a -> b $ Order -> Char uploFromOrder Order order Ptr CInt kPtr <- Int -> FortranIO () (Ptr CInt) forall r. Int -> FortranIO r (Ptr CInt) Call.cint Int k 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 nInt -> Int -> Int forall a. Num a => a -> a -> a *Int lda) ForeignPtr a a Ptr CInt ldaPtr <- Int -> FortranIO () (Ptr CInt) forall r. Int -> FortranIO r (Ptr CInt) Call.leadingDim Int lda let zPtr :: Ptr a zPtr = Ptr a forall a. Ptr a nullPtr Ptr CInt ldzPtr <- 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 -> String -> (Ptr CInt -> IO ()) -> IO () withInfo String eigenMsg String "hbev" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ HBEV_ (RealOf a) a forall a. Floating a => HBEV_ (RealOf a) a hbev Ptr CChar jobzPtr Ptr CChar uploPtr Int n Ptr CInt kPtr Ptr a aPtr Ptr CInt ldaPtr Ptr ar Ptr (RealOf a) wPtr Ptr a forall a. Ptr a zPtr Ptr CInt ldzPtr decompose :: (Unary.Natural offDiag, Shape.C sh, Class.Floating a) => BandedHermitian offDiag sh a -> (Matrix.Square sh a, Vector sh (RealOf a)) decompose :: BandedHermitian offDiag sh a -> (Square sh a, Vector sh (RealOf a)) decompose = Decompose offDiag sh a -> BandedHermitian offDiag sh a -> (Square sh a, Vector sh (RealOf a)) forall offDiag sh a. Decompose offDiag sh a -> Decompose_ offDiag sh a getDecompose (Decompose offDiag sh a -> BandedHermitian offDiag sh a -> (Square sh a, Vector sh (RealOf a))) -> Decompose offDiag sh a -> BandedHermitian offDiag sh a -> (Square sh a, Vector sh (RealOf a)) forall a b. (a -> b) -> a -> b $ Decompose offDiag sh Float -> Decompose offDiag sh Double -> Decompose offDiag sh (Complex Float) -> Decompose offDiag sh (Complex Double) -> Decompose offDiag sh a forall a (f :: * -> *). Floating a => f Float -> f Double -> f (Complex Float) -> f (Complex Double) -> f a Class.switchFloating (Decompose_ offDiag sh Float -> Decompose offDiag sh Float forall offDiag sh a. Decompose_ offDiag sh a -> Decompose offDiag sh a Decompose Decompose_ offDiag sh Float forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => Decompose_ offDiag sh a decomposeAux) (Decompose_ offDiag sh Double -> Decompose offDiag sh Double forall offDiag sh a. Decompose_ offDiag sh a -> Decompose offDiag sh a Decompose Decompose_ offDiag sh Double forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => Decompose_ offDiag sh a decomposeAux) (Decompose_ offDiag sh (Complex Float) -> Decompose offDiag sh (Complex Float) forall offDiag sh a. Decompose_ offDiag sh a -> Decompose offDiag sh a Decompose Decompose_ offDiag sh (Complex Float) forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => Decompose_ offDiag sh a decomposeAux) (Decompose_ offDiag sh (Complex Double) -> Decompose offDiag sh (Complex Double) forall offDiag sh a. Decompose_ offDiag sh a -> Decompose offDiag sh a Decompose Decompose_ offDiag sh (Complex Double) forall offDiag sh a ar. (Natural offDiag, C sh, Floating a, RealOf a ~ ar, Storable ar) => Decompose_ offDiag sh a decomposeAux) type Decompose_ offDiag sh a = BandedHermitian offDiag sh a -> (Matrix.Square sh a, Vector sh (RealOf a)) newtype Decompose offDiag sh a = Decompose {Decompose offDiag sh a -> Decompose_ offDiag sh a getDecompose :: Decompose_ offDiag sh a} decomposeAux :: (Unary.Natural offDiag, Shape.C sh, Class.Floating a, RealOf a ~ ar, Storable ar) => Decompose_ offDiag sh a decomposeAux :: Decompose_ offDiag sh a decomposeAux (Array (MatrixShape.BandedHermitian UnaryProxy offDiag numOff Order order sh size) ForeignPtr a a) = Full Small Small sh sh -> (Int -> Ptr a -> IO (Array sh ar)) -> (Array (Full Small Small sh sh) a, Array sh ar) forall sh a b. (C sh, Storable a) => sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b) Array.unsafeCreateWithSizeAndResult (Order -> sh -> Full Small Small sh sh forall sh. Order -> sh -> Square sh MatrixShape.square Order ColumnMajor sh size) ((Int -> Ptr a -> IO (Array sh ar)) -> (Array (Full Small Small sh sh) a, Array sh ar)) -> (Int -> Ptr a -> IO (Array sh ar)) -> (Array (Full Small Small sh sh) a, Array sh ar) forall a b. (a -> b) -> a -> b $ \Int _ Ptr a zPtr -> sh -> (Int -> Ptr ar -> IO ()) -> IO (Array sh ar) forall (m :: * -> *) sh a. (PrimMonad m, C sh, Storable a) => sh -> (Int -> Ptr a -> IO ()) -> m (Array sh a) ArrayIO.unsafeCreateWithSize sh size ((Int -> Ptr ar -> IO ()) -> IO (Array sh ar)) -> (Int -> Ptr ar -> IO ()) -> IO (Array sh ar) forall a b. (a -> b) -> a -> b $ \Int n Ptr ar wPtr -> 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 k :: Int k = UnaryProxy offDiag -> Int forall x y. (Integer x, Num y) => Proxy x -> y integralFromProxy UnaryProxy offDiag numOff let lda :: Int lda = Int kInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1 Ptr CChar jobzPtr <- Char -> FortranIO () (Ptr CChar) forall r. Char -> FortranIO r (Ptr CChar) Call.char Char 'V' Ptr CChar uploPtr <- Char -> FortranIO () (Ptr CChar) forall r. Char -> FortranIO r (Ptr CChar) Call.char (Char -> FortranIO () (Ptr CChar)) -> Char -> FortranIO () (Ptr CChar) forall a b. (a -> b) -> a -> b $ Order -> Char uploFromOrder Order order Ptr CInt kPtr <- Int -> FortranIO () (Ptr CInt) forall r. Int -> FortranIO r (Ptr CInt) Call.cint Int k Ptr a aPtr <- Conjugation -> Int -> ForeignPtr a -> ContT () IO (Ptr a) forall a r. Floating a => Conjugation -> Int -> ForeignPtr a -> ContT r IO (Ptr a) copyCondConjugateToTemp (Order -> Conjugation conjugatedOnRowMajor Order order) (Int nInt -> Int -> Int forall a. Num a => a -> a -> a *Int lda) ForeignPtr a a Ptr CInt ldaPtr <- Int -> FortranIO () (Ptr CInt) forall r. Int -> FortranIO r (Ptr CInt) Call.leadingDim Int lda Ptr CInt ldzPtr <- 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 -> String -> (Ptr CInt -> IO ()) -> IO () withInfo String eigenMsg String "hbev" ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ HBEV_ (RealOf a) a forall a. Floating a => HBEV_ (RealOf a) a hbev Ptr CChar jobzPtr Ptr CChar uploPtr Int n Ptr CInt kPtr Ptr a aPtr Ptr CInt ldaPtr Ptr ar Ptr (RealOf a) wPtr Ptr a zPtr Ptr CInt ldzPtr type HBEV_ ar a = Ptr CChar -> Ptr CChar -> Int -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr ar -> Ptr a -> Ptr CInt -> Ptr CInt -> IO () newtype HBEV a = HBEV {HBEV a -> HBEV_ (RealOf a) a getHBEV :: HBEV_ (RealOf a) a} hbev :: Class.Floating a => HBEV_ (RealOf a) a hbev :: HBEV_ (RealOf a) a hbev = HBEV a -> HBEV_ (RealOf a) a forall a. HBEV a -> HBEV_ (RealOf a) a getHBEV (HBEV a -> HBEV_ (RealOf a) a) -> HBEV a -> HBEV_ (RealOf a) a forall a b. (a -> b) -> a -> b $ HBEV Float -> HBEV Double -> HBEV (Complex Float) -> HBEV (Complex Double) -> HBEV a forall a (f :: * -> *). Floating a => f Float -> f Double -> f (Complex Float) -> f (Complex Double) -> f a Class.switchFloating (HBEV_ (RealOf Float) Float -> HBEV Float forall a. HBEV_ (RealOf a) a -> HBEV a HBEV HBEV_ (RealOf Float) Float forall a. Real a => HBEV_ a a sbevReal) (HBEV_ (RealOf Double) Double -> HBEV Double forall a. HBEV_ (RealOf a) a -> HBEV a HBEV HBEV_ (RealOf Double) Double forall a. Real a => HBEV_ a a sbevReal) (HBEV_ (RealOf (Complex Float)) (Complex Float) -> HBEV (Complex Float) forall a. HBEV_ (RealOf a) a -> HBEV a HBEV HBEV_ (RealOf (Complex Float)) (Complex Float) forall a. Real a => HBEV_ a (Complex a) hbevComplex) (HBEV_ (RealOf (Complex Double)) (Complex Double) -> HBEV (Complex Double) forall a. HBEV_ (RealOf a) a -> HBEV a HBEV HBEV_ (RealOf (Complex Double)) (Complex Double) forall a. Real a => HBEV_ a (Complex a) hbevComplex) sbevReal :: Class.Real a => HBEV_ a a sbevReal :: HBEV_ a a sbevReal Ptr CChar jobzPtr Ptr CChar uploPtr Int n Ptr CInt kdPtr Ptr a aPtr Ptr CInt ldaPtr Ptr a wPtr Ptr a zPtr Ptr CInt ldzPtr Ptr CInt infoPtr = 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 CInt nPtr <- Int -> FortranIO () (Ptr CInt) forall r. Int -> FortranIO r (Ptr CInt) Call.cint Int n Ptr a workPtr <- Int -> FortranIO () (Ptr a) forall a r. Storable a => Int -> FortranIO r (Ptr a) Call.allocaArray (Int -> Int -> Int forall a. Ord a => a -> a -> a max Int 1 (Int 3Int -> Int -> Int forall a. Num a => a -> a -> a *Int nInt -> Int -> Int forall a. Num a => a -> a -> a -Int 2)) 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 $ Ptr CChar -> Ptr CChar -> Ptr CInt -> Ptr CInt -> Ptr a -> Ptr CInt -> Ptr a -> Ptr a -> Ptr CInt -> Ptr a -> 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 -> IO () LapackReal.sbev Ptr CChar jobzPtr Ptr CChar uploPtr Ptr CInt nPtr Ptr CInt kdPtr Ptr a aPtr Ptr CInt ldaPtr Ptr a wPtr Ptr a zPtr Ptr CInt ldzPtr Ptr a workPtr Ptr CInt infoPtr hbevComplex :: Class.Real a => HBEV_ a (Complex a) hbevComplex :: HBEV_ a (Complex a) hbevComplex Ptr CChar jobzPtr Ptr CChar uploPtr Int n Ptr CInt kdPtr Ptr (Complex a) aPtr Ptr CInt ldaPtr Ptr a wPtr Ptr (Complex a) zPtr Ptr CInt ldzPtr Ptr CInt infoPtr = 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 CInt nPtr <- Int -> FortranIO () (Ptr CInt) forall r. Int -> FortranIO r (Ptr CInt) Call.cint Int n Ptr (Complex a) workPtr <- Int -> FortranIO () (Ptr (Complex a)) forall a r. Storable a => Int -> FortranIO r (Ptr a) Call.allocaArray Int n Ptr a rworkPtr <- Int -> FortranIO () (Ptr a) forall a r. Storable a => Int -> FortranIO r (Ptr a) Call.allocaArray (Int -> Int -> Int forall a. Ord a => a -> a -> a max Int 1 (Int 3Int -> Int -> Int forall a. Num a => a -> a -> a *Int nInt -> Int -> Int forall a. Num a => a -> a -> a -Int 2)) 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 $ Ptr CChar -> Ptr CChar -> Ptr CInt -> Ptr CInt -> Ptr (Complex a) -> Ptr CInt -> Ptr a -> Ptr (Complex a) -> Ptr CInt -> Ptr (Complex a) -> 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 a -> Ptr CInt -> IO () LapackComplex.hbev Ptr CChar jobzPtr Ptr CChar uploPtr Ptr CInt nPtr Ptr CInt kdPtr Ptr (Complex a) aPtr Ptr CInt ldaPtr Ptr a wPtr Ptr (Complex a) zPtr Ptr CInt ldzPtr Ptr (Complex a) workPtr Ptr a rworkPtr Ptr CInt infoPtr