diff options
-rw-r--r-- | examples/benchmarks.hs | 151 | ||||
-rw-r--r-- | examples/latexmat.hs | 11 | ||||
-rw-r--r-- | examples/pca1.hs | 15 | ||||
-rw-r--r-- | examples/pca2.hs | 28 | ||||
-rw-r--r-- | examples/pinv.hs | 2 | ||||
-rw-r--r-- | hmatrix.cabal | 5 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Util.hs | 122 |
7 files changed, 22 insertions, 312 deletions
diff --git a/examples/benchmarks.hs b/examples/benchmarks.hs deleted file mode 100644 index d7f8c40..0000000 --- a/examples/benchmarks.hs +++ /dev/null | |||
@@ -1,151 +0,0 @@ | |||
1 | {-# LANGUAGE BangPatterns #-} | ||
2 | |||
3 | -- $ ghc --make -O2 benchmarks.hs | ||
4 | |||
5 | |||
6 | import Numeric.LinearAlgebra | ||
7 | import System.Time | ||
8 | import System.CPUTime | ||
9 | import Text.Printf | ||
10 | import Data.List(foldl1') | ||
11 | |||
12 | |||
13 | time act = do | ||
14 | t0 <- getCPUTime | ||
15 | act | ||
16 | t1 <- getCPUTime | ||
17 | printf "%.3f s CPU\n" $ (fromIntegral (t1 - t0) / (10^12 :: Double)) :: IO () | ||
18 | |||
19 | -------------------------------------------------------------------------------- | ||
20 | |||
21 | main = sequence_ [bench1, | ||
22 | bench2, | ||
23 | bench4, | ||
24 | bench5 1000000 3, bench5 100000 50, | ||
25 | bench6 100 (100000::Double), bench6 100000 (100::Double), bench6 10000 (1000::Double)] | ||
26 | |||
27 | w :: Vector Double | ||
28 | w = constant 1 5000000 | ||
29 | w2 = 1 * w | ||
30 | |||
31 | v = flatten $ ident 500 :: Vector Double | ||
32 | |||
33 | |||
34 | bench1 = do | ||
35 | time $ print$ vectorMax (w+w2) -- evaluate it | ||
36 | putStrLn "Sum of a vector with 5M doubles:" | ||
37 | print$ vectorMax (w+w2) -- evaluate it | ||
38 | time $ printf " BLAS: %.2f: " $ sumVB w | ||
39 | time $ printf "BLAS only dot: %.2f: " $ w <.> w2 | ||
40 | time $ printf " Haskell: %.2f: " $ sumVH w | ||
41 | time $ printf " innerH: %.2f: " $ innerH w w2 | ||
42 | time $ printf "foldVector: %.2f: " $ sumVector w | ||
43 | let getPos k s = if k `mod` 500 < 200 && w@>k > 0 then k:s else s | ||
44 | putStrLn "foldLoop for element selection:" | ||
45 | time $ print $ (`divMod` 500) $ maximum $ foldLoop getPos [] (dim w) | ||
46 | putStrLn "constant 5M:" | ||
47 | time $ print $ constant (1::Double) 5000001 @> 7 | ||
48 | time $ print $ constant i 5000001 @> 7 | ||
49 | time $ print $ conj (constant i 5000001) @> 7 | ||
50 | putStrLn "zips C vs H:" | ||
51 | time $ print $ (w / w2) @> 7 | ||
52 | time $ print $ (zipVector (/) w w2) @> 7 | ||
53 | putStrLn "folds C/BLAS vs H:" | ||
54 | let t = constant (1::Double) 5000002 | ||
55 | print $ t @> 7 | ||
56 | time $ print $ foldVector max (t@>0) t | ||
57 | time $ print $ vectorMax t | ||
58 | time $ print $ sqrt $ foldVector (\v s -> v*v+s) 0 t | ||
59 | time $ print $ pnorm PNorm2 t | ||
60 | putStrLn "scale C/BLAS vs H:" | ||
61 | time $ print $ mapVector (*2) t @> 7 | ||
62 | time $ print $ (2 * t) @> 7 | ||
63 | |||
64 | sumVB v = constant 1 (dim v) <.> v | ||
65 | |||
66 | sumVH v = go (d - 1) 0 | ||
67 | where | ||
68 | d = dim v | ||
69 | go :: Int -> Double -> Double | ||
70 | go 0 s = s + (v @> 0) | ||
71 | go !j !s = go (j - 1) (s + (v @> j)) | ||
72 | |||
73 | innerH u v = go (d - 1) 0 | ||
74 | where | ||
75 | d = min (dim u) (dim v) | ||
76 | go :: Int -> Double -> Double | ||
77 | go 0 s = s + (u @> 0) * (v @> 0) | ||
78 | go !j !s = go (j - 1) (s + (u @> j) * (v @> j)) | ||
79 | |||
80 | |||
81 | -- sumVector = foldVectorG (\k v s -> v k + s) 0.0 | ||
82 | sumVector = foldVector (+) 0.0 | ||
83 | |||
84 | -------------------------------------------------------------------------------- | ||
85 | |||
86 | bench2 = do | ||
87 | putStrLn "-------------------------------------------------------" | ||
88 | putStrLn "Multiplication of 1M different 3x3 matrices:" | ||
89 | -- putStrLn "from [[]]" | ||
90 | -- time $ print $ manymult (10^6) rot' | ||
91 | -- putStrLn "from (3><3) []" | ||
92 | time $ print $ manymult (10^6) rot | ||
93 | print $ cos (10^6/2) | ||
94 | |||
95 | |||
96 | rot' :: Double -> Matrix Double | ||
97 | rot' a = matrix [[ c,0,s], | ||
98 | [ 0,1,0], | ||
99 | [-s,0,c]] | ||
100 | where c = cos a | ||
101 | s = sin a | ||
102 | matrix = fromLists | ||
103 | |||
104 | rot :: Double -> Matrix Double | ||
105 | rot a = (3><3) [ c,0,s | ||
106 | , 0,1,0 | ||
107 | ,-s,0,c ] | ||
108 | where c = cos a | ||
109 | s = sin a | ||
110 | |||
111 | manymult n r = foldl1' (<>) (map r angles) | ||
112 | where angles = toList $ linspace n (0,1) | ||
113 | -- angles = map (k*) [0..n'] | ||
114 | -- n' = fromIntegral n - 1 | ||
115 | -- k = recip n' | ||
116 | |||
117 | -------------------------------------------------------------------------------- | ||
118 | |||
119 | bench4 = do | ||
120 | putStrLn "-------------------------------------------------------" | ||
121 | putStrLn "1000x1000 inverse" | ||
122 | let a = ident 1000 :: Matrix Double | ||
123 | let b = 2*a | ||
124 | print $ vectorMax $ flatten (a+b) -- evaluate it | ||
125 | time $ print $ vectorMax $ flatten $ linearSolve a b | ||
126 | |||
127 | -------------------------------------------------------------------------------- | ||
128 | |||
129 | op1 a b = a <> trans b | ||
130 | op2 a b = a + trans b | ||
131 | |||
132 | timep = time . print . vectorMax . flatten | ||
133 | |||
134 | bench5 n d = do | ||
135 | putStrLn "-------------------------------------------------------" | ||
136 | putStrLn "transpose in add" | ||
137 | let ms = replicate n ((ident d :: Matrix Double)) | ||
138 | timep $ foldl1' (+) ms | ||
139 | timep $ foldl1' op2 ms | ||
140 | putStrLn "-------------------------------------------------------" | ||
141 | putStrLn "transpose in multiply" | ||
142 | |||
143 | timep $ foldl1' (<>) ms | ||
144 | timep $ foldl1' op1 ms | ||
145 | |||
146 | -------------------------------------------------------------------------------- | ||
147 | |||
148 | bench6 sz n = do | ||
149 | putStrLn "-------------------------------------------------------" | ||
150 | putStrLn "many constants" | ||
151 | time $ print $ sum $ map ((@>0). flip constant sz) [1..n] \ No newline at end of file | ||
diff --git a/examples/latexmat.hs b/examples/latexmat.hs deleted file mode 100644 index d912a28..0000000 --- a/examples/latexmat.hs +++ /dev/null | |||
@@ -1,11 +0,0 @@ | |||
1 | import Numeric.LinearAlgebra | ||
2 | import Text.Printf | ||
3 | |||
4 | disp w l fmt m = unlines $ map (++l) $ lines $ format w (printf fmt) m | ||
5 | |||
6 | latex fmt m = "\\begin{bmatrix}\n" ++ disp " & " " \\\\" fmt m ++ "\\end{bmatrix}" | ||
7 | |||
8 | main = do | ||
9 | let m = (3><4) [1..12::Double] | ||
10 | putStrLn $ disp " | " "" "%.2f" m | ||
11 | putStrLn $ latex "%.3f" m | ||
diff --git a/examples/pca1.hs b/examples/pca1.hs index 775bb4c..58b5577 100644 --- a/examples/pca1.hs +++ b/examples/pca1.hs | |||
@@ -8,15 +8,14 @@ import Control.Monad(when) | |||
8 | type Vec = Vector Double | 8 | type Vec = Vector Double |
9 | type Mat = Matrix Double | 9 | type Mat = Matrix Double |
10 | 10 | ||
11 | sumColumns m = constant 1 (rows m) <> m | ||
12 | 11 | ||
13 | -- Vec with the mean value of the columns of a Mat | 12 | -- Vector with the mean value of the columns of a matrix |
14 | mean x = sumColumns x / fromIntegral (rows x) | 13 | mean a = constant (recip . fromIntegral . rows $ a) (rows a) <> a |
14 | |||
15 | -- covariance matrix of a list of observations stored as rows | ||
16 | cov x = (trans xc <> xc) / fromIntegral (rows x - 1) | ||
17 | where xc = x - asRow (mean x) | ||
15 | 18 | ||
16 | -- covariance Mat of a list of observations as rows of a Mat | ||
17 | cov x = (trans xc <> xc) / fromIntegral (rows x -1) | ||
18 | where xc = center x | ||
19 | center m = m - constant 1 (rows m) `outer` mean m | ||
20 | 19 | ||
21 | -- creates the compression and decompression functions from the desired number of components | 20 | -- creates the compression and decompression functions from the desired number of components |
22 | pca :: Int -> Mat -> (Vec -> Vec , Vec -> Vec) | 21 | pca :: Int -> Mat -> (Vec -> Vec , Vec -> Vec) |
@@ -38,7 +37,7 @@ main = do | |||
38 | system("wget -nv http://dis.um.es/~alberto/material/sp/mnist.txt.gz") | 37 | system("wget -nv http://dis.um.es/~alberto/material/sp/mnist.txt.gz") |
39 | system("gunzip mnist.txt.gz") | 38 | system("gunzip mnist.txt.gz") |
40 | return () | 39 | return () |
41 | m <- fromFile "mnist.txt" (5000,785) | 40 | m <- loadMatrix "mnist.txt" -- fromFile "mnist.txt" (5000,785) |
42 | let xs = takeColumns (cols m -1) m -- the last column is the digit type (class label) | 41 | let xs = takeColumns (cols m -1) m -- the last column is the digit type (class label) |
43 | let x = toRows xs !! 4 -- an arbitrary test Vec | 42 | let x = toRows xs !! 4 -- an arbitrary test Vec |
44 | let (pe,pd) = pca 10 xs | 43 | let (pe,pd) = pca 10 xs |
diff --git a/examples/pca2.hs b/examples/pca2.hs index 8c20370..c38857c 100644 --- a/examples/pca2.hs +++ b/examples/pca2.hs | |||
@@ -9,33 +9,31 @@ import Control.Monad(when) | |||
9 | type Vec = Vector Double | 9 | type Vec = Vector Double |
10 | type Mat = Matrix Double | 10 | type Mat = Matrix Double |
11 | 11 | ||
12 | sumColumns m = constant 1 (rows m) <> m | 12 | -- Vector with the mean value of the columns of a matrix |
13 | mean a = constant (recip . fromIntegral . rows $ a) (rows a) <> a | ||
13 | 14 | ||
14 | -- Vector with the mean value of the columns of a Mat | 15 | -- covariance matrix of a list of observations stored as rows |
15 | mean x = sumColumns x / fromIntegral (rows x) | 16 | cov x = (trans xc <> xc) / fromIntegral (rows x - 1) |
17 | where xc = x - asRow (mean x) | ||
16 | 18 | ||
17 | -- covariance matrix of a list of observations as rows of a matrix | ||
18 | cov x = (trans xc <> xc) / fromIntegral (rows x -1) | ||
19 | where xc = center x | ||
20 | center m = m - constant 1 (rows m) `outer` mean m | ||
21 | 19 | ||
22 | type Stat = (Vec, [Double], Mat) | 20 | type Stat = (Vec, [Double], Mat) |
23 | -- 1st and 2nd order statistics of a dataset (mean, eigenvalues and eigenvectors of cov) | 21 | -- 1st and 2nd order statistics of a dataset (mean, eigenvalues and eigenvectors of cov) |
24 | stat :: Mat -> Stat | 22 | stat :: Mat -> Stat |
25 | stat x = (m, toList s, trans v) where | 23 | stat x = (m, toList s, trans v) where |
26 | m = mean x | 24 | m = mean x |
27 | (s,v) = eigSH' (cov x) | 25 | (s,v) = eigSH' (cov x) |
28 | 26 | ||
29 | -- creates the compression and decompression functions from the desired reconstruction | 27 | -- creates the compression and decompression functions from the desired reconstruction |
30 | -- quality and the statistics of a data set | 28 | -- quality and the statistics of a data set |
31 | pca :: Double -> Stat -> (Vec -> Vec , Vec -> Vec) | 29 | pca :: Double -> Stat -> (Vec -> Vec , Vec -> Vec) |
32 | pca prec (m,s,v) = (encode,decode) | 30 | pca prec (m,s,v) = (encode,decode) |
33 | where | 31 | where |
34 | encode x = vp <> (x - m) | 32 | encode x = vp <> (x - m) |
35 | decode x = x <> vp + m | 33 | decode x = x <> vp + m |
36 | vp = takeRows n v | 34 | vp = takeRows n v |
37 | n = 1 + (length $ fst $ span (< (prec'*sum s)) $ cumSum s) | 35 | n = 1 + (length $ fst $ span (< (prec'*sum s)) $ cumSum s) |
38 | cumSum = tail . scanl (+) 0.0 | 36 | cumSum = tail . scanl (+) 0.0 |
39 | prec' = if prec <=0.0 || prec >= 1.0 | 37 | prec' = if prec <=0.0 || prec >= 1.0 |
40 | then error "the precision in pca must be 0<prec<1" | 38 | then error "the precision in pca must be 0<prec<1" |
41 | else prec | 39 | else prec |
@@ -49,7 +47,7 @@ test st prec x = do | |||
49 | let (pe,pd) = pca prec st | 47 | let (pe,pd) = pca prec st |
50 | let y = pe x | 48 | let y = pe x |
51 | print $ dim y | 49 | print $ dim y |
52 | shdigit (pd y) | 50 | shdigit (pd y) |
53 | 51 | ||
54 | main = do | 52 | main = do |
55 | ok <- doesFileExist ("mnist.txt") | 53 | ok <- doesFileExist ("mnist.txt") |
@@ -58,7 +56,7 @@ main = do | |||
58 | system("wget -nv http://dis.um.es/~alberto/material/sp/mnist.txt.gz") | 56 | system("wget -nv http://dis.um.es/~alberto/material/sp/mnist.txt.gz") |
59 | system("gunzip mnist.txt.gz") | 57 | system("gunzip mnist.txt.gz") |
60 | return () | 58 | return () |
61 | m <- fromFile "mnist.txt" (5000,785) | 59 | m <- loadMatrix "mnist.txt" |
62 | let xs = takeColumns (cols m -1) m | 60 | let xs = takeColumns (cols m -1) m |
63 | let x = toRows xs !! 4 -- an arbitrary test vector | 61 | let x = toRows xs !! 4 -- an arbitrary test vector |
64 | shdigit x | 62 | shdigit x |
diff --git a/examples/pinv.hs b/examples/pinv.hs index cab8fc6..7de50b8 100644 --- a/examples/pinv.hs +++ b/examples/pinv.hs | |||
@@ -3,7 +3,7 @@ import Graphics.Plot | |||
3 | import Text.Printf(printf) | 3 | import Text.Printf(printf) |
4 | 4 | ||
5 | expand :: Int -> Vector Double -> Matrix Double | 5 | expand :: Int -> Vector Double -> Matrix Double |
6 | expand n x = fromColumns $ constant 1 (dim x): map (x^) [1 .. n] | 6 | expand n x = fromColumns $ map (x^) [0 .. n] |
7 | 7 | ||
8 | polynomialModel :: Vector Double -> Vector Double -> Int | 8 | polynomialModel :: Vector Double -> Vector Double -> Int |
9 | -> (Vector Double -> Vector Double) | 9 | -> (Vector Double -> Vector Double) |
diff --git a/hmatrix.cabal b/hmatrix.cabal index 49d7b05..0fb772f 100644 --- a/hmatrix.cabal +++ b/hmatrix.cabal | |||
@@ -33,9 +33,7 @@ extra-source-files: examples/tests.hs | |||
33 | examples/kalman.hs | 33 | examples/kalman.hs |
34 | examples/parallel.hs | 34 | examples/parallel.hs |
35 | examples/plot.hs | 35 | examples/plot.hs |
36 | examples/latexmat.hs | ||
37 | examples/inplace.hs | 36 | examples/inplace.hs |
38 | examples/benchmarks.hs | ||
39 | examples/error.hs | 37 | examples/error.hs |
40 | examples/devel/wrappers.hs | 38 | examples/devel/wrappers.hs |
41 | examples/devel/functions.c | 39 | examples/devel/functions.c |
@@ -128,8 +126,7 @@ library | |||
128 | Data.Packed.Convert, | 126 | Data.Packed.Convert, |
129 | Data.Packed.ST, | 127 | Data.Packed.ST, |
130 | Data.Packed.Development, | 128 | Data.Packed.Development, |
131 | Data.Packed.Random, | 129 | Data.Packed.Random |
132 | Numeric.LinearAlgebra.Util | ||
133 | other-modules: Data.Packed.Internal, | 130 | other-modules: Data.Packed.Internal, |
134 | Data.Packed.Internal.Common, | 131 | Data.Packed.Internal.Common, |
135 | Data.Packed.Internal.Signatures, | 132 | Data.Packed.Internal.Signatures, |
diff --git a/lib/Numeric/LinearAlgebra/Util.hs b/lib/Numeric/LinearAlgebra/Util.hs deleted file mode 100644 index 24317e3..0000000 --- a/lib/Numeric/LinearAlgebra/Util.hs +++ /dev/null | |||
@@ -1,122 +0,0 @@ | |||
1 | ----------------------------------------------------------------------------- | ||
2 | {- | | ||
3 | Module : Numeric.LinearAlgebra.Util | ||
4 | Copyright : (c) Alberto Ruiz 2010 | ||
5 | License : GPL | ||
6 | |||
7 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
8 | Stability : provisional | ||
9 | Portability : portable | ||
10 | |||
11 | Alternative interface and utilities for creation of real arrays, useful to work in interactive mode. | ||
12 | |||
13 | -} | ||
14 | ----------------------------------------------------------------------------- | ||
15 | |||
16 | module Numeric.LinearAlgebra.Util( | ||
17 | module Numeric.LinearAlgebra, | ||
18 | (<>), (*>), (<*), (<\>), (\>), | ||
19 | vector, | ||
20 | eye, | ||
21 | zeros, ones, | ||
22 | diagl, | ||
23 | row, | ||
24 | col, | ||
25 | (#),(&), (//), blocks, | ||
26 | rand, | ||
27 | splitEvery, | ||
28 | table | ||
29 | ) where | ||
30 | |||
31 | import Numeric.LinearAlgebra hiding ((<>), (<|>), (<->), (<\>), (.*), (*/)) | ||
32 | import Data.Packed.Internal.Common(table,splitEvery) | ||
33 | import System.Random(randomIO) | ||
34 | |||
35 | infixl 7 <> | ||
36 | -- | Matrix product ('multiply') | ||
37 | (<>) :: Field t => Matrix t -> Matrix t -> Matrix t | ||
38 | (<>) = multiply | ||
39 | |||
40 | infixl 7 *> | ||
41 | -- | matrix x vector | ||
42 | (*>) :: Field t => Matrix t -> Vector t -> Vector t | ||
43 | m *> v = flatten $ m <> (asColumn v) | ||
44 | |||
45 | infixl 7 <* | ||
46 | -- | vector x matrix | ||
47 | (<*) :: Field t => Vector t -> Matrix t -> Vector t | ||
48 | v <* m = flatten $ (asRow v) <> m | ||
49 | |||
50 | |||
51 | -- | Least squares solution of a linear system for several right-hand sides, similar to the \\ operator of Matlab\/Octave. (\<\\\>) = 'linearSolveSVD'. | ||
52 | (<\>) :: (Field a) => Matrix a -> Matrix a -> Matrix a | ||
53 | infixl 7 <\> | ||
54 | (<\>) = linearSolveSVD | ||
55 | |||
56 | -- | Least squares solution of a linear system for a single right-hand side. See '(\<\\\>)'. | ||
57 | (\>) :: (Field a) => Matrix a -> Vector a -> Vector a | ||
58 | infixl 7 \> | ||
59 | m \> v = flatten (m <\> reshape 1 v) | ||
60 | |||
61 | -- | Pseudorandom matrix with uniform elements between 0 and 1. | ||
62 | rand :: Int -- ^ rows | ||
63 | -> Int -- ^ columns | ||
64 | -> IO (Matrix Double) | ||
65 | rand r c = do | ||
66 | seed <- randomIO | ||
67 | return (reshape c $ randomVector seed Uniform (r*c)) | ||
68 | |||
69 | -- | Real identity matrix. | ||
70 | eye :: Int -> Matrix Double | ||
71 | eye = ident | ||
72 | |||
73 | -- | Create a real vector from a list. | ||
74 | vector :: [Double] -> Vector Double | ||
75 | vector = fromList | ||
76 | |||
77 | -- | Create a real diagonal matrix from a list. | ||
78 | diagl :: [Double] -> Matrix Double | ||
79 | diagl = diag . vector | ||
80 | |||
81 | -- | Create a matrix or zeros. | ||
82 | zeros :: Int -- ^ rows | ||
83 | -> Int -- ^ columns | ||
84 | -> Matrix Double | ||
85 | zeros r c = reshape c (constant 0 (r*c)) | ||
86 | |||
87 | -- | Create a matrix or ones. | ||
88 | ones :: Int -- ^ rows | ||
89 | -> Int -- ^ columns | ||
90 | -> Matrix Double | ||
91 | ones r c = reshape c (constant 1 (r*c)) | ||
92 | |||
93 | |||
94 | -- | Concatenation of real vectors. | ||
95 | infixl 9 # | ||
96 | (#) :: Vector Double -> Vector Double -> Vector Double | ||
97 | a # b = join [a,b] | ||
98 | |||
99 | |||
100 | -- | Horizontal concatenation of real matrices. | ||
101 | infixl 8 & | ||
102 | (&) :: Matrix Double -> Matrix Double -> Matrix Double | ||
103 | a & b = fromBlocks [[a,b]] | ||
104 | |||
105 | -- | Vertical concatenation of real matrices. | ||
106 | infixl 7 // | ||
107 | (//) :: Matrix Double -> Matrix Double -> Matrix Double | ||
108 | a // b = fromBlocks [[a],[b]] | ||
109 | |||
110 | -- | Real block matrix from a rectangular list of lists. | ||
111 | blocks :: [[Matrix Double]] -> Matrix Double | ||
112 | blocks = fromBlocks | ||
113 | |||
114 | -- | A real matrix with a single row, create from a list of elements. | ||
115 | row :: [Double] -> Matrix Double | ||
116 | row = asRow . vector | ||
117 | |||
118 | -- | A real matrix with a single column, created from a list of elements. | ||
119 | col :: [Double] -> Matrix Double | ||
120 | col = asColumn . vector | ||
121 | |||
122 | |||