------------------------------------------------------------------------
-- |
-- Module      :  Data.Datamining.Clustering.DSOMInternal
-- Copyright   :  (c) 2012-2021 Amy de Buitléir
-- 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 DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.Datamining.Clustering.DSOMInternal where

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 (FiniteGrid (..),
                                                             Grid (..))
import qualified Math.Geometry.GridMap                 as GM (GridMap (..))
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 x k p = DSOM
  {
    -- | Maps patterns to tiles in a regular grid.
    --   In the context of a SOM, the tiles are called "nodes"
    DSOM gm x k p -> gm p
gridMap      :: gm p,
    -- | A function which determines the how quickly the SOM learns.
    DSOM gm x k p -> x -> x -> x -> x
learningRate :: (x -> x -> x -> 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.
    DSOM 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@.
    DSOM gm x k p -> p -> x -> p -> p
makeSimilar  :: p -> x -> p -> p
  } deriving ((forall x. DSOM gm x k p -> Rep (DSOM gm x k p) x)
-> (forall x. Rep (DSOM gm x k p) x -> DSOM gm x k p)
-> Generic (DSOM gm x k p)
forall x. Rep (DSOM gm x k p) x -> DSOM gm x k p
forall x. DSOM gm x k p -> Rep (DSOM gm x k p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (gm :: * -> *) x k p x.
Rep (DSOM gm x k p) x -> DSOM gm x k p
forall (gm :: * -> *) x k p x.
DSOM gm x k p -> Rep (DSOM gm x k p) x
$cto :: forall (gm :: * -> *) x k p x.
Rep (DSOM gm x k p) x -> DSOM gm x k p
$cfrom :: forall (gm :: * -> *) x k p x.
DSOM gm x k p -> Rep (DSOM gm x k p) x
Generic, DSOM gm x k p -> ()
(DSOM gm x k p -> ()) -> NFData (DSOM gm x k p)
forall a. (a -> ()) -> NFData a
forall (gm :: * -> *) x k p. NFData (gm p) => DSOM gm x k p -> ()
rnf :: DSOM gm x k p -> ()
$crnf :: forall (gm :: * -> *) x k p. NFData (gm p) => DSOM gm x k p -> ()
NFData)

instance (F.Foldable gm) => F.Foldable (DSOM gm x k) where
  foldr :: (a -> b -> b) -> b -> DSOM gm x k a -> b
foldr a -> b -> b
f b
x DSOM 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 (DSOM gm x k a -> gm a
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap DSOM gm x k a
g)

instance (G.Grid (gm p)) => G.Grid (DSOM gm x k p) where
  type Index (DSOM gm x k p) = G.Index (gm p)
  type Direction (DSOM gm x k p) = G.Direction (gm p)
  indices :: DSOM gm x k p -> [Index (DSOM gm x k p)]
indices = gm p -> [Index (gm p)]
forall g. Grid g => g -> [Index g]
G.indices (gm p -> [Index (gm p)])
-> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> [Index (gm p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  distance :: DSOM gm x k p
-> Index (DSOM gm x k p) -> Index (DSOM 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)
-> (DSOM gm x k p -> gm p)
-> DSOM gm x k p
-> Index (gm p)
-> Index (gm p)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  neighbours :: DSOM gm x k p -> Index (DSOM gm x k p) -> [Index (DSOM 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)])
-> (DSOM gm x k p -> gm p)
-> DSOM gm x k p
-> Index (gm p)
-> [Index (gm p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  contains :: DSOM gm x k p -> Index (DSOM 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)
-> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> Index (gm p) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  viewpoint :: DSOM gm x k p
-> Index (DSOM gm x k p) -> [(Index (DSOM 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)])
-> (DSOM gm x k p -> gm p)
-> DSOM gm x k p
-> Index (gm p)
-> [(Index (gm p), Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  directionTo :: DSOM gm x k p
-> Index (DSOM gm x k p)
-> Index (DSOM gm x k p)
-> [Direction (DSOM 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)])
-> (DSOM gm x k p -> gm p)
-> DSOM gm x k p
-> Index (gm p)
-> Index (gm p)
-> [Direction (gm p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  tileCount :: DSOM gm x k p -> Int
tileCount = gm p -> Int
forall g. Grid g => g -> Int
G.tileCount (gm p -> Int) -> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  null :: DSOM gm x k p -> Bool
null = gm p -> Bool
forall g. Grid g => g -> Bool
G.null (gm p -> Bool) -> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  nonNull :: DSOM gm x k p -> Bool
nonNull = gm p -> Bool
forall g. Grid g => g -> Bool
G.nonNull (gm p -> Bool) -> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap

instance
  (F.Foldable gm, GM.GridMap gm p, G.FiniteGrid (GM.BaseGrid gm p)) =>
    GM.GridMap (DSOM gm x k) p where
  type BaseGrid (DSOM gm x k) p = GM.BaseGrid gm p
  toGrid :: DSOM gm x k p -> BaseGrid (DSOM 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)
-> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> BaseGrid gm p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  toMap :: DSOM 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)
-> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> Map k p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  mapWithKey :: (k -> p -> v2) -> DSOM gm x k p -> DSOM gm x k v2
mapWithKey = [Char] -> (k -> p -> v2) -> DSOM gm x k p -> DSOM gm x k v2
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented"
  delete :: k -> DSOM gm x k p -> DSOM gm x k p
delete k
k = (gm p -> gm p) -> DSOM gm x k p -> DSOM gm x k p
forall (gm :: * -> *) p x k.
(gm p -> gm p) -> DSOM gm x k p -> DSOM 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 -> DSOM gm x k p -> DSOM gm x k p
adjustWithKey k -> p -> p
f k
k = (gm p -> gm p) -> DSOM gm x k p -> DSOM gm x k p
forall (gm :: * -> *) p x k.
(gm p -> gm p) -> DSOM gm x k p -> DSOM 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 -> DSOM gm x k p -> DSOM gm x k p
insertWithKey k -> p -> p -> p
f k
k p
v = (gm p -> gm p) -> DSOM gm x k p -> DSOM gm x k p
forall (gm :: * -> *) p x k.
(gm p -> gm p) -> DSOM gm x k p -> DSOM 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 -> DSOM gm x k p -> DSOM gm x k p
alter Maybe p -> Maybe p
f k
k = (gm p -> gm p) -> DSOM gm x k p -> DSOM gm x k p
forall (gm :: * -> *) p x k.
(gm p -> gm p) -> DSOM gm x k p -> DSOM 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) -> DSOM gm x k p -> DSOM gm x k p
filterWithKey k -> p -> Bool
f = (gm p -> gm p) -> DSOM gm x k p -> DSOM gm x k p
forall (gm :: * -> *) p x k.
(gm p -> gm p) -> DSOM gm x k p -> DSOM 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) -> DSOM gm x k p -> DSOM gm x k p
withGridMap :: (gm p -> gm p) -> DSOM gm x k p -> DSOM gm x k p
withGridMap gm p -> gm p
f DSOM gm x k p
s = DSOM gm x k p
s { gridMap :: gm p
gridMap=gm p
gm' }
    where gm :: gm p
gm = DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap DSOM gm x k p
s
          gm' :: gm p
gm' = gm p -> gm p
f gm p
gm

-- | Extracts the grid and current models from the DSOM.
toGridMap :: GM.GridMap gm p => DSOM gm x k p -> gm p
toGridMap :: DSOM gm x k p -> gm p
toGridMap = DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap

-- | Internal method.
adjustNode
  :: (G.FiniteGrid (gm p), GM.GridMap gm p,
      k ~ G.Index (gm p), k ~ G.Index (GM.BaseGrid gm p),
      Ord k, Num x, Fractional x) =>
     gm p -> (p -> x -> p -> p) -> (p -> p -> x) -> (x -> x -> x) -> p -> k -> k
       -> (p -> p)
adjustNode :: gm p
-> (p -> x -> p -> p)
-> (p -> p -> x)
-> (x -> x -> x)
-> p
-> k
-> k
-> p
-> p
adjustNode gm p
gm p -> x -> p -> p
fms p -> p -> x
fd x -> x -> x
fr p
target k
bmu k
k = p -> x -> p -> p
fms p
target x
amount
  where diff :: x
diff = p -> p -> x
fd (gm p
gm gm p -> k -> p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v), Ord k) =>
gm v -> k -> v
GM.! k
k) p
target
        dist :: x
dist = Int -> Int -> x
forall a. (Num a, Fractional a) => Int -> Int -> a
scaleDistance (gm p -> Index (gm p) -> Index (gm p) -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
G.distance gm p
gm k
Index (gm p)
bmu k
Index (gm p)
k)
                 (gm p -> Int
forall g. FiniteGrid g => g -> Int
G.maxPossibleDistance gm p
gm)
        amount :: x
amount = x -> x -> x
fr x
diff x
dist

-- | Internal method.
scaleDistance :: (Num a, Fractional a) => Int -> Int -> a
scaleDistance :: Int -> Int -> a
scaleDistance Int
d Int
dMax
  | Int
dMax Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = a
0
  | Bool
otherwise = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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
  :: (G.FiniteGrid (gm p), GM.GridMap gm p,
      k ~ G.Index (gm p), k ~ G.Index (GM.BaseGrid gm p),
      Ord k, Num x, Fractional x) =>
      DSOM gm x t p -> k -> p -> DSOM gm x k p
trainNeighbourhood :: DSOM gm x t p -> k -> p -> DSOM gm x k p
trainNeighbourhood DSOM gm x t p
s k
bmu p
target = DSOM gm x t p
s { gridMap :: gm p
gridMap=gm p
gm' }
  where gm :: gm p
gm = DSOM gm x t p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap DSOM gm x t p
s
        gm' :: gm p
gm' = (k -> 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
-> (p -> x -> p -> p)
-> (p -> p -> x)
-> (x -> x -> x)
-> p
-> k
-> k
-> p
-> p
forall (gm :: * -> *) p k x.
(FiniteGrid (gm p), GridMap gm p, k ~ Index (gm p),
 k ~ Index (BaseGrid gm p), Ord k, Num x, Fractional x) =>
gm p
-> (p -> x -> p -> p)
-> (p -> p -> x)
-> (x -> x -> x)
-> p
-> k
-> k
-> p
-> p
adjustNode gm p
gm p -> x -> p -> p
fms p -> p -> x
fd x -> x -> x
fr p
target k
bmu) gm p
gm
        fms :: p -> x -> p -> p
fms = DSOM gm x t p -> p -> x -> p -> p
forall (gm :: * -> *) x k p. DSOM gm x k p -> p -> x -> p -> p
makeSimilar DSOM gm x t p
s
        fd :: p -> p -> x
fd = DSOM gm x t p -> p -> p -> x
forall (gm :: * -> *) x k p. DSOM gm x k p -> p -> p -> x
difference DSOM gm x t p
s
        fr :: x -> x -> x
fr = (DSOM gm x t p -> x -> x -> x -> x
forall (gm :: * -> *) x k p. DSOM gm x k p -> x -> x -> x -> x
learningRate DSOM gm x t p
s) x
bmuDiff
        bmuDiff :: x
bmuDiff = (DSOM gm x t p -> p -> p -> x
forall (gm :: * -> *) x k p. DSOM gm x k p -> p -> p -> x
difference DSOM gm x t p
s) (gm p
gm gm p -> k -> p
forall (gm :: * -> *) v k.
(GridMap gm v, k ~ Index (BaseGrid gm v), Ord k) =>
gm v -> k -> v
GM.! k
bmu) p
target

-- | Internal method.
justTrain
  :: (G.FiniteGrid (gm p), GM.GridMap gm p, GM.GridMap gm x,
      k ~ G.Index (gm p), k ~ G.Index (gm x),
      k ~ G.Index (GM.BaseGrid gm p), k ~ G.Index (GM.BaseGrid gm x),
      Ord k, Ord x, Num x, Fractional x) =>
     DSOM gm x t p -> p -> DSOM gm x k p
justTrain :: DSOM gm x t p -> p -> DSOM gm x k p
justTrain DSOM gm x t p
s p
p = DSOM gm x t p -> k -> p -> DSOM gm x k p
forall (gm :: * -> *) p k x t.
(FiniteGrid (gm p), GridMap gm p, k ~ Index (gm p),
 k ~ Index (BaseGrid gm p), Ord k, Num x, Fractional x) =>
DSOM gm x t p -> k -> p -> DSOM gm x k p
trainNeighbourhood DSOM gm x t p
s k
bmu p
p
  where ds :: [(k, x)]
ds = 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 (DSOM gm x t p -> p -> p -> x
forall (gm :: * -> *) x k p. DSOM gm x k p -> p -> p -> x
difference DSOM gm x t p
s p
p) (gm p -> [(k, x)]) -> gm p -> [(k, x)]
forall a b. (a -> b) -> a -> b
$ DSOM gm x t p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap DSOM gm x t p
s
        bmu :: k
bmu = [(k, x)] -> k
forall b p. Ord b => [(p, b)] -> p
f [(k, x)]
ds
        f :: [(p, b)] -> p
f [] = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"DSOM 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.FiniteGrid (gm p), GM.GridMap gm x, k ~ G.Index (gm p),
    k ~ G.Index (gm x), k ~ G.Index (GM.BaseGrid gm x), Ord k, Ord x,
    Num x, Fractional x) =>
   Classifier (DSOM gm) x k p where
  toList :: DSOM 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)])
-> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> [(k, p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  numModels :: DSOM gm x k p -> Int
numModels = gm p -> Int
forall g. Grid g => g -> Int
G.tileCount (gm p -> Int) -> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  models :: DSOM gm x k p -> [p]
models = gm p -> [p]
forall (gm :: * -> *) v. GridMap gm v => gm v -> [v]
GM.elems (gm p -> [p]) -> (DSOM gm x k p -> gm p) -> DSOM gm x k p -> [p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap
  differences :: DSOM gm x k p -> p -> [(k, x)]
differences DSOM 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 (DSOM gm x k p -> p -> p -> x
forall (gm :: * -> *) x k p. DSOM gm x k p -> p -> p -> x
difference DSOM gm x k p
s p
p) (gm p -> [(k, x)]) -> gm p -> [(k, x)]
forall a b. (a -> b) -> a -> b
$ DSOM gm x k p -> gm p
forall (gm :: * -> *) x k p. DSOM gm x k p -> gm p
gridMap DSOM gm x k p
s
  trainBatch :: DSOM gm x k p -> [p] -> DSOM gm x k p
trainBatch DSOM gm x k p
s = (DSOM gm x k p -> p -> DSOM gm x k p)
-> DSOM gm x k p -> [p] -> DSOM gm x k p
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DSOM gm x k p -> p -> DSOM gm x k p
forall (gm :: * -> *) p x k t.
(FiniteGrid (gm p), GridMap gm p, GridMap gm x, k ~ Index (gm p),
 k ~ Index (gm x), k ~ Index (BaseGrid gm p),
 k ~ Index (BaseGrid gm x), Ord k, Ord x, Num x, Fractional x) =>
DSOM gm x t p -> p -> DSOM gm x k p
justTrain DSOM gm x k p
s
  reportAndTrain :: DSOM gm x k p -> p -> (k, [(k, x)], DSOM gm x k p)
reportAndTrain DSOM gm x k p
s p
p = (k
bmu, [(k, x)]
ds, DSOM gm x k p
s')
    where ds :: [(k, x)]
ds = DSOM 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 DSOM gm x k p
s p
p
          bmu :: k
bmu = [(k, x)] -> k
forall b p. Ord b => [(p, b)] -> p
f [(k, x)]
ds
          f :: [(p, b)] -> p
f [] = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"DSOM 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
          s' :: DSOM gm x k p
s' = DSOM gm x k p -> k -> p -> DSOM gm x k p
forall (gm :: * -> *) p k x t.
(FiniteGrid (gm p), GridMap gm p, k ~ Index (gm p),
 k ~ Index (BaseGrid gm p), Ord k, Num x, Fractional x) =>
DSOM gm x t p -> k -> p -> DSOM gm x k p
trainNeighbourhood DSOM gm x k p
s k
bmu p
p

-- | 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 :: a -> a -> a -> a -> a -> a
rougierLearningFunction a
r a
p a
bmuDiff a
diff a
dist
  | a
bmuDiff a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0         = a
0
  | Bool
otherwise           = a
r a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
abs a
diff a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
exp (-a
ka -> a -> a
forall a. Num a => a -> a -> a
*a
k)
  where k :: a
k = a
dista -> a -> a
forall a. Fractional a => a -> a -> a
/(a
pa -> a -> a
forall a. Num a => a -> a -> a
*a -> a
forall a. Num a => a -> a
abs a
bmuDiff)