git.iko.soy/grenade
on master help sign in
Change fusing layers so we can have two paths of sub networks
32f3e31Huw Campbell
src/Grenade/Core/Network.hs+7
compare with master
unifiedsplit
@@ -22,6 +22,7 @@ module Grenade.Core.Network (
22 , UpdateLayer (..)
22 , UpdateLayer (..)
23 , LearningParameters (..)
23 , LearningParameters (..)
24 , Gradients (..)
24 , Gradients (..)
25+ , Tapes (..)
25 , CreatableNetwork (..)
26 , CreatableNetwork (..)
26 ) where
27 ) where
27
28
@@ -97,6 +98,12 @@ data Gradients :: [*] -> * where
97 GNil :: Gradients '[]
98 GNil :: Gradients '[]
98 (:/>) :: UpdateLayer x => Gradient x -> Gradients xs -> Gradients (x ': xs)
99 (:/>) :: UpdateLayer x => Gradient x -> Gradients xs -> Gradients (x ': xs)
99
100
101+-- | Gradients of a network.
102+-- Parameterised on the layers of a Network.
103+data Tapes :: [*] -> [Shape] -> * where
104+ TNil :: SingI i => Tapes '[] '[i]
105+ (:\>) :: (SingI i, SingI h, Layer x i h) => !(Tape x i h) -> !(Tapes xs (h ': hs)) -> Tapes (x ': xs) (i ': h ': hs)
106+
100-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random
107-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random
101-- network is with the randomNetwork.
108-- network is with the randomNetwork.
102class CreatableNetwork (xs :: [*]) (ss :: [Shape]) where
109class CreatableNetwork (xs :: [*]) (ss :: [Shape]) where
src/Grenade/Core/Shape.hs+3−1
@@ -66,9 +66,11 @@ data S (n :: Shape) where
66
66
67deriving instance Show (S n)
67deriving instance Show (S n)
68
68
69−-- Singletons
69+-- Singleton instances.
70+--
70-- These could probably be derived with template haskell, but this seems
71-- These could probably be derived with template haskell, but this seems
71-- clear and makes adding the KnownNat constraints simple.
72-- clear and makes adding the KnownNat constraints simple.
73+-- We can also keep our code TH free, which is great.
72data instance Sing (n :: Shape) where
74data instance Sing (n :: Shape) where
73 D1Sing :: KnownNat a => Sing ('D1 a)
75 D1Sing :: KnownNat a => Sing ('D1 a)
74 D2Sing :: (KnownNat a, KnownNat b) => Sing ('D2 a b)
76 D2Sing :: (KnownNat a, KnownNat b) => Sing ('D2 a b)
src/Grenade/Layers/Fuse.hs+67−30
@@ -1,4 +1,5 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE GADTs #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
@@ -7,40 +8,76 @@
7{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleInstances #-}
9{-# LANGUAGE FlexibleInstances #-}
9module Grenade.Layers.Fuse (
10module Grenade.Layers.Fuse (
10− Fuse (..)
11+ SubNetwork (..)
12+ , BranchNetwork (..)
11 ) where
13 ) where
12
14
15+import Data.Singletons.Prelude
16+
13import Grenade.Core.Network
17import Grenade.Core.Network
14import Grenade.Core.Shape
18import Grenade.Core.Shape
19+import Grenade.Core.Runner
15
20
16-- | Fuse two layers into one layer.
21-- | Fuse two layers into one layer.
17-- This can be used to simplify a network if a complicated repeated structure is used.
22-- This can be used to simplify a network if a complicated repeated structure is used.
18−data Fuse :: * -> * -> Shape -> Shape -> Shape -> * where
23+data SubNetwork :: [*] -> [Shape] -> * where
19− (:$$) :: (Layer x i h, Layer y h o)
24+ SubNetwork :: Network sublayers subshapes -> SubNetwork sublayers subshapes
20− => !x
25+
21− -> !y
26+instance CreatableNetwork sublayers subshapes => UpdateLayer (SubNetwork sublayers subshapes) where
22− -> Fuse x y i h o
27+ type Gradient (SubNetwork sublayers subshapes) = Gradients sublayers
23−infixr 5 :$$
28+ runUpdate lr (SubNetwork net) = SubNetwork . applyUpdate lr net
24−
29+ createRandom = SubNetwork <$> randomNetwork
25−instance (Show x, Show y) => Show (Fuse x y i h o) where
30+
26− show (x :$$ y) = "(" ++ show x ++ " :$$ " ++ show y ++ ")"
31+instance (CreatableNetwork sublayers subshapes, i ~ (Head subshapes), o ~ (Last subshapes)) => Layer (SubNetwork sublayers subshapes) i o where
27−
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+
28−instance (Layer x i h, Layer y h o) => UpdateLayer (Fuse x y i h o) where
68+instance (UpdateLayer x, UpdateLayer y) => UpdateLayer (BranchNetwork x y) where
29− type Gradient (Fuse x y i h o) = (Gradient x, Gradient y)
69+ type Gradient (BranchNetwork x y) = (Gradient x, Gradient y)
30− runUpdate lr (x :$$ y) (x', y') =
70+ runUpdate lr (BranchNetwork x y) (x', y') = BranchNetwork (runUpdate lr x x') (runUpdate lr y y')
31− let newX = runUpdate lr x x'
32− newY = runUpdate lr y y'
33− in (newX :$$ newY)
34− createRandom = (:$$) <$> createRandom <*> createRandom
71+ createRandom = BranchNetwork <$> createRandom <*> createRandom
35−
72+
36−instance (Layer x i h, Layer y h o) => Layer (Fuse x y i h o) i o where
73+instance (SingI i, SingI o, Layer x i o, Layer y i o) => Layer (BranchNetwork x y) i o where
37− type Tape (Fuse x y i h o) i o = (Tape x i h, Tape y h o)
74+ type Tape (BranchNetwork x y) i o = (Tape x i o, Tape y i o)
38− runForwards (x :$$ y) input =
75+ runForwards (BranchNetwork x y) input =
39− let (xTape, yInput :: S h) = runForwards x input
76+ let (xT, xOut) = runForwards x input
40− (yTape, output :: S o) = runForwards y yInput
77+ (yT, yOut) = runForwards y input
41− in ((xTape, yTape), output)
78+ in ((xT, yT), xOut + yOut)
42−
79+
43− runBackwards (x :$$ y) (xTape, yTape) backGradient =
80+ runBackwards (BranchNetwork x y) (xTape, yTape) o =
44− let (y', yGrad :: S h) = runBackwards y yTape backGradient
81+ let (x', xB) = runBackwards x xTape o
45− (x', xGrad) = runBackwards x xTape yGrad
82+ (y', yB) = runBackwards y yTape o
46− in ((x', y'), xGrad)
83+ in ((x', y'), xB + yB)