Zamrznutí programu – Pascal – Fórum – Programujte.com

Ahoj,

právě jsem napsal svůj první program založený na evolučním algoritmu. Program funguje pěkně, akorát když zadám počet jedinců jiný než 100 tak se mi zasekne. Nezamrzne klasicky, že nejde vypnout atd., jenom se zasekne na náhodné hodnotě.

program Evoluce2;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp,crt,math
  { you can add units after this };
const geny=15;  //"kvalita" reseni
      miramutace=7; //zvýšení rozmanitosti (max stejna jako "geny", min je 0)
      pocj=1000;  //vzorek (velikost) populace
      pocgen=30;  //mira evoluce
      elita=30;   //zvysují kvalitu populace (prezivaji do dalsi generace)
      min=0;
      max=0.8;
      delka=8;
      delitel=16384;
type jedinec=record
     vlastnosti:array[1..2,1..geny] of char;
     fitness:real;
end;
type di=record
     hodnota:real;
     index:integer;
end;
var a:Array[1..pocj,0..2] of jedinec;//poradi/generace
    nejfit:array[1..elita] of di;
    pouziti:array[1..pocj] of boolean;
    i,j,k,p,l:int64;
    pravdepodobnost:real;
    elitni:boolean;
    F:text;
function expo(base,exponent:integer):integer;
         var i:integer;
         begin
              expo:=1;
              for i:=1 to exponent do
                  expo:=expo*base;
         end;
function BinToDec(Bin:string):integer;
         var i:byte;
         begin
              BinToDec:=0;
              for i:=1 to Length(Bin) do
                  begin
                       BinToDec:=BinToDec+StrToInt(Bin[i])*expo(2,Length(Bin)-i);
                  end;
         end;
Function O1ToChar(a:byte):char;
         begin
              case a of
              0:O1ToChar:='0';
              1:O1ToChar:='1';
              end;
         end;
Function Fxy(x,y:real):real; //funkce, u které hledám maximum
         begin
              Fxy:=-cos(3*pi*((x-(power(2,geny-1)))/power(2,geny-1)))-cos(3*pi*((y-(power(2,geny-1)))/power(2,geny-1)))+sin((y-(power(2,geny-1)))/power(2,geny-1))+sin((x-(power(2,geny-1)))/power(2,geny-1))+4;
         end;
function mutace(s1:string):string;
          var a:integer;
              b:array[1..15] of integer;
              i:integer;
          begin
               mutace:=s1;
               a:=random(miramutace)+1;
               for i:=1 to a do
                   begin
                        b[i]:=random(geny)+1;
                        if mutace[b[i]]='0' then
                           mutace[b[i]]:='1'
                        else mutace[b[i]]:='0';
                   end;
          end;
function krizeni(s1,s2:string):string;
         var rez1,i:integer;
         begin
               rez1:=random(geny-1)+1;
               krizeni:='';
               for i:=1 to rez1 do
                   krizeni:=krizeni+s1[i];
               for i:=rez1+1 to Length(s1) do
                   krizeni:=krizeni+s2[i];
         end;
