summaryrefslogtreecommitdiff
path: root/examples/vector-map.hs
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2010-09-26 17:05:09 +0000
committerAlberto Ruiz <aruiz@um.es>2010-09-26 17:05:09 +0000
commit611ff4782c261a6c6e52fe7ed0c122a0eac22691 (patch)
tree5b9362a88a568cbb4e8ad442365e26bdef17946d /examples/vector-map.hs
parent632c2c5a8b934fd8b54c8be68d178aa49323077d (diff)
fix imports, examples
Diffstat (limited to 'examples/vector-map.hs')
-rw-r--r--examples/vector-map.hs74
1 files changed, 0 insertions, 74 deletions
diff --git a/examples/vector-map.hs b/examples/vector-map.hs
deleted file mode 100644
index 7796cc0..0000000
--- a/examples/vector-map.hs
+++ /dev/null
@@ -1,74 +0,0 @@
1-- use of vectorMapM
2--
3
4-------------------------------------------
5
6import Data.Packed.Vector
7import Numeric.LinearAlgebra.Interface
8
9import Control.Monad.State
10
11-------------------------------------------
12
13-- an instance of MonadIO, a monad transformer
14type VectorMonadT = StateT Int IO
15
16v :: Vector Int
17v = fromList $ take 10 [0..]
18
19test1 :: Vector Int -> IO (Vector Int)
20test1 = do
21 mapVectorM (\x -> do
22 putStr $ (show x) ++ " "
23 return (x + 1))
24
25-- we can have an arbitrary monad AND do IO
26addInitialM :: Vector Int -> VectorMonadT ()
27addInitialM = mapVectorM_ (\x -> do
28 i <- get
29 liftIO $ putStr $ (show $ x + i) ++ " "
30 put $ x + i
31 )
32
33-- sum the values of the even indiced elements
34sumEvens :: Vector Int -> Int
35sumEvens = foldVectorWithIndex (\x a b -> if x `mod` 2 == 0 then a + b else b) 0
36
37-- sum and print running total of evens
38sumEvensAndPrint :: Vector Int -> VectorMonadT ()
39sumEvensAndPrint = mapVectorWithIndexM_ (\ i x -> do
40 when (i `mod` 2 == 0) (do
41 v <- get
42 put $ v + x
43 v' <- get
44 liftIO $ putStr $ (show v') ++ " "
45 return ())
46 return ()
47 )
48
49indexPlusSum :: Vector Int -> VectorMonadT ()
50indexPlusSum v' = do
51 v <- mapVectorWithIndexM (\i x -> do
52 s <- get
53 let inc = x+s
54 liftIO $ putStr $ show (i,inc) ++ " "
55 put inc
56 return inc) v'
57 liftIO $ do
58 putStrLn ""
59 putStrLn $ show v
60
61-------------------------------------------
62
63main = do
64 v' <- test1 v
65 putStrLn ""
66 putStrLn $ show v'
67 evalStateT (addInitialM v) 0
68 putStrLn ""
69 putStrLn $ show (sumEvens v)
70 evalStateT (sumEvensAndPrint v) 0
71 putStrLn ""
72 evalStateT (indexPlusSum v) 0
73 return ()
74