923c9f5 · grenade · git.iko.soy

grenade.cabal+3−1

compare with master

unifiedsplit

@@ -20,7 +20,8 @@ library

20 , MonadRandom

21 , mtl >= 2.2.1 && < 2.3

22 , parallel == 3.2.*

23+ , primitive

23− , text == 1.2.*

24+ , text >= 1.2

24 , transformers

25 , transformers

25 , singletons

26 , singletons

26

27

@@ -36,6 +37,7 @@ library

36 Grenade.Core.Vector

37 Grenade.Core.Vector

37 Grenade.Core.Runner

38 Grenade.Core.Runner

38 Grenade.Core.Shape

39 Grenade.Core.Shape

40+ Grenade.Core.Phase

39 Grenade.Layers.Convolution

41 Grenade.Layers.Convolution

40 Grenade.Layers.Dropout

42 Grenade.Layers.Dropout

41 Grenade.Layers.FullyConnected

43 Grenade.Layers.FullyConnected

src/Grenade.hs+2

@@ -19,6 +19,7 @@ import Grenade.Core.Vector as X

19import Grenade.Core.Network as X

20import Grenade.Core.Runner as X

21import Grenade.Core.Shape as X

22+import Grenade.Core.Phase as X

22import Grenade.Layers.Dropout as X

23import Grenade.Layers.Dropout as X

23import Grenade.Layers.Pooling as X

24import Grenade.Layers.Pooling as X

24import Grenade.Layers.Flatten as X

25import Grenade.Layers.Flatten as X

@@ -27,4 +28,5 @@ import Grenade.Layers.FullyConnected as X

27import Grenade.Layers.Logit as X

28import Grenade.Layers.Logit as X

28import Grenade.Layers.Convolution as X

29import Grenade.Layers.Convolution as X

29import Grenade.Layers.Relu as X

30import Grenade.Layers.Relu as X

31+-- import Grenade.Layers.Recurrent as X

30import Grenade.Layers.Tanh as X

32import Grenade.Layers.Tanh as X

src/Grenade/Core/Phase.hsnew file+14

@@ -0,0 +1,14 @@

1+{-# LANGUAGE FlexibleContexts #-}

2+module Grenade.Core.Phase (

3+ Phase (..)

4+ , isTrainingPhase

5+ ) where

6+

7+import Control.Monad.State

8+

9+data Phase = TrainingPhase

10+ | TestingPhase

11+ deriving (Eq, Ord, Show)

12+

13+isTrainingPhase :: MonadState Phase m => m Bool

14+isTrainingPhase = (== TrainingPhase) <$> get

src/Grenade/Layers/Dropout.hs+13−5

@@ -5,17 +5,21 @@

5{-# LANGUAGE TypeOperators #-}

6{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

8+{-# LANGUAGE FlexibleContexts #-}

8{-# LANGUAGE FlexibleInstances #-}

9{-# LANGUAGE FlexibleInstances #-}

10+{-# LANGUAGE LambdaCase #-}

9

11

10module Grenade.Layers.Dropout (

12module Grenade.Layers.Dropout (

11 Dropout (..)

13 Dropout (..)

12 ) where

14 ) where

13

15

14import Control.Monad.Random hiding (fromList)

16import Control.Monad.Random hiding (fromList)

17+import Control.Monad.State

15

18

16import GHC.TypeLits

19import GHC.TypeLits

17import Grenade.Core.Shape

20import Grenade.Core.Shape

18import Grenade.Core.Network

21import Grenade.Core.Network

22+import Grenade.Core.Phase

19

23

20import Numeric.LinearAlgebra.Static

24import Numeric.LinearAlgebra.Static

21

25

@@ -36,8 +40,12 @@ randomDropout rate = do

36 xs = dvmap (\a -> if a <= rate then 0 else 1) wN

40 xs = dvmap (\a -> if a <= rate then 0 else 1) wN

37 return $ Dropout rate xs

41 return $ Dropout rate xs

38

42

39−instance (MonadRandom m, KnownNat i) => Layer m (Dropout i) ('D1 i) ('D1 i) where

43+instance (MonadRandom m, MonadState Phase m, KnownNat i) => Layer m (Dropout i) ('D1 i) ('D1 i) where

40− runForwards (Dropout _ drops) (S1D' x) = return . S1D' $ x * drops

44+ runForwards (Dropout rate drops) (S1D' x) = isTrainingPhase >>= \case

45+ True -> return . S1D' $ x * drops

46+ False -> return . S1D' $ dvmap (* (1 - rate)) x

41− runBackards _ (Dropout rate drops) _ (S1D' x) = do

47+ runBackards _ oldDropout@(Dropout rate drops) _ (S1D' x) = isTrainingPhase >>= \case

48+ True -> do

42− newDropout <- randomDropout rate

49+ newDropout <- randomDropout rate

43− return (newDropout, S1D' $ x * drops)

50+ return (newDropout, S1D' $ x * drops)

51+ False -> return (oldDropout, S1D' $ dvmap (* (1 - rate)) x)