{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Packed.Matrix
-- Copyright   :  (c) Alberto Ruiz 2007-10
-- License     :  BSD3
-- Maintainer  :  Alberto Ruiz
-- Stability   :  provisional
--
-- A Matrix representation suitable for numerical computations using LAPACK and GSL.
--
-- This module provides basic functions for manipulation of structure.

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

module Internal.Element where

import Internal.Vector
import Internal.Matrix
import Internal.Vectorized
import qualified Internal.ST as ST
import Data.Array
import Text.Printf
import Data.List(transpose,intersperse)
import Data.List.Split(chunksOf)
import Foreign.Storable(Storable)
import System.IO.Unsafe(unsafePerformIO)
import Control.Monad(liftM)
import Foreign.C.Types(CInt)

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


import Data.Binary

instance (Binary a, Element a) => Binary (Matrix a) where
    put :: Matrix a -> Put
put Matrix a
m = do
            forall t. Binary t => t -> Put
put (forall t. Matrix t -> Int
cols Matrix a
m)
            forall t. Binary t => t -> Put
put (forall t. Element t => Matrix t -> Vector t
flatten Matrix a
m)
    get :: Get (Matrix a)
get = do
          Int
c <- forall t. Binary t => Get t
get
          Vector a
v <- forall t. Binary t => Get t
get
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
c Vector a
v)


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

instance (Show a, Element a) => (Show (Matrix a)) where
    show :: Matrix a -> [Char]
show Matrix a
m | forall t. Matrix t -> Int
rows Matrix a
m forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| forall t. Matrix t -> Int
cols Matrix a
m forall a. Eq a => a -> a -> Bool
== Int
0 = forall t. Matrix t -> [Char]
sizes Matrix a
m forall a. [a] -> [a] -> [a]
++[Char]
" []"
    show Matrix a
m = (forall t. Matrix t -> [Char]
sizes Matrix a
mforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [Char]
dsp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => Matrix t -> [[t]]
toLists forall a b. (a -> b) -> a -> b
$ Matrix a
m

sizes :: Matrix t -> [Char]
sizes :: forall t. Matrix t -> [Char]
sizes Matrix t
m = [Char]
"("forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall t. Matrix t -> Int
rows Matrix t
m)forall a. [a] -> [a] -> [a]
++[Char]
"><"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall t. Matrix t -> Int
cols Matrix t
m)forall a. [a] -> [a] -> [a]
++[Char]
")\n"

dsp :: [[[Char]]] -> [Char]
dsp :: [[[Char]]] -> [Char]
dsp [[[Char]]]
as = (forall a. [a] -> [a] -> [a]
++[Char]
" ]") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
" ["forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Char]
" , "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [Char]
unwords' forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose [[[Char]]]
mtp
    where
        mt :: [[[Char]]]
mt = forall a. [[a]] -> [[a]]
transpose [[[Char]]]
as
        longs :: [Int]
longs = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[[Char]]]
mt
        mtp :: [[[Char]]]
mtp = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
a [[Char]]
b -> forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
pad Int
a) [[Char]]
b) [Int]
longs [[[Char]]]
mt
        pad :: Int -> ShowS
pad Int
n [Char]
str = forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str) Char
' ' forall a. [a] -> [a] -> [a]
++ [Char]
str
        unwords' :: [[Char]] -> [Char]
unwords' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [Char]
", "

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

instance (Element a, Read a) => Read (Matrix a) where
    readsPrec :: Int -> ReadS (Matrix a)
readsPrec Int
_ [Char]
s = [((Int
rsforall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> a
read forall a b. (a -> b) -> a -> b
$ [Char]
listnums, [Char]
rest)]
        where ([Char]
thing,[Char]
rest) = forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
']' [Char]
s
              ([Char]
dims,[Char]
listnums) = forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
')' [Char]
thing
              cs :: Int
cs = forall a. Read a => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
')' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
'<' forall a b. (a -> b) -> a -> b
$ [Char]
dims
              rs :: Int
rs = forall a. Read a => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
'(' forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
'>' forall a b. (a -> b) -> a -> b
$ [Char]
dims


breakAt :: Eq a => a -> [a] -> ([a], [a])
breakAt :: forall a. Eq a => a -> [a] -> ([a], [a])
breakAt a
c [a]
l = ([a]
aforall a. [a] -> [a] -> [a]
++[a
c],forall a. [a] -> [a]
tail [a]
b) where
    ([a]
a,[a]
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==a
c) [a]
l

--------------------------------------------------------------------------------
-- | Specification of indexes for the operator '??'.
data Extractor
    = All
    | Range Int Int Int
    | Pos (Vector I)
    | PosCyc (Vector I)
    | Take Int
    | TakeLast Int
    | Drop Int
    | DropLast Int
  deriving Int -> Extractor -> ShowS
[Extractor] -> ShowS
Extractor -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Extractor] -> ShowS
$cshowList :: [Extractor] -> ShowS
show :: Extractor -> [Char]
$cshow :: Extractor -> [Char]
showsPrec :: Int -> Extractor -> ShowS
$cshowsPrec :: Int -> Extractor -> ShowS
Show

ppext :: Extractor -> [Char]
ppext :: Extractor -> [Char]
ppext Extractor
All = [Char]
":"
ppext (Range Int
a Int
1 Int
c) = forall r. PrintfType r => [Char] -> r
printf [Char]
"%d:%d" Int
a Int
c
ppext (Range Int
a Int
b Int
c) = forall r. PrintfType r => [Char] -> r
printf [Char]
"%d:%d:%d" Int
a Int
b Int
c
ppext (Pos Vector I
v) = forall a. Show a => a -> [Char]
show (forall a. Storable a => Vector a -> [a]
toList Vector I
v)
ppext (PosCyc Vector I
v) = [Char]
"Cyclic"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall a. Storable a => Vector a -> [a]
toList Vector I
v)
ppext (Take Int
n) = forall r. PrintfType r => [Char] -> r
printf [Char]
"Take %d" Int
n
ppext (Drop Int
n) = forall r. PrintfType r => [Char] -> r
printf [Char]
"Drop %d" Int
n
ppext (TakeLast Int
n) = forall r. PrintfType r => [Char] -> r
printf [Char]
"TakeLast %d" Int
n
ppext (DropLast Int
n) = forall r. PrintfType r => [Char] -> r
printf [Char]
"DropLast %d" Int
n

