neural 0.1.0.1 → 0.1.1.0

raw patch · 12 files changed

+296/−35 lines, 12 filesdep +Globdep ~neuralPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: Glob

Dependency ranges changed: neural

API changes (from Hackage documentation)

Files

• .ghci +1/−0
• .gitignore +3/−0
• .travis.yml +118/−0
• README.markdown +31/−0
• doctest/doctest.hs +8/−10
• examples/iris/iris.hs +8/−5
• examples/sqrt/sqrt.hs +7/−3
• neural.cabal +16/−7
• src/Numeric/Neural/Layer.hs +22/−4
• src/Numeric/Neural/Model.hs +13/−6
• src/Numeric/Neural/Normalization.hs +36/−0
• stack.yaml +33/−0

@@ -0,0 +1,1 @@+:set -XDataKinds

@@ -0,0 +1,3 @@+*.swp
+.stack-work/
+dist/

@@ -0,0 +1,118 @@+# Copy these contents into the root directory of your Github project in a file
+# named .travis.yml
+
+# Use new container infrastructure to enable caching
+sudo: false
+
+# Choose a lightweight base image; we provide our own build tools.
+language: c
+
+# Caching so the next build will be fast too.
+cache:
+  directories:
+  - $HOME/.ghc
+  - $HOME/.cabal
+  - $HOME/.stack
+
+# The different configurations we want to test. We have BUILD=cabal which uses
+# cabal-install, and BUILD=stack which uses Stack. More documentation on each
+# of those below.
+#
+# We set the compiler values here to tell Travis to use a different
+# cache file per set of arguments.
+#
+# If you need to have different apt packages for each combination in the
+# matrix, you can use a line such as:
+#     addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
+matrix:
+  include:
+  # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See:
+  # https://github.com/hvr/multi-ghc-travis
+  - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7
+    compiler: ": #GHC 7.10.3"
+    addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
+
+  # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS
+  # variable, such as using --stack-yaml to point to a different file.
+  - env: BUILD=stack ARGS=""
+    compiler: ": #stack default"
+    addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}}
+
+  - env: BUILD=stack ARGS="--resolver lts-5"
+    compiler: ": #stack 7.10.3"
+    addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}}
+
+before_install:
+# Using compiler above sets CC to an invalid value, so unset it
+- unset CC
+
+# We want to always allow newer versions of packages when building on GHC HEAD
+- CABALARGS=""
+- if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi
+
+# Download and unpack the stack executable
+- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH
+- mkdir -p ~/.local/bin
+- |
+  if [ `uname` = "Darwin" ]
+  then
+    travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin
+  else
+    travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+  fi
+
+  # Use the more reliable S3 mirror of Hackage
+  mkdir -p $HOME/.cabal
+  echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config
+  echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config
+
+  if [ "$CABALVER" != "1.16" ]
+  then
+    echo 'jobs: $ncpus' >> $HOME/.cabal/config
+  fi
+
+# Get the list of packages from the stack.yaml file
+- PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@')
+
+install:
+- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+- if [ -f configure.ac ]; then autoreconf -i; fi
+- |
+  set -ex
+  case "$BUILD" in
+    stack)
+      stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies
+      ;;
+    cabal)
+      cabal --version
+      travis_retry cabal update
+      cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES
+      ;;
+  esac
+  set +ex
+
+script:
+- |
+  set -ex
+  case "$BUILD" in
+    stack)
+      stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps
+      ;;
+    cabal)
+      cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES
+
+      ORIGDIR=$(pwd)
+      for dir in $PACKAGES
+      do
+        cd $dir
+        cabal check || [ "$CABALVER" == "1.16" ]
+        cabal sdist
+        SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \
+          (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
+        cd $ORIGDIR
+      done
+      ;;
+  esac
+  set +ex
+
+- stack --no-terminal --skip-ghc-check test

@@ -0,0 +1,31 @@+# neural - Neural Nets in native Haskell
+
+[![Build Status](https://travis-ci.org/brunjlar/neural.svg?branch=master)](https://travis-ci.org/brunjlar/neural)
+
+The goal of this project is to provide a flexible framework for 
+[neural networks](https://en.wikipedia.org/wiki/Artificial_neural_network) 
+(and similar parameterized models) in Haskell.
+
+There are already a couple of neural network libraries out there on Hackage, but as far as I can tell,
+they either
+
+- are wrappers for an engine written in another language or
+- offer a limitted choice of network architectures, training algorithms or error functions
+  or are not easily extensible.
+
+The goal of this library is to have an implementation in native Haskell (reasonably efficient)
+which offers maximal flexibility.
+
+Furthermore, [gradient descent/backpropagation](https://en.wikipedia.org/wiki/Backpropagation) should work automatically, using
+[automatic differentiation](https://hackage.haskell.org/package/ad-4.3.2/docs/Numeric-AD.html).
+This means that new and complicated activation functions and/or network architectures can be used without the need
+to first calculate derivatives by hand.
+
+In order to provide a powerful and flexible API, models are constructed using *components* which implement the
+[Arrow and ArrowChoice](https://hackage.haskell.org/package/base-4.9.0.0/docs/Control-Arrow.html) typeclasses. 
+They can therefore easily be combined and transformed, using a multitude of
+available combinators or [arrow notation](http://downloads.haskell.org/~ghc/8.0.1/docs/html/users_guide/glasgow_exts.html#arrow-notation).
+
+Even though neural networks are the primary motivation for this project, any other kind of model can be
+defined in the same framework, whenever the model depends on a collection of numerical parameters in a differentiable
+way. - One simple example for this would be [linear regression](https://en.wikipedia.org/wiki/Linear_regression).

@@ -1,12 +1,10 @@-import Test.DocTest
+module Main (main) where
 
+import System.FilePath.Glob (glob)
+import Test.DocTest (doctest)
+
 main :: IO ()
-main = doctest [ "src/Data/Utils/Analytic.hs"
-               , "src/Data/Utils/Matrix.hs"
-               , "src/Data/Utils/List.hs"
-               , "src/Data/Utils/Random.hs"
-               , "src/Data/Utils/Statistics.hs"
-               , "src/Data/Utils/Traversable.hs"
-               , "src/Data/Utils/Vector.hs"
-               , "src/Numeric/Neural/Normalization.hs"
-               ]
+main = do
+  glob "src/**/*.hs"           >>= doctest
+  glob "examples/iris/**/*.hs" >>= doctest
+  glob "examples/sqrt/**/*.hs" >>= doctest

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DataKinds #-}
 
+module Main where
+
 import           Control.Applicative
 import           Control.Arrow        hiding (loop)
 import           Data.Attoparsec.Text
@@ -12,20 +14,21 @@ main :: IO ()
 main = do
     xs <- readSamples
-    printf "read %d samples\n" (length xs)
+    printf "read %d samples\n\n" (length xs)
+    printf "generation  learning rate  model error  accuracy\n\n"
     (g, q) <- flip evalRandT (mkStdGen 123456) $ do
-        m <- modelR irisModel
+        m <- modelR (whiten irisModel $ fst <$> xs)
         runEffect $
                 simpleBatchP xs 5
-            >-> descentP m 1 (\i -> 0.02 * 5000 / (5000 + fromIntegral i))
+            >-> descentP m 1 (\i -> 0.1 * 5000 / (5000 + fromIntegral i))
             >-> reportTSP 1000 (report xs)
             >-> consumeTSP (check xs)
-    printf "reached prediction accuracy of %5.3f after %d generations\n" q g
+    printf "\nreached prediction accuracy of %5.3f after %d generations\n" q g
 
   where
 
     report xs ts = liftIO $ 
-        printf "%6d %6.4f %8.6f %6.4f\n" (tsGeneration ts) (tsEta ts) (modelError (tsModel ts) xs) (getQuota xs ts)
+        printf "%10d %14.4f %12.6f %9.4f\n" (tsGeneration ts) (tsEta ts) (modelError (tsModel ts) xs) (getQuota xs ts)
 
     check xs ts = return $
         let g = tsGeneration ts

@@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-}
 
+module Main where
+
 import Control.Arrow        hiding (loop)
 import Control.Monad.Random
 import Data.MyPrelude
@@ -8,6 +10,7 @@ 
 main :: IO ()
 main = do
+    putStrLn "generation  batch error  model error\n"
     m <- flip evalRandT (mkStdGen 691245) $ do
         m <- modelR sqrtModel
         runEffect $
@@ -15,12 +18,13 @@             >-> descentP m 1 (const 0.03) 
             >-> reportTSP 100 report
             >-> consumeTSP check
-    
+   
+    putStrLn "  x      sqrt x   predicted       error\n"
     forM_ [0 :: Double, 0.1 .. 4] $ \x -> do
         let y' = model m x
             y  = sqrt x
             e = abs (y - y')
-        printf "%3.1f %10.8f %10.8f %10.8f\n" x y y' e
+        printf "%3.1f  %10.8f  %10.8f  %10.8f\n" x y y' e
 
   where
 
@@ -35,7 +39,7 @@ 
     report ts = do
         let e = getErr ts
-        liftIO $ printf "%6d %10.8f %10.8f\n" (tsGeneration ts) (tsBatchError ts) e
+        liftIO $ printf "    %6d   %10.8f   %10.8f\n" (tsGeneration ts) (tsBatchError ts) e
 
     check ts = do
         let e = getErr ts

@@ -1,12 +1,14 @@ name: neural-version: 0.1.0.1+version: 0.1.1.0 cabal-version: >=1.10 build-type: Simple license: MIT license-file: LICENSE-copyright: Copyright: (c) 2016 Dr. Lars Bruenjes+copyright: Copyright: (c) 2016 Lars Bruenjes maintainer: brunjlar@gmail.com-homepage: http://github.com/brunjlar/neural+stability: provisional+homepage: https://github.com/brunjlar/neural+bug-reports: https://github.com/brunjlar/neural/issues synopsis: Neural Networks in native Haskell description:     The goal of `neural` is to provide a modular and flexible neural network library written in native Haskell.@@ -33,6 +35,13 @@     The library is still very much experimental at this point. category: Machine Learning author: Lars Bruenjes+tested-with: GHC ==7.10.3+extra-source-files:+    .travis.yml+    .gitignore+    .ghci+    stack.yaml+    README.markdown  source-repository head     type: git@@ -85,7 +94,7 @@     build-depends:         base >=4.7 && <5,         attoparsec >=0.13.0.1 && <0.14,-        neural >=0.1.0.1 && <0.2,+        neural >=0.1.1.0 && <0.2,         text >=1.2.2.1 && <1.3     default-language: Haskell2010     hs-source-dirs: examples/iris@@ -96,7 +105,7 @@     build-depends:         base >=4.7 && <5,         MonadRandom >=0.4.2.2 && <0.5,-        neural >=0.1.0.1 && <0.2+        neural >=0.1.1.0 && <0.2     default-language: Haskell2010     hs-source-dirs: examples/sqrt     ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fexcess-precision -optc-O3 -optc-ffast-math@@ -108,7 +117,7 @@         base >=4.7 && <5,         hspec >=2.2.2 && <2.3,         MonadRandom >=0.4.2.2 && <0.5,-        neural >=0.1.0.1 && <0.2+        neural >=0.1.1.0 && <0.2     default-language: Haskell2010     hs-source-dirs: test     other-modules:@@ -121,7 +130,7 @@     build-depends:         base >=4.7 && <5,         doctest >=0.10.1 && <0.11,-        neural >=0.1.0.1 && <0.2+        Glob >=0.7.5 && <0.8     default-language: Haskell2010     hs-source-dirs: doctest     ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fexcess-precision -optc-O3 -optc-ffast-math

@@ -22,6 +22,7 @@     , layer
     , tanhLayer
     , logisticLayer
+    , reLULayer
     , softmax
     ) where
 
@@ -30,11 +31,11 @@ import Data.Proxy
 import GHC.TypeLits
 import GHC.TypeLits.Witnesses
-import Data.MyPrelude
 import Numeric.Neural.Model
 import Prelude                 hiding (id, (.))
 import Data.Utils.Analytic
 import Data.Utils.Matrix
+import Data.Utils.Random
 import Data.Utils.Vector
 
 -- | A @'Layer' i o@ is a component that maps a vector of length @i@ to a vector of length @j@.
@@ -45,14 +46,25 @@ linearLayer' = ParamFun $ \xs ws -> ws <%%> cons 1 xs
 
 -- | Creates a /linear/ 'Layer', i.e. a layer that multiplies the input with a weight matrix and adds a bias to get the output.
---
+--   
+--   Random initialization follows the recommendation from chapter 3 of the online book 
+--   <http://neuralnetworksanddeeplearning.com/ Neural Networks and Deep Learning> by Michael Nielsen.
 linearLayer :: forall i o. (KnownNat i, KnownNat o) => Layer i o
-linearLayer = withNatOp (%+) (Proxy :: Proxy i) (Proxy :: Proxy 1) Component
+linearLayer = withNatOp (%+) p (Proxy :: Proxy 1) Component
     { weights = pure 0
     , compute = linearLayer'
-    , initR   = sequenceA $ pure $ getRandomR (-0.001, 0.001)
+    , initR   = sequenceA $ mgenerate r
     }
 
+  where
+
+    p = Proxy :: Proxy i
+
+    s = 1 / sqrt (fromIntegral $ natVal p)
+
+    r (_, 0) = boxMuller
+    r (_, _) = boxMuller' 0 s
+
 -- | Creates a 'Layer' as a combination of a linear layer and a non-linear activation function.
 --
 layer :: (KnownNat i, KnownNat o) => (Analytic -> Analytic) -> Layer i o
@@ -67,6 +79,12 @@ --
 logisticLayer :: (KnownNat i, KnownNat o) => Layer i o
 logisticLayer = layer $ \x -> 1 / (1 + exp (- x))
+
+-- | This is simply 'layer', specialized to the /rectified linear unit/ activation function. 
+--   Output values are all non-negative.
+--
+reLULayer :: (KnownNat i, KnownNat o) => Layer i o
+reLULayer = layer $ \x -> max 0 x
 
 -- | The 'softmax' function normalizes a vector, so that all entries are in [0,1] with sum 1. 
 --   This means the output entries can be interpreted as probabilities.

@@ -28,9 +28,10 @@ module Numeric.Neural.Model
     ( ParamFun(..)
     , Component(..)
-    , weightsLens
+    , _weights
     , activate
     , Model(..)
+    , _component
     , model
     , modelR
     , modelError
@@ -43,7 +44,7 @@ import Control.Category
 import Data.Profunctor
 import Data.MyPrelude
-import Prelude           hiding (id, (.))
+import Prelude                hiding (id, (.))
 import Data.Utils.Analytic
 import Data.Utils.Arrow
 import Data.Utils.Statistics  (mean)
@@ -83,7 +84,7 @@ 
 instance Profunctor (ParamFun t) where dimap  = dimapArr
 
--- | A @'Model' a b@ is a parameterized function from @a@ to @b@, combined with /some/ collection of analytic parameters,
+-- | A @'Component' a b@ is a parameterized function from @a@ to @b@, combined with /some/ collection of analytic parameters,
 --   In contrast to 'ParamFun', when components are composed, parameters are not shared. 
 --   Each component carries its own collection of parameters instead.
 --
@@ -97,9 +98,9 @@ --   The shape of the parameter collection is hidden by existential quantification,
 --   so this lens has to use simple generic lists.
 --
-weightsLens :: Lens' (Component a b) [Double]
-weightsLens = lens (\(Component ws _ _)    -> toList ws)
-                   (\(Component _  c i) ws -> let Just ws' = fromList ws in Component ws' c i)
+_weights:: Lens' (Component a b) [Double]
+_weights= lens (\(Component ws _ _)    -> toList ws)
+               (\(Component _  c i) ws -> let Just ws' = fromList ws in Component ws' c i)
 
 -- | Activates a component, i.e. applies it to the specified input, using the current parameter values.
 --
@@ -176,6 +177,12 @@ instance Profunctor (Model f g a) where
 
     dimap m n (Model c e i o) = Model c e (i . m) (n . o)
+
+-- | A 'Lens' for accessing the component embedded in a model.
+--
+_component :: Lens' (Model f g a b c) (Component (f Analytic) (g Analytic))
+_component = lens (\(Model c _ _ _) -> c)
+                  (\(Model _ e i o) c -> Model c e i o)
 
 -- | Computes the modelled function.
 model :: Model f g a b c -> b -> c

@@ -22,14 +22,20 @@     , encodeEquiDist
     , decodeEquiDist
     , crossEntropyError
+    , white
+    , whiten
     ) where
 
+import Control.Arrow
 import Data.Proxy
 import GHC.TypeLits
 import GHC.TypeLits.Witnesses
 import Data.MyPrelude
+import Data.Utils.Analytic
+import Data.Utils.Statistics
 import Data.Utils.Traversable
 import Data.Utils.Vector
+import Numeric.Neural.Model
 
 -- | Provides "1 of @n@" encoding for enumerable types.
 --
@@ -131,3 +137,33 @@ --
 crossEntropyError :: (Enum a, Floating b, KnownNat n) => a -> Vector n b -> b
 crossEntropyError a ys = negate $ log $ encode1ofN a <%> ys
+
+-- | Function 'white' takes a batch of values (of a specific shape)
+--   and computes a normalization function which whitens values of that shape,
+--   so that each component has zero mean and unit variance.
+--
+-- >>> :set -XDataKinds
+-- >>> let xss = [cons 1 (cons 1 nil), cons 1 (cons 2 nil), cons 1 (cons 3 nil)] :: [Vector 2 Float]
+-- >>> let f   = white xss
+-- >>> f <$> xss
+-- [[0.0,-1.224745],[0.0,0.0],[0.0,1.224745]]
+white :: (Applicative f, Traversable t, Eq a, Floating a) => t (f a) -> f a -> f a
+white xss = ((w <$> sequenceA xss) <*>) where
+
+    w xs = case toList xs of
+        []  -> id
+        xs' -> let (_, m, v) = countMeanVar xs'
+                   s         = if v == 0 then 1 else 1 / sqrt v
+               in  \x -> (x - m) * s
+
+-- | Modifies a 'Model' by whitening the input before feeding it into the embedded component.
+--
+whiten :: (Applicative f, Traversable t)
+          => Model f g a b c             -- ^ original model 
+          -> t b                         -- ^ batch of input data
+          -> Model f g a b c             
+whiten (Model c e i o) xss = Model c' e i o where
+
+    c' = white xss' ^>> c
+
+    xss' = (fmap fromDouble . i) <$> xss

@@ -0,0 +1,33 @@+# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
+
+# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
+resolver: lts-5.9
+
+# Local packages, usually specified by relative directory name
+packages:
+- '.'
+
+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
+extra-deps:
+    - natural-transformation-0.3.1
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: >= 1.0.0
+
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]