begin
     Assign(F,'Body.nb');
     rewrite(F);
     writeln(F,'Plot3D[(-Cos[3*Pi*x]+Sin[x])+(-Cos[3*Pi*y]+Sin[y])+4,{x,-',((power(2,geny-1))/(delitel)):0:delka,',',((power(2,geny-1))/(delitel)):0:delka,'},{y,-',((power(2,geny-1))/(delitel)):0:delka,',',((power(2,geny-1))/(delitel)):0:delka,'}]');
     write(F,'Graphics3D[Point[{');
     randomize;
     for i:=1 to pocj do
         begin
              for j:=1 to geny do
                  begin
                       a[i,0].vlastnosti[1,j]:=O1ToChar(Random(2));
                       a[i,0].vlastnosti[2,j]:=O1ToChar(Random(2));
                  end;
              a[i,0].fitness:=Fxy(BinToDec(a[i,0].vlastnosti[1]),BinToDec(a[i,0].vlastnosti[2]));
              if i mod 5=0 then
                 writeln(f,'{',((BinToDec(a[i,0].vlastnosti[1])-(power(2,geny-1)))/delitel):0:delka,',',((BinToDec(a[i,0].vlastnosti[2])-(power(2,geny-1)))/delitel):0:delka,',',(a[i,0].fitness/10):0:delka,'},')
              else
                 write(f,'{',((BinToDec(a[i,0].vlastnosti[1])-(power(2,geny-1)))/delitel):0:delka,',',((BinToDec(a[i,0].vlastnosti[2])-(power(2,geny-1)))/delitel):0:delka,',',(a[i,0].fitness/10):0:delka,'},');
         end;
     writeln(f,'{',((BinToDec(a[1,0].vlastnosti[1])-(power(2,geny-1)))/delitel):0:delka,',',((BinToDec(a[1,0].vlastnosti[2])-(power(2,geny-1)))/delitel):0:delka,',',(a[1,0].fitness/10):0:delka,'}}],Axes->True,PlotRange->{{-',((power(2,geny-1))/(delitel)):0:delka,',',((power(2,geny-1))/(delitel)):0:delka,'},{-',((power(2,geny-1))/(delitel)):0:delka,',',((power(2,geny-1))/(delitel)):0:delka,'},{',min,',',max:0:3,'}}]');
     i:=0;
     repeat
           i:=i+1;
           for k:=1 to pocj do
               pouziti[k]:=false;
           writeln(F);
           write(F,'Graphics3D[Point[{');
           for j:=1 to elita do
               begin
                    nejfit[j].hodnota:=-100;
                    nejfit[j].index:=0;
               end;
           for p:=1 to pocj do
               begin
                    if (i mod 3=0) then
                       begin
                            if a[p,2].fitness>=nejfit[1].hodnota then
                               begin
                                    nejfit[1].hodnota:=a[p,2].fitness;
                                    nejfit[1].index:=p;
                               end;
                       end
                    else
                        if a[p,(i mod 3)-1].fitness>=nejfit[1].hodnota then
                           begin
                                nejfit[1].hodnota:=a[p,(i mod 3)-1].fitness;
                                nejfit[1].index:=p;
                           end;
               end;
           if (i mod 3=0) then
             a[1,(i mod 3)].vlastnosti:=a[nejfit[1].index,2].vlastnosti
           else
           a[1,(i mod 3)].vlastnosti:=a[nejfit[1].index,(i mod 3)-1].vlastnosti;
           p:=1;
           repeat
                 k:=0;
                 p:=p+1;
                 repeat
                       k:=k+1;
                       elitni:=true;
                       for j:=1 to p-1 do
                          elitni:=((elitni) and (k<>nejfit[j].index));
                       if elitni=true then
                        if (i mod 3=0) then
                         begin
                              if ((a[k,2].fitness>=nejfit[p].hodnota) and (a[k,2].fitness<=nejfit[p-1].hodnota)) then
                                 begin
                                      nejfit[p].hodnota:=a[k,2].fitness;
                                      nejfit[p].index:=k;
                                 end;
                         end
                        else
                         begin
                          if ((a[k,(i mod 3)-1].fitness>=nejfit[p].hodnota) and (a[k,(i mod 3)-1].fitness<=nejfit[p-1].hodnota)) then
                             begin
                                  nejfit[p].hodnota:=a[k,(i mod 3)-1].fitness;
                                  nejfit[p].index:=k;
                             end;
                         end;
                 until(k=pocj);
              if (i mod 3=0) then
                a[p,(i mod 3)].vlastnosti:=a[nejfit[p].index,2].vlastnosti
              else
                 a[p,(i mod 3)].vlastnosti:=a[nejfit[p].index,(i mod 3)-1].vlastnosti;
           until(p=elita) ;
           j:=0;
           k:=elita;
           repeat
                 j:=j+1;
                 gotoxy(1,1);
                 write(i,' ',j);
                 gotoxy(1,1);
              if (i mod 3=0) then
                pravdepodobnost:=100*(a[j,2].fitness/nejfit[1].hodnota)
              else
                 pravdepodobnost:=100*(a[j,(i mod 3)-1].fitness/nejfit[1].hodnota);
                 p:=random(100)+1;
                 if ((p<=pravdepodobnost) and (pouziti[j]=false)) then
                    begin
                         repeat
                               p:=random(100)+1;
                         until((p<>j) and (pouziti[p]=false)) ;
                         l:=random(2)+1;
                         if ((l=2) and (k<pocj-1)) then
                             begin
                                  if (i mod 3=0) then
                                   begin
                                        k:=k+1;
                                        a[k,(i mod 3)].vlastnosti[1]:=krizeni((a[j,2].vlastnosti[1]),(a[p,2].vlastnosti[1]));
                                        a[k,(i mod 3)].vlastnosti[2]:=krizeni((a[j,2].vlastnosti[2]),(a[p,2].vlastnosti[2]));
                                        k:=k+1;
                                        a[k,(i mod 3)].vlastnosti[1]:=krizeni((a[j,2].vlastnosti[1]),(a[p,2].vlastnosti[1]));
                                        a[k,(i mod 3)].vlastnosti[2]:=krizeni((a[j,2].vlastnosti[2]),(a[p,2].vlastnosti[2]));
                                   end
                                  else
                                    begin
                                     k:=k+1;
                                     a[k,(i mod 3)].vlastnosti[1]:=krizeni((a[j,(i mod 3)-1].vlastnosti[1]),(a[p,(i mod 3)-1].vlastnosti[1]));
                                     a[k,(i mod 3)].vlastnosti[2]:=krizeni((a[j,(i mod 3)-1].vlastnosti[2]),(a[p,(i mod 3)-1].vlastnosti[2]));
                                     k:=k+1;
                                     a[k,(i mod 3)].vlastnosti[1]:=krizeni((a[j,(i mod 3)-1].vlastnosti[1]),(a[p,(i mod 3)-1].vlastnosti[1]));
                                     a[k,(i mod 3)].vlastnosti[2]:=krizeni((a[j,(i mod 3)-1].vlastnosti[2]),(a[p,(i mod 3)-1].vlastnosti[2]));
                                    end;
                             end
                         else
                            begin
                               if (i mod 3=0) then
                                begin
                                     k:=k+1;
                                     a[k,(i mod 3)].vlastnosti[1]:=krizeni((a[j,2].vlastnosti[1]),(a[p,2].vlastnosti[1]));
                                     a[k,(i mod 3)].vlastnosti[2]:=krizeni((a[j,2].vlastnosti[2]),(a[p,2].vlastnosti[2]));
                                end
                               else
                                begin
                                 k:=k+1;
                                 a[k,(i mod 3)].vlastnosti[1]:=krizeni((a[j,(i mod 3)-1].vlastnosti[1]),(a[p,(i mod 3)-1].vlastnosti[1]));
                                 a[k,(i mod 3)].vlastnosti[2]:=krizeni((a[j,(i mod 3)-1].vlastnosti[2]),(a[p,(i mod 3)-1].vlastnosti[2]));
                                end;
                            end;
                         pouziti[j]:=true;
                         pouziti[p]:=true;
                         p:=random(100)+1;
                         if p<=miramutace then
                            begin
                                 a[k,(i mod 3)].vlastnosti[1]:=mutace(a[k,(i mod 3)].vlastnosti[1]);
                                 a[k,(i mod 3)].vlastnosti[2]:=mutace(a[k,(i mod 3)].vlastnosti[2]);
                            end;
                    end;
           until((j=pocj) or (k=pocj)) ;
           if k<pocj then
              for j:=k+1 to pocj do
                  for p:=1 to geny do
                      begin
                           a[j,(i mod 3)].vlastnosti[1,p]:=O1ToChar(Random(2));
                           a[j,(i mod 3)].vlastnosti[2,p]:=O1ToChar(Random(2));
                      end;
           for j:=1 to pocj do
               begin
                    a[j,(i mod 3)].fitness:=Fxy(BinToDec(a[j,(i mod 3)].vlastnosti[1]),BinToDec(a[j,(i mod 3)].vlastnosti[2]));
                    if j mod 4=0 then
                       writeln(F,'{',((BinToDec(a[j,(i mod 3)].vlastnosti[1])-(power(2,geny-1)))/delitel):0:delka,',',((BinToDec(a[j,(i mod 3)].vlastnosti[2])-(power(2,geny-1)))/delitel):0:delka,',',(a[j,(i mod 3)].fitness/10):0:delka,'},')
                    else
                      write(F,'{',((BinToDec(a[j,(i mod 3)].vlastnosti[1])-(power(2,geny-1)))/delitel):0:delka,',',((BinToDec(a[j,(i mod 3)].vlastnosti[2])-(power(2,geny-1)))/delitel):0:delka,',',(a[j,(i mod 3)].fitness/10):0:delka,'},');
               end;
           write(F,'{',((BinToDec(a[1,(i mod 3)].vlastnosti[1])-(power(2,geny-1)))/delitel):0:delka,',',((BinToDec(a[1,(i mod 3)].vlastnosti[2])-(power(2,geny-1)))/delitel):0:delka,',',(a[1,(i mod 3)].fitness/10):0:delka,'}}],Axes->True,PlotRange->{{-',((power(2,geny-1))/(delitel)):0:delka,',',((power(2,geny-1))/(delitel)):0:delka,'},{-',((power(2,geny-1))/(delitel)):0:delka,',',((power(2,geny-1))/(delitel)):0:delka,'},{',min,',',max:0:3,'}}]');
     until(i=pocgen);
     close(F);
