diff options
author | Alberto Ruiz <aruiz@um.es> | 2008-06-05 12:04:40 +0000 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2008-06-05 12:04:40 +0000 |
commit | cfd75ac234ef7d769f8a6f86949a18ee5f37fa00 (patch) | |
tree | c4610223df8f22aab256da147b64665e170adfa2 /examples/inplace.hs | |
parent | d0fde9bdcb7cf490f7b067f0fa4d15b4f8fc3a61 (diff) |
first version of Data.Packed.ST
Diffstat (limited to 'examples/inplace.hs')
-rw-r--r-- | examples/inplace.hs | 118 |
1 files changed, 118 insertions, 0 deletions
diff --git a/examples/inplace.hs b/examples/inplace.hs new file mode 100644 index 0000000..d32933a --- /dev/null +++ b/examples/inplace.hs | |||
@@ -0,0 +1,118 @@ | |||
1 | -- some tests of the interface for pure | ||
2 | -- computations with inplace updates | ||
3 | |||
4 | import Numeric.LinearAlgebra | ||
5 | import Data.Packed.ST | ||
6 | import Data.Packed.Convert | ||
7 | |||
8 | import Data.Array.Unboxed | ||
9 | import Data.Array.ST | ||
10 | import Control.Monad.ST | ||
11 | import Control.Monad | ||
12 | |||
13 | main = sequence_[ | ||
14 | print test1, | ||
15 | print test2, | ||
16 | print test3, | ||
17 | print test4, | ||
18 | test5, | ||
19 | test6, | ||
20 | print test7, | ||
21 | test0] | ||
22 | |||
23 | -- helper functions | ||
24 | vector l = fromList l :: Vector Double | ||
25 | norm v = pnorm PNorm2 v | ||
26 | zeros n m = reshape m (constant 0 (n*m)) | ||
27 | newMatrix n m = thawMatrix (zeros n m) | ||
28 | |||
29 | |||
30 | -- hmatrix vector and matrix | ||
31 | v = vector [1..10] | ||
32 | m = (5><10) [1..50::Double] | ||
33 | |||
34 | ---------------------------------------------------------------------- | ||
35 | |||
36 | -- vector creation by in-place updates on a copy of the argument | ||
37 | test1 = fun v | ||
38 | |||
39 | fun :: Element t => Vector t -> Vector t | ||
40 | fun x = runSTVector $ do | ||
41 | a <- thawVector x | ||
42 | mapM_ (flip (modifyVector a) (+57)) [0 .. dim x `div` 2 - 1] | ||
43 | return a | ||
44 | |||
45 | -- another example: creation of an antidiagonal matrix from a list | ||
46 | test2 = antiDiag 5 8 [1..] :: Matrix Double | ||
47 | |||
48 | antiDiag :: (Element b) => Int -> Int -> [b] -> Matrix b | ||
49 | antiDiag r c l = runSTMatrix $ do | ||
50 | m <- newMatrix r c | ||
51 | let d = min r c - 1 | ||
52 | sequence_ $ zipWith (\i v -> writeMatrix m i (c-1-i) v) [0..d] l | ||
53 | return m | ||
54 | |||
55 | -- using vector or matrix functions on mutable objects requires freezing: | ||
56 | test3 = g1 v | ||
57 | |||
58 | g1 x = runST $ do | ||
59 | a <- thawVector x | ||
60 | writeVector a (dim x -1) 0 | ||
61 | b <- freezeVector a | ||
62 | return (norm b) | ||
63 | |||
64 | -- another possibility: | ||
65 | test4 = g2 v | ||
66 | |||
67 | g2 x = runST $ do | ||
68 | a <- thawVector x | ||
69 | writeVector a (dim x -1) 0 | ||
70 | t <- liftSTVector norm a | ||
71 | return t | ||
72 | |||
73 | -------------------------------------------------------------- | ||
74 | |||
75 | -- haskell arrays | ||
76 | hv = listArray (0,9) [1..10::Double] | ||
77 | hm = listArray ((0,0),(4,9)) [1..50::Double] | ||
78 | |||
79 | |||
80 | |||
81 | -- conversion from standard Haskell arrays | ||
82 | test5 = do | ||
83 | print $ norm (vectorFromArray hv) | ||
84 | print $ norm v | ||
85 | print $ rcond (matrixFromArray hm) | ||
86 | print $ rcond m | ||
87 | |||
88 | |||
89 | -- conversion to mutable ST arrays | ||
90 | test6 = do | ||
91 | let y = clearColumn m 1 | ||
92 | print y | ||
93 | print (matrixFromArray y) | ||
94 | |||
95 | clearColumn x c = runSTUArray $ do | ||
96 | a <- mArrayFromMatrix x | ||
97 | forM_ [0..rows x-1] $ \i-> | ||
98 | writeArray a (i,c) (0::Double) | ||
99 | return a | ||
100 | |||
101 | -- hmatrix functions applied to mutable ST arrays | ||
102 | test7 = unitary (listArray (1,4) [3,5,7,2] :: UArray Int Double) | ||
103 | |||
104 | unitary v = runSTUArray $ do | ||
105 | a <- thaw v | ||
106 | n <- norm `fmap` vectorFromMArray a | ||
107 | b <- mapArray (/n) a | ||
108 | return b | ||
109 | |||
110 | ------------------------------------------------- | ||
111 | |||
112 | -- (just to check that they are not affected) | ||
113 | test0 = do | ||
114 | print v | ||
115 | print m | ||
116 | --print hv | ||
117 | --print hm | ||
118 | |||