const MAX_IN_SIZE = 25;
HIGH_IN_VAL = MAX_IN_SIZE-1;
MAX_OUT_SIZE = 256;
HIGH_OUT_VAL = MAX_OUT_SIZE-1;
type TInpArray = Array [0..HIGH_IN_VAL] of Byte;
TOutArray = Array [0..HIGH_OUT_VAL] of Byte;
var
DS : TSqlite3Dataset;
MMList : TStringList;
procedure SetCorrectOut(var aOut : TOutArray; value : Word);
var Pos : Word;
Shift : Byte;
begin
Pos := value div 8;
Shift := value mod 8;
aOut[Pos] := $1 shl Shift;
end;
function GetCorrectOut(const aOut : TOutArray) : Word;
var Pos : Word;
Shift : Byte;
begin
for Pos := 0 to HIGH_OUT_VAL do
begin
if (aOut[Pos] > 0) then
begin
case aOut[Pos] of
2 : Shift := 1;
4 : Shift := 2;
8 : Shift := 3;
16 : Shift := 4;
32 : Shift := 5;
64 : Shift := 6;
128 : Shift := 7;
else
Shift := 0;
end;
Exit(Pos * 8 + Shift);
end;
end;
Result := 0;
end;
function GetCorrectOutList(const aOut : TOutArray) : String;
var Pos : Word;
Cnt : Byte;
S : String;
procedure AddOption(W : Word);
begin
if length(S) > 0 then S := S + ' ';
S := S + MMList.Values[inttostr(W)];
Inc(Cnt);
end;
begin
S := '';
Cnt := 0;
for Pos := 0 to HIGH_OUT_VAL do
begin
if (aOut[Pos] > 0) then
begin
if aOut[Pos] and $1 > 0 then AddOption(Pos shl 3);
if aOut[Pos] and $2 > 0 then AddOption(Pos shl 3 or $1);
if aOut[Pos] and $4 > 0 then AddOption(Pos shl 3 or $2);
if aOut[Pos] and $8 > 0 then AddOption(Pos shl 3 or $3);
if aOut[Pos] and $10 > 0 then AddOption(Pos shl 3 or $4);
if aOut[Pos] and $20 > 0 then AddOption(Pos shl 3 or $5);
if aOut[Pos] and $40 > 0 then AddOption(Pos shl 3 or $6);
if aOut[Pos] and $80 > 0 then AddOption(Pos shl 3 or $7);
end;
if Cnt > 15 then break;
end;
Result := S;
end;
procedure RunAlgo();
const MAX_EPOCH_CNT = 1000;
MAX_EPOCH_SIZE = 512;
MAX_ERROR_CNT = 1;
var
NN: TNNetForByteProcessing;
BAInput : TInpArray;
BAExpected, BAOutput :TOutArray;
L, epoch : integer;
Txt1, Res, Outv : String;
MM, MM1 : Word;
ErrorCnt, EpochSize : Integer;
NeedNextEpoch : Boolean;
Key : char;
begin
NN := TNNetForByteProcessing.Create();
try
NN.AddBasicByteProcessingLayers(MAX_IN_SIZE, MAX_OUT_SIZE, 8, 32);
NN.SetLearningRate(0.1, 0.0);
WriteLn('Computing...');
epoch := 1;
NeedNextEpoch := true;
ErrorCnt := MAX_ERROR_CNT + 1;
EpochSize := MAX_EPOCH_SIZE;
while NeedNextEpoch and (epoch <= MAX_EPOCH_CNT) and (ErrorCnt > MAX_ERROR_CNT) do
begin
WriteLn('Epoch #', epoch);
inc(epoch);
DS.SQL := 'select mrkorig, uniq_ats_schem.id as mmid, '+
'ats_schem.mrk||" "||ats_schem.model as expc '+
'from ats_schem, uniq_ats_marks, uniq_ats_schem '+
'where length(mrkorig) < 25 and uniq_ats_marks.mrk = ats_schem.mrk and '+
' uniq_ats_schem.mrk = ats_schem.mrk and '+
' uniq_ats_schem.model = ats_schem.model order by random() limit ' + inttostr(EpochSize);
DS.Open;
try
ErrorCnt := 0;
// tests the learning
while not DS.EOF do
begin
if Keypressed then // if user provided input
begin
Key := readkey;
if Key = #27 then begin
NeedNextEpoch := false;
Break;
end;
end;
FillChar(BAInput, MAX_IN_SIZE, #0);
FillChar(BAExpected, MAX_OUT_SIZE, #0);
FillChar(BAOutput, MAX_OUT_SIZE, #0);
Txt1 := UTF8ToConsole(UTF8LowerCase(DS.FieldByName('mrkorig').AsString));
Res := UTF8ToConsole(DS.FieldByName('expc').AsString);
MM := DS.FieldByName('mmid').AsInteger;
L := Length(Txt1);
if L > HIGH_IN_VAL then
begin
L := HIGH_IN_VAL;
end;
Move((@(Txt1[1]))^, (@(BAInput[0]))^, L);
SetCorrectOut(BAExpected, MM);
NN.Compute(BAInput);
NN.GetOutput(BAOutPut);
NN.Backpropagate(BAExpected);
MM1 := GetCorrectOut(BAOutput);
if MM <> MM1 then Inc(ErrorCnt);
Outv := GetCorrectOutList(BAOutput);
WriteLn
( 'In:',
ConsoleToUTF8(PChar(@(BAInput[0]))),
' Out:',
Outv,
' Expect:',
Res
);
DS.Next;
end;
finally
DS.Close;
end;
end;
finally
NN.Free;
Write('Press ENTER to exit.');
ReadLn;
end;
end;
Recent
