{-# 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
            Int -> Put
forall t. Binary t => t -> Put
put (Matrix a -> Int
forall t. Matrix t -> Int
cols Matrix a
m)
            Vector a -> Put
forall t. Binary t => t -> Put
put (Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
flatten Matrix a
m)
    get :: Get (Matrix a)
get = do
          Int
c <- Get Int
forall t. Binary t => Get t
get
          Vector a
v <- Get (Vector a)
forall t. Binary t => Get t
get
          Matrix a -> Get (Matrix a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Vector a -> Matrix a
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 -> String
show Matrix a
m | Matrix a -> Int
forall t. Matrix t -> Int
rows Matrix a
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Matrix a -> Int
forall t. Matrix t -> Int
cols Matrix a
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Matrix a -> String
forall t. Matrix t -> String
sizes Matrix a
m String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" []"
    show Matrix a
m = (Matrix a -> String
forall t. Matrix t -> String
sizes Matrix a
mString -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Matrix a -> String) -> Matrix a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> String
dsp ([[String]] -> String)
-> (Matrix a -> [[String]]) -> Matrix a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [String]) -> [[a]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show) ([[a]] -> [[String]])
-> (Matrix a -> [[a]]) -> Matrix a -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> [[a]]
forall t. Element t => Matrix t -> [[t]]
toLists (Matrix a -> String) -> Matrix a -> String
forall a b. (a -> b) -> a -> b
$ Matrix a
m

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

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

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

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


breakAt :: Eq a => a -> [a] -> ([a], [a])
breakAt :: a -> [a] -> ([a], [a])
breakAt a
c [a]
l = ([a]
a[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a
c],[a] -> [a]
forall a. [a] -> [a]
tail [a]
b) where
    ([a]
a,[a]
b) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
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 -> String
(Int -> Extractor -> ShowS)
-> (Extractor -> String)
-> ([Extractor] -> ShowS)
-> Show Extractor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extractor] -> ShowS
$cshowList :: [Extractor] -> ShowS
show :: Extractor -> String
$cshow :: Extractor -> String
showsPrec :: Int -> Extractor -> ShowS
$cshowsPrec :: Int -> Extractor -> ShowS
Show

ppext :: Extractor -> [Char]
ppext :: Extractor -> String
ppext Extractor
All = String
":"
ppext (Range Int
a Int
1 Int
c) = String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d:%d" Int
a Int
c
ppext (Range Int
a Int
b Int
c) = String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d:%d:%d" Int
a Int
b Int
c
ppext (Pos Vector I
v) = [I] -> String
forall a. Show a => a -> String
show (Vector I -> [I]
forall a. Storable a => Vector a -> [a]
toList Vector I
v)
ppext (PosCyc Vector I
v) = String
"Cyclic"String -> ShowS
forall a. [a] -> [a] -> [a]
++[I] -> String
forall a. Show a => a -> String
show (Vector I -> [I]
forall a. Storable a => Vector a -> [a]
toList Vector I
v)
ppext (Take Int
n) = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Take %d" Int
n
ppext (Drop Int
n) = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"Drop %d" Int
n
ppext (TakeLast Int
n) = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"TakeLast %d" Int
n
ppext (DropLast Int
n) = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"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 :: Matrix t1 -> (Extractor, Extractor) -> t
extractError Matrix t1
m (Extractor
e1,Extractor
e2)= String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"can't extract (%s,%s) from matrix %dx%d" (Extractor -> String
ppext Extractor
e1::String) (Extractor -> String
ppext Extractor
e2::String) (Matrix t1 -> Int
forall t. Matrix t -> Int
rows Matrix t1
m) (Matrix t1 -> Int
forall t. Matrix t -> Int
cols Matrix t1
m)

