# New Math Functions in R

Posted

The R code for the 39 new math functions of GeneXproTools was easily created from the C# code. I basically just removed all type keywords (double, int, const), put parentheses around the "return" expression, removed all the semi-colons, replaced the assignment sign by "<-", the comment marks by "#", and Math.Min and Math.Max by min and max.

The functions declarations are also different in both programming languages, but that's easily taken care of as we can use templates to generate the different function headers used in the R language.

Here's the R code for all the 39 new math functions that were added to the built-in math functions of GeneXproTools 5.0 with Mini-Release 1:

gepRamp1 <- function(x)
{
if (x > 0.0)
return (x)
else
return (0.0)
}

gepRamp2 <- function(x)
{
if (x > 0.0)
return (0.0)
else
return (x)
}

gepRamp3 <- function(x)
{
if (x > 0.0)
return (0.0)
else
return (-x)
}

gepRamp4 <- function(x)
{
if (x > 0.0)
return (-x)
else
return (0.0)
}

gepStep1 <- function(x)
{
if (x > 0.0)
return (1.0)
else
return (-1.0)
}

gepStep2 <- function(x)
{
if (x > 0.0)
return (1.0)
else
return (0.0)
}

gepStep3 <- function(x)
{
if (x >= 1.0)
return (1.0)
else
if (x <= -1.0)
return (-1.0)
else
return (x)
}

gepStep4 <- function(x)
{
if (x >= 1.0)
return (1.0)
else
if (x <= 0.0)
return (0.0)
else
return (x)
}

gepCL2A <- function(x, y)
{
if (x > 0.0 && y > 0.0)
return (1.0)
else
return (-1.0)
}

gepCL2B <- function(x, y)
{
if (x >= 0.0 && y < 0.0)
return (-1.0)
else
return (1.0)
}

gepCL2C <- function(x, y)
{
if (x > 1.0 && y < -1.0)
return (-1.0)
else
return (1.0)
}

gepCL2D <- function(x, y)
{
if (x > 0.0 && y > 0.0)
return (1.0)
else
return (0.0)
}

gepCL2E <- function(x, y)
{
if (x >= 0.0 && y <= 0.0)
return (0.0)
else
return (1.0)
}

gepCL2F <- function(x, y)
{
if (x > 1.0 && y < -1.0)
return (0.0)
else
return (1.0)
}

gepCL3A <- function(x, y)
{
if (x > 0.0 && y < 0.0)
return (1.0)
else
if (x < 0.0 && y > 0.0)
return (-1.0)
else
return (0.0)
}

gepCL3B <- function(x, y)
{
if (x >= 1.0 && y >= 1.0)
return (1.0)
else
if (x <= -1.0 && y <= -1.0)
return (-1.0)
else
return (0.0)
}

gepCL3C <- function(x, y)
{
if (x > 0.0 && y > 0.0)
return (1.0)
else
if (x < 0.0 && y < 0.0)
return (-1.0)
else
return (0.0)
}

gepMap3A <- function(x, y)
{
SLACK <- 10.0
outVal <- 0.0
if (y < (x - SLACK))
outVal <- -1.0
else if (y > (x + SLACK))
outVal <- 1.0
return (outVal)
}

gepMap3B <- function(x, y, z)
{
minValue <- min(x,y)
maxValue <- max(x,y)
outVal <- 0.0
if (z < minValue)
outVal <- -1.0
else if (z > maxValue)
outVal <- 1.0
return (outVal)
}

gepMap3C <- function(a, b, c, d)
{
minValue <- min(a,b,c)
maxValue <- max(a,b,c)
outVal <- 0.0
if (d < minValue)
outVal <- -1.0
else if (d > maxValue)
outVal <- 1.0
return (outVal)
}

gepMap4A <- function(x, y)
{
SLACK <- 10.0
outVal <- 0.0
if (y < (x - SLACK))
outVal <- 0.0
else if (y >= (x - SLACK) && y < x)
outVal <- 1.0
else if (y >= x && y < (x + SLACK))
outVal <- 2.0
else if (y >= (x + SLACK))
outVal <- 3.0
return (outVal)
}

