unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, ComCtrls, TeEngine, Series,
  TeeProcs, Chart;

type
  TForm1 = class(TForm)
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    lw11: TLabel;
    Image1: TImage;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    lw12: TLabel;
    lw21: TLabel;
    lw22: TLabel;
    lv1: TLabel;
    lv2: TLabel;
    lu2: TLabel;
    lu1: TLabel;
    lu0: TLabel;
    Button1: TButton;
    Label1: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    ly: TLabel;
    lx1: TLabel;
    lx2: TLabel;
    ls: TLabel;
    Timer1: TTimer;
    SpeedButton1: TSpeedButton;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    Chart1: TChart;
    Series1: TFastLineSeries;
    Label13: TLabel;
    Label14: TLabel;
    Ltasa: TLabel;
    Button2: TButton;
    Timer2: TTimer;
    SpeedButton2: TSpeedButton;
    Button3: TButton;
    RadioGroup1: TRadioGroup;
    TrackBar3: TTrackBar;
    Label15: TLabel;
    Label16: TLabel;
    Bevel1: TBevel;
    Label17: TLabel;
    Label18: TLabel;
    Bevel2: TBevel;
    Button4: TButton;
    TrackBar4: TTrackBar;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure ActualizaTextos;
    { Public declarations }
    procedure  InicializaCROMOSOMAS;
    function  EvaluaCROMOSOMA(i:integer):double;
    procedure VerCromosoma1;
  end;



const ejX1: array[1..4] of integer = (0, 1, 0, 1);
const ejX2: array[1..4] of integer = (0, 0, 1, 1);
const ejS: array[1..4] of integer = (0, 1, 1, 0);

var
  Form1: TForm1;
  w11,w12,w21,w22,v1,v2,u1,u2,u0:double;
  a1,a2:double;
  x1,x2,s,y,alfa:double;
  index:integer;
  error:double;

//ALG GENETICOS
type
  CROMOSOMA= array[1..9] of double;

var
  Conjunto:array[1..30] of CROMOSOMA;
  Conjunto15:array[1..15] of CROMOSOMA;

implementation

{$R *.dfm}


procedure TForm1.ActualizaTextos;
begin
lw11.Caption:=formatfloat('0.000',w11);
lw12.Caption:=formatfloat('0.000',w12);
lw21.Caption:=formatfloat('0.000',w21);
lw22.Caption:=formatfloat('0.000',w22);
lv1.Caption:=formatfloat('0.000',v1);
lv2.Caption:=formatfloat('0.000',v2);
lu1.Caption:=formatfloat('0.000',u1);
lu2.Caption:=formatfloat('0.000',u2);
lu0.Caption:=formatfloat('0.000',u0);

lx1.Caption:=formatfloat('0.000',x1);
lx2.Caption:=formatfloat('0.000',x2);
ly.Caption:=formatfloat('0.000',y);
ls.Caption:=formatfloat('0.000',s);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
alfa:=0.3;
randomize;
w11:=random(2)*(0.5-random);
w12:=random(2)*(0.5-random);
w21:=random(2)*(0.5-random);
w22:=random(2)*(0.5-random);
v1:=random(2)*(0.5-random);
v2:=random(2)*(0.5-random);
u1:=random(2)*(0.5-random);
u2:=random(2)*(0.5-random);
u0:=random(2)*(0.5-random);
ActualizaTextos;
index:=1;
timer1.Interval:=Trackbar1.Position;
alfa:=trackbar2.Position/1000;
series1.Clear;



end;

function sig(x: double):double;
begin
    result:=1/(1+exp(-x));
end;


function RED:double;
begin
 a1:=sig(x1*w11+x2*w21+u1);
 a2:=sig(x1*w12+x2*w22+u2);
 result:=sig(a1*v1+a2*v2+u0);
end;



procedure TForm1.Timer1Timer(Sender: TObject);
var d0,d1,d2:double;
begin

  x1:=ejX1[index];
  x2:=ejX2[index];
  s:=ejS[index];

  y:=RED;

  d0:=(s-y)*y*(1-y);
  v1:=v1+ALFA*d0*a1;
  v2:=v2+ALFA*d0*a2;
  u0:=u0+ALFA*d0;

  d1:=a1*(1-a1)*v1*d0;
  d2:=a2*(1-a2)*v2*d0;
  w11:=w11+ALFA*d1*x1;
  w12:=w12+ALFA*d2*x1;
  w21:=w21+ALFA*d1*x2;
  w22:=w22+ALFA*d2*x2;
  u1:=u1+ALFA*d1;
  u2:=u2+ALFA*d2;


  ActualizaTextos;

  error:=error+abs(s-y);


  index:=index+1;
  if index>4 then begin
    index:=1;
    series1.add(error,'',clteecolor);
    error:=0;
  end;


end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
timer1.Enabled:=SpeedButton1.Down;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
timer1.Interval:=Trackbar1.Position;
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
alfa:=(trackbar2.Position)/1000;
ltasa.caption:=formatfloat('0.000',alfa);
end;


