diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,32 @@
+# Changelog for som
+
+10.1.11 Simplified nix build config.
+
+10.1.10 Added SGM6.
+
+10.1.9 Added SGM4.
+       Updated copyright year.
+
+10.1.8 Revamped to work with Nix + cabal-install.
+
+10.1.7 Revamped to work with Nix + Stack.
+
+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.
+
+10.1.2 Fixed a warning.
+       Added SGM2.
+
+10.1.1 Fixed a warning.
+       Added more documentation.
+
+10.0.1 Upgraded to Stackage lts-12.16.
+
+10.0.0 Revamped to work with Stack v1.7.1.
+
+## Unreleased changes
diff --git a/ChangeLog.md b/ChangeLog.md
deleted file mode 100644
--- a/ChangeLog.md
+++ /dev/null
@@ -1,25 +0,0 @@
-# Changelog for som
-
-10.1.8 Revamped to work with Nix + cabal-install.
-
-10.1.7 Revamped to work with Nix + Stack.
-
-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.
-
-10.1.2 Fixed a warning.
-       Added SGM2.
-
-10.1.1 Fixed a warning.
-       Added more documentation.
-
-10.0.1 Upgraded to Stackage lts-12.16.
-
-10.0.0 Revamped to work with Stack v1.7.1.
-
-## Unreleased changes
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Amy de Buitléir (c) 2010-2018
+Copyright (c) 2010-2021 Amy de Buitléir
 
 All rights reserved.
 
diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/som.cabal b/som.cabal
--- a/som.cabal
+++ b/som.cabal
@@ -1,63 +1,71 @@
-name:                som
-version:             10.1.8
-synopsis:            Self-Organising Maps
-description:         Please see the README on GitHub at <https://github.com/mhwombat/som#readme>
-homepage:            https://github.com/mhwombat/som#readme
-license:             BSD3
-license-file:        LICENSE
-author:              Amy de Buitléir
-maintainer:          amy@nualeargais.ie
-copyright:           2012-2018 Amy de Buitléir
-category:            Math
-bug-reports:         https://github.com/mhwombat/som/issues
-build-type:          Simple
+cabal-version:      2.4
+name:               som
+version:            10.1.11
+synopsis:           Self-Organising Maps
+description:
+  Please see the README on GitHub at <https://github.com/mhwombat/som#readme>
+homepage:           https://github.com/mhwombat/som
+bug-reports:        https://github.com/mhwombat/som/issues
+license:            BSD-3-Clause
+license-file:       LICENSE
+author:             Amy de Buitléir
+maintainer:         amy@nualeargais.ie
+copyright:          2012-2021 Amy de Buitléir
+category:           Math
 extra-source-files:
-    README.md
-    ChangeLog.md
-cabal-version:       >=1.10
+  CHANGELOG.md
+  README.md
 
+source-repository head
+  type:     git
+  location: https://github.com/mhwombat/som
+
+common common-stuff
+  default-language: Haskell2010
+
 library
+  import:          common-stuff
+  hs-source-dirs:  src
   exposed-modules:
-      Data.Datamining.Clustering.Classifier
-      Data.Datamining.Clustering.DSOM
-      Data.Datamining.Clustering.DSOMInternal
-      Data.Datamining.Clustering.SGM
-      Data.Datamining.Clustering.SGMInternal
-      Data.Datamining.Clustering.SOM
-      Data.Datamining.Clustering.SOMInternal
-      Data.Datamining.Pattern
-  other-modules:
-      Paths_som
-  hs-source-dirs:
-      src
-  ghc-options: -Wall
+    Data.Datamining.Clustering.Classifier
+    Data.Datamining.Clustering.DSOM
+    Data.Datamining.Clustering.DSOMInternal
+    Data.Datamining.Clustering.SGM
+    Data.Datamining.Clustering.SGM4
+    Data.Datamining.Clustering.SGM4Internal
+    Data.Datamining.Clustering.SGMInternal
+    Data.Datamining.Clustering.SOM
+    Data.Datamining.Clustering.SOMInternal
+    Data.Datamining.Pattern
+  other-modules:   Paths_som
+  autogen-modules: Paths_som
+  ghc-options:     -Wall -Wunused-packages
   build-depends:
-      base >=4.7 && <5
-    , containers ==0.5.* || ==0.6.*
-    , deepseq ==1.4.*
-    , grid >=7.8.12 && <7.9
-  default-language: Haskell2010
+    , base        >=4.7    && <5
+    , containers  >=0.5    && <0.7
+    , deepseq     ^>=1.4
+    , grid        ^>=7.8.15
 
 test-suite som-test
-  type: exitcode-stdio-1.0
-  main-is: Spec.hs
+  import:         common-stuff
+  type:           exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is:        Spec.hs
   other-modules:
-      Data.Datamining.Clustering.DSOMQC
-      Data.Datamining.Clustering.SGMQC
-      Data.Datamining.Clustering.SOMQC
-      Data.Datamining.PatternQC
-      Paths_som
-  hs-source-dirs:
-      test
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
+    Data.Datamining.Clustering.DSOMQC
+    Data.Datamining.Clustering.SGM4QC
+    Data.Datamining.Clustering.SGMQC
+    Data.Datamining.Clustering.SOMQC
+    Data.Datamining.PatternQC
+  ghc-options:
+    -threaded -rtsopts -with-rtsopts=-N -Wall -Wunused-packages
   build-depends:
-      QuickCheck
-    , base >=4.6 && <5
+    , base
     , containers
     , deepseq
     , grid
+    , QuickCheck
     , random
     , som
     , test-framework
     , test-framework-quickcheck2