{- | General matrix slicing.

>>> m
(4><5)
 [  0,  1,  2,  3,  4
 ,  5,  6,  7,  8,  9
 , 10, 11, 12, 13, 14
 , 15, 16, 17, 18, 19 ]

>>> m ?? (Take 3, DropLast 2)
(3><3)
 [  0,  1,  2
 ,  5,  6,  7
 , 10, 11, 12 ]

>>> m ?? (Pos (idxs[2,1]), All)
(2><5)
 [ 10, 11, 12, 13, 14
 ,  5,  6,  7,  8,  9 ]

>>> m ?? (PosCyc (idxs[-7,80]), Range 4 (-2) 0)
(2><3)
 [ 9, 7, 5
 , 4, 2, 0 ]

-}
infixl 9 ??
(??)  :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t

minEl :: Vector CInt -> CInt
minEl :: Vector I -> I
minEl = FunCodeS -> Vector I -> I
toScalarI FunCodeS
Min
maxEl :: Vector CInt -> CInt
maxEl :: Vector I -> I
maxEl = FunCodeS -> Vector I -> I
toScalarI FunCodeS
Max
cmodi :: Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt
cmodi :: I -> Vector I -> Vector I
cmodi = FunCodeSV -> I -> Vector I -> Vector I
vectorMapValI FunCodeSV
ModVS

extractError :: Matrix t1 -> (Extractor, Extractor) -> t
extractError :: forall t1 t. Matrix t1 -> (Extractor, Extractor) -> t
extractError Matrix t1
m (Extractor
e1,Extractor
e2)= forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
"can't extract (%s,%s) from matrix %dx%d" (Extractor -> [Char]
ppext Extractor
e1::String) (Extractor -> [Char]
ppext Extractor
e2::String) (forall t. Matrix t -> Int
rows Matrix t1
m) (forall t. Matrix t -> Int
cols Matrix t1
m)

Matrix t
m ?? :: forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Range Int
a Int
s Int
b,Extractor
e) | Int
s forall a. Eq a => a -> a -> Bool
/= Int
1 = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Vector I -> Extractor
Pos ([Int] -> Vector I
idxs [Int
a,Int
aforall a. Num a => a -> a -> a
+Int
s .. Int
b]), Extractor
e)
Matrix t
m ?? (Extractor
e,Range Int
a Int
s Int
b) | Int
s forall a. Eq a => a -> a -> Bool
/= Int
1 = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e, Vector I -> Extractor
Pos ([Int] -> Vector I
idxs [Int
a,Int
aforall a. Num a => a -> a -> a
+Int
s .. Int
b]))

Matrix t
m ?? e :: (Extractor, Extractor)
e@(Range Int
a Int
_ Int
b,Extractor
_) | Int
a forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
b forall a. Ord a => a -> a -> Bool
>= forall t. Matrix t -> Int
rows Matrix t
m = forall t1 t. Matrix t1 -> (Extractor, Extractor) -> t
extractError Matrix t
m (Extractor, Extractor)
e
Matrix t
m ?? e :: (Extractor, Extractor)
e@(Extractor
_,Range Int
a Int
_ Int
b) | Int
a forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
b forall a. Ord a => a -> a -> Bool
>= forall t. Matrix t -> Int
cols Matrix t
m = forall t1 t. Matrix t1 -> (Extractor, Extractor) -> t
extractError Matrix t
m (Extractor, Extractor)
e

Matrix t
m ?? e :: (Extractor, Extractor)
e@(Pos Vector I
vs,Extractor
_) | forall t. Storable t => Vector t -> Int
dim Vector I
vsforall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& (Vector I -> I
minEl Vector I
vs forall a. Ord a => a -> a -> Bool
< I
0 Bool -> Bool -> Bool
|| Vector I -> I
maxEl Vector I
vs forall a. Ord a => a -> a -> Bool
>= Int -> I
fi (forall t. Matrix t -> Int
rows Matrix t
m)) = forall t1 t. Matrix t1 -> (Extractor, Extractor) -> t
extractError Matrix t
m (Extractor, Extractor)
e
Matrix t
m ?? e :: (Extractor, Extractor)
e@(Extractor
_,Pos Vector I
vs) | forall t. Storable t => Vector t -> Int
dim Vector I
vsforall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& (Vector I -> I
minEl Vector I
vs forall a. Ord a => a -> a -> Bool
< I
0 Bool -> Bool -> Bool
|| Vector I -> I
maxEl Vector I
vs forall a. Ord a => a -> a -> Bool
>= Int -> I
fi (forall t. Matrix t -> Int
cols Matrix t
m)) = forall t1 t. Matrix t1 -> (Extractor, Extractor) -> t
extractError Matrix t
m (Extractor, Extractor)
e

Matrix t
m ?? (Extractor
All,Extractor
All) = Matrix t
m

Matrix t
m ?? (Range Int
a Int
_ Int
b,Extractor
e) | Int
a forall a. Ord a => a -> a -> Bool
> Int
b = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Int -> Extractor
Take Int
0,Extractor
e)
Matrix t
m ?? (Extractor
e,Range Int
a Int
_ Int
b) | Int
a forall a. Ord a => a -> a -> Bool
> Int
b = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e,Int -> Extractor
Take Int
0)

Matrix t
m ?? (Take Int
n,Extractor
e)
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0      = (Int
0forall a. Storable a => Int -> Int -> [a] -> Matrix a
><forall t. Matrix t -> Int
cols Matrix t
m) [] forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
All,Extractor
e)
    | Int
n forall a. Ord a => a -> a -> Bool
>= forall t. Matrix t -> Int
rows Matrix t
m =              Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
All,Extractor
e)

Matrix t
m ?? (Extractor
e,Take Int
n)
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0      = (forall t. Matrix t -> Int
rows Matrix t
mforall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
0) [] forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e,Extractor
All)
    | Int
n forall a. Ord a => a -> a -> Bool
>= forall t. Matrix t -> Int
cols Matrix t
m =              Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e,Extractor
All)

Matrix t
m ?? (Drop Int
n,Extractor
e)
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0      =              Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
All,Extractor
e)
    | Int
n forall a. Ord a => a -> a -> Bool
>= forall t. Matrix t -> Int
rows Matrix t
m = (Int
0forall a. Storable a => Int -> Int -> [a] -> Matrix a
><forall t. Matrix t -> Int
cols Matrix t
m) [] forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
All,Extractor
e)

Matrix t
m ?? (Extractor
e,Drop Int
n)
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0      =              Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e,Extractor
All)
    | Int
