diff options
Diffstat (limited to 'lib/GSLHaskell.hs')
-rw-r--r-- | lib/GSLHaskell.hs | 158 |
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) | |||
9 | Stability : provisional | 9 | Stability : provisional |
10 | Portability : uses -fffi and -fglasgow-exts | 10 | Portability : uses -fffi and -fglasgow-exts |
11 | 11 | ||
12 | GSLHaskell 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. | 12 | Old 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) | ||
50 | import Data.Packed.Vector | 49 | import Data.Packed.Vector |
51 | import Data.Packed.Matrix | 50 | import Data.Packed.Matrix |
52 | import Data.Packed.Matrix hiding ((><)) | 51 | import Data.Packed.Matrix hiding ((><)) |
@@ -55,163 +54,14 @@ import qualified LinearAlgebra.Algorithms | |||
55 | import LAPACK | 54 | import LAPACK |
56 | import GSL.Matrix | 55 | import GSL.Matrix |
57 | import LinearAlgebra.Algorithms hiding (pnorm) | 56 | import LinearAlgebra.Algorithms hiding (pnorm) |
58 | import LinearAlgebra.Linear | 57 | import LinearAlgebra.Linear hiding (Mul,(<>)) |
58 | import Data.Packed.Internal.Matrix(multiply) | ||
59 | import Complex | 59 | import Complex |
60 | import Numeric(showGFloat) | 60 | import Numeric(showGFloat) |
61 | import Data.List(transpose,intersperse) | 61 | import Data.List(transpose,intersperse) |
62 | import Foreign(Storable) | 62 | import Foreign(Storable) |
63 | import Data.Array | 63 | import Data.Array |
64 | 64 | import LinearAlgebra.Instances | |
65 | |||
66 | adaptScalar 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 | |||
71 | liftMatrix2' :: (Field t, Field a, Field b) => (Vector a -> Vector b -> Vector t) -> Matrix a -> Matrix b -> Matrix t | ||
72 | liftMatrix2' 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 | |||
75 | compat' :: Matrix a -> Matrix b -> Bool | ||
76 | compat' 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 | |||
80 | instance (Eq a, Field a) => Eq (Vector a) where | ||
81 | a == b = dim a == dim b && toList a == toList b | ||
82 | |||
83 | instance (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 | |||
91 | instance (Eq a, Field a) => Eq (Matrix a) where | ||
92 | a == b = cols a == cols b && flatten a == flatten b | ||
93 | |||
94 | instance (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 | |||
105 | instance 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 | |||
113 | instance 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 | |||
121 | instance Fractional (Matrix Double) where | ||
122 | fromRational n = (1><1) [fromRational n] | ||
123 | (/) = liftMatrix2' (/) | ||
124 | |||
125 | ------------------------------------------------------- | ||
126 | |||
127 | instance Fractional (Matrix (Complex Double)) where | ||
128 | fromRational n = (1><1) [fromRational n] | ||
129 | (/) = liftMatrix2' (/) | ||
130 | |||
131 | --------------------------------------------------------- | ||
132 | |||
133 | instance 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 | |||
154 | instance 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 | |||
174 | instance 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 | |||
195 | instance 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 | ||
217 | class Mul a b c | a b -> c where | 67 | class Mul a b c | a b -> c where |