Haskell 'n' layered ANN forward pass

Question

I'm trying to write a simple 'n' layered ANN in haskell for supervised learning, it will eventually have back prop and you'll be able to use it in a step by step fashion through a GUI which will graph the error function. This is for learning (so I'm not looking for suggestions on libraries that already solve this problem). In this review I'm mainly looking for feedback on how I've arranged my code and if there are better ways to represent a neural network in Haskell.

The approach I'm trying to take is to separate the forward pass from the backward pass, so that the training can be controlled by the consumer (rather than having a network that is just a one shot IO which does forward -> back recursively until error < x). The reason for this is that I can then separate the rendering of the networks state at any given pass (i.e. after each forward pass I can easily just render the current loss of the whole network by applying the cost function across the output vector).

Here is the current code for a forward pass of the network. It takes a list of double (which is the input vector) and a list of matrix of double (where each element in the list is a weight matrix representing the weights of each connection on a given layer in the network). The activation function then creates an output vector by recursively applying a forwardPass function through each layer until the final layer 'n' has been evaluated.

Here is the code for that:

module Training (randomWeights, activate, cost) where

  import Data.Matrix
  import System.Random

  activate :: [Double] -> [Matrix Double] -> Matrix Double
  activate i weights = forwardPass inputs weights where
    inputSize = length i
    inputs = fromList 1 inputSize i
    forwardPass inputs weights
      | length weights == 1 = squashedOutputs
      | otherwise = forwardPass (squashedOutputs) (tail weights)
      where
        squashedOutputs = mapPos (\(row, col) a -> leakyRelu a) layerOutputs where
          layerOutputs = multStd2 inputs (head weights)
          leakyRelu a
            | a > 0.0 = a
            | otherwise = 0.01 * a

  randomWeights :: (RandomGen g) => g -> Int -> Int -> Matrix Double
  randomWeights generator inputSize outputSize = weights where
    weights = matrix inputSize outputSize (\(col, row) -> (take 10000 $ randomRs (-1.0, 1.0) generator)!!(col * row))

The randomWeights function is consumed in the main function of my program and is used to generate the list of matrix of double to be passed to the forwardPass (i.e. each layers weights).

The main function looks like this:

  main :: IO()
  main = do
    generator <- newStdGen

    let expected = 0.0
    let inputs = [0, 1]

    let inputWeights = randomWeights generator (length inputs) 3
    let hiddenWeights = randomWeights generator 3 1
    let outputWeights = randomWeights generator 1 1

    let outputs = activate inputs [inputWeights, hiddenWeights, outputWeights]

    print inputs
    print outputs

So it a bit like a unit test (eventually I will wrap the activate/backprop loop into a structure that a user can control by a 'next' button on a GUI, but for now I simply want a solid forwardPass foundation to build off.

Does all of this look like reasonable haskell, or are there some obvious improvements I can make?

Answer 1

\(col, row) -> (take 10000 $ randomRs (-1.0, 1.0) generator)!!(col * row)

Oh man you got me going "no no no no no no" like I long haven't :D. take 10000 does nothing here. col * row is going to come out to the same when you switch row and col, perhaps you want col + inputSize * row? randomRs is going to be recalculated for each (col,row) pair - fromList fixes that. Calling the line's result weights is little more than a comment. MonadRandom can avert the generator passery, and also stop you generating the same random values for each call to randomWeights.

activate :: [Double] -> [Matrix Double] -> Matrix Double
activate i = foldl squash (fromLists [i]) where
  squash inputs weights = fmap leakyRelu $ multStd2 inputs weights
  leakyRelu a
    | a > 0.0 = a
    | otherwise = 0.01 * a

randomWeights :: Int -> Int -> IO (Matrix Double)
randomWeights rows cols = fromList rows cols <$> getRandomRs (-1.0, 1.0)

main :: IO ()
main = do
  let inputs = [0, 1]

  inputWeights <- randomWeights (length inputs) 3
  hiddenWeights <- randomWeights 3 1
  outputWeights <- randomWeights 1 1

  let outputs = activate inputs [inputWeights, hiddenWeights, outputWeights]

  print inputs
  print outputs