diff options
Diffstat (limited to 'lib/Data/Packed/Vector.hs')
-rw-r--r-- | lib/Data/Packed/Vector.hs | 54 |
1 files changed, 1 insertions, 53 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 | ------------------------------------------------------------------- | ||