git.iko.soy/grenade
on master help sign in
Simplify Network Type
148c777Huw Campbell
main/recurrent.hs+4−5
compare with master
unifiedsplit
@@ -22,13 +22,12 @@ import Grenade.Recurrent
22--
22--
23-- The F and R types are Tagging types to ensure that the runner and
23-- The F and R types are Tagging types to ensure that the runner and
24-- creation function know how to treat the layers.
24-- creation function know how to treat the layers.
25−type F = FeedForward
26type R = Recurrent
25type R = Recurrent
27
26
28−type RecNet = RecurrentNetwork '[ R (LSTM 1 4), R (LSTM 4 1), F Trivial]
27+type RecNet = RecurrentNetwork '[ R (LSTM 1 4), R (LSTM 4 1)]
29− '[ 'D1 1, 'D1 4, 'D1 1, 'D1 1 ]
28+ '[ 'D1 1, 'D1 4, 'D1 1 ]
30
29
31−type RecInput = RecurrentInputs '[ R (LSTM 1 4), R (LSTM 4 1), F Trivial]
30+type RecInput = RecurrentInputs '[ R (LSTM 1 4), R (LSTM 4 1)]
32
31
33randomNet :: MonadRandom m => m (RecNet, RecInput)
32randomNet :: MonadRandom m => m (RecNet, RecInput)
34randomNet = randomRecurrent
33randomNet = randomRecurrent
@@ -51,7 +50,7 @@ netTest net0 i0 rate iterations =
51data FeedForwardOpts = FeedForwardOpts Int LearningParameters
50data FeedForwardOpts = FeedForwardOpts Int LearningParameters
52
51
53feedForward' :: Parser FeedForwardOpts
52feedForward' :: Parser FeedForwardOpts
54−feedForward' = FeedForwardOpts <$> option auto (long "examples" <> short 'e' <> value 20000)
53+feedForward' = FeedForwardOpts <$> option auto (long "examples" <> short 'e' <> value 40000)
55 <*> (LearningParameters
54 <*> (LearningParameters
56 <$> option auto (long "train_rate" <> short 'r' <> value 0.01)
55 <$> option auto (long "train_rate" <> short 'r' <> value 0.01)
57 <*> option auto (long "momentum" <> value 0.9)
56 <*> option auto (long "momentum" <> value 0.9)
src/Grenade/Core/Network.hs+10−11
@@ -82,18 +82,18 @@ class UpdateLayer x => Layer x (i :: Shape) (o :: Shape) where
82-- Can be considered to be a heterogeneous list of layers which are able to
82-- Can be considered to be a heterogeneous list of layers which are able to
83-- transform the data shapes of the network.
83-- transform the data shapes of the network.
84data Network :: [*] -> [Shape] -> * where
84data Network :: [*] -> [Shape] -> * where
85− O :: (SingI i, SingI o, Layer x i o) => !x -> Network '[x] '[i, o]
85+ NNil :: SingI i => Network '[] '[i]
86 (:~>) :: (SingI i, SingI h, Layer x i h) => !x -> !(Network xs (h ': hs)) -> Network (x ': xs) (i ': h ': hs)
86 (:~>) :: (SingI i, SingI h, Layer x i h) => !x -> !(Network xs (h ': hs)) -> Network (x ': xs) (i ': h ': hs)
87infixr 5 :~>
87infixr 5 :~>
88
88
89instance Show (Network l h) where
89instance Show (Network l h) where
90− show (O a) = "O " ++ show a
90+ show NNil = "NNil"
91 show (i :~> o) = show i ++ "\n:~>\n" ++ show o
91 show (i :~> o) = show i ++ "\n:~>\n" ++ show o
92
92
93-- | Gradients of a network.
93-- | Gradients of a network.
94-- Parameterised on the layers of a Network.
94-- Parameterised on the layers of a Network.
95data Gradients :: [*] -> * where
95data Gradients :: [*] -> * where
96− OG :: UpdateLayer x => Gradient x -> Gradients '[x]
96+ GNil :: Gradients '[]
97 (:/>) :: UpdateLayer x => Gradient x -> Gradients xs -> Gradients (x ': xs)
97 (:/>) :: UpdateLayer x => Gradient x -> Gradients xs -> Gradients (x ': xs)
98
98
99-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random
99-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random
@@ -102,19 +102,18 @@ class CreatableNetwork (xs :: [*]) (ss :: [Shape]) where
102 -- | Create a network of the types requested
102 -- | Create a network of the types requested
103 randomNetwork :: MonadRandom m => m (Network xs ss)
103 randomNetwork :: MonadRandom m => m (Network xs ss)
104
104
105−instance (SingI i, SingI o, Layer x i o) => CreatableNetwork (x ': '[]) (i ': o ': '[]) where
105+instance SingI i => CreatableNetwork '[] '[i] where
106− randomNetwork = O <$> createRandom
106+ randomNetwork = return NNil
107
107
108−instance (SingI i, SingI o, Layer x i o, CreatableNetwork xs (o ': r ': rs)) => CreatableNetwork (x ': xs) (i ': o ': r ': rs) where
108+instance (SingI i, SingI o, Layer x i o, CreatableNetwork xs (o ': rs)) => CreatableNetwork (x ': xs) (i ': o ': rs) where
109 randomNetwork = (:~>) <$> createRandom <*> randomNetwork
109 randomNetwork = (:~>) <$> createRandom <*> randomNetwork
110
110
111
111
112-- | Add very simple serialisation to the network
112-- | Add very simple serialisation to the network
113−instance (SingI i, SingI o, Layer x i o, Serialize x) => Serialize (Network '[x] '[i, o]) where
113+instance SingI i => Serialize (Network '[] '[i]) where
114− put (O x) = put x
114+ put NNil = pure ()
115− put _ = error "impossible"
115+ get = return NNil
116− get = O <$> get
117
116
118−instance (SingI i, SingI o, Layer x i o, Serialize x, Serialize (Network xs (o ': r ': rs))) => Serialize (Network (x ': xs) (i ': o ': r ': rs)) where
117+instance (SingI i, SingI o, Layer x i o, Serialize x, Serialize (Network xs (o ': rs))) => Serialize (Network (x ': xs) (i ': o ': rs)) where
119 put (x :~> r) = put x >> put r
118 put (x :~> r) = put x >> put r
120 get = (:~>) <$> get <*> get
119 get = (:~>) <$> get <*> get
src/Grenade/Core/Runner.hs+6−12
@@ -51,22 +51,16 @@ backPropagate network input target =
51
51
52 in (layer' :/> n', dWs)
52 in (layer' :/> n', dWs)
53
53
54− -- handle the output layer, bouncing the derivatives back down.
54+ -- Bouncing the derivatives back down.
55− go !x (O layer)
55+ go !x NNil
56− = let (tape, y) = runForwards layer x
56+ = (GNil, x - target)
57− -- the gradient (how much y affects the error)
58− (layer', dWs) = runBackwards layer tape (y - target)
59−
60− in (OG layer', dWs)
61
57
62-- | Apply one step of stochastic gradient decent across the network.
58-- | Apply one step of stochastic gradient decent across the network.
63applyUpdate :: LearningParameters -> Network ls ss -> Gradients ls -> Network ls ss
59applyUpdate :: LearningParameters -> Network ls ss -> Gradients ls -> Network ls ss
64−applyUpdate rate (O layer) (OG gradient)
60+applyUpdate _ NNil GNil
65− = O (runUpdate rate layer gradient)
61+ = NNil
66applyUpdate rate (layer :~> rest) (gradient :/> grest)
62applyUpdate rate (layer :~> rest) (gradient :/> grest)
67 = runUpdate rate layer gradient :~> applyUpdate rate rest grest
63 = runUpdate rate layer gradient :~> applyUpdate rate rest grest
68−applyUpdate _ _ _
69− = error "Impossible for the gradients of a network to have a different length to the network"
70
64
71-- | Update a network with new weights after training with an instance.
65-- | Update a network with new weights after training with an instance.
72train :: LearningParameters -> Network layers shapes -> S (Head shapes) -> S (Last shapes) -> Network layers shapes
66train :: LearningParameters -> Network layers shapes -> S (Head shapes) -> S (Last shapes) -> Network layers shapes
@@ -77,4 +71,4 @@ train rate network input output =
77-- | Run the network with input and return the given output.
71-- | Run the network with input and return the given output.
78runNet :: Network layers shapes -> S (Head shapes) -> S (Last shapes)
72runNet :: Network layers shapes -> S (Head shapes) -> S (Last shapes)
79runNet (layer :~> n) !x = let (_, y) = runForwards layer x in runNet n y
73runNet (layer :~> n) !x = let (_, y) = runForwards layer x in runNet n y
80−runNet (O layer) !x = snd (runForwards layer x)
74+runNet NNil !x = x
src/Grenade/Layers/Dropout.hs+13−19
@@ -13,32 +13,26 @@ import GHC.TypeLits
13import Grenade.Core.Shape
13import Grenade.Core.Shape
14import Grenade.Core.Network
14import Grenade.Core.Network
15
15
16−import Numeric.LinearAlgebra.Static
17−
18−
19-- Dropout layer help to reduce overfitting.
16-- Dropout layer help to reduce overfitting.
20-- Idea here is that the vector is a shape of 1s and 0s, which we multiply the input by.
17-- Idea here is that the vector is a shape of 1s and 0s, which we multiply the input by.
21-- After backpropogation, we return a new matrix/vector, with different bits dropped out.
18-- After backpropogation, we return a new matrix/vector, with different bits dropped out.
22-- Double is the proportion to drop in each training iteration (like 1% or 5% would be
19-- Double is the proportion to drop in each training iteration (like 1% or 5% would be
23-- reasonable).
20-- reasonable).
24−data Dropout o =
21+data Dropout = Dropout {
25− Dropout (R o)
22+ dropoutRate :: Double
23+ , dropoutSeed :: Int
26− deriving Show
24+ } deriving Show
27
25
28−instance (KnownNat i) => UpdateLayer (Dropout i) where
26+instance UpdateLayer Dropout where
29− type Gradient (Dropout i) = ()
27+ type Gradient Dropout = ()
30 runUpdate _ x _ = x
28 runUpdate _ x _ = x
31 createRandom = randomDropout 0.95
29 createRandom = randomDropout 0.95
32
30
33−randomDropout :: (MonadRandom m, KnownNat i)
31+randomDropout :: MonadRandom m
34− => Double -> m (Dropout i)
32+ => Double -> m Dropout
35−randomDropout rate = do
33+randomDropout rate = Dropout rate <$> getRandom
36− seed <- getRandom
37− let wN = randomVector seed Uniform
38− xs = dvmap (\a -> if a <= rate then 0 else 1) wN
39− return $ Dropout xs
40
34
41−instance (KnownNat i) => Layer (Dropout i) ('D1 i) ('D1 i) where
35+instance (KnownNat i) => Layer Dropout ('D1 i) ('D1 i) where
42− type Tape (Dropout i) ('D1 i) ('D1 i) = ()
36+ type Tape Dropout ('D1 i) ('D1 i) = ()
43− runForwards (Dropout drops) (S1D x) = ((), S1D $ x * drops)
37+ runForwards (Dropout _ _) (S1D x) = ((), S1D x)
44− runBackwards (Dropout drops) _ (S1D x) = ((), S1D $ x * drops)
38+ runBackwards (Dropout _ _) _ (S1D x) = ((), S1D x)
src/Grenade/Layers/FullyConnected.hs+2−1
@@ -6,6 +6,7 @@
6{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7module Grenade.Layers.FullyConnected (
7module Grenade.Layers.FullyConnected (
8 FullyConnected (..)
8 FullyConnected (..)
9+ , FullyConnected' (..)
9 , randomFullyConnected
10 , randomFullyConnected
10 ) where
11 ) where
11
12
@@ -25,7 +26,7 @@ import Grenade.Layers.Internal.Update
25
26
26-- | A basic fully connected (or inner product) neural network layer.
27-- | A basic fully connected (or inner product) neural network layer.
27data FullyConnected i o = FullyConnected
28data FullyConnected i o = FullyConnected
28− !(FullyConnected' i o) -- Weuron weights
29+ !(FullyConnected' i o) -- Neuron weights
29 !(FullyConnected' i o) -- Neuron momentum
30 !(FullyConnected' i o) -- Neuron momentum
30
31
31data FullyConnected' i o = FullyConnected'
32data FullyConnected' i o = FullyConnected'
src/Grenade/Layers/Logit.hs+6−15
@@ -1,6 +1,7 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE TypeOperators #-}
2{-# LANGUAGE TypeOperators #-}
3{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
4+{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
5module Grenade.Layers.Logit (
6module Grenade.Layers.Logit (
6 Logit (..)
7 Logit (..)
@@ -8,8 +9,8 @@ module Grenade.Layers.Logit (
8
9
9
10
10import Data.Serialize
11import Data.Serialize
12+import Data.Singletons
11
13
12−import Data.Singletons.TypeLits
13import Grenade.Core.Network
14import Grenade.Core.Network
14import Grenade.Core.Shape
15import Grenade.Core.Shape
15
16
@@ -25,20 +26,10 @@ instance UpdateLayer Logit where
25 runUpdate _ _ _ = Logit
26 runUpdate _ _ _ = Logit
26 createRandom = return Logit
27 createRandom = return Logit
27
28
28−instance (KnownNat i) => Layer Logit ('D1 i) ('D1 i) where
29+instance (a ~ b, SingI a) => Layer Logit a b where
29− type Tape Logit ('D1 i) ('D1 i) = S ('D1 i)
30− runForwards _ (S1D y) = (S1D y, S1D (logistic y))
31− runBackwards _ (S1D y) (S1D dEdy) = ((), S1D (logistic' y * dEdy))
32−
33−instance (KnownNat i, KnownNat j) => Layer Logit ('D2 i j) ('D2 i j) where
34− type Tape Logit ('D2 i j) ('D2 i j) = S ('D2 i j)
35− runForwards _ (S2D y) = (S2D y, S2D (logistic y))
36− runBackwards _ (S2D y) (S2D dEdy) = ((), S2D (logistic' y * dEdy))
37−
38−instance (KnownNat i, KnownNat j, KnownNat k) => Layer Logit ('D3 i j k) ('D3 i j k) where
39− type Tape Logit ('D3 i j k) ('D3 i j k) = S ('D3 i j k)
30+ type Tape Logit a b = S a
40− runForwards _ (S3D y) = (S3D y, S3D (logistic y))
31+ runForwards _ a = (a, logistic a)
41− runBackwards _ (S3D y) (S3D dEdy) = ((), S3D (logistic' y * dEdy))
32+ runBackwards _ a g = ((), logistic' a * g)
42
33
43instance Serialize Logit where
34instance Serialize Logit where
44 put _ = return ()
35 put _ = return ()
src/Grenade/Layers/Tanh.hs+1−1
@@ -27,7 +27,7 @@ instance Serialize Tanh where
27 put _ = return ()
27 put _ = return ()
28 get = return Tanh
28 get = return Tanh
29
29
30−instance (a ~ b, SingI a, SingI b) => Layer Tanh a b where
30+instance (a ~ b, SingI a) => Layer Tanh a b where
31 type Tape Tanh a b = S a
31 type Tape Tanh a b = S a
32 runForwards _ a = (a, tanh a)
32 runForwards _ a = (a, tanh a)
33 runBackwards _ a g = ((), tanh' a * g)
33 runBackwards _ a g = ((), tanh' a * g)
src/Grenade/Recurrent/Core/Network.hs+17−20
@@ -53,14 +53,14 @@ class (RecurrentUpdateLayer x, SingI (RecurrentShape x)) => RecurrentLayer x (i
53 runRecurrentBackwards :: x -> S (RecurrentShape x) -> S i -> S (RecurrentShape x) -> S o -> (Gradient x, S (RecurrentShape x), S i)
53 runRecurrentBackwards :: x -> S (RecurrentShape x) -> S i -> S (RecurrentShape x) -> S o -> (Gradient x, S (RecurrentShape x), S i)
54
54
55data RecurrentNetwork :: [*] -> [Shape] -> * where
55data RecurrentNetwork :: [*] -> [Shape] -> * where
56− OR :: (SingI i, SingI o, Layer x i o) => !x -> RecurrentNetwork '[FeedForward x] '[i, o]
56+ RNil :: SingI i => RecurrentNetwork '[] '[i]
57 (:~~>) :: (SingI i, Layer x i h) => !x -> !(RecurrentNetwork xs (h ': hs)) -> RecurrentNetwork (FeedForward x ': xs) (i ': h ': hs)
57 (:~~>) :: (SingI i, Layer x i h) => !x -> !(RecurrentNetwork xs (h ': hs)) -> RecurrentNetwork (FeedForward x ': xs) (i ': h ': hs)
58 (:~@>) :: (SingI i, RecurrentLayer x i h) => !x -> !(RecurrentNetwork xs (h ': hs)) -> RecurrentNetwork (Recurrent x ': xs) (i ': h ': hs)
58 (:~@>) :: (SingI i, RecurrentLayer x i h) => !x -> !(RecurrentNetwork xs (h ': hs)) -> RecurrentNetwork (Recurrent x ': xs) (i ': h ': hs)
59infixr 5 :~~>
59infixr 5 :~~>
60infixr 5 :~@>
60infixr 5 :~@>
61
61
62instance Show (RecurrentNetwork l h) where
62instance Show (RecurrentNetwork l h) where
63− show (OR a) = "OR " ++ show a
63+ show RNil = "RNil"
64 show (i :~~> o) = show i ++ "\n:~~>\n" ++ show o
64 show (i :~~> o) = show i ++ "\n:~~>\n" ++ show o
65 show (i :~@> o) = show i ++ "\n:~@>\n" ++ show o
65 show (i :~@> o) = show i ++ "\n:~@>\n" ++ show o
66
66
@@ -68,8 +68,7 @@ instance Show (RecurrentNetwork l h) where
68-- | Recurrent inputs (sideways shapes on an imaginary unrolled graph)
68-- | Recurrent inputs (sideways shapes on an imaginary unrolled graph)
69-- Parameterised on the layers of a Network.
69-- Parameterised on the layers of a Network.
70data RecurrentInputs :: [*] -> * where
70data RecurrentInputs :: [*] -> * where
71− ORS :: UpdateLayer x
72− => () -> RecurrentInputs '[FeedForward x]
71+ RINil :: RecurrentInputs '[]
73 (:~~+>) :: UpdateLayer x
72 (:~~+>) :: UpdateLayer x
74 => () -> !(RecurrentInputs xs) -> RecurrentInputs (FeedForward x ': xs)
73 => () -> !(RecurrentInputs xs) -> RecurrentInputs (FeedForward x ': xs)
75 (:~@+>) :: (SingI (RecurrentShape x), RecurrentUpdateLayer x)
74 (:~@+>) :: (SingI (RecurrentShape x), RecurrentUpdateLayer x)
@@ -83,18 +82,17 @@ class CreatableRecurrent (xs :: [*]) (ss :: [Shape]) where
83 -- | Create a network of the types requested
82 -- | Create a network of the types requested
84 randomRecurrent :: MonadRandom m => m (RecurrentNetwork xs ss, RecurrentInputs xs)
83 randomRecurrent :: MonadRandom m => m (RecurrentNetwork xs ss, RecurrentInputs xs)
85
84
86−instance (SingI i, SingI o, Layer x i o) => CreatableRecurrent (FeedForward x ': '[]) (i ': o ': '[]) where
85+instance SingI i => CreatableRecurrent '[] '[i] where
87− randomRecurrent = do
86+ randomRecurrent =
88− thisLayer <- createRandom
87+ return (RNil, RINil)
89− return (OR thisLayer, ORS ())
90
88
91−instance (SingI i, Layer x i o, CreatableRecurrent xs (o ': r ': rs)) => CreatableRecurrent (FeedForward x ': xs) (i ': o ': r ': rs) where
89+instance (SingI i, Layer x i o, CreatableRecurrent xs (o ': rs)) => CreatableRecurrent (FeedForward x ': xs) (i ': o ': rs) where
92 randomRecurrent = do
90 randomRecurrent = do
93 thisLayer <- createRandom
91 thisLayer <- createRandom
94 (rest, resti) <- randomRecurrent
92 (rest, resti) <- randomRecurrent
95 return (thisLayer :~~> rest, () :~~+> resti)
93 return (thisLayer :~~> rest, () :~~+> resti)
96
94
97−instance (SingI i, RecurrentLayer x i o, CreatableRecurrent xs (o ': r ': rs)) => CreatableRecurrent (Recurrent x ': xs) (i ': o ': r ': rs) where
95+instance (SingI i, RecurrentLayer x i o, CreatableRecurrent xs (o ': rs)) => CreatableRecurrent (Recurrent x ': xs) (i ': o ': rs) where
98 randomRecurrent = do
96 randomRecurrent = do
99 thisLayer <- createRandom
97 thisLayer <- createRandom
100 thisShape <- randomOfShape
98 thisShape <- randomOfShape
@@ -102,28 +100,27 @@ instance (SingI i, RecurrentLayer x i o, CreatableRecurrent xs (o ': r ': rs)) =
102 return (thisLayer :~@> rest, thisShape :~@+> resti)
100 return (thisLayer :~@> rest, thisShape :~@+> resti)
103
101
104-- | Add very simple serialisation to the recurrent network
102-- | Add very simple serialisation to the recurrent network
105−instance (SingI i, SingI o, Layer x i o, Serialize x) => Serialize (RecurrentNetwork '[FeedForward x] '[i, o]) where
103+instance SingI i => Serialize (RecurrentNetwork '[] '[i]) where
106− put (OR x) = put x
104+ put RNil = pure ()
107− put _ = error "impossible"
105+ get = pure RNil
108− get = OR <$> get
109
106
110−instance (SingI i, Layer x i o, Serialize x, Serialize (RecurrentNetwork xs (o ': r ': rs))) => Serialize (RecurrentNetwork (FeedForward x ': xs) (i ': o ': r ': rs)) where
107+instance (SingI i, Layer x i o, Serialize x, Serialize (RecurrentNetwork xs (o ': rs))) => Serialize (RecurrentNetwork (FeedForward x ': xs) (i ': o ': rs)) where
111 put (x :~~> r) = put x >> put r
108 put (x :~~> r) = put x >> put r
112 get = (:~~>) <$> get <*> get
109 get = (:~~>) <$> get <*> get
113
110
114−instance (SingI i, RecurrentLayer x i o, Serialize x, Serialize (RecurrentNetwork xs (o ': r ': rs))) => Serialize (RecurrentNetwork (Recurrent x ': xs) (i ': o ': r ': rs)) where
111+instance (SingI i, RecurrentLayer x i o, Serialize x, Serialize (RecurrentNetwork xs (o ': rs))) => Serialize (RecurrentNetwork (Recurrent x ': xs) (i ': o ': rs)) where
115 put (x :~@> r) = put x >> put r
112 put (x :~@> r) = put x >> put r
116 get = (:~@>) <$> get <*> get
113 get = (:~@>) <$> get <*> get
117
114
118−instance (UpdateLayer x) => (Serialize (RecurrentInputs '[FeedForward x])) where
115+instance (Serialize (RecurrentInputs '[])) where
119 put _ = return ()
116 put _ = return ()
120− get = return (ORS ())
117+ get = return RINil
121
118
122−instance (UpdateLayer x, Serialize (RecurrentInputs (y ': ys))) => (Serialize (RecurrentInputs (FeedForward x ': y ': ys))) where
119+instance (UpdateLayer x, Serialize (RecurrentInputs ys)) => (Serialize (RecurrentInputs (FeedForward x ': ys))) where
123 put ( () :~~+> rest) = put rest
120 put ( () :~~+> rest) = put rest
124 get = ( () :~~+> ) <$> get
121 get = ( () :~~+> ) <$> get
125
122
126−instance (SingI (RecurrentShape x), RecurrentUpdateLayer x, Serialize (RecurrentInputs (y ': ys))) => (Serialize (RecurrentInputs (Recurrent x ': y ': ys))) where
123+instance (SingI (RecurrentShape x), RecurrentUpdateLayer x, Serialize (RecurrentInputs ys)) => (Serialize (RecurrentInputs (Recurrent x ': ys))) where
127 put ( i :~@+> rest ) = do
124 put ( i :~@+> rest ) = do
128 _ <- (case i of
125 _ <- (case i of
129 (S1D x) -> putListOf put . LA.toList . LAS.extract $ x
126 (S1D x) -> putListOf put . LA.toList . LAS.extract $ x
src/Grenade/Recurrent/Core/Runner.hs+10−26
@@ -76,23 +76,12 @@ trainRecurrent rate network recinputs examples =
76
76
77 -- Handle the output layer, bouncing the derivatives back down.
77 -- Handle the output layer, bouncing the derivatives back down.
78 -- We may not have a target for each example, so when we don't use 0 gradient.
78 -- We may not have a target for each example, so when we don't use 0 gradient.
79− go !xs (OR layer) (ORS ())
79+ go !xs RNil RINil
80− = let tys = runForwards layer <$> xs
81− tapes = fst <$> tys
82− ys = snd <$> tys
83− -- recursively run the rest of the network, and get the gradients from above.
84− back = uncurry (runBackwards layer) <$> zip tapes (zipWith makeError ys targets)
80+ = (RNil, RINil, reverse (zipWith makeError xs targets))
85− -- the new trained layer.
81+ where
86− newlayer = runUpdates rate layer (reverse $ fst <$> back)
87− in (OR newlayer, ORS (), reverse (snd <$> back))
88−
89− go _ _ _ =
90− error "Impossible for network and recurrent inputs to have different shapes"
91−
92−
93− makeError :: S (Last shapes) -> Maybe (S (Last shapes)) -> S (Last shapes)
82+ makeError :: S (Last shapes) -> Maybe (S (Last shapes)) -> S (Last shapes)
94− makeError _ Nothing = 0
83+ makeError _ Nothing = 0
95− makeError y (Just t) = y - t
84+ makeError y (Just t) = y - t
96
85
97 updateRecInputs :: forall sublayers.
86 updateRecInputs :: forall sublayers.
98 LearningParameters
87 LearningParameters
@@ -106,10 +95,8 @@ trainRecurrent rate network recinputs examples =
106 updateRecInputs l@LearningParameters {..} (x :~@+> xs) (y :~@+> ys)
95 updateRecInputs l@LearningParameters {..} (x :~@+> xs) (y :~@+> ys)
107 = (realToFrac (learningRate * learningRegulariser) * x - realToFrac learningRate * y) :~@+> updateRecInputs l xs ys
96 = (realToFrac (learningRate * learningRegulariser) * x - realToFrac learningRate * y) :~@+> updateRecInputs l xs ys
108
97
109− updateRecInputs _ (ORS ()) (ORS ())
98+ updateRecInputs _ RINil RINil
110− = ORS ()
99+ = RINil
111− updateRecInputs _ _ _
112− = error "Impossible for updateRecInputs to have different shapes"
113
100
114scanlFrom :: forall x i o. RecurrentLayer x i o
101scanlFrom :: forall x i o. RecurrentLayer x i o
115 => x -- ^ the layer
102 => x -- ^ the layer
@@ -147,8 +134,5 @@ runRecurrent (layer :~@> n) (recin :~@+> nr) !x
147 = let (recin', y) = runRecurrentForwards layer recin x
134 = let (recin', y) = runRecurrentForwards layer recin x
148 (nr', o) = runRecurrent n nr y
135 (nr', o) = runRecurrent n nr y
149 in (recin' :~@+> nr', o)
136 in (recin' :~@+> nr', o)
150−runRecurrent (OR layer) (ORS ()) !x
137+runRecurrent RNil RINil !x
151− = (ORS (), snd $ runForwards layer x)
138+ = (RINil, x)
152−
153−runRecurrent _ _ _
154− = error "Impossible for the gradients of a network to have a different length or shape to the network"
test/Test/Grenade/Layers/Convolution.hs+2−2
@@ -92,9 +92,9 @@ prop_conv_net =
92 , (unsafeCoerce (Dict :: Dict ()) :: Dict (((outCols - 1) * strideCols) ~ (inCols - kernelCols)))) of
92 , (unsafeCoerce (Dict :: Dict ()) :: Dict (((outCols - 1) * strideCols) ~ (inCols - kernelCols)))) of
93 (Dict, Dict, Dict, Dict) ->
93 (Dict, Dict, Dict, Dict) ->
94 gamble (S3D <$> uniformSample) $ \(input :: S ('D3 inRows inCols channels)) ->
94 gamble (S3D <$> uniformSample) $ \(input :: S ('D3 inRows inCols channels)) ->
95− let output :: S ('D3 outRows outCols filters) = runForwards convLayer input
95+ let (tape, output :: S ('D3 outRows outCols filters)) = runForwards convLayer input
96 backed :: (Gradient (Convolution channels filters kernelRows kernelCols strideRows strideCols), S ('D3 inRows inCols channels))
96 backed :: (Gradient (Convolution channels filters kernelRows kernelCols strideRows strideCols), S ('D3 inRows inCols channels))
97− = runBackwards convLayer input output
97+ = runBackwards convLayer tape output
98 in backed `seq` True
98 in backed `seq` True
99 ) :: Property
99 ) :: Property
100 ) :: Property
100 ) :: Property
test/Test/Grenade/Layers/FullyConnected.hs+3−3
@@ -39,15 +39,15 @@ genOpaqueFullyConnected = do
39 bM <- randomVector
39 bM <- randomVector
40 wN <- uniformSample
40 wN <- uniformSample
41 kM <- uniformSample
41 kM <- uniformSample
42− return . OpaqueFullyConnected $ (FullyConnected wB bM wN kM :: FullyConnected i' o')
42+ return . OpaqueFullyConnected $ (FullyConnected (FullyConnected' wB wN) (FullyConnected' bM kM) :: FullyConnected i' o')
43
43
44prop_fully_connected_forwards :: Property
44prop_fully_connected_forwards :: Property
45prop_fully_connected_forwards =
45prop_fully_connected_forwards =
46 gamble genOpaqueFullyConnected $ \(OpaqueFullyConnected (fclayer :: FullyConnected i o)) ->
46 gamble genOpaqueFullyConnected $ \(OpaqueFullyConnected (fclayer :: FullyConnected i o)) ->
47 gamble (S1D <$> randomVector) $ \(input :: S ('D1 i)) ->
47 gamble (S1D <$> randomVector) $ \(input :: S ('D1 i)) ->
48− let output :: S ('D1 o) = runForwards fclayer input
48+ let (tape, output :: S ('D1 o)) = runForwards fclayer input
49 backed :: (Gradient (FullyConnected i o), S ('D1 i))
49 backed :: (Gradient (FullyConnected i o), S ('D1 i))
50− = runBackwards fclayer input output
50+ = runBackwards fclayer tape output
51 in backed `seq` True
51 in backed `seq` True
52
52
53return []
53return []