packages feed

som 10.0.1 → 10.1.0

raw patch · 5 files changed

+607/−5 lines, 5 files

Files

som.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d1d8fdf12fb32719c2cfe79540840cc8335acba19f3624ec8df3965e57eb27e6+-- hash: 4a51f13415d0fcbda9b5fbf306f56b17839c4b559ff620f78bc562de163dc9c4  name:           som-version:        10.0.1+version:        10.1.0 synopsis:       Self-Organising Maps description:    Please see the README on GitHub at <https://github.com/mhwombat/som#readme> category:       Math@@ -13,7 +13,7 @@ bug-reports:    https://github.com/mhwombat/som/issues author:         Amy de Buitléir maintainer:     amy@nualeargais.ie-copyright:      2018 Amy de Buitléir+copyright:      2012-2018 Amy de Buitléir license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -32,6 +32,8 @@       Data.Datamining.Clustering.DSOM       Data.Datamining.Clustering.DSOMInternal       Data.Datamining.Clustering.SGM+      Data.Datamining.Clustering.SGM2+      Data.Datamining.Clustering.SGM2Internal       Data.Datamining.Clustering.SGMInternal       Data.Datamining.Clustering.SOM       Data.Datamining.Clustering.SOMInternal@@ -53,6 +55,7 @@   main-is: Spec.hs   other-modules:       Data.Datamining.Clustering.DSOMQC+      Data.Datamining.Clustering.SGM2QC       Data.Datamining.Clustering.SGMQC       Data.Datamining.Clustering.SOMQC       Data.Datamining.PatternQC
+ src/Data/Datamining/Clustering/SGM2.hs view
@@ -0,0 +1,70 @@+------------------------------------------------------------------------+-- |+-- Module      :  Data.Datamining.Clustering.SGM+-- Copyright   :  (c) Amy de Buitléir 2012-2018+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A Self-generating Model (SGM). An SGM maps input patterns+-- onto a set, where each element in the set is a model of the input+-- data. An SGM is like a Kohonen Self-organising Map (SOM), except:+--+-- * Instead of a grid, it uses a simple set of unconnected models.+--   Since the models are unconnected, only the model that best matches+--   the input is ever updated. This makes it faster, however,+--   topological relationships within the input data are not preserved.+-- * New models are created on-the-fly when no existing model is+--   similar enough to an input pattern. If the SGM is at capacity,+--   the least useful model will be deleted.+--+-- This implementation supports the use of non-numeric patterns.+--+-- In layman's terms, a SGM can be useful when you you want to build+-- a set of models on some data. A tutorial is available at+-- <https://github.com/mhwombat/som/wiki>.+--+-- References:+--+-- * Amy de Buitléir, Mark Daly, and Michael Russell.+--   The Self-generating Model: an Adaptation of the Self-organizing Map+--   for Intelligent Agents and Data Mining.+--   In: Artificial Life and Intelligent Agents: Second International+--   Symposium, ALIA 2016, Birmingham, UK, June 14-15, 2016,+--   Revised Selected Papers.+--   Ed. by Peter R. Lewis et al. Springer International Publishing,+--   2018, pp. 59–72.+--   Available at http://amydebuitleir.eu/publications/.+--+-- * Amy de Buitléir, Michael Russell, and Mark Daly.+--   Wains: A pattern-seeking artificial life species.+--   Artificial Life, (18)4:399–423, 2012.+--   Available at http://amydebuitleir.eu/publications/.+--+-- * Kohonen, T. (1982). Self-organized formation of topologically+--   correct feature maps. Biological Cybernetics, 43 (1), 59–69.+------------------------------------------------------------------------++module Data.Datamining.Clustering.SGM2+  (+    -- * Construction+    SGM(..),+    makeSGM,+    -- * Deconstruction+    time,+    isEmpty,+    size,+    modelMap,+    counterMap,+    modelAt,+    -- * Learning and classification+    exponential,+    classify,+    trainAndClassify,+    train,+    trainBatch+  ) where++import Data.Datamining.Clustering.SGM2Internal+
+ src/Data/Datamining/Clustering/SGM2Internal.hs view
@@ -0,0 +1,314 @@+------------------------------------------------------------------------+-- |+-- Module      :  Data.Datamining.Clustering.SGMInternal+-- Copyright   :  (c) Amy de Buitléir 2012-2018+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A module containing private @SGM@ internals. Most developers should+-- use @SGM@ instead. This module is subject to change without notice.+--+------------------------------------------------------------------------+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,+    MultiParamTypeClasses, DeriveAnyClass, DeriveGeneric #-}++module Data.Datamining.Clustering.SGM2Internal where++import Prelude hiding (lookup)++import Control.DeepSeq (NFData)+import Data.List ((\\), minimumBy, sortBy, foldl')+import Data.Ord (comparing)+import qualified Data.Map.Strict as M+import GHC.Generics (Generic)++-- | A typical learning function for classifiers.+--   @'exponential' r0 d t@ returns the learning rate at time @t@.+--   When @t = 0@, the learning rate is @r0@.+--   Over time the learning rate decays exponentially; the decay rate is+--   @d@.+--   Normally the parameters are chosen such that:+--+--   * 0 < r0 < 1+--+--   * 0 < d+exponential :: (Floating a, Integral t) => a -> a -> t -> a+exponential r0 d t = r0 * exp (-d*t')+  where t' = fromIntegral t++-- | A Simplified Self-Organising Map (SGM).+--   @t@ is the type of the counter.+--   @x@ is the type of the learning rate and the difference metric.+--   @k@ is the type of the model indices.+--   @p@ is the type of the input patterns and models.+data SGM t x k p = SGM+  {+    -- | Maps patterns and match counts to nodes.+    toMap :: M.Map k (p, t),+    -- | A function which determines the learning rate for a node.+    --   The input parameter indicates how many patterns (or pattern+    --   batches) have previously been presented to the classifier.+    --   Typically this is used to make the learning rate decay over+    --   time.+    --   The output is the learning rate for that node (the amount by+    --   which the node's model should be updated to match the target).+    --   The learning rate should be between zero and one.+    learningRate :: t -> x,+    -- | The maximum number of models this SGM can hold.+    capacity :: Int,+    -- | A function which compares two patterns and returns a+    --   /non-negative/ number representing how different the patterns+    --   are.+    --   A result of @0@ indicates that the patterns are identical.+    difference :: p -> p -> x,+    -- | A function which updates models.+    --   For example, if this function is @f@, then+    --   @f target amount pattern@ returns a modified copy of @pattern@+    --   that is more similar to @target@ than @pattern@ is.+    --   The magnitude of the adjustment is controlled by the @amount@+    --   parameter, which should be a number between 0 and 1.+    --   Larger values for @amount@ permit greater adjustments.+    --   If @amount@=1, the result should be identical to the @target@.+    --   If @amount@=0, the result should be the unmodified @pattern@.+    makeSimilar :: p -> x -> p -> p,+    -- | Index for the next node to add to the SGM.+    nextIndex :: k+  } deriving (Generic, NFData)++-- @'makeSGM' lr n diff ms@ creates a new SGM that does not (yet)+-- contain any models.+-- It will learn at the rate determined by the learning function @lr@,+-- and will be able to hold up to @n@ models.+-- It will create a new model based on a pattern presented to it when+-- the SGM is not at capacity, or a less useful model can be replaced.+-- It will use the function @diff@ to measure the similarity between+-- an input pattern and a model.+-- It will use the function @ms@ to adjust models as needed to make+-- them more similar to input patterns.+makeSGM+  :: Bounded k+    => (t -> x) -> Int -> (p -> p -> x) -> (p -> x -> p -> p) -> SGM t x k p+makeSGM lr n diff ms =+  if n <= 0+    then error "max size for SGM <= 0"+    else SGM M.empty lr n diff ms minBound++-- | Returns true if the SGM has no models, false otherwise.+isEmpty :: SGM t x k p -> Bool+isEmpty = M.null . toMap++-- | Returns the number of models the SGM currently contains.+size :: SGM t x k p -> Int+size = M.size . toMap++-- | Returns a map from node ID to model.+modelMap :: SGM t x k p -> M.Map k p+modelMap = M.map fst . toMap++-- | Returns a map from node ID to counter (number of times the+--   node's model has been the closest match to an input pattern).+counterMap :: SGM t x k p -> M.Map k t+counterMap = M.map snd . toMap++-- | Returns the model at a specified node.+modelAt :: Ord k => SGM t x k p -> k -> p+modelAt s k = (modelMap s) M.! k++-- | Returns the match counter for a specified node.+counterAt :: Ord k => SGM t x k p -> k -> t+counterAt s k = (counterMap s) M.! k++-- | Returns the current labels.+labels :: SGM t x k p -> [k]+labels = M.keys . toMap++-- -- | Returns the current models.+-- models :: SGM t x k p -> [p]+-- models = map fst . M.elems . toMap++-- -- | Returns the current counters (number of times the+-- --   node's model has been the closest match to an input pattern).+-- counters :: SGM t x k p -> [t]+-- counters = map snd . M.elems . toMap++-- | The current "time" (number of times the SGM has been trained).+time :: Num t => SGM t x k p -> t+time = sum . map snd . M.elems . toMap++-- | Adds a new node to the SGM.+addNode+  :: (Num t, Enum k, Ord k)+    => p -> SGM t x k p -> SGM t x k p+addNode p s = if size s >= capacity s+                then error "SGM is full"+                else s { toMap=gm', nextIndex=succ k }+  where gm = toMap s+        k = nextIndex s+        gm' = M.insert k (p, 0) gm++incrementCounter :: (Num t, Ord k) => k -> SGM t x k p -> SGM t x k p+incrementCounter k s = s { toMap=gm' }+  where gm = toMap s+        gm' = if M.member k gm+                then M.adjust inc k gm+                else error "no such node"+        inc (p, t) = (p, t+1)++-- | Trains the specified node to better match a target.+--   Most users should use @'train'@, which automatically determines+--   the BMU and trains it.+trainNode+  :: (Num t, Ord k)+    => SGM t x k p -> k -> p -> SGM t x k p+trainNode s k target = s { toMap=gm' }+  where gm = toMap s+        gm' = M.adjust tweakModel k gm+        r = (learningRate s) (time s)+        tweakModel (p, t) = (makeSimilar s target r p, t)++-- | Calculates the difference between all pairs of non-identical+--   labels in the SGM.+modelDiffs :: (Eq k, Ord k) => SGM t x k p -> [((k, k), x)]+modelDiffs s = map f $ labelPairs s+  where f (k, k') = ( (k, k'),+                      difference s (s `modelAt` k) (s `modelAt` k') )++-- | Generates all pairs of non-identical labels in the SGM.+labelPairs :: Eq k => SGM t x k p -> [(k, k)]+labelPairs s = concatMap (labelPairs' s) $ labels s++-- | Pairs a node label with all labels except itself.+labelPairs' :: Eq k => SGM t x k p -> k -> [(k, k)]+labelPairs' s k = map (\k' -> (k, k')) $ labels s \\ [k]++-- | Returns the labels of the two most similar models, and the+--   difference between them.+twoMostSimilar :: (Ord x, Eq k, Ord k) => SGM t x k p -> (k, k, x)+twoMostSimilar s+  | size s < 2 = error "there aren't two models to merge"+  | otherwise = (k, k', d)+  where ((k, k'), d) = minimumBy (comparing snd) $ modelDiffs s++-- | Deletes the least used (least matched) model in a pair,+--   and returns its label (now available) and the updated SGM.+--   TODO: Modify the other model to make it slightly more similar to+--   the one that was deleted?+mergeModels :: (Num t, Ord t, Ord k) => SGM t x k p -> k -> k -> (k, SGM t x k p)+mergeModels s k1 k2+  | not (M.member k1 gm) = error "no such node 1"+  | not (M.member k2 gm) = error "no such node 2"+  | otherwise          = (k, s { toMap = gm' })+  where c1 = s `counterAt` k1+        c2 = s `counterAt` k2+        k = if c1 >= c2+              then k1+              else k2+        gm = toMap s+        gm' = M.adjust f k $ M.delete k gm+        f (p, _) = (p, c1 + c2)++setModel :: (Num t, Ord k) => SGM t x k p -> k -> p -> SGM t x k p+setModel s k p+  | M.member k gm = error "node already exists"+  | otherwise     = s { toMap = gm' }+  where gm = toMap s+        gm' = M.insert k (p, 0) gm++addModel+  :: (Num t, Ord t, Enum k, Ord k)+    => p -> SGM t x k p -> SGM t x k p+addModel p s+  | size s >= capacity s = error "SGM at capacity"+  | otherwise           = addNode p s++mergeAddModel+  :: (Num t, Ord t, Ord k) => SGM t x k p -> k -> k -> p -> SGM t x k p+mergeAddModel s k1 k2 p = s3+  where (k3, s2) = mergeModels s k1 k2+        s3 = setModel s2 k3 p++-- | @'classify' s p@ identifies the model @s@ that most closely+--   matches the pattern @p@.+--   It will not make any changes to the classifier.+--   (I.e., it will not change the models or match counts.)+--   Returns the ID of the node with the best matching model,+--   the difference between the best matching model and the pattern,+--   and the SGM labels paired with the model and the difference+--   between the input and the corresponding model.+--   The final paired list is sorted in decreasing order of similarity.+classify+  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)+    => SGM t x k p -> p -> (k, x, M.Map k (p, x))+classify s p+  | isEmpty s = error "SGM has no models"+  | otherwise = (bmu, bmuDiff, report)+  where report+          = M.map (\p0 -> (p0, difference s p p0)) . modelMap $ s+        (bmu, bmuDiff)+          = head . sortBy matchOrder . map (\(k, (_, x)) -> (k, x))+              . M.toList $ report++-- We want the model with the lowest difference from the input pattern.+-- If two models have the same difference, return the model that was+-- created earlier (has the lower label #).+matchOrder :: (Ord a, Ord b) => (a, b) -> (a, b) -> Ordering+matchOrder (a, b) (c, d) = compare (b, a) (d, c)++-- | @'trainAndClassify' s p@ identifies the model in @s@ that most+--   closely matches @p@, and updates it to be a somewhat better match.+--   If necessary, it will create a new node and model.+--   Returns the ID of the node with the best matching model,+--   the difference between the pattern and the best matching model+--   in the original SGM (before training or adding a new model),+--   the differences between the pattern and each model in the updated+--   SGM,+--   and the updated SGM.+trainAndClassify+  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)+    => SGM t x k p -> p -> (k, x, M.Map k (p, x), SGM t x k p)+trainAndClassify s p+  | size s < capacity s = addModelTrainAndClassify s p+  | size s < 2          = (bmu, bmuDiff, report, s2)+  | bmuDiff > cutoff    = (bmu4, bmuDiff, report4, s4)+  | otherwise           = (bmu, bmuDiff, report, s2)+  where (bmu, bmuDiff, report, s2) = trainAndClassify' s p+        (k1, k2, cutoff) = twoMostSimilar s+        s3 = mergeAddModel s k1 k2 p+        (bmu4, _, report4, s4) = trainAndClassify' s3 p++-- NOTE: This function will adjust the model and update the match+-- for the BMU.+trainAndClassify'+  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)+    => SGM t x k p -> p -> (k, x, M.Map k (p, x), SGM t x k p)+trainAndClassify' s p = (bmu2, bmuDiff, report, s3)+  where (bmu, bmuDiff, _) = classify s p+        s2 = incrementCounter bmu s+        s3 = trainNode s2 bmu p+        (bmu2, _, report) = classify s3 p++addModelTrainAndClassify+  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)+    => SGM t x k p -> p -> (k, x, M.Map k (p, x), SGM t x k p)+addModelTrainAndClassify s p = (bmu, 1, report, s')+  where (bmu, _, report, s') = trainAndClassify' (addModel p s) p++-- | @'train' s p@ identifies the model in @s@ that most closely+--   matches @p@, and updates it to be a somewhat better match.+--   If necessary, it will create a new node and model.+train+  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)+    => SGM t x k p -> p -> SGM t x k p+train s p = s'+  where (_, _, _, s') = trainAndClassify s p++-- | For each pattern @p@ in @ps@, @'trainBatch' s ps@ identifies the+--   model in @s@ that most closely matches @p@,+--   and updates it to be a somewhat better match.+trainBatch+  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)+    => SGM t x k p -> [p] -> SGM t x k p+trainBatch = foldl' train+
+ test/Data/Datamining/Clustering/SGM2QC.hs view
@@ -0,0 +1,213 @@+------------------------------------------------------------------------+-- |+-- Module      :  Data.Datamining.Clustering.SGMQC+-- Copyright   :  (c) Amy de Buitléir 2012-2018+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- Tests+--+------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleInstances,+    FlexibleContexts #-}+{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-}++module Data.Datamining.Clustering.SGM2QC+  (+    test+  ) where++import Control.DeepSeq (deepseq)+import Data.Datamining.Pattern (adjustNum, absDifference)+import Data.Datamining.Clustering.SGM2Internal+import Data.List (minimumBy)+import qualified Data.Map.Strict as M+import Data.Ord (comparing)+import Data.Word (Word16)+import System.Random (Random)+import Test.Framework as TF (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck ((==>), Gen, Arbitrary, Property, Positive,+  arbitrary, shrink, choose, property, sized, suchThat, vectorOf,+  getPositive)++newtype UnitInterval a = UnitInterval {getUnitInterval :: a}+ deriving ( Eq, Ord, Show, Read)++instance Functor UnitInterval where+  fmap f (UnitInterval x) = UnitInterval (f x)++instance (Num a, Ord a, Random a, Arbitrary a)+    => Arbitrary (UnitInterval a) where+  arbitrary = fmap UnitInterval $ choose (0,1)+  shrink (UnitInterval x) =+    [ UnitInterval x' | x' <- shrink x, x' >= 0, x' <= 1]++prop_Exponential_starts_at_r0+  :: UnitInterval Double -> Positive Double -> Property+prop_Exponential_starts_at_r0 r0 d+  = property $ abs (exponential r0' d' 0 - r0') < 0.01+  where r0' = getUnitInterval r0+        d' = getPositive d++prop_Exponential_ge_0+  :: UnitInterval Double -> Positive Double -> Positive Int -> Property+prop_Exponential_ge_0 r0 d t = property $ exponential r0' d' t' >= 0+  where r0' = getUnitInterval r0+        d' = getPositive d+        t' = getPositive t++positive :: (Num a, Ord a, Arbitrary a) => Gen a+positive = arbitrary `suchThat` (> 0)++data TestSGM = TestSGM (SGM Int Double Word16 Double) String++instance Show TestSGM where+  show (TestSGM _ desc) = desc++buildTestSGM+  :: Double -> Double -> Int -> [Double] -> TestSGM+buildTestSGM r0 d maxSz ps = TestSGM s' desc+  where lrf = exponential r0 d+        s = makeSGM lrf maxSz absDifference adjustNum+        desc = "buildTestSGM " ++ show r0 ++ " " ++ show d+                 ++ " " ++ show maxSz+                 ++ " " ++ show ps+        s' = trainBatch s ps++sizedTestSGM :: Int -> Gen TestSGM+sizedTestSGM n = do+  maxSz <- choose (1, min (n+1) 1023)+  let numPatterns = n+  r0 <- choose (0, 1)+  d <- positive+  ps <- vectorOf numPatterns arbitrary+  return $ buildTestSGM r0 d maxSz ps++instance Arbitrary TestSGM where+  arbitrary = sized sizedTestSGM++prop_classify_chooses_best_fit :: TestSGM -> Double -> Property+prop_classify_chooses_best_fit (TestSGM s _) x+  = not (isEmpty s) ==> property $ bmu == bmu2+  where (bmu, _, report) = classify s x+        bmu2 = fst (minimumBy (comparing f) . M.toList $ report)+        f (_, (_, d)) = d++prop_trainAndClassify_chooses_best_fit :: TestSGM -> Double -> Property+prop_trainAndClassify_chooses_best_fit (TestSGM s _) x+  = property $ bmu == bmu2+  where (bmu, _, report, _) = trainAndClassify s x+        bmu2 = fst (minimumBy (comparing f) . M.toList $ report)+        f (_, (_, d)) = d++prop_classify_never_creates_model :: TestSGM -> Double -> Property+prop_classify_never_creates_model (TestSGM s _) x+  = not (isEmpty s) ==> bmu `elem` (labels s)+  where (bmu, _, _) = classify s x++prop_classify_never_causes_error_unless_som_empty+  :: TestSGM -> Double -> Property+prop_classify_never_causes_error_unless_som_empty (TestSGM s _) p+  = not (isEmpty s) ==> property $ deepseq x True+  where x = classify s p++prop_trainNode_reduces_diff :: TestSGM -> Double -> Property+prop_trainNode_reduces_diff (TestSGM s _) x = not (isEmpty s) ==>+  diffAfter < diffBefore || diffBefore == 0+                         || learningRate s (time s) < 1e-10+  where (bmu, diffBefore, _) = classify s x+        s2 = trainNode s bmu x+        (_, diffAfter, _) = classify s2 x++prop_training_reduces_diff :: TestSGM -> Double -> Property+prop_training_reduces_diff (TestSGM s _) x = not (isEmpty s) ==>+  diffAfter < diffBefore || diffBefore == 0+                         || learningRate s (time s) < 1e-10+  where (_, diffBefore, _) = classify s x+        s2 = train s x+        (_, diffAfter, _) = classify s2 x++-- TODO prop: map will never exceed capacity++prop_train_only_modifies_one_model+  :: TestSGM -> Double -> Property+prop_train_only_modifies_one_model (TestSGM s _) p+  = size s < capacity s ==> otherModelsBefore == otherModelsAfter+    where (bmu, _, _, s2) = trainAndClassify s p+          otherModelsBefore = M.delete bmu . M.map fst . toMap $ s+          otherModelsAfter = M.delete bmu . M.map fst . toMap $ s2++prop_train_increments_counter :: TestSGM -> Double -> Property+prop_train_increments_counter (TestSGM s _) x+  = size s < capacity s ==> countAfter == countBefore + 1+  -- We have to check if the SGM is full, otherwise we'll replace an+  -- existing model (and its counter), which means that the total+  -- count could change by an arbitrary amount.+  where countBefore = time s+        countAfter = time $ train s x++-- | The training set consists of the same vectors in the same order,+--   several times over. So the resulting classifications should consist+--   of the same integers in the same order, over and over.+prop_batch_training_works :: TestSGM -> [Double] -> Property+prop_batch_training_works (TestSGM s _) ps+  -- = capacity s > length ps+  --   ==> classifications == (concat . replicate 5) firstSet+  = property $ classifications == (concat . replicate 5) firstSet+  where trainingSet = (concat . replicate 5) ps+        sRightSize = if capacity s >= length ps+          then s+          else s { capacity=length ps + 1}+        s' = trainBatch sRightSize trainingSet+        classifications = map (justBMU . classify s') trainingSet+        justBMU = \(bmu, _, _) -> bmu+        firstSet = take (length ps) classifications++-- | WARNING: This can fail when two nodes are close enough in+--   value so that after training they become identical.+prop_classification_is_consistent :: TestSGM -> Double -> Property+prop_classification_is_consistent (TestSGM s _) x+  = property $ bmu == bmu'+  where (bmu, _, _, s2) = trainAndClassify s x+        (bmu', _, _) = classify s2 x++prop_classification_stabilises :: TestSGM -> [Double] -> Property+prop_classification_stabilises (TestSGM s _)  ps+  = (not . null $ ps) && capacity s > length ps ==> k2 == k1+  where sStable = trainBatch s . concat . replicate 10 $ ps+        (k1, _, _, sStable2) = trainAndClassify sStable (head ps)+        sStable3 = trainBatch sStable2 ps+        (k2, _, _) = classify sStable3 (head ps)++test :: Test+test = testGroup "QuickCheck Data.Datamining.Clustering.SGM2"+  [+    testProperty "prop_Exponential_starts_at_r0"+      prop_Exponential_starts_at_r0,+    testProperty "prop_Exponential_ge_0"+      prop_Exponential_ge_0,+    testProperty "prop_classify_chooses_best_fit"+      prop_classify_chooses_best_fit,+    testProperty "prop_trainAndClassify_chooses_best_fit"+      prop_trainAndClassify_chooses_best_fit,+    testProperty "prop_classify_never_creates_model"+      prop_classify_never_creates_model,+    testProperty "prop_classify_never_causes_error_unless_som_empty"+      prop_classify_never_causes_error_unless_som_empty,+    testProperty "prop_trainNode_reduces_diff"+      prop_trainNode_reduces_diff,+    testProperty "prop_training_reduces_diff"+      prop_training_reduces_diff,+    testProperty "prop_train_only_modifies_one_model"+      prop_train_only_modifies_one_model,+    testProperty "prop_train_increments_counter"+      prop_train_increments_counter,+    testProperty "prop_batch_training_works" prop_batch_training_works,+    testProperty "prop_classification_is_consistent"+      prop_classification_is_consistent,+    testProperty "prop_classification_stabilises"+      prop_classification_stabilises+  ]
test/Spec.hs view
@@ -13,14 +13,16 @@ import Data.Datamining.PatternQC ( test ) import Data.Datamining.Clustering.SOMQC ( test ) import Data.Datamining.Clustering.SGMQC ( test )+import Data.Datamining.Clustering.SGM2QC ( test ) import Data.Datamining.Clustering.DSOMQC ( test )  import Test.Framework as TF ( defaultMain, Test )  tests :: [TF.Test]-tests = -  [ +tests =+  [     Data.Datamining.PatternQC.test,+    Data.Datamining.Clustering.SGM2QC.test,     Data.Datamining.Clustering.SGMQC.test,     Data.Datamining.Clustering.SOMQC.test,     Data.Datamining.Clustering.DSOMQC.test