Clojureで中置記法を計算する

これは何

Clojure for the Brave and Trueのchapter7のExercises 2より。
年末年始の休みを利用して取り組んでいた問題。
あまり英語が得意ではないので、雰囲気で読み取り、 (1 + 2 * 3)のようなリストを引数として取り、演算子の優先順位規則に従って計算をする関数を作れ、という問題として受け取ってたんだけど、今見ると、正しく評価できるリストに変換する関数を作れとも受け取れる。
今回は計算を行う関数を作ったので、そのことについて書く。

方法

「操車場アルゴリズム」を使う。
wikipediaによると、ダイクストラ先生が考案したらしい。
が、よくわからないので色々調べた結果、こちらの記事が大変参考になった。

解説

今回したこと

下記の演算子と数値を含むリストを正しい計算順序で計算できるようにした。

* (乗算)
/ (除算)
+ (加算)
- (減算)

また式内に()(括弧)が含まれている場合は、そちらを優先する。
つまりこんなリストを計算できるようにした。
'(1 + 4 - (3 * (4 - 5)))
この場合は8になる。グーグル先生の電卓でも8と計算されているので正しいはず。
https://www.google.com/search?q=(1+%2B+4+-+(3+*+(4+-+5)))&ie=utf-8&oe=utf-8

操車場アルゴリズムについて

詳しい説明については、検索してもらうのが一番良いと思う。
今、wikipediaを見ると今回の実装が果たして操車場アルゴリズムと呼べるのかもちょっと怪しい気がしてきた。。。
ここでは今回実装したアルゴリズムについて簡単に説明する。
例として、下記のような数式で考える。

1 + 2 * 3

この数式の場合、単純に左から計算していくとだめで、先に2 * 3を計算しないといけない。つまりこのように計算したい。

1 + (2 * 3)

そのために、数式を下記のように見ていく。トークンとは数式の先頭の値のこと。

1. 
式: 1 + 2 * 3
トークン: 1
演算子スタック: []
被演算子スタック: []
動作: 被演算子スタックにトークンを追加する。

2. 
式: + 2 * 3
トークン: +
演算子スタック: []
被演算子スタック: [1]
動作: 演算子スタックにトークンを追加する。

3. 
式: 2 * 3
トークン: 2
演算子スタック: [+]
被演算子スタック: [1]
動作: 被演算子スタックにトークンを追加する。

4. 
式: * 3
トークン: *
演算子スタック: [+]
被演算子スタック: [2, 1]
動作:
    * トークンが演算子スタックの先頭の演算子より優先度が高い
    * トークンを用いて、被演算子スタックの先頭の値とトークンの右の被演算子を計算し、その結果を被演算子スタックに追加する:  [(2 * 3), 1] => [6, 1]
    * 次のループはトークンより2つ右の値からとなる。この場合は3までなので、次のループで終了となる

5. 
式: なし
トークン: なし
演算子スタック: [+]
被演算子スタック: [6, 1]
動作: 
    * 式の終了まで来たので、演算子スタックと被演算子スタックの値を計算する
    * 演算子スタック [+] ,被演算子スタック: [6,1] なので、古い順から 1 + 6 と計算する。答えは7となる。

コード

リポジトリはこちら。
詳細についてはコードを読んでいただきたい。
肝になるのはsrc/infix_calculator/calc.clj。
特にparse関数。
パースした結果が演算子である場合の条件分岐が結構大変だった気がする。
コードにコメントを追加したので、それを見て何をしているのか理解していただきたい。

(ns infix-calculator.calc)

