packages feed

som 7.0.1 → 7.2.0

raw patch · 4 files changed

+87/−131 lines, 4 files

Files

som.cabal view
@@ -1,5 +1,5 @@ name:           som-version:        7.0.1+version:        7.2.0 synopsis:       Self-Organising Maps description:    A Kohonen Self-organising Map (SOM) maps input patterns                  onto a regular grid (usually two-dimensional) where each
src/Data/Datamining/Clustering/DSOMInternal.hs view
@@ -114,8 +114,8 @@       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+  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,@@ -126,11 +126,11 @@   toList = GM.toList . sGridMap   numModels = G.tileCount . sGridMap   models = GM.elems . sGridMap-  differences s p = GM.toList . GM.map (p `difference`) . sGridMap $ s+  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+          bmu = fst $ minimumBy (comparing snd) ds           s' = trainNeighbourhood s bmu p
src/Data/Datamining/Clustering/SOM.hs view
@@ -44,13 +44,9 @@     -- * Deconstruction     toGridMap,     -- * Advanced control-    trainNeighbourhood,-    incrementCounter,-    counter,-    setCounter+    trainNeighbourhood   ) where  import Data.Datamining.Clustering.SOMInternal (SOM(..),-  DecayingGaussian(..), toGridMap, trainNeighbourhood, incrementCounter,-  counter, setCounter)+  DecayingGaussian(..), toGridMap, trainNeighbourhood)
src/Data/Datamining/Clustering/SOMInternal.hs view
@@ -26,9 +26,20 @@ import GHC.Generics (Generic) import Prelude hiding (lookup) +-- | A function used to adjust the models in a classifier. class LearningFunction f where   type LearningRate f-  rate :: f -> Int -> Int -> (LearningRate f)+  -- | @'rate' f t d@ returns the learning rate for a node.+  --   The parameter @f@ is the learning function.+  --   The parameter @t@ indicates how many patterns (or pattern+  --   batches) have previously been presented to the classifier.+  --   Typically this is used to make the learning rate decay over time.+  --   The parameter @d@ 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.+  rate :: f -> LearningRate f -> LearningRate f -> LearningRate f  -- | A typical learning function for classifiers. --   @'DecayingGaussian' r0 rf w0 wf tf@ returns a bell curve-shaped@@ -47,25 +58,23 @@ -- --   where << means "is much smaller than" (not the Haskell @<<@ --   operator!)-data DecayingGaussian a = DecayingGaussian a a a a Int+data DecayingGaussian a = DecayingGaussian a a a a a   deriving (Eq, Show, Generic) -instance (Floating a, Fractional a, Num a) =>-         LearningFunction (DecayingGaussian a) where+instance (Floating a, Fractional a, Num a)+    => LearningFunction (DecayingGaussian a) where   type LearningRate (DecayingGaussian a) = a-  rate (DecayingGaussian r0 rf w0 wf tf) t d = r * exp (-(d'*d')/(w*w))-    where a = t'/tf'+  rate (DecayingGaussian r0 rf w0 wf tf) t d = r * exp (-(d*d)/(w*w))+    where a = t/tf           r = r0 * ((rf/r0)**a)           w = w0 * ((wf/w0)**a)-          t' = fromIntegral t-          tf' = fromIntegral tf-          d' = fromIntegral d  -- | A learning function that only updates the BMU and has a constant --   learning rate. data StepFunction a = StepFunction a deriving (Eq, Show, Generic) -instance (Fractional a) => LearningFunction (StepFunction a) where+instance (Fractional a, Eq a)+  => LearningFunction (StepFunction a) where   type LearningRate (StepFunction a) = a   rate (StepFunction r) _ d = if d == 0 then r else 0.0 @@ -90,52 +99,63 @@ --      just return an @error@). It would be problematic to implement --      them because the input SOM and the output SOM would have to have --      the same @Metric@ type.-data SOM f gm k p = SOM+data SOM f t gm k p = SOM   {-    sGridMap :: gm p,-    sLearningFunction :: f,-    sCounter :: Int+    -- | Maps patterns to tiles in a regular grid.+    --   In the context of a SOM, the tiles are called "nodes"+    gridMap :: gm p,+    -- | The function used to update the nodes.+    learningFunction :: f,+    -- | A counter used as a "time" parameter.+    --   If you create the SOM with a counter value @0@, and don't+    --   directly modify it, then the counter will represent the number+    --   of patterns that this SOM has classified.+    counter :: t   } deriving (Eq, Show, Generic) -instance (F.Foldable gm) => F.Foldable (SOM f gm k) where-  foldr f x g = F.foldr f x (sGridMap g)+instance (F.Foldable gm) => F.Foldable (SOM f t gm k) where+  foldr f x g = F.foldr f x (gridMap g) -instance (G.Grid (gm p)) => G.Grid (SOM f gm k p) where-  type Index (SOM f gm k p) = G.Index (gm p)-  type Direction (SOM f 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 (G.Grid (gm p)) => G.Grid (SOM f t gm k p) where+  type Index (SOM f t gm k p) = G.Index (gm p)+  type Direction (SOM f t gm k p) = G.Direction (gm p)+  indices = G.indices . gridMap+  distance = G.distance . gridMap+  neighbours = G.neighbours . gridMap+  contains = G.contains . gridMap+  viewpoint = G.viewpoint . gridMap+  directionTo = G.directionTo . gridMap+  tileCount = G.tileCount . gridMap+  null = G.null . gridMap+  nonNull = G.nonNull . gridMap -instance (F.Foldable gm, GM.GridMap gm p, G.Grid (GM.BaseGrid gm p)) => GM.GridMap (SOM f gm k) p where-  type BaseGrid (SOM f gm k) p = GM.BaseGrid gm p-  toGrid = GM.toGrid . sGridMap-  toMap = GM.toMap . sGridMap+instance (F.Foldable gm, GM.GridMap gm p, G.Grid (GM.BaseGrid gm p))+    => GM.GridMap (SOM f t gm k) p where+  type BaseGrid (SOM f t gm k) p = GM.BaseGrid gm p+  toGrid = GM.toGrid . gridMap+  toMap = GM.toMap . gridMap   mapWithKey = error "Not implemented"-  adjustWithKey f k s = s { sGridMap=gm' }-    where gm = sGridMap s+  adjustWithKey f k s = s { gridMap=gm' }+    where gm = gridMap s           gm' = GM.adjustWithKey f k gm  currentLearningFunction-  :: (LearningFunction f, LearningRate f ~ Metric p)-    => SOM f gm k p -> (Int -> Metric p)-currentLearningFunction s = (rate . sLearningFunction $ s) (sCounter s)+  :: (LearningFunction f, Metric p ~ LearningRate f,+    Num (LearningRate f), Integral t)+      => SOM f t gm k p -> (LearningRate f -> Metric p)+currentLearningFunction s+  = rate (learningFunction s) (fromIntegral $ counter s)  -- | Extracts the grid and current models from the SOM.-toGridMap :: GM.GridMap gm p => SOM f gm k p -> gm p-toGridMap = sGridMap+--   A synonym for @'gridMap'@.+toGridMap :: GM.GridMap gm p => SOM f t gm k p -> gm p+toGridMap = gridMap  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, Num t) =>+     g -> (t -> Metric p) -> p -> k -> k -> p -> p adjustNode g f target bmu k = makeSimilar target (f d)-  where d = G.distance g bmu k+  where d = fromIntegral $ G.distance g bmu k  -- | Trains the specified node and the neighbourood around it to better --   match a target.@@ -144,100 +164,40 @@ trainNeighbourhood   :: (Pattern p, G.Grid (gm p), GM.GridMap gm p,       G.Index (GM.BaseGrid gm p) ~ G.Index (gm p), LearningFunction f,-      LearningRate f ~ Metric p) =>-     SOM f gm k p -> G.Index (gm p) -> p -> SOM f gm k p-trainNeighbourhood s bmu target = s { sGridMap=gm' }-  where gm = sGridMap s+      Metric p ~ LearningRate f, Num (LearningRate f), Integral t) =>+     SOM f t gm k p -> G.Index (gm p) -> p -> SOM f t gm k p+trainNeighbourhood s bmu target = s { gridMap=gm' }+  where gm = gridMap s         gm' = GM.mapWithKey (adjustNode gm f target bmu) gm         f = currentLearningFunction s -incrementCounter :: SOM f gm k p -> SOM f gm k p-incrementCounter s = setCounter (sCounter s + 1) s--counter :: SOM f gm k p -> Int-counter = sCounter--setCounter :: Int -> SOM f gm k p -> SOM f gm k p-setCounter k s = s { sCounter = k }+incrementCounter :: Num t => SOM f t gm k p -> SOM f t gm k p+incrementCounter s = s { counter=counter s + 1}  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), LearningFunction f,-      LearningRate f ~ Metric p) =>-     SOM f gm k p -> p -> SOM f gm k p+      Metric p ~ LearningRate f, Num (LearningRate f), Integral t) =>+     SOM f t gm k p -> p -> SOM f t 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+  where ds = GM.toList . GM.map (p `difference`) $ gridMap s+        bmu = fst $ minimumBy (comparing snd) ds  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),-  LearningFunction f, LearningRate f ~ Metric p) =>-    Classifier (SOM f 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+  LearningFunction f, Metric p ~ LearningRate f, Num (LearningRate f),+  Integral t)+    => Classifier (SOM f t gm) k p where+  toList = GM.toList . gridMap+  numModels = G.tileCount . gridMap+  models = GM.elems . gridMap+  differences s p = GM.toList . GM.map (p `difference`) $ gridMap s   trainBatch s = incrementCounter . foldl' justTrain s   reportAndTrain s p = (bmu, ds, incrementCounter s')     where ds = differences s p-          bmu = fst . minimumBy (comparing snd) $ ds+          bmu = fst $ minimumBy (comparing snd) ds           s' = trainNeighbourhood s bmu p----- -- | Creates a classifier with a default (bell-shaped) learning--- --   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.--- ----- --   [@r0@] See description in @'decayingGaussian2'@.--- ----- --   [@rf@] See description in @'decayingGaussian2'@.--- ----- --   [@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 -> Metric p ->---      Metric p -> Int -> SOM f gm k p--- defaultSOM gm r0 rf w0 wf tf =---   SOM {---         sGridMap=gm,---         sLearningFunction=DecayingGaussian r0 rf w0 wf tf,---         sCounter=0---       }---- -- | Creates a classifier with a custom learning function.--- --   Usage is @'customSOM' 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 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.--- customSOM---   :: (LearningFunction f, LearningRate f ~ Metric p)---     => gm p -> f -> SOM f gm k p--- customSOM gm f =---   SOM {---         sGridMap=gm,---         sLearningFunction=f,---         sCounter=0---       }-