diff --git a/som.cabal b/som.cabal
--- a/som.cabal
+++ b/som.cabal
@@ -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
diff --git a/src/Data/Datamining/Clustering/SGM2.hs b/src/Data/Datamining/Clustering/SGM2.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Datamining/Clustering/SGM2.hs
@@ -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
+
diff --git a/src/Data/Datamining/Clustering/SGM2Internal.hs b/src/Data/Datamining/Clustering/SGM2Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Datamining/Clustering/SGM2Internal.hs
@@ -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
+
diff --git a/test/Data/Datamining/Clustering/SGM2QC.hs b/test/Data/Datamining/Clustering/SGM2QC.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Datamining/Clustering/SGM2QC.hs
@@ -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
+  ]
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -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