diff options
-rw-r--r-- | Setup.lhs | 2 | ||||
-rw-r--r-- | configure.hs | 4 | ||||
-rw-r--r-- | examples/parallel.hs | 2 | ||||
-rw-r--r-- | examples/pca1.hs | 2 | ||||
-rw-r--r-- | examples/pca2.hs | 2 | ||||
-rw-r--r-- | examples/vector-map.hs | 74 | ||||
-rw-r--r-- | examples/vector.hs | 5 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests.hs | 4 | ||||
-rw-r--r-- | monadic.hs | 90 |
9 files changed, 101 insertions, 84 deletions
@@ -1,7 +1,7 @@ | |||
1 | #! /usr/bin/env runhaskell | 1 | #! /usr/bin/env runhaskell |
2 | 2 | ||
3 | > import Distribution.Simple | 3 | > import Distribution.Simple |
4 | > import System(system) | 4 | > import System.Process(system) |
5 | 5 | ||
6 | > main = defaultMainWithHooks autoconfUserHooks {runTests = t} | 6 | > main = defaultMainWithHooks autoconfUserHooks {runTests = t} |
7 | 7 | ||
diff --git a/configure.hs b/configure.hs index 9b8a177..3b12e0f 100644 --- a/configure.hs +++ b/configure.hs | |||
@@ -17,7 +17,9 @@ | |||
17 | 17 | ||
18 | -} | 18 | -} |
19 | 19 | ||
20 | import System | 20 | import System.Process |
21 | import System.Exit | ||
22 | import System.Environment | ||
21 | import System.Directory(createDirectoryIfMissing) | 23 | import System.Directory(createDirectoryIfMissing) |
22 | import Data.List(isPrefixOf, intercalate) | 24 | import Data.List(isPrefixOf, intercalate) |
23 | import Distribution.Simple.LocalBuildInfo | 25 | import Distribution.Simple.LocalBuildInfo |
diff --git a/examples/parallel.hs b/examples/parallel.hs index c82114f..566b729 100644 --- a/examples/parallel.hs +++ b/examples/parallel.hs | |||
@@ -1,6 +1,6 @@ | |||
1 | -- $ runhaskell parallel.hs 2000 | 1 | -- $ runhaskell parallel.hs 2000 |
2 | 2 | ||
3 | import System(getArgs) | 3 | import System.Environment(getArgs) |
4 | import Numeric.LinearAlgebra | 4 | import Numeric.LinearAlgebra |
5 | import Control.Parallel.Strategies | 5 | import Control.Parallel.Strategies |
6 | import System.Time | 6 | import System.Time |
diff --git a/examples/pca1.hs b/examples/pca1.hs index 58b5577..a11eba9 100644 --- a/examples/pca1.hs +++ b/examples/pca1.hs | |||
@@ -2,7 +2,7 @@ | |||
2 | 2 | ||
3 | import Numeric.LinearAlgebra | 3 | import Numeric.LinearAlgebra |
4 | import System.Directory(doesFileExist) | 4 | import System.Directory(doesFileExist) |
5 | import System(system) | 5 | import System.Process(system) |
6 | import Control.Monad(when) | 6 | import Control.Monad(when) |
7 | 7 | ||
8 | type Vec = Vector Double | 8 | type Vec = Vector Double |
diff --git a/examples/pca2.hs b/examples/pca2.hs index c38857c..e7ea95f 100644 --- a/examples/pca2.hs +++ b/examples/pca2.hs | |||
@@ -3,7 +3,7 @@ | |||
3 | import Numeric.LinearAlgebra | 3 | import Numeric.LinearAlgebra |
4 | import Graphics.Plot | 4 | import Graphics.Plot |
5 | import System.Directory(doesFileExist) | 5 | import System.Directory(doesFileExist) |
6 | import System(system) | 6 | import System.Process(system) |
7 | import Control.Monad(when) | 7 | import Control.Monad(when) |
8 | 8 | ||
9 | type Vec = Vector Double | 9 | type Vec = Vector Double |
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 | |||
6 | import Data.Packed.Vector | ||
7 | import Numeric.LinearAlgebra.Interface | ||
8 | |||
9 | import Control.Monad.State | ||
10 | |||
11 | ------------------------------------------- | ||
12 | |||
13 | -- an instance of MonadIO, a monad transformer | ||
14 | type VectorMonadT = StateT Int IO | ||
15 | |||
16 | v :: Vector Int | ||
17 | v = fromList $ take 10 [0..] | ||
18 | |||
19 | test1 :: Vector Int -> IO (Vector Int) | ||
20 | test1 = do | ||
21 | mapVectorM (\x -> do | ||
22 | putStr $ (show x) ++ " " | ||
23 | return (x + 1)) | ||
24 | |||
25 | -- we can have an arbitrary monad AND do IO | ||
26 | addInitialM :: Vector Int -> VectorMonadT () | ||
27 | addInitialM = 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 | ||
34 | sumEvens :: Vector Int -> Int | ||
35 | sumEvens = foldVectorWithIndex (\x a b -> if x `mod` 2 == 0 then a + b else b) 0 | ||
36 | |||
37 | -- sum and print running total of evens | ||
38 | sumEvensAndPrint :: Vector Int -> VectorMonadT () | ||
39 | sumEvensAndPrint = 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 | |||
49 | indexPlusSum :: Vector Int -> VectorMonadT () | ||
50 | indexPlusSum 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 | |||
63 | main = 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 | |||
diff --git a/examples/vector.hs b/examples/vector.hs index eda9290..f531cbd 100644 --- a/examples/vector.hs +++ b/examples/vector.hs | |||
@@ -14,7 +14,7 @@ fromVector :: Storable t => V.Vector t -> H.Vector t | |||
14 | fromVector v = unsafeFromForeignPtr p i n where | 14 | fromVector v = unsafeFromForeignPtr p i n where |
15 | (p,i,n) = V.unsafeToForeignPtr v | 15 | (p,i,n) = V.unsafeToForeignPtr v |
16 | 16 | ||
17 | toVector :: H.Vector t -> V.Vector t | 17 | toVector :: Storable t => H.Vector t -> V.Vector t |
18 | toVector v = V.unsafeFromForeignPtr p i n where | 18 | toVector v = V.unsafeFromForeignPtr p i n where |
19 | (p,i,n) = unsafeToForeignPtr v | 19 | (p,i,n) = unsafeToForeignPtr v |
20 | 20 | ||
@@ -22,11 +22,10 @@ toVector v = V.unsafeFromForeignPtr p i n where | |||
22 | 22 | ||
23 | v = V.slice 5 10 (V.fromList [1 .. 10::Double] V.++ V.replicate 10 7) | 23 | v = V.slice 5 10 (V.fromList [1 .. 10::Double] V.++ V.replicate 10 7) |
24 | 24 | ||
25 | w = subVector 2 3 (linspace 10 (0,2)) | 25 | w = subVector 2 3 (linspace 5 (0,1)) :: Vector Double |
26 | 26 | ||
27 | main = do | 27 | main = do |
28 | print v | 28 | print v |
29 | print $ fromVector v | 29 | print $ fromVector v |
30 | print w | 30 | print w |
31 | print $ toVector w | 31 | print $ toVector w |
32 | |||
diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs index a44c273..630ba91 100644 --- a/lib/Numeric/LinearAlgebra/Tests.hs +++ b/lib/Numeric/LinearAlgebra/Tests.hs | |||
@@ -300,8 +300,8 @@ 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 | succTest = utest "successive" $ successive_ (>) (fromList [1 :: Double,2,3,4]) == True |
304 | && successive_ (<) (fromList [1 :: Double,3,2,4]) == False | 304 | && successive_ (<) (fromList [1 :: Double,3,2,4]) == False |
305 | 305 | ||
306 | --------------------------------------------------------------------- | 306 | --------------------------------------------------------------------- |
307 | 307 | ||
diff --git a/monadic.hs b/monadic.hs new file mode 100644 index 0000000..b933de9 --- /dev/null +++ b/monadic.hs | |||
@@ -0,0 +1,90 @@ | |||
1 | -- monadic computations | ||
2 | -- (contributed by Vivian McPhail) | ||
3 | |||
4 | import Numeric.Container | ||
5 | import Control.Monad.State | ||
6 | import Control.Monad.Maybe | ||
7 | |||
8 | ------------------------------------------- | ||
9 | |||
10 | -- an instance of MonadIO, a monad transformer | ||
11 | type VectorMonadT = StateT Int IO | ||
12 | |||
13 | v :: Vector Int | ||
14 | v = 10 |> [0..] | ||
15 | |||
16 | test1 :: Vector Int -> IO (Vector Int) | ||
17 | test1 = mapVectorM $ \x -> do | ||
18 | putStr $ (show x) ++ " " | ||
19 | return (x + 1) | ||
20 | |||
21 | -- we can have an arbitrary monad AND do IO | ||
22 | addInitialM :: Vector Int -> VectorMonadT () | ||
23 | addInitialM = mapVectorM_ $ \x -> do | ||
24 | i <- get | ||
25 | liftIO $ putStr $ (show $ x + i) ++ " " | ||
26 | put $ x + i | ||
27 | |||
28 | -- sum the values of the even indiced elements | ||
29 | sumEvens :: Vector Int -> Int | ||
30 | sumEvens = foldVectorWithIndex (\x a b -> if x `mod` 2 == 0 then a + b else b) 0 | ||
31 | |||
32 | -- sum and print running total of evens | ||
33 | sumEvensAndPrint :: Vector Int -> VectorMonadT () | ||
34 | sumEvensAndPrint = mapVectorWithIndexM_ $ \ i x -> do | ||
35 | when (i `mod` 2 == 0) $ do | ||
36 | v <- get | ||
37 | put $ v + x | ||
38 | v' <- get | ||
39 | liftIO $ putStr $ (show v') ++ " " | ||
40 | |||
41 | |||
42 | indexPlusSum :: Vector Int -> VectorMonadT () | ||
43 | indexPlusSum v' = do | ||
44 | let f i x = do | ||
45 | s <- get | ||
46 | let inc = x+s | ||
47 | liftIO $ putStr $ show (i,inc) ++ " " | ||
48 | put inc | ||
49 | return inc | ||
50 | v <- mapVectorWithIndexM f v' | ||
51 | liftIO $ do | ||
52 | putStrLn "" | ||
53 | putStrLn $ show v | ||
54 | |||
55 | ------------------------------------------- | ||
56 | |||
57 | -- short circuit | ||
58 | monoStep :: Double -> MaybeT (State Double) () | ||
59 | monoStep d = do | ||
60 | dp <- get | ||
61 | when (d < dp) (fail "negative difference") | ||
62 | put d | ||
63 | {-# INLINE monoStep #-} | ||
64 | |||
65 | isMonotoneIncreasing :: Vector Double -> Bool | ||
66 | isMonotoneIncreasing v = | ||
67 | let res = evalState (runMaybeT $ (mapVectorM_ monoStep v)) (v @> 0) | ||
68 | in case res of | ||
69 | Nothing -> False | ||
70 | Just _ -> True | ||
71 | |||
72 | w = fromList ([1..10]++[10,9..1]) :: Vector Double | ||
73 | |||
74 | ------------------------------------------- | ||
75 | |||
76 | main = do | ||
77 | v' <- test1 v | ||
78 | putStrLn "" | ||
79 | putStrLn $ show v' | ||
80 | evalStateT (addInitialM v) 0 | ||
81 | putStrLn "" | ||
82 | putStrLn $ show (sumEvens v) | ||
83 | evalStateT (sumEvensAndPrint v) 0 | ||
84 | putStrLn "" | ||
85 | evalStateT (indexPlusSum v) 0 | ||
86 | putStrLn "-----------------------" | ||
87 | print $ isMonotoneIncreasing w | ||
88 | print $ isMonotoneIncreasing (subVector 0 7 w) | ||
89 | print $ successive_ (>) v | ||
90 | print $ successive_ (>) w | ||