n forall a. Ord a => a -> a -> Bool
>= forall t. Matrix t -> Int
cols Matrix t
m = (forall t. Matrix t -> Int
rows Matrix t
mforall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
0) [] forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e,Extractor
All)

Matrix t
m ?? (TakeLast Int
n, Extractor
e) = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Int -> Extractor
Drop (forall t. Matrix t -> Int
rows Matrix t
m forall a. Num a => a -> a -> a
- Int
n), Extractor
e)
Matrix t
m ?? (Extractor
e, TakeLast Int
n) = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e, Int -> Extractor
Drop (forall t. Matrix t -> Int
cols Matrix t
m forall a. Num a => a -> a -> a
- Int
n))

Matrix t
m ?? (DropLast Int
n, Extractor
e) = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Int -> Extractor
Take (forall t. Matrix t -> Int
rows Matrix t
m forall a. Num a => a -> a -> a
- Int
n), Extractor
e)
Matrix t
m ?? (Extractor
e, DropLast Int
n) = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e, Int -> Extractor
Take (forall t. Matrix t -> Int
cols Matrix t
m forall a. Num a => a -> a -> a
- Int
n))

Matrix t
m ?? (Extractor
er,Extractor
ec) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a.
Element a =>
MatrixOrder
-> Matrix a -> I -> Vector I -> I -> Vector I -> IO (Matrix a)
extractR (forall t. Matrix t -> MatrixOrder
orderOf Matrix t
m) Matrix t
m I
moder Vector I
rs I
modec Vector I
cs
  where
    (I
moder,Vector I
rs) = forall {a}. Num a => Int -> Extractor -> (a, Vector I)
mkExt (forall t. Matrix t -> Int
rows Matrix t
m) Extractor
er
    (I
modec,Vector I
cs) = forall {a}. Num a => Int -> Extractor -> (a, Vector I)
mkExt (forall t. Matrix t -> Int
cols Matrix t
m) Extractor
ec
    ran :: Int -> Int -> (a, Vector I)
ran Int
a Int
b = (a
0, [Int] -> Vector I
idxs [Int
a,Int
b])
    pos :: b -> (a, b)
pos b
ks  = (a
1, b
ks)
    mkExt :: Int -> Extractor -> (a, Vector I)
mkExt Int
_ (Pos  Vector I
ks)     = forall {a} {b}. Num a => b -> (a, b)
pos Vector I
ks
    mkExt Int
n (PosCyc Vector I
ks)
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
0          = Int -> Extractor -> (a, Vector I)
mkExt Int
n (Int -> Extractor
Take Int
0)
        | Bool
otherwise       = forall {a} {b}. Num a => b -> (a, b)
pos (I -> Vector I -> Vector I
cmodi (Int -> I
fi Int
n) Vector I
ks)
    mkExt Int
_ (Range Int
mn Int
_ Int
mx) = forall {a}. Num a => Int -> Int -> (a, Vector I)
ran Int
mn Int
mx
    mkExt Int
_ (Take Int
k)      = forall {a}. Num a => Int -> Int -> (a, Vector I)
ran Int
0 (Int
kforall a. Num a => a -> a -> a
-Int
1)
    mkExt Int
n (Drop Int
k)      = forall {a}. Num a => Int -> Int -> (a, Vector I)
ran Int
k (Int
nforall a. Num a => a -> a -> a
-Int
1)
    mkExt Int
n Extractor
_             = forall {a}. Num a => Int -> Int -> (a, Vector I)
ran Int
0 (Int
nforall a. Num a => a -> a -> a
-Int
1) -- All

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

-- | obtains the common value of a property of a list
common :: (Eq a) => (b->a) -> [b] -> Maybe a
common :: forall a b. Eq a => (b -> a) -> [b] -> Maybe a
common b -> a
f = forall a. Eq a => [a] -> Maybe a
commonval forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map b -> a
f
  where
    commonval :: (Eq a) => [a] -> Maybe a
    commonval :: forall a. Eq a => [a] -> Maybe a
commonval [] = forall a. Maybe a
Nothing
    commonval [a
a] = forall a. a -> Maybe a
Just a
a
    commonval (a
a:a
b:[a]
xs) = if a
aforall a. Eq a => a -> a -> Bool
==a
b then forall a. Eq a => [a] -> Maybe a
commonval (a
bforall a. a -> [a] -> [a]
:[a]
xs) else forall a. Maybe a
Nothing


-- | creates a matrix from a vertical list of matrices
joinVert :: Element t => [Matrix t] -> Matrix t
joinVert :: forall t. Element t => [Matrix t] -> Matrix t
joinVert [] = forall t. Storable t => Int -> Int -> Matrix t
emptyM Int
0 Int
0
joinVert [Matrix t]
ms = case forall a b. Eq a => (b -> a) -> [b] -> Maybe a
common forall t. Matrix t -> Int
cols [Matrix t]
ms of
    Maybe Int
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"(impossible) joinVert on matrices with different number of columns"
    Just Int
c  -> forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall t. Matrix t -> Int
rows [Matrix t]
ms)) Int
c forall a b. (a -> b) -> a -> b
$ forall t. Storable t => [Vector t] -> Vector t
vjoin (forall a b. (a -> b) -> [a] -> [b]
map forall t. Element t => Matrix t -> Vector t
flatten [Matrix t]
ms)

-- | creates a matrix from a horizontal list of matrices
joinHoriz :: Element t => [Matrix t] -> Matrix t
joinHoriz :: forall t. Element t => [Matrix t] -> Matrix t
joinHoriz [Matrix t]
ms = forall t. Matrix t -> Matrix t
transforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => [Matrix t] -> Matrix t
joinVert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall t. Matrix t -> Matrix t
trans forall a b. (a -> b) -> a -> b
$ [Matrix t]
ms

{- | Create a matrix from blocks given as a list of lists of matrices.

Single row-column components are automatically expanded to match the
corresponding common row and column:

@
disp = putStr . dispf 2
@

>>> disp $ fromBlocks [[ident 5, 7, row[10,20]], [3, diagl[1,2,3], 0]]
8x10
1  0  0  0  0  7  7  7  10  20
0  1  0  0  0  7  7  7  10  20
0  0  1  0  0  7  7  7  10  20
0  0  0  1  0  7  7  7  10  20
0  0  0  0  1  7  7  7  10  20
3  3  3  3  3  1  0  0   0   0
3  3  3  3  3  0  2  0   0   0
3  3  3  3  3  0  0  3   0   0

-}
fromBlocks :: Element t => [[Matrix t]] -> Matrix t
fromBlocks :: forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocks = forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocksRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => [[Matrix t]] -> [[Matrix t]]
adaptBlocks

