diff options
Diffstat (limited to 'lib/Numeric/LinearAlgebra/Tests.hs')
-rw-r--r-- | lib/Numeric/LinearAlgebra/Tests.hs | 17 |
1 files changed, 13 insertions, 4 deletions
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 | ||