summaryrefslogtreecommitdiff
path: root/packages/base/src/Numeric/Matrix.hs
blob: 06da1507537ec6cc19cdf26be660159b609bd27d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- 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


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

instance Container Matrix a => Eq (Matrix a) where
    (==) = equal

instance (Container Matrix a, Num a, Num (Vector a)) => Num (Matrix a) where
    (+) = liftMatrix2Auto (+)
    (-) = liftMatrix2Auto (-)
    negate = liftMatrix negate
    (*) = liftMatrix2Auto (*)
    signum = liftMatrix signum
    abs = liftMatrix abs
    fromInteger = (1><1) . return . fromInteger

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

instance (Container Vector a, Fractional a, Fractional (Vector a), Num (Matrix a)) => Fractional (Matrix a) where
    fromRational n = (1><1) [fromRational n]
    (/) = liftMatrix2Auto (/)

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

instance (Floating a, Container Vector a, Floating (Vector a), Fractional (Matrix a)) => Floating (Matrix a) where
    sin   = liftMatrix sin
    cos   = liftMatrix cos
    tan   = liftMatrix tan
    asin  = liftMatrix asin
    acos  = liftMatrix acos
    atan  = liftMatrix atan
    sinh  = liftMatrix sinh
    cosh  = liftMatrix cosh
    tanh  = liftMatrix tanh
    asinh = liftMatrix asinh
    acosh = liftMatrix acosh
    atanh = liftMatrix atanh
    exp   = liftMatrix exp
    log   = liftMatrix log
    (**)  = liftMatrix2Auto (**)
    sqrt  = liftMatrix sqrt
    pi    = (1><1) [pi]

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

isScalar m = rows m == 1 && cols m == 1

adaptScalarM f1 f2 f3 x y
    | isScalar x = f1   (x @@>(0,0) ) y
    | isScalar y = f3 x (y @@>(0,0) )
    | otherwise = f2 x y

instance (Container Vector t, Eq t, Num (Vector t), Product t) => S.Semigroup (Matrix t)
  where
    (<>) = mappend
    sconcat = mconcat . F.toList

instance (Container Vector t, Eq t, Num (Vector t), Product t) => M.Monoid (Matrix t)
  where
    mempty = 1
    mappend = adaptScalarM scale mXm (flip scale)
    
    mconcat xs = work (partition isScalar xs)
      where
        work (ss,[]) = product ss
        work (ss,ms) = scl (product ss) (optimiseMult ms)
        scl x m
            | isScalar x && x00 == 1 = m
            | otherwise              = scale x00 m
          where
            x00 = x @@> (0,0)