Skip to content

Commit 341f4bf

Browse files
Coding neuralfit
1 parent 5493e26 commit 341f4bf

File tree

2 files changed

+104
-37
lines changed

2 files changed

+104
-37
lines changed

neural/neuralfit.pas

Lines changed: 102 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ TNeuralFitBase = class(TMObject)
2424
FNN: TNNet;
2525
FGlobalHit: integer;
2626
FGlobalMiss: integer;
27+
FGlobalTotal: integer;
2728
FGlobalTotalLoss: single;
2829
FGlobalErrorSum: single;
2930
FFinishedThread: TNNetVolume;
@@ -71,18 +72,18 @@ TNeuralFitBase = class(TMObject)
7172
property Verbose: boolean read FVerbose write FVerbose;
7273
end;
7374

74-
TNNetDefineHitFn = function(vPair: TNNetVolumePair): boolean of object;
7575
TNNetDataAugmentationFn = function(vPair: TNNetVolume): TNeuralFloat of object;
7676
TNNetLossFn = function(vPair: TNNetVolume): TNeuralFloat of object;
77+
TNNetInferHitFn = function(A, B: TNNetVolume): boolean;
7778

7879
/// Generic Neural Network Fitting Algorithm
7980
TNeuralFit = class(TNeuralFitBase)
8081
protected
8182
FTrainingVolumes, FValidationVolumes, FTestVolumes: TNNetVolumePairList;
8283
FWorkingVolumes: TNNetVolumePairList;
8384

84-
FInferHitFn: TNNetDefineHitFn;
8585
FDataAugmentationFn: TNNetDataAugmentationFn;
86+
FInferHitFn: TNNetInferHitFn;
8687
FLossFn: TNNetLossFn;
8788
public
8889
constructor Create();
@@ -95,6 +96,12 @@ TNeuralFit = class(TNeuralFitBase)
9596
Item: TMultiThreadProcItem);
9697
procedure TestNNThread(Index: PtrInt; Data: Pointer;
9798
Item: TMultiThreadProcItem);
99+
procedure EnableMonopolarHitComparison();
100+
procedure EnableBipolarHitComparison();
101+
102+
property DataAugmentationFn: TNNetDataAugmentationFn read FDataAugmentationFn write FDataAugmentationFn;
103+
property InferHitFn: TNNetInferHitFn read FInferHitFn write FInferHitFn;
104+
property LossFn: TNNetLossFn read FLossFn write FLossFn;
98105
end;
99106

100107
/// Image Classification Fitting Algorithm
@@ -121,10 +128,52 @@ TNeuralImageFit = class(TNeuralFitBase)
121128
procedure ClassifyImage(pNN: TNNet; pImgInput, pOutput: TNNetVolume);
122129
end;
123130

131+
132+
function MonopolarCompare(A, B: TNNetVolume): boolean;
133+
function BipolarCompare(A, B: TNNetVolume): boolean;
134+
124135
implementation
125136
uses
126137
math;
127138

