923c9f5 · grenade · git.iko.soy

git.iko.soy/grenade

Add Phase to network, so dropout acts correctly between train and test

commit923c9f546ef8954c7520b4dc171c873a36b3c52d authorHuw Campbell <huw.campbell@ambiata.com> dateMon 27 Jun 2016, 19:01 (10 years ago) parente710046

4 files changed+32−6

compare with master

unifiedsplit

grenade.cabal+3−1 src/Grenade.hs+2 src/Grenade/Core/Phase.hs+14 src/Grenade/Layers/Dropout.hs+13−5

grenade.cabal+3−1

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

2020 , MonadRandom

2121 , mtl >= 2.2.1 && < 2.3

2222 , parallel == 3.2.*

23− , text == 1.2.*

23+ , primitive

24+ , text >= 1.2

2425 , transformers

2526 , singletons

2627

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

3637 Grenade.Core.Vector

3738 Grenade.Core.Runner

3839 Grenade.Core.Shape

40+ Grenade.Core.Phase

3941 Grenade.Layers.Convolution

4042 Grenade.Layers.Dropout

4143 Grenade.Layers.FullyConnected

src/Grenade.hs+2

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

1919import Grenade.Core.Network as X

2020import Grenade.Core.Runner as X

2121import Grenade.Core.Shape as X

22+import Grenade.Core.Phase as X

2223import Grenade.Layers.Dropout as X

2324import Grenade.Layers.Pooling as X

2425import Grenade.Layers.Flatten as X

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

2728import Grenade.Layers.Logit as X

2829import Grenade.Layers.Convolution as X

2930import Grenade.Layers.Relu as X

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

3032import 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

7+import Control.Monad.State

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 @@

55{-# LANGUAGE TypeOperators #-}

66{-# LANGUAGE TypeFamilies #-}

77{-# LANGUAGE MultiParamTypeClasses #-}

8+{-# LANGUAGE FlexibleContexts #-}

89{-# LANGUAGE FlexibleInstances #-}

10+{-# LANGUAGE LambdaCase #-}

911

1012module Grenade.Layers.Dropout (

1113 Dropout (..)

1214 ) where

1315

1416import Control.Monad.Random hiding (fromList)

17+import Control.Monad.State

1518

1619import GHC.TypeLits

1720import Grenade.Core.Shape

1821import Grenade.Core.Network

22+import Grenade.Core.Phase

1923

2024import Numeric.LinearAlgebra.Static

2125

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

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

3741 return $ Dropout rate xs

3842

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

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

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

42− newDropout <- randomDropout rate

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

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

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

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

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

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

48+ True -> do

49+ newDropout <- randomDropout rate

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

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