-  default-language: Haskell2010
diff --git a/src/Data/Datamining/Clustering/Classifier.hs b/src/Data/Datamining/Clustering/Classifier.hs
--- a/src/Data/Datamining/Clustering/Classifier.hs
+++ b/src/Data/Datamining/Clustering/Classifier.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.Classifier
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/src/Data/Datamining/Clustering/DSOM.hs b/src/Data/Datamining/Clustering/DSOM.hs
--- a/src/Data/Datamining/Clustering/DSOM.hs
+++ b/src/Data/Datamining/Clustering/DSOM.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.SOM
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/src/Data/Datamining/Clustering/DSOMInternal.hs b/src/Data/Datamining/Clustering/DSOMInternal.hs
--- a/src/Data/Datamining/Clustering/DSOMInternal.hs
+++ b/src/Data/Datamining/Clustering/DSOMInternal.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.DSOMInternal
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/src/Data/Datamining/Clustering/SGM.hs b/src/Data/Datamining/Clustering/SGM.hs
--- a/src/Data/Datamining/Clustering/SGM.hs
+++ b/src/Data/Datamining/Clustering/SGM.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.SGM
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/src/Data/Datamining/Clustering/SGM4.hs b/src/Data/Datamining/Clustering/SGM4.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Datamining/Clustering/SGM4.hs
@@ -0,0 +1,75 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Datamining.Clustering.SGM4
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
+-- 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.SGM4
+  (
+    -- * Construction
+    SGM(..),
+    makeSGM,
+    -- * Deconstruction
+    time,
+    isEmpty,
+    size,
+    modelMap,
+    counterMap,
+    modelAt,
+    -- * Learning and classification
+    exponential,
+    classify,
+    trainAndClassify,
+    train,
+    trainBatch,
+    imprint,
+    imprintBatch,
+    -- * Other
+    filter
+  ) where
+
+import           Data.Datamining.Clustering.SGM4Internal
+import           Prelude                                 hiding (filter)
+
diff --git a/src/Data/Datamining/Clustering/SGM4Internal.hs b/src/Data/Datamining/Clustering/SGM4Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Datamining/Clustering/SGM4Internal.hs
@@ -0,0 +1,358 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Datamining.Clustering.SGM4Internal
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
+-- 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.SGM4Internal where
+
+import           Prelude         hiding (filter, lookup)
+
+import           Control.DeepSeq (NFData)
+import           Data.List       (foldl', minimumBy, sortBy, (\\))
+import qualified Data.Map.Strict as M
+import           Data.Ord        (comparing)
+-- import           Data.Ratio      ((%))
+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 x, Integral t) => x -> x -> t -> x
+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
+
+-- | 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, Bounded k, Enum k, Ord k)
+    => SGM t x k p -> p -> SGM t x k p
+addNode s p = addNodeAt s (nextIndex s) p
+
+addNodeAt
+  :: (Num t, Bounded k, Enum k, Ord k)
+    => SGM t x k p -> k -> p -> SGM t x k p
+addNodeAt s k p
+  | atCapacity s   = error "SGM is full"
+  | s `hasLabel` k = error "label already exists"
+  | otherwise      = s { toMap=gm', nextIndex=kNext }
+  where gm = toMap s
+        gm' = M.insert k (p, 0) gm
+        -- kNext = succ . maximum . M.keys $ gm'
+        allPossibleIndices = enumFromTo minBound maxBound
+        usedIndices = M.keys gm'
+        availableIndices = allPossibleIndices \\ usedIndices
+        kNext = head availableIndices
+
+-- | 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' | M.member k gm = M.adjust inc k gm
+            | otherwise     = 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)
+
+hasLabel :: Ord k => SGM t x k p -> k -> Bool
+hasLabel s k = M.member k . toMap $ s
+
+imprint
+  :: (Num t, Ord t, Fractional x, Num x, Ord x,
+     Bounded k, Enum k, Ord k)
+  => SGM t x k p -> k -> p -> SGM t x k p
+imprint s k p
+  | s `hasLabel` k = trainNode s k p
+  | atCapacity s   = train s p
+  | otherwise      = addNodeAt s k p
+
+imprintBatch
+  :: (Num t, Ord t, Fractional x, Num x, Ord x,
+     Bounded k, Enum k, Ord k)
+  => SGM t x k p -> [(k, p)] -> SGM t x k p
+imprintBatch = foldl' imprintOne
+  where imprintOne s' (k, p) = imprint s' k p
+
+-- | 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', x)
+  where ((k, k'), x) = 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          = (kDelete, s { toMap = gm' })
+  where c1 = s `counterAt` k1
+        c2 = s `counterAt` k2
+        (kKeep, kDelete) | c1 >= c2   = (k1, k2)
+                         | otherwise = (k2, k1)
+        gm = toMap s
+        gm' = M.adjust f kKeep $ M.delete kDelete gm
+        f (p, _) = (p, c1 + c2)
+
+-- | Returns True if the SOM is full; returns False if it can add one
+--   or more models.
+atCapacity :: SGM t x k p -> Bool
+atCapacity s = size s == capacity s
+
+-- | @'consolidate' s@ finds the two most similar models, and combines
+--   them. This can be used to free up more space for learning. It
+--   returns the index of the newly free node, and the updated SGM.
+consolidate :: (Num t, Ord t, Ord x, Ord k) => SGM t x k p -> (k, SGM t x k p)
+consolidate s = (k3, s2)
+  where (k1, k2, _) = twoMostSimilar s
+        (k3, s2) = mergeModels s k1 k2
+
+consolidateAndAdd
+  :: (Num t, Ord t, Ord x, Bounded k, Enum k, Ord k)
+  => SGM t x k p -> p -> SGM t x k p
+consolidateAndAdd s p = addNode s' p
+  where (_, s') = consolidate s
+
+-- | 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
+
+-- | @'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, Num x, Ord x,
+     Bounded k, 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 = trainAndClassify' s' p
+  where s' | size s > 1 && bmuDiff == 0        = s
+           | atCapacity s && capacity s == 1   = s
+           | size s < 2                      = addNode s p
+           | atCapacity s && bmuDiff >= cutoff = consolidateAndAdd s p
+           | atCapacity s                    = s
+           | otherwise                       = addNode s p
+        (_, bmuDiff, _) = classify s p
+        (_, _, cutoff) = twoMostSimilar s
+
+-- | 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
+
+-- | @'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, Num x, Ord x,
+     Bounded k, 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, Num x, Ord x,
+     Bounded k, Enum k, Ord k)
+    => SGM t x k p -> [p] -> SGM t x k p
+trainBatch = foldl' train
+
+-- | Same as @'size'@.
+numModels :: SGM t x k p -> Int
+numModels = size
+
+-- | Same as @'capacity'@.
+maxSize :: SGM t x k p -> Int
+maxSize = capacity
+
+-- | Returns a copy of the SOM containing only models that satisfy the
+--   predicate.
+filter :: (p -> Bool) -> SGM t x k p -> SGM t x k p
+filter f s = s { toMap = pm' }
+  where pm = toMap s
+        pm' = M.filter (\(p, _) -> f p) pm
diff --git a/src/Data/Datamining/Clustering/SGMInternal.hs b/src/Data/Datamining/Clustering/SGMInternal.hs
--- a/src/Data/Datamining/Clustering/SGMInternal.hs
+++ b/src/Data/Datamining/Clustering/SGMInternal.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.SGMInternal
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/src/Data/Datamining/Clustering/SOM.hs b/src/Data/Datamining/Clustering/SOM.hs
--- a/src/Data/Datamining/Clustering/SOM.hs
+++ b/src/Data/Datamining/Clustering/SOM.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.SOM
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/src/Data/Datamining/Clustering/SOMInternal.hs b/src/Data/Datamining/Clustering/SOMInternal.hs
--- a/src/Data/Datamining/Clustering/SOMInternal.hs
+++ b/src/Data/Datamining/Clustering/SOMInternal.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.SOMInternal
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/src/Data/Datamining/Pattern.hs b/src/Data/Datamining/Pattern.hs
--- a/src/Data/Datamining/Pattern.hs
+++ b/src/Data/Datamining/Pattern.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Pattern
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/test/Data/Datamining/Clustering/DSOMQC.hs b/test/Data/Datamining/Clustering/DSOMQC.hs
--- a/test/Data/Datamining/Clustering/DSOMQC.hs
+++ b/test/Data/Datamining/Clustering/DSOMQC.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.DSOMQC
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/test/Data/Datamining/Clustering/SGM4QC.hs b/test/Data/Datamining/Clustering/SGM4QC.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Datamining/Clustering/SGM4QC.hs
@@ -0,0 +1,239 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Datamining.Clustering.SGM4QC
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
+-- 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.SGM4QC
+  (
+    test
+  ) where
+
+import           Control.DeepSeq                         (deepseq)
+import           Data.Datamining.Clustering.SGM4Internal
+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] -> [(Word16, Double)] -> TestSGM
+buildTestSGM r0 d maxSz ps kps = TestSGM s'' desc
+  where lrf = exponential r0 d
+        s = makeSGM lrf maxSz absDifference adjustNum
+        desc = "buildTestSGM " ++ show r0 ++ " " ++ show d
+                 ++ " " ++ show maxSz
+                 ++ " " ++ show ps
+                 ++ " " ++ show kps
+        s' = trainBatch s ps
+        s'' = imprintBatch s' kps
+
+sizedTestSGM :: Int -> Gen TestSGM
+sizedTestSGM n = do
+  maxSz <- choose (1, min (n+1) 1023)
+  numTrainingPatterns <- choose (0, n)
+  let numImprintPatterns = n - numTrainingPatterns
+  r0 <- choose (0, 1)
+  d <- positive
+  ps <- vectorOf numTrainingPatterns arbitrary
+  kps <- vectorOf numImprintPatterns arbitrary
+  return $ buildTestSGM r0 d maxSz ps kps
+
+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_addNode_never_causes_error :: TestSGM -> Double -> Property
+prop_addNode_never_causes_error (TestSGM s _) p
+  = size s < capacity s ==> deepseq (addNode s p) True
+
+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 n) firstSet
+  where trainingSet = (concat . replicate n) ps
+        n = 4
+        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 > 1 + length ps ==> k2 == k1
+  where sStable = trainBatch s . concat . replicate 8 $ ps
+        (k1, _, _, sStable2) = trainAndClassify sStable (head ps)
+        sStable3 = trainBatch sStable2 ps
+        (k2, _, _) = classify sStable3 (head ps)
+
+prop_imprint_never_causes_error :: TestSGM -> Word16 -> Double -> Property
+prop_imprint_never_causes_error (TestSGM s _) k p
+  = property $ deepseq (imprint s k p) True
+
+
+test :: Test
+test = testGroup "QuickCheck Data.Datamining.Clustering.SGM4"
+  [
+    testProperty "prop_Exponential_starts_at_r0"
+      prop_Exponential_starts_at_r0,
+    testProperty "prop_Exponential_ge_0"
+      prop_Exponential_ge_0,
+    testProperty "prop_addNode_never_causes_error"
+      prop_addNode_never_causes_error,
+    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,
+    testProperty "prop_imprint_never_causes_error"
+      prop_imprint_never_causes_error
+  ]
diff --git a/test/Data/Datamining/Clustering/SGMQC.hs b/test/Data/Datamining/Clustering/SGMQC.hs
--- a/test/Data/Datamining/Clustering/SGMQC.hs
+++ b/test/Data/Datamining/Clustering/SGMQC.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.SGMQC
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/test/Data/Datamining/Clustering/SOMQC.hs b/test/Data/Datamining/Clustering/SOMQC.hs
--- a/test/Data/Datamining/Clustering/SOMQC.hs
+++ b/test/Data/Datamining/Clustering/SOMQC.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.Clustering.SOMQC
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/test/Data/Datamining/PatternQC.hs b/test/Data/Datamining/PatternQC.hs
--- a/test/Data/Datamining/PatternQC.hs
+++ b/test/Data/Datamining/PatternQC.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Datamining.PatternQC
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------
 -- |
 -- Module      :  Main
