Zamrznutí programu – Pascal – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu

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

 

Toto vlákno bylo označeno za vyřešené.
Kalgys0
Návštěvník
30. 10. 2012   #1
-
0
-

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        
Nahlásit jako SPAM
IP: 62.84.150.–
JoDiK
~ Anonymní uživatel
987 příspěvků
31. 10. 2012   #2
-
0
-

#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.

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
31. 10. 2012   #3
-
0
-

#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....

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
31. 10. 2012   #4
-
0
-

#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!

Nahlásit jako SPAM
IP: 88.103.236.–
Kalgys0
Návštěvník
31. 10. 2012   #5
-
0
-

#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

Nahlásit jako SPAM
IP: 62.84.150.–
JoDiK
~ Anonymní uživatel
987 příspěvků
1. 11. 2012   #6
-
0
-

#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č...

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
1. 11. 2012   #7
-
0
-

#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?

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
1. 11. 2012   #8
-
0
-

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

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
1. 11. 2012   #9
-
0
-

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

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
1. 11. 2012   #10
-
0
-

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.

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
1. 11. 2012   #11
-
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...

Nahlásit jako SPAM
IP: 88.103.236.–
JoDiK
~ Anonymní uživatel
987 příspěvků
4. 11. 2012   #12
-
0
-

Pomohlo to? Bylo to tím?

Nahlásit jako SPAM
IP: 88.103.233.–
Kalgys0
Návštěvník
4. 11. 2012   #13
-
0
-

#12 JoDiK
díky moc měj se 

Nahlásit jako SPAM
IP: 62.84.150.–
Zjistit počet nových příspěvků

Přidej příspěvek

Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!

Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 1 host

Podobná vlákna

Chyba v programu — založil choice_

Překlad programu — založil David Kolibřík

Padanie programu v C — založil Erik12345

Moderátoři diskuze

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032024 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý