unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg, ComCtrls, Buttons, Math, XPMan, Menus, MMSystem;

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    Memo1: TMemo;
    Image1: TImage;
    Bevel2: TBevel;
    Memo2: TMemo;
    Shape1: TShape;
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    Bevel3: TBevel;
    Label2: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    Label3: TLabel;
    BitBtn2: TBitBtn;
    Shape2: TShape;
    Label4: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label5: TLabel;
    XPManifest1: TXPManifest;
    BitBtn3: TBitBtn;
    Bevel4: TBevel;
    StaticText1: TStaticText;
    Bevel5: TBevel;
    BitBtn4: TBitBtn;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Timer1: TTimer;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Edit2Click(Sender: TObject);
    procedure Edit3Click(Sender: TObject);
    procedure Edit4Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  Num_i = 3;  // кол-во нейронов во вх. слое
  Num_s = 21; // кол-во нейронов в скр. слое
  Num_o = 3;  // кол-во нейронов в вых. слое
  Step = 0.01;

var
  Form1                     : TForm1;
  X_et, Y_et, Z_et          : Array [1..9999] Of Extended;  // эталонные значения
  X_pr, Y_pr, Z_pr          : Array [1..9999] Of Extended;  // спрогнозированные значения
  Gen_Size                  : Word; // размер выборки
  F_x_et, F_y_et, F_z_et    : TextFile; // файлы эталонных значений
  F_x_pr, F_y_pr, F_z_pr    : TextFile; // файлы спрогнозированных значений
  F_x, F_y, F_z             : TextFile; // файлы обученных значений
  Max_Images                : Word; // размер обучающей выборки
  FCST_Images               : Word; // кол-во прогнозируемых значений
  E_, Emax                  : Extended;  // суммарная среднекв. ошибка;
                                         // желаемая среднекв. ошибка
  Alpha                     : Extended;  // шаг обучения
  W_in                      : Array [1..Num_i, 1..Num_s] Of Extended; // весовые коэффициенты
  W_out                     : Array [1..Num_s, 1..Num_o] Of Extended; // весовые коэффициенты
  T1                        : Array [1..Num_s] Of Extended; // пороговые значения
  T2                        : Array [1..Num_o] Of Extended; // пороговые значения
  X_in, Y_in, Z_in          : Extended; // образы из эталонных значений
  X_out, Y_out, Z_out       : Extended; // выходные значения
  Y                         : Array [1..Num_s] Of Extended; // выходная активность
  Err_s                     : Array [1..Num_s] Of Extended; // ошибка скр. слоя
  Err_o_x, Err_o_y, Err_o_z : Extended; // ошибка вых. слоя
  S_x, S_y, S_z             : Extended;
  Iter                      : LongWord; // счетчик итераций
  i, j                      : Word; // счетчики
  Sum                       : Array [1..Num_s] Of Extended;
  xx, yy, zz                : Array [1..9999] Of Extended;  //  обученные значения
  bench                     : Boolean = False;
  mmResult                  : Integer;
  stime                     : LongWord = 0;
  first_start               : Boolean = True;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TimeCallBack(TimerID, Msg: Uint; dwUser, dw1, dw2: DWORD); pascal;
begin
  Inc(stime, 10);
end;

function F(x : Extended) : Extended;
begin
  F := 1 / (1 + Exp(-x)); // сигмоидная ФА
end;

