New Math Functions in R

Posted
Comments None

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

Comments

There are currently no comments on this article.

Comment

your_ip_is_blacklisted_by sbl.spamhaus.org

← Older Newer →