Arithmetic evaluation: Difference between revisions

=={{header|Common Lisp}}==

The following code parses a string into a sequence of tokens. The sequence of tokens includes <code>:lparen</code> and <code>:rparen</code> indicating left and right parenthesis, respectively. That sequence of tokens is then transformed by replacing subsequences of the form <code>:lparen ... :rparen</code> with a sublist containing the tokens between the <code>:lparen</code> and <code>:rparen</code>. The resulting tree is then simplified by replacing any subsequence of the form <code>A x B y C …</code> with either <code>(A x B) y C …</code> or <code>A x (B y C)</code> depending on the relative precedence of <code>x</code> and <code>y</code>. This produces a syntax tree each of whose elements is either a node representing an integer, <code>(:integer . <var>n</var>)</code>, a list containing a single expression, <code>(<var>exp</var>), or an operation, <code>(<var>e₁</var> <var>op</var> <var>e₂</var>)</code>. Evaluating such a syntax tree is then trivial. This implementation can read integers, and produce integral and rational values.

<lang lisp>(defun tokenize-stream (stream)

(labels ((whitespace-p (char)

(find char #(#\space #\newline #\return #\tab)))

(consume-whitespace ()

(loop while (whitespace-p (peek-char nil stream nil #\a))

do (read-char stream)))

(read-integer ()

(loop while (digit-char-p (peek-char nil stream nil #\space))

collect (read-char stream) into digits

finally (return (parse-integer (coerce digits 'string))))))

(consume-whitespace)

(let ((c (peek-char nil stream nil nil)))

(multiple-value-bind (token value)

(case c

((nil) :eof)

((#\() :lparen)

((#\)) :rparen)

((#\*) :multiply)

((#\/) :divide)

((#\+) :add)

((#\-) :subtract)

(otherwise

(if (digit-char-p c)

(values :integer (read-integer))

(error "Unexpected character ~w encountered." c))))

(unless (find token #(:integer :eof))

(read-char stream))

(if (not (eql token :integer)) token

(cons token value))))))

(defun group-parentheses (tokens &optional (delimited nil))

(do ((new-tokens '()))

((endp tokens) (values (nreverse new-tokens) '()))

(let ((token (pop tokens)))

(case token

((:lparen)

(multiple-value-bind (group remaining-tokens)

(group-parentheses tokens t)

(setf new-tokens (cons group new-tokens)

tokens remaining-tokens)))

((:rparen)

(assert delimited () "Unexpected right parenthesis.")

(return (values (nreverse new-tokens) tokens)))

(otherwise

(push token new-tokens))))))

(defun group-operations (expression)

(flet ((gop (exp) (group-operations exp)))

(if (or (eql (car expression) :integer) ; <integer>

(endp (cdr expression)) ; (e1)

(endp (cdddr expression))) ; (e1 op e2)

expression

(destructuring-bind (A x B y C &rest others) expression

(let ((A (gop A)) (B (gop B)) (C (gop C)))

(if (and (find x #(:add :subtract))

(find y #(:multiply :divide)))

(gop (list* A x (list B y C) others))

(gop (list* (list A x B) y C others))))))))

(defun evaluate-expression (expression)

(cond

((eql (car expression) :integer)

(cdr expression))

((endp (cdr expression))

(evaluate-expression (car expression)))

(t (destructuring-bind (e1 op e2) expression

(let ((v1 (evaluate-expression e1))

(v2 (evaluate-expression e2)))

(ecase op

(:add (+ v1 v2))

(:subtract (- v1 v2))

(:multiply (* v1 v2))

(:divide (/ v1 v2))))))))

(defun evaluate (string)

(with-input-from-string (in string)

(evaluate-expression

(group-operations

(group-parentheses

(loop for token = (tokenize-stream in)

until (eql :eof token)

collect token))))))</lang>

Examples

> (evaluate "1 - 5 * 2 / 20 + 1")

3/2

> (evaluate "(1 - 5) * 2 / (20 + 1)")

-8/21

> (evaluate "2 * (3 + ((5) / (7 - 11)))")

7/2

> (evaluate "(2 + 3) / (10 - 5)")

1