Demonstration of Crossovers

Let’s write a program demonstrating permutational operators. The well-known operators are the next ones:

- Partial Matched Crossover (PMX)

- Order Crossover (OX)

- Cycle Crossover (CX).

In genetic algorithms crossover is a genetic operator used to vary the programming of a chromosome (example: inversion operator) or two chromosomes from one generation to the next. It is similar to reproduction and biological crossover on which genetic algorithms are based.

The aim of the crossover operator is to interchange the information and genes between chromosomes. Therefore crossover operator combines two parents to reproduce new children, then one of these children may hopefully collect all good features that exist in parents.

This screen-shots made in run time, Partial Matched Crossover (PMX):

Order Crossover (OX):

Cycle Crossover (CX):

We have to select in crossovers to choose number of genes, and in case of PMX and OX two cut spaces. The genes of parents setup the program (random values), or we fix by +/- signs.

The list of program:

unit UCODemo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

Const M=32;
      FontS=18;
      XOrig=320;
      YOrigP1=132;
      YOrigP2=212;
      YOrigC1=332;
      YOrigC2=412;
      GenM=10;
type
  TfmCODemo = class(TForm)
    lbCODemo: TLabel;
    btExit: TButton;
    btP1RND: TButton;
    rgCO: TRadioGroup;
    btP2RND: TButton;
    btCutClear: TButton;
    lbCuts: TLabel;
    btCrossover: TButton;
    edGensNum: TEdit;
    lbGensNum: TLabel;
    lbChild1: TLabel;
    lbChild2: TLabel;
    lbCutSet: TLabel;
Procedure GensShow;
Procedure ChildShow;
Procedure GensHide;
Procedure ChildDel;
Procedure ShowCuts;
procedure btExitClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
procedure FormClick(Sender: TObject);
procedure btP1RNDClick(Sender: TObject);
procedure btP2RNDClick(Sender: TObject);
procedure FormDblClick(Sender: TObject);
procedure btCutClearClick(Sender: TObject);
procedure edGensNumChange(Sender: TObject);
procedure btCrossoverClick(Sender: TObject);
procedure rgCOClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Type
  TGen=Class
    FNum: Integer;
    FX, FY: Integer;
    FWidth, FHeight: Word;
    FBGColor, FFGColor: TColor;
    FSign: Boolean;
Procedure Init(INum, IX, IY, IWidth, IHeight: Integer; ISign: Boolean);
Procedure SetColors(IBGColor, IFGColor: TColor);
Function GetBGColor: TColor;
Procedure Show;
Procedure Hide;
Function GetLeft: Integer;
Function GetTop: Integer;
Function GetNum: Byte;
Procedure SetNum(SNum: Byte);
End;

var
  fmCODemo: TfmCODemo;
  GenP1, GenP2, GenC1, GenC2: Array[1..GenM] Of TGen;
  P1, P2, PX1, PX2, C1, C2: Array[1..GenM] Of Byte;
  Parents: Byte;
  GenN: Byte;
  P1OK, P2OK: Boolean;
  MouseX, MouseY: Integer;
  ActGen, SelGen, Cut, Cut1, Cut2: Byte;

implementation

{$R *.dfm}

Procedure TGen.Init(INum, IX, IY, IWidth, IHeight: Integer; ISign: Boolean);
Begin
  FNum:= INum; FX:= IX; FY:= IY; FWidth:= IWidth; FHeight:= IHeight;
  FSign:= ISign;
End;

Procedure TGen.SetColors(IBGColor, IFGColor: TColor);
Begin
  FBGColor:= IBGColor; FFGColor:= IFGColor;
End;

Function TGen.GetBGColor: TColor;
Begin
  GetBGColor:= FBGColor;
End;

Procedure TGen.Show;
Begin
With fmCODemo.Canvas Do
Begin
    Brush.Color:= FBGColor;
    Pen.Color:= FFGColor;
    RecTangle(FX,FY,FX+FWidth,FY+FHeight);
With Font Do
Begin
      Color:= FFGColor;
      Size:= FontS;
