som 5.1 → 6.4

raw patch · 8 files changed

+332/−102 lines, 8 filesdep ~gridPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: grid

API changes (from Hackage documentation)

Files

• som.cabal +5/−3
• src/Data/Datamining/Clustering/Classifier.hs +16/−17
• src/Data/Datamining/Clustering/DSOM.hs +35/−0
• src/Data/Datamining/Clustering/DSOMInternal.hs +198/−0
• src/Data/Datamining/Clustering/SOM.hs +6/−3
• src/Data/Datamining/Clustering/SOMInternal.hs +45/−52
• src/Data/Datamining/Pattern.hs +22/−24
• test/Main.hs +5/−3

@@ -1,5 +1,5 @@ name:           som-version:        5.1+version:        6.4 synopsis:       Self-Organising Maps description:    A Kohonen Self-organising Map (SOM) maps input patterns                  onto a regular grid (usually two-dimensional) where each@@ -31,11 +31,13 @@                    base-unicode-symbols ==0.2.*,                    binary == 0.5.* || == 0.6.* || == 0.7.*,                    containers ==0.4.2.* || ==0.5.*,-                   grid >=6.1 && ==6.*,+                   grid ==7.*,                    MonadRandom ==0.1.*   ghc-options:     -Wall   exposed-modules: Data.Datamining.Clustering.SOM,                    Data.Datamining.Clustering.SOMInternal,+                   Data.Datamining.Clustering.DSOM,+                   Data.Datamining.Clustering.DSOMInternal,                    Data.Datamining.Clustering.Classifier,                    Data.Datamining.Pattern @@ -46,7 +48,7 @@                    QuickCheck ==2.5.* || ==2.6.*,                    test-framework == 0.8.*,                    som,-                   grid >=6.1 && ==6.*,+                   grid ==7.*,                    base-unicode-symbols ==0.2.*,                    MonadRandom ==0.1.*,                    random ==1.0.*

@@ -10,8 +10,7 @@ -- Tools for identifying patterns in data. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts,-    MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses #-} module Data.Datamining.Clustering.Classifier   (     Classifier(..)@@ -23,37 +22,37 @@  -- | A machine which learns to classify input patterns.  --   Minimal complete definition: @trainBatch@, @reportAndTrain@.-class Classifier (c ∷ * → * → *) k p where+class Classifier (c :: * -> * -> *) k p where   -- | Returns a list of index\/model pairs.-  toList ∷ c k p → [(k, p)]+  toList :: c k p -> [(k, p)]    -- | Returns the number of models this classifier can learn.-  numModels ∷ c k p → Int+  numModels :: c k p -> Int    -- | Returns the current models of the classifier.-  models ∷ c k p → [p]+  models :: c k p -> [p]    -- | @'differences' c target@ returns the indices of all nodes in    --   @c@, paired with the difference between @target@ and the    --   node's model.-  differences ∷ (Pattern p, v ~ Metric p) ⇒ c k p → p → [(k, v)]+  differences :: (Pattern p, v ~ Metric p) => c k p -> p -> [(k, v)]    -- | @classify c target@ returns the index of the node in @c@    --   whose model best matches the @target@.-  classify ∷ (Pattern p, Ord v, v ~ Metric p) ⇒ c k p → p → k+  classify :: (Pattern p, Ord v, v ~ Metric p) => c k p -> p -> k   classify c p = fst . minimumBy (comparing snd) $ differences c p    -- | @'train' c target@ returns a modified copy   --   of the classifier @c@ that has partially learned the @target@.   train-    ∷ (Ord v, v ~ Metric p) ⇒ -      c k p → p → c k p+    :: (Ord v, v ~ Metric p) => +      c k p -> p -> c k p   train c p = c'     where (_, _, c') = reportAndTrain c p    -- | @'trainBatch' c targets@ returns a modified copy   --   of the classifier @c@ that has partially learned the @targets@.-  trainBatch ∷ c k p → [p] → c k p+  trainBatch :: c k p -> [p] -> c k p    -- | @'classifyAndTrain' c target@ returns a tuple containing the   --   index of the node in @c@ whose model best matches the input@@ -63,8 +62,8 @@   --   they   --   should give identical results.   classifyAndTrain -    ∷ (Ord v, v ~ Metric p) ⇒ -      c k p → p → (k, c k p)+    :: (Ord v, v ~ Metric p) => +      c k p -> p -> (k, c k p)   classifyAndTrain c p = (bmu, c')     where (bmu, _, c') = reportAndTrain c p @@ -77,8 +76,8 @@   --   @(p `diff` c, train c p)@, but they should give identical   --   results.   diffAndTrain-    ∷ (Ord v, v ~ Metric p) ⇒ -      c k p → p → ([(k, v)], c k p)+    :: (Ord v, v ~ Metric p) => +      c k p -> p -> ([(k, v)], c k p)   diffAndTrain c p = (ds, c')     where (_, ds, c') = reportAndTrain c p @@ -93,7 +92,7 @@   --   @(p `diff` c, train c p)@, but they should give identical   --   results.   reportAndTrain -    ∷ (Ord v, v ~ Metric p) ⇒ -      c k p → p → (k, [(k, v)], c k p)+    :: (Ord v, v ~ Metric p) => +      c k p -> p -> (k, [(k, v)], c k p)  

