Test.hs

-- | Clustering Tests
module Bio.Clustering.Test where

import Bio.Util.TestBase
import Bio.Clustering
import Data.List (nub,sort)

tests :: [Test]
--           .........o.........o.........o
tests = [ T "retains elements"              prop_retains
        , T "hierarchy w/sorted"            prop_hierarchy
        , T "triangle ineq"                 prop_triangle
        ]

-- | Check that all elements from pairs are in the clustering
prop_retains :: [(Double,Int,Int)] -> Bool
prop_retains xs = clusterElements (cluster_sl xs) == listElements xs
    where listElements = nub . sort . concatMap (\(_,x,y)->[x,y])
          clusterElements = nub . sort . concatMap cE
          cE (Branch _ left right) = cE left ++ cE right
          cE (Leaf a) = [a]

-- | Check that the order of branches is correct, as long as the order of
--   input pairs are sorted.          
prop_hierarchy :: [Int] -> [Int] -> Bool
prop_hierarchy xs ys = let ts = zip3 [(1::Double)..] xs ys
                           cs = cluster_sl ts 
                           isSorted (Leaf _) = True
                           isSorted (Branch s left right) = 
                               lessThan s left && lessThan s right &&
                                        isSorted left && isSorted right
                           lessThan x (Branch y _ _) = x >= y
                           lessThan _ (Leaf _) = True
                       in all isSorted cs

prop_triangle :: [(Double,Int,Int)] -> [(Double,Int,Int)] -> Bool
prop_triangle xs ys = length (cluster_sl (xs ++ ys))
                      <= length (cluster_sl xs) + length (cluster_sl ys)