7
\$\begingroup\$

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.

Memory usage

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
\$\endgroup\$
5
  • \$\begingroup\$ Please also include your .cabal file, just in case you had some strange ghc-options on. It will also make it easier to use the same packages as you did. \$\endgroup\$
    – Zeta
    Jul 7, 2017 at 16:46
  • \$\begingroup\$ @Zeta I've now added by .cabal file. Thanks! \$\endgroup\$
    – 4castle
    Jul 7, 2017 at 22:52
  • \$\begingroup\$ I haven't had time to check the code thoroughly yet, but it seems like you deviate from the original C implementation. Your nodes only contain the Weight, but not the Input or Output 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 or vector should be suitable. I'll try to review your code till the end of the week. \$\endgroup\$
    – Zeta
    Jul 18, 2017 at 13:02
  • \$\begingroup\$ @Zeta Right, I started out doing it like the original C implementation (where I used a tuple of ([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\$
    – 4castle
    Jul 18, 2017 at 14:49
  • \$\begingroup\$ Oh. I completely forgot this review. I'll grab my laptop tomorrow and have a look at it. \$\endgroup\$
    – Zeta
    Oct 6, 2017 at 5:52

1 Answer 1

2
\$\begingroup\$

A couple things jump out at me:

  1. Lists in Haskell are not data structures for storing like data, but rather control structures. Admittedly, Haskell hides the fact that they're implemented as linked lists. Use rather array - if your inputs are of constant size (as they appear to be) then this shouldn't cause any real problems.

  2. It's partly a matter of personal preference, but I would avoid using type and use rather newtype, combined with the GeneralizedNewtypeDeriving extension to derive any instances that you need. This will make some parts of your code more verbose, but it will add type safety guarantees you would otherwise not have.

  3. length is \$O(n)\$ in Haskell. Hence len (filter id xs) / len xs will traverse the list (at least) twice.

  4. I believe ByteString has a readFile function that would simplify some of your code. It would also possibly prevent you from having to unpack the ByteString, which is \$O(n)\$.

  5. When you zip layer with outputs, with outputs defined in terms of layer, I believe this traverses the list twice. Also, (++) is \$O(n)\$ in the first argument - this can be fixed with using a dedicated array data type.

    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
    
\$\endgroup\$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.