For programming the new 39 math functions of GeneXproTools in Pascal, I had to decide whether to use the Ada code or the Fortran code. I ended up using the Ada code even though Pascal shares with Fortran the same style for returning a function output. Moreover, all three programming languages use a declarative block or region for declaring variables and constants and in both Pascal and Fortran you cannot declare and initialize your variables at the same time.
Here's the Pascal code for the new 39 math functions added to the built-in math functions of GeneXproTools 5.0 with Mini-Release 1:
begin
if (x > 0.0) then
gepRamp1 := x
else
gepRamp1 := 0.0;
end;
function gepRamp2(x: real): real;
begin
if (x > 0.0) then
gepRamp2 := 0.0
else
gepRamp2 := x;
end;
function gepRamp3(x: real): real;
begin
if (x > 0.0) then
gepRamp3 := 0.0
else
gepRamp3 := -x;
end;
function gepRamp4(x: real): real;
begin
if (x > 0.0) then
gepRamp4 := -x
else
gepRamp4 := 0.0;
end;
function gepStep1(x: real): real;
begin
if (x > 0.0) then
gepStep1 := 1.0
else
gepStep1 := -1.0;
end;
function gepStep2(x: real): real;
begin
if (x > 0.0) then
gepStep2 := 1.0
else
gepStep2 := 0.0;
end;
function gepStep3(x: real): real;
begin
if (x >= 1.0) then
gepStep3 := 1.0
else if (x <= -1.0) then
gepStep3 := -1.0
else
gepStep3 := x;
end;
function gepStep4(x: real): real;
begin
if (x >= 1.0) then
gepStep4 := 1.0
else if (x <= 0.0) then
gepStep4 := 0.0
else
gepStep4 := x;
end;
function gepCL2A(x, y: real): real;
begin
if ((x > 0.0) and (y > 0.0)) then
gepCL2A := 1.0
else
gepCL2A := -1.0;
end;
function gepCL2B(x, y: real): real;
begin
if ((x >= 0.0) and (y < 0.0)) then
gepCL2B := -1.0
else
gepCL2B := 1.0;
end;
function gepCL2C(x, y: real): real;
begin
if ((x > 1.0) and (y < -1.0)) then
gepCL2C := -1.0
else
gepCL2C := 1.0;
end;
function gepCL2D(x, y: real): real;
begin
if ((x > 0.0) and (y > 0.0)) then
gepCL2D := 1.0
else
gepCL2D := 0.0;
end;
function gepCL2E(x, y: real): real;
begin
if ((x >= 0.0) and (y <= 0.0)) then
gepCL2E := 0.0
else
gepCL2E := 1.0;
end;
function gepCL2F(x, y: real): real;
begin
if ((x > 1.0) and (y < -1.0)) then
gepCL2F := 0.0
else
gepCL2F := 1.0;
end;
function gepCL3A(x, y: real): real;
begin
if ((x > 0.0) and (y < 0.0)) then
gepCL3A := 1.0
else if ((x < 0.0) and (y > 0.0)) then
gepCL3A := -1.0
else
gepCL3A := 0.0;
end;
function gepCL3B(x, y: real): real;
begin
if ((x >= 1.0) and (y >= 1.0)) then
gepCL3B := 1.0
else if ((x <= -1.0) and (y <= -1.0)) then
gepCL3B := -1.0
else
gepCL3B := 0.0;
end;
function gepCL3C(x, y: real): real;
begin
if ((x > 0.0) and (y > 0.0)) then
gepCL3C := 1.0
else if ((x < 0.0) and (y < 0.0)) then
gepCL3C := -1.0
else
gepCL3C := 0.0;
end;
function gepMap3A(x, y: real): real;
const SLACK = 10.0;
begin
if (y < (x - SLACK)) then
gepMap3A := -1.0
else if (y > (x + SLACK)) then
gepMap3A := 1.0
else
gepMap3A := 0.0;
end;
function gepMap3B(x, y, z: real): real;
var
minValue, maxValue: real;
begin
minValue := x;
maxValue := y;
if (minValue > y) then
begin
minValue := y;
maxValue := x;
end;
if (z < minValue) then
gepMap3B := -1.0
else if (z > maxValue) then
gepMap3B := 1.0
else
gepMap3B := 0.0;
end;
function gepMap3C(a, b, c, d: real): real;
var
minValue, maxValue: real;
begin
{ evaluate minValue(a,b,c) and maxValue(a,b,c) }
{ evaluate minValue(a,b,c) }
minValue := a;
if (minValue > b) then
minValue := b;
if (minValue > c) then
minValue := c;
{ evaluate maxValue(a,b,c) }
maxValue := a;
if (maxValue < b) then
maxValue := b;
if (maxValue < c) then
maxValue := c;
if (d < minValue) then
gepMap3C := -1.0
else if (d > maxValue) then
gepMap3C := 1.0
else
gepMap3C := 0.0;
end;
function gepMap4A(x, y: real): real;
const SLACK = 10.0;
begin
if (y < (x - SLACK)) then
gepMap4A := 0.0
else if ((y >= (x - SLACK)) and (y < x)) then
gepMap4A := 1.0
else if ((y >= x) and (y < (x + SLACK))) then
gepMap4A := 2.0
else if (y >= (x + SLACK)) then
gepMap4A := 3.0;
end;
function gepMap4B(x, y, z: real): real;
var
minValue, maxValue, midrange: real;
begin
{ evaluate minValue(x,y), maxValue(x,y) and midrange }
minValue := x;
maxValue := y;
if (minValue > y) then
begin
minValue := y;
maxValue := x;
end;
midrange := (maxValue + minValue)/2.0;
if (z < minValue) then
gepMap4B := 0.0
else if ((z >= minValue) and (z < midrange)) then
gepMap4B := 1.0
else if ((z >= midrange) and (z < maxValue)) then
gepMap4B := 2.0
else if (z >= maxValue) then
gepMap4B := 3.0;
end;
function gepMap4C(a, b, c, d: real): real;
var
minValue, maxValue, midleValue: real;
argMin, argMax: integer;
begin
{ evaluate minValue(a,b,c), maxValue(a,b,c) and midleValue(a,b,c) }
{ evaluate minValue(a,b,c) }
minValue := a;
argMin := 0;
if (minValue > b) then
begin
minValue := b;
argMin := 1;
end;
if (minValue > c) then
begin
minValue := c;
argMin := 2;
end;
{ evaluate maxValue(a,b,c) }
maxValue := a;
argMax := 0;
if (maxValue < b) then
begin
maxValue := b;
argMax := 1;
end;
if (maxValue < c) then
begin
maxValue := c;
argMax := 2;
end;
{ evaluate midleValue(a,b,c) }
midleValue := c;
if ((0 <> argMin) and (0 <> argMax)) then
midleValue := a;
if ((1 <> argMin) and (1 <> argMax)) then
midleValue := b;
if (d < minValue) then
gepMap4C := 0.0
else if ((d >= minValue) and (d < midleValue)) then
gepMap4C := 1.0
else if ((d >= midleValue) and (d < maxValue)) then
gepMap4C := 2.0
else if (d >= maxValue) then
gepMap4C := 3.0;
end;
function gepMap5A(x, y: real): real;
const SLACK = 15.0;
begin
if (y < (x - SLACK)) then
gepMap5A := 0.0
else if ((y >= (x - SLACK)) and (y < (x - SLACK/3.0))) then
gepMap5A := 1.0
else if ((y >= (x - SLACK/3.0)) and (y < (x + SLACK/3.0))) then
gepMap5A := 2.0
else if ((y >= (x + SLACK/3.0)) and (y < (x + SLACK))) then
gepMap5A := 3.0
else if (y >= (x + SLACK)) then
gepMap5A := 4.0;
end;
function gepMap5B(x, y, z: real): real;
var
minValue, maxValue, intervalLength, midpoint1, midpoint2: real;
begin
{ evaluate minValue(x,y), maxValue(x,y), midpoint1, midpoint2 }
minValue := x;
maxValue := y;
if (minValue > y) then
begin
minValue := y;
maxValue := x;
end;
intervalLength := (maxValue - minValue)/3.0;
midpoint1 := minValue + intervalLength;
midpoint2 := minValue + 2.0*intervalLength;
if (z < minValue) then
gepMap5B := 0.0
else if ((z >= minValue) and (z < midpoint1)) then
gepMap5B := 1.0
else if ((z >= midpoint1) and (z < midpoint2)) then
gepMap5B := 2.0
else if ((z >= midpoint2) and (z < maxValue)) then
gepMap5B := 3.0
else if (z >= maxValue) then
gepMap5B := 4.0;
end;
function gepMap5C(a, b, c, d: real): real;
var
minValue, maxValue, midleValue, midrange1, midrange2: real;
argMin, argMax: integer;
begin
{ evaluate minValue(a,b,c), maxValue(a,b,c), midleValue(a,b,c), midrange1, midrange2 }
{ evaluate minValue(a,b,c) }
minValue := a;
argMin := 0;
if (minValue > b) then
begin
minValue := b;
argMin := 1;
end;
if (minValue > c) then
begin
minValue := c;
argMin := 2;
end;
{ evaluate maxValue(a,b,c) }
maxValue := a;
argMax := 0;
if (maxValue < b) then
begin
maxValue := b;
argMax := 1;
end;
if (maxValue < c) then
begin
maxValue := c;
argMax := 2;
end;
{ evaluate midleValue(a,b,c) }
midleValue := c;
if ((0 <> argMin) and (0 <> argMax)) then
midleValue := a;
if ((1 <> argMin) and (1 <> argMax)) then
midleValue := b;
{ evaluate midrange1 and midrange2 }
midrange1 := (minValue + midleValue)/2.0;
midrange2 := (midleValue + maxValue)/2.0;
if (d < minValue) then
gepMap5C := 0.0
else if ((d >= minValue) and (d < midrange1)) then
gepMap5C := 1.0
else if ((d >= midrange1) and (d < midrange2)) then
gepMap5C := 2.0
else if ((d >= midrange2) and (d < maxValue)) then
gepMap5C := 3.0
else if (d >= maxValue) then
gepMap5C := 4.0;
end;
function gepMap6A(x, y: real): real;
const SLACK = 10.0;
begin
if (y < (x - SLACK)) then
gepMap6A := 0.0
else if ((y >= (x - SLACK)) and (y < (x - SLACK/2.0))) then
gepMap6A := 1.0
else if ((y >= (x - SLACK/2.0)) and (y < x)) then
gepMap6A := 2.0
else if ((y >= x) and (y < (x + SLACK/2.0))) then
gepMap6A := 3.0
else if ((y >= (x + SLACK/2.0)) and (y < (x + SLACK))) then
gepMap6A := 4.0
else if (y >= (x + SLACK)) then
gepMap6A := 5.0;
end;
function gepMap6B(x, y, z: real): real;
var
minValue, maxValue, midrange, midpoint1, midpoint2: real;
begin
{ evaluate minValue(x,y), maxValue(x,y), midrange, midpoint1, midpoint2 }
minValue := x;
maxValue := y;
if (minValue > y) then
begin
minValue := y;
maxValue := x;
end;
midrange := (minValue + maxValue)/2.0;
midpoint1 := (minValue + midrange)/2.0;
midpoint2 := (midrange + maxValue)/2.0;
if (z < minValue) then
gepMap6B := 0.0
else if ((z >= minValue) and (z < midpoint1)) then
gepMap6B := 1.0
else if ((z >= midpoint1) and (z < midrange)) then
gepMap6B := 2.0
else if ((z >= midrange) and (z < midpoint2)) then
gepMap6B := 3.0
else if ((z >= midpoint2) and (z < maxValue)) then
gepMap6B := 4.0
else if (z >= maxValue) then
gepMap6B := 5.0;
end;
function gepMap6C(a, b, c, d: real): real;
var
minValue, maxValue, midleValue, midrange1, midrange2: real;
argMin, argMax: integer;
begin
{ evaluate minValue(a,b,c), maxValue(a,b,c), midleValue(a,b,c), midrange1, midrange2 }
{ evaluate minValue(a,b,c) }
minValue := a;
argMin := 0;
if (minValue > b) then
begin
minValue := b;
argMin := 1;
end;
if (minValue > c) then
begin
minValue := c;
argMin := 2;
end;
{ evaluate maxValue(a,b,c) }
maxValue := a;
argMax := 0;
if (maxValue < b) then
begin
maxValue := b;
argMax := 1;
end;
if (maxValue < c) then
begin
maxValue := c;
argMax := 2;
end;
{ evaluate midleValue(a,b,c) }
midleValue := c;
if ((0 <> argMin) and (0 <> argMax)) then
begin
midleValue := a;
end;
if ((1 <> argMin) and (1 <> argMax)) then
begin
midleValue := b;
end;
{ evaluate midrange1 and midrange2 }
midrange1 := (minValue + midleValue)/2.0;
midrange2 := (midleValue + maxValue)/2.0;
if (d < minValue) then
gepMap6C := 0.0
else if ((d >= minValue) and (d < midrange1)) then
gepMap6C := 1.0
else if ((d >= midrange1) and (d < midleValue)) then
gepMap6C := 2.0
else if ((d >= midleValue) and (d < midrange2)) then
gepMap6C := 3.0
else if ((d >= midrange2) and (d < maxValue)) then
gepMap6C := 4.0
else if (d >= maxValue) then
gepMap6C := 5.0;
end;
function gepECL3A(x, y, z: real): real;
begin
if ((y > x) and (z < x)) then
gepECL3A := 1.0
else if ((y < x) and (z > x)) then
gepECL3A := -1.0
else
gepECL3A := 0.0;
end;
function gepECL3B(x, y, z: real): real;
begin
if ((y > x) and (z > x)) then
gepECL3B := 1.0
else if ((y < x) and (z < x)) then
gepECL3B := -1.0
else
gepECL3B := 0.0;
end;
function gepECL3C(x, y, z: real): real;
begin
if ((y >= x) and (z >= x)) then
gepECL3C := 1.0
else if ((y <= -x) and (z <= -x)) then
gepECL3C := -1.0
else
gepECL3C := 0.0;
end;
function gepECL3D(a, b, c, d: real): real;
var
minValue, maxValue: real;
begin
minValue := a;
maxValue := b;
if (minValue > b) then
begin
minValue := b;
maxValue := a;
end;
if ((c >= maxValue) and (d >= maxValue)) then
gepECL3D := 1.0
else if ((c <= minValue) and (d <= minValue)) then
gepECL3D := -1.0
else
gepECL3D := 0.0;
end;
function gepAMin2(x, y: real): real;
begin
if (x < y) then
gepAMin2 := 0.0
else
gepAMin2 := 1.0;
end;
function gepAMin3(x, y, z: real): real;
var
temp, argMin: real;
begin
temp := x;
argMin := 0.0;
if (temp >= y) then
begin
temp := y;
argMin := 1.0;
end;
if (temp >= z) then
argMin := 2.0;
gepAMin3 := argMin;
end;
function gepAMin4(a, b, c, d: real): real;
var
temp, argMin: real;
begin
temp := a;
argMin := 0.0;
if (temp >= b) then
begin
temp := b;
argMin := 1.0;
end;
if (temp >= c) then
begin
temp := c;
argMin := 2.0;
end;
if (temp >= d) then
argMin := 3.0;
gepAMin4 := argMin;
end;
function gepAMax2(x, y: real): real;
begin
if (x >= y) then
gepAMax2 := 0.0
else
gepAMax2 := 1.0;
end;
function gepAMax3(x, y, z: real): real;
var
temp, argMax: real;
begin
temp := x;
argMax := 0.0;
if (temp < y) then
begin
temp := y;
argMax := 1.0;
end;
if (temp < z) then
argMax := 2.0;
gepAMax3 := argMax;
end;
function gepAMax4(a, b, c, d: real): real;
var
temp, argMax: real;
begin
temp := a;
argMax := 0.0;
if (temp < b) then
begin
temp := b;
argMax := 1.0;
end;
if (temp < c) then
begin
temp := c;
argMax := 2.0;
end;
if (temp < d) then
argMax := 3.0;
gepAMax4 := argMax;
end;
Comments
There are currently no comments on this article.
Comment
your_ip_is_blacklisted_by sbl.spamhaus.org