From 853b46c522fa48a2c476fbfd0771a0da7aa9efc0 Mon Sep 17 00:00:00 2001
From: Alberto Ruiz <aruiz@um.es>
Date: Tue, 28 Dec 2010 12:30:18 +0000
Subject: step, find, assoc

---
 lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c | 20 ++++++++++++++++++++
 lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.h |  3 +++
 lib/Numeric/LinearAlgebra/Tests.hs            | 17 +++++++++++++----
 3 files changed, 36 insertions(+), 4 deletions(-)

(limited to 'lib/Numeric/LinearAlgebra')

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)) {
     OK
 }
 
+//////////////////// step /////////////////////////
+
+int stepF(FVEC(x),FVEC(y)) {
+    DEBUGMSG("stepF")
+    int k;
+    for(k=0;k<xn;k++) {
+        yp[k]=xp[k]>0;
+    }
+    OK
+}
+
+int stepD(DVEC(x),DVEC(y)) {
+    DEBUGMSG("stepD")
+    int k;
+    for(k=0;k<xn;k++) {
+        yp[k]=xp[k]>0;
+    }
+    OK
+}
+
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));
 int conjugateQ(KQVEC(x),QVEC(t));
 int conjugateC(KCVEC(x),CVEC(t));
 
+int stepF(FVEC(x),FVEC(y));
+int stepD(DVEC(x),DVEC(y));
+
 int svd_l_R(KDMAT(x),DMAT(u),DVEC(s),DMAT(v));
 int svd_l_Rdd(KDMAT(x),DMAT(u),DVEC(s),DMAT(v));
 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
 
 -- | apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs
 --successive_ :: Storable a => (a -> a -> Bool) -> Vector a -> Bool
-successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ step (subVector 1 (dim v - 1) v))) (v @> 0)
-   where step e = do
+successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ stp (subVector 1 (dim v - 1) v))) (v @> 0)
+   where stp e  = do
                   ep <- lift_maybe $ state_get
                   if t e ep
                      then lift_maybe $ state_put e
@@ -351,8 +351,8 @@ successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ s
 
 -- | operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input
 --successive :: (Storable a, Storable b) => (a -> a -> b) -> Vector a -> Vector b
-successive f v = evalState (mapVectorM step (subVector 1 (dim v - 1) v)) (v @> 0)
-   where step e = do
+successive f v = evalState (mapVectorM stp (subVector 1 (dim v - 1) v)) (v @> 0)
+   where stp  e = do
                   ep <- state_get
                   state_put e
                   return $ f ep e
@@ -365,6 +365,14 @@ succTest = utest "successive" $
 
 ---------------------------------------------------------------------
 
+findAssocTest = utest "findAssoc" ok
+  where
+    ok = m1 == m2
+    m1 = assoc (6,6) 7 $ zip (find (>0) (ident 5 :: Matrix Float)) [10 ..] :: Matrix Double
+    m2 = diagRect 7 (fromList[10..14]) 6 6 :: Matrix Double
+
+---------------------------------------------------------------------
+
 
 -- | All tests must pass with a maximum dimension of about 20
 --  (some tests may fail with bigger sizes due to precision loss).
@@ -533,6 +541,7 @@ runTests n = do
         , sumprodTest
         , chainTest
         , succTest
+        , findAssocTest
         ]
     return ()
 
-- 
cgit v1.2.3