end.

Program má výstup jako několik množin bodů zpracovatelných 
ve Wolfram Mathematica. Jak už jsem říkal, pro pocj=100 
funguje, pro čísla menší se sám ukončí bez vyhození 
klasické chybové hlášky a pro větší čísla se zasekne 
v průběhu.

Windows 7 64bit
Lazarus nejnovější patch  
Poradí mi někdo proč se to děje?
PS: vím, že tam mám pár věcí navíc 
(např. několik begin a end)tak sorry        

#1 Kalgys
Jednu logickou chybu máš tady:

expo:=expo*base;

expo je funkce, takže tam máš rekurzi! Musíš použít pomocnou proměnnou a až výsledek uložit do jména funkce.

#2 JoDiK
Takových "chyb" tam máš spoustu, takže je možné, že tvůj překladač to umí i jinak... Netuším ale, jak potom dělá rekurzi....

#3 JoDiK
Ještě jedna chyba:

a[k,(i mod 3)].vlastnosti[1]:=krizeni((a[j,2].vlastnosti[1]),(a[p,2].vlastnosti[1]));

Tady do proměnné typu char přiřazuješ proměnnou typu string!

#4 JoDiK

1) mam ozkoušeno, že "funkce" (při její definici bych to nazval spíše funkční hodnotou) se chová jako proměnná, takže tato rekurze (pokud je ukončena - což je) funguje normálně.

