6ad9803 · grenade · git.iko.soy

git.iko.soy/grenade

Start working on Tape

commit6ad98032867b115bb826ae9c7974d7cfc6d6a14f authorHuw Campbell <huw.campbell@ambiata.com> dateSat 21 Jan 2017, 12:43 (10 years ago) parent51ae147

15 files changed+88−68

compare with master

unifiedsplit

src/Grenade/Core/Network.hs+6−2

@@ -60,14 +60,18 @@ class Show x => UpdateLayer x where

6060-- | Class for a layer. All layers implement this, however, they don't

6161-- need to implement it for all shapes, only ones which are appropriate.

6262class UpdateLayer x => Layer x (i :: Shape) (o :: Shape) where

63+ -- | The Wengert tape for this layer. Includes all that is required

64+ -- to generate the back propagated gradients efficiently. As a

65+ -- default, `S i` is fine.

66+ type Tape x i o :: *

6367 -- | Used in training and scoring. Take the input from the previous

6468 -- layer, and give the output from this layer.

65− runForwards :: x -> S i -> S o

69+ runForwards :: x -> S i -> (Tape x i o, S o)

6670 -- | Back propagate a step. Takes the current layer, the input that the

6771 -- layer gave from the input and the back propagated derivatives from

6872 -- the layer above.

6973 -- Returns the gradient layer and the derivatives to push back further.

70− runBackwards :: x -> S i -> S o -> (Gradient x, S i)

74+ runBackwards :: x -> Tape x i o -> S o -> (Gradient x, S i)

7175

7276-- | Type of a network.

7377--

src/Grenade/Core/Runner.hs+6−6

@@ -43,19 +43,19 @@ backPropagate network input target =

4343 -> (Gradients sublayers, S (Head js))

4444 -- handle input from the beginning, feeding upwards.

4545 go !x (layer :~> n)

46− = let y = runForwards layer x

46+ = let (tape, y) = runForwards layer x

4747 -- recursively run the rest of the network, and get the gradients from above.

4848 (n', dWs') = go y n

4949 -- calculate the gradient for this layer to pass down,

