Помогите пожалуйста

Модераторы: Duncon, Naeel Maqsudov, Игорь Акопян, Хыиуду

Ответить
Kristi56
Сообщения: 0
Зарегистрирован: 08 дек 2014, 07:18

08 дек 2014, 07:20

Применение генетического алгоритма для решения задач функциональной оптимизации
Задание в Pascal
Найти максимальное значение функции f(x) на заданном интервале, используя генетический алгоритм.
Функция f(x) =0.5*Exp(х)/(5-sin(20*x))
Интервал [0;8]
Численность популяции 50
Число поколений 30
Метод селекции Турнирный
Тип кроссовера Двухточечный
Длина генотипа 16
Вероятность мутации 0.034
Вероятность кроссовера 0.77
Вот Программа на Pascal.Там надо дописать кроссовер и отбор.Помогите пожалуйста.

Uses crt;
Const xn=0;xk=8;N=20;P=30;Gen=8;Pm=0.034; Pc=0.77;
Type PP=array[1..2*N] of string;
ff=array[1..2*N] of real;
Var
NR:byte;
function Fx(a:string):real;

Var
i:byte;
Sum,x:real;
begin
Sum:=0;
for i:=Gen downto 1 do
if a='1' then Sum:=Sum+exp(abs(i-Gen)*ln(2));
x:=xn+(xk-xn)/trunc(exp(Gen*ln(2)))*Sum;
Fx:=0.5*Exp(x)/(5-sin(20*x));
end;


procedure Form(var a:PP;var b:ff);
Var
i,j,k:byte;
begin
for i:=1 to N do begin
a:='';
for j:=1 to Gen do begin
k:=random(2);
if k=0 then
a:=a+'0' else
a:=a+'1';end;
b:=Fx(a);end;
end;

procedure Out(a:PP;b:ff);
Var
i:byte;
begin
writeln(' N KOD Fx');
for i:=1 to N do
writeln( i:2,' ',a, b:9:2);

end;

procedure Crossover(var a:PP;var b:ff);

begin

end;


procedure Mutation(var a:PP;var b:ff);
Var
i,j:byte;
x:real;
begin
for i:=1 to N do begin
for j:=1 to Gen do begin
x:=random(1001);
x:=x/1000;
if x<=Pm then
if a[i,j]='0' then a[i,j]:='1' else a[i,j]:='0';
end;
b[i]:=Fx(a[i]);
end;
end;
procedure Otbor(var a:PP;b:ff);

begin

end;

Var popul:PP;
func:ff;
i:byte;
Begin
clrscr;randomize;
Form(popul,func);
writeln('Nachalnaya populiacia');
Out(popul,func);readln;
for i:=1 to P do begin
Crossover(popul,func);
Mutation(popul,func);
Otbor(popul,func);
end;

writeln;
writeln('Konechnaya populiacia');
Out(popul,func);
readln;
end.
Ответить