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
        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)
        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

2 Answers 2


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)
        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
        -- 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)
            start = fromList 3 1 (randoms (mkStdGen 42))
            generations = iterate nextGeneration start
            result = generations !! 9999
  • \$\begingroup\$ 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. \$\endgroup\$ Mar 14, 2016 at 1:45
  • \$\begingroup\$ The fromIntegral calls aren't necessary. \$\endgroup\$
    – Zeta
    Mar 14, 2016 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
  • 1
    \$\begingroup\$ 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? \$\endgroup\$ Mar 14, 2016 at 1:49
  • \$\begingroup\$ @error_null_pointer that's from Data.Matrix. You did check the contents of that module, right? \$\endgroup\$
    – Zeta
    Mar 14, 2016 at 4:55
  • 1
    \$\begingroup\$ @Gurkenglas that's not a review, but an alternative solution. \$\endgroup\$
    – Zeta
    Mar 14, 2016 at 4:55
  • 2
    \$\begingroup\$ ":: 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. \$\endgroup\$
    – Gurkenglas
    Mar 14, 2016 at 12:34

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.