Neural Network giving wrong outputs - delphi

Question

I am trying to get my first neural network working, though no matter what I do, the network never seems to get to the correct answer.
Here is the output after the network reached an MSE of 0.0001
0 XOR 0 = 0.0118003716248665
1 XOR 1 = 0.994320073237859
1 XOR 0 = 0.818618888320916
0 XOR 1 = 0.985995457430471
The problem: these answers are incorrect.
I create a network with 2 inputs, 2 hidden neurons, and 1 output, the XOR problem has been solved using the same amounts, so that possibility is ruled out (I guess).
As a side note, I converted this code from a C# example found on another site, the C# code executes and works perfectly, so this is most likely a logic error or miscalculation somewhere :/
Now, unfortunately I have been totally unable to find the relevant piece of code leading up to the error, so I am going to have to post the entire code involving the Network here (sorry).
Edit: The UpdateWeights() function is the Back propagation, just thought I'd put this here in-case someone didn't catch it, the rest of the names and stuff is pretty understandable.
unit NeuralNetwork_u;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Math;
type TDoubleArray = array of Double;
type TDouble2DArray = array of TDoubleArray;
type TNeuralNetwork = class(TObject)
private
numInput, numHidden, numOutput : Integer;
inputs, hBiases, hSums, hOutputs, oBiases, oSums, Outputs, oGrads, hGrads, hPrevBiasesDelta, oPrevBiasesDelta : TDoubleArray;
ihWeights, hoWeights, ihPrevWeightsDelta, hoPrevWeightsDelta : TDouble2DArray;
public
constructor Create(NumInputs, NumHiddens, NumOutputs : Integer);
procedure SetWeights(weights : TDoubleArray);
function GetWeights : TDoubleArray;
function GetOutputs : TDoubleArray;
function ComputeOutputs( xvalues : TDoubleArray) : TDoubleArray;
function SigmoidFunction( X : Double) : Double;
function HyperTanFunction( X: Double) : Double;
procedure UpdateWeights( tValues : TDoubleArray ; learn, mom : Double);
function Train( TrainData : TDouble2DArray ; MaxEpochs : Integer ; LearningRate, Momentum, DesiredError : Double) : Double;
function WeightCount : Integer;
procedure Shuffle(Seq : array of Integer);
function MeanSquaredError(TrainData : TDouble2DArray) : Double;
end;
type THelper = class(TObject)
public
function MakeMatrix( Rows, Cols : Integer) : TDouble2DArray;
function Error(tValues, yValues : array of Double) : Double;
end;
implementation
uses NetworkInterface_u;
constructor TNeuralNetwork.Create(NumInputs, NumHiddens, NumOutputs : Integer);
var
Helper : THelper;
begin
Helper := THelper.Create;
numInput := NumInputs;
numHidden := NumHiddens;
numOutput := NumOutputs;
SetLength(inputs,numInput);
ihWeights := Helper.MakeMatrix(numInput, numHidden);
SetLength(hBiases,numHidden);
SetLength(hSums, numHidden);
SetLength(hOutputs, numHidden);
howeights := Helper.makeMatrix(numHidden, numOutput);
SetLength(oBiases,numOutput);
SetLength(oSums, numOutput);
SetLength(Outputs, numOutput);
SetLength(oGrads,numOutput);
SetLength(hGrads,numHidden);
ihPrevWeightsDelta := Helper.makeMatrix(numInput,numHidden);
SetLength(hPrevBiasesDelta,numHidden);
hoPrevWeightsDelta := Helper.makeMatrix(numHidden,numOutput);
SetLength(oPrevBiasesDelta,numOutput);
end;
unit NeuralNetwork_u;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Math;
type TDoubleArray = array of Double;
type TDouble2DArray = array of TDoubleArray;
type TNeuralNetwork = class(TObject)
private
numInput, numHidden, numOutput : Integer;
inputs, hBiases, hSums, hOutputs, oBiases, oSums, Outputs, oGrads, hGrads, hPrevBiasesDelta, oPrevBiasesDelta : TDoubleArray;
ihWeights, hoWeights, ihPrevWeightsDelta, hoPrevWeightsDelta : TDouble2DArray;
public
constructor Create(NumInputs, NumHiddens, NumOutputs : Integer);
procedure SetWeights(weights : TDoubleArray);
function GetWeights : TDoubleArray;
function GetOutputs : TDoubleArray;
function ComputeOutputs( xvalues : TDoubleArray) : TDoubleArray;
function SigmoidFunction( X : Double) : Double;
function HyperTanFunction( X: Double) : Double;
procedure UpdateWeights( tValues : TDoubleArray ; learn, mom : Double);
function Train( TrainData : TDouble2DArray ; MaxEpochs : Integer ; LearningRate, Momentum, DesiredError : Double) : Double;
function WeightCount : Integer;
procedure Shuffle( var Seq : array of Integer);
function MeanSquaredError(TrainData : TDouble2DArray) : Double;
end;
type THelper = class(TObject)
public
function MakeMatrix( Rows, Cols : Integer) : TDouble2DArray;
function Error(tValues, yValues : array of Double) : Double;
end;
implementation
uses NetworkInterface_u;
constructor TNeuralNetwork.Create(NumInputs, NumHiddens, NumOutputs : Integer);
var
Helper : THelper;
begin
Helper := THelper.Create;
numInput := NumInputs;
numHidden := NumHiddens;
numOutput := NumOutputs;
SetLength(inputs,numInput);
ihWeights := Helper.MakeMatrix(numInput, numHidden);
SetLength(hBiases,numHidden);
SetLength(hSums, numHidden);
SetLength(hOutputs, numHidden);
howeights := Helper.makeMatrix(numHidden, numOutput);
SetLength(oBiases,numOutput);
SetLength(oSums, numOutput);
SetLength(Outputs, numOutput);
SetLength(oGrads,numOutput);
SetLength(hGrads,numHidden);
ihPrevWeightsDelta := Helper.makeMatrix(numInput,numHidden);
SetLength(hPrevBiasesDelta,numHidden);
hoPrevWeightsDelta := Helper.makeMatrix(numHidden,numOutput);
SetLength(oPrevBiasesDelta,numOutput);
end;
procedure TNeuralNetwork.SetWeights(weights : TDoubleArray);
var
numWeights : Integer;
i, k, j : Integer;
begin
numWeights := (numInput * numHidden) + (numHidden * numOutput) + numHidden + numOutput;
if High(weights) <> numWeights then
begin
Raise Exception.Create('The Weights Array Length Does Not match The Total Number Of Weights And Biases - ' + IntToStr(numWeights));
end;
k := 0;
for i := 0 to numInput-1 do
begin
for j := 0 to numHidden-1 do
begin
ihWeights[i][j] := weights[k];
Inc(k);
end;
end;
for i := 0 to numHidden-1 do
begin
hBiases[i] := weights[k];
Inc(k);
end;
for i := 0 to numHidden-1 do
begin
for j := 0 to numOutput-1 do
begin
hoWeights[i][j] := weights[k];
Inc(k);
end;
end;
for i := 0 to numOutput-1 do
begin
oBiases[i] := weights[k];
Inc(k);
end;
end;
function TNeuralNetwork.GetWeights : TDoubleArray;
var
numWeights : Integer;
k, i, j : Integer;
begin
numWeights := (numInput * numHidden) + (numHidden * numOutput) + numHidden + numOutput;
SetLength(Result,numWeights);
k := 0;
for i := 0 to Length(ihWeights)-1 do
begin
for j := 0 to Length(ihWeights[0])-1 do
begin
Result[k] := ihWeights[i][j];
Inc(k);
end;
end;
for i := 0 to Length(hBiases)-1 do
begin
Result[k] := hBiases[i];
Inc(k);
end;
for i := 0 to Length(hoWeights)-1 do
begin
for j := 0 to Length(hoWeights[0])-1 do
begin
Result[k] := hoWeights[i][j] ;
Inc(k);
end;
end;
for i := 0 to Length(oBiases)-1 do
begin
Result[k] := oBiases[i];
Inc(k);
end;
end;
function TNeuralnetwork.GetOutputs : TDoubleArray;
begin
SetLength(Result, numOutput-1);
Result := Outputs;
end;
Function TNeuralNetwork.ComputeOutputs( xValues : TDoubleArray) : TDoubleArray;
var
i, j : Integer;
begin
if Length(xvalues) <> numInput then
begin
raise Exception.Create('Inputs Array Does Not Match Neural Network Inputs Count = Array ' + IntToStr(Length(xValues)) + ' Input Count ' + IntToStr(numInput));
end;
for i := 0 to numHidden-1 do
begin
hSums[i] := 0.0;
end;
for i := 0 to numOutput-1 do
begin
oSums[i] := 0.0;
end;
for i := 0 to Length(xValues)-1 do
begin
inputs[i] := xValues[i];
end;
for j := 0 to numHidden-1 do
begin
for i := 0 to numInput-1 do
begin
hSums[j] := hSums[j] + (inputs[i]*ihWeights[i][j]);
end;
end;
for i := 0 to numHidden-1 do
begin
hSums[i] := hSums[i] + hBiases[i];
end;
for i := 0 to numHidden-1 do
begin
hOutputs[i] := HyperTanFunction(hSums[i]);
end;
for j := 0 to numOutput-1 do
begin
for i := 0 to numHidden-1 do
begin
oSums[j] := oSums[j] + (hOutputs[i] * hoWeights[i][j]);
end;
end;
for i := 0 to numOutput-1 do
begin
oSums[i] := oSums[i] + oBiases[i];
end;
for i := 0 to numOutput-1 do
begin
Outputs[i] := HyperTanFunction(oSums[i]);
end;
Result := Outputs;
end;
function TNeuralNetwork.SigmoidFunction(X : Double) : Double;
begin
if x < -45.0 then
Result := 0
else if x > 45.0 then
Result := 1
else
Result := 1.0 / (1.0 + Exp(-x));
end;
function TNeuralNetwork.HyperTanFunction( X : Double) : Double;
begin
if x < -45.0 then
Result := -1
else if x > 45.0 then
Result := 1
else
Result := Tanh(X);
end;
procedure TNeuralNetwork.UpdateWeights(tValues : TDoubleArray ; learn, mom : Double);
var
i, j : Integer;
derivative, sum, delta,X : Double;
begin
if Length(tValues) <> numOutput then
begin
Raise Exception.Create('Target Values Not Same Length As Output = ' + IntToStr(Length(tValues)) + ' - Outputcount = ' + IntToStr(numOutput));
end;
for i := 0 to Length(oGrads)-1 do
begin
derivative := (1 - outputs[i]) * outputs[i];
oGrads[i] := derivative * (tValues[i] - outputs[i]);
end;
for i := 0 to Length(hGrads)-1 do
begin
derivative := (1 - hOutputs[i]) * (1 + hOutputs[i]);
sum := 0;
for j := 0 to numOutput-1 do
begin
X := oGrads[j] * hoWeights[i][j];
sum := sum + X;
end;
hGrads[i] := derivative * sum;
end;
for i := 0 to Length(ihWeights)-1 do
begin
for j := 0 to Length(ihWeights[0])-1 do
begin
delta := learn * hGrads[j] * inputs[i];
ihWeights[i][j] := ihWeights[i][j] + delta;
ihWeights[i][j] := ihWeights[i][j] + (mom * ihPrevWeightsDelta[i][j]);
ihPrevWeightsDelta[i][j] := delta;
end;
end;
for i := 0 to Length(hBiases)-1 do
begin
delta := learn * hGrads[i] * 1.0;
hBiases[i] := hBiases[i] + delta;
hBiases[i] := hBiases[i] + (mom * hPrevBiasesDelta[i]);
hPrevBiasesDelta[i] := delta;
end;
for i := 0 to Length(hoWeights)-1 do
begin
for j := 0 to Length(hoWeights[0])-1 do
begin
delta := learn * oGrads[j] * hOutputs[i];
hoWeights[i][j] := hoWeights[i][j] + delta;
hoWeights[i][j] := hoWeights[i][j] + (mom * hoPrevWeightsDelta[i][j]);
hoPrevWeightsDelta[i][j] := delta;
end;
end;
for i := 0 to Length(oBiases)-1 do
begin
delta := learn * oGrads[i] * 1.0;
oBiases[i] := oBiases[i] + delta;
oBiases[i] := oBiases[i] + (mom * oPrevBiasesDelta[i]);
oPrevBiasesDelta[i] := delta;
end;
end;
function TNeuralNetwork.Train( TrainData : TDouble2DArray ; MaxEpochs : Integer ; LearningRate, Momentum, DesiredError : Double) : Double;
var
Epoch, I, Idx, c : Integer;
xValues : TDoubleArray;
tValues : TDoubleArray;
Sequence : Array of Integer;
MeanSquaredErrorr : Double;
Helper : THelper;
begin
Epoch := 0;
SetLength(xValues,numInput);
SetLength(tValues,numOutput+1);
SetLength(Sequence,Length(TrainData));
for I := 0 to Length(Sequence)-1 do
Sequence[I] := I;
Shuffle(Sequence);
while Epoch < MaxEpochs do
begin
frmNetworkInterface.redTraining.Lines.Add('Current Epoch - ' + IntToStr(Epoch) + ' : error = ' + FloatToStr(MeanSquaredErrorr) + ' and Desired Error is = ' + FloatToStr(DesiredError));
Application.ProcessMessages;
MeanSquaredErrorr := MeanSquaredError(TrainData);
if MeanSquaredErrorr < DesiredError then
Break;
for I := 0 to Length(TrainData)-1 do
begin
Idx := Sequence[i];
xValues := Copy(TrainData[Idx],0,numInput);
tValues := Copy(TrainData[Idx],numInput,numOutput);
ComputeOutputs(xValues);
UpdateWeights(tValues,LearningRate,Momentum);
end;
Inc(Epoch);
Result := MeanSquaredErrorr;
end;
end;
procedure TNeuralNetwork.Shuffle( var Seq : array of Integer);
var
I, R, Tmp : Integer;
begin
for I := 0 to Length(Seq)-1 do
begin
R := RandomRange(i,Length(Seq));
Tmp := Seq[i];
Seq[R] := Seq[I];
Seq[I] := Tmp;
end;
end;
function TNeuralNetwork.MeanSquaredError(TrainData : TDouble2DArray) : Double;
var
sumSquaredError, err : Double;
xValues, tValues, yValues : TDoubleArray;
I, J : Integer;
begin
sumSquaredError := 0;
SetLength(xValues,numInput);
SetLength(tvalues,numOutput);
for I := 0 to Length(TrainData)-1 do
begin
xValues := Copy(TrainData[I],0,numInput);
tValues := Copy(TrainData[I],numInput,numOutput);
yValues := ComputeOutputs(xValues);
for J := 0 to numOutput-1 do
begin
err := tValues[j] - yValues[j];
sumSquaredError := sumSquaredError + (err * err);
end;
end;
Result := sumSquaredError / Length(TrainData);
end;
function TNeuralNetwork.WeightCount : Integer;
begin
Result := (numInput * numHidden) + (numHidden * numOutput) + numHidden + numOutput;
end;
function THelper.MakeMatrix(Rows, Cols : Integer) : TDouble2DArray;
begin
SetLength(Result,Rows,Cols);
end;
function THelper.Error(tValues : array of Double ; yValues : array of Double) : Double;
var
sum : Double;
i : Integer;
begin
sum := 0.0;
for i := 0 to High(tValues)-1 do
begin
sum := sum + ((tValues[i] - yValues[i]) * (tValues[i] - yValues[i]));
end;
Result := Sqrt(sum);
end;
end.
I have been through this code nearly a hundred times now, and no answer comes to light, no logic error or miscalculation found, however, as I know the C# example works, this should too.
EDIT :
Observation: it seems to me, whenever the second value I pass in is 1, the network automatically makes the output way too big (values of the weights involved with the second input are way too large for my tastes?), hence 1 XOR 1 is wrong, because the second value is 1 (see the data above).
EDIT :
Here is the initial weights of one network i just ran (2 input, 2 hidden, 1 output)
Initial Weight0 - 0.0372207039175555
Initial Weight1 - 0.01092082898831
Initial Weight2 - 0.0755334409791976
Initial Weight3 - 0.0866588755254634
Initial Weight4 - 0.0626101282471791
Initial Weight5 - 0.0365478269639425
Initial Weight6 - 0.0724486718699336
Initial Weight7 - 0.0320405319170095
Initial Weight8 - 0.0680674042692408
And after 132 Epochs (an error of 0.001)
Final Weight 0 = 0.432341693850932
Final Weight 1 = 0.338041456780997
Final Weight 2 = 1.0096817584107
Final Weight 3 = 0.839104863469981
Final Weight 4 = -0.275763414588823
Final Weight 5 = -0.171414938983027
Final Weight 6 = 1.26394969109634
Final Weight 7 = 0.998915778388676
Final Weight 8 = 0.549501870374428
EDIT: So a new development has come to light, an error when passing in the TrainingData caused it to identify 1 XOR 1 = 1, however, after fixing this error, the network cant converge on an answer (ran 100 networks, 10 thousand epochs each) the lowest MSE (Mean Squared Error) I got was
Current Epoch - 9999 : error = 0.487600332892658 and Desired Error is = 0.001
I logged the input and outputs sent into the network on each epoch of training and identified that they all were correct now, so now it just seems that the network is unable to solve the problem?
Also, I'm updating the code to my most recent version. (08/26/2015)
Whats new in this code :
Fixed Copy indices that was 1 instead of 0.
Can confirm that the Inputs and Desired outputs is correctly copied now.
EDIT : The MSE of the network is actually INCREASING now, here is the initial error :
0.467486419821747,
and after 10000 Epochs,
0.487600332892658,
the overall error increased with
0.020113913070917
... This leads me to believe that either my Training procedure, or the UpdateWeights procedure is faulty...
EDIT : Another observation I made, is that the Mean Square Error of the network caps out on 2.5 ( when running an insanely long training session to make it move that much ) The damn MSE is going up instead of going down??
EDIT : Another observation of output of the network whilst training
Current Epoch - 233 : error = 0.802251346201161 and Desired Error is = 0.0001
Current Epoch - 234 : error = 1.24798705066641 and Desired Error is = 0.0001
Current Epoch - 235 : error = 2.47206076545025 and Desired Error is = 0.0001
Current Epoch - 236 : error = 2.49999999811955 and Desired Error is = 0.0001
A radical jump from 1.24 was seen to 2.49 , The network is clearly getting errors in the functions having to do with either training or weight changing.

Answer 1

I suspect from your code that the original works in degrees (because you use constants like -45.0) and Delphi works in radians, so wherever you have 45 you need (PI/4) etc. It is likely that during training you are running out of epochs before you reach the accuracy required because the functions can go out of range.