_evec3v1.pas

微分进化法的pascal程序

              begin
                 k := rt[i] + 1;
                 a5[i] := a4[k];
              end;
{%%%%%% a5}

{%%%%%% pm1}
          for i := 1 to NP do
              begin
                 k := a1[i];
                 for j := 1 to D do
                     pm1[i,j] := popold[k,j]; {* shuffled population 1 *}
              end;
{%%%%%% pm1}

{%%%%%% pm2}
          for i := 1 to NP do
              begin
                 k := a2[i];
                 for j := 1 to D do
                     pm2[i,j] := popold[k,j]; {* shuffled population 2 *}
              end;
{%%%%%% pm2}

{%%%%%% pm3}
          for i := 1 to NP do
              begin
                 k := a3[i];
                 for j := 1 to D do
                     pm3[i,j] := popold[k,j]; {* shuffled population 3 *}
              end;
{%%%%%% pm3}

{%%%%%% pm4}
          for i := 1 to NP do
              begin
                 k := a4[i];
                 for j := 1 to D do
                     pm4[i,j] := popold[k,j]; {* shuffled population 4 *}
              end;
{%%%%%% pm4}

{%%%%%% pm5}
          for i := 1 to NP do
              begin
                 k := a5[i];
                 for j := 1 to D do
                     pm5[i,j] := popold[k,j]; {* shuffled population 5 *}
              end;
{%%%%%% pm5}

