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

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

-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Matrix
-- Copyright   :  (c) Alberto Ruiz 2014
-- License     :  BSD3
--
-- Maintainer  :  Alberto Ruiz
-- Stability   :  provisional
--
-- Provides instances of standard classes 'Show', 'Read', 'Eq',
-- 'Num', 'Fractional', and 'Floating' for 'Matrix'.
--
-- In arithmetic operations one-component
-- vectors and matrices automatically expand to match the dimensions of the other operand.

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

module Numeric.Matrix (
                      ) where

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

import Internal.Vector
import Internal.Matrix
import Internal.Element
import Internal.Numeric
import qualified Data.Monoid as M
import Data.List(partition)
import qualified Data.Foldable as F
import qualified Data.Semigroup as S
import Internal.Chain
import Foreign.Storable(Storable)


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

instance Container Matrix a => Eq (Matrix a) where
    == :: Matrix a -> Matrix a -> Bool
(==) = Matrix a -> Matrix a -> Bool
forall (c :: * -> *) e. Container c e => c e -> c e -> Bool
equal

instance (Container Matrix a, Num a, Num (Vector a)) => Num (Matrix a) where
    + :: Matrix a -> Matrix a -> Matrix a
(+) = (Vector a -> Vector a -> Vector a)
-> Matrix a -> Matrix a -> Matrix a
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 a -> Vector a
forall a. Num a => a -> a -> a
(+)
    (-) = (Vector a -> Vector a -> Vector a)
-> Matrix a -> Matrix a -> Matrix a
forall t a b.
(Element t, Element a, Element b) =>
(Vector a -> Vector b -> Vector t)
-> Matrix a -> Matrix b -> Matrix t
liftMatrix2Auto (-)
    negate :: Matrix a -> Matrix a
negate = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Num a => a -> a
negate
    * :: Matrix a -> Matrix a -> Matrix a
(*) = (Vector a -> Vector a -> Vector a)
-> Matrix a -> Matrix a -> Matrix a
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 a -> Vector a
forall a. Num a => a -> a -> a
(*)
    signum :: Matrix a -> Matrix a
signum = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Num a => a -> a
signum
    abs :: Matrix a -> Matrix a
abs = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Num a => a -> a
abs
    fromInteger :: Integer -> Matrix a
fromInteger = (Int
1Int -> Int -> [a] -> Matrix a
forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
1) ([a] -> Matrix a) -> (Integer -> [a]) -> Integer -> Matrix a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [a]) -> (Integer -> a) -> Integer -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger

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

instance (Container Vector a, Fractional a, Fractional (Vector a), Num (Matrix a)) => Fractional (Matrix a) where
    fromRational :: Rational -> Matrix a
fromRational Rational
n = (Int
1Int -> Int -> [a] -> Matrix a
forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
1) [Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
n]
    / :: Matrix a -> Matrix a -> Matrix a
(/) = (Vector a -> Vector a -> Vector a)
-> Matrix a -> Matrix a -> Matrix a
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 a -> Vector a
forall a. Fractional a => a -> a -> a
(/)

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

instance (Floating a, Container Vector a, Floating (Vector a), Fractional (Matrix a)) => Floating (Matrix a) where
    sin :: Matrix a -> Matrix a
sin   = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
sin
    cos :: Matrix a -> Matrix a
cos   = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
cos
    tan :: Matrix a -> Matrix a
tan   = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
tan
    asin :: Matrix a -> Matrix a
asin  = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
asin
    acos :: Matrix a -> Matrix a
acos  = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
acos
    atan :: Matrix a -> Matrix a
atan  = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
atan
    sinh :: Matrix a -> Matrix a
sinh  = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
sinh
    cosh :: Matrix a -> Matrix a
cosh  = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
cosh
    tanh :: Matrix a -> Matrix a
tanh  = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
tanh
    asinh :: Matrix a -> Matrix a
asinh = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
asinh
    acosh :: Matrix a -> Matrix a
acosh = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
acosh
    atanh :: Matrix a -> Matrix a
atanh = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
atanh
    exp :: Matrix a -> Matrix a
exp   = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
exp
    log :: Matrix a -> Matrix a
log   = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
log
    ** :: Matrix a -> Matrix a -> Matrix a
(**)  = (Vector a -> Vector a -> Vector a)
-> Matrix a -> Matrix a -> Matrix a
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 a -> Vector a
forall a. Floating a => a -> a -> a
(**)
    sqrt :: Matrix a -> Matrix a
sqrt  = (Vector a -> Vector a) -> Matrix a -> Matrix a
forall a b.
(Element a, Element b) =>
(Vector a -> Vector b) -> Matrix a -> Matrix b
liftMatrix Vector a -> Vector a
forall a. Floating a => a -> a
sqrt
    pi :: Matrix a
pi    = (Int
1Int -> Int -> [a] -> Matrix a
forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
1) [a
forall a. Floating a => a
pi]

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

isScalar :: Matrix t -> Bool
isScalar :: Matrix t -> Bool
isScalar Matrix t
m = Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

