diff options
author | Alberto Ruiz <aruiz@um.es> | 2010-12-28 12:30:18 +0000 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2010-12-28 12:30:18 +0000 |
commit | 853b46c522fa48a2c476fbfd0771a0da7aa9efc0 (patch) | |
tree | 468b345425a6793f9ed2efd5225d455fcff5e8cd /lib/Numeric/LinearAlgebra | |
parent | b6a2f4e1dc25c5f36586af22c6f6096c526d09aa (diff) |
step, find, assoc
Diffstat (limited to 'lib/Numeric/LinearAlgebra')
-rw-r--r-- | lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c | 20 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h | 3 | ||||
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests.hs | 17 |
3 files changed, 36 insertions, 4 deletions
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c index e8bbbdb..ae437d2 100644 --- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c +++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c | |||
@@ -1247,3 +1247,23 @@ int conjugateC(KCVEC(x),CVEC(t)) { | |||
1247 | OK | 1247 | OK |
1248 | } | 1248 | } |
1249 | 1249 | ||
1250 | //////////////////// step ///////////////////////// | ||
1251 | |||
1252 | int stepF(FVEC(x),FVEC(y)) { | ||
1253 | DEBUGMSG("stepF") | ||
1254 | int k; | ||
1255 | for(k=0;k<xn;k++) { | ||
1256 | yp[k]=xp[k]>0; | ||
1257 | } | ||
1258 | OK | ||
1259 | } | ||
1260 | |||
1261 | int stepD(DVEC(x),DVEC(y)) { | ||
1262 | DEBUGMSG("stepD") | ||
1263 | int k; | ||
1264 | for(k=0;k<xn;k++) { | ||
1265 | yp[k]=xp[k]>0; | ||
1266 | } | ||
1267 | OK | ||
1268 | } | ||
1269 | |||
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h index 0543f7a..6207a59 100644 --- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h +++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h | |||
@@ -87,6 +87,9 @@ int double2float(DVEC(x),FVEC(y)); | |||
87 | int conjugateQ(KQVEC(x),QVEC(t)); | 87 | int conjugateQ(KQVEC(x),QVEC(t)); |
88 | int conjugateC(KCVEC(x),CVEC(t)); | 88 | int conjugateC(KCVEC(x),CVEC(t)); |
89 | 89 | ||
90 | int stepF(FVEC(x),FVEC(y)); | ||
91 | int stepD(DVEC(x),DVEC(y)); | ||
92 | |||
90 | int svd_l_R(KDMAT(x),DMAT(u),DVEC(s),DMAT(v)); | 93 | int svd_l_R(KDMAT(x),DMAT(u),DVEC(s),DMAT(v)); |
91 | int svd_l_Rdd(KDMAT(x),DMAT(u),DVEC(s),DMAT(v)); | 94 | int svd_l_Rdd(KDMAT(x),DMAT(u),DVEC(s),DMAT(v)); |
92 | int svd_l_C(KCMAT(a),CMAT(u),DVEC(s),CMAT(v)); | 95 | int svd_l_C(KCMAT(a),CMAT(u),DVEC(s),CMAT(v)); |
diff --git a/lib/Numeric/LinearAlgebra/Tests.hs b/lib/Numeric/LinearAlgebra/Tests.hs index 68e77f1..181cfbf 100644 --- a/lib/Numeric/LinearAlgebra/Tests.hs +++ b/lib/Numeric/LinearAlgebra/Tests.hs | |||
@@ -342,8 +342,8 @@ lift_maybe m = MaybeT $ do | |||
342 | 342 | ||
343 | -- | apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs | 343 | -- | apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs |
344 | --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool | 344 | --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool |
345 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ step (subVector 1 (dim v - 1) v))) (v @> 0) | 345 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ stp (subVector 1 (dim v - 1) v))) (v @> 0) |
346 | where step e = do | 346 | where stp e = do |
347 | ep <- lift_maybe $ state_get | 347 | ep <- lift_maybe $ state_get |
348 | if t e ep | 348 | if t e ep |
349 | then lift_maybe $ state_put e | 349 | then lift_maybe $ state_put e |
@@ -351,8 +351,8 @@ successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ s | |||
351 | 351 | ||
352 | -- | operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input | 352 | -- | operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input |
353 | --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b | 353 | --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b |
354 | successive f v = evalState (mapVectorM step (subVector 1 (dim v - 1) v)) (v @> 0) | 354 | successive f v = evalState (mapVectorM stp (subVector 1 (dim v - 1) v)) (v @> 0) |
355 | where step e = do | 355 | where stp e = do |
356 | ep <- state_get | 356 | ep <- state_get |
357 | state_put e | 357 | state_put e |
358 | return $ f ep e | 358 | return $ f ep e |
@@ -365,6 +365,14 @@ succTest = utest "successive" $ | |||
365 | 365 | ||
366 | --------------------------------------------------------------------- | 366 | --------------------------------------------------------------------- |
367 | 367 | ||
368 | findAssocTest = utest "findAssoc" ok | ||
369 | where | ||
370 | ok = m1 == m2 | ||
371 | m1 = assoc (6,6) 7 $ zip (find (>0) (ident 5 :: Matrix Float)) [10 ..] :: Matrix Double | ||
372 | m2 = diagRect 7 (fromList[10..14]) 6 6 :: Matrix Double | ||
373 | |||
374 | --------------------------------------------------------------------- | ||
375 | |||
368 | 376 | ||
369 | -- | All tests must pass with a maximum dimension of about 20 | 377 | -- | All tests must pass with a maximum dimension of about 20 |
370 | -- (some tests may fail with bigger sizes due to precision loss). | 378 | -- (some tests may fail with bigger sizes due to precision loss). |
@@ -533,6 +541,7 @@ runTests n = do | |||
533 | , sumprodTest | 541 | , sumprodTest |
534 | , chainTest | 542 | , chainTest |
535 | , succTest | 543 | , succTest |
544 | , findAssocTest | ||
536 | ] | 545 | ] |
537 | return () | 546 | return () |
538 | 547 | ||