diff options
-rw-r--r-- | lib/Data/Packed/Internal/Matrix.hs | 25 | ||||
-rw-r--r-- | lib/Numeric/Container.hs | 25 |
2 files changed, 26 insertions, 24 deletions
diff --git a/lib/Data/Packed/Internal/Matrix.hs b/lib/Data/Packed/Internal/Matrix.hs index f3bab76..7b823de 100644 --- a/lib/Data/Packed/Internal/Matrix.hs +++ b/lib/Data/Packed/Internal/Matrix.hs | |||
@@ -257,28 +257,30 @@ class (Storable a) => Element a where | |||
257 | transdata = transdataP -- transdata' | 257 | transdata = transdataP -- transdata' |
258 | constantD :: a -> Int -> Vector a | 258 | constantD :: a -> Int -> Vector a |
259 | constantD = constantP -- constant' | 259 | constantD = constantP -- constant' |
260 | {- | ||
260 | conjugateD :: Vector a -> Vector a | 261 | conjugateD :: Vector a -> Vector a |
261 | conjugateD = id | 262 | conjugateD = id |
263 | -} | ||
262 | 264 | ||
263 | instance Element Float where | 265 | instance Element Float where |
264 | transdata = transdataAux ctransF | 266 | transdata = transdataAux ctransF |
265 | constantD = constantAux cconstantF | 267 | constantD = constantAux cconstantF |
266 | conjugateD = id | 268 | -- conjugateD = id |
267 | 269 | ||
268 | instance Element Double where | 270 | instance Element Double where |
269 | transdata = transdataAux ctransR | 271 | transdata = transdataAux ctransR |
270 | constantD = constantAux cconstantR | 272 | constantD = constantAux cconstantR |
271 | conjugateD = id | 273 | -- conjugateD = id |
272 | 274 | ||
273 | instance Element (Complex Float) where | 275 | instance Element (Complex Float) where |
274 | transdata = transdataAux ctransQ | 276 | transdata = transdataAux ctransQ |
275 | constantD = constantAux cconstantQ | 277 | constantD = constantAux cconstantQ |
276 | conjugateD = conjugateQ | 278 | -- conjugateD = conjugateQ |
277 | 279 | ||
278 | instance Element (Complex Double) where | 280 | instance Element (Complex Double) where |
279 | transdata = transdataAux ctransC | 281 | transdata = transdataAux ctransC |
280 | constantD = constantAux cconstantC | 282 | constantD = constantAux cconstantC |
281 | conjugateD = conjugateC | 283 | -- conjugateD = conjugateC |
282 | 284 | ||
283 | ------------------------------------------------------------------- | 285 | ------------------------------------------------------------------- |
284 | 286 | ||
@@ -390,21 +392,6 @@ constantP a n = unsafePerformIO $ do | |||
390 | return v | 392 | return v |
391 | foreign import ccall "constantP" cconstantP :: Ptr () -> CInt -> Ptr () -> CInt -> IO CInt | 393 | foreign import ccall "constantP" cconstantP :: Ptr () -> CInt -> Ptr () -> CInt -> IO CInt |
392 | 394 | ||
393 | --------------------------------------- | ||
394 | |||
395 | conjugateAux fun x = unsafePerformIO $ do | ||
396 | v <- createVector (dim x) | ||
397 | app2 fun vec x vec v "conjugateAux" | ||
398 | return v | ||
399 | |||
400 | conjugateQ :: Vector (Complex Float) -> Vector (Complex Float) | ||
401 | conjugateQ = conjugateAux c_conjugateQ | ||
402 | foreign import ccall "conjugateQ" c_conjugateQ :: TQVQV | ||
403 | |||
404 | conjugateC :: Vector (Complex Double) -> Vector (Complex Double) | ||
405 | conjugateC = conjugateAux c_conjugateC | ||
406 | foreign import ccall "conjugateC" c_conjugateC :: TCVCV | ||
407 | |||
408 | ---------------------------------------------------------------------- | 395 | ---------------------------------------------------------------------- |
409 | 396 | ||
410 | -- | Extracts a submatrix from a matrix. | 397 | -- | Extracts a submatrix from a matrix. |
diff --git a/lib/Numeric/Container.hs b/lib/Numeric/Container.hs index 09f8002..3b590de 100644 --- a/lib/Numeric/Container.hs +++ b/lib/Numeric/Container.hs | |||
@@ -52,6 +52,8 @@ import Control.Monad(ap) | |||
52 | 52 | ||
53 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ) | 53 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ) |
54 | 54 | ||
55 | import System.IO.Unsafe | ||
56 | |||
55 | ------------------------------------------------------------------- | 57 | ------------------------------------------------------------------- |
56 | 58 | ||
57 | type family IndexOf c | 59 | type family IndexOf c |
@@ -119,7 +121,7 @@ instance Container Vector Float where | |||
119 | equal u v = dim u == dim v && maxElement (vectorMapF Abs (sub u v)) == 0.0 | 121 | equal u v = dim u == dim v && maxElement (vectorMapF Abs (sub u v)) == 0.0 |
120 | scalar x = fromList [x] | 122 | scalar x = fromList [x] |
121 | konst = constantD | 123 | konst = constantD |
122 | conj = conjugateD | 124 | conj = id |
123 | cmap = mapVector | 125 | cmap = mapVector |
124 | atIndex = (@>) | 126 | atIndex = (@>) |
125 | minIndex = round . toScalarF MinIdx | 127 | minIndex = round . toScalarF MinIdx |
@@ -140,7 +142,7 @@ instance Container Vector Double where | |||
140 | equal u v = dim u == dim v && maxElement (vectorMapR Abs (sub u v)) == 0.0 | 142 | equal u v = dim u == dim v && maxElement (vectorMapR Abs (sub u v)) == 0.0 |
141 | scalar x = fromList [x] | 143 | scalar x = fromList [x] |
142 | konst = constantD | 144 | konst = constantD |
143 | conj = conjugateD | 145 | conj = id |
144 | cmap = mapVector | 146 | cmap = mapVector |
145 | atIndex = (@>) | 147 | atIndex = (@>) |
146 | minIndex = round . toScalarR MinIdx | 148 | minIndex = round . toScalarR MinIdx |
@@ -161,7 +163,7 @@ instance Container Vector (Complex Double) where | |||
161 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 | 163 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 |
162 | scalar x = fromList [x] | 164 | scalar x = fromList [x] |
163 | konst = constantD | 165 | konst = constantD |
164 | conj = conjugateD | 166 | conj = conjugateC |
165 | cmap = mapVector | 167 | cmap = mapVector |
166 | atIndex = (@>) | 168 | atIndex = (@>) |
167 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) | 169 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) |
@@ -182,7 +184,7 @@ instance Container Vector (Complex Float) where | |||
182 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 | 184 | equal u v = dim u == dim v && maxElement (mapVector magnitude (sub u v)) == 0.0 |
183 | scalar x = fromList [x] | 185 | scalar x = fromList [x] |
184 | konst = constantD | 186 | konst = constantD |
185 | conj = conjugateD | 187 | conj = conjugateQ |
186 | cmap = mapVector | 188 | cmap = mapVector |
187 | atIndex = (@>) | 189 | atIndex = (@>) |
188 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) | 190 | minIndex = minIndex . fst . fromComplex . (zipVectorWith (*) `ap` mapVector conjugate) |
@@ -205,7 +207,7 @@ instance (Container Vector a) => Container Matrix a where | |||
205 | equal a b = cols a == cols b && flatten a `equal` flatten b | 207 | equal a b = cols a == cols b && flatten a `equal` flatten b |
206 | scalar x = (1><1) [x] | 208 | scalar x = (1><1) [x] |
207 | konst v (r,c) = reshape c (konst v (r*c)) | 209 | konst v (r,c) = reshape c (konst v (r*c)) |
208 | conj = liftMatrix conjugateD | 210 | conj = liftMatrix conj |
209 | cmap f = liftMatrix (mapVector f) | 211 | cmap f = liftMatrix (mapVector f) |
210 | atIndex = (@@>) | 212 | atIndex = (@@>) |
211 | minIndex m = let (r,c) = (rows m,cols m) | 213 | minIndex m = let (r,c) = (rows m,cols m) |
@@ -405,6 +407,19 @@ type instance ElementOf (Matrix a) = a | |||
405 | 407 | ||
406 | ------------------------------------------------------------ | 408 | ------------------------------------------------------------ |
407 | 409 | ||
410 | conjugateAux fun x = unsafePerformIO $ do | ||
411 | v <- createVector (dim x) | ||
412 | app2 fun vec x vec v "conjugateAux" | ||
413 | return v | ||
414 | |||
415 | conjugateQ :: Vector (Complex Float) -> Vector (Complex Float) | ||
416 | conjugateQ = conjugateAux c_conjugateQ | ||
417 | foreign import ccall "conjugateQ" c_conjugateQ :: TQVQV | ||
418 | |||
419 | conjugateC :: Vector (Complex Double) -> Vector (Complex Double) | ||
420 | conjugateC = conjugateAux c_conjugateC | ||
421 | foreign import ccall "conjugateC" c_conjugateC :: TCVCV | ||
422 | |||
408 | ---------------------------------------------------- | 423 | ---------------------------------------------------- |
409 | 424 | ||
410 | {-# DEPRECATED (.*) "use scale a x or scalar a * x" #-} | 425 | {-# DEPRECATED (.*) "use scale a x or scalar a * x" #-} |