som 10.1.5 → 10.1.6
raw patch · 9 files changed
+8/−1288 lines, 9 files
Files
- ChangeLog.md +1/−1
- som.cabal +2/−8
- src/Data/Datamining/Clustering/SGM2.hs +0/−70
- src/Data/Datamining/Clustering/SGM2Internal.hs +0/−324
- src/Data/Datamining/Clustering/SGM3.hs +0/−70
- src/Data/Datamining/Clustering/SGM3Internal.hs +0/−343
- test/Data/Datamining/Clustering/SGM2QC.hs +0/−220
- test/Data/Datamining/Clustering/SGM3QC.hs +0/−241
- test/Spec.hs +5/−11
ChangeLog.md view
@@ -1,6 +1,6 @@ # Changelog for som -+10.1.6 Removed SGM2 and SGM3; they aren't ready for use. 10.1.5 Bug fix in SGM3. 10.1.4 Modified SGM3 to work with limited range floating point types. 10.1.3 Added SGM3.
som.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ed692aa37706e47ed881b4ea21769be3add5357c26ac89e9d5408c65a03158c2+-- hash: a1c7e199c3b4a41a8be19860537f59c1300e6b50b3b4829d87755dadf2ce7017 name: som-version: 10.1.5+version: 10.1.6 synopsis: Self-Organising Maps description: Please see the README on GitHub at <https://github.com/mhwombat/som#readme> category: Math@@ -32,10 +32,6 @@ Data.Datamining.Clustering.DSOM Data.Datamining.Clustering.DSOMInternal Data.Datamining.Clustering.SGM- Data.Datamining.Clustering.SGM2- Data.Datamining.Clustering.SGM2Internal- Data.Datamining.Clustering.SGM3- Data.Datamining.Clustering.SGM3Internal Data.Datamining.Clustering.SGMInternal Data.Datamining.Clustering.SOM Data.Datamining.Clustering.SOMInternal@@ -57,8 +53,6 @@ main-is: Spec.hs other-modules: Data.Datamining.Clustering.DSOMQC- Data.Datamining.Clustering.SGM2QC- Data.Datamining.Clustering.SGM3QC Data.Datamining.Clustering.SGMQC Data.Datamining.Clustering.SOMQC Data.Datamining.PatternQC
− src/Data/Datamining/Clustering/SGM2.hs
@@ -1,70 +0,0 @@---------------------------------------------------------------------------- |--- Module : Data.Datamining.Clustering.SGM2--- 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
@@ -1,324 +0,0 @@---------------------------------------------------------------------------- |--- Module : Data.Datamining.Clustering.SGM2Internal--- 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 DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}--module Data.Datamining.Clustering.SGM2Internal where--import Prelude hiding (lookup)--import Control.DeepSeq (NFData)-import Data.List (foldl', minimumBy, sortBy, (\\))-import qualified Data.Map.Strict as M-import Data.Ord (comparing)-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---- | Increments the counter.-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)---- | Set the model for a node.--- Useful when merging two models and replacing one.-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---- | Add a new node, making room for it by merging two existing nodes.-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---- | Order models by ascending difference from the input pattern,--- then by creation order (label number).-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---- | Internal method.--- 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---- | Internal method.-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' (addNode 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-
− src/Data/Datamining/Clustering/SGM3.hs
@@ -1,70 +0,0 @@---------------------------------------------------------------------------- |--- Module : Data.Datamining.Clustering.SGM3--- 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.SGM3- (- -- * Construction- SGM(..),- makeSGM,- -- * Deconstruction- time,- isEmpty,- size,- modelMap,- counterMap,- modelAt,- -- * Learning and classification- exponential,- classify,- trainAndClassify,- train,- trainBatch- ) where--import Data.Datamining.Clustering.SGM3Internal-
− src/Data/Datamining/Clustering/SGM3Internal.hs
@@ -1,343 +0,0 @@---------------------------------------------------------------------------- |--- Module : Data.Datamining.Clustering.SGM3Internal--- 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 DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}--module Data.Datamining.Clustering.SGM3Internal where--import Prelude hiding- (lookup)--import Control.DeepSeq- (NFData)-import Data.List- (foldl', minimumBy, sortBy, (\\))-import qualified Data.Map.Strict as M-import Data.Ord- (comparing)-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---- | Increments the match counter.-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---- | Returns the labels of the two most similar models, and the--- difference between them.-meanModelDiff- :: (Fractional x, Real x, Num x, Ord x, Eq k, Ord k)- => SGM t x k p -> x-meanModelDiff s- | size s == 0 = 0- | otherwise = fromRational . mean . map (toRational . snd)- $ modelDiffs s---- | Calculate the mean of a set of values.--- mean :: (Eq a, Fractional a, Foldable t) => t a -> a-mean :: (Fractional a, Eq a) => [a] -> a-mean xs- | count == 0 = error "no data"- | otherwise = total / count- where (total, count) = foldr f (0, 0) xs- f x (y, n) = (y+x, n+1)---- | 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)---- | Set the model for a node.--- Useful when merging two models and replacing one.-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---- | Adds a new node, making room for it by merging two existing nodes.-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---- | Order models by ascending difference from the input pattern,--- then by creation order (label number).-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, Fractional x, Real x, 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 = (bmu, bmuDiff, report, s2)- | size s < 2 = addModelTrainAndClassify s p- | bmuDiff > diffThreshold = addModelTrainAndClassify s p- | bmuDiff > cutoff = (bmu4, bmuDiff, report4, s4)- | otherwise = (bmu, bmuDiff, report, s2)- where diffThreshold = meanModelDiff s- (bmu, bmuDiff, report, s2) = trainAndClassify' s p- (k1, k2, cutoff) = twoMostSimilar s- s3 = mergeAddModel s k1 k2 p- (bmu4, _, report4, s4) = trainAndClassify' s3 p---- | Internal method.--- 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---- | Internal method.-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' (addNode 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, Fractional x, Real x, 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, Fractional x, Real x, 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
@@ -1,220 +0,0 @@---------------------------------------------------------------------------- |--- Module : Data.Datamining.Clustering.SGM2QC--- Copyright : (c) Amy de Buitléir 2012-2018--- License : BSD-style--- Maintainer : amy@nualeargais.ie--- Stability : experimental--- Portability : portable------ Tests-----------------------------------------------------------------------------{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-}--module Data.Datamining.Clustering.SGM2QC- (- test- ) where--import Control.DeepSeq (deepseq)-import Data.Datamining.Clustering.SGM2Internal-import Data.Datamining.Pattern (absDifference,- adjustNum)-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 (Arbitrary, Gen,- Positive, Property,- arbitrary, choose,- getPositive, property,- shrink, sized,- suchThat, vectorOf,- (==>))--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/Data/Datamining/Clustering/SGM3QC.hs
@@ -1,241 +0,0 @@---------------------------------------------------------------------------- |--- Module : Data.Datamining.Clustering.SGM3QC--- Copyright : (c) Amy de Buitléir 2012-2018--- License : BSD-style--- Maintainer : amy@nualeargais.ie--- Stability : experimental--- Portability : portable------ Tests-----------------------------------------------------------------------------{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-}--module Data.Datamining.Clustering.SGM3QC- (- test- ) where--import Control.DeepSeq- (deepseq)-import Data.Datamining.Clustering.SGM2Internal-import Data.Datamining.Pattern- (absDifference, adjustNum)-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- ( Arbitrary- , Gen- , Positive- , Property- , arbitrary- , choose- , getPositive- , property- , shrink- , sized- , suchThat- , vectorOf- , (==>)- )--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 (classify s p) True--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_never_causes_error :: TestSGM -> Double -> Property-prop_train_never_causes_error (TestSGM s _) p- = property $ deepseq (train s p) True--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_never_causes_error"- prop_train_never_causes_error,- 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
@@ -10,28 +10,22 @@ -- Tests -- -------------------------------------------------------------------------import Data.Datamining.Clustering.DSOMQC- (test)-import Data.Datamining.Clustering.SGM2QC- (test)-import Data.Datamining.Clustering.SGM3QC+import Data.Datamining.Clustering.DSOMQC (test)-import Data.Datamining.Clustering.SGMQC+import Data.Datamining.Clustering.SGMQC (test)-import Data.Datamining.Clustering.SOMQC+import Data.Datamining.Clustering.SOMQC (test)-import Data.Datamining.PatternQC+import Data.Datamining.PatternQC (test) -import Test.Framework as TF+import Test.Framework as TF (Test, defaultMain) tests :: [TF.Test] tests = [ Data.Datamining.PatternQC.test,- Data.Datamining.Clustering.SGM3QC.test,- Data.Datamining.Clustering.SGM2QC.test, Data.Datamining.Clustering.SGMQC.test, Data.Datamining.Clustering.SOMQC.test, Data.Datamining.Clustering.DSOMQC.test