I've used this tutorial in order to learn the basics of creating a neural network from scratch. The program is meant to read handwritten numbers from the MNIST database. The author of the tutorial implements the algorithm in C, and claims that it only takes less than 10 seconds to go through both the training and testing phase. My Haskell implementation takes about 50 seconds.
I've also noticed by heap profiling that my code is progressively using more memory as it trains. I've been successful at eliminating most of the memory issues using force
from Control.DeepSeq
, but I'd expect my code to use a constant amount of memory.
How can I make this code faster, and more efficient? Any style tips are welcome as well. I don't have much experience in optimizing Haskell code.
Here's the guts of the application, NeuralNumbers.hs
:
{- |
Module : NeuralNumbers
Description : Read handwritten numbers with a neural network.
Copyright : Castle Kerr
License : BSD3
Maintainer : [email protected]
Stability : experimental
Portability : portable
Read handwritten numbers from IDX files using a neural network.
-}
module NeuralNumbers
( Network
, train
, test
) where
import Control.Arrow (first)
import Data.List (mapAccumL, zipWith4)
import Data.Word (Word8)
import System.IO (Handle, IOMode(ReadMode), openBinaryFile)
import Control.DeepSeq (force)
import System.Random (randoms, getStdGen)
import Data.List.Split (chunksOf)
import qualified Data.ByteString.Lazy as BS
import qualified Data.Binary.Get as Get
type Label = Word8 -- ^ The number represented by a corresponding image
type Image = [Word8] -- ^ A 28 by 28 list of pixels with brightness 0-255
type Input = Double -- ^ A 0 or 1 representing a white or black pixel
type Output = Double -- ^ A number between 0 and 1 for a node's output
type Weight = Double -- ^ A number between 0 and 1 for a node's multiplier
type Node = [Weight] -- ^ The weights used by a node
type Layer = [Node] -- ^ A single layer of a neural network
-- | A neural network for reading handwritten numbers.
newtype Network = Network [Layer]
layerSize, imageSize :: Num a => a
layerSize = 10
imageSize = 28 * 28
-- | Generate and train a new neural network using
-- the images and labels from the given IDX-format files.
-- Return the neural network along with its success rate.
train :: FilePath -- ^ Images file
-> FilePath -- ^ Labels file
-> IO (Network,Double) -- ^ Neural net and success rate
train imgsPath lblsPath = fmap (first (Network . pure)) $
runBatch train' imgsPath lblsPath =<< getRandomLayer
-- | Test a given neural network using the images
-- and labels from the given IDX-format files. The
-- network will not learn from any of the images.
-- Return the success rate.
test :: Network -- ^ Neural network to test
-> FilePath -- ^ Images file
-> FilePath -- ^ Labels file
-> IO Double -- ^ Success rate of tests
test (Network [layer]) imgsPath lblsPath =
snd <$> runBatch test' imgsPath lblsPath layer
test _ _ _ = error "Invalid network"
runBatch
:: (Layer -> (Image,Label) -> (Layer,Bool))
-> FilePath -> FilePath
-> Layer -> IO (Layer,Double)
runBatch run imgsPath lblsPath layer =
fmap (fmap percentTrue . mapAccumL run layer) $
zip <$> getImages imgsPath <*> getLabels lblsPath
train' :: Layer -> (Image,Label) -> (Layer,Bool)
train' layer (image, label) = (force layer', label == guess)
where
inputs = fromIntegral . min 1 <$> image
outputs = calcNode inputs <$> layer
guess = snd (maximum (zip outputs [0..]))
targetOutputs = replicate (fromIntegral label) 0 ++ 1 : repeat 0
layer' = zipWith4 updateWeights
targetOutputs
outputs
(repeat inputs)
layer
test' :: Layer -> (Image,Label) -> (Layer,Bool)
test' layer (image, label) =
(layer, snd (train' layer (image, label)))
calcNode :: [Input] -> [Weight] -> Output
calcNode inputs weights =
sum (zipWith (*) inputs weights) / imageSize
updateWeights :: Output -> Output -> [Input] -> [Weight] -> [Weight]
updateWeights target actual =
zipWith (\input weight -> weight + input * dx)
where
dx = 0.05 * (target - actual)
percentTrue :: [Bool] -> Double
percentTrue xs =
len (filter id xs) / len xs * 100
where
len = fromIntegral . length
getRandomLayer :: IO Layer
getRandomLayer = take layerSize
. chunksOf imageSize
. randoms <$> getStdGen
getLength :: Handle -> Int -> IO Int
getLength handle fileHeaderSize = fromIntegral .
Get.runGet (Get.skip 4 >> Get.getWord32be)
<$> BS.hGet handle fileHeaderSize
getImages :: FilePath -> IO [Image]
getImages path = do
file <- openBinaryFile path ReadMode
numImages <- getLength file 16
take numImages . chunksOf imageSize . BS.unpack
<$> BS.hGetContents file
getLabels :: FilePath -> IO [Label]
getLabels path = do
file <- openBinaryFile path ReadMode
numLabels <- getLength file 8
take numLabels . BS.unpack
<$> BS.hGetContents file
Here's the Main.hs
:
import Text.Printf
import NeuralNumbers
main :: IO ()
main = do
(layer, trainingRate) <- train
"train-images.idx3-ubyte" "train-labels.idx1-ubyte"
testingRate <- test layer
"t10k-images.idx3-ubyte" "t10k-labels.idx1-ubyte"
printf "Training: %.2f%% success rate\n" trainingRate
printf "Testing: %.2f%% success rate\n" testingRate
And here's the nn-numbers.cabal
:
name: nn-numbers
version: 0.1.0.0
license: BSD3
license-file: LICENSE
author: Castle Kerr
maintainer: [email protected]
copyright: 2017 Castle Kerr
build-type: Simple
cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: NeuralNumbers
build-depends: base
, binary
, bytestring
, split
, random
, deepseq
ghc-options: -O2 -Wall -Werror
default-language: Haskell2010
executable nn-numbers
hs-source-dirs: app
main-is: Main.hs
ghc-options: -O2 -rtsopts
build-depends: base, nn-numbers
default-language: Haskell2010
.cabal
file, just in case you had some strangeghc-options
on. It will also make it easier to use the same packages as you did. \$\endgroup\$.cabal
file. Thanks! \$\endgroup\$Weight
, but not theInput
orOutput
in a local fashion. Speaking about local,updateWeight
is currently a scapegoat, as it evaluates the lists. Since you're working with fixed size lists,array
orvector
should be suitable. I'll try to review your code till the end of the week. \$\endgroup\$([Weight],[Input],Output)
), but over the course of several iterations of refactoring, the tuple was broken apart into its components, because it seemed unnatural to group them.calcNode
was the only function that gained readability from grouping them together. \$\endgroup\$