test_schaffer.pas

粒子群优化算法PSO

unit test_schaffer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Math;
type
TFltArray=array of array of single;
TIntArray=array of array of integer;
type
    TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Button1: TButton;
    Label13: TLabel;
    Label14: TLabel;
    Edit13: TEdit;
    Edit14: TEdit;
    Label15: TLabel;
    Edit15: TEdit;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    Edit16: TEdit;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Edit17: TEdit;
    Edit18: TEdit;
    Label19: TLabel;
    ComboBox1: TComboBox;
    Memo2: TMemo;
    Label20: TLabel;
    Edit19: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   procedure initagent(UpLmtFlt,DnLmtFlt:array of single;UpLmtInt,DnLmtInt:array of integer);
   Procedure EvaluateAgent(FirstTime:Boolean;m:integer);
   Function Fitness(b:integer):single;
   Function rand(a:integer):single;
  end;

var
  Form1: TForm1;
  AgentNo:integer;   //粒子个数
  //ECutoff:single;  //用户希望起码达到的结果,（作为终止条件的依据）
  MaxV:single;    //最大速度值
  MaxX: single;    //最大位置值
  WeightUp:single;   //惯性权重的上限（如0.9）
  WeightDown:single; //惯性权重的下限（如0.4）
  MaxIter:integer;  //最大迭代次数
  RunNo:integer;   //相当于全局迭代的次数，通常为2～3次
  {IRangL:single; //空间左限
  IRangR:single; //空间右限  }
  SolutionNo:integer;  //要求输出解的个数
  NoVar:integer;//变量的个数
  NoFltVar:integer;//实数变量个数
  NoIntVar:integer;//整数变量个数
  //NoBinVar:integer;//二进制变量的个数
  GBest:integer;//最优粒子的序号
  AFlt:TFltArray;//实数变量数组
  AInt:TIntArray;//整数变量数组
  //ABin:TIntArray; //二进制变量数组
  UpLmtFlt:array of single;//实数变量的上限数组
  UpLmtInt:array of integer;//整数变量的上限数组
  //UpLmtBin:array of integer;//二进制变量的上限数组
  DnLmtFlt:array of single;//实数变量的下限数组
  DnLmtInt:array of integer;//整数变量的上限数组
  //DnLmtBin:array of integer;//二进制变量的下限数组
  VFlt: TFltArray;  //实数粒子（实数变量）的速度
  VInt: TIntArray;  //整数粒子（整数变量）的速度
  //VFltBin: TFltArray; //二进制粒子（二进制变量）的速度
  MaxVFlt: array of single;
  MaxVInt: array of single;
  PBestFlt: TFltArray; //实数变量的个人最好值数组
  PBestInt: TIntArray; //整数变量的个人最好值数组
  //PBestBin: TIntArray; //二进制变量的个人最好值数组
  VToA: single;  //k值＝速度/位置
  PBestFit,GBestFit:single;//个人最好适应值，和全局最好适应值
  PBest: array of single;  //个人最好值，由于每一个粒子对应一个最好值所以为数组
  MaxOrMin:boolean; //优化问题是最小化还是最大化，最大化ture，最小化false
  Zero: single;//0
   implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i,j,m,n,l:integer;
 ExactDigital : Integer;
FirstTime: boolean;
OptimalSolution: single;
Weight:single;
BeginTime:single; //开始时间
Endtime: single; //结束时间
begin
  AgentNo:=strtoint(Edit1.Text);//粒子个数
  //ECutoff:=strtofloat(edit2.Text);  //用户希望起码达到的结果,（作为终止条件的依据）
  MaxV:=strtofloat(edit4.Text); //最大速度值
  //MaxX:=strtofloat(edit5.Text); //最大位置值
  WeightUp:=strtofloat(edit8.Text); //惯性权重的上限（如0.9）
  WeightDown:=strtofloat(edit9.Text); //惯性权重的下限（如0.4）
  MaxIter:=strtoint(edit3.Text); //最大迭代次数
  RunNo:=strtoint(edit10.Text);; //相当于全局迭代的次数，通常为2～3次
  //IRangL:=strtofloat(edit6.Text);//空间左限
  //IRangR:=strtofloat(edit7.Text); //空间右限
  SolutionNo:=strtoint(edit11.Text); //要求输出解的个数
  NoVar:=strtoint(edit12.Text);//变量的个数
  NoFltVar:=strtoint(edit13.Text);//实数变量个数
  NoIntVar:=strtoint(edit14.Text);//整数变量个数
  //NoBinVar:=NoVar-NoFltVar-NoIntVar;//二进制变量的个数
  VToA:=strtofloat(edit15.Text);
  ExactDigital:=strtoint(edit19.Text);
  zero:=power(10,-ExactDigital);

   //未完 allocate memory to all dynamic arrays
   SetLength(AFlt,AgentNo,NoFltVar);
   SetLength(AInt,AgentNo,NoIntVar);
   //SetLength(ABin,AgentNo,NoBinVar);

   SetLength(PBestFlt,AgentNo,NoFltVar);
   SetLength(PBestInt,AgentNo,NoIntVar);

   SetLength(UpLmtFlt,NoFltVar);//实数变量的上限数组
   SetLength(UpLmtInt,NoIntVar);//整数变量的上限数组
   //SetLength(UpLmtBin,NoBinVar);//二进制变量的上限数组

   SetLength(DnLmtFlt,NoFltVar);//实数变量的下限数组
   SetLength(DnLmtInt,NoIntVar);//整数变量的上限数组
   //SetLength(DnLmtBin,NoBinVar);//二进制变量的下限数组

   SetLength(VFlt,AgentNo,NoFltVar);  //实数粒子（实数变量）的速度
   SetLength(VInt,AgentNo,NoIntVar);  //整数粒子（整数变量）的速度
   //SetLength(VBin,AgentNo,NoBinVar);

   Setlength(MaxVFlt,NoFltVar);
   setlength(MaxVInt,NoIntVar);

   Setlength(PBest,AgentNo);


  //Set parameter

  if (ComboBox1.ItemIndex=0) then
  MaxOrMin:=True        //如果是最大化问题，就令MaxOrMin为true
  else
  if(ComboBox1.ItemIndex=1) then
  MaxorMin:=False      //最小化问题为false
  else
  begin
  ShowMessage('未选择最大还是最小，请选择');
  end;
  (* UpLmtFlt[0]:=10;
   UpLmtFlt[1]:=10;
   DnLmtFlt[0]:=-10;
   DnLmtFlt[1]:=-10;*)
   for l := 0 to NoFltVar-1 do    // Iterate
   begin
    UpLmtFlt[l]:=100;
    DnLmtFlt[l]:=-100;
   end;    // for

   BeginTime:=getTickCount();//开始时间
    for i:=0 to RunNo-1 do
    begin
      randomize;//??
      initagent(UpLmtFlt,DnLmtFlt,UpLmtInt,DnLmtInt);
      firsttime:=true;
      for j:=0 to MaxIter-1 do
      begin
        Weight:=(WeightDown-WeightUp)*j/MaxIter +WeightUp;
        for m:=0 to AgentNo-1 do
        begin
          EvaluateAgent(FirstTime,m);
          for n:=0 to NoFltVar-1 do
          begin
            VFlt[m,n]:=Weight*VFlt[m,n]+2*rand(1)*(PBestFlt[m,n]-AFlt[m,n])+2*rand(1)*(PBestFlt[GBest,n]-AFlt[m,n]);  //速度更新
            if (VFlt[m,n]>MaxVFlt[n]) then
            VFlt[m,n]:=MaxVFlt[n]
            else
              if VFlt[m,n]<-MaxVFlt[n]
              then VFlt[m,n]:=-MaxVFlt[n];
            AFlt[m,n]:=AFlt[m,n]+VFlt[m,n];
            (*if (AFlt[m,n]>UpLmtFlt[n]) then
            AFlt[m,n]:=UpLmtFlt[n]
            else if (AFlt[m,n]<DnLmtFlt[n]) then
            AFlt[m,n]:=DnLmtFlt[n];*)
          end;
          for n:=0 to NoIntVar-1 do
          begin
            VInt[m,n]:=round(Weight*VInt[m,n]+2*rand(1)*(PBestInt[m,n]-AInt[m,n])+2*rand(1)*(PBestInt[GBest,n]-AInt[m,n]));  //先按照取整来作
            if(VInt[m,n]>MaxVInt[n])  then
            VInt[m,n]:=round(MaxVInt[n])
            else
            VInt[m,n]:=-round(MaxVInt[n]);
            AInt[m,n]:=AInt[m,n]+VInt[m,n];

          end;
        end;
        firsttime:=false;
      end;
      EndTime:=getTickCount(); //end time
      Edit16.Text:=floattostr(EndTime-BeginTime);
      OptimalSolution:=Fitness(Gbest);
      if (abs(OptimalSolution)<Zero) then
      OptimalSolution:=0;
      memo1.Text:=memo1.Text+'   '+floattostr(OptimalSolution);
      if (abs(AFlt[GBest,0])<Zero) then AFlt[GBest,0]:=0;
      Edit17.Text:=floattostr(AFlt[Gbest,0]);
      Edit18.Text:=floattostr(Aflt[GBest,1]);
      for l:= 0 to NoFltVar-1 do    // Iterate
      begin
       if (abs(AFlt[Gbest,l])<Zero) then
       AFlt[GBest,l]:=0;
       memo2.Text:=memo2.Text+'  '+floattostr(AFlt[Gbest,l]);
      end;    // for

    end;

end;
//初始化粒子群
procedure TForm1.initagent(UpLmtFlt, DnLmtFlt: array of single; UpLmtInt,DnLmtInt: array of integer);
  var
  i,j:integer;
  GBestTemp:single;
begin
  for i:=0 to AgentNo-1 do
  begin
    for j:=0 to NoFltVar-1 do
    begin
      AFlt[i,j]:=(UpLmtFlt[j]-DnLmtFlt[j])*rand(1)+DnLmtFlt[j];    //在变量的左限和右限之间随机产生一个初始解
      if (abs(UpLmtFlt[j])> abs(DnLmtFlt[j])) //设置最大速度值//
      then                                    //取左右限中大的//
      MaxVFlt[j]:=VToA*abs(UpLmtFlt[j])             //作为空间限    //
      else
      MaxVFlt[j]:=VToA*abs(DnLmtFlt[j]);
      VFlt[i,j]:=rand(1)*MaxVFlt[j]; //在最大速度范围内随机产生一个速度值
      if (rand(1)>0.5) then
      VFlt[i,j]:=-rand(1)*MaxVFlt[j]; //且令其有50％的概率为负
      PBestFlt[i,j]:=AFlt[i,j];     //令各个粒子的PBest为初始值
    end;
    for j:=0 to NoIntVar-1 do             //对整数部分同样处理
    begin
      AInt[i,j]:=Round((UpLmtInt[j]-DnLmtInt[j])*rand(1)+DnLmtInt[j]); //round四舍五入函数
      if (abs(UpLmtInt[j])> abs(DnLmtInt[j]))
      then
      MaxVInt[j]:=VToA*abs(UpLmtInt[j])//这里的最大速度值不必取整
      else
      MaxVInt[j]:=VToA*abs(DnLmtInt[j]);
      VInt[i,j]:=Round(rand(1)*MaxVInt[j]); //??
      if (rand(1)>0.5) then
      VInt[i,j]:=-Round(rand(1)*MaxVInt[j]);
      PBestInt[i,j]:=AInt[i,j];
    end;
  {for j:=0 to NoBinVar-1 do
  begin
    if (rand(1)>0.5) then ABin[i,j]:=0
    else ABin[i,j]:=1;
    VFltBin[i,j]:=rand(1)*MaxV;
  end;}
  PBest[i]:=Fitness(i); //将该粒子的当前适应值设为个人最好适应值
  end;
 GBestTemp:=PBest[0];
  for i:=1 to AgentNo-1 do//
  begin
  if (PBest[i]<GBestTemp)then
  begin
  GBestTemp:=PBest[i];
  GBest:=i;
  end;
  end;  //全局最好粒子设为Gbest}
end;
//适应值计算函数


Procedure TForm1.EvaluateAgent(FirstTime:boolean;m:integer);
var
n:Integer;
FitnessValue:single;
begin
  if(firsttime=false) then
  begin
    FitnessValue:=Fitness(m);     //计算适应度
    if (MaxOrMin) then       //如果是最大化问题
      begin
        if (Fitnessvalue>Pbest[m]) then           //若该适应值好于PBest.则用该值更新PBestFlt数组
        begin
          PBest[m]:=FitnessValue;
          for n:=0 to NoFltVar-1 do
            PBestFlt[m,n]:=AFlt[m,n];
          for n:=0 to NoIntVar-1 do
            PBestInt[m,n]:=AInt[m,n];
        end;
        if (PBest[m]>PBest[GBest]) then     //若该PBest也好于群体最好粒子，则更新。
          GBest:=m;
      end
    else  //若是最小化问题。
    begin
      if (FitnessValue<Pbest[m]) then
        begin
          PBest[m]:=FitnessValue;
          for n:=0 to NoFltVar-1 do
            PBestFlt[m,n]:=AFlt[m,n];
          for n:=0 to NoIntVar-1 do
            PBestInt[m,n]:=AInt[m,n];
        end;
      if (PBest[m]<PBest[GBest]) then
        GBest:=m;
    end;
  end;
end;


Function TForm1.Fitness(b:integer):single;
begin
 result:=(sqr(sin(sqrt(sqr(AFlt[b,0])+sqr(AFlt[b,1]))))-0.5)/sqr(1+0.001*(sqr(AFlt[b,0])+sqr(AFlt[b,1])))-0.5;
end;
//产生0到a之间的随机数
Function TForm1.rand(a: integer): single;
begin
  result:=a*random(1001)/1000;
end;



end.