function F1(x : Extended) : Extended;
begin
  F1 := x * (1 - x);  // 1ая произв. сигм. ФА
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i : Word;
begin
  Gen_Size := StrToInt(Edit1.Text);
  AssignFile(F_x_et, 'x_et.dat');
  AssignFile(F_y_et, 'y_et.dat');
  AssignFile(F_z_et, 'z_et.dat');
  {$I-}
    ReWrite(F_x_et);
    ReWrite(F_y_et);
    ReWrite(F_z_et);
  {$I+}
  BitBtn1.Enabled := False;
  N5.Enabled := False; 
  X_et[1] := 1;
  Y_et[1] := 1;
  Z_et[1] := 1;
  WriteLN(F_x_et, X_et[1]);
  WriteLN(F_y_et, Y_et[1]);
  WriteLN(F_z_et, Z_et[1]);
  i := 2;
  ProgressBar1.Max := Gen_Size;
  While (i <= Gen_Size) Do
    Begin
      X_et[i] := X_et[i-1] + Step * Y_et[i-1];
      Y_et[i] := Y_et[i-1] + Step * ((-Power(X_et[i-1],3)) - 0.05 * Y_et[i-1] + 7.5 * Sin(Z_et[i-1]));
      Z_et[i] := Z_et[i-1] + Step * 1;
      WriteLN(F_x_et, X_et[i]);
      WriteLN(F_y_et, Y_et[i]);
      WriteLN(F_z_et, Z_et[i]);
      ProgressBar1.StepIt;
      Inc(i);
    End;
  Label3.Visible := True;
  ProgressBar1.Visible := False;
  Edit2.Enabled := True;
  CloseFile(F_x_et);
  CloseFile(F_y_et);
  CloseFile(F_z_et);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  ProcessID: DWORD;
  ProcessHandle: THandle;
  ThreadHandle: THandle;
  PriorityClass, Priority: integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);
  ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION, false, ProcessID);
  SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);
  ThreadHandle := GetCurrentThread;
  SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
  Max_Images := StrToInt(Edit4.Text);
  If Max_Images >= Gen_Size Then
    Begin
      Max_Images := Round(Gen_Size / 2);
      Edit4.Text := IntToStr(Max_Images);
    End;
  Edit4.Enabled := False;
  BitBtn2.Enabled := False;
  StaticText1.Visible := True;
  Alpha := StrToFloat(Edit2.Text);
  Emax  := StrToFloat(Edit3.Text);
  AssignFile(F_x,'x_ob.dat');
  AssignFile(F_y,'y_ob.dat');
  AssignFile(F_z,'z_ob.dat');
{$I-}
  ReWrite(F_x);
  ReWrite(F_y);
  ReWrite(F_z);
{$I+}
  For j := 1 To Num_s Do
    For i := 1 To Num_i Do
      W_in[i,j] := 1 / (500 + Random(500));
  For j := 1 To Num_o Do
    Begin
      For i := 1 To Num_s Do
        Begin
          W_out[i,j] := 1 / (500 + Random(500));
          If j = 1 Then T1[i] := Random;
        End;
      T2[j] := Random;
    End;
  Iter := 0;
  If bench = True Then
      mmResult := TimeSetEvent(10, 0, @TimeCallBack, 0, TIME_PERIODIC);
  Repeat
      E_ := 0.;
      For i := 1 To Max_Images Do
        Begin
          X_in := X_et[i];
          Y_in := Y_et[i];
          Z_in := Z_et[i];
          (* фаза прямого распространения сигнала *)
          For j := 1 To Num_s Do
            Begin
              Sum[j]  := W_in[1,j] * X_in + W_in[2,j] * Y_in + W_in[3,j] * Z_in - T1[j];
              Y[j]    := F(Sum[j]);
            End;
          X_out := 0;
          Y_out := 0;
          Z_out := 0;
          For j := 1 To Num_s Do
            Begin
              X_out := X_out + W_out[j,1] * Y[j];
              Y_out := Y_out + W_out[j,2] * Y[j];
              Z_out := Z_out + W_out[j,3] * Y[j];
            End;
          X_out := X_out - T2[1];
          Y_out := Y_out - T2[2];
          Z_out := Z_out - T2[3];
          (* фаза обратного распространения сигнала *)
          Err_o_x := X_out - X_et[i + 1];
          Err_o_y := Y_out - Y_et[i + 1];
          Err_o_z := Z_out - Z_et[i + 1];
          For j := 1 To Num_s Do
            Err_s[j] := Err_o_x * W_out[j,1] + Err_o_y * W_out[j,2] + Err_o_z * W_out[j,3];
          For j := 1 To Num_s Do
            Begin
              W_in[1,j] := W_in[1,j] - Alpha * Err_s[j] * X_in * F1(Y[j]);
              W_in[2,j] := W_in[2,j] - Alpha * Err_s[j] * Y_in * F1(Y[j]);
              W_in[3,j] := W_in[3,j] - Alpha * Err_s[j] * Z_in * F1(Y[j]);
              T1[j] := T1[j] + Alpha * Err_s[j] * F1(Y[j]);
            End;
          For j := 1 To Num_s Do
            Begin
              W_out[j,1] := W_out[j,1] - Alpha * Err_o_x * Y[j];
              W_out[j,2] := W_out[j,2] - Alpha * Err_o_y * Y[j];
              W_out[j,3] := W_out[j,3] - Alpha * Err_o_z * Y[j];
            End;
          T2[1] := T2[1] + Alpha * Err_o_x;
          T2[2] := T2[2] + Alpha * Err_o_y;
          T2[3] := T2[3] + Alpha * Err_o_z;
          xx[i] := x_out;
          yy[i] := y_out;
          zz[i] := z_out;
          E_ := E_ + Power(X_out - X_et[i + 1],2) + Power(Y_out - Y_et[i + 1],2) + Power(Z_out - Z_et[i + 1],2);
        End;
      E_ := E_ / 2;
      StaticText1.Caption := FloatToStr(E_);
      Inc(Iter, 1);
  Until (E_ <= Emax);
  If bench = True Then
    TimeKillEvent(mmResult);
  For i := 1 To Max_Images Do
    Begin
      Form2.Series2.AddXY(xx[i],yy[i]);
      Form2.Series4.AddXY(yy[i],zz[i]);
      WriteLN(F_x,xx[i]);
      WriteLN(F_y,yy[i]);
      WriteLN(F_z,zz[i]);
    End;
  CloseFile(F_x);
  CloseFile(F_y);
  CloseFile(F_z);
  StaticText1.Visible := False;
  Label5.Visible      := True;
  MessageDlg('Потребовалось итераций: ' + IntToStr(iter),mtInformation,[mbOK],0);
  BitBtn3.Enabled := True;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  If bench = True Then
    Form3.Show; 
