instinct (empty) → 0.1.0
raw patch · 8 files changed
+585/−0 lines, 8 filesdep +basedep +containersdep +mersenne-randomsetup-changed
Dependencies added: base, containers, mersenne-random, vector
Files
- AI/Instinct.hs +17/−0
- AI/Instinct/Activation.hs +40/−0
- AI/Instinct/Brain.hs +163/−0
- AI/Instinct/ConnMatrix.hs +177/−0
- AI/Instinct/Train/Delta.hs +101/−0
- LICENSE +32/−0
- Setup.lhs +12/−0
- instinct.cabal +43/−0
+ AI/Instinct.hs view
@@ -0,0 +1,17 @@+-- |+-- Module: AI.Instinct+-- Copyright: (c) 2011 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- Convenience module. Reexports the most important instinct modules.++module AI.Instinct+ ( -- * Reexports+ module AI.Instinct.Activation,+ module AI.Instinct.Brain+ )+ where++import AI.Instinct.Activation+import AI.Instinct.Brain
+ AI/Instinct/Activation.hs view
@@ -0,0 +1,40 @@+-- |+-- Module: AI.Instinct.Activation+-- Copyright: (c) 2011 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- Activation functions.++module AI.Instinct.Activation+ ( -- * Type+ Activation(..),+ actFunc,+ actDeriv+ )+ where+++-- | Activation functions.++data Activation+ = LogisticAct -- ^ Logistic activation.+ deriving (Read, Show)+++-- | Apply an activation function.++actFunc :: Activation -> Double -> Double+actFunc LogisticAct = logistic+++-- | Apply the derivative of an activation function.++actDeriv :: Activation -> Double -> Double+actDeriv LogisticAct x = let lx = logistic x in lx * (1 - lx)+++-- | This is the logistic activation function.++logistic :: Double -> Double+logistic x = 1 / (1 + exp (-x))
+ AI/Instinct/Brain.hs view
@@ -0,0 +1,163 @@+-- |+-- Module: AI.Instinct.Brain+-- Copyright: (c) 2011 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- This module provides artifical neural networks.++module AI.Instinct.Brain+ ( -- * Brains+ Brain(..),+ Pattern,++ -- * Initialization+ NetInit(..),+ buildNet,++ -- * High level+ runNet,+ runNetList,++ -- * Low level+ activation,+ netInput,+ netInputFrom,++ -- * Utility functions+ listPat,+ patError+ )+ where++import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import AI.Instinct.Activation+import AI.Instinct.ConnMatrix+import Text.Printf+++-- | A 'Brain' value is an aritifical neural network.++data Brain =+ Brain {+ brainAct :: Activation, -- ^ Activation function.+ brainConns :: ConnMatrix, -- ^ Connection matrix.+ brainInputs :: Int, -- ^ Number of input neurons.+ brainOutputs :: Int -- ^ Number of output neurons.+ }++instance Show Brain where+ show (Brain actF cm il ol) =+ printf "Neural network: %i input(s), %i output(s), %s\n%s\n"+ il ol (show actF) (replicate 72 '-') +++ show cm+++-- | Network builder configuration. See 'buildNet'.++data NetInit =+ -- | Recipe for a multi-layer perceptron. This is a neural network,+ -- which is made up of neuron layers, where adjacent layers are (in+ -- this case fully) connected.+ InitMLP {+ mlpActFunc :: Activation, -- ^ Network's activation function.+ mlpLayers :: [Int] -- ^ Layer sizes from input to output.+ }+ deriving (Read, Show)+++-- | A signal pattern.++type Pattern = U.Vector Double+++-- | Feeds the given input vector into the network and calculates the+-- activation vector.++activation :: Brain -> Pattern -> V.Vector Double+activation (Brain actF cm il _) inP = av+ where+ af = actFunc actF++ actOf :: Int -> Double+ actOf dk+ | dk < il = inP U.! dk+ | otherwise = af $ cmFold dk (\s sk w -> s + w * actOf sk) 0 cm++ av :: V.Vector Double+ av = V.generate (cmSize cm) actOf+++-- | Build a random neural network from the given description.++buildNet :: NetInit -> IO Brain+buildNet (InitMLP actF ls) = do+ let il = head ls+ ol = last ls++ cm <- buildLayered ls+ let b = Brain { brainAct = actF,+ brainConns = cm,+ brainInputs = il,+ brainOutputs = ol }++ return b+++-- | Construct a pattern vector from a list.++listPat :: [Double] -> Pattern+listPat = U.fromList+++-- | Calculate the net input vector, i.e. the values just before+-- applying the activation function.++netInput :: Brain -> Pattern -> V.Vector Double+netInput b@(Brain _ cm il _) inP = iv+ where+ av = activation b inP+ iv = V.generate (cmSize cm) inputOf++ inputOf :: Int -> Double+ inputOf dk+ | dk < il = inP U.! dk+ | otherwise = cmFold dk (\s sk w -> s + w * (av V.! sk)) 0 cm+++-- | Calculate the net input vector from the given activation vector.++netInputFrom :: Brain -> V.Vector Double -> Pattern -> V.Vector Double+netInputFrom (Brain _ cm il _) av inP = iv+ where+ iv = V.generate (cmSize cm) inputOf++ inputOf :: Int -> Double+ inputOf dk+ | dk < il = inP U.! dk+ | otherwise = cmFold dk (\s sk w -> s + w * (av V.! sk)) 0 cm+++-- | The total discrepancy between the two given patterns. Can be used+-- to calculate the total network error.++patError :: Pattern -> Pattern -> Double+patError p1 p2 = U.sum (U.zipWith (\x y -> let e = x - y in e*e) p1 p2)+++-- | Pass the given input pattern through the given neural network and+-- return its output.++runNet :: Brain -> Pattern -> Pattern+runNet b@(Brain _ cm _ ol) inP =+ V.convert .+ V.drop (cmSize cm - ol) $+ activation b inP+++-- | Convenience wrapper around 'runNet' using lists instead of vectors.+-- If you care for performance, use 'runNet'.++runNetList :: Brain -> [Double] -> [Double]+runNetList b = U.toList . runNet b . U.fromList
+ AI/Instinct/ConnMatrix.hs view
@@ -0,0 +1,177 @@+-- |+-- Module: AI.Instinct.ConnMatrix+-- Copyright: (c) 2011 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- This module provides an efficient connection matrix type.++module AI.Instinct.ConnMatrix+ ( -- * Connection matrix+ ConnMatrix,++ -- * Construction+ buildLayered,+ buildRandom,+ buildZero,++ -- * Accessing+ cmAdd,+ cmDests,+ cmFold,+ cmMap,+ cmSize,++ -- * Modification+ addLayer+ )+ where++import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import Control.Applicative+import Control.Arrow+import Data.List (foldl')+import Data.Monoid+import System.Random.Mersenne+import Text.Printf+++-- | A connection matrix is essentially a two-dimensional array of+-- synaptic weights.++newtype ConnMatrix =+ CM { getCM :: V.Vector ConnVector }++instance Monoid ConnMatrix where+ mempty = CM V.empty+ mappend = cmAdd++instance Show ConnMatrix where+ show (CM m) = " " ++ header ++ rows+ where+ header = concatMap (printf "%9i") $ take (V.length m) [0 :: Int ..]+ rows = V.foldl (++) [] . V.imap (\i -> printf "\n%4i: %s" i . show) $ m+++-- | A connection vector contains the incoming weights.++newtype ConnVector =+ CV { getCV :: U.Vector (Bool, Double) }++instance Show ConnVector where+ show =+ concatMap (\(b, w) -> if b then printf "%9.5f" w else " .") .+ U.toList .+ getCV+++-- | @addLayer s1 n1 s2 n2@ overwrite @n1@ nodes starting from @s1@ to+-- be fully connected with random weights to the @n2@ nodes starting+-- from @s2@.++addLayer :: Int -> Int -> Int -> Int -> ConnMatrix -> IO ConnMatrix+addLayer s1 n1 s2 n2 (CM m') = do+ mt <- getStdGen+ let (m1, m3) = second (V.drop n1) $ V.splitAt s1 m'++ m2 <-+ V.replicateM n1 $+ fmap (\ws -> CV $ U.replicate s2 (False, 0) U.++ ws)+ (U.replicateM n2 ((True, ) <$> random1 mt))++ return (CM $ m1 V.++ m2 V.++ m3)+++-- | Build a layered connection matrix, where adjacent layers are fully+-- connected.++buildLayered :: [Int] -> IO ConnMatrix+buildLayered ls = mkLayer ls 0 0 0 (buildZero size)+ where+ mkLayer :: [Int] -> Int -> Int -> Int -> ConnMatrix -> IO ConnMatrix+ mkLayer [] _ _ _ m' = return m'+ mkLayer (l:ls) s1 s2 n2 m' =+ addLayer s1 l s2 n2 m' >>= mkLayer ls (s1+l) s1 l++ size :: Int+ size = foldl' (+) 0 ls+++-- | Build a completely random connection matrix with the given edge+-- length. The random values will be between -1 and 1 exclusive.++buildRandom :: Int -> IO ConnMatrix+buildRandom size = do+ mt <- getStdGen+ CM <$> V.replicateM size (CV <$> U.replicateM size ((True, ) <$> random1 mt))+++-- | Build a zero connection matrix. It will represent a completely+-- disconnected network, where all nodes are isolated.++buildZero :: Int -> ConnMatrix+buildZero size = CM $ V.replicate size (CV U.empty)+++-- | Add two connection matrices. Note that this function is+-- left-biased in that it will adopt the connectivity of the first+-- connection matrix.+--+-- You may want to use the 'Monoid' instance instead of this function.++cmAdd :: ConnMatrix -> ConnMatrix -> ConnMatrix+cmAdd (CM cm1) (CM cm2) =+ CM $+ V.zipWith (\(CV cv1) (CV cv2) -> CV $ U.zipWith add cv1 cv2) cm1 cm2++ where+ add :: (Bool, Double) -> (Bool, Double) -> (Bool, Double)+ add x@(False, _) _ = x+ add x@(True, _) (False, _) = x+ add (True, x1) (True, x2) = (True, x1 + x2)+++-- | Strictly fold over the outputs, including zeroes.++cmDests :: forall b. Int -> (b -> Int -> Double -> b) -> b -> ConnMatrix -> b+cmDests sk f z (CM m) = V.ifoldl' acc z m+ where+ acc :: b -> Int -> ConnVector -> b+ acc s' dk (CV cv) =+ case cv U.!? sk of+ Nothing -> s'+ Just (False, _) -> s'+ Just (True, w) -> f s' dk w+++-- | Strictly fold over the nonzero inputs of a node.++cmFold :: Int -> (b -> Int -> Double -> b) -> b -> ConnMatrix -> b+cmFold dk f z (CM m) =+ U.ifoldl' (\s sk (b, w) -> if b && w == 0 then s else f s sk w) z .+ getCV $ m V.! dk+++-- | Map over the inputs of a node.++cmMap :: (Int -> Int -> Double -> Double) -> ConnMatrix -> ConnMatrix+cmMap f =+ CM .+ V.imap (\dk -> CV . U.imap (\sk x@(b, w) -> if b then (b, f sk dk w) else x) . getCV) .+ getCM+++-- | Edge length of a connection matrix.++cmSize :: ConnMatrix -> Int+cmSize (CM m) = V.length m+++-- | Returns a random number between -1 and 1 exclusive.++random1 :: MTGen -> IO Double+random1 mt = do+ b <- random mt+ x <- random mt+ return (if b then x else -x)
+ AI/Instinct/Train/Delta.hs view
@@ -0,0 +1,101 @@+-- |+-- Module: AI.Instinct.Train.Delta+-- Copyright: (c) 2011 Ertugrul Soeylemez+-- License: BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+--+-- Delta rule aka backpropagation algorithm.++module AI.Instinct.Train.Delta+ ( -- * Backpropagation training+ TrainPat,+ train,+ trainAtomic,+ trainPat,++ -- * Low level+ learnPat,++ -- * Utility functions+ totalError,+ tpList+ )+ where++import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import AI.Instinct.Activation+import AI.Instinct.Brain+import AI.Instinct.ConnMatrix+import Control.Arrow+import Data.List+++-- | A training pattern is a tuple of an input pattern and an expected+-- output pattern.++type TrainPat = (Pattern, Pattern)+++-- | Calculate the weight deltas and the total error for a single+-- pattern. The second argument specifies the learning rate.++learnPat :: Brain -> Double -> TrainPat -> ConnMatrix+learnPat b@(Brain actF cm _ ol) rate (inP, expP) =+ cmMap (\sk dk _ -> rate * (delta V.! dk) * (av V.! sk)) cm++ where+ av = activation b inP+ iv = netInputFrom b av inP+ outP = U.convert (V.drop outk av)+ outk = size - ol+ size = cmSize cm++ dact :: Double -> Double+ dact = actDeriv actF++ delta :: V.Vector Double+ delta = V.generate size f+ where+ f k | k >= outk = let ok = k - outk in del * ((expP U.! ok) - (outP U.! ok))+ | otherwise = del * cmDests k (\s' dk w -> s' + (delta V.! dk) * w) 0 cm+ where+ del = dact (iv V.! k)+++-- | Calculate the total error of a neural network with respect to the+-- given list of training patterns.++totalError :: Brain -> [TrainPat] -> Double+totalError b = foldl' (\e' (inP, expP) -> e' + patError (runNet b inP) expP) 0+++-- | Convenience function: Construct a training pattern from an input+-- and output vector.++tpList :: [Double] -> [Double] -> (Pattern, Pattern)+tpList = curry (U.fromList *** U.fromList)+++-- | Non-atomic version of 'trainAtomic'. Will adjust the weights for+-- each pattern instead of at the end of the epoch.++train :: Brain -> Double -> [TrainPat] -> Brain+train b' rate = foldl' (\b' -> trainPat b' rate) b'+++-- | Train a list of patterns with the specified learning rate. This+-- will adjust the weights at the end of the epoch. Returns an updated+-- neural network and the new total error.++trainAtomic :: Brain -> Double -> [TrainPat] -> Brain+trainAtomic b'@(Brain _ cm' _ _) rate ps =+ b' { brainConns = foldl' (\m' -> cmAdd m' . learnPat b' rate) cm' ps }+++-- | Train a single pattern. The second argument specifies the learning+-- rate.++trainPat :: Brain -> Double -> TrainPat -> Brain+trainPat b@(Brain _ cm _ _) rate inP =+ b { brainConns = cmAdd cm (learnPat b rate inP) }
+ LICENSE view
@@ -0,0 +1,32 @@+instinct license+Copyright (c) 2011, Ertugrul Soeylemez++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in+ the documentation and/or other materials provided with the+ distribution.++ * Neither the name of the author nor the names of any contributors+ may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,12 @@+instinct setup script+Copyright (C) 2011, Ertugrul Soeylemez++Please see the LICENSE file for terms and conditions of use,+modification and distribution of this package, including this file.++> module Main where+>+> import Distribution.Simple+>+> main :: IO ()+> main = defaultMain
+ instinct.cabal view
@@ -0,0 +1,43 @@+Name: instinct+Version: 0.1.0+Category: AI+Synopsis: Fast artifical neural networks+Maintainer: Ertugrul Söylemez <es@ertes.de>+Author: Ertugrul Söylemez <es@ertes.de>+Copyright: (c) 2011 Ertugrul Söylemez+License: BSD3+License-file: LICENSE+Build-type: Simple+Stability: experimental+Cabal-version: >= 1.8+Description:+ Instinct is a library for fast artifical neural networks.++Library+ Build-depends:+ base >= 4 && <= 5,+ containers >= 0.4.0,+ mersenne-random >= 1.0.0,+ vector >= 0.7.1+ Extensions:+ ScopedTypeVariables+ TupleSections+ GHC-Options: -W+ Exposed-modules:+ AI.Instinct+ AI.Instinct.Activation+ AI.Instinct.Brain+ AI.Instinct.ConnMatrix+ AI.Instinct.Train.Delta+ -- AI.Instinct.Train.Genetic++-- Executable instinct-test+-- Build-depends:+-- base >= 4 && <= 5,+-- gloss,+-- instinct,+-- vector,+-- vector-algorithms+-- Hs-source-dirs: test+-- Main-is: Main.hs+-- GHC-Options: -W -threaded -rtsopts