diff options
Diffstat (limited to 'packages')
-rw-r--r-- | packages/tests/src/Numeric/LinearAlgebra/Tests.hs | 26 |
1 files changed, 23 insertions, 3 deletions
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs index 99c0c91..7e1799e 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs | |||
@@ -43,6 +43,8 @@ import Control.Arrow((***)) | |||
43 | import Debug.Trace | 43 | import Debug.Trace |
44 | import Control.Monad(when) | 44 | import Control.Monad(when) |
45 | import Numeric.LinearAlgebra.Util hiding (ones,row,col) | 45 | import Numeric.LinearAlgebra.Util hiding (ones,row,col) |
46 | import Control.Applicative | ||
47 | import Control.Monad(ap) | ||
46 | 48 | ||
47 | import Data.Packed.ST | 49 | import Data.Packed.ST |
48 | 50 | ||
@@ -266,9 +268,9 @@ normsVTest = TestList [ | |||
266 | ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double) | 268 | ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double) |
267 | x = fromList [1,2,-3] :: Vector Double | 269 | x = fromList [1,2,-3] :: Vector Double |
268 | #ifndef NONORMVTEST | 270 | #ifndef NONORMVTEST |
269 | norm2PropR a = norm2 a =~= sqrt (dot a a) | 271 | norm2PropR a = norm2 a =~= sqrt (udot a a) |
270 | #endif | 272 | #endif |
271 | norm2PropC a = norm2 a =~= realPart (sqrt (dot a (conj a))) | 273 | norm2PropC a = norm2 a =~= realPart (sqrt (udot a (conj a))) |
272 | a =~= b = fromList [a] |~| fromList [b] | 274 | a =~= b = fromList [a] |~| fromList [b] |
273 | 275 | ||
274 | normsMTest = TestList [ | 276 | normsMTest = TestList [ |
@@ -330,6 +332,15 @@ conjuTest m = mapVector conjugate (flatten (trans m)) == flatten (ctrans m) | |||
330 | 332 | ||
331 | newtype State s a = State { runState :: s -> (a,s) } | 333 | newtype State s a = State { runState :: s -> (a,s) } |
332 | 334 | ||
335 | instance Functor (State s) | ||
336 | where | ||
337 | fmap f x = pure f <*> x | ||
338 | |||
339 | instance Applicative (State s) | ||
340 | where | ||
341 | pure = return | ||
342 | (<*>) = ap | ||
343 | |||
333 | instance Monad (State s) where | 344 | instance Monad (State s) where |
334 | return a = State $ \s -> (a,s) | 345 | return a = State $ \s -> (a,s) |
335 | m >>= f = State $ \s -> let (a,s') = runState m s | 346 | m >>= f = State $ \s -> let (a,s') = runState m s |
@@ -347,6 +358,15 @@ evalState m s = let (a,s') = runState m s | |||
347 | 358 | ||
348 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } | 359 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } |
349 | 360 | ||
361 | instance Monad m => Functor (MaybeT m) | ||
362 | where | ||
363 | fmap f x = pure f <*> x | ||
364 | |||
365 | instance Monad m => Applicative (MaybeT m) | ||
366 | where | ||
367 | pure = return | ||
368 | (<*>) = ap | ||
369 | |||
350 | instance Monad m => Monad (MaybeT m) where | 370 | instance Monad m => Monad (MaybeT m) where |
351 | return a = MaybeT $ return $ Just a | 371 | return a = MaybeT $ return $ Just a |
352 | m >>= f = MaybeT $ do | 372 | m >>= f = MaybeT $ do |
@@ -640,7 +660,7 @@ a |~~| b = a :~6~: b | |||
640 | 660 | ||
641 | makeUnitary v | realPart n > 1 = v / scalar n | 661 | makeUnitary v | realPart n > 1 = v / scalar n |
642 | | otherwise = v | 662 | | otherwise = v |
643 | where n = sqrt (conj v <.> v) | 663 | where n = sqrt (conj v `udot` v) |
644 | 664 | ||
645 | -- -- | Some additional tests on big matrices. They take a few minutes. | 665 | -- -- | Some additional tests on big matrices. They take a few minutes. |
646 | -- runBigTests :: IO () | 666 | -- runBigTests :: IO () |