Problém s fcí arctan – Pascal – Fórum – Programujte.com

Zdravím vás, píšu program na vykreslování fraktálů (tzv. vločka).

Tady přikládám zdroják, tento je bez problému sestaven, ale během běhu programu mi to spadne tam kde mám koment "problém" nevím proč. Hodnota argumentu u arctan může být cokoli z R takže jsem v koncích. děkuji

CreateDir('Fraktal');
     for i:=1 to pocetperiod do
         begin
              Fname[i]:=fr+rad+IntToStr(i)+tx;
              assign(F[i],Fname[i]);
              rewrite(f[i]);
              close(f[i]);
         end;
     x:=cos(pi/2);
     y:=sin(pi/2);
     append(f[1]);
     writeln(F[1],x:0:6,',',y:0:6);
     for i:=2 to poctvar+1 do
         begin
              x:=cos(pi/2+((i-1)*2*pi)/(poctvar));
              y:=sin(pi/2+(2*pi*(i-1))/(poctvar));
              writeln(F[1],x:0:6,',',y:0:6);
         end;
     close(f[1]);
     for i:=2 to pocetperiod do
         begin
              reset(f[i-1]);
              append(F[i]);
              readln(F[i-1],Name1);
              j:=0;
              Aname:='';
              repeat
                    j:=j+1;
                    Aname:=Aname+Name1[j];
              until(Name1[j+1]=',') ;
              A.x:=strtoreal(Aname);
              j:=j+1;
              Bname:='';
              repeat
                    j:=j+1;
                    Bname:=Bname+Name1[j];
              until(j=Length(Name1));
              A.y:=strtoreal(Bname);
              writeln(F[i],Name1);
              while not eof(F[i-1]) do
                    begin
                         readln(F[i-1],Name2);
                         j:=0;
                         Aname:='';
                         repeat
                               j:=j+1;
                               Aname:=Aname+Name2[j];
                         until(Name2[j+1]=',') ;
                         B.x:=strtoreal(Aname);
                         j:=j+1;
                         Bname:='';
                         repeat
                               j:=j+1;
                               Bname:=Bname+Name2[j];
                         until(j=Length(Name1));
                         B.y:=strtoreal(Bname);
                         x:=(2*A.x+B.x)/3;
                         y:=(2*A.y+B.y)/3;
                         writeln(F[i],x:0:6,',',y:0:6);
                         x:=cos(arctan((y-A.y)/(x-A.x))-(2*pi/poctvar))+x;  //problem
                         y:=sin(arctan((y-A.y)/(x-A.x))-(2*pi/poctvar))+y; //problem
                         writeln(F[i],x:0:6,',',y:0:6);
                         x:=(A.x+2*B.x)/3;
                         y:=(A.y+2*B.y)/3;
                         writeln(F[i],x:0:6,',',y:0:6);
                         writeln(F[i],B.x:0:6,',',B.y:0:6);
                         A:=B;
                    end;
              close(F[i]);
              close(F[i-1]);
         end;

end.

muzes tam napriklad delit nulou, to je pro bezici program problem, mel bys to mit osetreny nejakou podminkou

(y-A.y)/(x-A.x)

#2 xy
jo to mě taky napadlo, ale nulou tam nedělím (aspoň ne v tu chvíli, kdy mi vyskakuje chyba) ve chvíli chyby je hodnota argumentu cca -0.572 což 0 určitě není

PS:nechal jsem si vypsat hodnotu toho argumentu ještě před fcí arctan a vypočetlo ho to

#1 Kalgys
Jakou chybu přesně to vypsalo při pádu? Zkus si nastavit kompilátor, aby ti to vypsal. 

Případně sem hoď celý program, ať si to můžeme zkusit spustit.

#4 yetty
OK tady je celý kod používám Lazarus 64bit

program vlocka;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp,crt,math
  { you can add units after this };
const pocetperiod=5;
      rad='perioda';
      fr='Fraktal\';
      tx='.txt';
      poctvar=4;
type bod=record
  x,y:real;
end;

var x,y,x0,y0,x1,y1:real;
  i,j:byte;
  A,A0,B:bod;
  F:array[1..pocetperiod] of text;
  Fname:array[1..pocetperiod] of string;
  g:text;
  Aname,Bname,Name1,Name2:string;
function strtoreal(str:string):real;          //fungujici bezchybne
         var Ccast:byte;
             Dcast:real;
             i,i0:byte;
         begin
              i:=2;
              case str[1] of
              ' ':
                  begin
                       Ccast:=StrToInt(str[2]);
                       i:=i+1;
                  end;
              '-':
                  begin
                       Ccast:=-StrToInt(str[2]);
                       i:=i+1;
                  end;
              else
                  Ccast:=StrToInt(str[1]);
              end;
              i0:=i;
              Dcast:=0;
              repeat
                    i:=i+1;
                    Dcast:=Dcast+StrToInt(str[i])*power(10,i0-i);
              until(i=Length(str));
              if str[1]='-' then strtoreal:=Ccast-Dcast
              else strtoreal:=Ccast+Dcast;
         end;
