NeuralNetwork.hs 12.4 KB
Newer Older
Andor Kyrill Willared's avatar
Andor Kyrill Willared committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
{-|
Module      : NeuralNetwork
Description : A haskell implementation of a neural network
License     : MIT
Maintainer  : andor.willared@mni.thm.de
Stability   : experimental

A naive neural-network implementation in haskell. 

Use 'initNN' to get an initialised neural network and train it using the 'train' function.

You can get predictions of your trained neural network by running 'predict'.
-}

module NeuralNetwork (
  -- * DataType
  NeuralNetwork,
  -- * Initialisiation
  initNN,
  -- * Prediction
  predict,
  -- * Training
  train,
  -- * Serializiation
  -- ** Binary coded
  serialize,
  deserialize,
  -- ** Plain coded
  serializePlain,
  deserializePlain,
  -- * Helper functions
  sigmoid,
  sigmoid',
  randomRMatrix,
  zeroMatrix,
  multiplyElementwise,
  ) where

import Data.Matrix
import System.Random
import qualified Data.ByteString.Lazy as BSL
import Data.Binary
import Data.List.Split
import System.Random.Shuffle

-- | The data type 'NeuralNetwork' represents the state of a neural network.
--
-- It contains:
-- 
-- - config (nodes per layer) as a list of 'Int' 
-- - weights as 'Matrix' of 'Float' 
-- - biases as 'Matrix' of 'Float' 
data NeuralNetwork 
    = NeuralNetwork { config::[Int], weights::[Matrix Float], biases::[Matrix Float] }

instance Binary NeuralNetwork where
  put (NeuralNetwork config weights biases) = do
    put config
    put $ fmap toList weights
    put $ fmap toList biases
    
  get = do
    config <- get
    rawWeights <- get
    let weights = [fromList (config!!(i+1)) (config!!i) (rawWeights!!i) | i <- [0..(length config-2)]]
    rawBiases <- get
    let biases = [fromList (config!!i) 1 (rawBiases!!(i-1)) | i <- [1..((length config)-1)]]
    return (NeuralNetwork config weights biases)

-- | 'initNN' creates a randomly initialised network with the specified layers
--
-- __For example:__ 
-- 
-- A network with 784 input-nodes, 2 hidden layers with 1000 nodes each and 10 output-nodes 
-- 
-- @> network <- initNN [784,1000,1000,10] 123123@
initNN :: [Int]               -- ^ List of Nodes per Layer
       -> Int                 -- ^ Seed for the random generation of nodes
       -> IO (NeuralNetwork)

initNN config seed = do
  weights <- sequence [ randomRMatrix (config!!(i+1)) (config!!i) (-1.0, 1.0) seed | i <- [0..((length config)-2)] ]
  let biases = [zeroMatrix (config!!i) 1 | i <- [1..((length config)-1)]]
  return (NeuralNetwork config weights biases)

-- | 'predict' takes a network and an input, then runs a forwardPass with these parameters.
-- The resulting output 'Matrix' is returned
predict :: NeuralNetwork    -- ^ Trained 'NeuralNetwork' that will be used to 'predict' an output 
        -> Matrix Float     -- ^ Matrix of the input values for the given network
        -> Matrix Float     -- ^ Matrix of the output node values
        
predict nn input = last (forwardPass nn input)

-- | A function that runs one 'forwardPass' for the provided 'NeuralNetwork' 
-- with the given input and returns the activations of all layers except the input layer.
forwardPass :: NeuralNetwork    -- ^ Trained 'NeuralNetwork' that will be used for 'forwardPass'
            -> Matrix Float     -- ^ Matrix of the input values for the given network
            -> [Matrix Float]   -- ^ List of the matrices of the activations (last one is the output matrix of the network)
            
forwardPass nn input = input : forwardPass' (weights nn) (biases nn) input

-- | A helper function that provides the recursive calculation of the activations of the network and returns them.
forwardPass' :: [Matrix Float]  -- ^ Weights of the network
             -> [Matrix Float]  -- ^ Biases
             -> Matrix Float    -- ^ Activation of the previous recursion (starts with [])
             -> [Matrix Float]
             
forwardPass' [] _ activation = []
forwardPass' _ [] activation = []
forwardPass' (w:weights) (b:biases) activation = nextActivation : forwardPass' weights biases nextActivation
  where nextActivation = fmap sigmoid ((multStd w activation) + b)

-- | 'train' should be used to train the network with the passed inputs/outputs and the specified learning rate.

