123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by Florian Klaempfl
- member of the Free Pascal development team
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- {
- This unit is an equivalent to the Delphi math unit
- (with some improvements)
- What's to do:
- o a lot of function :), search for !!!!
- o some statistical functions
- o all financial functions
- o optimizations
- }
- unit math;
- interface
- {$MODE objfpc}
- {$ifdef VER1_0}
- { we don't assume cross compiling from 1.0.x-m68k ... }
- {$define FPC_HAS_TYPE_EXTENDED}
- {$endif VER1_0}
- uses
- sysutils;
- { Ranges of the IEEE floating point types, including denormals }
- {$ifdef FPC_HAS_TYPE_SINGLE}
- const
- MinSingle = 1.5e-45;
- MaxSingle = 3.4e+38;
- {$endif FPC_HAS_TYPE_SINGLE}
- {$ifdef FPC_HAS_TYPE_DOUBLE}
- const
- MinDouble = 5.0e-324;
- MaxDouble = 1.7e+308;
- {$endif FPC_HAS_TYPE_DOUBLE}
- {$ifdef FPC_HAS_TYPE_EXTENDED}
- const
- MinExtended = 3.4e-4932;
- MaxExtended = 1.1e+4932;
- {$endif FPC_HAS_TYPE_EXTENDED}
- {$ifdef FPC_HAS_TYPE_COMP}
- const
- MinComp = -9.223372036854775807e+18;
- MaxComp = 9.223372036854775807e+18;
- {$endif FPC_HAS_TYPE_COMP}
- { the original delphi functions use extended as argument, }
- { but I would prefer double, because 8 bytes is a very }
- { natural size for the processor }
- { WARNING : changing float type will }
- { break all assembler code PM }
- {$ifdef FPC_HAS_TYPE_FLOAT128}
- type
- float = float128;
- const
- MinFloat = MinFloat128;
- MaxFloat = MaxFloat128;
- {$else FPC_HAS_TYPE_FLOAT128}
- {$ifdef FPC_HAS_TYPE_EXTENDED}
- type
- float = extended;
- const
- MinFloat = MinExtended;
- MaxFloat = MaxExtended;
- {$else FPC_HAS_TYPE_EXTENDED}
- {$ifdef FPC_HAS_TYPE_DOUBLE}
- type
- float = double;
- const
- MinFloat = MinDouble;
- MaxFloat = MaxDouble;
- {$else FPC_HAS_TYPE_DOUBLE}
- {$ifdef FPC_HAS_TYPE_SINGLE}
- type
- float = single;
- const
- MinFloat = MinSingle;
- MaxFloat = MaxSingle;
- {$else FPC_HAS_TYPE_SINGLE}
- {$fatal At least one floating point type must be supported}
- {$endif FPC_HAS_TYPE_SINGLE}
- {$endif FPC_HAS_TYPE_DOUBLE}
- {$endif FPC_HAS_TYPE_EXTENDED}
- {$endif FPC_HAS_TYPE_FLOAT128}
- type
- PFloat = ^Float;
- PInteger = ^Integer;
- tpaymenttime = (ptendofperiod,ptstartofperiod);
- einvalidargument = class(ematherror);
- TValueRelationship = -1..1;
- const
- EqualsValue = 0;
- LessThanValue = Low(TValueRelationship);
- GreaterThanValue = High(TValueRelationship);
- { Min/max determination }
- function MinIntValue(const Data: array of Integer): Integer;
- function MaxIntValue(const Data: array of Integer): Integer;
- { Extra, not present in Delphi, but used frequently }
- function Min(a, b: Integer): Integer;
- function Max(a, b: Integer): Integer;
- function Min(a, b: Cardinal): Cardinal;
- function Max(a, b: Cardinal): Cardinal;
- function Min(a, b: Int64): Int64;
- function Max(a, b: Int64): Int64;
- {$ifdef FPC_HAS_TYPE_SINGLE}
- function Min(a, b: Single): Single;
- function Max(a, b: Single): Single;
- {$endif FPC_HAS_TYPE_SINGLE}
- {$ifdef FPC_HAS_TYPE_DOUBLE}
- function Min(a, b: Double): Double;
- function Max(a, b: Double): Double;
- {$endif FPC_HAS_TYPE_DOUBLE}
- {$ifdef FPC_HAS_TYPE_EXTENDED}
- function Min(a, b: Extended): Extended;
- function Max(a, b: Extended): Extended;
- {$endif FPC_HAS_TYPE_EXTENDED}
- { angle conversion }
- function degtorad(deg : float) : float;
- function radtodeg(rad : float) : float;
- function gradtorad(grad : float) : float;
- function radtograd(rad : float) : float;
- function degtograd(deg : float) : float;
- function gradtodeg(grad : float) : float;
- { one cycle are 2*Pi rad }
- function cycletorad(cycle : float) : float;
- function radtocycle(rad : float) : float;
- { trigoniometric functions }
- function tan(x : float) : float;
- function cotan(x : float) : float;
- procedure sincos(theta : float;var sinus,cosinus : float);
- { inverse functions }
- function arccos(x : float) : float;
- function arcsin(x : float) : float;
- { calculates arctan(y/x) and returns an angle in the correct quadrant }
- function arctan2(y,x : float) : float;
- { hyperbolic functions }
- function cosh(x : float) : float;
- function sinh(x : float) : float;
- function tanh(x : float) : float;
- { area functions }
- { delphi names: }
- function arccosh(x : float) : float;
- function arcsinh(x : float) : float;
- function arctanh(x : float) : float;
- { IMHO the function should be called as follows (FK) }
- function arcosh(x : float) : float;
- function arsinh(x : float) : float;
- function artanh(x : float) : float;
- { triangle functions }
- { returns the length of the hypotenuse of a right triangle }
- { if x and y are the other sides }
- function hypot(x,y : float) : float;
- { logarithm functions }
- function log10(x : float) : float;
- function log2(x : float) : float;
- function logn(n,x : float) : float;
- { returns natural logarithm of x+1 }
- function lnxp1(x : float) : float;
- { exponential functions }
- function power(base,exponent : float) : float;
- { base^exponent }
- function intpower(base : float;const exponent : Integer) : float;
- { number converting }
- { rounds x towards positive infinity }
- function ceil(x : float) : Integer;
- { rounds x towards negative infinity }
- function floor(x : float) : Integer;
- { misc. functions }
- { splits x into mantissa and exponent (to base 2) }
- procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
- { returns x*(2^p) }
- function ldexp(x : float; const p : Integer) : float;
- { statistical functions }
- function mean(const data : array of float) : float;
- function sum(const data : array of float) : float;
- function mean(const data : PFloat; Const N : longint) : float;
- function sum(const data : PFloat; Const N : Longint) : float;
- function sumofsquares(const data : array of float) : float;
- function sumofsquares(const data : PFloat; Const N : Integer) : float;
- { calculates the sum and the sum of squares of data }
- procedure sumsandsquares(const data : array of float;
- var sum,sumofsquares : float);
- procedure sumsandsquares(const data : PFloat; Const N : Integer;
- var sum,sumofsquares : float);
- function minvalue(const data : array of float) : float;
- function minvalue(const data : array of integer) : Integer;
- function minvalue(const data : PFloat; Const N : Integer) : float;
- function MinValue(const Data : PInteger; Const N : Integer): Integer;
- function maxvalue(const data : array of float) : float;
- function maxvalue(const data : array of integer) : Integer;
- function maxvalue(const data : PFloat; Const N : Integer) : float;
- function maxvalue(const data : PInteger; Const N : Integer) : Integer;
- { calculates the standard deviation }
- function stddev(const data : array of float) : float;
- function stddev(const data : PFloat; Const N : Integer) : float;
- { calculates the mean and stddev }
- procedure meanandstddev(const data : array of float;
- var mean,stddev : float);
- procedure meanandstddev(const data : PFloat;
- Const N : Longint;var mean,stddev : float);
- function variance(const data : array of float) : float;
- function totalvariance(const data : array of float) : float;
- function variance(const data : PFloat; Const N : Integer) : float;
- function totalvariance(const data : PFloat; Const N : Integer) : float;
- { returns random values with gaussian distribution }
- function randg(mean,stddev : float) : float;
- { I don't know what the following functions do: }
- function popnstddev(const data : array of float) : float;
- function popnstddev(const data : PFloat; Const N : Integer) : float;
- function popnvariance(const data : PFloat; Const N : Integer) : float;
- function popnvariance(const data : array of float) : float;
- procedure momentskewkurtosis(const data : array of float;
- var m1,m2,m3,m4,skew,kurtosis : float);
- procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
- var m1,m2,m3,m4,skew,kurtosis : float);
- { geometrical function }
- { returns the euclidean L2 norm }
- function norm(const data : array of float) : float;
- function norm(const data : PFloat; Const N : Integer) : float;
- { include cpu specific stuff }
- {$i mathuh.inc}
- implementation
- { include cpu specific stuff }
- {$i mathu.inc}
- ResourceString
- SMathError = 'Math Error : %s';
- SInvalidArgument = 'Invalid argument';
- Procedure DoMathError(Const S : String);
- begin
- Raise EMathError.CreateFmt(SMathError,[S]);
- end;
- Procedure InvalidArgument;
- begin
- Raise EInvalidArgument.Create(SInvalidArgument);
- end;
- function degtorad(deg : float) : float;
- begin
- degtorad:=deg*(pi/180.0);
- end;
- function radtodeg(rad : float) : float;
- begin
- radtodeg:=rad*(180.0/pi);
- end;
- function gradtorad(grad : float) : float;
- begin
- gradtorad:=grad*(pi/200.0);
- end;
- function radtograd(rad : float) : float;
- begin
- radtograd:=rad*(200.0/pi);
- end;
- function degtograd(deg : float) : float;
- begin
- degtograd:=deg*(200.0/180.0);
- end;
- function gradtodeg(grad : float) : float;
- begin
- gradtodeg:=grad*(180.0/200.0);
- end;
- function cycletorad(cycle : float) : float;
- begin
- cycletorad:=(2*pi)*cycle;
- end;
- function radtocycle(rad : float) : float;
- begin
- { avoid division }
- radtocycle:=rad*(1/(2*pi));
- end;
- function tan(x : float) : float;
- begin
- Tan:=Sin(x)/Cos(x)
- end;
- function cotan(x : float) : float;
- begin
- cotan:=Cos(X)/Sin(X);
- end;
- procedure sincos(theta : float;var sinus,cosinus : float);
- begin
- sinus:=sin(theta);
- cosinus:=cos(theta);
- end;
- { Sign, ArcSin and ArcCos from Arjan van Dijk ([email protected]) }
- function sign(x : float) : float;
- begin
- if x > 0 then sign := 1.0
- else if x < 0 then sign := -1.0
- else sign := 0.0;
- end;
- function arcsin(x : float) : float;
- begin
- if abs(x) > 1 then InvalidArgument
- else if abs(x) < 0.5 then
- arcsin := arctan(x/sqrt(1-sqr(x)))
- else
- arcsin := sign(x) * (pi*0.5 - arctan(sqrt(1 / sqr(x) - 1)));
- end;
- function Arccos(x : Float) : Float;
- begin
- arccos := pi*0.5 - arcsin(x);
- end;
- {$ifndef FPC_MATH_HAS_ARCTAN2}
- function arctan2(y,x : float) : float;
- begin
- if (x=0) then
- begin
- if y=0 then
- arctan2:=0.0
- else if y>0 then
- arctan2:=pi/2
- else if y<0 then
- arctan2:=-pi/2;
- end
- else
- ArcTan2:=ArcTan(y/x);
- end;
- {$endif FPC_MATH_HAS_ARCTAN2}
- function cosh(x : float) : float;
- var
- temp : float;
- begin
- temp:=exp(x);
- cosh:=0.5*(temp+1.0/temp);
- end;
- function sinh(x : float) : float;
- var
- temp : float;
- begin
- temp:=exp(x);
- sinh:=0.5*(temp-1.0/temp);
- end;
- Const MaxTanh = 5678.22249441322; // Ln(MaxExtended)/2
- function tanh(x : float) : float;
- var Temp : float;
- begin
- if x>MaxTanh then exit(1.0)
- else if x<-MaxTanh then exit (-1.0);
- temp:=exp(-2*x);
- tanh:=(1-temp)/(1+temp)
- end;
- function arccosh(x : float) : float;
- begin
- arccosh:=arcosh(x);
- end;
- function arcsinh(x : float) : float;
- begin
- arcsinh:=arsinh(x);
- end;
- function arctanh(x : float) : float;
- begin
- if x>1 then InvalidArgument;
- arctanh:=artanh(x);
- end;
- function arcosh(x : float) : float;
- begin
- if x<1 then InvalidArgument;
- arcosh:=Ln(x+Sqrt(x*x-1));
- end;
- function arsinh(x : float) : float;
- begin
- arsinh:=Ln(x+Sqrt(1+x*x));
- end;
- function artanh(x : float) : float;
- begin
- If abs(x)>1 then InvalidArgument;
- artanh:=(Ln((1+x)/(1-x)))*0.5;
- end;
- function hypot(x,y : float) : float;
- begin
- hypot:=Sqrt(x*x+y*y)
- end;
- function log10(x : float) : float;
- begin
- log10:=ln(x)/ln(10);
- end;
- function log2(x : float) : float;
- begin
- log2:=ln(x)/ln(2)
- end;
- function logn(n,x : float) : float;
- begin
- if n<0 then InvalidArgument;
- logn:=ln(x)/ln(n);
- end;
- function lnxp1(x : float) : float;
- begin
- if x<-1 then
- InvalidArgument;
- lnxp1:=ln(1+x);
- end;
- function power(base,exponent : float) : float;
- begin
- If Exponent=0.0 then
- Result:=1.0
- else
- If base>0.0 then
- Power:=exp(exponent * ln (base))
- else if base=0.0 then
- Result:=0.0
- else
- InvalidArgument
- end;
- function intpower(base : float;const exponent : Integer) : float;
- var
- i : longint;
- begin
- i:=abs(exponent);
- intpower:=1.0;
- while i>0 do
- begin
- while (i and 1)=0 do
- begin
- i:=i shr 1;
- base:=sqr(base);
- end;
- i:=i-1;
- intpower:=intpower*base;
- end;
- if exponent<0 then
- intpower:=1.0/intpower;
- end;
- function ceil(x : float) : integer;
- begin
- Ceil:=Trunc(x);
- If Frac(x)>0 then
- Ceil:=Ceil+1;
- end;
- function floor(x : float) : integer;
- begin
- Floor:=Trunc(x);
- If Frac(x)<0 then
- Floor := Floor-1;
- end;
- procedure Frexp(X: float; var Mantissa: float; var Exponent: integer);
- begin
- Exponent :=0;
- if (abs(x)<0.5) then
- While (abs(x)<0.5) do
- begin
- x := x*2;
- Dec(Exponent);
- end
- else
- While (abs(x)>1) do
- begin
- x := x/2;
- Inc(Exponent);
- end;
- mantissa := x;
- end;
- function ldexp(x : float;const p : Integer) : float;
- begin
- ldexp:=x*intpower(2.0,p);
- end;
- function mean(const data : array of float) : float;
- begin
- Result:=Mean(@data[0],High(Data)+1);
- end;
- function mean(const data : PFloat; Const N : longint) : float;
- begin
- mean:=sum(Data,N);
- mean:=mean/N;
- end;
- function sum(const data : array of float) : float;
- begin
- Result:=Sum(@Data[0],High(Data)+1);
- end;
- function sum(const data : PFloat;Const N : longint) : float;
- var
- i : longint;
- begin
- sum:=0.0;
- for i:=0 to N-1 do
- sum:=sum+data[i];
- end;
- function sumofsquares(const data : array of float) : float;
- begin
- Result:=sumofsquares(@data[0],High(Data)+1);
- end;
- function sumofsquares(const data : PFloat; Const N : Integer) : float;
- var
- i : longint;
- begin
- sumofsquares:=0.0;
- for i:=0 to N-1 do
- sumofsquares:=sumofsquares+sqr(data[i]);
- end;
- procedure sumsandsquares(const data : array of float;
- var sum,sumofsquares : float);
- begin
- sumsandsquares (@Data[0],High(Data)+1,Sum,sumofsquares);
- end;
- procedure sumsandsquares(const data : PFloat; Const N : Integer;
- var sum,sumofsquares : float);
- var
- i : Integer;
- temp : float;
- begin
- sumofsquares:=0.0;
- sum:=0.0;
- for i:=0 to N-1 do
- begin
- temp:=data[i];
- sumofsquares:=sumofsquares+sqr(temp);
- sum:=sum+temp;
- end;
- end;
- function stddev(const data : array of float) : float;
- begin
- Result:=Stddev(@Data[0],High(Data)+1)
- end;
- function stddev(const data : PFloat; Const N : Integer) : float;
- begin
- StdDev:=Sqrt(Variance(Data,N));
- end;
- procedure meanandstddev(const data : array of float;
- var mean,stddev : float);
- begin
- Meanandstddev(@Data[0],High(Data)+1,Mean,stddev);
- end;
- procedure meanandstddev(const data : PFloat;
- Const N : Longint;var mean,stddev : float);
- Var I : longint;
- begin
- Mean:=0;
- StdDev:=0;
- For I:=0 to N-1 do
- begin
- Mean:=Mean+Data[i];
- StdDev:=StdDev+Sqr(Data[i]);
- end;
- Mean:=Mean/N;
- StdDev:=(StdDev-N*Sqr(Mean));
- If N>1 then
- StdDev:=Sqrt(Stddev/(N-1))
- else
- StdDev:=0;
- end;
- function variance(const data : array of float) : float;
- begin
- Variance:=Variance(@Data[0],High(Data)+1);
- end;
- function variance(const data : PFloat; Const N : Integer) : float;
- begin
- If N=1 then
- Result:=0
- else
- Result:=TotalVariance(Data,N)/(N-1);
- end;
- function totalvariance(const data : array of float) : float;
- begin
- Result:=TotalVariance(@Data[0],High(Data)+1);
- end;
- function totalvariance(const data : Pfloat;Const N : Integer) : float;
- var S,SS : Float;
- begin
- If N=1 then
- Result:=0
- else
- begin
- SumsAndSquares(Data,N,S,SS);
- Result := SS-Sqr(S)/N;
- end;
- end;
- function randg(mean,stddev : float) : float;
- Var U1,S2 : Float;
- begin
- repeat
- u1:= 2*random-1;
- S2:=Sqr(U1)+sqr(2*random-1);
- until s2<1;
- randg:=Sqrt(-2*ln(S2)/S2)*u1*stddev+Mean;
- end;
- function popnstddev(const data : array of float) : float;
- begin
- PopnStdDev:=Sqrt(PopnVariance(@Data[0],High(Data)+1));
- end;
- function popnstddev(const data : PFloat; Const N : Integer) : float;
- begin
- PopnStdDev:=Sqrt(PopnVariance(Data,N));
- end;
- function popnvariance(const data : array of float) : float;
- begin
- popnvariance:=popnvariance(@data[0],high(Data)+1);
- end;
- function popnvariance(const data : PFloat; Const N : Integer) : float;
- begin
- PopnVariance:=TotalVariance(Data,N)/N;
- end;
- procedure momentskewkurtosis(const data : array of float;
- var m1,m2,m3,m4,skew,kurtosis : float);
- begin
- momentskewkurtosis(@Data[0],High(Data)+1,m1,m2,m3,m4,skew,kurtosis);
- end;
- procedure momentskewkurtosis(const data : PFloat; Const N : Integer;
- var m1,m2,m3,m4,skew,kurtosis : float);
- Var S,SS,SC,SQ,invN,Acc,M1S,S2N,S3N,temp : Float;
- I : Longint;
- begin
- invN:=1.0/N;
- s:=0;
- ss:=0;
- sq:=0;
- sc:=0;
- for i:=0 to N-1 do
- begin
- temp:=Data[i]; { faster }
- S:=S+temp;
- acc:=temp*temp;
- ss:=ss+acc;
- Acc:=acc*temp;
- Sc:=sc+acc;
- acc:=acc*temp;
- sq:=sq+acc;
- end;
- M1:=s*invN;
- M1S:=M1*M1;
- S2N:=SS*invN;
- S3N:=SC*invN;
- M2:=S2N-M1S;
- M3:=S3N-(M1*3*S2N) + 2*M1S*M1;
- M4:=SQ*invN - (M1 * 4 * S3N) + (M1S*6*S2N-3*Sqr(M1S));
- Skew:=M3*power(M2,-3/2);
- Kurtosis:=M4 / Sqr(M2);
- end;
- function norm(const data : array of float) : float;
- begin
- norm:=Norm(@data[0],High(Data)+1);
- end;
- function norm(const data : PFloat; Const N : Integer) : float;
- begin
- norm:=sqrt(sumofsquares(data,N));
- end;
- function MinIntValue(const Data: array of Integer): Integer;
- var
- I: Integer;
- begin
- Result := Data[Low(Data)];
- For I := Succ(Low(Data)) To High(Data) Do
- If Data[I] < Result Then Result := Data[I];
- end;
- function MinValue(const Data: array of Integer): Integer;
- begin
- Result:=MinValue(Pinteger(@Data[0]),High(Data)+1)
- end;
- function MinValue(const Data: PInteger; Const N : Integer): Integer;
- var
- I: Integer;
- begin
- Result := Data[0];
- For I := 1 To N-1 do
- If Data[I] < Result Then Result := Data[I];
- end;
- function minvalue(const data : array of float) : float;
- begin
- Result:=minvalue(PFloat(@data[0]),High(Data)+1);
- end;
- function minvalue(const data : PFloat; Const N : Integer) : float;
- var
- i : longint;
- begin
- { get an initial value }
- minvalue:=data[0];
- for i:=1 to N-1 do
- if data[i]<minvalue then
- minvalue:=data[i];
- end;
- function MaxIntValue(const Data: array of Integer): Integer;
- var
- I: Integer;
- begin
- Result := Data[Low(Data)];
- For I := Succ(Low(Data)) To High(Data) Do
- If Data[I] > Result Then Result := Data[I];
- end;
- function maxvalue(const data : array of float) : float;
- begin
- Result:=maxvalue(PFloat(@data[0]),High(Data)+1);
- end;
- function maxvalue(const data : PFloat; Const N : Integer) : float;
- var
- i : longint;
- begin
- { get an initial value }
- maxvalue:=data[0];
- for i:=1 to N-1 do
- if data[i]>maxvalue then
- maxvalue:=data[i];
- end;
- function MaxValue(const Data: array of Integer): Integer;
- begin
- Result:=MaxValue(PInteger(@Data[0]),High(Data)+1)
- end;
- function maxvalue(const data : PInteger; Const N : Integer) : Integer;
- var
- i : longint;
- begin
- { get an initial value }
- maxvalue:=data[0];
- for i:=1 to N-1 do
- if data[i]>maxvalue then
- maxvalue:=data[i];
- end;
- function Min(a, b: Integer): Integer;
- begin
- if a < b then
- Result := a
- else
- Result := b;
- end;
- function Max(a, b: Integer): Integer;
- begin
- if a > b then
- Result := a
- else
- Result := b;
- end;
- function Min(a, b: Cardinal): Cardinal;
- begin
- if a < b then
- Result := a
- else
- Result := b;
- end;
- function Max(a, b: Cardinal): Cardinal;
- begin
- if a > b then
- Result := a
- else
- Result := b;
- end;
- function Min(a, b: Int64): Int64;
- begin
- if a < b then
- Result := a
- else
- Result := b;
- end;
- function Max(a, b: Int64): Int64;
- begin
- if a > b then
- Result := a
- else
- Result := b;
- end;
- {$ifdef FPC_HAS_TYPE_SINGLE}
- function Min(a, b: Single): Single;
- begin
- if a < b then
- Result := a
- else
- Result := b;
- end;
- function Max(a, b: Single): Single;
- begin
- if a > b then
- Result := a
- else
- Result := b;
- end;
- {$endif FPC_HAS_TYPE_SINGLE}
- {$ifdef FPC_HAS_TYPE_DOUBLE}
- function Min(a, b: Double): Double;
- begin
- if a < b then
- Result := a
- else
- Result := b;
- end;
- function Max(a, b: Double): Double;
- begin
- if a > b then
- Result := a
- else
- Result := b;
- end;
- {$endif FPC_HAS_TYPE_DOUBLE}
- {$ifdef FPC_HAS_TYPE_EXTENDED}
- function Min(a, b: Extended): Extended;
- begin
- if a < b then
- Result := a
- else
- Result := b;
- end;
- function Max(a, b: Extended): Extended;
- begin
- if a > b then
- Result := a
- else
- Result := b;
- end;
- {$endif FPC_HAS_TYPE_EXTENDED}
- end.
- {
- $Log$
- Revision 1.14 2003-10-29 19:10:07 jonas
- * fixed arctan2
- Revision 1.13 2003/10/26 15:58:05 florian
- * fixed arctan2 to handle x=0 correctly as well
- Revision 1.12 2003/09/01 20:46:59 peter
- * small fixes for sparc
- Revision 1.11 2003/04/24 09:38:12 florian
- * min/max must check the compiler capabilities
- Revision 1.10 2003/04/24 09:21:59 florian
- + moved cpu dependend code to mathuh.inc and mathu.inc
- Revision 1.9 2003/01/03 20:34:02 peter
- * i386 fpu controlword functions added
- Revision 1.8 2002/09/07 21:06:12 carl
- * cleanup of parameters
- - remove assembler code
- Revision 1.7 2002/09/07 16:01:22 peter
- * old logs removed and tabs fixed
- }
|