Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add option for learning rate

  • Loading branch information...
commit 327a0438c192a0085037a2e3c22f13f25fa9c4f8 1 parent b409743
Larry Diehl authored
55 Perceptron.hs
@@ -3,55 +3,58 @@ import qualified Data.Map as M
3 3 import qualified Data.ByteString.Char8 as B
4 4 import Data.List (transpose, foldl')
5 5
6   -learningRate = 1.0
7 6 bias = 1.0
8 7 epochsLimit = 4000
9 8
10 9 hubris_learn :: M.Map B.ByteString [[Double]] -> Maybe [[Int]]
11 10 hubris_learn m = result
  11 + (M.lookup (B.pack "learning_rate") m)
12 12 (M.lookup (B.pack "input_patterns") m)
13 13 (M.lookup (B.pack "output_patterns") m)
14 14 (M.lookup (B.pack "hidden_weights_group") m)
15 15 (M.lookup (B.pack "output_weights_group") m)
16 16 where
17   - result (Just a) (Just b) (Just c) (Just d) =
18   - Just (learn a b c d)
19   - result _ _ _ _ = Nothing
  17 + result (Just [[a]]) (Just b) (Just c) (Just d) (Just e)=
  18 + Just (learn a b c d e)
  19 + result _ _ _ _ _ = Nothing
20 20
21   -learn :: [[Double]] -> [[Double]] -> [[Double]] -> [[Double]] ->
  21 +learn :: Double -> [[Double]] -> [[Double]] -> [[Double]] -> [[Double]] ->
22 22 [[Int]]
23   -learn inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup =
  23 +learn learningRate inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup =
24 24 map finalOutput inputPatterns
25 25 where
26 26 (hiddenWeightsGroup', outputWeightsGroup') =
27   - learnWeights 0 inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup
  27 + learnWeights 0 learningRate
  28 + inputPatterns outputPatterns
  29 + hiddenWeightsGroup outputWeightsGroup
28 30 finalOutput inputNodes = map (round . fromRational . toRational) outputNodes
29 31 where inputNodes' = calculateInputNodes inputNodes
30 32 hiddenNodes = calculateHiddenNodes inputNodes' hiddenWeightsGroup'
31 33 outputNodes = calculateOutputNodes hiddenNodes outputWeightsGroup'
32 34
33   -learnWeights :: Integer -> [[Double]] -> [[Double]] -> [[Double]] -> [[Double]] ->
  35 +learnWeights :: Integer -> Double -> [[Double]] -> [[Double]] -> [[Double]] -> [[Double]] ->
34 36 ( [[Double]], [[Double]] )
35   -learnWeights i inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup
  37 +learnWeights i learningRate inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup
36 38 | i < epochsLimit =
37 39 let (hiddenWeightsGroup', outputWeightsGroup') =
38   - epoch inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup
  40 + epoch learningRate inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup
39 41 in
40   - learnWeights (succ i) inputPatterns outputPatterns
  42 + learnWeights (succ i) learningRate
  43 + inputPatterns outputPatterns
41 44 hiddenWeightsGroup' outputWeightsGroup'
42 45 | otherwise = (hiddenWeightsGroup, outputWeightsGroup)
43 46
44   -epoch :: [[Double]] -> [[Double]] -> [[Double]] -> [[Double]] ->
  47 +epoch :: Double -> [[Double]] -> [[Double]] -> [[Double]] -> [[Double]] ->
45 48 ( [[Double]], [[Double]] )
46   -epoch inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup =
  49 +epoch learningRate inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup =
47 50 foldl' (\ (hiddenWeights, outputWeights) (inputPattern, outputPattern) ->
48   - pattern inputPattern outputPattern hiddenWeights outputWeights)
  51 + pattern learningRate inputPattern outputPattern hiddenWeights outputWeights)
49 52 (hiddenWeightsGroup, outputWeightsGroup)
50 53 (zip inputPatterns outputPatterns)
51 54
52   -pattern :: [Double] -> [Double] -> [[Double]] -> [[Double]] ->
  55 +pattern :: Double -> [Double] -> [Double] -> [[Double]] -> [[Double]] ->
53 56 ( [[Double]], [[Double]] )
54   -pattern inputNodes desiredOutputs hiddenWeightsGroup outputWeightsGroup =
  57 +pattern learningRate inputNodes desiredOutputs hiddenWeightsGroup outputWeightsGroup =
55 58 (hiddenWeightsGroup', outputWeightsGroup')
56 59 where
57 60 -- forward propogation
@@ -63,14 +66,14 @@ pattern inputNodes desiredOutputs hiddenWeightsGroup outputWeightsGroup =
63 66 hiddenErrorTerms = zipWith (`hiddenErrorTerm` outputErrorTerms)
64 67 hiddenNodes (transpose outputWeightsGroup)
65 68 -- weight change
66   - hiddenWeightsGroup' = zipWith (\ hiddenWeights hiddenError ->
67   - zipWith (`changedWeight` hiddenError)
68   - hiddenWeights inputNodes')
69   - hiddenWeightsGroup (tail hiddenErrorTerms)
70   - outputWeightsGroup' = zipWith (\ outputWeights outputError ->
71   - zipWith (`changedWeight` outputError)
72   - outputWeights hiddenNodes)
73   - outputWeightsGroup outputErrorTerms
  69 + hiddenWeightsGroup' = zipWith (\ hiddenError hiddenWeights ->
  70 + zipWith (changedWeight learningRate hiddenError)
  71 + inputNodes' hiddenWeights)
  72 + (tail hiddenErrorTerms) hiddenWeightsGroup
  73 + outputWeightsGroup' = zipWith (\ outputError outputWeights ->
  74 + zipWith (changedWeight learningRate outputError)
  75 + hiddenNodes outputWeights)
  76 + outputErrorTerms outputWeightsGroup
