program ttestcalls;
{$mode objfpc}{$H+}{$inline on}
{$modeswitch advancedrecords}
uses SysUtils, DateUtils, Math;
type
Float = single;
TVector = array of Float;
TTransformFunc = function(X:float):float;
function Seq(Lb, Ub : integer; first, increment:Float; Vector:TVector = nil):TVector;
var
I:integer;
begin
if Vector = nil then
SetLength(Vector, Ub+1)
else
Ub := Max(Ub,High(Vector));
if Lb <= Ub then
Vector[Lb] := 0
else
Exit;
for I := Lb+1 to Ub do // 2 cycles to avoid rounding error if
Vector[I] := Vector[I-1]+increment; //First is very large and increment small
for I := Lb to Ub do
Vector[I] := Vector[I]+first;
Result := Vector;
end;
procedure Apply(V: TVector; Lb, Ub: integer; Func: TTransformFunc);
var
I:integer;
begin
Ub := max(High(V),Ub);
for I := Lb to Ub do
V[I] := Func(V[I]);
end;
function EAbs(X:float):float; inline;
begin
result := abs(X);
end;
procedure AbsArray(V:TVector; Lb, Ub: integer);
var
I:integer;
begin
Ub := max(High(V),Ub);
for I := Lb to Ub do
V[I] := abs(V[I]);
end;
generic procedure ApplyFunctor<T>(V: TVector; Lb, Ub: Integer);
var
i: Integer;
begin
Ub := max(High(v), Ub);
for i := Lb to Ub do
V[i] := T.Call(V[i]);
end;
type
TAbsFunctor = record
class function Call(aValue: Float): Float; static; inline;
end;
class function TAbsFunctor.Call(aValue: Float): Float;
begin
Result := Abs(aValue);
end;
var
Vec:TVector; // TVector = array of Float; Float = double
I:integer;
time1,time2:tdatetime;
begin
Vec := Seq(0,256000,-3000,2); // creates array with maximal index 128000
time1 := time; // and initializes with sequence -3000, -2998 etc
for I := 0 to 20 do
AbsArray(Vec,0,High(Vec));
time2 := time;
writeln('it takes ',inttostr(millisecondsbetween(time2, time1)), ' ms. for direct call of Abs.');
time1 := time;
for I := 0 to 20 do
Apply(Vec,0,High(Vec),@EAbs);
time2 := time;
writeln('it takes ',inttostr(millisecondsbetween(time2, time1)), ' ms. Apply of indirect call.');
time1 := time;
for i := 0 to 20 do
specialize ApplyFunctor<TAbsFunctor>(Vec,0,High(Vec));
time2 := time;
writeln('it takes ',inttostr(millisecondsbetween(time2, time1)), ' ms. Apply of functor.');
readln;
end.