Решение задачи повышения надежности резервирования

num: integer;

begin

{for i:= 0 to L-1 do

for j:= 0 to N-1 do

if random(101)/100 <= Pmut then

TempPop. Individs[i] [j]:= random(3) + 1;}

for i:= 1 to L-1 do

if random(101)/100 <= Pmut then

for j:= 1 to N-1 do

if random(101)/100 <= Pmut then

TempPop. Individs[i] [j]:= random(3) + 1;

end;

function SumTxX (var Indiv: TIndivid): real;

var

j: integer;

begin

result:= 0;

for j:= 0 to N-1 do

case Indiv[j] of

1: result:= result + 1/T[j];

2: result:= result + 2/3/T[j];

3: result:= result + 6/5/T[j];

end;

end;

procedure FixPopulation (var TempPop: TPopulation);

var i, index: integer;

begin

for i:= 0 to L-1 do

while SumTxX (TempPop. Individs[i]) > 1/Tavg do

begin

index:= random (N);

if TempPop. Individs[i] [index] = 3 then dec (TempPop. Individs[i] [index], random(2)+1)

else if TempPop. Individs[i] [index] = 1 then inc (TempPop. Individs[i] [index])

end;

end;

procedure InitTavg;

var j: integer;

temp: real;

begin

temp:= 0;

for j:= 0 to N-1 do

temp:= temp + 1/T[j];

Tavg:= 1/temp;

end;

procedure InitRecord;

var i: integer;

begin

for i:= 1 to RecQuantity do

begin

Rec[i].S:= -9999999;

Rec[i].P:= -9999999;

Rec[i].Quantity:= 0;

end;

end;

function VectorIsHere (var RecEl: TRecElement; var Indivs: TIndivid): boolean;

var i, j, k: integer;

raznitsa: boolean;

begin

result:= false; /// вектора нет

for i:= 0 to RecEl. Quantity -1 do

begin

raznitsa:= false;

for j:= 0 to N-1 do

if RecEl. Solutions[i] [j] <> Indivs[j] then

begin

raznitsa:= true;

break;

end;

result:= result or not raznitsa;

if result then break;

end;

end;

procedure AddToRecord (var TempPop: TPopulation);

var i, j, k, q, g: integer;

begin

for i:= 0 to L-1 do

for k:= 1 to RecQuantity do

begin

g:= 0;

if (TempPop. Rank[i] >=1) and (TempPop. Rank[i] < 2) then // в рекорд идут недоминируемые решения

Begin // если вектор доминирует

if ((TempPop. Fitness[i].S >= Rec[k].S) and (TempPop. Fitness[i].P > Rec[k].P))

or ((TempPop. Fitness[i].S > Rec[k].S) and (TempPop. Fitness[i].P >= Rec[k].P)) then

begin

rec[k].S:= TempPop. Fitness[i].S;

rec[k].P:= TempPop. Fitness[i].P;

SetLength (rec[k].Solutions, 1);

rec[k].Quantity:= 1; // остальные подтереть

SetLength (rec[k].Solutions[0], N);

for j:= 0 to N-1 do

rec[k].Solutions[0] [j]:= TempPop. Individs[i] [j];

RefreshNum:= 0;

 // подтирание

for g:= k+1 to RecQuantity do

if ((TempPop. Fitness[i].S >= Rec[g].S) and (TempPop. Fitness[i].P > Rec[g].P))

or ((TempPop. Fitness[g].S > Rec[k].S) and (TempPop. Fitness[i].P >= Rec[g].P)) then

begin

Rec[g].S:= -9999999;

Rec[g].P:= -9999999;

Rec[g].Quantity:= 0;

end;

break;

end

else // если вектор равен. то добавляем еще одно возможное решение

if (TempPop. Fitness[i].S = Rec[k].S) and (TempPop. Fitness[i].P = Rec[k].P) then

begin

if not VectorIsHere (Rec[k], TempPop. Individs[i]) then

begin

inc (rec[k].Quantity);

SetLength (rec[k].Solutions, rec[k].Quantity);

SetLength (rec[k].Solutions [rec[k].Quantity-1], N);

for j:= 0 to N-1 do

rec[k].Solutions [rec[k].Quantity-1] [j]:= TempPop. Individs[i] [j];

RefreshNum:= 0;

end;

break;

end

else if (TempPop. Fitness[i].S <= Rec[k].S) and (TempPop. Fitness[i].P <= Rec[k].P) then

break

End;

end;

end;

procedure CopyPopulation (var PopFrom: TPopulation; var PopInto: TPopulation);

var i, j: integer;

begin

for i:= 0 to L-1 do

begin

PopInto. Rank[i]:= PopFrom. Rank[i];

PopInto. Fitness[i].S:= PopFrom. Fitness[i].S;

PopInto. Fitness[i].P:= PopFrom. Fitness[i].P;

for j:= 0 to N-1 do

begin

PopInto. Individs[i] [j]:= PopFrom. Individs[i] [j];

end;

end;

end;

procedure InitRec;

begin

SetLength (Rec, RecQuantity + 1);

end;

procedure EraseRec;

begin

Rec:= nil;

end;

procedure InitInputArrays;

begin

SetLength (P, N);

SetLength (T, N);

SetLength (S, N);

SetLength (G, N);

end;

procedure EraseInputArrays;

begin

P:= nil;

T:= nil;

S:= nil;

G:= nil;

end;

END.

Размещено на Allbest.ru