fromBlocksRaw :: Element t => [[Matrix t]] -> Matrix t
fromBlocksRaw :: forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocksRaw [[Matrix t]]
mms = forall t. Element t => [Matrix t] -> Matrix t
joinVert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall t. Element t => [Matrix t] -> Matrix t
joinHoriz forall a b. (a -> b) -> a -> b
$ [[Matrix t]]
mms

adaptBlocks :: Element t => [[Matrix t]] -> [[Matrix t]]
adaptBlocks :: forall t. Element t => [[Matrix t]] -> [[Matrix t]]
adaptBlocks [[Matrix t]]
ms = [[Matrix t]]
ms' where
    bc :: Int
bc = case forall a b. Eq a => (b -> a) -> [b] -> Maybe a
common forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Matrix t]]
ms of
          Just Int
c -> Int
c
          Maybe Int
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"fromBlocks requires rectangular [[Matrix]]"
    rs :: [Maybe Int]
rs = forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Maybe Int
compatdim forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall t. Matrix t -> Int
rows) [[Matrix t]]
ms
    cs :: [Maybe Int]
cs = forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Maybe Int
compatdim forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall t. Matrix t -> Int
cols) (forall a. [[a]] -> [[a]]
transpose [[Matrix t]]
ms)
    szs :: [[Maybe Int]]
szs = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [[Maybe Int]
rs,[Maybe Int]
cs]
    ms' :: [[Matrix t]]
ms' = forall e. Int -> [e] -> [[e]]
chunksOf Int
bc forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t}. Element t => [Maybe Int] -> Matrix t -> Matrix t
g [[Maybe Int]]
szs (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Matrix t]]
ms)

    g :: [Maybe Int] -> Matrix t -> Matrix t
g [Just Int
nr,Just Int
nc] Matrix t
m
                | Int
nr forall a. Eq a => a -> a -> Bool
== Int
r Bool -> Bool -> Bool
&& Int
nc forall a. Eq a => a -> a -> Bool
== Int
c = Matrix t
m
                | Int
r forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
c forall a. Eq a => a -> a -> Bool
== Int
1 = forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
nr Int
nc (forall a. Element a => a -> Int -> Vector a
constantD t
x (Int
nrforall a. Num a => a -> a -> a
*Int
nc))
                | Int
r forall a. Eq a => a -> a -> Bool
== Int
1 = forall t. Element t => [Vector t] -> Matrix t
fromRows (forall a. Int -> a -> [a]
replicate Int
nr (forall t. Element t => Matrix t -> Vector t
flatten Matrix t
m))
                | Bool
otherwise = forall t. Element t => [Vector t] -> Matrix t
fromColumns (forall a. Int -> a -> [a]
replicate Int
nc (forall t. Element t => Matrix t -> Vector t
flatten Matrix t
m))
      where
        r :: Int
r = forall t. Matrix t -> Int
rows Matrix t
m
        c :: Int
c = forall t. Matrix t -> Int
cols Matrix t
m
        x :: t
x = Matrix t
mforall t. Storable t => Matrix t -> (Int, Int) -> t
@@>(Int
0,Int
0)
    g [Maybe Int]
_ Matrix t
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"inconsistent dimensions in fromBlocks"


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

{- | create a block diagonal matrix

>>>  disp 2 $ diagBlock [konst 1 (2,2), konst 2 (3,5), col [5,7]]
7x8
1  1  0  0  0  0  0  0
1  1  0  0  0  0  0  0
0  0  2  2  2  2  2  0
0  0  2  2  2  2  2  0
0  0  2  2  2  2  2  0
0  0  0  0  0  0  0  5
0  0  0  0  0  0  0  7

>>> diagBlock [(0><4)[], konst 2 (2,3)]  :: Matrix Double
(2><7)
 [ 0.0, 0.0, 0.0, 0.0, 2.0, 2.0, 2.0
 , 0.0, 0.0, 0.0, 0.0, 2.0, 2.0, 2.0 ]

-}
diagBlock :: (Element t, Num t) => [Matrix t] -> Matrix t
diagBlock :: forall t. (Element t, Num t) => [Matrix t] -> Matrix t
diagBlock [Matrix t]
ms = forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocks forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Matrix t -> Int -> [Matrix t]
f [Matrix t]
ms [Int
0..]
  where
    f :: Matrix t -> Int -> [Matrix t]
f Matrix t
m Int
k = forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
k Matrix t
z forall a. [a] -> [a] -> [a]
++ Matrix t
m forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Matrix t
z
    n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Matrix t]
ms
    z :: Matrix t
z = (Int
1forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
1) [t
0]

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


-- | Reverse rows
flipud :: Element t => Matrix t -> Matrix t
flipud :: forall t. Element t => Matrix t -> Matrix t
flipud Matrix t
m = forall t. Element t => [Int] -> Matrix t -> Matrix t
extractRows [Int
rforall a. Num a => a -> a -> a
-Int
1,Int
rforall a. Num a => a -> a -> a
-Int
2 .. Int
0] forall a b. (a -> b) -> a -> b
$ Matrix t
m
  where
    r :: Int
r = forall t. Matrix t -> Int
rows Matrix t
m

-- | Reverse columns
fliprl :: Element t => Matrix t -> Matrix t
fliprl :: forall t. Element t => Matrix t -> Matrix t
fliprl Matrix t
m = forall t. Element t => [Int] -> Matrix t -> Matrix t
extractColumns [Int
cforall a. Num a => a -> a -> a
-Int
1,Int
cforall a. Num a => a -> a -> a
-Int
2 .. Int
0] forall a b. (a -> b) -> a -> b
$ Matrix t
m
  where
    c :: Int
c = forall t. Matrix t -> Int
cols Matrix t
m

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

{- | creates a rectangular diagonal matrix:

>>> diagRect 7 (fromList [10,20,30]) 4 5 :: Matrix Double
(4><5)
 [ 10.0,  7.0,  7.0, 7.0, 7.0
 ,  7.0, 20.0,  7.0, 7.0, 7.0
 ,  7.0,  7.0, 30.0, 7.0, 7.0
 ,  7.0,  7.0,  7.0, 7.0, 7.0 ]

-}
diagRect :: (Storable t) => t -> Vector t -> Int -> Int -> Matrix t
diagRect :: forall t. Storable t => t -> Vector t -> Int -> Int -> Matrix t
diagRect t
z Vector t
v Int
r Int
c = forall t. Storable t => (forall s. ST s (STMatrix s t)) -> Matrix t
ST.runSTMatrix forall a b. (a -> b) -> a -> b
$ do
        STMatrix s t
