Quadratic Obj with Linear Cons, Using Bicriterion(ga3)
/******************************************************************/
/* */
/* S A S S A M P L E L I B R A R Y */
/* */
/* NAME: ga3 */
/* TITLE: Quadratic Obj with Linear Cons, Using Bicriterion(ga3)*/
/* PRODUCT: OR */
/* SYSTEM: ALL */
/* KEYS: OR */
/* PROCS: GA */
/* DATA: */
/* */
/* SUPPORT: UPDATE: */
/* REF: */
/* MISC: Example 3 from the GA chapter of Local Search */
/* Optimization. */
/* */
/******************************************************************/
/* Input linear constraint matrix */
data lincon;
input A1-A13 b;
datalines;
2 2 0 0 0 0 0 0 0 1 1 0 0 10
2 0 2 0 0 0 0 0 0 1 0 1 0 10
2 0 2 0 0 0 0 0 0 0 1 1 0 10
-8 0 0 0 0 0 0 0 0 1 0 0 0 0
0 -8 0 0 0 0 0 0 0 0 1 0 0 0
0 0 -8 0 0 0 0 0 0 0 0 1 0 0
0 0 0 -2 -1 0 0 0 0 1 0 0 0 0
0 0 0 0 0 -2 -1 0 0 0 1 0 0 0
0 0 0 0 0 0 0 -2 -1 0 0 1 0 0
;
/* Input lower and upper bounds */
data bounds;
input lower upper;
datalines;
0 1
0 1
0 1
0 1
0 1
0 1
0 1
0 1
0 1
0 100
0 100
0 100
0 1
;
title1 'Bicriteria Constraint Handling Example';
proc ga lastgen = out matrix1 = lincon seed = 555555 data1 = bounds
novalidate = 3;
call SetEncoding('R13R3');
nvar = 13;
ncon = 9;
function quad(selected[*], matrix1[*,*], nvar, ncon);
array x[1] /nosym;
array r[3] /nosym;
array violations[1] /nosym;
call dynamic_array(x, nvar);
call dynamic_array(violations, ncon);
call ReadMember(selected,1,x);
sum1 = 0;
do i = 1 to 4;
sum1 + x[i] - x[i] * x[i];
end;
sum2 = 0;
do i = 5 to 13;
sum2 + x[i];
end;
obj = 5 * sum1 - sum2;
call EvaluateLC(matrix1,violations,sumvio,selected,1);
r[1] = obj;
r[2] = sumvio;
call WriteMember(selected,2,r);
return(obj);
endsub;
call SetObjFunc('quad',0);
subroutine update(popsize);
/* find pareto-optimal set */
array minmax[3] /nosym (-1 -1 0);
array results[1,1] /nosym;
array scratch[1] /nosym;
call dynamic_array(scratch, popsize);
call dynamic_array(results,popsize,3);
/* read original and constraint objectives, stored in
* solution segment 2, into array */
call GetSolutions(results,popsize,2);
/* mark the pareto-optimal set */
call MarkPareto(scratch, npareto,results, minmax);
/* transfer the results to the solution segment */
do i = 1 to popsize;
results[i,3] = scratch[i];
end;
/* write updated segment 2 back into solution population
*/
call UpdateSolutions(results,popsize,2);
/* Set Elite parameter to preserve the first 15 pareto-optimal
* solutions
*/
if npareto < 16 then
call SetElite(npareto);
else
call SetElite(15);
endsub;
call SetUpdateRoutine('update');
function paretocomp(selected[*]);
array member1[3] /nosym;
array member2[3] /nosym;
call ReadCompare(selected,2,1, member1);
call ReadCompare(selected,2,2, member2);
/* if one member is in the pareto-optimal set
* and the other is not, then it is the
* most fit
*/
if(member1[3] > member2[3]) then
return(1);
if(member2[3] > member1[3]) then
return(-1);
/* if both are in the pareto-optimal set, then
* the one with the lowest constraint violation
* is the most fit
*/
if(member1[3] = 1) then do;
if member1[2] <= member2[2] then
return(1);
return( -1);
end;
/* if neither is in the pareto-optimal set, then
* take the one that dominates the other
*/
if (member1[2] <= member2[2]) &
(member1[1] <= member2[1]) then
return(1);
if (member2[2] <= member1[2]) &
(member2[1] <= member1[1]) then
return(-1);
/* if neither dominates, then consider fitness to be
* the same
*/
return( 0);
endsub;
call SetSel('tournament', 'size', 2);
call SetCompareRoutine('paretocomp');
/* set up crossover parameters */
subroutine Cross1(selected[*], alpha);
call Cross(selected,1, 'twopoint',alpha);
endsub;
call SetCrossRoutine('Cross1',2,2);
alpha = 0.5;
call SetCrossProb(0.8);
/* set up mutation parameters */
subroutine Mut1(selected[*], delta[*]);
call Mutate(selected,1,'delta',delta,1);
endsub;
call SetMutRoutine('Mut1');
array delta[13] /nosym (.5 .5 .5 .5 .5 .5 .5 .5 .5 10 10 10 .1);
call SetMutProb(0.05);
/* Initialize first population */
call SetBounds(lower, upper);
popsize = 100;
call Initialize('DEFAULT',popsize);
call ContinueFor(500);
run;
quit;