som 10.1.0 → 10.1.1

raw patch · 7 files changed

+71/−48 lines, 7 files

Files

• ChangeLog.md +2/−0
• som.cabal +2/−2
• src/Data/Datamining/Clustering/DSOMInternal.hs +12/−7
• src/Data/Datamining/Clustering/SGM2Internal.hs +25/−20
• src/Data/Datamining/Clustering/SGMInternal.hs +20/−15
• src/Data/Datamining/Clustering/SOMInternal.hs +7/−4
• src/Data/Datamining/Pattern.hs +3/−0

@@ -1,5 +1,7 @@ # Changelog for som +10.0.2 Fixed a warning.+       Added more documentation. 10.0.1 Upgraded to Stackage lts-12.16. 10.0.0 Revamped to work with Stack v1.7.1. 

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4a51f13415d0fcbda9b5fbf306f56b17839c4b559ff620f78bc562de163dc9c4+-- hash: 5821eed6b940eb4034165c9ddfccc442441bba7ee1f8f61c9d11022f811eba6d  name:           som-version:        10.1.0+version:        10.1.1 synopsis:       Self-Organising Maps description:    Please see the README on GitHub at <https://github.com/mhwombat/som#readme> category:       Math

@@ -12,7 +12,8 @@ -- ------------------------------------------------------------------------ {-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,-    MultiParamTypeClasses, DeriveAnyClass, DeriveGeneric #-}+    MultiParamTypeClasses, DeriveAnyClass, DeriveGeneric,+    UndecidableInstances #-}  module Data.Datamining.Clustering.DSOMInternal where @@ -46,7 +47,7 @@     gridMap :: gm p,     -- | A function which determines the how quickly the SOM learns.     learningRate :: (x -> x -> x -> x),-    -- | A function which compares two patterns and returns a +    -- | 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.@@ -92,6 +93,7 @@   alter f k = withGridMap (GM.alter f k)   filterWithKey f = withGridMap (GM.filterWithKey f) +-- | Internal method. withGridMap :: (gm p -> gm p) -> DSOM gm x k p -> DSOM gm x k p withGridMap f s = s { gridMap=gm' }     where gm = gridMap s@@ -101,10 +103,11 @@ toGridMap :: GM.GridMap gm p => DSOM gm x k p -> gm p toGridMap = 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) => +      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 fms fd fr target bmu k = fms target amount@@ -113,6 +116,7 @@                  (G.maxPossibleDistance gm)         amount = fr diff dist +-- | Internal method. scaleDistance :: (Num a, Fractional a) => Int -> Int -> a scaleDistance d dMax   | dMax == 0  = 0@@ -125,7 +129,7 @@ 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) => +      Ord k, Num x, Fractional x) =>       DSOM gm x t p -> k -> p -> DSOM gm x k p trainNeighbourhood s bmu target = s { gridMap=gm' }   where gm = gridMap s@@ -135,11 +139,12 @@         fr = (learningRate s) bmuDiff         bmuDiff = (difference s) (gm GM.! bmu) 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) => +      Ord k, Ord x, Num x, Fractional x) =>      DSOM gm x t p -> p -> DSOM gm x k p justTrain s p = trainNeighbourhood s bmu p   where ds = GM.toList . GM.map (difference s p) $ gridMap s@@ -148,7 +153,7 @@         f xs = fst $ minimumBy (comparing snd) xs  instance-  (GM.GridMap gm p, k ~ G.Index (GM.BaseGrid gm p), +  (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) =>@@ -179,5 +184,5 @@ rougierLearningFunction r p bmuDiff diff dist   | bmuDiff == 0         = 0   | otherwise           = r * abs diff * exp (-k*k)-  where k = dist/(p*abs bmuDiff) +  where k = dist/(p*abs bmuDiff) 

@@ -77,16 +77,16 @@     nextIndex :: k   } deriving (Generic, NFData) --- @'makeSGM' lr n 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--- the SGM is not at capacity, or a less useful model can be replaced.--- 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' lr n 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+--   the SGM is not at capacity, or a less useful model can be replaced.+--   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 -> (p -> p -> x) -> (p -> x -> p -> p) -> SGM t x k p@@ -148,6 +148,7 @@         k = nextIndex s         gm' = M.insert k (p, 0) gm +-- | Increments the counter. incrementCounter :: (Num t, Ord k) => k -> SGM t x k p -> SGM t x k p incrementCounter k s = s { toMap=gm' }   where gm = toMap s@@ -209,6 +210,8 @@         gm' = M.adjust f k $ M.delete k gm         f (p, _) = (p, c1 + c2) +-- | Set the model for a node.+--   Useful when merging two models and replacing one. setModel :: (Num t, Ord k) => SGM t x k p -> k -> p -> SGM t x k p setModel s k p   | M.member k gm = error "node already exists"@@ -216,13 +219,14 @@   where gm = toMap s         gm' = M.insert k (p, 0) gm -addModel-  :: (Num t, Ord t, Enum k, Ord k)-    => p -> SGM t x k p -> SGM t x k p-addModel p s-  | size s >= capacity s = error "SGM at capacity"-  | otherwise           = addNode p s+-- addModel+--   :: (Num t, Ord t, Enum k, Ord k)+--     => p -> SGM t x k p -> SGM t x k p+-- addModel p s+--   | size s >= capacity s = error "SGM at capacity"+--   | otherwise           = addNode p s +-- | Add a new node, making room for it by merging two existing nodes. mergeAddModel   :: (Num t, Ord t, Ord k) => SGM t x k p -> k -> k -> p -> SGM t x k p mergeAddModel s k1 k2 p = s3@@ -250,9 +254,8 @@           = head . sortBy matchOrder . map (\(k, (_, x)) -> (k, x))               . M.toList $ report --- We want the model with the lowest difference from the input pattern.--- If two models have the same difference, return the model that was--- created earlier (has the lower label #).+-- | 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) (c, d) = compare (b, a) (d, c) @@ -278,6 +281,7 @@         s3 = mergeAddModel s k1 k2 p         (bmu4, _, report4, s4) = trainAndClassify' s3 p +-- | Internal method. -- NOTE: This function will adjust the model and update the match -- for the BMU. trainAndClassify'@@ -289,11 +293,12 @@         s3 = trainNode s2 bmu p         (bmu2, _, report) = classify s3 p +-- | Internal method. addModelTrainAndClassify   :: (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) addModelTrainAndClassify s p = (bmu, 1, report, s')-  where (bmu, _, report, s') = trainAndClassify' (addModel p s) p+  where (bmu, _, report, s') = trainAndClassify' (addNode p s) p  -- | @'train' s p@ identifies the model in @s@ that most closely --   matches @p@, and updates it to be a somewhat better match.

@@ -82,18 +82,18 @@     nextIndex :: k   } deriving (Generic, 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' 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)@@ -161,6 +161,7 @@                 then M.delete k gm                 else error "no such node" +-- | Increment the match counter. incrementCounter :: (Num t, Ord k) => k -> SGM t x k p -> SGM t x k p incrementCounter k s = s { toMap=gm' }   where gm = toMap s@@ -181,16 +182,20 @@         r = (learningRate s) (time s)         tweakModel (p, t) = (makeSimilar s target r p, t) +-- | Returns the node that has been the BMU least often. leastUsefulNode :: Ord t => SGM t x k p -> k leastUsefulNode s = if isEmpty s                       then error "SGM has no nodes"                       else fst . minimumBy (comparing (snd . snd))                              . M.toList . toMap $ 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 s = deleteNode k s   where k = leastUsefulNode 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@@ -216,6 +221,7 @@         (bmu, bmuDiff, report, _) = classify' sFull p  +-- | Internal method. -- NOTE: This function may create a new model, but it does not modify -- existing models. classify'@@ -234,9 +240,8 @@               . M.toList $ report         s' = incrementCounter bmu s --- We want the model with the lowest difference from the input pattern.--- If two models have the same difference, return the model that was--- created earlier (has the lower label #).+-- | 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) (c, d) = compare (b, a) (d, c) 

@@ -93,7 +93,7 @@     --   which the node's model should be updated to match the target).     --   The learning rate should be between zero and one.     learningRate :: t -> d -> x,-    -- | A function which compares two patterns and returns a +    -- | 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.@@ -143,14 +143,14 @@   alter f k = withGridMap (GM.alter f k)   filterWithKey f = withGridMap (GM.filterWithKey f) +-- | Internal method. withGridMap :: (gm p -> gm p) -> SOM t d gm x k p -> SOM t d gm x k p withGridMap f s = s { gridMap=gm' }     where gm = gridMap s           gm' = f gm -currentLearningFunction-  :: (Num t)-    => SOM t d gm x k p -> (d -> x)+-- | Returns the learning function currently being used by the SOM.+currentLearningFunction :: (Num t) => SOM t d gm x k p -> (d -> x) currentLearningFunction s   = (learningRate s) (counter s) @@ -159,6 +159,7 @@ toGridMap :: GM.GridMap gm p => SOM t d gm x k p -> gm p toGridMap = 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@@ -180,9 +181,11 @@         f1 = currentLearningFunction s         f2 = makeSimilar s +-- | Increment the match counter. incrementCounter :: Num t => SOM t d gm x k p -> SOM t d gm x k p incrementCounter s = s { counter=counter s + 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),

@@ -37,9 +37,11 @@ -- Using numbers as patterns. -- +-- | Returns the absolute difference between two numbers. absDifference :: Num a => a -> a -> a absDifference x y = abs (x - y) +-- | Adjusts a number to make it more similar to the target. adjustNum :: (Num a, Ord a, Eq a) => a -> a -> a -> a adjustNum target r x   | r < 0     = error "Negative learning rate"@@ -54,6 +56,7 @@ -- Using numeric vectors as patterns. -- +-- | Returns the sum of the squares of the elements of a vector. magnitudeSquared :: Num a => [a] -> a magnitudeSquared xs =  sum $ map (\x -> x*x) xs