end;

procedure TForm1.Edit2Click(Sender: TObject);
begin
  Edit2.ReadOnly := False;
  Edit2.Text := '';
  Edit3.Enabled := True;
end;

procedure TForm1.Edit3Click(Sender: TObject);
begin
  Edit2.Enabled := False;
  Edit3.ReadOnly := False;
  Edit3.Text := '';
  Edit4.Enabled := True; 
end;

procedure TForm1.Edit4Click(Sender: TObject);
begin
  Edit3.Enabled := False;
  Edit4.ReadOnly := False;
  Edit4.Text := '';
  BitBtn2.Enabled := True;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  BitBtn3.Enabled := False;
  FCST_Images := Round(Max_images / 2);
  AssignFile(F_x_pr,'x_pr.dat');
  AssignFile(F_y_pr,'y_pr.dat');
  AssignFile(F_z_pr,'z_pr.dat');
{$I-}
  ReWrite(F_x_pr);
  ReWrite(F_y_pr);
  ReWrite(F_z_pr);
{$I+}
  X_pr[1] :=  X_et[Max_images];
  Y_pr[1] :=  Y_et[Max_images];
  Z_pr[1] :=  Z_et[Max_images];
  For i := 2 To FCST_Images Do
    Begin
      For j := 1 To Num_s Do
        Begin
          Sum[j]  := W_in[1,j] * X_pr[i-1] + W_in[2,j] * Y_pr[i-1] + W_in[3,j] * Z_pr[i-1] - T1[j];
          Y[j]    := F(Sum[j]);
        End;
      X_out := 0;
      Y_out := 0;
      Z_out := 0;
      For j := 1 To Num_s Do
        Begin
          X_out := X_out + W_out[j,1] * Y[j];
          Y_out := Y_out + W_out[j,2] * Y[j];
          Z_out := Z_out + W_out[j,3] * Y[j];
        End;
      X_out := X_out - T2[1];
      Y_out := Y_out - T2[2];
      Z_out := Z_out - T2[3];
      X_pr[i] := X_out;
      Y_pr[i] := Y_out;
      Z_pr[i] := Z_out;
    End;
  For i := 1 To FCST_Images Do
    Begin
      WriteLN(F_x_pr,X_pr[i]);
      WriteLN(F_y_pr,Y_pr[i]);
      WriteLN(F_z_pr,Z_pr[i]);
    End;
  CloseFile(F_x_pr);
  CloseFile(F_y_pr);
  CloseFile(F_z_pr);
  BitBtn4.Enabled := True;
end;
   
procedure TForm1.N3Click(Sender: TObject);
var
  a : Word;
begin
  a := MessageDlg('Вы действительно'+#13+'хотите выйти?',mtConfirmation,[mbYES,mbNO],0);
  If a = mrNO Then
    Exit;
  If a = mrYES Then
    Form1.Close;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  Form2.ShowModal;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  bench := True;
  Edit1.Text := '8000';
  ЭТО СПАМ - ОТПРАВЬТЕ ЖАЛОБУ (синий квадрат);
  Edit2.Text := '0,01';
  Edit3.Text := '0,001';
  Edit4.Text := '100';
  MessageDlg('Сейчас будет произведен тест системы.' + #13 + 'Не перемещайте мышь и не трогайте клавиатуру!',mtInformation,[mbOK],0);
  Form1.Update;
  ЭТО СПАМ - ОТПРАВЬТЕ ЖАЛОБУ (синий квадрат);
end;

end.