Matrix t
m ?? :: Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Range Int
a Int
s Int
b,Extractor
e) | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 = Matrix t
m Matrix t -> (Extractor, Extractor) -> Matrix t
forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Vector I -> Extractor
Pos ([Int] -> Vector I
idxs [Int
a,Int
aInt -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 = Matrix t
m Matrix t -> (Extractor, Extractor) -> Matrix t
forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
e, Vector I -> Extractor
Pos ([Int] -> Vector I
idxs [Int
a,Int
aInt -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m = Matrix t -> (Extractor, Extractor) -> Matrix t
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m = Matrix t -> (Extractor, Extractor) -> Matrix t
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
_) | Vector I -> Int
forall t. Storable t => Vector t -> Int
dim Vector I
vsInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& (Vector I -> I
minEl Vector I
vs I -> I -> Bool
forall a. Ord a => a -> a -> Bool
< I
0 Bool -> Bool -> Bool
|| Vector I -> I
maxEl Vector I
vs I -> I -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> I
fi (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m)) = Matrix t -> (Extractor, Extractor) -> Matrix t
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) | Vector I -> Int
forall t. Storable t => Vector t -> Int
dim Vector I
vsInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& (Vector I -> I
minEl Vector I
vs I -> I -> Bool
forall a. Ord a => a -> a -> Bool
< I
0 Bool -> Bool -> Bool
|| Vector I -> I
maxEl Vector I
vs I -> I -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> I
fi (Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m)) = Matrix t -> (Extractor, Extractor) -> Matrix t
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
b = Matrix t
m Matrix t -> (Extractor, Extractor) -> Matrix t
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
b = Matrix t
m Matrix t -> (Extractor, Extractor) -> Matrix t
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0      = (Int
0Int -> Int -> [t] -> Matrix t
forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m) [] Matrix t -> (Extractor, Extractor) -> Matrix t
forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
All,Extractor
e)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m =              Matrix t
m Matrix t -> (Extractor, Extractor) -> Matrix t
forall t.
Element t =>
Matrix t -> (Extractor, Extractor) -> Matrix t
?? (Extractor
All,Extractor
e)

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

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

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

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

Matrix t
m ?? (Extractor
er,Extractor
ec) = 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 -> I -> Vector I -> I -> Vector I -> IO (Matrix t)
forall a.
Element a =>
MatrixOrder
-> Matrix a -> I -> Vector I -> I -> Vector I -> IO (Matrix a)
extractR (Matrix t -> MatrixOrder
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) = Int -> Extractor -> (I, Vector I)
forall a. Num a => Int -> Extractor -> (a, Vector I)
mkExt (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m) Extractor
er
    (I
modec,Vector I
cs) = Int -> Extractor -> (I, Vector I)
forall a. Num a => Int -> Extractor -> (a, Vector I)
mkExt (Matrix t -> Int
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)     = Vector I -> (a, Vector I)
forall a b. Num a => b -> (a, b)
pos Vector I
ks
    mkExt Int
n (PosCyc Vector I
ks)
        | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0          = Int -> Extractor -> (a, Vector I)
mkExt Int
n (Int -> Extractor
Take Int
0)
        | Bool
otherwise       = Vector I -> (a, Vector I)
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) = Int -> Int -> (a, Vector I)
forall a. Num a => Int -> Int -> (a, Vector I)
ran Int
mn Int
mx
    mkExt Int
