packages feed

som 9.0.1 → 9.0.2

raw patch · 15 files changed

+96/−1052 lines, 15 filesdep ~MonadRandomdep ~QuickCheckdep ~assert

Dependency ranges changed: MonadRandom, QuickCheck, assert, base, containers, deepseq, grid, som, test-framework, test-framework-quickcheck2

Files

LICENSE view
@@ -1,27 +1,30 @@-Copyright (c) Amy de Buitléir 2010-2015+Copyright Amy de Buitléir (c) 2010-2017+ All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met:+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: -* Redistributions of source code must retain the above copyright -  notice, this list of conditions and the following disclaimer.-* Redistributions in binary form must reproduce the above copyright-  notice, this list of conditions and the following disclaimer in the-  documentation and/or other materials provided with the distribution.-* Neither the name of the author nor the names of other contributors-  may be used to endorse or promote products derived from this software-  without specific prior written permission.+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS-IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Amy de Buitléir nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
som.cabal view
@@ -1,76 +1,70 @@-Name:              som-Version:           9.0.1-Stability:         experimental-Synopsis:          Self-Organising Maps.-Description:       A Kohonen Self-organising Map (SOM) maps input patterns -                   onto a regular grid (usually two-dimensional) where each-                   node in the grid is a model of the input data, and does-                   so using a method which ensures that any topological-                   relationships within the input data are also represented-                   in the grid. This implementation supports the use of -                   non-numeric patterns.-                   .-                   In layman's terms, a SOM can be useful when you you want-                   to discover the underlying structure of some data.-                   .-                   The userguide is available at -                   <https://github.com/mhwombat/som/wiki>.-Category:          Math-License:           BSD3-License-file:      LICENSE-Copyright:         (c) Amy de Buitléir 2010-2015-Homepage:          https://github.com/mhwombat/som-Bug-reports:       https://github.com/mhwombat/som/issues-Author:            Amy de Buitléir-Maintainer:        amy@nualeargais.ie-Build-Type:        Simple-Cabal-Version:     >=1.8+name: som+version: 9.0.2+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: (c) 2010-2017 Amy de Buitléir+maintainer: amy@nualeargais.ie+homepage: https://github.com/mhwombat/som#readme+bug-reports: https://github.com/mhwombat/som/issues+synopsis: Self-Organising Maps.+description:+    A Kohonen Self-organising Map (SOM) maps input patterns+    onto a regular grid (usually two-dimensional) where each+    node in the grid is a model of the input data, and does+    so using a method which ensures that any topological+    relationships within the input data are also represented+    in the grid. This implementation supports the use of+    non-numeric patterns.+    .+    In layman's terms, a SOM can be useful when you you want+    to discover the underlying structure of some data.+    .+    The userguide is available at+    <https://github.com/mhwombat/som/wiki>.+category: Math+author: Amy de Buitléir  source-repository head-  type:     git-  location: https://github.com/mhwombat/som.git--source-repository this-  type:     git-  location: https://github.com/mhwombat/som.git-  tag:      8.2.3-+    type: git+    location: https://github.com/mhwombat/som  library-  hs-source-dirs:  src-  build-depends:   assert ==0.0.*,-                   base >=4.8 && <5,-                   containers ==0.5.*,-                   deepseq ==1.4.*,-                   grid ==7.* && >=7.7,-                   MonadRandom ==0.4.*-  ghc-options:     -Wall-  exposed-modules: Data.Datamining.Clustering.SOM,-                   Data.Datamining.Clustering.SOMInternal,-                   Data.Datamining.Clustering.DSOM,-                   Data.Datamining.Clustering.DSOMInternal,-                   Data.Datamining.Clustering.SGM,-                   Data.Datamining.Clustering.SGMInternal,-                   Data.Datamining.Clustering.Classifier,-                   Data.Datamining.Pattern--test-suite som-tests-  type:            exitcode-stdio-1.0-  build-depends:   assert ==0.0.*,-                   base >=4.8 && <5,-                   test-framework-quickcheck2 == 0.3.*,-                   QuickCheck ==2.8.*,-                   test-framework ==0.8.*,-                   som,-                   containers ==0.5.*,-                   grid ==7.* && >=7.7,-                   MonadRandom ==0.4.*,-                   random ==1.1.*-  hs-source-dirs:  test-  ghc-options:     -Wall-  main-is:         Main.hs-  other-modules:   Data.Datamining.Clustering.SOMQC,-                   Data.Datamining.Clustering.DSOMQC,-                   Data.Datamining.Clustering.SGMQC,-                   Data.Datamining.PatternQC+    exposed-modules:+        Data.Datamining.Clustering.SOM+        Data.Datamining.Clustering.SOMInternal+        Data.Datamining.Clustering.DSOM+        Data.Datamining.Clustering.DSOMInternal+        Data.Datamining.Clustering.SGM+        Data.Datamining.Clustering.SGMInternal+        Data.Datamining.Clustering.Classifier+        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,+        grid >=7.8.8 && <7.9,+        MonadRandom >=0.5.1 && <0.6+    default-language: Haskell2010+    hs-source-dirs: src+    ghc-options: -Wall +test-suite som-test+    type: exitcode-stdio-1.0+    main-is: Main.hs+    build-depends:+        assert >=0.0.1.2 && <0.1,+        base >=4.9.1.0 && <4.10,+        test-framework-quickcheck2 >=0.3.0.3 && <0.4,+        QuickCheck >=2.9.2 && <2.10,+        test-framework >=0.8.1.1 && <0.9,+        som >=9.0.2 && <9.1,+        containers >=0.5.7.1 && <0.6,+        grid >=7.8.8 && <7.9,+        MonadRandom >=0.5.1 && <0.6,+        random ==1.1.*+    default-language: Haskell2010+    hs-source-dirs: test+    ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
src/Data/Datamining/Clustering/Classifier.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Clustering.Classifier--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
src/Data/Datamining/Clustering/DSOM.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Clustering.SOM--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
src/Data/Datamining/Clustering/DSOMInternal.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Clustering.DSOMInternal--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
src/Data/Datamining/Clustering/SGM.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Clustering.SGM--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
src/Data/Datamining/Clustering/SGMInternal.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Clustering.SGMInternal--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
src/Data/Datamining/Clustering/SOM.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Clustering.SOM--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
src/Data/Datamining/Clustering/SOMInternal.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Clustering.SOMInternal--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
src/Data/Datamining/Pattern.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Data.Datamining.Pattern--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental
− test/Data/Datamining/Clustering/DSOMQC.hs 
@@ -1,287 +0,0 @@---------------------------------------------------------------------------- |--- Module      :  Data.Datamining.Clustering.DSOMQC--- Copyright   :  (c) Amy de Buitléir 2012-2015--- 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-  ]
− test/Data/Datamining/Clustering/SGMQC.hs 
@@ -1,241 +0,0 @@---------------------------------------------------------------------------- |--- Module      :  Data.Datamining.Clustering.SGMQC--- Copyright   :  (c) Amy de Buitléir 2012-2015--- 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    -  ]
− test/Data/Datamining/Clustering/SOMQC.hs 
@@ -1,338 +0,0 @@---------------------------------------------------------------------------- |--- Module      :  Data.Datamining.Clustering.SOMQC--- Copyright   :  (c) Amy de Buitléir 2012-2015--- 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-  ]
− test/Data/Datamining/PatternQC.hs 
@@ -1,87 +0,0 @@---------------------------------------------------------------------------- |--- Module      :  Data.Datamining.PatternQC--- Copyright   :  (c) Amy de Buitléir 2012-2015--- 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-  ]-
test/Main.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------ -- | -- Module      :  Main--- Copyright   :  (c) Amy de Buitléir 2012-2015+-- Copyright   :  (c) Amy de Buitléir 2012-2016 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental