{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE TypeFamilies             #-}
{-# LANGUAGE ViewPatterns             #-}
{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE ConstrainedClassMethods  #-}

-- |
-- Module      :  Internal.Matrix
-- Copyright   :  (c) Alberto Ruiz 2007-15
-- License     :  BSD3
-- Maintainer  :  Alberto Ruiz
-- Stability   :  provisional
--
-- Internal matrix representation
--

module Internal.Matrix where

import Internal.Vector
import Internal.Devel
import Internal.Vectorized hiding ((#), (#!))
import Foreign.Marshal.Alloc ( free )
import Foreign.Marshal.Array(newArray)
import Foreign.Ptr ( Ptr )
import Foreign.Storable ( Storable )
import Data.Complex ( Complex )
import Foreign.C.Types ( CInt(..) )
import Foreign.C.String ( CString, newCString )
import System.IO.Unsafe ( unsafePerformIO )
import Control.DeepSeq ( NFData(..) )
import Text.Printf

-----------------------------------------------------------------

data MatrixOrder = RowMajor | ColumnMajor deriving (Int -> MatrixOrder -> ShowS
[MatrixOrder] -> ShowS
MatrixOrder -> String
(Int -> MatrixOrder -> ShowS)
-> (MatrixOrder -> String)
-> ([MatrixOrder] -> ShowS)
-> Show MatrixOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatrixOrder] -> ShowS
$cshowList :: [MatrixOrder] -> ShowS
show :: MatrixOrder -> String
$cshow :: MatrixOrder -> String
showsPrec :: Int -> MatrixOrder -> ShowS
$cshowsPrec :: Int -> MatrixOrder -> ShowS
Show,MatrixOrder -> MatrixOrder -> Bool
(MatrixOrder -> MatrixOrder -> Bool)
-> (MatrixOrder -> MatrixOrder -> Bool) -> Eq MatrixOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatrixOrder -> MatrixOrder -> Bool
$c/= :: MatrixOrder -> MatrixOrder -> Bool
== :: MatrixOrder -> MatrixOrder -> Bool
$c== :: MatrixOrder -> MatrixOrder -> Bool
Eq)

-- | Matrix representation suitable for BLAS\/LAPACK computations.

data Matrix t = Matrix
    { Matrix t -> Int
irows :: {-# UNPACK #-} !Int
    , Matrix t -> Int
icols :: {-# UNPACK #-} !Int
    , Matrix t -> Int
xRow  :: {-# UNPACK #-} !Int
    , Matrix t -> Int
xCol  :: {-# UNPACK #-} !Int
    , Matrix t -> Vector t
xdat  :: {-# UNPACK #-} !(Vector t)
    }


rows :: Matrix t -> Int
rows :: Matrix t -> Int
rows = Matrix t -> Int
forall t. Matrix t -> Int
irows
{-# INLINE rows #-}

cols :: Matrix t -> Int
cols :: Matrix t -> Int
cols = Matrix t -> Int
forall t. Matrix t -> Int
icols
{-# INLINE cols #-}

size :: Matrix t -> (Int, Int)
size :: Matrix t -> (Int, Int)
size Matrix t
m = (Matrix t -> Int
forall t. Matrix t -> Int
irows Matrix t
m, Matrix t -> Int
forall t. Matrix t -> Int
icols Matrix t
m)
{-# INLINE size #-}

rowOrder :: Matrix t -> Bool
rowOrder :: Matrix t -> Bool
rowOrder Matrix t
m = Matrix t -> Int
forall t. Matrix t -> Int
xCol Matrix t
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
{-# INLINE rowOrder #-}

colOrder :: Matrix t -> Bool
colOrder :: Matrix t -> Bool
colOrder Matrix t
m = Matrix t -> Int
forall t. Matrix t -> Int
xRow Matrix t
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
{-# INLINE colOrder #-}

is1d :: Matrix t -> Bool
is1d :: Matrix t -> Bool
is1d (Matrix t -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size->(Int
r,Int
c)) = Int
rInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
|| Int
cInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1
{-# INLINE is1d #-}

-- data is not contiguous
isSlice :: Storable t => Matrix t -> Bool
isSlice :: Matrix t -> Bool
isSlice m :: Matrix t
m@(Matrix t -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size->(Int
r,Int
c)) = Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector t -> Int
forall t. Storable t => Vector t -> Int
dim (Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat Matrix t
m)
{-# INLINE isSlice #-}

orderOf :: Matrix t -> MatrixOrder
orderOf :: Matrix t -> MatrixOrder
orderOf Matrix t
m = if Matrix t -> Bool
forall t. Matrix t -> Bool
rowOrder Matrix t
m then MatrixOrder
RowMajor else MatrixOrder
ColumnMajor


showInternal :: Storable t => Matrix t -> IO ()
showInternal :: Matrix t -> IO ()
showInternal Matrix t
m = String
-> Int -> Int -> String -> String -> Int -> Int -> Int -> IO ()
forall r. PrintfType r => String -> r
printf String
"%dx%d %s %s %d:%d (%d)\n" Int
r Int
c String
slc String
ord Int
xr Int
xc Int
dv
  where
    r :: Int
r  = Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m
    c :: Int
c  = Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m
    xr :: Int
xr = Matrix t -> Int
forall t. Matrix t -> Int
xRow Matrix t
m
    xc :: Int
xc = Matrix t -> Int
forall t. Matrix t -> Int
xCol Matrix t
m
    slc :: String
slc = if Matrix t -> Bool
forall t. Storable t => Matrix t -> Bool
isSlice Matrix t
m then String
"slice" else String
"full"
    ord :: String
ord = if Matrix t -> Bool
forall t. Matrix t -> Bool
is1d Matrix t
m then String
"1d" else if Matrix t -> Bool
forall t. Matrix t -> Bool
rowOrder Matrix t
m then String
"rows" else String
"cols"
    dv :: Int
dv = Vector t -> Int
forall t. Storable t => Vector t -> Int
dim (Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat Matrix t
m)

--------------------------------------------------------------------------------

-- | Matrix transpose.
trans :: Matrix t -> Matrix t
trans :: Matrix t -> Matrix t
trans m :: Matrix t
m@Matrix { irows :: forall t. Matrix t -> Int
irows = Int
r, icols :: forall t. Matrix t -> Int
icols = Int
c, xRow :: forall t. Matrix t -> Int
xRow = Int
xr, xCol :: forall t. Matrix t -> Int
xCol = Int
xc } =
             Matrix t
m { irows :: Int
irows = Int
c, icols :: Int
icols = Int
r, xRow :: Int
xRow = Int
xc, xCol :: Int
xCol = Int
xr }


cmat :: (Element t) => Matrix t -> Matrix t
cmat :: Matrix t -> Matrix t
cmat Matrix t
m
    | Matrix t -> Bool
forall t. Matrix t -> Bool
rowOrder Matrix t
m = Matrix t
m
    | Bool
otherwise  = MatrixOrder -> Matrix t -> Matrix t
forall t. Element t => MatrixOrder -> Matrix t -> Matrix t
extractAll MatrixOrder
RowMajor Matrix t
m


fmat :: (Element t) => Matrix t -> Matrix t
fmat :: Matrix t -> Matrix t
fmat Matrix t
m
    | Matrix t -> Bool
forall t. Matrix t -> Bool
colOrder Matrix t
m = Matrix t
m
    | Bool
otherwise  = MatrixOrder -> Matrix t -> Matrix t
forall t. Element t => MatrixOrder -> Matrix t -> Matrix t
extractAll MatrixOrder
ColumnMajor Matrix t
m


-- C-Haskell matrix adapters
{-# INLINE amatr #-}
amatr :: Storable a => Matrix a -> (f -> IO r) -> (CInt -> CInt -> Ptr a -> f) -> IO r
amatr :: Matrix a -> (f -> IO r) -> (CInt -> CInt -> Ptr a -> f) -> IO r
amatr Matrix a
x f -> IO r
f CInt -> CInt -> Ptr a -> f
g = Vector a -> (Ptr a -> IO r) -> IO r
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith (Matrix a -> Vector a
forall t. Matrix t -> Vector t
xdat Matrix a
x) (f -> IO r
f (f -> IO r) -> (Ptr a -> f) -> Ptr a -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> Ptr a -> f
g CInt
r CInt
c)
  where
    r :: CInt
r  = Int -> CInt
fi (Matrix a -> Int
forall t. Matrix t -> Int
rows Matrix a
x)
    c :: CInt
c  = Int -> CInt
fi (Matrix a -> Int
forall t. Matrix t -> Int
cols Matrix a
x)

{-# INLINE amat #-}
amat :: Storable a => Matrix a -> (f -> IO r) -> (CInt -> CInt -> CInt -> CInt -> Ptr a -> f) -> IO r
amat :: Matrix a
-> (f -> IO r)
-> (CInt -> CInt -> CInt -> CInt -> Ptr a -> f)
-> IO r
amat Matrix a
x f -> IO r
f CInt -> CInt -> CInt -> CInt -> Ptr a -> f
g = Vector a -> (Ptr a -> IO r) -> IO r
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
unsafeWith (Matrix a -> Vector a
forall t. Matrix t -> Vector t
xdat Matrix a
x) (f -> IO r
f (f -> IO r) -> (Ptr a -> f) -> Ptr a -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt -> CInt -> Ptr a -> f
g CInt
r CInt
c CInt
sr CInt
sc)
  where
    r :: CInt
r  = Int -> CInt
fi (Matrix a -> Int
forall t. Matrix t -> Int
rows Matrix a
x)
    c :: CInt
c  = Int -> CInt
fi (Matrix a -> Int
forall t. Matrix t -> Int
cols Matrix a
x)
    sr :: CInt
sr = Int -> CInt
fi (Matrix a -> Int
forall t. Matrix t -> Int
xRow Matrix a
x)
    sc :: CInt
sc = Int -> CInt
fi (Matrix a -> Int
forall t. Matrix t -> Int
xCol Matrix a
x)


instance Storable t => TransArray (Matrix t)
  where
    type TransRaw (Matrix t) b = CInt -> CInt -> Ptr t -> b
    type Trans (Matrix t) b    = CInt -> CInt -> CInt -> CInt -> Ptr t -> b
    apply :: Matrix t -> (b -> IO r) -> Trans (Matrix t) b -> IO r
apply = Matrix t -> (b -> IO r) -> Trans (Matrix t) b -> IO r
forall a f r.
Storable a =>
Matrix a
-> (f -> IO r)
-> (CInt -> CInt -> CInt -> CInt -> Ptr a -> f)
-> IO r
amat
    {-# INLINE apply #-}
    applyRaw :: Matrix t -> (b -> IO r) -> TransRaw (Matrix t) b -> IO r
applyRaw = Matrix t -> (b -> IO r) -> TransRaw (Matrix t) b -> IO r
forall a f r.
Storable a =>
Matrix a -> (f -> IO r) -> (CInt -> CInt -> Ptr a -> f) -> IO r
amatr
    {-# INLINE applyRaw #-}

infixr 1 #
(#) :: TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
c
a # :: c -> (b -> IO r) -> Trans c b -> IO r
# b -> IO r
b = c -> (b -> IO r) -> Trans c b -> IO r
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
apply c
a b -> IO r
b
{-# INLINE (#) #-}

(#!) :: (TransArray c, TransArray c1) => c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
c1
a #! :: c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! c
b = c1
a c1 -> (Trans c (IO r) -> IO r) -> Trans c1 (Trans c (IO r)) -> IO r
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c
b c -> (IO r -> IO r) -> Trans c (IO r) -> IO r
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# IO r -> IO r
forall a. a -> a
id
{-# INLINE (#!) #-}

--------------------------------------------------------------------------------

copy :: Element t => MatrixOrder -> Matrix t -> IO (Matrix t)
copy :: MatrixOrder -> Matrix t -> IO (Matrix t)
copy MatrixOrder
ord Matrix t
m = MatrixOrder
-> Matrix t
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix t)
forall a.
Element a =>
MatrixOrder
-> Matrix a
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix a)
extractR MatrixOrder
ord Matrix t
m CInt
0 ([Int] -> Vector CInt
idxs[Int
0,Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) CInt
0 ([Int] -> Vector CInt
idxs[Int
0,Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])

extractAll :: Element t => MatrixOrder -> Matrix t -> Matrix t
extractAll :: MatrixOrder -> Matrix t -> Matrix t
extractAll MatrixOrder
ord Matrix t
m = IO (Matrix t) -> Matrix t
forall a. IO a -> a
unsafePerformIO (MatrixOrder -> Matrix t -> IO (Matrix t)
forall t. Element t => MatrixOrder -> Matrix t -> IO (Matrix t)
copy MatrixOrder
ord Matrix t
m)

{- | Creates a vector by concatenation of rows. If the matrix is ColumnMajor, this operation requires a transpose.

>>> flatten (ident 3)
[1.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,1.0]
it :: (Num t, Element t) => Vector t

-}
flatten :: Element t => Matrix t -> Vector t
flatten :: Matrix t -> Vector t
flatten Matrix t
m
    | Matrix t -> Bool
forall t. Storable t => Matrix t -> Bool
isSlice Matrix t
m Bool -> Bool -> Bool
|| Bool -> Bool
not (Matrix t -> Bool
forall t. Matrix t -> Bool
rowOrder Matrix t
m) = Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat (MatrixOrder -> Matrix t -> Matrix t
forall t. Element t => MatrixOrder -> Matrix t -> Matrix t
extractAll MatrixOrder
RowMajor Matrix t
m)
    | Bool
otherwise                     = Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat Matrix t
m


-- | the inverse of 'Data.Packed.Matrix.fromLists'
toLists :: (Element t) => Matrix t -> [[t]]
toLists :: Matrix t -> [[t]]
toLists = (Vector t -> [t]) -> [Vector t] -> [[t]]
forall a b. (a -> b) -> [a] -> [b]
map Vector t -> [t]
forall a. Storable a => Vector a -> [a]
toList ([Vector t] -> [[t]])
-> (Matrix t -> [Vector t]) -> Matrix t -> [[t]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix t -> [Vector t]
forall t. Element t => Matrix t -> [Vector t]
toRows



-- | common value with \"adaptable\" 1
compatdim :: [Int] -> Maybe Int
compatdim :: [Int] -> Maybe Int
compatdim [] = Maybe Int
forall a. Maybe a
Nothing
compatdim [Int
a] = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
a
compatdim (Int
a:Int
b:[Int]
xs)
    | Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b = [Int] -> Maybe Int
compatdim (Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
    | Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 = [Int] -> Maybe Int
compatdim (Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
    | Int
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 = [Int] -> Maybe Int
compatdim (Int
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)
    | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing




-- | Create a matrix from a list of vectors.
-- All vectors must have the same dimension,
-- or dimension 1, which is are automatically expanded.
fromRows :: Element t => [Vector t] -> Matrix t
fromRows :: [Vector t] -> Matrix t
fromRows [] = Int -> Int -> Matrix t
forall t. Storable t => Int -> Int -> Matrix t
emptyM Int
0 Int
0
fromRows [Vector t]
vs = case [Int] -> Maybe Int
compatdim ((Vector t -> Int) -> [Vector t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Vector t -> Int
forall t. Storable t => Vector t -> Int
dim [Vector t]
vs) of
    Maybe Int
Nothing -> String -> Matrix t
forall a. HasCallStack => String -> a
error (String -> Matrix t) -> String -> Matrix t
forall a b. (a -> b) -> a -> b
$ String
"fromRows expects vectors with equal sizes (or singletons), given: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show ((Vector t -> Int) -> [Vector t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Vector t -> Int
forall t. Storable t => Vector t -> Int
dim [Vector t]
vs)
    Just Int
0  -> Int -> Int -> Matrix t
forall t. Storable t => Int -> Int -> Matrix t
emptyM Int
r Int
0
    Just Int
c  -> MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
r Int
c (Vector t -> Matrix t)
-> ([Vector t] -> Vector t) -> [Vector t] -> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector t] -> Vector t
forall t. Storable t => [Vector t] -> Vector t
vjoin ([Vector t] -> Vector t)
-> ([Vector t] -> [Vector t]) -> [Vector t] -> Vector t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector t -> Vector t) -> [Vector t] -> [Vector t]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Vector t -> Vector t
forall a. Element a => Int -> Vector a -> Vector a
adapt Int
c) ([Vector t] -> Matrix t) -> [Vector t] -> Matrix t
forall a b. (a -> b) -> a -> b
$ [Vector t]
vs
  where
    r :: Int
r = [Vector t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vector t]
vs
    adapt :: Int -> Vector a -> Vector a
adapt Int
c Vector a
v
        | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [a] -> Vector a
forall a. Storable a => [a] -> Vector a
fromList[]
        | Vector a -> Int
forall t. Storable t => Vector t -> Int
dim Vector a
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c = Vector a
v
        | Bool
otherwise = a -> Int -> Vector a
forall a. Element a => a -> Int -> Vector a
constantD (Vector a
vVector a -> Int -> a
forall t. Storable t => Vector t -> Int -> t
@>Int
0) Int
c

-- | extracts the rows of a matrix as a list of vectors
toRows :: Element t => Matrix t -> [Vector t]
toRows :: Matrix t -> [Vector t]
toRows Matrix t
m
    | Matrix t -> Bool
forall t. Matrix t -> Bool
rowOrder Matrix t
m = (Int -> Vector t) -> [Int] -> [Vector t]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vector t
sub [Int]
rowRange
    | Bool
otherwise  = (Int -> Vector t) -> [Int] -> [Vector t]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Vector t
ext [Int]
rowRange
  where
    rowRange :: [Int]
rowRange = [Int
0..Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    sub :: Int -> Vector t
sub Int
k = Int -> Int -> Vector t -> Vector t
forall t. Storable t => Int -> Int -> Vector t -> Vector t
subVector (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
*Matrix t -> Int
forall t. Matrix t -> Int
xRow Matrix t
m) (Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m) (Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat Matrix t
m)
    ext :: Int -> Vector t
ext Int
k = Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat (Matrix t -> Vector t) -> Matrix t -> Vector t
forall a b. (a -> b) -> a -> b
$ IO (Matrix t) -> Matrix t
forall a. IO a -> a
unsafePerformIO (IO (Matrix t) -> Matrix t) -> IO (Matrix t) -> Matrix t
forall a b. (a -> b) -> a -> b
$ MatrixOrder
-> Matrix t
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix t)
forall a.
Element a =>
MatrixOrder
-> Matrix a
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix a)
extractR MatrixOrder
RowMajor Matrix t
m CInt
1 ([Int] -> Vector CInt
idxs[Int
k]) CInt
0 ([Int] -> Vector CInt
idxs[Int
0,Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])


-- | Creates a matrix from a list of vectors, as columns
fromColumns :: Element t => [Vector t] -> Matrix t
fromColumns :: [Vector t] -> Matrix t
fromColumns [Vector t]
m = Matrix t -> Matrix t
forall t. Matrix t -> Matrix t
trans (Matrix t -> Matrix t)
-> ([Vector t] -> Matrix t) -> [Vector t] -> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector t] -> Matrix t
forall t. Element t => [Vector t] -> Matrix t
fromRows ([Vector t] -> Matrix t) -> [Vector t] -> Matrix t
forall a b. (a -> b) -> a -> b
$ [Vector t]
m

-- | Creates a list of vectors from the columns of a matrix
toColumns :: Element t => Matrix t -> [Vector t]
toColumns :: Matrix t -> [Vector t]
toColumns Matrix t
m = Matrix t -> [Vector t]
forall t. Element t => Matrix t -> [Vector t]
toRows (Matrix t -> [Vector t])
-> (Matrix t -> Matrix t) -> Matrix t -> [Vector t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix t -> Matrix t
forall t. Matrix t -> Matrix t
trans (Matrix t -> [Vector t]) -> Matrix t -> [Vector t]
forall a b. (a -> b) -> a -> b
$ Matrix t
m

-- | Reads a matrix position.
(@@>) :: Storable t => Matrix t -> (Int,Int) -> t
infixl 9 @@>
m :: Matrix t
m@Matrix {irows :: forall t. Matrix t -> Int
irows = Int
r, icols :: forall t. Matrix t -> Int
icols = Int
c} @@> :: Matrix t -> (Int, Int) -> t
@@> (Int
i,Int
j)
    | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
r Bool -> Bool -> Bool
|| Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
c = String -> t
forall a. HasCallStack => String -> a
error String
"matrix indexing out of range"
    | Bool
otherwise = Matrix t -> Int -> Int -> t
forall t. Storable t => Matrix t -> Int -> Int -> t
atM' Matrix t
m Int
i Int
j
{-# INLINE (@@>) #-}

--  Unsafe matrix access without range checking
atM' :: Storable t => Matrix t -> Int -> Int -> t
atM' :: Matrix t -> Int -> Int -> t
atM' Matrix t
m Int
i Int
j = Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat Matrix t
m Vector t -> Int -> t
forall t. Storable t => Vector t -> Int -> t
`at'` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Matrix t -> Int
forall t. Matrix t -> Int
xRow Matrix t
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Matrix t -> Int
forall t. Matrix t -> Int
xCol Matrix t
m))
{-# INLINE atM' #-}

------------------------------------------------------------------

matrixFromVector :: Storable t => MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector :: MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
_ Int
1 Int
_ v :: Vector t
v@(Vector t -> Int
forall t. Storable t => Vector t -> Int
dim->Int
d) = Matrix :: forall t. Int -> Int -> Int -> Int -> Vector t -> Matrix t
Matrix { irows :: Int
irows = Int
1, icols :: Int
icols = Int
d, xdat :: Vector t
xdat = Vector t
v, xRow :: Int
xRow = Int
d, xCol :: Int
xCol = Int
1 }
matrixFromVector MatrixOrder
_ Int
_ Int
1 v :: Vector t
v@(Vector t -> Int
forall t. Storable t => Vector t -> Int
dim->Int
d) = Matrix :: forall t. Int -> Int -> Int -> Int -> Vector t -> Matrix t
Matrix { irows :: Int
irows = Int
d, icols :: Int
icols = Int
1, xdat :: Vector t
xdat = Vector t
v, xRow :: Int
xRow = Int
1, xCol :: Int
xCol = Int
d }
matrixFromVector MatrixOrder
o Int
r Int
c Vector t
v
    | Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v = Matrix t
m
    | Bool
otherwise = String -> Matrix t
forall a. HasCallStack => String -> a
error (String -> Matrix t) -> String -> Matrix t
forall a b. (a -> b) -> a -> b
$ String
"can't reshape vector dim = "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" to matrix " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matrix t -> String
forall t. Matrix t -> String
shSize Matrix t
m
  where
    m :: Matrix t
m | MatrixOrder
o MatrixOrder -> MatrixOrder -> Bool
forall a. Eq a => a -> a -> Bool
== MatrixOrder
RowMajor = Matrix :: forall t. Int -> Int -> Int -> Int -> Vector t -> Matrix t
Matrix { irows :: Int
irows = Int
r, icols :: Int
icols = Int
c, xdat :: Vector t
xdat = Vector t
v, xRow :: Int
xRow = Int
c, xCol :: Int
xCol = Int
1 }
      | Bool
otherwise     = Matrix :: forall t. Int -> Int -> Int -> Int -> Vector t -> Matrix t
Matrix { irows :: Int
irows = Int
r, icols :: Int
icols = Int
c, xdat :: Vector t
xdat = Vector t
v, xRow :: Int
xRow = Int
1, xCol :: Int
xCol = Int
r }

-- allocates memory for a new matrix
createMatrix :: (Storable a) => MatrixOrder -> Int -> Int -> IO (Matrix a)
createMatrix :: MatrixOrder -> Int -> Int -> IO (Matrix a)
createMatrix MatrixOrder
ord Int
r Int
c = do
    Vector a
p <- Int -> IO (Vector a)
forall a. Storable a => Int -> IO (Vector a)
createVector (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c)
    Matrix a -> IO (Matrix a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MatrixOrder -> Int -> Int -> Vector a -> Matrix a
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
ord Int
r Int
c Vector a
p)

{- | Creates a matrix from a vector by grouping the elements in rows with the desired number of columns. (GNU-Octave groups by columns. To do it you can define @reshapeF r = tr' . reshape r@
where r is the desired number of rows.)

>>> reshape 4 (fromList [1..12])
(3><4)
 [ 1.0,  2.0,  3.0,  4.0
 , 5.0,  6.0,  7.0,  8.0
 , 9.0, 10.0, 11.0, 12.0 ]

-}
reshape :: Storable t => Int -> Vector t -> Matrix t
reshape :: Int -> Vector t -> Matrix t
reshape Int
0 Vector t
v = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
0 Int
0 Vector t
v
reshape Int
c Vector t
v = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
c) Int
c Vector t
v


-- | application of a vector function on the flattened matrix elements
liftMatrix :: (Element a, Element b) => (Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix :: (Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector b
f m :: Matrix a
m@Matrix { irows :: forall t. Matrix t -> Int
irows = Int
r, icols :: forall t. Matrix t -> Int
icols = Int
c, xdat :: forall t. Matrix t -> Vector t
xdat = Vector a
d}
    | Matrix a -> Bool
forall t. Storable t => Matrix t -> Bool
isSlice Matrix a
m = MatrixOrder -> Int -> Int -> Vector b -> Matrix b
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
r Int
c (Vector a -> Vector b
f (Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
flatten Matrix a
m))
    | Bool
otherwise = MatrixOrder -> Int -> Int -> Vector b -> Matrix b
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector (Matrix a -> MatrixOrder
forall t. Matrix t -> MatrixOrder
orderOf Matrix a
m) Int
r Int
c (Vector a -> Vector b
f Vector a
d)

-- | application of a vector function on the flattened matrices elements
liftMatrix2 :: (Element t, Element a, Element b) => (Vector a -> Vector b -> Vector t) -> Matrix a -> Matrix b -> Matrix t
liftMatrix2 :: (Vector a -> Vector b -> Vector t)
-> Matrix a -> Matrix b -> Matrix t
liftMatrix2 Vector a -> Vector b -> Vector t
f m1 :: Matrix a
m1@(Matrix a -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size->(Int
r,Int
c)) Matrix b
m2
    | (Int
r,Int
c)(Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/=Matrix b -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size Matrix b
m2 = String -> Matrix t
forall a. HasCallStack => String -> a
error String
"nonconformant matrices in liftMatrix2"
    | Matrix a -> Bool
forall t. Matrix t -> Bool
rowOrder Matrix a
m1 = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor    Int
r Int
c (Vector a -> Vector b -> Vector t
f (Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
flatten Matrix a
m1) (Matrix b -> Vector b
forall t. Element t => Matrix t -> Vector t
flatten Matrix b
m2))
    | Bool
otherwise   = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
ColumnMajor Int
r Int
c (Vector a -> Vector b -> Vector t
f (Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
flatten (Matrix a -> Matrix a
forall t. Matrix t -> Matrix t
trans Matrix a
m1)) (Matrix b -> Vector b
forall t. Element t => Matrix t -> Vector t
flatten (Matrix b -> Matrix b
forall t. Matrix t -> Matrix t
trans Matrix b
m2)))

------------------------------------------------------------------

-- | Supported matrix elements.
class (Storable a) => Element a where
    constantD  :: a -> Int -> Vector a
    extractR :: MatrixOrder -> Matrix a -> CInt -> Vector CInt -> CInt -> Vector CInt -> IO (Matrix a)
    setRect  :: Int -> Int -> Matrix a -> Matrix a -> IO ()
    sortI    :: Ord a => Vector a -> Vector CInt
    sortV    :: Ord a => Vector a -> Vector a
    compareV :: Ord a => Vector a -> Vector a -> Vector CInt
    selectV  :: Vector CInt -> Vector a -> Vector a -> Vector a -> Vector a
    remapM   :: Matrix CInt -> Matrix CInt -> Matrix a -> Matrix a
    rowOp    :: Int -> a -> Int -> Int -> Int -> Int -> Matrix a -> IO ()
    gemm     :: Vector a -> Matrix a -> Matrix a -> Matrix a -> IO ()
    reorderV :: Vector CInt-> Vector CInt-> Vector a -> Vector a -- see reorderVector for documentation


instance Element Float where
    constantD :: Float -> Int -> Vector Float
constantD  = (Ptr Float -> CInt -> Ptr Float -> IO CInt)
-> Float -> Int -> Vector Float
forall a1 a.
(Storable a1, Storable a) =>
(Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a
constantAux Ptr Float -> CInt -> Ptr Float -> IO CInt
cconstantF
    extractR :: MatrixOrder
-> Matrix Float
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix Float)
extractR   = (CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix Float)
      (CInt -> CInt -> CInt -> CInt -> Ptr Float -> IO CInt))
-> MatrixOrder
-> Matrix Float
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix Float)
forall t3 t2 c a t1 t.
(Eq t3, Eq t2, TransArray c, Storable a, Storable t1, Storable t,
 Num t3, Num t2, Integral t1, Integral t) =>
(t3
 -> t2
 -> CInt
 -> Ptr t1
 -> CInt
 -> Ptr t
 -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> MatrixOrder
-> c
-> t3
-> Vector t1
-> t2
-> Vector t
-> IO (Matrix a)
extractAux CInt
-> CInt
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix Float)
     (CInt -> CInt -> CInt -> CInt -> Ptr Float -> IO CInt)
Extr Float
c_extractF
    setRect :: Int -> Int -> Matrix Float -> Matrix Float -> IO ()
setRect    = (CInt
 -> CInt -> Trans (Matrix Float) (Trans (Matrix Float) (IO CInt)))
-> Int -> Int -> Matrix Float -> Matrix Float -> IO ()
forall c1 c.
(TransArray c1, TransArray c) =>
(CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
-> Int -> Int -> c1 -> c -> IO ()
setRectAux CInt
-> CInt -> Trans (Matrix Float) (Trans (Matrix Float) (IO CInt))
SetRect Float
c_setRectF
    sortI :: Vector Float -> Vector CInt
sortI      = Vector Float -> Vector CInt
sortIdxF
    sortV :: Vector Float -> Vector Float
sortV      = Vector Float -> Vector Float
sortValF
    compareV :: Vector Float -> Vector Float -> Vector CInt
compareV   = Vector Float -> Vector Float -> Vector CInt
compareF
    selectV :: Vector CInt
-> Vector Float -> Vector Float -> Vector Float -> Vector Float
selectV    = Vector CInt
-> Vector Float -> Vector Float -> Vector Float -> Vector Float
selectF
    remapM :: Matrix CInt -> Matrix CInt -> Matrix Float -> Matrix Float
remapM     = Matrix CInt -> Matrix CInt -> Matrix Float -> Matrix Float
remapF
    rowOp :: Int -> Float -> Int -> Int -> Int -> Int -> Matrix Float -> IO ()
rowOp      = (CInt
 -> Ptr Float
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> Trans (Matrix Float) (IO CInt))
-> Int
-> Float
-> Int
-> Int
-> Int
-> Int
-> Matrix Float
-> IO ()
forall c a.
(TransArray c, Storable a) =>
(CInt
 -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux CInt
-> Ptr Float
-> CInt
-> CInt
-> CInt
-> CInt
-> Trans (Matrix Float) (IO CInt)
RowOp Float
c_rowOpF
    gemm :: Vector Float
-> Matrix Float -> Matrix Float -> Matrix Float -> IO ()
gemm       = Trans
  (Vector Float)
  (Trans
     (Matrix Float)
     (Trans (Matrix Float) (Trans (Matrix Float) (IO CInt))))
-> Vector Float
-> Matrix Float
-> Matrix Float
-> Matrix Float
-> IO ()
forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg Trans
  (Vector Float)
  (Trans
     (Matrix Float)
     (Trans (Matrix Float) (Trans (Matrix Float) (IO CInt))))
Tgemm Float
c_gemmF
    reorderV :: Vector CInt -> Vector CInt -> Vector Float -> Vector Float
reorderV   = (CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Vector CInt) (CInt -> Ptr Float -> CInt -> Ptr Float -> IO CInt))
-> Vector CInt -> Vector CInt -> Vector Float -> Vector Float
forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(CInt
 -> Ptr a
 -> CInt
 -> Ptr t1
 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Vector CInt) (CInt -> Ptr Float -> CInt -> Ptr Float -> IO CInt)
Reorder Float
c_reorderF

instance Element Double where
    constantD :: Double -> Int -> Vector Double
constantD  = (Ptr Double -> CInt -> Ptr Double -> IO CInt)
-> Double -> Int -> Vector Double
forall a1 a.
(Storable a1, Storable a) =>
(Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a
constantAux Ptr Double -> CInt -> Ptr Double -> IO CInt
cconstantR
    extractR :: MatrixOrder
-> Matrix Double
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix Double)
extractR   = (CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix Double)
      (CInt -> CInt -> CInt -> CInt -> Ptr Double -> IO CInt))
-> MatrixOrder
-> Matrix Double
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix Double)
forall t3 t2 c a t1 t.
(Eq t3, Eq t2, TransArray c, Storable a, Storable t1, Storable t,
 Num t3, Num t2, Integral t1, Integral t) =>
(t3
 -> t2
 -> CInt
 -> Ptr t1
 -> CInt
 -> Ptr t
 -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> MatrixOrder
-> c
-> t3
-> Vector t1
-> t2
-> Vector t
-> IO (Matrix a)
extractAux CInt
-> CInt
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix Double)
     (CInt -> CInt -> CInt -> CInt -> Ptr Double -> IO CInt)
Extr Double
c_extractD
    setRect :: Int -> Int -> Matrix Double -> Matrix Double -> IO ()
setRect    = (CInt
 -> CInt -> Trans (Matrix Double) (Trans (Matrix Double) (IO CInt)))
-> Int -> Int -> Matrix Double -> Matrix Double -> IO ()
forall c1 c.
(TransArray c1, TransArray c) =>
(CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
-> Int -> Int -> c1 -> c -> IO ()
setRectAux CInt
-> CInt -> Trans (Matrix Double) (Trans (Matrix Double) (IO CInt))
SetRect Double
c_setRectD
    sortI :: Vector Double -> Vector CInt
sortI      = Vector Double -> Vector CInt
sortIdxD
    sortV :: Vector Double -> Vector Double
sortV      = Vector Double -> Vector Double
sortValD
    compareV :: Vector Double -> Vector Double -> Vector CInt
compareV   = Vector Double -> Vector Double -> Vector CInt
compareD
    selectV :: Vector CInt
-> Vector Double -> Vector Double -> Vector Double -> Vector Double
selectV    = Vector CInt
-> Vector Double -> Vector Double -> Vector Double -> Vector Double
selectD
    remapM :: Matrix CInt -> Matrix CInt -> Matrix Double -> Matrix Double
remapM     = Matrix CInt -> Matrix CInt -> Matrix Double -> Matrix Double
remapD
    rowOp :: Int -> Double -> Int -> Int -> Int -> Int -> Matrix Double -> IO ()
rowOp      = (CInt
 -> Ptr Double
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> Trans (Matrix Double) (IO CInt))
-> Int
-> Double
-> Int
-> Int
-> Int
-> Int
-> Matrix Double
-> IO ()
forall c a.
(TransArray c, Storable a) =>
(CInt
 -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux CInt
-> Ptr Double
-> CInt
-> CInt
-> CInt
-> CInt
-> Trans (Matrix Double) (IO CInt)
RowOp Double
c_rowOpD
    gemm :: Vector Double
-> Matrix Double -> Matrix Double -> Matrix Double -> IO ()
gemm       = Trans
  (Vector Double)
  (Trans
     (Matrix Double)
     (Trans (Matrix Double) (Trans (Matrix Double) (IO CInt))))
-> Vector Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> IO ()
forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg Trans
  (Vector Double)
  (Trans
     (Matrix Double)
     (Trans (Matrix Double) (Trans (Matrix Double) (IO CInt))))
Tgemm Double
c_gemmD
    reorderV :: Vector CInt -> Vector CInt -> Vector Double -> Vector Double
reorderV   = (CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Vector CInt)
      (CInt -> Ptr Double -> CInt -> Ptr Double -> IO CInt))
-> Vector CInt -> Vector CInt -> Vector Double -> Vector Double
forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(CInt
 -> Ptr a
 -> CInt
 -> Ptr t1
 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Vector CInt) (CInt -> Ptr Double -> CInt -> Ptr Double -> IO CInt)
Reorder Double
c_reorderD

instance Element (Complex Float) where
    constantD :: Complex Float -> Int -> Vector (Complex Float)
constantD  = (Ptr (Complex Float) -> CInt -> Ptr (Complex Float) -> IO CInt)
-> Complex Float -> Int -> Vector (Complex Float)
forall a1 a.
(Storable a1, Storable a) =>
(Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a
constantAux Ptr (Complex Float) -> CInt -> Ptr (Complex Float) -> IO CInt
cconstantQ
    extractR :: MatrixOrder
-> Matrix (Complex Float)
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix (Complex Float))
extractR   = (CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix (Complex Float))
      (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Float) -> IO CInt))
-> MatrixOrder
-> Matrix (Complex Float)
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix (Complex Float))
forall t3 t2 c a t1 t.
(Eq t3, Eq t2, TransArray c, Storable a, Storable t1, Storable t,
 Num t3, Num t2, Integral t1, Integral t) =>
(t3
 -> t2
 -> CInt
 -> Ptr t1
 -> CInt
 -> Ptr t
 -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> MatrixOrder
-> c
-> t3
-> Vector t1
-> t2
-> Vector t
-> IO (Matrix a)
extractAux CInt
-> CInt
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix (Complex Float))
     (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Float) -> IO CInt)
Extr (Complex Float)
c_extractQ
    setRect :: Int
-> Int -> Matrix (Complex Float) -> Matrix (Complex Float) -> IO ()
setRect    = (CInt
 -> CInt
 -> Trans
      (Matrix (Complex Float))
      (Trans (Matrix (Complex Float)) (IO CInt)))
-> Int
-> Int
-> Matrix (Complex Float)
-> Matrix (Complex Float)
-> IO ()
forall c1 c.
(TransArray c1, TransArray c) =>
(CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
-> Int -> Int -> c1 -> c -> IO ()
setRectAux CInt
-> CInt
-> Trans
     (Matrix (Complex Float)) (Trans (Matrix (Complex Float)) (IO CInt))
SetRect (Complex Float)
c_setRectQ
    sortI :: Vector (Complex Float) -> Vector CInt
sortI      = Vector (Complex Float) -> Vector CInt
forall a. HasCallStack => a
undefined
    sortV :: Vector (Complex Float) -> Vector (Complex Float)
sortV      = Vector (Complex Float) -> Vector (Complex Float)
forall a. HasCallStack => a
undefined
    compareV :: Vector (Complex Float) -> Vector (Complex Float) -> Vector CInt
compareV   = Vector (Complex Float) -> Vector (Complex Float) -> Vector CInt
forall a. HasCallStack => a
undefined
    selectV :: Vector CInt
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
selectV    = Vector CInt
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
selectQ
    remapM :: Matrix CInt
-> Matrix CInt -> Matrix (Complex Float) -> Matrix (Complex Float)
remapM     = Matrix CInt
-> Matrix CInt -> Matrix (Complex Float) -> Matrix (Complex Float)
remapQ
    rowOp :: Int
-> Complex Float
-> Int
-> Int
-> Int
-> Int
-> Matrix (Complex Float)
-> IO ()
rowOp      = (CInt
 -> Ptr (Complex Float)
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> Trans (Matrix (Complex Float)) (IO CInt))
-> Int
-> Complex Float
-> Int
-> Int
-> Int
-> Int
-> Matrix (Complex Float)
-> IO ()
forall c a.
(TransArray c, Storable a) =>
(CInt
 -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux CInt
-> Ptr (Complex Float)
-> CInt
-> CInt
-> CInt
-> CInt
-> Trans (Matrix (Complex Float)) (IO CInt)
RowOp (Complex Float)
c_rowOpQ
    gemm :: Vector (Complex Float)
-> Matrix (Complex Float)
-> Matrix (Complex Float)
-> Matrix (Complex Float)
-> IO ()
gemm       = Trans
  (Vector (Complex Float))
  (Trans
     (Matrix (Complex Float))
     (Trans
        (Matrix (Complex Float))
        (Trans (Matrix (Complex Float)) (IO CInt))))
-> Vector (Complex Float)
-> Matrix (Complex Float)
-> Matrix (Complex Float)
-> Matrix (Complex Float)
-> IO ()
forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg Trans
  (Vector (Complex Float))
  (Trans
     (Matrix (Complex Float))
     (Trans
        (Matrix (Complex Float))
        (Trans (Matrix (Complex Float)) (IO CInt))))
Tgemm (Complex Float)
c_gemmQ
    reorderV :: Vector CInt
-> Vector CInt -> Vector (Complex Float) -> Vector (Complex Float)
reorderV   = (CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Vector CInt)
      (CInt
       -> Ptr (Complex Float) -> CInt -> Ptr (Complex Float) -> IO CInt))
-> Vector CInt
-> Vector CInt
-> Vector (Complex Float)
-> Vector (Complex Float)
forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(CInt
 -> Ptr a
 -> CInt
 -> Ptr t1
 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Vector CInt)
     (CInt
      -> Ptr (Complex Float) -> CInt -> Ptr (Complex Float) -> IO CInt)
Reorder (Complex Float)
c_reorderQ

instance Element (Complex Double) where
    constantD :: Complex Double -> Int -> Vector (Complex Double)
constantD  = (Ptr (Complex Double) -> CInt -> Ptr (Complex Double) -> IO CInt)
-> Complex Double -> Int -> Vector (Complex Double)
forall a1 a.
(Storable a1, Storable a) =>
(Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a
constantAux Ptr (Complex Double) -> CInt -> Ptr (Complex Double) -> IO CInt
cconstantC
    extractR :: MatrixOrder
-> Matrix (Complex Double)
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix (Complex Double))
extractR   = (CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix (Complex Double))
      (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Double) -> IO CInt))
-> MatrixOrder
-> Matrix (Complex Double)
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix (Complex Double))
forall t3 t2 c a t1 t.
(Eq t3, Eq t2, TransArray c, Storable a, Storable t1, Storable t,
 Num t3, Num t2, Integral t1, Integral t) =>
(t3
 -> t2
 -> CInt
 -> Ptr t1
 -> CInt
 -> Ptr t
 -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> MatrixOrder
-> c
-> t3
-> Vector t1
-> t2
-> Vector t
-> IO (Matrix a)
extractAux CInt
-> CInt
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix (Complex Double))
     (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Double) -> IO CInt)
Extr (Complex Double)
c_extractC
    setRect :: Int
-> Int
-> Matrix (Complex Double)
-> Matrix (Complex Double)
-> IO ()
setRect    = (CInt
 -> CInt
 -> Trans
      (Matrix (Complex Double))
      (Trans (Matrix (Complex Double)) (IO CInt)))
-> Int
-> Int
-> Matrix (Complex Double)
-> Matrix (Complex Double)
-> IO ()
forall c1 c.
(TransArray c1, TransArray c) =>
(CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
-> Int -> Int -> c1 -> c -> IO ()
setRectAux CInt
-> CInt
-> Trans
     (Matrix (Complex Double))
     (Trans (Matrix (Complex Double)) (IO CInt))
SetRect (Complex Double)
c_setRectC
    sortI :: Vector (Complex Double) -> Vector CInt
sortI      = Vector (Complex Double) -> Vector CInt
forall a. HasCallStack => a
undefined
    sortV :: Vector (Complex Double) -> Vector (Complex Double)
sortV      = Vector (Complex Double) -> Vector (Complex Double)
forall a. HasCallStack => a
undefined
    compareV :: Vector (Complex Double) -> Vector (Complex Double) -> Vector CInt
compareV   = Vector (Complex Double) -> Vector (Complex Double) -> Vector CInt
forall a. HasCallStack => a
undefined
    selectV :: Vector CInt
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
selectV    = Vector CInt
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
selectC
    remapM :: Matrix CInt
-> Matrix CInt
-> Matrix (Complex Double)
-> Matrix (Complex Double)
remapM     = Matrix CInt
-> Matrix CInt
-> Matrix (Complex Double)
-> Matrix (Complex Double)
remapC
    rowOp :: Int
-> Complex Double
-> Int
-> Int
-> Int
-> Int
-> Matrix (Complex Double)
-> IO ()
rowOp      = (CInt
 -> Ptr (Complex Double)
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> Trans (Matrix (Complex Double)) (IO CInt))
-> Int
-> Complex Double
-> Int
-> Int
-> Int
-> Int
-> Matrix (Complex Double)
-> IO ()
forall c a.
(TransArray c, Storable a) =>
(CInt
 -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux CInt
-> Ptr (Complex Double)
-> CInt
-> CInt
-> CInt
-> CInt
-> Trans (Matrix (Complex Double)) (IO CInt)
RowOp (Complex Double)
c_rowOpC
    gemm :: Vector (Complex Double)
-> Matrix (Complex Double)
-> Matrix (Complex Double)
-> Matrix (Complex Double)
-> IO ()
gemm       = Trans
  (Vector (Complex Double))
  (Trans
     (Matrix (Complex Double))
     (Trans
        (Matrix (Complex Double))
        (Trans (Matrix (Complex Double)) (IO CInt))))
-> Vector (Complex Double)
-> Matrix (Complex Double)
-> Matrix (Complex Double)
-> Matrix (Complex Double)
-> IO ()
forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg Trans
  (Vector (Complex Double))
  (Trans
     (Matrix (Complex Double))
     (Trans
        (Matrix (Complex Double))
        (Trans (Matrix (Complex Double)) (IO CInt))))
Tgemm (Complex Double)
c_gemmC
    reorderV :: Vector CInt
-> Vector CInt
-> Vector (Complex Double)
-> Vector (Complex Double)
reorderV   = (CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Vector CInt)
      (CInt
       -> Ptr (Complex Double)
       -> CInt
       -> Ptr (Complex Double)
       -> IO CInt))
-> Vector CInt
-> Vector CInt
-> Vector (Complex Double)
-> Vector (Complex Double)
forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(CInt
 -> Ptr a
 -> CInt
 -> Ptr t1
 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Vector CInt)
     (CInt
      -> Ptr (Complex Double) -> CInt -> Ptr (Complex Double) -> IO CInt)
Reorder (Complex Double)
c_reorderC

instance Element (CInt) where
    constantD :: CInt -> Int -> Vector CInt
constantD  = (Ptr CInt -> CInt -> Ptr CInt -> IO CInt)
-> CInt -> Int -> Vector CInt
forall a1 a.
(Storable a1, Storable a) =>
(Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a
constantAux Ptr CInt -> CInt -> Ptr CInt -> IO CInt
cconstantI
    extractR :: MatrixOrder
-> Matrix CInt
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix CInt)
extractR   = (CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix CInt)
      (CInt -> CInt -> CInt -> CInt -> Ptr CInt -> IO CInt))
-> MatrixOrder
-> Matrix CInt
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix CInt)
forall t3 t2 c a t1 t.
(Eq t3, Eq t2, TransArray c, Storable a, Storable t1, Storable t,
 Num t3, Num t2, Integral t1, Integral t) =>
(t3
 -> t2
 -> CInt
 -> Ptr t1
 -> CInt
 -> Ptr t
 -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> MatrixOrder
-> c
-> t3
-> Vector t1
-> t2
-> Vector t
-> IO (Matrix a)
extractAux CInt
-> CInt
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix CInt) (CInt -> CInt -> CInt -> CInt -> Ptr CInt -> IO CInt)
Extr CInt
c_extractI
    setRect :: Int -> Int -> Matrix CInt -> Matrix CInt -> IO ()
setRect    = (CInt
 -> CInt -> Trans (Matrix CInt) (Trans (Matrix CInt) (IO CInt)))
-> Int -> Int -> Matrix CInt -> Matrix CInt -> IO ()
forall c1 c.
(TransArray c1, TransArray c) =>
(CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
-> Int -> Int -> c1 -> c -> IO ()
setRectAux CInt -> CInt -> Trans (Matrix CInt) (Trans (Matrix CInt) (IO CInt))
SetRect CInt
c_setRectI
    sortI :: Vector CInt -> Vector CInt
sortI      = Vector CInt -> Vector CInt
sortIdxI
    sortV :: Vector CInt -> Vector CInt
sortV      = Vector CInt -> Vector CInt
sortValI
    compareV :: Vector CInt -> Vector CInt -> Vector CInt
compareV   = Vector CInt -> Vector CInt -> Vector CInt
compareI
    selectV :: Vector CInt
-> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
selectV    = Vector CInt
-> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
selectI
    remapM :: Matrix CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt
remapM     = Matrix CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt
remapI
    rowOp :: Int -> CInt -> Int -> Int -> Int -> Int -> Matrix CInt -> IO ()
rowOp      = (CInt
 -> Ptr CInt
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> Trans (Matrix CInt) (IO CInt))
-> Int -> CInt -> Int -> Int -> Int -> Int -> Matrix CInt -> IO ()
forall c a.
(TransArray c, Storable a) =>
(CInt
 -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux CInt
-> Ptr CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> Trans (Matrix CInt) (IO CInt)
RowOp CInt
c_rowOpI
    gemm :: Vector CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt -> IO ()
gemm       = Trans
  (Vector CInt)
  (Trans
     (Matrix CInt)
     (Trans (Matrix CInt) (Trans (Matrix CInt) (IO CInt))))
-> Vector CInt
-> Matrix CInt
-> Matrix CInt
-> Matrix CInt
-> IO ()
forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg Trans
  (Vector CInt)
  (Trans
     (Matrix CInt)
     (Trans (Matrix CInt) (Trans (Matrix CInt) (IO CInt))))
Tgemm CInt
c_gemmI
    reorderV :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
reorderV   = (CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Vector CInt) (CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt))
-> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(CInt
 -> Ptr a
 -> CInt
 -> Ptr t1
 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Vector CInt) (CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt)
Reorder CInt
c_reorderI

instance Element Z where
    constantD :: Z -> Int -> Vector Z
constantD  = (Ptr Z -> CInt -> Ptr Z -> IO CInt) -> Z -> Int -> Vector Z
forall a1 a.
(Storable a1, Storable a) =>
(Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a
constantAux Ptr Z -> CInt -> Ptr Z -> IO CInt
cconstantL
    extractR :: MatrixOrder
-> Matrix Z
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix Z)
extractR   = (CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix Z) (CInt -> CInt -> CInt -> CInt -> Ptr Z -> IO CInt))
-> MatrixOrder
-> Matrix Z
-> CInt
-> Vector CInt
-> CInt
-> Vector CInt
-> IO (Matrix Z)
forall t3 t2 c a t1 t.
(Eq t3, Eq t2, TransArray c, Storable a, Storable t1, Storable t,
 Num t3, Num t2, Integral t1, Integral t) =>
(t3
 -> t2
 -> CInt
 -> Ptr t1
 -> CInt
 -> Ptr t
 -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> MatrixOrder
-> c
-> t3
-> Vector t1
-> t2
-> Vector t
-> IO (Matrix a)
extractAux CInt
-> CInt
-> CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix Z) (CInt -> CInt -> CInt -> CInt -> Ptr Z -> IO CInt)
Extr Z
c_extractL
    setRect :: Int -> Int -> Matrix Z -> Matrix Z -> IO ()
setRect    = (CInt -> CInt -> Trans (Matrix Z) (Trans (Matrix Z) (IO CInt)))
-> Int -> Int -> Matrix Z -> Matrix Z -> IO ()
forall c1 c.
(TransArray c1, TransArray c) =>
(CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
-> Int -> Int -> c1 -> c -> IO ()
setRectAux CInt -> CInt -> Trans (Matrix Z) (Trans (Matrix Z) (IO CInt))
SetRect Z
c_setRectL
    sortI :: Vector Z -> Vector CInt
sortI      = Vector Z -> Vector CInt
sortIdxL
    sortV :: Vector Z -> Vector Z
sortV      = Vector Z -> Vector Z
sortValL
    compareV :: Vector Z -> Vector Z -> Vector CInt
compareV   = Vector Z -> Vector Z -> Vector CInt
compareL
    selectV :: Vector CInt -> Vector Z -> Vector Z -> Vector Z -> Vector Z
selectV    = Vector CInt -> Vector Z -> Vector Z -> Vector Z -> Vector Z
selectL
    remapM :: Matrix CInt -> Matrix CInt -> Matrix Z -> Matrix Z
remapM     = Matrix CInt -> Matrix CInt -> Matrix Z -> Matrix Z
remapL
    rowOp :: Int -> Z -> Int -> Int -> Int -> Int -> Matrix Z -> IO ()
rowOp      = (CInt
 -> Ptr Z
 -> CInt
 -> CInt
 -> CInt
 -> CInt
 -> Trans (Matrix Z) (IO CInt))
-> Int -> Z -> Int -> Int -> Int -> Int -> Matrix Z -> IO ()
forall c a.
(TransArray c, Storable a) =>
(CInt
 -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux CInt
-> Ptr Z
-> CInt
-> CInt
-> CInt
-> CInt
-> Trans (Matrix Z) (IO CInt)
RowOp Z
c_rowOpL
    gemm :: Vector Z -> Matrix Z -> Matrix Z -> Matrix Z -> IO ()
gemm       = Trans
  (Vector Z)
  (Trans (Matrix Z) (Trans (Matrix Z) (Trans (Matrix Z) (IO CInt))))
-> Vector Z -> Matrix Z -> Matrix Z -> Matrix Z -> IO ()
forall c1 c c2 c3.
(TransArray c1, TransArray c, TransArray c2, TransArray c3) =>
Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg Trans
  (Vector Z)
  (Trans (Matrix Z) (Trans (Matrix Z) (Trans (Matrix Z) (IO CInt))))
Tgemm Z
c_gemmL
    reorderV :: Vector CInt -> Vector CInt -> Vector Z -> Vector Z
reorderV   = (CInt
 -> Ptr CInt
 -> CInt
 -> Ptr CInt
 -> Trans (Vector CInt) (CInt -> Ptr Z -> CInt -> Ptr Z -> IO CInt))
-> Vector CInt -> Vector CInt -> Vector Z -> Vector Z
forall c t a1 t1 a.
(TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
(CInt
 -> Ptr a
 -> CInt
 -> Ptr t1
 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux CInt
-> Ptr CInt
-> CInt
-> Ptr CInt
-> Trans (Vector CInt) (CInt -> Ptr Z -> CInt -> Ptr Z -> IO CInt)
Reorder Z
c_reorderL

-------------------------------------------------------------------

-- | reference to a rectangular slice of a matrix (no data copy)
subMatrix :: Element a
            => (Int,Int) -- ^ (r0,c0) starting position
            -> (Int,Int) -- ^ (rt,ct) dimensions of submatrix
            -> Matrix a -- ^ input matrix
            -> Matrix a -- ^ result
subMatrix :: (Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
r0,Int
c0) (Int
rt,Int
ct) Matrix a
m
    | Int
rt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
ct Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = MatrixOrder -> Int -> Int -> Vector a -> Matrix a
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
rt) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
ct) ([a] -> Vector a
forall a. Storable a => [a] -> Vector a
fromList [])
    | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r0 Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rt Bool -> Bool -> Bool
&& Int
r0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Matrix a -> Int
forall t. Matrix t -> Int
rows Matrix a
m Bool -> Bool -> Bool
&&
      Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c0 Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ct Bool -> Bool -> Bool
&& Int
c0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ct Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Matrix a -> Int
forall t. Matrix t -> Int
cols Matrix a
m = Matrix a
res
    | Bool
otherwise = String -> Matrix a
forall a. HasCallStack => String -> a
error (String -> Matrix a) -> String -> Matrix a
forall a b. (a -> b) -> a -> b
$ String
"wrong subMatrix "String -> ShowS
forall a. [a] -> [a] -> [a]
++((Int, Int), (Int, Int)) -> String
forall a. Show a => a -> String
show ((Int
r0,Int
c0),(Int
rt,Int
ct))String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" of "String -> ShowS
forall a. [a] -> [a] -> [a]
++Matrix a -> String
forall t. Matrix t -> String
shSize Matrix a
m
  where
    p :: Int
p = Int
r0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Matrix a -> Int
forall t. Matrix t -> Int
xRow Matrix a
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Matrix a -> Int
forall t. Matrix t -> Int
xCol Matrix a
m
    tot :: Int
tot | Matrix a -> Bool
forall t. Matrix t -> Bool
rowOrder Matrix a
m = Int
ct Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
rtInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Matrix a -> Int
forall t. Matrix t -> Int
xRow Matrix a
m
        | Bool
otherwise  = Int
rt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
ctInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Matrix a -> Int
forall t. Matrix t -> Int
xCol Matrix a
m
    res :: Matrix a
res = Matrix a
m { irows :: Int
irows = Int
rt, icols :: Int
icols = Int
ct, xdat :: Vector a
xdat = Int -> Int -> Vector a -> Vector a
forall t. Storable t => Int -> Int -> Vector t -> Vector t
subVector Int
p Int
tot (Matrix a -> Vector a
forall t. Matrix t -> Vector t
xdat Matrix a
m) }

--------------------------------------------------------------------------

maxZ :: (Num t1, Ord t1, Foldable t) => t t1 -> t1
maxZ :: t t1 -> t1
maxZ t t1
xs = if t t1 -> t1
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum t t1
xs t1 -> t1 -> Bool
forall a. Eq a => a -> a -> Bool
== t1
0 then t1
0 else t t1 -> t1
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum t t1
xs

conformMs :: Element t => [Matrix t] -> [Matrix t]
conformMs :: [Matrix t] -> [Matrix t]
conformMs [Matrix t]
ms = (Matrix t -> Matrix t) -> [Matrix t] -> [Matrix t]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Matrix t -> Matrix t
forall t. Element t => (Int, Int) -> Matrix t -> Matrix t
conformMTo (Int
r,Int
c)) [Matrix t]
ms
  where
    r :: Int
r = [Int] -> Int
forall t1 (t :: * -> *). (Num t1, Ord t1, Foldable t) => t t1 -> t1
maxZ ((Matrix t -> Int) -> [Matrix t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Matrix t -> Int
forall t. Matrix t -> Int
rows [Matrix t]
ms)
    c :: Int
c = [Int] -> Int
forall t1 (t :: * -> *). (Num t1, Ord t1, Foldable t) => t t1 -> t1
maxZ ((Matrix t -> Int) -> [Matrix t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Matrix t -> Int
forall t. Matrix t -> Int
cols [Matrix t]
ms)

conformVs :: Element t => [Vector t] -> [Vector t]
conformVs :: [Vector t] -> [Vector t]
conformVs [Vector t]
vs = (Vector t -> Vector t) -> [Vector t] -> [Vector t]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Vector t -> Vector t
forall a. Element a => Int -> Vector a -> Vector a
conformVTo Int
n) [Vector t]
vs
  where
    n :: Int
n = [Int] -> Int
forall t1 (t :: * -> *). (Num t1, Ord t1, Foldable t) => t t1 -> t1
maxZ ((Vector t -> Int) -> [Vector t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Vector t -> Int
forall t. Storable t => Vector t -> Int
dim [Vector t]
vs)

conformMTo :: Element t => (Int, Int) -> Matrix t -> Matrix t
conformMTo :: (Int, Int) -> Matrix t -> Matrix t
conformMTo (Int
r,Int
c) Matrix t
m
    | Matrix t -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size Matrix t
m (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
r,Int
c) = Matrix t
m
    | Matrix t -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size Matrix t
m (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1,Int
1) = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
r Int
c (t -> Int -> Vector t
forall a. Element a => a -> Int -> Vector a
constantD (Matrix t
mMatrix t -> (Int, Int) -> t
forall t. Storable t => Matrix t -> (Int, Int) -> t
@@>(Int
0,Int
0)) (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c))
    | Matrix t -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size Matrix t
m (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
r,Int
1) = Int -> Matrix t -> Matrix t
forall t. Element t => Int -> Matrix t -> Matrix t
repCols Int
c Matrix t
m
    | Matrix t -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size Matrix t
m (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1,Int
c) = Int -> Matrix t -> Matrix t
forall t. Element t => Int -> Matrix t -> Matrix t
repRows Int
r Matrix t
m
    | Bool
otherwise = String -> Matrix t
forall a. HasCallStack => String -> a
error (String -> Matrix t) -> String -> Matrix t
forall a b. (a -> b) -> a -> b
$ String
"matrix " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matrix t -> String
forall t. Matrix t -> String
shSize Matrix t
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cannot be expanded to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a a1. (Show a, Show a1) => (a1, a) -> String
shDim (Int
r,Int
c)

conformVTo :: Element t => Int -> Vector t -> Vector t
conformVTo :: Int -> Vector t -> Vector t
conformVTo Int
n Vector t
v
    | Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Vector t
v
    | Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = t -> Int -> Vector t
forall a. Element a => a -> Int -> Vector a
constantD (Vector t
vVector t -> Int -> t
forall t. Storable t => Vector t -> Int -> t
@>Int
0) Int
n
    | Bool
otherwise = String -> Vector t
forall a. HasCallStack => String -> a
error (String -> Vector t) -> String -> Vector t
forall a b. (a -> b) -> a -> b
$ String
"vector of dim=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cannot be expanded to dim=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

repRows :: Element t => Int -> Matrix t -> Matrix t
repRows :: Int -> Matrix t -> Matrix t
repRows Int
n Matrix t
x = [Vector t] -> Matrix t
forall t. Element t => [Vector t] -> Matrix t
fromRows (Int -> Vector t -> [Vector t]
forall a. Int -> a -> [a]
replicate Int
n (Matrix t -> Vector t
forall t. Element t => Matrix t -> Vector t
flatten Matrix t
x))
repCols :: Element t => Int -> Matrix t -> Matrix t
repCols :: Int -> Matrix t -> Matrix t
repCols Int
n Matrix t
x = [Vector t] -> Matrix t
forall t. Element t => [Vector t] -> Matrix t
fromColumns (Int -> Vector t -> [Vector t]
forall a. Int -> a -> [a]
replicate Int
n (Matrix t -> Vector t
forall t. Element t => Matrix t -> Vector t
flatten Matrix t
x))

shSize :: Matrix t -> [Char]
shSize :: Matrix t -> String
shSize = (Int, Int) -> String
forall a a1. (Show a, Show a1) => (a1, a) -> String
shDim ((Int, Int) -> String)
-> (Matrix t -> (Int, Int)) -> Matrix t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix t -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size

shDim :: (Show a, Show a1) => (a1, a) -> [Char]
shDim :: (a1, a) -> String
shDim (a1
r,a
c) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a1 -> String
forall a. Show a => a -> String
show a1
r String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"x"String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"

emptyM :: Storable t => Int -> Int -> Matrix t
emptyM :: Int -> Int -> Matrix t
emptyM Int
r Int
c = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
r Int
c ([t] -> Vector t
forall a. Storable a => [a] -> Vector a
fromList[])

----------------------------------------------------------------------

instance (Storable t, NFData t) => NFData (Matrix t)
  where
    rnf :: Matrix t -> ()
rnf Matrix t
m | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = t -> ()
forall a. NFData a => a -> ()
rnf (Vector t
v Vector t -> Int -> t
forall t. Storable t => Vector t -> Int -> t
@> Int
0)
          | Bool
otherwise = ()
      where
        d :: Int
d = Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v
        v :: Vector t
v = Matrix t -> Vector t
forall t. Matrix t -> Vector t
xdat Matrix t
m

---------------------------------------------------------------

extractAux :: (Eq t3, Eq t2, TransArray c, Storable a, Storable t1,
                Storable t, Num t3, Num t2, Integral t1, Integral t)
           => (t3 -> t2 -> CInt -> Ptr t1 -> CInt -> Ptr t
                  -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
           -> MatrixOrder -> c -> t3 -> Vector t1 -> t2 -> Vector t -> IO (Matrix a)
extractAux :: (t3
 -> t2
 -> CInt
 -> Ptr t1
 -> CInt
 -> Ptr t
 -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> MatrixOrder
-> c
-> t3
-> Vector t1
-> t2
-> Vector t
-> IO (Matrix a)
extractAux t3
-> t2
-> CInt
-> Ptr t1
-> CInt
-> Ptr t
-> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)
f MatrixOrder
ord c
m t3
moder Vector t1
vr t2
modec Vector t
vc = do
    let nr :: Int
nr = if t3
moder t3 -> t3 -> Bool
forall a. Eq a => a -> a -> Bool
== t3
0 then t1 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t1 -> Int) -> t1 -> Int
forall a b. (a -> b) -> a -> b
$ Vector t1
vrVector t1 -> Int -> t1
forall t. Storable t => Vector t -> Int -> t
@>Int
1 t1 -> t1 -> t1
forall a. Num a => a -> a -> a
- Vector t1
vrVector t1 -> Int -> t1
forall t. Storable t => Vector t -> Int -> t
@>Int
0 t1 -> t1 -> t1
forall a. Num a => a -> a -> a
+ t1
1 else Vector t1 -> Int
forall t. Storable t => Vector t -> Int
dim Vector t1
vr
        nc :: Int
nc = if t2
modec t2 -> t2 -> Bool
forall a. Eq a => a -> a -> Bool
== t2
0 then t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t -> Int) -> t -> Int
forall a b. (a -> b) -> a -> b
$ Vector t
vcVector t -> Int -> t
forall t. Storable t => Vector t -> Int -> t
@>Int
1 t -> t -> t
forall a. Num a => a -> a -> a
- Vector t
vcVector t -> Int -> t
forall t. Storable t => Vector t -> Int -> t
@>Int
0 t -> t -> t
forall a. Num a => a -> a -> a
+ t
1 else Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
vc
    Matrix a
r <- MatrixOrder -> Int -> Int -> IO (Matrix a)
forall a. Storable a => MatrixOrder -> Int -> Int -> IO (Matrix a)
createMatrix MatrixOrder
ord Int
nr Int
nc
    (Vector t1
vr Vector t1
-> ((CInt
     -> Ptr t
     -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
    -> IO CInt)
-> Trans
     (Vector t1)
     (CInt
      -> Ptr t
      -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# Vector t
vc Vector t
-> (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)
    -> IO CInt)
-> Trans
     (Vector t)
     (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c
m c -> Matrix a -> Trans c (Trans (Matrix a) (IO CInt)) -> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! Matrix a
r) (t3
-> t2
-> CInt
-> Ptr t1
-> CInt
-> Ptr t
-> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)
f t3
moder t2
modec)  IO CInt -> String -> IO ()
#|String
"extract"

    Matrix a -> IO (Matrix a)
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix a
r

type Extr x = CInt -> CInt -> CIdxs (CIdxs (OM x (OM x (IO CInt))))

foreign import ccall unsafe "extractD" c_extractD :: Extr Double
foreign import ccall unsafe "extractF" c_extractF :: Extr Float
foreign import ccall unsafe "extractC" c_extractC :: Extr (Complex Double)
foreign import ccall unsafe "extractQ" c_extractQ :: Extr (Complex Float)
foreign import ccall unsafe "extractI" c_extractI :: Extr CInt
foreign import ccall unsafe "extractL" c_extractL :: Extr Z

---------------------------------------------------------------

setRectAux :: (TransArray c1, TransArray c)
           => (CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
           -> Int -> Int -> c1 -> c -> IO ()
setRectAux :: (CInt -> CInt -> Trans c1 (Trans c (IO CInt)))
-> Int -> Int -> c1 -> c -> IO ()
setRectAux CInt -> CInt -> Trans c1 (Trans c (IO CInt))
f Int
i Int
j c1
m c
r = (c1
m c1 -> c -> Trans c1 (Trans c (IO CInt)) -> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! c
r) (CInt -> CInt -> Trans c1 (Trans c (IO CInt))
f (Int -> CInt
fi Int
i) (Int -> CInt
fi Int
j)) IO CInt -> String -> IO ()
#|String
"setRect"

type SetRect x = I -> I -> x ::> x::> Ok

foreign import ccall unsafe "setRectD" c_setRectD :: SetRect Double
foreign import ccall unsafe "setRectF" c_setRectF :: SetRect Float
foreign import ccall unsafe "setRectC" c_setRectC :: SetRect (Complex Double)
foreign import ccall unsafe "setRectQ" c_setRectQ :: SetRect (Complex Float)
foreign import ccall unsafe "setRectI" c_setRectI :: SetRect I
foreign import ccall unsafe "setRectL" c_setRectL :: SetRect Z

--------------------------------------------------------------------------------

sortG :: (Storable t, Storable a)
      => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG :: (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr t -> CInt -> Ptr a -> IO CInt
f Vector t
v = IO (Vector a) -> Vector a
forall a. IO a -> a
unsafePerformIO (IO (Vector a) -> Vector a) -> IO (Vector a) -> Vector a
forall a b. (a -> b) -> a -> b
$ do
    Vector a
r <- Int -> IO (Vector a)
forall a. Storable a => Int -> IO (Vector a)
createVector (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v)
    (Vector t
v Vector t
-> Vector a
-> Trans (Vector t) (Trans (Vector a) (IO CInt))
-> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! Vector a
r) Trans (Vector t) (Trans (Vector a) (IO CInt))
CInt -> Ptr t -> CInt -> Ptr a -> IO CInt
f IO CInt -> String -> IO ()
#|String
"sortG"
    Vector a -> IO (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector a
r

sortIdxD :: Vector Double -> Vector CInt
sortIdxD :: Vector Double -> Vector CInt
sortIdxD = (CInt -> Ptr Double -> CInt -> Ptr CInt -> IO CInt)
-> Vector Double -> Vector CInt
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr Double -> CInt -> Ptr CInt -> IO CInt
c_sort_indexD
sortIdxF :: Vector Float -> Vector CInt
sortIdxF :: Vector Float -> Vector CInt
sortIdxF = (CInt -> Ptr Float -> CInt -> Ptr CInt -> IO CInt)
-> Vector Float -> Vector CInt
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr Float -> CInt -> Ptr CInt -> IO CInt
c_sort_indexF
sortIdxI :: Vector CInt -> Vector CInt
sortIdxI :: Vector CInt -> Vector CInt
sortIdxI = (CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt)
-> Vector CInt -> Vector CInt
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt
c_sort_indexI
sortIdxL :: Vector Z -> Vector I
sortIdxL :: Vector Z -> Vector CInt
sortIdxL = (CInt -> Ptr Z -> CInt -> Ptr CInt -> IO CInt)
-> Vector Z -> Vector CInt
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr Z -> CInt -> Ptr CInt -> IO CInt
c_sort_indexL

sortValD :: Vector Double -> Vector Double
sortValD :: Vector Double -> Vector Double
sortValD = (CInt -> Ptr Double -> CInt -> Ptr Double -> IO CInt)
-> Vector Double -> Vector Double
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr Double -> CInt -> Ptr Double -> IO CInt
c_sort_valD
sortValF :: Vector Float -> Vector Float
sortValF :: Vector Float -> Vector Float
sortValF = (CInt -> Ptr Float -> CInt -> Ptr Float -> IO CInt)
-> Vector Float -> Vector Float
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr Float -> CInt -> Ptr Float -> IO CInt
c_sort_valF
sortValI :: Vector CInt -> Vector CInt
sortValI :: Vector CInt -> Vector CInt
sortValI = (CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt)
-> Vector CInt -> Vector CInt
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt
c_sort_valI
sortValL :: Vector Z -> Vector Z
sortValL :: Vector Z -> Vector Z
sortValL = (CInt -> Ptr Z -> CInt -> Ptr Z -> IO CInt) -> Vector Z -> Vector Z
forall t a.
(Storable t, Storable a) =>
(CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a
sortG CInt -> Ptr Z -> CInt -> Ptr Z -> IO CInt
c_sort_valL

foreign import ccall unsafe "sort_indexD" c_sort_indexD :: CV Double (CV CInt (IO CInt))
foreign import ccall unsafe "sort_indexF" c_sort_indexF :: CV Float  (CV CInt (IO CInt))
foreign import ccall unsafe "sort_indexI" c_sort_indexI :: CV CInt   (CV CInt (IO CInt))
foreign import ccall unsafe "sort_indexL" c_sort_indexL :: Z :> I :> Ok

foreign import ccall unsafe "sort_valuesD" c_sort_valD :: CV Double (CV Double (IO CInt))
foreign import ccall unsafe "sort_valuesF" c_sort_valF :: CV Float  (CV Float (IO CInt))
foreign import ccall unsafe "sort_valuesI" c_sort_valI :: CV CInt   (CV CInt (IO CInt))
foreign import ccall unsafe "sort_valuesL" c_sort_valL :: Z :> Z :> Ok

--------------------------------------------------------------------------------

compareG :: (TransArray c, Storable t, Storable a)
         => Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
         -> c -> Vector t -> Vector a
compareG :: Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
-> c -> Vector t -> Vector a
compareG Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
f c
u Vector t
v = IO (Vector a) -> Vector a
forall a. IO a -> a
unsafePerformIO (IO (Vector a) -> Vector a) -> IO (Vector a) -> Vector a
forall a b. (a -> b) -> a -> b
$ do
    Vector a
r <- Int -> IO (Vector a)
forall a. Storable a => Int -> IO (Vector a)
createVector (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v)
    (c
u c
-> ((CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> IO CInt)
-> Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# Vector t
v Vector t
-> Vector a
-> Trans (Vector t) (Trans (Vector a) (IO CInt))
-> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! Vector a
r) Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
f IO CInt -> String -> IO ()
#|String
"compareG"
    Vector a -> IO (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector a
r

compareD :: Vector Double -> Vector Double -> Vector CInt
compareD :: Vector Double -> Vector Double -> Vector CInt
compareD = Trans
  (Vector Double) (CInt -> Ptr Double -> CInt -> Ptr CInt -> IO CInt)
-> Vector Double -> Vector Double -> Vector CInt
forall c t a.
(TransArray c, Storable t, Storable a) =>
Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
-> c -> Vector t -> Vector a
compareG Trans
  (Vector Double) (CInt -> Ptr Double -> CInt -> Ptr CInt -> IO CInt)
CV Double (CInt -> Ptr Double -> CInt -> Ptr CInt -> IO CInt)
c_compareD
compareF :: Vector Float -> Vector Float -> Vector CInt
compareF :: Vector Float -> Vector Float -> Vector CInt
compareF = Trans
  (Vector Float) (CInt -> Ptr Float -> CInt -> Ptr CInt -> IO CInt)
-> Vector Float -> Vector Float -> Vector CInt
forall c t a.
(TransArray c, Storable t, Storable a) =>
Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
-> c -> Vector t -> Vector a
compareG Trans
  (Vector Float) (CInt -> Ptr Float -> CInt -> Ptr CInt -> IO CInt)
CV Float (CInt -> Ptr Float -> CInt -> Ptr CInt -> IO CInt)
c_compareF
compareI :: Vector CInt -> Vector CInt -> Vector CInt
compareI :: Vector CInt -> Vector CInt -> Vector CInt
compareI = Trans
  (Vector CInt) (CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt)
-> Vector CInt -> Vector CInt -> Vector CInt
forall c t a.
(TransArray c, Storable t, Storable a) =>
Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
-> c -> Vector t -> Vector a
compareG Trans
  (Vector CInt) (CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt)
CV CInt (CInt -> Ptr CInt -> CInt -> Ptr CInt -> IO CInt)
c_compareI
compareL :: Vector Z -> Vector Z -> Vector CInt
compareL :: Vector Z -> Vector Z -> Vector CInt
compareL = Trans (Vector Z) (CInt -> Ptr Z -> CInt -> Ptr CInt -> IO CInt)
-> Vector Z -> Vector Z -> Vector CInt
forall c t a.
(TransArray c, Storable t, Storable a) =>
Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt)
-> c -> Vector t -> Vector a
compareG Trans (Vector Z) (CInt -> Ptr Z -> CInt -> Ptr CInt -> IO CInt)
Z :> (CInt -> Ptr Z -> CInt -> Ptr CInt -> IO CInt)
c_compareL

foreign import ccall unsafe "compareD" c_compareD :: CV Double (CV Double (CV CInt (IO CInt)))
foreign import ccall unsafe "compareF" c_compareF :: CV Float (CV Float  (CV CInt (IO CInt)))
foreign import ccall unsafe "compareI" c_compareI :: CV CInt (CV CInt   (CV CInt (IO CInt)))
foreign import ccall unsafe "compareL" c_compareL :: Z :> Z :> I :> Ok

--------------------------------------------------------------------------------

selectG :: (TransArray c, TransArray c1, TransArray c2, Storable t, Storable a)
        => Trans c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
        -> c2 -> c1 -> Vector t -> c -> Vector a
selectG :: Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> c2 -> c1 -> Vector t -> c -> Vector a
selectG Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
f c2
c c1
u Vector t
v c
w = IO (Vector a) -> Vector a
forall a. IO a -> a
unsafePerformIO (IO (Vector a) -> Vector a) -> IO (Vector a) -> Vector a
forall a b. (a -> b) -> a -> b
$ do
    Vector a
r <- Int -> IO (Vector a)
forall a. Storable a => Int -> IO (Vector a)
createVector (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v)
    (c2
c c2
-> (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt))
    -> IO CInt)
-> Trans
     c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c1
u c1
-> ((CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt))
    -> IO CInt)
-> Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# Vector t
v Vector t
-> (Trans c (CInt -> Ptr a -> IO CInt) -> IO CInt)
-> Trans (Vector t) (Trans c (CInt -> Ptr a -> IO CInt))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c
w c -> Vector a -> Trans c (Trans (Vector a) (IO CInt)) -> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! Vector a
r) Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
f IO CInt -> String -> IO ()
#|String
"selectG"
    Vector a -> IO (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector a
r

selectD :: Vector CInt -> Vector Double -> Vector Double -> Vector Double -> Vector Double
selectD :: Vector CInt
-> Vector Double -> Vector Double -> Vector Double -> Vector Double
selectD = Trans
  (Vector CInt)
  (Trans
     (Vector Double)
     (CInt
      -> Ptr Double
      -> Trans (Vector Double) (CInt -> Ptr Double -> IO CInt)))
-> Vector CInt
-> Vector Double
-> Vector Double
-> Vector Double
-> Vector Double
forall c c1 c2 t a.
(TransArray c, TransArray c1, TransArray c2, Storable t,
 Storable a) =>
Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> c2 -> c1 -> Vector t -> c -> Vector a
selectG Trans
  (Vector CInt)
  (Trans
     (Vector Double)
     (CInt
      -> Ptr Double
      -> Trans (Vector Double) (CInt -> Ptr Double -> IO CInt)))
Sel Double
c_selectD
selectF :: Vector CInt -> Vector Float -> Vector Float -> Vector Float -> Vector Float
selectF :: Vector CInt
-> Vector Float -> Vector Float -> Vector Float -> Vector Float
selectF = Trans
  (Vector CInt)
  (Trans
     (Vector Float)
     (CInt
      -> Ptr Float
      -> Trans (Vector Float) (CInt -> Ptr Float -> IO CInt)))
-> Vector CInt
-> Vector Float
-> Vector Float
-> Vector Float
-> Vector Float
forall c c1 c2 t a.
(TransArray c, TransArray c1, TransArray c2, Storable t,
 Storable a) =>
Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> c2 -> c1 -> Vector t -> c -> Vector a
selectG Trans
  (Vector CInt)
  (Trans
     (Vector Float)
     (CInt
      -> Ptr Float
      -> Trans (Vector Float) (CInt -> Ptr Float -> IO CInt)))
Sel Float
c_selectF
selectI :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
selectI :: Vector CInt
-> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
selectI = Trans
  (Vector CInt)
  (Trans
     (Vector CInt)
     (CInt
      -> Ptr CInt -> Trans (Vector CInt) (CInt -> Ptr CInt -> IO CInt)))
-> Vector CInt
-> Vector CInt
-> Vector CInt
-> Vector CInt
-> Vector CInt
forall c c1 c2 t a.
(TransArray c, TransArray c1, TransArray c2, Storable t,
 Storable a) =>
Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> c2 -> c1 -> Vector t -> c -> Vector a
selectG Trans
  (Vector CInt)
  (Trans
     (Vector CInt)
     (CInt
      -> Ptr CInt -> Trans (Vector CInt) (CInt -> Ptr CInt -> IO CInt)))
Reorder CInt
c_selectI
selectL :: Vector CInt -> Vector Z -> Vector Z -> Vector Z -> Vector Z
selectL :: Vector CInt -> Vector Z -> Vector Z -> Vector Z -> Vector Z
selectL = Trans
  (Vector CInt)
  (Trans
     (Vector Z)
     (CInt -> Ptr Z -> Trans (Vector Z) (CInt -> Ptr Z -> IO CInt)))
-> Vector CInt -> Vector Z -> Vector Z -> Vector Z -> Vector Z
forall c c1 c2 t a.
(TransArray c, TransArray c1, TransArray c2, Storable t,
 Storable a) =>
Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> c2 -> c1 -> Vector t -> c -> Vector a
selectG Trans
  (Vector CInt)
  (Trans
     (Vector Z)
     (CInt -> Ptr Z -> Trans (Vector Z) (CInt -> Ptr Z -> IO CInt)))
Sel Z
c_selectL
selectC :: Vector CInt
        -> Vector (Complex Double)
        -> Vector (Complex Double)
        -> Vector (Complex Double)
        -> Vector (Complex Double)
selectC :: Vector CInt
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
selectC = Trans
  (Vector CInt)
  (Trans
     (Vector (Complex Double))
     (CInt
      -> Ptr (Complex Double)
      -> Trans
           (Vector (Complex Double))
           (CInt -> Ptr (Complex Double) -> IO CInt)))
-> Vector CInt
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
-> Vector (Complex Double)
forall c c1 c2 t a.
(TransArray c, TransArray c1, TransArray c2, Storable t,
 Storable a) =>
Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> c2 -> c1 -> Vector t -> c -> Vector a
selectG Trans
  (Vector CInt)
  (Trans
     (Vector (Complex Double))
     (CInt
      -> Ptr (Complex Double)
      -> Trans
           (Vector (Complex Double))
           (CInt -> Ptr (Complex Double) -> IO CInt)))
Sel (Complex Double)
c_selectC
selectQ :: Vector CInt
        -> Vector (Complex Float)
        -> Vector (Complex Float)
        -> Vector (Complex Float)
        -> Vector (Complex Float)
selectQ :: Vector CInt
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
selectQ = Trans
  (Vector CInt)
  (Trans
     (Vector (Complex Float))
     (CInt
      -> Ptr (Complex Float)
      -> Trans
           (Vector (Complex Float)) (CInt -> Ptr (Complex Float) -> IO CInt)))
-> Vector CInt
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
-> Vector (Complex Float)
forall c c1 c2 t a.
(TransArray c, TransArray c1, TransArray c2, Storable t,
 Storable a) =>
Trans
  c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt)))
-> c2 -> c1 -> Vector t -> c -> Vector a
selectG Trans
  (Vector CInt)
  (Trans
     (Vector (Complex Float))
     (CInt
      -> Ptr (Complex Float)
      -> Trans
           (Vector (Complex Float)) (CInt -> Ptr (Complex Float) -> IO CInt)))
Sel (Complex Float)
c_selectQ

type Sel x = CV CInt (CV x (CV x (CV x (CV x (IO CInt)))))

foreign import ccall unsafe "chooseD" c_selectD :: Sel Double
foreign import ccall unsafe "chooseF" c_selectF :: Sel Float
foreign import ccall unsafe "chooseI" c_selectI :: Sel CInt
foreign import ccall unsafe "chooseC" c_selectC :: Sel (Complex Double)
foreign import ccall unsafe "chooseQ" c_selectQ :: Sel (Complex Float)
foreign import ccall unsafe "chooseL" c_selectL :: Sel Z

---------------------------------------------------------------------------

remapG :: (TransArray c, TransArray c1, Storable t, Storable a)
       => (CInt -> CInt -> CInt -> CInt -> Ptr t
                -> Trans c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
       -> Matrix t -> c1 -> c -> Matrix a
remapG :: (CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr t
 -> Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> Matrix t -> c1 -> c -> Matrix a
remapG CInt
-> CInt
-> CInt
-> CInt
-> Ptr t
-> Trans
     c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
f Matrix t
i c1
j c
m = IO (Matrix a) -> Matrix a
forall a. IO a -> a
unsafePerformIO (IO (Matrix a) -> Matrix a) -> IO (Matrix a) -> Matrix a
forall a b. (a -> b) -> a -> b
$ do
    Matrix a
r <- MatrixOrder -> Int -> Int -> IO (Matrix a)
forall a. Storable a => MatrixOrder -> Int -> Int -> IO (Matrix a)
createMatrix MatrixOrder
RowMajor (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
i) (Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
i)
    (Matrix t
i Matrix t
-> (Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
    -> IO CInt)
-> Trans
     (Matrix t)
     (Trans
        c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c1
j c1
-> (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)
    -> IO CInt)
-> Trans
     c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c
m c -> Matrix a -> Trans c (Trans (Matrix a) (IO CInt)) -> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! Matrix a
r) Trans
  (Matrix t)
  (Trans
     c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
CInt
-> CInt
-> CInt
-> CInt
-> Ptr t
-> Trans
     c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))
f IO CInt -> String -> IO ()
#|String
"remapG"
    Matrix a -> IO (Matrix a)
forall (m :: * -> *) a. Monad m => a -> m a
return Matrix a
r

remapD :: Matrix CInt -> Matrix CInt -> Matrix Double -> Matrix Double
remapD :: Matrix CInt -> Matrix CInt -> Matrix Double -> Matrix Double
remapD = (CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix CInt)
      (Trans
         (Matrix Double)
         (CInt -> CInt -> CInt -> CInt -> Ptr Double -> IO CInt)))
-> Matrix CInt -> Matrix CInt -> Matrix Double -> Matrix Double
forall c c1 t a.
(TransArray c, TransArray c1, Storable t, Storable a) =>
(CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr t
 -> Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> Matrix t -> c1 -> c -> Matrix a
remapG CInt
-> CInt
-> CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix CInt)
     (Trans
        (Matrix Double)
        (CInt -> CInt -> CInt -> CInt -> Ptr Double -> IO CInt))
Rem Double
c_remapD
remapF :: Matrix CInt -> Matrix CInt -> Matrix Float -> Matrix Float
remapF :: Matrix CInt -> Matrix CInt -> Matrix Float -> Matrix Float
remapF = (CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix CInt)
      (Trans
         (Matrix Float)
         (CInt -> CInt -> CInt -> CInt -> Ptr Float -> IO CInt)))
-> Matrix CInt -> Matrix CInt -> Matrix Float -> Matrix Float
forall c c1 t a.
(TransArray c, TransArray c1, Storable t, Storable a) =>
(CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr t
 -> Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> Matrix t -> c1 -> c -> Matrix a
remapG CInt
-> CInt
-> CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix CInt)
     (Trans
        (Matrix Float)
        (CInt -> CInt -> CInt -> CInt -> Ptr Float -> IO CInt))
Rem Float
c_remapF
remapI :: Matrix CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt
remapI :: Matrix CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt
remapI = (CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix CInt)
      (Trans
         (Matrix CInt)
         (CInt -> CInt -> CInt -> CInt -> Ptr CInt -> IO CInt)))
-> Matrix CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt
forall c c1 t a.
(TransArray c, TransArray c1, Storable t, Storable a) =>
(CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr t
 -> Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> Matrix t -> c1 -> c -> Matrix a
remapG CInt
-> CInt
-> CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix CInt)
     (Trans
        (Matrix CInt)
        (CInt -> CInt -> CInt -> CInt -> Ptr CInt -> IO CInt))
Rem CInt
c_remapI
remapL :: Matrix CInt -> Matrix CInt -> Matrix Z -> Matrix Z
remapL :: Matrix CInt -> Matrix CInt -> Matrix Z -> Matrix Z
remapL = (CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix CInt)
      (Trans
         (Matrix Z) (CInt -> CInt -> CInt -> CInt -> Ptr Z -> IO CInt)))
-> Matrix CInt -> Matrix CInt -> Matrix Z -> Matrix Z
forall c c1 t a.
(TransArray c, TransArray c1, Storable t, Storable a) =>
(CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr t
 -> Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> Matrix t -> c1 -> c -> Matrix a
remapG CInt
-> CInt
-> CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix CInt)
     (Trans
        (Matrix Z) (CInt -> CInt -> CInt -> CInt -> Ptr Z -> IO CInt))
Rem Z
c_remapL
remapC :: Matrix CInt
       -> Matrix CInt
       -> Matrix (Complex Double)
       -> Matrix (Complex Double)
remapC :: Matrix CInt
-> Matrix CInt
-> Matrix (Complex Double)
-> Matrix (Complex Double)
remapC = (CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix CInt)
      (Trans
         (Matrix (Complex Double))
         (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Double) -> IO CInt)))
-> Matrix CInt
-> Matrix CInt
-> Matrix (Complex Double)
-> Matrix (Complex Double)
forall c c1 t a.
(TransArray c, TransArray c1, Storable t, Storable a) =>
(CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr t
 -> Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> Matrix t -> c1 -> c -> Matrix a
remapG CInt
-> CInt
-> CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix CInt)
     (Trans
        (Matrix (Complex Double))
        (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Double) -> IO CInt))
Rem (Complex Double)
c_remapC
remapQ :: Matrix CInt -> Matrix CInt -> Matrix (Complex Float) -> Matrix (Complex Float)
remapQ :: Matrix CInt
-> Matrix CInt -> Matrix (Complex Float) -> Matrix (Complex Float)
remapQ = (CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr CInt
 -> Trans
      (Matrix CInt)
      (Trans
         (Matrix (Complex Float))
         (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Float) -> IO CInt)))
-> Matrix CInt
-> Matrix CInt
-> Matrix (Complex Float)
-> Matrix (Complex Float)
forall c c1 t a.
(TransArray c, TransArray c1, Storable t, Storable a) =>
(CInt
 -> CInt
 -> CInt
 -> CInt
 -> Ptr t
 -> Trans
      c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)))
-> Matrix t -> c1 -> c -> Matrix a
remapG CInt
-> CInt
-> CInt
-> CInt
-> Ptr CInt
-> Trans
     (Matrix CInt)
     (Trans
        (Matrix (Complex Float))
        (CInt -> CInt -> CInt -> CInt -> Ptr (Complex Float) -> IO CInt))
Rem (Complex Float)
c_remapQ

type Rem x = OM CInt (OM CInt (OM x (OM x (IO CInt))))

foreign import ccall unsafe "remapD" c_remapD :: Rem Double
foreign import ccall unsafe "remapF" c_remapF :: Rem Float
foreign import ccall unsafe "remapI" c_remapI :: Rem CInt
foreign import ccall unsafe "remapC" c_remapC :: Rem (Complex Double)
foreign import ccall unsafe "remapQ" c_remapQ :: Rem (Complex Float)
foreign import ccall unsafe "remapL" c_remapL :: Rem Z

--------------------------------------------------------------------------------

rowOpAux :: (TransArray c, Storable a) =>
            (CInt -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
         -> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux :: (CInt
 -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt))
-> Int -> a -> Int -> Int -> Int -> Int -> c -> IO ()
rowOpAux CInt -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt)
f Int
c a
x Int
i1 Int
i2 Int
j1 Int
j2 c
m = do
    Ptr a
px <- [a] -> IO (Ptr a)
forall a. Storable a => [a] -> IO (Ptr a)
newArray [a
x]
    (c
m c -> (IO CInt -> IO CInt) -> Trans c (IO CInt) -> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# IO CInt -> IO CInt
forall a. a -> a
id) (CInt -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt)
f (Int -> CInt
fi Int
c) Ptr a
px (Int -> CInt
fi Int
i1) (Int -> CInt
fi Int
i2) (Int -> CInt
fi Int
j1) (Int -> CInt
fi Int
j2)) IO CInt -> String -> IO ()
#|String
"rowOp"
    Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
px

type RowOp x = CInt -> Ptr x -> CInt -> CInt -> CInt -> CInt -> x ::> Ok

foreign import ccall unsafe "rowop_double"  c_rowOpD :: RowOp R
foreign import ccall unsafe "rowop_float"   c_rowOpF :: RowOp Float
foreign import ccall unsafe "rowop_TCD"     c_rowOpC :: RowOp C
foreign import ccall unsafe "rowop_TCF"     c_rowOpQ :: RowOp (Complex Float)
foreign import ccall unsafe "rowop_int32_t" c_rowOpI :: RowOp I
foreign import ccall unsafe "rowop_int64_t" c_rowOpL :: RowOp Z
foreign import ccall unsafe "rowop_mod_int32_t" c_rowOpMI :: I -> RowOp I
foreign import ccall unsafe "rowop_mod_int64_t" c_rowOpML :: Z -> RowOp Z

--------------------------------------------------------------------------------

gemmg :: (TransArray c1, TransArray c, TransArray c2, TransArray c3)
      => Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
      -> c3 -> c2 -> c1 -> c -> IO ()
gemmg :: Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> c3 -> c2 -> c1 -> c -> IO ()
gemmg Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
f c3
v c2
m1 c1
m2 c
m3 = (c3
v c3
-> (Trans c2 (Trans c1 (Trans c (IO CInt))) -> IO CInt)
-> Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c2
m1 c2
-> (Trans c1 (Trans c (IO CInt)) -> IO CInt)
-> Trans c2 (Trans c1 (Trans c (IO CInt)))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c1
m2 c1 -> c -> Trans c1 (Trans c (IO CInt)) -> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! c
m3) Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt))))
f IO CInt -> String -> IO ()
#|String
"gemmg"

type Tgemm x = x :> x ::> x ::> x ::> Ok

foreign import ccall unsafe "gemm_double"  c_gemmD :: Tgemm R
foreign import ccall unsafe "gemm_float"   c_gemmF :: Tgemm Float
foreign import ccall unsafe "gemm_TCD"     c_gemmC :: Tgemm C
foreign import ccall unsafe "gemm_TCF"     c_gemmQ :: Tgemm (Complex Float)
foreign import ccall unsafe "gemm_int32_t" c_gemmI :: Tgemm I
foreign import ccall unsafe "gemm_int64_t" c_gemmL :: Tgemm Z
foreign import ccall unsafe "gemm_mod_int32_t" c_gemmMI :: I -> Tgemm I
foreign import ccall unsafe "gemm_mod_int64_t" c_gemmML :: Z -> Tgemm Z

--------------------------------------------------------------------------------

reorderAux :: (TransArray c, Storable t, Storable a1, Storable t1, Storable a) =>
              (CInt -> Ptr a -> CInt -> Ptr t1
                    -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
           -> Vector t1 -> c -> Vector t -> Vector a1
reorderAux :: (CInt
 -> Ptr a
 -> CInt
 -> Ptr t1
 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> Vector t1 -> c -> Vector t -> Vector a1
reorderAux CInt
-> Ptr a
-> CInt
-> Ptr t1
-> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt)
f Vector t1
s c
d Vector t
v = IO (Vector a1) -> Vector a1
forall a. IO a -> a
unsafePerformIO (IO (Vector a1) -> Vector a1) -> IO (Vector a1) -> Vector a1
forall a b. (a -> b) -> a -> b
$ do
    Vector a
k <- Int -> IO (Vector a)
forall a. Storable a => Int -> IO (Vector a)
createVector (Vector t1 -> Int
forall t. Storable t => Vector t -> Int
dim Vector t1
s)
    Vector a1
r <- Int -> IO (Vector a1)
forall a. Storable a => Int -> IO (Vector a)
createVector (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v)
    (Vector a
k Vector a
-> ((CInt
     -> Ptr t1 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
    -> IO CInt)
-> Trans
     (Vector a)
     (CInt
      -> Ptr t1 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# Vector t1
s Vector t1
-> (Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt)
    -> IO CInt)
-> Trans
     (Vector t1) (Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# c
d c
-> ((CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt) -> IO CInt)
-> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt)
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# Vector t
v Vector t
-> Vector a1
-> Trans (Vector t) (Trans (Vector a1) (IO CInt))
-> IO CInt
forall c c1 r.
(TransArray c, TransArray c1) =>
c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r
#! Vector a1
r) Trans
  (Vector a)
  (CInt
   -> Ptr t1 -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt))
CInt
-> Ptr a
-> CInt
-> Ptr t1
-> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt)
f IO CInt -> String -> IO ()
#| String
"reorderV"
    Vector a1 -> IO (Vector a1)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector a1
r

type Reorder x = CV CInt (CV CInt (CV CInt (CV x (CV x (IO CInt)))))

foreign import ccall unsafe "reorderD" c_reorderD :: Reorder Double
foreign import ccall unsafe "reorderF" c_reorderF :: Reorder Float
foreign import ccall unsafe "reorderI" c_reorderI :: Reorder CInt
foreign import ccall unsafe "reorderC" c_reorderC :: Reorder (Complex Double)
foreign import ccall unsafe "reorderQ" c_reorderQ :: Reorder (Complex Float)
foreign import ccall unsafe "reorderL" c_reorderL :: Reorder Z

-- | Transpose an array with dimensions @dims@ by making a copy using @strides@. For example, for an array with 3 indices,
--   @(reorderVector strides dims v) ! ((i * dims ! 1 + j) * dims ! 2 + k) == v ! (i * strides ! 0 + j * strides ! 1 + k * strides ! 2)@
--   This function is intended to be used internally by tensor libraries.
reorderVector :: Element a
                    => Vector CInt -- ^ @strides@: array strides
                    -> Vector CInt -- ^ @dims@: array dimensions of new array @v@
                    -> Vector a    -- ^ @v@: flattened input array
                    -> Vector a    -- ^ @v'@: flattened output array
reorderVector :: Vector CInt -> Vector CInt -> Vector a -> Vector a
reorderVector = Vector CInt -> Vector CInt -> Vector a -> Vector a
forall a.
Element a =>
Vector CInt -> Vector CInt -> Vector a -> Vector a
reorderV

--------------------------------------------------------------------------------

foreign import ccall unsafe "saveMatrix" c_saveMatrix
    :: CString -> CString -> Double ::> Ok

{- | save a matrix as a 2D ASCII table
-}
saveMatrix
    :: FilePath
    -> String        -- ^ \"printf\" format (e.g. \"%.2f\", \"%g\", etc.)
    -> Matrix Double
    -> IO ()
saveMatrix :: String -> String -> Matrix Double -> IO ()
saveMatrix String
name String
format Matrix Double
m = do
    CString
cname   <- String -> IO CString
newCString String
name
    CString
cformat <- String -> IO CString
newCString String
format
    (Matrix Double
m Matrix Double
-> (IO CInt -> IO CInt)
-> Trans (Matrix Double) (IO CInt)
-> IO CInt
forall c b r. TransArray c => c -> (b -> IO r) -> Trans c b -> IO r
# IO CInt -> IO CInt
forall a. a -> a
id) (CString
-> CString -> CInt -> CInt -> CInt -> CInt -> Ptr Double -> IO CInt
c_saveMatrix CString
cname CString
cformat) IO CInt -> String -> IO ()
#|String
"saveMatrix"
    CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
    CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cformat
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

--------------------------------------------------------------------------------