e6179ce · grenade · git.iko.soy

grenade.cabal+1

compare with master

unifiedsplit

@@ -54,6 +54,7 @@ library

54 Grenade.Layers.Fuse

55 Grenade.Layers.Logit

56 Grenade.Layers.Relu

57+ Grenade.Layers.Elu

57 Grenade.Layers.Tanh

58 Grenade.Layers.Tanh

58 Grenade.Layers.Pad

59 Grenade.Layers.Pad

59 Grenade.Layers.Pooling

60 Grenade.Layers.Pooling

main/mnist.hs+1−1

@@ -33,7 +33,7 @@ import Grenade.Utils.OneHot

33

34-- With the mnist data from Kaggle normalised to doubles between 0 and 1, learning rate of 0.01 and 15 iterations,

35-- this network should get down to about a 1.3% error rate.

36−type MNIST = Network '[ Convolution 1 10 5 5 1 1, Pooling 2 2 2 2, Relu, Convolution 10 16 5 5 1 1, Pooling 2 2 2 2, Relu, FlattenLayer, FullyConnected 256 80, Logit, FullyConnected 80 10, Logit]

36+type MNIST = Network '[ Convolution 1 10 5 5 1 1, Pooling 2 2 2 2, Elu, Convolution 10 16 5 5 1 1, Pooling 2 2 2 2, Elu, FlattenLayer, FullyConnected 256 80, Logit, FullyConnected 80 10, Logit]

37 '[ 'D2 28 28, 'D3 24 24 10, 'D3 12 12 10, 'D3 12 12 10, 'D3 8 8 16, 'D3 4 4 16, 'D3 4 4 16, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10]

38

39randomMnist :: MonadRandom m => m MNIST

src/Grenade.hs+1

@@ -15,5 +15,6 @@ import Grenade.Layers.FullyConnected as X

15import Grenade.Layers.Logit as X

16import Grenade.Layers.Convolution as X

17import Grenade.Layers.Relu as X

18+import Grenade.Layers.Elu as X

18import Grenade.Layers.Tanh as X

19import Grenade.Layers.Tanh as X

19import Grenade.Layers.Softmax as X

20import Grenade.Layers.Softmax as X

src/Grenade/Core/Network.hs−1

@@ -91,7 +91,6 @@ instance Show (Network '[] '[i]) where

91instance (Show x, Show (Network xs rs)) => Show (Network (x ': xs) (i ': rs)) where

92 show (x :~> xs) = show x ++ "\n~>\n" ++ show xs

93

94−

95-- | Gradients of a network.

94-- | Gradients of a network.

96-- Parameterised on the layers of a Network.

95-- Parameterised on the layers of a Network.

97data Gradients :: [*] -> * where

96data Gradients :: [*] -> * where

src/Grenade/Core/Shape.hs+1

@@ -25,6 +25,7 @@ are understood by Grenade.

25module Grenade.Core.Shape (

26 Shape (..)

27 , S (..)

28+ , Sing (..)

28 , randomOfShape

29 , randomOfShape

29 , fromStorable

30 , fromStorable

30 ) where

31 ) where

src/Grenade/Recurrent/Core/Network.hs+4−2

@@ -43,14 +43,16 @@ class UpdateLayer x => RecurrentUpdateLayer x where

43 type RecurrentShape x :: Shape

44

45class (RecurrentUpdateLayer x, SingI (RecurrentShape x)) => RecurrentLayer x (i :: Shape) (o :: Shape) where

46+ -- | Wengert Tape

47+ type RecTape x i o :: *

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

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

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

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

48− runRecurrentForwards :: x -> S (RecurrentShape x) -> S i -> (S (RecurrentShape x), S o)

50+ runRecurrentForwards :: x -> S (RecurrentShape x) -> S i -> (RecTape x i o, S (RecurrentShape x), S o)

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

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

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

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

51 -- the layer above.

53 -- the layer above.

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

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

53− runRecurrentBackwards :: x -> S (RecurrentShape x) -> S i -> S (RecurrentShape x) -> S o -> (Gradient x, S (RecurrentShape x), S i)

55+ runRecurrentBackwards :: x -> RecTape x i o -> S (RecurrentShape x) -> S o -> (Gradient x, S (RecurrentShape x), S i)

54

56

55data RecurrentNetwork :: [*] -> [Shape] -> * where

57data RecurrentNetwork :: [*] -> [Shape] -> * where

