summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlpMestanogullari <>2016-03-25 23:41:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-03-25 23:41:00 (GMT)
commit0c3fb1616434dfa895c1a727cffaa3139a5ae96c (patch)
treec555b191e3e9047080a8b9e4bad06ece55f6308a
parent91748f5ff3437e996e831bf0c2d0f5030a2a6eb0 (diff)
version 0.3HEAD0.3master
-rw-r--r--AI/HNN/FF/Network.hs47
-rw-r--r--AI/HNN/Recurrent/Network.hs121
-rw-r--r--hnn.cabal12
3 files changed, 28 insertions, 152 deletions
diff --git a/AI/HNN/FF/Network.hs b/AI/HNN/FF/Network.hs
index a0dc45b..b1334c8 100644
--- a/AI/HNN/FF/Network.hs
+++ b/AI/HNN/FF/Network.hs
@@ -2,8 +2,7 @@
ScopedTypeVariables,
RecordWildCards,
FlexibleContexts,
- TypeFamilies,
- GeneralizedNewtypeDeriving #-}
+ TypeFamilies #-}
-- |
-- Module : AI.HNN.FF.Network
@@ -81,9 +80,9 @@
--
-- So, this tiny piece of code will run the backpropagation algorithm on the samples 1000 times, with a learning rate
-- of 0.8. The learning rate is basically how strongly we should modify the weights when we try to correct the error the net makes
--- on our samples. The bigger it is, the more the weights are going to change significantly. Depending on the cases, it is good,
--- but sometimes it can also make the backprop algorithm oscillate around good weight values without actually getting to them.
--- You usually want to test several values and see which ones gets you the nicest neural net, which generalizes well to samples
+-- on our samples. The bigger it is, the more the weights are going to change significantly. Depending on the case, it can be good,
+-- but sometimes it can make the backprop algorithm oscillate around good weight values without actually getting to them.
+-- You usually want to test several values and see which ones get you the nicest neural net, which generalizes well to samples
-- that are not in the training set while giving decent results on the training set.
--
-- Now, let's see how that worked out for us:
@@ -162,7 +161,7 @@ import qualified Data.ByteString.Lazy as B
import qualified Data.Vector as V
import System.Random.MWC
-import Numeric.LinearAlgebra
+import Numeric.LinearAlgebra.HMatrix hiding (corr)
-- | Our feed-forward neural network type. Note the 'Binary' instance, which means you can use
-- 'encode' and 'decode' in case you need to serialize your neural nets somewhere else than
@@ -215,26 +214,26 @@ fromWeightMatrices ws = Network ws
-- implementation and in my experiments those networks are able to easily solve non linearly separable problems."
-- | Computes the output of the network on the given input vector with the given activation function
-output :: (Floating (Vector a), Product a, Storable a, Num (Vector a)) => Network a -> ActivationFunction a -> Vector a -> Vector a
-output (Network{..}) act input = V.foldl' f (join [input, 1]) matrices
- where f !inp m = mapVector act $ m <> inp
+output :: (Floating (Vector a), Numeric a, Storable a, Num (Vector a)) => Network a -> ActivationFunction a -> Vector a -> Vector a
+output (Network{..}) act input = V.foldl' f (vjoin [input, 1]) matrices
+ where f !inp m = cmap act $ m #> inp
{-# INLINE output #-}
-- | Computes and keeps the output of all the layers of the neural network with the given activation function
-outputs :: (Floating (Vector a), Product a, Storable a, Num (Vector a)) => Network a -> ActivationFunction a -> Vector a -> V.Vector (Vector a)
-outputs (Network{..}) act input = V.scanl f (join [input, 1]) matrices
- where f !inp m = mapVector act $ m <> inp
+outputs :: (Floating (Vector a), Numeric a, Storable a, Num (Vector a)) => Network a -> ActivationFunction a -> Vector a -> V.Vector (Vector a)
+outputs (Network{..}) act input = V.scanl f (vjoin [input, 1]) matrices
+ where f !inp m = cmap act $ m #> inp
{-# INLINE outputs #-}
-deltas :: (Floating (Vector a), Floating a, Product a, Storable a, Num (Vector a)) => Network a -> ActivationFunctionDerivative a -> V.Vector (Vector a) -> Vector a -> V.Vector (Matrix a)
+deltas :: (Floating (Vector a), Floating a, Numeric a, Container Vector a, Num (Vector a)) => Network a -> ActivationFunctionDerivative a -> V.Vector (Vector a) -> Vector a -> V.Vector (Matrix a)
deltas (Network{..}) act' os expected = V.zipWith outer (V.tail ds) (V.init os)
where !dl = (V.last os - expected) * (deriv $ V.last os)
!ds = V.scanr f dl (V.zip os matrices)
- f (!o, m) !del = deriv o * (trans m <> del)
- deriv = mapVector act'
+ f (!o, m) !del = deriv o * (tr m #> del)
+ deriv = cmap act'
{-# INLINE deltas #-}
-updateNetwork :: (Floating (Vector a), Floating a, Product a, Storable a, Num (Vector a), Container Vector a) => a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Sample a -> Network a
+updateNetwork :: (Floating (Vector a), Floating a, Numeric a, Storable a, Num (Vector a), Container Vector a) => a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Sample a -> Network a
updateNetwork alpha act act' n@(Network{..}) (input, expectedOutput) = Network $ V.zipWith (+) matrices corr
where !xs = outputs n act input
!ds = deltas n act' xs expectedOutput
@@ -270,7 +269,7 @@ type Samples a = [Sample a]
(-->) :: Vector a -> Vector a -> Sample a
(-->) = (,)
-backpropOnce :: (Floating (Vector a), Floating a, Product a, Num (Vector a), Container Vector a) => a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
+backpropOnce :: (Floating (Vector a), Floating a, Numeric a, Num (Vector a), Container Vector a) => a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
backpropOnce rate act act' n samples = foldl' (updateNetwork rate act act') n samples
{-# INLINE backpropOnce #-}
@@ -293,7 +292,7 @@ backpropOnce rate act act' n samples = foldl' (updateNetwork rate act act') n sa
-- The second argument (after the predicate) is the learning rate. Then come the activation function you want,
-- its derivative, the initial neural network, and your training set.
-- Note that we provide 'trainNTimes' and 'trainUntilErrorBelow' for common use cases.
-trainUntil :: (Floating (Vector a), Floating a, Product a, Num (Vector a), Container Vector a) => (Int -> Network a -> Samples a -> Bool) -> a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
+trainUntil :: (Floating (Vector a), Floating a, Numeric a, Num (Vector a), Container Vector a) => (Int -> Network a -> Samples a -> Bool) -> a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
trainUntil pr learningRate act act' net samples = go net 0
where go n !k | pr k n samples = n
| otherwise = case backpropOnce learningRate act act' n samples of
@@ -302,22 +301,22 @@ trainUntil pr learningRate act act' net samples = go net 0
-- | Trains the neural network with backpropagation the number of times specified by the 'Int' argument,
-- using the given learning rate (second argument).
-trainNTimes :: (Floating (Vector a), Floating a, Product a, Num (Vector a), Container Vector a) => Int -> a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
+trainNTimes :: (Floating (Vector a), Floating a, Numeric a, Num (Vector a), Container Vector a) => Int -> a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
trainNTimes n = trainUntil (\k _ _ -> k > n)
{-# INLINE trainNTimes #-}
-- | Quadratic error on the given training set using the given activation function. Useful to create
-- your own predicates for 'trainUntil'.
-quadError :: (Floating (Vector a), Floating a, Num (Vector a), Num (RealOf a), Product a) => ActivationFunction a -> Network a -> Samples a -> RealOf a
-quadError act net samples = foldl' (\err (inp, out) -> err + (norm2 $ output net act inp - out)) 0 samples
+quadError :: (Floating (Vector a), Floating a, Fractional (RealOf a), Normed (Vector a), Numeric a) => ActivationFunction a -> Network a -> Samples a -> RealOf a
+quadError act net samples = realToFrac $ foldl' (\err (inp, out) -> err + (norm_2 $ output net act inp - out)) 0 samples
{-# INLINE quadError #-}
-- | Trains the neural network until the quadratic error ('quadError') comes below the given value (first argument),
-- using the given learning rate (second argument).
--
--- /Note/: this can loop pretty much forever when you're using a bad architecture for the problem, or unappropriate activation
+-- /Note/: this can loop pretty much forever when you're using a bad architecture for the problem, or inappropriate activation
-- functions.
-trainUntilErrorBelow :: (Floating (Vector a), Floating a, Product a, Num (Vector a), Ord a, Container Vector a, Num (RealOf a), a ~ RealOf a, Show a) => a -> a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
+trainUntilErrorBelow :: (Floating (Vector a), Floating a, Numeric a, Normed (Vector a), Ord a, Container Vector a, Num (RealOf a), a ~ RealOf a, Show a) => a -> a -> ActivationFunction a -> ActivationFunctionDerivative a -> Network a -> Samples a -> Network a
trainUntilErrorBelow x rate act = trainUntil (\_ n s -> quadError act n s < x) rate act
{-# INLINE trainUntilErrorBelow #-}
@@ -347,4 +346,4 @@ loadNetwork fp = return . decode . decompress =<< B.readFile fp
-- | Saving a neural network to a file (uses zlib compression on top of serialization using the binary package).
saveNetwork :: (Storable a, Element a, Binary a) => FilePath -> Network a -> IO ()
saveNetwork fp net = B.writeFile fp . compress $ encode net
-{-# INLINE saveNetwork #-} \ No newline at end of file
+{-# INLINE saveNetwork #-}
diff --git a/AI/HNN/Recurrent/Network.hs b/AI/HNN/Recurrent/Network.hs
deleted file mode 100644
index 9cff5b8..0000000
--- a/AI/HNN/Recurrent/Network.hs
+++ /dev/null
@@ -1,121 +0,0 @@
-{-# LANGUAGE BangPatterns, ScopedTypeVariables, RecordWildCards #-}
-
--- |
--- Module : AI.HNN.Recurrent.Network
--- Copyright : (c) 2012 Gatlin Johnson
--- License : LGPL
--- Maintainer : rokenrol@gmail.com
--- Stability : experimental
--- Portability : GHC
---
--- An implementation of recurrent neural networks in pure Haskell.
---
--- A network is an adjacency matrix of connection weights, the number of
--- neurons, the number of inputs, and the threshold values for each neuron.
---
--- E.g.,
---
--- > module Main where
--- >
--- > import AI.HNN.Recurrent.Network
--- >
--- > main = do
--- > let numNeurons = 3
--- > numInputs = 1
--- > thresholds = replicate numNeurons 0.5
--- > inputs = [[0.38], [0.75]]
--- > adj = [ 0.0, 0.0, 0.0,
--- > 0.9, 0.8, 0.0,
--- > 0.0, 0.1, 0.0 ]
--- > n <- createNetwork numNeurons numInputs adj thresholds :: IO (Network Double)
--- > output <- evalNet n inputs sigmoid
--- > putStrLn $ "Output: " ++ (show output)
---
--- This creates a network with three neurons (one of which is an input), an
--- arbitrary connection / weight matrix, and arbitrary thresholds for each neuron.
--- Then, we evaluate the network with an arbitrary input.
---
--- For the purposes of this library, the outputs returned are the values of all
--- the neurons except the inputs. Conceptually, in a recurrent net *any*
--- non-input neuron can be treated as an output, so we let you decide which
--- ones matter.
-
-module AI.HNN.Recurrent.Network (
-
- -- * Network type
- Network, createNetwork,
- weights, size, nInputs, thresh,
-
- -- * Evaluation functions
- computeStep, evalNet,
-
- -- * Misc
- sigmoid
-
-) where
-
-import System.Random.MWC
-import Control.Monad
-import Numeric.LinearAlgebra
-import Foreign.Storable as F
-
--- | Our recurrent neural network
-data Network a = Network
- { weights :: !(Matrix a)
- , size :: {-# UNPACK #-} !Int
- , nInputs :: {-# UNPACK #-} !Int
- , thresh :: !(Vector a)
- } deriving Show
-
--- | Creates a network with an adjacency matrix of your choosing, specified as
--- an unboxed vector. You also must supply a vector of threshold values.
-createNetwork :: (Variate a, Fractional a, Storable a) =>
- Int -> -- ^ number of total neurons neurons (input and otherwise)
- Int -> -- ^ number of inputs
- [a] -> -- ^ flat weight matrix
- [a] -> -- ^ threshold (bias) values for each neuron
- IO (Network a) -- ^ a new network
-
-createNetwork n m matrix thresh = return $!
- Network ( (n><n) matrix ) n m (n |> thresh)
-
--- | Evaluates a network with the specified function and list of inputs
--- precisely one time step. This is used by `evalNet` which is probably a
--- more convenient interface for client applications.
-computeStep :: (Variate a, Num a, F.Storable a, Product a) =>
- Network a -> -- ^ Network to evaluate input
- Vector a -> -- ^ vector of pre-existing state
- (a -> a) -> -- ^ activation function
- Vector a -> -- ^ list of inputs
- Vector a -- ^ new state vector
-
-computeStep (Network{..}) state activation input =
- mapVector activation $! zipVectorWith (-) (weights <> prefixed) thresh
- where
- prefixed = Numeric.LinearAlgebra.join
- [ input, (subVector nInputs (size-nInputs) state) ]
- {-# INLINE prefixed #-}
-
--- | Iterates over a list of input vectors in sequence and computes one time
--- step for each.
-evalNet :: (Num a, Variate a, Fractional a, Product a) =>
- Network a -> -- ^ Network to evaluate inputs
- [[a]] -> -- ^ list of input lists
- (a -> a) -> -- ^ activation function
- IO (Vector a) -- ^ output state vector
-
-evalNet n@(Network{..}) inputs activation = do
- s <- foldM (\x -> computeStepM n x activation) state inputsV
- return $! subVector nInputs (size-nInputs) s
- where
- state = fromList $ replicate size 0.0
- {-# INLINE state #-}
- computeStepM n s a i = return $ computeStep n s a i
- {-# INLINE computeStepM #-}
- inputsV = map (fromList) inputs
- {-# INLINE inputsV #-}
-
--- | It's a simple, differentiable sigmoid function.
-sigmoid :: Floating a => a -> a
-sigmoid !x = 1 / (1 + exp (-x))
-{-# INLINE sigmoid #-} \ No newline at end of file
diff --git a/hnn.cabal b/hnn.cabal
index 672f18b..eb2d45c 100644
--- a/hnn.cabal
+++ b/hnn.cabal
@@ -1,5 +1,5 @@
name: hnn
-version: 0.2.0.0
+version: 0.3
synopsis: A reasonably fast and simple neural network library
description:
.
@@ -7,24 +7,22 @@ description:
hmatrix library.
.
This library provides a straight and simple feed-forward neural networks implementation which
- is way better than the one in hnn-0.1, in all aspects. It also provides a simple and little tested
- implementation of recurrent neural networks.
+ is way better than the one in hnn-0.1, in all aspects.
.
- If you're interested in the feed-forward neural networks, please read the mini-tutorial on
- @AI.HNN.FF.Network@.
+ You can find a mini-tutorial in @AI.HNN.FF.Network@.
homepage: http://github.com/alpmestan/hnn
bug-reports: http://github.com/alpmestan/hnn/issues
license: BSD3
license-file: LICENSE
author: Alp Mestanogullari <alpmestan@gmail.com>, Gatlin Johnson <rokenrol@gmail.com>
maintainer: Alp Mestanogullari <alpmestan@gmail.com>
-copyright: 2009-2014 Alp Mestanogullari, Gatlin Johnson
+copyright: 2009-2016 Alp Mestanogullari, Gatlin Johnson
category: AI
build-type: Simple
cabal-version: >=1.8
library
- exposed-modules: AI.HNN.FF.Network, AI.HNN.Recurrent.Network
+ exposed-modules: AI.HNN.FF.Network
build-depends:
base >=4 && <5,
vector,