diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Data/Packed/Vector.hs | 54 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests.hs | 58 |
2 files changed, 56 insertions, 56 deletions
diff --git a/lib/Data/Packed/Vector.hs b/lib/Data/Packed/Vector.hs index e79e237..8b1e813 100644 --- a/lib/Data/Packed/Vector.hs +++ b/lib/Data/Packed/Vector.hs | |||
@@ -22,8 +22,7 @@ module Data.Packed.Vector ( | |||
22 | subVector, takesV, join, | 22 | subVector, takesV, join, |
23 | mapVector, zipVector, zipVectorWith, unzipVector, unzipVectorWith, | 23 | mapVector, zipVector, zipVectorWith, unzipVector, unzipVectorWith, |
24 | mapVectorM, mapVectorM_, mapVectorWithIndexM, mapVectorWithIndexM_, | 24 | mapVectorM, mapVectorM_, mapVectorWithIndexM, mapVectorWithIndexM_, |
25 | foldLoop, foldVector, foldVectorG, foldVectorWithIndex, | 25 | foldLoop, foldVector, foldVectorG, foldVectorWithIndex |
26 | successive_, successive | ||
27 | ) where | 26 | ) where |
28 | 27 | ||
29 | import Data.Packed.Internal.Vector | 28 | import Data.Packed.Internal.Vector |
@@ -84,54 +83,3 @@ unzipVector :: (Storable a, Storable b, Storable (a,b)) => Vector (a,b) -> (Vect | |||
84 | unzipVector = unzipVectorWith id | 83 | unzipVector = unzipVectorWith id |
85 | 84 | ||
86 | ------------------------------------------------------------------- | 85 | ------------------------------------------------------------------- |
87 | |||
88 | newtype State s a = State { runState :: s -> (a,s) } | ||
89 | |||
90 | instance Monad (State s) where | ||
91 | return a = State $ \s -> (a,s) | ||
92 | m >>= f = State $ \s -> let (a,s') = runState m s | ||
93 | in runState (f a) s' | ||
94 | |||
95 | state_get :: State s s | ||
96 | state_get = State $ \s -> (s,s) | ||
97 | |||
98 | state_put :: s -> State s () | ||
99 | state_put s = State $ \_ -> ((),s) | ||
100 | |||
101 | evalState :: State s a -> s -> a | ||
102 | evalState m s = let (a,s') = runState m s | ||
103 | in seq s' a | ||
104 | |||
105 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } | ||
106 | |||
107 | instance Monad m => Monad (MaybeT m) where | ||
108 | return a = MaybeT $ return $ Just a | ||
109 | m >>= f = MaybeT $ do | ||
110 | res <- runMaybeT m | ||
111 | case res of | ||
112 | Nothing -> return Nothing | ||
113 | Just r -> runMaybeT (f r) | ||
114 | fail _ = MaybeT $ return Nothing | ||
115 | |||
116 | lift_maybe m = MaybeT $ do | ||
117 | res <- m | ||
118 | return $ Just res | ||
119 | |||
120 | -- | apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs | ||
121 | successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool | ||
122 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ step (subVector 1 (dim v - 1) v))) (v @> 0) | ||
123 | where step e = do | ||
124 | ep <- lift_maybe $ state_get | ||
125 | if t e ep | ||
126 | then lift_maybe $ state_put e | ||
127 | else (fail "successive_ test failed") | ||
128 | |||
129 | -- | operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input | ||
130 | successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b | ||
131 | successive f v = evalState (mapVectorM step (subVector 1 (dim v - 1) v)) (v @> 0) | ||
132 | where step e = do | ||
133 | ep <- state_get | ||
134 | state_put e | ||
135 | return $ f ep e | ||
136 | |||
137 | ------------------------------------------------------------------- | ||
diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs index 630ba91..093e4ef 100644 --- a/lib/Numeric/LinearAlgebra/Tests.hs +++ b/lib/Numeric/LinearAlgebra/Tests.hs | |||
@@ -26,7 +26,7 @@ import Numeric.LinearAlgebra | |||
26 | import Numeric.LinearAlgebra.LAPACK | 26 | import Numeric.LinearAlgebra.LAPACK |
27 | import Numeric.LinearAlgebra.Tests.Instances | 27 | import Numeric.LinearAlgebra.Tests.Instances |
28 | import Numeric.LinearAlgebra.Tests.Properties | 28 | import Numeric.LinearAlgebra.Tests.Properties |
29 | import Test.HUnit hiding ((~:),test,Testable) | 29 | import Test.HUnit hiding ((~:),test,Testable,State) |
30 | import System.Info | 30 | import System.Info |
31 | import Data.List(foldl1') | 31 | import Data.List(foldl1') |
32 | import Numeric.GSL | 32 | import Numeric.GSL |
@@ -300,8 +300,60 @@ conjuTest m = mapVector conjugate (flatten (trans m)) == flatten (ctrans m) | |||
300 | 300 | ||
301 | --------------------------------------------------------------------- | 301 | --------------------------------------------------------------------- |
302 | 302 | ||
303 | succTest = utest "successive" $ successive_ (>) (fromList [1 :: Double,2,3,4]) == True | 303 | newtype State s a = State { runState :: s -> (a,s) } |
304 | && successive_ (<) (fromList [1 :: Double,3,2,4]) == False | 304 | |
305 | instance Monad (State s) where | ||
306 | return a = State $ \s -> (a,s) | ||
307 | m >>= f = State $ \s -> let (a,s') = runState m s | ||
308 | in runState (f a) s' | ||
309 | |||
310 | state_get :: State s s | ||
311 | state_get = State $ \s -> (s,s) | ||
312 | |||
313 | state_put :: s -> State s () | ||
314 | state_put s = State $ \_ -> ((),s) | ||
315 | |||
316 | evalState :: State s a -> s -> a | ||
317 | evalState m s = let (a,s') = runState m s | ||
318 | in seq s' a | ||
319 | |||
320 | newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } | ||
321 | |||
322 | instance Monad m => Monad (MaybeT m) where | ||
323 | return a = MaybeT $ return $ Just a | ||
324 | m >>= f = MaybeT $ do | ||
325 | res <- runMaybeT m | ||
326 | case res of | ||
327 | Nothing -> return Nothing | ||
328 | Just r -> runMaybeT (f r) | ||
329 | fail _ = MaybeT $ return Nothing | ||
330 | |||
331 | lift_maybe m = MaybeT $ do | ||
332 | res <- m | ||
333 | return $ Just res | ||
334 | |||
335 | -- | apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs | ||
336 | --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool | ||
337 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ step (subVector 1 (dim v - 1) v))) (v @> 0) | ||
338 | where step e = do | ||
339 | ep <- lift_maybe $ state_get | ||
340 | if t e ep | ||
341 | then lift_maybe $ state_put e | ||
342 | else (fail "successive_ test failed") | ||
343 | |||
344 | -- | operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input | ||
345 | --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b | ||
346 | successive f v = evalState (mapVectorM step (subVector 1 (dim v - 1) v)) (v @> 0) | ||
347 | where step e = do | ||
348 | ep <- state_get | ||
349 | state_put e | ||
350 | return $ f ep e | ||
351 | |||
352 | |||
353 | succTest = utest "successive" $ | ||
354 | successive_ (>) (fromList [1 :: Double,2,3,4]) == True | ||
355 | && successive_ (>) (fromList [1 :: Double,3,2,4]) == False | ||
356 | && successive (+) (fromList [1..10 :: Double]) == 9 |> [3,5,7,9,11,13,15,17,19] | ||
305 | 357 | ||
306 | --------------------------------------------------------------------- | 358 | --------------------------------------------------------------------- |
307 | 359 | ||