End;
    TextOut(FX+FontS Div 2, FY+2, IntToStr(FNum));
If FSign Then
Begin
      Brush.Color:= clBtnFace;
      Font.Size:= 14;
      TextOut((2*FX+FWidth) Div 2-6,Fy-24,'+');
      TextOut((2*FX+FWidth) Div 2-3,Fy+FHeight,'-');
End;
End;
End;

Procedure TGen.Hide;
Begin
With fmCODemo.Canvas Do
Begin
    Brush.Color:= clBtnFace;
    Pen.Color:= clBtnFace;
    RecTangle(FX,FY-24,FX+FWidth,FY+FHeight+24);
End;
End;

Function TGen.GetLeft: Integer;
Begin
  GetLeft:= FX;
End;

Function TGen.GetTop: Integer;
Begin
  GetTop:= FY;
End;

Function TGen.GetNum: Byte;
Begin
  GetNum:= FNum;
End;

Procedure TGen.SetNum(SNum: Byte);
Begin
  FNum:= SNum;
End;

procedure TfmCODemo.btExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfmCODemo.FormPaint(Sender: TObject);
begin
  GensShow;
end;

Procedure TfmCODemo.GensShow;
Var I: Word;
Begin
For I:= 1 To GenN Do
Begin
    GenP1[I].Show;
    GenP2[I].Show;
    GenC1[I].Show;
    GenC2[I].Show;
End;
End;

Procedure TfmCODemo.ChildShow;
Var I: Word;
Begin
For I:= 1 To GenN Do
Begin
    GenC1[I].Show;
    GenC2[I].Show;
End;
End;

Procedure TfmCODemo.GensHide;
Var I: Word;
Begin
For I:= 1 To GenN Do
Begin
    GenP1[I].Hide;
    GenP2[I].Hide;
    GenC1[I].Hide;
    GenC2[I].Hide;
End;
End;

Procedure TfmCODemo.ChildDel;
Var I: Word;
Begin
For I:= 1 To GenN Do
Begin
    GenC1[I].SetNum(0);
    GenC2[I].SetNum(0);
End;
End;

Procedure TfmCODemo.ShowCuts;
Begin
  lbCuts.Caption:= IntToStr(Cut1)+' - '+IntToStr(Cut2);
End;

procedure TfmCODemo.FormCreate(Sender: TObject);
Var I: Word;
begin
  Randomize;
  GenN:= 9; Cut1:= 1; Cut2:= GenN;
For I:= 1 To GenN Do
Begin
    GenP1[I]:= TGen.Create;
With GenP1[I] Do
Begin
      Init(0,XOrig+(M-1)*(I-1),YOrigP1,M,M, True);
      SetColors(clWhite,clBlack);
End;
    GenP2[I]:= TGen.Create;
With GenP2[I] Do
Begin
      Init(0,XOrig+(M-1)*(I-1),YOrigP2,M,M, True);
      SetColors(clWhite,clBlack);
End;

    GenC1[I]:= TGen.Create;
With GenC1[I] Do
Begin
      Init(0,XOrig+(M-1)*(I-1),YOrigC1,M,M, False);
      SetColors(clWhite,clBlack);
End;
    GenC2[I]:= TGen.Create;
With GenC2[I] Do
Begin
      Init(0,XOrig+(M-1)*(I-1),YOrigC2,M,M, False);
      SetColors(clWhite,clBlack);
End;
End;
  rgCO.ItemIndex:= 0; P1OK:= False; P2OK:= False;
  ShowCuts;
end;

procedure TfmCODemo.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  MouseX:= X; MouseY:= Y;
end;

procedure TfmCODemo.FormClick(Sender: TObject);
begin
  ActGen:= 0; Parents:= 0; SelGen:= 0;
If (MouseX<GenP1[1].GetLeft) Or (MouseX>GenP1[GenN].GetLeft+M) Then Exit;
If (MouseY>GenP1[1].GetTop-M) And (MouseY<GenP1[1].GetTop+2*M) Then
  Parents:= 1;
