diff options
Diffstat (limited to 'packages')
43 files changed, 594 insertions, 717 deletions
diff --git a/packages/Makefile b/packages/Makefile index e9d8586..b00d71f 100644 --- a/packages/Makefile +++ b/packages/Makefile | |||
@@ -1,22 +1,26 @@ | |||
1 | pkgs=base gsl special glpk tests ../../hTensor ../../easyVision/packages/base | 1 | pkgs=base gsl special glpk tests ../../hTensor ../../easyVision/packages/tools ../../easyVision/packages/base |
2 | |||
3 | mkl=--extra-include-dirs=$(MKL) --extra-lib-dirs=$(MKL) | ||
4 | |||
5 | cabalcmd = \ | ||
6 | for p in $(1); do \ | ||
7 | if [ -e $$p ]; then \ | ||
8 | cd $$p; cabal $(2) ; cd -; \ | ||
9 | fi; \ | ||
10 | done; \ | ||
11 | cd sparse; \ | ||
12 | cabal $(3) $(2); cd -; | ||
13 | |||
2 | 14 | ||
3 | all: | 15 | all: |
4 | for p in $(pkgs); do \ | 16 | $(call cabalcmd, $(pkgs), install --force-reinstall --enable-documentation, $(mkl)) |
5 | if [ -e $$p ]; then \ | ||
6 | cd $$p; cabal install --force-reinstall --enable-documentation ; cd -; \ | ||
7 | fi; \ | ||
8 | done | ||
9 | cd sparse; \ | ||
10 | cabal install --extra-include-dirs=$(MKL) --extra-lib-dirs=$(MKL) \ | ||
11 | --force-reinstall --enable-documentation ; cd -; | ||
12 | 17 | ||
13 | fast: | 18 | fast: |
14 | for p in $(pkgs); do \ | 19 | $(call cabalcmd, $(pkgs), install --force-reinstall, $(mkl)) |
15 | if [ -e $$p ]; then \ | 20 | |
16 | cd $$p; cabal install --force-reinstall ; cd -; \ | 21 | clean: |
17 | fi; \ | 22 | $(call cabalcmd, $(pkgs), clean) |
18 | done | 23 | |
19 | cd sparse; \ | 24 | prof: |
20 | cabal install --extra-include-dirs=$(MKL) --extra-lib-dirs=$(MKL) \ | 25 | $(call cabalcmd, $(pkgs), install --force-reinstall --enable-library-profiling, $(mkl)) |
21 | --force-reinstall; cd -; | ||
22 | 26 | ||
diff --git a/packages/base/CHANGELOG b/packages/base/CHANGELOG index c137285..ce19c97 100644 --- a/packages/base/CHANGELOG +++ b/packages/base/CHANGELOG | |||
@@ -1,3 +1,10 @@ | |||
1 | 0.17.0.0 | ||
2 | -------- | ||
3 | |||
4 | * old compatibility modules removed | ||
5 | |||
6 | * added "unitary" and "pairwiseD2" | ||
7 | |||
1 | 0.16.1.0 | 8 | 0.16.1.0 |
2 | -------- | 9 | -------- |
3 | 10 | ||
diff --git a/packages/base/hmatrix.cabal b/packages/base/hmatrix.cabal index 3895dc1..7bfc762 100644 --- a/packages/base/hmatrix.cabal +++ b/packages/base/hmatrix.cabal | |||
@@ -1,5 +1,5 @@ | |||
1 | Name: hmatrix | 1 | Name: hmatrix |
2 | Version: 0.16.1.5 | 2 | Version: 0.17.0.0 |
3 | License: BSD3 | 3 | License: BSD3 |
4 | License-file: LICENSE | 4 | License-file: LICENSE |
5 | Author: Alberto Ruiz | 5 | Author: Alberto Ruiz |
@@ -9,16 +9,6 @@ Homepage: https://github.com/albertoruiz/hmatrix | |||
9 | Synopsis: Numeric Linear Algebra | 9 | Synopsis: Numeric Linear Algebra |
10 | Description: Linear algebra based on BLAS and LAPACK. | 10 | Description: Linear algebra based on BLAS and LAPACK. |
11 | . | 11 | . |
12 | The package is organized as follows: | ||
13 | . | ||
14 | ["Numeric.LinearAlgebra.HMatrix"] Starting point and recommended import module for most applications. | ||
15 | . | ||
16 | ["Numeric.LinearAlgebra.Static"] Experimental alternative interface. | ||
17 | . | ||
18 | ["Numeric.LinearAlgebra.Devel"] Tools for extending the library. | ||
19 | . | ||
20 | (Other modules are exposed with hidden documentation for backwards compatibility.) | ||
21 | . | ||
22 | Code examples: <http://dis.um.es/~alberto/hmatrix/hmatrix.html> | 12 | Code examples: <http://dis.um.es/~alberto/hmatrix/hmatrix.html> |
23 | 13 | ||
24 | Category: Math | 14 | Category: Math |
@@ -39,7 +29,7 @@ flag openblas | |||
39 | 29 | ||
40 | library | 30 | library |
41 | 31 | ||
42 | Build-Depends: base >= 4 && < 5, | 32 | Build-Depends: base >= 4.8 && < 5, |
43 | binary, | 33 | binary, |
44 | array, | 34 | array, |
45 | deepseq, | 35 | deepseq, |
@@ -51,27 +41,19 @@ library | |||
51 | 41 | ||
52 | hs-source-dirs: src | 42 | hs-source-dirs: src |
53 | 43 | ||
54 | exposed-modules: Data.Packed, | 44 | exposed-modules: Numeric.LinearAlgebra |
55 | Data.Packed.Vector, | ||
56 | Data.Packed.Matrix, | ||
57 | Data.Packed.Foreign, | ||
58 | Data.Packed.ST, | ||
59 | Data.Packed.Development, | ||
60 | |||
61 | Numeric.LinearAlgebra | ||
62 | Numeric.LinearAlgebra.LAPACK | ||
63 | Numeric.LinearAlgebra.Algorithms | ||
64 | Numeric.Container | ||
65 | Numeric.LinearAlgebra.Util | ||
66 | |||
67 | Numeric.LinearAlgebra.Devel | 45 | Numeric.LinearAlgebra.Devel |
68 | Numeric.LinearAlgebra.Data | 46 | Numeric.LinearAlgebra.Data |
69 | Numeric.LinearAlgebra.HMatrix | 47 | Numeric.LinearAlgebra.HMatrix |
70 | Numeric.LinearAlgebra.Static | 48 | Numeric.LinearAlgebra.Static |
71 | |||
72 | |||
73 | 49 | ||
74 | other-modules: Data.Packed.Internal, | 50 | other-modules: Data.Packed, |
51 | Data.Packed.Vector | ||
52 | Data.Packed.Matrix | ||
53 | Data.Packed.Foreign | ||
54 | Data.Packed.ST | ||
55 | Data.Packed.Development | ||
56 | Data.Packed.Internal | ||
75 | Data.Packed.Internal.Common | 57 | Data.Packed.Internal.Common |
76 | Data.Packed.Internal.Signatures | 58 | Data.Packed.Internal.Signatures |
77 | Data.Packed.Internal.Vector | 59 | Data.Packed.Internal.Vector |
@@ -83,12 +65,16 @@ library | |||
83 | Numeric.Matrix | 65 | Numeric.Matrix |
84 | Data.Packed.Internal.Numeric | 66 | Data.Packed.Internal.Numeric |
85 | Data.Packed.Numeric | 67 | Data.Packed.Numeric |
68 | Numeric.LinearAlgebra.LAPACK | ||
69 | Numeric.LinearAlgebra.Algorithms | ||
70 | Numeric.Container | ||
86 | Numeric.LinearAlgebra.Util.Convolution | 71 | Numeric.LinearAlgebra.Util.Convolution |
87 | Numeric.LinearAlgebra.Util.CG | 72 | Numeric.LinearAlgebra.Util.CG |
88 | Numeric.LinearAlgebra.Random | 73 | Numeric.LinearAlgebra.Random |
89 | Numeric.Conversion | 74 | Numeric.Conversion |
90 | Numeric.Sparse | 75 | Numeric.Sparse |
91 | Numeric.LinearAlgebra.Static.Internal | 76 | Numeric.LinearAlgebra.Static.Internal |
77 | Numeric.LinearAlgebra.Util | ||
92 | 78 | ||
93 | C-sources: src/C/lapack-aux.c | 79 | C-sources: src/C/lapack-aux.c |
94 | src/C/vector-aux.c | 80 | src/C/vector-aux.c |
diff --git a/packages/base/src/Data/Packed/IO.hs b/packages/base/src/Data/Packed/IO.hs index 85f1b37..b0999a8 100644 --- a/packages/base/src/Data/Packed/IO.hs +++ b/packages/base/src/Data/Packed/IO.hs | |||
@@ -22,7 +22,6 @@ import Text.Printf(printf) | |||
22 | import Data.List(intersperse) | 22 | import Data.List(intersperse) |
23 | import Data.Complex | 23 | import Data.Complex |
24 | import Numeric.Vectorized(vectorScan,saveMatrix) | 24 | import Numeric.Vectorized(vectorScan,saveMatrix) |
25 | import Control.Applicative((<$>)) | ||
26 | import Data.Packed.Internal | 25 | import Data.Packed.Internal |
27 | 26 | ||
28 | {- | Creates a string from a matrix given a separator and a function to show each entry. Using | 27 | {- | Creates a string from a matrix given a separator and a function to show each entry. Using |
diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs index 257ad73..7a4dd29 100644 --- a/packages/base/src/Data/Packed/Internal/Numeric.hs +++ b/packages/base/src/Data/Packed/Internal/Numeric.hs | |||
@@ -48,7 +48,6 @@ import Numeric.Conversion | |||
48 | import Data.Packed.Development | 48 | import Data.Packed.Development |
49 | import Numeric.Vectorized | 49 | import Numeric.Vectorized |
50 | import Data.Complex | 50 | import Data.Complex |
51 | import Control.Applicative((<*>)) | ||
52 | 51 | ||
53 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ) | 52 | import Numeric.LinearAlgebra.LAPACK(multiplyR,multiplyC,multiplyF,multiplyQ) |
54 | import Data.Packed.Internal | 53 | import Data.Packed.Internal |
diff --git a/packages/base/src/Data/Packed/Internal/Vector.hs b/packages/base/src/Data/Packed/Internal/Vector.hs index d0bc143..b49f379 100644 --- a/packages/base/src/Data/Packed/Internal/Vector.hs +++ b/packages/base/src/Data/Packed/Internal/Vector.hs | |||
@@ -35,7 +35,6 @@ import Foreign.Ptr(Ptr) | |||
35 | import Foreign.Storable(Storable, peekElemOff, pokeElemOff, sizeOf) | 35 | import Foreign.Storable(Storable, peekElemOff, pokeElemOff, sizeOf) |
36 | import Foreign.C.Types | 36 | import Foreign.C.Types |
37 | import Data.Complex | 37 | import Data.Complex |
38 | import Control.Monad(when) | ||
39 | import System.IO.Unsafe(unsafePerformIO) | 38 | import System.IO.Unsafe(unsafePerformIO) |
40 | 39 | ||
41 | #if __GLASGOW_HASKELL__ >= 605 | 40 | #if __GLASGOW_HASKELL__ >= 605 |
diff --git a/packages/base/src/Data/Packed/Numeric.hs b/packages/base/src/Data/Packed/Numeric.hs index 6027f43..6d62f22 100644 --- a/packages/base/src/Data/Packed/Numeric.hs +++ b/packages/base/src/Data/Packed/Numeric.hs | |||
@@ -39,7 +39,7 @@ module Data.Packed.Numeric ( | |||
39 | step, cond, find, assoc, accum, | 39 | step, cond, find, assoc, accum, |
40 | Transposable(..), Linear(..), | 40 | Transposable(..), Linear(..), |
41 | -- * Matrix product | 41 | -- * Matrix product |
42 | Product(..), udot, dot, (<·>), (#>), app, | 42 | Product(..), udot, dot, (<·>), (#>), (<#), app, |
43 | Mul(..), | 43 | Mul(..), |
44 | (<.>), | 44 | (<.>), |
45 | optimiseMult, | 45 | optimiseMult, |
@@ -71,7 +71,6 @@ import Data.Packed | |||
71 | import Data.Packed.Internal.Numeric | 71 | import Data.Packed.Internal.Numeric |
72 | import Data.Complex | 72 | import Data.Complex |
73 | import Numeric.LinearAlgebra.Algorithms(Field,linearSolveSVD) | 73 | import Numeric.LinearAlgebra.Algorithms(Field,linearSolveSVD) |
74 | import Data.Monoid(Monoid(mconcat)) | ||
75 | import Data.Packed.IO | 74 | import Data.Packed.IO |
76 | import Numeric.LinearAlgebra.Random | 75 | import Numeric.LinearAlgebra.Random |
77 | 76 | ||
@@ -142,6 +141,11 @@ fromList [140.0,320.0] | |||
142 | app :: Numeric t => Matrix t -> Vector t -> Vector t | 141 | app :: Numeric t => Matrix t -> Vector t -> Vector t |
143 | app = (#>) | 142 | app = (#>) |
144 | 143 | ||
144 | infixl 8 <# | ||
145 | -- | dense vector-matrix product | ||
146 | (<#) :: Numeric t => Vector t -> Matrix t -> Vector t | ||
147 | (<#) = vXm | ||
148 | |||
145 | -------------------------------------------------------------------------------- | 149 | -------------------------------------------------------------------------------- |
146 | 150 | ||
147 | class Mul a b c | a b -> c where | 151 | class Mul a b c | a b -> c where |
diff --git a/packages/base/src/Numeric/Chain.hs b/packages/base/src/Numeric/Chain.hs index 443bd28..64c09c0 100644 --- a/packages/base/src/Numeric/Chain.hs +++ b/packages/base/src/Numeric/Chain.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
1 | ----------------------------------------------------------------------------- | 3 | ----------------------------------------------------------------------------- |
2 | -- | | 4 | -- | |
3 | -- Module : Numeric.Chain | 5 | -- Module : Numeric.Chain |
diff --git a/packages/base/src/Numeric/LinearAlgebra.hs b/packages/base/src/Numeric/LinearAlgebra.hs index ad315e4..4ba0c98 100644 --- a/packages/base/src/Numeric/LinearAlgebra.hs +++ b/packages/base/src/Numeric/LinearAlgebra.hs | |||
@@ -1,22 +1,235 @@ | |||
1 | -------------------------------------------------------------------------------- | 1 | ----------------------------------------------------------------------------- |
2 | {- | | 2 | {- | |
3 | Module : Numeric.LinearAlgebra | 3 | Module : Numeric.LinearAlgebra |
4 | Copyright : (c) Alberto Ruiz 2006-14 | 4 | Copyright : (c) Alberto Ruiz 2006-15 |
5 | License : BSD3 | 5 | License : BSD3 |
6 | Maintainer : Alberto Ruiz | 6 | Maintainer : Alberto Ruiz |
7 | Stability : provisional | 7 | Stability : provisional |
8 | 8 | ||
9 | -} | 9 | -} |
10 | -------------------------------------------------------------------------------- | 10 | ----------------------------------------------------------------------------- |
11 | {-# OPTIONS_HADDOCK hide #-} | ||
12 | |||
13 | module Numeric.LinearAlgebra ( | 11 | module Numeric.LinearAlgebra ( |
14 | module Numeric.Container, | 12 | |
15 | module Numeric.LinearAlgebra.Algorithms | 13 | -- * Basic types and data processing |
14 | module Numeric.LinearAlgebra.Data, | ||
15 | |||
16 | -- * Arithmetic and numeric classes | ||
17 | -- | | ||
18 | -- The standard numeric classes are defined elementwise: | ||
19 | -- | ||
20 | -- >>> vector [1,2,3] * vector [3,0,-2] | ||
21 | -- fromList [3.0,0.0,-6.0] | ||
22 | -- | ||
23 | -- >>> matrix 3 [1..9] * ident 3 | ||
24 | -- (3><3) | ||
25 | -- [ 1.0, 0.0, 0.0 | ||
26 | -- , 0.0, 5.0, 0.0 | ||
27 | -- , 0.0, 0.0, 9.0 ] | ||
28 | -- | ||
29 | -- In arithmetic operations single-element vectors and matrices | ||
30 | -- (created from numeric literals or using 'scalar') automatically | ||
31 | -- expand to match the dimensions of the other operand: | ||
32 | -- | ||
33 | -- >>> 5 + 2*ident 3 :: Matrix Double | ||
34 | -- (3><3) | ||
35 | -- [ 7.0, 5.0, 5.0 | ||
36 | -- , 5.0, 7.0, 5.0 | ||
37 | -- , 5.0, 5.0, 7.0 ] | ||
38 | -- | ||
39 | -- >>> matrix 3 [1..9] + matrix 1 [10,20,30] | ||
40 | -- (3><3) | ||
41 | -- [ 11.0, 12.0, 13.0 | ||
42 | -- , 24.0, 25.0, 26.0 | ||
43 | -- , 37.0, 38.0, 39.0 ] | ||
44 | -- | ||
45 | |||
46 | -- * Products | ||
47 | -- ** dot | ||
48 | dot, (<·>), | ||
49 | -- ** matrix-vector | ||
50 | app, (#>), (<#), (!#>), | ||
51 | -- ** matrix-matrix | ||
52 | mul, (<>), | ||
53 | -- | The matrix product is also implemented in the "Data.Monoid" instance, where | ||
54 | -- single-element matrices (created from numeric literals or using 'scalar') | ||
55 | -- are used for scaling. | ||
56 | -- | ||
57 | -- >>> import Data.Monoid as M | ||
58 | -- >>> let m = matrix 3 [1..6] | ||
59 | -- >>> m M.<> 2 M.<> diagl[0.5,1,0] | ||
60 | -- (2><3) | ||
61 | -- [ 1.0, 4.0, 0.0 | ||
62 | -- , 4.0, 10.0, 0.0 ] | ||
63 | -- | ||
64 | -- 'mconcat' uses 'optimiseMult' to get the optimal association order. | ||
65 | |||
66 | |||
67 | -- ** other | ||
68 | outer, kronecker, cross, | ||
69 | scale, | ||
70 | sumElements, prodElements, | ||
71 | |||
72 | -- * Linear Systems | ||
73 | (<\>), | ||
74 | linearSolve, | ||
75 | linearSolveLS, | ||
76 | linearSolveSVD, | ||
77 | luSolve, | ||
78 | cholSolve, | ||
79 | cgSolve, | ||
80 | cgSolve', | ||
81 | |||
82 | -- * Inverse and pseudoinverse | ||
83 | inv, pinv, pinvTol, | ||
84 | |||
85 | -- * Determinant and rank | ||
86 | rcond, rank, | ||
87 | det, invlndet, | ||
88 | |||
89 | -- * Norms | ||
90 | Normed(..), | ||
91 | norm_Frob, norm_nuclear, | ||
92 | |||
93 | -- * Nullspace and range | ||
94 | orth, | ||
95 | nullspace, null1, null1sym, | ||
96 | |||
97 | -- * SVD | ||
98 | svd, | ||
99 | thinSVD, | ||
100 | compactSVD, | ||
101 | singularValues, | ||
102 | leftSV, rightSV, | ||
103 | |||
104 | -- * Eigensystems | ||
105 | eig, eigSH, eigSH', | ||
106 | eigenvalues, eigenvaluesSH, eigenvaluesSH', | ||
107 | geigSH', | ||
108 | |||
109 | -- * QR | ||
110 | qr, rq, qrRaw, qrgr, | ||
111 | |||
112 | -- * Cholesky | ||
113 | chol, cholSH, mbCholSH, | ||
114 | |||
115 | -- * Hessenberg | ||
116 | hess, | ||
117 | |||
118 | -- * Schur | ||
119 | schur, | ||
120 | |||
121 | -- * LU | ||
122 | lu, luPacked, | ||
123 | |||
124 | -- * Matrix functions | ||
125 | expm, | ||
126 | sqrtm, | ||
127 | matFunc, | ||
128 | |||
129 | -- * Correlation and convolution | ||
130 | corr, conv, corrMin, corr2, conv2, | ||
131 | |||
132 | -- * Random arrays | ||
133 | |||
134 | Seed, RandDist(..), randomVector, rand, randn, gaussianSample, uniformSample, | ||
135 | |||
136 | -- * Misc | ||
137 | meanCov, rowOuters, pairwiseD2, unitary, peps, relativeError, haussholder, optimiseMult, udot, nullspaceSVD, orthSVD, ranksv, | ||
138 | ℝ,ℂ,iC, | ||
139 | -- * Auxiliary classes | ||
140 | Element, Container, Product, Numeric, LSDiv, | ||
141 | Complexable, RealElement, | ||
142 | RealOf, ComplexOf, SingleOf, DoubleOf, | ||
143 | IndexOf, | ||
144 | Field, | ||
145 | -- Normed, | ||
146 | Transposable, | ||
147 | CGState(..), | ||
148 | Testable(..) | ||
16 | ) where | 149 | ) where |
17 | 150 | ||
18 | import Numeric.Container | 151 | import Numeric.LinearAlgebra.Data |
19 | import Numeric.LinearAlgebra.Algorithms | 152 | |
20 | import Numeric.Matrix() | 153 | import Numeric.Matrix() |
21 | import Numeric.Vector() | 154 | import Numeric.Vector() |
155 | import Data.Packed.Numeric hiding ((<>), mul) | ||
156 | import Numeric.LinearAlgebra.Algorithms hiding (linearSolve,Normed,orth) | ||
157 | import qualified Numeric.LinearAlgebra.Algorithms as A | ||
158 | import Numeric.LinearAlgebra.Util | ||
159 | import Numeric.LinearAlgebra.Random | ||
160 | import Numeric.Sparse((!#>)) | ||
161 | import Numeric.LinearAlgebra.Util.CG | ||
162 | |||
163 | {- | infix synonym of 'mul' | ||
164 | |||
165 | >>> let a = (3><5) [1..] | ||
166 | >>> a | ||
167 | (3><5) | ||
168 | [ 1.0, 2.0, 3.0, 4.0, 5.0 | ||
169 | , 6.0, 7.0, 8.0, 9.0, 10.0 | ||
170 | , 11.0, 12.0, 13.0, 14.0, 15.0 ] | ||
171 | |||
172 | >>> let b = (5><2) [1,3, 0,2, -1,5, 7,7, 6,0] | ||
173 | >>> b | ||
174 | (5><2) | ||
175 | [ 1.0, 3.0 | ||
176 | , 0.0, 2.0 | ||
177 | , -1.0, 5.0 | ||
178 | , 7.0, 7.0 | ||
179 | , 6.0, 0.0 ] | ||
180 | |||
181 | >>> a <> b | ||
182 | (3><2) | ||
183 | [ 56.0, 50.0 | ||
184 | , 121.0, 135.0 | ||
185 | , 186.0, 220.0 ] | ||
186 | |||
187 | -} | ||
188 | (<>) :: Numeric t => Matrix t -> Matrix t -> Matrix t | ||
189 | (<>) = mXm | ||
190 | infixr 8 <> | ||
191 | |||
192 | -- | dense matrix product | ||
193 | mul :: Numeric t => Matrix t -> Matrix t -> Matrix t | ||
194 | mul = mXm | ||
195 | |||
196 | |||
197 | {- | Solve a linear system (for square coefficient matrix and several right-hand sides) using the LU decomposition, returning Nothing for a singular system. For underconstrained or overconstrained systems use 'linearSolveLS' or 'linearSolveSVD'. | ||
198 | |||
199 | @ | ||
200 | a = (2><2) | ||
201 | [ 1.0, 2.0 | ||
202 | , 3.0, 5.0 ] | ||
203 | @ | ||
204 | |||
205 | @ | ||
206 | b = (2><3) | ||
207 | [ 6.0, 1.0, 10.0 | ||
208 | , 15.0, 3.0, 26.0 ] | ||
209 | @ | ||
210 | |||
211 | >>> linearSolve a b | ||
212 | Just (2><3) | ||
213 | [ -1.4802973661668753e-15, 0.9999999999999997, 1.999999999999997 | ||
214 | , 3.000000000000001, 1.6653345369377348e-16, 4.000000000000002 ] | ||
215 | |||
216 | >>> let Just x = it | ||
217 | >>> disp 5 x | ||
218 | 2x3 | ||
219 | -0.00000 1.00000 2.00000 | ||
220 | 3.00000 0.00000 4.00000 | ||
221 | |||
222 | >>> a <> x | ||
223 | (2><3) | ||
224 | [ 6.0, 1.0, 10.0 | ||
225 | , 15.0, 3.0, 26.0 ] | ||
226 | |||
227 | -} | ||
228 | linearSolve m b = A.mbLinearSolve m b | ||
229 | |||
230 | -- | return an orthonormal basis of the null space of a matrix. See also 'nullspaceSVD'. | ||
231 | nullspace m = nullspaceSVD (Left (1*eps)) m (rightSV m) | ||
232 | |||
233 | -- | return an orthonormal basis of the range space of a matrix. See also 'orthSVD'. | ||
234 | orth m = orthSVD (Left (1*eps)) m (leftSV m) | ||
22 | 235 | ||
diff --git a/packages/base/src/Numeric/LinearAlgebra/Algorithms.hs b/packages/base/src/Numeric/LinearAlgebra/Algorithms.hs index 02ac6a0..0e085c1 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Algorithms.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Algorithms.hs | |||
@@ -228,7 +228,9 @@ fromList [35.18264833189422,1.4769076999800903,1.089145439970417e-15] | |||
228 | 228 | ||
229 | -} | 229 | -} |
230 | svd :: Field t => Matrix t -> (Matrix t, Vector Double, Matrix t) | 230 | svd :: Field t => Matrix t -> (Matrix t, Vector Double, Matrix t) |
231 | svd = {-# SCC "svd" #-} svd' | 231 | svd = {-# SCC "svd" #-} g . svd' |
232 | where | ||
233 | g (u,s,v) = (u,s,tr v) | ||
232 | 234 | ||
233 | {- | A version of 'svd' which returns only the @min (rows m) (cols m)@ singular vectors of @m@. | 235 | {- | A version of 'svd' which returns only the @min (rows m) (cols m)@ singular vectors of @m@. |
234 | 236 | ||
@@ -272,7 +274,10 @@ fromList [35.18264833189422,1.4769076999800903,1.089145439970417e-15] | |||
272 | 274 | ||
273 | -} | 275 | -} |
274 | thinSVD :: Field t => Matrix t -> (Matrix t, Vector Double, Matrix t) | 276 | thinSVD :: Field t => Matrix t -> (Matrix t, Vector Double, Matrix t) |
275 | thinSVD = {-# SCC "thinSVD" #-} thinSVD' | 277 | thinSVD = {-# SCC "thinSVD" #-} g . thinSVD' |
278 | where | ||
279 | g (u,s,v) = (u,s,tr v) | ||
280 | |||
276 | 281 | ||
277 | -- | Singular values only. | 282 | -- | Singular values only. |
278 | singularValues :: Field t => Matrix t -> Vector Double | 283 | singularValues :: Field t => Matrix t -> Vector Double |
@@ -587,7 +592,7 @@ m = (3><3) [ 1, 0, 0 | |||
587 | -} | 592 | -} |
588 | 593 | ||
589 | pinvTol :: Field t => Double -> Matrix t -> Matrix t | 594 | pinvTol :: Field t => Double -> Matrix t -> Matrix t |
590 | pinvTol t m = conj v' `mXm` diag s' `mXm` ctrans u' where | 595 | pinvTol t m = v' `mXm` diag s' `mXm` ctrans u' where |
591 | (u,s,v) = thinSVD m | 596 | (u,s,v) = thinSVD m |
592 | sl@(g:_) = toList s | 597 | sl@(g:_) = toList s |
593 | s' = real . fromList . map rec $ sl | 598 | s' = real . fromList . map rec $ sl |
@@ -649,7 +654,7 @@ nullspaceSVD hint a (s,v) = vs where | |||
649 | k = case hint of | 654 | k = case hint of |
650 | Right t -> t | 655 | Right t -> t |
651 | _ -> rankSVD tol a s | 656 | _ -> rankSVD tol a s |
652 | vs = conj (dropColumns k v) | 657 | vs = dropColumns k v |
653 | 658 | ||
654 | 659 | ||
655 | -- | The nullspace of a matrix. See also 'nullspaceSVD'. | 660 | -- | The nullspace of a matrix. See also 'nullspaceSVD'. |
@@ -935,10 +940,9 @@ relativeError' x y = dig (norm (x `sub` y) / norm x) | |||
935 | dig r = round $ -logBase 10 (realToFrac r :: Double) | 940 | dig r = round $ -logBase 10 (realToFrac r :: Double) |
936 | 941 | ||
937 | 942 | ||
938 | relativeError :: (Normed c t, Num (c t)) => NormType -> c t -> c t -> Double | 943 | relativeError :: Num a => (a -> Double) -> a -> a -> Double |
939 | relativeError t a b = realToFrac r | 944 | relativeError norm a b = r |
940 | where | 945 | where |
941 | norm = pnorm t | ||
942 | na = norm a | 946 | na = norm a |
943 | nb = norm b | 947 | nb = norm b |
944 | nab = norm (a-b) | 948 | nab = norm (a-b) |
diff --git a/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs b/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs index 677f9ee..8e67eb4 100644 --- a/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs +++ b/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs | |||
@@ -1,4 +1,4 @@ | |||
1 | ----------------------------------------------------------------------------- | 1 | -------------------------------------------------------------------------------- |
2 | {- | | 2 | {- | |
3 | Module : Numeric.LinearAlgebra.HMatrix | 3 | Module : Numeric.LinearAlgebra.HMatrix |
4 | Copyright : (c) Alberto Ruiz 2006-14 | 4 | Copyright : (c) Alberto Ruiz 2006-14 |
@@ -7,229 +7,11 @@ Maintainer : Alberto Ruiz | |||
7 | Stability : provisional | 7 | Stability : provisional |
8 | 8 | ||
9 | -} | 9 | -} |
10 | ----------------------------------------------------------------------------- | 10 | -------------------------------------------------------------------------------- |
11 | module Numeric.LinearAlgebra.HMatrix ( | ||
12 | |||
13 | -- * Basic types and data processing | ||
14 | module Numeric.LinearAlgebra.Data, | ||
15 | |||
16 | -- * Arithmetic and numeric classes | ||
17 | -- | | ||
18 | -- The standard numeric classes are defined elementwise: | ||
19 | -- | ||
20 | -- >>> vector [1,2,3] * vector [3,0,-2] | ||
21 | -- fromList [3.0,0.0,-6.0] | ||
22 | -- | ||
23 | -- >>> matrix 3 [1..9] * ident 3 | ||
24 | -- (3><3) | ||
25 | -- [ 1.0, 0.0, 0.0 | ||
26 | -- , 0.0, 5.0, 0.0 | ||
27 | -- , 0.0, 0.0, 9.0 ] | ||
28 | -- | ||
29 | -- In arithmetic operations single-element vectors and matrices | ||
30 | -- (created from numeric literals or using 'scalar') automatically | ||
31 | -- expand to match the dimensions of the other operand: | ||
32 | -- | ||
33 | -- >>> 5 + 2*ident 3 :: Matrix Double | ||
34 | -- (3><3) | ||
35 | -- [ 7.0, 5.0, 5.0 | ||
36 | -- , 5.0, 7.0, 5.0 | ||
37 | -- , 5.0, 5.0, 7.0 ] | ||
38 | -- | ||
39 | -- >>> matrix 3 [1..9] + matrix 1 [10,20,30] | ||
40 | -- (3><3) | ||
41 | -- [ 11.0, 12.0, 13.0 | ||
42 | -- , 24.0, 25.0, 26.0 | ||
43 | -- , 37.0, 38.0, 39.0 ] | ||
44 | -- | ||
45 | |||
46 | -- * Products | ||
47 | -- ** dot | ||
48 | dot, (<·>), | ||
49 | -- ** matrix-vector | ||
50 | app, (#>), (!#>), | ||
51 | -- ** matrix-matrix | ||
52 | mul, (<>), | ||
53 | -- | The matrix product is also implemented in the "Data.Monoid" instance, where | ||
54 | -- single-element matrices (created from numeric literals or using 'scalar') | ||
55 | -- are used for scaling. | ||
56 | -- | ||
57 | -- >>> import Data.Monoid as M | ||
58 | -- >>> let m = matrix 3 [1..6] | ||
59 | -- >>> m M.<> 2 M.<> diagl[0.5,1,0] | ||
60 | -- (2><3) | ||
61 | -- [ 1.0, 4.0, 0.0 | ||
62 | -- , 4.0, 10.0, 0.0 ] | ||
63 | -- | ||
64 | -- 'mconcat' uses 'optimiseMult' to get the optimal association order. | ||
65 | |||
66 | |||
67 | -- ** other | ||
68 | outer, kronecker, cross, | ||
69 | scale, | ||
70 | sumElements, prodElements, | ||
71 | |||
72 | -- * Linear Systems | ||
73 | (<\>), | ||
74 | linearSolve, | ||
75 | linearSolveLS, | ||
76 | linearSolveSVD, | ||
77 | luSolve, | ||
78 | cholSolve, | ||
79 | cgSolve, | ||
80 | cgSolve', | ||
81 | |||
82 | -- * Inverse and pseudoinverse | ||
83 | inv, pinv, pinvTol, | ||
84 | |||
85 | -- * Determinant and rank | ||
86 | rcond, rank, | ||
87 | det, invlndet, | ||
88 | |||
89 | -- * Norms | ||
90 | Normed(..), | ||
91 | norm_Frob, norm_nuclear, | ||
92 | |||
93 | -- * Nullspace and range | ||
94 | orth, | ||
95 | nullspace, null1, null1sym, | ||
96 | |||
97 | -- * SVD | ||
98 | svd, | ||
99 | thinSVD, | ||
100 | compactSVD, | ||
101 | singularValues, | ||
102 | leftSV, rightSV, | ||
103 | |||
104 | -- * Eigensystems | ||
105 | eig, eigSH, eigSH', | ||
106 | eigenvalues, eigenvaluesSH, eigenvaluesSH', | ||
107 | geigSH', | ||
108 | |||
109 | -- * QR | ||
110 | qr, rq, qrRaw, qrgr, | ||
111 | |||
112 | -- * Cholesky | ||
113 | chol, cholSH, mbCholSH, | ||
114 | |||
115 | -- * Hessenberg | ||
116 | hess, | ||
117 | |||
118 | -- * Schur | ||
119 | schur, | ||
120 | |||
121 | -- * LU | ||
122 | lu, luPacked, | ||
123 | |||
124 | -- * Matrix functions | ||
125 | expm, | ||
126 | sqrtm, | ||
127 | matFunc, | ||
128 | |||
129 | -- * Correlation and convolution | ||
130 | corr, conv, corrMin, corr2, conv2, | ||
131 | |||
132 | -- * Random arrays | ||
133 | 11 | ||
134 | Seed, RandDist(..), randomVector, rand, randn, gaussianSample, uniformSample, | 12 | module Numeric.LinearAlgebra.HMatrix ( |
135 | 13 | module Numeric.LinearAlgebra | |
136 | -- * Misc | ||
137 | meanCov, rowOuters, peps, relativeError, haussholder, optimiseMult, udot, nullspaceSVD, orthSVD, ranksv, | ||
138 | ℝ,ℂ,iC, | ||
139 | -- * Auxiliary classes | ||
140 | Element, Container, Product, Numeric, LSDiv, | ||
141 | Complexable, RealElement, | ||
142 | RealOf, ComplexOf, SingleOf, DoubleOf, | ||
143 | IndexOf, | ||
144 | Field, | ||
145 | -- Normed, | ||
146 | Transposable, | ||
147 | CGState(..), | ||
148 | Testable(..) | ||
149 | ) where | 14 | ) where |
150 | 15 | ||
151 | import Numeric.LinearAlgebra.Data | 16 | import Numeric.LinearAlgebra |
152 | |||
153 | import Numeric.Matrix() | ||
154 | import Numeric.Vector() | ||
155 | import Data.Packed.Numeric hiding ((<>), mul) | ||
156 | import Numeric.LinearAlgebra.Algorithms hiding (linearSolve,Normed,orth) | ||
157 | import qualified Numeric.LinearAlgebra.Algorithms as A | ||
158 | import Numeric.LinearAlgebra.Util | ||
159 | import Numeric.LinearAlgebra.Random | ||
160 | import Numeric.Sparse((!#>)) | ||
161 | import Numeric.LinearAlgebra.Util.CG | ||
162 | |||
163 | {- | infix synonym of 'mul' | ||
164 | |||
165 | >>> let a = (3><5) [1..] | ||
166 | >>> a | ||
167 | (3><5) | ||
168 | [ 1.0, 2.0, 3.0, 4.0, 5.0 | ||
169 | , 6.0, 7.0, 8.0, 9.0, 10.0 | ||
170 | , 11.0, 12.0, 13.0, 14.0, 15.0 ] | ||
171 | |||
172 | >>> let b = (5><2) [1,3, 0,2, -1,5, 7,7, 6,0] | ||
173 | >>> b | ||
174 | (5><2) | ||
175 | [ 1.0, 3.0 | ||
176 | , 0.0, 2.0 | ||
177 | , -1.0, 5.0 | ||
178 | , 7.0, 7.0 | ||
179 | , 6.0, 0.0 ] | ||
180 | |||
181 | >>> a <> b | ||
182 | (3><2) | ||
183 | [ 56.0, 50.0 | ||
184 | , 121.0, 135.0 | ||
185 | , 186.0, 220.0 ] | ||
186 | |||
187 | -} | ||
188 | (<>) :: Numeric t => Matrix t -> Matrix t -> Matrix t | ||
189 | (<>) = mXm | ||
190 | infixr 8 <> | ||
191 | |||
192 | -- | dense matrix product | ||
193 | mul :: Numeric t => Matrix t -> Matrix t -> Matrix t | ||
194 | mul = mXm | ||
195 | |||
196 | |||
197 | {- | Solve a linear system (for square coefficient matrix and several right-hand sides) using the LU decomposition, returning Nothing for a singular system. For underconstrained or overconstrained systems use 'linearSolveLS' or 'linearSolveSVD'. | ||
198 | |||
199 | @ | ||
200 | a = (2><2) | ||
201 | [ 1.0, 2.0 | ||
202 | , 3.0, 5.0 ] | ||
203 | @ | ||
204 | |||
205 | @ | ||
206 | b = (2><3) | ||
207 | [ 6.0, 1.0, 10.0 | ||
208 | , 15.0, 3.0, 26.0 ] | ||
209 | @ | ||
210 | |||
211 | >>> linearSolve a b | ||
212 | Just (2><3) | ||
213 | [ -1.4802973661668753e-15, 0.9999999999999997, 1.999999999999997 | ||
214 | , 3.000000000000001, 1.6653345369377348e-16, 4.000000000000002 ] | ||
215 | |||
216 | >>> let Just x = it | ||
217 | >>> disp 5 x | ||
218 | 2x3 | ||
219 | -0.00000 1.00000 2.00000 | ||
220 | 3.00000 0.00000 4.00000 | ||
221 | |||
222 | >>> a <> x | ||
223 | (2><3) | ||
224 | [ 6.0, 1.0, 10.0 | ||
225 | , 15.0, 3.0, 26.0 ] | ||
226 | |||
227 | -} | ||
228 | linearSolve m b = A.mbLinearSolve m b | ||
229 | |||
230 | -- | return an orthonormal basis of the null space of a matrix. See also 'nullspaceSVD'. | ||
231 | nullspace m = nullspaceSVD (Left (1*eps)) m (rightSV m) | ||
232 | |||
233 | -- | return an orthonormal basis of the range space of a matrix. See also 'orthSVD'. | ||
234 | orth m = orthSVD (Left (1*eps)) m (leftSV m) | ||
235 | 17 | ||
diff --git a/packages/base/src/Numeric/LinearAlgebra/LAPACK.hs b/packages/base/src/Numeric/LinearAlgebra/LAPACK.hs index e088fdc..d96e14f 100644 --- a/packages/base/src/Numeric/LinearAlgebra/LAPACK.hs +++ b/packages/base/src/Numeric/LinearAlgebra/LAPACK.hs | |||
@@ -115,7 +115,7 @@ svdAux f st x = unsafePerformIO $ do | |||
115 | s <- createVector (min r c) | 115 | s <- createVector (min r c) |
116 | v <- createMatrix ColumnMajor c c | 116 | v <- createMatrix ColumnMajor c c |
117 | app4 f mat x mat u vec s mat v st | 117 | app4 f mat x mat u vec s mat v st |
118 | return (u,s,trans v) | 118 | return (u,s,v) |
119 | where r = rows x | 119 | where r = rows x |
120 | c = cols x | 120 | c = cols x |
121 | 121 | ||
@@ -141,7 +141,7 @@ thinSVDAux f st x = unsafePerformIO $ do | |||
141 | s <- createVector q | 141 | s <- createVector q |
142 | v <- createMatrix ColumnMajor q c | 142 | v <- createMatrix ColumnMajor q c |
143 | app4 f mat x mat u vec s mat v st | 143 | app4 f mat x mat u vec s mat v st |
144 | return (u,s,trans v) | 144 | return (u,s,v) |
145 | where r = rows x | 145 | where r = rows x |
146 | c = cols x | 146 | c = cols x |
147 | q = min r c | 147 | q = min r c |
@@ -185,7 +185,7 @@ rightSVAux f st x = unsafePerformIO $ do | |||
185 | s <- createVector q | 185 | s <- createVector q |
186 | v <- createMatrix ColumnMajor c c | 186 | v <- createMatrix ColumnMajor c c |
187 | app3 g mat x vec s mat v st | 187 | app3 g mat x vec s mat v st |
188 | return (s,trans v) | 188 | return (s,v) |
189 | where r = rows x | 189 | where r = rows x |
190 | c = cols x | 190 | c = cols x |
191 | q = min r c | 191 | q = min r c |
diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs index 3398e6a..25b10b4 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Static.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs | |||
@@ -1,5 +1,3 @@ | |||
1 | #if __GLASGOW_HASKELL__ >= 708 | ||
2 | |||
3 | {-# LANGUAGE DataKinds #-} | 1 | {-# LANGUAGE DataKinds #-} |
4 | {-# LANGUAGE KindSignatures #-} | 2 | {-# LANGUAGE KindSignatures #-} |
5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
@@ -13,7 +11,6 @@ | |||
13 | {-# LANGUAGE TypeOperators #-} | 11 | {-# LANGUAGE TypeOperators #-} |
14 | {-# LANGUAGE ViewPatterns #-} | 12 | {-# LANGUAGE ViewPatterns #-} |
15 | {-# LANGUAGE GADTs #-} | 13 | {-# LANGUAGE GADTs #-} |
16 | {-# LANGUAGE OverlappingInstances #-} | ||
17 | {-# LANGUAGE TypeFamilies #-} | 14 | {-# LANGUAGE TypeFamilies #-} |
18 | 15 | ||
19 | 16 | ||
@@ -63,13 +60,13 @@ module Numeric.LinearAlgebra.Static( | |||
63 | 60 | ||
64 | 61 | ||
65 | import GHC.TypeLits | 62 | import GHC.TypeLits |
66 | import Numeric.LinearAlgebra.HMatrix hiding ( | 63 | import Numeric.LinearAlgebra hiding ( |
67 | (<>),(#>),(<·>),Konst(..),diag, disp,(¦),(——), | 64 | (<>),(#>),(<·>),Konst(..),diag, disp,(¦),(——), |
68 | row,col,vector,matrix,linspace,toRows,toColumns, | 65 | row,col,vector,matrix,linspace,toRows,toColumns, |
69 | (<\>),fromList,takeDiag,svd,eig,eigSH,eigSH', | 66 | (<\>),fromList,takeDiag,svd,eig,eigSH,eigSH', |
70 | eigenvalues,eigenvaluesSH,eigenvaluesSH',build, | 67 | eigenvalues,eigenvaluesSH,eigenvaluesSH',build, |
71 | qr,size,app,mul,dot,chol) | 68 | qr,size,app,mul,dot,chol) |
72 | import qualified Numeric.LinearAlgebra.HMatrix as LA | 69 | import qualified Numeric.LinearAlgebra as LA |
73 | import Data.Proxy(Proxy) | 70 | import Data.Proxy(Proxy) |
74 | import Numeric.LinearAlgebra.Static.Internal | 71 | import Numeric.LinearAlgebra.Static.Internal |
75 | import Control.Arrow((***)) | 72 | import Control.Arrow((***)) |
@@ -184,8 +181,9 @@ a ¦ b = tr (tr a —— tr b) | |||
184 | type Sq n = L n n | 181 | type Sq n = L n n |
185 | --type CSq n = CL n n | 182 | --type CSq n = CL n n |
186 | 183 | ||
187 | type GL = forall n m. (KnownNat n, KnownNat m) => L m n | 184 | |
188 | type GSq = forall n. KnownNat n => Sq n | 185 | type GL = forall n m . (KnownNat n, KnownNat m) => L m n |
186 | type GSq = forall n . KnownNat n => Sq n | ||
189 | 187 | ||
190 | isKonst :: forall m n . (KnownNat m, KnownNat n) => L m n -> Maybe (ℝ,(Int,Int)) | 188 | isKonst :: forall m n . (KnownNat m, KnownNat n) => L m n -> Maybe (ℝ,(Int,Int)) |
191 | isKonst s@(unwrap -> x) | 189 | isKonst s@(unwrap -> x) |
@@ -618,23 +616,3 @@ instance (KnownNat n', KnownNat m') => Testable (L n' m') | |||
618 | where | 616 | where |
619 | checkT _ = test | 617 | checkT _ = test |
620 | 618 | ||
621 | #else | ||
622 | |||
623 | {- | | ||
624 | Module : Numeric.LinearAlgebra.Static | ||
625 | Copyright : (c) Alberto Ruiz 2014 | ||
626 | License : BSD3 | ||
627 | Stability : experimental | ||
628 | |||
629 | Experimental interface with statically checked dimensions. | ||
630 | |||
631 | This module requires GHC >= 7.8 | ||
632 | |||
633 | -} | ||
634 | |||
635 | module Numeric.LinearAlgebra.Static | ||
636 | {-# WARNING "This module requires GHC >= 7.8" #-} | ||
637 | where | ||
638 | |||
639 | #endif | ||
640 | |||
diff --git a/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs b/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs index ec02cf6..a5fc29b 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Static/Internal.hs | |||
@@ -24,8 +24,8 @@ module Numeric.LinearAlgebra.Static.Internal where | |||
24 | 24 | ||
25 | 25 | ||
26 | import GHC.TypeLits | 26 | import GHC.TypeLits |
27 | import qualified Numeric.LinearAlgebra.HMatrix as LA | 27 | import qualified Numeric.LinearAlgebra as LA |
28 | import Numeric.LinearAlgebra.HMatrix hiding (konst,size) | 28 | import Numeric.LinearAlgebra hiding (konst,size) |
29 | import Data.Packed as D | 29 | import Data.Packed as D |
30 | import Data.Packed.ST | 30 | import Data.Packed.ST |
31 | import Data.Proxy(Proxy) | 31 | import Data.Proxy(Proxy) |
diff --git a/packages/base/src/Numeric/LinearAlgebra/Util.hs b/packages/base/src/Numeric/LinearAlgebra/Util.hs index 043aa21..370ca27 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Util.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Util.hs | |||
@@ -16,7 +16,6 @@ Stability : provisional | |||
16 | 16 | ||
17 | -} | 17 | -} |
18 | ----------------------------------------------------------------------------- | 18 | ----------------------------------------------------------------------------- |
19 | {-# OPTIONS_HADDOCK hide #-} | ||
20 | 19 | ||
21 | module Numeric.LinearAlgebra.Util( | 20 | module Numeric.LinearAlgebra.Util( |
22 | 21 | ||
@@ -53,18 +52,7 @@ module Numeric.LinearAlgebra.Util( | |||
53 | -- ** 1D | 52 | -- ** 1D |
54 | corr, conv, corrMin, | 53 | corr, conv, corrMin, |
55 | -- ** 2D | 54 | -- ** 2D |
56 | corr2, conv2, separable, | 55 | corr2, conv2, separable |
57 | -- * Tools for the Kronecker product | ||
58 | -- | ||
59 | -- | (see A. Fusiello, A matter of notation: Several uses of the Kronecker product in | ||
60 | -- 3d computer vision, Pattern Recognition Letters 28 (15) (2007) 2127-2132) | ||
61 | |||
62 | -- | ||
63 | -- | @`vec` (a \<> x \<> b) == ('trans' b ` 'kronecker' ` a) \<> 'vec' x@ | ||
64 | vec, | ||
65 | vech, | ||
66 | dup, | ||
67 | vtrans | ||
68 | ) where | 56 | ) where |
69 | 57 | ||
70 | import Data.Packed.Numeric | 58 | import Data.Packed.Numeric |
@@ -227,10 +215,11 @@ infixl 9 ¿ | |||
227 | (¿)= flip extractColumns | 215 | (¿)= flip extractColumns |
228 | 216 | ||
229 | 217 | ||
230 | cross :: Vector Double -> Vector Double -> Vector Double | 218 | cross :: Product t => Vector t -> Vector t -> Vector t |
231 | -- ^ cross product (for three-element real vectors) | 219 | -- ^ cross product (for three-element vectors) |
232 | cross x y | dim x == 3 && dim y == 3 = fromList [z1,z2,z3] | 220 | cross x y | dim x == 3 && dim y == 3 = fromList [z1,z2,z3] |
233 | | otherwise = error $ "cross ("++show x++") ("++show y++")" | 221 | | otherwise = error $ "the cross product requires 3-element vectors (sizes given: " |
222 | ++show (dim x)++" and "++show (dim y)++")" | ||
234 | where | 223 | where |
235 | [x1,x2,x3] = toList x | 224 | [x1,x2,x3] = toList x |
236 | [y1,y2,y3] = toList y | 225 | [y1,y2,y3] = toList y |
@@ -238,6 +227,9 @@ cross x y | dim x == 3 && dim y == 3 = fromList [z1,z2,z3] | |||
238 | z2 = x3*y1-x1*y3 | 227 | z2 = x3*y1-x1*y3 |
239 | z3 = x1*y2-x2*y1 | 228 | z3 = x1*y2-x2*y1 |
240 | 229 | ||
230 | {-# SPECIALIZE cross :: Vector Double -> Vector Double -> Vector Double #-} | ||
231 | {-# SPECIALIZE cross :: Vector (Complex Double) -> Vector (Complex Double) -> Vector (Complex Double) #-} | ||
232 | |||
241 | norm :: Vector Double -> Double | 233 | norm :: Vector Double -> Double |
242 | -- ^ 2-norm of real vector | 234 | -- ^ 2-norm of real vector |
243 | norm = pnorm PNorm2 | 235 | norm = pnorm PNorm2 |
@@ -403,40 +395,6 @@ null1sym = last . toColumns . snd . eigSH' | |||
403 | 395 | ||
404 | -------------------------------------------------------------------------------- | 396 | -------------------------------------------------------------------------------- |
405 | 397 | ||
406 | vec :: Element t => Matrix t -> Vector t | ||
407 | -- ^ stacking of columns | ||
408 | vec = flatten . trans | ||
409 | |||
410 | |||
411 | vech :: Element t => Matrix t -> Vector t | ||
412 | -- ^ half-vectorization (of the lower triangular part) | ||
413 | vech m = vjoin . zipWith f [0..] . toColumns $ m | ||
414 | where | ||
415 | f k v = subVector k (dim v - k) v | ||
416 | |||
417 | |||
418 | dup :: (Num t, Num (Vector t), Element t) => Int -> Matrix t | ||
419 | -- ^ duplication matrix (@'dup' k \<> 'vech' m == 'vec' m@, for symmetric m of 'dim' k) | ||
420 | dup k = trans $ fromRows $ map f es | ||
421 | where | ||
422 | rs = zip [0..] (toRows (ident (k^(2::Int)))) | ||
423 | es = [(i,j) | j <- [0..k-1], i <- [0..k-1], i>=j ] | ||
424 | f (i,j) | i == j = g (k*j + i) | ||
425 | | otherwise = g (k*j + i) + g (k*i + j) | ||
426 | g j = v | ||
427 | where | ||
428 | Just v = lookup j rs | ||
429 | |||
430 | |||
431 | vtrans :: Element t => Int -> Matrix t -> Matrix t | ||
432 | -- ^ generalized \"vector\" transposition: @'vtrans' 1 == 'trans'@, and @'vtrans' ('rows' m) m == 'asColumn' ('vec' m)@ | ||
433 | vtrans p m | r == 0 = fromBlocks . map (map asColumn . takesV (replicate q p)) . toColumns $ m | ||
434 | | otherwise = error $ "vtrans " ++ show p ++ " of matrix with " ++ show (rows m) ++ " rows" | ||
435 | where | ||
436 | (q,r) = divMod (rows m) p | ||
437 | |||
438 | -------------------------------------------------------------------------------- | ||
439 | |||
440 | infixl 0 ~!~ | 398 | infixl 0 ~!~ |
441 | c ~!~ msg = when c (error msg) | 399 | c ~!~ msg = when c (error msg) |
442 | 400 | ||
diff --git a/packages/base/src/Numeric/LinearAlgebra/Util/CG.hs b/packages/base/src/Numeric/LinearAlgebra/Util/CG.hs index b82c74f..899a5bf 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Util/CG.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Util/CG.hs | |||
@@ -9,7 +9,7 @@ module Numeric.LinearAlgebra.Util.CG( | |||
9 | import Data.Packed.Numeric | 9 | import Data.Packed.Numeric |
10 | import Numeric.Sparse | 10 | import Numeric.Sparse |
11 | import Numeric.Vector() | 11 | import Numeric.Vector() |
12 | import Numeric.LinearAlgebra.Algorithms(linearSolveLS, relativeError, NormType(..)) | 12 | import Numeric.LinearAlgebra.Algorithms(linearSolveLS, relativeError, pnorm, NormType(..)) |
13 | import Control.Arrow((***)) | 13 | import Control.Arrow((***)) |
14 | 14 | ||
15 | {- | 15 | {- |
@@ -142,13 +142,13 @@ instance Testable GMatrix | |||
142 | print s3; print d3 | 142 | print s3; print d3 |
143 | print s4; print d4 | 143 | print s4; print d4 |
144 | print s5; print d5 | 144 | print s5; print d5 |
145 | print $ relativeError Infinity s5 d5 | 145 | print $ relativeError (pnorm Infinity) s5 d5 |
146 | 146 | ||
147 | ok = s1==d1 | 147 | ok = s1==d1 |
148 | && s2==d2 | 148 | && s2==d2 |
149 | && s3==d3 | 149 | && s3==d3 |
150 | && s4==d4 | 150 | && s4==d4 |
151 | && relativeError Infinity s5 d5 < 1E-10 | 151 | && relativeError (pnorm Infinity) s5 d5 < 1E-10 |
152 | 152 | ||
153 | disp = putStr . dispf 2 | 153 | disp = putStr . dispf 2 |
154 | 154 | ||
diff --git a/packages/base/src/Numeric/Vectorized.hs b/packages/base/src/Numeric/Vectorized.hs index 6f0d240..405ae01 100644 --- a/packages/base/src/Numeric/Vectorized.hs +++ b/packages/base/src/Numeric/Vectorized.hs | |||
@@ -37,7 +37,6 @@ import Foreign.C.String | |||
37 | import System.IO.Unsafe(unsafePerformIO) | 37 | import System.IO.Unsafe(unsafePerformIO) |
38 | 38 | ||
39 | import Control.Monad(when) | 39 | import Control.Monad(when) |
40 | import Control.Applicative((<$>)) | ||
41 | 40 | ||
42 | 41 | ||
43 | 42 | ||
diff --git a/packages/glpk/hmatrix-glpk.cabal b/packages/glpk/hmatrix-glpk.cabal index 5a1b59c..8593e0a 100644 --- a/packages/glpk/hmatrix-glpk.cabal +++ b/packages/glpk/hmatrix-glpk.cabal | |||
@@ -1,5 +1,5 @@ | |||
1 | Name: hmatrix-glpk | 1 | Name: hmatrix-glpk |
2 | Version: 0.4.1.0 | 2 | Version: 0.5.0.0 |
3 | License: GPL | 3 | License: GPL |
4 | License-file: LICENSE | 4 | License-file: LICENSE |
5 | Author: Alberto Ruiz | 5 | Author: Alberto Ruiz |
@@ -23,7 +23,7 @@ extra-source-files: examples/simplex1.hs | |||
23 | examples/simplex5.hs | 23 | examples/simplex5.hs |
24 | 24 | ||
25 | library | 25 | library |
26 | Build-Depends: base <5, hmatrix >= 0.16, containers >= 0.5.4.0 | 26 | Build-Depends: base <5, hmatrix >= 0.17, containers |
27 | 27 | ||
28 | hs-source-dirs: src | 28 | hs-source-dirs: src |
29 | 29 | ||
diff --git a/packages/glpk/src/Numeric/LinearProgramming.hs b/packages/glpk/src/Numeric/LinearProgramming.hs index 6a0c47d..7bf4279 100644 --- a/packages/glpk/src/Numeric/LinearProgramming.hs +++ b/packages/glpk/src/Numeric/LinearProgramming.hs | |||
@@ -85,8 +85,8 @@ module Numeric.LinearProgramming( | |||
85 | Solution(..) | 85 | Solution(..) |
86 | ) where | 86 | ) where |
87 | 87 | ||
88 | import Data.Packed | 88 | import Numeric.LinearAlgebra.HMatrix |
89 | import Data.Packed.Development | 89 | import Numeric.LinearAlgebra.Devel hiding (Dense) |
90 | import Foreign(Ptr) | 90 | import Foreign(Ptr) |
91 | import System.IO.Unsafe(unsafePerformIO) | 91 | import System.IO.Unsafe(unsafePerformIO) |
92 | import Foreign.C.Types | 92 | import Foreign.C.Types |
@@ -180,16 +180,17 @@ exact opt constr@(General _) bnds = exact opt (sparseOfGeneral constr) bnds | |||
180 | 180 | ||
181 | adapt :: Optimization -> (Int, Double, [Double]) | 181 | adapt :: Optimization -> (Int, Double, [Double]) |
182 | adapt opt = case opt of | 182 | adapt opt = case opt of |
183 | Maximize x -> (size x, 1 ,x) | 183 | Maximize x -> (sz x, 1 ,x) |
184 | Minimize x -> (size x, -1, (map negate x)) | 184 | Minimize x -> (sz x, -1, (map negate x)) |
185 | where size x | null x = error "simplex: objective function with zero variables" | 185 | where |
186 | | otherwise = length x | 186 | sz x | null x = error "simplex: objective function with zero variables" |
187 | | otherwise = length x | ||
187 | 188 | ||
188 | extract :: Double -> Vector Double -> Solution | 189 | extract :: Double -> Vector Double -> Solution |
189 | extract sg sol = r where | 190 | extract sg sol = r where |
190 | z = sg * (sol@>1) | 191 | z = sg * (sol!1) |
191 | v = toList $ subVector 2 (dim sol -2) sol | 192 | v = toList $ subVector 2 (size sol -2) sol |
192 | r = case round(sol@>0)::Int of | 193 | r = case round(sol!0)::Int of |
193 | 1 -> Undefined | 194 | 1 -> Undefined |
194 | 2 -> Feasible (z,v) | 195 | 2 -> Feasible (z,v) |
195 | 3 -> Infeasible (z,v) | 196 | 3 -> Infeasible (z,v) |
@@ -261,7 +262,7 @@ mkConstrD n f b1 | ok = fromLists (ob ++ co) | |||
261 | ok = all (==n) ls | 262 | ok = all (==n) ls |
262 | den = fromLists cs | 263 | den = fromLists cs |
263 | ob = map (([0,0]++).return) f | 264 | ob = map (([0,0]++).return) f |
264 | co = [[fromIntegral i, fromIntegral j,den@@>(i-1,j-1)]| i<-[1 ..rows den], j<-[1 .. cols den]] | 265 | co = [[fromIntegral i, fromIntegral j,den `atIndex` (i-1,j-1)]| i<-[1 ..rows den], j<-[1 .. cols den]] |
265 | 266 | ||
266 | mkConstrS :: Int -> [Double] -> [Bound [(Double, Int)]] -> Matrix Double | 267 | mkConstrS :: Int -> [Double] -> [Bound [(Double, Int)]] -> Matrix Double |
267 | mkConstrS n objfun b1 = fromLists (ob ++ co) where | 268 | mkConstrS n objfun b1 = fromLists (ob ++ co) where |
diff --git a/packages/glpk/src/Numeric/LinearProgramming/L1.hs b/packages/glpk/src/Numeric/LinearProgramming/L1.hs index f55c721..d7f1258 100644 --- a/packages/glpk/src/Numeric/LinearProgramming/L1.hs +++ b/packages/glpk/src/Numeric/LinearProgramming/L1.hs | |||
@@ -14,7 +14,7 @@ module Numeric.LinearProgramming.L1 ( | |||
14 | l1SolveU, | 14 | l1SolveU, |
15 | ) where | 15 | ) where |
16 | 16 | ||
17 | import Numeric.LinearAlgebra | 17 | import Numeric.LinearAlgebra.HMatrix |
18 | import Numeric.LinearProgramming | 18 | import Numeric.LinearProgramming |
19 | 19 | ||
20 | -- | L_inf solution of overconstrained system Ax=b. | 20 | -- | L_inf solution of overconstrained system Ax=b. |
diff --git a/packages/gsl/CHANGELOG b/packages/gsl/CHANGELOG new file mode 100644 index 0000000..b83973a --- /dev/null +++ b/packages/gsl/CHANGELOG | |||
@@ -0,0 +1,10 @@ | |||
1 | 0.17.0.0 | ||
2 | -------- | ||
3 | |||
4 | * Added interpolation modules | ||
5 | |||
6 | 0.16.0.0 | ||
7 | -------- | ||
8 | |||
9 | * The modules Numeric.GSL.* have been moved from hmatrix to the new package hmatrix-gsl. | ||
10 | |||
diff --git a/packages/gsl/THANKS.md b/packages/gsl/THANKS.md new file mode 100644 index 0000000..b066185 --- /dev/null +++ b/packages/gsl/THANKS.md | |||
@@ -0,0 +1,4 @@ | |||
1 | Matt Peddie wrote the interpolation interface. | ||
2 | |||
3 | (see also the THANKS file of the hmatrix package) | ||
4 | |||
diff --git a/packages/gsl/hmatrix-gsl.cabal b/packages/gsl/hmatrix-gsl.cabal index 2f6f51b..7028bae 100644 --- a/packages/gsl/hmatrix-gsl.cabal +++ b/packages/gsl/hmatrix-gsl.cabal | |||
@@ -1,5 +1,5 @@ | |||
1 | Name: hmatrix-gsl | 1 | Name: hmatrix-gsl |
2 | Version: 0.16.0.3 | 2 | Version: 0.17.0.0 |
3 | License: GPL | 3 | License: GPL |
4 | License-file: LICENSE | 4 | License-file: LICENSE |
5 | Author: Alberto Ruiz | 5 | Author: Alberto Ruiz |
@@ -25,7 +25,7 @@ flag onlygsl | |||
25 | 25 | ||
26 | library | 26 | library |
27 | 27 | ||
28 | Build-Depends: base<5, hmatrix>=0.16, array, vector, | 28 | Build-Depends: base<5, hmatrix>=0.17, array, vector, |
29 | process, random | 29 | process, random |
30 | 30 | ||
31 | 31 | ||
diff --git a/packages/gsl/src/Graphics/Plot.hs b/packages/gsl/src/Graphics/Plot.hs index 0ea41ac..d2ea192 100644 --- a/packages/gsl/src/Graphics/Plot.hs +++ b/packages/gsl/src/Graphics/Plot.hs | |||
@@ -27,13 +27,13 @@ module Graphics.Plot( | |||
27 | 27 | ||
28 | ) where | 28 | ) where |
29 | 29 | ||
30 | import Numeric.Container | 30 | import Numeric.LinearAlgebra.HMatrix |
31 | import Data.List(intersperse) | 31 | import Data.List(intersperse) |
32 | import System.Process (system) | 32 | import System.Process (system) |
33 | 33 | ||
34 | -- | From vectors x and y, it generates a pair of matrices to be used as x and y arguments for matrix functions. | 34 | -- | From vectors x and y, it generates a pair of matrices to be used as x and y arguments for matrix functions. |
35 | meshdom :: Vector Double -> Vector Double -> (Matrix Double , Matrix Double) | 35 | meshdom :: Vector Double -> Vector Double -> (Matrix Double , Matrix Double) |
36 | meshdom r1 r2 = (outer r1 (constant 1 (dim r2)), outer (constant 1 (dim r1)) r2) | 36 | meshdom r1 r2 = (outer r1 (konst 1 (size r2)), outer (konst 1 (size r1)) r2) |
37 | 37 | ||
38 | 38 | ||
39 | {- | Draws a 3D surface representation of a real matrix. | 39 | {- | Draws a 3D surface representation of a real matrix. |
diff --git a/packages/gsl/src/Numeric/GSL/Fitting.hs b/packages/gsl/src/Numeric/GSL/Fitting.hs index 0a92373..db9d82f 100644 --- a/packages/gsl/src/Numeric/GSL/Fitting.hs +++ b/packages/gsl/src/Numeric/GSL/Fitting.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
1 | {- | | 3 | {- | |
2 | Module : Numeric.GSL.Fitting | 4 | Module : Numeric.GSL.Fitting |
3 | Copyright : (c) Alberto Ruiz 2010 | 5 | Copyright : (c) Alberto Ruiz 2010 |
@@ -50,7 +52,7 @@ module Numeric.GSL.Fitting ( | |||
50 | fitModelScaled, fitModel | 52 | fitModelScaled, fitModel |
51 | ) where | 53 | ) where |
52 | 54 | ||
53 | import Numeric.LinearAlgebra | 55 | import Numeric.LinearAlgebra.HMatrix |
54 | import Numeric.GSL.Internal | 56 | import Numeric.GSL.Internal |
55 | 57 | ||
56 | import Foreign.Ptr(FunPtr, freeHaskellFunPtr) | 58 | import Foreign.Ptr(FunPtr, freeHaskellFunPtr) |
@@ -80,13 +82,13 @@ nlFitting :: FittingMethod | |||
80 | nlFitting method epsabs epsrel maxit fun jac xinit = nlFitGen (fi (fromEnum method)) fun jac xinit epsabs epsrel maxit | 82 | nlFitting method epsabs epsrel maxit fun jac xinit = nlFitGen (fi (fromEnum method)) fun jac xinit epsabs epsrel maxit |
81 | 83 | ||
82 | nlFitGen m f jac xiv epsabs epsrel maxit = unsafePerformIO $ do | 84 | nlFitGen m f jac xiv epsabs epsrel maxit = unsafePerformIO $ do |
83 | let p = dim xiv | 85 | let p = size xiv |
84 | n = dim (f xiv) | 86 | n = size (f xiv) |
85 | fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) | 87 | fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) |
86 | jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) | 88 | jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) |
87 | rawpath <- createMatrix RowMajor maxit (2+p) | 89 | rawpath <- createMatrix RowMajor maxit (2+p) |
88 | app2 (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) vec xiv mat rawpath "c_nlfit" | 90 | app2 (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) vec xiv mat rawpath "c_nlfit" |
89 | let it = round (rawpath @@> (maxit-1,0)) | 91 | let it = round (rawpath `atIndex` (maxit-1,0)) |
90 | path = takeRows it rawpath | 92 | path = takeRows it rawpath |
91 | [sol] = toRows $ dropRows (it-1) path | 93 | [sol] = toRows $ dropRows (it-1) path |
92 | freeHaskellFunPtr fp | 94 | freeHaskellFunPtr fp |
@@ -99,7 +101,7 @@ foreign import ccall safe "nlfit" | |||
99 | ------------------------------------------------------- | 101 | ------------------------------------------------------- |
100 | 102 | ||
101 | checkdim1 n _p v | 103 | checkdim1 n _p v |
102 | | dim v == n = v | 104 | | size v == n = v |
103 | | otherwise = error $ "Error: "++ show n | 105 | | otherwise = error $ "Error: "++ show n |
104 | ++ " components expected in the result of the function supplied to nlFitting" | 106 | ++ " components expected in the result of the function supplied to nlFitting" |
105 | 107 | ||
@@ -114,9 +116,9 @@ err (model,deriv) dat vsol = zip sol errs where | |||
114 | sol = toList vsol | 116 | sol = toList vsol |
115 | c = max 1 (chi/sqrt (fromIntegral dof)) | 117 | c = max 1 (chi/sqrt (fromIntegral dof)) |
116 | dof = length dat - (rows cov) | 118 | dof = length dat - (rows cov) |
117 | chi = norm2 (fromList $ cost (resMs model) dat sol) | 119 | chi = norm_2 (fromList $ cost (resMs model) dat sol) |
118 | js = fromLists $ jacobian (resDs deriv) dat sol | 120 | js = fromLists $ jacobian (resDs deriv) dat sol |
119 | cov = inv $ trans js <> js | 121 | cov = inv $ tr js <> js |
120 | errs = toList $ scalar c * sqrt (takeDiag cov) | 122 | errs = toList $ scalar c * sqrt (takeDiag cov) |
121 | 123 | ||
122 | 124 | ||
diff --git a/packages/gsl/src/Numeric/GSL/Fourier.hs b/packages/gsl/src/Numeric/GSL/Fourier.hs index 734325b..d824b4f 100644 --- a/packages/gsl/src/Numeric/GSL/Fourier.hs +++ b/packages/gsl/src/Numeric/GSL/Fourier.hs | |||
@@ -16,14 +16,13 @@ module Numeric.GSL.Fourier ( | |||
16 | ifft | 16 | ifft |
17 | ) where | 17 | ) where |
18 | 18 | ||
19 | import Data.Packed | 19 | import Numeric.LinearAlgebra.HMatrix |
20 | import Numeric.GSL.Internal | 20 | import Numeric.GSL.Internal |
21 | import Data.Complex | ||
22 | import Foreign.C.Types | 21 | import Foreign.C.Types |
23 | import System.IO.Unsafe (unsafePerformIO) | 22 | import System.IO.Unsafe (unsafePerformIO) |
24 | 23 | ||
25 | genfft code v = unsafePerformIO $ do | 24 | genfft code v = unsafePerformIO $ do |
26 | r <- createVector (dim v) | 25 | r <- createVector (size v) |
27 | app2 (c_fft code) vec v vec r "fft" | 26 | app2 (c_fft code) vec v vec r "fft" |
28 | return r | 27 | return r |
29 | 28 | ||
diff --git a/packages/gsl/src/Numeric/GSL/IO.hs b/packages/gsl/src/Numeric/GSL/IO.hs index 0d6031a..936f6bf 100644 --- a/packages/gsl/src/Numeric/GSL/IO.hs +++ b/packages/gsl/src/Numeric/GSL/IO.hs | |||
@@ -14,7 +14,7 @@ module Numeric.GSL.IO ( | |||
14 | fileDimensions, loadMatrix, fromFile | 14 | fileDimensions, loadMatrix, fromFile |
15 | ) where | 15 | ) where |
16 | 16 | ||
17 | import Data.Packed | 17 | import Numeric.LinearAlgebra.HMatrix hiding(saveMatrix, loadMatrix) |
18 | import Numeric.GSL.Vector | 18 | import Numeric.GSL.Vector |
19 | import System.Process(readProcess) | 19 | import System.Process(readProcess) |
20 | 20 | ||
diff --git a/packages/gsl/src/Numeric/GSL/Internal.hs b/packages/gsl/src/Numeric/GSL/Internal.hs index a1c4e0c..a269224 100644 --- a/packages/gsl/src/Numeric/GSL/Internal.hs +++ b/packages/gsl/src/Numeric/GSL/Internal.hs | |||
@@ -22,14 +22,13 @@ module Numeric.GSL.Internal( | |||
22 | aux_vTom, | 22 | aux_vTom, |
23 | createV, | 23 | createV, |
24 | createMIO, | 24 | createMIO, |
25 | module Data.Packed.Development, | 25 | module Numeric.LinearAlgebra.Devel, |
26 | check, | 26 | check, |
27 | Res,TV,TM,TCV,TCM | 27 | Res,TV,TM,TCV,TCM |
28 | ) where | 28 | ) where |
29 | 29 | ||
30 | import Data.Packed | 30 | import Numeric.LinearAlgebra.HMatrix |
31 | import Data.Packed.Development hiding (check) | 31 | import Numeric.LinearAlgebra.Devel hiding (check) |
32 | import Data.Complex | ||
33 | 32 | ||
34 | import Foreign.Marshal.Array(copyArray) | 33 | import Foreign.Marshal.Array(copyArray) |
35 | import Foreign.Ptr(Ptr, FunPtr) | 34 | import Foreign.Ptr(Ptr, FunPtr) |
diff --git a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs index 17e2258..cb78bf4 100644 --- a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs +++ b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs | |||
@@ -15,7 +15,7 @@ module Numeric.GSL.LinearAlgebra ( | |||
15 | fileDimensions, loadMatrix, fromFile | 15 | fileDimensions, loadMatrix, fromFile |
16 | ) where | 16 | ) where |
17 | 17 | ||
18 | import Data.Packed | 18 | import Numeric.LinearAlgebra.HMatrix hiding (RandDist,randomVector,saveMatrix,loadMatrix) |
19 | import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) | 19 | import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) |
20 | 20 | ||
21 | import Foreign.Marshal.Alloc(free) | 21 | import Foreign.Marshal.Alloc(free) |
diff --git a/packages/gsl/src/Numeric/GSL/Minimization.hs b/packages/gsl/src/Numeric/GSL/Minimization.hs index 056d463..00e0619 100644 --- a/packages/gsl/src/Numeric/GSL/Minimization.hs +++ b/packages/gsl/src/Numeric/GSL/Minimization.hs | |||
@@ -1,3 +1,6 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
3 | |||
1 | {- | | 4 | {- | |
2 | Module : Numeric.GSL.Minimization | 5 | Module : Numeric.GSL.Minimization |
3 | Copyright : (c) Alberto Ruiz 2006-9 | 6 | Copyright : (c) Alberto Ruiz 2006-9 |
@@ -56,7 +59,7 @@ module Numeric.GSL.Minimization ( | |||
56 | ) where | 59 | ) where |
57 | 60 | ||
58 | 61 | ||
59 | import Data.Packed | 62 | import Numeric.LinearAlgebra.HMatrix hiding(step) |
60 | import Numeric.GSL.Internal | 63 | import Numeric.GSL.Internal |
61 | 64 | ||
62 | import Foreign.Ptr(Ptr, FunPtr, freeHaskellFunPtr) | 65 | import Foreign.Ptr(Ptr, FunPtr, freeHaskellFunPtr) |
@@ -99,7 +102,7 @@ uniMinimizeGen m f xmin xl xu epsrel maxit = unsafePerformIO $ do | |||
99 | rawpath <- createMIO maxit 4 | 102 | rawpath <- createMIO maxit 4 |
100 | (c_uniMinize m fp epsrel (fi maxit) xmin xl xu) | 103 | (c_uniMinize m fp epsrel (fi maxit) xmin xl xu) |
101 | "uniMinimize" | 104 | "uniMinimize" |
102 | let it = round (rawpath @@> (maxit-1,0)) | 105 | let it = round (rawpath `atIndex` (maxit-1,0)) |
103 | path = takeRows it rawpath | 106 | path = takeRows it rawpath |
104 | [sol] = toLists $ dropRows (it-1) path | 107 | [sol] = toLists $ dropRows (it-1) path |
105 | freeHaskellFunPtr fp | 108 | freeHaskellFunPtr fp |
@@ -137,13 +140,13 @@ minimize method eps maxit sz f xi = v2l $ minimizeV method eps maxit (fromList s | |||
137 | ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 | 140 | ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 |
138 | 141 | ||
139 | minimizeV method eps maxit szv f xiv = unsafePerformIO $ do | 142 | minimizeV method eps maxit szv f xiv = unsafePerformIO $ do |
140 | let n = dim xiv | 143 | let n = size xiv |
141 | fp <- mkVecfun (iv f) | 144 | fp <- mkVecfun (iv f) |
142 | rawpath <- ww2 vec xiv vec szv $ \xiv' szv' -> | 145 | rawpath <- ww2 vec xiv vec szv $ \xiv' szv' -> |
143 | createMIO maxit (n+3) | 146 | createMIO maxit (n+3) |
144 | (c_minimize (fi (fromEnum method)) fp eps (fi maxit) // xiv' // szv') | 147 | (c_minimize (fi (fromEnum method)) fp eps (fi maxit) // xiv' // szv') |
145 | "minimize" | 148 | "minimize" |
146 | let it = round (rawpath @@> (maxit-1,0)) | 149 | let it = round (rawpath `atIndex` (maxit-1,0)) |
147 | path = takeRows it rawpath | 150 | path = takeRows it rawpath |
148 | sol = flatten $ dropColumns 3 $ dropRows (it-1) path | 151 | sol = flatten $ dropColumns 3 $ dropRows (it-1) path |
149 | freeHaskellFunPtr fp | 152 | freeHaskellFunPtr fp |
@@ -191,7 +194,7 @@ minimizeD method eps maxit istep tol f df xi = v2l $ minimizeVD | |||
191 | 194 | ||
192 | 195 | ||
193 | minimizeVD method eps maxit istep tol f df xiv = unsafePerformIO $ do | 196 | minimizeVD method eps maxit istep tol f df xiv = unsafePerformIO $ do |
194 | let n = dim xiv | 197 | let n = size xiv |
195 | f' = f | 198 | f' = f |
196 | df' = (checkdim1 n . df) | 199 | df' = (checkdim1 n . df) |
197 | fp <- mkVecfun (iv f') | 200 | fp <- mkVecfun (iv f') |
@@ -200,7 +203,7 @@ minimizeVD method eps maxit istep tol f df xiv = unsafePerformIO $ do | |||
200 | createMIO maxit (n+2) | 203 | createMIO maxit (n+2) |
201 | (c_minimizeD (fi (fromEnum method)) fp dfp istep tol eps (fi maxit) // xiv') | 204 | (c_minimizeD (fi (fromEnum method)) fp dfp istep tol eps (fi maxit) // xiv') |
202 | "minimizeD" | 205 | "minimizeD" |
203 | let it = round (rawpath @@> (maxit-1,0)) | 206 | let it = round (rawpath `atIndex` (maxit-1,0)) |
204 | path = takeRows it rawpath | 207 | path = takeRows it rawpath |
205 | sol = flatten $ dropColumns 2 $ dropRows (it-1) path | 208 | sol = flatten $ dropColumns 2 $ dropRows (it-1) path |
206 | freeHaskellFunPtr fp | 209 | freeHaskellFunPtr fp |
@@ -217,6 +220,6 @@ foreign import ccall safe "gsl-aux.h minimizeD" | |||
217 | --------------------------------------------------------------------- | 220 | --------------------------------------------------------------------- |
218 | 221 | ||
219 | checkdim1 n v | 222 | checkdim1 n v |
220 | | dim v == n = v | 223 | | size v == n = v |
221 | | otherwise = error $ "Error: "++ show n | 224 | | otherwise = error $ "Error: "++ show n |
222 | ++ " components expected in the result of the gradient supplied to minimizeD" | 225 | ++ " components expected in the result of the gradient supplied to minimizeD" |
diff --git a/packages/gsl/src/Numeric/GSL/ODE.hs b/packages/gsl/src/Numeric/GSL/ODE.hs index 7549a65..3258b83 100644 --- a/packages/gsl/src/Numeric/GSL/ODE.hs +++ b/packages/gsl/src/Numeric/GSL/ODE.hs | |||
@@ -1,3 +1,6 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
3 | |||
1 | {- | | 4 | {- | |
2 | Module : Numeric.GSL.ODE | 5 | Module : Numeric.GSL.ODE |
3 | Copyright : (c) Alberto Ruiz 2010 | 6 | Copyright : (c) Alberto Ruiz 2010 |
@@ -32,7 +35,7 @@ module Numeric.GSL.ODE ( | |||
32 | odeSolve, odeSolveV, ODEMethod(..), Jacobian | 35 | odeSolve, odeSolveV, ODEMethod(..), Jacobian |
33 | ) where | 36 | ) where |
34 | 37 | ||
35 | import Data.Packed | 38 | import Numeric.LinearAlgebra.HMatrix |
36 | import Numeric.GSL.Internal | 39 | import Numeric.GSL.Internal |
37 | 40 | ||
38 | import Foreign.Ptr(FunPtr, nullFunPtr, freeHaskellFunPtr) | 41 | import Foreign.Ptr(FunPtr, nullFunPtr, freeHaskellFunPtr) |
@@ -68,7 +71,7 @@ odeSolve | |||
68 | -> Vector Double -- ^ desired solution times | 71 | -> Vector Double -- ^ desired solution times |
69 | -> Matrix Double -- ^ solution | 72 | -> Matrix Double -- ^ solution |
70 | odeSolve xdot xi ts = odeSolveV RKf45 hi epsAbs epsRel (l2v xdot) (fromList xi) ts | 73 | odeSolve xdot xi ts = odeSolveV RKf45 hi epsAbs epsRel (l2v xdot) (fromList xi) ts |
71 | where hi = (ts@>1 - ts@>0)/100 | 74 | where hi = (ts!1 - ts!0)/100 |
72 | epsAbs = 1.49012e-08 | 75 | epsAbs = 1.49012e-08 |
73 | epsRel = 1.49012e-08 | 76 | epsRel = 1.49012e-08 |
74 | l2v f = \t -> fromList . f t . toList | 77 | l2v f = \t -> fromList . f t . toList |
@@ -107,14 +110,14 @@ odeSolveV' | |||
107 | -> Vector Double -- ^ desired solution times | 110 | -> Vector Double -- ^ desired solution times |
108 | -> Matrix Double -- ^ solution | 111 | -> Matrix Double -- ^ solution |
109 | odeSolveV' method mbjac h epsAbs epsRel f xiv ts = unsafePerformIO $ do | 112 | odeSolveV' method mbjac h epsAbs epsRel f xiv ts = unsafePerformIO $ do |
110 | let n = dim xiv | 113 | let n = size xiv |
111 | fp <- mkDoubleVecVecfun (\t -> aux_vTov (checkdim1 n . f t)) | 114 | fp <- mkDoubleVecVecfun (\t -> aux_vTov (checkdim1 n . f t)) |
112 | jp <- case mbjac of | 115 | jp <- case mbjac of |
113 | Just jac -> mkDoubleVecMatfun (\t -> aux_vTom (checkdim2 n . jac t)) | 116 | Just jac -> mkDoubleVecMatfun (\t -> aux_vTom (checkdim2 n . jac t)) |
114 | Nothing -> return nullFunPtr | 117 | Nothing -> return nullFunPtr |
115 | sol <- vec xiv $ \xiv' -> | 118 | sol <- vec xiv $ \xiv' -> |
116 | vec (checkTimes ts) $ \ts' -> | 119 | vec (checkTimes ts) $ \ts' -> |
117 | createMIO (dim ts) n | 120 | createMIO (size ts) n |
118 | (ode_c (method) h epsAbs epsRel fp jp // xiv' // ts' ) | 121 | (ode_c (method) h epsAbs epsRel fp jp // xiv' // ts' ) |
119 | "ode" | 122 | "ode" |
120 | freeHaskellFunPtr fp | 123 | freeHaskellFunPtr fp |
@@ -126,7 +129,7 @@ foreign import ccall safe "ode" | |||
126 | ------------------------------------------------------- | 129 | ------------------------------------------------------- |
127 | 130 | ||
128 | checkdim1 n v | 131 | checkdim1 n v |
129 | | dim v == n = v | 132 | | size v == n = v |
130 | | otherwise = error $ "Error: "++ show n | 133 | | otherwise = error $ "Error: "++ show n |
131 | ++ " components expected in the result of the function supplied to odeSolve" | 134 | ++ " components expected in the result of the function supplied to odeSolve" |
132 | 135 | ||
@@ -135,6 +138,7 @@ checkdim2 n m | |||
135 | | otherwise = error $ "Error: "++ show n ++ "x" ++ show n | 138 | | otherwise = error $ "Error: "++ show n ++ "x" ++ show n |
136 | ++ " Jacobian expected in odeSolve" | 139 | ++ " Jacobian expected in odeSolve" |
137 | 140 | ||
138 | checkTimes ts | dim ts > 1 && all (>0) (zipWith subtract ts' (tail ts')) = ts | 141 | checkTimes ts | size ts > 1 && all (>0) (zipWith subtract ts' (tail ts')) = ts |
139 | | otherwise = error "odeSolve requires increasing times" | 142 | | otherwise = error "odeSolve requires increasing times" |
140 | where ts' = toList ts | 143 | where ts' = toList ts |
144 | |||
diff --git a/packages/gsl/src/Numeric/GSL/Polynomials.hs b/packages/gsl/src/Numeric/GSL/Polynomials.hs index b1be85d..246e301 100644 --- a/packages/gsl/src/Numeric/GSL/Polynomials.hs +++ b/packages/gsl/src/Numeric/GSL/Polynomials.hs | |||
@@ -16,9 +16,8 @@ module Numeric.GSL.Polynomials ( | |||
16 | polySolve | 16 | polySolve |
17 | ) where | 17 | ) where |
18 | 18 | ||
19 | import Data.Packed | 19 | import Numeric.LinearAlgebra.HMatrix |
20 | import Numeric.GSL.Internal | 20 | import Numeric.GSL.Internal |
21 | import Data.Complex | ||
22 | import System.IO.Unsafe (unsafePerformIO) | 21 | import System.IO.Unsafe (unsafePerformIO) |
23 | 22 | ||
24 | #if __GLASGOW_HASKELL__ >= 704 | 23 | #if __GLASGOW_HASKELL__ >= 704 |
@@ -47,8 +46,8 @@ polySolve :: [Double] -> [Complex Double] | |||
47 | polySolve = toList . polySolve' . fromList | 46 | polySolve = toList . polySolve' . fromList |
48 | 47 | ||
49 | polySolve' :: Vector Double -> Vector (Complex Double) | 48 | polySolve' :: Vector Double -> Vector (Complex Double) |
50 | polySolve' v | dim v > 1 = unsafePerformIO $ do | 49 | polySolve' v | size v > 1 = unsafePerformIO $ do |
51 | r <- createVector (dim v-1) | 50 | r <- createVector (size v-1) |
52 | app2 c_polySolve vec v vec r "polySolve" | 51 | app2 c_polySolve vec v vec r "polySolve" |
53 | return r | 52 | return r |
54 | | otherwise = error "polySolve on a polynomial of degree zero" | 53 | | otherwise = error "polySolve on a polynomial of degree zero" |
diff --git a/packages/gsl/src/Numeric/GSL/Random.hs b/packages/gsl/src/Numeric/GSL/Random.hs index f1f49e5..139c921 100644 --- a/packages/gsl/src/Numeric/GSL/Random.hs +++ b/packages/gsl/src/Numeric/GSL/Random.hs | |||
@@ -21,11 +21,13 @@ module Numeric.GSL.Random ( | |||
21 | ) where | 21 | ) where |
22 | 22 | ||
23 | import Numeric.GSL.Vector | 23 | import Numeric.GSL.Vector |
24 | import Numeric.LinearAlgebra(cholSH) | 24 | import Numeric.LinearAlgebra.HMatrix hiding ( |
25 | import Numeric.Container hiding ( | ||
26 | randomVector, | 25 | randomVector, |
27 | gaussianSample, | 26 | gaussianSample, |
28 | uniformSample | 27 | uniformSample, |
28 | Seed, | ||
29 | rand, | ||
30 | randn | ||
29 | ) | 31 | ) |
30 | import System.Random(randomIO) | 32 | import System.Random(randomIO) |
31 | 33 | ||
@@ -40,10 +42,10 @@ gaussianSample :: Seed | |||
40 | -> Matrix Double -- ^ covariance matrix | 42 | -> Matrix Double -- ^ covariance matrix |
41 | -> Matrix Double -- ^ result | 43 | -> Matrix Double -- ^ result |
42 | gaussianSample seed n med cov = m where | 44 | gaussianSample seed n med cov = m where |
43 | c = dim med | 45 | c = size med |
44 | meds = konst 1 n `outer` med | 46 | meds = konst 1 n `outer` med |
45 | rs = reshape c $ randomVector seed Gaussian (c * n) | 47 | rs = reshape c $ randomVector seed Gaussian (c * n) |
46 | m = rs `mXm` cholSH cov `add` meds | 48 | m = rs <> cholSH cov + meds |
47 | 49 | ||
48 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate | 50 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate |
49 | -- uniform distribution. | 51 | -- uniform distribution. |
@@ -55,10 +57,10 @@ uniformSample seed n rgs = m where | |||
55 | (as,bs) = unzip rgs | 57 | (as,bs) = unzip rgs |
56 | a = fromList as | 58 | a = fromList as |
57 | cs = zipWith subtract as bs | 59 | cs = zipWith subtract as bs |
58 | d = dim a | 60 | d = size a |
59 | dat = toRows $ reshape n $ randomVector seed Uniform (n*d) | 61 | dat = toRows $ reshape n $ randomVector seed Uniform (n*d) |
60 | am = konst 1 n `outer` a | 62 | am = konst 1 n `outer` a |
61 | m = fromColumns (zipWith scale cs dat) `add` am | 63 | m = fromColumns (zipWith scale cs dat) + am |
62 | 64 | ||
63 | -- | pseudorandom matrix with uniform elements between 0 and 1 | 65 | -- | pseudorandom matrix with uniform elements between 0 and 1 |
64 | randm :: RandDist | 66 | randm :: RandDist |
diff --git a/packages/gsl/src/Numeric/GSL/Root.hs b/packages/gsl/src/Numeric/GSL/Root.hs index b9f3b94..724f32f 100644 --- a/packages/gsl/src/Numeric/GSL/Root.hs +++ b/packages/gsl/src/Numeric/GSL/Root.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | |||
1 | {- | | 3 | {- | |
2 | Module : Numeric.GSL.Root | 4 | Module : Numeric.GSL.Root |
3 | Copyright : (c) Alberto Ruiz 2009 | 5 | Copyright : (c) Alberto Ruiz 2009 |
@@ -39,7 +41,7 @@ module Numeric.GSL.Root ( | |||
39 | rootJ, RootMethodJ(..), | 41 | rootJ, RootMethodJ(..), |
40 | ) where | 42 | ) where |
41 | 43 | ||
42 | import Data.Packed | 44 | import Numeric.LinearAlgebra.HMatrix |
43 | import Numeric.GSL.Internal | 45 | import Numeric.GSL.Internal |
44 | import Foreign.Ptr(FunPtr, freeHaskellFunPtr) | 46 | import Foreign.Ptr(FunPtr, freeHaskellFunPtr) |
45 | import Foreign.C.Types | 47 | import Foreign.C.Types |
@@ -69,7 +71,7 @@ uniRootGen m f xl xu epsrel maxit = unsafePerformIO $ do | |||
69 | rawpath <- createMIO maxit 4 | 71 | rawpath <- createMIO maxit 4 |
70 | (c_root m fp epsrel (fi maxit) xl xu) | 72 | (c_root m fp epsrel (fi maxit) xl xu) |
71 | "root" | 73 | "root" |
72 | let it = round (rawpath @@> (maxit-1,0)) | 74 | let it = round (rawpath `atIndex` (maxit-1,0)) |
73 | path = takeRows it rawpath | 75 | path = takeRows it rawpath |
74 | [sol] = toLists $ dropRows (it-1) path | 76 | [sol] = toLists $ dropRows (it-1) path |
75 | freeHaskellFunPtr fp | 77 | freeHaskellFunPtr fp |
@@ -100,7 +102,7 @@ uniRootJGen m f df x epsrel maxit = unsafePerformIO $ do | |||
100 | rawpath <- createMIO maxit 2 | 102 | rawpath <- createMIO maxit 2 |
101 | (c_rootj m fp dfp epsrel (fi maxit) x) | 103 | (c_rootj m fp dfp epsrel (fi maxit) x) |
102 | "rootj" | 104 | "rootj" |
103 | let it = round (rawpath @@> (maxit-1,0)) | 105 | let it = round (rawpath `atIndex` (maxit-1,0)) |
104 | path = takeRows it rawpath | 106 | path = takeRows it rawpath |
105 | [sol] = toLists $ dropRows (it-1) path | 107 | [sol] = toLists $ dropRows (it-1) path |
106 | freeHaskellFunPtr fp | 108 | freeHaskellFunPtr fp |
@@ -132,13 +134,13 @@ root method epsabs maxit fun xinit = rootGen (fi (fromEnum method)) fun xinit ep | |||
132 | 134 | ||
133 | rootGen m f xi epsabs maxit = unsafePerformIO $ do | 135 | rootGen m f xi epsabs maxit = unsafePerformIO $ do |
134 | let xiv = fromList xi | 136 | let xiv = fromList xi |
135 | n = dim xiv | 137 | n = size xiv |
136 | fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) | 138 | fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) |
137 | rawpath <- vec xiv $ \xiv' -> | 139 | rawpath <- vec xiv $ \xiv' -> |
138 | createMIO maxit (2*n+1) | 140 | createMIO maxit (2*n+1) |
139 | (c_multiroot m fp epsabs (fi maxit) // xiv') | 141 | (c_multiroot m fp epsabs (fi maxit) // xiv') |
140 | "multiroot" | 142 | "multiroot" |
141 | let it = round (rawpath @@> (maxit-1,0)) | 143 | let it = round (rawpath `atIndex` (maxit-1,0)) |
142 | path = takeRows it rawpath | 144 | path = takeRows it rawpath |
143 | [sol] = toLists $ dropRows (it-1) path | 145 | [sol] = toLists $ dropRows (it-1) path |
144 | freeHaskellFunPtr fp | 146 | freeHaskellFunPtr fp |
@@ -169,14 +171,14 @@ rootJ method epsabs maxit fun jac xinit = rootJGen (fi (fromEnum method)) fun ja | |||
169 | 171 | ||
170 | rootJGen m f jac xi epsabs maxit = unsafePerformIO $ do | 172 | rootJGen m f jac xi epsabs maxit = unsafePerformIO $ do |
171 | let xiv = fromList xi | 173 | let xiv = fromList xi |
172 | n = dim xiv | 174 | n = size xiv |
173 | fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) | 175 | fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) |
174 | jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList)) | 176 | jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList)) |
175 | rawpath <- vec xiv $ \xiv' -> | 177 | rawpath <- vec xiv $ \xiv' -> |
176 | createMIO maxit (2*n+1) | 178 | createMIO maxit (2*n+1) |
177 | (c_multirootj m fp jp epsabs (fi maxit) // xiv') | 179 | (c_multirootj m fp jp epsabs (fi maxit) // xiv') |
178 | "multiroot" | 180 | "multiroot" |
179 | let it = round (rawpath @@> (maxit-1,0)) | 181 | let it = round (rawpath `atIndex` (maxit-1,0)) |
180 | path = takeRows it rawpath | 182 | path = takeRows it rawpath |
181 | [sol] = toLists $ dropRows (it-1) path | 183 | [sol] = toLists $ dropRows (it-1) path |
182 | freeHaskellFunPtr fp | 184 | freeHaskellFunPtr fp |
@@ -189,7 +191,7 @@ foreign import ccall safe "multirootj" | |||
189 | ------------------------------------------------------- | 191 | ------------------------------------------------------- |
190 | 192 | ||
191 | checkdim1 n v | 193 | checkdim1 n v |
192 | | dim v == n = v | 194 | | size v == n = v |
193 | | otherwise = error $ "Error: "++ show n | 195 | | otherwise = error $ "Error: "++ show n |
194 | ++ " components expected in the result of the function supplied to root" | 196 | ++ " components expected in the result of the function supplied to root" |
195 | 197 | ||
diff --git a/packages/gsl/src/Numeric/GSL/Vector.hs b/packages/gsl/src/Numeric/GSL/Vector.hs index af79f32..0cd99eb 100644 --- a/packages/gsl/src/Numeric/GSL/Vector.hs +++ b/packages/gsl/src/Numeric/GSL/Vector.hs | |||
@@ -14,8 +14,7 @@ module Numeric.GSL.Vector ( | |||
14 | fwriteVector, freadVector, fprintfVector, fscanfVector | 14 | fwriteVector, freadVector, fprintfVector, fscanfVector |
15 | ) where | 15 | ) where |
16 | 16 | ||
17 | import Data.Packed | 17 | import Numeric.LinearAlgebra.HMatrix hiding(randomVector, saveMatrix) |
18 | import Numeric.LinearAlgebra(RandDist(..)) | ||
19 | import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) | 18 | import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) |
20 | 19 | ||
21 | import Foreign.Marshal.Alloc(free) | 20 | import Foreign.Marshal.Alloc(free) |
diff --git a/packages/sparse/src/Numeric/LinearAlgebra/Sparse.hs b/packages/sparse/src/Numeric/LinearAlgebra/Sparse.hs index 8608394..d75fec2 100644 --- a/packages/sparse/src/Numeric/LinearAlgebra/Sparse.hs +++ b/packages/sparse/src/Numeric/LinearAlgebra/Sparse.hs | |||
@@ -13,8 +13,11 @@ import System.IO.Unsafe(unsafePerformIO) | |||
13 | import Foreign(Ptr) | 13 | import Foreign(Ptr) |
14 | import Numeric.LinearAlgebra.HMatrix | 14 | import Numeric.LinearAlgebra.HMatrix |
15 | import Text.Printf | 15 | import Text.Printf |
16 | import Numeric.LinearAlgebra.Util((~!~)) | 16 | import Control.Monad(when) |
17 | 17 | ||
18 | (???) :: Bool -> String -> IO () | ||
19 | infixl 0 ??? | ||
20 | c ??? msg = when c (error msg) | ||
18 | 21 | ||
19 | type IV t = CInt -> Ptr CInt -> t | 22 | type IV t = CInt -> Ptr CInt -> t |
20 | type V t = CInt -> Ptr Double -> t | 23 | type V t = CInt -> Ptr Double -> t |
@@ -22,7 +25,7 @@ type SMxV = V (IV (IV (V (V (IO CInt))))) | |||
22 | 25 | ||
23 | dss :: CSR -> Vector Double -> Vector Double | 26 | dss :: CSR -> Vector Double -> Vector Double |
24 | dss CSR{..} b = unsafePerformIO $ do | 27 | dss CSR{..} b = unsafePerformIO $ do |
25 | size b /= csrNRows ~!~ printf "dss: incorrect sizes: (%d,%d) x %d" csrNRows csrNCols (size b) | 28 | size b /= csrNRows ??? printf "dss: incorrect sizes: (%d,%d) x %d" csrNRows csrNCols (size b) |
26 | r <- createVector csrNCols | 29 | r <- createVector csrNCols |
27 | app5 c_dss vec csrVals vec csrCols vec csrRows vec b vec r "dss" | 30 | app5 c_dss vec csrVals vec csrCols vec csrRows vec b vec r "dss" |
28 | return r | 31 | return r |
diff --git a/packages/special/hmatrix-special.cabal b/packages/special/hmatrix-special.cabal index 28b294b..3b122c8 100644 --- a/packages/special/hmatrix-special.cabal +++ b/packages/special/hmatrix-special.cabal | |||
@@ -1,5 +1,5 @@ | |||
1 | Name: hmatrix-special | 1 | Name: hmatrix-special |
2 | Version: 0.3.0.1 | 2 | Version: 0.4.0.0 |
3 | License: GPL | 3 | License: GPL |
4 | License-file: LICENSE | 4 | License-file: LICENSE |
5 | Author: Alberto Ruiz | 5 | Author: Alberto Ruiz |
@@ -27,7 +27,7 @@ flag safe-cheap | |||
27 | default: False | 27 | default: False |
28 | 28 | ||
29 | library | 29 | library |
30 | Build-Depends: base <5, hmatrix, hmatrix-gsl | 30 | Build-Depends: base <5, hmatrix>=0.17, hmatrix-gsl |
31 | 31 | ||
32 | Extensions: ForeignFunctionInterface, | 32 | Extensions: ForeignFunctionInterface, |
33 | CPP | 33 | CPP |
diff --git a/packages/special/lib/Numeric/GSL/Special/Internal.hsc b/packages/special/lib/Numeric/GSL/Special/Internal.hsc index e7c38e8..a9aab9b 100644 --- a/packages/special/lib/Numeric/GSL/Special/Internal.hsc +++ b/packages/special/lib/Numeric/GSL/Special/Internal.hsc | |||
@@ -33,7 +33,7 @@ import Foreign.Storable | |||
33 | import Foreign.Ptr | 33 | import Foreign.Ptr |
34 | import Foreign.Marshal | 34 | import Foreign.Marshal |
35 | import System.IO.Unsafe(unsafePerformIO) | 35 | import System.IO.Unsafe(unsafePerformIO) |
36 | import Data.Packed.Development(check,(//)) | 36 | import Numeric.LinearAlgebra.Devel(check,(//)) |
37 | import Foreign.C.Types | 37 | import Foreign.C.Types |
38 | 38 | ||
39 | data Precision = PrecDouble | PrecSingle | PrecApprox | 39 | data Precision = PrecDouble | PrecSingle | PrecApprox |
diff --git a/packages/tests/hmatrix-tests.cabal b/packages/tests/hmatrix-tests.cabal index 0514843..de796e8 100644 --- a/packages/tests/hmatrix-tests.cabal +++ b/packages/tests/hmatrix-tests.cabal | |||
@@ -1,5 +1,5 @@ | |||
1 | Name: hmatrix-tests | 1 | Name: hmatrix-tests |
2 | Version: 0.4.1.0 | 2 | Version: 0.5.0.0 |
3 | License: BSD3 | 3 | License: BSD3 |
4 | License-file: LICENSE | 4 | License-file: LICENSE |
5 | Author: Alberto Ruiz | 5 | Author: Alberto Ruiz |
@@ -28,9 +28,9 @@ library | |||
28 | 28 | ||
29 | Build-Depends: base >= 4 && < 5, | 29 | Build-Depends: base >= 4 && < 5, |
30 | QuickCheck >= 2, HUnit, random, | 30 | QuickCheck >= 2, HUnit, random, |
31 | hmatrix >= 0.16 | 31 | hmatrix >= 0.17 |
32 | if flag(gsl) | 32 | if flag(gsl) |
33 | Build-Depends: hmatrix-gsl >= 0.16 | 33 | Build-Depends: hmatrix-gsl >= 0.17 |
34 | 34 | ||
35 | hs-source-dirs: src | 35 | hs-source-dirs: src |
36 | 36 | ||
diff --git a/packages/tests/src/Numeric/GSL/Tests.hs b/packages/tests/src/Numeric/GSL/Tests.hs index 9dff6f5..e5d205d 100644 --- a/packages/tests/src/Numeric/GSL/Tests.hs +++ b/packages/tests/src/Numeric/GSL/Tests.hs | |||
@@ -19,7 +19,7 @@ import System.Exit (exitFailure) | |||
19 | 19 | ||
20 | import Test.HUnit (runTestTT, failures, Test(..), errors) | 20 | import Test.HUnit (runTestTT, failures, Test(..), errors) |
21 | 21 | ||
22 | import Numeric.LinearAlgebra | 22 | import Numeric.LinearAlgebra.HMatrix |
23 | import Numeric.GSL | 23 | import Numeric.GSL |
24 | import Numeric.LinearAlgebra.Tests (qCheck, utest) | 24 | import Numeric.LinearAlgebra.Tests (qCheck, utest) |
25 | import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~)) | 25 | import Numeric.LinearAlgebra.Tests.Properties ((|~|), (~~)) |
@@ -42,7 +42,7 @@ fittingTest = utest "levmar" (ok1 && ok2) | |||
42 | sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0] | 42 | sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0] |
43 | 43 | ||
44 | ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d | 44 | ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d |
45 | ok2 = norm2 (fromList (map fst sols) - fromList sol) < 1E-5 | 45 | ok2 = norm_2 (fromList (map fst sols) - fromList sol) < 1E-5 |
46 | 46 | ||
47 | --------------------------------------------------------------------- | 47 | --------------------------------------------------------------------- |
48 | 48 | ||
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs index 713af79..71c7c16 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs | |||
@@ -28,12 +28,9 @@ module Numeric.LinearAlgebra.Tests( | |||
28 | --, runBigTests | 28 | --, runBigTests |
29 | ) where | 29 | ) where |
30 | 30 | ||
31 | import Numeric.LinearAlgebra | 31 | import Numeric.LinearAlgebra hiding (unitary) |
32 | import Numeric.LinearAlgebra.HMatrix hiding ((<>),linearSolve) | 32 | import Numeric.LinearAlgebra.Devel hiding (vec) |
33 | import Numeric.LinearAlgebra.Static(L) | 33 | import Numeric.LinearAlgebra.Static(L) |
34 | import Numeric.LinearAlgebra.Util(col,row) | ||
35 | import Data.Packed | ||
36 | import Numeric.LinearAlgebra.LAPACK | ||
37 | import Numeric.LinearAlgebra.Tests.Instances | 34 | import Numeric.LinearAlgebra.Tests.Instances |
38 | import Numeric.LinearAlgebra.Tests.Properties | 35 | import Numeric.LinearAlgebra.Tests.Properties |
39 | import Test.HUnit hiding ((~:),test,Testable,State) | 36 | import Test.HUnit hiding ((~:),test,Testable,State) |
@@ -44,16 +41,13 @@ import qualified Prelude | |||
44 | import System.CPUTime | 41 | import System.CPUTime |
45 | import System.Exit | 42 | import System.Exit |
46 | import Text.Printf | 43 | import Text.Printf |
47 | import Data.Packed.Development(unsafeFromForeignPtr,unsafeToForeignPtr) | 44 | import Numeric.LinearAlgebra.Devel(unsafeFromForeignPtr,unsafeToForeignPtr) |
48 | import Control.Arrow((***)) | 45 | import Control.Arrow((***)) |
49 | import Debug.Trace | 46 | import Debug.Trace |
50 | import Control.Monad(when) | 47 | import Control.Monad(when) |
51 | import Numeric.LinearAlgebra.Util hiding (ones,row,col) | ||
52 | import Control.Applicative | 48 | import Control.Applicative |
53 | import Control.Monad(ap) | 49 | import Control.Monad(ap) |
54 | 50 | ||
55 | import Data.Packed.ST | ||
56 | |||
57 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | 51 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector |
58 | ,sized,classify,Testable,Property | 52 | ,sized,classify,Testable,Property |
59 | ,quickCheckWithResult,maxSize,stdArgs,shrink) | 53 | ,quickCheckWithResult,maxSize,stdArgs,shrink) |
@@ -89,7 +83,7 @@ detTest1 = det m == 26 | |||
89 | mc = (3><3) | 83 | mc = (3><3) |
90 | [ 1, 2, 3 | 84 | [ 1, 2, 3 |
91 | , 4, 5, 7 | 85 | , 4, 5, 7 |
92 | , 2, 8, i | 86 | , 2, 8, iC |
93 | ] | 87 | ] |
94 | 88 | ||
95 | detTest2 = inv1 |~| inv2 && [det1] ~~ [det2] | 89 | detTest2 = inv1 |~| inv2 && [det1] ~~ [det2] |
@@ -140,7 +134,7 @@ randomTestGaussian = c :~1~: snd (meanCov dat) where | |||
140 | 2,4,0, | 134 | 2,4,0, |
141 | -2,2,1] | 135 | -2,2,1] |
142 | m = 3 |> [1,2,3] | 136 | m = 3 |> [1,2,3] |
143 | c = a <> trans a | 137 | c = a <> tr a |
144 | dat = gaussianSample 7 (10^6) m c | 138 | dat = gaussianSample 7 (10^6) m c |
145 | 139 | ||
146 | randomTestUniform = c :~1~: snd (meanCov dat) where | 140 | randomTestUniform = c :~1~: snd (meanCov dat) where |
@@ -174,54 +168,54 @@ offsetTest = y == y' where | |||
174 | 168 | ||
175 | normsVTest = TestList [ | 169 | normsVTest = TestList [ |
176 | utest "normv2CD" $ norm2PropC v | 170 | utest "normv2CD" $ norm2PropC v |
177 | , utest "normv2CF" $ norm2PropC (single v) | 171 | -- , utest "normv2CF" $ norm2PropC (single v) |
178 | #ifndef NONORMVTEST | 172 | #ifndef NONORMVTEST |
179 | , utest "normv2D" $ norm2PropR x | 173 | , utest "normv2D" $ norm2PropR x |
180 | , utest "normv2F" $ norm2PropR (single x) | 174 | -- , utest "normv2F" $ norm2PropR (single x) |
181 | #endif | 175 | #endif |
182 | , utest "normv1CD" $ norm1 v == 8 | 176 | , utest "normv1CD" $ norm_1 v == 8 |
183 | , utest "normv1CF" $ norm1 (single v) == 8 | 177 | -- , utest "normv1CF" $ norm_1 (single v) == 8 |
184 | , utest "normv1D" $ norm1 x == 6 | 178 | , utest "normv1D" $ norm_1 x == 6 |
185 | , utest "normv1F" $ norm1 (single x) == 6 | 179 | -- , utest "normv1F" $ norm_1 (single x) == 6 |
186 | 180 | ||
187 | , utest "normvInfCD" $ normInf v == 5 | 181 | , utest "normvInfCD" $ norm_Inf v == 5 |
188 | , utest "normvInfCF" $ normInf (single v) == 5 | 182 | -- , utest "normvInfCF" $ norm_Inf (single v) == 5 |
189 | , utest "normvInfD" $ normInf x == 3 | 183 | , utest "normvInfD" $ norm_Inf x == 3 |
190 | , utest "normvInfF" $ normInf (single x) == 3 | 184 | -- , utest "normvInfF" $ norm_Inf (single x) == 3 |
191 | 185 | ||
192 | ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double) | 186 | ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double) |
193 | x = fromList [1,2,-3] :: Vector Double | 187 | x = fromList [1,2,-3] :: Vector Double |
194 | #ifndef NONORMVTEST | 188 | #ifndef NONORMVTEST |
195 | norm2PropR a = norm2 a =~= sqrt (udot a a) | 189 | norm2PropR a = norm_2 a =~= sqrt (udot a a) |
196 | #endif | 190 | #endif |
197 | norm2PropC a = norm2 a =~= realPart (sqrt (a <.> a)) | 191 | norm2PropC a = norm_2 a =~= realPart (sqrt (a `dot` a)) |
198 | a =~= b = fromList [a] |~| fromList [b] | 192 | a =~= b = fromList [a] |~| fromList [b] |
199 | 193 | ||
200 | normsMTest = TestList [ | 194 | normsMTest = TestList [ |
201 | utest "norm2mCD" $ pnorm PNorm2 v =~= 8.86164970498005 | 195 | utest "norm2mCD" $ norm_2 v =~= 8.86164970498005 |
202 | , utest "norm2mCF" $ pnorm PNorm2 (single v) =~= 8.86164970498005 | 196 | -- , utest "norm2mCF" $ norm_2 (single v) =~= 8.86164970498005 |
203 | , utest "norm2mD" $ pnorm PNorm2 x =~= 5.96667765076216 | 197 | , utest "norm2mD" $ norm_2 x =~= 5.96667765076216 |
204 | , utest "norm2mF" $ pnorm PNorm2 (single x) =~= 5.96667765076216 | 198 | -- , utest "norm2mF" $ norm_2 (single x) =~= 5.96667765076216 |
205 | 199 | ||
206 | , utest "norm1mCD" $ pnorm PNorm1 v == 9 | 200 | , utest "norm1mCD" $ norm_1 v == 9 |
207 | , utest "norm1mCF" $ pnorm PNorm1 (single v) == 9 | 201 | -- , utest "norm1mCF" $ norm_1 (single v) == 9 |
208 | , utest "norm1mD" $ pnorm PNorm1 x == 7 | 202 | , utest "norm1mD" $ norm_1 x == 7 |
209 | , utest "norm1mF" $ pnorm PNorm1 (single x) == 7 | 203 | -- , utest "norm1mF" $ norm_1 (single x) == 7 |
210 | 204 | ||
211 | , utest "normmInfCD" $ pnorm Infinity v == 12 | 205 | , utest "normmInfCD" $ norm_Inf v == 12 |
212 | , utest "normmInfCF" $ pnorm Infinity (single v) == 12 | 206 | -- , utest "normmInfCF" $ norm_Inf (single v) == 12 |
213 | , utest "normmInfD" $ pnorm Infinity x == 8 | 207 | , utest "normmInfD" $ norm_Inf x == 8 |
214 | , utest "normmInfF" $ pnorm Infinity (single x) == 8 | 208 | -- , utest "normmInfF" $ norm_Inf (single x) == 8 |
215 | 209 | ||
216 | , utest "normmFroCD" $ pnorm Frobenius v =~= 8.88819441731559 | 210 | , utest "normmFroCD" $ norm_Frob v =~= 8.88819441731559 |
217 | , utest "normmFroCF" $ pnorm Frobenius (single v) =~~= 8.88819441731559 | 211 | -- , utest "normmFroCF" $ norm_Frob (single v) =~~= 8.88819441731559 |
218 | , utest "normmFroD" $ pnorm Frobenius x =~= 6.24499799839840 | 212 | , utest "normmFroD" $ norm_Frob x =~= 6.24499799839840 |
219 | , utest "normmFroF" $ pnorm Frobenius (single x) =~~= 6.24499799839840 | 213 | -- , utest "normmFroF" $ norm_Frob (single x) =~~= 6.24499799839840 |
220 | 214 | ||
221 | ] where v = (2><2) [1,-2*i,3:+4,7] :: Matrix (Complex Double) | 215 | ] where v = (2><2) [1,-2*iC,3:+4,7] :: Matrix (Complex Double) |
222 | x = (2><2) [1,2,-3,5] :: Matrix Double | 216 | x = (2><2) [1,2,-3,5] :: Matrix Double |
223 | a =~= b = fromList [a] :~10~: fromList [b] | 217 | a =~= b = fromList [a] :~10~: fromList [b] |
224 | a =~~= b = fromList [a] :~5~: fromList [b] | 218 | -- a =~~= b = fromList [a] :~5~: fromList [b] |
225 | 219 | ||
226 | --------------------------------------------------------------------- | 220 | --------------------------------------------------------------------- |
227 | 221 | ||
@@ -236,7 +230,7 @@ sumprodTest = TestList [ | |||
236 | , utest "prodD" $ prodProp v | 230 | , utest "prodD" $ prodProp v |
237 | , utest "prodF" $ prodProp (single v) | 231 | , utest "prodF" $ prodProp (single v) |
238 | ] where v = fromList [1,2,3] :: Vector Double | 232 | ] where v = fromList [1,2,3] :: Vector Double |
239 | z = fromList [1,2-i,3+i] | 233 | z = fromList [1,2-iC,3+iC] |
240 | prodProp x = prodElements x == product (toList x) | 234 | prodProp x = prodElements x == product (toList x) |
241 | 235 | ||
242 | --------------------------------------------------------------------- | 236 | --------------------------------------------------------------------- |
@@ -250,7 +244,7 @@ chainTest = utest "chain" $ foldl1' (<>) ms |~| optimiseMult ms where | |||
250 | 244 | ||
251 | --------------------------------------------------------------------- | 245 | --------------------------------------------------------------------- |
252 | 246 | ||
253 | conjuTest m = mapVector conjugate (flatten (trans m)) == flatten (ctrans m) | 247 | conjuTest m = cmap conjugate (flatten (conj (tr m))) == flatten (tr m) |
254 | 248 | ||
255 | --------------------------------------------------------------------- | 249 | --------------------------------------------------------------------- |
256 | 250 | ||
@@ -306,7 +300,7 @@ lift_maybe m = MaybeT $ do | |||
306 | 300 | ||
307 | -- apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs | 301 | -- apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs |
308 | --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool | 302 | --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool |
309 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ stp (subVector 1 (dim v - 1) v))) (v @> 0) | 303 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ stp (subVector 1 (size v - 1) v))) (v ! 0) |
310 | where stp e = do | 304 | where stp e = do |
311 | ep <- lift_maybe $ state_get | 305 | ep <- lift_maybe $ state_get |
312 | if t e ep | 306 | if t e ep |
@@ -315,7 +309,7 @@ successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ s | |||
315 | 309 | ||
316 | -- operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input | 310 | -- operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input |
317 | --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b | 311 | --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b |
318 | successive f v = evalState (mapVectorM stp (subVector 1 (dim v - 1) v)) (v @> 0) | 312 | successive f v = evalState (mapVectorM stp (subVector 1 (size v - 1) v)) (v ! 0) |
319 | where stp e = do | 313 | where stp e = do |
320 | ep <- state_get | 314 | ep <- state_get |
321 | state_put e | 315 | state_put e |
@@ -377,23 +371,6 @@ convolutionTest = utest "convolution" ok | |||
377 | 371 | ||
378 | -------------------------------------------------------------------------------- | 372 | -------------------------------------------------------------------------------- |
379 | 373 | ||
380 | kroneckerTest = utest "kronecker" ok | ||
381 | where | ||
382 | a,x,b :: Matrix Double | ||
383 | a = (3><4) [1..] | ||
384 | x = (4><2) [3,5..] | ||
385 | b = (2><5) [0,5..] | ||
386 | v1 = vec (a <> x <> b) | ||
387 | v2 = (trans b `kronecker` a) <> vec x | ||
388 | s = trans b <> b | ||
389 | v3 = vec s | ||
390 | v4 = (dup 5 :: Matrix Double) <> vech s | ||
391 | ok = v1 == v2 && v3 == v4 | ||
392 | && vtrans 1 a == trans a | ||
393 | && vtrans (rows a) a == asColumn (vec a) | ||
394 | |||
395 | -------------------------------------------------------------------------------- | ||
396 | |||
397 | sparseTest = utest "sparse" (fst $ checkT (undefined :: GMatrix)) | 374 | sparseTest = utest "sparse" (fst $ checkT (undefined :: GMatrix)) |
398 | 375 | ||
399 | -------------------------------------------------------------------------------- | 376 | -------------------------------------------------------------------------------- |
@@ -435,11 +412,11 @@ runTests n = do | |||
435 | test (multProp1 10 . cConsist) | 412 | test (multProp1 10 . cConsist) |
436 | test (multProp2 10 . rConsist) | 413 | test (multProp2 10 . rConsist) |
437 | test (multProp2 10 . cConsist) | 414 | test (multProp2 10 . cConsist) |
438 | putStrLn "------ mult Float" | 415 | -- putStrLn "------ mult Float" |
439 | test (multProp1 6 . (single *** single) . rConsist) | 416 | -- test (multProp1 6 . (single *** single) . rConsist) |
440 | test (multProp1 6 . (single *** single) . cConsist) | 417 | -- test (multProp1 6 . (single *** single) . cConsist) |
441 | test (multProp2 6 . (single *** single) . rConsist) | 418 | -- test (multProp2 6 . (single *** single) . rConsist) |
442 | test (multProp2 6 . (single *** single) . cConsist) | 419 | -- test (multProp2 6 . (single *** single) . cConsist) |
443 | putStrLn "------ sub-trans" | 420 | putStrLn "------ sub-trans" |
444 | test (subProp . rM) | 421 | test (subProp . rM) |
445 | test (subProp . cM) | 422 | test (subProp . cM) |
@@ -472,16 +449,16 @@ runTests n = do | |||
472 | putStrLn "------ svd" | 449 | putStrLn "------ svd" |
473 | test (svdProp1 . rM) | 450 | test (svdProp1 . rM) |
474 | test (svdProp1 . cM) | 451 | test (svdProp1 . cM) |
475 | test (svdProp1a svdR) | 452 | test (svdProp1a svd . rM) |
476 | test (svdProp1a svdC) | 453 | test (svdProp1a svd . cM) |
477 | test (svdProp1a svdRd) | 454 | -- test (svdProp1a svdRd) |
478 | test (svdProp1b svdR) | 455 | test (svdProp1b svd . rM) |
479 | test (svdProp1b svdC) | 456 | test (svdProp1b svd . cM) |
480 | test (svdProp1b svdRd) | 457 | -- test (svdProp1b svdRd) |
481 | test (svdProp2 thinSVDR) | 458 | test (svdProp2 thinSVD . rM) |
482 | test (svdProp2 thinSVDC) | 459 | test (svdProp2 thinSVD . cM) |
483 | test (svdProp2 thinSVDRd) | 460 | -- test (svdProp2 thinSVDRd) |
484 | test (svdProp2 thinSVDCd) | 461 | -- test (svdProp2 thinSVDCd) |
485 | test (svdProp3 . rM) | 462 | test (svdProp3 . rM) |
486 | test (svdProp3 . cM) | 463 | test (svdProp3 . cM) |
487 | test (svdProp4 . rM) | 464 | test (svdProp4 . rM) |
@@ -492,12 +469,12 @@ runTests n = do | |||
492 | test (svdProp6b) | 469 | test (svdProp6b) |
493 | test (svdProp7 . rM) | 470 | test (svdProp7 . rM) |
494 | test (svdProp7 . cM) | 471 | test (svdProp7 . cM) |
495 | putStrLn "------ svdCd" | 472 | -- putStrLn "------ svdCd" |
496 | #ifdef NOZGESDD | 473 | #ifdef NOZGESDD |
497 | putStrLn "Omitted" | 474 | -- putStrLn "Omitted" |
498 | #else | 475 | #else |
499 | test (svdProp1a svdCd) | 476 | -- test (svdProp1a svdCd) |
500 | test (svdProp1b svdCd) | 477 | -- test (svdProp1b svdCd) |
501 | #endif | 478 | #endif |
502 | putStrLn "------ eig" | 479 | putStrLn "------ eig" |
503 | test (eigSHProp . rHer) | 480 | test (eigSHProp . rHer) |
@@ -515,10 +492,10 @@ runTests n = do | |||
515 | test (qrProp . rM) | 492 | test (qrProp . rM) |
516 | test (qrProp . cM) | 493 | test (qrProp . cM) |
517 | test (rqProp . rM) | 494 | test (rqProp . rM) |
518 | test (rqProp . cM) | 495 | -- test (rqProp . cM) |
519 | test (rqProp1 . cM) | 496 | test (rqProp1 . cM) |
520 | test (rqProp2 . cM) | 497 | test (rqProp2 . cM) |
521 | test (rqProp3 . cM) | 498 | -- test (rqProp3 . cM) |
522 | putStrLn "------ hess" | 499 | putStrLn "------ hess" |
523 | test (hessProp . rSq) | 500 | test (hessProp . rSq) |
524 | test (hessProp . cSq) | 501 | test (hessProp . cSq) |
@@ -539,12 +516,12 @@ runTests n = do | |||
539 | test (\u -> sin u ** 2 + cos u ** 2 |~| (1::RM)) | 516 | test (\u -> sin u ** 2 + cos u ** 2 |~| (1::RM)) |
540 | test (\u -> cos u * tan u |~| sin (u::RM)) | 517 | test (\u -> cos u * tan u |~| sin (u::RM)) |
541 | test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary | 518 | test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary |
542 | putStrLn "------ vector operations - Float" | 519 | -- putStrLn "------ vector operations - Float" |
543 | test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM)) | 520 | -- test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM)) |
544 | test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary | 521 | -- test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary |
545 | test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM)) | 522 | -- test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM)) |
546 | test (\u -> cos u * tan u |~~| sin (u::FM)) | 523 | -- test (\u -> cos u * tan u |~~| sin (u::FM)) |
547 | test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary | 524 | -- test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary |
548 | putStrLn "------ read . show" | 525 | putStrLn "------ read . show" |
549 | test (\m -> (m::RM) == read (show m)) | 526 | test (\m -> (m::RM) == read (show m)) |
550 | test (\m -> (m::CM) == read (show m)) | 527 | test (\m -> (m::CM) == read (show m)) |
@@ -562,8 +539,8 @@ runTests n = do | |||
562 | , utest "expm1" (expmTest1) | 539 | , utest "expm1" (expmTest1) |
563 | , utest "expm2" (expmTest2) | 540 | , utest "expm2" (expmTest2) |
564 | , utest "arith1" $ ((ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| (49 :: RM) | 541 | , utest "arith1" $ ((ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| (49 :: RM) |
565 | , utest "arith2" $ ((scalar (1+i) * ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| ( scalar (140*i-51) :: CM) | 542 | , utest "arith2" $ ((scalar (1+iC) * ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| ( scalar (140*iC-51) :: CM) |
566 | , utest "arith3" $ exp (scalar i * ones(10,10)*pi) + 1 |~| 0 | 543 | , utest "arith3" $ exp (scalar iC * ones(10,10)*pi) + 1 |~| 0 |
567 | , utest "<\\>" $ (3><2) [2,0,0,3,1,1::Double] <\> 3|>[4,9,5] |~| 2|>[2,3] | 544 | , utest "<\\>" $ (3><2) [2,0,0,3,1,1::Double] <\> 3|>[4,9,5] |~| 2|>[2,3] |
568 | -- , utest "gamma" (gamma 5 == 24.0) | 545 | -- , utest "gamma" (gamma 5 == 24.0) |
569 | -- , besselTest | 546 | -- , besselTest |
@@ -571,10 +548,10 @@ runTests n = do | |||
571 | , utest "randomGaussian" randomTestGaussian | 548 | , utest "randomGaussian" randomTestGaussian |
572 | , utest "randomUniform" randomTestUniform | 549 | , utest "randomUniform" randomTestUniform |
573 | , utest "buildVector/Matrix" $ | 550 | , utest "buildVector/Matrix" $ |
574 | complex (10 |> [0::Double ..]) == buildVector 10 fromIntegral | 551 | complex (10 |> [0::Double ..]) == build 10 id |
575 | && ident 5 == buildMatrix 5 5 (\(r,c) -> if r==c then 1::Double else 0) | 552 | && ident 5 == build (5,5) (\r c -> if r==c then 1::Double else 0) |
576 | , utest "rank" $ rank ((2><3)[1,0,0,1,5*eps,0]) == 1 | 553 | , utest "rank" $ rank ((2><3)[1,0,0,1,5*peps,0::Double]) == 1 |
577 | && rank ((2><3)[1,0,0,1,7*eps,0]) == 2 | 554 | && rank ((2><3)[1,0,0,1,7*peps,0::Double]) == 2 |
578 | , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) | 555 | , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM) |
579 | , mbCholTest | 556 | , mbCholTest |
580 | , utest "offset" offsetTest | 557 | , utest "offset" offsetTest |
@@ -588,7 +565,6 @@ runTests n = do | |||
588 | , conformTest | 565 | , conformTest |
589 | , accumTest | 566 | , accumTest |
590 | , convolutionTest | 567 | , convolutionTest |
591 | , kroneckerTest | ||
592 | , sparseTest | 568 | , sparseTest |
593 | , staticTest | 569 | , staticTest |
594 | ] | 570 | ] |
@@ -597,12 +573,12 @@ runTests n = do | |||
597 | 573 | ||
598 | 574 | ||
599 | -- single precision approximate equality | 575 | -- single precision approximate equality |
600 | infixl 4 |~~| | 576 | -- infixl 4 |~~| |
601 | a |~~| b = a :~6~: b | 577 | -- a |~~| b = a :~6~: b |
602 | 578 | ||
603 | makeUnitary v | realPart n > 1 = v / scalar n | 579 | makeUnitary v | realPart n > 1 = v / scalar n |
604 | | otherwise = v | 580 | | otherwise = v |
605 | where n = sqrt (v <.> v) | 581 | where n = sqrt (v `dot` v) |
606 | 582 | ||
607 | -- -- | Some additional tests on big matrices. They take a few minutes. | 583 | -- -- | Some additional tests on big matrices. They take a few minutes. |
608 | -- runBigTests :: IO () | 584 | -- runBigTests :: IO () |
@@ -668,9 +644,9 @@ manyvec5 xs = sumElements $ fromRows $ map (\x -> vec3 x (x**2) (x**3)) xs | |||
668 | 644 | ||
669 | 645 | ||
670 | manyvec2 xs = sum $ map (\x -> sqrt(x^2 + (x**2)^2 +(x**3)^2)) xs | 646 | manyvec2 xs = sum $ map (\x -> sqrt(x^2 + (x**2)^2 +(x**3)^2)) xs |
671 | manyvec3 xs = sum $ map (pnorm PNorm2 . (\x -> fromList [x,x**2,x**3])) xs | 647 | manyvec3 xs = sum $ map (norm_2 . (\x -> fromList [x,x**2,x**3])) xs |
672 | 648 | ||
673 | manyvec4 xs = sum $ map (pnorm PNorm2 . (\x -> vec3 x (x**2) (x**3))) xs | 649 | manyvec4 xs = sum $ map (norm_2 . (\x -> vec3 x (x**2) (x**3))) xs |
674 | 650 | ||
675 | vec3 :: Double -> Double -> Double -> Vector Double | 651 | vec3 :: Double -> Double -> Double -> Vector Double |
676 | vec3 a b c = runSTVector $ do | 652 | vec3 a b c = runSTVector $ do |
@@ -695,11 +671,11 @@ mkVecBench = do | |||
695 | 671 | ||
696 | subBench = do | 672 | subBench = do |
697 | putStrLn "" | 673 | putStrLn "" |
698 | let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (dim v -1) v)) | 674 | let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (size v -1) v)) |
699 | time "0.1M subVector " (g (konst 1 (1+10^5) :: Vector Double) @> 0) | 675 | time "0.1M subVector " (g (konst 1 (1+10^5) :: Vector Double) ! 0) |
700 | let f = foldl1' (.) (replicate (10^5) (fromRows.toRows)) | 676 | let f = foldl1' (.) (replicate (10^5) (fromRows.toRows)) |
701 | time "subVector-join 3" (f (ident 3 :: Matrix Double) @@>(0,0)) | 677 | time "subVector-join 3" (f (ident 3 :: Matrix Double) `atIndex` (0,0)) |
702 | time "subVector-join 10" (f (ident 10 :: Matrix Double) @@>(0,0)) | 678 | time "subVector-join 10" (f (ident 10 :: Matrix Double) `atIndex` (0,0)) |
703 | 679 | ||
704 | -------------------------------- | 680 | -------------------------------- |
705 | 681 | ||
@@ -724,7 +700,7 @@ multBench = do | |||
724 | 700 | ||
725 | eigBench = do | 701 | eigBench = do |
726 | let m = reshape 1000 (randomVector 777 Uniform (1000*1000)) | 702 | let m = reshape 1000 (randomVector 777 Uniform (1000*1000)) |
727 | s = m + trans m | 703 | s = m + tr m |
728 | m `seq` s `seq` putStrLn "" | 704 | m `seq` s `seq` putStrLn "" |
729 | time "eigenvalues symmetric 1000x1000" (eigenvaluesSH' m) | 705 | time "eigenvalues symmetric 1000x1000" (eigenvaluesSH' m) |
730 | time "eigenvectors symmetric 1000x1000" (snd $ eigSH' m) | 706 | time "eigenvectors symmetric 1000x1000" (snd $ eigSH' m) |
@@ -736,7 +712,7 @@ eigBench = do | |||
736 | svdBench = do | 712 | svdBench = do |
737 | let a = reshape 500 (randomVector 777 Uniform (3000*500)) | 713 | let a = reshape 500 (randomVector 777 Uniform (3000*500)) |
738 | b = reshape 1000 (randomVector 777 Uniform (1000*1000)) | 714 | b = reshape 1000 (randomVector 777 Uniform (1000*1000)) |
739 | fv (_,_,v) = v@@>(0,0) | 715 | fv (_,_,v) = v `atIndex` (0,0) |
740 | a `seq` b `seq` putStrLn "" | 716 | a `seq` b `seq` putStrLn "" |
741 | time "singular values 3000x500" (singularValues a) | 717 | time "singular values 3000x500" (singularValues a) |
742 | time "thin svd 3000x500" (fv $ thinSVD a) | 718 | time "thin svd 3000x500" (fv $ thinSVD a) |
@@ -748,7 +724,7 @@ svdBench = do | |||
748 | 724 | ||
749 | solveBenchN n = do | 725 | solveBenchN n = do |
750 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) | 726 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) |
751 | a = trans x <> x | 727 | a = tr x <> x |
752 | b = asColumn $ randomVector 666 Uniform n | 728 | b = asColumn $ randomVector 666 Uniform n |
753 | a `seq` b `seq` putStrLn "" | 729 | a `seq` b `seq` putStrLn "" |
754 | time ("svd solve " ++ show n) (linearSolveSVD a b) | 730 | time ("svd solve " ++ show n) (linearSolveSVD a b) |
@@ -765,7 +741,7 @@ solveBench = do | |||
765 | 741 | ||
766 | cholBenchN n = do | 742 | cholBenchN n = do |
767 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) | 743 | let x = uniformSample 777 (2*n) (replicate n (-1,1)) |
768 | a = trans x <> x | 744 | a = tr x <> x |
769 | a `seq` putStr "" | 745 | a `seq` putStr "" |
770 | time ("chol " ++ show n) (chol a) | 746 | time ("chol " ++ show n) (chol a) |
771 | 747 | ||
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index 53fc4d2..904ae05 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs | |||
@@ -1,5 +1,4 @@ | |||
1 | {-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP, FlexibleInstances #-} | 1 | {-# LANGUAGE FlexibleContexts, UndecidableInstances, FlexibleInstances #-} |
2 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} | ||
3 | ----------------------------------------------------------------------------- | 2 | ----------------------------------------------------------------------------- |
4 | {- | | 3 | {- | |
5 | Module : Numeric.LinearAlgebra.Tests.Instances | 4 | Module : Numeric.LinearAlgebra.Tests.Instances |
@@ -26,15 +25,11 @@ module Numeric.LinearAlgebra.Tests.Instances( | |||
26 | 25 | ||
27 | import System.Random | 26 | import System.Random |
28 | 27 | ||
29 | import Numeric.LinearAlgebra | 28 | import Numeric.LinearAlgebra.HMatrix hiding (vector) |
30 | import Numeric.LinearAlgebra.Devel | ||
31 | import Numeric.Container | ||
32 | import Control.Monad(replicateM) | 29 | import Control.Monad(replicateM) |
33 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | 30 | import Test.QuickCheck(Arbitrary,arbitrary,choose,vector,sized,shrink) |
34 | ,sized,classify,Testable,Property | 31 | |
35 | ,quickCheckWith,maxSize,stdArgs,shrink) | ||
36 | 32 | ||
37 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
38 | shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] | 33 | shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]] |
39 | shrinkListElementwise [] = [] | 34 | shrinkListElementwise [] = [] |
40 | shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] | 35 | shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] |
@@ -42,25 +37,6 @@ shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ] | |||
42 | 37 | ||
43 | shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)] | 38 | shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)] |
44 | shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] | 39 | shrinkPair (a,b) = [ (a,x) | x <- shrink b ] ++ [ (x,b) | x <- shrink a ] |
45 | #endif | ||
46 | |||
47 | #if MIN_VERSION_QuickCheck(2,1,1) | ||
48 | #else | ||
49 | instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where | ||
50 | arbitrary = do | ||
51 | re <- arbitrary | ||
52 | im <- arbitrary | ||
53 | return (re :+ im) | ||
54 | |||
55 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
56 | shrink (re :+ im) = | ||
57 | [ u :+ v | (u,v) <- shrinkPair (re,im) ] | ||
58 | #else | ||
59 | -- this has been moved to the 'Coarbitrary' class in QuickCheck 2 | ||
60 | coarbitrary = undefined | ||
61 | #endif | ||
62 | |||
63 | #endif | ||
64 | 40 | ||
65 | chooseDim = sized $ \m -> choose (1,max 1 m) | 41 | chooseDim = sized $ \m -> choose (1,max 1 m) |
66 | 42 | ||
@@ -68,15 +44,9 @@ instance (Field a, Arbitrary a) => Arbitrary (Vector a) where | |||
68 | arbitrary = do m <- chooseDim | 44 | arbitrary = do m <- chooseDim |
69 | l <- vector m | 45 | l <- vector m |
70 | return $ fromList l | 46 | return $ fromList l |
71 | |||
72 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
73 | -- shrink any one of the components | 47 | -- shrink any one of the components |
74 | shrink = map fromList . shrinkListElementwise . toList | 48 | shrink = map fromList . shrinkListElementwise . toList |
75 | 49 | ||
76 | #else | ||
77 | coarbitrary = undefined | ||
78 | #endif | ||
79 | |||
80 | instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where | 50 | instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where |
81 | arbitrary = do | 51 | arbitrary = do |
82 | m <- chooseDim | 52 | m <- chooseDim |
@@ -84,16 +54,11 @@ instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where | |||
84 | l <- vector (m*n) | 54 | l <- vector (m*n) |
85 | return $ (m><n) l | 55 | return $ (m><n) l |
86 | 56 | ||
87 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
88 | -- shrink any one of the components | 57 | -- shrink any one of the components |
89 | shrink a = map (rows a >< cols a) | 58 | shrink a = map (rows a >< cols a) |
90 | . shrinkListElementwise | 59 | . shrinkListElementwise |
91 | . concat . toLists | 60 | . concat . toLists |
92 | $ a | 61 | $ a |
93 | #else | ||
94 | coarbitrary = undefined | ||
95 | #endif | ||
96 | |||
97 | 62 | ||
98 | -- a square matrix | 63 | -- a square matrix |
99 | newtype (Sq a) = Sq (Matrix a) deriving Show | 64 | newtype (Sq a) = Sq (Matrix a) deriving Show |
@@ -103,11 +68,7 @@ instance (Element a, Arbitrary a) => Arbitrary (Sq a) where | |||
103 | l <- vector (n*n) | 68 | l <- vector (n*n) |
104 | return $ Sq $ (n><n) l | 69 | return $ Sq $ (n><n) l |
105 | 70 | ||
106 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
107 | shrink (Sq a) = [ Sq b | b <- shrink a ] | 71 | shrink (Sq a) = [ Sq b | b <- shrink a ] |
108 | #else | ||
109 | coarbitrary = undefined | ||
110 | #endif | ||
111 | 72 | ||
112 | 73 | ||
113 | -- a unitary matrix | 74 | -- a unitary matrix |
@@ -118,11 +79,6 @@ instance (Field a, Arbitrary a) => Arbitrary (Rot a) where | |||
118 | let (q,_) = qr m | 79 | let (q,_) = qr m |
119 | return (Rot q) | 80 | return (Rot q) |
120 | 81 | ||
121 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
122 | #else | ||
123 | coarbitrary = undefined | ||
124 | #endif | ||
125 | |||
126 | 82 | ||
127 | -- a complex hermitian or real symmetric matrix | 83 | -- a complex hermitian or real symmetric matrix |
128 | newtype (Her a) = Her (Matrix a) deriving Show | 84 | newtype (Her a) = Her (Matrix a) deriving Show |
@@ -130,12 +86,8 @@ instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where | |||
130 | arbitrary = do | 86 | arbitrary = do |
131 | Sq m <- arbitrary | 87 | Sq m <- arbitrary |
132 | let m' = m/2 | 88 | let m' = m/2 |
133 | return $ Her (m' + ctrans m') | 89 | return $ Her (m' + tr m') |
134 | 90 | ||
135 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
136 | #else | ||
137 | coarbitrary = undefined | ||
138 | #endif | ||
139 | 91 | ||
140 | class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a | 92 | class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a |
141 | instance ArbitraryField Double | 93 | instance ArbitraryField Double |
@@ -144,7 +96,7 @@ instance ArbitraryField (Complex Double) | |||
144 | 96 | ||
145 | -- a well-conditioned general matrix (the singular values are between 1 and 100) | 97 | -- a well-conditioned general matrix (the singular values are between 1 and 100) |
146 | newtype (WC a) = WC (Matrix a) deriving Show | 98 | newtype (WC a) = WC (Matrix a) deriving Show |
147 | instance (ArbitraryField a) => Arbitrary (WC a) where | 99 | instance (Numeric a, ArbitraryField a) => Arbitrary (WC a) where |
148 | arbitrary = do | 100 | arbitrary = do |
149 | m <- arbitrary | 101 | m <- arbitrary |
150 | let (u,_,v) = svd m | 102 | let (u,_,v) = svd m |
@@ -153,34 +105,24 @@ instance (ArbitraryField a) => Arbitrary (WC a) where | |||
153 | n = min r c | 105 | n = min r c |
154 | sv' <- replicateM n (choose (1,100)) | 106 | sv' <- replicateM n (choose (1,100)) |
155 | let s = diagRect 0 (fromList sv') r c | 107 | let s = diagRect 0 (fromList sv') r c |
156 | return $ WC (u `mXm` real s `mXm` trans v) | 108 | return $ WC (u <> real s <> tr v) |
157 | |||
158 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
159 | #else | ||
160 | coarbitrary = undefined | ||
161 | #endif | ||
162 | 109 | ||
163 | 110 | ||
164 | -- a well-conditioned square matrix (the singular values are between 1 and 100) | 111 | -- a well-conditioned square matrix (the singular values are between 1 and 100) |
165 | newtype (SqWC a) = SqWC (Matrix a) deriving Show | 112 | newtype (SqWC a) = SqWC (Matrix a) deriving Show |
166 | instance (ArbitraryField a) => Arbitrary (SqWC a) where | 113 | instance (ArbitraryField a, Numeric a) => Arbitrary (SqWC a) where |
167 | arbitrary = do | 114 | arbitrary = do |
168 | Sq m <- arbitrary | 115 | Sq m <- arbitrary |
169 | let (u,_,v) = svd m | 116 | let (u,_,v) = svd m |
170 | n = rows m | 117 | n = rows m |
171 | sv' <- replicateM n (choose (1,100)) | 118 | sv' <- replicateM n (choose (1,100)) |
172 | let s = diag (fromList sv') | 119 | let s = diag (fromList sv') |
173 | return $ SqWC (u `mXm` real s `mXm` trans v) | 120 | return $ SqWC (u <> real s <> tr v) |
174 | |||
175 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
176 | #else | ||
177 | coarbitrary = undefined | ||
178 | #endif | ||
179 | 121 | ||
180 | 122 | ||
181 | -- a positive definite square matrix (the eigenvalues are between 0 and 100) | 123 | -- a positive definite square matrix (the eigenvalues are between 0 and 100) |
182 | newtype (PosDef a) = PosDef (Matrix a) deriving Show | 124 | newtype (PosDef a) = PosDef (Matrix a) deriving Show |
183 | instance (ArbitraryField a, Num (Vector a)) | 125 | instance (Numeric a, ArbitraryField a, Num (Vector a)) |
184 | => Arbitrary (PosDef a) where | 126 | => Arbitrary (PosDef a) where |
185 | arbitrary = do | 127 | arbitrary = do |
186 | Her m <- arbitrary | 128 | Her m <- arbitrary |
@@ -188,13 +130,8 @@ instance (ArbitraryField a, Num (Vector a)) | |||
188 | n = rows m | 130 | n = rows m |
189 | l <- replicateM n (choose (0,100)) | 131 | l <- replicateM n (choose (0,100)) |
190 | let s = diag (fromList l) | 132 | let s = diag (fromList l) |
191 | p = v `mXm` real s `mXm` ctrans v | 133 | p = v <> real s <> tr v |
192 | return $ PosDef (0.5 * p + 0.5 * ctrans p) | 134 | return $ PosDef (0.5 * p + 0.5 * tr p) |
193 | |||
194 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
195 | #else | ||
196 | coarbitrary = undefined | ||
197 | #endif | ||
198 | 135 | ||
199 | 136 | ||
200 | -- a pair of matrices that can be multiplied | 137 | -- a pair of matrices that can be multiplied |
@@ -208,11 +145,7 @@ instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where | |||
208 | lb <- vector (k*m) | 145 | lb <- vector (k*m) |
209 | return $ Consistent ((n><k) la, (k><m) lb) | 146 | return $ Consistent ((n><k) la, (k><m) lb) |
210 | 147 | ||
211 | #if MIN_VERSION_QuickCheck(2,0,0) | ||
212 | shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ] | 148 | shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ] |
213 | #else | ||
214 | coarbitrary = undefined | ||
215 | #endif | ||
216 | 149 | ||
217 | 150 | ||
218 | 151 | ||
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs index a5c37f4..207a303 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs | |||
@@ -1,5 +1,4 @@ | |||
1 | {-# LANGUAGE CPP, FlexibleContexts #-} | 1 | {-# LANGUAGE FlexibleContexts #-} |
2 | {-# OPTIONS_GHC -fno-warn-unused-imports #-} | ||
3 | {-# LANGUAGE TypeFamilies #-} | 2 | {-# LANGUAGE TypeFamilies #-} |
4 | 3 | ||
5 | ----------------------------------------------------------------------------- | 4 | ----------------------------------------------------------------------------- |
@@ -29,7 +28,7 @@ module Numeric.LinearAlgebra.Tests.Properties ( | |||
29 | pinvProp, | 28 | pinvProp, |
30 | detProp, | 29 | detProp, |
31 | nullspaceProp, | 30 | nullspaceProp, |
32 | bugProp, | 31 | -- bugProp, |
33 | svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4, | 32 | svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4, |
34 | svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7, | 33 | svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7, |
35 | eigProp, eigSHProp, eigProp2, eigSHProp2, | 34 | eigProp, eigSHProp, eigProp2, eigSHProp2, |
@@ -43,20 +42,15 @@ module Numeric.LinearAlgebra.Tests.Properties ( | |||
43 | linearSolveProp, linearSolveProp2 | 42 | linearSolveProp, linearSolveProp2 |
44 | ) where | 43 | ) where |
45 | 44 | ||
46 | import Numeric.Container | 45 | import Numeric.LinearAlgebra.HMatrix hiding (Testable,unitary) |
47 | import Numeric.LinearAlgebra --hiding (real,complex) | 46 | import Test.QuickCheck |
48 | import Numeric.LinearAlgebra.LAPACK | ||
49 | import Debug.Trace | ||
50 | import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector | ||
51 | ,sized,classify,Testable,Property | ||
52 | ,quickCheckWith,maxSize,stdArgs,shrink) | ||
53 | 47 | ||
54 | trivial :: Testable a => Bool -> a -> Property | 48 | trivial :: Testable a => Bool -> a -> Property |
55 | trivial = (`classify` "trivial") | 49 | trivial = (`classify` "trivial") |
56 | 50 | ||
57 | -- relative error | 51 | -- relative error |
58 | dist :: (Normed c t, Num (c t)) => c t -> c t -> Double | 52 | dist :: (Num a, Normed a) => a -> a -> Double |
59 | dist = relativeError Infinity | 53 | dist = relativeError norm_Inf |
60 | 54 | ||
61 | infixl 4 |~| | 55 | infixl 4 |~| |
62 | a |~| b = a :~10~: b | 56 | a |~| b = a :~10~: b |
@@ -73,11 +67,11 @@ a :~n~: b = dist a b < 10^^(-n) | |||
73 | square m = rows m == cols m | 67 | square m = rows m == cols m |
74 | 68 | ||
75 | -- orthonormal columns | 69 | -- orthonormal columns |
76 | orthonormal m = ctrans m <> m |~| ident (cols m) | 70 | orthonormal m = tr m <> m |~| ident (cols m) |
77 | 71 | ||
78 | unitary m = square m && orthonormal m | 72 | unitary m = square m && orthonormal m |
79 | 73 | ||
80 | hermitian m = square m && m |~| ctrans m | 74 | hermitian m = square m && m |~| tr m |
81 | 75 | ||
82 | wellCond m = rcond m > 1/100 | 76 | wellCond m = rcond m > 1/100 |
83 | 77 | ||
@@ -85,12 +79,12 @@ positiveDefinite m = minimum (toList e) > 0 | |||
85 | where (e,_v) = eigSH m | 79 | where (e,_v) = eigSH m |
86 | 80 | ||
87 | upperTriang m = rows m == 1 || down == z | 81 | upperTriang m = rows m == 1 || down == z |
88 | where down = fromList $ concat $ zipWith drop [1..] (toLists (ctrans m)) | 82 | where down = fromList $ concat $ zipWith drop [1..] (toLists (tr m)) |
89 | z = konst 0 (dim down) | 83 | z = konst 0 (size down) |
90 | 84 | ||
91 | upperHessenberg m = rows m < 3 || down == z | 85 | upperHessenberg m = rows m < 3 || down == z |
92 | where down = fromList $ concat $ zipWith drop [2..] (toLists (ctrans m)) | 86 | where down = fromList $ concat $ zipWith drop [2..] (toLists (tr m)) |
93 | z = konst 0 (dim down) | 87 | z = konst 0 (size down) |
94 | 88 | ||
95 | zeros (r,c) = reshape c (konst 0 (r*c)) | 89 | zeros (r,c) = reshape c (konst 0 (r*c)) |
96 | 90 | ||
@@ -118,81 +112,94 @@ detProp m = s d1 |~| s d2 | |||
118 | s x = fromList [x] | 112 | s x = fromList [x] |
119 | 113 | ||
120 | nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c) | 114 | nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c) |
121 | && orthonormal (fromColumns nl)) | 115 | && orthonormal n) |
122 | where nl = nullspacePrec 1 m | 116 | where n = nullspaceSVD (Left (1*peps)) m (rightSV m) |
123 | n = fromColumns nl | 117 | nl = toColumns n |
124 | r = rows m | 118 | r = rows m |
125 | c = cols m - rank m | 119 | c = cols m - rank m |
126 | 120 | ||
127 | ------------------------------------------------------------------ | 121 | ------------------------------------------------------------------ |
128 | 122 | {- | |
129 | -- testcase for nonempty fpu stack | 123 | -- testcase for nonempty fpu stack |
130 | -- uncommenting unitary' signature eliminates the problem | 124 | -- uncommenting unitary' signature eliminates the problem |
131 | bugProp m = m |~| u <> real d <> trans v && unitary' u && unitary' v | 125 | bugProp m = m |~| u <> real d <> tr v && unitary' u && unitary' v |
132 | where (u,d,v) = fullSVD m | 126 | where (u,d,v) = svd m |
133 | -- unitary' :: (Num (Vector t), Field t) => Matrix t -> Bool | 127 | -- unitary' :: (Num (Vector t), Field t) => Matrix t -> Bool |
134 | unitary' a = unitary a | 128 | unitary' a = unitary a |
135 | 129 | -} | |
136 | ------------------------------------------------------------------ | 130 | ------------------------------------------------------------------ |
137 | 131 | ||
138 | -- fullSVD | 132 | -- fullSVD |
139 | svdProp1 m = m |~| u <> real d <> trans v && unitary u && unitary v | 133 | svdProp1 m = m |~| u <> real d <> tr v && unitary u && unitary v |
140 | where (u,d,v) = fullSVD m | 134 | where |
135 | (u,s,v) = svd m | ||
136 | d = diagRect 0 s (rows m) (cols m) | ||
141 | 137 | ||
142 | svdProp1a svdfun m = m |~| u <> real d <> trans v && unitary u && unitary v where | 138 | svdProp1a svdfun m = m |~| u <> real d <> tr v && unitary u && unitary v |
139 | where | ||
143 | (u,s,v) = svdfun m | 140 | (u,s,v) = svdfun m |
144 | d = diagRect 0 s (rows m) (cols m) | 141 | d = diagRect 0 s (rows m) (cols m) |
145 | 142 | ||
146 | svdProp1b svdfun m = unitary u && unitary v where | 143 | svdProp1b svdfun m = unitary u && unitary v |
144 | where | ||
147 | (u,_,v) = svdfun m | 145 | (u,_,v) = svdfun m |
148 | 146 | ||
149 | -- thinSVD | 147 | -- thinSVD |
150 | svdProp2 thinSVDfun m = m |~| u <> diag (real s) <> trans v && orthonormal u && orthonormal v && dim s == min (rows m) (cols m) | 148 | svdProp2 thinSVDfun m |
151 | where (u,s,v) = thinSVDfun m | 149 | = m |~| u <> diag (real s) <> tr v |
150 | && orthonormal u && orthonormal v | ||
151 | && size s == min (rows m) (cols m) | ||
152 | where | ||
153 | (u,s,v) = thinSVDfun m | ||
152 | 154 | ||
153 | -- compactSVD | 155 | -- compactSVD |
154 | svdProp3 m = (m |~| u <> real (diag s) <> trans v | 156 | svdProp3 m = (m |~| u <> real (diag s) <> tr v |
155 | && orthonormal u && orthonormal v) | 157 | && orthonormal u && orthonormal v) |
156 | where (u,s,v) = compactSVD m | 158 | where |
159 | (u,s,v) = compactSVD m | ||
157 | 160 | ||
158 | svdProp4 m' = m |~| u <> real (diag s) <> trans v | 161 | svdProp4 m' = m |~| u <> real (diag s) <> tr v |
159 | && orthonormal u && orthonormal v | 162 | && orthonormal u && orthonormal v |
160 | && (dim s == r || r == 0 && dim s == 1) | 163 | && (size s == r || r == 0 && size s == 1) |
161 | where (u,s,v) = compactSVD m | 164 | where |
162 | m = fromBlocks [[m'],[m']] | 165 | (u,s,v) = compactSVD m |
163 | r = rank m' | 166 | m = fromBlocks [[m'],[m']] |
164 | 167 | r = rank m' | |
165 | svdProp5a m = all (s1|~|) [s2,s3,s4,s5,s6] where | 168 | |
166 | s1 = svR m | 169 | svdProp5a m = all (s1|~|) [s3,s5] where |
167 | s2 = svRd m | 170 | s1 = singularValues (m :: Matrix Double) |
168 | (_,s3,_) = svdR m | 171 | -- s2 = svRd m |
169 | (_,s4,_) = svdRd m | 172 | (_,s3,_) = svd m |
170 | (_,s5,_) = thinSVDR m | 173 | -- (_,s4,_) = svdRd m |
171 | (_,s6,_) = thinSVDRd m | 174 | (_,s5,_) = thinSVD m |
172 | 175 | -- (_,s6,_) = thinSVDRd m | |
173 | svdProp5b m = all (s1|~|) [s2,s3,s4,s5,s6] where | 176 | |
174 | s1 = svC m | 177 | svdProp5b m = all (s1|~|) [s3,s5] where |
175 | s2 = svCd m | 178 | s1 = singularValues (m :: Matrix (Complex Double)) |
176 | (_,s3,_) = svdC m | 179 | -- s2 = svCd m |
177 | (_,s4,_) = svdCd m | 180 | (_,s3,_) = svd m |
178 | (_,s5,_) = thinSVDC m | 181 | -- (_,s4,_) = svdCd m |
179 | (_,s6,_) = thinSVDCd m | 182 | (_,s5,_) = thinSVD m |
183 | -- (_,s6,_) = thinSVDCd m | ||
180 | 184 | ||
181 | svdProp6a m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' | 185 | svdProp6a m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' |
182 | where (u,s,v) = svdR m | 186 | where |
183 | (s',v') = rightSVR m | 187 | (u,s,v) = svd (m :: Matrix Double) |
184 | (u',s'') = leftSVR m | 188 | (s',v') = rightSV m |
189 | (u',s'') = leftSV m | ||
185 | 190 | ||
186 | svdProp6b m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' | 191 | svdProp6b m = s |~| s' && v |~| v' && s |~| s'' && u |~| u' |
187 | where (u,s,v) = svdC m | 192 | where |
188 | (s',v') = rightSVC m | 193 | (u,s,v) = svd (m :: Matrix (Complex Double)) |
189 | (u',s'') = leftSVC m | 194 | (s',v') = rightSV m |
195 | (u',s'') = leftSV m | ||
190 | 196 | ||
191 | svdProp7 m = s |~| s' && u |~| u' && v |~| v' && s |~| s''' | 197 | svdProp7 m = s |~| s' && u |~| u' && v |~| v' && s |~| s''' |
192 | where (u,s,v) = svd m | 198 | where |
193 | (s',v') = rightSV m | 199 | (u,s,v) = svd m |
194 | (u',_s'') = leftSV m | 200 | (s',v') = rightSV m |
195 | s''' = singularValues m | 201 | (u',_s'') = leftSV m |
202 | s''' = singularValues m | ||
196 | 203 | ||
197 | ------------------------------------------------------------------ | 204 | ------------------------------------------------------------------ |
198 | 205 | ||
@@ -201,7 +208,7 @@ eigProp m = complex m <> v |~| v <> diag s | |||
201 | 208 | ||
202 | eigSHProp m = m <> v |~| v <> real (diag s) | 209 | eigSHProp m = m <> v |~| v <> real (diag s) |
203 | && unitary v | 210 | && unitary v |
204 | && m |~| v <> real (diag s) <> ctrans v | 211 | && m |~| v <> real (diag s) <> tr v |
205 | where (s, v) = eigSH m | 212 | where (s, v) = eigSH m |
206 | 213 | ||
207 | eigProp2 m = fst (eig m) |~| eigenvalues m | 214 | eigProp2 m = fst (eig m) |~| eigenvalues m |
@@ -226,19 +233,19 @@ rqProp3 m = upperTriang' r | |||
226 | where (r,_q) = rq m | 233 | where (r,_q) = rq m |
227 | 234 | ||
228 | upperTriang' r = upptr (rows r) (cols r) * r |~| r | 235 | upperTriang' r = upptr (rows r) (cols r) * r |~| r |
229 | where upptr f c = buildMatrix f c $ \(r',c') -> if r'-t > c' then 0 else 1 | 236 | where upptr f c = build (f,c) $ \r' c' -> if r'-t > c' then 0 else 1 |
230 | where t = f-c | 237 | where t = fromIntegral (f-c) |
231 | 238 | ||
232 | hessProp m = m |~| p <> h <> ctrans p && unitary p && upperHessenberg h | 239 | hessProp m = m |~| p <> h <> tr p && unitary p && upperHessenberg h |
233 | where (p,h) = hess m | 240 | where (p,h) = hess m |
234 | 241 | ||
235 | schurProp1 m = m |~| u <> s <> ctrans u && unitary u && upperTriang s | 242 | schurProp1 m = m |~| u <> s <> tr u && unitary u && upperTriang s |
236 | where (u,s) = schur m | 243 | where (u,s) = schur m |
237 | 244 | ||
238 | schurProp2 m = m |~| u <> s <> ctrans u && unitary u && upperHessenberg s -- fixme | 245 | schurProp2 m = m |~| u <> s <> tr u && unitary u && upperHessenberg s -- fixme |
239 | where (u,s) = schur m | 246 | where (u,s) = schur m |
240 | 247 | ||
241 | cholProp m = m |~| ctrans c <> c && upperTriang c | 248 | cholProp m = m |~| tr c <> c && upperTriang c |
242 | where c = chol m | 249 | where c = chol m |
243 | 250 | ||
244 | exactProp m = chol m == chol (m+0) | 251 | exactProp m = chol m == chol (m+0) |
@@ -252,7 +259,7 @@ mulH a b = fromLists [[ doth ai bj | bj <- toColumns b] | ai <- toRows a ] | |||
252 | 259 | ||
253 | multProp1 p (a,b) = (a <> b) :~p~: (mulH a b) | 260 | multProp1 p (a,b) = (a <> b) :~p~: (mulH a b) |
254 | 261 | ||
255 | multProp2 p (a,b) = (ctrans (a <> b)) :~p~: (ctrans b <> ctrans a) | 262 | multProp2 p (a,b) = (tr (a <> b)) :~p~: (tr b <> tr a) |
256 | 263 | ||
257 | linearSolveProp f m = f m m |~| ident (rows m) | 264 | linearSolveProp f m = f m m |~| ident (rows m) |
258 | 265 | ||
@@ -261,5 +268,5 @@ linearSolveProp2 f (a,x) = not wc `trivial` (not wc || a <> f a b |~| b) | |||
261 | b = a <> x | 268 | b = a <> x |
262 | wc = rank a == q | 269 | wc = rank a == q |
263 | 270 | ||
264 | subProp m = m == (trans . fromColumns . toRows) m | 271 | subProp m = m == (conj . tr . fromColumns . toRows) m |
265 | 272 | ||