begin
     CreateDir('Fraktal');       //vytvor slozku
     for i:=1 to pocetperiod do
         begin
              Fname[i]:=fr+rad+IntToStr(i)+tx;  //vytvor textaky pro souradnice
              assign(F[i],Fname[i]);
              rewrite(f[i]);
              close(f[i]);
         end;
     x:=cos(pi/2);      //x prvniho bodu
     y:=sin(pi/2);      //y prvniho bodu
     append(f[1]);
     writeln(F[1],x:0:6,',',y:0:6);  //zapis prvni bod do prvniho textaku
     for i:=2 to poctvar+1 do
         begin
              x:=cos(pi/2-((i-1)*2*pi)/(poctvar));     //x nasledujicich bodu (pootoceno vzdy o 2Pi/n
              y:=sin(pi/2-(2*pi*(i-1))/(poctvar));     //y -||-
              writeln(F[1],x:0:6,',',y:0:6);           //zapis x,y
         end;
     close(f[1]);          //prvni textak je hotovy a funguje
//----------------------------------------------------------------------------------------------------
     for i:=2 to pocetperiod do
         begin
              reset(f[i-1]);     //otevre predchozi textak ke cteni
              append(F[i]);      //otevre nynejsi textak(prazdny) k zapisu
              readln(F[i-1],Name1);  //precte prvni bod(0,1)d z predchoziho textaku
              j:=0;
              Aname:='';
              repeat
                    j:=j+1;
                    Aname:=Aname+Name1[j];
              until(Name1[j+1]=',') ;
              A.x:=strtoreal(Aname);    //x prvniho bodu v cisle (0)
              j:=j+1;
              Bname:='';
              repeat
                    j:=j+1;
                    Bname:=Bname+Name1[j];
              until(j=Length(Name1));
              A.y:=strtoreal(Bname);   //y -||- (1)
              writeln(F[i],Name1);     //zapis bodu A do noveho textaku
              A0:=A;                   //ulození hodnoty bodu A
              while not eof(F[i-1]) do
                    begin
                         readln(F[i-1],Name2);  //nacteni bodu B z predchoziho textaku
                         j:=0;
                         Aname:='';
                         repeat
                               j:=j+1;
                               Aname:=Aname+Name2[j];                      //prevod z textu na cisla
                         until(Name2[j+1]=',') ;
                         B.x:=strtoreal(Aname);           //x bodu B
                         j:=j+1;
                         Bname:='';
                         repeat
                               j:=j+1;
                               Bname:=Bname+Name2[j];
                         until(j=Length(Name1));
                         B.y:=strtoreal(Bname);    //y bodu B
                         x:=((2*A.x)+B.x)/3;       //x bodu ve tretine usecky mezi A a B (blize A)
                         y:=((2*A.y)+B.y)/3;       //y -||-
                         x0:=x;
                         y0:=y;
                         writeln(F[i],x:0:6,',',y:0:6);   //zapis vyse zmineneho bodu
                         if (x-A.x)=0 then  //kontrola deleni nulou
                            if y<A.y then   //kontrola uhlu (90 nebo 270)
                               begin
                                    x:=(1/power(3,i-1))*cos((pi/2)-(2*pi/poctvar))+x;
                                    y:=(1/power(3,i-1))*sin((pi/2)-(2*pi/poctvar))+y;
                               end
                            else
                                begin
                                     x:=(1/power(3,i-1))*cos((pi/2)+(2*pi/poctvar))+x;
                                     y:=(1/power(3,i-1))*sin((pi/2)+(2*pi/poctvar))+y;
                                end
                         else
                             begin
                                  x:=(1/power(3,i-1))*cos(arctan((y-A.y)/(x-A.x))+(2*pi/poctvar))+x;
                                  y:=(1/power(3,i-1))*sin(arctan((y-A.y)/(x-A.x))+(2*pi/poctvar))+y;
                             end;
                         writeln(F[i],x:0:6,',',y:0:6);  //zapis nalezeneho bodu
                         if poctvar>3 then //pro pocatecni tvar s vice uhy nez 3
                            begin
                                 for j:=1 to poctvar-3 do  //pocet bodu, ktere jsou mimo usecku AB
                                     begin
                                          if (x-x0)=0 then //kontrola deleni nulou
                                             if y<y0 then
                                                begin
                                                     x1:=(1/power(3,i-1))*cos((pi/2)-(180-(2*pi/poctvar)))+x;
                                                     y1:=(1/power(3,i-1))*sin((pi/2)-(180-(2*pi/poctvar)))+y;
                                                end
                                             else
                                                 begin
                                                      x1:=(1/power(3,i-1))*cos((pi/2)+(180-(2*pi/poctvar)))+x;
                                                      y1:=(1/power(3,i-1))*sin((pi/2)+(180-(2*pi/poctvar)))+y;
                                                 end
                                             else
                                                 begin
                                                      x1:=(1/power(3,i-1))*cos(arctan((y-y0)/(x-x0))+(180-(2*pi/poctvar)))+x;
                                                      y1:=(1/power(3,i-1))*sin(arctan((y-y0)/(x-x0))+(180-(2*pi/poctvar)))+y;
                                                 end;
                                             writeln(F[i],x1:0:6,',',y1:0:6);//zapis dalsich bodu
                                             x0:=x;
                                             y0:=y;
                                             x:=x1;
                                             y:=y1;
                                     end;
                            end;
                         x:=(A.x+2*B.x)/3;
                         y:=(A.y+2*B.y)/3;
                         writeln(F[i],x:0:6,',',y:0:6);
                         writeln(F[i],B.x:0:6,',',B.y:0:6);
                         A:=B;
                    end;
              writeln(F[i],A0.x:0:6,',',A0.y:0:6);
              close(F[i]);
              close(F[i-1]);
         end;
     {assign(g,'Fraktaly\Vlocka\vlocka.grf');
     Rewrite(g);
     writeln(g,';This file was created by Graph (http://www.padowan.dk)');
     writeln(g,';Do not change this file from other programs.');
     writeln(g,'[Graph]');
     writeln(g,'Version = 4.4.0.532');
     writeln(g,'MinVersion = 2.5');
     writeln(g,'OS = Windows NT 6.1 Service Pack 1');
     writeln(g,'');
     writeln(g,'[Axes]');
     writeln(g,'xMin = ',-1.75*2);
     writeln(g,'xMax = ',1.75*2);
     writeln(g,'xTickUnit = 0.2');
     writeln(g,'xGridUnit = 0.2');
     writeln(g,'yMin = -2');
     writeln(g,'yMax = 2');
     writeln(g,'yTickUnit = 0.5');
     writeln(g,'yGridUnit = 0.5');
     writeln(g,'AxesColor = clBlue');
     writeln(g,'GridColor = 0x00FF9999');
     writeln(g,'ShowLegend = 0');
     writeln(g,'Radian = 1');
     writeln(g,'AxesStyle = 2');
     writeln(g,'');
     writeln(g,'[PointSeries1]');
     writeln(g,'FillColor = clBlack');
     writeln(g,'LineColor = clBlack ');
     writeln(g,'Size = 1');
     writeln(g,'Style = 0');
     writeln(g,'LineSize = 1');
     writeln(g,'LineStyle = 0 ');
     writeln(g,'LabelPosition = 1');
     write(g,'Points = 1,0');
     while not eof(f[1]) do
           begin
                readln(f[1],Bname);
                write(g,';',Bname);
           end;
     WriteLn(g,'');
     WriteLn(g,'Legend text = Vlocka');
     Writeln(g,'');
     WriteLn(g,'[Data]');
     WriteLn(g,'TextLabelCount = 0');
     WriteLn(g,'FuncCount = 0');
     WriteLn(g,'PointSeriesCount = 1');
     WriteLn(g,'ShadeCount = 0');
     WriteLn(g,'RelationCount = 0');
     WriteLn(g,'OleObjectCount = 0');}