_ (Take Int
k)      = Int -> Int -> (a, Vector I)
forall a. Num a => Int -> Int -> (a, Vector I)
ran Int
0 (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    mkExt Int
n (Drop Int
k)      = Int -> Int -> (a, Vector I)
forall a. Num a => Int -> Int -> (a, Vector I)
ran Int
k (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    mkExt Int
n Extractor
_             = Int -> Int -> (a, Vector I)
forall a. Num a => Int -> Int -> (a, Vector I)
ran Int
0 (Int
nInt -> Int -> Int
forall 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 :: (b -> a) -> [b] -> Maybe a
common b -> a
f = [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
commonval ([a] -> Maybe a) -> ([b] -> [a]) -> [b] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> [b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map b -> a
f
  where
    commonval :: (Eq a) => [a] -> Maybe a
    commonval :: [a] -> Maybe a
commonval [] = Maybe a
forall a. Maybe a
Nothing
    commonval [a
a] = a -> Maybe a
forall a. a -> Maybe a
Just a
a
    commonval (a
a:a
b:[a]
xs) = if a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b then [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
commonval (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) else Maybe a
forall a. Maybe a
Nothing


-- | creates a matrix from a vertical list of matrices
joinVert :: Element t => [Matrix t] -> Matrix t
joinVert :: [Matrix t] -> Matrix t
joinVert [] = Int -> Int -> Matrix t
forall t. Storable t => Int -> Int -> Matrix t
emptyM Int
0 Int
0
joinVert [Matrix t]
ms = case (Matrix t -> Int) -> [Matrix t] -> Maybe Int
forall a b. Eq a => (b -> a) -> [b] -> Maybe a
common Matrix t -> Int
forall t. Matrix t -> Int
cols [Matrix t]
ms of
    Maybe Int
Nothing -> String -> Matrix t
forall a. HasCallStack => String -> a
error String
"(impossible) joinVert on matrices with different number of columns"
    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] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((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)) Int
c (Vector t -> Matrix t) -> Vector t -> Matrix t
forall a b. (a -> b) -> a -> b
$ [Vector t] -> Vector t
forall t. Storable t => [Vector t] -> Vector t
vjoin ((Matrix t -> Vector t) -> [Matrix t] -> [Vector t]
forall a b. (a -> b) -> [a] -> [b]
map Matrix t -> Vector t
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 :: [Matrix t] -> Matrix t
joinHoriz [Matrix t]
ms = Matrix t -> Matrix t
forall t. Matrix t -> Matrix t
trans(Matrix t -> Matrix t)
-> ([Matrix t] -> Matrix t) -> [Matrix t] -> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Matrix t] -> Matrix t
forall t. Element t => [Matrix t] -> Matrix t
joinVert ([Matrix t] -> Matrix t)
-> ([Matrix t] -> [Matrix t]) -> [Matrix t] -> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix t -> Matrix t) -> [Matrix t] -> [Matrix t]
forall a b. (a -> b) -> [a] -> [b]
map Matrix t -> Matrix t
forall t. Matrix t -> Matrix t
trans ([Matrix t] -> Matrix t) -> [Matrix t] -> Matrix t
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 :: [[Matrix t]] -> Matrix t
fromBlocks = [[Matrix t]] -> Matrix t
forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocksRaw ([[Matrix t]] -> Matrix t)
-> ([[Matrix t]] -> [[Matrix t]]) -> [[Matrix t]] -> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Matrix t]] -> [[Matrix t]]
forall t. Element t => [[Matrix t]] -> [[Matrix t]]
adaptBlocks

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

adaptBlocks :: Element t => [[Matrix t]] -> [[Matrix t]]
adaptBlocks :: [[Matrix t]] -> [[Matrix t]]
adaptBlocks [[Matrix t]]
ms = [[Matrix t]]
ms' where
    bc :: Int
bc = case ([Matrix t] -> Int) -> [[Matrix t]] -> Maybe Int
forall a b. Eq a => (b -> a) -> [b] -> Maybe a
common [Matrix t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Matrix t]]
ms of
          Just Int
c -> Int
c
          Maybe Int
Nothing -> String -> Int
forall a. HasCallStack => String -> a
error String
"fromBlocks requires rectangular [[Matrix]]"
    rs :: [Maybe Int]
rs = ([Matrix t] -> Maybe Int) -> [[Matrix t]] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Maybe Int
compatdim ([Int] -> Maybe Int)
-> ([Matrix t] -> [Int]) -> [Matrix t] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
    cs :: [Maybe Int]
cs = ([Matrix t] -> Maybe Int) -> [[Matrix t]] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Maybe Int
compatdim ([Int] -> Maybe Int)
-> ([Matrix t] -> [Int]) -> [Matrix t] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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]] -> [[Matrix t]]
forall a. [[a]] -> [[a]]
transpose [[Matrix t]]
ms)
    szs :: [[Maybe Int]]