gepMap4B <- function(x, y, z)
{
# evaluate minValue(x,y), maxValue(x,y) and midrange
minValue <- min(x,y)
maxValue <- max(x,y)
midrange <- (maxValue + minValue)/2.0

outVal <- 0.0
if (z < minValue)
outVal <- 0.0
else if (z >= minValue && z < midrange)
outVal <- 1.0
else if (z >= midrange && z < maxValue)
outVal <- 2.0
else if (z >= maxValue)
outVal <- 3.0
return (outVal)
}

gepMap4C <- function(a, b, c, d)
{
# 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)
{
minValue <- b
argMin <- 1
}
if (minValue > c)
{
minValue <- c
argMin <- 2
}
# evaluate maxValue(a,b,c)
maxValue <- a
argMax <- 0
if (maxValue < b)
{
maxValue <- b
argMax <- 1
}
if (maxValue < c)
{
maxValue <- c
argMax <- 2
}
# evaluate midleValue(a,b,c)
midleValue <- c
if (0 != argMin && 0 != argMax)
midleValue <- a
if (1 != argMin && 1 != argMax)
midleValue <- b

outVal <- 0.0
if (d < minValue)
outVal <- 0.0
else if (d >= minValue && d < midleValue)
outVal <- 1.0
else if (d >= midleValue && d < maxValue)
outVal <- 2.0
else if (d >= maxValue)
outVal <- 3.0
return (outVal)
}

gepMap5A <- function(x, y)
{
SLACK <- 15.0
outVal <- 0.0
if (y < (x - SLACK))
outVal <- 0.0
else if (y >= (x - SLACK) && y < (x - SLACK/3.0))
outVal <- 1.0
else if (y >= (x - SLACK/3.0) && y < (x + SLACK/3.0))
outVal <- 2.0
else if (y >= (x + SLACK/3.0) && y < (x + SLACK))
outVal <- 3.0
else if (y >= (x + SLACK))
outVal <- 4.0
return (outVal)
}

gepMap5B <- function(x, y, z)
{
# evaluate minValue(x,y), maxValue(x,y), midpoint1, midpoint2
minValue <- min(x,y)
maxValue <- max(x,y)
intervalLength <- (maxValue - minValue)/3.0
midpoint1 <- minValue + intervalLength
midpoint2 <- minValue + 2.0*intervalLength

outVal <- 0.0
if (z < minValue)
outVal <- 0.0
else if (z >= minValue && z < midpoint1)
outVal <- 1.0
else if (z >= midpoint1 && z < midpoint2)
outVal <- 2.0
else if (z >= midpoint2 && z < maxValue)
outVal <- 3.0
else if (z >= maxValue)
outVal <- 4.0
return (outVal)
}

gepMap5C <- function(a, b, c, d)
{
# 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)
{
minValue <- b
argMin <- 1
}
if (minValue > c)
{
minValue <- c
argMin <- 2
}
# evaluate maxValue(a,b,c)
maxValue <- a
argMax <- 0
if (maxValue < b)
{
maxValue <- b
argMax <- 1
}
if (maxValue < c)
{
maxValue <- c
argMax <- 2
}
# evaluate midleValue(a,b,c)
midleValue <- c
if (0 != argMin && 0 != argMax)
midleValue <- a
if (1 != argMin && 1 != argMax)
midleValue <- b
# evaluate midrange1 and midrange2
midrange1 <- (minValue + midleValue)/2.0
midrange2 <- (midleValue + maxValue)/2.0

outVal <- 0.0
if (d < minValue)
outVal <- 0.0
else if (d >= minValue && d < midrange1)
outVal <- 1.0
else if (d >= midrange1 && d < midrange2)
outVal <- 2.0
else if (d >= midrange2 && d < maxValue)
outVal <- 3.0
else if (d >= maxValue)
outVal <- 4.0
return (outVal)
}

gepMap6A <- function(x, y)
{
SLACK <- 10.0
outVal <- 0.0
if (y < (x - SLACK))
outVal <- 0.0
else if (y >= (x - SLACK) && y < (x - SLACK/2.0))
outVal <- 1.0
else if (y >= (x - SLACK/2.0) && y < x)
outVal <- 2.0
else if (y >= x && y < (x + SLACK/2.0))
outVal <- 3.0
else if (y >= (x + SLACK/2.0) && y < (x + SLACK))
outVal <- 4.0
else if (y >= (x + SLACK))
outVal <- 5.0
return (outVal)
}