train :: NeuralNetwork                  -- ^ Network
      -> [(Matrix Float, Matrix Float)] -- ^ List of Tupels of the corresponding in-/output matrices
      -> Float                          -- ^ Learning rate
      -> IO (NeuralNetwork)             -- ^ Updated 'NeuralNetwork'
      
train nn ((input, output):samples) learningRate = train' nn samples learningRate 0 0

-- | 'train\'' should not be used manually or only for testing purpose. 
-- It is called by 'train' and trains the network by applying the 'backprop' function and passing the outcome to the next recursion of 'train\''.
-- Returns the trained network as IO.
train' :: NeuralNetwork                     -- ^ Network
       -> [(Matrix Float, Matrix Float)]    -- ^ List of Tupels of the corresponding in-/output matrices
       -> Float                             -- ^ Learning rate
       -> Float                             -- ^ Total error of one iteration (initialised with 0)
       -> Int                               -- ^ Training counter (initialised with 0)
       -> IO (NeuralNetwork)
       
train' nn' [] _ _ _ = return nn'
train' nn' ((input, output):samples) learningRate totalError' trainingIterations' = do
  backpropR <- (backprop nn' input output learningRate totalError' trainingIterations')
  train' (nn backpropR) samples learningRate (totalError backpropR) (totalIterations backpropR)

-- | DataType to store the result of one backpropagation in 'backprop'. 
-- It contains the network the total error and the number of iterations that the network was trained.
data BackpropResult 
    = BackpropResult { nn :: NeuralNetwork , totalError :: Float , totalIterations :: Int }

-- | 'backprop' gets the activations of the given 'NeuralNetwork' from calling 'forwardPass' and applies the calculated updates to the network.
backprop :: NeuralNetwork   -- ^ Network
         -> Matrix Float    -- ^ Input matrix
         -> Matrix Float    -- ^ Output matrix
         -> Float           -- ^ Learing rate
         -> Float           -- ^ Total error
         -> Int             -- ^ Training Counter (Number of training iterations)
         -> IO (BackpropResult)
         
backprop nn input output learningRate totalError totalIterations = do
  
  let err = 0.5 * (sum $ toList (fmap (^2) ((last activations) - output)))
  let updatedNN = apply nn (reverse (gradients (reverse (weights nn)) (reverse (biases nn)) (reverse (init activations)) ((last activations) - output))) learningRate
  
  putStrLn ((show (totalIterations + 1)) ++ ": " ++ show ((totalError + err)/(fromIntegral (totalIterations + 1))))
  
  return (BackpropResult updatedNN (totalError + err) (totalIterations + 1))
    where activations = forwardPass nn input

-- | Applies a list of updates to a given network and returns the updated 'NeuralNetwork'
apply :: NeuralNetwork                  -- ^ Network
      -> [(Matrix Float,Matrix Float)]  -- ^ List of Tupels of weight and bias update matrices
      -> Float                          -- ^ Learning rate
      -> NeuralNetwork                  
      
apply nn updates learningRate = NeuralNetwork (config nn) (update (weights nn) (fst (unzip updates)) learningRate) (update (biases nn) (snd (unzip updates)) learningRate)

-- | 'update' is called by 'apply' to apply one update matrix to either a weight or a bias matrix.
-- Returns the updated list of matrices.
update :: [Matrix Float]    -- ^ matrices to update
       -> [Matrix Float]    -- ^ update matrices
       -> Float             -- ^ Learning rate
       -> [Matrix Float]
       
update [] _ _ = []
update _ [] _ = []
update (m:matrices) (u:updates) learningRate = m - fmap (*learningRate) u : update matrices updates learningRate

Marco Herzog's avatar
Marco Herzog committed
180 181 182 183 184
-- | 'gradients' calculates the updates for the 'weights' and 'biases' of a 'NeuralNetwork'. This function is only to be called by 'apply'

gradients :: [Matrix Float] -- ^ The 'weight' matrix
          -> [Matrix Float] -- ^ The 'bias' matrix
          -> [Matrix Float] -- ^ The activations calculated by
185 186 187
          -> Matrix Float   -- ^ The error for a layer initialised with 0 and calculated recursively
          -> [(Matrix Float, Matrix Float)]

Andor Kyrill Willared's avatar
Andor Kyrill Willared committed
188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
          
gradients [] _ _ _ = []
gradients _ [] _ _ = []
gradients _ _ [] _ = []
gradients (w:weights) (b:biases) (a:activations) error = (multStd error' (transpose a), error') : gradients weights biases activations error''
  where error' = multiplyElementwise error (fmap sigmoid' ((multStd w a) + (b)))
        error'' = multStd (transpose w) error'

