a23103e · grenade · git.iko.soy

bench/bench-lstm.hs+9−10

compare with master

unifiedsplit

@@ -22,8 +22,8 @@ main = do

22 let upIn512 :: H.R 262144 = H.randomVector 1 H.Uniform * 2 - 1

23

24 defaultMain [

25− bgroup "lstm" [ bench "forwards-60" $ nf (nfT2 . uncurry (testRun60 layer60)) (rec60, input40)

25+ bgroup "lstm" [ bench "forwards-60" $ nf (nfT3 . uncurry (testRun60 layer60)) (rec60, input40)

26− , bench "forwards-512" $ nf (nfT2 . uncurry (testRun512 layer512)) (rec512, input40)

26+ , bench "forwards-512" $ nf (nfT3 . uncurry (testRun512 layer512)) (rec512, input40)

27 , bench "backwards-60" $ nf (nfT3 . uncurry4 (testRun60' layer60)) (rec60, input40, rec60, rec60)

28 , bench "backwards-512" $ nf (nfT3 . uncurry4 (testRun512' layer512)) (rec512, input40, rec512, rec512)

29 ]

@@ -36,17 +36,17 @@ main = do

36 ]

37 ]

38

39−testRun60 :: LSTM 40 60 -> S ('D1 60) -> S ('D1 40) -> (S ('D1 60), S ('D1 60))

39+testRun60 :: LSTM 40 60 -> S ('D1 60) -> S ('D1 40) -> ((S ('D1 60), S ('D1 40)), S ('D1 60), S ('D1 60))

40testRun60 = runRecurrentForwards

41

42testRun60' :: LSTM 40 60 -> S ('D1 60) -> S ('D1 40) -> S ('D1 60) -> S ('D1 60) -> (Gradient (LSTM 40 60), S ('D1 60), S ('D1 40))

43−testRun60' = runRecurrentBackwards

43+testRun60' = curry . runRecurrentBackwards

44

45−testRun512 :: LSTM 40 512 -> S ('D1 512) -> S ('D1 40) -> (S ('D1 512), S ('D1 512))

45+testRun512 :: LSTM 40 512 -> S ('D1 512) -> S ('D1 40) -> ((S ('D1 512), S ('D1 40)), S ('D1 512), S ('D1 512))

46testRun512 = runRecurrentForwards

47

48testRun512' :: LSTM 40 512 -> S ('D1 512) -> S ('D1 40) -> S ('D1 512) -> S ('D1 512) -> (Gradient (LSTM 40 512), S ('D1 512), S ('D1 40))

49−testRun512' = runRecurrentBackwards

49+testRun512' = curry . runRecurrentBackwards

50

51uncurry4 :: (t -> t1 -> t2 -> t3 -> t4) -> (t, t1, t2, t3) -> t4

52uncurry4 f (a,b,c,d) = f a b c d

@@ -61,12 +61,11 @@ nfT3 :: (a, b, c) -> (b, c)

61nfT3 (!_, !b, !c) = (b, c)

62

63

64−type F = FeedForward

65type R = Recurrent

64type R = Recurrent

66−type RecNet = RecurrentNetwork '[ R (LSTM 40 512), R (LSTM 512 40), F (FullyConnected 40 40), F Logit]

65+type RecNet = RecurrentNetwork '[ R (LSTM 40 512), R (LSTM 512 40) ]

67− '[ 'D1 40, 'D1 512, 'D1 40, 'D1 40, 'D1 40 ]

66+ '[ 'D1 40, 'D1 512, 'D1 40 ]

68

67

69−type RecInput = RecurrentInputs '[ R (LSTM 40 512), R (LSTM 512 40), F (FullyConnected 40 40), F Logit]

68+type RecInput = RecurrentInputs '[ R (LSTM 40 512), R (LSTM 512 40) ]

70

69

71lp :: LearningParameters

70lp :: LearningParameters

72lp = LearningParameters 0.1 0 0

71lp = LearningParameters 0.1 0 0

grenade.cabal+3−2

@@ -43,6 +43,9 @@ library

43

44 exposed-modules:

45 Grenade

46+ Grenade.Core

47+ Grenade.Core.Layer

48+ Grenade.Core.LearningParameters

46 Grenade.Core.Network

49 Grenade.Core.Network

47 Grenade.Core.Runner

50 Grenade.Core.Runner

48 Grenade.Core.Shape

51 Grenade.Core.Shape

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

51 Grenade.Layers.Dropout

54 Grenade.Layers.Dropout

52 Grenade.Layers.FullyConnected

55 Grenade.Layers.FullyConnected

53 Grenade.Layers.Flatten

56 Grenade.Layers.Flatten

54− Grenade.Layers.Fuse

55 Grenade.Layers.Logit

57 Grenade.Layers.Logit

56 Grenade.Layers.Relu

58 Grenade.Layers.Relu

57 Grenade.Layers.Elu

59 Grenade.Layers.Elu

@@ -70,7 +72,6 @@ library

70

72

71 Grenade.Recurrent.Layers.BasicRecurrent

73 Grenade.Recurrent.Layers.BasicRecurrent

72 Grenade.Recurrent.Layers.LSTM

74 Grenade.Recurrent.Layers.LSTM

73− Grenade.Recurrent.Layers.Trivial

74

75

75 Grenade.Utils.OneHot

76 Grenade.Utils.OneHot

76

77

main/mnist.hs+8−2

@@ -33,8 +33,14 @@ 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 MNISTa = 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 ]

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 ]

38+