50− (layer', dWs) = runBackwards layer x dWs'

50+ (layer', dWs) = runBackwards layer tape dWs'

5151

5252 in (layer' :/> n', dWs)

5353

5454 -- handle the output layer, bouncing the derivatives back down.

5555 go !x (O layer)

56− = let y = runForwards layer x

56+ = let (tape, y) = runForwards layer x

5757 -- the gradient (how much y affects the error)

58− (layer', dWs) = runBackwards layer x (y - target)

58+ (layer', dWs) = runBackwards layer tape (y - target)

5959

6060 in (OG layer', dWs)

6161

@@ -76,5 +76,5 @@ train rate network input output =

7676

7777-- | Run the network with input and return the given output.

7878runNet :: Network layers shapes -> S (Head shapes) -> S (Last shapes)

79−runNet (layer :~> n) !x = let y = runForwards layer x in runNet n y

80−runNet (O layer) !x = runForwards layer x

79+runNet (layer :~> n) !x = let (_, y) = runForwards layer x in runNet n y

80+runNet (O layer) !x = snd (runForwards layer x)

src/Grenade/Layers/Convolution.hs+6−2

@@ -157,6 +157,7 @@ instance ( KnownNat kernelRows

157157 , KnownNat (kernelRows * kernelCols * 1)

158158 , KnownNat (outputRows * filters)

159159 ) => Layer (Convolution 1 filters kernelRows kernelCols strideRows strideCols) ('D2 inputRows inputCols) ('D3 outputRows outputCols filters) where

160+ type Tape (Convolution 1 filters kernelRows kernelCols strideRows strideCols) ('D2 inputRows inputCols) ('D3 outputRows outputCols filters) = S ('D2 inputRows inputCols)

160161 runForwards (Convolution kernel _) (S2D input) =

161162 let ex = extract input

162163 ek = extract kernel

@@ -170,7 +171,7 @@ instance ( KnownNat kernelRows

170171 mt = c LA.<> ek

171172 r = col2vid 1 1 1 1 ox oy mt

172173 rs = fromJust . create $ r

173− in S3D rs

174+ in (S2D input, S3D rs)

174175

175176 runBackwards (Convolution kernel _) (S2D input) (S3D dEdy) =

176177 let ex = extract input

@@ -214,6 +215,9 @@ instance ( KnownNat kernelRows

214215 , KnownNat (kernelRows * kernelCols * channels)

215216 , KnownNat (outputRows * filters)

216217 ) => Layer (Convolution channels filters kernelRows kernelCols strideRows strideCols) ('D3 inputRows inputCols channels) ('D3 outputRows outputCols filters) where

218+

219+ type Tape (Convolution channels filters kernelRows kernelCols strideRows strideCols) ('D3 inputRows inputCols channels) ('D3 outputRows outputCols filters) = S ('D3 inputRows inputCols channels)

220+

217221 runForwards (Convolution kernel _) (S3D input) =

218222 let ex = extract input

219223 ek = extract kernel

@@ -230,7 +234,7 @@ instance ( KnownNat kernelRows

230234 mt = c LA.<> ek

231235 r = col2vid 1 1 1 1 ox oy mt

232236 rs = fromJust . create $ r

233− in S3D rs

237+ in (S3D input, S3D rs)

234238 runBackwards (Convolution kernel _) (S3D input) (S3D dEdy) =

235239 let ex = extract input

236240 ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)

src/Grenade/Layers/Crop.hs+2−1

@@ -46,6 +46,7 @@ instance ( KnownNat cropLeft

4646 , (inputRows - cropTop - cropBottom) ~ outputRows

4747 , (inputColumns - cropLeft - cropRight) ~ outputColumns

4848 ) => Layer (Crop cropLeft cropTop cropRight cropBottom) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) where

49+ type Tape (Crop cropLeft cropTop cropRight cropBottom) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) = ()

4950 runForwards Crop (S2D input) =

5051 let cropl = fromIntegral $ natVal (Proxy :: Proxy cropLeft)

5152 cropt = fromIntegral $ natVal (Proxy :: Proxy cropTop)

@@ -53,7 +54,7 @@ instance ( KnownNat cropLeft

5354 ncols = fromIntegral $ natVal (Proxy :: Proxy outputColumns)

5455 m = extract input

5556 r = subMatrix (cropt, cropl) (nrows, ncols) m

56− in S2D . fromJust . create $ r

57+ in ((), S2D . fromJust . create $ r)

5758 runBackwards _ _ (S2D dEdy) =

5859 let cropl = fromIntegral $ natVal (Proxy :: Proxy cropLeft)

5960 cropt = fromIntegral $ natVal (Proxy :: Proxy cropTop)

src/Grenade/Layers/Dropout.hs+2−4

@@ -23,7 +23,6 @@ import Numeric.LinearAlgebra.Static

2323-- reasonable).

2424data Dropout o =

2525 Dropout (R o)

26− | Pass Double

2726 deriving Show

2827

2928instance (KnownNat i) => UpdateLayer (Dropout i) where

@@ -40,7 +39,6 @@ randomDropout rate = do

4039 return $ Dropout xs

4140

4241instance (KnownNat i) => Layer (Dropout i) ('D1 i) ('D1 i) where

43− runForwards (Dropout drops) (S1D x) = S1D $ x * drops

44− runForwards (Pass rate) (S1D x)= S1D $ dvmap (* (1 - rate)) x

42+ type Tape (Dropout i) ('D1 i) ('D1 i) = ()

43+ runForwards (Dropout drops) (S1D x) = ((), S1D $ x * drops)

4544 runBackwards (Dropout drops) _ (S1D x) = ((), S1D $ x * drops)

46− runBackwards (Pass rate) _ (S1D x) = ((), S1D $ dvmap (* (1 - rate)) x)

src/Grenade/Layers/Flatten.hs+6−3

@@ -32,15 +32,18 @@ instance UpdateLayer FlattenLayer where

3232 createRandom = return FlattenLayer

3333

3434instance (KnownNat a, KnownNat x, KnownNat y, a ~ (x * z)) => Layer FlattenLayer ('D2 x y) ('D1 a) where

35− runForwards _ (S2D y) = fromJust' . fromStorable . flatten . extract $ y

35+ type Tape FlattenLayer ('D2 x y) ('D1 a) = ()

36+ runForwards _ (S2D y) = ((), fromJust' . fromStorable . flatten . extract $ y)

3637 runBackwards _ _ (S1D y) = ((), fromJust' . fromStorable . extract $ y)

3738

3839instance (KnownNat a, KnownNat x, KnownNat y, KnownNat (x * z), KnownNat z, a ~ (x * y * z)) => Layer FlattenLayer ('D3 x y z) ('D1 a) where

39− runForwards _ (S3D y) = fromJust' . fromStorable . flatten . extract $ y

40+ type Tape FlattenLayer ('D3 x y z) ('D1 a) = ()

41+ runForwards _ (S3D y) = ((), fromJust' . fromStorable . flatten . extract $ y)

4042 runBackwards _ _ (S1D y) = ((), fromJust' . fromStorable . extract $ y)

4143

4244instance (KnownNat y, KnownNat x, KnownNat z, z ~ 1) => Layer FlattenLayer ('D3 x y z) ('D2 x y) where

43− runForwards _ (S3D y) = S2D y

45+ type Tape FlattenLayer ('D3 x y z) ('D2 x y) = ()

46+ runForwards _ (S3D y) = ((), S2D y)

4447 runBackwards _ _ (S2D y) = ((), S3D y)

4548

4649instance Serialize FlattenLayer where

src/Grenade/Layers/FullyConnected.hs+12−13

@@ -25,14 +25,12 @@ import Grenade.Layers.Internal.Update

2525

2626-- | A basic fully connected (or inner product) neural network layer.

2727data FullyConnected i o = FullyConnected

28− !(R o) -- Bias neuron weights

29− !(R o) -- Bias neuron momentum

30− !(L o i) -- Activation weights

31− !(L o i) -- Momentum

28+ !(FullyConnected' i o) -- Weuron weights

29+ !(FullyConnected' i o) -- Neuron momentum

3230

3331data FullyConnected' i o = FullyConnected'

34− !(R o) -- Bias neuron gradient

35− !(L o i) -- Activation gradient

32+ !(R o) -- Bias

33+ !(L o i) -- Activations

3634

3735instance Show (FullyConnected i o) where

3836 show FullyConnected {} = "FullyConnected"

@@ -40,19 +38,20 @@ instance Show (FullyConnected i o) where

4038instance (KnownNat i, KnownNat o) => UpdateLayer (FullyConnected i o) where

4139 type Gradient (FullyConnected i o) = (FullyConnected' i o)

4240

43− runUpdate LearningParameters {..} (FullyConnected oldBias oldBiasMomentum oldActivations oldMomentum) (FullyConnected' biasGradient activationGradient) =

41+ runUpdate LearningParameters {..} (FullyConnected (FullyConnected' oldBias oldActivations) (FullyConnected' oldBiasMomentum oldMomentum)) (FullyConnected' biasGradient activationGradient) =

4442 let (newBias, newBiasMomentum) = decendVector learningRate learningMomentum learningRegulariser oldBias biasGradient oldBiasMomentum

4543 (newActivations, newMomentum) = decendMatrix learningRate learningMomentum learningRegulariser oldActivations activationGradient oldMomentum

46− in FullyConnected newBias newBiasMomentum newActivations newMomentum

44+ in FullyConnected (FullyConnected' newBias newActivations) (FullyConnected' newBiasMomentum newMomentum)

4745

4846 createRandom = randomFullyConnected

4947

5048instance (KnownNat i, KnownNat o) => Layer (FullyConnected i o) ('D1 i) ('D1 o) where

49+ type Tape (FullyConnected i o) ('D1 i) ('D1 o) = S ('D1 i)

5150 -- Do a matrix vector multiplication and return the result.

52− runForwards (FullyConnected wB _ wN _) (S1D v) = S1D (wB + wN #> v)

51+ runForwards (FullyConnected (FullyConnected' wB wN) _) (S1D v) = (S1D v, S1D (wB + wN #> v))

5352

5453 -- Run a backpropogation step for a full connected layer.

55− runBackwards (FullyConnected _ _ wN _) (S1D x) (S1D dEdy) =

54+ runBackwards (FullyConnected (FullyConnected' _ wN) _) (S1D x) (S1D dEdy) =

5655 let wB' = dEdy

5756 mm' = dEdy `outer` x

5857 -- calcluate derivatives for next step

@@ -60,7 +59,7 @@ instance (KnownNat i, KnownNat o) => Layer (FullyConnected i o) ('D1 i) ('D1 o)

6059 in (FullyConnected' wB' mm', S1D dWs)

6160

6261instance (KnownNat i, KnownNat o) => Serialize (FullyConnected i o) where

63− put (FullyConnected b _ w _) = do

62+ put (FullyConnected (FullyConnected' b w) _) = do

6463 putListOf put . LA.toList . extract $ b

6564 putListOf put . LA.toList . LA.flatten . extract $ w

6665

@@ -70,7 +69,7 @@ instance (KnownNat i, KnownNat o) => Serialize (FullyConnected i o) where

7069 k <- maybe (fail "Vector of incorrect size") return . create . LA.reshape f . LA.fromList =<< getListOf get

7170 let bm = konst 0

7271 let mm = konst 0

73− return $ FullyConnected b bm k mm

72+ return $ FullyConnected (FullyConnected' b k) (FullyConnected' bm mm)

7473

7574randomFullyConnected :: (MonadRandom m, KnownNat i, KnownNat o)

7675 => m (FullyConnected i o)

@@ -81,4 +80,4 @@ randomFullyConnected = do

8180 wN = uniformSample s2 (-1) 1

8281 bm = konst 0

8382 mm = konst 0

84− return $ FullyConnected wB bm wN mm

83+ return $ FullyConnected (FullyConnected' wB wN) (FullyConnected' bm mm)

src/Grenade/Layers/Fuse.hs+7−8

@@ -15,8 +15,6 @@ import Grenade.Core.Shape

1515

1616-- | Fuse two layers into one layer.

1717-- This can be used to simplify a network if a complicated repeated structure is used.

18−-- This does however have a trade off, internal incremental states in the Wengert tape are

19−-- not retained during reverse accumulation. So less RAM is used, but more compute is required.

2018data Fuse :: * -> * -> Shape -> Shape -> Shape -> * where

2119 (:$$) :: (Layer x i h, Layer y h o)

2220 => !x

@@ -36,12 +34,13 @@ instance (Layer x i h, Layer y h o) => UpdateLayer (Fuse x y i h o) where

3634 createRandom = (:$$) <$> createRandom <*> createRandom

3735

3836instance (Layer x i h, Layer y h o) => Layer (Fuse x y i h o) i o where

37+ type Tape (Fuse x y i h o) i o = (Tape x i h, Tape y h o)

3938 runForwards (x :$$ y) input =

40− let yInput :: S h = runForwards x input

41− in runForwards y yInput

39+ let (xTape, yInput :: S h) = runForwards x input

40+ (yTape, output :: S o) = runForwards y yInput

41+ in ((xTape, yTape), output)

4242

43− runBackwards (x :$$ y) input backGradient =

44− let yInput :: S h = runForwards x input

45− (y', yGrad) = runBackwards y yInput backGradient

46− (x', xGrad) = runBackwards x input yGrad

43+ runBackwards (x :$$ y) (xTape, yTape) backGradient =

44+ let (y', yGrad :: S h) = runBackwards y yTape backGradient

45+ (x', xGrad) = runBackwards x xTape yGrad

4746 in ((x', y'), xGrad)

src/Grenade/Layers/Logit.hs+6−3

@@ -26,15 +26,18 @@ instance UpdateLayer Logit where

2626 createRandom = return Logit

2727

2828instance (KnownNat i) => Layer Logit ('D1 i) ('D1 i) where

29− runForwards _ (S1D y) = S1D (logistic y)

29+ type Tape Logit ('D1 i) ('D1 i) = S ('D1 i)

30+ runForwards _ (S1D y) = (S1D y, S1D (logistic y))

3031 runBackwards _ (S1D y) (S1D dEdy) = ((), S1D (logistic' y * dEdy))

3132

3233instance (KnownNat i, KnownNat j) => Layer Logit ('D2 i j) ('D2 i j) where

33− runForwards _ (S2D y) = S2D (logistic y)

34+ type Tape Logit ('D2 i j) ('D2 i j) = S ('D2 i j)

35+ runForwards _ (S2D y) = (S2D y, S2D (logistic y))

3436 runBackwards _ (S2D y) (S2D dEdy) = ((), S2D (logistic' y * dEdy))

3537

3638instance (KnownNat i, KnownNat j, KnownNat k) => Layer Logit ('D3 i j k) ('D3 i j k) where

37− runForwards _ (S3D y) = S3D (logistic y)

39+ type Tape Logit ('D3 i j k) ('D3 i j k) = S ('D3 i j k)

40+ runForwards _ (S3D y) = (S3D y, S3D (logistic y))

3841 runBackwards _ (S3D y) (S3D dEdy) = ((), S3D (logistic' y * dEdy))

3942

4043instance Serialize Logit where

src/Grenade/Layers/Pad.hs+2−1

@@ -51,6 +51,7 @@ instance ( KnownNat padLeft

5151 , (inputRows + padTop + padBottom) ~ outputRows

5252 , (inputColumns + padLeft + padRight) ~ outputColumns

5353 ) => Layer (Pad padLeft padTop padRight padBottom) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) where

54+ type Tape (Pad padLeft padTop padRight padBottom) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) = ()

5455 runForwards Pad (S2D input) =

5556 let padl = fromIntegral $ natVal (Proxy :: Proxy padLeft)

5657 padt = fromIntegral $ natVal (Proxy :: Proxy padTop)

@@ -58,7 +59,7 @@ instance ( KnownNat padLeft

5859 padb = fromIntegral $ natVal (Proxy :: Proxy padBottom)

5960 m = extract input

6061 r = diagBlock [konst 0 (padt,padl), m, konst 0 (padb,padr)]

61− in S2D . fromJust . create $ r

62+ in ((), S2D . fromJust . create $ r)

6263 runBackwards Pad _ (S2D dEdy) =

6364 let padl = fromIntegral $ natVal (Proxy :: Proxy padLeft)

6465 padt = fromIntegral $ natVal (Proxy :: Proxy padTop)

src/Grenade/Layers/Pooling.hs+4−2

@@ -56,6 +56,7 @@ instance ( KnownNat kernelRows

5656 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)

5757 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)

5858 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) where

59+ type Tape (Pooling kernelRows kernelColumns strideRows strideColumns) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) = S ('D2 inputRows inputColumns)

5960 runForwards Pooling (S2D input) =

6061 let height = fromIntegral $ natVal (Proxy :: Proxy inputRows)

6162 width = fromIntegral $ natVal (Proxy :: Proxy inputColumns)

@@ -66,7 +67,7 @@ instance ( KnownNat kernelRows

6667 ex = extract input

6768 r = poolForward 1 height width kx ky sx sy ex

6869 rs = fromJust . create $ r

69− in S2D $ rs

70+ in (S2D input, S2D rs)

7071 runBackwards Pooling (S2D input) (S2D dEdy) =

7172 let height = fromIntegral $ natVal (Proxy :: Proxy inputRows)

7273 width = fromIntegral $ natVal (Proxy :: Proxy inputColumns)

@@ -94,6 +95,7 @@ instance ( KnownNat kernelRows

9495 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)

9596 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)

9697 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D3 inputRows inputColumns channels) ('D3 outputRows outputColumns channels) where

98+ type Tape (Pooling kernelRows kernelColumns strideRows strideColumns) ('D3 inputRows inputColumns channels) ('D3 outputRows outputColumns channels) = S ('D3 inputRows inputColumns channels)

9799 runForwards Pooling (S3D input) =

98100 let ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)

99101 iy = fromIntegral $ natVal (Proxy :: Proxy inputColumns)

@@ -105,7 +107,7 @@ instance ( KnownNat kernelRows

105107 ex = extract input

106108 r = poolForward ch ix iy kx ky sx sy ex

107109 rs = fromJust . create $ r

108− in S3D rs

110+ in (S3D input, S3D rs)

109111 runBackwards Pooling (S3D input) (S3D dEdy) =

110112 let ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)

111113 iy = fromIntegral $ natVal (Proxy :: Proxy inputColumns)

src/Grenade/Layers/Relu.hs+10−3

@@ -30,7 +30,9 @@ instance Serialize Relu where

3030 get = return Relu

3131

3232instance ( KnownNat i) => Layer Relu ('D1 i) ('D1 i) where

33− runForwards _ (S1D y) = S1D (relu y)

33+ type Tape Relu ('D1 i) ('D1 i) = S ('D1 i)

34+

35+ runForwards _ (S1D y) = (S1D y, S1D (relu y))

3436 where

3537 relu = LAS.dvmap (\a -> if a <= 0 then 0 else a)

3638 runBackwards _ (S1D y) (S1D dEdy) = ((), S1D (relu' y * dEdy))

@@ -38,7 +40,9 @@ instance ( KnownNat i) => Layer Relu ('D1 i) ('D1 i) where

3840 relu' = LAS.dvmap (\a -> if a <= 0 then 0 else 1)

3941

4042instance (KnownNat i, KnownNat j) => Layer Relu ('D2 i j) ('D2 i j) where

41− runForwards _ (S2D y) = S2D (relu y)

43+ type Tape Relu ('D2 i j) ('D2 i j) = S ('D2 i j)

44+

45+ runForwards _ (S2D y) = (S2D y, S2D (relu y))

4246 where

4347 relu = LAS.dmmap (\a -> if a <= 0 then 0 else a)

4448 runBackwards _ (S2D y) (S2D dEdy) = ((), S2D (relu' y * dEdy))

@@ -46,7 +50,10 @@ instance (KnownNat i, KnownNat j) => Layer Relu ('D2 i j) ('D2 i j) where

4650 relu' = LAS.dmmap (\a -> if a <= 0 then 0 else 1)

4751

4852instance (KnownNat i, KnownNat j, KnownNat k) => Layer Relu ('D3 i j k) ('D3 i j k) where

49− runForwards _ (S3D y) = S3D (relu y)

53+

54+ type Tape Relu ('D3 i j k) ('D3 i j k) = S ('D3 i j k)

55+

56+ runForwards _ (S3D y) = (S3D y, S3D (relu y))

5057 where

5158 relu = LAS.dmmap (\a -> if a <= 0 then 0 else a)

5259 runBackwards _ (S3D y) (S3D dEdy) = ((), S3D (relu' y * dEdy))

src/Grenade/Layers/Tanh.hs+6−12

@@ -1,14 +1,15 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE TypeOperators #-}

33{-# LANGUAGE TypeFamilies #-}

4+{-# LANGUAGE FlexibleInstances #-}

45{-# LANGUAGE MultiParamTypeClasses #-}

56module Grenade.Layers.Tanh (

67 Tanh (..)

78 ) where

910import Data.Serialize

11+import Data.Singletons

1012

11−import GHC.TypeLits

1213import Grenade.Core.Network

1314import Grenade.Core.Shape

1415

@@ -26,17 +27,10 @@ instance Serialize Tanh where

2627 put _ = return ()

2728 get = return Tanh

2829

29−instance KnownNat i => Layer Tanh ('D1 i) ('D1 i) where

30− runForwards _ (S1D y) = S1D (tanh y)

31− runBackwards _ (S1D y) (S1D dEdy) = ((), S1D (tanh' y * dEdy))

32−

33−instance (KnownNat i, KnownNat j) => Layer Tanh ('D2 i j) ('D2 i j) where

34− runForwards _ (S2D y) = S2D (tanh y)

35− runBackwards _ (S2D y) (S2D dEdy) = ((), S2D (tanh' y * dEdy))

36−

37−instance (KnownNat i, KnownNat j, KnownNat k) => Layer Tanh ('D3 i j k) ('D3 i j k) where

38− runForwards _ (S3D y) = S3D (tanh y)

39− runBackwards _ (S3D y) (S3D dEdy) = ((), S3D (tanh' y * dEdy))

30+instance (a ~ b, SingI a, SingI b) => Layer Tanh a b where

31+ type Tape Tanh a b = S a

32+ runForwards _ a = (a, tanh a)

33+ runBackwards _ a g = ((), tanh' a * g)

4034

4135tanh' :: (Floating a) => a -> a

4236tanh' t = 1 - s ^ (2 :: Int) where s = tanh t

src/Grenade/Recurrent/Core/Runner.hs+11−7

@@ -48,11 +48,13 @@ trainRecurrent rate network recinputs examples =

4848 -- Note we're doing training here, we could just return a list of gradients

4949 -- (and probably will in future).

5050 go !xs (layer :~~> n) (() :~~+> nIn)

51− = let ys = runForwards layer <$> xs

51+ = let tys = runForwards layer <$> xs

52+ tapes = fst <$> tys

53+ ys = snd <$> tys

5254 -- recursively run the rest of the network, and get the gradients from above.

5355 (newFN, ig, grads) = go ys n nIn

5456 -- calculate the gradient for this layer to pass down,

55− back = uncurry (runBackwards layer) <$> zip (reverse xs) grads

57+ back = uncurry (runBackwards layer) <$> zip (reverse tapes) grads

5658 -- the new trained layer.

5759 newlayer = runUpdates rate layer (fst <$> back)

5860

@@ -75,11 +77,13 @@ trainRecurrent rate network recinputs examples =

7577 -- Handle the output layer, bouncing the derivatives back down.

7678 -- We may not have a target for each example, so when we don't use 0 gradient.

7779 go !xs (OR layer) (ORS ())

78− = let ys = runForwards layer <$> xs

80+ = let tys = runForwards layer <$> xs

81+ tapes = fst <$> tys

82+ ys = snd <$> tys

7983 -- recursively run the rest of the network, and get the gradients from above.

80− back = uncurry (runBackwards layer) <$> zip xs (zipWith makeError ys targets)

84+ back = uncurry (runBackwards layer) <$> zip tapes (zipWith makeError ys targets)

8185 -- the new trained layer.

82− newlayer = runUpdates rate layer (reverse $ fst <$> back)

86+ newlayer = runUpdates rate layer (reverse $ fst <$> back)

8387 in (OR newlayer, ORS (), reverse (snd <$> back))

8488

8589 go _ _ _ =

@@ -136,7 +140,7 @@ runRecurrent :: RecurrentNetwork layers shapes

136140 -> RecurrentInputs layers -> S (Head shapes)

137141 -> (RecurrentInputs layers, S (Last shapes))

138142runRecurrent (layer :~~> n) (() :~~+> nr) !x

139− = let ys = runForwards layer x

143+ = let (_, ys) = runForwards layer x

140144 (nr', o) = runRecurrent n nr ys

141145 in (() :~~+> nr', o)

142146runRecurrent (layer :~@> n) (recin :~@+> nr) !x

@@ -144,7 +148,7 @@ runRecurrent (layer :~@> n) (recin :~@+> nr) !x

144148 (nr', o) = runRecurrent n nr y

145149 in (recin' :~@+> nr', o)

146150runRecurrent (OR layer) (ORS ()) !x

147− = (ORS (), runForwards layer x)

151+ = (ORS (), snd $ runForwards layer x)

148152

149153runRecurrent _ _ _

150154 = error "Impossible for the gradients of a network to have a different length or shape to the network"

src/Grenade/Recurrent/Layers/Trivial.hs+2−1

@@ -25,5 +25,6 @@ instance UpdateLayer Trivial where

2525 createRandom = return Trivial

2626

2727instance (a ~ b) => Layer Trivial a b where

28− runForwards _ = id

28+ type Tape Trivial a b = ()

29+ runForwards _ x = ((), x)

2930 runBackwards _ _ y = ((), y)