vectorMapM, vectorMapM_

3 files changed, 40 insertions, 1 deletions

diff --git a/hmatrix.cabal b/hmatrix.cabal
index e7a64c8..009219c 100644
--- a/hmatrix.cabal
+++ b/hmatrix.cabal
@@ -72,7 +72,7 @@ flag vector
 library
 
     Build-Depends:      base >= 4 && < 5,
-                        array,
+                        array, mtl,
                         storable-complex,
                         process,
                         ghc-binary
diff --git a/lib/Data/Packed/Internal/Vector.hs b/lib/Data/Packed/Internal/Vector.hs
index 06db806..6d39c6e 100644
--- a/lib/Data/Packed/Internal/Vector.hs
+++ b/lib/Data/Packed/Internal/Vector.hs
@@ -18,6 +18,7 @@ module Data.Packed.Internal.Vector (
     fromList, toList, (|>),
     join, (@>), safe, at, at', subVector, takesV,
     mapVector, zipVector, unzipVectorWith,
+    mapVectorM, mapVectorM_,
     foldVector, foldVectorG, foldLoop,
     createVector, vec,
     asComplex, asReal,
@@ -35,6 +36,7 @@ import Foreign.C.String
 import Foreign.C.Types(CInt,CChar)
 import Data.Complex
 import Control.Monad(when)
+import Control.Monad.Trans
 
 #if __GLASGOW_HASKELL__ >= 605
 import GHC.ForeignPtr           (mallocPlainForeignPtrBytes)
@@ -357,6 +359,39 @@ foldVectorG f s0 v = foldLoop g s0 (dim v)
 
 -------------------------------------------------------------------
 
+-- | monadic map over Vectors
+mapVectorM :: (Storable a, Storable b, MonadIO m) => (a -> m b) -> Vector a -> m (Vector b)
+mapVectorM f v = do
+    w <- liftIO $ createVector (dim v)
+    mapVectorM' f v w (dim v -1)
+    return w
+    where mapVectorM' f' v' w' 0  = do
+                                    x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p 0 
+                                    y <- f' x
+                                    liftIO $ unsafeWith w' $ \q -> pokeElemOff q 0 y
+          mapVectorM' f' v' w' !k = do
+                                    x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k 
+                                    y <- f' x
+                                    liftIO $ unsafeWith w' $ \q -> pokeElemOff q k y
+                                    mapVectorM' f' v' w' (k-1)
+{-# INLINE mapVectorM #-}
+
+-- | monadic map over Vectors
+mapVectorM_ :: (Storable a, MonadIO m) => (a -> m ()) -> Vector a -> m ()
+mapVectorM_ f v = do
+    mapVectorM' f v (dim v -1)
+    where mapVectorM' f' v' 0  = do
+                                 x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p 0
+                                 f' x
+          mapVectorM' f' v' !k = do
+                                 x <- liftIO $ unsafeWith v' $ \p -> peekElemOff p k 
+                                 _ <- f' x
+                                 mapVectorM' f' v' (k-1)
+{-# INLINE mapVectorM_ #-}
+
+-------------------------------------------------------------------
+
+
 -- | Loads a vector from an ASCII file (the number of elements must be known in advance).
 fscanfVector :: FilePath -> Int -> IO (Vector Double)
 fscanfVector filename n = do
@@ -398,3 +433,4 @@ fwriteVector filename v = do
     free charname
 
 foreign import ccall "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV
+
diff --git a/lib/Data/Packed/Vector.hs b/lib/Data/Packed/Vector.hs
index ad2ae10..b87372f 100644
--- a/lib/Data/Packed/Vector.hs
+++ b/lib/Data/Packed/Vector.hs
@@ -25,6 +25,7 @@ module Data.Packed.Vector (
 --    vectorMax, vectorMin,
     vectorMaxIndex, vectorMinIndex,
     mapVector, zipVector, unzipVector, unzipVectorWith,
+    mapVectorM, mapVectorM_,
     fscanfVector, fprintfVector, freadVector, fwriteVector,
     foldLoop, foldVector, foldVectorG
 ) where
@@ -154,3 +155,5 @@ vecdisp f v
 -- | unzip for Vectors
 unzipVector :: (Storable a, Storable b, Storable (a,b)) => Vector (a,b) -> (Vector a,Vector b)
 unzipVector = unzipVectorWith id id
+
+