szs = [[Maybe Int]] -> [[Maybe Int]]
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' = Int -> [Matrix t] -> [[Matrix t]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
bc ([Matrix t] -> [[Matrix t]]) -> [Matrix t] -> [[Matrix t]]
forall a b. (a -> b) -> a -> b
$ ([Maybe Int] -> Matrix t -> Matrix t)
-> [[Maybe Int]] -> [Matrix t] -> [Matrix t]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Maybe Int] -> Matrix t -> Matrix t
forall t. Element t => [Maybe Int] -> Matrix t -> Matrix t
g [[Maybe Int]]
szs ([[Matrix t]] -> [Matrix t]
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r Bool -> Bool -> Bool
&& Int
nc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c = Matrix t
m
                | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
nr Int
nc (t -> Int -> Vector t
forall a. Element a => a -> Int -> Vector a
constantD t
x (Int
nrInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nc))
                | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [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
nr (Matrix t -> Vector t
forall t. Element t => Matrix t -> Vector t
flatten Matrix t
m))
                | Bool
otherwise = [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
nc (Matrix t -> Vector t
forall t. Element t => Matrix t -> Vector t
flatten Matrix t
m))
      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
        x :: t
x = Matrix t
mMatrix t -> (Int, Int) -> t
forall t. Storable t => Matrix t -> (Int, Int) -> t
@@>(Int
0,Int
0)
    g [Maybe Int]
_ Matrix t
_ = String -> Matrix t
forall a. HasCallStack => String -> a
error String
"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 :: [Matrix t] -> Matrix t
diagBlock [Matrix t]
ms = [[Matrix t]] -> Matrix t
forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocks ([[Matrix t]] -> Matrix t) -> [[Matrix t]] -> Matrix t
forall a b. (a -> b) -> a -> b
$ (Matrix t -> Int -> [Matrix t])
-> [Matrix t] -> [Int] -> [[Matrix t]]
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 = Int -> [Matrix t] -> [Matrix t]
forall a. Int -> [a] -> [a]
take Int
n ([Matrix t] -> [Matrix t]) -> [Matrix t] -> [Matrix t]
forall a b. (a -> b) -> a -> b
$ Int -> Matrix t -> [Matrix t]
forall a. Int -> a -> [a]
replicate Int
k Matrix t
z [Matrix t] -> [Matrix t] -> [Matrix t]
forall a. [a] -> [a] -> [a]
++ Matrix t
m Matrix t -> [Matrix t] -> [Matrix t]
forall a. a -> [a] -> [a]
: Matrix t -> [Matrix t]
forall a. a -> [a]
repeat Matrix t
z
    n :: Int
n = [Matrix t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Matrix t]
ms
    z :: Matrix t
z = (Int
1Int -> Int -> [t] -> Matrix t
forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
1) [t
0]

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


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

-- | Reverse columns
fliprl :: Element t => Matrix t -> Matrix t
fliprl :: Matrix t -> Matrix t
fliprl Matrix t
m = [Int] -> Matrix t -> Matrix t
forall t. Element t => [Int] -> Matrix t -> Matrix t
extractColumns [Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2 .. Int
0] (Matrix t -> Matrix t) -> Matrix t -> Matrix t
forall a b. (a -> b) -> a -> b
$ Matrix t
m
  where
    c :: Int
c = Matrix t -> Int
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 :: t -> Vector t -> Int -> Int -> Matrix t
diagRect t
z Vector t
v Int
r Int
c = (forall s. ST s (STMatrix s t)) -> Matrix t
forall t. Storable t => (forall s. ST s (STMatrix s t)) -> Matrix t
ST.runSTMatrix ((forall s. ST s (STMatrix s t)) -> Matrix t)
-> (forall s. ST s (STMatrix s t)) -> Matrix t
forall a b. (a -> b) -> a -> b
$ do
        STMatrix s t
m <- t -> Int -> Int -> ST s (STMatrix s t)
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 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
r Int
c Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v)
        (Int -> ST s ()) -> [Int] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
