Reverse Polish

ReversePolish.R

rp <- function() {
    stack <- numeric()
    push <- function(values) stack <<- c(stack, values)
    pop <- function() {
        a <- stack[length(stack)]
        stack <<- stack[-length(stack)]
        return(a)
    }
    reverse <- function() {
        r <- readline()
        if(r == "Q") {
            return(r)
        } else {
            if(r == "+") {
                p1 <- pop()
                p2 <- pop()
                push(p1 + p2)
            } else if(r == "-") {
                p1 <- pop()
                p2 <- pop()
                push(p2 - p1)
            } else if(r == "*") {
                p1 <- pop()
                p2 <- pop()
                push(p2 * p1)
            } else if(r == "/") {
                p1 <- pop()
                p2 <- pop()
                push(p2 / p1)
            } else if(r == "^"){
                p1 <- pop()
                p2 <- pop()
                push(p2 ^ p1)
            } else if(is.numeric(r)) {
                push(r)
            }
        }
        return(r)
    }
    r <- readline()
    while(r != "Q") {
        r <- reverse()
        print(stack)
    }
    return(stack)
}


# push
push <- function(x, values, env = parent.frame()) (assign(as.character(substitute(x)), c(x, values), env))
 
# pop
pop <- function(x, n = 1, env = parent.frame()) (assign(as.character(substitute(x)), x[-c((length(x)-n):length(x))], env))

# reverse polish push
polish <- function(x, values, env = parent.frame()) {
    if(values == "+") {
        new <- x[length(x)-1] + x[length(x)]
        pop(substitute(x), 2, env = env)
        push(substitute(x), new, env = env)
    } else if(values == "-") {
        new <- x[length(x)-1] - x[length(x)]
        pop(substitute(x), 2, env = env)
        push(substitute(x), new, env = env)
    } else if(values == "*") {
        new <- x[length(x)-1] * x[length(x)]
        pop(substitute(x), 2, env = env)
        push(substitute(x), new, env = env)
    } else if(values == "/") {
        new <- x[length(x)-1] / x[length(x)]
        pop(substitute(x), 2, env = env)
        push(substitute(x), new, env = env)
    } else if(values == "^") {
        new <- x[length(x)-1] ^ x[length(x)]
        pop(substitute(x), 2, env = env)
        push(substitute(x), new, env = env)
    } else {
        push(substitute(x), values, env = env)
    }
}

# Example from: http://en.wikipedia.org/wiki/Reverse_Polish_notation#Postfix_algorithm
# 5 1 2 + 4 × + 3 − 
x <- numeric()
polish(x, 5)
polish(x, 1)
polish(x, 2)
polish(x, "+")
polish(x, 4)
polish(x, "*")
polish(x, "+")
polish(x, 3)
polish(x, "-")