www.TrSek.com/cz/pas/math.pas -

{ MATH.PAS                   Copyleft (c) Zdeno Sekerák, <etrsek@gmail.com> }
{ Trsek mathematics function for unit bignumber                             }
{                                                                           }
{ Tento program je slobodný software. Možete ho ďalej distribuovať a/alebo  }
{ upravovať pod podmienkou licence GNU General Public License vydanej       }
{ organizáciou Free Software Foundation, verzia licencie 3 alebo vyššej.    }
{                                                                           }
{ Tento program je distribuvaný v nádeji, že bude užitočným, ale            }
{ NEPOSKYTUJE ŽIADNE ZÁRUKY. Bez akejkoľvek vyplývajúcej záruky na          }
{ OBCHODOVATEĽNOSŤ alebo VHODNOSŤ PRE KONKRÉTNE POUŽITIE. Pre viac          }
{ podrobností si prečítajte licenciu GNU General Public Licence.            }
{                                                                           }
{  http://www.gnu.org/copyleft/gpl.html                                     }
{                                                                           }
{ Author: Zdeno Sekerák (TrSek)                                             }
{ Datum : 08.01.2010                                                        }
{ Verzia: 0.91 RC1                                     http://www.trsek.com }
 
unit Math;
 
interface
uses Objects, Crt, Dos, BigNum;
 
{ make testing computing in native format, use for debuging                 }
{ for release use UNDEF _BN_NATIVE                                          }
{ DEFINE _BN_NATIVE}
{ view computing time with scroolbar }
{$DEFINE _BN_SCROOL_TIME}
{ view parcial computing number }
{$DEFINE _BN_SCROLL_NUMBER}
 
const BN_EPSILON : integer = -100;         { variable !?! }
      BN_EPSILON_MAX = BN_MAX_DIGIT-2;     { maximal epsilon exponent for taylor polynom }
      BN_EPSILON_PI  = -5;                 { epsilon for taylor polynom less }
      BN_INFINITY    = BN_MAX_DIGIT;
 
      { char for scroolbar }
      BN_SCROOL_OK     = '#';
      BN_SCROOL_WAIT   = '.';
      BN_SCROOL_RUZICA:string[4] = '/-\-';
 
      { for unit needs - do not change }
      BN_RADIAN     = 0;
      BN_DEGREE     = 1;
      BN_GRADIENT   = 2;
 
      BN_PI = '3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086';
      BN_E  = '2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427427466391';
 
{ Ludolfovo cislo
3.141592653589793238462643383279502884197169399375105820974944592307816406286208
99862803482534211706798214808651328230664709384460955058223172535940812848111745
02841027019385211055596446229489549303819644288109756659334461284756482337867831
65271201909145648566923460348610454326648213393607260249141273724587006606315588
17488152092096282925409171536436789259036001133053054882046652138414695194151160
94330572703657595919530921861173819326117931051185480744623799627495673518857527
24891227938183011949129833673362440656643086021394946395224737190702179860943702
77053921717629317675238467481846766940513200056812714526356082778577134275778960
91736371787214684409012249534301465495853710507922796892589235420199561121290219
60864034418159813629774771309960518707211349999998372978049951059731732816096318
59502445945534690830264252230825334468503526193118817101000313783875288658753320
83814206171776691473035982534904287554687311595628638823537875937519577818577805
32171226806613001927876611195909216420198938095257201065485863278865936153381827
}
 
{ Eulerovo cislo
2,7182818284 5904523536 0287471352 6624977572 4709369995
  9574966967 6277240766 3035354759 4571382178 5251664274
  2746639193 2003059921 8174135966 2904357290 0334295260
  5956307381 3232862794 3490763233 8298807531 9525101901
  1573834187 9307021540 8914993488 4167509244 7614606680
  8226480016 8477411853 7423454424 3710753907 7744992069
  5517027618 3860626133 1384583000 7520449338 2656029760
  6737113200 7093287091 2744374704 7230696977 2093101416
  9283681902 5515108657 4637721112 5238978442 5056953696
  7707854499 6996794686 4454905987 9316368892 3009879312
  7736178215 4249992295 7635148220 8269895193 6680331825
  2886939849 6465105820 9392398294 8879332036 2509443117
  3012381970 6841614039 7019837679 3206832823 7646480429
  5311802328 7825098194 5581530175 6717361332 0698112509
  9618188159 3041690351 5988885193 4580727386 6738589422
  8792284998 9208680582 5749279610 4841984443 6346324496
  8487560233 6248270419 7862320900 2160990235 3043699418
  4914631409 3431738143 6405462531 5209618369 0888707016
  7683964243 7814059271 4563549061 3031072085 1038375051
  0115747704 1718986106 8739696552 1267154688 9570350...
}
 
type
   Infinity = Object(BigNumber)
 
    public
    constructor init(s:string);
    destructor  done; virtual;
 
    public
    procedure Abs;      { Vypocita absolutnu hodnotu argumentu.              }
    procedure ArcCos;   { Vypocita arcus kosinus argumentu.                  }
    procedure ArcCotan; { Vypocita arcus cotangens argumentu.                }
    procedure ArcSin;   { Vypocita arcus sinus argumentu.                    }
    procedure ArcTan;   { Vypocita arcus tangens argumentu.                  }
    procedure Cos;      { Vypocita kosinus argumentu.                        }
    procedure Cotan;    { Vypocita cotangens argumentu.                      }
    procedure Dec;      { Dekrementuje promennou.                            }
    procedure Exp;      { Vypocita exponenci. Invert k prirozenemu logaritmu.}
    procedure Factorial;{ Vypocita faktorial celeo cisla                     }
    procedure Inc;      { Inkrementuje promennou.                            }
    procedure Int;      { Vypocita celociselnou cast argumentu.              }
    procedure Ln;       { Vypocita prirozeny logaritmus argumentu.           }
    procedure Negation; { Zneguje cislo, zmeni znamienko                     }
    procedure Pi;       { Vypocita hodnotu pi.                               }
    procedure PiCompute;{ Compute Pi                                         }
    procedure E;        { Vypocita hodnotu euklidovho cisla.                 }
    procedure Pred;     { Vypocita predchudce argumentu.                     }
    procedure Random;   { Vygeneguje nahodne cislo                           }
    procedure Round;    { Zaokrouhli realnou hodnotu na celociselnou.        }
    procedure Sin;      { Vypocita sinus argumentu.                          }
    procedure Succ;     { Vypocita nasledovnika argumentu.                   }
    procedure Sqr;      { Vypocita druhou mocninu argumentu.                 }
    procedure SqrY(b:bignumber); { vypocita n-tu mocninu cisla               }
    procedure Sqrt;     { Vypocita druhou odmocninu argumentu.               }
    procedure SqrtN(n:integer); { Vypocita tretiu odmocninu argumentu.       }
    procedure Tan;      { Vypocita tangens argumentu.                        }
 
    function  Odd:boolean;      { Testuje, zda argumentem je liche cislo.    }
    function  SizeOf:integer;   { Vypocita velikost argumentu v bajtech.     }
    procedure KurzorOnOff(OnOff:boolean);   { zapne/vypne kurzor             }
 
    { operacie porovnania }
    function lt  (x: bignumber):boolean;        { less-than x                }
    function equal (x: bignumber):boolean;      { identical to x             }
    function ne (x: bignumber):boolean;         { not equal to x             }
    function gt (x: bignumber):boolean;         { greater-than x             }
    function le (x: bignumber):boolean;         { less-than or equal to x    }
    function ge (x: bignumber):boolean;         { greater-than or equal to x }
 
    { operacie pre ine primitiva }
    procedure Copy(r: extended);
    procedure Copy_bn(bn: infinity);
    function  ReadLn(ch:char):char;
    procedure WriteLn(n,d:integer);
 
    { pretazene pre realne cisla }
    procedure plus_r     (r: extended);
    procedure minus_r    (r: extended);
    procedure multiply_r (r: extended);
    procedure divide_r   (r: extended);
 
    { teplomer vypoctu }
    private
    _scroolBarX    : integer;
    _scroolBarY    : integer;
    _scroolBarD    : integer;
    _scroolBarDis  : byte;
{$IFDEF _BN_SCROOL_TIME}
    _scroolBarTime : longint;
{$ENDIF}
    _rdg_type      : integer;   { Radian/Degree/Gradient }
 
    public
    procedure ScroolBarInit(x,y,d: integer);
    procedure ScroolBarStart;
    procedure ScroolBarInc(_step: integer);
	procedure ScroolBarFinish;
 
	procedure SetEpsilon(_eps: integer);
	function  GetEpsilon:integer;
 
	procedure SetRadian;
	procedure SetDegree;
	procedure SetGradient;
	procedure SetRDG(_type: integer);   { Radian/Degree/Gradient }
	function  GetRDG : integer;
 
	procedure ToRadian;
	procedure ToDegree;
 
    { niesom si isty ci je potreba }
    {Hi;         { Vypocita vyssi bajt argumentu.                        }
    {Lo;         { Vypocita nizsi (mene vyznamny) bajt argumentu.        }
    {High;       { Vypocita nejvvyssi hodnotu rozsahu argumentu.         }
    {Low;        { Vypocita nejnizsi hodnotu v rozsahu argumentu.        }
 
    { uz implementovane v bignumber }
    {Str;        { Prevede ciselnou hodnotu do podoby znakoveho retezce. }
    {Val;        { Prevede znakovy retezec na ciselnou hodnotu.          }
    {Trunc;      { Prevede hodnotu realneho typu na hodnotu celociselnou.}
    {Frac;       { Vraci zlomkovou cast argumentu.                       }
    {Randomize;  { Inicializuje vestaveny generator n hodnych cisel      }
  end;
 
implementation
{---------------------------------------------------------------------------}
 
{ inicialize constructor }
constructor infinity.init(s:string);
begin
  _scroolBarX   := 0;
  _scroolBarY   := 0;
  _rdg_type     := BN_RADIAN;
  bignumber.init(s);
end;
{---------------------------------------------------------------------------}
 
{ destructor, nothing do }
destructor infinity.done;
begin
end;
{---------------------------------------------------------------------------}
 
{ zmensi/zvacsi presnot pre taylorove rady }
procedure infinity.SetEpsilon(_eps: integer);
begin
  { vzdy minus }
  BN_EPSILON := system.abs(_eps);
 
  { nie viac ako maximum }
  if(BN_EPSILON > BN_EPSILON_MAX)then
     BN_EPSILON := BN_EPSILON_MAX;
 
  { nie menej ako bezne }
  if(BN_EPSILON < 10)then
     BN_EPSILON := 10;
 
  { vzdy minus }
  BN_EPSILON := (-1)* BN_EPSILON;
end;
{---------------------------------------------------------------------------}
 
{ povie aka je presnost pre taylorove rady }
function infinity.GetEpsilon:integer;
begin
  GetEpsilon := system.abs(BN_EPSILON);
end;
{---------------------------------------------------------------------------}
 
procedure infinity.SetRadian;
begin
  _rdg_type := BN_RADIAN;
end;
 
procedure infinity.SetDegree;
begin
  _rdg_type := BN_DEGREE;
end;
 
procedure infinity.SetGradient;
begin
  _rdg_type := BN_GRADIENT;
end;
{---------------------------------------------------------------------------}
 
{ Radian/Degree/Gradient }
procedure infinity.SetRDG(_type: integer);
begin
  _rdg_type := _type;
end;
{---------------------------------------------------------------------------}
 
function infinity.GetRDG : integer;
begin
  GetRDG := _rdg_type;
end;
{---------------------------------------------------------------------------}
 
{ konvert stupne na radiany }
procedure infinity.ToRadian;
var pom: infinity;
begin
  pom.Pi;
  self.Divide_r(180);
  self.Multiply(pom);
end;
{---------------------------------------------------------------------------}
 
{ konvert radiany na stupne }
procedure infinity.ToDegree;
var pom: infinity;
begin
  pom.Pi;
  self.Divide(pom);
  self.Multiply_r(180);
end;
{---------------------------------------------------------------------------}
 
{ Vypocita absolutni hodnotu argumentu. }
procedure infinity.Abs;
begin
{$IFDEF _BN_NATIVE}
  { for test }
  _bn.native:=system.abs( _bn.native );
{$ENDIF}
 
  _bn.sign := false;
end;
{---------------------------------------------------------------------------}
 
procedure infinity.Negation;
begin
{$IFDEF _BN_NATIVE}
  { for test }
  _bn.native:=(-1)* _bn.native;
{$ENDIF}
 
  _bn.sign := not(_bn.sign);
end;
{---------------------------------------------------------------------------}
 
{ Dekrementuje promennou. }
{ !!! optimalizovat }
procedure infinity.Dec;
var pom:bignumber;
begin
  pom.Init('-1');
  self.Plus(pom);
end;
{---------------------------------------------------------------------------}
 
{ Inkrementuje promennou. }
{ !!! optimalizovat }
procedure infinity.Inc;
var pom:bignumber;
begin
  pom.Init('1');
  self.Plus(pom);
end;
{---------------------------------------------------------------------------}
 
{ Vypocita predchudce argumentu. }
procedure infinity.Pred;
begin
  self.Dec;
end;
{---------------------------------------------------------------------------}
 
{ Vypocita nasledovnika argumentu. }
procedure infinity.Succ;
begin
  self.Inc;
end;
{---------------------------------------------------------------------------}
 
{ Vygeneguje nahodne cislo. }
procedure infinity.Random;
var i: integer;
    s: string;
begin
  for i:=1 to BN_MAX_DIGIT do
    _bn.mantisa[i]:= system.random( BN_NUMSYSTEM );
 
  { prva nesmie byt nula }
  _bn.mantisa[1]:= system.random( BN_NUMSYSTEM - 1)+1;
  _bn.overflow  := BNE_OK;
  _bn.zero      := false;
 
  { generate sign }
  if( system.random(2)> 0) then
       _bn.sign := true
  else _bn.sign := false;
 
  { generate exponent }
  _bn.exponent := system.random(65535);
  _bn.exponent := _bn.exponent - (65535 div 2);
 
{$IFDEF _BN_NATIVE}
  _bn.exponent := system.random(9864);
  _bn.exponent := _bn.exponent - 4932;
 
  { for test }
  s:=self.Str(18,18);
  system.Val(s, _bn.native, i);
{$ENDIF}
end;
{---------------------------------------------------------------------------}
 
{ Vypocita velikost argumentu v bajtech. }
function infinity.SizeOf: integer;
begin
    SizeOf := BN_MAX_DIGIT;
end;
{---------------------------------------------------------------------------}
 
{ zapne/vypne kurzor }
procedure infinity.KurzorOnOff(OnOff:boolean);
var  Regs : Registers;
begin
  with Regs do
   begin
    AH := $03;
    BH := $00;
    Intr($10,Regs);
    If not (OnOff) then
       CH := CH or $20
      else
       CH := CH and $DF;
 
    AH := $01;
    Intr($10,Regs);
   end;
end;
{---------------------------------------------------------------------------}
 
{ Vypocita druhou mocninu argumentu. }
procedure infinity.Sqr;
var pom: bignumber;
begin
  pom._bn := _bn;
  self.Multiply(pom);
end;
{---------------------------------------------------------------------------}
 
{ n-ta mocnina }
procedure infinity.SqrY(b:bignumber);
var pom: infinity;
   step: real;
  i,kolko: longint;
begin
  { je to celociselny mocnitel }
  pom._bn := b._bn;
  pom.Frac;
  if( pom._bn.zero )then begin
    pom._bn := self._bn;
    kolko := b.ToInt( b.Str(BN_INFINITY, BN_INFINITY))-1;
    ScroolBarStart;
 
    { nasobime }
    for i:=1 to kolko do begin
      self.Multiply(pom);
      step:=i*BN_EPSILON/kolko;
      ScroolBarInc( system.trunc(step));
    end;
 
    { finish }
    ScroolBarFinish;
  end
  else begin
    { je to mocnenie desatinnym cislom }
    self.Ln;
    self.Multiply(b);
    self.Exp;
  end;
end;
{---------------------------------------------------------------------------}
 
{ Testuje, zda argumentem je liche cislo. }
function infinity.Odd:boolean;
var i:integer; 
begin
  { ak je to velke cislo je sude/parne }
  Odd:=false;
  if( _bn.exponent > BN_MAX_DIGIT )then
     exit;
 
  { pozriem na konkretne cislo }
  if((_bn.exponent >= 1)
  and(_bn.exponent <= BN_MAX_DIGIT))then
  begin
     if((_bn.mantisa[_bn.exponent] div 2) <> 0)then
          Odd:=true
     else Odd:=false;
     exit;
  end;
 
  { ak ma desatinnu cast potom je liche/neparne }
  for i:=_bn.Exponent + 1 to BN_MAX_DIGIT do 
    if(_bn.mantisa[i] <> 0 )then begin
       Odd:=true;
       exit;
 
    end;
 
  { inak je sude/parne }
  Odd:=false;
end;
{---------------------------------------------------------------------------}
 
{ Vypocita celociselnou cast argumentu. }
procedure infinity.Int;
begin
  self.Trunc;
end;
{------------------------------------------------------------------------------}
 
{ Zaokrouhli realnou hodnotu na celociselnou. }
procedure infinity.Round;
var pom: bignumber;
begin
  { nema zmysel }
  if(self._bn.exponent < -1)then
  begin
    self.Init('0');
    exit;
  end;
 
  pom.Init('0.5');
  pom._bn.sign   := _bn.sign;
 
{$IFDEF _BN_NATIVE}
  pom._bn.native := 0.5;
{$ENDIF}
 
  { pripocitame 0.5 a zavolame Trunc }
  self.plus(pom);
  self.Trunc;
end;
{------------------------------------------------------------------------------}
 
{ cislo je mensie ako x }
function infinity.lt(x: bignumber):boolean;
begin
  { rozdielne znamienka tam je to jasne }
  if(_bn.sign <> x._bn.sign)then begin
     if( _bn.sign )then
          lt:=true
     else lt:=false;
     exit;
  end;
 
  { pozerame sa na zaporne }
  if( _bn.sign )then begin
      lt:=false;
      if(_bn.exponent < x._bn.exponent )then
         exit;
 
      if(_bn.exponent = x._bn.exponent )then 
        if(self.compare_mantisa(x) = BN_MANTISA_LESS)then
           exit;
 
      lt:=true;
  end
  { pozerame sa na kladne }
  else begin
      lt:=true;
      if(_bn.exponent < x._bn.exponent )then
         exit;
 
      if(_bn.exponent = x._bn.exponent )then 
        if(self.compare_mantisa(x) = BN_MANTISA_LESS)then
           exit;
 
      lt:=false;
  end;
end;
{------------------------------------------------------------------------------}
 
{ cislo je rovnake ako x }
function infinity.equal(x: bignumber):boolean;
begin
  equal:=true;
  if(_bn.sign = x._bn.sign )then
   if(_bn.exponent = x._bn.exponent )then
    if(self.compare_mantisa(x) = BN_MANTISA_EQUAL)then
       exit;
 
  equal:=false;
end;
{------------------------------------------------------------------------------}
 
{ cislo nieje rovnake ako x }
function infinity.ne(x: bignumber):boolean;
begin
  ne:=not(self.equal(x));
end;
{------------------------------------------------------------------------------}
 
{ cislo je vacsie ako x }
{ !!! optimalizovat }
function infinity.gt(x: bignumber):boolean;
begin
  if(self.equal(x))then
     gt:=false
  else
     gt:=not(self.lt(x));
end;
{------------------------------------------------------------------------------}
 
{ cislo je mensie rovnake ako x }
{ !!! optimalizovat }
function infinity.le(x: bignumber):boolean;
begin
  if(self.equal(x))then
     le:=true
  else
     le:=self.lt(x);
end;
{------------------------------------------------------------------------------}
 
{ cislo je vacsie rovnake ako x }
{ !!! optimalizovat }
function infinity.ge(x: bignumber):boolean;
begin
  if(self.equal(x))then
     ge:=true
  else
     ge:=not(self.lt(x));
end;
{------------------------------------------------------------------------------}
 
{ prekopiruje realne cislo do formatu bignumber }
procedure infinity.Copy(r: extended);
var s:string;
begin
  system.Str(r,s);
  self.Val(s);
end;
{------------------------------------------------------------------------------}
 
{ prekopiruje cislo do clenskej premennej }
procedure infinity.Copy_bn(bn: infinity);
begin
  _bn := bn._bn;
 
  _scroolBarX    := bn._scroolBarX;
  _scroolBarY    := bn._scroolBarY;
  _scroolBarD    := bn._scroolBarD;
  _scroolBarDis  := bn._scroolBarDis;
  _rdg_type      := bn._rdg_type;
  BN_EPSILON     := (-1)*GetEpsilon;
 
{$IFDEF _BN_SCROOL_TIME}
  _scroolBarTime := bn._scroolBarTime;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
function infinity.ReadLn(ch:char):char;
begin
  ReadLn:=self.Read(ch);
  system.Writeln;
end;
{------------------------------------------------------------------------------}
 
procedure infinity.WriteLn(n,d:integer);
begin
  self.Write(n,d);
  system.Writeln;
end;
{------------------------------------------------------------------------------}
 
{ pretazene pre pracu s realnymi cislami }
procedure infinity.Plus_r(r: extended);
var pom:infinity;
begin
  pom.Copy(r);
  self.Plus(pom);
end;
 
procedure infinity.Minus_r(r: extended);
var pom:infinity;
begin
  pom.Copy(r);
  self.Minus(pom);
end;
 
procedure infinity.Multiply_r(r: extended);
var pom:infinity;
begin
  pom.Copy(r);
  self.Multiply(pom);
end;
 
procedure infinity.Divide_r(r: extended);
var pom:infinity;
begin
  pom.Copy(r);
  self.Divide(pom);
end;
{------------------------------------------------------------------------------}
 
{ pouzivaj teplomer vypoctu }    
procedure infinity.ScroolBarInit(x,y,d: integer);
begin
  _scroolBarX := x;
  _scroolBarY := y;
  _scroolBarD := d-4;
 
{$IFDEF _BN_SCROOL_TIME}
  _scroolBarD := _scroolBarD-6;
{$ENDIF}
 
  { od 10 do 78 }
  if( _scroolBarD < 10 )then _scroolBarD:=10;
  if( _scroolBarD > 76 )then _scroolBarD:=76;
end;
{------------------------------------------------------------------------------}
 
{ teplomer vypoctu }
procedure infinity.ScroolBarStart;
var h,m,s,ss:word;
begin
  _scroolBarDis := 0;
 
  KurzorOnOff(false);
 
{$IFDEF _BN_SCROOL_TIME}
  { cas spustenia }
  gettime(h,m,s,ss);
  _scroolBarTime:=((longint(h)*60 + m)*60 + s)*10 + (ss div 10);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ teplomer vypoctu }
procedure infinity.ScroolBarFinish;
begin
  ScroolBarInc( BN_EPSILON );
  KurzorOnOff(true);
end;
{------------------------------------------------------------------------------}
 
procedure infinity.ScroolBarInc(_step: integer);
var x,y,i: integer;
     step: real;
  ruzicka: boolean;
 h,m,s,ss: word;
    _time: longint;
begin
  { nepouziva }
  if((_scroolBarX <= 0)
  or (_scroolBarY <= 0)
  or (_scroolBarX > Lo(WindMax))
  or (_scroolBarY > Hi(WindMax)))then
     exit;
 
  { odlozime }
  x:=wherex;
  y:=wherey;
 
  { }
  ruzicka := true;
  step := BN_EPSILON / _scroolBarD;
  if(system.abs(step)<0.01)then
     step:=-0.01;
 
  gotoxy(_scroolBarX, _scroolBarY);
 
  for i:=1 to _scroolBarD do
    if((_step/step) >= i) or (_step = BN_EPSILON)then
       system.Write( BN_SCROOL_OK )
    else begin
       if ruzicka then begin
          ruzicka:=false;
          _scroolBarDis := (_scroolBarDis+1) mod 4;
          system.Write( BN_SCROOL_RUZICA[ _scroolBarDis+1 ]);
       end
	   else
          system.Write( BN_SCROOL_WAIT );
    end;
 
  { este percenta }
  step:=100*(_step/BN_EPSILON);
  system.Write(step:3:0,'%');
 
{$IFDEF _BN_SCROOL_TIME}
  { este cas }
  gettime(h,m,s,ss);
  _time:=((longint(h)*60 + m)*60 + s)*10 + (ss div 10) - _scroolBarTime;
  system.Write((_time div 10):3, '.', (_time mod 10), 's');
{$ENDIF}
 
{$IFDEF _BN_SCROLL_NUMBER}
  { zobrazovat medzivypocet }
  gotoxy(_scroolBarX, _scroolBarY+1);
  system.write( self.Str(BN_INFINITY, BN_INFINITY));
{$ENDIF}
 
  { a spat }
  gotoxy(x,y);
end;
{------------------------------------------------------------------------------}
 
procedure infinity.Factorial;
var i,kolko: longint;
  step: real;
begin
  kolko := self.ToInt( self.Str(BN_INFINITY, BN_INFINITY));
  self.Copy(1);
  ScroolBarStart;
 
  for i:=1 to kolko do begin
    self.Multiply_r(i);
    step:=i*BN_EPSILON/kolko;
    ScroolBarInc( system.trunc(step));
  end;
 
  ScroolBarFinish;
end;
{------------------------------------------------------------------------------}
 
 
{ Vypocita sinus argumentu. }
{ Sin X = x - x3/3! + x5/5! - x7/7! + ... }
procedure infinity.Sin;
var clen: infinity;
       x: bignumber;
       n: longint;
begin
  { prevod na radiany }
  if( _rdg_type = BN_DEGREE )then
    self.ToRadian;
 
  { Presun argumentu do intervalu <0,2*PI> }
  x.Val(BN_PI);
  x.Plus(x);
 
  self.Divide(x);
  self.Frac;
  self.Multiply(x);
 
  while self._bn.sign do        { while x<=0 do x:=x+2*Pi; }
    self.Plus(x);
 
  {Vlastni vypocet}
  n   := 1;
  clen._bn := _bn;
  x._bn    := _bn;
  ScroolBarStart;
 
  while(( clen._bn.exponent > BN_EPSILON ) and not(clen._bn.zero)) do
  begin
    n := n+2;
 
    clen.multiply(x);           { clen:=-clen*x*x/(n*(n-1)) }
    clen.multiply(x);
    clen.divide_r(n * (n-1));
    clen.Negation;
 
    self.plus(clen);            { sin:=sin+clen }
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
  _bn.native := system.sin(x._bn.native);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
 
{ Vypocita kosinus argumentu. (X je uhel v radianech) }
{ Cos X = x - x2/2! + x4/4! - x6/6! + ... }
procedure infinity.Cos;
var clen: infinity;
       x: bignumber;
       n: longint;
begin
  { prevod na radiany }
  if( _rdg_type = BN_DEGREE )then
    self.ToRadian;
 
  { Presun argumentu do intervalu <0,2*PI> }
  x.Val(BN_PI);
  x.Plus(x);
 
  self.Divide(x);
  self.Frac;
  self.Multiply(x);
 
  while self._bn.sign do        { while x<=0 do x:=x+2*Pi; } 
    self.Plus(x);
 
  {Vlastni vypocet}
  n := 0;
  x._bn := _bn;
  clen.Copy(1);
  self._bn := clen._bn;
  ScroolBarStart;
 
  while(( clen._bn.exponent > BN_EPSILON ) and not(clen._bn.zero)) do
  begin
    n := n+2;
 
    clen.multiply(x);           { clen:=-clen*x*x/(n*(n-1)) }
    clen.multiply(x);
    clen.divide_r(n * (n-1));
    clen.Negation;
 
    self.plus(clen);            { sin:=sin+clen }
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
  _bn.native := system.cos(x._bn.native);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ Vypocita druhou odmocninu argumentu. }
{ K výpočtu užijeme Newtonův iterační vztah:   }
{ S[0]:= počáteční aproximace = X              }
{ S[I+1]:= 1/2 * (X/S[I]+S[I]) ,               }
{ kde C je číslo, jehož odmocnina je počítána. }
procedure infinity.Sqrt;
var  x: infinity;
  clen: infinity;
  _exp: longint;
begin
  { it isn't possible }
  if( self._bn.sign )then begin
      self.Copy(0);
      _bn.overflow := BNE_SQRT_MINUS;
      exit;
  end;
 
  ScroolBarStart;
  ScroolBarInc(1);
 
  { upravime velky exponent }
  _exp := self._bn.exponent div 2;
  self._bn.exponent := self._bn.exponent mod 2;
 
  x._bn := self._bn;
  clen._bn := self._bn;
  clen._bn.exponent := BN_EPSILON div 2;
 
  while( clen._bn.exponent > BN_EPSILON )
   and ( clen._bn.overflow = BNE_OK )
   and not(clen._bn.zero) do
  begin
    clen._bn := self._bn;
 
    self._bn := x._bn;            { clen:=0.5*(x/s+s);}
    self.Divide(clen);
    self.Plus  (clen);
    self.Multiply_r(0.5);
 
    { pre podmienku }
    clen.Minus(self);
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { koniec }
  ScroolBarFinish;
 
  { exponent spat }
  self._bn.exponent := self._bn.exponent + _exp;
 
{$IFDEF _BN_NATIVE}
  _bn.native := system.sqrt(x._bn.native);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ n-ta cela tretia odmocnina cisla }
{ ale uz 4 odmocnina konverguje strasne pomaly }
procedure infinity.SqrtN(n:integer);
var  x: infinity;
  clen: infinity;
 nasob: infinity;
  _exp: longint;
 _sign: boolean;
     i: integer;
begin
  { it isn't possible for even sqrt }
  if(((n mod 2)=0) and ( self._bn.sign ))
  or ( n<2) then begin
      self.Copy(0);
      _bn.overflow := BNE_SQRT_MINUS;
      exit;
  end;
 
  { odd sqrt is possible }
  _sign := false;
  if( self._bn.sign )then begin
      _sign := _bn.sign;
      _bn.sign := false;
  end;
 
  ScroolBarStart;
  ScroolBarInc(1);
 
  { upravime velky exponent }
  _exp := self._bn.exponent div n;
  self._bn.exponent := self._bn.exponent mod n;
 
  x._bn := self._bn;
  clen._bn := self._bn;
  clen._bn.exponent := BN_EPSILON div 2;
 
  while( clen._bn.exponent > BN_EPSILON )
   and ( clen._bn.overflow = BNE_OK )
   and not(clen._bn.zero) do
  begin
    clen._bn := self._bn;
    nasob._bn := self._bn;
 
    for i:=3 to n do
      nasob.Multiply(clen);
 
    self._bn := x._bn;            { clen:=0.5*(x/(s^n)+s);}
    self.Divide(nasob);
    self.Plus  (clen);
    self.Multiply_r(0.5);
 
    { pre podmienku }
    clen.Minus(self);
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { koniec }
  ScroolBarFinish;
 
  { exponent spat }
  self._bn.exponent := self._bn.exponent + _exp;
  self._bn.sign     := _sign;
 
{$IFDEF _BN_NATIVE}
  _bn.native := system.sqrt(x._bn.native);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
procedure infinity.Tan;
var clen: infinity;
begin
  clen.Copy_bn(self);
  self.Sin;
  clen.Cos;
  self.Divide(clen);
end;
{------------------------------------------------------------------------------}
 
procedure infinity.Cotan;
var clen: infinity;
begin
  clen.Copy_bn(self);
  self.Cos;
  clen.Sin;
  self.Divide(clen);
end;
{------------------------------------------------------------------------------}
 
{ Vypocita hodnotu pi.      }
{ this version is very lazy }
procedure infinity.PiCompute;
var clen: infinity;
       n: longint;
    sign: integer;
begin
  self.Copy(0);
  clen.Copy_bn(self);
  ScroolBarStart;
 
  sign:=1;
  n:=0;
 
  while( clen._bn.exponent > BN_EPSILON_PI ) do
  begin
    clen.Copy(sign);
    clen.Divide_r(2*n+1);
    self.Plus(clen);
 
    sign:=-sign;
    n:=n+1;
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  self.Multiply_r(4);
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
   system.Val(BN_PI, _bn.native, sign);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ Vypocita hodnotu pi. }
procedure infinity.Pi;
begin
  self.Val(BN_PI);
end;
{------------------------------------------------------------------------------}
 
{ Vypocita hodnotu euklidovho cisla. }
procedure infinity.E;
var  x: infinity;
  clen: infinity;
     n: longint;
   err: integer;
begin
  { zapamatame si znamienko a odstranime ho kvoli vypoctu }
  x.Copy(0);
  self.Copy(1);
  clen.Copy(1);
  n:=0;
  ScroolBarStart;
 
  while(( clen._bn.exponent > BN_EPSILON ) and not(clen._bn.zero)) do
  begin
    n:=n+1;
    clen.Divide_r(n);
    self.Plus(clen);
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
   system.Val(BN_E, _bn.native, err);
{$ENDIF}
end;
 
{ Vypocita exponenci. Invert k prirozenemu logaritmu. }
{ Pro výpočet užijeme Taylorova rozvoje dané funkce:  }
{ ex = 1 + x + x2/2 + x3/3 + ...                      }
procedure infinity.Exp;
var  x: bignumber;
  clen: infinity;
  sign: boolean;
     n: integer;
begin
  { zapamatame si znamienko a odstranime ho kvoli vypoctu }
  x._bn := self._bn;
  sign  := self._bn.sign;
  self.Abs;
 
  ScroolBarStart;
  self.Copy(1);
  clen._bn := self._bn;
  n := 0;
 
  while(( clen._bn.exponent > BN_EPSILON ) and not(clen._bn.zero)) do
  begin
    n:=n+1;
    clen.Multiply(x);          { clen:=clen*x/n; }
    clen.Divide_r(n);
 
    self.Plus(clen);
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { ak to bolo zaporne }
  if( sign )then begin
    clen._bn := self._bn;
    self.Copy(1);
    self.Divide(clen);
  end;
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
   _bn.native := system.exp(x._bn.native);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ Vypocita prirozeny logaritmus argumentu. }
{ K výpočtu užijeme následujícího vztahu:                    }
{             ( x-1      (x-1)^3      3*(x-1)^5       )      }
{  Ln x = 2 * ( ---  +  ---------  +  --------- + ... )      }
{             ( x+1     3*(x+1)^3     5*(x+1)^5       )      }
procedure infinity.Ln;
var  clen: infinity;
    xp,x2: infinity;
        n: integer;
   native: extended;
begin
  { kontrola ln len z kladnych cisel }
  if( self._bn.zero or self._bn.sign )then begin
      self._bn.overflow := BNE_LN_NONPOSITIVE;
      exit;
  end;
 
{$IFDEF _BN_NATIVE}
   native := system.ln(self._bn.native);
{$ENDIF}
 
  ScroolBarStart;
  ScroolBarInc(1);
 
  xp._bn := self._bn;
  x2._bn := self._bn;
  xp.Dec;               { x-1 }
  x2.Inc;               { x+1 }
  xp.Divide(x2);        { (x-1)/(x+1) }
 
  Clen._bn := xp._bn;
  self._bn := Clen._bn;
  xp.Multiply(xp);      { (x-1)^2/(x+1)^2 }
  n:=1;
 
  while(( clen._bn.exponent > BN_EPSILON ) and not(clen._bn.zero)) do
  begin
    Clen.Multiply_r(n);
    Clen.Multiply(xp);
    Clen.Divide_r(n+2);
 
    n:=n+2;
    self.Plus(Clen);
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  self.Plus(self);
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
   _bn.native := native;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ Vypocita arcus sinus argumentu. }
{                 1 x^3   1*3  x^5    1*3*5  x^7              }
{  ArcSin x = x + -*--- + ---*----- + -----*----- + ---- .... } 
{                 2  3    2*4   5     2*4*6   7               }
procedure infinity.ArcSin;
var  x: infinity;
  clen: infinity;
     n: longint;
begin
  clen._bn := self._bn;
  clen.Abs;
  clen.Dec;
 
  { len z rozsahu <-1,1> }
  if not(clen._bn.sign) 
  and not(clen._bn.zero) then begin
     self._bn.overflow := BNE_ARCSINUS_BIG;
     exit;
  end;
 
  x._bn := self._bn;
  clen._bn := x._bn;
  n:=1;
  ScroolBarStart;
 
  while(( clen._bn.exponent > BN_EPSILON ) and not(clen._bn.zero)) do
  begin
    clen.Multiply(x);       { clen:=clen * x * x *n/((n+1)*(n+2)) }
    clen.Multiply(x);
    clen.Multiply_r(n);
    clen.Divide_r((n+1)*(n+2));
 
    self.Plus(clen);
    clen.Multiply_r((n+2));
    n:=n+2;
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { potrebujem prevod na stupne }
  if( _rdg_type = BN_DEGREE )then
    self.ToDegree;
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
   _bn.native := 2*system.arctan(x._bn.native / (1+system.sqrt(1-x._bn.native*x._bn.native)));
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ Vypocita arcus kosinus argumentu. }
procedure infinity.ArcCos;
var pom: infinity;
begin
  pom.Copy_bn(self);
  pom.ArcSin;
 
  self.Pi;
  self.Minus(pom);
end;
{------------------------------------------------------------------------------}
 
{ Vypocita arcus tangens argumentu. }
{                 x^3    x^5     x^7              }
{  ArcTan x = x - --- + ----- - ----- + ---- .... } 
{                  3      5       7               }
procedure infinity.ArcTan;
var  x: infinity;
  clen: infinity;
     n: longint;
  sign: boolean;
begin
  x._bn := self._bn;
  clen._bn := x._bn;
  n:=1;
  sign:=true;
  ScroolBarStart;
 
  while(( clen._bn.exponent > BN_EPSILON ) and not(clen._bn.zero)) do
  begin
    clen.Multiply(x);
    clen.Multiply(x);
    clen.Multiply_r(n);
    clen.Divide_r(n+2);
 
    if( sign )then
         self.Minus(clen)
    else self.Plus(clen);
 
    sign:=not(sign);
    n:=n+2;
 
    { keyboard terminate }
    if( keypressed )then
      if( readkey = #27)then begin
         self._bn.overflow := BNE_USER_TERMINATE;
         break;
      end;
 
    { posun teplomer }
    ScroolBarInc( clen._bn.exponent );
  end;
 
  { potrebujem prevod na stupne }
  if( _rdg_type = BN_DEGREE )then
    self.ToDegree;
 
  { koniec }
  ScroolBarFinish;
 
{$IFDEF _BN_NATIVE}
   _bn.native := system.arctan(x._bn.native);
{$ENDIF}
end;
{------------------------------------------------------------------------------}
 
{ Vypocita arcus cotangens argumentu. }
procedure infinity.ArcCotan;
var pom: infinity;
begin
  pom.Copy_bn(self);
  pom.ArcTan;
 
  self.Pi;
  self.Minus(pom);
end;
{------------------------------------------------------------------------------}
 
 
begin
  system.writeln('This program use unit math (trsek mathematic s for infinity number).');
  system.writeln('Author: Zdeno Sekerak (TrSek), www.trsek.com ');
  system.writeln('Copyleft 2010, http://www.gnu.org/copyleft/gpl.html');
end.
Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Bonus

Kontakty

V jiných jazycích