;; 演算子とその優先度
(def operators-order [{:operator '+ :order 1}
                      {:operator '- :order 1}
                      {:operator '* :order 2}
                      {:operator '/ :order 2}])

;; 優先度の高い演算子
(def priorities (map :operator (filter #(= (:order %) 2) operators-order)))

;; 優先度の低い演算子
(def normals (map :operator (filter #(= (:order %) 1) operators-order)))

;; 演算子スタックと被演算子スタックが計算可能かどうか
(defn calc?
  [ops values]
  (and (not (nil? (first ops)))
       (not (nil? (first values)))))

;; 計算を行なう
(defn calc
  [operator operand1 operand2]
  (eval (list operator
              operand1
              operand2)))

;; 引数で渡された演算子の優先度を求める
(defn calc-order
  [operator]
  (:order (first (filter #(= (:operator %) operator) operators-order))))

;; 演算子スタックと被演算子スタックから値を計算する
(defn calc-stack
  [ops numbers]
  (cond
    (empty? ops) (first numbers)
    :else
    (calc-stack (rest ops)
                (cons (eval (list (first ops)
                                  (second numbers)
                                  (first numbers)))
                      (rest (rest numbers))))))

(defn parse
  [infixed]
  (loop [tokens infixed ;; 数式
         ops '() ;; 演算子スタック
         numbers '() ;; 被演算子スタック
         ]
    ;; 数式を先頭と残りに分ける
    ;; 先頭をトークンと呼ぶ
    (let [token (first tokens)
          remains (rest tokens)]
      (cond
        ;; トークンがnilであるか
        ;; nilであれば演算子と被演算子のスタックを計算する
        (nil? token) (calc-stack ops numbers)
        
        ;; トークンがリストであるか
        ;; リストであれば、そのリストをparse関数に渡し、その結果を被演算子スタックに追加する
        (list? token) (recur remains
                             ops
                             (cons (parse token) numbers))
                             
        ;; トークンが数値であるか
        ;; 数値であれば、被演算子スタックに追加する
        (number? token) (recur remains
                               ops
                               (cons token numbers))
                               
        ;; トークンが演算子であるか
        (ifn? token) (cond
                       ;; 演算子スタックが空であれば問答無用で追加する
                       (empty? ops) (recur remains
                                           (cons token ops)
                                           numbers)
                                           
                       ;; 演算子スタックと被演算子スタックが計算可能であり、
                       ;; トークンが優先すべき演算子であり、
                       ;; トークンが演算子スタックの先頭の演算子より優先度が高いか
                       (and (calc? ops numbers)
                            (some #(= token %) priorities)
                            (> (calc-order token)
                               (calc-order (first ops)))
                            (number? (first remains)))
                       ;; トークンを用いて被演算子スタックの先頭の値と、トークンの右の被演算子を計算し、
                       ;; その結果を被演算子スタックに追加する。
                       (recur (rest remains)
                              ops
                              (cons (calc token
                                          (first numbers)
                                          (first remains))
                                    (rest numbers)))

                       ;; 演算子スタックと被演算子スタックが計算可能であり、
                       ;; トークンと演算子スタックの先頭の演算子スタックの優先度が同じか
                       (and (calc? ops numbers)
                            (= (calc-order token)
                               (calc-order (first ops)))
                            (number? (first remains)))
                       ;; 演算子スタックの先頭の演算子を用いて被演算子スタックの値を計算し
                       ;; その結果を被演算子スタックに追加する
                       (recur remains
                              (cons token (rest ops))
                              (cons (calc (first ops)
                                          (second numbers)
                                          (first numbers))
                                    (rest (rest numbers))))
                       
                       ;; それ以外の場合
                       :else
                       ;; トークンを演算子スタックにスタックに追加する
                       (recur remains
                              (cons token ops)
                              numbers))))))

結構泥臭いことをやっていて、loopで愚直に調べている。Lisp的に正しいのかも分からない。
今見ると、calcと付く関数ばかりで自分でもどうなんだろうと思う。
最初は、reduceとかでできないものかと、色々調べたんだけど、何か無理っぽいのでおとなしくloopを使うことにした。
何年か前、Common Lispのloopがよくわからなかったので、loopはあまり使いたくなかったのだけど、これを作ったおかげで、Clojureのloopについては何とか使えるようになった。

参考記事

大変参考になりました。本当にありがとうございました。
https://blog.shibayu36.org/entry/2017/03/05/170000