deeplearning-hs (empty) → 0.1.0.0

raw patch · 7 files changed

+362/−0 lines, 7 filesdep +QuickCheckdep +acceleratedep +basesetup-changed

Dependencies added: QuickCheck, accelerate, base, deeplearning-hs, mtl, repa, repa-algorithms, test-framework, test-framework-quickcheck2, vector

Files

• DeepLearning/ConvNet.hs +185/−0
• DeepLearning/ConvNetTest.hs +38/−0
• DeepLearning/Util.hs +31/−0
• LICENSE +28/−0
• Main.hs +13/−0
• Setup.hs +4/−0
• deeplearning-hs.cabal +63/−0

@@ -0,0 +1,185 @@+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE FunctionalDependencies    #-}+{-# LANGUAGE TypeOperators             #-}++{-|+Module      : DeepLearning.ConvNet+Description : Deep Learning+Copyright   : (c) Andrew Tulloch, 2014+License     : GPL-3+Maintainer  : andrew+cabal@tullo.ch+Stability   : experimental+Portability : POSIX+-}+module DeepLearning.ConvNet+    (+     (>->),+     DVol,+     Forward,+     InnerLayer,+     SoftMaxLayer(..),+     TopLayer,+     Vol,+     flowNetwork,+     net1,+     net2,+     newFC,+     withActivations,+    ) where++import           Control.Monad as CM+import           Control.Monad.Writer                 hiding (Any)+import           Data.Array.Repa+import           Data.Array.Repa.Algorithms.Randomish+import qualified Data.Vector.Unboxed                  as V+import           Prelude                              as P hiding (map, zipWith)+++-- ** Helper Types++-- |Activation matrix+type Vol sh = Array U sh Double+-- |Delayed activation matrix+type DVol sh = Array D sh Double++-- |Label for supervised learning+type Label = Int++-- **  Top Layers+-- |'TopLayer' is a top level layer that can initialize a+-- backpropagation pass.+class TopLayer a where+    topForward :: (Monad m) => a -> Vol DIM1 -> m (DVol DIM1)+    topBackward :: (Monad m) => a -> Label -> Vol DIM1 -> Vol DIM1 -> m (DVol DIM1)++-- |'SoftMaxLayer' computes the softmax activation function.+data SoftMaxLayer = SoftMaxLayer -- ++instance TopLayer SoftMaxLayer where+    topForward _ = softMaxForward+    topBackward _ = softMaxBackward++softMaxForward :: (Shape sh, Monad m) => Vol sh -> m (DVol sh)+softMaxForward input = do+  exponentials <- exponentiate input+  sumE <- foldAllP (+) 0.0 exponentials+  return $ map (/ sumE) exponentials+      where+        maxA = foldAllP max 0.0+        exponentiate acts = do+              maxAct <- maxA acts+              return $ map (\a -> exp (a - maxAct)) acts++softMaxBackward :: (Monad m) => Label -> Vol DIM1 -> Vol DIM1 -> m (DVol DIM1)+softMaxBackward label output _ = return $ traverse output id gradientAt+      where+        gradientAt f s@(Z :. i) = gradient (f s) i+        gradient outA target = -(bool2Double indicator - outA)+            where+              indicator = label == target+              bool2Double x = if x then 1.0 else 0.0++-- ** Inner Layers+-- |'InnerLayer' represents an inner layer of a neural network that+-- can accept backpropagation input from higher layers+class (Shape sh, Shape sh') => InnerLayer a sh sh' | a -> sh, a -> sh' where+    innerForward :: Monad m => a -> Vol sh -> m (DVol sh')+    innerBackward :: Monad m => a -> Vol sh' -> Vol sh -> m (DVol sh)++-- |'FullyConnectedLayer' represents a fully-connected input layer+data FullyConnectedLayer sh = FullyConnectedLayer {+      _weights :: Vol (sh :. Int),+      _bias    :: Vol DIM1+    }++instance (Shape sh) => InnerLayer (FullyConnectedLayer sh) sh DIM1 where+    innerForward = fcForward+    innerBackward = fcBackward++fcForward :: (Shape sh, Monad m)+          => FullyConnectedLayer sh -> Vol sh -> m (DVol DIM1)+fcForward (FullyConnectedLayer w b) input =+    return $ traverse w toNumFilters f+        where+          toNumFilters (_ :. i) = Z :. i+          f _ (Z :. i) = bias + dotProduct weights input+              where+                bias = toUnboxed b V.! i+                weights = computeUnboxedS $ slice w (Any :. (i :: Int))++fcBackward :: (Monad m)+           => FullyConnectedLayer sh -> Vol DIM1 -> Vol sh -> m (DVol sh)+fcBackward = undefined++dotProduct :: (Num a, V.Unbox a) => Array U sh a -> Array U sh a -> a+dotProduct l r = prod (toUnboxed l) (toUnboxed r)+    where+      prod lv rv = V.sum $ V.zipWith (*) lv rv+++-- ** Composing Layers++-- |The 'Forward' function represents a single forward pass through a layer.+type Forward m sh sh' = (Vol sh -> WriterT [V.Vector Double] m (DVol sh'))++-- |'(>->)' composes two forward activation functions+(>->) :: (Monad m, Shape sh, Shape sh', Shape sh'')+        => Forward m sh sh' -> Forward m sh' sh'' -> Forward m sh sh''+(f >-> g) input = do+  intermediate <- f input+  unboxed <- computeP intermediate+  tell [toUnboxed unboxed]+  g unboxed++-- |'net1' constructs a single-layer fully connected perceptron with+-- softmax output.+net1+  :: (Monad m, InnerLayer a sh DIM1, TopLayer a1) =>+     a -> a1 -> Forward m sh DIM1+net1 bottom top = innerForward bottom >-> topForward top+++-- |'net1' constructs a two-layer fully connected MLP with+-- softmax output.+net2+  :: (Monad m, InnerLayer a sh sh', InnerLayer a1 sh' DIM1,+      TopLayer a2) =>+     a -> a1 -> a2 -> Forward m sh DIM1+net2 bottom middle top = innerForward bottom >-> net1 middle top++-- |'withActivations' computes the output activation, along with the+-- intermediate activations+withActivations :: Forward m sh sh' -> Vol sh -> m (DVol sh', [V.Vector Double])+withActivations f input = runWriterT (f input)++-- |'newFC' constructs a new fully connected layer+newFC :: Shape sh => sh -> Int -> FullyConnectedLayer sh+newFC sh numFilters = FullyConnectedLayer {+                        _weights=randomishDoubleArray (sh :. (numFilters :: Int)) 0 1.0 1,+                        _bias=randomishDoubleArray (Z :. (numFilters :: Int)) 0 1.0 1+                      }++-- |'FlowNetwork' builds a network of the form+--+-- @+--  Input Layer              Output Softmax+--     +--++--     |  |   Inner Layers    +--+   +--++--     |  |                   |  |   |  |+--     |  |   +-+   +-+  +-+  |  |   |  |+--     |  +---+ +---+ +--+ +--+  +--->  |+--     |  |   +-+   +-+  +-+  |  |   |  |+--     |  |                   |  |   |  |+--     |  |                   +--+   +--++--     +--++-- @+flowNetwork :: (Monad m, Shape sh) => sh -> Int -> Int -> Int -> Forward m sh DIM1+flowNetwork inputShape numHiddenLayers numHiddenNodes numClasses =+    inputLayer >-> innerLayers >-> preTopLayer >-> topLayer+    where+      inputLayer = innerForward $ newFC inputShape numHiddenNodes+      innerLayers = flatInner $ P.fmap (\_ -> newFC (Z :. numHiddenNodes) numHiddenNodes) [1..numHiddenLayers]+      preTopLayer = innerForward $ newFC (Z :. numHiddenNodes) numClasses+      topLayer = topForward SoftMaxLayer+      flatInner layers = P.foldl1 (>->) (P.fmap innerForward layers)

