empty hmatrix-base

1 files changed, 152 insertions, 0 deletions

diff --git a/packages/hmatrix/examples/inplace.hs b/packages/hmatrix/examples/inplace.hs
new file mode 100644
index 0000000..dcfff56
--- /dev/null
+++ b/packages/hmatrix/examples/inplace.hs
@@ -0,0 +1,152 @@
+-- some tests of the interface for pure
+-- computations with inplace updates
+
+import Numeric.LinearAlgebra
+import Data.Packed.ST
+import Data.Packed.Convert
+
+import Data.Array.Unboxed
+import Data.Array.ST
+import Control.Monad.ST
+import Control.Monad
+
+main = sequence_[
+    print test1,
+    print test2,
+    print test3,
+    print test4,
+    test5,
+    test6,
+    print test7,
+    test8,
+    test0]
+
+-- helper functions
+vector l = fromList l :: Vector Double
+norm v = pnorm PNorm2 v
+
+-- hmatrix vector and matrix
+v = vector [1..10]
+m = (5><10) [1..50::Double]
+
+----------------------------------------------------------------------
+
+-- vector creation by in-place updates on a copy of the argument
+test1 = fun v
+
+fun :: Element t => Vector t -> Vector t
+fun x = runSTVector $ do
+    a <- thawVector x
+    mapM_ (flip (modifyVector a) (+57)) [0 .. dim x `div` 2 - 1]
+    return a
+
+-- another example: creation of an antidiagonal matrix from a list
+test2 = antiDiag 5 8 [1..] :: Matrix Double
+
+antiDiag :: (Element b) => Int -> Int -> [b] -> Matrix b
+antiDiag r c l = runSTMatrix $ do
+    m <- newMatrix 0 r c
+    let d = min r c - 1
+    sequence_ $ zipWith (\i v -> writeMatrix m i (c-1-i) v) [0..d] l
+    return m
+
+-- using vector or matrix functions on mutable objects requires freezing:
+test3 = g1 v
+
+g1 x = runST $ do
+    a <- thawVector x
+    writeVector a (dim x -1) 0
+    b <- freezeVector a
+    return (norm b)
+
+--  another possibility:
+test4 = g2 v
+
+g2 x = runST $ do
+    a <- thawVector x
+    writeVector a (dim x -1) 0
+    t <- liftSTVector norm a
+    return t
+
+--------------------------------------------------------------
+
+-- haskell arrays
+hv = listArray (0,9) [1..10::Double]
+hm = listArray ((0,0),(4,9)) [1..50::Double]
+
+
+
+-- conversion from standard Haskell arrays
+test5 = do
+    print $ norm (vectorFromArray hv)
+    print $ norm v
+    print $ rcond (matrixFromArray hm)
+    print $ rcond m
+
+
+-- conversion to mutable ST arrays
+test6 = do
+    let y = clearColumn m 1
+    print y
+    print (matrixFromArray y)
+
+clearColumn x c = runSTUArray $ do
+    a <- mArrayFromMatrix x
+    forM_ [0..rows x-1] $ \i->
+        writeArray a (i,c) (0::Double)
+    return a
+
+-- hmatrix functions applied to mutable ST arrays
+test7 = unitary (listArray (1,4) [3,5,7,2] :: UArray Int Double)
+
+unitary v = runSTUArray $ do
+    a <- thaw v
+    n <- norm `fmap` vectorFromMArray a
+    b <- mapArray (/n) a
+    return b
+
+-------------------------------------------------
+
+-- (just to check that they are not affected)
+test0 = do
+    print v
+    print m
+    --print hv
+    --print hm
+
+-------------------------------------------------
+
+histogram n ds = runSTVector $ do
+    h <- newVector (0::Double) n -- number of bins
+    let inc k = modifyVector h k (+1)
+    mapM_ inc ds
+    return h
+
+-- check that newVector is really called with a fresh new array
+histoCheck ds = runSTVector $ do
+    h <- newVector (0::Double) 15 -- > constant for this test
+    let inc k = modifyVector h k (+1)
+    mapM_ inc ds
+    return h
+
+hc = fromList [1 .. 15::Double]
+
+-- check that thawVector creates a new array
+histoCheck2 ds = runSTVector $ do
+    h <- thawVector hc
+    let inc k = modifyVector h k (+1)
+    mapM_ inc ds
+    return h
+
+test8 = do
+    let ds = [0..14]
+    print $ histogram 15 ds
+    print $ histogram 15 ds
+    print $ histogram 15 ds
+    print $ histoCheck ds
+    print $ histoCheck ds
+    print $ histoCheck ds
+    print $ histoCheck2 ds
+    print $ histoCheck2 ds
+    print $ histoCheck2 ds
+    putStrLn "----------------------"