--- Copyright   :  (c) Amy de Buitléir 2012-2018
+-- Copyright   :  (c) 2012-2021 Amy de Buitléir
 -- License     :  BSD-style
 -- Maintainer  :  amy@nualeargais.ie
 -- Stability   :  experimental
@@ -10,23 +10,20 @@
 -- Tests
 --
 ------------------------------------------------------------------------
-import Data.Datamining.Clustering.DSOMQC
-    (test)
-import Data.Datamining.Clustering.SGMQC
-    (test)
-import Data.Datamining.Clustering.SOMQC
-    (test)
-import Data.Datamining.PatternQC
-    (test)
+import           Data.Datamining.Clustering.DSOMQC (test)
+import           Data.Datamining.Clustering.SGM4QC (test)
+import           Data.Datamining.Clustering.SGMQC  (test)
+import           Data.Datamining.Clustering.SOMQC  (test)
+import           Data.Datamining.PatternQC         (test)
 
-import Test.Framework                    as TF
-    (Test, defaultMain)
+import           Test.Framework                    as TF (Test, defaultMain)
 
 tests :: [TF.Test]
 tests =
   [
     Data.Datamining.PatternQC.test,
     Data.Datamining.Clustering.SGMQC.test,
+    Data.Datamining.Clustering.SGM4QC.test,
     Data.Datamining.Clustering.SOMQC.test,
     Data.Datamining.Clustering.DSOMQC.test
   ]
