diff --git a/som.cabal b/som.cabal
--- a/som.cabal
+++ b/som.cabal
@@ -1,5 +1,5 @@
 name: som
-version: 9.0.3
+version: 9.0.4
 cabal-version: >=1.10
 build-type: Simple
 license: BSD3
@@ -42,9 +42,9 @@
         Data.Datamining.Pattern
     build-depends:
         assert >=0.0.1.2 && <0.1,
-        base >=4.9.1.0 && <4.10,
-        containers >=0.5.7.1 && <0.6,
-        deepseq >=1.4.2.0 && <1.5,
+        base >=4.7 && <5,
+        containers >=0.5.10.2 && <0.6,
+        deepseq >=1.4.3.0 && <1.5,
         grid >=7.8.8 && <7.9,
         MonadRandom >=0.5.1 && <0.6
     default-language: Haskell2010
@@ -56,15 +56,20 @@
     main-is: Main.hs
     build-depends:
         assert >=0.0.1.2 && <0.1,
-        base ==4.9.*,
-        test-framework-quickcheck2 >=0.3.0.3 && <0.4,
-        QuickCheck >=2.9.2 && <2.10,
+        base >=4.10.0.0 && <4.11,
+        test-framework-quickcheck2 >=0.3.0.4 && <0.4,
+        QuickCheck >=2.10.0.1 && <2.11,
         test-framework >=0.8.1.1 && <0.9,
-        som >=9.0.3 && <9.1,
-        containers >=0.5.7.1 && <0.6,
+        som,
+        containers >=0.5.10.2 && <0.6,
         grid >=7.8.8 && <7.9,
         MonadRandom >=0.5.1 && <0.6,
         random ==1.1.*
     default-language: Haskell2010
     hs-source-dirs: test
+    other-modules:
+        Data.Datamining.Clustering.DSOMQC
+        Data.Datamining.Clustering.SGMQC
+        Data.Datamining.Clustering.SOMQC
+        Data.Datamining.PatternQC
     ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
