```-- |
-- Module:     AI.Instinct.Train.Delta
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Delta rule aka backpropagation algorithm.

module AI.Instinct.Train.Delta
( -- * Backpropagation training
TrainPat,
train,
trainAtomic,
trainPat,

-- * Low level
learnPat,

-- * Utility functions
totalError,
tpList
)
where

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import AI.Instinct.Activation
import AI.Instinct.Brain
import AI.Instinct.ConnMatrix
import Control.Arrow
import Data.List

-- | A training pattern is a tuple of an input pattern and an expected
-- output pattern.

type TrainPat = (Pattern, Pattern)

-- | Calculate the weight deltas and the total error for a single
-- pattern.  The second argument specifies the learning rate.

learnPat :: Brain -> Double -> TrainPat -> ConnMatrix
learnPat b@(Brain actF cm _ ol) rate (inP, expP) =
cmMap (\sk dk _ -> rate * (delta V.! dk) * (av V.! sk)) cm

where
av   = activation b inP
iv   = netInputFrom b av inP
outP = U.convert (V.drop outk av)
outk = size - ol
size = cmSize cm

dact :: Double -> Double
dact = actDeriv actF

delta :: V.Vector Double
delta = V.generate size f
where
f k | k >= outk  = let ok = k - outk in del * ((expP U.! ok) - (outP U.! ok))
| otherwise  = del * cmDests k (\s' dk w -> s' + (delta V.! dk) * w) 0 cm
where
del = dact (iv V.! k)

-- | Calculate the total error of a neural network with respect to the
-- given list of training patterns.

totalError :: Brain -> [TrainPat] -> Double
totalError b = foldl' (\e' (inP, expP) -> e' + patError (runNet b inP) expP) 0

-- | Convenience function:  Construct a training pattern from an input
-- and output vector.

tpList :: [Double] -> [Double] -> (Pattern, Pattern)
tpList = curry (U.fromList *** U.fromList)

-- | Non-atomic version of 'trainAtomic'.  Will adjust the weights for
-- each pattern instead of at the end of the epoch.

train :: Brain -> Double -> [TrainPat] -> Brain
train b' rate = foldl' (\b' -> trainPat b' rate) b'

-- | Train a list of patterns with the specified learning rate.  This
-- will adjust the weights at the end of the epoch.  Returns an updated
-- neural network and the new total error.

trainAtomic :: Brain -> Double -> [TrainPat] -> Brain
trainAtomic b'@(Brain _ cm' _ _) rate ps =
b' { brainConns = foldl' (\m' -> cmAdd m' . learnPat b' rate) cm' ps }

-- | Train a single pattern.  The second argument specifies the learning
-- rate.

trainPat :: Brain -> Double -> TrainPat -> Brain
trainPat b@(Brain _ cm _ _) rate inP =
b { brainConns = cmAdd cm (learnPat b rate inP) }
```