summaryrefslogtreecommitdiff
path: root/lib/Numeric
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Numeric')
-rw-r--r--lib/Numeric/GSL/Internal.hs8
-rw-r--r--lib/Numeric/GSL/Minimization.hs4
-rw-r--r--lib/Numeric/GSL/ODE.hs4
-rw-r--r--lib/Numeric/GSL/Root.hs4
-rw-r--r--lib/Numeric/LinearAlgebra/Instances.hs14
-rw-r--r--lib/Numeric/LinearAlgebra/Tests.hs14
-rw-r--r--lib/Numeric/LinearAlgebra/Tests/Properties.hs4
7 files changed, 35 insertions, 17 deletions
diff --git a/lib/Numeric/GSL/Internal.hs b/lib/Numeric/GSL/Internal.hs
index 37bcc1b..2ccc3ef 100644
--- a/lib/Numeric/GSL/Internal.hs
+++ b/lib/Numeric/GSL/Internal.hs
@@ -35,12 +35,12 @@ foreign import ccall "wrapper"
35 35
36aux_vTov :: (Vector Double -> Vector Double) -> TVV 36aux_vTov :: (Vector Double -> Vector Double) -> TVV
37aux_vTov f n p nr r = g where 37aux_vTov f n p nr r = g where
38 V {fptr = pr} = f x 38 v = f x
39 x = createV (fromIntegral n) copy "aux_vTov" 39 x = createV (fromIntegral n) copy "aux_vTov"
40 copy n' q = do 40 copy n' q = do
41 copyArray q p (fromIntegral n') 41 copyArray q p (fromIntegral n')
42 return 0 42 return 0
43 g = do withForeignPtr pr $ \p' -> copyArray r p' (fromIntegral nr) 43 g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral nr)
44 return 0 44 return 0
45 45
46foreign import ccall "wrapper" 46foreign import ccall "wrapper"
@@ -51,12 +51,12 @@ foreign import ccall "wrapper"
51 51
52aux_vTom :: (Vector Double -> Matrix Double) -> TVM 52aux_vTom :: (Vector Double -> Matrix Double) -> TVM
53aux_vTom f n p rr cr r = g where 53aux_vTom f n p rr cr r = g where
54 V {fptr = pr} = flatten $ f x 54 v = flatten $ f x
55 x = createV (fromIntegral n) copy "aux_vTov" 55 x = createV (fromIntegral n) copy "aux_vTov"
56 copy n' q = do 56 copy n' q = do
57 copyArray q p (fromIntegral n') 57 copyArray q p (fromIntegral n')
58 return 0 58 return 0
59 g = do withForeignPtr pr $ \p' -> copyArray r p' (fromIntegral $ rr*cr) 59 g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral $ rr*cr)
60 return 0 60 return 0
61 61
62createV n fun msg = unsafePerformIO $ do 62createV n fun msg = unsafePerformIO $ do
diff --git a/lib/Numeric/GSL/Minimization.hs b/lib/Numeric/GSL/Minimization.hs
index 3240ddf..3bbb2b3 100644
--- a/lib/Numeric/GSL/Minimization.hs
+++ b/lib/Numeric/GSL/Minimization.hs
@@ -109,7 +109,7 @@ ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2
109minimizeV method eps maxit szv f xiv = unsafePerformIO $ do 109minimizeV method eps maxit szv f xiv = unsafePerformIO $ do
110 let n = dim xiv 110 let n = dim xiv
111 fp <- mkVecfun (iv f) 111 fp <- mkVecfun (iv f)
112 rawpath <- ww2 withVector xiv withVector szv $ \xiv' szv' -> 112 rawpath <- ww2 vec xiv vec szv $ \xiv' szv' ->
113 createMIO maxit (n+3) 113 createMIO maxit (n+3)
114 (c_minimize (fi (fromEnum method)) fp eps (fi maxit) // xiv' // szv') 114 (c_minimize (fi (fromEnum method)) fp eps (fi maxit) // xiv' // szv')
115 "minimize" 115 "minimize"
@@ -166,7 +166,7 @@ minimizeVD method eps maxit istep tol f df xiv = unsafePerformIO $ do
166 df' = (checkdim1 n . df) 166 df' = (checkdim1 n . df)
167 fp <- mkVecfun (iv f') 167 fp <- mkVecfun (iv f')
168 dfp <- mkVecVecfun (aux_vTov df') 168 dfp <- mkVecVecfun (aux_vTov df')
169 rawpath <- withVector xiv $ \xiv' -> 169 rawpath <- vec xiv $ \xiv' ->
170 createMIO maxit (n+2) 170 createMIO maxit (n+2)
171 (c_minimizeD (fi (fromEnum method)) fp dfp istep tol eps (fi maxit) // xiv') 171 (c_minimizeD (fi (fromEnum method)) fp dfp istep tol eps (fi maxit) // xiv')
172 "minimizeD" 172 "minimizeD"
diff --git a/lib/Numeric/GSL/ODE.hs b/lib/Numeric/GSL/ODE.hs
index 9d890fc..f6f11f9 100644
--- a/lib/Numeric/GSL/ODE.hs
+++ b/lib/Numeric/GSL/ODE.hs
@@ -83,8 +83,8 @@ odeSolveV method h epsAbs epsRel f mbjac xiv ts = unsafePerformIO $ do
83 jp <- case mbjac of 83 jp <- case mbjac of
84 Just jac -> mkDoubleVecMatfun (\t -> aux_vTom (checkdim2 n . jac t)) 84 Just jac -> mkDoubleVecMatfun (\t -> aux_vTom (checkdim2 n . jac t))
85 Nothing -> return nullFunPtr 85 Nothing -> return nullFunPtr
86 sol <- withVector xiv $ \xiv' -> 86 sol <- vec xiv $ \xiv' ->
87 withVector (checkTimes ts) $ \ts' -> 87 vec (checkTimes ts) $ \ts' ->
88 createMIO (dim ts) n 88 createMIO (dim ts) n
89 (ode_c (fi (fromEnum method)) h epsAbs epsRel fp jp // xiv' // ts' ) 89 (ode_c (fi (fromEnum method)) h epsAbs epsRel fp jp // xiv' // ts' )
90 "ode" 90 "ode"
diff --git a/lib/Numeric/GSL/Root.hs b/lib/Numeric/GSL/Root.hs
index 840e8ee..ddb090d 100644
--- a/lib/Numeric/GSL/Root.hs
+++ b/lib/Numeric/GSL/Root.hs
@@ -79,7 +79,7 @@ rootGen m f xi epsabs maxit = unsafePerformIO $ do
79 let xiv = fromList xi 79 let xiv = fromList xi
80 n = dim xiv 80 n = dim xiv
81 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) 81 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList))
82 rawpath <- withVector xiv $ \xiv' -> 82 rawpath <- vec xiv $ \xiv' ->
83 createMIO maxit (2*n+1) 83 createMIO maxit (2*n+1)
84 (c_root m fp epsabs (fi maxit) // xiv') 84 (c_root m fp epsabs (fi maxit) // xiv')
85 "root" 85 "root"
@@ -117,7 +117,7 @@ rootJGen m f jac xi epsabs maxit = unsafePerformIO $ do
117 n = dim xiv 117 n = dim xiv
118 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) 118 fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList))
119 jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList)) 119 jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList))
120 rawpath <- withVector xiv $ \xiv' -> 120 rawpath <- vec xiv $ \xiv' ->
121 createMIO maxit (2*n+1) 121 createMIO maxit (2*n+1)
122 (c_rootj m fp jp epsabs (fi maxit) // xiv') 122 (c_rootj m fp jp epsabs (fi maxit) // xiv')
123 "root" 123 "root"
diff --git a/lib/Numeric/LinearAlgebra/Instances.hs b/lib/Numeric/LinearAlgebra/Instances.hs
index 67496f2..b17da5a 100644
--- a/lib/Numeric/LinearAlgebra/Instances.hs
+++ b/lib/Numeric/LinearAlgebra/Instances.hs
@@ -25,7 +25,7 @@ import Data.Packed.Matrix
25import Complex 25import Complex
26import Data.List(transpose,intersperse) 26import Data.List(transpose,intersperse)
27import Foreign(Storable) 27import Foreign(Storable)
28import Data.Monoid 28-- import Data.Monoid
29import Data.Packed.Internal.Vector 29import Data.Packed.Internal.Vector
30-- import Control.Parallel.Strategies 30-- import Control.Parallel.Strategies
31 31
@@ -182,12 +182,12 @@ instance (Linear Vector a, Floating (Vector a), Fractional (Matrix a)) => Floati
182 182
183--------------------------------------------------------------- 183---------------------------------------------------------------
184 184
185instance (Storable a, Num (Vector a)) => Monoid (Vector a) where 185-- instance (Storable a, Num (Vector a)) => Monoid (Vector a) where
186 mempty = 0 { idim = 0 } 186-- mempty = 0 { idim = 0 }
187 mappend a b = mconcat [a,b] 187-- mappend a b = mconcat [a,b]
188 mconcat = j . filter ((>0).dim) 188-- mconcat = j . filter ((>0).dim)
189 where j [] = mempty 189-- where j [] = mempty
190 j l = join l 190-- j l = join l
191 191
192--------------------------------------------------------------- 192---------------------------------------------------------------
193 193
diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs
index 016b9a1..3f7c847 100644
--- a/lib/Numeric/LinearAlgebra/Tests.hs
+++ b/lib/Numeric/LinearAlgebra/Tests.hs
@@ -180,6 +180,9 @@ runTests n = do
180 test (multProp1 . cConsist) 180 test (multProp1 . cConsist)
181 test (multProp2 . rConsist) 181 test (multProp2 . rConsist)
182 test (multProp2 . cConsist) 182 test (multProp2 . cConsist)
183 putStrLn "------ sub-trans"
184 test (subProp . rM)
185 test (subProp . cM)
183 putStrLn "------ lu" 186 putStrLn "------ lu"
184 test (luProp . rM) 187 test (luProp . rM)
185 test (luProp . cM) 188 test (luProp . cM)
@@ -305,6 +308,7 @@ makeUnitary v | realPart n > 1 = v / scalar n
305-- | Performance measurements. 308-- | Performance measurements.
306runBenchmarks :: IO () 309runBenchmarks :: IO ()
307runBenchmarks = do 310runBenchmarks = do
311 subBench
308 multBench 312 multBench
309 svdBench 313 svdBench
310 eigBench 314 eigBench
@@ -335,6 +339,16 @@ multb n = foldl1' (<>) (replicate (10^6) (ident n :: Matrix Double))
335 339
336-------------------------------- 340--------------------------------
337 341
342subBench = do
343 putStrLn ""
344 let g = foldl1' (.) (replicate (10^5) (\v -> subVector 1 (dim v -1) v))
345 time "0.1M subVector " (g (constant 1 (1+10^5) :: Vector Double) @> 0)
346 let f = foldl1' (.) (replicate (10^5) (fromRows.toRows))
347 time "subVector-join 3" (f (ident 3 :: Matrix Double) @@>(0,0))
348 time "subVector-join 10" (f (ident 10 :: Matrix Double) @@>(0,0))
349
350--------------------------------
351
338multBench = do 352multBench = do
339 let a = ident 1000 :: Matrix Double 353 let a = ident 1000 :: Matrix Double
340 let b = ident 2000 :: Matrix Double 354 let b = ident 2000 :: Matrix Double
diff --git a/lib/Numeric/LinearAlgebra/Tests/Properties.hs b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
index 93175f2..6d176fa 100644
--- a/lib/Numeric/LinearAlgebra/Tests/Properties.hs
+++ b/lib/Numeric/LinearAlgebra/Tests/Properties.hs
@@ -38,6 +38,7 @@ module Numeric.LinearAlgebra.Tests.Properties (
38 cholProp, 38 cholProp,
39 expmDiagProp, 39 expmDiagProp,
40 multProp1, multProp2, 40 multProp1, multProp2,
41 subProp,
41 linearSolveProp, linearSolveProp2 42 linearSolveProp, linearSolveProp2
42) where 43) where
43 44
@@ -243,3 +244,6 @@ linearSolveProp2 f (a,x) = not wc `trivial` (not wc || a <> f a b |~| b)
243 where q = min (rows a) (cols a) 244 where q = min (rows a) (cols a)
244 b = a <> x 245 b = a <> x
245 wc = rank a == q 246 wc = rank a == q
247
248subProp m = m == (trans . fromColumns . toRows) m
249