diff --git a/machine-learning-in-haskell/MachineLearning.hs b/machine-learning-in-haskell/MachineLearning.hs index 749e124..eeb7895 100644 --- a/machine-learning-in-haskell/MachineLearning.hs +++ b/machine-learning-in-haskell/MachineLearning.hs @@ -17,6 +17,18 @@ randomList n gen = go n gen [] -- definition of a neuron +data NeuralNetwork = NeuralNetwork + { layers :: [[Neuron]], + finalLayer :: Neuron + } + +runNetwork :: NeuralNetwork -> Input -> Output +runNetwork NeuralNetwork {layers, finalLayer} input = + run finalLayer $ runLayers layers input + where + runLayers [] input = input + runLayers (l : ls) input = runLayers ls $ map (`run` input) l + data Neuron = Neuron { bias :: Float, activate :: Float -> Output, @@ -43,12 +55,17 @@ modifyWeights dw neuron = neuron {weights = zipWith (+) dw (weights neuron)} modifyBias :: Weight -> Neuron -> Neuron modifyBias db neuron = neuron {bias = db + bias neuron} -initializeNeuron :: Int -> Int -> Neuron -initializeNeuron seed nWeights = - let gen = mkStdGen seed - (weights, gen') = randomList nWeights gen +initializeNeuron :: StdGen -> Int -> (Neuron, StdGen) +initializeNeuron gen nWeights = + let (weights, gen') = randomList nWeights gen (bias, gen'') = random gen' - in Neuron {bias = bias, activate = id, weights = weights} + in ( Neuron + { bias = bias, + activate = id, + weights = weights + }, + gen'' + ) -- prerequisites for gradient descent @@ -66,63 +83,104 @@ cost neuron trainingData = expected = map snd trainingData in meanSquaredError actual expected +costNetwork :: NeuralNetwork -> TrainingData -> Float +costNetwork network trainingData = + let actual = map (runNetwork network . fst) trainingData + expected = map snd trainingData + in meanSquaredError actual expected + oneHotVectors :: Int -> [[Weight]] oneHotVectors n = [oneHot i | i <- [0 .. n - 1]] where oneHot index = [if j == index then epsilon else 0 | j <- [0 .. n - 1]] -differential :: Neuron -> TrainingData -> Neuron -differential neuron trainingData = - let c = cost neuron trainingData +differential :: (Neuron -> TrainingData -> Float) -> Neuron -> TrainingData -> Neuron +differential costFunc neuron trainingData = + let c = costFunc neuron trainingData weightUpdates = oneHotVectors $ length $ weights neuron dws = map ( \weightUpdate -> - (cost (modifyWeights weightUpdate neuron) trainingData - c) / epsilon + (costFunc (modifyWeights weightUpdate neuron) trainingData - c) / epsilon ) weightUpdates - db = (cost (modifyBias epsilon neuron) trainingData - c) / epsilon - in trace (show neuron ++ ", cost = " ++ show c) $ - neuron - { weights = dws, - bias = db - } + db = (costFunc (modifyBias epsilon neuron) trainingData - c) / epsilon + in neuron {weights = dws, bias = db} + +differentialNetwork :: NeuralNetwork -> TrainingData -> NeuralNetwork +differentialNetwork network trainingData = + let costFunc = costNetwork + updatedLayers = map (map (\neuron -> differential costFunc neuron trainingData)) (layers network) + updatedFinalLayer = differential costFunc (finalLayer network) trainingData + in NeuralNetwork {layers = updatedLayers, finalLayer = updatedFinalLayer} learn :: Float -> Neuron -> (Neuron -> Neuron) learn learningRate differential = modifyBias (-learningRate * bias differential) . modifyWeights (map (\dw -> -learningRate * dw) (weights differential)) +learnNetwork :: Float -> NeuralNetwork -> (NeuralNetwork -> NeuralNetwork) +learnNetwork learningRate differential network = + NeuralNetwork + { finalLayer = learn learningRate (finalLayer differential) (finalLayer network), + layers = zipWith (zipWith (learn learningRate)) (layers differential) (layers network) + } + epoch :: TrainingData -> Neuron -> Neuron epoch trainingData neuron = - let neuron' = learn learningRate (differential neuron trainingData) neuron + let neuron' = learn learningRate (differential cost neuron trainingData) neuron in neuron' where learningRate = 1e-3 -- concrete example -trainingDataAdd, trainingDataDouble, trainingDataOr, trainingDataAnd :: TrainingData +trainingDataAdd, trainingDataDouble, trainingDataOr, trainingDataAnd, trainingDataNand, trainingDataNot, trainingDataXor :: TrainingData trainingDataDouble = [([x], x * 2) | x <- [0 .. 4]] trainingDataAdd = [([x, y], x + y) | x <- [1 .. 10], y <- [1 .. 10]] trainingDataOr = [([0, 0], 0), ([1, 0], 1), ([0, 1], 1), ([1, 1], 1)] trainingDataAnd = [([0, 0], 0), ([1, 0], 0), ([0, 1], 0), ([1, 1], 1)] +trainingDataNand = [([0, 0], 1), ([1, 0], 1), ([0, 1], 1), ([1, 1], 0)] +trainingDataXor = [([0, 0], 0), ([1, 0], 1), ([0, 1], 1), ([1, 1], 0)] +trainingDataNot = [([0], 1), ([1], 0)] + +gen = mkStdGen 69 trainDouble n = - let neuron = initializeNeuron 69 1 + let (neuron, _) = initializeNeuron gen 1 in iterate (epoch trainingDataDouble) neuron !! n trainAdd n = - let neuron = initializeNeuron 69 2 + let (neuron, _) = initializeNeuron gen 2 in iterate (epoch trainingDataAdd) neuron !! n trainOr n = - let neuron = (initializeNeuron 69 2) {activate = sigmoid} - in iterate (epoch trainingDataOr) neuron !! n + let (neuron, _) = initializeNeuron gen 2 + neuron' = neuron {activate = sigmoid} + in iterate (epoch trainingDataOr) neuron' !! n trainAnd n = - let neuron = (initializeNeuron 69 2) {activate = sigmoid} - in iterate (epoch trainingDataAnd) neuron !! n + let (neuron, _) = initializeNeuron gen 2 + neuron' = neuron {activate = sigmoid} + in iterate (epoch trainingDataAnd) neuron' !! n + +trainXor n = + let (neuron, _) = initializeNeuron gen 2 + neuron' = neuron {activate = sigmoid} + in iterate (epoch trainingDataXor) neuron' !! n + +trainNand n = + let (neuron, _) = initializeNeuron gen 2 + neuron' = neuron {activate = sigmoid} + in iterate (epoch trainingDataNand) neuron' !! n + +trainNot n = + let (neuron, _) = initializeNeuron gen 2 + neuron' = neuron {activate = sigmoid} + in iterate (epoch trainingDataNot) neuron' !! n evaluateNeuron :: Neuron -> TrainingData -> [(Input, Output)] evaluateNeuron neuron = map (\(x, _) -> (x, run neuron x)) + +evaluateNetwork :: NeuralNetwork -> TrainingData -> [(Input, Output)] +evaluateNetwork network = map (\(x, _) -> (x, runNetwork network x))