If (MouseY>GenP2[1].GetTop-M) And (MouseY<GenP2[1].GetTop+2*M) Then
  Parents:= 2;
  SelGen:= (MouseX-GenP1[1].GetLeft+M Div 7) Div M +1;
Case Parents Of
    1: With GenP1[SelGen] Do
Begin
If (MouseY<GetTop) And (GetNum<GenN) Then SetNum(GetNum+1);
If (MouseY>GetTop+M) And (GetNum>1) Then SetNum(GetNum-1);
           Hide; Show;
End;
    2: With GenP2[SelGen] Do
Begin
If (MouseY<GetTop) And (GetNum<GenN) Then SetNum(GetNum+1);
If (MouseY>GetTop+M) And (GetNum>1) Then SetNum(GetNum-1);
           Hide; Show;
End;
End;
end;

procedure TfmCODemo.btP1RNDClick(Sender: TObject);
Var I, J, K, P: Word;
    T: Array[1..GenM] Of Integer;
begin
For I:= 1 To GenN Do T[I]:= I;
For K:= 1 To 10*GenN Do
Begin
    I:= Random(GenN)+1; J:= Random(GenN)+1;
    P:= T[I]; T[I]:= T[J]; T[J]:= P;
End;
For I:= 1 To GenN Do With GenP1[I] Do
Begin Hide; SetNum(T[I]); Show End;
  ChildDel; ChildShow;
  P1OK:= True; btCrossover.Enabled:= P1OK And P2OK;
end;

procedure TfmCODemo.btP2RNDClick(Sender: TObject);
Var I, J, K, P: Word;
    T: Array[1..GenM] Of Integer;
begin
For I:= 1 To GenN Do T[I]:= I;
For K:= 1 To 10*GenN Do
Begin
    I:= Random(GenN)+1; J:= Random(GenN)+1;
    P:= T[I]; T[I]:= T[J]; T[J]:= P;
End;
For I:= 1 To GenN Do With GenP2[I] Do
Begin Hide; SetNum(T[I]); Show End;
  ChildDel; ChildShow;
  P2OK:= True; btCrossover.Enabled:= P1OK And P2OK;
end;

procedure TfmCODemo.FormDblClick(Sender: TObject);
begin
If rgCO.ItemIndex=2 Then Exit; 
  Cut:= (MouseX-GenP1[1].GetLeft+M Div 7) Div M +1;
With GenP1[Cut] Do Begin SetColors(clYellow,clBlack); Show End;
With GenP2[Cut] Do Begin SetColors(clYellow,clBlack); Show End;
With GenC1[Cut] Do Begin SetColors(clYellow,clBlack); Show End;
With GenC2[Cut] Do Begin SetColors(clYellow,clBlack); Show End;
  Cut1:= 1; While GenP1[Cut1].GetBGColor=clWhite Do Inc(Cut1);
  Cut2:= GenN; While GenP1[Cut2].GetBGColor=clWhite Do Dec(Cut2);
  ShowCuts;
end;

procedure TfmCODemo.btCutClearClick(Sender: TObject);
Var I: Word;
begin
For I:= 1 To GenN Do
Begin
With GenP1[I] Do Begin SetColors(clWhite,clBlack); Show  End;
With GenP2[I] Do Begin SetColors(clWhite,clBlack); Show  End;
With GenC1[I] Do Begin SetColors(clWhite,clBlack); Show  End;
With GenC2[I] Do Begin SetColors(clWhite,clBlack); Show  End;
End;
  Cut1:= 1; Cut2:= GenN; ShowCuts; ChildDel; ChildShow;
end;

procedure TfmCODemo.edGensNumChange(Sender: TObject);
Var I: Word;
    Kod: Integer;
begin
  btCutClearClick(Sender); GensHide;
  Val(edGensNum.Text,GenN,Kod); If GenN>9 Then GenN:= 9;
  edGensNum.Text:= IntToStr(GenN);
For I:= 1 To GenN Do
Begin
    GenP1[I].SetNum(0); GenP2[I].SetNum(0);
    GenC1[I].SetNum(0); GenC2[I].SetNum(0);
