Add a way to build a random network

Author: Taneb

IndexedTardis.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PolyKinds #-}
 module IndexedTardis where
 
 import           Control.Monad.Indexed

Main.hs

@@ -1,13 +1,16 @@
-{-# LANGUAGE GADTs           #-}
-{-# LANGUAGE Rank2Types      #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs            #-}
+{-# LANGUAGE Rank2Types       #-}
+{-# LANGUAGE RecordWildCards  #-}
+{-# LANGUAGE PolyKinds        #-}
 module Main where
 
 import           Control.Category
 import           Control.Monad.Indexed
 
 import           Data.Composition
 import           Data.Distributive
+import           Data.Random
 
 import           Linear
 import           Linear.V
@@ -17,6 +20,7 @@ import           Numeric.AD
 import           Prelude               hiding (id, (.))
 
 import           IndexedTardis
+import           WrapIndex
 
 -- | The type representing a single sigmoid layer
 data Layer f a b = Layer {weights :: V b (V a f), biases :: V b f}
@@ -134,5 +138,25 @@ runMiniBatch xys lr =
   backPropogate (collect fst xys, collect snd xys) (pure lr) .
   batch
 
+emptyLayer :: (Dim a, Dim b) => Layer () a b
+emptyLayer = Layer {weights = pure (pure ()), biases = pure ()}
+
+randomizeLayer' :: (Dim a, Dim b, Distribution d t) => d t -> Layer x a b -> RVar (Layer t a b)
+randomizeLayer' dist Layer{..} =
+  Layer <$>
+  traverse (traverse (\_ -> rvar dist)) weights <*>
+  traverse (\_ -> rvar dist) biases
+
+randomize' :: Distribution d t => d t -> Network x a b -> RVar (Network t a b)
+randomize' dist = iunwrap . traverseNetwork (IWrap . randomizeLayer' dist)
+
+randomize :: Distribution Normal t => Network x a b -> RVar (Network t a b)
+randomize = randomize' StdNormal
+
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+  let net0 = Lr (emptyLayer :: Layer () 10 3) Id .
+             Lr (emptyLayer :: Layer () 10 10) Id .
+             Lr (emptyLayer :: Layer () 3 10) Id
+  net <- runRVar (randomize net0) StdRandom :: IO (Network Double 3 3)
+  return ()

WrapIndex.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE PolyKinds #-}
+module WrapIndex where
+
+import Control.Monad.Indexed
+
+newtype IWrap m i j a = IWrap {iunwrap :: m a}
+
+instance Functor m => IxFunctor (IWrap m) where
+  imap f = IWrap . fmap f . iunwrap
+
+instance Applicative m => IxPointed (IWrap m) where
+  ireturn = IWrap . pure
+
+instance Applicative m => IxApplicative (IWrap m) where
+  IWrap f `iap` IWrap x = IWrap $ f <*> x
+
+instance Monad m => IxMonad (IWrap m) where
+  f `ibind` IWrap x = IWrap $ x >>= iunwrap . f

net.cabal

@@ -17,8 +17,8 @@ cabal-version:       >=1.10
 
 executable net
   main-is:             Main.hs
-  other-modules:       IndexedTardis
+  other-modules:       IndexedTardis, WrapIndex
   -- other-extensions:    
-  build-depends:       base >=4.9 && <4.10, linear, ad, distributive, indexed, composition
+  build-depends:       base >=4.9 && <4.10, linear, ad, distributive, indexed, composition, random-fu
   -- hs-source-dirs:      
   default-language:    Haskell2010