-- | 'serialize' is used to write a network to a specified file path as a binary file. Use 'deserialize' to read this file.
-- Alternatively you can use 'serializePlain' and 'deserializePlain' to save/read as text file.
serialize :: NeuralNetwork  -- ^ Network that should be saved
          -> FilePath       -- ^ Relative path to the file
          -> IO ()
          
serialize nn path = do
  BSL.writeFile path (encode nn)

-- | Used to load a network from a binary encoded file
--
-- Example usage:
--
-- @> network <- deserialize "networks/network_3.txt"@
deserialize :: FilePath -- ^ Relative path to the file
            -> IO (NeuralNetwork)
            
deserialize path = do
  nn <- decodeFile path :: IO (NeuralNetwork)
  return nn

-- | Same usage as 'serialize', but saves the network as text instead of binary.
-- Use 'deserializePlain' to read these files.
serializePlain :: NeuralNetwork -- ^ Network that should be saved
               -> FilePath      -- ^ Relative path to the file
               -> IO ()
               
serializePlain nn path = do
  writeFile path (show (
    [fromIntegral (length (config nn))]
    ++ (map fromIntegral (config nn))
    ++ (concat [ toList ((weights nn)!!i) | i <- [0..((length (config nn))-2)] ])
    ++ (concat [ toList ((biases nn)!!i) | i <- [0..((length (config nn))-2)] ])))

-- | Same usage as 'deserialize' but reads the network from text instead of binary.
deserializePlain :: FilePath    -- ^ Relative path to the file
                 -> IO (NeuralNetwork)
                 
deserializePlain path = do
  input <- (readFile path)
  let flist = map read (splitOn "," (take ((length (drop 1 input)) - 1) (drop 1 input)))
  let config = map round (take (round (flist!!0)) (drop 1 flist))
  let wstart = drop (1 + (length config)) flist
  let weights = [ fromList (config!!(i+1)) (config!!i) (take ((config!!(i+1)) * (config!!i)) (drop (sum [ (config!!j)*(config!!(j+1)) | j <- [0..i-1]]) wstart)) | i <- [0..((length config)-2)] ]
  let bstart = drop (sum [ (config!!j)*(config!!(j+1)) | j <- [0..((length config)-2)]]) wstart
  let biases = [ fromList (config!!(i+1)) 1 (take ((config!!(i+1))) (drop (sum [ (config!!(j+1)) | j <- [0..i-1]]) bstart)) | i <- [0..((length config)-2)] ]
  return (NeuralNetwork config weights biases)

-- Helper

-- | Generates an IO matrix with the specified dimensions, initialised with a random number in the given range.
randomRMatrix :: Int                -- ^ (m) Number of rows 
              -> Int                -- ^ (n) Number of columns
              -> (Float, Float)     -- ^ Range of the random numbers e.g. (-1,1)
              -> Int                -- ^ Seed for the random generator
              -> IO (Matrix Float)  -- ^ Initialised Matrix (m x n)
              
randomRMatrix rows columns range seed = do
                                    let weights = randomRs range (mkStdGen seed)
                                    return (matrix rows columns (\(row, column) -> weights!!(column+row*columns)))
-- | Generates a matrix with the specified dimensions, initialised with 0's.
zeroMatrix :: Int           -- ^ (m) Number of rows
           -> Int           -- ^ (n) Number of columns
           -> Matrix Float  -- ^ Initialised Matrix (m x n)
           
zeroMatrix rows columns = matrix rows columns (\(i, j) -> 0.0)

-- | 'multiplyElementwise' is used to multiply each element of matrix A with the element at the same position in matrix B.
multiplyElementwise :: Matrix Float -- ^ Matrix A
                    -> Matrix Float -- ^ Matrix B
                    -> Matrix Float -- ^ Result matrix
                    
multiplyElementwise m1 m2 = fromList (nrows m1) (ncols m2) (zipWith (*) m1List m2List)
  where m1List = toList m1
        m2List = toList m2

-- | Sigmoid function
sigmoid :: Float -- ^ x
        -> Float -- ^ f(x)
        
sigmoid x = 1 / (1 + exp (-x))

-- | Derivate of Sigmoid funtion
sigmoid' :: Float -- ^ x
         -> Float -- ^ f(x)

sigmoid' x = (sigmoid x) * (1 - (sigmoid x))