m <- forall t s. Storable t => t -> Int -> Int -> ST s (STMatrix s t)
ST.newMatrix t
z Int
r Int
c
        let d :: Int
d = forall a. Ord a => a -> a -> a
min Int
r Int
c forall a. Ord a => a -> a -> a
`min` (forall t. Storable t => Vector t -> Int
dim Vector t
v)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
k -> forall t s.
Storable t =>
STMatrix s t -> Int -> Int -> t -> ST s ()
ST.writeMatrix STMatrix s t
m Int
k Int
k (Vector t
vforall t. Storable t => Vector t -> Int -> t
@>Int
k)) [Int
0..Int
dforall a. Num a => a -> a -> a
-Int
1]
        forall (m :: * -> *) a. Monad m => a -> m a
return STMatrix s t
m

-- | extracts the diagonal from a rectangular matrix
takeDiag :: (Element t) => Matrix t -> Vector t
takeDiag :: forall t. Element t => Matrix t -> Vector t
takeDiag Matrix t
m = forall a. Storable a => [a] -> Vector a
fromList [forall t. Element t => Matrix t -> Vector t
flatten Matrix t
m forall t. Storable t => Vector t -> Int -> t
@> (Int
kforall a. Num a => a -> a -> a
*forall t. Matrix t -> Int
cols Matrix t
mforall a. Num a => a -> a -> a
+Int
k) | Int
k <- [Int
0 .. forall a. Ord a => a -> a -> a
min (forall t. Matrix t -> Int
rows Matrix t
m) (forall t. Matrix t -> Int
cols Matrix t
m) forall a. Num a => a -> a -> a
-Int
1]]

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

{- | Create a matrix from a list of elements

>>> (2><3) [2, 4, 7+2*iC,   -3, 11, 0]
(2><3)
 [       2.0 :+ 0.0,  4.0 :+ 0.0, 7.0 :+ 2.0
 , (-3.0) :+ (-0.0), 11.0 :+ 0.0, 0.0 :+ 0.0 ]

The input list is explicitly truncated, so that it can
safely be used with lists that are too long (like infinite lists).

>>> (2><3)[1..]
(2><3)
 [ 1.0, 2.0, 3.0
 , 4.0, 5.0, 6.0 ]

This is the format produced by the instances of Show (Matrix a), which
can also be used for input.

-}
(><) :: (Storable a) => Int -> Int -> [a] -> Matrix a
Int
r >< :: forall a. Storable a => Int -> Int -> [a] -> Matrix a
>< Int
c = [a] -> Matrix a
f where
    f :: [a] -> Matrix a
f [a]
l | forall t. Storable t => Vector t -> Int
dim Vector a
v forall a. Eq a => a -> a -> Bool
== Int
rforall a. Num a => a -> a -> a
*Int
c = forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
r Int
c Vector a
v
        | Bool
otherwise    = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"inconsistent list size = "
                                 forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall t. Storable t => Vector t -> Int
dim Vector a
v) forall a. [a] -> [a] -> [a]
++[Char]
" in ("forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Int
rforall a. [a] -> [a] -> [a]
++[Char]
"><"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Int
cforall a. [a] -> [a] -> [a]
++[Char]
")"
        where v :: Vector a
v = forall a. Storable a => [a] -> Vector a
fromList forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (Int
rforall a. Num a => a -> a -> a
*Int
c) [a]
l

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

takeRows :: Element t => Int -> Matrix t -> Matrix t
takeRows :: forall t. Element t => Int -> Matrix t -> Matrix t
takeRows Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (Int
n, forall t. Matrix t -> Int
cols Matrix t
mt) Matrix t
mt

-- | Creates a matrix with the last n rows of another matrix
takeLastRows :: Element t => Int -> Matrix t -> Matrix t
takeLastRows :: forall t. Element t => Int -> Matrix t -> Matrix t
takeLastRows Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (forall t. Matrix t -> Int
rows Matrix t
mt forall a. Num a => a -> a -> a
- Int
n, Int
0) (Int
n, forall t. Matrix t -> Int
cols Matrix t
mt) Matrix t
mt

dropRows :: Element t => Int -> Matrix t -> Matrix t
dropRows :: forall t. Element t => Int -> Matrix t -> Matrix t
dropRows Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
n,Int
0) (forall t. Matrix t -> Int
rows Matrix t
mt forall a. Num a => a -> a -> a
- Int
n, forall t. Matrix t -> Int
cols Matrix t
mt) Matrix t
mt

-- | Creates a copy of a matrix without the last n rows
dropLastRows :: Element t => Int -> Matrix t -> Matrix t
dropLastRows :: forall t. Element t => Int -> Matrix t -> Matrix t
dropLastRows Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (forall t. Matrix t -> Int
rows Matrix t
mt forall a. Num a => a -> a -> a
- Int
n, forall t. Matrix t -> Int
cols Matrix t
mt) Matrix t
mt

takeColumns :: Element t => Int -> Matrix t -> Matrix t
takeColumns :: forall t. Element t => Int -> Matrix t -> Matrix t
takeColumns Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (forall t. Matrix t -> Int
rows Matrix t
mt, Int
n) Matrix t
mt

-- |Creates a matrix with the last n columns of another matrix
takeLastColumns :: Element t => Int -> Matrix t -> Matrix t
takeLastColumns :: forall t. Element t => Int -> Matrix t -> Matrix t
takeLastColumns Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0, forall t. Matrix t -> Int
cols Matrix t
mt forall a. Num a => a -> a -> a
- Int
n) (forall t. Matrix t -> Int
rows Matrix t
mt, Int
n) Matrix t
mt

dropColumns :: Element t => Int -> Matrix t -> Matrix t
dropColumns :: forall t. Element t => Int -> Matrix t -> Matrix t
dropColumns Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
n) (forall t. Matrix t -> Int
rows Matrix t
mt, forall t. Matrix t -> Int
cols Matrix t
mt forall a. Num a => a -> a -> a
- Int
n) Matrix t
mt

-- | Creates a copy of a matrix without the last n columns
dropLastColumns :: Element t => Int -> Matrix t -> Matrix t
dropLastColumns :: forall t. Element t => Int -> Matrix t -> Matrix t
dropLastColumns Int
n Matrix t
mt = forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (forall t. Matrix t -> Int
rows Matrix t
mt, forall t. Matrix t -> Int
cols Matrix t
mt forall a. Num a => a -> a -> a
- Int
n) Matrix t
mt

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

