Решение задачи повышения надежности резервирования с помощью эволюционного моделирования

for i := 0 to (L div 2) - 1 do

begin

t1 := random(L);

t2 := random(L);

if random(101)/100 <= Pcros then

begin

CrPt := random (N);

for j := 0 to CrPt-1 do

begin

TempPopCr.Individs[2*i][j]:=TempPop.Individs[t1][j];

TempPopCr.Individs[2*i+1][j]:=TempPop.Individs[t2][j];

end;

for j := CrPt to N-1 do

begin

TempPopCr.Individs[2*i][j]:=TempPop.Individs[t2][j];

TempPopCr.Individs[2*i+1][j]:=TempPop.Individs[t1][j];

end;

end

else

for j := 0 to N-1 do

begin

TempPopCr.Individs[2*i][j]:=TempPop.Individs[t1][j];

TempPopCr.Individs[2*i+1][j]:=TempPop.Individs[t2][j];

end;

end;

if L mod 2 <> 0 then

for j := 0 to N-1 do

TempPopCr.Individs[L-1][j]:=TempPop.Individs[t1][j];

end;

procedure MutantPopulation (var TempPop: TPopulation);

var i,j: integer;

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