------------------------------------------------------------------------
-- |
-- Module      :  Data.Datamining.Clustering.SOMInternal
-- Copyright   :  (c) 2012-2021 Amy de Buitléir
-- License     :  BSD-style
-- Maintainer  :  amy@nualeargais.ie
-- Stability   :  experimental
-- Portability :  portable
--
-- A module containing private @SOM@ internals. Most developers should
-- use @SOM@ instead. This module is subject to change without notice.
--
------------------------------------------------------------------------
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.Datamining.Clustering.SOMInternal where

import           Prelude                               hiding (lookup)

import           Control.DeepSeq                       (NFData)
import           Data.Datamining.Clustering.Classifier (Classifier (..))
import qualified Data.Foldable                         as F (Foldable, foldr)
import           Data.List                             (foldl', minimumBy)
import           Data.Ord                              (comparing)
import           GHC.Generics                          (Generic)
import qualified Math.Geometry.Grid                    as G (Grid (..))
import qualified Math.Geometry.GridMap                 as GM (GridMap (..))

-- | A typical learning function for classifiers.
--   @'decayingGaussian' r0 rf w0 wf tf@ returns a bell curve-shaped
--   function. At time zero, the maximum learning rate (applied to the
--   BMU) is @r0@, and the neighbourhood width is @w0@. Over time the
--   bell curve shrinks and the learning rate tapers off, until at time
--   @tf@, the maximum learning rate (applied to the BMU) is @rf@,
--   and the neighbourhood width is @wf@. Normally the parameters
--   should be chosen such that:
--
--   * 0 < rf << r0 < 1
--
--   * 0 < wf << w0
--
--   * 0 < tf
--
--   where << means "is much smaller than" (not the Haskell @<<@
--   operator!)
decayingGaussian :: Floating x => x -> x -> x -> x -> x -> x -> x -> x
decayingGaussian :: x -> x -> x -> x -> x -> x -> x -> x
decayingGaussian x
r0 x
rf x
w0 x
wf x
tf x
t x
d = x
r x -> x -> x
forall a. Num a => a -> a -> a
* x -> x
forall a. Floating a => a -> a
exp (-x
xx -> x -> x
forall a. Fractional a => a -> a -> a
/x
y)
  where a :: x
a = x
t x -> x -> x
forall a. Fractional a => a -> a -> a
/ x
tf
        r :: x
r = x
r0 x -> x -> x
forall a. Num a => a -> a -> a
* ((x
rfx -> x -> x
forall a. Fractional a => a -> a -> a
/x
r0)x -> x -> x
forall a. Floating a => a -> a -> a
**x
a)
        w :: x
w = x
w0 x -> x -> x
forall a. Num a => a -> a -> a
* ((x
wfx -> x -> x
forall a. Fractional a => a -> a -> a
/x
w0)x -> x -> x
forall a. Floating a => a -> a -> a
**x
a)
        x :: x
x =  (x
dx -> x -> x
forall a. Num a => a -> a -> a
*x
d)
        y :: x
y =  (x
2x -> x -> x
forall a. Num a => a -> a -> a
*x
wx -> x -> x
forall a. Num a => a -> a -> a
*x
w)

-- | A learning function that only updates the BMU and has a constant
--   learning rate.
stepFunction :: (Num d, Fractional x, Eq d) => x -> t -> d -> x
stepFunction :: x -> t -> d -> x
stepFunction x
r t
_ d
d = if d
d d -> d -> Bool
forall a. Eq a => a -> a -> Bool
== d
0 then x
r else x
0.0

-- | A learning function that updates all nodes with the same, constant
--   learning rate. This can be useful for testing.
constantFunction :: x -> t -> d -> x
constantFunction :: x -> t -> d -> x
constantFunction x
r t
_ d
_ = x
r

-- | A Self-Organising Map (SOM).
--
--   Although @SOM@ 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 SOM and the output SOM would have to have
--      the same @Metric@ type.
data SOM t d gm x k p = SOM
  {
    -- | Maps patterns to tiles in a regular grid.
    --   In the context of a SOM, the tiles are called "nodes"
    SOM t d gm x k p -> gm p
gridMap      :: gm p,
    -- | A function which determines the how quickly the SOM learns.
    --   For example, if the function is @f@, then @f t d@ returns the
    --   learning rate for a node.
    --   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.
    SOM t d gm x k p -> t -> d -> x
learningRate :: t -> d -> x,
    -- | A function which 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.
    SOM t d gm x k p -> p -> p -> x
difference   :: p -> p -> x,
    -- | A function which updates models.
    --   If this function is @f@, then @f 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@.
    SOM t d gm x k p -> p -> x -> p -> p
makeSimilar  :: p -> x -> p -> p,
    -- | 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.
    SOM t d gm x k p -> t
counter      :: t
  } deriving ((forall x. SOM t d gm x k p -> Rep (SOM t d gm x k p) x)
-> (forall x. Rep (SOM t d gm x k p) x -> SOM t d gm x k p)
-> Generic (SOM t d gm x k p)
forall x. Rep (SOM t d gm x k p) x -> SOM t d gm x k p
forall x. SOM t d gm x k p -> Rep (SOM t d gm x k p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t d (gm :: * -> *) x k p x.
Rep (SOM t d gm x k p) x -> SOM t d gm x k p
forall t d (gm :: * -> *) x k p x.
SOM t d gm x k p -> Rep (SOM t d gm x k p) x
$cto :: forall t d (gm :: * -> *) x k p x.
Rep (SOM t d gm x k p) x -> SOM t d gm x k p
$cfrom :: forall t d (gm :: * -> *) x k p x.
SOM t d gm x k p -> Rep (SOM t d gm x k p) x
Generic, SOM t d gm x k p -> ()
(SOM t d gm x k p -> ()) -> NFData (SOM t d gm x k p)
forall a. (a -> ()) -> NFData a
forall t d (gm :: * -> *) x k p.
(NFData t, NFData (gm p)) =>
SOM t d gm x k p -> ()
rnf :: SOM t d gm x k p -> ()
$crnf :: forall t d (gm :: * -> *) x k p.
(NFData t, NFData (gm p)) =>
SOM t d gm x k p -> ()
NFData)

instance (F.Foldable gm) => F.Foldable (SOM t d gm x k) where
  foldr :: (a -> b -> b) -> b -> SOM t d gm x k a -> b
foldr a -> b -> b
f b
x SOM t d gm x k a
g = (a -> b -> b) -> b -> gm a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> b -> b
f b
x (SOM t d gm x k a -> gm a
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap SOM t d gm x k a
g)

instance (G.Grid (gm p)) => G.Grid (SOM t d gm x k p) where
  type Index (SOM t d gm x k p) = G.Index (gm p)
  type Direction (SOM t d gm x k p) = G.Direction (gm p)
  indices :: SOM t d gm x k p -> [Index (SOM t d gm x k p)]
indices = gm p -> [Index (gm p)]
forall g. Grid g => g -> [Index g]
G.indices (gm p -> [Index (gm p)])
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> [Index (gm p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  distance :: SOM t d gm x k p
-> Index (SOM t d gm x k p) -> Index (SOM t d gm x k p) -> Int
distance = gm p -> Index (gm p) -> Index (gm p) -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
G.distance (gm p -> Index (gm p) -> Index (gm p) -> Int)
-> (SOM t d gm x k p -> gm p)
-> SOM t d gm x k p
-> Index (gm p)
-> Index (gm p)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  neighbours :: SOM t d gm x k p
-> Index (SOM t d gm x k p) -> [Index (SOM t d gm x k p)]
neighbours = gm p -> Index (gm p) -> [Index (gm p)]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
G.neighbours (gm p -> Index (gm p) -> [Index (gm p)])
-> (SOM t d gm x k p -> gm p)
-> SOM t d gm x k p
-> Index (gm p)
-> [Index (gm p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  contains :: SOM t d gm x k p -> Index (SOM t d gm x k p) -> Bool
contains = gm p -> Index (gm p) -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
G.contains (gm p -> Index (gm p) -> Bool)
-> (SOM t d gm x k p -> gm p)
-> SOM t d gm x k p
-> Index (gm p)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  viewpoint :: SOM t d gm x k p
-> Index (SOM t d gm x k p) -> [(Index (SOM t d gm x k p), Int)]
viewpoint = gm p -> Index (gm p) -> [(Index (gm p), Int)]
forall g. Grid g => g -> Index g -> [(Index g, Int)]
G.viewpoint (gm p -> Index (gm p) -> [(Index (gm p), Int)])
-> (SOM t d gm x k p -> gm p)
-> SOM t d gm x k p
-> Index (gm p)
-> [(Index (gm p), Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  directionTo :: SOM t d gm x k p
-> Index (SOM t d gm x k p)
-> Index (SOM t d gm x k p)
-> [Direction (SOM t d gm x k p)]
directionTo = gm p -> Index (gm p) -> Index (gm p) -> [Direction (gm p)]
forall g. Grid g => g -> Index g -> Index g -> [Direction g]
G.directionTo (gm p -> Index (gm p) -> Index (gm p) -> [Direction (gm p)])
-> (SOM t d gm x k p -> gm p)
-> SOM t d gm x k p
-> Index (gm p)
-> Index (gm p)
-> [Direction (gm p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  tileCount :: SOM t d gm x k p -> Int
tileCount = gm p -> Int
forall g. Grid g => g -> Int
G.tileCount (gm p -> Int)
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  null :: SOM t d gm x k p -> Bool
null = gm p -> Bool
forall g. Grid g => g -> Bool
G.null (gm p -> Bool)
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  nonNull :: SOM t d gm x k p -> Bool
nonNull = gm p -> Bool
forall g. Grid g => g -> Bool
G.nonNull (gm p -> Bool)
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap

instance (F.Foldable gm, GM.GridMap gm p, G.Grid (GM.BaseGrid gm p))
    => GM.GridMap (SOM t d gm x k) p where
  type BaseGrid (SOM t d gm x k) p = GM.BaseGrid gm p
  toGrid :: SOM t d gm x k p -> BaseGrid (SOM t d gm x k) p
toGrid = gm p -> BaseGrid gm p
forall (gm :: * -> *) v. GridMap gm v => gm v -> BaseGrid gm v
GM.toGrid (gm p -> BaseGrid gm p)
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> BaseGrid gm p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  toMap :: SOM t d gm x k p -> Map k p
toMap = gm p -> Map k p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v)) =>
gm v -> Map k v
GM.toMap (gm p -> Map k p)
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> Map k p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  mapWithKey :: (k -> p -> v2) -> SOM t d gm x k p -> SOM t d gm x k v2
mapWithKey = [Char] -> (k -> p -> v2) -> SOM t d gm x k p -> SOM t d gm x k v2
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented"
  delete :: k -> SOM t d gm x k p -> SOM t d gm x k p
delete k
k = (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
forall (gm :: * -> *) p t d x k.
(gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
withGridMap (k -> gm p -> gm p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v), Ord k) =>
k -> gm v -> gm v
GM.delete k
k)
  adjustWithKey :: (k -> p -> p) -> k -> SOM t d gm x k p -> SOM t d gm x k p
adjustWithKey k -> p -> p
f k
k = (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
forall (gm :: * -> *) p t d x k.
(gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
withGridMap ((k -> p -> p) -> k -> gm p -> gm p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v), Ord k) =>
(k -> v -> v) -> k -> gm v -> gm v
GM.adjustWithKey k -> p -> p
f k
k)
  insertWithKey :: (k -> p -> p -> p)
-> k -> p -> SOM t d gm x k p -> SOM t d gm x k p
insertWithKey k -> p -> p -> p
f k
k p
v = (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
forall (gm :: * -> *) p t d x k.
(gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
withGridMap ((k -> p -> p -> p) -> k -> p -> gm p -> gm p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v), Ord k) =>
(k -> v -> v -> v) -> k -> v -> gm v -> gm v
GM.insertWithKey k -> p -> p -> p
f k
k p
v)
  alter :: (Maybe p -> Maybe p) -> k -> SOM t d gm x k p -> SOM t d gm x k p
alter Maybe p -> Maybe p
f k
k = (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
forall (gm :: * -> *) p t d x k.
(gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
withGridMap ((Maybe p -> Maybe p) -> k -> gm p -> gm p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v), Ord k) =>
(Maybe v -> Maybe v) -> k -> gm v -> gm v
GM.alter Maybe p -> Maybe p
f k
k)
  filterWithKey :: (k -> p -> Bool) -> SOM t d gm x k p -> SOM t d gm x k p
filterWithKey k -> p -> Bool
f = (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
forall (gm :: * -> *) p t d x k.
(gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
withGridMap ((k -> p -> Bool) -> gm p -> gm p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v)) =>
(k -> v -> Bool) -> gm v -> gm v
GM.filterWithKey k -> p -> Bool
f)

-- | Internal method.
withGridMap :: (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
withGridMap :: (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p
withGridMap gm p -> gm p
f SOM t d gm x k p
s = SOM t d gm x k p
s { gridMap :: gm p
gridMap=gm p
gm' }
    where gm :: gm p
gm = SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap SOM t d gm x k p
s
          gm' :: gm p
gm' = gm p -> gm p
f gm p
gm

-- | Returns the learning function currently being used by the SOM.
currentLearningFunction :: (Num t) => SOM t d gm x k p -> (d -> x)
currentLearningFunction :: SOM t d gm x k p -> d -> x
currentLearningFunction SOM t d gm x k p
s
  = (SOM t d gm x k p -> t -> d -> x
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> t -> d -> x
learningRate SOM t d gm x k p
s) (SOM t d gm x k p -> t
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> t
counter SOM t d gm x k p
s)

-- | Extracts the grid and current models from the SOM.
--   A synonym for @'gridMap'@.
toGridMap :: GM.GridMap gm p => SOM t d gm x k p -> gm p
toGridMap :: SOM t d gm x k p -> gm p
toGridMap = SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap

-- | Internal method.
adjustNode
  :: (G.Grid g, k ~ G.Index g, Num t) =>
     g -> (t -> x) -> (p -> x -> p -> p) -> p -> k -> k -> p -> p
adjustNode :: g -> (t -> x) -> (p -> x -> p -> p) -> p -> k -> k -> p -> p
adjustNode g
g t -> x
rateF p -> x -> p -> p
adjustF p
target k
bmu k
k = p -> x -> p -> p
adjustF p
target (t -> x
rateF t
d)
  where d :: t
d = Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> t) -> Int -> t
forall a b. (a -> b) -> a -> b
$ g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
G.distance g
g k
Index g
bmu k
Index g
k

-- | 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
  :: (G.Grid (gm p), GM.GridMap gm p,
      G.Index (GM.BaseGrid gm p) ~ G.Index (gm p), Num t, Num x,
      Num d) =>
     SOM t d gm x k p -> G.Index (gm p) -> p -> SOM t d gm x k p
trainNeighbourhood :: SOM t d gm x k p -> Index (gm p) -> p -> SOM t d gm x k p
trainNeighbourhood SOM t d gm x k p
s Index (gm p)
bmu p
target = SOM t d gm x k p
s { gridMap :: gm p
gridMap=gm p
gm' }
  where gm :: gm p
gm = SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap SOM t d gm x k p
s
        gm' :: gm p
gm' = (Index (gm p) -> p -> p) -> gm p -> gm p
forall (gm :: * -> *) v k v2.
(GridMap gm v, k ~ Index (BaseGrid gm v),
 k ~ Index (BaseGrid gm v2), GridMap gm v2) =>
(k -> v -> v2) -> gm v -> gm v2
GM.mapWithKey (gm p
-> (d -> x)
-> (p -> x -> p -> p)
-> p
-> Index (gm p)
-> Index (gm p)
-> p
-> p
forall g k t x p.
(Grid g, k ~ Index g, Num t) =>
g -> (t -> x) -> (p -> x -> p -> p) -> p -> k -> k -> p -> p
adjustNode gm p
gm d -> x
f1 p -> x -> p -> p
f2 p
target Index (gm p)
bmu) gm p
gm
        f1 :: d -> x
f1 = SOM t d gm x k p -> d -> x
forall t d (gm :: * -> *) x k p.
Num t =>
SOM t d gm x k p -> d -> x
currentLearningFunction SOM t d gm x k p
s
        f2 :: p -> x -> p -> p
f2 = SOM t d gm x k p -> p -> x -> p -> p
forall t d (gm :: * -> *) x k p.
SOM t d gm x k p -> p -> x -> p -> p
makeSimilar SOM t d gm x k p
s

-- | Increment the match counter.
incrementCounter :: Num t => SOM t d gm x k p -> SOM t d gm x k p
incrementCounter :: SOM t d gm x k p -> SOM t d gm x k p
incrementCounter SOM t d gm x k p
s = SOM t d gm x k p
s { counter :: t
counter=SOM t d gm x k p -> t
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> t
counter SOM t d gm x k p
s t -> t -> t
forall a. Num a => a -> a -> a
+ t
1}

-- | Internal method.
justTrain
  :: (Ord x, G.Grid (gm p), GM.GridMap gm x, GM.GridMap gm p,
      G.Index (GM.BaseGrid gm x) ~ G.Index (gm p),
      G.Index (GM.BaseGrid gm p) ~ G.Index (gm p), Num t, Num x,
      Num d) =>
     SOM t d gm x k p -> p -> SOM t d gm x k p
justTrain :: SOM t d gm x k p -> p -> SOM t d gm x k p
justTrain SOM t d gm x k p
s p
p = SOM t d gm x k p -> Index (gm p) -> p -> SOM t d gm x k p
forall (gm :: * -> *) p t x d k.
(Grid (gm p), GridMap gm p, Index (BaseGrid gm p) ~ Index (gm p),
 Num t, Num x, Num d) =>
SOM t d gm x k p -> Index (gm p) -> p -> SOM t d gm x k p
trainNeighbourhood SOM t d gm x k p
s Index (gm p)
bmu p
p
  where ds :: [(Index (gm p), x)]
ds = gm x -> [(Index (gm p), x)]
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v)) =>
gm v -> [(k, v)]
GM.toList (gm x -> [(Index (gm p), x)])
-> (gm p -> gm x) -> gm p -> [(Index (gm p), x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> x) -> gm p -> gm x
forall (gm :: * -> *) v v2.
(GridMap gm v, GridMap gm v2,
 Index (BaseGrid gm v) ~ Index (BaseGrid gm v2)) =>
(v -> v2) -> gm v -> gm v2
GM.map (SOM t d gm x k p -> p -> p -> x
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> p -> p -> x
difference SOM t d gm x k p
s p
p) (gm p -> [(Index (gm p), x)]) -> gm p -> [(Index (gm p), x)]
forall a b. (a -> b) -> a -> b
$ SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap SOM t d gm x k p
s
        bmu :: Index (gm p)
bmu = [(Index (gm p), x)] -> Index (gm p)
forall b p. Ord b => [(p, b)] -> p
f [(Index (gm p), x)]
ds
        f :: [(p, b)] -> p
f [] = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"SOM has no models"
        f [(p, b)]
xs = (p, b) -> p
forall a b. (a, b) -> a
fst ((p, b) -> p) -> (p, b) -> p
forall a b. (a -> b) -> a -> b
$ ((p, b) -> (p, b) -> Ordering) -> [(p, b)] -> (p, b)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((p, b) -> b) -> (p, b) -> (p, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (p, b) -> b
forall a b. (a, b) -> b
snd) [(p, b)]
xs

instance
  (GM.GridMap gm p, k ~ G.Index (GM.BaseGrid gm p), G.Grid (gm p),
  GM.GridMap gm x, k ~ G.Index (gm p), k ~ G.Index (GM.BaseGrid gm x),
  Num t, Ord x, Num x, Num d)
    => Classifier (SOM t d gm) x k p where
  toList :: SOM t d gm x k p -> [(k, p)]
toList = gm p -> [(k, p)]
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v)) =>
gm v -> [(k, v)]
GM.toList (gm p -> [(k, p)])
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> [(k, p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  numModels :: SOM t d gm x k p -> Int
numModels = gm p -> Int
forall g. Grid g => g -> Int
G.tileCount (gm p -> Int)
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  models :: SOM t d gm x k p -> [p]
models = gm p -> [p]
forall (gm :: * -> *) v. GridMap gm v => gm v -> [v]
GM.elems (gm p -> [p])
-> (SOM t d gm x k p -> gm p) -> SOM t d gm x k p -> [p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap
  differences :: SOM t d gm x k p -> p -> [(k, x)]
differences SOM t d gm x k p
s p
p = gm x -> [(k, x)]
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v)) =>
gm v -> [(k, v)]
GM.toList (gm x -> [(k, x)]) -> (gm p -> gm x) -> gm p -> [(k, x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> x) -> gm p -> gm x
forall (gm :: * -> *) v v2.
(GridMap gm v, GridMap gm v2,
 Index (BaseGrid gm v) ~ Index (BaseGrid gm v2)) =>
(v -> v2) -> gm v -> gm v2
GM.map (SOM t d gm x k p -> p -> p -> x
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> p -> p -> x
difference SOM t d gm x k p
s p
p) (gm p -> [(k, x)]) -> gm p -> [(k, x)]
forall a b. (a -> b) -> a -> b
$ SOM t d gm x k p -> gm p
forall t d (gm :: * -> *) x k p. SOM t d gm x k p -> gm p
gridMap SOM t d gm x k p
s
  trainBatch :: SOM t d gm x k p -> [p] -> SOM t d gm x k p
trainBatch SOM t d gm x k p
s = SOM t d gm x k p -> SOM t d gm x k p
forall t d (gm :: * -> *) x k p.
Num t =>
SOM t d gm x k p -> SOM t d gm x k p
incrementCounter (SOM t d gm x k p -> SOM t d gm x k p)
-> ([p] -> SOM t d gm x k p) -> [p] -> SOM t d gm x k p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SOM t d gm x k p -> p -> SOM t d gm x k p)
-> SOM t d gm x k p -> [p] -> SOM t d gm x k p
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SOM t d gm x k p -> p -> SOM t d gm x k p
forall x (gm :: * -> *) p t d k.
(Ord x, Grid (gm p), GridMap gm x, GridMap gm p,
 Index (BaseGrid gm x) ~ Index (gm p),
 Index (BaseGrid gm p) ~ Index (gm p), Num t, Num x, Num d) =>
SOM t d gm x k p -> p -> SOM t d gm x k p
justTrain SOM t d gm x k p
s
  reportAndTrain :: SOM t d gm x k p -> p -> (k, [(k, x)], SOM t d gm x k p)
reportAndTrain SOM t d gm x k p
s p
p = (k
bmu, [(k, x)]
ds, SOM t d gm x k p -> SOM t d gm x k p
forall t d (gm :: * -> *) x k p.
Num t =>
SOM t d gm x k p -> SOM t d gm x k p
incrementCounter SOM t d gm x k p
s')
    where ds :: [(k, x)]
ds = SOM t d gm x k p -> p -> [(k, x)]
forall (c :: * -> * -> * -> *) v k p.
Classifier c v k p =>
c v k p -> p -> [(k, v)]
differences SOM t d gm x k p
s p
p
          bmu :: k
bmu = (k, x) -> k
forall a b. (a, b) -> a
fst ((k, x) -> k) -> (k, x) -> k
forall a b. (a -> b) -> a -> b
$ ((k, x) -> (k, x) -> Ordering) -> [(k, x)] -> (k, x)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((k, x) -> x) -> (k, x) -> (k, x) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (k, x) -> x
forall a b. (a, b) -> b
snd) [(k, x)]
ds
          s' :: SOM t d gm x k p
s' = SOM t d gm x k p -> Index (gm p) -> p -> SOM t d gm x k p
forall (gm :: * -> *) p t x d k.
(Grid (gm p), GridMap gm p, Index (BaseGrid gm p) ~ Index (gm p),
 Num t, Num x, Num d) =>
SOM t d gm x k p -> Index (gm p) -> p -> SOM t d gm x k p
trainNeighbourhood SOM t d gm x k p
s k
Index (gm p)
bmu p
p