39+type MNISTb = Network '[ Convolution 1 10 7 7 1 1, Pooling 2 2 2 2, Elu, Convolution 10 16 4 4 1 1, Pooling 2 2 2 2, Elu, FlattenLayer ]

40+ '[ 'D2 28 28, 'D3 22 22 10, 'D3 11 11 10, 'D3 11 11 10, 'D3 8 8 16, 'D3 4 4 16, 'D3 4 4 16, 'D1 256 ]

41+

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]

42+type MNIST = Network '[ (MNISTa, MNISTb), 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]

43+ '[ 'D2 28 28, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10 ]

38

44

39randomMnist :: MonadRandom m => m MNIST

45randomMnist :: MonadRandom m => m MNIST

40randomMnist = randomNetwork

46randomMnist = randomNetwork

src/Grenade.hs+2−1

@@ -2,6 +2,8 @@ module Grenade (

2 module X

3 ) where

4

5+import Grenade.Core.LearningParameters as X

6+import Grenade.Core.Layer as X

5import Grenade.Core.Network as X

7import Grenade.Core.Network as X

6import Grenade.Core.Runner as X

8import Grenade.Core.Runner as X

7import Grenade.Core.Shape as X

9import Grenade.Core.Shape as X

@@ -10,7 +12,6 @@ import Grenade.Layers.Dropout as X

10import Grenade.Layers.Pad as X

12import Grenade.Layers.Pad as X

11import Grenade.Layers.Pooling as X

13import Grenade.Layers.Pooling as X

12import Grenade.Layers.Flatten as X

14import Grenade.Layers.Flatten as X

13−import Grenade.Layers.Fuse as X

14import Grenade.Layers.FullyConnected as X

15import Grenade.Layers.FullyConnected as X

15import Grenade.Layers.Logit as X

16import Grenade.Layers.Logit as X

16import Grenade.Layers.Convolution as X

17import Grenade.Layers.Convolution as X

src/Grenade/Core.hsnew file+8

@@ -0,0 +1,8 @@

1+module Grenade.Core (

2+ module X

3+ ) where

4+

5+import Grenade.Core.Layer as X

6+import Grenade.Core.LearningParameters as X

7+import Grenade.Core.Shape as X

8+import Grenade.Core.Network as X

src/Grenade/Core/Layer.hsnew file+82

@@ -0,0 +1,82 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE GADTs #-}

