summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples/benchmarks.hs151
-rw-r--r--examples/latexmat.hs11
-rw-r--r--examples/pca1.hs15
-rw-r--r--examples/pca2.hs28
-rw-r--r--examples/pinv.hs2
-rw-r--r--hmatrix.cabal5
-rw-r--r--lib/Numeric/LinearAlgebra/Util.hs122
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
6import Numeric.LinearAlgebra
7import System.Time
8import System.CPUTime
9import Text.Printf
10import Data.List(foldl1')
11
12
13time 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
21main = 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
27w :: Vector Double
28w = constant 1 5000000
29w2 = 1 * w
30
31v = flatten $ ident 500 :: Vector Double
32
33
34bench1 = 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
64sumVB v = constant 1 (dim v) <.> v
65
66sumVH 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
73innerH 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
82sumVector = foldVector (+) 0.0
83
84--------------------------------------------------------------------------------
85
86bench2 = 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
96rot' :: Double -> Matrix Double
97rot' 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
104rot :: Double -> Matrix Double
105rot a = (3><3) [ c,0,s
106 , 0,1,0
107 ,-s,0,c ]
108 where c = cos a
109 s = sin a
110
111manymult 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
119bench4 = 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
129op1 a b = a <> trans b
130op2 a b = a + trans b
131
132timep = time . print . vectorMax . flatten
133
134bench5 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
148bench6 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 @@
1import Numeric.LinearAlgebra
2import Text.Printf
3
4disp w l fmt m = unlines $ map (++l) $ lines $ format w (printf fmt) m
5
6latex fmt m = "\\begin{bmatrix}\n" ++ disp " & " " \\\\" fmt m ++ "\\end{bmatrix}"
7
8main = 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)
8type Vec = Vector Double 8type Vec = Vector Double
9type Mat = Matrix Double 9type Mat = Matrix Double
10 10
11sumColumns 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
14mean x = sumColumns x / fromIntegral (rows x) 13mean a = constant (recip . fromIntegral . rows $ a) (rows a) <> a
14
15-- covariance matrix of a list of observations stored as rows
16cov 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
17cov 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
22pca :: Int -> Mat -> (Vec -> Vec , Vec -> Vec) 21pca :: 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)
9type Vec = Vector Double 9type Vec = Vector Double
10type Mat = Matrix Double 10type Mat = Matrix Double
11 11
12sumColumns m = constant 1 (rows m) <> m 12-- Vector with the mean value of the columns of a matrix
13mean 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
15mean x = sumColumns x / fromIntegral (rows x) 16cov 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
18cov 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
22type Stat = (Vec, [Double], Mat) 20type 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)
24stat :: Mat -> Stat 22stat :: Mat -> Stat
25stat x = (m, toList s, trans v) where 23stat 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
31pca :: Double -> Stat -> (Vec -> Vec , Vec -> Vec) 29pca :: Double -> Stat -> (Vec -> Vec , Vec -> Vec)
32pca prec (m,s,v) = (encode,decode) 30pca 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
54main = do 52main = 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
3import Text.Printf(printf) 3import Text.Printf(printf)
4 4
5expand :: Int -> Vector Double -> Matrix Double 5expand :: Int -> Vector Double -> Matrix Double
6expand n x = fromColumns $ constant 1 (dim x): map (x^) [1 .. n] 6expand n x = fromColumns $ map (x^) [0 .. n]
7 7
8polynomialModel :: Vector Double -> Vector Double -> Int 8polynomialModel :: 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{- |
3Module : Numeric.LinearAlgebra.Util
4Copyright : (c) Alberto Ruiz 2010
5License : GPL
6
7Maintainer : Alberto Ruiz (aruiz at um dot es)
8Stability : provisional
9Portability : portable
10
11Alternative interface and utilities for creation of real arrays, useful to work in interactive mode.
12
13-}
14-----------------------------------------------------------------------------
15
16module 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
31import Numeric.LinearAlgebra hiding ((<>), (<|>), (<->), (<\>), (.*), (*/))
32import Data.Packed.Internal.Common(table,splitEvery)
33import System.Random(randomIO)
34
35infixl 7 <>
36-- | Matrix product ('multiply')
37(<>) :: Field t => Matrix t -> Matrix t -> Matrix t
38(<>) = multiply
39
40infixl 7 *>
41-- | matrix x vector
42(*>) :: Field t => Matrix t -> Vector t -> Vector t
43m *> v = flatten $ m <> (asColumn v)
44
45infixl 7 <*
46-- | vector x matrix
47(<*) :: Field t => Vector t -> Matrix t -> Vector t
48v <* 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
53infixl 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
58infixl 7 \>
59m \> v = flatten (m <\> reshape 1 v)
60
61-- | Pseudorandom matrix with uniform elements between 0 and 1.
62rand :: Int -- ^ rows
63 -> Int -- ^ columns
64 -> IO (Matrix Double)
65rand r c = do
66 seed <- randomIO
67 return (reshape c $ randomVector seed Uniform (r*c))
68
69-- | Real identity matrix.
70eye :: Int -> Matrix Double
71eye = ident
72
73-- | Create a real vector from a list.
74vector :: [Double] -> Vector Double
75vector = fromList
76
77-- | Create a real diagonal matrix from a list.
78diagl :: [Double] -> Matrix Double
79diagl = diag . vector
80
81-- | Create a matrix or zeros.
82zeros :: Int -- ^ rows
83 -> Int -- ^ columns
84 -> Matrix Double
85zeros r c = reshape c (constant 0 (r*c))
86
87-- | Create a matrix or ones.
88ones :: Int -- ^ rows
89 -> Int -- ^ columns
90 -> Matrix Double
91ones r c = reshape c (constant 1 (r*c))
92
93
94-- | Concatenation of real vectors.
95infixl 9 #
96(#) :: Vector Double -> Vector Double -> Vector Double
97a # b = join [a,b]
98
99
100-- | Horizontal concatenation of real matrices.
101infixl 8 &
102(&) :: Matrix Double -> Matrix Double -> Matrix Double
103a & b = fromBlocks [[a,b]]
104
105-- | Vertical concatenation of real matrices.
106infixl 7 //
107(//) :: Matrix Double -> Matrix Double -> Matrix Double
108a // b = fromBlocks [[a],[b]]
109
110-- | Real block matrix from a rectangular list of lists.
111blocks :: [[Matrix Double]] -> Matrix Double
112blocks = fromBlocks
113
114-- | A real matrix with a single row, create from a list of elements.
115row :: [Double] -> Matrix Double
116row = asRow . vector
117
118-- | A real matrix with a single column, created from a list of elements.
119col :: [Double] -> Matrix Double
120col = asColumn . vector
121
122