139+
function MonopolarCompare(A, B: TNNetVolume): boolean;
140+
var
141+
Pos: integer;
142+
ACount, BCount: integer;
143+
begin
144+
ACount := A.Size;
145+
BCount := B.Size;
146+
Result := (ACount>0) and (ACount = BCount);
147+
Pos := 0;
148+
while Result and (Pos < ACount) do
149+
begin
150+
Result := Result and (
151+
( (A.FData[Pos]>0.5) and (B.FData[Pos]>0.5) ) or
152+
( (A.FData[Pos]<0.5) and (B.FData[Pos]<0.5) )
153+
);
154+
Inc(Pos);
155+
end;
156+
end;
157+
158+
function BipolarCompare(A, B: TNNetVolume): boolean;
159+
var
160+
Pos: integer;
161+
ACount, BCount: integer;
162+
begin
163+
ACount := A.Size;
164+
BCount := B.Size;
165+
Result := (ACount>0) and (ACount = BCount);
166+
Pos := 0;
167+
while Result and (Pos < ACount) do
168+
begin
169+
Result := Result and (
170+
( (A.FData[Pos]>0) and (B.FData[Pos]>0) ) or
171+
( (A.FData[Pos]<0) and (B.FData[Pos]<0) )
172+
);
173+
Inc(Pos);
174+
end;
175+
end;
176+
128177
constructor TNeuralFit.Create();
129178
begin
130179
inherited Create();
@@ -263,11 +312,12 @@ procedure TNeuralFit.Fit(pNN: TNNet; pTrainingVolumes, pValidationVolumes,
263312
FNN.UpdateWeights();
264313
FNN.ComputeL2Decay();
265314

266-
if (FGlobalHit > 0) then
315+
FGlobalTotal := (FGlobalHit + FGlobalMiss);
316+
if (FGlobalTotal > 0) then
267317
begin
268-
TrainingError := FGlobalErrorSum / (FGlobalHit + FGlobalMiss);
269-
TrainingLoss := FGlobalTotalLoss / (FGlobalHit + FGlobalMiss);
270-
CurrentAccuracy := (FGlobalHit*100) div (FGlobalHit+FGlobalMiss);
318+
TrainingError := FGlobalErrorSum / FGlobalTotal;
319+
TrainingLoss := FGlobalTotalLoss / FGlobalTotal;
320+
CurrentAccuracy := (FGlobalHit*100) div FGlobalTotal;
271321
if (FStepSize < 100) then
272322
begin
273323
AccuracyWithInertia := AccuracyWithInertia*0.99 + CurrentAccuracy*0.01;
@@ -282,7 +332,7 @@ procedure TNeuralFit.Fit(pNN: TNNet; pTrainingVolumes, pValidationVolumes,
282332
end;
283333
end;
284334

285-
if ( (FGlobalHit > 0) and (I mod 10 = 0) ) then
335+
if ( (FGlobalTotal > 0) and (I mod 10 = 0) ) then
286336
begin
287337
totalTimeSeconds := (Now() - startTime) * 24 * 60 * 60;
288338

@@ -334,11 +384,12 @@ procedure TNeuralFit.Fit(pNN: TNNet; pTrainingVolumes, pValidationVolumes,
334384
FMessageProc('Starting Validation.');
335385
ProcThreadPool.DoParallel(@TestNNThread, 0, FThreadNN.Count-1, Nil, FThreadNN.Count);
336386

337-
if FGlobalHit + FGlobalMiss > 0 then
387+
FGlobalTotal := (FGlobalHit + FGlobalMiss);
388+
if FGlobalTotal > 0 then
338389
begin
339-
ValidationRate := FGlobalHit / (FGlobalHit + FGlobalMiss);
340-
ValidationLoss := FGlobalTotalLoss / (FGlobalHit + FGlobalMiss);
341-
ValidationError := FGlobalErrorSum / (FGlobalHit + FGlobalMiss);
390+
ValidationRate := FGlobalHit / FGlobalTotal;
391+
ValidationLoss := FGlobalTotalLoss / FGlobalTotal;
392+
ValidationError := FGlobalErrorSum / FGlobalTotal;
342393
end;
343394

344395
if (ValidationRate > ValidationRecord) then
@@ -384,13 +435,14 @@ procedure TNeuralFit.Fit(pNN: TNNet; pTrainingVolumes, pValidationVolumes,
384435
FMessageProc('Starting Testing.');
385436
ProcThreadPool.DoParallel(@TestNNThread, 0, FThreadNN.Count-1, Nil, FThreadNN.Count);
386437

387-
if FGlobalHit + FGlobalMiss > 0 then
438+
FGlobalTotal := (FGlobalHit + FGlobalMiss);
439+
if FGlobalTotal > 0 then
388440
begin
389-
TestRate := FGlobalHit / (FGlobalHit + FGlobalMiss);
390-
TestLoss := FGlobalTotalLoss / (FGlobalHit + FGlobalMiss);
391-
TestError := FGlobalErrorSum / (FGlobalHit + FGlobalMiss);
441+
TestRate := FGlobalHit / FGlobalTotal;
442+
TestLoss := FGlobalTotalLoss / FGlobalTotal;
443+
TestError := FGlobalErrorSum / FGlobalTotal;
392444
end;
393-
if (FGlobalHit > 0) and (FVerbose) then
445+
if (FGlobalTotal > 0) and (FVerbose) then
394446
begin
395447
WriteLn(
396448
'Epochs: ', iEpochCount,
@@ -520,7 +572,7 @@ procedure TNeuralFit.RunNNThread(Index: PtrInt; Data: Pointer;
520572

521573
if Assigned(FInferHitFn) then
522574
begin
523-
if FInferHitFn(FTrainingVolumes[ElementIdx]) then
575+
if FInferHitFn(FTrainingVolumes[ElementIdx].O, pOutput) then
524576
begin
525577
Inc(LocalHit);
526578
end
@@ -612,7 +664,7 @@ procedure TNeuralFit.TestNNThread(Index: PtrInt; Data: Pointer;
612664

613665
if Assigned(FInferHitFn) then
614666
begin
615-
if FInferHitFn(FTrainingVolumes[ElementIdx]) then
667+
if FInferHitFn(FTrainingVolumes[ElementIdx].O, pOutput) then
616668
begin
617669
Inc(LocalHit);
618670
end
@@ -640,6 +692,16 @@ procedure TNeuralFit.TestNNThread(Index: PtrInt; Data: Pointer;
640692
pOutput.Free;
641693
end;
642694

695+
procedure TNeuralFit.EnableMonopolarHitComparison();
696+
begin
697+
FInferHitFn := @MonopolarCompare;
698+
end;
699+
700+
procedure TNeuralFit.EnableBipolarHitComparison();
701+
begin
702+
FInferHitFn := @BipolarCompare;
703+
end;
704+
643705
{ TNeuralFitBase }
644706

645707
constructor TNeuralFitBase.Create();
@@ -809,8 +871,8 @@ procedure TNeuralImageFit.Fit(pNN: TNNet;
809871
' Step size:', FStepSize,
810872
' Staircase ephocs:',FStaircaseEpochs);
811873
if Assigned(FImgVolumes) then WriteLn('Training images:', FImgVolumes.Count);
812-
if Assigned(FImgValidationVolumes) then WriteLn('Training images:', FImgValidationVolumes.Count);
813-
if Assigned(FImgTestVolumes) then WriteLn('Training images:', FImgTestVolumes.Count);
874+
if Assigned(FImgValidationVolumes) then WriteLn('Validation images:', FImgValidationVolumes.Count);
875+
if Assigned(FImgTestVolumes) then WriteLn('Test images:', FImgTestVolumes.Count);
814876
end;
815877

816878
FThreadNN.SetLearningRate(FCurrentLearningRate, FInertia);
@@ -856,11 +918,12 @@ procedure TNeuralImageFit.Fit(pNN: TNNet;
856918
FNN.UpdateWeights();
857919
FNN.ComputeL2Decay();
858920

859-
if (FGlobalHit > 0) then
921+
FGlobalTotal := (FGlobalHit + FGlobalMiss);
922+
if (FGlobalTotal > 0) then
860923
begin
861-
TrainingError := FGlobalErrorSum / (FGlobalHit + FGlobalMiss);
862-
TrainingLoss := FGlobalTotalLoss / (FGlobalHit + FGlobalMiss);
863-
CurrentAccuracy := (FGlobalHit*100) div (FGlobalHit+FGlobalMiss);
924+
TrainingError := FGlobalErrorSum / FGlobalTotal;
925+
TrainingLoss := FGlobalTotalLoss / FGlobalTotal;
926+
CurrentAccuracy := (FGlobalHit*100) div FGlobalTotal;
864927
if (FStepSize < 100) then
865928
begin
866929
AccuracyWithInertia := AccuracyWithInertia*0.99 + CurrentAccuracy*0.01;
@@ -875,7 +938,7 @@ procedure TNeuralImageFit.Fit(pNN: TNNet;
875938
end;
876939
end;
877940

878-
if ( (FGlobalHit > 0) and (I mod 10 = 0) ) then
941+
if ( (FGlobalTotal > 0) and (I mod 10 = 0) ) then
879942
begin
880943
totalTimeSeconds := (Now() - startTime) * 24 * 60 * 60;
881944

@@ -927,11 +990,12 @@ procedure TNeuralImageFit.Fit(pNN: TNNet;
927990
FMessageProc('Starting Validation.');
928991
ProcThreadPool.DoParallel(@TestNNThread, 0, FThreadNN.Count-1, Nil, FThreadNN.Count);
929992

930-
if FGlobalHit + FGlobalMiss > 0 then
993+
FGlobalTotal := (FGlobalHit + FGlobalMiss);
994+
if (FGlobalTotal > 0) then
931995
begin
932-
ValidationRate := FGlobalHit / (FGlobalHit + FGlobalMiss);
933-
ValidationLoss := FGlobalTotalLoss / (FGlobalHit + FGlobalMiss);
934-
ValidationError := FGlobalErrorSum / (FGlobalHit + FGlobalMiss);
996+
ValidationRate := FGlobalHit / FGlobalTotal;
997+
ValidationLoss := FGlobalTotalLoss / FGlobalTotal;
998+
ValidationError := FGlobalErrorSum / FGlobalTotal;
935999
end;
9361000

9371001
if (ValidationRate > ValidationRecord) then
@@ -940,7 +1004,8 @@ procedure TNeuralImageFit.Fit(pNN: TNNet;
9401004
FMessageProc('VALIDATION RECORD! Saving NN at '+fileName);
9411005
FAvgWeight.SaveToFile(fileName);
9421006
end;
943-
if (FGlobalHit > 0) and (FVerbose) then
1007+
1008+
if (FGlobalTotal > 0) and (FVerbose) then
9441009
begin
9451010
WriteLn(
9461011
'Epochs: ',iEpochCount,
@@ -976,13 +1041,15 @@ procedure TNeuralImageFit.Fit(pNN: TNNet;
9761041
FMessageProc('Starting Testing.');
9771042
ProcThreadPool.DoParallel(@TestNNThread, 0, FThreadNN.Count-1, Nil, FThreadNN.Count);
9781043

979-
if FGlobalHit + FGlobalMiss > 0 then
1044+
FGlobalTotal := (FGlobalHit + FGlobalMiss);
1045+
if (FGlobalTotal > 0) then
9801046
begin
981-
TestRate := FGlobalHit / (FGlobalHit + FGlobalMiss);
982-
TestLoss := FGlobalTotalLoss / (FGlobalHit + FGlobalMiss);
983-
TestError := FGlobalErrorSum / (FGlobalHit + FGlobalMiss);
1047+
TestRate := FGlobalHit / FGlobalTotal;
1048+
TestLoss := FGlobalTotalLoss / FGlobalTotal;
1049+
TestError := FGlobalErrorSum / FGlobalTotal;
9841050
end;
985-
if (FGlobalHit > 0) and (FVerbose) then
1051+
1052+
if (FGlobalTotal > 0) and (FVerbose) then
9861053
begin
9871054
WriteLn(
9881055
'Epochs: ',iEpochCount,

neural/readme.txt

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,10 @@ CAI NEURAL API.
22
Copyright (C) 2019 Joao Paulo Schwarz Schuler
33

44
This folder contains libraries/APIs built under the CAI Project. Please have a look at these links for more information:
5-
https://sourceforge.net/p/cai/svncode/HEAD/tree/trunk/lazarus/readme.txt
5+
https://github.com/joaopauloschuler/neural-api
66
https://sourceforge.net/projects/cai/
77

8-
The most updated release is located here:
8+
The most recent development revision/commit is located here:
99
https://sourceforge.net/p/cai/svncode/HEAD/tree/trunk/lazarus/neural/
1010

1111
This program is free software; you can redistribute it and/or modify

0 commit comments

Comments
 (0)