procedure TForm1.Button4Click(Sender: TObject);
var n:integer;
begin
 n:=Trackbar4.Position;
 randomize;
 w11:=w11+n*(0.5-random);
 w12:=w12+n*(0.5-random);
 w21:=w21+n*(0.5-random);
 w22:=w22+n*(0.5-random);
 v1:=v1+n*(0.5-random);
 v2:=v2+n*(0.5-random);
 u1:=u1+n*(0.5-random);
 u2:=u2+n*(0.5-random);
 u0:=u0+n*(0.5-random);

end;

//**************************************
//**************************************
// AG
//**************************************
//**************************************
//**************************************

procedure TForm1.VerCromosoma1;
begin
  w11:=Conjunto[1][1];
  w12:=Conjunto[1][2];
  w21:=Conjunto[1][3];
  w22:=Conjunto[1][4];
  u1:=Conjunto[1][7];
  u2:=Conjunto[1][8];

  v1:=Conjunto[1][5];
  v2:=Conjunto[1][6];
  u0:=Conjunto[1][9];
  lw11.Caption:=formatfloat('0.000',w11);
  lw12.Caption:=formatfloat('0.000',w12);
  lw21.Caption:=formatfloat('0.000',w21);
  lw22.Caption:=formatfloat('0.000',w22);
  lv1.Caption:=formatfloat('0.000',v1);
  lv2.Caption:=formatfloat('0.000',v2);
  lu1.Caption:=formatfloat('0.000',u1);
  lu2.Caption:=formatfloat('0.000',u2);
  lu0.Caption:=formatfloat('0.000',u0);
end;



function TForm1.EvaluaCROMOSOMA(i:integer):double;
begin
  w11:=Conjunto[i][1];
  w12:=Conjunto[i][2];
  w21:=Conjunto[i][3];
  w22:=Conjunto[i][4];
  u1:=Conjunto[i][7];
  u2:=Conjunto[i][8];

  v1:=Conjunto[i][5];
  v2:=Conjunto[i][6];
  u0:=Conjunto[i][9];

  a1:=sig(x1*w11+x2*w21+u1);
  a2:=sig(x1*w12+x2*w22+u2);
  result:=sig(a1*v1+a2*v2+u0);
end;

procedure TForm1.InicializaCROMOSOMAS;
var i,j:integer;
begin
  randomize;
  for i:=1 to 30 do begin
     for j:=1 to 9 do Conjunto[i][j]:=random(40)*(0.5-random);
  end;
  VerCromosoma1;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  InicializaCROMOSOMAS;
  ActualizaTextos;
  series1.Clear;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var i,a,b,pos,mut:integer;
var error:array[1..30,1..2] of double;
var aux1,aux2:double;
begin

 mut:=trackbar3.position;//tasa de mutacion;

 for i:=1 to 30 do begin
   error[i,1]:=0;
   error[i,2]:=i;
   for index:=1 to 4 do begin
      x1:=ejX1[index];
      x2:=ejX2[index];
      s:=ejS[index];

      y:=EvaluaCROMOSOMA(i);
      error[i,1]:=error[i,1]+abs(s-y);
   end;
 end;

 //ORDENA POR ERROR
 for  a:=1 to 29 do begin
    for b:=a+1 to 30 do begin
        if error[a,1]>error[b,1] then begin
            aux1:=error[a,1];
            aux2:=error[a,2];
            error[a,1]:=error[b,1];
            error[a,2]:=error[b,2];
            error[b,1]:=aux1;
            error[b,2]:=aux2;
        end;
    end;
 end;

 //Grafica y visualiza error del mejor cromosoma
 series1.add(error[1,1],'',clteecolor);
 VerCromosoma1;


 //Elige 15 mejores...
 for a:=1 to 15 do begin
    for b:=1 to 9 do begin
    Conjunto15[a][b]:=Conjunto[round(error[a,2])][b];
    end;
 end;
 for a:=1 to 15 do begin
    for b:=1 to 9 do begin
    Conjunto[a][b]:=Conjunto15[a][b];
    end;
 end;


 //MUTACION
 for a:=1 to 7 do begin
     //Copia los 7 mejores para mutarlos...
     for b:=1 to 9 do Conjunto[a+15][b]:=Conjunto[a][b];

     //Cambia genes según tasa de mutación mut
     for b:=1 to mut do begin
       Conjunto[a+15][random(9)+1]:=random(40)*(0.5-random);
     end;
 end;

 for a:=1 to 6 do begin
     //CRUCE
     pos:=random(8)+1;
     for b:=1 to pos do Conjunto[a+15+7][b]:=Conjunto[a][b];
     for b:=pos+1 to 9 do Conjunto[a+15+7][b]:=Conjunto[a+1][b];
 end;


end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
timer2.Enabled:=SpeedButton2.Down;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin


case RadioGroup1.ItemIndex of
0:begin x1:=0;x2:=0;end;
1:begin x1:=1;x2:=0;end;
2:begin x1:=0;x2:=1;end;
3:begin x1:=1;x2:=1;end;
end;
y:=RED;
ActualizaTextos;


end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
label15.caption:='Genes:'+inttostr(TrackBar3.position);
end;



end.
