summaryrefslogtreecommitdiff
path: root/packages
diff options
context:
space:
mode:
Diffstat (limited to 'packages')
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests.hs26
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((***))
43import Debug.Trace 43import Debug.Trace
44import Control.Monad(when) 44import Control.Monad(when)
45import Numeric.LinearAlgebra.Util hiding (ones,row,col) 45import Numeric.LinearAlgebra.Util hiding (ones,row,col)
46import Control.Applicative
47import Control.Monad(ap)
46 48
47import Data.Packed.ST 49import 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
274normsMTest = TestList [ 276normsMTest = TestList [
@@ -330,6 +332,15 @@ conjuTest m = mapVector conjugate (flatten (trans m)) == flatten (ctrans m)
330 332
331newtype State s a = State { runState :: s -> (a,s) } 333newtype State s a = State { runState :: s -> (a,s) }
332 334
335instance Functor (State s)
336 where
337 fmap f x = pure f <*> x
338
339instance Applicative (State s)
340 where
341 pure = return
342 (<*>) = ap
343
333instance Monad (State s) where 344instance 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
348newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } 359newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
349 360
361instance Monad m => Functor (MaybeT m)
362 where
363 fmap f x = pure f <*> x
364
365instance Monad m => Applicative (MaybeT m)
366 where
367 pure = return
368 (<*>) = ap
369
350instance Monad m => Monad (MaybeT m) where 370instance 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
641makeUnitary v | realPart n > 1 = v / scalar n 661makeUnitary 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 ()