The Shunting Yard Algorithm

The Shunting Yard Algorithm converts expressions written in infix notation (i.e. with the operator between the operands) to Reverse Polish Notation (RPN). The algorithm was published by Dijkstra in November 1961 and the original paper can be found here.

RPN is often used in stack-based languages, such as Joy. In this respect, Clojure is to prefix notation as Joy is to stack-based notation.

The algorithm is simple and the description on Wikipedia is very complete; but it still was a great learning exercise for lazy sequences. The code implements a very simple expression parser based on a sequence of elements. Currently nesting expressions isn't supported directly, you have to use \( and \) to escape parenthesis.

;;; Shunting Yard Algorithm
(ns uk.co.fatvat.algorithms.shuntingyard
  (:use clojure.contrib.test-is))

(defstruct operator :name :precedence :associativity)

(def operators
     #{(struct operator + '1 'left)
       (struct operator - '1 'left)
       (struct operator * '2 'left)
       (struct operator / '2 'left)
       (struct operator '^ 3 'right)})

(defn lookup-operator
  [symb]
  (first (filter (fn [x] (= (:name x) symb)) operators)))

(defn operator?
  [op]
  (not (nil? (lookup-operator op))))

(defn op-compare
  [op1 op2]
  (let [operand1 (lookup-operator op1)
        operand2 (lookup-operator op2)]
    (or
     (and (= 'left (:associativity operand1)) (<= (:precedence operand1) (:precedence operand2)))
     (and (= 'right (:associativity operand1)) (<= (:precedence operand1) (:precedence operand2))))))

(defn- open-bracket? [op]
  (= op \())

(defn- close-bracket? [op]
  (= op \)))

(defn shunting-yard
  ([expr] 
     (shunting-yard expr []))
  ([expr stack]
     (if (empty? expr)
       (if-not (some (partial = \() stack)
         stack
         (assert false))
       (let [token (first expr)
             remainder (rest expr)]
         (cond

           (number? token) (lazy-seq
                             (cons token (shunting-yard remainder stack)))
           
           (operator? token) (if (operator? (first stack))
                               (lazy-seq
                                 (concat (take-while (partial op-compare token) stack)
                                         (shunting-yard remainder 
                                                        (cons token 
                                                              (drop-while (partial op-compare token) stack)))))
                               (shunting-yard remainder (cons token stack)))

           (open-bracket? token) (shunting-yard remainder (cons token stack))
           
           (close-bracket? token) (let [ops (take-while (comp not open-bracket?) stack)
                                        ret (drop-while (comp not open-bracket?) stack)]
                                    (assert (= (first ret) \())
                                    (lazy-seq
                                      (concat ops (shunting-yard remainder (rest ret)))))
                                       
           :else (assert false))))))

(defn pretty-print 
  [expr]
  (map (fn [x] 
         (cond 
           (= x +) '+
           (= x -) '-
           (= x /) '/
           (= x *) '*
           :else x)) expr))
     
(deftest test-shuntingyard
  (is (= (pretty-print (shunting-yard [100 + 200])) '(100 200 +)))
  (is (= (pretty-print (shunting-yard [100 * 200])) '(100 200 *)))
  (is (= (pretty-print (shunting-yard [100 / 200])) '(100 200 /)))
  (is (= (pretty-print (shunting-yard [100 - 200])) '(100 200 -)))
  (is (= (pretty-print (shunting-yard [4 + 5 + \( 6 * 7 \)] '(4 5 + 6 7 * +)))))
  (is (= (pretty-print (shunting-yard [\( \( \( 6 * 7 \) \) \)] '(6 7 *)))))
  (is (= (pretty-print (shunting-yard [3 + 4 * 5])) '(3 4 5 * +))))

    

Most of the entries on my blog could be considered Coding Dojo type tasks. I'm basically after problems I can solve in a few hours that I can learn something from!