nn (empty) → 0.2.0

raw patch · 6 files changed

+446/−0 lines, 6 filesdep +basedep +nndep +randomsetup-changed

Dependencies added: base, nn, random, split, tasty, tasty-hspec, tasty-quickcheck

Files

LICENSE +21/−0
README.md +62/−0
Setup.hs +2/−0
nn.cabal +57/−0
src/AI/Nn.hs +234/−0
test/Spec.hs +70/−0

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Sascha Grunert++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.

+ README.md view

@@ -0,0 +1,62 @@+# ηn+## A tiny neural network 🧠++This small neural network is based on the+[backpropagation](https://en.wikipedia.org/wiki/Backpropagation) algorithm.++## Usage++A minimal usage example would look like this:++```haskell+import AI.Nn (new+             ,predict+             ,train)++main :: IO ()+main = do+  {- Creates a new network with two inputs,+     two hidden layers and one output -}+  network <- new [2, 2, 1]++  {- Train the network for a common logical AND,+     until the maximum error of 0.01 is reached -}+  let trainedNetwork = train 0.01 network [([0, 0], [0])+                                          ,([0, 1], [0])+                                          ,([1, 0], [0])+                                          ,([1, 1], [1])]++  {- Predict the learned values -}+  let r00 = predict trainedNetwork [0, 0]+  let r01 = predict trainedNetwork [0, 1]+  let r10 = predict trainedNetwork [1, 0]+  let r11 = predict trainedNetwork [1, 1]++  {- Print the results -}+  putStrLn $ printf "0 0 -> %.2f" (head r00)+  putStrLn $ printf "0 1 -> %.2f" (head r01)+  putStrLn $ printf "1 0 -> %.2f" (head r10)+  putStrLn $ printf "1 1 -> %.2f" (head r11)+```++The result should be something like:++```console+0 0 -> -0.02+0 1 -> -0.02+1 0 -> -0.01+1 1 -> 1.00+```++## Hacking+To start hacking simply clone this repository and make sure that+[stack](https://docs.haskellstack.org/en/stable/README/) is installed. Then+simply hack around and build the project with:++```console+> stack build --file-watch+```++## Contributing+You want to contribute to this project? Wow, thanks! So please just fork it and+send me a pull request.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ nn.cabal view

@@ -0,0 +1,57 @@+-- This file has been generated from package.yaml by hpack version 0.27.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 51c1408159910b3ceba84d3d8adc4b8f1e0e45c55f43cdb4d20bdd03fc8cfd76++name:           nn+version:        0.2.0+synopsis:       A tiny neural network+description:    Please see the README on Github at <https://github.com/saschagrunert/nn#readme>+category:       AI+homepage:       https://github.com/saschagrunert/nn#readme+bug-reports:    https://github.com/saschagrunert/nn/issues+author:         Sascha Grunert+maintainer:     mail@saschagrunert.de+copyright:      2018 Sascha Grunert+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/saschagrunert/nn++library+  exposed-modules:+      AI.Nn+  other-modules:+      Paths_nn+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat+  build-depends:+      base >=4.7 && <5+    , random+    , split+  default-language: Haskell2010++test-suite nn-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_nn+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , nn+    , tasty+    , tasty-hspec+    , tasty-quickcheck+  default-language: Haskell2010

+ src/AI/Nn.hs view

