git.iko.soy/grenade
on master help sign in
Add a reshape to the generator
96a6324Huw Campbell
src/Grenade/Core/Shape.hs+6
compare with master
unifiedsplit
@@ -142,9 +142,11 @@ randomOfShape = do
142 D1Sing l ->
142 D1Sing l ->
143 withKnownNat l $
143 withKnownNat l $
144 S1D (randomVector seed Uniform * 2 - 1)
144 S1D (randomVector seed Uniform * 2 - 1)
145+
145 D2Sing r c ->
146 D2Sing r c ->
146 withKnownNat r $ withKnownNat c $
147 withKnownNat r $ withKnownNat c $
147 S2D (uniformSample seed (-1) 1)
148 S2D (uniformSample seed (-1) 1)
149+
148 D3Sing r c d ->
150 D3Sing r c d ->
149 withKnownNat r $ withKnownNat c $ withKnownNat d $
151 withKnownNat r $ withKnownNat c $ withKnownNat d $
150 S3D (uniformSample seed (-1) 1)
152 S3D (uniformSample seed (-1) 1)
@@ -157,9 +159,11 @@ fromStorable xs = case sing :: Sing x of
157 D1Sing l ->
159 D1Sing l ->
158 withKnownNat l $
160 withKnownNat l $
159 S1D <$> H.create xs
161 S1D <$> H.create xs
162+
160 D2Sing r c ->
163 D2Sing r c ->
161 withKnownNat r $ withKnownNat c $
164 withKnownNat r $ withKnownNat c $
162 S2D <$> mkL xs
165 S2D <$> mkL xs
166+
163 D3Sing r c d ->
167 D3Sing r c d ->
164 withKnownNat r $ withKnownNat c $ withKnownNat d $
168 withKnownNat r $ withKnownNat c $ withKnownNat d $
165 S3D <$> mkL xs
169 S3D <$> mkL xs
@@ -191,9 +195,11 @@ nk x = case (sing :: Sing x) of
191 D1Sing l ->
195 D1Sing l ->
192 withKnownNat l $
196 withKnownNat l $
193 S1D (konst x)
197 S1D (konst x)
198+
194 D2Sing r c ->
199 D2Sing r c ->
195 withKnownNat r $ withKnownNat c $
200 withKnownNat r $ withKnownNat c $
196 S2D (konst x)
201 S2D (konst x)
202+
197 D3Sing r c d ->
203 D3Sing r c d ->
198 withKnownNat r $ withKnownNat c $ withKnownNat d $
204 withKnownNat r $ withKnownNat c $ withKnownNat d $
199 S3D (konst x)
205 S3D (konst x)
test/Test/Hedgehog/Network.hs+13
@@ -73,6 +73,19 @@ genNetwork =
73 , pure (SomeNetwork (Relu :~> rest :: Network ( Relu ': layers ) ( h ': h ': hs )))
73 , pure (SomeNetwork (Relu :~> rest :: Network ( Relu ': layers ) ( h ': h ': hs )))
74 , pure (SomeNetwork (Elu :~> rest :: Network ( Elu ': layers ) ( h ': h ': hs )))
74 , pure (SomeNetwork (Elu :~> rest :: Network ( Elu ': layers ) ( h ': h ': hs )))
75 , pure (SomeNetwork (Softmax :~> rest :: Network ( Softmax ': layers ) ( h ': h ': hs )))
75 , 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
76 ]
89 ]
77 D2Sing r c -> withKnownNat r $ withKnownNat c $
90 D2Sing r c -> withKnownNat r $ withKnownNat c $
78 Gen.choice [
91 Gen.choice [