{%%%%%% bm}
          for i := 1 to NP do
              for j := 1 to D do
                  bm[i,j] := bestmemiter[1,j]; {* population filled with *}
		                        {* the best member of the last iteration *}
{%%%%%% bm}

          for i := 1 to NP do
              for j := 1 to D do
                  begin
                     teval := rand;
                     if teval < CR   {* all random numbers < CR are 1, 0 otherwise *}
                     then mui[i,j] := 1
                     else mui[i,j] := 0;
                  end;




          if  strategy > 5
          then st := strategy - 5
          else
             begin
                st := strategy;
                for i:= 1 to NP do    {* transpose, collect 1's in each column *}
                    for j := 1 to D do
                        muitrans[i,j] := mui[j,i];
             end;
          for j := 1 to D do
          begin
             valmin := 2;
             for i := 1 to NP do
	         begin
                    if muitrans[i,j] < valmin
                    then
                      begin
                         valmin := muitrans[i,j];  {* shuffle locations of vectors *}
                      end;
                 end;
             for k := 1 to NP do
                 begin
                    if muitrans[k,j]= valmin
                    then muitrans[k,j] := 2;
                 end;
          end;







          for i := 1 to D do
              rotd[i] := i-1;

          for j := 1 to NP do
              begin
                 teval := rand * D;
	         n := round(teval);
	         if n > teval
                 then n := n - 1;
	            if n > 0
 	            then
                       begin
                          for i := 1 to D do
                              begin
                                 transmata[i] := rotd[i] + n;
                                 tempmata[i] := transmata[i]/D;
                                 if tempmata[i] < 1.0
                                 then onezero[i] := 0
               	                 else onezero[i] := 1;
                              end;
    	                  for i := 1 to NP do
                              rtd[i] := transmata[i] - (onezero[i] * D);
	                  for i := 1 to D do
	                      for k:= 1 to NP do
		                  temmui[i,k] := mui[i,k];
	                  for i := 1 to D do
		              for k := 1 to NP do
		                  begin
			             l := rtd[i] + 1;
			             mui[l,k] := temmui[i,k];	{* rotate column i by n *}
		                  end;
                       end;
              end;

          for i := 1 to D do
              for j := 1 to NP do
                   mui[j,i] := muitrans[i,j];	{* transpose back *}

          for i :=1 to NP do
              for j := 1 to D do
                  if mui[i,j] = 1
                  then mpo[i,j] := 0
                  else mpo[i,j] := 1;	{* inverse mask to mui *}

          if st = 1             {* DE/best/1 *}
          then
             for i := 1 to NP do
                 for j := 1 to D do
	             ui[i,j] := (popold[i,j] * mpo[i,j]) + ((bm[i,j] + F * (pm1[i,j] - pm2[i,j])) * mui[i,j])
          else
            if st = 2           {* DE/rand/1 *}
            then
               for i := 1 to NP do
                   for j :=1 to D do
                       ui[i,j] := (popold[i,j] * mpo[i,j]) + ((pm3[i,j] + F * (pm1[i,j] - pm2[i,j])) * mui[i,j])
            else
              if st = 3         {* DE/rand-to-best/1 *}
              then
                 for i := 1 to NP do
                     for j :=1 to D do
                         ui[i,j] := (popold[i,j] * mpo[i,j]) + (popold[i,j] +
                         (F * (bm[i,j] - popold[i,j])) + (F * pm1[i,j] - pm2[i,j]))
              else
                if st = 4       {* DE/best/2 *}
                then
	           for i := 1 to NP do
                       for j :=1 to D do
                           ui[i,j] := (popold[i,j] * mpo[i,j]) + ((bm[i,j] +
                           F * (pm1[i,j] - pm2[i,j] + pm3[i,j] - pm4[i,j])) * mui[i,j])
                else
                  if st = 5     {* DE/rand/2 *}
                  then
	             for i := 1 to NP do
                         for j :=1 to D do
                      	     ui[i,j] := (popold[i,j] * mpo[i,j]) + ((pm5[i,j] +
                             F * (pm1[i,j] - pm2[i,j] + pm3[i,j] - pm4[i,j])) * mui[i,j]);

{*-----Select which vectors are allowed to enter the new population-----*}

      for i := 1 to NP do
          begin
             sqall := 0.0;
             for k := 1 to XY do
                 begin
                    ger := (ydata[k] - (pop[i,1]*xdata[k]*xdata[k])) * (ydata[k] - (pop[i,1]*xdata[k]*xdata[k]));  {***}
                    sqall := sqall + ger;
                 end;
                 memberval[i] := sqall;
          end;

      for i := 1 to NP do
          begin
             sqall := 0;
             for k := 1 to XY do
                 begin
                    ger := (ydata[k] - (ui[i,1]*xdata[k]*xdata[k])) * (ydata[k] - (ui[i,1]*xdata[k]*xdata[k]));  {***}
                    sqall := sqall + ger;
                 end;
                 membervalui[i] := sqall;
          end;

      for i := 1 to NP do
          if membervalui[i] < memberval[i]
          then
            begin
               for j := 1 to D do
                   pop[i,j] := ui[i,j];
                   memberval[i] := membervalui[i];
            end;

      bestval := memberval[1];
      for i := 1 to D do
          bestmemiter[1,i] := pop[1,i];
      for i := 2 to NP do
          begin
             if memberval[i] < bestval
             then
               begin
                  for j := 1 to D do
                      bestmemiter[1,j] := pop[i,j];
                  bestval := memberval[i];
               end;
          end;

      for i := 1 to D do
          bestmem[1,i] := bestmemiter[1,i];
      bestvalev := bestval;

{*-----Output section-----*}

      writeln(res);
      writeln(res,'---------------------------------------------------');
      writeln(res);
      writeln(res,'  Generation:   ',cur_gen,'.');
      writeln(res);
      for i := 1 to NP do
          begin
             write(res,i,'.  [');
             begin
                for j := 1 to D - 1 do
                    write(res,pop[i,j],' ');
             end;
             writeln(res,pop[i,D],' ],  value: ',memberval[i]);
          end;
      writeln(res);
      write(res,'  Best member:  ');
      write(res,'[ ');
      for j := 1 to D - 1 do
          write(res,bestmem[1,j],' ');
      writeln(res,bestmem[1,D],' ]');
      writeln(res,'  Value of best member ever:  ',bestvalev);
      writeln(res);
      writeln(res,'---------------------------------------------------');

      writeln;
      write('Generation   ',cur_gen,':      Best member ever: [');
      for j := 1 to D - 1 do
          write(bestmem[1,j],' ');
      writeln(bestmem[1,D],' ]');

      if bestvalev < VTR
      then goto theend;

      cur_gen := cur_gen + 1;

   end;

theend: writeln;
writeln('Calculations are done. "Value To Reach" has been reached.');
writeln('Results are in c:/result.txt file.');
writeln('Press any key...');
repeat until keypressed;

END.