{- | Creates a 'Matrix' from a list of lists (considered as rows).

>>> fromLists [[1,2],[3,4],[5,6]]
(3><2)
 [ 1.0, 2.0
 , 3.0, 4.0
 , 5.0, 6.0 ]

-}
fromLists :: Element t => [[t]] -> Matrix t
fromLists :: forall t. Element t => [[t]] -> Matrix t
fromLists = forall t. Element t => [Vector t] -> Matrix t
fromRows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Storable a => [a] -> Vector a
fromList

-- | creates a 1-row matrix from a vector
--
-- >>> asRow (fromList [1..5])
--  (1><5)
--   [ 1.0, 2.0, 3.0, 4.0, 5.0 ]
--
asRow :: Storable a => Vector a -> Matrix a
asRow :: forall a. Storable a => Vector a -> Matrix a
asRow = forall t. Matrix t -> Matrix t
trans forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Vector a -> Matrix a
asColumn

-- | creates a 1-column matrix from a vector
--
-- >>> asColumn (fromList [1..5])
-- (5><1)
--  [ 1.0
--  , 2.0
--  , 3.0
--  , 4.0
--  , 5.0 ]
--
asColumn :: Storable a => Vector a -> Matrix a
asColumn :: forall a. Storable a => Vector a -> Matrix a
asColumn Vector a
v = forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
1 Vector a
v



{- | creates a Matrix of the specified size using the supplied function to
     to map the row\/column position to the value at that row\/column position.

@> buildMatrix 3 4 (\\(r,c) -> fromIntegral r * fromIntegral c)
(3><4)
 [ 0.0, 0.0, 0.0, 0.0, 0.0
 , 0.0, 1.0, 2.0, 3.0, 4.0
 , 0.0, 2.0, 4.0, 6.0, 8.0]@

Hilbert matrix of order N:

@hilb n = buildMatrix n n (\\(i,j)->1/(fromIntegral i + fromIntegral j +1))@

-}
buildMatrix :: Element a => Int -> Int -> ((Int, Int) -> a) -> Matrix a
buildMatrix :: forall a. Element a => Int -> Int -> ((Int, Int) -> a) -> Matrix a
buildMatrix Int
rc Int
cc (Int, Int) -> a
f =
    forall t. Element t => [[t]] -> Matrix t
fromLists forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> a
f)
        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ Int
ri -> forall a b. (a -> b) -> [a] -> [b]
map (\ Int
ci -> (Int
ri, Int
ci)) [Int
0 .. (Int
cc forall a. Num a => a -> a -> a
- Int
1)]) [Int
0 .. (Int
rc forall a. Num a => a -> a -> a
- Int
1)]

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

fromArray2D :: (Storable e) => Array (Int, Int) e -> Matrix e
fromArray2D :: forall e. Storable e => Array (Int, Int) e -> Matrix e
fromArray2D Array (Int, Int) e
m = (Int
rforall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
c) (forall i e. Array i e -> [e]
elems Array (Int, Int) e
m)
    where ((Int
r0,Int
c0),(Int
r1,Int
c1)) = forall i e. Array i e -> (i, i)
bounds Array (Int, Int) e
m
          r :: Int
r = Int
r1forall a. Num a => a -> a -> a
-Int
r0forall a. Num a => a -> a -> a
+Int
1
          c :: Int
c = Int
c1forall a. Num a => a -> a -> a
-Int
c0forall a. Num a => a -> a -> a
+Int
1


-- | rearranges the rows of a matrix according to the order given in a list of integers.
extractRows :: Element t => [Int] -> Matrix t -> Matrix t
extractRows :: forall t. Element t => [Int] -> Matrix t -> Matrix t
extractRows [Int]
l Matrix t
m = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Vector I -> Extractor
Pos ([Int] -> Vector I
idxs [Int]
l), Extractor
All)

-- | rearranges the rows of a matrix according to the order given in a list of integers.
extractColumns :: Element t => [Int] -> Matrix t -> Matrix t
extractColumns :: forall t. Element t => [Int] -> Matrix t -> Matrix t
extractColumns [Int]
l Matrix t
m = Matrix t
m forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
All, Vector I -> Extractor
Pos ([Int] -> Vector I
idxs [Int]
l))


{- | creates matrix by repetition of a matrix a given number of rows and columns

>>> repmat (ident 2) 2 3
(4><6)
 [ 1.0, 0.0, 1.0, 0.0, 1.0, 0.0
 , 0.0, 1.0, 0.0, 1.0, 0.0, 1.0
 , 1.0, 0.0, 1.0, 0.0, 1.0, 0.0
 , 0.0, 1.0, 0.0, 1.0, 0.0, 1.0 ]

-}
repmat :: (Element t) => Matrix t -> Int -> Int -> Matrix t
repmat :: forall t. Element t => Matrix t -> Int -> Int -> Matrix t
repmat Matrix t
m Int
r Int
c
    | Int
r forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
c forall a. Eq a => a -> a -> Bool
== Int
0 = forall t. Storable t => Int -> Int -> Matrix t
emptyM (Int
rforall a. Num a => a -> a -> a
*forall t. Matrix t -> Int
rows Matrix t
m) (Int
cforall a. Num a => a -> a -> a
*forall t. Matrix t -> Int
cols Matrix t
m)
    | Bool
otherwise = forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocks forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
r forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
c forall a b. (a -> b) -> a -> b
$ Matrix t
m

-- | A version of 'liftMatrix2' which automatically adapt matrices with a single row or column to match the dimensions of the other matrix.
liftMatrix2Auto :: (Element t, Element a, Element b) => (Vector a -> Vector b -> Vector t) -> Matrix a -> Matrix b -> Matrix t
liftMatrix2Auto :: forall t a b.
(Element t, Element a, Element b) =>
(Vector a -> Vector b -> Vector t)
-> Matrix a -> Matrix b -> Matrix t
liftMatrix2Auto Vector a -> Vector b -> Vector t
f Matrix a
m1 Matrix b
m2
    | forall a b. Matrix a -> Matrix b -> Bool
compat' Matrix a
m1 Matrix b
m2 = forall t t1 t2.
(Storable t, Element t1, Element t2) =>
(Vector t1 -> Vector t2 -> Vector t)
-> Matrix t1 -> Matrix t2 -> Matrix t
lM Vector a -> Vector b -> Vector t
f Matrix a
m1  Matrix b
m2
    | Bool
