diff options
-rw-r--r-- | examples/inplace.hs | 118 | ||||
-rw-r--r-- | hmatrix.cabal | 1 | ||||
-rw-r--r-- | lib/Data/Packed/Convert.hs | 61 |
3 files changed, 171 insertions, 9 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 | |||
diff --git a/hmatrix.cabal b/hmatrix.cabal index 1dcc21b..5efe7a6 100644 --- a/hmatrix.cabal +++ b/hmatrix.cabal | |||
@@ -86,6 +86,7 @@ library | |||
86 | Graphics.Plot, | 86 | Graphics.Plot, |
87 | Numeric.LinearAlgebra.Tests | 87 | Numeric.LinearAlgebra.Tests |
88 | Data.Packed.Convert | 88 | Data.Packed.Convert |
89 | Data.Packed.ST | ||
89 | other-modules: Data.Packed.Internal, | 90 | other-modules: Data.Packed.Internal, |
90 | Data.Packed.Internal.Common, | 91 | Data.Packed.Internal.Common, |
91 | Data.Packed.Internal.Vector, | 92 | Data.Packed.Internal.Vector, |
diff --git a/lib/Data/Packed/Convert.hs b/lib/Data/Packed/Convert.hs index 55fdf8f..206fa06 100644 --- a/lib/Data/Packed/Convert.hs +++ b/lib/Data/Packed/Convert.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# OPTIONS -XTypeOperators -XRank2Types -XFlexibleContexts #-} | ||
2 | |||
1 | ----------------------------------------------------------------------------- | 3 | ----------------------------------------------------------------------------- |
2 | -- | | 4 | -- | |
3 | -- Module : Data.Packed.Convert | 5 | -- Module : Data.Packed.Convert |
@@ -9,18 +11,26 @@ | |||
9 | -- Portability : portable | 11 | -- Portability : portable |
10 | -- | 12 | -- |
11 | -- Conversion of Vectors and Matrices to and from the standard Haskell arrays. | 13 | -- Conversion of Vectors and Matrices to and from the standard Haskell arrays. |
14 | -- (provisional) | ||
12 | -- | 15 | -- |
13 | ----------------------------------------------------------------------------- | 16 | ----------------------------------------------------------------------------- |
14 | 17 | ||
15 | module Data.Packed.Convert ( | 18 | module Data.Packed.Convert ( |
16 | vectorToStorableArray, | 19 | arrayFromVector, vectorFromArray, |
17 | storableArrayToVector, | 20 | mArrayFromVector, vectorFromMArray, |
18 | -- unsafeUpdateVector, | 21 | vectorToStorableArray, storableArrayToVector, |
22 | arrayFromMatrix, matrixFromArray, | ||
23 | mArrayFromMatrix, matrixFromMArray, | ||
24 | -- matrixToStorableArray, storableArrayToMatrix | ||
19 | ) where | 25 | ) where |
20 | 26 | ||
21 | import Data.Packed.Internal | 27 | import Data.Packed.Internal |
22 | import Data.Array.Storable | 28 | import Data.Array.Storable |
23 | import Foreign | 29 | import Foreign |
30 | import Control.Monad.ST | ||
31 | import Data.Array.ST | ||
32 | import Data.Array.IArray | ||
33 | import Data.Array.Unboxed | ||
24 | 34 | ||
25 | -- | Creates a StorableArray indexed from 0 to dim -1. | 35 | -- | Creates a StorableArray indexed from 0 to dim -1. |
26 | -- (Memory is efficiently copied, so you can then freely modify the obtained array) | 36 | -- (Memory is efficiently copied, so you can then freely modify the obtained array) |
@@ -49,11 +59,44 @@ unsafeVectorToStorableArray v = unsafeForeignPtrToStorableArray (fptr v) (0,dim | |||
49 | --unsafeStorableArrayToVector s = undefined -- the foreign ptr of Storable Array is not available? | 59 | --unsafeStorableArrayToVector s = undefined -- the foreign ptr of Storable Array is not available? |
50 | 60 | ||
51 | ----------------------------------------------------------------- | 61 | ----------------------------------------------------------------- |
62 | -- provisional, we need Unboxed arrays for Complex Double | ||
63 | |||
64 | |||
65 | unsafeFreeze' :: (MArray a e m, Ix i) => a i e -> m (Array i e) | ||
66 | unsafeFreeze' = unsafeFreeze | ||
67 | |||
68 | -- | creates an immutable Array from an hmatrix Vector (to do: unboxed) | ||
69 | arrayFromVector :: (Storable t) => Vector t -> Array Int t | ||
70 | arrayFromVector x = runSTArray (mArrayFromVector x) | ||
71 | |||
72 | -- | creates a mutable array from an hmatrix Vector (to do: unboxed) | ||
73 | mArrayFromVector :: (MArray b t (ST s), Storable t) => Vector t -> ST s (b Int t) | ||
74 | mArrayFromVector v = unsafeThaw =<< unsafeIOToST ( unsafeFreeze' =<< (vectorToStorableArray $ v)) | ||
75 | |||
76 | |||
77 | -- (creates an hmatrix Vector from an immutable array (to do: unboxed)) | ||
78 | vectorFromArray :: (Storable t) => Array Int t -> Vector t | ||
79 | vectorFromArray a = unsafePerformIO $ storableArrayToVector =<< unsafeThaw a | ||
80 | |||
81 | -- | creates a mutable Array from an hmatrix Vector for manipulation with runSTUArray (to do: unboxed) | ||
82 | vectorFromMArray :: (Storable t, MArray a t (ST s)) => a Int t -> ST s (Vector t) | ||
83 | vectorFromMArray x = fmap vectorFromArray (unsafeFreeze' x) | ||
84 | |||
85 | -------------------------------------------------------------------- | ||
86 | -- provisional | ||
87 | |||
88 | matrixFromArray :: UArray (Int, Int) Double -> Matrix Double | ||
89 | matrixFromArray m = reshape c . fromList . elems $ m | ||
90 | where ((r1,c1),(r2,c2)) = bounds m | ||
91 | r = r2-r1+1 | ||
92 | c = c2-c1+1 | ||
93 | |||
94 | arrayFromMatrix :: Matrix Double -> UArray (Int, Int) Double | ||
95 | arrayFromMatrix m = listArray ((0,0),(rows m -1, cols m -1)) (toList $ flatten m) | ||
96 | |||
52 | 97 | ||
98 | mArrayFromMatrix :: (MArray b Double m) => Matrix Double -> m (b (Int, Int) Double) | ||
99 | mArrayFromMatrix = unsafeThaw . arrayFromMatrix | ||
53 | 100 | ||
54 | unsafeUpdateVector :: Storable t => Int -- ^ position | 101 | matrixFromMArray :: (MArray a Double (ST s)) => a (Int,Int) Double -> ST s (Matrix Double) |
55 | -> (t->t) -- ^ modification function | 102 | matrixFromMArray x = fmap matrixFromArray (unsafeFreeze x) |
56 | -> Vector t -- ^ source | ||
57 | -> IO () -- ^ result | ||
58 | unsafeUpdateVector k h v = do | ||
59 | withForeignPtr (fptr v) $ \s -> pokeElemOff s k (h (v`at'`k)) | ||