end.

#5 Kalgys
Btw ta poslední část bude zápis do souboru, který je čitelný pro program Graph

Poctvar=4 je konstanta, v té chyba nebude. Nenulovost x-A.x kontroluješ, takže v pořádku. Na arctan ani cos není co zkazit. Potom by mohlo být nulové power(3,i-1). Nebo může být problém přímo s tou mocninou: nevím, jaké má ta funkce pořadí parametrů - jestli 3 na i-1 nebo i-1 na třetí. Ve druhém případě by bylo potřeba, aby i-1>0, protože obecná mocnina x na y se interně počítá jako exp(y*ln(x)) a logaritmus existuje jenom pro kladná čísla.

Další možnost je, že dělíš něčím sice nenulovým, ale dostatečně malým na to, aby to způsobilo přetečení výsledku. Takže bych místo testu nulovosti zkoušel spíš nějakou toleranci: if abs(hodnota)<=1E-10 then je to prakticky nula.

#7 Mircosoft
No teď zkouším Poctvat=3 (klasický trojúhelník) a program po kompilaci jede ... projede první "periodu" (udělá n=3 úhelník, btw funguje mi to bez problému pro všechna n>2), ve druhé "periodě" to tvar ukončí, ale výstup je nějaký divný (místo úhlu mezi úsečkami 120° je úhel ... nepočítal jsem to, pouze odhaduji ... 60°) a třetí kolo mi to začne a padne to v půlce psaní řádku. Nwm, kde nastavit kompilátor na výpis chybového hlášení.

Já to kompiluji s:

fpc -v0 -g -O2 -Sg -Ci -Cr -Ct

a padá mi to na Range check error:

An unhandled exception occurred at $08048B4A :
ERangeError : Range check error
  $08048B4A

#9 yetty
Osvětlíš mi to prosím?

#10 Kalgys
Co přesně? ;)

Range check error je chyba, která vzniká při přetečení proměnné, nebo když se sahá mimo pole. Kontrola se zapíná přepínačem -Cr. Na určení, kde přesně program padá by bylo potřeba trochu ho debugovat.

#11 yetty
padá to při hodnotách 1/3^2, takže v tom power to nebude, ale udivuje mě, jak se to začne chovat při počátečním tvaru čtverci už v druhém kole je to vážně divné