packages feed

som 3.1 → 4.0

raw patch · 6 files changed

+399/−262 lines, 6 filesdep ~QuickCheckdep ~binary

Dependency ranges changed: QuickCheck, binary

Files

som.cabal view
@@ -1,5 +1,5 @@ name:           som-version:        3.1+version:        4.0 synopsis:       Self-Organising Maps description:    A Kohonen Self-organising Map (SOM) maps input patterns                  onto a regular grid (usually two-dimensional) where each@@ -14,10 +14,6 @@                 .                 The userguide is available at                  <https://github.com/mhwombat/som/wiki>.-                .-                NOTE: Version 3.0 changed the order of parameters-                for many functions. This makes it easier for the user-                to write mapping and folding operations. category:       Math  cabal-version:  >=1.8@@ -33,19 +29,21 @@   hs-source-dirs:  src   build-depends:   base ==4.*,                    base-unicode-symbols ==0.2.*,-                   binary == 0.5.*,+                   binary == 0.5.* || == 0.6.* || == 0.7.*,                    containers ==0.4.2.* || ==0.5.*,                    grid ==4.*,                    MonadRandom ==0.1.*   ghc-options:     -Wall   exposed-modules: Data.Datamining.Clustering.SOM,-                   Data.Datamining.Clustering.SOMInternal+                   Data.Datamining.Clustering.SOMInternal,+                   Data.Datamining.Clustering.Classifier,+                   Data.Datamining.Pattern  test-suite som-tests   type:            exitcode-stdio-1.0   build-depends:   base ==4.*,                    test-framework-quickcheck2 == 0.3.*,-                   QuickCheck == 2.5.*,+                   QuickCheck ==2.5.* || ==2.6.*,                    test-framework == 0.8.*,                    som,                    grid ==4.*,
+ src/Data/Datamining/Clustering/Classifier.hs view
@@ -0,0 +1,98 @@+------------------------------------------------------------------------+-- |+-- Module      :  Data.Datamining.Clustering.Classifier+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- Tools for identifying patterns in data.+--+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts,+    MultiParamTypeClasses #-}+module Data.Datamining.Clustering.Classifier+  (+    Classifier(..)+  ) where++import Data.Datamining.Pattern (Pattern, Metric)+import Data.List (minimumBy)+import Data.Ord (comparing)++-- | A machine which learns to classify input patterns. +--   Minimal complete definition: @trainBatch@, @reportAndTrain@.+class Classifier (c ∷ * → * → *) k p where+  -- | Returns a list of index\/model pairs.+  toList ∷ c k p → [(k, p)]++  -- | Returns the number of models this classifier can learn.+  numModels ∷ c k p → Int++  -- | Returns the current models of the classifier.+  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)]++  -- | @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 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+  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++  -- | @'classifyAndTrain' c target@ returns a tuple containing the+  --   index of the node in @c@ whose model best matches the input+  --   @target@, and a modified copy of the classifier @c@ that has+  --   partially learned the @target@. Invoking @classifyAndTrain c p@+  --   may be faster than invoking @(p `classify` c, train c p)@, but they+  --   should give identical results.+  classifyAndTrain +    ∷ (Ord v, v ~ Metric p) ⇒ +      c k p → p → (k, c k p)+  classifyAndTrain c p = (bmu, c')+    where (bmu, _, c') = reportAndTrain c p++  -- | @'diffAndTrain' c target@ returns a tuple containing:+  --   1. The indices of all nodes in @c@, paired with the difference+  --      between @target@ and the node's model+  --   2. A modified copy of the classifier @c@ that has partially+  --      learned the @target@.+  --   Invoking @diffAndTrain c p@ may be faster than invoking+  --   @(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)+  diffAndTrain c p = (ds, c')+    where (_, ds, c') = reportAndTrain c p++  -- | @'reportAndTrain' c f target@ returns a tuple containing:+  --   1. The index of the node in @c@ whose model best matches the+  --      input @target@+  --   2. The indices of all nodes in @c@, paired with the difference+  --      between @target@ and the node's model+  --   3. A modified copy of the classifier @c@ that has partially+  --      learned the @target@+  --   Invoking @diffAndTrain c p@ may be faster than invoking+  --   @(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)++
src/Data/Datamining/Clustering/SOM.hs view
@@ -23,56 +23,21 @@ -- * Kohonen, T. (1982). Self-organized formation of topologically  --   correct feature maps. Biological Cybernetics, 43 (1), 59–69. ----- NOTE: Version 3.0 changed the order of parameters for many functions.--- This makes it easier for the user to write mapping and folding--- operations.--- ------------------------------------------------------------------------  {-# LANGUAGE UnicodeSyntax #-}- module Data.Datamining.Clustering.SOM   (-    -- * Patterns-    Pattern(..),-    -- * Using the SOM-    train,-    trainBatch,-    classify,-    classifyAndTrain,-    diff,-    diffAndTrain,-    -- * Numeric vectors as patterns-    -- ** Normalised vectors-    normalise,-    NormalisedVector,-    -- ** Scaled vectors-    scale,-    ScaledVector,-    -- ** Useful functions-    -- $Vector-    adjustVector,-    euclideanDistanceSquared,-    gaussian+    SOM,+    defaultSOM,+    customSOM,+    gaussian,+    decayingGaussian,+    toGridMap   ) where -import Data.Datamining.Clustering.SOMInternal (adjustVector, classify, -  classifyAndTrain, diff, diffAndTrain, -  euclideanDistanceSquared, normalise, NormalisedVector, scale,-  ScaledVector, train, trainBatch, Pattern(..))---- | Calculates @c/e/^(-d^2/2w^2)@.---   This form of the Gaussian function is useful as a learning rate---   function. In @'gaussian' c w d@, @c@ specifies the highest learning---   rate, which will be applied to the SOM node that best matches the---   input pattern. The learning rate applied to other nodes will be ---   applied based on their distance @d@ from the best matching node. ---   The value @w@ controls the \'width\' of the Gaussian. Higher values---   of @w@ cause the learning rate to fall off more slowly with ---   distance.-gaussian ∷ Double → Double → Int → Double-gaussian c w d = c * exp (-d'*d'/(2*w*w))-  where d' = fromIntegral d+import Data.Datamining.Clustering.SOMInternal (SOM, defaultSOM,+  customSOM, gaussian, decayingGaussian, toGridMap)  {- $Vector If you wish to use a SOM with raw numeric vectors, use @no-warn-orphans@
src/Data/Datamining/Clustering/SOMInternal.hs view
@@ -11,237 +11,162 @@ -- use @SOM@ instead. This module is subject to change without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts, +    FlexibleInstances, MultiParamTypeClasses #-}  module Data.Datamining.Clustering.SOMInternal   (-    adjustNode,-    adjustVector,-    classify,-    classifyAndTrain,-    diff,-    diffAndTrain,-    euclideanDistanceSquared,-    magnitudeSquared,-    normalise,-    NormalisedVector,-    scale,-    scaleAll,-    ScaledVector,-    train,-    trainBatch,-    Pattern(..)+    SOM(..),+    defaultSOM,+    customSOM,+    gaussian,+    decayingGaussian,+    toGridMap   ) where -import Data.Eq.Unicode ((≡)) import Data.List (foldl', minimumBy) import Data.Ord (comparing)-import Math.Geometry.GridMap (GridMap, BaseGrid, mapWithKey, toList)-import Math.Geometry.Grid (Grid, Index, distance)-import qualified Math.Geometry.GridMap as GM (map)---- | A pattern to be learned or classified by a self-organising map.-class Pattern p where-  type Metric p-  -- | 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-  -- | @'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@ -  --   parameter, which should be a number between 0 and 1. Larger -  --   values for @amount@ permit greater adjustments. If @amount@=1,-  --   the result should be identical to the @target@. If @amount@=0,-  --   the result should be the unmodified @pattern@.-  makeSimilar ∷ p → Metric p → p → p---- | @'diff' c pattern@ returns the positions of all nodes in ---   @c@, paired with the difference between @pattern@ and the node's ---   pattern.-diff -  ∷ (GridMap gm p, Pattern p, GridMap gm m,-    Metric p ~ m, BaseGrid gm p ~ BaseGrid gm m) ⇒ -    gm p → p → gm m-diff c pattern = GM.map (pattern `difference`) c---- | @classify c pattern@ returns the position of the node in @c@ ---   whose pattern best matches the input @pattern@.-classify-  ∷ (GridMap gm p, Pattern p, GridMap gm m,-      Metric p ~ m, Ord m, k ~ Index (BaseGrid gm p), -      BaseGrid gm m ~ BaseGrid gm p) ⇒ -    gm p → p → k-classify c pattern = -  fst $ minimumBy (comparing snd) $ toList $ diff c pattern---- | If @f d@ is a function that returns the learning rate to apply to a---   node based on its distance @d@from the node that best matches the---   input pattern, then @'train' c f pattern@ returns a modified copy---   of the classifier @c@ that has partially learned the @target@.-train-  ∷ (Ord m, GridMap gm p, GridMap gm m,-      GridMap gm (Int, p), GridMap gm (m, p), Grid (gm p),-      Pattern p, Metric p ~ m, Index (BaseGrid gm p) ~ Index (gm p),-      BaseGrid gm m ~ BaseGrid gm p) ⇒-    gm p → (Int → m) → p → gm p-train c f pattern = snd $ classifyAndTrain c f pattern+import qualified Math.Geometry.Grid as G (Grid(..))+import qualified Math.Geometry.GridMap as GM (GridMap(..))+import Data.Datamining.Pattern (Pattern(..))+import Data.Datamining.Clustering.Classifier(Classifier(..))+import Prelude hiding (lookup) --- | Same as @train@, but applied to multiple patterns.-trainBatch-  ∷ (Ord m, GridMap gm p, GridMap gm m,-      GridMap gm (Int, p), GridMap gm (m, p), Grid (gm p),-      Pattern p, Metric p ~ m, Index (BaseGrid gm p) ~ Index (gm p),-      BaseGrid gm m ~ BaseGrid gm p) ⇒-    gm p → (Int → m) → [p] → gm p-trainBatch c f ps = foldl' (\som → train som f) c ps+data SOM gm k p = SOM+  {+    sGridMap ∷ gm p,+    sLearningFunction ∷ Int → Int → Metric p,+    sCounter ∷ Int+  } --- | If @f@ is a function that returns the learning rate to apply to a---   node based on its distance from the node that best matches the ---   @target@, then @'classifyAndTrain' c f target@ returns a tuple ---   containing the position of the node in @c@ whose pattern best ---   matches the input @target@, and a modified copy of the classifier ---   @c@ that has partially learned the @target@.---   Invoking @classifyAndTrain c f p@ may be faster than invoking---   @(p `classify` c, train c f p)@, but they should give identical---   results.-classifyAndTrain-  ∷ (Ord m, GridMap gm p, GridMap gm m,-      GridMap gm (Int, p), GridMap gm (m, p), Grid (gm p),-      Pattern p, Metric p ~ m, Index (BaseGrid gm p) ~ Index (gm p),-      BaseGrid gm m ~ BaseGrid gm p) ⇒-     gm p → (Int → m) → p → (Index (gm p), gm p)-classifyAndTrain c f pattern = (bmu, c')-  where (bmu, _, c') = reportAndTrain c f pattern+currentLearningFunction ∷ SOM gm k p → (Int → Metric p)+currentLearningFunction s = (sLearningFunction s) (sCounter s) --- | If @f@ is a function that returns the learning rate to apply to a---   node based on its distance from the node that best matches the ---   @target@, then @'diffAndTrain' c f target@ returns a tuple ---   containing:---   1. The positions of all nodes in @c@, paired with the difference---      between @pattern@ and the node's pattern---   2. A modified copy of the classifier @c@ that has partially---      learned the @target@.---   Invoking @diffAndTrain c f p@ may be faster than invoking---   @(p `diff` c, train c f p)@, but they should give identical---   results.-diffAndTrain-  ∷ (Ord m, GridMap gm p, GridMap gm m,-      GridMap gm (Int, p), GridMap gm (m, p), Grid (gm p),-      Pattern p, Metric p ~ m, Index (BaseGrid gm p) ~ Index (gm p),-      BaseGrid gm m ~ BaseGrid gm p) ⇒-     gm p → (Int → m) → p → (gm m, gm p)-diffAndTrain c f pattern = (ds, c')-  where (_, ds, c') = reportAndTrain c f pattern+-- | Extract the grid and current models from the SOM.+toGridMap ∷ GM.GridMap gm p ⇒ SOM gm k p → gm p+toGridMap = sGridMap -reportAndTrain-  ∷ (Ord m, GridMap gm p, GridMap gm m,-      GridMap gm (Int, p), GridMap gm (m, p), Grid (gm p),-      Pattern p, Metric p ~ m, Index (BaseGrid gm p) ~ Index (gm p),-      BaseGrid gm m ~ BaseGrid gm p) ⇒-     gm p → (Int → m) → p → (Index (gm p), gm m, gm p)-reportAndTrain c f pattern = (bmu, ds, c')-  where ds = c `diff` pattern-        bmu = fst $ minimumBy (comparing snd) $ toList ds-        c' = trainWithBMU c f bmu pattern+adjustNode+  ∷ (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  trainWithBMU-  ∷ (GridMap gm p, GridMap gm (Int, p), GridMap gm (m, p),-      Grid (gm p), Pattern p, Metric p ~ m, k ~ Index (BaseGrid gm p), -      k ~ Index (gm p)) ⇒-    gm p → (Int → m) → k → p → gm p-trainWithBMU c f bmu pattern = GM.map (adjustNode pattern) lrMap-  where dMap = mapWithKey (\k p → (distance c k bmu, p)) c-        lrMap = GM.map (\(d,p) → (f d, p)) dMap+  ∷ (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+trainWithBMU s bmu target = s { sGridMap=gm' }+  where gm = sGridMap s+        gm' = GM.mapWithKey (adjustNode gm f target bmu) gm+        f = currentLearningFunction s -adjustNode ∷ (Pattern p) ⇒ p → (Metric p, p) → p-adjustNode target (r,p) = makeSimilar target r p+justTrain+  ∷ (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+justTrain s p = trainWithBMU s bmu p+  where ds = GM.toList . GM.map (p `difference`) . sGridMap $ s+        bmu = fst . minimumBy (comparing snd) $ ds ------ Using numeric vectors as patterns.--- +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)) ⇒ +    Classifier (SOM 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 ps = (foldl' justTrain s ps) {sCounter=sCounter s + 1}+  reportAndTrain s p = (bmu, ds, s'')+    where ds = differences s p+          bmu = fst . minimumBy (comparing snd) $ ds+          s' = trainWithBMU s bmu p+          s'' = s' { sCounter=sCounter s + 1} -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 xs ys = magnitudeSquared $ zipWith (-) xs ys+-- Creates a classifier with a default (bell-shaped) learning function.+defaultSOM +  ∷ Floating (Metric p) ⇒+  -- | The geometry and initial models for this classifier.+  --   A reasonable choice here is 'lazyGridMap g ps', where 'g' is a+  --   @'Math.Geometry.Grid.HexHexGrid'@, and 'ps' is a set of+  --   random patterns.+  gm p →+  -- | 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.+  Metric p →+  -- | The width of the bell curve at "time" zero.+  Metric p →+  -- | After this time, any learning done by the classifier will be+  --   negligible. Recommend setting this parameter to the number of+  --   patterns (or pattern batches) that will be presented to the+  --   classifier. An estimate is fine.+  Int →+  -- | The result+  SOM gm k p+defaultSOM gm r w t = +  SOM { +        sGridMap=gm, +        sLearningFunction=decayingGaussian r w t, +        sCounter=0+      } --- | @'adjustVector' target amount vector@ adjusts @vector@ to move it ---   closer to @target@. The amount of adjustment is controlled by the---   learning rate @r@, which is a number between 0 and 1. Larger values---   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 xs r ys-  | r < 0     = error "Negative learning rate"-  | r > 1     = error "Learning rate > 1"-  | r ≡ 1     = xs-  | otherwise = zipWith (+) ys deltas-      where ds = zipWith (-) xs ys-            deltas = map (r *) ds+-- Creates a classifier with a custom learning function.+customSOM ∷ +  -- | The geometry and initial models for this classifier.+  --   A reasonable choice here is 'lazyGridMap g ps', where 'g' is a+  --   @'Math.Geometry.Grid.HexHexGrid'@, and 'ps' is a set of+  --   random patterns.+  gm p →+  -- | A function used to adjust the models in the classifier.+  --   This function will be invoked with two parameters.+  --   The first parameter will indicate how many patterns (or pattern +  --   batches) have previously been presented to this classifier. +  --   Typically this is used to make the learning rate decay over time.+  --   The second parameter to the function is the grid distance from+  --   the node being updated to the BMU (Best Matching Unit).+  --   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.+  (Int → Int → Metric p) →+  -- | The result+  SOM gm k p+customSOM gm f = +  SOM {+        sGridMap=gm,+        sLearningFunction=f,+        sCounter=0+      } --- | A vector that has been normalised, i.e., the magnitude of the ---   vector = 1.-data NormalisedVector a = NormalisedVector [a] deriving Show --- | Normalises a vector-normalise ∷ Floating a ⇒ [a] → NormalisedVector a-normalise xs = NormalisedVector $ map (/x) xs-  where x = norm xs--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) ⇒ -    Pattern (NormalisedVector a) where-  type Metric (NormalisedVector a) = a-  difference (NormalisedVector xs) (NormalisedVector ys) = -    euclideanDistanceSquared xs ys-  makeSimilar (NormalisedVector xs) r (NormalisedVector ys) = -    normalise $ adjustVector xs r ys---- | A vector that has been scaled so that all elements in the vector ---   are between zero and one. To scale a set of vectors, use ---   @'scaleAll'@. Alternatively, if you can identify a maximum and ---   minimum value for each element in a vector, you can scale ---   individual vectors using @'scale'@.-data ScaledVector a = ScaledVector [a] deriving Show---- | Given a vector @qs@ of pairs of numbers, where each pair represents---   the maximum and minimum value to be expected at each position in ---   @xs@, @'scale' qs xs@ scales the vector @xs@ element by element, ---   mapping the maximum value expected at that position to one, and the---   minimum value to zero.-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 position 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 xss = map (scale qs) xss-  where qs = quantify xss--scaleValue ∷ Fractional a ⇒ (a,a) → a → a-scaleValue (minX,maxX) x = (x - minX) / (maxX-minX)--quantify ∷ Ord a ⇒ [[a]] → [(a,a)]-quantify xss = foldl' quantify' qs (tail xss)-  where qs = zip (head xss) (head xss)+-- | Calculates @r/e/^(-d^2/2w^2)@.+--   This form of the Gaussian function is useful as a learning rate+--   function. In @'gaussian' r w d@, @r@ specifies the highest learning+--   rate, which will be applied to the SOM node that best matches the+--   input pattern. The learning rate applied to other nodes will be +--   applied based on their distance @d@ from the best matching node. +--   The value @w@ controls the \'width\' of the Gaussian. Higher values+--   of @w@ cause the learning rate to fall off more slowly with +--   distance @d@.+gaussian ∷ Floating a ⇒ a → a → Int → a+gaussian r w d = r * exp (-d'*d'/(2*w*w))+  where d' = fromIntegral d -quantify' ∷ Ord a ⇒ [(a,a)] → [a] → [(a,a)]-quantify' = zipWith f-  where f (minX, maxX) x = (min minX x, max maxX x)+-- | Configures a typical learning function for classifiers.+--   @'decayingGaussian r w0 tMax' returns a bell curve-shaped function.+--   At time zero, the maximum learning rate (applied to the BMU) is +--   @r@, and the neighbourhood width is @w@. Over time the bell curve+--   shrinks and the learning rate tapers off, until at time @tMax@,+--   the learning rate is negligible.+decayingGaussian+  ∷ Floating a ⇒ a → a → Int → (Int → Int → a)+decayingGaussian r w0 tMax = +  \t d → let t' = fromIntegral t in gaussian r w0 d * exp (-t'/tMax')+  where tMax' = fromIntegral tMax -instance (Fractional a, Ord a, Eq a) ⇒ Pattern (ScaledVector a) where-  type Metric (ScaledVector a) = a-  difference (ScaledVector xs) (ScaledVector ys) = -    euclideanDistanceSquared xs ys-  makeSimilar (ScaledVector xs) r (ScaledVector ys) =-    ScaledVector $ adjustVector xs r ys
+ src/Data/Datamining/Pattern.hs view
@@ -0,0 +1,149 @@+------------------------------------------------------------------------+-- |+-- Module      :  Data.Datamining.Pattern+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- Tools for identifying patterns in data.+--+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts,+    MultiParamTypeClasses #-}+module Data.Datamining.Pattern+  (+    -- * Patterns+    Pattern(..),+    -- * Numeric vectors as patterns+    -- ** Normalised vectors+    NormalisedVector,+    normalise,+    -- ** Scaled vectors+    ScaledVector,+    scale,+    scaleAll,+    -- ** Useful functions+    -- $Vector+    adjustVector,+    euclideanDistanceSquared,+    magnitudeSquared+  ) where++import Data.Eq.Unicode ((≡))+import Data.List (foldl')++-- | A pattern to be learned or classified.+class Pattern p where+  type Metric p+  -- | 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+  -- | @'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@ +  --   parameter, which should be a number between 0 and 1. Larger +  --   values for @amount@ permit greater adjustments. If @amount@=1,+  --   the result should be identical to the @target@. If @amount@=0,+  --   the result should be the unmodified @pattern@.+  makeSimilar ∷ p → Metric p → p → p++--+-- Using numeric vectors as patterns.+-- ++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 xs ys = magnitudeSquared $ zipWith (-) xs ys++-- | @'adjustVector' target amount vector@ adjusts @vector@ to move it +--   closer to @target@. The amount of adjustment is controlled by the+--   learning rate @r@, which is a number between 0 and 1. Larger values+--   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 xs r ys+  | r < 0     = error "Negative learning rate"+  | r > 1     = error "Learning rate > 1"+  | r ≡ 1     = xs+  | otherwise = zipWith (+) ys deltas+      where ds = zipWith (-) xs ys+            deltas = map (r *) ds++-- | A vector that has been normalised, i.e., the magnitude of the +--   vector = 1.+data NormalisedVector a = NormalisedVector [a] deriving Show++-- | Normalises a vector+normalise ∷ Floating a ⇒ [a] → NormalisedVector a+normalise xs = NormalisedVector $ map (/x) xs+  where x = norm xs++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) ⇒ +    Pattern (NormalisedVector a) where+  type Metric (NormalisedVector a) = a+  difference (NormalisedVector xs) (NormalisedVector ys) = +    euclideanDistanceSquared xs ys+  makeSimilar (NormalisedVector xs) r (NormalisedVector ys) = +    normalise $ adjustVector xs r ys++-- | A vector that has been scaled so that all elements in the vector +--   are between zero and one. To scale a set of vectors, use +--   @'scaleAll'@. Alternatively, if you can identify a maximum and +--   minimum value for each element in a vector, you can scale +--   individual vectors using @'scale'@.+data ScaledVector a = ScaledVector [a] deriving Show++-- | Given a vector @qs@ of pairs of numbers, where each pair represents+--   the maximum and minimum value to be expected at each index in +--   @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 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 xss = map (scale qs) xss+  where qs = quantify xss++scaleValue ∷ Fractional a ⇒ (a,a) → a → a+scaleValue (minX,maxX) x = (x - minX) / (maxX-minX)++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' = zipWith f+  where f (minX, maxX) x = (min minX x, max maxX x)++instance (Fractional a, Ord a, Eq a) ⇒ Pattern (ScaledVector a) where+  type Metric (ScaledVector a) = a+  difference (ScaledVector xs) (ScaledVector ys) = +    euclideanDistanceSquared xs ys+  makeSimilar (ScaledVector xs) r (ScaledVector ys) =+    ScaledVector $ adjustVector xs r ys++{- $Vector+If you wish to use raw numeric vectors as a pattern, use+@no-warn-orphans@ and add the following to your code:++> instance (Floating a, Fractional a, Ord a, Eq a) ⇒ Pattern [a] a where+>   difference = euclideanDistanceSquared+>   makeSimilar = adjustVector+-}+
test/Main.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE UnicodeSyntax #-} module Main where +import Data.Datamining.PatternQC ( test ) import Data.Datamining.Clustering.SOMQC ( test )  import Test.Framework as TF ( defaultMain, Test )@@ -8,6 +9,7 @@ tests ∷ [TF.Test] tests =    [ +    Data.Datamining.PatternQC.test,     Data.Datamining.Clustering.SOMQC.test   ]