unit1.pas

用遗传算法进行排序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    StringGrid1: TStringGrid;
    Button1: TButton;
    Label2: TLabel;
    Button2: TButton;
    Label3: TLabel;
    StringGrid2: TStringGrid;
    StringGrid3: TStringGrid;
    Label4: TLabel;
    StringGrid4: TStringGrid;
    Label5: TLabel;
    StringGrid5: TStringGrid;
    Label6: TLabel;
    StringGrid6: TStringGrid;
    Label7: TLabel;
    StringGrid7: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure zhajiao;
    procedure bianyi;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  globex:array[1..6] of integer=(60,40,50,10,30,20);

implementation

{$R *.DFM}

function calshipei(A:tstrings):integer;
var
i:integer;
begin
result:=0;
for i:=1 to A.Count-1 do
  if strtoint(A[i])>strtoint(A[i-1]) then inc(result);
end;

procedure zj(S1,S2:tstrings);
var
i,j,f1,f2,e1,e2:integer;
stack,ss1,ss2:tstringlist;
tem:string;
begin
ss1:=tstringlist.Create;
ss2:=tstringlist.Create;
for i:=0 to S1.Count-1 do SS1.Add(S1[i]);
for i:=0 to S2.Count-1 do SS2.Add(S1[i]);
stack:=tstringlist.Create;
f1:=random(SS1.count-1);
i:=f1+1;
while true do
if (i<ss1.count) and (strtoint(SS1[i])>strtoint(SS1[i-1])) then inc(i) else break;
e1:=i-1;
f2:=random(S2.count-1);
i:=f2+1;
while true do
if (i<ss1.count) and (strtoint(SS1[i])>strtoint(SS1[i-1])) then inc(i) else break;
e2:=i-1;
for i:=f1 to e1 do stack.Add(SS1[i]);
for i:=f2 to e2 do
  if stack.IndexOf(SS2[i])=-1 then stack.add(SS2[i]);
for i:=0 to stack.Count-1 do
  for j:=0 to stack.Count-2 do
    if strtoint(stack[j+1])<strtoint(stack[j]) then
      begin
      tem:=stack[j];
      stack[j]:=stack[j+1];
      stack[j+1]:=tem;
      end;
for i:=0 to stack.Count-1 do
  begin
  SS1.Delete(SS1.IndexOf(stack[i]));
  SS2.Delete(SS2.IndexOf(stack[i]));
  end;
//j:=random(SS1.count-1);
for i:=stack.Count-1 downto 0 do SS1.Insert(0,stack[i]);
//j:=random(SS2.count-1);
for i:=stack.Count-1 downto 0 do SS2.Insert(0,stack[i]);
for i:=0 to S1.Count-1 do S1[i]:=SS1[i];
for i:=0 to S2.Count-1 do S2[i]:=SS2[i];
end;

procedure calcopynum(A:tstrings);
var
i,j,temsum:integer;
seg:array of integer;
rand:double;
begin
temsum:=0;
setlength(seg,A.count);
for i:=0 to A.Count-1 do
  begin
  temsum:=temsum+strtoint(A[i]);
  seg[i]:=temsum;
  end;
for i:=0 to A.Count-1 do A[i]:='0';
for i:=0 to A.Count-1 do
  begin
  rand:=random*temsum;
  j:=0;
  while rand>seg[j] do inc(j);
  A[j]:=inttostr(strtoint(A[j])+1);
  end;
end;

procedure tform1.bianyi;
var
i,j,k,p1,p2:integer;
tem:string;
begin
for j:=1 to 4 do
  for i:=1 to stringgrid7.colcount do
    stringgrid7.cells[i-1,j-1]:=stringgrid6.cells[i-1,j-1];
k:=random(4);
p1:=random(stringgrid7.colcount);
p2:=0;
repeat p2:=random(stringgrid7.colcount) until p1<>p2;
tem:=stringgrid7.cells[p1,k];
stringgrid7.cells[p1,k]:=stringgrid7.cells[p2,k];
stringgrid7.cells[p2,k]:=tem;
end;

procedure exchange(S1,S2:tstrings;p:integer);
var
i,tem:integer;
begin
for i:=p to S1.Count-1 do
  begin
  tem:=strtoint(S1[i]);
  S1[i]:=S2[i];
  S2[i]:=inttostr(tem);
  end
end;

procedure tform1.zhajiao;
var
temset:set of 0..3;
i,j,l1,l2,tem,pzhajiao:integer;
begin
for j:=1 to 4 do
  for i:=1 to stringgrid5.ColCount do
    stringgrid6.Cells[i-1,j-1]:=stringgrid5.Cells[i-1,j-1];
zj(stringgrid6.Rows[0],stringgrid6.Rows[1]);
zj(stringgrid6.Rows[2],stringgrid6.Rows[3]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i,j,x,y,tem:integer;
begin
for j:=1 to 4 do
  begin
  for i:=1 to 6 do
    stringgrid1.Cells[i-1,j-1]:=inttostr(globex[i]);
  for i:=1 to 6 do
    begin
    x:=1+random(6);
    repeat y:=1+random(6); until x<>y;
    tem:=strtoint(stringgrid1.cells[x-1,j-1]);
    stringgrid1.cells[x-1,j-1]:=stringgrid1.cells[y-1,j-1];
    stringgrid1.cells[y-1,j-1]:=inttostr(tem);
    end
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i,j,k,temsum,tem,top,pzhajiao:integer;
begin
if stringgrid7.Cells[0,0]<>'' then
for j:=1 to 4 do
  for i:=1 to stringgrid1.ColCount do
    stringgrid1.Cells[i-1,j-1]:=stringgrid7.Cells[i-1,j-1];
temsum:=0;
for i:=1 to 4 do
  begin
  stringgrid2.Cells[0,i-1]:=inttostr(calshipei(stringgrid1.Rows[i-1]));
  temsum:=strtoint(stringgrid2.cells[0,i-1])+temsum;
  end;
if stringgrid2.cols[0].indexof('5')<>-1 then begin showmessage('排序已完成，算法结束'); exit; end;
for i:=1 to 4 do
  begin
  stringgrid3.Cells[0,i-1]:=floattostr(strtoint(stringgrid2.cells[0,i-1])/temsum*4);
  stringgrid4.Cells[0,i-1]:=stringgrid2.Cells[0,i-1];
  end;
calcopynum(stringgrid4.Cols[0]);
top:=0;
for i:=1 to 4 do
  begin
  if stringgrid4.Cells[0,i-1]<>'0' then
  for k:=1 to strtoint(stringgrid4.Cells[0,i-1]) do
    begin
    for j:=1 to stringgrid1.colcount do stringgrid5.Cells[j-1,top]:=stringgrid1.cells[j-1,i-1];
    top:=top+1;
    end
  end;
zhajiao;
bianyi;
end;

end.