@@ -0,0 +1,35 @@+------------------------------------------------------------------------+-- |+-- Module      :  Data.Datamining.Clustering.SOM+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A modified Kohonen Self-organising Map (SOM) which supports a+-- time-independent learning function. (See+-- @'Data.Datamining.Clustering.SOM'@ for a description of a SOM.)+--+-- References:+--+-- * Rougier, N. & Boniface, Y. (2011). Dynamic self-organising map.+--   Neurocomputing, 74 (11), 1840-1847. +------------------------------------------------------------------------++module Data.Datamining.Clustering.DSOM+  (+    -- * Construction+    DSOM,+    defaultDSOM,+    customDSOM,+    rougierLearningFunction,+    -- * Deconstruction+    toGridMap,+    -- * Advanced control+    trainNeighbourhood+  ) where++import Data.Datamining.Clustering.DSOMInternal (DSOM, defaultDSOM,+  customDSOM, rougierLearningFunction, toGridMap, trainNeighbourhood)+

@@ -0,0 +1,198 @@+------------------------------------------------------------------------+-- |+-- Module      :  Data.Datamining.Clustering.DSOMInternal+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A module containing private @DSOM@ internals. Most developers should+-- use @DSOM@ instead. This module is subject to change without notice.+--+------------------------------------------------------------------------+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,+    MultiParamTypeClasses #-}++module Data.Datamining.Clustering.DSOMInternal where++import qualified Data.Foldable as F (Foldable, foldr)+import Data.List (foldl', minimumBy)+import Data.Ord (comparing)+import qualified Math.Geometry.Grid as G (Grid(..), FiniteGrid(..))+import qualified Math.Geometry.GridMap as GM (GridMap(..))+import Data.Datamining.Pattern (Pattern(..))+import Data.Datamining.Clustering.Classifier(Classifier(..))+import Prelude hiding (lookup)++-- | A Self-Organising Map (DSOM).+--+--   Although @DSOM@ implements @GridMap@, most users will only need the+--   interface provided by @Data.Datamining.Clustering.Classifier@. If+--   you chose to use the @GridMap@ functions, please note:+--+--   1. The functions @adjust@, and @adjustWithKey@ do not increment the+--      counter. You can do so manually with @incrementCounter@.+--+--   2. The functions @map@ and @mapWithKey@ are not implemented (they+--      just return an @error@). It would be problematic to implement+--      them because the input DSOM and the output DSOM would have to+--      have the same @Metric@ type.+data DSOM gm k p = DSOM+  {+    sGridMap :: gm p,+    sLearningFunction :: (Metric p -> Metric p -> Metric p -> Metric p)+  }++instance (F.Foldable gm) => F.Foldable (DSOM gm k) where+  foldr f x g = F.foldr f x (sGridMap g)++instance (G.Grid (gm p)) => G.Grid (DSOM gm k p) where+  type Index (DSOM gm k p) = G.Index (gm p)+  type Direction (DSOM gm k p) = G.Direction (gm p)+  indices = G.indices . sGridMap+  distance = G.distance . sGridMap+  neighbours = G.neighbours . sGridMap+  contains = G.contains . sGridMap+  viewpoint = G.viewpoint . sGridMap+  directionTo = G.directionTo . sGridMap+  tileCount = G.tileCount . sGridMap+  null = G.null . sGridMap+  nonNull = G.nonNull . sGridMap++instance+  (F.Foldable gm, GM.GridMap gm p, G.FiniteGrid (GM.BaseGrid gm p)) =>+    GM.GridMap (DSOM gm k) p where+  type BaseGrid (DSOM gm k) p = GM.BaseGrid gm p+  toGrid = GM.toGrid . sGridMap+  toMap = GM.toMap . sGridMap+  mapWithKey = error "Not implemented"+  adjustWithKey f k s = s { sGridMap=gm' }+    where gm = sGridMap s+          gm' = GM.adjustWithKey f k gm++-- | Extracts the grid and current models from the DSOM.+toGridMap :: GM.GridMap gm p => DSOM gm k p -> gm p+toGridMap = sGridMap++adjustNode+  :: (Pattern p, G.FiniteGrid (gm p), GM.GridMap gm p,+      k ~ G.Index (gm p), Ord k, k ~ G.Index (GM.BaseGrid gm p),+      Num (Metric p), Fractional (Metric p)) => +     gm p -> (Metric p -> Metric p -> Metric p) -> p -> k -> k -> p -> p+adjustNode gm f target bmu k = makeSimilar target amount+  where diff = difference (gm GM.! k) target+        dist = scaleDistance (G.distance gm bmu k)+                 (G.maxPossibleDistance gm)+        amount = f diff dist++scaleDistance :: (Num a, Fractional a) => Int -> Int -> a+scaleDistance d dMax+  | dMax == 0  = 0+  | otherwise = fromIntegral d / fromIntegral dMax++-- | Trains the specified node and the neighbourood around it to better+--   match a target.+--   Most users should use @train@, which automatically determines+--   the BMU and trains it and its neighbourhood.+trainNeighbourhood+  :: (Pattern p, G.FiniteGrid (gm p), GM.GridMap gm p, Num (Metric p),+      Ord k, k ~ G.Index (gm p),+      k ~ G.Index (GM.BaseGrid gm p), Fractional (Metric p)) =>+     DSOM gm t p -> k -> p -> DSOM gm k p+trainNeighbourhood s bmu target = s { sGridMap=gm' }+  where gm = sGridMap s+        gm' = GM.mapWithKey (adjustNode gm f target bmu) gm+        f = (sLearningFunction s) bmuDiff+        bmuDiff = difference (gm GM.! bmu) target++justTrain+  :: (Pattern p, G.FiniteGrid (gm p), GM.GridMap gm p,+      Num (Metric p), Ord (Metric p), Ord (G.Index (gm p)),+      GM.GridMap gm (Metric p), Fractional (Metric p),+      G.Index (GM.BaseGrid gm (Metric p)) ~ G.Index (gm p),+      G.Index (GM.BaseGrid gm p) ~ G.Index (gm p)) =>+     DSOM gm t p -> p -> DSOM gm (G.Index (gm p)) p+justTrain s p = trainNeighbourhood s bmu p+  where ds = GM.toList . GM.map (p `difference`) . sGridMap $ s+        bmu = fst . minimumBy (comparing snd) $ ds++instance+  (GM.GridMap gm p, k ~ G.Index (GM.BaseGrid gm p), Pattern p,+    G.FiniteGrid (gm p), GM.GridMap gm (Metric p), k ~ G.Index (gm p),+    k ~ G.Index (GM.BaseGrid gm (Metric p)), Ord k, Ord (Metric p),+    Num (Metric p), Fractional (Metric p)) =>+   Classifier (DSOM gm) k p where+  toList = GM.toList . sGridMap+  numModels = G.tileCount . sGridMap+  models = GM.elems . sGridMap+  differences s p = GM.toList . GM.map (p `difference`) . sGridMap $ s+  trainBatch s = foldl' justTrain s+  reportAndTrain s p = (bmu, ds, s')+    where ds = differences s p+          bmu = fst . minimumBy (comparing snd) $ ds+          s' = trainNeighbourhood s bmu p+++-- | Creates a classifier with a default (bell-shaped) learning+--   function. Usage is @'defaultDSOM' gm r w t@, where:+--+--   [@gm@] The geometry and initial models for this classifier.+--   A reasonable choice here is @'lazyGridMap' g ps@, where @g@ is a+--   @'HexHexGrid'@, and @ps@ is a set of random patterns.+--+--   [@r@] and [@p@] are the first two parameters to the+--   @'rougierLearningFunction'@.+defaultDSOM+  :: (Eq (Metric p), Ord (Metric p), Floating (Metric p)) =>+     gm p -> Metric p -> Metric p -> DSOM gm k p+defaultDSOM gm r p =+  DSOM {+        sGridMap=gm,+        sLearningFunction=rougierLearningFunction r p+      }++-- | Creates a classifier with a custom learning function.+--   Usage is @'customDSOM' gm g@, where:+--+--   [@gm@] The geometry and initial models for this classifier.+--   A reasonable choice here is @'lazyGridMap' g ps@, where @g@ is a+--   @'HexHexGrid'@, and @ps@ is a set of random patterns.+--+--   [@f@] A function used to determine the learning rate (for+--   adjusting the models in the classifier).+--   This function will be invoked with three parameters.+--   The first parameter will indicate how different the BMU is from+--   the input pattern.+--   The second parameter indicates how different the pattern of the+--   node currently being trained is from the input pattern.+--   The third parameter is the grid distance from the BMU to the node+--   currently being trained, as a fraction of the maximum grid+--   distance.+--   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.+customDSOM+  :: gm p -> (Metric p -> Metric p -> Metric p -> Metric p) -> DSOM gm k p+customDSOM gm f =+  DSOM {+        sGridMap=gm,+        sLearningFunction=f+      }++-- | Configures a learning function that depends not on the time, but+--   on how good a model we already have for the target. If the+--   BMU is an exact match for the target, no learning occurs.+--   Usage is @'rougierLearningFunction' r p@, where @r@ is the+--   maximal learning rate (0 <= r <= 1), and @p@ is the elasticity.+--+--   NOTE: When using this learning function, ensure that+--   @abs . difference@ is always between 0 and 1, inclusive. Otherwise+--   you may get invalid learning rates.+rougierLearningFunction+  :: (Eq a, Ord a, Floating a) => a -> a -> (a -> a -> a -> a)+rougierLearningFunction r p bmuDiff diff dist+  | bmuDiff == 0         = 0+  | otherwise           = r * abs diff * exp (-k*k)+  where k = dist/(p*abs bmuDiff) +

