Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 08.12.2014, 07:14   #1
Kristi56
Новичок
Джуниор
 
Регистрация: 08.12.2014
Сообщений: 2
Сообщение Применение генетического алгоритма для решения задач функциональной оптимизации

Задание в 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[i]='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[i]:='';
 for j:=1 to Gen do begin
  k:=random(2);
 if k=0 then
 a[i]:=a[i]+'0' else
 a[i]:=a[i]+'1';end;
 b[i]:=Fx(a[i]);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[i],   b[i]: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.

Последний раз редактировалось Stilet; 08.12.2014 в 07:34.
Kristi56 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание алгоритма оптимизации кода VyachNik Общие вопросы Delphi 7 21.02.2012 17:42
Разработать схему алгоритма для решения задач(Pascal) Alexandr Foobar Помощь студентам 3 07.01.2012 14:54
Задача раскроя в Delphi с использованием генетического алгоритма kaktusss Фриланс 2 29.01.2011 16:45