@@ -0,0 +1,38 @@+{-# LANGUAGE TypeOperators #-}+module Main where++import           Data.Array.Repa+import           Data.Array.Repa.Arbitrary+import           Data.Monoid+import qualified Data.Vector.Unboxed                  as V+import           DeepLearning.ConvNet+import           DeepLearning.Util+import           Test.Framework+import           Test.Framework.Providers.QuickCheck2+import           Test.QuickCheck++genOneLayer :: (Shape sh) => sh -> Gen (Int, Vol sh)+genOneLayer sh = do+  a <- choose (1, 10)+  b <- arbitraryUShaped sh+  return (a, b)++testFilter :: (Shape sh) => (Int, Vol sh) -> Bool+testFilter (numFilters, input) = and invariants+    where+      [(outAP, [innerA])] = withActivations (testNet sh numFilters) (testInput sh)+      outA = computeS outAP :: Vol DIM1+      sh = extent input+      invariants = [+       (length . toList) outA == numFilters,+       V.length innerA == numFilters]++prop_singleLayer :: Property+prop_singleLayer = forAll (genOneLayer testShape) testFilter++tests :: [Test]+tests = [testProperty "singleLayer" prop_singleLayer]+++main :: IO ()+main = defaultMainWithOpts tests mempty

@@ -0,0 +1,31 @@+{-# LANGUAGE TypeOperators #-}++{-|+Module      : DeepLearning.Util+Description : Deep Learning+Copyright   : (c) Andrew Tulloch, 2014+License     : GPL-3+Maintainer  : andrew+cabal@tullo.ch+Stability   : experimental+Portability : POSIX+-}+module DeepLearning.Util where++import           Data.Array.Repa+import           Data.Array.Repa.Algorithms.Randomish+import           DeepLearning.ConvNet++-- |Sample 3x3 matrix used for demonstrations and tests+testShape :: (Z :. Int) :. Int+testShape = Z :. (3 :: Int) :. (3 :: Int)++-- |Random 3x3 matrix+testInput :: Shape sh => sh -> Array U sh Double+testInput sh = randomishDoubleArray sh 0 1.0 1++-- |Random single-layer network+testNet :: (Monad m, Shape sh) => sh -> Int -> Forward m sh DIM1+testNet sh numFilters = net1 testFC testSM+    where+      testFC = newFC sh numFilters+      testSM = SoftMaxLayer

@@ -0,0 +1,28 @@+The MIT License++Author:: Andrew Tulloch <andrew@tullo.ch>+Copyright:: Copyright (c) 2014, Andrew Tulloch++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++Except as contained in this notice, the name(s) of the above copyright+holders shall not be used in advertising or otherwise to promote the+sale, use or other dealings in this Software without prior written+authorization.

@@ -0,0 +1,13 @@+{-# LANGUAGE TypeOperators #-}+module Main where++import           Data.Array.Repa+import           DeepLearning.ConvNet+import           DeepLearning.Util++-- |Main+main :: IO ()+main = do+  (pvol, acts) <- withActivations (testNet testShape 2) (testInput testShape)+  print (computeS pvol :: Vol DIM1)+  print acts

@@ -0,0 +1,4 @@+import           Distribution.Simple++main :: IO ()+main = defaultMain

@@ -0,0 +1,63 @@+-- Initial deeplearning.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/+++name:                deeplearning-hs+version:             0.1.0.0+description:         Implements type-safe deep neural networks+synopsis:            Deep Learning in Haskell+homepage:            https://github.com/ajtulloch/deeplearning-hs+license:             MIT+license-file:        LICENSE+author:              Andrew Tulloch+maintainer:          Andrew Tulloch <andrew+cabal@tullo.ch>+category:            Math+build-type:          Simple+cabal-version:       >=1.10+bug-reports:         https://github.com/ajtulloch/deeplearning-hs/issues+source-repository head+  type:      git+  location:  https://github.com/ajtulloch/deeplearning-hs.git++Library+  exposed-modules: DeepLearning.ConvNet, DeepLearning.Util+  default-language:    Haskell2010+  GHC-Options: -Wall+  build-depends:+        base >=4.6 && <4.7,+        accelerate,+        vector,+        repa,+        repa-algorithms,+        mtl++Test-suite deeplearning_test+  Main-Is: DeepLearning/ConvNetTest.hs+  Type: exitcode-stdio-1.0+  x-uses-tf: true+  default-language: Haskell2010+  build-depends:+        deeplearning-hs,+        base >=4.6 && <4.7,+        accelerate,+        vector,+        repa,+        repa-algorithms,+        mtl,+        QuickCheck,+        test-framework-quickcheck2,+        test-framework+  Ghc-Options:          -Wall++executable deeplearning_demonstration+  main-is: Main.hs+  default-language: Haskell2010+  GHC-Options:    -Wall+  build-depends:+        deeplearning-hs,+        base >=4.6 && <4.7,+        accelerate,+        vector,+        repa,+        repa-algorithms,+        mtl