Range check error

Program sga;
Uses Crt;
 
Const
     maxpop=100;
     maxstring=30;
     dim=2; {- размерность пространства поиска}
 
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=(2.048,2.048);
           {- массив максимальных значений для координат точки в пространстве поиска}
     xmin:fenotype=(-2.048,-2.048);
           {- массив минимальных значений для координат точки в пространстве поиска}
 
Var
     oldpop,newpop,intpop:population;
           {- три непересекающихся популяции - старая, новая и промежуточная}
     popsize,lchrom,gen,maxgen:integer;
           {- глобальные целые переменные}
     pcross,pmutation,sumfitness:real;
           {- глобальные вещественные переменные}
     nmutation,ncross:integer;
           {- статистические целые}
     avg,max,min:real;
           {- статистические вещественные}
     {Дополнительные переменные:}
     popsize0,maxgen0,i1,i2,i3:Integer;
     result,total_result: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;
 
Function rnd(low,high:Integer):Integer;{- cлучайный выбор между low и high}
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;
 
{*** Интерфейсные процедуры ***}
 
Function objfunc(x:fenotype):Real;
Begin
     objfunc:=100*Sqr(Sqr(x[1])-x[2])+Sqr(1-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;
 
{*** Расчет статистических величин ***}
 
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;
 
{*** Процедура инициализации (инициализация начальной популяции случайным образом) ***}
 
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;
 
{*** Генетические операторы отбора, скрещивания и мутации ***}
 
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 (Var child:chromosome; alleleval:allele; pmutation:Real;
                   Var nmutation:Integer; flchrom:Integer):allele;
Var p,mutate:Boolean; j1,j2:Integer;
Begin
     mutate:=flip(pmutation);
 
     If mutate Then Begin
       {Определение точек разрыва:}
        Repeat Begin
          j1:=rnd(0, flchrom-1);
          j2:=rnd(0, flchrom-1);
          End;
        Until j1<>j2;
 
        mutation:=Not alleleval;
        p:=child[j1];
        child[j1]:=child[j2];
        child[j2]:=p;
        nmutation:=nmutation+1;
 
        End
     Else
        mutation:=alleleval;
End;
 
Procedure crossover(Var parent1,parent2,child1,child2:chromosome;
                    flchrom:Integer; Var ncross,nmutation,jcross:Integer;
                    Var pcross,pmutation:Real);
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, parent1[j], pmutation, nmutation, flchrom);
           child2[j]:=mutation(parent2, parent2[j], pmutation, nmutation, flchrom);
     End;
     {Bторая часть обмена (1 to 2 and 2 to 1):}
     If jcross<>flchrom Then
           {- пропуск, если точка скрещивания равна flchrom--скрещивание не происходит}
           For j:=jcross+1 To flchrom Do Begin
                 child1[j]:=mutation(parent2, parent2[j], pmutation, nmutation, flchrom);
                 child2[j]:=mutation(parent1, parent1[j], pmutation, nmutation, flchrom);
           End;
End;
 
{*** Процедура создания нового поколения ***}
 
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
     Clrscr;
     For i3:=1 To 2 Do Begin {- цикл выбора колличества поколений}
           {Колличество поколений:}
           If i3=1 Then popsize0:=50;
           If i3=2 Then popsize0:=100;
           For i1:=1 To 3 Do Begin {- цикл выбора размера популяции}
                 {Размеры популяций:}
                 If i1=1 Then maxgen0:=10;
                 If i1=2 Then maxgen0:=20;
                 If i1=3 Then maxgen0:=30;
                 result:=0; {- инициализация переменной ответа}
                 For i2:=1 To 30 Do Begin{- цикл основной программы}
                       popsize:=popsize0; {- размер популяции}
                       lchrom:=30; {- число битов на один кодируемый параметр}
                       maxgen:=maxgen0; {- максимальное число поколений}
                       pmutation:=0.01; {- вероятность скрещивания}
                       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; {- переход на новое поколение }
                       Until (gen >= maxgen);
                       result:=result+min;
                 End;{- конец цикла главной программы}
                 total_result:=result/30;{- среднее значение результата}
                 Writeln('При ',popsize0,' поколениях и размере популяции ',maxgen0,' особей');
                 Writeln('среднее значение минимума функции в заданной области ',total_result:1:15);
                 Writeln('::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::');
                 result:=0; {Очищаем переменную}
           End;{Конец цикла выбора размера популяций}
     End;{Конец цикла выбора колличества поколений}
     Textcolor(8);
     Writeln;
     Write('Для завершения программы нажмите ENTER');
     Readln;
End.