git.iko.soy/grenade
on master help sign in
Split back propagation function into two.
c8cfa39Huw Campbell
src/Grenade/Core/Layer.hs+18−7
compare with master
unifiedsplit
@@ -12,6 +12,9 @@ Description : Core definition a simple neural etwork
12Copyright : (c) Huw Campbell, 2016-2017
12Copyright : (c) Huw Campbell, 2016-2017
13License : BSD2
13License : BSD2
14Stability : experimental
14Stability : experimental
15+
16+This module defines what a Layer is in a Grenade
17+neural network.
15-}
18-}
16module Grenade.Core.Layer (
19module Grenade.Core.Layer (
17 Layer (..)
20 Layer (..)
@@ -25,12 +28,14 @@ import Data.List ( foldl' )
25import Grenade.Core.Shape
28import Grenade.Core.Shape
26import Grenade.Core.LearningParameters
29import Grenade.Core.LearningParameters
27
30
28−-- | Class for updating a layer. All layers implement this, and it is
31+-- | Class for updating a layer. All layers implement this, as it
29−-- shape independent.
32+-- describes how to create and update the layer.
33+--
30class UpdateLayer x where
34class UpdateLayer x where
31 -- | The type for the gradient for this layer.
35 -- | The type for the gradient for this layer.
32 -- Unit if there isn't a gradient to pass back.
36 -- Unit if there isn't a gradient to pass back.
33 type Gradient x :: *
37 type Gradient x :: *
38+
34 -- | Update a layer with its gradient and learning parameters
39 -- | Update a layer with its gradient and learning parameters
35 runUpdate :: LearningParameters -> x -> Gradient x -> x
40 runUpdate :: LearningParameters -> x -> Gradient x -> x
36
41
@@ -44,17 +49,23 @@ class UpdateLayer x where
44 {-# MINIMAL runUpdate, createRandom #-}
49 {-# MINIMAL runUpdate, createRandom #-}
45
50
46-- | Class for a layer. All layers implement this, however, they don't
51-- | Class for a layer. All layers implement this, however, they don't
47−-- need to implement it for all shapes, only ones which are appropriate.
52+-- need to implement it for all shapes, only ones which are
53+-- appropriate.
54+--
48class UpdateLayer x => Layer x (i :: Shape) (o :: Shape) where
55class UpdateLayer x => Layer x (i :: Shape) (o :: Shape) where
49 -- | The Wengert tape for this layer. Includes all that is required
56 -- | The Wengert tape for this layer. Includes all that is required
50 -- to generate the back propagated gradients efficiently. As a
57 -- to generate the back propagated gradients efficiently. As a
51 -- default, `S i` is fine.
58 -- default, `S i` is fine.
52 type Tape x i o :: *
59 type Tape x i o :: *
60+
53 -- | Used in training and scoring. Take the input from the previous
61 -- | Used in training and scoring. Take the input from the previous
54 -- layer, and give the output from this layer.
62 -- layer, and give the output from this layer.
55 runForwards :: x -> S i -> (Tape x i o, S o)
63 runForwards :: x -> S i -> (Tape x i o, S o)
64+
56− -- | Back propagate a step. Takes the current layer, the input that the
65+ -- | Back propagate a step. Takes the current layer, the input that
57− -- layer gave from the input and the back propagated derivatives from
66+ -- the layer gave from the input and the back propagated derivatives
58− -- the layer above.
67+ -- from the layer above.
68+ --
59− -- Returns the gradient layer and the derivatives to push back further.
69+ -- Returns the gradient layer and the derivatives to push back
70+ -- further.
60 runBackwards :: x -> Tape x i o -> S o -> (Gradient x, S i)
71 runBackwards :: x -> Tape x i o -> S o -> (Gradient x, S i)
src/Grenade/Core/Network.hs+91−48
@@ -15,9 +15,8 @@ Copyright : (c) Huw Campbell, 2016-2017
15License : BSD2
15License : BSD2
16Stability : experimental
16Stability : experimental
17
17
18−This module defines the core data type for the simplest
18+This module defines the core data types and functions
19−Neural network we support.
19+for non-recurrent neural networks.
20−
21-}
20-}
22
21
23#if __GLASGOW_HASKELL__ < 800
22#if __GLASGOW_HASKELL__ < 800
@@ -28,9 +27,12 @@ module Grenade.Core.Network (
28 Network (..)
27 Network (..)
29 , Gradients (..)
28 , Gradients (..)
30 , Tapes (..)
29 , Tapes (..)
31− , CreatableNetwork (..)
32
30
31+ , runNetwork
32+ , runGradient
33 , applyUpdate
33 , applyUpdate
34+
35+ , randomNetwork
34 ) where
36 ) where
35
37
36import Control.Monad.Random ( MonadRandom )
38import Control.Monad.Random ( MonadRandom )
@@ -66,27 +68,94 @@ instance Show (Network '[] '[i]) where
66instance (Show x, Show (Network xs rs)) => Show (Network (x ': xs) (i ': rs)) where
68instance (Show x, Show (Network xs rs)) => Show (Network (x ': xs) (i ': rs)) where
67 show (x :~> xs) = show x ++ "\n~>\n" ++ show xs
69 show (x :~> xs) = show x ++ "\n~>\n" ++ show xs
68
70
69−
70−-- | Apply one step of stochastic gradient decent across the network.
71−applyUpdate :: LearningParameters -> Network ls ss -> Gradients ls -> Network ls ss
72−applyUpdate _ NNil GNil
73− = NNil
74−applyUpdate rate (layer :~> rest) (gradient :/> grest)
75− = runUpdate rate layer gradient :~> applyUpdate rate rest grest
76−
77−
78−
79−-- | Gradients of a network.
71+-- | Gradient of a network.
72+--
80-- Parameterised on the layers of the network.
73-- Parameterised on the layers of the network.
81data Gradients :: [*] -> * where
74data Gradients :: [*] -> * where
82 GNil :: Gradients '[]
75 GNil :: Gradients '[]
83− (:/>) :: UpdateLayer x => Gradient x -> Gradients xs -> Gradients (x ': xs)
84
76
77+ (:/>) :: UpdateLayer x
78+ => Gradient x
79+ -> Gradients xs
80+ -> Gradients (x ': xs)
81+
85−-- | Wegnert Tapes of a network.
82+-- | Wegnert Tape of a network.
83+--
86-- Parameterised on the layers and shapes of the network.
84-- Parameterised on the layers and shapes of the network.
87data Tapes :: [*] -> [Shape] -> * where
85data Tapes :: [*] -> [Shape] -> * where
88− TNil :: SingI i => Tapes '[] '[i]
86+ TNil :: SingI i
87+ => Tapes '[] '[i]
88+
89− (:\>) :: (SingI i, SingI h, Layer x i h) => !(Tape x i h) -> !(Tapes xs (h ': hs)) -> Tapes (x ': xs) (i ': h ': hs)
89+ (:\>) :: (SingI i, SingI h, Layer x i h)
90+ => !(Tape x i h)
91+ -> !(Tapes xs (h ': hs))
92+ -> Tapes (x ': xs) (i ': h ': hs)
93+
94+
95+-- | Running a network forwards with some input data.
96+--
97+-- This gives the output, and the Wengert tape required for back
98+-- propagation.
99+--
100+runNetwork :: forall layers shapes.
101+ Network layers shapes
102+ -> S (Head shapes)
103+ -> (Tapes layers shapes, S (Last shapes))
104+runNetwork =
105+ go
106+ where
107+ go :: forall js ss. (Last js ~ Last shapes)
108+ => Network ss js
109+ -> S (Head js)
110+ -> (Tapes ss js, S (Last js))
111+ go (layer :~> n) !x =
112+ let (tape, forward) = runForwards layer x
113+ (tapes, answer) = go n forward
114+ in (tape :\> tapes, answer)
115+
116+ go NNil !x
117+ = (TNil, x)
118+
119+
120+-- | Running a loss gradient back through the network.
121+--
122+-- This requires a Wengert tape, generated with the appropriate input
123+-- for the loss.
124+--
125+-- Gives the gradients for the layer, and the gradient across the
126+-- input (which may not be required).
127+--
128+runGradient :: forall layers shapes. Network layers shapes
129+ -> Tapes layers shapes
130+ -> S (Last shapes)
131+ -> (Gradients layers, S (Head shapes))
132+runGradient net tapes o =
133+ go net tapes
134+ where
135+ go :: forall js ss. (Last js ~ Last shapes)
136+ => Network ss js
137+ -> Tapes ss js
138+ -> (Gradients ss, S (Head js))
139+ go (layer :~> n) (tape :\> nt) =
140+ let (gradients, feed) = go n nt
141+ (layer', backGrad) = runBackwards layer tape feed
142+ in (layer' :/> gradients, backGrad)
143+
144+ go NNil TNil
145+ = (GNil, o)
146+
147+
148+-- | Apply one step of stochastic gradient decent across the network.
149+applyUpdate :: LearningParameters
150+ -> Network layers shapes
151+ -> Gradients layers
152+ -> Network layers shapes
153+applyUpdate rate (layer :~> rest) (gradient :/> grest)
154+ = runUpdate rate layer gradient :~> applyUpdate rate rest grest
155+
156+applyUpdate _ NNil GNil
157+ = NNil
158+
90
159
91-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random
160-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random
92-- network is with the randomNetwork.
161-- network is with the randomNetwork.
@@ -115,36 +184,10 @@ instance (SingI i, SingI o, Layer x i o, Serialize x, Serialize (Network xs (o '
115-- This allows a complete network to be treated as a layer in a bigger network.
184-- This allows a complete network to be treated as a layer in a bigger network.
116instance CreatableNetwork sublayers subshapes => UpdateLayer (Network sublayers subshapes) where
185instance CreatableNetwork sublayers subshapes => UpdateLayer (Network sublayers subshapes) where
117 type Gradient (Network sublayers subshapes) = Gradients sublayers
186 type Gradient (Network sublayers subshapes) = Gradients sublayers
118− runUpdate = applyUpdate
187+ runUpdate = applyUpdate
119 createRandom = randomNetwork
188 createRandom = randomNetwork
120
189
121instance (CreatableNetwork sublayers subshapes, i ~ (Head subshapes), o ~ (Last subshapes)) => Layer (Network sublayers subshapes) i o where
190instance (CreatableNetwork sublayers subshapes, i ~ (Head subshapes), o ~ (Last subshapes)) => Layer (Network sublayers subshapes) i o where
122 type Tape (Network sublayers subshapes) i o = Tapes sublayers subshapes
191 type Tape (Network sublayers subshapes) i o = Tapes sublayers subshapes
123−
124− runForwards net i =
192+ runForwards = runNetwork
125− go i net
193+ runBackwards = runGradient
126− where
127− go :: forall js ss. (Last js ~ Last subshapes)
128− => S (Head js) -- ^ input vector
129− -> Network ss js -- ^ network to train
130− -> (Tapes ss js, S (Last js))
131− go !x (layer :~> n) =
132− let (tape, forward) = runForwards layer x
133− (tapes, answer) = go forward n
134− in (tape :\> tapes, answer)
135− go !x NNil
136− = (TNil, x)
137−
138− runBackwards net tapes o =
139− go net tapes
140− where
141− go :: forall js ss. (Last js ~ Last subshapes)
142− => Network ss js -- ^ network to train
143− -> Tapes ss js -- ^ network to train
144− -> (Gradients ss, S (Head js))
145− go (layer :~> n) (tape :\> nt) =
146− let (gradients, feed) = go n nt
147− (layer', backGrad) = runBackwards layer tape feed
148− in (layer' :/> gradients, backGrad)
149− go NNil TNil
150− = (GNil, o)
src/Grenade/Core/Runner.hs+21−35
@@ -1,9 +1,5 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE GADTs #-}
3{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
2+{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE TypeOperators #-}
6−{-# LANGUAGE TypeFamilies #-}
7{-|
3{-|
8Module : Grenade.Core.Shape
4Module : Grenade.Core.Shape
9Description : Core definition of the Shapes of data we understand
5Description : Core definition of the Shapes of data we understand
@@ -14,19 +10,14 @@ Stability : experimental
14This module defines simple back propagation and training functions
10This module defines simple back propagation and training functions
15for a network.
11for a network.
16-}
12-}
17−
18−-- GHC 7.10 doesn't think that go is complete
19−{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
20module Grenade.Core.Runner (
13module Grenade.Core.Runner (
21 train
14 train
22 , backPropagate
15 , backPropagate
23 , runNet
16 , runNet
24− , applyUpdate
25 ) where
17 ) where
26
18
27import Data.Singletons.Prelude
19import Data.Singletons.Prelude
28
20
29−import Grenade.Core.Layer
30import Grenade.Core.LearningParameters
21import Grenade.Core.LearningParameters
31import Grenade.Core.Network
22import Grenade.Core.Network
32import Grenade.Core.Shape
23import Grenade.Core.Shape
@@ -36,37 +27,32 @@ import Grenade.Core.Shape
36--
27--
37-- /Note:/ The loss function pushed backwards is appropriate
28-- /Note:/ The loss function pushed backwards is appropriate
38-- for both regression and classification as a squared loss
29-- for both regression and classification as a squared loss
39−-- or log-loss respectively. Other loss functions are not yet
30+-- or log-loss respectively.
40−-- implemented.
31+--
32+-- For other loss functions, use runNetwork and runGradient
33+-- with the back propagated gradient of your loss.
34+--
41−backPropagate :: forall shapes layers.
35+backPropagate :: SingI (Last shapes)
42− Network layers shapes -> S (Head shapes) -> S (Last shapes) -> Gradients layers
36+ => Network layers shapes
37+ -> S (Head shapes)
38+ -> S (Last shapes)
39+ -> Gradients layers
43backPropagate network input target =
40backPropagate network input target =
44− fst $ go input network
41+ let (tapes, output) = runNetwork network input
45− where
42+ (grads, _) = runGradient network tapes (output - target)
46− go :: forall js sublayers. (Last js ~ Last shapes)
43+ in grads
47− => S (Head js) -- ^ input vector
48− -> Network sublayers js -- ^ network to train
49− -> (Gradients sublayers, S (Head js))
50− -- handle input from the beginning, feeding upwards.
51− go !x (layer :~> n)
52− = let (tape, y) = runForwards layer x
53− -- recursively run the rest of the network, and get the gradients from above.
54− (n', dWs') = go y n
55− -- calculate the gradient for this layer to pass down,
56− (layer', dWs) = runBackwards layer tape dWs'
57− in (layer' :/> n', dWs)
58−
59− -- Bouncing the derivatives back down.
60− go !x NNil
61− = (GNil, x - target)
62
44
63-- | Update a network with new weights after training with an instance.
45-- | Update a network with new weights after training with an instance.
64−train :: LearningParameters -> Network layers shapes -> S (Head shapes) -> S (Last shapes) -> Network layers shapes
46+train :: SingI (Last shapes)
47+ => LearningParameters
48+ -> Network layers shapes
49+ -> S (Head shapes)
50+ -> S (Last shapes)
51+ -> Network layers shapes
65train rate network input output =
52train rate network input output =
66 let grads = backPropagate network input output
53 let grads = backPropagate network input output
67 in applyUpdate rate network grads
54 in applyUpdate rate network grads
68
55
69-- | Run the network with input and return the given output.
56-- | Run the network with input and return the given output.
70runNet :: Network layers shapes -> S (Head shapes) -> S (Last shapes)
57runNet :: Network layers shapes -> S (Head shapes) -> S (Last shapes)
71−runNet (layer :~> n) !x = let (_, y) = runForwards layer x in runNet n y
58+runNet net = snd . runNetwork net
72−runNet NNil !x = x
src/Grenade/Core/Shape.hs+3−1
@@ -27,6 +27,7 @@ module Grenade.Core.Shape (
27 Shape (..)
27 Shape (..)
28 , S (..)
28 , S (..)
29 , Sing (..)
29 , Sing (..)
30+
30 , randomOfShape
31 , randomOfShape
31 , fromStorable
32 , fromStorable
32 ) where
33 ) where
@@ -59,7 +60,8 @@ data Shape
59 | D3 Nat Nat Nat
60 | D3 Nat Nat Nat
60 -- ^ Three dimensional matrix. Row, Column, Channels.
61 -- ^ Three dimensional matrix. Row, Column, Channels.
61
62
62−-- | Given a Shape n, these are the possible data structures with that shape.
63+-- | Concrete data structures for a Shape.
64+--
63-- All shapes are held in contiguous memory.
65-- All shapes are held in contiguous memory.
64-- 3D is held in a matrix (usually row oriented) which has height depth * rows.
66-- 3D is held in a matrix (usually row oriented) which has height depth * rows.
65data S (n :: Shape) where
67data S (n :: Shape) where