**diff options**

author | AlpMestanogullari <> | 2016-03-25 23:41:00 (GMT) |
---|---|---|

committer | hdiff <hdiff@hdiff.luite.com> | 2016-03-25 23:41:00 (GMT) |

commit | 0c3fb1616434dfa895c1a727cffaa3139a5ae96c (patch) | |

tree | c555b191e3e9047080a8b9e4bad06ece55f6308a | |

parent | 91748f5ff3437e996e831bf0c2d0f5030a2a6eb0 (diff) |

-rw-r--r-- | AI/HNN/FF/Network.hs | 47 | ||||

-rw-r--r-- | AI/HNN/Recurrent/Network.hs | 121 | ||||

-rw-r--r-- | hnn.cabal | 12 |

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 @@ -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, |