summaryrefslogtreecommitdiff
path: root/lib/GSLHaskell.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/GSLHaskell.hs')
-rw-r--r--lib/GSLHaskell.hs158
1 files changed, 4 insertions, 154 deletions
diff --git a/lib/GSLHaskell.hs b/lib/GSLHaskell.hs
index 3158458..254a957 100644
--- a/lib/GSLHaskell.hs
+++ b/lib/GSLHaskell.hs
@@ -9,7 +9,7 @@ Maintainer : Alberto Ruiz (aruiz at um dot es)
9Stability : provisional 9Stability : provisional
10Portability : uses -fffi and -fglasgow-exts 10Portability : uses -fffi and -fglasgow-exts
11 11
12GSLHaskell interface, with reasonable numeric instances for Vectors and Matrices. In the context of the standard numeric operators, one-component vectors and matrices automatically expand to match the dimensions of the other operand. 12Old GSLHaskell interface.
13 13
14-} 14-}
15----------------------------------------------------------------------------- 15-----------------------------------------------------------------------------
@@ -46,7 +46,6 @@ import GSL.Special(setErrorHandlerOff,
46 bessel_J0_e, 46 bessel_J0_e,
47 exp_e10_e, 47 exp_e10_e,
48 gamma) 48 gamma)
49--import Data.Packed.Internal hiding (dsp,comp)
50import Data.Packed.Vector 49import Data.Packed.Vector
51import Data.Packed.Matrix 50import Data.Packed.Matrix
52import Data.Packed.Matrix hiding ((><)) 51import Data.Packed.Matrix hiding ((><))
@@ -55,163 +54,14 @@ import qualified LinearAlgebra.Algorithms
55import LAPACK 54import LAPACK
56import GSL.Matrix 55import GSL.Matrix
57import LinearAlgebra.Algorithms hiding (pnorm) 56import LinearAlgebra.Algorithms hiding (pnorm)
58import LinearAlgebra.Linear 57import LinearAlgebra.Linear hiding (Mul,(<>))
58import Data.Packed.Internal.Matrix(multiply)
59import Complex 59import Complex
60import Numeric(showGFloat) 60import Numeric(showGFloat)
61import Data.List(transpose,intersperse) 61import Data.List(transpose,intersperse)
62import Foreign(Storable) 62import Foreign(Storable)
63import Data.Array 63import Data.Array
64 64import LinearAlgebra.Instances
65
66adaptScalar f1 f2 f3 x y
67 | dim x == 1 = f1 (x@>0) y
68 | dim y == 1 = f3 x (y@>0)
69 | otherwise = f2 x y
70
71liftMatrix2' :: (Field t, Field a, Field b) => (Vector a -> Vector b -> Vector t) -> Matrix a -> Matrix b -> Matrix t
72liftMatrix2' f m1 m2 | compat' m1 m2 = reshape (max (cols m1) (cols m2)) (f (flatten m1) (flatten m2))
73 | otherwise = error "nonconformant matrices in liftMatrix2'"
74
75compat' :: Matrix a -> Matrix b -> Bool
76compat' m1 m2 = rows m1 == 1 && cols m1 == 1
77 || rows m2 == 1 && cols m2 == 1
78 || rows m1 == rows m2 && cols m1 == cols m2
79
80instance (Eq a, Field a) => Eq (Vector a) where
81 a == b = dim a == dim b && toList a == toList b
82
83instance (Linear Vector a) => Num (Vector a) where
84 (+) = adaptScalar addConstant add (flip addConstant)
85 negate = scale (-1)
86 (*) = adaptScalar scale mul (flip scale)
87 signum = liftVector signum
88 abs = liftVector abs
89 fromInteger = fromList . return . fromInteger
90
91instance (Eq a, Field a) => Eq (Matrix a) where
92 a == b = cols a == cols b && flatten a == flatten b
93
94instance (Field a, Linear Vector a) => Num (Matrix a) where
95 (+) = liftMatrix2' (+)
96 (-) = liftMatrix2' (-)
97 negate = liftMatrix negate
98 (*) = liftMatrix2' (*)
99 signum = liftMatrix signum
100 abs = liftMatrix abs
101 fromInteger = (1><1) . return . fromInteger
102
103---------------------------------------------------
104
105instance Fractional (Vector Double) where
106 fromRational n = fromList [fromRational n]
107 (/) = adaptScalar f (vectorZipR Div) g where
108 r `f` v = vectorMapValR Recip r v
109 v `g` r = scale (recip r) v
110
111-------------------------------------------------------
112
113instance Fractional (Vector (Complex Double)) where
114 fromRational n = fromList [fromRational n]
115 (/) = adaptScalar f (vectorZipC Div) g where
116 r `f` v = vectorMapValC Recip r v
117 v `g` r = scale (recip r) v
118
119------------------------------------------------------
120
121instance Fractional (Matrix Double) where
122 fromRational n = (1><1) [fromRational n]
123 (/) = liftMatrix2' (/)
124
125-------------------------------------------------------
126
127instance Fractional (Matrix (Complex Double)) where
128 fromRational n = (1><1) [fromRational n]
129 (/) = liftMatrix2' (/)
130
131---------------------------------------------------------
132
133instance Floating (Vector Double) where
134 sin = vectorMapR Sin
135 cos = vectorMapR Cos
136 tan = vectorMapR Tan
137 asin = vectorMapR ASin
138 acos = vectorMapR ACos
139 atan = vectorMapR ATan
140 sinh = vectorMapR Sinh
141 cosh = vectorMapR Cosh
142 tanh = vectorMapR Tanh
143 asinh = vectorMapR ASinh
144 acosh = vectorMapR ACosh
145 atanh = vectorMapR ATanh
146 exp = vectorMapR Exp
147 log = vectorMapR Log
148 sqrt = vectorMapR Sqrt
149 (**) = adaptScalar (vectorMapValR PowSV) (vectorZipR Pow) (flip (vectorMapValR PowVS))
150 pi = fromList [pi]
151
152-----------------------------------------------------------
153
154instance Floating (Matrix Double) where
155 sin = liftMatrix sin
156 cos = liftMatrix cos
157 tan = liftMatrix tan
158 asin = liftMatrix asin
159 acos = liftMatrix acos
160 atan = liftMatrix atan
161 sinh = liftMatrix sinh
162 cosh = liftMatrix cosh
163 tanh = liftMatrix tanh
164 asinh = liftMatrix asinh
165 acosh = liftMatrix acosh
166 atanh = liftMatrix atanh
167 exp = liftMatrix exp
168 log = liftMatrix log
169 (**) = liftMatrix2' (**)
170 sqrt = liftMatrix sqrt
171 pi = (1><1) [pi]
172-------------------------------------------------------------
173
174instance Floating (Vector (Complex Double)) where
175 sin = vectorMapC Sin
176 cos = vectorMapC Cos
177 tan = vectorMapC Tan
178 asin = vectorMapC ASin
179 acos = vectorMapC ACos
180 atan = vectorMapC ATan
181 sinh = vectorMapC Sinh
182 cosh = vectorMapC Cosh
183 tanh = vectorMapC Tanh
184 asinh = vectorMapC ASinh
185 acosh = vectorMapC ACosh
186 atanh = vectorMapC ATanh
187 exp = vectorMapC Exp
188 log = vectorMapC Log
189 sqrt = vectorMapC Sqrt
190 (**) = adaptScalar (vectorMapValC PowSV) (vectorZipC Pow) (flip (vectorMapValC PowVS))
191 pi = fromList [pi]
192
193---------------------------------------------------------------
194
195instance Floating (Matrix (Complex Double)) where
196 sin = liftMatrix sin
197 cos = liftMatrix cos
198 tan = liftMatrix tan
199 asin = liftMatrix asin
200 acos = liftMatrix acos
201 atan = liftMatrix atan
202 sinh = liftMatrix sinh
203 cosh = liftMatrix cosh
204 tanh = liftMatrix tanh
205 asinh = liftMatrix asinh
206 acosh = liftMatrix acosh
207 atanh = liftMatrix atanh
208 exp = liftMatrix exp
209 log = liftMatrix log
210 (**) = liftMatrix2' (**)
211 sqrt = liftMatrix sqrt
212 pi = (1><1) [pi]
213
214---------------------------------------------------------------
215 65
216 66
217class Mul a b c | a b -> c where 67class Mul a b c | a b -> c where