ok            = forall t t1 t2.
(Storable t, Element t1, Element t2) =>
(Vector t1 -> Vector t2 -> Vector t)
-> Matrix t1 -> Matrix t2 -> Matrix t
lM Vector a -> Vector b -> Vector t
f Matrix a
m1' Matrix b
m2'
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"nonconformable matrices in liftMatrix2Auto: " forall a. [a] -> [a] -> [a]
++ forall t. Matrix t -> [Char]
shSize Matrix a
m1 forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ forall t. Matrix t -> [Char]
shSize Matrix b
m2
  where
    (Int
r1,Int
c1) = forall t. Matrix t -> (Int, Int)
size Matrix a
m1
    (Int
r2,Int
c2) = forall t. Matrix t -> (Int, Int)
size Matrix b
m2
    r :: Int
r = forall a. Ord a => a -> a -> a
max Int
r1 Int
r2
    c :: Int
c = forall a. Ord a => a -> a -> a
max Int
c1 Int
c2
    r0 :: Int
r0 = forall a. Ord a => a -> a -> a
min Int
r1 Int
r2
    c0 :: Int
c0 = forall a. Ord a => a -> a -> a
min Int
c1 Int
c2
    ok :: Bool
ok = Int
r0 forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
r1 forall a. Eq a => a -> a -> Bool
== Int
r2 Bool -> Bool -> Bool
&& Int
c0 forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
c1 forall a. Eq a => a -> a -> Bool
== Int
c2
    m1' :: Matrix a
m1' = forall t. Element t => (Int, Int) -> Matrix t -> Matrix t
conformMTo (Int
r,Int
c) Matrix a
m1
    m2' :: Matrix b
m2' = forall t. Element t => (Int, Int) -> Matrix t -> Matrix t
conformMTo (Int
r,Int
c) Matrix b
m2

-- FIXME do not flatten if equal order
lM :: (Storable t, Element t1, Element t2)
   => (Vector t1 -> Vector t2 -> Vector t)
   -> Matrix t1 -> Matrix t2 -> Matrix t
lM :: forall t t1 t2.
(Storable t, Element t1, Element t2) =>
(Vector t1 -> Vector t2 -> Vector t)
-> Matrix t1 -> Matrix t2 -> Matrix t
lM Vector t1 -> Vector t2 -> Vector t
f Matrix t1
m1 Matrix t2
m2 = forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector
                MatrixOrder
RowMajor
                (forall {p}. (Num p, Ord p) => p -> p -> p
max' (forall t. Matrix t -> Int
rows Matrix t1
m1) (forall t. Matrix t -> Int
rows Matrix t2
m2))
                (forall {p}. (Num p, Ord p) => p -> p -> p
max' (forall t. Matrix t -> Int
cols Matrix t1
m1) (forall t. Matrix t -> Int
cols Matrix t2
m2))
                (Vector t1 -> Vector t2 -> Vector t
f (forall t. Element t => Matrix t -> Vector t
flatten Matrix t1
m1) (forall t. Element t => Matrix t -> Vector t
flatten Matrix t2
m2))
  where
    max' :: p -> p -> p
max' p
1 p
b = p
b
    max' p
a p
1 = p
a
    max' p
a p
b = forall a. Ord a => a -> a -> a
max p
a p
b

compat' :: Matrix a -> Matrix b -> Bool
compat' :: forall a b. Matrix a -> Matrix b -> Bool
compat' Matrix a
m1 Matrix b
m2 = (Int, Int)
s1 forall a. Eq a => a -> a -> Bool
== (Int
1,Int
1) Bool -> Bool -> Bool
|| (Int, Int)
s2 forall a. Eq a => a -> a -> Bool
== (Int
1,Int
1) Bool -> Bool -> Bool
|| (Int, Int)
s1 forall a. Eq a => a -> a -> Bool
== (Int, Int)
s2
  where
    s1 :: (Int, Int)
s1 = forall t. Matrix t -> (Int, Int)
size Matrix a
m1
    s2 :: (Int, Int)
s2 = forall t. Matrix t -> (Int, Int)
size Matrix b
m2

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

toBlockRows :: Element t => [Int] -> Matrix t -> [Matrix t]
toBlockRows :: forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockRows [Int
r] Matrix t
m
    | Int
r forall a. Eq a => a -> a -> Bool
== forall t. Matrix t -> Int
rows Matrix t
m = [Matrix t
m]
toBlockRows [Int]
rs Matrix t
m
    | forall t. Matrix t -> Int
cols Matrix t
m forall a. Ord a => a -> a -> Bool
> Int
0 = forall a b. (a -> b) -> [a] -> [b]
map (forall t. Storable t => Int -> Vector t -> Matrix t
reshape (forall t. Matrix t -> Int
cols Matrix t
m)) (forall t. Storable t => [Int] -> Vector t -> [Vector t]
takesV [Int]
szs (forall t. Element t => Matrix t -> Vector t
flatten Matrix t
m))
    | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Storable a => Int -> Matrix a
g [Int]
rs
  where
    szs :: [Int]
szs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
* forall t. Matrix t -> Int
cols Matrix t
m) [Int]
rs
    g :: Int -> Matrix a
g Int
k = (Int
kforall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
0)[]

toBlockCols :: Element t => [Int] -> Matrix t -> [Matrix t]
toBlockCols :: forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockCols [Int
c] Matrix t
m | Int
c forall a. Eq a => a -> a -> Bool
== forall t. Matrix t -> Int
cols Matrix t
m = [Matrix t
m]
toBlockCols [Int]
cs Matrix t
m = forall a b. (a -> b) -> [a] -> [b]
map forall t. Matrix t -> Matrix t
trans forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockRows [Int]
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Matrix t -> Matrix t
trans forall a b. (a -> b) -> a -> b
$ Matrix t
m

-- | Partition a matrix into blocks with the given numbers of rows and columns.
-- The remaining rows and columns are discarded.
toBlocks :: (Element t) => [Int] -> [Int] -> Matrix t -> [[Matrix t]]
toBlocks :: forall t. Element t => [Int] -> [Int] -> Matrix t -> [[Matrix t]]
toBlocks [Int]
rs [Int]
cs Matrix t
m
    | Bool
