Run Code
|
API
|
Code Wall
|
Misc
|
Feedback
|
Login
|
Theme
|
Privacy
|
Patreon
Genetic Pascal
program sga; uses crt; const maxpop = 100; maxstring = 30; dim = 1; {размерность пространства поиска} type allele = boolean; { позиция в битовой строке} chromosome = array[1..maxstring*dim] of allele; {битовая строка} fenotype = array[1..dim] of real; {фенотип = массив вещественных координат точки в пространстве поиска} individual = record chrom:chromosome; {генотип = битовая строка} x:fenotype; {фенотип = массив вещественных координат точки в пространстве поиска} fitness:real; {значение целевой функции} end; population = array[1..maxpop] of individual; const xmax:fenotype=(5.12); {массив максимальных значений для координат точки в пространстве поиска} xmin:fenotype=(-5.12); {массив минимальных значений для координат точки в пространстве поиска} var oldpop, newpop, intpop :population; {Три непересекающихся популяции ? старая, новая и проме-жуточная} popsize, lchrom, gen, maxgen :integer; {Глобальные целые переменные} pcross, pmutation, sumfitness :real; {глобальные вещественные переменные} nmutation, ncross :integer; {Статистические целые} avg, max, min :real; {Статистические вещественные} {Вероятностные процедуры} function random_:real; begin random_:=random(65535)/(65535-1); end; function flip(probability:real):boolean; {подбрасывание монетки ? true если орел} begin if probability=1.0 then flip:=true else flip:=(random_<=probability); end; {Случайный выбор между low и high} function rnd(low,high:integer):integer; var i:integer; begin if low >= high then i := low else begin i := trunc( random_ * (high-low+1) + low); if i > high then i := high; end; rnd := i; end; {интерфейсные процедуры: decode and objfunc} function objfunc(x:fenotype):real; begin objfunc:= sqr(x[1]); end; procedure decode(chrom:chromosome; lbits:integer; var x:fenotype); {Декодирование строки в массив вещественных координат точки в пространстве поиска - true=1, false=0} var i,j:integer; f, accum, powerof2:real; begin for i:=1 to dim do begin accum:=0.0; powerof2:=1; f:=1; for j:=1+lbits*(i-1) to lbits+lbits*(i-1) do begin if chrom[j] then accum := accum + powerof2; powerof2 := powerof2 * 2; f:=f*2; end; x[i]:=xmin[i]+(xmax[i]-xmin[i])*accum/(f-1) end end; {Расчет статистических величин: statistics } procedure statistics(popsize:integer; var max,avg,min,sumfitness:real; var pop:population); {Расчет статистик популяции } var j:integer; begin {Инициализация } sumfitness := pop[1].fitness; min := pop[1].fitness; max := pop[1].fitness; {Цикл для max, min, sumfitness } for j := 2 to popsize do with pop[j] do begin sumfitness := sumfitness + fitness; {Накопление суммы значений функции пригодности} if fitness>max then max := fitness; {Новое значение max} if fitness<min then min := fitness; {Новое значение min} end; avg := sumfitness/popsize; {Расчет среднего} end; {Процедура инициализации initpop} procedure initpop; {Инициализация начальной популяции случайным образом} var j, j1:integer; begin for j := 1 to popsize do with oldpop[j] do begin for j1 := 1 to lchrom*dim do chrom[j1] := flip(0.5); {Бросок монетки} decode(chrom,lchrom,x); {Декодирование строки} fitness := objfunc(x); {Вычисление начальных значений функции пригодности} end; end; {3 генетических оператора: отбора (select), скрещивания (crossover) и мутации (mutation)} procedure select; {процедура выбора} var ipick:integer; procedure shuffle(var pop:population); {процедура перемешивания популяции в процессе отбора} var i,j:integer; ind0:individual; begin for i := popsize downto 2 do begin j:= random(i-1)+1; ind0:=pop[i]; pop[i]:=pop[j]; pop[j]:=ind0; end; end; function select_1:integer; var j1,j2,m:integer; begin if (ipick>popsize) then begin shuffle(oldpop); ipick:=1 end; j1:=ipick; j2:=ipick+1; if (oldpop[j2].fitness<oldpop[j1].fitness) then m:=j2 else m:=j1; ipick:=ipick+2; select_1:=m; end; var j:integer; begin ipick:=1; for j:=1 to popsize do begin intpop[j]:=oldpop[select_1]; end; oldpop:=intpop; end; function mutation (alleleval:allele; pmutation:real; var nmutation:integer):allele; {мутация одного бита в строке (аллеля) с вероятностью pmutation, count number of mutations} var mutate:boolean; begin mutate := flip(pmutation); if mutate then begin nmutation := nmutation + 1; mutation := not alleleval; end else mutation := alleleval; end; procedure crossover(var parent1, parent2, child1, child2:chromosome; flchrom:integer; var ncross, nmutation, jcross:integer; var pcross, pmutation:real); {Скрещивание 2 родительских строк, результат помещается в 2 строках-потомках} var j:integer; begin if flip(pcross) then begin {Выполняется скрещивание с вероятностью pcross} jcross:=rnd(1,flchrom-1); {Определение точки сечения в диапазоне между 1 и l-1} ncross:=ncross + 1; {Инкрементирование счетчика скрещиваний} end else jcross:=flchrom; {певая часть обмена , 1 to 1 and 2 to 2} for j := 1 to jcross do begin child1[j]:=mutation(parent1[j], pmutation, nmutation); child2[j]:=mutation(parent2[j], pmutation, nmutation); end; {вторая часть обмена, 1 to 2 and 2 to 1} if jcross<>flchrom then {пропуск, если точка скрещивания равна flchrom--скрещивание не происходит} for j := jcross+1 to flchrom do begin child1[j] := mutation(parent2[j], pmutation, nmutation); child2[j] := mutation(parent1[j], pmutation, nmutation); end; end; {Процедура создания нового поколения: generation} procedure generation; {Генерирование нового поколения при помощи отбора, скрещивания и мутации} {Прим: предполагается, что популяция имеет четный размер} var j, mate1, mate2, jcross:integer; begin select; j := 1; repeat {выполняются отбор, скрещивание и мутация, пока полностью не сформируется новая популяция ? newpop} mate1:=j; {выбор родительской пары} mate2:=j+1; {скрещивание и мутация ? мутация вставлена в процедуру скрещивания} crossover(oldpop[mate1].chrom, oldpop[mate2].chrom, newpop[j].chrom, newpop[j + 1].chrom, lchrom*dim, ncross, nmutation, jcross, pcross, pmutation); {Декодирование строки и вычисление пригодности} with newpop[j] do begin decode(chrom, lchrom,x); fitness := objfunc(x); end; with newpop[j+1] do begin decode(chrom, lchrom,x); fitness := objfunc(x); end; j := j + 2; until j>popsize end; begin { Главная программа } popsize:=20; {размер популяции} lchrom:=20; {число битов на один кодируемый параметр} maxgen:=100; {максимальное число поколений} pmutation:=0.1; {вероятность скрещивания} pcross:=0.9; {вероятность мутации} randomize; {Инициализация генератора случайных чисел} nmutation := 0; ncross := 0; {Инициализация счетчиков} initpop; statistics (popsize, max, avg, min, sumfitness, oldpop); gen:= 0; {Установка счетчика поколений в 0} repeat {Главный итерационный цикл} gen:= gen + 1; generation; statistics(popsize, max, avg, min, sumfitness, newpop); oldpop:= newpop; {переход на новое поколение } writeln('min= ',min); until (gen >= maxgen) end. {End главной программы}
run
|
edit
|
history
|
help
0
virtuelna ravan-preklapanje krugova
zadacha4
Enkripsi2
solar sysmtem 6 (with random mass m1)
practica 1 ejercicio 3
POBLAR Y MOSTRAR VECTOR EDADES
lecturas
Определение стенки с максимальной высотой
Zadanie 3 б
считалочка06