96a6324 · grenade · git.iko.soy

git.iko.soy/grenade

Add a reshape to the generator

commit96a6324f78393fc3448d9a1d5ee92b4e94c96a8f authorHuw Campbell <huw.campbell@ambiata.com> dateWed 12 Apr 2017, 12:26 (10 years ago) parent8767e83

2 files changed+19

compare with master

unifiedsplit

src/Grenade/Core/Shape.hs+6 test/Test/Hedgehog/Network.hs+13

src/Grenade/Core/Shape.hs+6

@@ -142,9 +142,11 @@ randomOfShape = do

142142 D1Sing l ->

143143 withKnownNat l $

144144 S1D (randomVector seed Uniform * 2 - 1)

145+

145146 D2Sing r c ->

146147 withKnownNat r $ withKnownNat c $

147148 S2D (uniformSample seed (-1) 1)

149+

148150 D3Sing r c d ->

149151 withKnownNat r $ withKnownNat c $ withKnownNat d $

150152 S3D (uniformSample seed (-1) 1)

@@ -157,9 +159,11 @@ fromStorable xs = case sing :: Sing x of

157159 D1Sing l ->

158160 withKnownNat l $

159161 S1D <$> H.create xs

162+

160163 D2Sing r c ->

161164 withKnownNat r $ withKnownNat c $

162165 S2D <$> mkL xs

166+

163167 D3Sing r c d ->

164168 withKnownNat r $ withKnownNat c $ withKnownNat d $

165169 S3D <$> mkL xs

@@ -191,9 +195,11 @@ nk x = case (sing :: Sing x) of

191195 D1Sing l ->

192196 withKnownNat l $

193197 S1D (konst x)

198+

194199 D2Sing r c ->

195200 withKnownNat r $ withKnownNat c $

196201 S2D (konst x)

202+

197203 D3Sing r c d ->

198204 withKnownNat r $ withKnownNat c $ withKnownNat d $

199205 S3D (konst x)

test/Test/Hedgehog/Network.hs+13

@@ -73,6 +73,19 @@ genNetwork =

7373 , pure (SomeNetwork (Relu :~> rest :: Network ( Relu ': layers ) ( h ': h ': hs )))

7474 , pure (SomeNetwork (Elu :~> rest :: Network ( Elu ': layers ) ( h ': h ': hs )))

7575 , pure (SomeNetwork (Softmax :~> rest :: Network ( Softmax ': layers ) ( h ': h ': hs )))

76+ , do -- Reshape to two dimensions

77+ let divisors n = 1 : [x | x <- [2..(n-1)], n `rem` x == 0]

78+ let len = natVal l

79+ rs <- Gen.element $ divisors len

80+ let cs = len `quot` rs

81+ case ( someNatVal rs, someNatVal cs, someNatVal len ) of

82+ ( Just (SomeNat (rs' :: Proxy inRows)), Just (SomeNat (cs' :: Proxy inCols)), Just (SomeNat (_ :: Proxy outLen ) )) ->

83+ let p1 = natDict rs'

84+ p2 = natDict cs'

85+ in case ( p1 %* p2, unsafeCoerce (Dict :: Dict ()) :: Dict ((inRows * inCols) ~ outLen), unsafeCoerce (Dict :: Dict ()) :: Dict (( 'D1 outLen ) ~ h )) of

86+ ( Dict, Dict, Dict ) ->

87+ pure (SomeNetwork (Reshape :~> rest :: Network ( Reshape ': layers ) ( ('D2 inRows inCols) ': h ': hs )))

88+ _ -> Gen.discard -- Doesn't occur

7689 ]

7790 D2Sing r c -> withKnownNat r $ withKnownNat c $

7891 Gen.choice [