feat(randomNetwork): generate random networks with a simple function

app/Main.hs

@@ -5,20 +5,6 @@ import Numeric.LinearAlgebra
 import Data.List
 import Debug.Trace
 
--- 1x2
--- 2x3 + 1x3
--- 3x1 + 1x1
-
--- main :: IO [()]
-main =
-  let learning_rate = 0.5
-      ih = randomLayer 0 (2, 8)
-      ho = randomLayer 1 (8, 1)
-      network = ih :- O ho
-
-      inputs = [vector [0, 1], vector [1, 0], vector [1, 1], vector [0, 0]]
-      labels = [vector [1], vector [1], vector [0], vector [0]]
-
-      updated_network = session inputs network labels learning_rate (2, 1000)
-      results = map (`forward` updated_network) inputs
-  in print results
+main = do
+  putStrLn "Try the examples:"
+  putStrLn "- stack exec example-xor"

examples/xor.hs

@@ -4,28 +4,23 @@ module Main where
   import Data.List
   import Debug.Trace
 
-  -- 1x2
-  -- 2x3 + 1x3
-  -- 3x1 + 1x1
-
-  -- main :: IO [()]
-  main =
+  main = do
     let learning_rate = 0.5
         (iterations, epochs) = (2, 1000)
-        ih = randomLayer 0 (2, 8)
-        ho = randomLayer 1 (8, 1)
-        network = ih :- O ho
+        rnetwork = randomNetwork 0 2 [8] 1 -- two inputs, 8 nodes in a single hidden layer, 1 output
 
         inputs = [vector [0, 1], vector [1, 0], vector [1, 1], vector [0, 0]]
         labels = [vector [1], vector [1], vector [0], vector [0]]
 
-        updated_network = session inputs network labels learning_rate (iterations, epochs)
-        results = map (`forward` updated_network) inputs
+        network = session inputs rnetwork labels learning_rate (iterations, epochs)
+        results = map (`forward` network) inputs
         rounded = map (map round . toList) results
-    in sequence [putStrLn $ "inputs: " ++ show inputs,
-                 putStrLn $ "labels: " ++ show labels,
-                 putStrLn $ "learning rate: " ++ show learning_rate,
-                 putStrLn $ "iterations/epochs: " ++ show (iterations, epochs),
-                 putStrLn "...",
-                 putStrLn $ "rounded result: " ++ show rounded,
-                 putStrLn $ "actual result: " ++ show results]
+
+    putStrLn "parameters: "
+    putStrLn $ "- inputs: " ++ show inputs
+    putStrLn $ "- labels: " ++ show labels
+    putStrLn $ "- learning rate: " ++ show learning_rate
+    putStrLn $ "- iterations/epochs: " ++ show (iterations, epochs)
+    putStrLn "results: "
+    putStrLn $ "- actual result: " ++ show results
+    putStrLn $ "- rounded result: " ++ show rounded

src/Sibe.hs

@@ -10,6 +10,7 @@ module Sibe
      Output,
      forward,
      randomLayer,
+     randomNetwork,
      train,
      session,
      shuffle,
@@ -45,6 +46,13 @@ module Sibe
             biases  = randomVector seed Uniform wc * 2 - 1
         in L biases weights
 
+      randomNetwork :: Seed -> Int -> [Int] -> Int -> Network
+      randomNetwork seed input [] output =
+        O $ randomLayer seed (input, output)
+      randomNetwork seed input (h:hs) output =
+        randomLayer seed (input, h) :-
+        randomNetwork (seed + 1) h hs output
+
       logistic :: Double -> Double
       logistic x = 1 / (1 + exp (-x))