# Conversion of a simple Python Neural Network to a Haskell implementation

I started with this code and modified and expanded it in Python. As an exercise/challenge to myself I decided to covert the original to Haskell. I either write imperatively or functionally. This is the first time I have tried converting from one logic to another. I ran into a lot of little issue along the way. I aimed to just get it to work and I want to make it work better now.

import Data.List
import System.Random
import Data.Matrix hiding (transpose, trace)
import Debug.Trace

flipSign::Num a => a -> a
flipSign x = (-1) * x

nonlin:: Bool -> Double ->   Double
nonlin True x = x*(1.0-x)
nonlin False x =  1.0 / (1.0 + (exp $flipSign x)) randomList :: (Random a) => Int -> [a] randomList seed = randoms (mkStdGen seed) sample:: [[Double]] sample = map (map fromIntegral)[ [0,0,1], [0,1,1], [1,0,1], [1,1,1] ] answers:: [[Double]] answers = transpose$ map (map fromIntegral) [[0,0,1,1]]

syn0:: [[Double]]
syn0 = [[x] | x<- take 3 (randomList 42 :: [Double])]

dotp:: [[Double]] -> [[Double]] -> [[Double]]
dotp x y = toLists newMatrix
where
mx = fromLists x
my = fromLists y
newMatrix = multStd mx my

nextGeneration::[[Double]] -> [[Double]] -> ([[Double]], [[Double]]) -> ([[Double]],[[Double]])
nextGeneration x labels syn0_l1 = (new_syn0, l1)
where
l0 = x
syn0 = fst syn0_l1
l1 = map (map $nonlin False)$ dotp l0 syn0
l1_error = zipWith (zipWith (-)) labels l1
l1_delta = zipWith (zipWith (*)) l1_error $map (map (nonlin True)) l1 new_syn0 = zipWith (zipWith (+)) syn0$ dotp (transpose l0) l1_delta

generations::([[Double]] -> [[Double]]) -> [[Double]] -> Int -> [[Double]]
generations _ end 0 = end
generations fun weights count = generations fun (fun weights) (count - 1)

main = print $snd$ iterate (nextGeneration sample answers ) (syn0, [[]] ) !!10000


You often switch between matrices and lists in the dotp function. Since that is an essential part of your code called every iteration and your data is a matrix, you should be using matrices everywhere.

In the documentation is noted, that there is a functor instance. That means you can use the function fmap on the matrix, which (in this case) maps a function over every cell. This means you can swap map (map fromIntegral) with fmap fromIntegral. The equivalent to zipWith (zipWith ..) is called elementwise.

The generations function doesn't seem to be called: you can avoid having dead code by compiling with warnings enabled, -Wall. The flipSign function is predefined and called negate.

I have changed nonlin to make the variable explicit, otherwise it wouldn't be clear what this Bool actually does. Furthermore, I have added some comments.

Finally, I have changed nextGeneration as there is no need to carry the l1 variable if it isn't needed by the next step. I've extracted that into a function (and so have to take the 9999th iteration in main).

Here is my version of the code:

import System.Random (randoms, mkStdGen)
import Data.Matrix

-- | input dataset
sample :: Matrix Double
sample = fmap fromIntegral $fromLists [ [0,0,1] , [0,1,1] , [1,0,1] , [1,1,1] ] -- | output dataset answers :: Matrix Double answers = transpose (fmap fromIntegral output) where output = fromLists [[0,0,1,1]] -- | sigmoid function nonlin :: Bool -> Double -> Double nonlin derivative x = if derivative then x * (1.0 - x) else 1.0 / (1.0 + (exp (negate x))) layer1 :: Matrix Double -> Matrix Double -> Matrix Double layer1 l0 syn0 = fmap (nonlin False) (multStd l0 syn0) nextGeneration :: Matrix Double -> Matrix Double nextGeneration syn0 = new_syn0 where -- forward propagation l1 = layer1 sample syn0 -- how much did we miss? l1_error = elementwise (-) answers l1 -- multiply how much we missed by the -- slope of the sigmoid at the values in l1 l1_delta = elementwise (*) l1_error (fmap (nonlin True) l1) -- update weights new_syn0 = elementwise (+) syn0 (multStd (transpose sample) l1_delta) main = do putStrLn "Output After Training:" print (layer1 sample result) where start = fromList 3 1 (randoms (mkStdGen 42)) generations = iterate nextGeneration start result = generations !! 9999  • You had some great suggestions! Only thing I didn't like was that you moved sample and answers fully into the function. The problem with that is it makes it harder if I want to apply the same function to multiple sets of different data. I'll upload my new version in a bit. – error_null_pointer Mar 14 '16 at 1:45 • The fromIntegral calls aren't necessary. – Zeta Mar 14 '16 at 4:53 Have some refactoring! import Data.List import System.Random import Data.Matrix import Control.Monad.Trans.State nextGeneration:: Matrix Double -> Matrix Double -> Matrix Double -> (Matrix Double, Matrix Double) nextGeneration l0 labels syn0 = (new_syn0, l1) where l1 = (\x -> 1 / (1 + exp (-x))) <$> multStd l0 syn0
l1_error = elementwise (-) labels l1
l1_delta = elementwise (*) l1_error $(\x -> x * (1 - x)) <$> l1
new_syn0 = elementwise (+) syn0 $multStd (transpose l0) l1_delta main = do syn0 <- transpose . fromLists . (:[]) <$> replicateM 3 randomIO :: IO (Matrix Double)
let sample = fromLists [[0,0,1], [0,1,1], [1,0,1], [1,1,1]]     ::     Matrix Double
answers = transpose $fromLists [[0,0,1,1]] :: Matrix Double print$ last $evalState (replicateM 10000$ state \$ nextGeneration sample answers) syn0

• Wow you made this program small. That is awesome! I had a few question I was hoping you could answer. What does the :: Matrix Double do? I have seen it in other programs, but I am a little fuzzy on it. Why RandomIO over just plain random? – error_null_pointer Mar 14 '16 at 1:49
• @error_null_pointer that's from Data.Matrix. You did check the contents of that module, right? – Zeta Mar 14 '16 at 4:55
• @Gurkenglas that's not a review, but an alternative solution. – Zeta Mar 14 '16 at 4:55
• ":: Matrix Double" is the anologon to ":: [[Double]]" that we use after fromLists made it not be a [[Double]] anymore; it allows us to declare a type signature for sample/answers without using another line for it. I'm using IO because we're already in an IO block and randomIO does the work of generating a StdGen for us. (And not the same one each time!) Zeta, I did have some verbal commentary at first, but then found it superfluous to just pasting the mostly self-explanatory code. – Gurkenglas Mar 14 '16 at 12:34