summaryrefslogtreecommitdiff
path: root/packages
diff options
context:
space:
mode:
Diffstat (limited to 'packages')
-rw-r--r--packages/glpk/hmatrix-glpk.cabal10
-rw-r--r--packages/glpk/lib/Numeric/LinearProgramming.hs5
-rw-r--r--packages/special/hmatrix-special.cabal12
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Airy.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Bessel.hs9
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Clausen.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Coulomb.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Coupling.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Dawson.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Debye.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Dilog.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Elementary.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Ellint.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Elljac.hs7
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Erf.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Exp.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Expint.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Fermi_dirac.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Gamma.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Hyperg.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Internal.hsc7
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Laguerre.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Lambert.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Legendre.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Log.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Pow_int.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Psi.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Synchrotron.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Transport.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Trig.hs4
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Zeta.hs4
-rwxr-xr-xpackages/special/lib/Numeric/GSL/Special/auto.hs8
-rwxr-xr-xpackages/special/lib/Numeric/GSL/Special/replace.hs2
-rw-r--r--packages/tests/CHANGES5
-rw-r--r--packages/tests/LICENSE2
-rw-r--r--packages/tests/Setup.lhs5
-rw-r--r--packages/tests/hmatrix-tests.cabal45
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests.hs738
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs251
-rw-r--r--packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs272
-rw-r--r--packages/tests/src/tests.hs3
42 files changed, 1412 insertions, 73 deletions
diff --git a/packages/glpk/hmatrix-glpk.cabal b/packages/glpk/hmatrix-glpk.cabal
index 7fdfaac..f9655d4 100644
--- a/packages/glpk/hmatrix-glpk.cabal
+++ b/packages/glpk/hmatrix-glpk.cabal
@@ -1,5 +1,5 @@
1Name: hmatrix-glpk 1Name: hmatrix-glpk
2Version: 0.2.2 2Version: 0.3.0
3License: GPL 3License: GPL
4License-file: LICENSE 4License-file: LICENSE
5Author: Alberto Ruiz 5Author: Alberto Ruiz
@@ -11,7 +11,7 @@ Description:
11 Simple interface to linear programming functions provided by GLPK. 11 Simple interface to linear programming functions provided by GLPK.
12 12
13Category: Math 13Category: Math
14tested-with: GHC ==6.10.4, GHC ==7.0.3 14tested-with: GHC ==7.4
15 15
16cabal-version: >=1.2 16cabal-version: >=1.2
17build-type: Simple 17build-type: Simple
@@ -30,7 +30,7 @@ library
30 30
31 c-sources: lib/Numeric/LinearProgramming/glpk.c 31 c-sources: lib/Numeric/LinearProgramming/glpk.c
32 32
33 ghc-options: -Wall 33 ghc-options: -Wall
34 34
35 extra-libraries: glpk 35 extra-libraries: glpk
36 36
@@ -42,3 +42,7 @@ library
42 if arch(i386) 42 if arch(i386)
43 cc-options: -arch i386 43 cc-options: -arch i386
44 44
45source-repository head
46 type: git
47 location: https://github.com/AlbertoRuiz/hmatrix
48
diff --git a/packages/glpk/lib/Numeric/LinearProgramming.hs b/packages/glpk/lib/Numeric/LinearProgramming.hs
index f0709c3..b832bac 100644
--- a/packages/glpk/lib/Numeric/LinearProgramming.hs
+++ b/packages/glpk/lib/Numeric/LinearProgramming.hs
@@ -69,8 +69,9 @@ module Numeric.LinearProgramming(
69 69
70import Numeric.LinearAlgebra hiding (i) 70import Numeric.LinearAlgebra hiding (i)
71import Data.Packed.Development 71import Data.Packed.Development
72import Foreign(Ptr,unsafePerformIO) 72import Foreign(Ptr)
73import Foreign.C.Types(CInt) 73import System.IO.Unsafe(unsafePerformIO)
74import Foreign.C.Types
74import Data.List((\\),sortBy,nub) 75import Data.List((\\),sortBy,nub)
75import Data.Function(on) 76import Data.Function(on)
76 77
diff --git a/packages/special/hmatrix-special.cabal b/packages/special/hmatrix-special.cabal
index c6c8379..22e989f 100644
--- a/packages/special/hmatrix-special.cabal
+++ b/packages/special/hmatrix-special.cabal
@@ -1,5 +1,5 @@
1Name: hmatrix-special 1Name: hmatrix-special
2Version: 0.1.1 2Version: 0.2.0
3License: GPL 3License: GPL
4License-file: LICENSE 4License-file: LICENSE
5Author: Alberto Ruiz 5Author: Alberto Ruiz
@@ -11,7 +11,7 @@ Description:
11 Interface to GSL special functions. 11 Interface to GSL special functions.
12 12
13Category: Math 13Category: Math
14tested-with: GHC ==6.12.3 14tested-with: GHC ==7.4
15 15
16cabal-version: >=1.6 16cabal-version: >=1.6
17build-type: Simple 17build-type: Simple
@@ -66,14 +66,14 @@ library
66 66
67 other-modules: Numeric.GSL.Special.Internal 67 other-modules: Numeric.GSL.Special.Internal
68 68
69 ghc-options: -Wall -fno-warn-unused-binds 69 ghc-options: -Wall -fno-warn-unused-binds
70 70
71 if flag(safe-cheap) 71 if flag(safe-cheap)
72 cpp-options: -DSAFE_CHEAP=safe 72 cpp-options: -DSAFE_CHEAP=safe
73 else 73 else
74 cpp-options: -DSAFE_CHEAP=unsafe 74 cpp-options: -DSAFE_CHEAP=unsafe
75 75
76source-repository head 76source-repository head
77 type: darcs 77 type: git
78 location: http://code.haskell.org/hmatrix 78 location: https://github.com/AlbertoRuiz/hmatrix
79 79
diff --git a/packages/special/lib/Numeric/GSL/Special/Airy.hs b/packages/special/lib/Numeric/GSL/Special/Airy.hs
index 8a04eed..737de7c 100644
--- a/packages/special/lib/Numeric/GSL/Special/Airy.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Airy.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Airy 3-- Module : Numeric.GSL.Special.Airy
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -41,7 +41,7 @@ module Numeric.GSL.Special.Airy(
41) where 41) where
42 42
43import Foreign(Ptr) 43import Foreign(Ptr)
44import Foreign.C.Types(CInt) 44import Foreign.C.Types
45import Numeric.GSL.Special.Internal 45import Numeric.GSL.Special.Internal
46 46
47airy_Ai_e :: Double -> Precision -> (Double,Double) 47airy_Ai_e :: Double -> Precision -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Bessel.hs b/packages/special/lib/Numeric/GSL/Special/Bessel.hs
index 66d6c5b..4a80c28 100644
--- a/packages/special/lib/Numeric/GSL/Special/Bessel.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Bessel.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Bessel 3-- Module : Numeric.GSL.Special.Bessel
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -91,6 +91,7 @@ module Numeric.GSL.Special.Bessel(
91, bessel_Inu 91, bessel_Inu
92, bessel_Knu_scaled_e 92, bessel_Knu_scaled_e
93, bessel_Knu_scaled 93, bessel_Knu_scaled
94, bessel_Knu_scaled_e10_e
94, bessel_Knu_e 95, bessel_Knu_e
95, bessel_Knu 96, bessel_Knu
96, bessel_lnKnu_e 97, bessel_lnKnu_e
@@ -104,7 +105,7 @@ module Numeric.GSL.Special.Bessel(
104) where 105) where
105 106
106import Foreign(Ptr) 107import Foreign(Ptr)
107import Foreign.C.Types(CInt) 108import Foreign.C.Types
108import Numeric.GSL.Special.Internal 109import Numeric.GSL.Special.Internal
109 110
110bessel_J0_e :: Double -> (Double,Double) 111bessel_J0_e :: Double -> (Double,Double)
@@ -467,6 +468,10 @@ bessel_Knu_scaled :: Double -> Double -> Double
467bessel_Knu_scaled = gsl_sf_bessel_Knu_scaled 468bessel_Knu_scaled = gsl_sf_bessel_Knu_scaled
468foreign import ccall SAFE_CHEAP "gsl_sf_bessel_Knu_scaled" gsl_sf_bessel_Knu_scaled :: Double -> Double -> Double 469foreign import ccall SAFE_CHEAP "gsl_sf_bessel_Knu_scaled" gsl_sf_bessel_Knu_scaled :: Double -> Double -> Double
469 470
471bessel_Knu_scaled_e10_e :: Double -> Double -> (Double,Int,Double)
472bessel_Knu_scaled_e10_e nu x = createSFR_E10 "bessel_Knu_scaled_e10_e" $ gsl_sf_bessel_Knu_scaled_e10_e nu x
473foreign import ccall SAFE_CHEAP "gsl_sf_bessel_Knu_scaled_e10_e" gsl_sf_bessel_Knu_scaled_e10_e :: Double -> Double -> Ptr () -> IO CInt
474
470bessel_Knu_e :: Double -> Double -> (Double,Double) 475bessel_Knu_e :: Double -> Double -> (Double,Double)
471bessel_Knu_e nu x = createSFR "bessel_Knu_e" $ gsl_sf_bessel_Knu_e nu x 476bessel_Knu_e nu x = createSFR "bessel_Knu_e" $ gsl_sf_bessel_Knu_e nu x
472foreign import ccall SAFE_CHEAP "gsl_sf_bessel_Knu_e" gsl_sf_bessel_Knu_e :: Double -> Double -> Ptr () -> IO CInt 477foreign import ccall SAFE_CHEAP "gsl_sf_bessel_Knu_e" gsl_sf_bessel_Knu_e :: Double -> Double -> Ptr () -> IO CInt
diff --git a/packages/special/lib/Numeric/GSL/Special/Clausen.hs b/packages/special/lib/Numeric/GSL/Special/Clausen.hs
index 70f05a7..80bd45c 100644
--- a/packages/special/lib/Numeric/GSL/Special/Clausen.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Clausen.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Clausen 3-- Module : Numeric.GSL.Special.Clausen
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -18,7 +18,7 @@ module Numeric.GSL.Special.Clausen(
18) where 18) where
19 19
20import Foreign(Ptr) 20import Foreign(Ptr)
21import Foreign.C.Types(CInt) 21import Foreign.C.Types
22import Numeric.GSL.Special.Internal 22import Numeric.GSL.Special.Internal
23 23
24clausen_e :: Double -> (Double,Double) 24clausen_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Coulomb.hs b/packages/special/lib/Numeric/GSL/Special/Coulomb.hs
index 7253972..218213a 100644
--- a/packages/special/lib/Numeric/GSL/Special/Coulomb.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Coulomb.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Coulomb 3-- Module : Numeric.GSL.Special.Coulomb
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -21,7 +21,7 @@ module Numeric.GSL.Special.Coulomb(
21) where 21) where
22 22
23import Foreign(Ptr) 23import Foreign(Ptr)
24import Foreign.C.Types(CInt) 24import Foreign.C.Types
25import Numeric.GSL.Special.Internal 25import Numeric.GSL.Special.Internal
26 26
27hydrogenicR_1_e :: Double -> Double -> (Double,Double) 27hydrogenicR_1_e :: Double -> Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Coupling.hs b/packages/special/lib/Numeric/GSL/Special/Coupling.hs
index 16ff9b9..326f53f 100644
--- a/packages/special/lib/Numeric/GSL/Special/Coupling.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Coupling.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Coupling 3-- Module : Numeric.GSL.Special.Coupling
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -24,7 +24,7 @@ module Numeric.GSL.Special.Coupling(
24) where 24) where
25 25
26import Foreign(Ptr) 26import Foreign(Ptr)
27import Foreign.C.Types(CInt) 27import Foreign.C.Types
28import Numeric.GSL.Special.Internal 28import Numeric.GSL.Special.Internal
29 29
30coupling_3j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> (Double,Double) 30coupling_3j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Dawson.hs b/packages/special/lib/Numeric/GSL/Special/Dawson.hs
index 7e8d9ce..9f73767 100644
--- a/packages/special/lib/Numeric/GSL/Special/Dawson.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Dawson.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Dawson 3-- Module : Numeric.GSL.Special.Dawson
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -18,7 +18,7 @@ module Numeric.GSL.Special.Dawson(
18) where 18) where
19 19
20import Foreign(Ptr) 20import Foreign(Ptr)
21import Foreign.C.Types(CInt) 21import Foreign.C.Types
22import Numeric.GSL.Special.Internal 22import Numeric.GSL.Special.Internal
23 23
24dawson_e :: Double -> (Double,Double) 24dawson_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Debye.hs b/packages/special/lib/Numeric/GSL/Special/Debye.hs
index 01976ee..7ca17e4 100644
--- a/packages/special/lib/Numeric/GSL/Special/Debye.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Debye.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Debye 3-- Module : Numeric.GSL.Special.Debye
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -28,7 +28,7 @@ module Numeric.GSL.Special.Debye(
28) where 28) where
29 29
30import Foreign(Ptr) 30import Foreign(Ptr)
31import Foreign.C.Types(CInt) 31import Foreign.C.Types
32import Numeric.GSL.Special.Internal 32import Numeric.GSL.Special.Internal
33 33
34debye_1_e :: Double -> (Double,Double) 34debye_1_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Dilog.hs b/packages/special/lib/Numeric/GSL/Special/Dilog.hs
index 6aa58c4..32cceba 100644
--- a/packages/special/lib/Numeric/GSL/Special/Dilog.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Dilog.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Dilog 3-- Module : Numeric.GSL.Special.Dilog
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -21,7 +21,7 @@ module Numeric.GSL.Special.Dilog(
21) where 21) where
22 22
23import Foreign(Ptr) 23import Foreign(Ptr)
24import Foreign.C.Types(CInt) 24import Foreign.C.Types
25import Numeric.GSL.Special.Internal 25import Numeric.GSL.Special.Internal
26 26
27dilog_e :: Double -> (Double,Double) 27dilog_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Elementary.hs b/packages/special/lib/Numeric/GSL/Special/Elementary.hs
index 7e7f8b6..e58a697 100644
--- a/packages/special/lib/Numeric/GSL/Special/Elementary.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Elementary.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Elementary 3-- Module : Numeric.GSL.Special.Elementary
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -19,7 +19,7 @@ module Numeric.GSL.Special.Elementary(
19) where 19) where
20 20
21import Foreign(Ptr) 21import Foreign(Ptr)
22import Foreign.C.Types(CInt) 22import Foreign.C.Types
23import Numeric.GSL.Special.Internal 23import Numeric.GSL.Special.Internal
24 24
25multiply_e :: Double -> Double -> (Double,Double) 25multiply_e :: Double -> Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Ellint.hs b/packages/special/lib/Numeric/GSL/Special/Ellint.hs
index 6735057..365c366 100644
--- a/packages/special/lib/Numeric/GSL/Special/Ellint.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Ellint.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Ellint 3-- Module : Numeric.GSL.Special.Ellint
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -40,7 +40,7 @@ module Numeric.GSL.Special.Ellint(
40) where 40) where
41 41
42import Foreign(Ptr) 42import Foreign(Ptr)
43import Foreign.C.Types(CInt) 43import Foreign.C.Types
44import Numeric.GSL.Special.Internal 44import Numeric.GSL.Special.Internal
45 45
46ellint_Kcomp_e :: Double -> Precision -> (Double,Double) 46ellint_Kcomp_e :: Double -> Precision -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Elljac.hs b/packages/special/lib/Numeric/GSL/Special/Elljac.hs
index 5b32cfe..553350c 100644
--- a/packages/special/lib/Numeric/GSL/Special/Elljac.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Elljac.hs
@@ -16,8 +16,11 @@ module Numeric.GSL.Special.Elljac(
16elljac_e 16elljac_e
17) where 17) where
18 18
19import Foreign 19import System.IO.Unsafe
20import Foreign.C.Types(CInt) 20import Foreign.Ptr
21import Foreign.Storable
22import Foreign.Marshal
23import Foreign.C.Types
21 24
22elljac_e :: Double -> Double -> (Double,Double,Double) 25elljac_e :: Double -> Double -> (Double,Double,Double)
23elljac_e u m = unsafePerformIO $ do 26elljac_e u m = unsafePerformIO $ do
diff --git a/packages/special/lib/Numeric/GSL/Special/Erf.hs b/packages/special/lib/Numeric/GSL/Special/Erf.hs
index 258afd3..171a3c5 100644
--- a/packages/special/lib/Numeric/GSL/Special/Erf.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Erf.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Erf 3-- Module : Numeric.GSL.Special.Erf
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -28,7 +28,7 @@ module Numeric.GSL.Special.Erf(
28) where 28) where
29 29
30import Foreign(Ptr) 30import Foreign(Ptr)
31import Foreign.C.Types(CInt) 31import Foreign.C.Types
32import Numeric.GSL.Special.Internal 32import Numeric.GSL.Special.Internal
33 33
34erfc_e :: Double -> (Double,Double) 34erfc_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Exp.hs b/packages/special/lib/Numeric/GSL/Special/Exp.hs
index 4f15964..3b70078 100644
--- a/packages/special/lib/Numeric/GSL/Special/Exp.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Exp.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Exp 3-- Module : Numeric.GSL.Special.Exp
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -35,7 +35,7 @@ module Numeric.GSL.Special.Exp(
35) where 35) where
36 36
37import Foreign(Ptr) 37import Foreign(Ptr)
38import Foreign.C.Types(CInt) 38import Foreign.C.Types
39import Numeric.GSL.Special.Internal 39import Numeric.GSL.Special.Internal
40 40
41exp_e :: Double -> (Double,Double) 41exp_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Expint.hs b/packages/special/lib/Numeric/GSL/Special/Expint.hs
index f1102c4..06f4594 100644
--- a/packages/special/lib/Numeric/GSL/Special/Expint.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Expint.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Expint 3-- Module : Numeric.GSL.Special.Expint
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -44,7 +44,7 @@ module Numeric.GSL.Special.Expint(
44) where 44) where
45 45
46import Foreign(Ptr) 46import Foreign(Ptr)
47import Foreign.C.Types(CInt) 47import Foreign.C.Types
48import Numeric.GSL.Special.Internal 48import Numeric.GSL.Special.Internal
49 49
50expint_E1_e :: Double -> (Double,Double) 50expint_E1_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Fermi_dirac.hs b/packages/special/lib/Numeric/GSL/Special/Fermi_dirac.hs
index 362c7ba..c39c096 100644
--- a/packages/special/lib/Numeric/GSL/Special/Fermi_dirac.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Fermi_dirac.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Fermi_dirac 3-- Module : Numeric.GSL.Special.Fermi_dirac
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -34,7 +34,7 @@ module Numeric.GSL.Special.Fermi_dirac(
34) where 34) where
35 35
36import Foreign(Ptr) 36import Foreign(Ptr)
37import Foreign.C.Types(CInt) 37import Foreign.C.Types
38import Numeric.GSL.Special.Internal 38import Numeric.GSL.Special.Internal
39 39
40fermi_dirac_m1_e :: Double -> (Double,Double) 40fermi_dirac_m1_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Gamma.hs b/packages/special/lib/Numeric/GSL/Special/Gamma.hs
index 1a4ed4e..78115f1 100644
--- a/packages/special/lib/Numeric/GSL/Special/Gamma.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Gamma.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Gamma 3-- Module : Numeric.GSL.Special.Gamma
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -57,7 +57,7 @@ module Numeric.GSL.Special.Gamma(
57) where 57) where
58 58
59import Foreign(Ptr) 59import Foreign(Ptr)
60import Foreign.C.Types(CInt) 60import Foreign.C.Types
61import Numeric.GSL.Special.Internal 61import Numeric.GSL.Special.Internal
62 62
63lngamma_e :: Double -> (Double,Double) 63lngamma_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs b/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs
index 31568f3..a3c998a 100644
--- a/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Gegenbauer 3-- Module : Numeric.GSL.Special.Gegenbauer
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -24,7 +24,7 @@ module Numeric.GSL.Special.Gegenbauer(
24) where 24) where
25 25
26import Foreign(Ptr) 26import Foreign(Ptr)
27import Foreign.C.Types(CInt) 27import Foreign.C.Types
28import Numeric.GSL.Special.Internal 28import Numeric.GSL.Special.Internal
29 29
30gegenpoly_1_e :: Double -> Double -> (Double,Double) 30gegenpoly_1_e :: Double -> Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Hyperg.hs b/packages/special/lib/Numeric/GSL/Special/Hyperg.hs
index b5425f1..ac237a5 100644
--- a/packages/special/lib/Numeric/GSL/Special/Hyperg.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Hyperg.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Hyperg 3-- Module : Numeric.GSL.Special.Hyperg
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -38,7 +38,7 @@ module Numeric.GSL.Special.Hyperg(
38) where 38) where
39 39
40import Foreign(Ptr) 40import Foreign(Ptr)
41import Foreign.C.Types(CInt) 41import Foreign.C.Types
42import Numeric.GSL.Special.Internal 42import Numeric.GSL.Special.Internal
43 43
44hyperg_0F1_e :: Double -> Double -> (Double,Double) 44hyperg_0F1_e :: Double -> Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Internal.hsc b/packages/special/lib/Numeric/GSL/Special/Internal.hsc
index ae735df..e7c38e8 100644
--- a/packages/special/lib/Numeric/GSL/Special/Internal.hsc
+++ b/packages/special/lib/Numeric/GSL/Special/Internal.hsc
@@ -29,9 +29,12 @@ module Numeric.GSL.Special.Internal (
29) 29)
30where 30where
31 31
32import Foreign 32import Foreign.Storable
33import Foreign.Ptr
34import Foreign.Marshal
35import System.IO.Unsafe(unsafePerformIO)
33import Data.Packed.Development(check,(//)) 36import Data.Packed.Development(check,(//))
34import Foreign.C.Types(CSize,CInt) 37import Foreign.C.Types
35 38
36data Precision = PrecDouble | PrecSingle | PrecApprox 39data Precision = PrecDouble | PrecSingle | PrecApprox
37 40
diff --git a/packages/special/lib/Numeric/GSL/Special/Laguerre.hs b/packages/special/lib/Numeric/GSL/Special/Laguerre.hs
index 8db6a6c..28b3d20 100644
--- a/packages/special/lib/Numeric/GSL/Special/Laguerre.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Laguerre.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Laguerre 3-- Module : Numeric.GSL.Special.Laguerre
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -24,7 +24,7 @@ module Numeric.GSL.Special.Laguerre(
24) where 24) where
25 25
26import Foreign(Ptr) 26import Foreign(Ptr)
27import Foreign.C.Types(CInt) 27import Foreign.C.Types
28import Numeric.GSL.Special.Internal 28import Numeric.GSL.Special.Internal
29 29
30laguerre_1_e :: Double -> Double -> (Double,Double) 30laguerre_1_e :: Double -> Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Lambert.hs b/packages/special/lib/Numeric/GSL/Special/Lambert.hs
index b229bf6..44fbfb1 100644
--- a/packages/special/lib/Numeric/GSL/Special/Lambert.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Lambert.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Lambert 3-- Module : Numeric.GSL.Special.Lambert
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -20,7 +20,7 @@ module Numeric.GSL.Special.Lambert(
20) where 20) where
21 21
22import Foreign(Ptr) 22import Foreign(Ptr)
23import Foreign.C.Types(CInt) 23import Foreign.C.Types
24import Numeric.GSL.Special.Internal 24import Numeric.GSL.Special.Internal
25 25
26lambert_W0_e :: Double -> (Double,Double) 26lambert_W0_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Legendre.hs b/packages/special/lib/Numeric/GSL/Special/Legendre.hs
index e329457..cb33e2e 100644
--- a/packages/special/lib/Numeric/GSL/Special/Legendre.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Legendre.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Legendre 3-- Module : Numeric.GSL.Special.Legendre
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -53,7 +53,7 @@ module Numeric.GSL.Special.Legendre(
53) where 53) where
54 54
55import Foreign(Ptr) 55import Foreign(Ptr)
56import Foreign.C.Types(CInt) 56import Foreign.C.Types
57import Numeric.GSL.Special.Internal 57import Numeric.GSL.Special.Internal
58 58
59legendre_Pl_e :: CInt -> Double -> (Double,Double) 59legendre_Pl_e :: CInt -> Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Log.hs b/packages/special/lib/Numeric/GSL/Special/Log.hs
index 7f3f9d6..3becf15 100644
--- a/packages/special/lib/Numeric/GSL/Special/Log.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Log.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Log 3-- Module : Numeric.GSL.Special.Log
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -25,7 +25,7 @@ module Numeric.GSL.Special.Log(
25) where 25) where
26 26
27import Foreign(Ptr) 27import Foreign(Ptr)
28import Foreign.C.Types(CInt) 28import Foreign.C.Types
29import Numeric.GSL.Special.Internal 29import Numeric.GSL.Special.Internal
30 30
31log_e :: Double -> (Double,Double) 31log_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Pow_int.hs b/packages/special/lib/Numeric/GSL/Special/Pow_int.hs
index fd232ab..08fd497 100644
--- a/packages/special/lib/Numeric/GSL/Special/Pow_int.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Pow_int.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Pow_int 3-- Module : Numeric.GSL.Special.Pow_int
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -18,7 +18,7 @@ module Numeric.GSL.Special.Pow_int(
18) where 18) where
19 19
20import Foreign(Ptr) 20import Foreign(Ptr)
21import Foreign.C.Types(CInt) 21import Foreign.C.Types
22import Numeric.GSL.Special.Internal 22import Numeric.GSL.Special.Internal
23 23
24pow_int_e :: Double -> CInt -> (Double,Double) 24pow_int_e :: Double -> CInt -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Psi.hs b/packages/special/lib/Numeric/GSL/Special/Psi.hs
index cb4c756..da53d1b 100644
--- a/packages/special/lib/Numeric/GSL/Special/Psi.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Psi.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Psi 3-- Module : Numeric.GSL.Special.Psi
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -29,7 +29,7 @@ module Numeric.GSL.Special.Psi(
29) where 29) where
30 30
31import Foreign(Ptr) 31import Foreign(Ptr)
32import Foreign.C.Types(CInt) 32import Foreign.C.Types
33import Numeric.GSL.Special.Internal 33import Numeric.GSL.Special.Internal
34 34
35psi_int_e :: CInt -> (Double,Double) 35psi_int_e :: CInt -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Synchrotron.hs b/packages/special/lib/Numeric/GSL/Special/Synchrotron.hs
index 59d6c76..b3292a6 100644
--- a/packages/special/lib/Numeric/GSL/Special/Synchrotron.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Synchrotron.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Synchrotron 3-- Module : Numeric.GSL.Special.Synchrotron
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -20,7 +20,7 @@ module Numeric.GSL.Special.Synchrotron(
20) where 20) where
21 21
22import Foreign(Ptr) 22import Foreign(Ptr)
23import Foreign.C.Types(CInt) 23import Foreign.C.Types
24import Numeric.GSL.Special.Internal 24import Numeric.GSL.Special.Internal
25 25
26synchrotron_1_e :: Double -> (Double,Double) 26synchrotron_1_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Transport.hs b/packages/special/lib/Numeric/GSL/Special/Transport.hs
index e95a67a..b92b578 100644
--- a/packages/special/lib/Numeric/GSL/Special/Transport.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Transport.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Transport 3-- Module : Numeric.GSL.Special.Transport
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -24,7 +24,7 @@ module Numeric.GSL.Special.Transport(
24) where 24) where
25 25
26import Foreign(Ptr) 26import Foreign(Ptr)
27import Foreign.C.Types(CInt) 27import Foreign.C.Types
28import Numeric.GSL.Special.Internal 28import Numeric.GSL.Special.Internal
29 29
30transport_2_e :: Double -> (Double,Double) 30transport_2_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Trig.hs b/packages/special/lib/Numeric/GSL/Special/Trig.hs
index 91c264a..43fdc95 100644
--- a/packages/special/lib/Numeric/GSL/Special/Trig.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Trig.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Trig 3-- Module : Numeric.GSL.Special.Trig
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -39,7 +39,7 @@ module Numeric.GSL.Special.Trig(
39) where 39) where
40 40
41import Foreign(Ptr) 41import Foreign(Ptr)
42import Foreign.C.Types(CInt) 42import Foreign.C.Types
43import Numeric.GSL.Special.Internal 43import Numeric.GSL.Special.Internal
44 44
45sin_e :: Double -> (Double,Double) 45sin_e :: Double -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/Zeta.hs b/packages/special/lib/Numeric/GSL/Special/Zeta.hs
index 930efc0..a57a918 100644
--- a/packages/special/lib/Numeric/GSL/Special/Zeta.hs
+++ b/packages/special/lib/Numeric/GSL/Special/Zeta.hs
@@ -1,7 +1,7 @@
1------------------------------------------------------------ 1------------------------------------------------------------
2-- | 2-- |
3-- Module : Numeric.GSL.Special.Zeta 3-- Module : Numeric.GSL.Special.Zeta
4-- Copyright : (c) Alberto Ruiz 2006 4-- Copyright : (c) Alberto Ruiz 2006-11
5-- License : GPL 5-- License : GPL
6-- Maintainer : Alberto Ruiz (aruiz at um dot es) 6-- Maintainer : Alberto Ruiz (aruiz at um dot es)
7-- Stability : provisional 7-- Stability : provisional
@@ -30,7 +30,7 @@ module Numeric.GSL.Special.Zeta(
30) where 30) where
31 31
32import Foreign(Ptr) 32import Foreign(Ptr)
33import Foreign.C.Types(CInt) 33import Foreign.C.Types
34import Numeric.GSL.Special.Internal 34import Numeric.GSL.Special.Internal
35 35
36zeta_int_e :: CInt -> (Double,Double) 36zeta_int_e :: CInt -> (Double,Double)
diff --git a/packages/special/lib/Numeric/GSL/Special/auto.hs b/packages/special/lib/Numeric/GSL/Special/auto.hs
index b6276b2..36947ad 100755
--- a/packages/special/lib/Numeric/GSL/Special/auto.hs
+++ b/packages/special/lib/Numeric/GSL/Special/auto.hs
@@ -2,8 +2,10 @@
2 2
3-- automatic generation of wrappers for simple GSL special functions 3-- automatic generation of wrappers for simple GSL special functions
4 4
5{-# LANGUAGE NoMonomorphismRestriction #-}
6
5import Text.ParserCombinators.Parsec 7import Text.ParserCombinators.Parsec
6import System 8import System.Environment(getArgs)
7import Data.List(intersperse, isPrefixOf) 9import Data.List(intersperse, isPrefixOf)
8import Data.Char(toUpper,isUpper,toLower) 10import Data.Char(toUpper,isUpper,toLower)
9 11
@@ -64,7 +66,7 @@ main = do
64 let exports = rep (")",") where") $ rep ("(\n","(\n ") $ rep (",\n",", ") $ unlines $ ["("]++intersperse "," (map (\(Header _ n _) -> hName n) (filter safe parsed))++[")"] 66 let exports = rep (")",") where") $ rep ("(\n","(\n ") $ rep (",\n",", ") $ unlines $ ["("]++intersperse "," (map (\(Header _ n _) -> hName n) (filter safe parsed))++[")"]
65 let defs = unlines $ map (showFull (name ++".h")) parsed 67 let defs = unlines $ map (showFull (name ++".h")) parsed
66 let imports = "\nimport Foreign(Ptr)\n" 68 let imports = "\nimport Foreign(Ptr)\n"
67 ++"import Foreign.C.Types(CInt)\n" 69 ++"import Foreign.C.Types\n"
68 ++"import Numeric.GSL.Special.Internal\n" 70 ++"import Numeric.GSL.Special.Internal\n"
69 let mod = modhead name ++ "module Numeric.GSL.Special."++ upperFirst name++exports++imports++defs 71 let mod = modhead name ++ "module Numeric.GSL.Special."++ upperFirst name++exports++imports++defs
70 writeFile (upperFirst name ++ ".hs") mod 72 writeFile (upperFirst name ++ ".hs") mod
@@ -80,7 +82,7 @@ google name = "<http://www.google.com/search?q="
80 82
81modhead name = replicate 60 '-' ++ "\n-- |\n" 83modhead name = replicate 60 '-' ++ "\n-- |\n"
82 ++"-- Module : Numeric.GSL.Special."++upperFirst name++"\n" 84 ++"-- Module : Numeric.GSL.Special."++upperFirst name++"\n"
83 ++"-- Copyright : (c) Alberto Ruiz 2006\n" 85 ++"-- Copyright : (c) Alberto Ruiz 2006-11\n"
84 ++"-- License : GPL\n" 86 ++"-- License : GPL\n"
85 ++"-- Maintainer : Alberto Ruiz (aruiz at um dot es)\n" 87 ++"-- Maintainer : Alberto Ruiz (aruiz at um dot es)\n"
86 ++"-- Stability : provisional\n" 88 ++"-- Stability : provisional\n"
diff --git a/packages/special/lib/Numeric/GSL/Special/replace.hs b/packages/special/lib/Numeric/GSL/Special/replace.hs
index f20a6b8..f0f491b 100755
--- a/packages/special/lib/Numeric/GSL/Special/replace.hs
+++ b/packages/special/lib/Numeric/GSL/Special/replace.hs
@@ -1,7 +1,7 @@
1#!/usr/bin/env runhaskell 1#!/usr/bin/env runhaskell
2 2
3import Data.List(isPrefixOf) 3import Data.List(isPrefixOf)
4import System(getArgs) 4import System.Environment(getArgs)
5 5
6rep (c,r) [] = [] 6rep (c,r) [] = []
7rep (c,r) f@(x:xs) 7rep (c,r) f@(x:xs)
diff --git a/packages/tests/CHANGES b/packages/tests/CHANGES
new file mode 100644
index 0000000..e4e8b2f
--- /dev/null
+++ b/packages/tests/CHANGES
@@ -0,0 +1,5 @@
10.1
2===
3
4Created a separate testing package.
5
diff --git a/packages/tests/LICENSE b/packages/tests/LICENSE
new file mode 100644
index 0000000..f2125ec
--- /dev/null
+++ b/packages/tests/LICENSE
@@ -0,0 +1,2 @@
1Copyright Alberto Ruiz 2010
2GPL license
diff --git a/packages/tests/Setup.lhs b/packages/tests/Setup.lhs
new file mode 100644
index 0000000..4b19c19
--- /dev/null
+++ b/packages/tests/Setup.lhs
@@ -0,0 +1,5 @@
1#! /usr/bin/env runhaskell
2
3> import Distribution.Simple
4> main = defaultMain
5
diff --git a/packages/tests/hmatrix-tests.cabal b/packages/tests/hmatrix-tests.cabal
new file mode 100644
index 0000000..9f7bcdc
--- /dev/null
+++ b/packages/tests/hmatrix-tests.cabal
@@ -0,0 +1,45 @@
1Name: hmatrix-tests
2Version: 0.1.0.0
3License: GPL
4License-file: LICENSE
5Author: Alberto Ruiz
6Maintainer: Alberto Ruiz <aruiz@um.es>
7Stability: provisional
8Homepage: http://perception.inf.um.es/hmatrix
9Synopsis: Tests for hmatrix
10Description: Tests for hmatrix
11Category: Math
12tested-with: GHC==7.0.4
13
14cabal-version: >=1.8
15
16build-type: Simple
17
18extra-source-files: CHANGES
19 src/tests.hs
20
21library
22
23 Build-Depends: base >= 4 && < 5,
24 hmatrix >= 0.13,
25 QuickCheck >= 2, HUnit, random
26
27 hs-source-dirs: src
28
29 exposed-modules: Numeric.LinearAlgebra.Tests
30
31 other-modules: Numeric.LinearAlgebra.Tests.Instances,
32 Numeric.LinearAlgebra.Tests.Properties
33
34 ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-orphans
35
36
37source-repository head
38 type: git
39 location: https://github.com/AlbertoRuiz/hmatrix
40
41Test-Suite basic
42 Build-Depends: base, hmatrix-tests
43 type: exitcode-stdio-1.0
44 main-is: src/tests.hs
45
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
new file mode 100644
index 0000000..8d402d0
--- /dev/null
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs
@@ -0,0 +1,738 @@
1{-# LANGUAGE CPP #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-}
3-----------------------------------------------------------------------------
4{- |
5Module : Numeric.LinearAlgebra.Tests
6Copyright : (c) Alberto Ruiz 2007-11
7License : GPL-style
8
9Maintainer : Alberto Ruiz (aruiz at um dot es)
10Stability : provisional
11Portability : portable
12
13Some tests.
14
15-}
16
17module Numeric.LinearAlgebra.Tests(
18-- module Numeric.LinearAlgebra.Tests.Instances,
19-- module Numeric.LinearAlgebra.Tests.Properties,
20-- qCheck,
21 runTests,
22 runBenchmarks
23-- , findNaN
24--, runBigTests
25) where
26
27--import Data.Packed.Random
28import Numeric.LinearAlgebra
29import Numeric.LinearAlgebra.LAPACK
30import Numeric.LinearAlgebra.Tests.Instances
31import Numeric.LinearAlgebra.Tests.Properties
32import Test.HUnit hiding ((~:),test,Testable,State)
33import System.Info
34import Data.List(foldl1')
35import Numeric.GSL
36import Prelude hiding ((^))
37import qualified Prelude
38import System.CPUTime
39import System.Exit
40import Text.Printf
41import Data.Packed.Development(unsafeFromForeignPtr,unsafeToForeignPtr)
42import Control.Arrow((***))
43import Debug.Trace
44import Control.Monad(when)
45
46import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
47 ,sized,classify,Testable,Property
48 ,quickCheckWithResult,maxSize,stdArgs,shrink)
49
50import Test.QuickCheck.Test(isSuccess)
51
52qCheck n x = do
53 r <- quickCheckWithResult stdArgs {maxSize = n} x
54 when (not $ isSuccess r) (exitFailure)
55
56a ^ b = a Prelude.^ (b :: Int)
57
58utest str b = TestCase $ assertBool str b
59
60a ~~ b = fromList a |~| fromList b
61
62feye n = flipud (ident n) :: Matrix Double
63
64-----------------------------------------------------------
65
66detTest1 = det m == 26
67 && det mc == 38 :+ (-3)
68 && det (feye 2) == -1
69 where
70 m = (3><3)
71 [ 1, 2, 3
72 , 4, 5, 7
73 , 2, 8, 4 :: Double
74 ]
75 mc = (3><3)
76 [ 1, 2, 3
77 , 4, 5, 7
78 , 2, 8, i
79 ]
80
81detTest2 = inv1 |~| inv2 && [det1] ~~ [det2]
82 where
83 m = complex (feye 6)
84 inv1 = inv m
85 det1 = det m
86 (inv2,(lda,sa)) = invlndet m
87 det2 = sa * exp lda
88
89--------------------------------------------------------------------
90
91polyEval cs x = foldr (\c ac->ac*x+c) 0 cs
92
93polySolveProp p = length p <2 || last p == 0|| 1E-8 > maximum (map magnitude $ map (polyEval (map (:+0) p)) (polySolve p))
94
95---------------------------------------------------------------------
96
97quad f a b = fst $ integrateQAGS 1E-9 100 f a b
98
99-- A multiple integral can be easily defined using partial application
100quad2 f a b g1 g2 = quad h a b
101 where h x = quad (f x) (g1 x) (g2 x)
102
103volSphere r = 8 * quad2 (\x y -> sqrt (r*r-x*x-y*y))
104 0 r (const 0) (\x->sqrt (r*r-x*x))
105
106---------------------------------------------------------------------
107
108derivTest = abs (d (\x-> x * d (\y-> x+y) 1) 1 - 1) < 1E-10
109 where d f x = fst $ derivCentral 0.01 f x
110
111---------------------------------------------------------------------
112
113-- besselTest = utest "bessel_J0_e" ( abs (r-expected) < e )
114-- where (r,e) = bessel_J0_e 5.0
115-- expected = -0.17759677131433830434739701
116
117-- exponentialTest = utest "exp_e10_e" ( abs (v*10^e - expected) < 4E-2 )
118-- where (v,e,_err) = exp_e10_e 30.0
119-- expected = exp 30.0
120
121---------------------------------------------------------------------
122
123nd1 = (3><3) [ 1/2, 1/4, 1/4
124 , 0/1, 1/2, 1/4
125 , 1/2, 1/4, 1/2 :: Double]
126
127nd2 = (2><2) [1, 0, 1, 1:: Complex Double]
128
129expmTest1 = expm nd1 :~14~: (3><3)
130 [ 1.762110887278176
131 , 0.478085470590435
132 , 0.478085470590435
133 , 0.104719410945666
134 , 1.709751181805343
135 , 0.425725765117601
136 , 0.851451530235203
137 , 0.530445176063267
138 , 1.814470592751009 ]
139
140expmTest2 = expm nd2 :~15~: (2><2)
141 [ 2.718281828459045
142 , 0.000000000000000
143 , 2.718281828459045
144 , 2.718281828459045 ]
145
146---------------------------------------------------------------------
147
148minimizationTest = TestList
149 [ utest "minimization conjugatefr" (minim1 f df [5,7] ~~ [1,2])
150 , utest "minimization nmsimplex2" (minim2 f [5,7] `elem` [24,25])
151 ]
152 where f [x,y] = 10*(x-1)^2 + 20*(y-2)^2 + 30
153 df [x,y] = [20*(x-1), 40*(y-2)]
154 minim1 g dg ini = fst $ minimizeD ConjugateFR 1E-3 30 1E-2 1E-4 g dg ini
155 minim2 g ini = rows $ snd $ minimize NMSimplex2 1E-2 30 [1,1] g ini
156
157---------------------------------------------------------------------
158
159rootFindingTest = TestList [ utest "root Hybrids" (fst sol1 ~~ [1,1])
160 , utest "root Newton" (rows (snd sol2) == 2)
161 ]
162 where sol1 = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5]
163 sol2 = rootJ Newton 1E-7 30 (rosenbrock 1 10) (jacobian 1 10) [-10,-5]
164 rosenbrock a b [x,y] = [ a*(1-x), b*(y-x^2) ]
165 jacobian a b [x,_y] = [ [-a , 0]
166 , [-2*b*x, b] ]
167
168---------------------------------------------------------------------
169
170odeTest = utest "ode" (last (toLists sol) ~~ [-1.7588880332411019, 8.364348908711941e-2])
171 where sol = odeSolveV RK8pd 1E-6 1E-6 0 (l2v $ vanderpol 10) Nothing (fromList [1,0]) ts
172 ts = linspace 101 (0,100)
173 l2v f = \t -> fromList . f t . toList
174 vanderpol mu _t [x,y] = [y, -x + mu * y * (1-x^2) ]
175
176---------------------------------------------------------------------
177
178fittingTest = utest "levmar" (ok1 && ok2)
179 where
180 xs = map return [0 .. 39]
181 sigma = 0.1
182 ys = map return $ toList $ fromList (map (head . expModel [5,0.1,1]) xs)
183 + scalar sigma * (randomVector 0 Gaussian 40)
184 dats = zip xs (zip ys (repeat sigma))
185 dat = zip xs ys
186
187 expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b]
188 expModelDer [a,lambda,_b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]]
189
190 sols = fst $ fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dats [1,0,0]
191 sol = fst $ fitModel 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0]
192
193 ok1 = and (zipWith f sols [5,0.1,1]) where f (x,d) r = abs (x-r)<2*d
194 ok2 = norm2 (fromList (map fst sols) - fromList sol) < 1E-5
195
196-----------------------------------------------------
197
198mbCholTest = utest "mbCholTest" (ok1 && ok2) where
199 m1 = (2><2) [2,5,5,8 :: Double]
200 m2 = (2><2) [3,5,5,9 :: Complex Double]
201 ok1 = mbCholSH m1 == Nothing
202 ok2 = mbCholSH m2 == Just (chol m2)
203
204---------------------------------------------------------------------
205
206randomTestGaussian = c :~1~: snd (meanCov dat) where
207 a = (3><3) [1,2,3,
208 2,4,0,
209 -2,2,1]
210 m = 3 |> [1,2,3]
211 c = a <> trans a
212 dat = gaussianSample 7 (10^6) m c
213
214randomTestUniform = c :~1~: snd (meanCov dat) where
215 c = diag $ 3 |> map ((/12).(^2)) [1,2,3]
216 dat = uniformSample 7 (10^6) [(0,1),(1,3),(3,6)]
217
218---------------------------------------------------------------------
219
220rot :: Double -> Matrix Double
221rot a = (3><3) [ c,0,s
222 , 0,1,0
223 ,-s,0,c ]
224 where c = cos a
225 s = sin a
226
227rotTest = fun (10^5) :~11~: rot 5E4
228 where fun n = foldl1' (<>) (map rot angles)
229 where angles = toList $ linspace n (0,1)
230
231---------------------------------------------------------------------
232-- vector <= 0.6.0.2 bug discovered by Patrick Perry
233-- http://trac.haskell.org/vector/ticket/31
234
235offsetTest = y == y' where
236 x = fromList [0..3 :: Double]
237 y = subVector 1 3 x
238 (f,o,n) = unsafeToForeignPtr y
239 y' = unsafeFromForeignPtr f o n
240
241---------------------------------------------------------------------
242
243normsVTest = TestList [
244 utest "normv2CD" $ norm2PropC v
245 , utest "normv2CF" $ norm2PropC (single v)
246#ifndef NONORMVTEST
247 , utest "normv2D" $ norm2PropR x
248 , utest "normv2F" $ norm2PropR (single x)
249#endif
250 , utest "normv1CD" $ norm1 v == 8
251 , utest "normv1CF" $ norm1 (single v) == 8
252 , utest "normv1D" $ norm1 x == 6
253 , utest "normv1F" $ norm1 (single x) == 6
254
255 , utest "normvInfCD" $ normInf v == 5
256 , utest "normvInfCF" $ normInf (single v) == 5
257 , utest "normvInfD" $ normInf x == 3
258 , utest "normvInfF" $ normInf (single x) == 3
259
260 ] where v = fromList [1,-2,3:+4] :: Vector (Complex Double)
261 x = fromList [1,2,-3] :: Vector Double
262#ifndef NONORMVTEST
263 norm2PropR a = norm2 a =~= sqrt (dot a a)
264#endif
265 norm2PropC a = norm2 a =~= realPart (sqrt (dot a (conj a)))
266 a =~= b = fromList [a] |~| fromList [b]
267
268normsMTest = TestList [
269 utest "norm2mCD" $ pnorm PNorm2 v =~= 8.86164970498005
270 , utest "norm2mCF" $ pnorm PNorm2 (single v) =~= 8.86164970498005
271 , utest "norm2mD" $ pnorm PNorm2 x =~= 5.96667765076216
272 , utest "norm2mF" $ pnorm PNorm2 (single x) =~= 5.96667765076216
273
274 , utest "norm1mCD" $ pnorm PNorm1 v == 9
275 , utest "norm1mCF" $ pnorm PNorm1 (single v) == 9
276 , utest "norm1mD" $ pnorm PNorm1 x == 7
277 , utest "norm1mF" $ pnorm PNorm1 (single x) == 7
278
279 , utest "normmInfCD" $ pnorm Infinity v == 12
280 , utest "normmInfCF" $ pnorm Infinity (single v) == 12
281 , utest "normmInfD" $ pnorm Infinity x == 8
282 , utest "normmInfF" $ pnorm Infinity (single x) == 8
283
284 , utest "normmFroCD" $ pnorm Frobenius v =~= 8.88819441731559
285 , utest "normmFroCF" $ pnorm Frobenius (single v) =~~= 8.88819441731559
286 , utest "normmFroD" $ pnorm Frobenius x =~= 6.24499799839840
287 , utest "normmFroF" $ pnorm Frobenius (single x) =~~= 6.24499799839840
288
289 ] where v = (2><2) [1,-2*i,3:+4,7] :: Matrix (Complex Double)
290 x = (2><2) [1,2,-3,5] :: Matrix Double
291 a =~= b = fromList [a] :~10~: fromList [b]
292 a =~~= b = fromList [a] :~5~: fromList [b]
293
294---------------------------------------------------------------------
295
296sumprodTest = TestList [
297 utest "sumCD" $ sumElements z == 6
298 , utest "sumCF" $ sumElements (single z) == 6
299 , utest "sumD" $ sumElements v == 6
300 , utest "sumF" $ sumElements (single v) == 6
301
302 , utest "prodCD" $ prodProp z
303 , utest "prodCF" $ prodProp (single z)
304 , utest "prodD" $ prodProp v
305 , utest "prodF" $ prodProp (single v)
306 ] where v = fromList [1,2,3] :: Vector Double
307 z = fromList [1,2-i,3+i]
308 prodProp x = prodElements x == product (toList x)
309
310---------------------------------------------------------------------
311
312chainTest = utest "chain" $ foldl1' (<>) ms |~| optimiseMult ms where
313 ms = [ diag (fromList [1,2,3 :: Double])
314 , konst 3 (3,5)
315 , (5><10) [1 .. ]
316 , konst 5 (10,2)
317 ]
318
319---------------------------------------------------------------------
320
321conjuTest m = mapVector conjugate (flatten (trans m)) == flatten (ctrans m)
322
323---------------------------------------------------------------------
324
325newtype State s a = State { runState :: s -> (a,s) }
326
327instance Monad (State s) where
328 return a = State $ \s -> (a,s)
329 m >>= f = State $ \s -> let (a,s') = runState m s
330 in runState (f a) s'
331
332state_get :: State s s
333state_get = State $ \s -> (s,s)
334
335state_put :: s -> State s ()
336state_put s = State $ \_ -> ((),s)
337
338evalState :: State s a -> s -> a
339evalState m s = let (a,s') = runState m s
340 in seq s' a
341
342newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
343
344instance Monad m => Monad (MaybeT m) where
345 return a = MaybeT $ return $ Just a
346 m >>= f = MaybeT $ do
347 res <- runMaybeT m
348 case res of
349 Nothing -> return Nothing
350 Just r -> runMaybeT (f r)
351 fail _ = MaybeT $ return Nothing
352
353lift_maybe m = MaybeT $ do
354 res <- m
355 return $ Just res
356
357-- apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs
358--successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool
359successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ stp (subVector 1 (dim v - 1) v))) (v @> 0)
360 where stp e = do
361 ep <- lift_maybe $ state_get
362 if t e ep
363 then lift_maybe $ state_put e
364 else (fail "successive_ test failed")
365
366-- operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input
367--successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b
368successive f v = evalState (mapVectorM stp (subVector 1 (dim v - 1) v)) (v @> 0)
369 where stp e = do
370 ep <- state_get
371 state_put e
372 return $ f ep e
373
374
375succTest = utest "successive" $
376 successive_ (>) (fromList [1 :: Double,2,3,4]) == True
377 && successive_ (>) (fromList [1 :: Double,3,2,4]) == False
378 && successive (+) (fromList [1..10 :: Double]) == 9 |> [3,5,7,9,11,13,15,17,19]
379
380---------------------------------------------------------------------
381
382findAssocTest = utest "findAssoc" ok
383 where
384 ok = m1 == m2
385 m1 = assoc (6,6) 7 $ zip (find (>0) (ident 5 :: Matrix Float)) [10 ..] :: Matrix Double
386 m2 = diagRect 7 (fromList[10..14]) 6 6
387
388---------------------------------------------------------------------
389
390condTest = utest "cond" ok
391 where
392 ok = step v * v == cond v 0 0 0 v
393 v = fromList [-7 .. 7 ] :: Vector Float
394
395---------------------------------------------------------------------
396
397conformTest = utest "conform" ok
398 where
399 ok = 1 + row [1,2,3] + col [10,20,30,40] + (4><3) [1..]
400 == (4><3) [13,15,17
401 ,26,28,30
402 ,39,41,43
403 ,52,54,56]
404 row = asRow . fromList
405 col = asColumn . fromList :: [Double] -> Matrix Double
406
407---------------------------------------------------------------------
408
409accumTest = utest "accum" ok
410 where
411 x = ident 3 :: Matrix Double
412 ok = accum x (+) [((1,2),7), ((2,2),3)]
413 == (3><3) [1,0,0
414 ,0,1,7
415 ,0,0,4]
416 &&
417 toList (flatten x) == [1,0,0,0,1,0,0,0,1]
418
419---------------------------------------------------------------------
420
421-- | All tests must pass with a maximum dimension of about 20
422-- (some tests may fail with bigger sizes due to precision loss).
423runTests :: Int -- ^ maximum dimension
424 -> IO ()
425runTests n = do
426 setErrorHandlerOff
427 let test p = qCheck n p
428 putStrLn "------ mult Double"
429 test (multProp1 10 . rConsist)
430 test (multProp1 10 . cConsist)
431 test (multProp2 10 . rConsist)
432 test (multProp2 10 . cConsist)
433 putStrLn "------ mult Float"
434 test (multProp1 6 . (single *** single) . rConsist)
435 test (multProp1 6 . (single *** single) . cConsist)
436 test (multProp2 6 . (single *** single) . rConsist)
437 test (multProp2 6 . (single *** single) . cConsist)
438 putStrLn "------ sub-trans"
439 test (subProp . rM)
440 test (subProp . cM)
441 putStrLn "------ ctrans"
442 test (conjuTest . cM)
443 test (conjuTest . zM)
444 putStrLn "------ lu"
445 test (luProp . rM)
446 test (luProp . cM)
447 putStrLn "------ inv (linearSolve)"
448 test (invProp . rSqWC)
449 test (invProp . cSqWC)
450 putStrLn "------ luSolve"
451 test (linearSolveProp (luSolve.luPacked) . rSqWC)
452 test (linearSolveProp (luSolve.luPacked) . cSqWC)
453 putStrLn "------ cholSolve"
454 test (linearSolveProp (cholSolve.chol) . rPosDef)
455 test (linearSolveProp (cholSolve.chol) . cPosDef)
456 putStrLn "------ luSolveLS"
457 test (linearSolveProp linearSolveLS . rSqWC)
458 test (linearSolveProp linearSolveLS . cSqWC)
459 test (linearSolveProp2 linearSolveLS . rConsist)
460 test (linearSolveProp2 linearSolveLS . cConsist)
461 putStrLn "------ pinv (linearSolveSVD)"
462 test (pinvProp . rM)
463 test (pinvProp . cM)
464 putStrLn "------ det"
465 test (detProp . rSqWC)
466 test (detProp . cSqWC)
467 putStrLn "------ svd"
468 test (svdProp1 . rM)
469 test (svdProp1 . cM)
470 test (svdProp1a svdR)
471 test (svdProp1a svdC)
472 test (svdProp1a svdRd)
473 test (svdProp1b svdR)
474 test (svdProp1b svdC)
475 test (svdProp1b svdRd)
476 test (svdProp2 thinSVDR)
477 test (svdProp2 thinSVDC)
478 test (svdProp2 thinSVDRd)
479 test (svdProp2 thinSVDCd)
480 test (svdProp3 . rM)
481 test (svdProp3 . cM)
482 test (svdProp4 . rM)
483 test (svdProp4 . cM)
484 test (svdProp5a)
485 test (svdProp5b)
486 test (svdProp6a)
487 test (svdProp6b)
488 test (svdProp7 . rM)
489 test (svdProp7 . cM)
490 putStrLn "------ svdCd"
491#ifdef NOZGESDD
492 putStrLn "Omitted"
493#else
494 test (svdProp1a svdCd)
495 test (svdProp1b svdCd)
496#endif
497 putStrLn "------ eig"
498 test (eigSHProp . rHer)
499 test (eigSHProp . cHer)
500 test (eigProp . rSq)
501 test (eigProp . cSq)
502 test (eigSHProp2 . rHer)
503 test (eigSHProp2 . cHer)
504 test (eigProp2 . rSq)
505 test (eigProp2 . cSq)
506 putStrLn "------ nullSpace"
507 test (nullspaceProp . rM)
508 test (nullspaceProp . cM)
509 putStrLn "------ qr"
510 test (qrProp . rM)
511 test (qrProp . cM)
512 test (rqProp . rM)
513 test (rqProp . cM)
514 test (rqProp1 . cM)
515 test (rqProp2 . cM)
516 test (rqProp3 . cM)
517 putStrLn "------ hess"
518 test (hessProp . rSq)
519 test (hessProp . cSq)
520 putStrLn "------ schur"
521 test (schurProp2 . rSq)
522 test (schurProp1 . cSq)
523 putStrLn "------ chol"
524 test (cholProp . rPosDef)
525 test (cholProp . cPosDef)
526 test (exactProp . rPosDef)
527 test (exactProp . cPosDef)
528 putStrLn "------ expm"
529 test (expmDiagProp . complex. rSqWC)
530 test (expmDiagProp . cSqWC)
531 putStrLn "------ fft"
532 test (\v -> ifft (fft v) |~| v)
533 putStrLn "------ vector operations - Double"
534 test (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::RM))
535 test $ (\u -> sin u ^ 2 + cos u ^ 2 |~| (1::CM)) . liftMatrix makeUnitary
536 test (\u -> sin u ** 2 + cos u ** 2 |~| (1::RM))
537 test (\u -> cos u * tan u |~| sin (u::RM))
538 test $ (\u -> cos u * tan u |~| sin (u::CM)) . liftMatrix makeUnitary
539 putStrLn "------ vector operations - Float"
540 test (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::FM))
541 test $ (\u -> sin u ^ 2 + cos u ^ 2 |~~| (1::ZM)) . liftMatrix makeUnitary
542 test (\u -> sin u ** 2 + cos u ** 2 |~~| (1::FM))
543 test (\u -> cos u * tan u |~~| sin (u::FM))
544 test $ (\u -> cos u * tan u |~~| sin (u::ZM)) . liftMatrix makeUnitary
545 putStrLn "------ read . show"
546 test (\m -> (m::RM) == read (show m))
547 test (\m -> (m::CM) == read (show m))
548 test (\m -> toRows (m::RM) == read (show (toRows m)))
549 test (\m -> toRows (m::CM) == read (show (toRows m)))
550 test (\m -> (m::FM) == read (show m))
551 test (\m -> (m::ZM) == read (show m))
552 test (\m -> toRows (m::FM) == read (show (toRows m)))
553 test (\m -> toRows (m::ZM) == read (show (toRows m)))
554 putStrLn "------ some unit tests"
555 c <- runTestTT $ TestList
556 [ utest "1E5 rots" rotTest
557 , utest "det1" detTest1
558 , utest "invlndet" detTest2
559 , utest "expm1" (expmTest1)
560 , utest "expm2" (expmTest2)
561 , utest "arith1" $ ((ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| (49 :: RM)
562 , utest "arith2" $ ((scalar (1+i) * ones (100,100) * 5 + 2)/0.5 - 7)**2 |~| ( scalar (140*i-51) :: CM)
563 , utest "arith3" $ exp (scalar i * ones(10,10)*pi) + 1 |~| 0
564 , utest "<\\>" $ (3><2) [2,0,0,3,1,1::Double] <\> 3|>[4,9,5] |~| 2|>[2,3]
565-- , utest "gamma" (gamma 5 == 24.0)
566-- , besselTest
567-- , exponentialTest
568 , utest "deriv" derivTest
569 , utest "integrate" (abs (volSphere 2.5 - 4/3*pi*2.5^3) < 1E-8)
570 , utest "polySolve" (polySolveProp [1,2,3,4])
571 , minimizationTest
572 , rootFindingTest
573 , utest "randomGaussian" randomTestGaussian
574 , utest "randomUniform" randomTestUniform
575 , utest "buildVector/Matrix" $
576 complex (10 |> [0::Double ..]) == buildVector 10 fromIntegral
577 && ident 5 == buildMatrix 5 5 (\(r,c) -> if r==c then 1::Double else 0)
578 , utest "rank" $ rank ((2><3)[1,0,0,1,6*eps,0]) == 1
579 && rank ((2><3)[1,0,0,1,7*eps,0]) == 2
580 , utest "block" $ fromBlocks [[ident 3,0],[0,ident 4]] == (ident 7 :: CM)
581 , odeTest
582 , fittingTest
583 , mbCholTest
584 , utest "offset" offsetTest
585 , normsVTest
586 , normsMTest
587 , sumprodTest
588 , chainTest
589 , succTest
590 , findAssocTest
591 , condTest
592 , conformTest
593 , accumTest
594 ]
595 when (errors c + failures c > 0) exitFailure
596 return ()
597
598
599-- single precision approximate equality
600infixl 4 |~~|
601a |~~| b = a :~6~: b
602
603makeUnitary v | realPart n > 1 = v / scalar n
604 | otherwise = v
605 where n = sqrt (conj v <.> v)
606
607-- -- | Some additional tests on big matrices. They take a few minutes.
608-- runBigTests :: IO ()
609-- runBigTests = undefined
610
611{-
612-- | testcase for nonempty fpu stack
613findNaN :: Int -> Bool
614findNaN n = all (bugProp . eye) (take n $ cycle [1..20])
615 where eye m = ident m :: Matrix ( Double)
616-}
617
618--------------------------------------------------------------------------------
619
620-- | Performance measurements.
621runBenchmarks :: IO ()
622runBenchmarks = do
623 solveBench
624 subBench
625 multBench
626 cholBench
627 svdBench
628 eigBench
629 putStrLn ""
630
631--------------------------------
632
633time msg act = do
634 putStr (msg++" ")
635 t0 <- getCPUTime
636 act `seq` putStr " "
637 t1 <- getCPUTime
638 printf "%6.2f s CPU\n" $ (fromIntegral (t1 - t0) / (10^12 :: Double)) :: IO ()
639 return ()
640
641--------------------------------
642
643manymult n = foldl1' (<>) (map rot2 angles) where
644 angles = toList $ linspace n (0,1)
645 rot2 :: Double -> Matrix Double
646 rot2 a = (3><3) [ c,0,s
647 , 0,1,0
648 ,-s,0,c ]
649 where c = cos a
650 s = sin a
651
652multb n = foldl1' (<>) (replicate (10^6) (ident n :: Matrix Double))
653
654--------------------------------
655
656subBench = do
657 putStrLn ""
658 let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (dim v -1) v))
659 time "0.1M subVector " (g (constant 1 (1+10^5) :: Vector Double) @> 0)
660 let f = foldl1' (.) (replicate (10^5) (fromRows.toRows))
661 time "subVector-join 3" (f (ident 3 :: Matrix Double) @@>(0,0))
662 time "subVector-join 10" (f (ident 10 :: Matrix Double) @@>(0,0))
663
664--------------------------------
665
666multBench = do
667 let a = ident 1000 :: Matrix Double
668 let b = ident 2000 :: Matrix Double
669 a `seq` b `seq` putStrLn ""
670 time "product of 1M different 3x3 matrices" (manymult (10^6))
671 putStrLn ""
672 time "product of 1M constant 1x1 matrices" (multb 1)
673 time "product of 1M constant 3x3 matrices" (multb 3)
674 --time "product of 1M constant 5x5 matrices" (multb 5)
675 time "product of 1M const. 10x10 matrices" (multb 10)
676 --time "product of 1M const. 15x15 matrices" (multb 15)
677 time "product of 1M const. 20x20 matrices" (multb 20)
678 --time "product of 1M const. 25x25 matrices" (multb 25)
679 putStrLn ""
680 time "product (1000 x 1000)<>(1000 x 1000)" (a<>a)
681 time "product (2000 x 2000)<>(2000 x 2000)" (b<>b)
682
683--------------------------------
684
685eigBench = do
686 let m = reshape 1000 (randomVector 777 Uniform (1000*1000))
687 s = m + trans m
688 m `seq` s `seq` putStrLn ""
689 time "eigenvalues symmetric 1000x1000" (eigenvaluesSH' m)
690 time "eigenvectors symmetric 1000x1000" (snd $ eigSH' m)
691 time "eigenvalues general 1000x1000" (eigenvalues m)
692 time "eigenvectors general 1000x1000" (snd $ eig m)
693
694--------------------------------
695
696svdBench = do
697 let a = reshape 500 (randomVector 777 Uniform (3000*500))
698 b = reshape 1000 (randomVector 777 Uniform (1000*1000))
699 fv (_,_,v) = v@@>(0,0)
700 a `seq` b `seq` putStrLn ""
701 time "singular values 3000x500" (singularValues a)
702 time "thin svd 3000x500" (fv $ thinSVD a)
703 time "full svd 3000x500" (fv $ svd a)
704 time "singular values 1000x1000" (singularValues b)
705 time "full svd 1000x1000" (fv $ svd b)
706
707--------------------------------
708
709solveBenchN n = do
710 let x = uniformSample 777 (2*n) (replicate n (-1,1))
711 a = trans x <> x
712 b = asColumn $ randomVector 666 Uniform n
713 a `seq` b `seq` putStrLn ""
714 time ("svd solve " ++ show n) (linearSolveSVD a b)
715 time (" ls solve " ++ show n) (linearSolveLS a b)
716 time (" solve " ++ show n) (linearSolve a b)
717 time ("cholSolve " ++ show n) (cholSolve (chol a) b)
718
719solveBench = do
720 solveBenchN 500
721 solveBenchN 1000
722 -- solveBenchN 1500
723
724--------------------------------
725
726cholBenchN n = do
727 let x = uniformSample 777 (2*n) (replicate n (-1,1))
728 a = trans x <> x
729 a `seq` putStr ""
730 time ("chol " ++ show n) (chol a)
731
732cholBench = do
733 putStrLn ""
734 cholBenchN 1200
735 cholBenchN 600
736 cholBenchN 300
737-- cholBenchN 150
738-- cholBenchN 50
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
new file mode 100644
index 0000000..647a06c
--- /dev/null
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs
@@ -0,0 +1,251 @@
1{-# LANGUAGE FlexibleContexts, UndecidableInstances, CPP, FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3-----------------------------------------------------------------------------
4{- |
5Module : Numeric.LinearAlgebra.Tests.Instances
6Copyright : (c) Alberto Ruiz 2008
7License : GPL-style
8
9Maintainer : Alberto Ruiz (aruiz at um dot es)
10Stability : provisional
11Portability : portable
12
13Arbitrary instances for vectors, matrices.
14
15-}
16
17module Numeric.LinearAlgebra.Tests.Instances(
18 Sq(..), rSq,cSq,
19 Rot(..), rRot,cRot,
20 Her(..), rHer,cHer,
21 WC(..), rWC,cWC,
22 SqWC(..), rSqWC, cSqWC,
23 PosDef(..), rPosDef, cPosDef,
24 Consistent(..), rConsist, cConsist,
25 RM,CM, rM,cM,
26 FM,ZM, fM,zM
27) where
28
29import System.Random
30
31import Numeric.LinearAlgebra
32import Control.Monad(replicateM)
33import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
34 ,sized,classify,Testable,Property
35 ,quickCheckWith,maxSize,stdArgs,shrink)
36
37#if MIN_VERSION_QuickCheck(2,0,0)
38shrinkListElementwise :: (Arbitrary a) => [a] -> [[a]]
39shrinkListElementwise [] = []
40shrinkListElementwise (x:xs) = [ y:xs | y <- shrink x ]
41 ++ [ x:ys | ys <- shrinkListElementwise xs ]
42
43shrinkPair :: (Arbitrary a, Arbitrary b) => (a,b) -> [(a,b)]
44shrinkPair (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
49instance (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
65chooseDim = sized $ \m -> choose (1,max 1 m)
66
67instance (Field a, Arbitrary a) => Arbitrary (Vector a) where
68 arbitrary = do m <- chooseDim
69 l <- vector m
70 return $ fromList l
71
72#if MIN_VERSION_QuickCheck(2,0,0)
73 -- shrink any one of the components
74 shrink = map fromList . shrinkListElementwise . toList
75
76#else
77 coarbitrary = undefined
78#endif
79
80instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where
81 arbitrary = do
82 m <- chooseDim
83 n <- chooseDim
84 l <- vector (m*n)
85 return $ (m><n) l
86
87#if MIN_VERSION_QuickCheck(2,0,0)
88 -- shrink any one of the components
89 shrink a = map (rows a >< cols a)
90 . shrinkListElementwise
91 . concat . toLists
92 $ a
93#else
94 coarbitrary = undefined
95#endif
96
97
98-- a square matrix
99newtype (Sq a) = Sq (Matrix a) deriving Show
100instance (Element a, Arbitrary a) => Arbitrary (Sq a) where
101 arbitrary = do
102 n <- chooseDim
103 l <- vector (n*n)
104 return $ Sq $ (n><n) l
105
106#if MIN_VERSION_QuickCheck(2,0,0)
107 shrink (Sq a) = [ Sq b | b <- shrink a ]
108#else
109 coarbitrary = undefined
110#endif
111
112
113-- a unitary matrix
114newtype (Rot a) = Rot (Matrix a) deriving Show
115instance (Field a, Arbitrary a) => Arbitrary (Rot a) where
116 arbitrary = do
117 Sq m <- arbitrary
118 let (q,_) = qr m
119 return (Rot q)
120
121#if MIN_VERSION_QuickCheck(2,0,0)
122#else
123 coarbitrary = undefined
124#endif
125
126
127-- a complex hermitian or real symmetric matrix
128newtype (Her a) = Her (Matrix a) deriving Show
129instance (Field a, Arbitrary a, Num (Vector a)) => Arbitrary (Her a) where
130 arbitrary = do
131 Sq m <- arbitrary
132 let m' = m/2
133 return $ Her (m' + ctrans m')
134
135#if MIN_VERSION_QuickCheck(2,0,0)
136#else
137 coarbitrary = undefined
138#endif
139
140class (Field a, Arbitrary a, Element (RealOf a), Random (RealOf a)) => ArbitraryField a
141instance ArbitraryField Double
142instance ArbitraryField (Complex Double)
143
144
145-- a well-conditioned general matrix (the singular values are between 1 and 100)
146newtype (WC a) = WC (Matrix a) deriving Show
147instance (ArbitraryField a) => Arbitrary (WC a) where
148 arbitrary = do
149 m <- arbitrary
150 let (u,_,v) = svd m
151 r = rows m
152 c = cols m
153 n = min r c
154 sv' <- replicateM n (choose (1,100))
155 let s = diagRect 0 (fromList sv') r c
156 return $ WC (u <> real s <> trans v)
157
158#if MIN_VERSION_QuickCheck(2,0,0)
159#else
160 coarbitrary = undefined
161#endif
162
163
164-- a well-conditioned square matrix (the singular values are between 1 and 100)
165newtype (SqWC a) = SqWC (Matrix a) deriving Show
166instance (ArbitraryField a) => Arbitrary (SqWC a) where
167 arbitrary = do
168 Sq m <- arbitrary
169 let (u,_,v) = svd m
170 n = rows m
171 sv' <- replicateM n (choose (1,100))
172 let s = diag (fromList sv')
173 return $ SqWC (u <> real s <> trans v)
174
175#if MIN_VERSION_QuickCheck(2,0,0)
176#else
177 coarbitrary = undefined
178#endif
179
180
181-- a positive definite square matrix (the eigenvalues are between 0 and 100)
182newtype (PosDef a) = PosDef (Matrix a) deriving Show
183instance (ArbitraryField a, Num (Vector a))
184 => Arbitrary (PosDef a) where
185 arbitrary = do
186 Her m <- arbitrary
187 let (_,v) = eigSH m
188 n = rows m
189 l <- replicateM n (choose (0,100))
190 let s = diag (fromList l)
191 p = v <> real s <> ctrans v
192 return $ PosDef (0.5 * p + 0.5 * ctrans p)
193
194#if MIN_VERSION_QuickCheck(2,0,0)
195#else
196 coarbitrary = undefined
197#endif
198
199
200-- a pair of matrices that can be multiplied
201newtype (Consistent a) = Consistent (Matrix a, Matrix a) deriving Show
202instance (Field a, Arbitrary a) => Arbitrary (Consistent a) where
203 arbitrary = do
204 n <- chooseDim
205 k <- chooseDim
206 m <- chooseDim
207 la <- vector (n*k)
208 lb <- vector (k*m)
209 return $ Consistent ((n><k) la, (k><m) lb)
210
211#if MIN_VERSION_QuickCheck(2,0,0)
212 shrink (Consistent (x,y)) = [ Consistent (u,v) | (u,v) <- shrinkPair (x,y) ]
213#else
214 coarbitrary = undefined
215#endif
216
217
218
219type RM = Matrix Double
220type CM = Matrix (Complex Double)
221type FM = Matrix Float
222type ZM = Matrix (Complex Float)
223
224
225rM m = m :: RM
226cM m = m :: CM
227fM m = m :: FM
228zM m = m :: ZM
229
230
231rHer (Her m) = m :: RM
232cHer (Her m) = m :: CM
233
234rRot (Rot m) = m :: RM
235cRot (Rot m) = m :: CM
236
237rSq (Sq m) = m :: RM
238cSq (Sq m) = m :: CM
239
240rWC (WC m) = m :: RM
241cWC (WC m) = m :: CM
242
243rSqWC (SqWC m) = m :: RM
244cSqWC (SqWC m) = m :: CM
245
246rPosDef (PosDef m) = m :: RM
247cPosDef (PosDef m) = m :: CM
248
249rConsist (Consistent (a,b)) = (a,b::RM)
250cConsist (Consistent (a,b)) = (a,b::CM)
251
diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
new file mode 100644
index 0000000..c96d3de
--- /dev/null
+++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -0,0 +1,272 @@
1{-# LANGUAGE CPP, FlexibleContexts #-}
2{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3-----------------------------------------------------------------------------
4{- |
5Module : Numeric.LinearAlgebra.Tests.Properties
6Copyright : (c) Alberto Ruiz 2008
7License : GPL-style
8
9Maintainer : Alberto Ruiz (aruiz at um dot es)
10Stability : provisional
11Portability : portable
12
13Testing properties.
14
15-}
16
17module Numeric.LinearAlgebra.Tests.Properties (
18 dist, (|~|), (~:), Aprox((:~)),
19 zeros, ones,
20 square,
21 unitary,
22 hermitian,
23 wellCond,
24 positiveDefinite,
25 upperTriang,
26 upperHessenberg,
27 luProp,
28 invProp,
29 pinvProp,
30 detProp,
31 nullspaceProp,
32 bugProp,
33 svdProp1, svdProp1a, svdProp1b, svdProp2, svdProp3, svdProp4,
34 svdProp5a, svdProp5b, svdProp6a, svdProp6b, svdProp7,
35 eigProp, eigSHProp, eigProp2, eigSHProp2,
36 qrProp, rqProp, rqProp1, rqProp2, rqProp3,
37 hessProp,
38 schurProp1, schurProp2,
39 cholProp, exactProp,
40 expmDiagProp,
41 multProp1, multProp2,
42 subProp,
43 linearSolveProp, linearSolveProp2
44) where
45
46import Numeric.LinearAlgebra --hiding (real,complex)
47import Numeric.LinearAlgebra.LAPACK
48import Debug.Trace
49import Test.QuickCheck(Arbitrary,arbitrary,coarbitrary,choose,vector
50 ,sized,classify,Testable,Property
51 ,quickCheckWith,maxSize,stdArgs,shrink)
52
53trivial :: Testable a => Bool -> a -> Property
54trivial = (`classify` "trivial")
55
56
57-- relative error
58dist :: (Normed c t, Num (c t)) => c t -> c t -> Double
59dist a b = realToFrac r
60 where norm = pnorm Infinity
61 na = norm a
62 nb = norm b
63 nab = norm (a-b)
64 mx = max na nb
65 mn = min na nb
66 r = if mn < peps
67 then mx
68 else nab/mx
69
70infixl 4 |~|
71a |~| b = a :~10~: b
72--a |~| b = dist a b < 10^^(-10)
73
74data Aprox a = (:~) a Int
75-- (~:) :: (Normed a, Num a) => Aprox a -> a -> Bool
76a :~n~: b = dist a b < 10^^(-n)
77
78------------------------------------------------------
79
80square m = rows m == cols m
81
82-- orthonormal columns
83orthonormal m = ctrans m <> m |~| ident (cols m)
84
85unitary m = square m && orthonormal m
86
87hermitian m = square m && m |~| ctrans m
88
89wellCond m = rcond m > 1/100
90
91positiveDefinite m = minimum (toList e) > 0
92 where (e,_v) = eigSH m
93
94upperTriang m = rows m == 1 || down == z
95 where down = fromList $ concat $ zipWith drop [1..] (toLists (ctrans m))
96 z = constant 0 (dim down)
97
98upperHessenberg m = rows m < 3 || down == z
99 where down = fromList $ concat $ zipWith drop [2..] (toLists (ctrans m))
100 z = constant 0 (dim down)
101
102zeros (r,c) = reshape c (constant 0 (r*c))
103
104ones (r,c) = zeros (r,c) + 1
105
106-----------------------------------------------------
107
108luProp m = m |~| p <> l <> u && f (det p) |~| f s
109 where (l,u,p,s) = lu m
110 f x = fromList [x]
111
112invProp m = m <> inv m |~| ident (rows m)
113
114pinvProp m = m <> p <> m |~| m
115 && p <> m <> p |~| p
116 && hermitian (m<>p)
117 && hermitian (p<>m)
118 where p = pinv m
119
120detProp m = s d1 |~| s d2
121 where d1 = det m
122 d2 = det' * det q
123 det' = product $ toList $ takeDiag r
124 (q,r) = qr m
125 s x = fromList [x]
126
127nullspaceProp m = null nl `trivial` (null nl || m <> n |~| zeros (r,c)
128 && orthonormal (fromColumns nl))
129 where nl = nullspacePrec 1 m
130 n = fromColumns nl
131 r = rows m
132 c = cols m - rank m
133
134------------------------------------------------------------------
135
136-- testcase for nonempty fpu stack
137-- uncommenting unitary' signature eliminates the problem
138bugProp m = m |~| u <> real d <> trans v && unitary' u && unitary' v
139 where (u,d,v) = fullSVD m
140 -- unitary' :: (Num (Vector t), Field t) => Matrix t -> Bool
141 unitary' a = unitary a
142
143------------------------------------------------------------------
144
145-- fullSVD
146svdProp1 m = m |~| u <> real d <> trans v && unitary u && unitary v
147 where (u,d,v) = fullSVD m
148
149svdProp1a svdfun m = m |~| u <> real d <> trans v && unitary u && unitary v where
150 (u,s,v) = svdfun m
151 d = diagRect 0 s (rows m) (cols m)
152
153svdProp1b svdfun m = unitary u && unitary v where
154 (u,_,v) = svdfun m
155
156-- thinSVD
157svdProp2 thinSVDfun m = m |~| u <> diag (real s) <> trans v && orthonormal u && orthonormal v && dim s == min (rows m) (cols m)
158 where (u,s,v) = thinSVDfun m
159
160-- compactSVD
161svdProp3 m = (m |~| u <> real (diag s) <> trans v
162 && orthonormal u && orthonormal v)
163 where (u,s,v) = compactSVD m
164
165svdProp4 m' = m |~| u <> real (diag s) <> trans v
166 && orthonormal u && orthonormal v
167 && (dim s == r || r == 0 && dim s == 1)
168 where (u,s,v) = compactSVD m
169 m = fromBlocks [[m'],[m']]
170 r = rank m'
171
172svdProp5a m = all (s1|~|) [s2,s3,s4,s5,s6] where
173 s1 = svR m
174 s2 = svRd m
175 (_,s3,_) = svdR m
176 (_,s4,_) = svdRd m
177 (_,s5,_) = thinSVDR m
178 (_,s6,_) = thinSVDRd m
179
180svdProp5b m = all (s1|~|) [s2,s3,s4,s5,s6] where
181 s1 = svC m
182 s2 = svCd m
183 (_,s3,_) = svdC m
184 (_,s4,_) = svdCd m
185 (_,s5,_) = thinSVDC m
186 (_,s6,_) = thinSVDCd m
187
188svdProp6a m = s |~| s' && v |~| v' && s |~| s'' && u |~| u'
189 where (u,s,v) = svdR m
190 (s',v') = rightSVR m
191 (u',s'') = leftSVR m
192
193svdProp6b m = s |~| s' && v |~| v' && s |~| s'' && u |~| u'
194 where (u,s,v) = svdC m
195 (s',v') = rightSVC m
196 (u',s'') = leftSVC m
197
198svdProp7 m = s |~| s' && u |~| u' && v |~| v' && s |~| s'''
199 where (u,s,v) = svd m
200 (s',v') = rightSV m
201 (u',_s'') = leftSV m
202 s''' = singularValues m
203
204------------------------------------------------------------------
205
206eigProp m = complex m <> v |~| v <> diag s
207 where (s, v) = eig m
208
209eigSHProp m = m <> v |~| v <> real (diag s)
210 && unitary v
211 && m |~| v <> real (diag s) <> ctrans v
212 where (s, v) = eigSH m
213
214eigProp2 m = fst (eig m) |~| eigenvalues m
215
216eigSHProp2 m = fst (eigSH m) |~| eigenvaluesSH m
217
218------------------------------------------------------------------
219
220qrProp m = q <> r |~| m && unitary q && upperTriang r
221 where (q,r) = qr m
222
223rqProp m = r <> q |~| m && unitary q && upperTriang' r
224 where (r,q) = rq m
225
226rqProp1 m = r <> q |~| m
227 where (r,q) = rq m
228
229rqProp2 m = unitary q
230 where (_r,q) = rq m
231
232rqProp3 m = upperTriang' r
233 where (r,_q) = rq m
234
235upperTriang' r = upptr (rows r) (cols r) * r |~| r
236 where upptr f c = buildMatrix f c $ \(r',c') -> if r'-t > c' then 0 else 1
237 where t = f-c
238
239hessProp m = m |~| p <> h <> ctrans p && unitary p && upperHessenberg h
240 where (p,h) = hess m
241
242schurProp1 m = m |~| u <> s <> ctrans u && unitary u && upperTriang s
243 where (u,s) = schur m
244
245schurProp2 m = m |~| u <> s <> ctrans u && unitary u && upperHessenberg s -- fixme
246 where (u,s) = schur m
247
248cholProp m = m |~| ctrans c <> c && upperTriang c
249 where c = chol m
250
251exactProp m = chol m == chol (m+0)
252
253expmDiagProp m = expm (logm m) :~ 7 ~: complex m
254 where logm = matFunc log
255
256-- reference multiply
257mulH a b = fromLists [[ doth ai bj | bj <- toColumns b] | ai <- toRows a ]
258 where doth u v = sum $ zipWith (*) (toList u) (toList v)
259
260multProp1 p (a,b) = (a <> b) :~p~: (mulH a b)
261
262multProp2 p (a,b) = (ctrans (a <> b)) :~p~: (ctrans b <> ctrans a)
263
264linearSolveProp f m = f m m |~| ident (rows m)
265
266linearSolveProp2 f (a,x) = not wc `trivial` (not wc || a <> f a b |~| b)
267 where q = min (rows a) (cols a)
268 b = a <> x
269 wc = rank a == q
270
271subProp m = m == (trans . fromColumns . toRows) m
272
diff --git a/packages/tests/src/tests.hs b/packages/tests/src/tests.hs
new file mode 100644
index 0000000..23fd675
--- /dev/null
+++ b/packages/tests/src/tests.hs
@@ -0,0 +1,3 @@
1import Numeric.LinearAlgebra.Tests
2
3main = runTests 20
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-27 11:55:16 +0000