74 77
75 78 averageError :: [[Double]] -> [[Double]] -> [[Double]] -> [[Double]] -> Double
76 79 averageError inputPatterns outputPatterns hiddenWeightsGroup outputWeightsGroup =
@@ -100,8 +103,8 @@ calculateHiddenNodes inputNodes hiddenWeightsGroup =
100 103 calculateInputNodes :: [Double] -> [Double]
101 104 calculateInputNodes = (bias:)
102 105
103   -changedWeight :: Double -> Double -> Double -> Double
104   -changedWeight weight errorTerm node =
  106 +changedWeight :: Double -> Double -> Double -> Double -> Double
  107 +changedWeight learningRate errorTerm node weight =
105 108 weight + product [learningRate, errorTerm, node]
106 109
107 110 hiddenErrorTerm :: Double -> [Double] -> [Double] -> Double
8 PerceptronTest.hs
@@ -6,14 +6,14 @@ import HUnitExtensions
6 6 main = runTestTT (TestList [
7 7
8 8 "learn given the XOR problem returns its definition (caveat: with learningRate 1.0)" ~:
9   - [[0], [1], [1], [1]] @=? (learn
  9 + [[0], [1], [1], [0]] @=? (learn 0.5
10 10 [[0.0, 0.0], [0.0, 1.0], [1.0, 0.0], [1.0, 1.0]]
11 11 [[0.0], [1.0], [1.0], [0.0]]
12 12 [[0.0923, 0.1958, -0.4049], [0.2904, 0.1946, -0.1057]]
13 13 [[0.0276, 0.1621, 0.2559]]),
14 14
15 15 "epoch given input and output patterns, and hidden and output weights groups" ~:
16   - let (hiddenWeights, outputWeights) = epoch
  16 + let (hiddenWeights, outputWeights) = epoch 1.0
17 17 [[0.0, 0.0], [0.0, 1.0], [1.0, 0.0], [1.0, 1.0]]
18 18 [[0.0], [1.0], [1.0], [0.0]]
19 19 [[0.1, 0.2, -0.4], [0.3, 0.2, -0.1]]
@@ -27,7 +27,7 @@ main = runTestTT (TestList [
27 27 True @=? True,
28 28
29 29 "pattern given input and output nodes, and hidden and output weights groups" ~:
30   - let (hiddenWeights, outputWeights) = pattern
  30 + let (hiddenWeights, outputWeights) = pattern 1.0
31 31 [0.0, 0.0]
32 32 [0.0]
33 33 [[0.1, 0.2, -0.4], [0.3, 0.2, -0.1]]
@@ -57,7 +57,7 @@ main = runTestTT (TestList [
57 57 "changedWeight given weight, error term, and node " ++
58 58 "returns the sum of the weight and the product of the " ++
59 59 "learning rate, error term, and node" ~:
60   - (0.1249, 0.0001) @~? changedWeight 0.2 (-0.1431) 0.5250,
  60 + (0.1249, 0.0001) @~? changedWeight 1.0 (-0.1431) 0.5250 0.2,
61 61
62 62 "hiddenErrorTerm given the hidden node, output error terms, and " ++
63 63 "output weights of the hidden node multiplies the actual output derivative " ++
2  README.markdown
Source Rendered
@@ -4,7 +4,7 @@
4 4
5 5 Neurosis is an example application to show off [Hubris](http://github.com/mwotton/Hubris) (a Haskell -> Ruby bridge) being used with non-trivial Haskell-code. See [this post](http://engineyard.com/blog/2010/a-hint-of-hubris/) for an intro to Hubris and for which Neurosis was written.
6 6
7   -Feel free to fork the code and send in pull requests if you would like to see this turn into a more sophisticated example webservice. I will be hacking on little improvements here and there as time goes on. Of course `learningRate` will need to be paramaterized as it is silly that it is a constant currently.
  7 +Feel free to fork the code and send in pull requests if you would like to see this turn into a more sophisticated example webservice. I will be hacking on little improvements here and there as time goes on.
8 8
9 9 ## Up next
10 10
2  neurosis.rb
@@ -16,7 +16,7 @@ def perceptron() Perceptron.new end
16 16 else
17 17 status 400
18 18 "Please specify all correct options for: " +
19   - "input_patterns, output_patterns, hidden_weights_group, output_weights_group"
  19 + "input_patterns, output_patterns, hidden_weights_group, output_weights_group, learning_rate"
20 20 end
21 21 end
22 22 end
5 neurosis_spec.rb
@@ -21,12 +21,13 @@ def app
21 21 "hidden_weights_group" =>
22 22 [[0.0923, 0.1958, -0.4049], [0.2904, 0.1946, -0.1057]],
23 23 "output_weights_group" =>
24   - [[0.0276, 0.1621, 0.2559]]
  24 + [[0.0276, 0.1621, 0.2559]],
  25 + "learning_rate" => [[0.5]]
25 26 }.to_json
26 27
27 28 last_response.should be_successful
28 29 JSON.parse(last_response.body).should ==
29   - [[0], [1], [1], [1]]
  30 + [[0], [1], [1], [0]]
30 31 end
31 32
32 33 it "responds with error message when missing options" do

0 comments on commit 327a043

Please sign in to comment.
Something went wrong with that request. Please try again.