adaptScalarM :: (Foreign.Storable.Storable t1, Foreign.Storable.Storable t2)
             => (t1 -> Matrix t2 -> t)
             -> (Matrix t1 -> Matrix t2 -> t)
             -> (Matrix t1 -> t2 -> t)
             -> Matrix t1
             -> Matrix t2
             -> t
adaptScalarM :: (t1 -> Matrix t2 -> t)
-> (Matrix t1 -> Matrix t2 -> t)
-> (Matrix t1 -> t2 -> t)
-> Matrix t1
-> Matrix t2
-> t
adaptScalarM t1 -> Matrix t2 -> t
f1 Matrix t1 -> Matrix t2 -> t
f2 Matrix t1 -> t2 -> t
f3 Matrix t1
x Matrix t2
y
    | Matrix t1 -> Bool
forall t. Matrix t -> Bool
isScalar Matrix t1
x = t1 -> Matrix t2 -> t
f1   (Matrix t1
x Matrix t1 -> (Int, Int) -> t1
forall t. Storable t => Matrix t -> (Int, Int) -> t
@@>(Int
0,Int
0) ) Matrix t2
y
    | Matrix t2 -> Bool
forall t. Matrix t -> Bool
isScalar Matrix t2
y = Matrix t1 -> t2 -> t
f3 Matrix t1
x (Matrix t2
y Matrix t2 -> (Int, Int) -> t2
forall t. Storable t => Matrix t -> (Int, Int) -> t
@@>(Int
0,Int
0) )
    | Bool
otherwise = Matrix t1 -> Matrix t2 -> t
f2 Matrix t1
x Matrix t2
y

instance (Container Vector t, Eq t, Num (Vector t), Product t) => S.Semigroup (Matrix t)
  where
    <> :: Matrix t -> Matrix t -> Matrix t
(<>) = Matrix t -> Matrix t -> Matrix t
forall a. Monoid a => a -> a -> a
mappend
    sconcat :: NonEmpty (Matrix t) -> Matrix t
sconcat = [Matrix t] -> Matrix t
forall a. Monoid a => [a] -> a
mconcat ([Matrix t] -> Matrix t)
-> (NonEmpty (Matrix t) -> [Matrix t])
-> NonEmpty (Matrix t)
-> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Matrix t) -> [Matrix t]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

instance (Container Vector t, Eq t, Num (Vector t), Product t) => M.Monoid (Matrix t)
  where
    mempty :: Matrix t
mempty = Matrix t
1
    mappend :: Matrix t -> Matrix t -> Matrix t
mappend = (t -> Matrix t -> Matrix t)
-> (Matrix t -> Matrix t -> Matrix t)
-> (Matrix t -> t -> Matrix t)
-> Matrix t
-> Matrix t
-> Matrix t
forall t1 t2 t.
(Storable t1, Storable t2) =>
(t1 -> Matrix t2 -> t)
-> (Matrix t1 -> Matrix t2 -> t)
-> (Matrix t1 -> t2 -> t)
-> Matrix t1
-> Matrix t2
-> t
adaptScalarM t -> Matrix t -> Matrix t
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale Matrix t -> Matrix t -> Matrix t
forall t. Product t => Matrix t -> Matrix t -> Matrix t
mXm ((t -> Matrix t -> Matrix t) -> Matrix t -> t -> Matrix t
forall a b c. (a -> b -> c) -> b -> a -> c
flip t -> Matrix t -> Matrix t
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale)

    mconcat :: [Matrix t] -> Matrix t
mconcat [Matrix t]
xs = ([Matrix t], [Matrix t]) -> Matrix t
forall (t :: * -> *) t.
(Foldable t, Container Vector t, Num (Vector t), Eq t,
 Product t) =>
(t (Matrix t), [Matrix t]) -> Matrix t
work ((Matrix t -> Bool) -> [Matrix t] -> ([Matrix t], [Matrix t])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Matrix t -> Bool
forall t. Matrix t -> Bool
isScalar [Matrix t]
xs)
      where
        work :: (t (Matrix t), [Matrix t]) -> Matrix t
work (t (Matrix t)
ss,[]) = t (Matrix t) -> Matrix t
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product t (Matrix t)
ss
        work (t (Matrix t)
ss,[Matrix t]
ms) = Matrix t -> Matrix t -> Matrix t
forall t (c :: * -> *).
(Storable t, Eq t, Num t, Linear t c) =>
Matrix t -> c t -> c t
scl (t (Matrix t) -> Matrix t
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product t (Matrix t)
ss) ([Matrix t] -> Matrix t
forall t. Product t => [Matrix t] -> Matrix t
optimiseMult [Matrix t]
ms)
        scl :: Matrix t -> c t -> c t
scl Matrix t
x c t
m
            | Matrix t -> Bool
forall t. Matrix t -> Bool
isScalar Matrix t
x Bool -> Bool -> Bool
&& t
x00 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1 = c t
m
            | Bool
otherwise              = t -> c t -> c t
forall t (c :: * -> *). Linear t c => t -> c t -> c t
scale t
x00 c t
m
          where
            x00 :: t
x00 = Matrix t
x Matrix t -> (Int, Int) -> t
forall t. Storable t => Matrix t -> (Int, Int) -> t
@@> (Int
0,Int
0)