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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
-----------------------------------------------------------------------------
{- |
Module : Numeric.LinearAlgebra.Instances
Copyright : (c) Alberto Ruiz 2006
License : GPL-style
Maintainer : Alberto Ruiz (aruiz at um dot es)
Stability : provisional
Portability : portable
This module exports Show, Eq, Num, Fractional, and Floating instances for Vector and Matrix.
In the context of the standard numeric operators, one-component vectors and matrices automatically expand to match the dimensions of the other operand.
-}
-----------------------------------------------------------------------------
module Numeric.LinearAlgebra.Instances(
) where
import Numeric.LinearAlgebra.Linear
import Numeric.GSL.Vector
import Data.Packed.Matrix
import Data.Packed.Vector
import Complex
import Data.List(transpose,intersperse)
import Foreign(Storable)
import Data.Monoid
import Data.Packed.Internal.Vector
------------------------------------------------------------------
instance (Show a, Element a) => (Show (Matrix a)) where
show m = (sizes++) . dsp . map (map show) . toLists $ m
where sizes = "("++show (rows m)++"><"++show (cols m)++")\n"
dsp as = (++" ]") . (" ["++) . init . drop 2 . unlines . map (" , "++) . map unwords' $ transpose mtp
where
mt = transpose as
longs = map (maximum . map length) mt
mtp = zipWith (\a b -> map (pad a) b) longs mt
pad n str = replicate (n - length str) ' ' ++ str
unwords' = concat . intersperse ", "
instance (Show a, Storable a) => (Show (Vector a)) where
show v = (show (dim v))++" |> " ++ show (toList v)
------------------------------------------------------------------
instance (Element a, Read a) => Read (Matrix a) where
readsPrec _ s = [((rows><cols) . read $ listnums, rest)]
where (thing,rest) = breakAt ']' s
(dims,listnums) = breakAt ')' thing
cols = read . init . fst. breakAt ')' . snd . breakAt '<' $ dims
rows = read . snd . breakAt '(' .init . fst . breakAt '>' $ dims
instance (Element a, Read a) => Read (Vector a) where
readsPrec _ s = [((d |>) . read $ listnums, rest)]
where (thing,rest) = breakAt ']' s
(dims,listnums) = breakAt '>' thing
d = read . init . fst . breakAt '|' $ dims
breakAt c l = (a++[c],tail b) where
(a,b) = break (==c) l
------------------------------------------------------------------
adaptScalar f1 f2 f3 x y
| dim x == 1 = f1 (x@>0) y
| dim y == 1 = f3 x (y@>0)
| otherwise = f2 x y
liftMatrix2' :: (Element t, Element a, Element b) => (Vector a -> Vector b -> Vector t) -> Matrix a -> Matrix b -> Matrix t
liftMatrix2' f m1 m2 | compat' m1 m2 = reshape (max (cols m1) (cols m2)) (f (flatten m1) (flatten m2))
| otherwise = error "nonconformant matrices in liftMatrix2'"
compat' :: Matrix a -> Matrix b -> Bool
compat' m1 m2 = rows m1 == 1 && cols m1 == 1
|| rows m2 == 1 && cols m2 == 1
|| rows m1 == rows m2 && cols m1 == cols m2
instance (Eq a, Element a) => Eq (Vector a) where
a == b = dim a == dim b && toList a == toList b
instance (Linear Vector a) => Num (Vector a) where
(+) = adaptScalar addConstant add (flip addConstant)
negate = scale (-1)
(*) = adaptScalar scale mul (flip scale)
signum = liftVector signum
abs = liftVector abs
fromInteger = fromList . return . fromInteger
instance (Eq a, Element a) => Eq (Matrix a) where
a == b = cols a == cols b && flatten a == flatten b
instance (Linear Vector a) => Num (Matrix a) where
(+) = liftMatrix2' (+)
(-) = liftMatrix2' (-)
negate = liftMatrix negate
(*) = liftMatrix2' (*)
signum = liftMatrix signum
abs = liftMatrix abs
fromInteger = (1><1) . return . fromInteger
---------------------------------------------------
instance (Linear Vector a) => Fractional (Vector a) where
fromRational n = fromList [fromRational n]
(/) = adaptScalar f divide g where
r `f` v = scaleRecip r v
v `g` r = scale (recip r) v
-------------------------------------------------------
instance (Linear Vector a, Fractional (Vector a)) => Fractional (Matrix a) where
fromRational n = (1><1) [fromRational n]
(/) = liftMatrix2' (/)
---------------------------------------------------------
instance Floating (Vector Double) where
sin = vectorMapR Sin
cos = vectorMapR Cos
tan = vectorMapR Tan
asin = vectorMapR ASin
acos = vectorMapR ACos
atan = vectorMapR ATan
sinh = vectorMapR Sinh
cosh = vectorMapR Cosh
tanh = vectorMapR Tanh
asinh = vectorMapR ASinh
acosh = vectorMapR ACosh
atanh = vectorMapR ATanh
exp = vectorMapR Exp
log = vectorMapR Log
sqrt = vectorMapR Sqrt
(**) = adaptScalar (vectorMapValR PowSV) (vectorZipR Pow) (flip (vectorMapValR PowVS))
pi = fromList [pi]
-------------------------------------------------------------
instance Floating (Vector (Complex Double)) where
sin = vectorMapC Sin
cos = vectorMapC Cos
tan = vectorMapC Tan
asin = vectorMapC ASin
acos = vectorMapC ACos
atan = vectorMapC ATan
sinh = vectorMapC Sinh
cosh = vectorMapC Cosh
tanh = vectorMapC Tanh
asinh = vectorMapC ASinh
acosh = vectorMapC ACosh
atanh = vectorMapC ATanh
exp = vectorMapC Exp
log = vectorMapC Log
sqrt = vectorMapC Sqrt
(**) = adaptScalar (vectorMapValC PowSV) (vectorZipC Pow) (flip (vectorMapValC PowVS))
pi = fromList [pi]
-----------------------------------------------------------
instance (Linear Vector a, Floating (Vector 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
(**) = liftMatrix2' (**)
sqrt = liftMatrix sqrt
pi = (1><1) [pi]
---------------------------------------------------------------
instance (Storable a) => Monoid (Vector a) where
mempty = V { dim = 0, fptr = undefined }
mappend a b = mconcat [a,b]
mconcat = j . filter ((>0).dim)
where j [] = mempty
j l = join l
|