k -> STMatrix s t -> Int -> Int -> t -> ST s ()
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
vVector t -> Int -> t
forall t. Storable t => Vector t -> Int -> t
@>Int
k)) [Int
0..Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
        STMatrix s t -> ST s (STMatrix s t)
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 :: Matrix t -> Vector t
takeDiag Matrix t
m = [t] -> Vector t
forall a. Storable a => [a] -> Vector a
fromList [Matrix t -> Vector t
forall t. Element t => Matrix t -> Vector t
flatten Matrix t
m Vector t -> Int -> t
forall t. Storable t => Vector t -> Int -> t
@> (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
*Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) | Int
k <- [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m) (Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m) Int -> Int -> Int
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 >< :: Int -> Int -> [a] -> Matrix a
>< Int
c = [a] -> Matrix a
f where
    f :: [a] -> Matrix a
f [a]
l | 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
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c = MatrixOrder -> Int -> Int -> Vector a -> Matrix a
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector MatrixOrder
RowMajor Int
r Int
c Vector a
v
        | 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
"inconsistent list size = "
                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (Vector a -> Int
forall t. Storable t => Vector t -> Int
dim Vector a
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" in ("String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
rString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"><"String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
cString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
        where v :: Vector a
v = [a] -> Vector a
forall a. Storable a => [a] -> Vector a
fromList ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c) [a]
l

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

takeRows :: Element t => Int -> Matrix t -> Matrix t
takeRows :: Int -> Matrix t -> Matrix t
takeRows Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (Int
n, Matrix t -> Int
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 :: Int -> Matrix t -> Matrix t
takeLastRows Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n, Int
0) (Int
n, Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mt) Matrix t
mt

dropRows :: Element t => Int -> Matrix t -> Matrix t
dropRows :: Int -> Matrix t -> Matrix t
dropRows Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
n,Int
0) (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n, Matrix t -> Int
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 :: Int -> Matrix t -> Matrix t
dropLastRows Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n, Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mt) Matrix t
mt

takeColumns :: Element t => Int -> Matrix t -> Matrix t
takeColumns :: Int -> Matrix t -> Matrix t
takeColumns Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (Matrix t -> Int
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 :: Int -> Matrix t -> Matrix t
takeLastColumns Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0, Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mt, Int
n) Matrix t
mt

dropColumns :: Element t => Int -> Matrix t -> Matrix t
dropColumns :: Int -> Matrix t -> Matrix t
dropColumns Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
n) (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mt, Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mt Int -> Int -> Int
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 :: Int -> Matrix t -> Matrix t
dropLastColumns Int
n Matrix t
mt = (Int, Int) -> (Int, Int) -> Matrix t -> Matrix t
forall a.
Element a =>
(Int, Int) -> (Int, Int) -> Matrix a -> Matrix a
subMatrix (Int
0,Int
0) (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
mt, Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
mt Int -> Int -> Int
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 :: [[t]] -> Matrix t
fromLists = [Vector t] -> Matrix t
forall t. Element t => [Vector t] -> Matrix t
fromRows ([Vector t] -> Matrix t)
-> ([[t]] -> [Vector t]) -> [[t]] -> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([t] -> Vector t) -> [[t]] -> [Vector t]
forall a b. (a -> b) -> [a] -> [b]
map [t] -> Vector t
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 :: Vector a -> Matrix a
asRow = Matrix a -> Matrix a
forall t. Matrix t -> Matrix t
trans (Matrix a -> Matrix a)
-> (Vector a -> Matrix a) -> Vector a -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Matrix a
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 :: Vector a -> Matrix a
asColumn Vector a
v = Int -> Vector a -> Matrix a
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 :: Int -> Int -> ((Int, Int) -> a) -> Matrix a
buildMatrix Int
rc Int
cc (Int, Int) -> a
f =
    [[a]] -> Matrix a
forall t. Element t => [[t]] -> Matrix t
fromLists ([[a]] -> Matrix a) -> [[a]] -> Matrix a
forall a b. (a -> b) -> a -> b
$ ([(Int, Int)] -> [a]) -> [[(Int, Int)]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Int) -> a) -> [(Int, Int)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> a
f)
        ([[(Int, Int)]] -> [[a]]) -> [[(Int, Int)]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (Int -> [(Int, Int)]) -> [Int] -> [[(Int, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
ri -> (Int -> (Int, Int)) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
ci -> (Int
ri, Int
ci)) [Int
0 .. (Int
cc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]) [Int
0 .. (Int
rc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

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

fromArray2D :: (Storable e) => Array (Int, Int) e -> Matrix e
fromArray2D :: Array (Int, Int) e -> Matrix e
fromArray2D Array (Int, Int) e
m = (Int
rInt -> Int -> [e] -> Matrix e
forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
c) (Array (Int, Int) e -> [e]
forall i e. Array i e -> [e]
elems Array (Int, Int) e
m)
    where ((Int
r0,Int
c0),(Int
r1,Int
c1)) = Array (Int, Int) e -> ((Int, Int), (Int, Int))
forall i e. Array i e -> (i, i)
bounds Array (Int, Int) e
m
          r :: Int
r = Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
          c :: Int
c = Int
c1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c0Int -> Int -> Int
forall 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 :: [Int] -> Matrix t -> Matrix t
extractRows [Int]
l Matrix t
m = Matrix t
m Matrix t -> (Extractor, Extractor) -> Matrix t
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 :: [Int] -> Matrix t -> Matrix t
extractColumns [Int]
l Matrix t
m = Matrix t
m Matrix t -> (Extractor, Extractor) -> Matrix t
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 :: Matrix t -> Int -> Int -> Matrix t
repmat Matrix t
m Int
r Int
c
    | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int -> Matrix t
forall t. Storable t => Int -> Int -> Matrix t
emptyM (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
*Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m) (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
*Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m)
    | Bool
otherwise = [[Matrix t]] -> Matrix t
forall t. Element t => [[Matrix t]] -> Matrix t
fromBlocks ([[Matrix t]] -> Matrix t) -> [[Matrix t]] -> Matrix t
forall a b. (a -> b) -> a -> b
$ Int -> [Matrix t] -> [[Matrix t]]
forall a. Int -> a -> [a]
replicate Int
r ([Matrix t] -> [[Matrix t]]) -> [Matrix t] -> [[Matrix t]]
forall a b. (a -> b) -> a -> b
$ Int -> Matrix t -> [Matrix t]
forall a. Int -> a -> [a]
replicate Int
c (Matrix t -> [Matrix t]) -> Matrix t -> [Matrix t]
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 :: (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
    | Matrix a -> Matrix b -> Bool
forall a b. Matrix a -> Matrix b -> Bool
compat' Matrix a
m1 Matrix b
m2 = (Vector a -> Vector b -> Vector t)
-> Matrix a -> Matrix b -> Matrix t
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            = (Vector a -> Vector b -> Vector t)
-> Matrix a -> Matrix b -> Matrix t
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 = String -> Matrix t
forall a. HasCallStack => String -> a
error (String -> Matrix t) -> String -> Matrix t
forall a b. (a -> b) -> a -> b
$ String
"nonconformable matrices in liftMatrix2Auto: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matrix a -> String
forall t. Matrix t -> String
shSize Matrix a
m1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Matrix b -> String
forall t. Matrix t -> String
shSize Matrix b
m2
  where
    (Int
r1,Int
c1) = Matrix a -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size Matrix a
m1
    (Int
r2,Int
c2) = Matrix b -> (Int, Int)
forall t. Matrix t -> (Int, Int)
size Matrix b
m2
    r :: Int
r = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
r1 Int
r2
    c :: Int
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
c1 Int
c2
    r0 :: Int
r0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
r1 Int
r2
    c0 :: Int
c0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
c1 Int
c2
    ok :: Bool
ok = Int
r0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2 Bool -> Bool -> Bool
&& Int
c0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
c1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c2
    m1' :: Matrix a
m1' = (Int, Int) -> Matrix a -> Matrix a
forall t. Element t => (Int, Int) -> Matrix t -> Matrix t
conformMTo (Int
r,Int
c) Matrix a
m1
    m2' :: Matrix b
m2' = (Int, Int) -> Matrix b -> Matrix b
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 :: (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 = MatrixOrder -> Int -> Int -> Vector t -> Matrix t
forall t.
Storable t =>
MatrixOrder -> Int -> Int -> Vector t -> Matrix t
matrixFromVector
                MatrixOrder
RowMajor
                (Int -> Int -> Int
forall a. (Num a, Ord a) => a -> a -> a
max' (Matrix t1 -> Int
forall t. Matrix t -> Int
rows Matrix t1
m1) (Matrix t2 -> Int
forall t. Matrix t -> Int
rows Matrix t2
m2))
                (Int -> Int -> Int
forall a. (Num a, Ord a) => a -> a -> a
max' (Matrix t1 -> Int
forall t. Matrix t -> Int
cols Matrix t1
m1) (Matrix t2 -> Int
forall t. Matrix t -> Int
cols Matrix t2
m2))
                (Vector t1 -> Vector t2 -> Vector t
f (Matrix t1 -> Vector t1
forall t. Element t => Matrix t -> Vector t
flatten Matrix t1
m1) (Matrix t2 -> Vector t2
forall t. Element t => Matrix t -> Vector t
flatten Matrix t2
m2))
  where
    max' :: a -> a -> a
max' a
1 a
b = a
b
    max' a
a a
1 = a
a
    max' a
a a
b = a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
b

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

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

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

toBlockCols :: Element t => [Int] -> Matrix t -> [Matrix t]
toBlockCols :: [Int] -> Matrix t -> [Matrix t]
toBlockCols [Int
c] Matrix t
m | Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m = [Matrix t
m]
toBlockCols [Int]
cs Matrix t
m = (Matrix t -> Matrix t) -> [Matrix t] -> [Matrix t]
forall a b. (a -> b) -> [a] -> [b]
map Matrix t -> Matrix t
forall t. Matrix t -> Matrix t
trans ([Matrix t] -> [Matrix t])
-> (Matrix t -> [Matrix t]) -> Matrix t -> [Matrix t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Matrix t -> [Matrix t]
forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockRows [Int]
cs (Matrix t -> [Matrix t])
-> (Matrix t -> Matrix t) -> Matrix t -> [Matrix t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix t -> Matrix t
forall t. Matrix t -> Matrix t
trans (Matrix t -> [Matrix t]) -> Matrix t -> [Matrix t]
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 :: [Int] -> [Int] -> Matrix t -> [[Matrix t]]
toBlocks [Int]
rs [Int]
cs Matrix t
m
    | Bool
ok = (Matrix t -> [Matrix t]) -> [Matrix t] -> [[Matrix t]]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Matrix t -> [Matrix t]
forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockCols [Int]
cs) ([Matrix t] -> [[Matrix t]])
-> (Matrix t -> [Matrix t]) -> Matrix t -> [[Matrix t]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Matrix t -> [Matrix t]
forall t. Element t => [Int] -> Matrix t -> [Matrix t]
toBlockRows [Int]
rs (Matrix t -> [[Matrix t]]) -> Matrix t -> [[Matrix t]]
forall a b. (a -> b) -> a -> b
$ 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
"toBlocks: bad partition: "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Int] -> String
forall a. Show a => a -> String
show [Int]
rsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Int] -> String
forall a. Show a => a -> String
show [Int]
cs
                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++Matrix t -> String
forall t. Matrix t -> String
shSize Matrix t
m
  where
    ok :: Bool
ok = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m Bool -> Bool -> Bool
&& [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0) [Int]
rs Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
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 :: Int -> Int -> Matrix t -> [[Matrix t]]
toBlocksEvery Int
r Int
c Matrix t
m
    | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> [[Matrix t]]
forall a. HasCallStack => String -> a
error (String -> [[Matrix t]]) -> String -> [[Matrix t]]
forall a b. (a -> b) -> a -> b
$ String
"toBlocksEvery expects block sizes > 0, given "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
rString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" and "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c
    | Bool
otherwise = [Int] -> [Int] -> Matrix t -> [[Matrix t]]
forall t. Element t => [Int] -> [Int] -> Matrix t -> [[Matrix t]]
toBlocks [Int]
rs [Int]
cs Matrix t
m
  where
    (Int
qr,Int
rr) = Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
r
    (Int
qc,Int
rc) = Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
c
    rs :: [Int]
rs = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
qr Int
r [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ if Int
rr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Int
rr] else []
    cs :: [Int]
cs = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
qc Int
c [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ if Int
rc Int -> Int -> Bool
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 :: Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> t
g = \Int
k -> (Int, Int) -> t
g (Int -> Int -> (Int, Int)
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_ :: ((Int, Int) -> a -> m ()) -> Matrix a -> m ()
mapMatrixWithIndexM_ (Int, Int) -> a -> m ()
g Matrix a
m = (Int -> a -> m ()) -> Vector a -> m ()
forall a (m :: * -> *).
(Storable a, Monad m) =>
(Int -> a -> m ()) -> Vector a -> m ()
mapVectorWithIndexM_ (Int -> ((Int, Int) -> a -> m ()) -> Int -> a -> m ()
forall t. Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> a -> m ()
g) (Vector a -> m ()) -> (Matrix a -> Vector a) -> Matrix a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
flatten (Matrix a -> m ()) -> Matrix a -> m ()
forall a b. (a -> b) -> a -> b
$ Matrix a
m
  where
    c :: Int
c = Matrix a -> Int
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 :: ((Int, Int) -> a -> m b) -> Matrix a -> m (Matrix b)
mapMatrixWithIndexM (Int, Int) -> a -> m b
g Matrix a
m = (Vector b -> Matrix b) -> m (Vector b) -> m (Matrix b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Vector b -> Matrix b
forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
c) (m (Vector b) -> m (Matrix b))
-> (Matrix a -> m (Vector b)) -> Matrix a -> m (Matrix b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> m b) -> Vector a -> m (Vector b)
forall a b (m :: * -> *).
(Storable a, Storable b, Monad m) =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
mapVectorWithIndexM (Int -> ((Int, Int) -> a -> m b) -> Int -> a -> m b
forall t. Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> a -> m b
g) (Vector a -> m (Vector b))
-> (Matrix a -> Vector a) -> Matrix a -> m (Vector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
flatten (Matrix a -> m (Matrix b)) -> Matrix a -> m (Matrix b)
forall a b. (a -> b) -> a -> b
$ Matrix a
m
    where
      c :: Int
c = Matrix a -> Int
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 :: ((Int, Int) -> a -> b) -> Matrix a -> Matrix b
mapMatrixWithIndex (Int, Int) -> a -> b
g Matrix a
m = Int -> Vector b -> Matrix b
forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
c (Vector b -> Matrix b)
-> (Matrix a -> Vector b) -> Matrix a -> Matrix b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Storable a, Storable b) =>
(Int -> a -> b) -> Vector a -> Vector b
mapVectorWithIndex (Int -> ((Int, Int) -> a -> b) -> Int -> a -> b
forall t. Int -> ((Int, Int) -> t) -> Int -> t
mk Int
c (Int, Int) -> a -> b
g) (Vector a -> Vector b)
-> (Matrix a -> Vector a) -> Matrix a -> Vector b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> Vector a
forall t. Element t => Matrix t -> Vector t
flatten (Matrix a -> Matrix b) -> Matrix a -> Matrix b
forall a b. (a -> b) -> a -> b
$ Matrix a
m
    where
      c :: Int
c = Matrix a -> Int
forall t. Matrix t -> Int
cols Matrix a
m

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