summaryrefslogtreecommitdiff
path: root/lib/Data
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Data')
-rw-r--r--lib/Data/Packed/Vector.hs54
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
29import Data.Packed.Internal.Vector 28import Data.Packed.Internal.Vector
@@ -84,54 +83,3 @@ unzipVector :: (Storable a, Storable b, Storable (a,b)) => Vector (a,b) -> (Vect
84unzipVector = unzipVectorWith id 83unzipVector = unzipVectorWith id
85 84
86------------------------------------------------------------------- 85-------------------------------------------------------------------
87
88newtype State s a = State { runState :: s -> (a,s) }
89
90instance 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
95state_get :: State s s
96state_get = State $ \s -> (s,s)
97
98state_put :: s -> State s ()
99state_put s = State $ \_ -> ((),s)
100
101evalState :: State s a -> s -> a
102evalState m s = let (a,s') = runState m s
103 in seq s' a
104
105newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
106
107instance 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
116lift_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
121successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool
122successive_ 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
130successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b
131successive 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-------------------------------------------------------------------