56 RNil :: SingI i => RecurrentNetwork '[] '[i]

58 RNil :: SingI i => RecurrentNetwork '[] '[i]

src/Grenade/Recurrent/Core/Runner.hs+14−12

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

66 -- This is a recurrent layer, so we need to do a scan, first input to last, providing

67 -- the recurrent shape output to the next layer.

68 go !xs (layer :~@> n) (g :~@+> nIn)

69− = let ys = scanlFrom layer g xs

69+ = let tys = scanlFrom layer g xs

70+ tapes = fst <$> tys

71+ ys = snd <$> tys

70

72

71− (newFN, ig, grads) = go (snd <$> ys) n nIn

73+ (newFN, ig, grads) = go ys n nIn

72

74

73− backExamples = zip3 (fst <$> reverse ys) (reverse xs) grads

75+ backExamples = zip (reverse tapes) grads

74

76

75 (rg, back) = myscanbackward layer backExamples

77 (rg, back) = myscanbackward layer backExamples

76 -- the new trained layer.

78 -- the new trained layer.

@@ -105,22 +107,22 @@ scanlFrom :: forall x i o. RecurrentLayer x i o

105 => x -- ^ the layer

107 => x -- ^ the layer

106 -> S (RecurrentShape x) -- ^ place to start

108 -> S (RecurrentShape x) -- ^ place to start

107 -> [S i] -- ^ list of inputs to scan through

109 -> [S i] -- ^ list of inputs to scan through

108− -> [(S (RecurrentShape x), S o)] -- ^ list of scan inputs and outputs

110+ -> [(RecTape x i o, S o)] -- ^ list of scan inputs and outputs

109scanlFrom !layer !recShape (x:xs) =

111scanlFrom !layer !recShape (x:xs) =

110− let (lerec, lepush) = runRecurrentForwards layer recShape x

112+ let (tape, lerec, lepush) = runRecurrentForwards layer recShape x

111− in (recShape, lepush) : scanlFrom layer lerec xs

113+ in (tape, lepush) : scanlFrom layer lerec xs

112scanlFrom _ _ [] = []

114scanlFrom _ _ [] = []

113

115

114myscanbackward :: forall x i o. RecurrentLayer x i o

116myscanbackward :: forall x i o. RecurrentLayer x i o

115 => x -- ^ the layer

117 => x -- ^ the layer

116− -> [(S (RecurrentShape x), S i, S o)] -- ^ the list of inputs and output to scan over

118+ -> [(RecTape x i o, S o)] -- ^ the list of inputs and output to scan over

117 -> (S (RecurrentShape x), [(Gradient x, S i)]) -- ^ list of gradients to fold and inputs to backprop

119 -> (S (RecurrentShape x), [(Gradient x, S i)]) -- ^ list of gradients to fold and inputs to backprop

118myscanbackward layer =

120myscanbackward layer =

119 goX 0

121 goX 0

120 where

122 where

121− goX :: S (RecurrentShape x) -> [(S (RecurrentShape x), S i, S o)] -> (S (RecurrentShape x), [(Gradient x, S i)])

123+ goX :: S (RecurrentShape x) -> [(RecTape x i o, S o)] -> (S (RecurrentShape x), [(Gradient x, S i)])

122− goX !lastback ((recShape, lastin, backgrad):xs) =

124+ goX !lastback ((recTape, backgrad):xs) =

123− let (layergrad, recgrad, ingrad) = runRecurrentBackwards layer recShape lastin lastback backgrad

125+ let (layergrad, recgrad, ingrad) = runRecurrentBackwards layer recTape lastback backgrad

124 (pushedback, ll) = goX recgrad xs

126 (pushedback, ll) = goX recgrad xs

125 in (pushedback, (layergrad, ingrad) : ll)

127 in (pushedback, (layergrad, ingrad) : ll)

126 goX !lastback [] = (lastback, [])

128 goX !lastback [] = (lastback, [])

@@ -134,8 +136,8 @@ runRecurrent (layer :~~> n) (() :~~+> nr) !x

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

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

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

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

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

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

