Neural Network in Haskell

Following this website I wrote a neural network which uses the MNIST training data to recognize digits. The author writes that it should take a couple of minutes to train the network with 30 epochs of training. My network needs something like 5 minutes alone for 1 epoch of training.

How could I make it process faster?

Furthermore after 1 epoch of training it recognizes about 10 percent of the digits in the test file. The author's network recognizes 90 percent of the digits in the test file after one epoch of training.

Can I make it train better in the first epoch?

```
{-# LANGUAGE TypeFamilies #-}

module Blueprint where

import Codec.Compression.GZip (decompress)
import qualified Data.ByteString.Lazy as BS

import Prelude
import Numeric.LinearAlgebra
import Control.Monad
import Control.Arrow
import System.Random
import Data.List
import Data.Ord
import Data.VectorSpace
import Data.Array.IO

newtype Network = Network [( Matrix Double, Vector Double)] deriving (Eq,Show)

instance AdditiveGroup Network where
(Network n1) ^+^ (Network n2) = Network $ zipWith (\(m,v) (n,w) -> (m+n,v+w)) n1 n2
(Network n1) ^-^ (Network n2) = Network $ zipWith (\(m,v) (n,w) -> (m-n,v-w)) n1 n2
zeroV = Network [(0,0) | x (-m,-v)) n

instance VectorSpace Network where
type Scalar Network = Double
lambda *^ (Network n) = Network $ (scale lambda Control.Arrow.*** scale lambda) n

part :: Int -> [a] -> [[a]]
part n xs = if length xs >= n then take n xs : part n (drop n xs) else []

randomlist :: Int -> StdGen -> [Int]
randomlist n = take n . unfoldr (Just . random)

shuffle :: [a] -> IO [a]
shuffle xs = do
ar do
j [a] -> IO (IOArray Int a)
newArray n = newListArray (1,n)

sigmoid :: Double -> Double
sigmoid x = 1 / (1+exp (-x))

sigmoid' :: Double -> Double
sigmoid' x = sigmoid x / (1 - sigmoid x)

getNetwork :: [Int] -> IO Network
getNetwork as@(_:bs) =
do
matrices randomVector n Gaussian m) (zip rs bs)
return $ Network $ zip matrices v

Let's start small and refactor:

type Network = ZipList [(Matrix Double, Vector Double)] and Data.NumInstances.Tuple will allow you to rewrite instance AdditiveGroup Network like so:

(^+^) = liftA2 (+)
(^-^) = liftA2 (-)
zeroV = pure 0
negateV = fmap negate


part is chunksOf from Data.List.Split, except it doesn't discard the remainder.

In getNetwork, letting the zipWithM envelop all removes the need for randomList, length bs and zipping:

getNetwork :: [Int] -> IO Network
getNetwork as@(_:bs) = fmap Network $ zipWithM foo bs as where
foo b a = do
matrix

shuffle has been done for you, for example in System.Random.Shuffle.

replicateM can take the recursion from train:

train :: Network -> [(Vector Double, Vector Double)] -> (Int, Int) -> Double -> IO Network
train network tdata (epochs,batchSize) eta = do
shuffledData

I would put Network as the last argument when a function turns parameters into a Network transformer. Your mileage may vary.

Not really being proficient with neural networks and just looking at it vaguely, are you sure you want to use last and tail in backpropagate rather than head and tail or init and last?

Edit: To start making sense of backpropagate, I've rewritten it into State form to make the data flow more linear. coerce allows us to ignore Networks newtype constructor. This won't actually work, because my modifys are trying to change the type of the state along the way, but perhaps this'll be instructive?

backpropagate :: (Vector Double, Vector Double) -> Network -> Network
backpropagate (input, output) = coerce $ execState $ do
modify $ liftA2 (zip on tail) (map fst) (scanl (\z (m,v) -> m #> cmap sigmoid z + v) input)
as (tr m #> delta) * cmap sigmoid' z) deltaL
modify $ zipWith (\a delta -> (asColumn a * tr (asColumn delta), delta)) as


StackExchange Code Review Q#135794, answer score: 7