2) viz. 1) popř. upřesni

3) poli charů (ne jednomu charu) přiřazuji string (což je datový typ stejný jako pole charů (myslím že pole od 1..255))

a[k,(i mod 3)].vlastnosti[1] je název celého pole charů (1..15)

v tomto mi ty chyby "nevyskakují"

Chyby mi vyskakují primárně v deklaraci proměnné pravděpodobnost, to by bylo logické např. při dělení číslem blízkým 0, ale i když tam dám "filtr" (if abs(...)<10^-3 then "trochu jiný poměr") tak to blbne, navíc tato čísla blízká 0 jsem podchytil oborem hodnot funkce (tudíž i fitness).

Jak už jsem psal v úvodu, tak mi ten program funguje, ale jen pro hodnotu pocj=100

#5 Kalgys
Nojo, já jsem odkojenej klasickým pascalem, kde typy musely vždy přesně sedět. Když tam máš dvojrozměrné pole charů a je to v tvém překladači kompatibilní s řetězcem, tak se v tom už poněkud ztrácím a v mém překladači tu chybu neodhalím.

Každopádně aby se to chovalo jinak pro jiný počet jednotek je vážná chyba, budeš muset použit debugger a hledat, kde se to cyklí a proč...

#6 JoDiK
Se mi to podařilo upravit tak, že mi to jde zkompilovat a způsobilo to "všeobecnou chybu ochrany" takže tipuju, že asi nemáš pohlídané indexy nebo něco a zapisuje to mimo rozsah proměnných?

#7 JoDiK
jo, chyba 201, chyba rozsahu, takže jak jsem tušil...

#8 JoDiK
Takže si v tom svém překladači zapni kontrolu rozsahu a oprav...

Měl jsem chvilku, tak jsem se ti na to ještě kouknul.

Chyba s počtem jiným než 100 je podle mě tady (je to na několika místech):

p:=random(100)+1;

mělo by být:

p:=random(pocj)+1;

No a další chybou aspoň u mě (BP7) je aritmetické přetečení u výpočtu bintodec do funkce strtoint se předávají řetězce typu '#0' '#0#0' a to se na celé číslo převést nedá, aspoň pascalské str z toho udělá -1345 nebo tak nějak...

Je možné, že novější překladač si s tím poradí,  BP7 for Windows už z toho udělá 0.

#10 JoDiK
Takže ověřeno, pro pocj=20 a elitu 10 (měla by asi být méně než pocj že?) to funguje (tedy neskončí to chybou a vyrobí soubor Body.nb ...)

Další pokus pocj 200, elita 30 funguje.

Tak to bylo asi v tom, co jsem psal...

Pomohlo to? Bylo to tím?

#12 JoDiK
díky moc měj se