namespace plasFridge
module NeuralNetwork = begin

open System

let rnd = new Random(0xDA22A)
let output (s:string) = Console.Write(s)

(* -------------------------------------------------------------------------------------------------------------------------------- *)
(* Neuron																															*)
(* -------------------------------------------------------------------------------------------------------------------------------- *)

type Neuron =
  class
    val mutable output : float										(* output value *)
    val mutable error : float										(* error value *)
    val mutable weights : float list								(* weights from each previous layer to this neuron *)
    val mutable bias : float										(* neuron bias *)
    val ActivationFunction : float -> bool -> float					(* activation function *)
    
    new (inputs, activationFunction) = 
    {
      ActivationFunction = activationFunction;
      weights = List.init inputs (fun _ -> rnd.NextDouble());
      bias = 0.0;
      output = 0.0;
      error = 0.0
    }
    
    member x.Bias = x.bias
    member x.Output with get() = x.output
    member x.Weights = x.weights
    
    member x.GetOutput inputs = 
      let preActivation = List.fold_left2 (fun sum weight input -> sum + (weight * input)) (-x.bias) x.weights inputs in
        (x.ActivationFunction) preActivation false
    
    member x.UpdateOutput inputs = 
      x.output <- x.GetOutput inputs
    
    member x.GetError errorInputs = 
      List.fold_left2 (fun sum weight errorInput -> sum + (weight * errorInput)) (0.0) x.weights errorInputs
    
    member x.UpdateError errorInputs = 
      x.error <- x.GetError errorInputs
  end

(* -------------------------------------------------------------------------------------------------------------------------------- *)
(* Layer																															*)
(* -------------------------------------------------------------------------------------------------------------------------------- *)

type Layer = 
  class
    val inputs : int												(* should be the number of neurons from the previous layer *)
    val neurons : Neuron list										(* neurons in this layer *)
    val mutable output : float list									(* outputs of each neuron *)
    
    new (inputs, neurons, activationFunction) = {
      inputs = inputs;
      neurons = List.init neurons (fun _ -> new Neuron(inputs, activationFunction));
      output = List.init inputs (fun _ -> 0.0)
    }
    
    member x.Output with get() = x.output
    member x.GetOutput inputs = List.init (x.neurons.Length) (fun i -> (List.nth x.neurons i).GetOutput(inputs))
    member x.UpdateOutput inputs = x.output <- x.GetOutput inputs
    
    member x.Neuron n = List.nth x.neurons n
    member x.Neurons with get() = x.neurons
  end

(* -------------------------------------------------------------------------------------------------------------------------------- *)
(* ANN																																*)
(* -------------------------------------------------------------------------------------------------------------------------------- *)

type ANN =
  class
    val layers : Layer list
    
    new ((layerNeurons:int list), activationFunction) =
    {
		layers = List.init 
		  layerNeurons.Length 
		  (fun i -> match i with
		     | 0 -> new Layer(List.nth layerNeurons 0, List.nth layerNeurons 0, activationFunction)
		     | _ -> new Layer(List.nth layerNeurons (i - 1), List.nth layerNeurons i, activationFunction)
		  );
    }
    
    member x.Layer n = List.nth x.layers n
    member x.Layers = x.layers.Length
    member x.InputLayer with get() = x.Layer 0
    member x.OutputLayer with get() = x.Layer (x.layers.Length - 1)
    member x.Neuron layer neuron = ((x.Layer layer).Neuron neuron)
    member x.Neurons layer = (List.nth x.layers layer)
    member x.Output with get() = x.OutputLayer.Output
    
    member x.GetOutput (inputs:float list) = 
      let rec calcLayer (input:float list) (layers:Layer list) = 
        match layers with
          | [] -> input
          | h::tail -> calcLayer (h.GetOutput(input)) tail in
        
        calcLayer inputs x.layers
    
    member x.UpdateOutput (inputs:float list) = 
      let rec updateLayer (input:float list) (layers:Layer list) =
        match layers with
          | [] -> ()
          | h::tail -> h.UpdateOutput(input); updateLayer (h.Output) tail in
          
        updateLayer inputs x.layers
          
    member x.Train (trainingData:(float list * float list) list) learning_rate max_iterations mse_threshold = 
      let train (input,output) = 
      
        let updateWeights layer_n backInput =
          let layerOutput = (x.Layer layer_n).Output in
          let layerInput = match layer_n with
            | 0 -> input
            | _ -> (x.Layer (layer_n - 1)).Output in
          let error = List.map2 (fun z g -> z * (1.0 - z) * g) layerOutput backInput in
          List.iteri (fun i e -> ((x.Layer layer_n).Neuron i).error <- e) error;
          let change = List.map (fun e -> learning_rate * e) error in
          
          List.iteri 
          (
            fun i change ->
              let weights = ((x.Layer layer_n).Neuron i).Weights in
              let newWeights = List.map2 (fun oldW diff -> oldW + diff) weights (List.map (fun x -> x * change) layerInput) in
              ((x.Layer layer_n).Neuron i).weights <- newWeights
          ) change           
        in
        
        x.UpdateOutput(input);
        
        (* difference between expected and actual *)
        let error = List.map2 (fun actual expected -> expected - actual) x.Output output in
        
        (* mean squared error *)
        let MSE = (List.fold_left (fun mse e -> mse + (e * e)) 0.0 error) / 2.0 in
          
        (* update output layer *)
        updateWeights (x.Layers - 1) error;
        
        (* update hidden layers + input layer *)
		let rec processLayer l = match l >= 0 with
		  | true ->
            let g = List.init (x.Layer l).Neurons.Length (fun i -> List.fold_left (fun prev neuron -> prev + ((List.nth neuron.weights i) * neuron.error)) 0.0 (x.Layer (l+1)).Neurons) in
              updateWeights l g;
              processLayer (l - 1)
          | _ -> () in
        
        processLayer (x.Layers - 2);
        
        MSE
        
      in 
      
      let mutable i = 0 in
      let mutable mse = 1.0 in
      while (i < max_iterations && mse > mse_threshold) do 
        let (tmp_i, tmp_mse) = List.fold_left 
        (
          fun (prev_i,_) data -> 
            let mse = train data in
              if ((prev_i + 1) mod 500 = 0) then output (String.Format("Iteration {0,5}: MSE {1,10}\n", prev_i + 1, mse));
          
          (prev_i + 1, train data)
          
         )
         (i,0.0) 
         trainingData in
          i <- tmp_i;
          mse <- tmp_mse;
          
      done
      
  end

(* -------------------------------------------------------------------------------------------------------------------------------- *)
(* Activation Functions																												*)
(* -------------------------------------------------------------------------------------------------------------------------------- *)

let NoActivationFunction input _ = input

let SigmoidActivationFunction input primed = 
  let alpha = 1.0 in
  match primed with
  | true -> alpha * input * (1.0 - input)
  | _ -> 1.0 / (1.0 + (exp (-alpha * input)))
 
end