diff --git a/test/Data/Datamining/Clustering/DSOMQC.hs b/test/Data/Datamining/Clustering/DSOMQC.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Datamining/Clustering/DSOMQC.hs
@@ -0,0 +1,287 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Datamining.Clustering.DSOMQC
+-- Copyright   :  (c) Amy de Buitléir 2012-2016
+-- License     :  BSD-style
+-- Maintainer  :  amy@nualeargais.ie
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Tests
+--
+------------------------------------------------------------------------
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-}
+
+module Data.Datamining.Clustering.DSOMQC
+  (
+    test
+  ) where
+
+import Data.Datamining.Pattern (euclideanDistanceSquared,
+  magnitudeSquared, adjustNum, absDifference)
+import Data.Datamining.Clustering.Classifier(classify,
+  classifyAndTrain, differences, diffAndTrain, models,
+  numModels, train, trainBatch)
+import Data.Datamining.Clustering.DSOMInternal
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative
+#endif
+
+import Data.List (sort)
+import Math.Geometry.Grid (size)
+import Math.Geometry.Grid.Hexagonal (HexHexGrid, hexHexGrid)
+import Math.Geometry.GridMap ((!), elems)
+import Math.Geometry.GridMap.Lazy (LGridMap, lazyGridMap)
+import Test.Framework as TF (Test, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck ((==>), Gen, Arbitrary, arbitrary, choose,
+  Property, property, sized, suchThat, vectorOf, shrink)
+
+positive :: (Num a, Ord a, Arbitrary a) => Gen a
+positive = arbitrary `suchThat` (> 0)
+
+data RougierArgs
+  = RougierArgs Double Double Double Double Double deriving Show
+
+instance Arbitrary RougierArgs where
+  arbitrary = RougierArgs <$> choose (0,1) <*> choose (0,1)
+                <*> arbitrary <*> choose (0,1) <*> positive
+
+prop_rougierFunction_zero_if_perfect_model_exists :: RougierArgs -> Property
+prop_rougierFunction_zero_if_perfect_model_exists (RougierArgs r p _ diff dist) =
+  property $ rougierLearningFunction r p 0 diff dist == 0
+
+prop_rougierFunction_r_if_bmu_is_bad_model :: RougierArgs -> Property
+prop_rougierFunction_r_if_bmu_is_bad_model (RougierArgs r p _ _ _) =
+  property $ rougierLearningFunction r p 1 1 0 == r
+
+prop_rougierFunction_r_in_bounds :: RougierArgs -> Property
+prop_rougierFunction_r_in_bounds (RougierArgs r p bmuDiff diff dist) =
+  property $ 0 <= f && f <= 1
+  where f = rougierLearningFunction r p bmuDiff diff dist
+
+prop_rougierFunction_r_if_inelastic :: RougierArgs -> Property
+prop_rougierFunction_r_if_inelastic (RougierArgs r _ _ _ _) =
+  property $ rougierLearningFunction r 1.0 1.0 1.0 0 == r
+
+fractionDiff :: [Double] -> [Double] -> Double
+fractionDiff xs ys = if denom == 0 then 0 else d / denom
+  where d = sqrt $ euclideanDistanceSquared xs ys
+        denom = max xMag yMag
+        xMag = sqrt $ magnitudeSquared xs
+        yMag = sqrt $ magnitudeSquared ys
+
+approxEqual :: [TestPattern] -> [TestPattern] -> Bool
+approxEqual xs ys = fractionDiff xs' ys' <= 0.1
+  where xs' = map toDouble xs
+        ys' = map toDouble ys
+
+-- We need to ensure that the absolute value of the difference
+-- between any two test patterns is on the unit interval.
+
+newtype TestPattern = TestPattern {toDouble :: Double}
+ deriving ( Eq, Ord, Show, Read)
+
+instance Arbitrary TestPattern where
+  arbitrary = fmap TestPattern $ choose (0,1)
+  shrink (TestPattern x) =
+    [ TestPattern x' | x' <- shrink x, x' >= 0, x' <= 1]
+
+testPatternDiff :: TestPattern -> TestPattern -> Double
+testPatternDiff (TestPattern a) (TestPattern b) = absDifference a b
+
+adjustTestPattern :: TestPattern -> Double -> TestPattern -> TestPattern
+adjustTestPattern (TestPattern target) r (TestPattern x)
+  = TestPattern $ adjustNum target r x
+
+-- | A classifier and a training set. The training set will consist of
+--   @j@ vectors of equal length, where @j@ is the number of patterns
+--   the classifier can model. After running through the training set a
+--   few times, the classifier should be very accurate at identifying
+--   any of those @j@ vectors.
+data DSOMTestData
+  = DSOMTestData
+    {
+      som1 :: DSOM (LGridMap HexHexGrid) Double (Int, Int) TestPattern,
+      params1 :: RougierArgs,
+      trainingSet1 :: [TestPattern]
+    }
+
+instance Show DSOMTestData where
+  show s = "buildDSOMTestData " ++ show (size . gridMap . som1 $ s)
+    ++ " " ++ show (elems . gridMap . som1 $ s)
+    ++ " (" ++ show (params1 s) 
+    ++ ") " ++ show (trainingSet1 s) 
+
+buildDSOMTestData
+  :: Int -> [TestPattern] -> RougierArgs -> [TestPattern] -> DSOMTestData
+buildDSOMTestData len ps rp@(RougierArgs r p _ _ _) targets =
+  DSOMTestData s rp targets
+    where g = hexHexGrid len
+          gm = lazyGridMap g ps
+          fr = rougierLearningFunction r p
+          s = DSOM gm fr testPatternDiff adjustTestPattern
+
+-- | Generate a classifier and a training set. The training set will
+--   consist @j@ vectors of equal length, where @j@ is the number of
+--   patterns the classifier can model. After running through the
+--   training set a few times, the classifier should be very accurate at
+--   identifying any of those @j@ vectors.
+sizedDSOMTestData :: Int -> Gen DSOMTestData
+sizedDSOMTestData n = do
+  sideLength <- choose (1, min (n+1) 5) --avoid long tests
+  let tileCount = 3*sideLength*(sideLength-1) + 1
+  let numberOfPatterns = tileCount
+  ps <- vectorOf numberOfPatterns arbitrary
+  rp <- arbitrary
+  targets <- vectorOf numberOfPatterns arbitrary
+  return $ buildDSOMTestData sideLength ps rp targets
+
+instance Arbitrary DSOMTestData where
+  arbitrary = sized sizedDSOMTestData
+
+-- | If we use a fixed learning rate of one (regardless of the distance
+--   from the BMU), and train a classifier once on one pattern, then all
+--   nodes should match the input vector.
+prop_global_instant_training_works :: DSOMTestData -> Property
+prop_global_instant_training_works (DSOMTestData s _ xs) =
+  property $ finalModels `approxEqual` expectedModels
+    where x = head xs
+          gm = toGridMap s :: LGridMap HexHexGrid TestPattern
+          f _ _ _ = 1
+          s2 = DSOM gm f testPatternDiff adjustTestPattern
+          s3 = train s2 x
+          finalModels = models s3 :: [TestPattern]
+          expectedModels = replicate (numModels s) x :: [TestPattern]
+
+prop_training_works :: DSOMTestData -> Property
+prop_training_works (DSOMTestData s _ xs) = errBefore /= 0 ==>
+  errAfter < errBefore
+    where (bmu, s') = classifyAndTrain s x
+          x = head xs
+          errBefore = testPatternDiff x (gridMap s ! bmu)
+          errAfter = testPatternDiff x (gridMap s' ! bmu)
+
+--   Invoking @diffAndTrain f s p@ should give identical results to
+--   @(p `classify` s, train s f p)@.
+prop_classifyAndTrainEquiv :: DSOMTestData -> Property
+prop_classifyAndTrainEquiv (DSOMTestData s _ ps) = property $
+  bmu == s `classify` p && gridMap s1 == gridMap s2
+    where p = head ps
+          (bmu, s1) = classifyAndTrain s p
+          s2 = train s p
+
+--   Invoking @diffAndTrain f s p@ should give identical results to
+--   @(s `diff` p, train s f p)@.
+prop_diffAndTrainEquiv :: DSOMTestData -> Property
+prop_diffAndTrainEquiv (DSOMTestData s _ ps) = property $
+  diffs == s `differences` p && gridMap s1 == gridMap s2
+    where p = head ps
+          (diffs, s1) = diffAndTrain s p
+          s2 = train s p
+
+--   Invoking @trainNeighbourhood s (classify s p) p@ should give
+--   identical results to @train s p@.
+prop_trainNeighbourhoodEquiv :: DSOMTestData -> Property
+prop_trainNeighbourhoodEquiv (DSOMTestData s _ ps) = property $
+  gridMap s1 == gridMap s2
+    where p = head ps
+          s1 = trainNeighbourhood s (classify s p) p
+          s2 = train s p
+
+-- | 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 :: DSOMTestData -> Property
+prop_batch_training_works (DSOMTestData s _ xs) = property $
+  classifications == (concat . replicate 5) firstSet
+  where trainingSet = (concat . replicate 5) xs
+        s' = trainBatch s trainingSet
+        classifications = map (classify s') trainingSet
+        firstSet = take (length xs) classifications
+
+data SpecialDSOMTestData
+  = SpecialDSOMTestData
+    {
+      som2 :: DSOM (LGridMap HexHexGrid) Double (Int, Int) TestPattern,
+      params2 :: Double,
+      trainingSet2 :: [TestPattern]
+    }
+
+instance Show SpecialDSOMTestData where
+  show s = "buildDSOMTestData " ++ show (size . gridMap . som2 $ s)
+    ++ " " ++ show (elems . gridMap . som2 $ s)
+    ++ " (" ++ show (params2 s) 
+    ++ ") " ++ show (trainingSet2 s) 
+
+stepFunction :: Double -> Double -> Double -> Double -> Double
+stepFunction r _ _ d = if d == 0 then r else 0.0
+
+buildSpecialDSOMTestData
+  :: Int -> [TestPattern] -> Double -> [TestPattern] -> SpecialDSOMTestData
+buildSpecialDSOMTestData len ps r targets =
+  SpecialDSOMTestData s r targets
+    where g = hexHexGrid len
+          gm = lazyGridMap g ps
+          fr = stepFunction r
+          s = DSOM gm fr testPatternDiff adjustTestPattern
+
+-- | Generate a classifier and a training set. The training set will
+--   consist @j@ vectors of equal length, where @j@ is the number of
+--   patterns the classifier can model. After running through the
+--   training set a few times, the classifier should be very accurate at
+--   identifying any of those @j@ vectors.
+sizedSpecialDSOMTestData :: Int -> Gen SpecialDSOMTestData
+sizedSpecialDSOMTestData n = do
+  sideLength <- choose (1, min (n+1) 5) --avoid long tests
+  let tileCount = 3*sideLength*(sideLength-1) + 1
+  let ps = map TestPattern $ take tileCount [0,100..]
+  r <- choose (0.001, 1)
+  let targets = map TestPattern $ take tileCount [5,105..]
+  return $ buildSpecialDSOMTestData sideLength ps r targets
+
+instance Arbitrary SpecialDSOMTestData where
+  arbitrary = sized sizedSpecialDSOMTestData
+
+-- | If we train a classifier once on a set of patterns, where the
+--   number of patterns in the set is equal to the number of nodes in
+--   the classifier, then the classifier should become a better
+--   representation of the training set. The initial models and training
+--   set are designed to ensure that a single node will NOT train to
+--   more than one pattern (which would render the test invalid).
+prop_batch_training_works2 :: SpecialDSOMTestData -> Property
+prop_batch_training_works2 (SpecialDSOMTestData s _ xs) =
+  errBefore /= 0 ==> errAfter < errBefore
+    where s' = trainBatch s xs
+          errBefore = euclideanDistanceSquared (map toDouble . sort $ xs) (map toDouble . sort . models $ s)
+          errAfter = euclideanDistanceSquared (map toDouble . sort $ xs) (map toDouble . sort . models $ s')
+
+test :: Test
+test = testGroup "QuickCheck Data.Datamining.Clustering.DSOM"
+  [
+    testProperty "prop_rougierFunction_zero_if_perfect_model_exists"
+      prop_rougierFunction_zero_if_perfect_model_exists,
+    testProperty "prop_rougierFunction_r_if_bmu_is_bad_model"
+      prop_rougierFunction_r_if_bmu_is_bad_model,
+    testProperty "prop_rougierFunction_r_if_inelastic"
+      prop_rougierFunction_r_if_inelastic,
+    testProperty "prop_rougierFunction_r_in_bounds"
+      prop_rougierFunction_r_in_bounds,
+    testProperty "prop_global_instant_training_works"
+      prop_global_instant_training_works,
+    testProperty "prop_training_works" prop_training_works,
+    testProperty "prop_classifyAndTrainEquiv"
+      prop_classifyAndTrainEquiv,
+    testProperty "prop_diffAndTrainEquiv" prop_diffAndTrainEquiv,
+    testProperty "prop_trainNeighbourhoodEquiv" prop_trainNeighbourhoodEquiv,
+    testProperty "prop_batch_training_works" prop_batch_training_works,
+    testProperty "prop_batch_training_works2"
+      prop_batch_training_works2
+  ]
diff --git a/test/Data/Datamining/Clustering/SGMQC.hs b/test/Data/Datamining/Clustering/SGMQC.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Datamining/Clustering/SGMQC.hs
@@ -0,0 +1,241 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Datamining.Clustering.SGMQC
+-- Copyright   :  (c) Amy de Buitléir 2012-2016
+-- 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.SGMQC
+  (
+    test
+  ) where
+
+import Data.Datamining.Pattern (adjustNum, absDifference)
+import Data.Datamining.Clustering.SGMInternal
+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 -> Bool -> [Double] -> TestSGM
+buildTestSGM r0 d maxSz dt ad ps = TestSGM s' desc
+  where lrf = exponential r0 d
+        s = makeSGM lrf maxSz dt ad absDifference adjustNum
+        desc = "buildTestSGM " ++ show r0 ++ " " ++ show d
+                 ++ " " ++ show maxSz
+                 ++ " " ++ show dt
+                 ++ " " ++ show ad
+                 ++ " " ++ show ps
+        s' = trainBatch s ps
+
+sizedTestSGM :: Int -> Gen TestSGM
+sizedTestSGM n = do
+  maxSz <- choose (1, n+1)
+  let numPatterns = n
+  r0 <- choose (0, 1)
+  d <- positive
+  dt <- choose (0, 1)
+  ad <- arbitrary
+  ps <- vectorOf numPatterns arbitrary
+  return $ buildTestSGM r0 d maxSz dt ad ps
+
+instance Arbitrary TestSGM where
+  arbitrary = sized sizedTestSGM
+
+prop_classify_chooses_best_fit :: TestSGM -> Double -> Property
+prop_classify_chooses_best_fit (TestSGM s _) x
+  = property $ bmu == fst (minimumBy (comparing snd) diffs)
+  where (bmu, _, diffs, _) = trainAndClassify s x
+
+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_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_diff_lt_threshold_after_training :: TestSGM -> Double -> Property
+prop_diff_lt_threshold_after_training (TestSGM s _) x =
+  numModels s < maxSize s ==> diffAfter < diffThreshold s
+  where (_, _, _, s') = trainAndClassify s x
+        (_, diffAfter, _) = classify s' 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 maxSize
+
+prop_train_only_modifies_one_model
+  :: TestSGM -> Double -> Property
+prop_train_only_modifies_one_model (TestSGM s _) p
+  = numModels s < maxSize 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
+  = numModels s < maxSize 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
+  -- = maxSize s > length ps
+  --   ==> classifications == (concat . replicate 5) firstSet
+  = property $ classifications == (concat . replicate 5) firstSet
+  where trainingSet = (concat . replicate 5) ps
+        sRightSize = if maxSize s >= length ps
+          then s
+          else s { maxSize=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_results_are_consistent
+  :: TestSGM -> Double -> Property
+prop_classification_results_are_consistent (TestSGM s _) x
+  = property $ bmu == fst (minimumBy (comparing snd) diffs)
+  where (bmu, _, diffs, _) = trainAndClassify s x
+
+prop_classification_results_are_consistent2
+  :: TestSGM -> Double -> Property
+prop_classification_results_are_consistent2 (TestSGM s _) x
+  = property $ bmuDiff == snd (minimumBy (comparing snd) diffs)
+  where (_, bmuDiff, diffs, _) = trainAndClassify s x
+
+prop_classification_stabilises :: TestSGM -> [Double] -> Property
+prop_classification_stabilises (TestSGM s _)  ps
+  = (not . null $ ps) && maxSize 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)
+
+prop_models_not_deleted_unless_allowed
+  :: TestSGM -> Double -> Property
+prop_models_not_deleted_unless_allowed (TestSGM s _) x =
+  (not . allowDeletion $ s) ==> null (labelsBefore \\ labelsAfter)
+  where labelsBefore = M.keys $ modelMap s
+        labelsAfter = M.keys $ modelMap s'
+        (_, _, _, s') = trainAndClassify s x
+
+prop_models_not_deleted_unless_allowed2
+  :: TestSGM -> Double -> Property
+prop_models_not_deleted_unless_allowed2 (TestSGM s _) x =
+  (not . allowDeletion $ s) ==> null (labelsBefore \\ labelsAfter)
+  where labelsBefore = M.keys $ modelMap s
+        labelsAfter = M.keys $ modelMap s'
+        s' = train s x
+
+test :: Test
+test = testGroup "QuickCheck Data.Datamining.Clustering.SGM"
+  [
+    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_classify_never_creates_model"
+      prop_classify_never_creates_model,
+    testProperty "prop_trainNode_reduces_diff"
+      prop_trainNode_reduces_diff,
+    testProperty "prop_diff_lt_threshold_after_training"
+      prop_diff_lt_threshold_after_training,
+    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_results_are_consistent"
+      prop_classification_results_are_consistent,
+    testProperty "prop_classification_results_are_consistent2"
+      prop_classification_results_are_consistent2,
+    testProperty "prop_classification_stabilises"
+      prop_classification_stabilises,
+    testProperty "prop_models_not_deleted_unless_allowed"
+      prop_models_not_deleted_unless_allowed,
+    testProperty "prop_models_not_deleted_unless_allowed2"
+      prop_models_not_deleted_unless_allowed2    
+  ]
diff --git a/test/Data/Datamining/Clustering/SOMQC.hs b/test/Data/Datamining/Clustering/SOMQC.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Datamining/Clustering/SOMQC.hs
@@ -0,0 +1,338 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Datamining.Clustering.SOMQC
+-- Copyright   :  (c) Amy de Buitléir 2012-2016
+-- 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.SOMQC
+  (
+    test
+  ) where
+
+import Data.Datamining.Pattern (euclideanDistanceSquared,
+  magnitudeSquared, adjustNum, absDifference)
+import Data.Datamining.Clustering.Classifier(classify,
+  classifyAndTrain, reportAndTrain, differences, diffAndTrain, models,
+  numModels, train, trainBatch)
+import Data.Datamining.Clustering.SOMInternal
+
+import Data.List (sort)
+import Math.Geometry.Grid (size)
+import Math.Geometry.Grid.Hexagonal (HexHexGrid, hexHexGrid)
+import Math.Geometry.GridMap ((!), elems)
+import Math.Geometry.GridMap.Lazy (LGridMap, lazyGridMap)
+import System.Random (Random)
+import Test.Framework as TF (Test, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck ((==>), Gen, Arbitrary, arbitrary, choose,
+  Property, property, sized, suchThat, vectorOf)
+
+positive :: (Num a, Ord a, Arbitrary a) => Gen a
+positive = arbitrary `suchThat` (> 0)
+
+data DecayingGaussianParams a = DecayingGaussianParams a a a a a
+  deriving (Eq, Show)
+
+instance
+  (Random a, Num a, Ord a, Arbitrary a)
+  => Arbitrary (DecayingGaussianParams a) where
+  arbitrary = do
+    r0 <- choose (0,1)
+    rf <- choose (0,r0)
+    w0 <- positive
+    wf <- choose (0,w0)
+    tf <- positive
+    return $ DecayingGaussianParams r0 rf w0 wf tf
+
+prop_DecayingGaussian_starts_at_r0
+  :: DecayingGaussianParams Double -> Property
+prop_DecayingGaussian_starts_at_r0 (DecayingGaussianParams r0 rf w0 wf tf)
+  = property $ abs ((decayingGaussian r0 rf w0 wf tf 0 0) - r0) < 0.01
+
+prop_DecayingGaussian_starts_at_w0
+  :: DecayingGaussianParams Double -> Property
+prop_DecayingGaussian_starts_at_w0 (DecayingGaussianParams r0 rf w0 wf tf)
+  = property $
+    decayingGaussian r0 rf w0 wf tf 0 inside >= r0 * exp (-0.5)
+      && decayingGaussian r0 rf w0 wf tf 0 outside < r0 * exp (-0.5)
+  where inside = w0 * 0.99999
+        outside = w0 * 1.00001
+
+prop_DecayingGaussian_decays_to_rf
+  :: DecayingGaussianParams Double -> Property
+prop_DecayingGaussian_decays_to_rf (DecayingGaussianParams r0 rf w0 wf tf)
+  = property $ abs ((decayingGaussian r0 rf w0 wf tf tf 0) - rf) < 0.01
+
+prop_DecayingGaussian_shrinks_to_wf
+  :: DecayingGaussianParams Double -> Property
+prop_DecayingGaussian_shrinks_to_wf (DecayingGaussianParams r0 rf w0 wf tf)
+  = property $
+    decayingGaussian r0 rf w0 wf tf tf inside >= rf * exp (-0.5)
+      && decayingGaussian r0 rf w0 wf tf tf outside < rf * exp (-0.5)
+  where inside = wf * 0.99999
+        outside = wf * 1.00001
+
+fractionDiff :: [Double] -> [Double] -> Double
+fractionDiff xs ys = if denom == 0 then 0 else d / denom
+  where d = sqrt $ euclideanDistanceSquared xs ys
+        denom = max xMag yMag
+        xMag = sqrt $ magnitudeSquared xs
+        yMag = sqrt $ magnitudeSquared ys
+
+approxEqual :: [Double] -> [Double] -> Bool
+approxEqual xs ys = fractionDiff xs ys <= 0.1
+
+-- | A classifier and a training set. The training set will consist of
+--   @j@ vectors of equal length, where @j@ is the number of patterns
+--   the classifier can model. After running through the training set a
+--   few times, the classifier should be very accurate at identifying
+--   any of those @j@ vectors.
+data SOMTestData
+  = SOMTestData
+    {
+      som1 :: SOM Double Double (LGridMap HexHexGrid) Double (Int, Int) Double,
+      params1 :: DecayingGaussianParams Double,
+      trainingSet1 :: [Double]
+    }
+
+instance Show SOMTestData where
+  show s = "buildSOMTestData " ++ show (size . gridMap . som1 $ s)
+    ++ " " ++ show (elems . gridMap . som1 $ s)
+    ++ " (" ++ show (params1 s) 
+    ++ ") " ++ show (trainingSet1 s) 
+
+buildSOMTestData
+  :: Int -> [Double] -> DecayingGaussianParams Double
+     -> [Double] -> SOMTestData
+buildSOMTestData len ps p@(DecayingGaussianParams r0 rf w0 wf tf) targets =
+  SOMTestData s p targets
+    where g = hexHexGrid len
+          gm = lazyGridMap g ps
+          fr = decayingGaussian r0 rf w0 wf tf
+          s = SOM gm fr absDifference adjustNum 0
+
+sizedSOMTestData :: Int -> Gen SOMTestData
+sizedSOMTestData n = do
+  sideLength <- choose (1, min (n+1) 5) --avoid long tests
+  let tileCount = 3*sideLength*(sideLength-1) + 1
+  let numberOfPatterns = tileCount
+  ps <- vectorOf numberOfPatterns arbitrary
+  r0 <- choose (0, 1)
+  rf <- choose (0, r0)
+  w0 <- choose (0, fromIntegral sideLength)
+  wf <- choose (0, w0)
+  tf <- choose (1, 10)
+  targets <- vectorOf numberOfPatterns arbitrary
+  return $ buildSOMTestData sideLength ps (DecayingGaussianParams r0 rf w0 wf tf) targets
+
+instance Arbitrary SOMTestData where
+  arbitrary = sized sizedSOMTestData
+
+-- | If we use a fixed learning rate of one (regardless of the distance
+--   from the BMU), and train a classifier once on one pattern, then all
+--   nodes should match the input vector.
+prop_global_instant_training_works :: SOMTestData -> Property
+prop_global_instant_training_works (SOMTestData s _ xs) =
+  property $ finalModels `approxEqual` expectedModels
+    where x = head xs
+          gm = toGridMap s :: LGridMap HexHexGrid Double
+          f _ _ = 1
+          s2 = SOM gm f absDifference adjustNum 0
+          s3 = train s2 x
+          finalModels = models s3 :: [Double]
+          expectedModels = replicate (numModels s) x :: [Double]
+
+prop_training_reduces_error :: SOMTestData -> Property
+prop_training_reduces_error (SOMTestData s _ xs) = errBefore /= 0 ==>
+  errAfter < errBefore
+    where (bmu, s') = classifyAndTrain s x
+          x = head xs
+          errBefore = abs $ x - (gridMap s ! bmu)
+          errAfter = abs $ x - (gridMap s' ! bmu)
+
+--   Invoking @diffAndTrain f s p@ should give identical results to
+--   @(p `classify` s, train s f p)@.
+prop_classifyAndTrainEquiv :: SOMTestData -> Property
+prop_classifyAndTrainEquiv (SOMTestData s _ ps) = property $
+  bmu == s `classify` p && gridMap s1 == gridMap s2
+    where p = head ps
+          (bmu, s1) = classifyAndTrain s p
+          s2 = train s p
+
+--   Invoking @diffAndTrain f s p@ should give identical results to
+--   @(s `diff` p, train s f p)@.
+prop_diffAndTrainEquiv :: SOMTestData -> Property
+prop_diffAndTrainEquiv (SOMTestData s _ ps) = property $
+  diffs == s `differences` p && gridMap s1 == gridMap s2
+    where p = head ps
+          (diffs, s1) = diffAndTrain s p
+          s2 = train s p
+
+--   Invoking @trainNeighbourhood s (classify s p) p@ should give
+--   identical results to @train s p@.
+prop_trainNeighbourhoodEquiv :: SOMTestData -> Property
+prop_trainNeighbourhoodEquiv (SOMTestData s _ ps) = property $
+  gridMap s1 == gridMap s2
+    where p = head ps
+          s1 = trainNeighbourhood s (classify s p) p
+          s2 = train s p
+
+-- | 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 :: SOMTestData -> Property
+prop_batch_training_works (SOMTestData s _ xs) = property $
+  classifications == (concat . replicate 5) firstSet
+  where trainingSet = (concat . replicate 5) xs
+        s' = trainBatch s trainingSet
+        classifications = map (classify s') trainingSet
+        firstSet = take (length xs) classifications
+
+-- | WARNING: This can fail when two nodes are close enough in
+--   value so that after training they become identical.
+--   This only happens rarely, so if the test fails, try again.
+prop_classification_is_consistent
+  :: SOMTestData -> Property
+prop_classification_is_consistent (SOMTestData s _ (x:_))
+  = property $ bmu == bmu'
+  where (bmu, _, s') = reportAndTrain s x
+        (bmu', _, _) = reportAndTrain s' x
+prop_classification_is_consistent _ = error "Should not happen"
+
+-- | Same as SOMTestData, except that the initial models and training
+--   set are designed to ensure that a single node will NOT train to
+--   more than one pattern.
+data SpecialSOMTestData
+  = SpecialSOMTestData
+    {
+      som2 :: SOM Int Int (LGridMap HexHexGrid) Double (Int, Int) Double,
+      params2 :: Double,
+      trainingSet2 :: [Double]
+    }
+
+instance Show SpecialSOMTestData where
+  show s = "buildSpecialSOMTestData " ++ show (size . gridMap . som2 $ s)
+    ++ " " ++ show (elems . gridMap . som2 $ s)
+    ++ " " ++ show (params2 s) 
+    ++ " " ++ show (trainingSet2 s) 
+
+buildSpecialSOMTestData
+  :: Int -> [Double] -> Double -> [Double] -> SpecialSOMTestData
+buildSpecialSOMTestData len ps r targets =
+  SpecialSOMTestData s r targets
+    where g = hexHexGrid len
+          gm = lazyGridMap g ps
+          s = SOM gm (stepFunction r) absDifference adjustNum 0
+
+sizedSpecialSOMTestData :: Int -> Gen SpecialSOMTestData
+sizedSpecialSOMTestData n = do
+  sideLength <- choose (1, min (n+1) 5) --avoid long tests
+  let tileCount = 3*sideLength*(sideLength-1) + 1
+  let ps = take tileCount [0,100..]
+  r <- choose (0.001, 1)
+  let targets = take tileCount [5,105..]
+  return $ buildSpecialSOMTestData sideLength ps r targets
+
+instance Arbitrary SpecialSOMTestData where
+  arbitrary = sized sizedSpecialSOMTestData
+
+-- | If we train a classifier once on a set of patterns, where the
+--   number of patterns in the set is equal to the number of nodes in
+--   the classifier, then the classifier should become a better
+--   representation of the training set. The initial models and training
+--   set are designed to ensure that a single node will NOT train to
+--   more than one pattern (which would render the test invalid).
+prop_batch_training_works2 :: SpecialSOMTestData -> Property
+prop_batch_training_works2 (SpecialSOMTestData s _ xs) =
+  errBefore /= 0 ==> errAfter < errBefore
+    where s' = trainBatch s xs
+          errBefore = euclideanDistanceSquared (sort xs) (sort (models s))
+          errAfter = euclideanDistanceSquared (sort xs) (sort (models s'))
+
+data IncompleteSOMTestData
+  = IncompleteSOMTestData
+    {
+      som3 :: SOM Double Double (LGridMap HexHexGrid) Double (Int, Int) Double,
+      params3 :: DecayingGaussianParams Double,
+      trainingSet3 :: [Double]
+    }
+
+instance Show IncompleteSOMTestData where
+  show s = "buildIncompleteSOMTestData " ++ show (size . gridMap . som3 $ s)
+    ++ " " ++ show (elems . gridMap . som3 $ s)
+    ++ " " ++ show (params3 s) 
+    ++ " " ++ show (trainingSet3 s) 
+
+buildIncompleteSOMTestData
+  :: Int -> [Double] -> DecayingGaussianParams Double
+     -> [Double] -> IncompleteSOMTestData
+buildIncompleteSOMTestData len ps p@(DecayingGaussianParams r0 rf w0 wf tf) targets =
+  IncompleteSOMTestData s p targets
+    where g = hexHexGrid len
+          gm = lazyGridMap g ps
+          fr = decayingGaussian r0 rf w0 wf tf
+          s = SOM gm fr absDifference adjustNum 0
+
+-- | Same as sizedSOMTestData, except some nodes don't have a value.
+sizedIncompleteSOMTestData :: Int -> Gen IncompleteSOMTestData
+sizedIncompleteSOMTestData n = do
+  sideLength <- choose (2, min (n+2) 5) --avoid long tests
+  let tileCount = 3*sideLength*(sideLength-1) + 1
+  numberOfPatterns <- choose (1,tileCount-1)
+  ps <- vectorOf numberOfPatterns arbitrary
+  r0 <- choose (0, 1)
+  rf <- choose (0, r0)
+  w0 <- choose (0, fromIntegral sideLength)
+  wf <- choose (0, w0)
+  tf <- choose (1, 10)
+  targets <- vectorOf numberOfPatterns arbitrary
+  return $ buildIncompleteSOMTestData sideLength ps (DecayingGaussianParams r0 rf w0 wf tf) targets
+
+instance Arbitrary IncompleteSOMTestData where
+  arbitrary = sized sizedIncompleteSOMTestData
+
+prop_can_train_incomplete_SOM :: IncompleteSOMTestData -> Property
+prop_can_train_incomplete_SOM (IncompleteSOMTestData s _ xs) = errBefore /= 0 ==>
+  errAfter < errBefore
+    where (bmu, s') = classifyAndTrain s x
+          x = head xs
+          errBefore = abs $ x - (gridMap s ! bmu)
+          errAfter = abs $ x - (gridMap s' ! bmu)
+
+test :: Test
+test = testGroup "QuickCheck Data.Datamining.Clustering.SOM"
+  [
+    testProperty "prop_DecayingGaussian_starts_at_r0"
+      prop_DecayingGaussian_starts_at_r0,
+    testProperty "prop_DecayingGaussian_starts_at_w0"
+      prop_DecayingGaussian_starts_at_w0,
+    testProperty "prop_DecayingGaussian_decays_to_rf"
+      prop_DecayingGaussian_decays_to_rf,
+    testProperty "prop_DecayingGaussian_shrinks_to_wf"
+      prop_DecayingGaussian_shrinks_to_wf,
+    testProperty "prop_global_instant_training_works"
+      prop_global_instant_training_works,
+    testProperty "prop_training_reduces_error"
+      prop_training_reduces_error,
+    testProperty "prop_classifyAndTrainEquiv"
+      prop_classifyAndTrainEquiv,
+    testProperty "prop_diffAndTrainEquiv" prop_diffAndTrainEquiv,
+    testProperty "prop_trainNeighbourhoodEquiv" prop_trainNeighbourhoodEquiv,
+    testProperty "prop_batch_training_works" prop_batch_training_works,
+    testProperty "prop_classification_is_consistent"
+      prop_classification_is_consistent,
+    testProperty "prop_batch_training_works2"
+      prop_batch_training_works2,
+    testProperty "prop_can_train_incomplete_SOM"
+      prop_can_train_incomplete_SOM
+  ]
diff --git a/test/Data/Datamining/PatternQC.hs b/test/Data/Datamining/PatternQC.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Datamining/PatternQC.hs
@@ -0,0 +1,87 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Datamining.PatternQC
+-- Copyright   :  (c) Amy de Buitléir 2012-2016
+-- License     :  BSD-style
+-- Maintainer  :  amy@nualeargais.ie
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Tests
+--
+------------------------------------------------------------------------
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-orphans #-}
+
+module Data.Datamining.PatternQC
+  (
+    test
+  ) where
+
+import Data.Datamining.Pattern
+
+import Test.Framework as TF (Test, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck ((==>), Gen, Arbitrary, arbitrary, choose, 
+  Property, property, sized, vector)
+
+#if MIN_VERSION_base(4,8,0)
+#else
+import Control.Applicative
+#endif
+
+newtype UnitInterval = FromDouble Double deriving Show
+
+instance Arbitrary UnitInterval where
+  arbitrary = FromDouble <$> choose (0,1)
+
+prop_adjustVector_doesnt_choke_on_infinite_lists ::
+  [Double] -> UnitInterval -> Property
+prop_adjustVector_doesnt_choke_on_infinite_lists xs (FromDouble d) = 
+  property $ 
+    length (adjustVector xs d [0,1..]) == length xs
+
+data TwoVectorsSameLength = TwoVectorsSameLength [Double] [Double] 
+  deriving Show
+
+sizedTwoVectorsSameLength :: Int -> Gen TwoVectorsSameLength
+sizedTwoVectorsSameLength n = 
+  TwoVectorsSameLength <$> vector n <*> vector n
+
+instance Arbitrary TwoVectorsSameLength where
+  arbitrary = sized sizedTwoVectorsSameLength
+
+prop_zero_adjustment_is_no_adjustment :: 
+  TwoVectorsSameLength -> Property
+prop_zero_adjustment_is_no_adjustment (TwoVectorsSameLength xs ys) = 
+  property $ adjustVector xs 0 ys == ys
+
+prop_full_adjustment_gives_perfect_match :: 
+  TwoVectorsSameLength -> Property
+prop_full_adjustment_gives_perfect_match (TwoVectorsSameLength xs ys) = 
+  property $ adjustVector xs 1 ys == xs
+
+prop_adjustVector_improves_similarity :: 
+  TwoVectorsSameLength -> UnitInterval -> Property
+prop_adjustVector_improves_similarity 
+  (TwoVectorsSameLength xs ys) (FromDouble a) = 
+    a > 0 && a < 1 && not (null xs) ==> d2 < d1
+      where d1 = euclideanDistanceSquared xs ys
+            d2 = euclideanDistanceSquared xs ys'
+            ys' = adjustVector xs a ys
+
+test :: Test
+test = testGroup "QuickCheck Data.Datamining.Clustering.PatternQC"
+  [
+    testProperty "prop_adjustVector_doesnt_choke_on_infinite_lists"
+      prop_adjustVector_doesnt_choke_on_infinite_lists,
+    testProperty "prop_zero_adjustment_is_no_adjustment"
+      prop_zero_adjustment_is_no_adjustment,
+    testProperty "prop_full_adjustment_gives_perfect_match"
+      prop_full_adjustment_gives_perfect_match,
+    testProperty "prop_adjustVector_improves_similarity"
+      prop_adjustVector_improves_similarity
+  ]
+