Basic Feed-Forward Neural network (without training code)

//------------------------------- Create Network ------------------------------- 
type Neuron  = { Weights : float  list ; Bias : float }
type Layer   = { Neurons : Neuron list }
type Network = { Layers  : Layer  list }

let rnd = System.Random()

let randomWeight _ = (2.0 * rnd.NextDouble()) - 1.0

let buildNeuron inputs =
    { Neuron.Weights = List.init inputs randomWeight ; Bias = randomWeight ()}

let buildLayer inputs neurons =
    { Layer.Neurons = List.init neurons (fun i -> buildNeuron inputs) }

let buildNetwork inputs layerSizes =
    let rec createLayers acc inputs layers =
        match layers with
        | [] -> acc
        | neurons :: nextSizes ->
            let newLayer = buildLayer inputs neurons
            createLayers (newLayer :: acc) neurons nextSizes
    { Network.Layers = List.rev (createLayers [] inputs layerSizes) }

//------------------------------- Compute Result ------------------------------- 
let activation = tanh

let neuronOutput neuron inputs =
    let weightedSum = 
        List.zip neuron.Weights inputs 
        |> List.sumBy (fun (w, i) -> w * i)
    activation (weightedSum + neuron.Bias)

let layerOutput layer inputs =
    layer.Neurons 
    |> List.map (fun neuron -> neuronOutput neuron inputs)

let feedForwardResult network inputs =
    let rec ff activationResult layers =
        match layers with
        | [] -> activationResult
        | layer :: remainingLayers -> 
            let nextLayerInput = layerOutput layer activationResult
            ff nextLayerInput remainingLayers 
    ff inputs network.Layers

//------------------------------- Compute Errors ------------------------------- 
type TrainingCase = { Inputs : float list; Outputs : float list }

let neuronError (expected, computed) =
    let error = expected - computed
    error * error

let layerError (expectedLastLayer, actualLastLayer) =
    List.zip actualLastLayer expectedLastLayer
    |> List.sumBy neuronError

let networkError network trainingCases =
    let expectedResults = trainingCases |> List.map (fun case -> case.Outputs)
    let networkResults  = trainingCases |> List.map (fun case -> feedForwardResult network case.Inputs)
    List.zip expectedResults networkResults
    |> List.sumBy layerError

//------------------------------- Modify Network ------------------------------- 
// TODO: Implement gradient/feature based algorithm for complex problems
//------------------------------- Train Network ------------------------------- 
let randomSearch (trainingSet : TrainingCase list) maxSeconds  =
    let inputs = trainingSet.Head.Inputs.Length
    let outputs = trainingSet.Head.Outputs.Length

    let createNetwork () = buildNetwork inputs [inputs;inputs;outputs]
    let stopwatch = System.Diagnostics.Stopwatch.StartNew()

    let rec findNext bestNetwork oldError =
        match stopwatch.Elapsed.TotalSeconds with
        | timeSpent when timeSpent > maxSeconds -> bestNetwork
        | _ ->
            let nn = createNetwork ()
            let newError = networkError nn trainingSet
            match newError < oldError with
            | true ->
                printfn "Better network found! %f" newError
                findNext nn newError
            |false ->
                findNext bestNetwork oldError
    findNext (createNetwork ()) System.Double.MaxValue

//----------------------------------- Test  ----------------------------------- 
let case1 = {Inputs = [1.0;1.0] ; Outputs = [0.0]}
let case2 = {Inputs = [0.0;1.0] ; Outputs = [1.0]}
let case3 = {Inputs = [1.0;0.0] ; Outputs = [1.0]}
let case4 = {Inputs = [0.0;0.0] ; Outputs = [0.0]}

let xorGate = [case1;case2;case3;case4]

let trainedNetwork = randomSearch xorGate 10.0

let computedValues = 
    xorGate 
    |> List.map (fun case -> feedForwardResult trainedNetwork case.Inputs)
    |> List.sortDescending

let xorOutput case = (feedForwardResult trainedNetwork case.Inputs).[0] > (computedValues).[2].[0]

xorGate |> List.iter (fun case -> printfn "XOR result of %A is %A" case.Inputs (xorOutput case))