@@ -0,0 +1,234 @@+-- | This module contains everything related to the main library interface+--+-- @since 0.1.0++module AI.Nn+  ( Network+  , predict+  , new+  , train+  ) where++import Data.List       (find+                       ,transpose)+import Data.List.Split (chunksOf)+import Data.Maybe      (fromJust)+import System.Random   (StdGen+                       ,getStdGen+                       ,randomRs)++-- | The network+--+-- @since 0.1.0+type Network = Network' ()++-- | The alias for a list of layers+--+-- @since 0.1.0+type Network' a = [Layer a]++-- | The network layer+--+-- @since 0.1.0+type Layer a = [(Neuron,a)]++-- | A network neuron+--+-- @since 0.1.0+data Neuron = Neuron { inputWeights :: [Double]      -- ^ The input weights+                     , activate :: Double -> Double  -- ^ The activation function+                     , activate' :: Double -> Double -- ^ The first derivation of the activation function+                     }++-- | The forward layer type+--+-- @since 0.1.0+data Forward = Forward { output :: Double+                       , sumInputWeight :: Double+                       , inputs :: [Double]+                       } deriving Show++-- | The alias for a list of input weights+--+-- @since 0.1.0+type Neuron' = [Double]++-- | The sigmoid activation function+--+-- @since 0.1.0+sigmoid :: Double -> Double+sigmoid x = 1.0 / (1 + exp (-x))++-- | The first derivation of the sigmoid function+--+-- @since 0.1.0+sigmoid' :: Double -> Double+sigmoid' x = sigmoid x * (1 - sigmoid x)++-- | Create a sigmoid neuron from given input weights+--+-- @since 0.1.0+sigmoidNeuron :: Neuron' -> Neuron+sigmoidNeuron ws = Neuron ws sigmoid sigmoid'++-- | Create a output neuron from given weights+--+-- @since 0.1.0+outputNeuron :: Neuron' -> Neuron+outputNeuron ws = Neuron ws id (const 1)++-- | Create a bias neuron from given number of inputs+--+-- @since 0.1.0+biasNeuron :: Int -> Neuron+biasNeuron i = Neuron (replicate i 1) (const 1) (const 0)++-- | Create a new Layer from a list of Neuron'+--+-- @since 0.1.0+createLayer :: Functor f => f t -> (t -> a) -> f (a, ())+createLayer n x = (\p -> (x p, ())) <$> n++-- | Create a new sigmoid Layer from a list of Neuron'+--+-- @since 0.1.0+sigmoidLayer :: [Neuron'] -> Layer ()+sigmoidLayer n = (biasNeuron x, ()) : createLayer n sigmoidNeuron+  where x = length $ head n++-- | Create a new standard network for a number of layer and neurons+--+-- @since 0.1.0+new :: [Int] -> IO Network+new n = newGen n <$> getStdGen++-- | Create a new output Layer from a list of Neuron'+--+-- @since 0.1.0+outputLayer :: [Neuron'] -> Layer ()+outputLayer n = createLayer n outputNeuron++-- | Create a new network for a StdGen and a number of layer and neurons+--+-- @since 0.1.0+newGen :: [Int] -> StdGen -> Network+newGen n g = (sigmoidLayer <$> init wss) ++ [outputLayer (last wss)]+ where+  rest                 = init n+  hiddenIcsNcs         = zip ((+ 1) <$> rest) (tail rest)+  (outputIc, outputNc) = (snd (last hiddenIcsNcs) + 1, last n)+  rs                   = randomRs (-1, 1) g+  (hidden, rs')        = foldl+    ( \(wss', rr') (ic, nc) ->+      let (sl, rs'') = pack ic nc rr' in (wss' ++ [sl], rs'')+    )+    ([], rs)+    hiddenIcsNcs+  (outputWss, _) = pack outputIc outputNc rs'+  wss            = hidden ++ [outputWss]+  pack ic nc ws = (take nc $ chunksOf ic ws, drop (ic * nc) ws)++-- | Do the complete back propagation+--+-- @since 0.1.0+backpropagate :: Network -> ([Double], [Double]) -> Network+backpropagate nw (xs, ys) = weightUpdate (forwardLayer nw xs) ys++-- | The learning rate+--+-- @since 0.1.0+rate :: Double+rate = 0.5++-- | Generate forward pass info+--+-- @since 0.1.0+forwardLayer :: Network -> [Double] -> Network' Forward+forwardLayer nw xs = reverse . fst $ foldl pf ([], 1 : xs) nw+ where+  pf (nw', xs') l = (l' : nw', xs'')+   where+    l'   = (\(n, _) -> (n, forwardNeuron n xs')) <$> l+    xs'' = (output . snd) <$> l'++-- | Generate forward pass info for a neuron+--+-- @since 0.1.0+forwardNeuron :: Neuron -> [Double] -> Forward+forwardNeuron n xs = Forward+  { output         = activate n net'+  , sumInputWeight = net'+  , inputs         = xs+  }+  where net' = calcNet xs (inputWeights n)++-- | Calculate the product sum+--+-- @since 0.1.0+calcNet :: [Double] -> [Double] -> Double+calcNet xs ws = sum $ zipWith (*) xs ws++-- | Updates the weights for an entire network+--+-- @since 0.1.0+weightUpdate+  :: Network' Forward+  -> [Double] -- ^ desired output value+  -> Network+weightUpdate fpnw ys = fst $ foldr updateLayer ([], ds) fpnw+  where ds = zipWith (-) ys ((output . snd) <$> last fpnw)++-- | Updates the weights for a layer+--+-- @since 0.1.0+updateLayer :: Layer Forward -> (Network, [Double]) -> (Network, [Double])+updateLayer fpl (nw, ds) = (l' : nw, ds')+ where+  (l, es) = unzip $ zipWith updateNeuron fpl ds+  ds' =+    map sum . transpose $ map (\(n, e) -> (* e) <$> inputWeights n) (zip l es)+  l' = (\n -> (n, ())) <$> l++-- | Updates the weights for a neuron+--+-- @since 0.1.0+updateNeuron :: (Neuron, Forward) -> Double -> (Neuron, Double)+updateNeuron (n, fpi) d = (n { inputWeights = ws' }, e)+ where+  e   = activate' n (sumInputWeight fpi) * d+  ws' = zipWith (\x w -> w + (rate * e * x)) (inputs fpi) (inputWeights n)++-- | Trains a network with a set of vector pairs until the global error is+-- smaller than epsilon+--+-- @since 0.1.0+train :: Double -> Network -> [([Double], [Double])] -> Network+train epsilon nw samples = fromJust+  $ find (\x -> globalQuadError x samples < epsilon) (trainUl nw samples)++-- | Create an indefinite sequence of networks+--+-- @since 0.1.0+trainUl :: Network -> [([Double], [Double])] -> [Network]+trainUl nw samples = iterate (\x -> foldl backpropagate x samples) nw++-- | Quadratic error for multiple pairs+--+-- @since 0.1.0+globalQuadError :: Network -> [([Double], [Double])] -> Double+globalQuadError nw samples = sum $ quadErrorNet nw <$> samples++-- | Quadratic error for a single vector pair+--+-- @since 0.1.0+quadErrorNet :: Network -> ([Double], [Double]) -> Double+quadErrorNet nw (xs, ys) =+  sum $ zipWith (\o y -> (y - o) ** 2) (predict nw xs) ys++-- | Calculates the output of a network for a given input vector+--+-- @since 0.1.0+predict :: Network -> [Double] -> [Double]+predict nw xs = foldl calculateLayer (1 : xs) nw+ where+  calculateLayer s = map (\(n, _) -> activate n (calcNet s (inputWeights n)))

+ test/Spec.hs view

@@ -0,0 +1,70 @@+-- | The main test module+--+-- @since 0.1.0++module Main+  ( main+  ) where++import AI.Nn                 (new+                             ,predict+                             ,train)+import Test.Tasty            (TestTree+                             ,defaultMain+                             ,localOption+                             ,testGroup)+import Test.Tasty.Hspec      (Spec+                             ,it+                             ,parallel+                             ,shouldBe+                             ,testSpec)+import Test.Tasty.QuickCheck (QuickCheckTests (QuickCheckTests))++-- The main test routine+main :: IO ()+main = do+  uTests <- unitTests+  defaultMain . opts $ testGroup "Tests" [uTests]+  where opts = localOption $ QuickCheckTests 5000++-- Unit tests based on hspec+unitTests :: IO TestTree+unitTests = do+  actionUnitTests <- testSpec "Nn" nnSpec+  return $ testGroup "Unit Tests" [actionUnitTests]++-- Nn.hs related tests+nnSpec :: Spec+nnSpec = parallel $ do+  it "should succeed to train logical AND" $ do+    n <- new [2, 2, 1]+    let+      nw = train 0.001+                 n+                 [([0, 0], [0]), ([0, 1], [0]), ([1, 0], [0]), ([1, 1], [1])]+    round (head $ predict nw [1, 1]) `shouldBe` (1 :: Int)+    round (head $ predict nw [1, 0]) `shouldBe` (0 :: Int)+    round (head $ predict nw [0, 1]) `shouldBe` (0 :: Int)+    round (head $ predict nw [0, 0]) `shouldBe` (0 :: Int)++  it "should succeed to train logical OR" $ do+    n <- new [2, 2, 1]+    let+      nw = train 0.001+                 n+                 [([0, 0], [0]), ([0, 1], [1]), ([1, 0], [1]), ([1, 1], [1])]+    round (head $ predict nw [1, 1]) `shouldBe` (1 :: Int)+    round (head $ predict nw [1, 0]) `shouldBe` (1 :: Int)+    round (head $ predict nw [0, 1]) `shouldBe` (1 :: Int)+    round (head $ predict nw [0, 0]) `shouldBe` (0 :: Int)++  it "should succeed to train addition" $ do+    n <- new [2, 2, 1]+    let+      nw = train 0.001+                 n+                 [([0, 1], [1]), ([1, 1], [2]), ([1, 0], [1]), ([1, 2], [3])]+    round (head $ predict nw [0, 1]) `shouldBe` (1 :: Int)+    round (head $ predict nw [1, 0]) `shouldBe` (1 :: Int)+    round (head $ predict nw [1, 1]) `shouldBe` (2 :: Int)+    round (head $ predict nw [1, 2]) `shouldBe` (3 :: Int)