End;
  GensShow; Cut1:= 1; Cut2:= GenN; ShowCuts;
  P1OK:= False; P2OK:= False; btCrossover.Enabled:= False;
end;

procedure TfmCODemo.btCrossoverClick(Sender: TObject);
Var I, J, A, B, C, P: Word;
begin
For I:= 1 To GenN Do
Begin
    P1[I]:= GenP1[I].GetNum; P2[I]:= GenP2[I].GetNum; C1[I]:= 0; C2[I]:= 0;
End;
Case rgCO.ItemIndex Of
    0: Begin //PMX (Partially Matched Crossover)
         A:= 0; B:= 0;
For I:= Cut1 To Cut2 Do
Begin
For J:= 1 To GenN Do If P1[J]=P2[I] Then A:= J;
For J:= 1 To GenN Do If P2[J]=P1[I] Then B:= J;
           P:= P1[I]; P1[I]:= P2[I]; P2[I]:= P;
           P:= P1[A]; P1[A]:= P2[B]; P2[B]:= P;
End;
         C1:= P1;
         C2:= P2;
End;

    1: Begin //OX (Order Crossover)
For I:= 1 To GenN Do Begin PX1[I]:= P1[I]; PX2[I]:= P2[I] End;

For I:= Cut1 To Cut2 Do For J:= 1 To GenN Do
If P2[J]=PX1[I] Then P2[J]:= 0;
For I:= Cut1 To Cut2 Do For J:= 1 To GenN Do
If P1[J]=PX2[I] Then P1[J]:= 0;

         A:= 0; B:= 0;
For I:= Cut1 To GenN Do
Begin
If P1[I]<>0 Then
Begin
             Inc(A); If A=Cut1 Then A:= Cut2+1; PX1[A]:= P1[I];
End;
If P2[I]<>0 Then
Begin
             Inc(B); If B=Cut1 Then B:= Cut2+1; PX2[B]:= P2[I];
End;
End;

For I:= 1 To Cut1-1 Do
Begin
If P1[I]<>0 Then
Begin
             Inc(A); If A=Cut1 Then A:= Cut2+1; PX1[A]:= P1[I];
End;
If P2[I]<>0 Then
Begin
             Inc(B); If B=Cut1 Then B:= Cut2+1; PX2[B]:= P2[I];
End;
End;

For I:= 1 To Cut1 Do P1[I]:= PX1[I];
For I:= Cut1 To Cut2 Do P1[I]:= PX2[I];
For I:= Cut2+1 To GenN Do P1[I]:= PX1[I];

For I:= 1 To Cut1 Do P2[I]:= PX2[I];
For I:= Cut1 To Cut2 Do P2[I]:= PX1[I];
For I:= Cut2+1 To GenN Do P2[I]:= PX2[I];

         C1:= P1;
         C2:= P2;

End;
    2: Begin //CX (Cycle Crossover)
For I:= 1 To GenN Do Begin PX1[I]:= 0; PX2[I]:= 0 End;

For I:= 1 To GenN Do If P1[I]=P2[I] Then
Begin PX1[I]:= P1[I]; PX2[I]:= P2[I] End;

         A:= 1;
While PX1[A]<>0 Do Inc(A); B:= A;
Repeat
           PX1[A]:= P1[A];
           PX2[A]:= P2[A];
           C:= 0; For J:= 1 To GenN Do
If P1[J]=PX2[A] Then C:= J; A:= C;
Until A=B;

For I:= 1 To GenN Do
Begin
If PX1[I]=0 Then PX1[I]:= P2[I];
If PX2[I]=0 Then PX2[I]:= P1[I];
End;
         C1:= PX1;
         C2:= PX2;
End;
End;
For I:= 1 To GenN Do
Begin GenC1[I].SetNum(C1[I]); GenC2[I].SetNum(C2[I]) End;
  GensShow;
end;

procedure TfmCODemo.rgCOClick(Sender: TObject);
begin
If rgCO.ItemIndex=2 Then
Begin
    btCutClearClick(Sender);
    btCutClear.Enabled:= False;
End Else btCutClear.Enabled:= True;
end;

end.