gepMap6B <- function(x, y, z)
{
# evaluate minValue(x,y), maxValue(x,y), midrange, midpoint1, midpoint2
minValue <- min(x,y)
maxValue <- max(x,y)
midrange <- (minValue + maxValue)/2.0
midpoint1 <- (minValue + midrange)/2.0
midpoint2 <- (midrange + maxValue)/2.0

outVal <- 0.0
if (z < minValue)
outVal <- 0.0
else if (z >= minValue && z < midpoint1)
outVal <- 1.0
else if (z >= midpoint1 && z < midrange)
outVal <- 2.0
else if (z >= midrange && z < midpoint2)
outVal <- 3.0
else if (z >= midpoint2 && z < maxValue)
outVal <- 4.0
else if (z >= maxValue)
outVal <- 5.0
return (outVal)
}

gepMap6C <- function(a, b, c, d)
{
# 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)
{
minValue <- b
argMin <- 1
}
if (minValue > c)
{
minValue <- c
argMin <- 2
}
# evaluate maxValue(a,b,c)
maxValue <- a
argMax <- 0
if (maxValue < b)
{
maxValue <- b
argMax <- 1
}
if (maxValue < c)
{
maxValue <- c
argMax <- 2
}
# evaluate midleValue(a,b,c)
midleValue <- c
if (0 != argMin && 0 != argMax)
midleValue <- a
if (1 != argMin && 1 != argMax)
midleValue <- b
# evaluate midrange1 and midrange2
midrange1 <- (minValue + midleValue)/2.0
midrange2 <- (midleValue + maxValue)/2.0

outVal <- 0.0
if (d < minValue)
outVal <- 0.0
else if (d >= minValue && d < midrange1)
outVal <- 1.0
else if (d >= midrange1 && d < midleValue)
outVal <- 2.0
else if (d >= midleValue && d < midrange2)
outVal <- 3.0
else if (d >= midrange2 && d < maxValue)
outVal <- 4.0
else if (d >= maxValue)
outVal <- 5.0
return (outVal)
}

gepECL3A <- function(x, y, z)
{
if (y > x && z < x)
return (1.0)
else
if (y < x && z > x)
return (-1.0)
else return (0.0)
}

gepECL3B <- function(x, y, z)
{
if (y > x && z > x)
return (1.0)
else
if (y < x && z < x)
return (-1.0)
else return (0.0)
}

gepECL3C <- function(x, y, z)
{
if (y >= x && z >= x)
return (1.0)
else
if (y <= -x && z <= -x)
return (-1.0)
else return (0.0)
}

gepECL3D <- function(a, b, c, d)
{
minValue <- min(a,b)
maxValue <- max(a,b)
if (c >= maxValue && d >= maxValue)
return (1.0)
else
if (c <= minValue && d <= minValue)
return (-1.0)
else return (0.0)
}

gepAMin2 <- function(x, y)
{
if (x < y)
return (0.0)
else
return (1.0)
}

gepAMin3 <- function(x, y, z)
{
temp <- x
argMin <- 0.0
if (temp >= y)
{
temp <- y
argMin <- 1.0
}
if (temp >= z)
{
argMin <- 2.0
}
return (argMin)
}

gepAMin4 <- function(a, b, c, d)
{
temp <- a
argMin <- 0.0
if (temp >= b)
{
temp <- b
argMin <- 1.0
}
if (temp >= c)
{
temp <- c
argMin <- 2.0
}
if (temp >= d)
{
argMin <- 3.0
}
return (argMin)
}

gepAMax2 <- function(x, y)
{
if (x >= y)
return (0.0)
else
return (1.0)
}

gepAMax3 <- function(x, y, z)
{
temp <- x
argMax <- 0.0
if (temp < y)
{
temp <- y
argMax <- 1.0
}
if (temp < z)
{
argMax <- 2.0
}
return (argMax)
}

gepAMax4 <- function(a, b, c, d)
{
temp <- a
argMax <- 0.0
if (temp < b)
{
temp <- b
argMax <- 1.0
}
if (temp < c)
{
temp <- c
argMax <- 2.0
}
if (temp < d)
{
argMax <- 3.0
}
return (argMax)
}

Author