137− = let (recin', y) = runRecurrentForwards layer recin x

139+ = let (_, recin', y) = runRecurrentForwards layer recin x

138− (nr', o) = runRecurrent n nr y

140+ (nr', o) = runRecurrent n nr y

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

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

140runRecurrent RNil RINil !x

142runRecurrent RNil RINil !x

141 = (RINil, x)

143 = (RINil, x)

src/Grenade/Recurrent/Layers/BasicRecurrent.hs+4−2

@@ -72,13 +72,15 @@ instance (KnownNat i, KnownNat o, KnownNat (i + o), i <= (i + o), o ~ ((i + o) -

72 type RecurrentShape (BasicRecurrent i o) = 'D1 o

73

74instance (KnownNat i, KnownNat o, KnownNat (i + o), i <= (i + o), o ~ ((i + o) - i)) => RecurrentLayer (BasicRecurrent i o) ('D1 i) ('D1 o) where

75+

76+ type RecTape (BasicRecurrent i o) ('D1 i) ('D1 o) = (S ('D1 o), S ('D1 i))

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

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

76 runRecurrentForwards (BasicRecurrent wB _ wN _) (S1D lastOutput) (S1D thisInput) =

78 runRecurrentForwards (BasicRecurrent wB _ wN _) (S1D lastOutput) (S1D thisInput) =

77 let thisOutput = S1D $ wB + wN #> (thisInput # lastOutput)

79 let thisOutput = S1D $ wB + wN #> (thisInput # lastOutput)

78− in (thisOutput, thisOutput)

80+ in ((S1D lastOutput, S1D thisInput), thisOutput, thisOutput)

79

81

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

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

81− runRecurrentBackwards (BasicRecurrent _ _ wN _) (S1D lastOutput) (S1D thisInput) (S1D dRec) (S1D dEdy) =

83+ runRecurrentBackwards (BasicRecurrent _ _ wN _) (S1D lastOutput, S1D thisInput) (S1D dRec) (S1D dEdy) =

82 let biasGradient = (dRec + dEdy)

84 let biasGradient = (dRec + dEdy)

83 layerGrad = (dRec + dEdy) `outer` (thisInput # lastOutput)

85 layerGrad = (dRec + dEdy) `outer` (thisInput # lastOutput)

84 -- calcluate derivatives for next step

86 -- calcluate derivatives for next step

src/Grenade/Recurrent/Layers/LSTM.hs+4−2

@@ -131,6 +131,8 @@ instance (KnownNat i, KnownNat o) => RecurrentUpdateLayer (LSTM i o) where

131 type RecurrentShape (LSTM i o) = 'D1 o

132

133instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) where

134+

135+ type RecTape (LSTM i o) ('D1 i) ('D1 o) = (S ('D1 o), S ('D1 i))

134 -- Forward propagation for the LSTM layer.

136 -- Forward propagation for the LSTM layer.

135 -- The size of the cell state is also the size of the output.

137 -- The size of the cell state is also the size of the output.

136 runRecurrentForwards (LSTM (LSTMWeights {..}) _) (S1D cell) (S1D input) =

138 runRecurrentForwards (LSTM (LSTMWeights {..}) _) (S1D cell) (S1D input) =

@@ -146,7 +148,7 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w

146 c_t = f_t * cell + i_t * c_x

148 c_t = f_t * cell + i_t * c_x

147 -- Output (it's sometimes recommended to use tanh c_t)

149 -- Output (it's sometimes recommended to use tanh c_t)

148 h_t = o_t * c_t

150 h_t = o_t * c_t

149− in (S1D c_t, S1D h_t)

151+ in ((S1D cell, S1D input), S1D c_t, S1D h_t)

150

152

151 -- Run a backpropogation step for an LSTM layer.

153 -- Run a backpropogation step for an LSTM layer.

152 -- We're doing all the derivatives by hand here, so one should

154 -- We're doing all the derivatives by hand here, so one should

@@ -154,7 +156,7 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w

154 --

156 --

155 -- There's a test version using the AD library without hmatrix in the test

157 -- There's a test version using the AD library without hmatrix in the test

156 -- suite. These should match always.

158 -- suite. These should match always.

157− runRecurrentBackwards (LSTM (LSTMWeights {..}) _) (S1D cell) (S1D input) (S1D cellGrad) (S1D h_t') =

159+ runRecurrentBackwards (LSTM (LSTMWeights {..}) _) (S1D cell, S1D input) (S1D cellGrad) (S1D h_t') =

158 -- We're not keeping the Wengert tape during the forward pass,

160 -- We're not keeping the Wengert tape during the forward pass,

159 -- so we're duplicating some work here.

161 -- so we're duplicating some work here.

160 --

162 --

test/Test/Jack/Hmatrix.hs+12

@@ -1,9 +1,13 @@

1{-# LANGUAGE RankNTypes #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4+{-# LANGUAGE GADTs #-}

4

5

5module Test.Jack.Hmatrix where

6module Test.Jack.Hmatrix where

6

7

8+import Grenade

9+import Data.Singletons

10+

7import Disorder.Jack

11import Disorder.Jack

8

12

9import GHC.TypeLits

13import GHC.TypeLits

@@ -15,3 +19,11 @@ randomVector = (\s -> HStatic.randomVector s HStatic.Uniform * 2 - 1) <$> sizedN

15

19

16uniformSample :: forall m n. (KnownNat m, KnownNat n) => Jack (HStatic.L m n)

20uniformSample :: forall m n. (KnownNat m, KnownNat n) => Jack (HStatic.L m n)

17uniformSample = (\s -> HStatic.uniformSample s (-1) 1 ) <$> sizedNat

21uniformSample = (\s -> HStatic.uniformSample s (-1) 1 ) <$> sizedNat

22+

23+-- | Generate random data of the desired shape

24+genOfShape :: forall x. ( SingI x ) => Jack (S x)

25+genOfShape =

26+ case (sing :: Sing x) of

27+ D1Sing -> S1D <$> randomVector

28+ D2Sing -> S2D <$> uniformSample

29+ D3Sing -> S3D <$> uniformSample

test/Test/Jack/TypeLits.hs+33

@@ -4,11 +4,44 @@

4

5module Test.Jack.TypeLits where

6

7+import Data.Constraint

8+import Data.Singletons

7import Disorder.Jack

9import Disorder.Jack

8

10

11+import Grenade

12+

9import GHC.TypeLits

13import GHC.TypeLits

14+import GHC.TypeLits.Witnesses

10

15

11genNat :: Jack SomeNat

16genNat :: Jack SomeNat

12genNat = do

17genNat = do

13 Just n <- someNatVal <$> choose (1, 10)

18 Just n <- someNatVal <$> choose (1, 10)

14 return n

19 return n

20+

21+genShape :: Jack (SomeSing Shape)

22+genShape

23+ = oneOf [

24+ genD1

25+ , genD2

26+ , genD3

27+ ]

28+ where

29+ genD1 = do

30+ n <- genNat

31+ return $ case n of

32+ SomeNat (_ :: Proxy x) -> SomeSing (sing :: Sing ('D1 x))

33+

34+ genD2 = do

35+ n <- genNat

36+ m <- genNat

37+ return $ case (n, m) of

38+ (SomeNat (_ :: Proxy x), SomeNat (_ :: Proxy y)) -> SomeSing (sing :: Sing ('D2 x y))

39+

40+ genD3 = do

41+ n <- genNat

42+ m <- genNat

43+ o <- genNat

44+ return $ case (n, m, o) of

45+ (SomeNat (px :: Proxy x), SomeNat (_ :: Proxy y), SomeNat (pz :: Proxy z)) ->

46+ case natDict px %* natDict pz of

47+ Dict -> SomeSing (sing :: Sing ('D3 x y z))

test/test.hs+2

@@ -3,6 +3,7 @@ import Disorder.Core.Main

3import qualified Test.Grenade.Layers.Pooling

4import qualified Test.Grenade.Layers.Convolution

5import qualified Test.Grenade.Layers.FullyConnected

6+import qualified Test.Grenade.Layers.Nonlinear

6

7

7import qualified Test.Grenade.Layers.Internal.Convolution

8import qualified Test.Grenade.Layers.Internal.Convolution

8import qualified Test.Grenade.Layers.Internal.Pooling

9import qualified Test.Grenade.Layers.Internal.Pooling

@@ -15,6 +16,7 @@ main =

15 Test.Grenade.Layers.Pooling.tests

16 Test.Grenade.Layers.Pooling.tests

16 , Test.Grenade.Layers.Convolution.tests

17 , Test.Grenade.Layers.Convolution.tests

17 , Test.Grenade.Layers.FullyConnected.tests

18 , Test.Grenade.Layers.FullyConnected.tests

19+ , Test.Grenade.Layers.Nonlinear.tests

18

20

19 , Test.Grenade.Layers.Internal.Convolution.tests

21 , Test.Grenade.Layers.Internal.Convolution.tests

20 , Test.Grenade.Layers.Internal.Pooling.tests

22 , Test.Grenade.Layers.Internal.Pooling.tests