1 -- | Clustering Tests
    2 module Bio.Clustering.Test where
    3 
    4 import Bio.Util.TestBase
    5 import Bio.Clustering
    6 import Data.List (nub,sort)
    7 
    8 tests :: [Test]
    9 --           .........o.........o.........o
   10 tests = [ T "retains elements"              prop_retains
   11         , T "hierarchy w/sorted"            prop_hierarchy
   12         , T "triangle ineq"                 prop_triangle
   13         ]
   14 
   15 -- | Check that all elements from pairs are in the clustering
   16 prop_retains :: [(Double,Int,Int)] -> Bool
   17 prop_retains xs = clusterElements (cluster_sl xs) == listElements xs
   18     where listElements = nub . sort . concatMap (\(_,x,y)->[x,y])
   19           clusterElements = nub . sort . concatMap cE
   20           cE (Branch _ left right) = cE left ++ cE right
   21           cE (Leaf a) = [a]
   22 
   23 -- | Check that the order of branches is correct, as long as the order of
   24 --   input pairs are sorted.          
   25 prop_hierarchy :: [Int] -> [Int] -> Bool
   26 prop_hierarchy xs ys = let ts = zip3 [(1::Double)..] xs ys
   27                            cs = cluster_sl ts 
   28                            isSorted (Leaf _) = True
   29                            isSorted (Branch s left right) = 
   30                                lessThan s left && lessThan s right &&
   31                                         isSorted left && isSorted right
   32                            lessThan x (Branch y _ _) = x >= y
   33                            lessThan _ (Leaf _) = True
   34                        in all isSorted cs
   35 
   36 prop_triangle :: [(Double,Int,Int)] -> [(Double,Int,Int)] -> Bool
   37 prop_triangle xs ys = length (cluster_sl (xs ++ ys))
   38                       <= length (cluster_sl xs) + length (cluster_sl ys)