------------------------------------------------------------------------
-- |
-- Module      :  Data.Datamining.Clustering.SGMInternal
-- Copyright   :  (c) 2012-2021 Amy de Buitléir
-- License     :  BSD-style
-- Maintainer  :  amy@nualeargais.ie
-- Stability   :  experimental
-- Portability :  portable
--
-- A module containing private @SGM@ internals. Most developers should
-- use @SGM@ 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.SGMInternal where

import           Prelude         hiding (lookup)

import           Control.DeepSeq (NFData)
import           Data.List       (foldl', minimumBy, sortBy)
import qualified Data.Map.Strict as M
import           Data.Ord        (comparing)
import           GHC.Generics    (Generic)

-- | A typical learning function for classifiers.
--   @'exponential' r0 d t@ returns the learning rate at time @t@.
--   When @t = 0@, the learning rate is @r0@.
--   Over time the learning rate decays exponentially; the decay rate is
--   @d@.
--   Normally the parameters are chosen such that:
--
--   * 0 < r0 < 1
--
--   * 0 < d
exponential :: (Floating a, Integral t) => a -> a -> t -> a
exponential :: a -> a -> t -> a
exponential a
r0 a
d t
t = a
r0 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
exp (-a
da -> a -> a
forall a. Num a => a -> a -> a
*a
t')
  where t' :: a
t' = t -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
t

-- | A Simplified Self-Organising Map (SGM).
--   @t@ is the type of the counter.
--   @x@ is the type of the learning rate and the difference metric.
--   @k@ is the type of the model indices.
--   @p@ is the type of the input patterns and models.
data SGM t x k p = SGM
  {
    -- | Maps patterns and match counts to nodes.
    SGM t x k p -> Map k (p, t)
toMap         :: M.Map k (p, t),
    -- | A function which determines the learning rate for a node.
    --   The input parameter 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 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.
    SGM t x k p -> t -> x
learningRate  :: t -> x,
    -- | The maximum number of models this SGM can hold.
    SGM t x k p -> Int
maxSize       :: Int,
    -- | The threshold that triggers creation of a new model.
    SGM t x k p -> x
diffThreshold :: x,
    -- | Delete existing models to make room for new ones? The least
    --   useful (least frequently matched) models will be deleted first.
    SGM t x k p -> Bool
allowDeletion :: Bool,
    -- | 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.
    SGM t x k p -> p -> p -> x
difference    :: p -> p -> x,
    -- | A function which updates models.
    --   For example, 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@.
    SGM t x k p -> p -> x -> p -> p
makeSimilar   :: p -> x -> p -> p,
    -- | Index for the next node to add to the SGM.
    SGM t x k p -> k
nextIndex     :: k
  } deriving ((forall x. SGM t x k p -> Rep (SGM t x k p) x)
-> (forall x. Rep (SGM t x k p) x -> SGM t x k p)
-> Generic (SGM t x k p)
forall x. Rep (SGM t x k p) x -> SGM t x k p
forall x. SGM t x k p -> Rep (SGM t x k p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x k p x. Rep (SGM t x k p) x -> SGM t x k p
forall t x k p x. SGM t x k p -> Rep (SGM t x k p) x
$cto :: forall t x k p x. Rep (SGM t x k p) x -> SGM t x k p
$cfrom :: forall t x k p x. SGM t x k p -> Rep (SGM t x k p) x
Generic, SGM t x k p -> ()
(SGM t x k p -> ()) -> NFData (SGM t x k p)
forall a. (a -> ()) -> NFData a
forall t x k p.
(NFData k, NFData p, NFData t, NFData x) =>
SGM t x k p -> ()
rnf :: SGM t x k p -> ()
$crnf :: forall t x k p.
(NFData k, NFData p, NFData t, NFData x) =>
SGM t x k p -> ()
NFData)

-- | @'makeSGM' lr n dt diff ms@ creates a new SGM that does not (yet)
--   contain any models.
--   It will learn at the rate determined by the learning function @lr@,
--   and will be able to hold up to @n@ models.
--   It will create a new model based on a pattern presented to it when
--   (1) the SGM contains no models, or
--   (2) the difference between the pattern and the closest matching
--   model exceeds the threshold @dt@.
--   It will use the function @diff@ to measure the similarity between
--   an input pattern and a model.
--   It will use the function @ms@ to adjust models as needed to make
--   them more similar to input patterns.
makeSGM
  :: Bounded k
    => (t -> x) -> Int -> x -> Bool -> (p -> p -> x)
      -> (p -> x -> p -> p) -> SGM t x k p
makeSGM :: (t -> x)
-> Int
-> x
-> Bool
-> (p -> p -> x)
-> (p -> x -> p -> p)
-> SGM t x k p
makeSGM t -> x
lr Int
n x
dt Bool
ad p -> p -> x
diff p -> x -> p -> p
ms =
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    then [Char] -> SGM t x k p
forall a. HasCallStack => [Char] -> a
error [Char]
"max size for SGM <= 0"
    else Map k (p, t)
-> (t -> x)
-> Int
-> x
-> Bool
-> (p -> p -> x)
-> (p -> x -> p -> p)
-> k
-> SGM t x k p
forall t x k p.
Map k (p, t)
-> (t -> x)
-> Int
-> x
-> Bool
-> (p -> p -> x)
-> (p -> x -> p -> p)
-> k
-> SGM t x k p
SGM Map k (p, t)
forall k a. Map k a
M.empty t -> x
lr Int
n x
dt Bool
ad p -> p -> x
diff p -> x -> p -> p
ms k
forall a. Bounded a => a
minBound

-- | Returns true if the SGM has no models, false otherwise.
isEmpty :: SGM t x k p -> Bool
isEmpty :: SGM t x k p -> Bool
isEmpty = Map k (p, t) -> Bool
forall k a. Map k a -> Bool
M.null (Map k (p, t) -> Bool)
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | Returns the number of models the SGM currently contains.
numModels :: SGM t x k p -> Int
numModels :: SGM t x k p -> Int
numModels = Map k (p, t) -> Int
forall k a. Map k a -> Int
M.size (Map k (p, t) -> Int)
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | Returns a map from node ID to model.
modelMap :: SGM t x k p -> M.Map k p
modelMap :: SGM t x k p -> Map k p
modelMap = ((p, t) -> p) -> Map k (p, t) -> Map k p
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (p, t) -> p
forall a b. (a, b) -> a
fst (Map k (p, t) -> Map k p)
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> Map k p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | Returns a map from node ID to counter (number of times the
--   node's model has been the closest match to an input pattern).
counterMap :: SGM t x k p -> M.Map k t
counterMap :: SGM t x k p -> Map k t
counterMap = ((p, t) -> t) -> Map k (p, t) -> Map k t
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (p, t) -> t
forall a b. (a, b) -> b
snd (Map k (p, t) -> Map k t)
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> Map k t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | Returns the model at a specified node.
modelAt :: Ord k => SGM t x k p -> k -> p
modelAt :: SGM t x k p -> k -> p
modelAt SGM t x k p
s k
k = (SGM t x k p -> Map k p
forall t x k p. SGM t x k p -> Map k p
modelMap SGM t x k p
s) Map k p -> k -> p
forall k a. Ord k => Map k a -> k -> a
M.! k
k

-- | Returns the current labels.
labels :: SGM t x k p -> [k]
labels :: SGM t x k p -> [k]
labels = Map k (p, t) -> [k]
forall k a. Map k a -> [k]
M.keys (Map k (p, t) -> [k])
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | Returns the current models.
models :: SGM t x k p -> [p]
models :: SGM t x k p -> [p]
models = ((p, t) -> p) -> [(p, t)] -> [p]
forall a b. (a -> b) -> [a] -> [b]
map (p, t) -> p
forall a b. (a, b) -> a
fst ([(p, t)] -> [p])
-> (SGM t x k p -> [(p, t)]) -> SGM t x k p -> [p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (p, t) -> [(p, t)]
forall k a. Map k a -> [a]
M.elems (Map k (p, t) -> [(p, t)])
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> [(p, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | Returns the current counters (number of times the
--   node's model has been the closest match to an input pattern).
counters :: SGM t x k p -> [t]
counters :: SGM t x k p -> [t]
counters = ((p, t) -> t) -> [(p, t)] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (p, t) -> t
forall a b. (a, b) -> b
snd ([(p, t)] -> [t])
-> (SGM t x k p -> [(p, t)]) -> SGM t x k p -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (p, t) -> [(p, t)]
forall k a. Map k a -> [a]
M.elems (Map k (p, t) -> [(p, t)])
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> [(p, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | The current "time" (number of times the SGM has been trained).
time :: Num t => SGM t x k p -> t
time :: SGM t x k p -> t
time = [t] -> t
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([t] -> t) -> (SGM t x k p -> [t]) -> SGM t x k p -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((p, t) -> t) -> [(p, t)] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (p, t) -> t
forall a b. (a, b) -> b
snd ([(p, t)] -> [t])
-> (SGM t x k p -> [(p, t)]) -> SGM t x k p -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (p, t) -> [(p, t)]
forall k a. Map k a -> [a]
M.elems (Map k (p, t) -> [(p, t)])
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> [(p, t)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap

-- | Adds a new node to the SGM.
addNode
  :: (Num t, Enum k, Ord k)
    => p -> SGM t x k p -> SGM t x k p
addNode :: p -> SGM t x k p -> SGM t x k p
addNode p
p SGM t x k p
s = if SGM t x k p -> Int
forall t x k p. SGM t x k p -> Int
numModels SGM t x k p
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SGM t x k p -> Int
forall t x k p. SGM t x k p -> Int
maxSize SGM t x k p
s
                then [Char] -> SGM t x k p
forall a. HasCallStack => [Char] -> a
error [Char]
"SGM is full"
                else SGM t x k p
s { toMap :: Map k (p, t)
toMap=Map k (p, t)
gm', nextIndex :: k
nextIndex=k -> k
forall a. Enum a => a -> a
succ k
k }
  where gm :: Map k (p, t)
gm = SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap SGM t x k p
s
        k :: k
k = SGM t x k p -> k
forall t x k p. SGM t x k p -> k
nextIndex SGM t x k p
s
        gm' :: Map k (p, t)
gm' = k -> (p, t) -> Map k (p, t) -> Map k (p, t)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k (p
p, t
0) Map k (p, t)
gm

-- | Removes a node from the SGM.
--   Deleted nodes are never re-used.
deleteNode :: Ord k => k -> SGM t x k p -> SGM t x k p
deleteNode :: k -> SGM t x k p -> SGM t x k p
deleteNode k
k SGM t x k p
s = SGM t x k p
s { toMap :: Map k (p, t)
toMap=Map k (p, t)
gm' }
  where gm :: Map k (p, t)
gm = SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap SGM t x k p
s
        gm' :: Map k (p, t)
gm' = if k -> Map k (p, t) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member k
k Map k (p, t)
gm
                then k -> Map k (p, t) -> Map k (p, t)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
k Map k (p, t)
gm
                else [Char] -> Map k (p, t)
forall a. HasCallStack => [Char] -> a
error [Char]
"no such node"

-- | Increments the match counter.
incrementCounter :: (Num t, Ord k) => k -> SGM t x k p -> SGM t x k p
incrementCounter :: k -> SGM t x k p -> SGM t x k p
incrementCounter k
k SGM t x k p
s = SGM t x k p
s { toMap :: Map k (p, t)
toMap=Map k (p, t)
gm' }
  where gm :: Map k (p, t)
gm = SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap SGM t x k p
s
        gm' :: Map k (p, t)
gm' = if k -> Map k (p, t) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member k
k Map k (p, t)
gm
                then ((p, t) -> (p, t)) -> k -> Map k (p, t) -> Map k (p, t)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (p, t) -> (p, t)
forall b a. Num b => (a, b) -> (a, b)
inc k
k Map k (p, t)
gm
                else [Char] -> Map k (p, t)
forall a. HasCallStack => [Char] -> a
error [Char]
"no such node"
        inc :: (a, b) -> (a, b)
inc (a
p, b
t) = (a
p, b
tb -> b -> b
forall a. Num a => a -> a -> a
+b
1)

-- | Trains the specified node to better match a target.
--   Most users should use @'train'@, which automatically determines
--   the BMU and trains it.
trainNode
  :: (Num t, Ord k)
    => SGM t x k p -> k -> p -> SGM t x k p
trainNode :: SGM t x k p -> k -> p -> SGM t x k p
trainNode SGM t x k p
s k
k p
target = SGM t x k p
s { toMap :: Map k (p, t)
toMap=Map k (p, t)
gm' }
  where gm :: Map k (p, t)
gm = SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap SGM t x k p
s
        gm' :: Map k (p, t)
gm' = ((p, t) -> (p, t)) -> k -> Map k (p, t) -> Map k (p, t)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (p, t) -> (p, t)
tweakModel k
k Map k (p, t)
gm
        r :: x
r = (SGM t x k p -> t -> x
forall t x k p. SGM t x k p -> t -> x
learningRate SGM t x k p
s) (SGM t x k p -> t
forall t x k p. Num t => SGM t x k p -> t
time SGM t x k p
s)
        tweakModel :: (p, t) -> (p, t)
tweakModel (p
p, t
t) = (SGM t x k p -> p -> x -> p -> p
forall t x k p. SGM t x k p -> p -> x -> p -> p
makeSimilar SGM t x k p
s p
target x
r p
p, t
t)

-- | Returns the node that has been the BMU least often.
leastUsefulNode :: Ord t => SGM t x k p -> k
leastUsefulNode :: SGM t x k p -> k
leastUsefulNode SGM t x k p
s = if SGM t x k p -> Bool
forall t x k p. SGM t x k p -> Bool
isEmpty SGM t x k p
s
                      then [Char] -> k
forall a. HasCallStack => [Char] -> a
error [Char]
"SGM has no nodes"
                      else (k, (p, t)) -> k
forall a b. (a, b) -> a
fst ((k, (p, t)) -> k)
-> (SGM t x k p -> (k, (p, t))) -> SGM t x k p -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, (p, t)) -> (k, (p, t)) -> Ordering)
-> [(k, (p, t))] -> (k, (p, t))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((k, (p, t)) -> t) -> (k, (p, t)) -> (k, (p, t)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((p, t) -> t
forall a b. (a, b) -> b
snd ((p, t) -> t) -> ((k, (p, t)) -> (p, t)) -> (k, (p, t)) -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, (p, t)) -> (p, t)
forall a b. (a, b) -> b
snd))
                             ([(k, (p, t))] -> (k, (p, t)))
-> (SGM t x k p -> [(k, (p, t))]) -> SGM t x k p -> (k, (p, t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (p, t) -> [(k, (p, t))]
forall k a. Map k a -> [(k, a)]
M.toList (Map k (p, t) -> [(k, (p, t))])
-> (SGM t x k p -> Map k (p, t)) -> SGM t x k p -> [(k, (p, t))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k (p, t)
forall t x k p. SGM t x k p -> Map k (p, t)
toMap (SGM t x k p -> k) -> SGM t x k p -> k
forall a b. (a -> b) -> a -> b
$ SGM t x k p
s

-- | Deletes the node that has been the BMU least often.
deleteLeastUsefulNode :: (Ord t, Ord k) => SGM t x k p -> SGM t x k p
deleteLeastUsefulNode :: SGM t x k p -> SGM t x k p
deleteLeastUsefulNode SGM t x k p
s = k -> SGM t x k p -> SGM t x k p
forall k t x p. Ord k => k -> SGM t x k p -> SGM t x k p
deleteNode k
k SGM t x k p
s
  where k :: k
k = SGM t x k p -> k
forall t x k p. Ord t => SGM t x k p -> k
leastUsefulNode SGM t x k p
s

-- | Adds a new node to the SGM, deleting the least useful
--   node/model if necessary to make room.
addModel
  :: (Num t, Ord t, Enum k, Ord k)
    => p -> SGM t x k p -> SGM t x k p
addModel :: p -> SGM t x k p -> SGM t x k p
addModel p
p SGM t x k p
s = p -> SGM t x k p -> SGM t x k p
forall t k p x.
(Num t, Enum k, Ord k) =>
p -> SGM t x k p -> SGM t x k p
addNode p
p SGM t x k p
s'
  where s' :: SGM t x k p
s' = if SGM t x k p -> Int
forall t x k p. SGM t x k p -> Int
numModels SGM t x k p
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SGM t x k p -> Int
forall t x k p. SGM t x k p -> Int
maxSize SGM t x k p
s
                then SGM t x k p -> SGM t x k p
forall t k x p. (Ord t, Ord k) => SGM t x k p -> SGM t x k p
deleteLeastUsefulNode SGM t x k p
s
                else SGM t x k p
s

-- | @'classify' s p@ identifies the model @s@ that most closely
--   matches the pattern @p@.
--   It will not make any changes to the classifier.
--   Returns the ID of the node with the best matching model,
--   the difference between the best matching model and the pattern,
--   and the SGM labels paired with the model and the difference
--   between the input and the corresponding model.
--   The final paired list is sorted in decreasing order of similarity.
classify
  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)
    => SGM t x k p -> p -> (k, x, M.Map k (p, x))
classify :: SGM t x k p -> p -> (k, x, Map k (p, x))
classify SGM t x k p
s p
p = (k
bmu, x
bmuDiff, Map k (p, x)
report)
  where sFull :: SGM t x k p
sFull = SGM t x k p
s { maxSize :: Int
maxSize = SGM t x k p -> Int
forall t x k p. SGM t x k p -> Int
numModels SGM t x k p
s, allowDeletion :: Bool
allowDeletion = Bool
False }
          -- don't allow any changes!
        (k
bmu, x
bmuDiff, Map k (p, x)
report, SGM t x k p
_) = SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
forall t x k p.
(Num t, Ord t, Num x, Ord x, Enum k, Ord k) =>
SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
classify' SGM t x k p
sFull p
p


-- | Internal method.
-- NOTE: This function may create a new model, but it does not modify
-- existing models.
classify'
  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)
    => SGM t x k p -> p -> (k, x, M.Map k (p, x), SGM t x k p)
classify' :: SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
classify' SGM t x k p
s p
p
  | SGM t x k p -> Bool
forall t x k p. SGM t x k p -> Bool
isEmpty SGM t x k p
s                 = SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
forall t x k p.
(Num t, Ord t, Num x, Ord x, Enum k, Ord k) =>
SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
classify' (p -> SGM t x k p -> SGM t x k p
forall t k p x.
(Num t, Ord t, Enum k, Ord k) =>
p -> SGM t x k p -> SGM t x k p
addModel p
p SGM t x k p
s) p
p
  | x
bmuDiff x -> x -> Bool
forall a. Ord a => a -> a -> Bool
> SGM t x k p -> x
forall t x k p. SGM t x k p -> x
diffThreshold SGM t x k p
s
      Bool -> Bool -> Bool
&& (SGM t x k p -> Int
forall t x k p. SGM t x k p -> Int
numModels SGM t x k p
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SGM t x k p -> Int
forall t x k p. SGM t x k p -> Int
maxSize SGM t x k p
s Bool -> Bool -> Bool
|| SGM t x k p -> Bool
forall t x k p. SGM t x k p -> Bool
allowDeletion SGM t x k p
s)
                              = SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
forall t x k p.
(Num t, Ord t, Num x, Ord x, Enum k, Ord k) =>
SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
classify' (p -> SGM t x k p -> SGM t x k p
forall t k p x.
(Num t, Ord t, Enum k, Ord k) =>
p -> SGM t x k p -> SGM t x k p
addModel p
p SGM t x k p
s) p
p
  | Bool
otherwise                 = (k
bmu, x
bmuDiff, Map k (p, x)
report, SGM t x k p
s')
  where report :: Map k (p, x)
report
          = (p -> (p, x)) -> Map k p -> Map k (p, x)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\p
p0 -> (p
p0, SGM t x k p -> p -> p -> x
forall t x k p. SGM t x k p -> p -> p -> x
difference SGM t x k p
s p
p p
p0)) (Map k p -> Map k (p, x))
-> (SGM t x k p -> Map k p) -> SGM t x k p -> Map k (p, x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SGM t x k p -> Map k p
forall t x k p. SGM t x k p -> Map k p
modelMap (SGM t x k p -> Map k (p, x)) -> SGM t x k p -> Map k (p, x)
forall a b. (a -> b) -> a -> b
$ SGM t x k p
s
        (k
bmu, x
bmuDiff)
          = [(k, x)] -> (k, x)
forall a. [a] -> a
head ([(k, x)] -> (k, x))
-> (Map k (p, x) -> [(k, x)]) -> Map k (p, x) -> (k, x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, x) -> (k, x) -> Ordering) -> [(k, x)] -> [(k, x)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (k, x) -> (k, x) -> Ordering
forall a b. (Ord a, Ord b) => (a, b) -> (a, b) -> Ordering
matchOrder ([(k, x)] -> [(k, x)])
-> (Map k (p, x) -> [(k, x)]) -> Map k (p, x) -> [(k, x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, (p, x)) -> (k, x)) -> [(k, (p, x))] -> [(k, x)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, (p
_, x
x)) -> (k
k, x
x))
              ([(k, (p, x))] -> [(k, x)])
-> (Map k (p, x) -> [(k, (p, x))]) -> Map k (p, x) -> [(k, x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (p, x) -> [(k, (p, x))]
forall k a. Map k a -> [(k, a)]
M.toList (Map k (p, x) -> (k, x)) -> Map k (p, x) -> (k, x)
forall a b. (a -> b) -> a -> b
$ Map k (p, x)
report
        s' :: SGM t x k p
s' = k -> SGM t x k p -> SGM t x k p
forall t k x p. (Num t, Ord k) => k -> SGM t x k p -> SGM t x k p
incrementCounter k
bmu SGM t x k p
s

-- | Order models by ascending difference from the input pattern,
--   then by creation order (label number).
matchOrder :: (Ord a, Ord b) => (a, b) -> (a, b) -> Ordering
matchOrder :: (a, b) -> (a, b) -> Ordering
matchOrder (a
a, b
b) (a
c, b
d) = (b, a) -> (b, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b
b, a
a) (b
d, a
c)

-- | @'trainAndClassify' s p@ identifies the model in @s@ that most
--   closely matches @p@, and updates it to be a somewhat better match.
--   If necessary, it will create a new node and model.
--   Returns the ID of the node with the best matching model,
--   the difference between the best matching model and the pattern,
--   the differences between the input and each model in the SGM,
--   and the updated SGM.
trainAndClassify
  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)
    => SGM t x k p -> p -> (k, x, M.Map k (p, x), SGM t x k p)
trainAndClassify :: SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
trainAndClassify SGM t x k p
s p
p = (k
bmu, x
bmuDiff, Map k (p, x)
report, SGM t x k p
s3)
  where (k
bmu, x
bmuDiff, Map k (p, x)
report, SGM t x k p
s2) = SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
forall t x k p.
(Num t, Ord t, Num x, Ord x, Enum k, Ord k) =>
SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
classify' SGM t x k p
s p
p
        s3 :: SGM t x k p
s3 = SGM t x k p -> k -> p -> SGM t x k p
forall t k x p.
(Num t, Ord k) =>
SGM t x k p -> k -> p -> SGM t x k p
trainNode SGM t x k p
s2 k
bmu p
p

-- | @'train' s p@ identifies the model in @s@ that most closely
--   matches @p@, and updates it to be a somewhat better match.
--   If necessary, it will create a new node and model.
train
  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)
    => SGM t x k p -> p -> SGM t x k p
train :: SGM t x k p -> p -> SGM t x k p
train SGM t x k p
s p
p = SGM t x k p
s'
  where (k
_, x
_, Map k (p, x)
_, SGM t x k p
s') = SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
forall t x k p.
(Num t, Ord t, Num x, Ord x, Enum k, Ord k) =>
SGM t x k p -> p -> (k, x, Map k (p, x), SGM t x k p)
trainAndClassify SGM t x k p
s p
p

-- | For each pattern @p@ in @ps@, @'trainBatch' s ps@ identifies the
--   model in @s@ that most closely matches @p@,
--   and updates it to be a somewhat better match.
trainBatch
  :: (Num t, Ord t, Num x, Ord x, Enum k, Ord k)
    => SGM t x k p -> [p] -> SGM t x k p
trainBatch :: SGM t x k p -> [p] -> SGM t x k p
trainBatch = (SGM t x k p -> p -> SGM t x k p)
-> SGM t x k p -> [p] -> SGM t x k p
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SGM t x k p -> p -> SGM t x k p
forall t x k p.
(Num t, Ord t, Num x, Ord x, Enum k, Ord k) =>
SGM t x k p -> p -> SGM t x k p
train