ok = forall a b. (a -> b) -> [a] -> [b]
map (forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockCols [Int]
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockRows [Int]
rs forall a b. (a -> b) -> a -> b
$ Matrix t
m
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"toBlocks: bad partition: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show [Int]
rsforall a. [a] -> [a] -> [a]
++[Char]
" "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show [Int]
cs
                          forall a. [a] -> [a] -> [a]
++ [Char]
" "forall a. [a] -> [a] -> [a]
++forall t. Matrix t -> [Char]
shSize Matrix t
m
  where
    ok :: Bool
ok = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
rs forall a. Ord a => a -> a -> Bool
<= forall t. Matrix t -> Int
rows Matrix t
m Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
cs forall a. Ord a => a -> a -> Bool
<= forall t. Matrix t -> Int
cols Matrix t
m Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
>=Int
0) [Int]
rs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
>=Int
0) [Int]
cs

-- | Fully partition a matrix into blocks of the same size. If the dimensions are not
-- a multiple of the given size the last blocks will be smaller.
toBlocksEvery :: (Element t) => Int -> Int -> Matrix t -> [[Matrix t]]
toBlocksEvery :: forall t. Element t => Int -> Int -> Matrix t -> [[Matrix t]]
toBlocksEvery Int
r Int
c Matrix t
m
    | Int
r forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
c forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"toBlocksEvery expects block sizes > 0, given "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Int
rforall a. [a] -> [a] -> [a]
++[Char]
" and "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
c
    | Bool
otherwise = forall t. Element t => [Int] -> [Int] -> Matrix t -> [[Matrix t]]
toBlocks [Int]
rs [Int]
cs Matrix t
m
  where
    (Int
qr,Int
rr) = forall t. Matrix t -> Int
rows Matrix t
m forall a. Integral a => a -> a -> (a, a)
`divMod` Int
r
    (Int
qc,Int
rc) = forall t. Matrix t -> Int
cols Matrix t
m forall a. Integral a => a -> a -> (a, a)
`divMod` Int
c
    rs :: [Int]
rs = forall a. Int -> a -> [a]
replicate Int
qr Int
r forall a. [a] -> [a] -> [a]
++ if Int
rr forall a. Ord a => a -> a -> Bool
> Int
0 then [Int
rr] else []
    cs :: [Int]
cs = forall a. Int -> a -> [a]
replicate Int
qc Int
c forall a. [a] -> [a] -> [a]
++ if Int
rc forall a. Ord a => a -> a -> Bool
> Int
0 then [Int
rc] else []

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

-- Given a column number and a function taking matrix indexes, returns
-- a function which takes vector indexes (that can be used on the
-- flattened matrix).
mk :: Int -> ((Int, Int) -> t) -> (Int -> t)
mk :: forall t. Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> t
g = \Int
k -> (Int, Int) -> t
g (forall a. Integral a => a -> a -> (a, a)
divMod Int
k Int
c)

{- |

>>> mapMatrixWithIndexM_ (\(i,j) v -> printf "m[%d,%d] = %.f\n" i j v :: IO()) ((2><3)[1 :: Double ..])
m[0,0] = 1
m[0,1] = 2
m[0,2] = 3
m[1,0] = 4
m[1,1] = 5
m[1,2] = 6

-}
mapMatrixWithIndexM_
  :: (Element a, Num a, Monad m) =>
      ((Int, Int) -> a -> m ()) -> Matrix a -> m ()
mapMatrixWithIndexM_ :: forall a (m :: * -> *).
(Element a, Num a, Monad m) =>
((Int, Int) -> a -> m ()) -> Matrix a -> m ()
mapMatrixWithIndexM_ (Int, Int) -> a -> m ()
g Matrix a
m = forall a (m :: * -> *).
(Storable a, Monad m) =>
(Int -> a -> m ()) -> Vector a -> m ()
mapVectorWithIndexM_ (forall t. Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> a -> m ()
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => Matrix t -> Vector t
flatten forall a b. (a -> b) -> a -> b
$ Matrix a
m
  where
    c :: Int
c = forall t. Matrix t -> Int
cols Matrix a
m

{- |

>>> mapMatrixWithIndexM (\(i,j) v -> Just $ 100*v + 10*fromIntegral i + fromIntegral j) (ident 3:: Matrix Double)
Just (3><3)
 [ 100.0,   1.0,   2.0
 ,  10.0, 111.0,  12.0
 ,  20.0,  21.0, 122.0 ]

-}
mapMatrixWithIndexM
  :: (Element a, Storable b, Monad m) =>
      ((Int, Int) -> a -> m b) -> Matrix a -> m (Matrix b)
mapMatrixWithIndexM :: forall a b (m :: * -> *).
(Element a, Storable b, Monad m) =>
((Int, Int) -> a -> m b) -> Matrix a -> m (Matrix b)
mapMatrixWithIndexM (Int, Int) -> a -> m b
g Matrix a
m = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (m :: * -> *).
(Storable a, Storable b, Monad m) =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
mapVectorWithIndexM (forall t. Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> a -> m b
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => Matrix t -> Vector t
flatten forall a b. (a -> b) -> a -> b
$ Matrix a
m
    where
      c :: Int
c = forall t. Matrix t -> Int
cols Matrix a
m

{- |

>>> mapMatrixWithIndex (\(i,j) v -> 100*v + 10*fromIntegral i + fromIntegral j) (ident 3:: Matrix Double)
(3><3)
 [ 100.0,   1.0,   2.0
 ,  10.0, 111.0,  12.0
 ,  20.0,  21.0, 122.0 ]

 -}
mapMatrixWithIndex
  :: (Element a, Storable b) =>
      ((Int, Int) -> a -> b) -> Matrix a -> Matrix b
mapMatrixWithIndex :: forall a b.
(Element a, Storable b) =>
((Int, Int) -> a -> b) -> Matrix a -> Matrix b
mapMatrixWithIndex (Int, Int) -> a -> b
g Matrix a
m = forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Storable a, Storable b) =>
(Int -> a -> b) -> Vector a -> Vector b
mapVectorWithIndex (forall t. Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> a -> b
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Element t => Matrix t -> Vector t
flatten forall a b. (a -> b) -> a -> b
$ Matrix a
m
    where
      c :: Int
c = forall t. Matrix t -> Int
cols Matrix a
m

mapMatrix :: (Element a, Element b) => (a -> b) -> Matrix a -> Matrix b
mapMatrix :: forall a b.
(Element a, Element b) =>
(a -> b) -> Matrix a -> Matrix b
mapMatrix a -> b
f = forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix (forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
mapVector a -> b
f)