summaryrefslogtreecommitdiff
path: root/packages/hmatrix/examples/inplace.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/hmatrix/examples/inplace.hs')
-rw-r--r--packages/hmatrix/examples/inplace.hs152
1 files changed, 0 insertions, 152 deletions
diff --git a/packages/hmatrix/examples/inplace.hs b/packages/hmatrix/examples/inplace.hs
deleted file mode 100644
index dcfff56..0000000
--- a/packages/hmatrix/examples/inplace.hs
+++ /dev/null
@@ -1,152 +0,0 @@
1-- some tests of the interface for pure
2-- computations with inplace updates
3
4import Numeric.LinearAlgebra
5import Data.Packed.ST
6import Data.Packed.Convert
7
8import Data.Array.Unboxed
9import Data.Array.ST
10import Control.Monad.ST
11import Control.Monad
12
13main = sequence_[
14 print test1,
15 print test2,
16 print test3,
17 print test4,
18 test5,
19 test6,
20 print test7,
21 test8,
22 test0]
23
24-- helper functions
25vector l = fromList l :: Vector Double
26norm v = pnorm PNorm2 v
27
28-- hmatrix vector and matrix
29v = vector [1..10]
30m = (5><10) [1..50::Double]
31
32----------------------------------------------------------------------
33
34-- vector creation by in-place updates on a copy of the argument
35test1 = fun v
36
37fun :: Element t => Vector t -> Vector t
38fun x = runSTVector $ do
39 a <- thawVector x
40 mapM_ (flip (modifyVector a) (+57)) [0 .. dim x `div` 2 - 1]
41 return a
42
43-- another example: creation of an antidiagonal matrix from a list
44test2 = antiDiag 5 8 [1..] :: Matrix Double
45
46antiDiag :: (Element b) => Int -> Int -> [b] -> Matrix b
47antiDiag r c l = runSTMatrix $ do
48 m <- newMatrix 0 r c
49 let d = min r c - 1
50 sequence_ $ zipWith (\i v -> writeMatrix m i (c-1-i) v) [0..d] l
51 return m
52
53-- using vector or matrix functions on mutable objects requires freezing:
54test3 = g1 v
55
56g1 x = runST $ do
57 a <- thawVector x
58 writeVector a (dim x -1) 0
59 b <- freezeVector a
60 return (norm b)
61
62-- another possibility:
63test4 = g2 v
64
65g2 x = runST $ do
66 a <- thawVector x
67 writeVector a (dim x -1) 0
68 t <- liftSTVector norm a
69 return t
70
71--------------------------------------------------------------
72
73-- haskell arrays
74hv = listArray (0,9) [1..10::Double]
75hm = listArray ((0,0),(4,9)) [1..50::Double]
76
77
78
79-- conversion from standard Haskell arrays
80test5 = do
81 print $ norm (vectorFromArray hv)
82 print $ norm v
83 print $ rcond (matrixFromArray hm)
84 print $ rcond m
85
86
87-- conversion to mutable ST arrays
88test6 = do
89 let y = clearColumn m 1
90 print y
91 print (matrixFromArray y)
92
93clearColumn x c = runSTUArray $ do
94 a <- mArrayFromMatrix x
95 forM_ [0..rows x-1] $ \i->
96 writeArray a (i,c) (0::Double)
97 return a
98
99-- hmatrix functions applied to mutable ST arrays
100test7 = unitary (listArray (1,4) [3,5,7,2] :: UArray Int Double)
101
102unitary v = runSTUArray $ do
103 a <- thaw v
104 n <- norm `fmap` vectorFromMArray a
105 b <- mapArray (/n) a
106 return b
107
108-------------------------------------------------
109
110-- (just to check that they are not affected)
111test0 = do
112 print v
113 print m
114 --print hv
115 --print hm
116
117-------------------------------------------------
118
119histogram n ds = runSTVector $ do
120 h <- newVector (0::Double) n -- number of bins
121 let inc k = modifyVector h k (+1)
122 mapM_ inc ds
123 return h
124
125-- check that newVector is really called with a fresh new array
126histoCheck ds = runSTVector $ do
127 h <- newVector (0::Double) 15 -- > constant for this test
128 let inc k = modifyVector h k (+1)
129 mapM_ inc ds
130 return h
131
132hc = fromList [1 .. 15::Double]
133
134-- check that thawVector creates a new array
135histoCheck2 ds = runSTVector $ do
136 h <- thawVector hc
137 let inc k = modifyVector h k (+1)
138 mapM_ inc ds
139 return h
140
141test8 = do
142 let ds = [0..14]
143 print $ histogram 15 ds
144 print $ histogram 15 ds
145 print $ histogram 15 ds
146 print $ histoCheck ds
147 print $ histoCheck ds
148 print $ histoCheck ds
149 print $ histoCheck2 ds
150 print $ histoCheck2 ds
151 print $ histoCheck2 ds
152 putStrLn "----------------------"