New Math Functions in Pascal

Posted
Comments None

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:

function gepRamp1(x: real): real;
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;

Author

Comments

There are currently no comments on this article.

Comment

your_ip_is_blacklisted_by sbl.spamhaus.org

← Older Newer →