[fpc-devel] Changed Math functions in FPC development trunk 2.7
info at wolfgang-ehrhardt.de
info at wolfgang-ehrhardt.de
Wed Apr 9 14:10:00 CEST 2014
A year ago there was a post from Jonas Maebe on this list
(http://www.mail-archive.com/fpc-devel@lists.freepascal.org/msg28483.html)
asking about the possibility to reuse parts of AMath/DAMath in FPC.
Today I downloaded the development source files from
(ftp://ftp.freepascal.org/pub/fpc/snapshot/trunk/source/fpc.zip)
and found very close source code similarity between the changed
(compared with FPC264) math.pp routines and AMath routines.
See the list below.
Although, as Jonas wrote, zlib is compatible with FPC, there is the
need to give references and/or mark the changes. Unfortunately this
is not done.
I am quite sure that these routines are 'inspired' by AMath.
If this is the case, I would appreciate reference to 'AMath by W.Ehrhardt'
or so, as it is done in the FPC264 source for Arjan van Dijk.
Best wishes
Wolfgang Ehrhardt
hypot
---------------------------------------------------------------------------
AMATH
function hypot(x,y: extended): extended;
{-Return sqrt(x*x + y*y)}
begin
x := abs(x);
y := abs(y);
if x>y then hypot := x*sqrt(1.0+sqr(y/x))
else if x>0.0 then hypot := y*sqrt(1.0+sqr(x/y)) {here y >= x > 0}
else hypot := y; {here x=0}
end;
FPC-Dev
function hypot(x,y : float) : float;
begin
x:=abs(x);
y:=abs(y);
if (x>y) then
hypot:=x*sqrt(1.0+sqr(y/x))
else if (x>0.0) then
hypot:=y*sqrt(1.0+sqr(x/y))
else
hypot:=y;
end;
FPC 264
function hypot(x,y : float) : float;
begin
hypot:=Sqrt(x*x+y*y)
end;
arcsin and arccos
---------------------------------------------------------------------------
AMATH
function arcsin(x: extended): extended;
{-Return the inverse circular sine of x, |x| <= 1}
begin
{basic formula arcsin(x) = arctan(x/sqrt(1-x^2))}
arcsin := arctan2(x, sqrt((1.0-x)*(1.0+x)))
end;
function arccos(x: extended): extended;
{-Return the inverse circular cosine of x, |x| <= 1}
begin
{basic formula arccos(x) = arctan(sqrt(1-x^2)/x))}
if abs(x)=1.0 then begin
if x<0.0 then arccos := Pi else arccos := 0.0;
end
else arccos := arctan2(sqrt((1.0-x)*(1.0+x)),x)
end;
FPC-Dev
function arcsin(x : float) : float;
begin
arcsin:=arctan2(x,sqrt((1.0-x)*(1.0+x)));
end;
function Arccos(x : Float) : Float;
begin
if abs(x)=1.0 then
if x<0.0 then
arccos:=Pi
else
arccos:=0
else
arccos:=arctan2(sqrt((1.0-x)*(1.0+x)),x);
end;
FPC 264
{ ArcSin and ArcCos from Arjan van Dijk (arjan.vanDijk at User.METAIR.WAU.NL) }
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;
lnxp1 = ln1p
---------------------------------------------------------------------------
AMath (up to V1.74 of 04.Oct.2013, V1.75 introduces an additional branch)
function ln1p(x: extended): extended;
{-Return ln(1+x), accurate even for x near 0}
var
y: extended;
const
x0 = 4.0;
begin
if x >= x0 then ln1p := ln(1.0 + x)
else begin
y := 1.0 + x;
{The following formula is more accurate than Goldberg [3], Theorem 4. The}
{Taylor series f(x) = f(x0) + (x-x0)*f'(x0) + .. for f(x) = ln(1+x) gives}
{ln1p(x) = ln(1+x0) + (x-x0)/(1+x0) = ln(y) + (x-(y-1))/y, with y = 1+x0.}
if y=1.0 then ln1p := x
else ln1p := ln(y) + (x-(y-1.0))/y;
end
end;
FPC-Dev
function lnxp1(x : float) : float;
var
y: float;
begin
if (x>=4.0) then
lnxp1:=ln(1.0+x)
else
begin
y:=1.0+x;
if (y=1.0) then
lnxp1:=x
else
lnxp1:=ln(y)+(x-(y-1.0))/y;
end;
end;
FPC 264
function lnxp1(x : float) : float;
begin
if x<-1 then
InvalidArgument;
lnxp1:=ln(1+x);
end;
More information about the fpc-devel
mailing list