{-| module : Data.Number.Flint.Support.D.Mat.FFI copyright : (c) 2022 Hartmut Monien license : GNU GPL, version 2 or above (see LICENSE) maintainer : hmonien@uni-bonn.de -} module Data.Number.Flint.Support.D.Mat.FFI ( -- * Double precision matrices DMat (..) , CDMat (..) -- * Smart constructors , newDMat , withDMat , withNewDMat -- * Memory management , d_mat_init , d_mat_clear -- * Basic assignment and manipulation , d_mat_set , d_mat_swap , d_mat_swap_entrywise , d_mat_entry , d_mat_get_entry , d_mat_entry_ptr , d_mat_zero , d_mat_one -- * Random matrix generation , d_mat_randtest -- * Input and output , d_mat_get_str , d_mat_fprint , d_mat_print -- * Comparison , d_mat_equal , d_mat_approx_equal , d_mat_is_zero , d_mat_is_approx_zero , d_mat_is_empty , d_mat_is_square -- * Transpose , d_mat_transpose -- * Matrix multiplication , d_mat_mul_classical -- * Gram-Schmidt Orthogonalisation and QR Decomposition , d_mat_gso , d_mat_qr ) where -- double precision matrices --------------------------------------------------- import Foreign.C.Types import Foreign.C.String import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Storable import Foreign.Marshal.Array import Data.Number.Flint.Flint #include -- d_mat_t --------------------------------------------------------------------- data DMat = DMat {-# UNPACK #-} !(ForeignPtr CDMat) data CDMat = CDMat (Ptr CDouble) CLong CLong (Ptr (Ptr CDouble)) instance Storable CDMat where {-# INLINE sizeOf #-} sizeOf _ = #{size d_mat_t} {-# INLINE alignment #-} alignment _ = #{alignment d_mat_t} peek ptr = CDMat <$> #{peek d_mat_struct, entries} ptr <*> #{peek d_mat_struct, r } ptr <*> #{peek d_mat_struct, c } ptr <*> #{peek d_mat_struct, rows } ptr poke = error "CDMat.poke: Not defined." -- | /newDMat/ /rows/ /cols/ -- -- Construct new `DMat` with /rows/ rows and /cols/ columns. newDMat rows cols = do x <- mallocForeignPtr withForeignPtr x $ \x -> d_mat_init x rows cols addForeignPtrFinalizer p_d_mat_clear x return $ DMat x -- | /withDMat/ /mat/ /f/ -- -- Apply /f/ to a /mat/. {-# INLINE withDMat #-} withDMat (DMat x) f = do withForeignPtr x $ \px -> f px >>= return . (DMat x,) -- | /withNewDMat/ /rows/ /cols/ /f/ -- -- Apply /f/ to a new `DMat` with /rows/ rows and /cols/ columns. {-# INLINE withNewDMat #-} withNewDMat rows cols f = do x <- newDMat rows cols withDMat x f -- Memory management ----------------------------------------------------------- -- | /d_mat_init/ /mat/ /rows/ /cols/ -- -- Initialises a matrix with the given number of rows and columns for use. foreign import ccall "d_mat.h d_mat_init" d_mat_init :: Ptr CDMat -> CLong -> CLong -> IO () -- | /d_mat_clear/ /mat/ -- -- Clears the given matrix. foreign import ccall "d_mat.h d_mat_clear" d_mat_clear :: Ptr CDMat -> IO () foreign import ccall "d_mat.h &d_mat_clear" p_d_mat_clear :: FunPtr (Ptr CDMat -> IO ()) -- Basic assignment and manipulation ------------------------------------------- -- | /d_mat_set/ /mat1/ /mat2/ -- -- Sets @mat1@ to a copy of @mat2@. The dimensions of @mat1@ and @mat2@ -- must be the same. foreign import ccall "d_mat.h d_mat_set" d_mat_set :: Ptr CDMat -> Ptr CDMat -> IO () -- | /d_mat_swap/ /mat1/ /mat2/ -- -- Swaps two matrices. The dimensions of @mat1@ and @mat2@ are allowed to -- be different. foreign import ccall "d_mat.h d_mat_swap" d_mat_swap :: Ptr CDMat -> Ptr CDMat -> IO () -- | /d_mat_swap_entrywise/ /mat1/ /mat2/ -- -- Swaps two matrices by swapping the individual entries rather than -- swapping the contents of the structs. foreign import ccall "d_mat.h d_mat_swap_entrywise" d_mat_swap_entrywise :: Ptr CDMat -> Ptr CDMat -> IO () -- | /d_mat_entry/ /mat/ /i/ /j/ -- -- Returns the entry of @mat@ at row \(i\) and column \(j\). Both \(i\) and -- \(j\) must not exceed the dimensions of the matrix. This function is -- implemented as a macro. d_mat_entry :: Ptr CDMat -> CLong -> CLong -> IO CDouble d_mat_entry mat i j = do CDMat _ r c rows <- peek mat row_i <- peek (rows `advancePtr` (fromIntegral i)) result <- peek (row_i `advancePtr` (fromIntegral j)) return result -- | /d_mat_get_entry/ /mat/ /i/ /j/ -- -- Returns the entry of @mat@ at row \(i\) and column \(j\). Both \(i\) and -- \(j\) must not exceed the dimensions of the matrix. foreign import ccall "d_mat.h d_mat_get_entry" d_mat_get_entry :: Ptr CDMat -> CLong -> CLong -> IO CDouble -- | /d_mat_entry_ptr/ /mat/ /i/ /j/ -- -- Returns a pointer to the entry of @mat@ at row \(i\) and column \(j\). -- Both \(i\) and \(j\) must not exceed the dimensions of the matrix. foreign import ccall "d_mat.h d_mat_entry_ptr" d_mat_entry_ptr :: Ptr CDMat -> CLong -> CLong -> IO (Ptr CDouble) -- | /d_mat_zero/ /mat/ -- -- Sets all entries of @mat@ to 0. foreign import ccall "d_mat.h d_mat_zero" d_mat_zero :: Ptr CDMat -> IO () -- | /d_mat_one/ /mat/ -- -- Sets @mat@ to the unit matrix, having ones on the main diagonal and -- zeroes elsewhere. If @mat@ is nonsquare, it is set to the truncation of -- a unit matrix. foreign import ccall "d_mat.h d_mat_one" d_mat_one :: Ptr CDMat -> IO () -- Random matrix generation ---------------------------------------------------- -- | /d_mat_randtest/ /mat/ /state/ /minexp/ /maxexp/ -- -- Sets the entries of @mat@ to random signed numbers with exponents -- between @minexp@ and @maxexp@ or zero. foreign import ccall "d_mat.h d_mat_randtest" d_mat_randtest :: Ptr CDMat -> Ptr CFRandState -> CLong -> CLong -> IO () -- Input and output ------------------------------------------------------------ -- | /d_mat_get_str/ /mat/ -- -- Returns a string representation of the given matrix. foreign import ccall "d_mat.h d_mat_get_str" d_mat_get_str :: Ptr CDMat -> IO CString -- | /d_mat_fprint/ /file/ /mat/ -- -- Prints the given matrix to the stream @stdout@. foreign import ccall "d_mat.h d_mat_fprint" d_mat_fprint :: Ptr CFile -> Ptr CDMat -> IO () -- | /d_mat_print/ /mat/ -- -- Prints the given matrix to the stream @stdout@. d_mat_print :: Ptr CDMat -> IO () d_mat_print mat = do printCStr d_mat_get_str mat return () -- Comparison ------------------------------------------------------------------ -- | /d_mat_equal/ /mat1/ /mat2/ -- -- Returns a non-zero value if @mat1@ and @mat2@ have the same dimensions -- and entries, and zero otherwise. foreign import ccall "d_mat.h d_mat_equal" d_mat_equal :: Ptr CDMat -> Ptr CDMat -> IO CInt -- | /d_mat_approx_equal/ /mat1/ /mat2/ /eps/ -- -- Returns a non-zero value if @mat1@ and @mat2@ have the same dimensions -- and entries within @eps@ of each other, and zero otherwise. foreign import ccall "d_mat.h d_mat_approx_equal" d_mat_approx_equal :: Ptr CDMat -> Ptr CDMat -> CDouble -> IO CInt -- | /d_mat_is_zero/ /mat/ -- -- Returns a non-zero value if all entries @mat@ are zero, and otherwise -- returns zero. foreign import ccall "d_mat.h d_mat_is_zero" d_mat_is_zero :: Ptr CDMat -> IO CInt -- | /d_mat_is_approx_zero/ /mat/ /eps/ -- -- Returns a non-zero value if all entries @mat@ are zero to within @eps@ -- and otherwise returns zero. foreign import ccall "d_mat.h d_mat_is_approx_zero" d_mat_is_approx_zero :: Ptr CDMat -> CDouble -> IO CInt -- | /d_mat_is_empty/ /mat/ -- -- Returns a non-zero value if the number of rows or the number of columns -- in @mat@ is zero, and otherwise returns zero. foreign import ccall "d_mat.h d_mat_is_empty" d_mat_is_empty :: Ptr CDMat -> IO CInt -- | /d_mat_is_square/ /mat/ -- -- Returns a non-zero value if the number of rows is equal to the number of -- columns in @mat@, and otherwise returns zero. foreign import ccall "d_mat.h d_mat_is_square" d_mat_is_square :: Ptr CDMat -> IO CInt -- Transpose ------------------------------------------------------------------- -- | /d_mat_transpose/ /B/ /A/ -- -- Sets \(B\) to \(A^T\), the transpose of \(A\). Dimensions must be -- compatible. \(A\) and \(B\) are allowed to be the same object if \(A\) -- is a square matrix. foreign import ccall "d_mat.h d_mat_transpose" d_mat_transpose :: Ptr CDMat -> Ptr CDMat -> IO () -- Matrix multiplication ------------------------------------------------------- -- | /d_mat_mul_classical/ /C/ /A/ /B/ -- -- Sets @C@ to the matrix product \(C = A B\). The matrices must have -- compatible dimensions for matrix multiplication (an exception is raised -- otherwise). Aliasing is allowed. foreign import ccall "d_mat.h d_mat_mul_classical" d_mat_mul_classical :: Ptr CDMat -> Ptr CDMat -> Ptr CDMat -> IO () -- Gram-Schmidt Orthogonalisation and QR Decomposition ------------------------- -- | /d_mat_gso/ /B/ /A/ -- -- Takes a subset of \(R^m\) \(S = {a_1, a_2, \ldots, a_n}\) (as the -- columns of a \(m x n\) matrix @A@) and generates an orthonormal set -- \(S' = {b_1, b_2, \ldots, b_n}\) (as the columns of the \(m x n\) matrix -- @B@) that spans the same subspace of \(R^m\) as \(S\). -- -- This uses an algorithm of Schwarz-Rutishauser. See pp. 9 of -- foreign import ccall "d_mat.h d_mat_gso" d_mat_gso :: Ptr CDMat -> Ptr CDMat -> IO () -- | /d_mat_qr/ /Q/ /R/ /A/ -- -- Computes the \(QR\) decomposition of a matrix @A@ using the Gram-Schmidt -- process. (Sets @Q@ and @R@ such that \(A = QR\) where @R@ is an upper -- triangular matrix and @Q@ is an orthogonal matrix.) -- -- This uses an algorithm of Schwarz-Rutishauser. See pp. 9 of -- foreign import ccall "d_mat.h d_mat_qr" d_mat_qr :: Ptr CDMat -> Ptr CDMat -> Ptr CDMat -> IO ()