3+{-# LANGUAGE TypeOperators #-}

4+{-# LANGUAGE TypeFamilies #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

6+{-# LANGUAGE FlexibleContexts #-}

7+{-# LANGUAGE RankNTypes #-}

8+{-# LANGUAGE FlexibleInstances #-}

9+{-|

10+Module : Grenade.Core.Network

11+Description : Core definition a simple neural etwork

12+Copyright : (c) Huw Campbell, 2016-2017

13+License : BSD2

14+Stability : experimental

15+-}

16+module Grenade.Core.Layer (

17+ Layer (..)

18+ , UpdateLayer (..)

19+ ) where

20+

21+import Control.Monad.Random (MonadRandom)

22+

23+import Data.List ( foldl' )

24+import Data.Singletons

25+

26+import Grenade.Core.Shape

27+import Grenade.Core.LearningParameters

28+

29+-- | Class for updating a layer. All layers implement this, and it is

30+-- shape independent.

31+class UpdateLayer x where

32+ {-# MINIMAL runUpdate, createRandom #-}

33+ -- | The type for the gradient for this layer.

34+ -- Unit if there isn't a gradient to pass back.

35+ type Gradient x :: *

36+ -- | Update a layer with its gradient and learning parameters

37+ runUpdate :: LearningParameters -> x -> Gradient x -> x

38+

39+ -- | Create a random layer, many layers will use pure

40+ createRandom :: MonadRandom m => m x

41+

42+ -- | Update a layer with many Gradients

43+ runUpdates :: LearningParameters -> x -> [Gradient x] -> x

44+ runUpdates rate = foldl' (runUpdate rate)

45+

46+-- | 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.

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

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

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

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

52+ type Tape x i o :: *

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

54+ -- layer, and give the output from this layer.

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

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

57+ -- layer gave from the input and the back propagated derivatives from

58+ -- the layer above.

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

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

61+

62+

63+-- | Run two layers in parallel, combining their outputs.

64+-- This just kind of "smooshes" the weights together.

65+instance (UpdateLayer x, UpdateLayer y) => UpdateLayer (x, y) where

66+ type Gradient (x, y) = (Gradient x, Gradient y)

67+ runUpdate lr (x, y) (x', y') = (runUpdate lr x x', runUpdate lr y y')

68+ createRandom = (,) <$> createRandom <*> createRandom

69+

70+-- | Combine the outputs and the inputs, summing the output shape

71+instance (SingI i, SingI o, Layer x i o, Layer y i o) => Layer (x, y) i o where

72+ type Tape (x, y) i o = (Tape x i o, Tape y i o)

73+

74+ runForwards (x, y) input =

75+ let (xT, xOut) = runForwards x input

76+ (yT, yOut) = runForwards y input

77+ in ((xT, yT), xOut + yOut)

78+

79+ runBackwards (x, y) (xTape, yTape) o =

80+ let (x', xB) = runBackwards x xTape o

81+ (y', yB) = runBackwards y yTape o

82+ in ((x', y'), xB + yB)

src/Grenade/Core/LearningParameters.hsnew file+10

@@ -0,0 +1,10 @@

1+module Grenade.Core.LearningParameters (

2+ LearningParameters (..)

3+ ) where

4+

5+-- | Learning parameters for stochastic gradient descent.

6+data LearningParameters = LearningParameters {

7+ learningRate :: Double

8+ , learningMomentum :: Double

9+ , learningRegulariser :: Double

10+ } deriving (Eq, Show)

src/Grenade/Core/Network.hs+60−48

@@ -1,5 +1,7 @@

1{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE GADTs #-}

3{-# LANGUAGE GADTs #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

3{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeOperators #-}

4{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeFamilies #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

@@ -17,63 +19,24 @@ Neural network we support.

17

19

18-}

20-}

19module Grenade.Core.Network (

21module Grenade.Core.Network (

20− Layer (..)

21− , Network (..)

22+ Network (..)

22− , UpdateLayer (..)

23− , LearningParameters (..)

24 , Gradients (..)

23 , Gradients (..)

25 , Tapes (..)

24 , Tapes (..)

26 , CreatableNetwork (..)

25 , CreatableNetwork (..)

26+

27+ , applyUpdate

27 ) where

28 ) where

28

29

29−import Control.Monad.Random (MonadRandom)

30+import Control.Monad.Random ( MonadRandom )

30−import Data.List ( foldl' )

31−import Data.Singletons

32

31

32+import Data.Singletons

33+import Data.Singletons.Prelude

33import Data.Serialize

34import Data.Serialize

34

35

36+import Grenade.Core.Layer

37+import Grenade.Core.LearningParameters

35import Grenade.Core.Shape

38import Grenade.Core.Shape

36

39

37−-- | Learning parameters for stochastic gradient descent.

38−data LearningParameters = LearningParameters {

39− learningRate :: Double

40− , learningMomentum :: Double

41− , learningRegulariser :: Double

42− } deriving (Eq, Show)

43−

44−-- | Class for updating a layer. All layers implement this, and it is

45−-- shape independent.

46−class UpdateLayer x where

47− {-# MINIMAL runUpdate, createRandom #-}

48− -- | The type for the gradient for this layer.

49− -- Unit if there isn't a gradient to pass back.

50− type Gradient x :: *

51− -- | Update a layer with its gradient and learning parameters

52− runUpdate :: LearningParameters -> x -> Gradient x -> x

53−

54− -- | Create a random layer, many layers will use pure

55− createRandom :: MonadRandom m => m x

56−

57− -- | Update a layer with many Gradients

58− runUpdates :: LearningParameters -> x -> [Gradient x] -> x

59− runUpdates rate = foldl' (runUpdate rate)

60−

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

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

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

64− -- | The Wengert tape for this layer. Includes all that is required

65− -- to generate the back propagated gradients efficiently. As a

66− -- default, `S i` is fine.

67− type Tape x i o :: *

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

69− -- layer, and give the output from this layer.

70− runForwards :: x -> S i -> (Tape x i o, S o)

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

72− -- layer gave from the input and the back propagated derivatives from

73− -- the layer above.

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

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

76−

77-- | Type of a network.

40-- | Type of a network.

78--

41--

79-- The [*] type specifies the types of the layers.

42-- The [*] type specifies the types of the layers.

@@ -92,6 +55,16 @@ instance Show (Network '[] '[i]) where

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

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

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

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

94

57

58+

59+-- | Apply one step of stochastic gradient decent across the network.

60+applyUpdate :: LearningParameters -> Network ls ss -> Gradients ls -> Network ls ss

61+applyUpdate _ NNil GNil

62+ = NNil

63+applyUpdate rate (layer :~> rest) (gradient :/> grest)

64+ = runUpdate rate layer gradient :~> applyUpdate rate rest grest

65+

66+

67+

95-- | Gradients of a network.

68-- | Gradients of a network.

96-- Parameterised on the layers of a Network.

69-- Parameterised on the layers of a Network.

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

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

@@ -116,7 +89,6 @@ instance SingI i => CreatableNetwork '[] '[i] where

116instance (SingI i, SingI o, Layer x i o, CreatableNetwork xs (o ': rs)) => CreatableNetwork (x ': xs) (i ': o ': rs) where

89instance (SingI i, SingI o, Layer x i o, CreatableNetwork xs (o ': rs)) => CreatableNetwork (x ': xs) (i ': o ': rs) where

117 randomNetwork = (:~>) <$> createRandom <*> randomNetwork

90 randomNetwork = (:~>) <$> createRandom <*> randomNetwork

118

91

119−

120-- | Add very simple serialisation to the network

92-- | Add very simple serialisation to the network

121instance SingI i => Serialize (Network '[] '[i]) where

93instance SingI i => Serialize (Network '[] '[i]) where

122 put NNil = pure ()

94 put NNil = pure ()

@@ -125,3 +97,43 @@ instance SingI i => Serialize (Network '[] '[i]) where

125instance (SingI i, SingI o, Layer x i o, Serialize x, Serialize (Network xs (o ': rs))) => Serialize (Network (x ': xs) (i ': o ': rs)) where

97instance (SingI i, SingI o, Layer x i o, Serialize x, Serialize (Network xs (o ': rs))) => Serialize (Network (x ': xs) (i ': o ': rs)) where

126 put (x :~> r) = put x >> put r

98 put (x :~> r) = put x >> put r

127 get = (:~>) <$> get <*> get

99 get = (:~>) <$> get <*> get

100+

101+

102+-- | Ultimate composition.

103+--

104+-- This allows a complete network to be treated as a layer in a bigger network.

105+instance CreatableNetwork sublayers subshapes => UpdateLayer (Network sublayers subshapes) where

106+ type Gradient (Network sublayers subshapes) = Gradients sublayers

107+ runUpdate = applyUpdate

108+ createRandom = randomNetwork

109+

110+instance (CreatableNetwork sublayers subshapes, i ~ (Head subshapes), o ~ (Last subshapes)) => Layer (Network sublayers subshapes) i o where

111+ type Tape (Network sublayers subshapes) i o = Tapes sublayers subshapes

112+

113+ runForwards net i =

114+ go i net

115+ where

116+ go :: forall js ss. (Last js ~ Last subshapes)

117+ => S (Head js) -- ^ input vector

118+ -> Network ss js -- ^ network to train

119+ -> (Tapes ss js, S (Last js))

120+ go !x (layer :~> n) =

121+ let (tape, forward) = runForwards layer x

122+ (tapes, answer) = go forward n

123+ in (tape :\> tapes, answer)

124+ go !x NNil

125+ = (TNil, x)

126+

127+ runBackwards net tapes o =

128+ go net tapes

129+ where

130+ go :: forall js ss. (Last js ~ Last subshapes)

131+ => Network ss js -- ^ network to train

132+ -> Tapes ss js -- ^ network to train

133+ -> (Gradients ss, S (Head js))

134+ go (layer :~> n) (tape :\> nt) =

135+ let (gradients, feed) = go n nt

136+ (layer', backGrad) = runBackwards layer tape feed

137+ in (layer' :/> gradients, backGrad)

138+ go NNil TNil

139+ = (GNil, o)

src/Grenade/Core/Runner.hs+3−7

@@ -25,6 +25,9 @@ module Grenade.Core.Runner (

25 ) where

26

27import Data.Singletons.Prelude

28+

29+import Grenade.Core.Layer

30+import Grenade.Core.LearningParameters

28import Grenade.Core.Network

31import Grenade.Core.Network

29import Grenade.Core.Shape

32import Grenade.Core.Shape

30

33

@@ -57,13 +60,6 @@ backPropagate network input target =

57 go !x NNil

60 go !x NNil

58 = (GNil, x - target)

61 = (GNil, x - target)

59

62

60−-- | Apply one step of stochastic gradient decent across the network.

61−applyUpdate :: LearningParameters -> Network ls ss -> Gradients ls -> Network ls ss

62−applyUpdate _ NNil GNil

63− = NNil

64−applyUpdate rate (layer :~> rest) (gradient :/> grest)

65− = runUpdate rate layer gradient :~> applyUpdate rate rest grest

66−

67-- | Update a network with new weights after training with an instance.

63-- | Update a network with new weights after training with an instance.

68train :: LearningParameters -> Network layers shapes -> S (Head shapes) -> S (Last shapes) -> Network layers shapes

64train :: LearningParameters -> Network layers shapes -> S (Head shapes) -> S (Last shapes) -> Network layers shapes

69train rate network input output =

65train rate network input output =

src/Grenade/Graph/Core/Network.hsnew file+39

@@ -0,0 +1,39 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE GADTs #-}

3+{-# LANGUAGE TypeFamilies #-}

4+{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE ScopedTypeVariables #-}

7+{-# LANGUAGE RankNTypes #-}

8+

9+{-|

10+Module : Grenade.Graph.Core.Network

11+Description : Core definition of the Shapes of data we understand

12+Copyright : (c) Huw Campbell, 2016-2017

13+License : BSD2

14+Stability : experimental

15+

16+This module defines the core data types for the shapes of data that

17+are understood by Grenade.

18+-}

19+module Grenade.Graph.Core.Network (

20+ Fin (..)

21+ ) where

22+

23+import Data.Constraint

24+import Data.Singletons

25+import Data.Proxy

26+

27+import Grenade

28+

29+import GHC.TypeLits

30+

31+data Edge :: * where

32+ E :: Fin n -> Shape -> Edge

33+

34+data Fin n where

35+ Fin0 :: Fin (n + 1)

36+ FinS :: Fin n -> Fin (n + 1)

37+

38+data Network :: [*] -> [Edge] -> * where { }

39+

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

@@ -25,8 +25,7 @@ import Numeric.LinearAlgebra hiding ( uniformSample, konst )

25import qualified Numeric.LinearAlgebra as LA

26import Numeric.LinearAlgebra.Static hiding ((|||), build, toRows)

27

28−import Grenade.Core.Network

28+import Grenade.Core

29−import Grenade.Core.Shape

30import Grenade.Layers.Internal.Convolution

29import Grenade.Layers.Internal.Convolution

31import Grenade.Layers.Internal.Update

30import Grenade.Layers.Internal.Update

32

31

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

@@ -13,8 +13,7 @@ import Data.Proxy

13import Data.Singletons.TypeLits

14import GHC.TypeLits

15

16−import Grenade.Core.Network

16+import Grenade.Core

17−import Grenade.Core.Shape

18

17

19import Numeric.LinearAlgebra (konst, subMatrix, diagBlock)

18import Numeric.LinearAlgebra (konst, subMatrix, diagBlock)

20import Numeric.LinearAlgebra.Static (extract, create)

19import Numeric.LinearAlgebra.Static (extract, create)

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

@@ -10,8 +10,7 @@ module Grenade.Layers.Dropout (

10import Control.Monad.Random hiding (fromList)

11

12import GHC.TypeLits

13−import Grenade.Core.Shape

13+import Grenade.Core

14−import Grenade.Core.Network

15

14

16-- Dropout layer help to reduce overfitting.

15-- Dropout layer help to reduce overfitting.

17-- Idea here is that the vector is a shape of 1s and 0s, which we multiply the input by.

16-- Idea here is that the vector is a shape of 1s and 0s, which we multiply the input by.

src/Grenade/Layers/Elu.hsnew file+60

@@ -0,0 +1,60 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE TypeOperators #-}

3+{-# LANGUAGE TypeFamilies #-}

4+{-# LANGUAGE MultiParamTypeClasses #-}

5+module Grenade.Layers.Elu (

6+ Elu (..)

7+ ) where

8+

9+import Data.Serialize

10+

11+import GHC.TypeLits

12+import Grenade.Core

13+

14+import qualified Numeric.LinearAlgebra.Static as LAS

15+

16+-- | An exponential linear unit.

17+-- A layer which can act between any shape of the same dimension, acting as a

18+-- diode on every neuron individually.

19+data Elu = Elu

20+ deriving Show

21+

22+instance UpdateLayer Elu where

23+ type Gradient Elu = ()

24+ runUpdate _ _ _ = Elu

25+ createRandom = return Elu

26+

27+instance Serialize Elu where

28+ put _ = return ()

29+ get = return Elu

30+

31+instance ( KnownNat i) => Layer Elu ('D1 i) ('D1 i) where

32+ type Tape Elu ('D1 i) ('D1 i) = S ('D1 i)

33+

34+ runForwards _ (S1D y) = (S1D y, S1D (elu y))

35+ where

36+ elu = LAS.dvmap (\a -> if a <= 0 then exp a - 1 else a)

37+ runBackwards _ (S1D y) (S1D dEdy) = ((), S1D (elu' y * dEdy))

38+ where

39+ elu' = LAS.dvmap (\a -> if a <= 0 then exp a else 1)

40+

41+instance (KnownNat i, KnownNat j) => Layer Elu ('D2 i j) ('D2 i j) where

42+ type Tape Elu ('D2 i j) ('D2 i j) = S ('D2 i j)

43+

44+ runForwards _ (S2D y) = (S2D y, S2D (elu y))

45+ where

46+ elu = LAS.dmmap (\a -> if a <= 0 then exp a - 1 else a)

47+ runBackwards _ (S2D y) (S2D dEdy) = ((), S2D (elu' y * dEdy))

48+ where

49+ elu' = LAS.dmmap (\a -> if a <= 0 then exp a else 1)

50+

51+instance (KnownNat i, KnownNat j, KnownNat k) => Layer Elu ('D3 i j k) ('D3 i j k) where

52+

53+ type Tape Elu ('D3 i j k) ('D3 i j k) = S ('D3 i j k)

54+

55+ runForwards _ (S3D y) = (S3D y, S3D (elu y))

56+ where

57+ elu = LAS.dmmap (\a -> if a <= 0 then exp a - 1 else a)

58+ runBackwards _ (S3D y) (S3D dEdy) = ((), S3D (elu' y * dEdy))

59+ where

60+ elu' = LAS.dmmap (\a -> if a <= 0 then exp a else 1)

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

@@ -15,8 +15,7 @@ import GHC.TypeLits

15import Numeric.LinearAlgebra.Static

16import Numeric.LinearAlgebra.Data as LA ( flatten )

17

18−import Grenade.Core.Shape

18+import Grenade.Core

19−import Grenade.Core.Network

20

19

21-- | Flatten Layer

20-- | Flatten Layer

22--

21--

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

@@ -19,8 +19,7 @@ import Data.Singletons.TypeLits

19import qualified Numeric.LinearAlgebra as LA

20import Numeric.LinearAlgebra.Static

21

22−import Grenade.Core.Network

22+import Grenade.Core

23−import Grenade.Core.Shape

24

23

25import Grenade.Layers.Internal.Update

24import Grenade.Layers.Internal.Update

26

25

src/Grenade/Layers/Fuse.hsdeleted−83

@@ -1,83 +0,0 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE GADTs #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5−{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE TypeFamilies #-}

7−{-# LANGUAGE MultiParamTypeClasses #-}

8−{-# LANGUAGE FlexibleContexts #-}

9−{-# LANGUAGE FlexibleInstances #-}

10−module Grenade.Layers.Fuse (

11− SubNetwork (..)

12− , BranchNetwork (..)

13− ) where

14−

15−import Data.Singletons.Prelude

16−

17−import Grenade.Core.Network

18−import Grenade.Core.Shape

19−import Grenade.Core.Runner

20−

21−-- | Fuse two layers into one layer.

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

23−data SubNetwork :: [*] -> [Shape] -> * where

24− SubNetwork :: Network sublayers subshapes -> SubNetwork sublayers subshapes

25−

26−instance CreatableNetwork sublayers subshapes => UpdateLayer (SubNetwork sublayers subshapes) where

27− type Gradient (SubNetwork sublayers subshapes) = Gradients sublayers

28− runUpdate lr (SubNetwork net) = SubNetwork . applyUpdate lr net

29− createRandom = SubNetwork <$> randomNetwork

30−

31−instance (CreatableNetwork sublayers subshapes, i ~ (Head subshapes), o ~ (Last subshapes)) => Layer (SubNetwork sublayers subshapes) i o where

32− type Tape (SubNetwork sublayers subshapes) i o = Tapes sublayers subshapes

33−

34− runForwards (SubNetwork net) i =

35− go i net

36− where

37− go :: forall js ss. (Last js ~ Last subshapes)

38− => S (Head js) -- ^ input vector

39− -> Network ss js -- ^ network to train

40− -> (Tapes ss js, S (Last js))

41− go !x (layer :~> n) =

42− let (tape, forward) = runForwards layer x

43− (tapes, answer) = go forward n

44− in (tape :\> tapes, answer)

45− go !x NNil

46− = (TNil, x)

47−

48− runBackwards (SubNetwork net) tapes o =

49− go net tapes

50− where

51− go :: forall js ss. (Last js ~ Last subshapes)

52− => Network ss js -- ^ network to train

53− -> Tapes ss js -- ^ network to train

54− -> (Gradients ss, S (Head js))

55− go (layer :~> n) (tape :\> nt) =

56− let (gradients, feed) = go n nt

57− (layer', backGrad) = runBackwards layer tape feed

58− in (layer' :/> gradients, backGrad)

59− go NNil TNil

60− = (GNil, o)

61−

62−

63−-- | Run two layers in parallel, combining their outputs. The way in which the output is combined is dependent

64−-- on the inut

65−data BranchNetwork :: * -> * -> * where

66− BranchNetwork :: x -> y -> BranchNetwork x y

67−

68−instance (UpdateLayer x, UpdateLayer y) => UpdateLayer (BranchNetwork x y) where

69− type Gradient (BranchNetwork x y) = (Gradient x, Gradient y)

70− runUpdate lr (BranchNetwork x y) (x', y') = BranchNetwork (runUpdate lr x x') (runUpdate lr y y')

71− createRandom = BranchNetwork <$> createRandom <*> createRandom

72−

73−instance (SingI i, SingI o, Layer x i o, Layer y i o) => Layer (BranchNetwork x y) i o where

74− type Tape (BranchNetwork x y) i o = (Tape x i o, Tape y i o)

75− runForwards (BranchNetwork x y) input =

76− let (xT, xOut) = runForwards x input

77− (yT, yOut) = runForwards y input

78− in ((xT, yT), xOut + yOut)

79−

80− runBackwards (BranchNetwork x y) (xTape, yTape) o =

81− let (x', xB) = runBackwards x xTape o

82− (y', yB) = runBackwards y yTape o

83− in ((x', y'), xB + yB)

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

@@ -11,8 +11,7 @@ module Grenade.Layers.Logit (

11import Data.Serialize

12import Data.Singletons

13

14−import Grenade.Core.Network

14+import Grenade.Core

15−import Grenade.Core.Shape

16

15

17-- | A Logit layer.

16-- | A Logit layer.

18-- A layer which can act between any shape of the same dimension, perfoming an sigmoid function.

17-- A layer which can act between any shape of the same dimension, perfoming an sigmoid function.

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

@@ -14,8 +14,7 @@ import Data.Serialize

14import Data.Singletons.TypeLits

15import GHC.TypeLits

16

17−import Grenade.Core.Network

17+import Grenade.Core

18−import Grenade.Core.Shape

19

18

20import Numeric.LinearAlgebra (konst, subMatrix, diagBlock)

19import Numeric.LinearAlgebra (konst, subMatrix, diagBlock)

21import Numeric.LinearAlgebra.Static (extract, create)

20import Numeric.LinearAlgebra.Static (extract, create)

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

@@ -16,8 +16,7 @@ import Data.Serialize

16import Data.Singletons.TypeLits

17import GHC.TypeLits

18

19−import Grenade.Core.Network

19+import Grenade.Core

20−import Grenade.Core.Shape

21import Grenade.Layers.Internal.Pooling

20import Grenade.Layers.Internal.Pooling

22

21

23import Numeric.LinearAlgebra.Static as LAS hiding ((|||), build, toRows)

22import Numeric.LinearAlgebra.Static as LAS hiding ((|||), build, toRows)

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

@@ -9,8 +9,7 @@ module Grenade.Layers.Relu (

9import Data.Serialize

10

11import GHC.TypeLits

12−import Grenade.Core.Network

12+import Grenade.Core

13−import Grenade.Core.Shape

14

13

15import qualified Numeric.LinearAlgebra.Static as LAS

14import qualified Numeric.LinearAlgebra.Static as LAS

16

15

src/Grenade/Layers/Softmax.hsnew file+53

@@ -0,0 +1,53 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE TypeOperators #-}

3+{-# LANGUAGE TypeFamilies #-}

4+{-# LANGUAGE FlexibleInstances #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

6+module Grenade.Layers.Softmax (

7+ Softmax (..)

8+ , softmax

9+ , softmax'

10+ ) where

11+

12+import Data.Serialize

13+

14+import GHC.TypeLits

15+import Grenade.Core

16+

17+import Numeric.LinearAlgebra.Static as LAS

18+

19+-- | A Softmax layer

20+-- This layer is like a logit layer, but normalises

21+-- a set of matricies to be probabilities.

22+data Softmax = Softmax

23+ deriving Show

24+

25+instance UpdateLayer Softmax where

26+ type Gradient Softmax = ()

27+ runUpdate _ _ _ = Softmax

28+ createRandom = return Softmax

29+

30+instance ( KnownNat i ) => Layer Softmax ('D1 i) ('D1 i) where

31+ type Tape Softmax ('D1 i) ('D1 i) = S ('D1 i)

32+

33+ runForwards _ (S1D y) = (S1D y, S1D (softmax y))

34+ runBackwards _ (S1D y) (S1D dEdy) = ((), S1D (softmax' y dEdy))

35+

36+instance Serialize Softmax where

37+ put _ = return ()

38+ get = return Softmax

39+

40+softmax :: KnownNat i => LAS.R i -> LAS.R i

41+softmax xs =

42+ let xs' = LAS.dvmap exp xs

43+ s = LAS.dot xs' 1

44+ in LAS.dvmap (/ s) xs'

45+

46+softmax' :: KnownNat i => LAS.R i -> LAS.R i -> LAS.R i

47+softmax' x grad =

48+ let yTy = outer sm sm

49+ d = diag sm

50+ g = d - yTy

51+ in g #> grad

52+ where

53+ sm = softmax x

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

@@ -10,8 +10,7 @@ module Grenade.Layers.Tanh (

10import Data.Serialize

11import Data.Singletons

12

13−import Grenade.Core.Network

13+import Grenade.Core

14−import Grenade.Core.Shape

15

14

16-- | A Tanh layer.

15-- | A Tanh layer.

17-- A layer which can act between any shape of the same dimension, perfoming a tanh function.

16-- A layer which can act between any shape of the same dimension, perfoming a tanh function.

src/Grenade/Recurrent.hs−1

@@ -6,4 +6,3 @@ import Grenade.Recurrent.Core.Network as X

6import Grenade.Recurrent.Core.Runner as X

7import Grenade.Recurrent.Layers.BasicRecurrent as X

8import Grenade.Recurrent.Layers.LSTM as X

9−import Grenade.Recurrent.Layers.Trivial as X

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

@@ -22,8 +22,7 @@ import Data.Singletons ( SingI )

22import Data.Serialize

23import qualified Data.Vector.Storable as V

24

25−import Grenade.Core.Shape

25+import Grenade.Core

26−import Grenade.Core.Network

27

26

28import qualified Numeric.LinearAlgebra as LA

27import qualified Numeric.LinearAlgebra as LA

29import qualified Numeric.LinearAlgebra.Static as LAS

28import qualified Numeric.LinearAlgebra.Static as LAS

src/Grenade/Recurrent/Core/Runner.hs+1−2

@@ -16,8 +16,7 @@ module Grenade.Recurrent.Core.Runner (

16 ) where

17

18import Data.Singletons.Prelude

19−import Grenade.Core.Network

19+import Grenade.Core

20−import Grenade.Core.Shape

21

20

22import Grenade.Recurrent.Core.Network

21import Grenade.Recurrent.Core.Network

23

22

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

@@ -24,8 +24,7 @@ import Numeric.LinearAlgebra.Static

24

25import GHC.TypeLits

26

27−import Grenade.Core.Network

27+import Grenade.Core

28−import Grenade.Core.Shape

29import Grenade.Recurrent.Core.Network

28import Grenade.Recurrent.Core.Network

30

29

31data BasicRecurrent :: Nat -- Input layer size

30data BasicRecurrent :: Nat -- Input layer size

src/Grenade/Recurrent/Layers/LSTM.hs+1−3

@@ -20,7 +20,6 @@ module Grenade.Recurrent.Layers.LSTM (

20

21import Control.Monad.Random ( MonadRandom, getRandom )

22

23−

24-- import Data.List ( foldl1' )

23-- import Data.List ( foldl1' )

25import Data.Proxy

24import Data.Proxy

26import Data.Serialize

25import Data.Serialize

@@ -29,8 +28,7 @@ import Data.Singletons.TypeLits

29import qualified Numeric.LinearAlgebra as LA

28import qualified Numeric.LinearAlgebra as LA

30import Numeric.LinearAlgebra.Static

29import Numeric.LinearAlgebra.Static

31

30

32−import Grenade.Core.Network

31+import Grenade.Core

33−import Grenade.Core.Shape

34

32

35import Grenade.Layers.Internal.Update

33import Grenade.Layers.Internal.Update

36

34

src/Grenade/Recurrent/Layers/Trivial.hsdeleted−30

@@ -1,30 +0,0 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE TypeOperators #-}

3−{-# LANGUAGE TypeFamilies #-}

4−{-# LANGUAGE MultiParamTypeClasses #-}

5−{-# LANGUAGE FlexibleInstances #-}

6−module Grenade.Recurrent.Layers.Trivial (

7− Trivial (..)

8− ) where

9−

10−import Data.Serialize

11−

12−import Grenade.Core.Network

13−

14−-- | A trivial layer.

15−data Trivial = Trivial

16− deriving Show

17−

18−instance Serialize Trivial where

19− put _ = return ()

20− get = return Trivial

21−

22−instance UpdateLayer Trivial where

23− type Gradient Trivial = ()

24− runUpdate _ _ _ = Trivial

25− createRandom = return Trivial

26−

27−instance (a ~ b) => Layer Trivial a b where

28− type Tape Trivial a b = ()

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

30− runBackwards _ _ y = ((), y)

test/Test/Grenade/Layers/Convolution.hs+1−2

@@ -15,8 +15,7 @@ import Data.Singletons ()

15import GHC.TypeLits

16import GHC.TypeLits.Witnesses

17

18−import Grenade.Core.Shape

18+import Grenade.Core

19−import Grenade.Core.Network

20import Grenade.Layers.Convolution

19import Grenade.Layers.Convolution

21

20

22import Disorder.Jack

21import Disorder.Jack

test/Test/Grenade/Layers/FullyConnected.hs+1−2

@@ -12,8 +12,7 @@ import Data.Singletons ()

12

13import GHC.TypeLits

14

15−import Grenade.Core.Shape

15+import Grenade.Core

16−import Grenade.Core.Network

17import Grenade.Layers.FullyConnected

16import Grenade.Layers.FullyConnected

18

17

19import Disorder.Jack

18import Disorder.Jack

test/Test/Grenade/Layers/Nonlinear.hsnew file+72

@@ -0,0 +1,72 @@

1+{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE TemplateHaskell #-}

3+{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE KindSignatures #-}

5+{-# LANGUAGE GADTs #-}

6+{-# LANGUAGE ScopedTypeVariables #-}

7+{-# LANGUAGE LambdaCase #-}

8+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

9+module Test.Grenade.Layers.Nonlinear where

10+

11+import Data.Singletons

12+

13+import Grenade

14+import GHC.TypeLits

15+

16+import Disorder.Jack

17+

18+import Test.Jack.Hmatrix

19+import Test.Jack.TypeLits

20+

21+import Numeric.LinearAlgebra.Static ( norm_Inf )

22+

23+prop_sigmoid_grad :: Property

24+prop_sigmoid_grad =

25+ gambleDisplay (const "Shape") genShape $ \case

26+ (SomeSing (r :: Sing s)) ->

27+ withSingI r $

28+ gamble genOfShape $ \(ds :: S s) ->

29+ let (tape, f :: S s) = runForwards Logit ds

30+ ((), ret :: S s) = runBackwards Logit tape (1 :: S s)

31+ (_, numer :: S s) = runForwards Logit (ds + 0.0001)

32+ numericalGradient = (numer - f) * 10000

33+ in counterexample (show numericalGradient ++ show ret)

34+ ((case numericalGradient - ret of

35+ (S1D x) -> norm_Inf x < 0.0001

36+ (S2D x) -> norm_Inf x < 0.0001

37+ (S3D x) -> norm_Inf x < 0.0001) :: Bool)

38+

39+prop_tanh_grad :: Property

40+prop_tanh_grad =

41+ gambleDisplay (const "Shape") genShape $ \case

42+ (SomeSing (r :: Sing s)) ->

43+ withSingI r $

44+ gamble genOfShape $ \(ds :: S s) ->

45+ let (tape, f :: S s) = runForwards Tanh ds

46+ ((), ret :: S s) = runBackwards Tanh tape (1 :: S s)

47+ (_, numer :: S s) = runForwards Tanh (ds + 0.0001)

48+ numericalGradient = (numer - f) * 10000

49+ in counterexample (show numericalGradient ++ show ret)

50+ ((case numericalGradient - ret of

51+ (S1D x) -> norm_Inf x < 0.001

52+ (S2D x) -> norm_Inf x < 0.001

53+ (S3D x) -> norm_Inf x < 0.001) :: Bool)

54+

55+prop_softmax_grad :: Property

56+prop_softmax_grad =

57+ gamble genNat $ \case

58+ (SomeNat (_ :: Proxy s)) ->

59+ gamble genOfShape $ \(ds :: S ('D1 s)) ->

60+ let (tape, f :: S ('D1 s)) = runForwards Relu ds

61+ ((), ret :: S ('D1 s)) = runBackwards Relu tape (1 :: S ('D1 s))

62+ (_, numer :: S ('D1 s)) = runForwards Relu (ds + 0.0001)

63+ numericalGradient = (numer - f) * 10000

64+ in counterexample (show numericalGradient ++ show ret)

65+ ((case numericalGradient - ret of

66+ (S1D x) -> norm_Inf x < 0.0001) :: Bool)

67+

68+

69+return []

70+tests :: IO Bool

71+tests = $quickCheckAll

72+

test/Test/Grenade/Recurrent/Layers/LSTM.hs+7−7

@@ -44,7 +44,7 @@ prop_lstm_reference_forwards =

44 gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->

45 let actual = runRecurrentForwards net (S1D cell) (S1D input)

46 in case actual of

47− ((S1D cellOut) :: S ('D1 2), (S1D output) :: S ('D1 2)) ->

47+ (_, (S1D cellOut) :: S ('D1 2), (S1D output) :: S ('D1 2)) ->

48 let cellOut' = Reference.Vector . H.toList . S.extract $ cellOut

49 output' = Reference.Vector . H.toList . S.extract $ output

50 refNet = Reference.lstmToReference lstmWeights

@@ -57,9 +57,9 @@ prop_lstm_reference_backwards =

57 gamble randomVector $ \(input :: S.R 3) ->

58 gamble randomVector $ \(cell :: S.R 2) ->

59 gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->

60− let actualBacks = runRecurrentBackwards net (S1D cell) (S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))

60+ let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))

61 in case actualBacks of

62− (actualGradients, _, _) ->

62+ (actualGradients, _, _ :: S ('D1 3)) ->

63 let refNet = Reference.lstmToReference lstmWeights

64 refCell = Reference.Vector . H.toList . S.extract $ cell

65 refInput = Reference.Vector . H.toList . S.extract $ input

@@ -70,9 +70,9 @@ prop_lstm_reference_backwards_input =

70 gamble randomVector $ \(input :: S.R 3) ->

71 gamble randomVector $ \(cell :: S.R 2) ->

72 gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->

73− let actualBacks = runRecurrentBackwards net (S1D cell) (S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))

73+ let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))

74 in case actualBacks of

75− (_, _, S1D actualGradients) ->

75+ (_, _, S1D actualGradients :: S ('D1 3)) ->

76 let refNet = Reference.lstmToReference lstmWeights

77 refCell = Reference.Vector . H.toList . S.extract $ cell

78 refInput = Reference.Vector . H.toList . S.extract $ input

@@ -83,9 +83,9 @@ prop_lstm_reference_backwards_cell =

83 gamble randomVector $ \(input :: S.R 3) ->

84 gamble randomVector $ \(cell :: S.R 2) ->

85 gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->

86− let actualBacks = runRecurrentBackwards net (S1D cell) (S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))

86+ let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))

87 in case actualBacks of

88− (_, S1D actualGradients, _) ->

88+ (_, S1D actualGradients, _ :: S ('D1 3)) ->

89 let refNet = Reference.lstmToReference lstmWeights

90 refCell = Reference.Vector . H.toList . S.extract $ cell

91 refInput = Reference.Vector . H.toList . S.extract $ input