@@ -35,9 +35,10 @@ -- * Kohonen, T. (1982). Self-organized formation of topologically  --   correct feature maps. Biological Cybernetics, 43 (1), 59–69. --+-- * Rougier, N. & Boniface, Y. (2011). Dynamic self-organising map.+--   Neurocomputing, 74 (11), 1840-1847.  ------------------------------------------------------------------------ -{-# LANGUAGE UnicodeSyntax #-} module Data.Datamining.Clustering.SOM   (     -- * Construction@@ -49,10 +50,12 @@     toGridMap,     -- * Advanced control     trainNeighbourhood,-    incrementCounter+    incrementCounter,+    counter,+    setCounter   ) where  import Data.Datamining.Clustering.SOMInternal (SOM, defaultSOM,   customSOM, decayingGaussian, toGridMap, trainNeighbourhood,-  incrementCounter)+  incrementCounter, counter, setCounter) 

@@ -11,23 +11,10 @@ -- use @SOM@ instead. This module is subject to change without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts,-    FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,+    MultiParamTypeClasses, DeriveGeneric #-} -module Data.Datamining.Clustering.SOMInternal-  (-    -- * Construction-    SOM(..),-    defaultSOM,-    customSOM,-    decayingGaussian,-    decayingGaussian2,-    -- * Deconstruction-    toGridMap,-    -- * Advanced control-    trainNeighbourhood,-    incrementCounter-  ) where+module Data.Datamining.Clustering.SOMInternal where  import qualified Data.Foldable as F (Foldable, foldr) import Data.List (foldl', minimumBy)@@ -36,6 +23,7 @@ import qualified Math.Geometry.GridMap as GM (GridMap(..)) import Data.Datamining.Pattern (Pattern(..)) import Data.Datamining.Clustering.Classifier(Classifier(..))+import GHC.Generics (Generic) import Prelude hiding (lookup)  -- | A Self-Organising Map (SOM).@@ -53,15 +41,15 @@ --      the same @Metric@ type. data SOM gm k p = SOM   {-    sGridMap ∷ gm p,-    sLearningFunction ∷ Int → Int → Metric p,-    sCounter ∷ Int-  }+    sGridMap :: gm p,+    sLearningFunction :: Int -> Int -> Metric p,+    sCounter :: Int+  } deriving Generic -instance (F.Foldable gm) ⇒ F.Foldable (SOM gm k) where+instance (F.Foldable gm) => F.Foldable (SOM gm k) where   foldr f x g = F.foldr f x (sGridMap g) -instance (G.Grid (gm p)) ⇒ G.Grid (SOM gm k p) where+instance (G.Grid (gm p)) => G.Grid (SOM gm k p) where   type Index (SOM gm k p) = G.Index (gm p)   type Direction (SOM gm k p) = G.Direction (gm p)   indices = G.indices . sGridMap@@ -74,7 +62,7 @@   null = G.null . sGridMap   nonNull = G.nonNull . sGridMap -instance (F.Foldable gm, GM.GridMap gm p, G.Grid (GM.BaseGrid gm p)) ⇒ GM.GridMap (SOM gm k) p where+instance (F.Foldable gm, GM.GridMap gm p, G.Grid (GM.BaseGrid gm p)) => GM.GridMap (SOM gm k) p where   type BaseGrid (SOM gm k) p = GM.BaseGrid gm p   toGrid = GM.toGrid . sGridMap   toMap = GM.toMap . sGridMap@@ -83,16 +71,16 @@     where gm = sGridMap s           gm' = GM.adjustWithKey f k gm -currentLearningFunction ∷ SOM gm k p → (Int → Metric p)+currentLearningFunction :: SOM gm k p -> (Int -> Metric p) currentLearningFunction s = (sLearningFunction s) (sCounter s)  -- | Extracts the grid and current models from the SOM.-toGridMap ∷ GM.GridMap gm p ⇒ SOM gm k p → gm p+toGridMap :: GM.GridMap gm p => SOM gm k p -> gm p toGridMap = sGridMap  adjustNode-  ∷ (Pattern p, G.Grid g, k ~ G.Index g) ⇒-     g → (Int → Metric p) → p → k → k → p → p+  :: (Pattern p, G.Grid g, k ~ G.Index g) =>+     g -> (Int -> Metric p) -> p -> k -> k -> p -> p adjustNode g f target bmu k = makeSimilar target (f d)   where d = G.distance g bmu k @@ -101,23 +89,29 @@ --   Most users should use @train@, which automatically determines --   the BMU and trains it and its neighbourhood. trainNeighbourhood-  ∷ (Pattern p, G.Grid (gm p), GM.GridMap gm p,-      G.Index (GM.BaseGrid gm p) ~ G.Index (gm p)) ⇒-     SOM gm k p → G.Index (gm p) → p → SOM gm k p+  :: (Pattern p, G.Grid (gm p), GM.GridMap gm p,+      G.Index (GM.BaseGrid gm p) ~ G.Index (gm p)) =>+     SOM gm k p -> G.Index (gm p) -> p -> SOM gm k p trainNeighbourhood s bmu target = s { sGridMap=gm' }   where gm = sGridMap s         gm' = GM.mapWithKey (adjustNode gm f target bmu) gm         f = currentLearningFunction s -incrementCounter :: SOM gm k p → SOM gm k p-incrementCounter s = s { sCounter=sCounter s + 1}+incrementCounter :: SOM gm k p -> SOM gm k p+incrementCounter s = setCounter (sCounter s + 1) s +counter :: SOM gm k p -> Int+counter = sCounter++setCounter :: Int -> SOM gm k p -> SOM gm k p+setCounter k s = s { sCounter = k }+ justTrain-  ∷ (Ord (Metric p), Pattern p, G.Grid (gm p),+  :: (Ord (Metric p), Pattern p, G.Grid (gm p),       GM.GridMap gm (Metric p), GM.GridMap gm p,       G.Index (GM.BaseGrid gm (Metric p)) ~ G.Index (gm p),-      G.Index (GM.BaseGrid gm p) ~ G.Index (gm p)) ⇒-     SOM gm k p → p → SOM gm k p+      G.Index (GM.BaseGrid gm p) ~ G.Index (gm p)) =>+     SOM gm k p -> p -> SOM gm k p justTrain s p = trainNeighbourhood s bmu p   where ds = GM.toList . GM.map (p `difference`) . sGridMap $ s         bmu = fst . minimumBy (comparing snd) $ ds@@ -125,7 +119,7 @@ instance   (GM.GridMap gm p, k ~ G.Index (GM.BaseGrid gm p), Pattern p,   G.Grid (gm p), GM.GridMap gm (Metric p), k ~ G.Index (gm p),-  k ~ G.Index (GM.BaseGrid gm (Metric p)), Ord (Metric p)) ⇒+  k ~ G.Index (GM.BaseGrid gm (Metric p)), Ord (Metric p)) =>     Classifier (SOM gm) k p where   toList = GM.toList . sGridMap   numModels = G.tileCount . sGridMap@@ -139,29 +133,28 @@   -- | Creates a classifier with a default (bell-shaped) learning---   function. Usage is @'defaultSOM' gm r w t@, where:+--   function. Usage is @'defaultSOM' gm r0 rf w0 wf tf@, where: -- --   [@gm@] The geometry and initial models for this classifier. --   A reasonable choice here is @'lazyGridMap' g ps@, where @g@ is a --   @'HexHexGrid'@, and @ps@ is a set of random patterns. -----   [@r@] The learning rate to be applied to the BMU (Best Matching Unit)---   at "time" zero. The BMU is the model which best matches the---   current target pattern.+--   [@r0@] See description in @'decayingGaussian2'@. -----   [@w@] The width of the bell curve at time zero.+--   [@rf@] See description in @'decayingGaussian2'@. -----   [@t@] Controls how rapidly the learning rate decays. After this---   time, any learning done by the classifier will be negligible.---   We recommend setting this parameter to the number of patterns---   (or pattern batches) that will be presented to the classifier. An---   estimate is fine.+--   [@w0@] See description in @'decayingGaussian2'@.+--+--   [@wf@] See description in @'decayingGaussian2'@.+--+--   [@tf@] See description in @'decayingGaussian2'@. defaultSOM-  ∷ Floating (Metric p) ⇒ gm p → Metric p → Metric p → Int → SOM gm k p-defaultSOM gm r w t =+  :: Floating (Metric p) => gm p -> Metric p -> Metric p -> Metric p ->+     Metric p -> Int -> SOM gm k p+defaultSOM gm r0 rf w0 wf tf =   SOM {         sGridMap=gm,-        sLearningFunction=decayingGaussian r w t,+        sLearningFunction=decayingGaussian2 r0 rf w0 wf tf,         sCounter=0       } @@ -182,7 +175,7 @@ --   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.-customSOM ∷ gm p → (Int → Int → Metric p) → SOM gm k p+customSOM :: gm p -> (Int -> Int -> Metric p) -> SOM gm k p customSOM gm f =   SOM {         sGridMap=gm,@@ -196,7 +189,7 @@ --   BMU) is @r0@, and the neighbourhood width is @w0@. Over time the --   neighbourhood width shrinks and the learning rate tapers off. decayingGaussian-  ∷ Floating a ⇒ a → a → Int → (Int → Int → a)+  :: Floating a => a -> a -> Int -> (Int -> Int -> a) decayingGaussian r w0 tMax t d = r * s * exp (-(d'*d')/(2*w0*w0*s*s))     where s = exp (-t'/tMax')           t' = fromIntegral t@@ -218,7 +211,7 @@ -- --   where << means "is much smaller than" (not the Haskell @<<@ --   operator!) -decayingGaussian2 :: Floating a ⇒ a → a → a → a → Int → (Int → Int → a)+decayingGaussian2 :: Floating a => a -> a -> a -> a -> Int -> (Int -> Int -> a) decayingGaussian2 r0 rf w0 wf tf t d = r * exp (-(d'*d')/(w*w))     where a = t'/tf'           r = r0 * ((rf/r0)**a)

@@ -10,8 +10,7 @@ -- Tools for identifying patterns in data. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts,-    MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses #-} module Data.Datamining.Pattern   (     -- * Patterns@@ -35,7 +34,6 @@     scaleAll   ) where -import Data.Eq.Unicode ((≡)) import Data.List (foldl')  -- | A pattern to be learned or classified.@@ -44,7 +42,7 @@   -- | 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 → Metric p+  difference :: p -> p -> Metric p   -- | @'makeSimilar' 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@@@ -52,7 +50,7 @@   --   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 → Metric p → p → p+  makeSimilar :: p -> Metric p -> p -> p  -- -- Using numbers as patterns.@@ -65,7 +63,7 @@ adjustNum target r x   | r < 0     = error "Negative learning rate"   | r > 1     = error "Learning rate > 1"-  | r ≡ 1     = x+  | r == 1     = x   | otherwise = adjustNum' r target x  -- Note that parameters are swapped@@ -76,22 +74,22 @@ If you wish to use, say, a @Double@ as a pattern, one option is to use @no-warn-orphans@ and add the following to your code: -> instance Double ⇒ Pattern Double where+> instance Double => Pattern Double where >   type Metric Double = Double->   difference = euclideanDistanceSquared->   makeSimilar = adjustVector+>   difference = absDifference+>   makeSimilar = adjustNum -}  -- -- Using numeric vectors as patterns. -- -magnitudeSquared ∷ Num a ⇒ [a] → a-magnitudeSquared xs =  sum $ map (\x → x*x) xs+magnitudeSquared :: Num a => [a] -> a+magnitudeSquared xs =  sum $ map (\x -> x*x) xs  -- | Calculates the square of the Euclidean distance between two --   vectors.-euclideanDistanceSquared ∷ Num a ⇒ [a] → [a] → a+euclideanDistanceSquared :: Num a => [a] -> [a] -> a euclideanDistanceSquared xs ys = magnitudeSquared $ zipWith (-) xs ys  -- | @'adjustVector' target amount vector@ adjusts @vector@ to move it@@ -100,11 +98,11 @@ --   of @r@ permit more adjustment. If @r@=1, the result will be --   identical to the @target@. If @amount@=0, the result will be the --   unmodified @pattern@.-adjustVector ∷ (Num a, Ord a, Eq a) ⇒ [a] → a → [a] → [a]+adjustVector :: (Num a, Ord a, Eq a) => [a] -> a -> [a] -> [a] adjustVector xs r ys   | r < 0     = error "Negative learning rate"   | r > 1     = error "Learning rate > 1"-  | r ≡ 1     = xs+  | r == 1     = xs   | otherwise = zipWith (adjustNum' r) xs ys  -- | A vector that has been normalised, i.e., the magnitude of the@@ -112,15 +110,15 @@ data NormalisedVector a = NormalisedVector [a] deriving Show  -- | Normalises a vector-normalise ∷ Floating a ⇒ [a] → NormalisedVector a+normalise :: Floating a => [a] -> NormalisedVector a normalise xs = NormalisedVector $ map (/x) xs   where x = norm xs -norm ∷ Floating a ⇒ [a] → a+norm :: Floating a => [a] -> a norm xs = sqrt $ sum (map f xs)   where f x = x*x -instance (Floating a, Fractional a, Ord a, Eq a) ⇒+instance (Floating a, Fractional a, Ord a, Eq a) =>     Pattern (NormalisedVector a) where   type Metric (NormalisedVector a) = a   difference (NormalisedVector xs) (NormalisedVector ys) =@@ -140,28 +138,28 @@ --   @xs@, @'scale' qs xs@ scales the vector @xs@ element by element, --   mapping the maximum value expected at that index to one, and the --   minimum value to zero.-scale ∷ Fractional a ⇒ [(a,a)] → [a] → ScaledVector a+scale :: Fractional a => [(a,a)] -> [a] -> ScaledVector a scale qs xs = ScaledVector $ zipWith scaleValue qs xs  -- | Scales a set of vectors by determining the maximum and minimum --   values at each index in the vector, and mapping the maximum --   value to one, and the minimum value to zero.-scaleAll ∷ (Fractional a, Ord a) ⇒ [[a]] → [ScaledVector a]+scaleAll :: (Fractional a, Ord a) => [[a]] -> [ScaledVector a] scaleAll xss = map (scale qs) xss   where qs = quantify xss -scaleValue ∷ Fractional a ⇒ (a,a) → a → a+scaleValue :: Fractional a => (a,a) -> a -> a scaleValue (minX,maxX) x = (x - minX) / (maxX-minX) -quantify ∷ Ord a ⇒ [[a]] → [(a,a)]+quantify :: Ord a => [[a]] -> [(a,a)] quantify xss = foldl' quantify' qs (tail xss)   where qs = zip (head xss) (head xss) -quantify' ∷ Ord a ⇒ [(a,a)] → [a] → [(a,a)]+quantify' :: Ord a => [(a,a)] -> [a] -> [(a,a)] quantify' = zipWith f   where f (minX, maxX) x = (min minX x, max maxX x) -instance (Fractional a, Ord a, Eq a) ⇒ Pattern (ScaledVector a) where+instance (Fractional a, Ord a, Eq a) => Pattern (ScaledVector a) where   type Metric (ScaledVector a) = a   difference (ScaledVector xs) (ScaledVector ys) =     euclideanDistanceSquared xs ys@@ -172,7 +170,7 @@ If you wish to use raw numeric vectors as a pattern, one option is to use @no-warn-orphans@ and add the following to your code: -> instance (Floating a, Fractional a, Ord a, Eq a) ⇒ Pattern [a] where+> instance (Floating a, Fractional a, Ord a, Eq a) => Pattern [a] where >   type Metric [a] = a >   difference = euclideanDistanceSquared >   makeSimilar = adjustVector

@@ -3,15 +3,17 @@  import Data.Datamining.PatternQC ( test ) import Data.Datamining.Clustering.SOMQC ( test )+import Data.Datamining.Clustering.DSOMQC ( test )  import Test.Framework as TF ( defaultMain, Test ) -tests ∷ [TF.Test]+tests :: [TF.Test] tests =    [      Data.Datamining.PatternQC.test,-    Data.Datamining.Clustering.SOMQC.test+    Data.Datamining.Clustering.SOMQC.test,+    Data.Datamining.Clustering.DSOMQC.test   ] -main ∷ IO ()+main :: IO () main = defaultMain tests