; ; ; ; ; ;;;; ;; ;; ; ; ; ; ; ; ; ; ;;;; ; ;;; ; ;; ;; ; ;;;; ;;;;; ;;;; ;; ;;; ; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ;; ; ; ;;;;; ; ; ; ; ; ;;;;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ;; ; ; ;; ; ; ; ; ; ; ;;; ;;; ;; ;;;;; ;;;; ;; ;; ;;;;; ;;; ;; ;;; ;;;; ;;;;; ; ; ; ; ; This program implements function my-eval which evaluates algebraic expressions in prefix notation. ; In order to simplify complex algebraic expressions, it allows to use definitions of subexpressions, ; i.e., we might denote a subexpression by a symbol and that symbol use instead of the subexpression. ; ; Syntax: (my-eval expr defs) where ; expr - is the algebraic expression to be evaluated ; defs - is a collection of definitions ; ; Algebraic expressions are defined inductively by the following forms: ; 1. a number ; 2. a symbol representing a defined subexpression ; 3. (op e1 e2 ... en) where op is an allowed operations (see below) and e1,...,en are expressions ; ; Definitions are formed by a list whose elements are pairs of the form (s expr) where s is a defined ; symbol and expr is an algebraic expression. ; ; Allowed operations: ; 1. add - addition of a list of numbers e.g. (add 1 -2) evaluates to -1; sum of empty list (add) equals zero ; 2. mul - multiplication of a list of numbers e.g. (mul 1 -2) evaluates to -2; product of empty list (mul) equals one ; 3. sub - subtraction has arity 2 e.g. (sub 1 -2) evaluates to 3 ; 4. div - division has arity 2 e.g. (div 1 -2) evaluates to -1/2; denominator can't be zero ; 5. sqrt - square root of a number (arity is 1) e.g. (sqrt 9) evaluates to 3; its argument can't be negative ; ; Examples of use: ; (my-eval '(sqrt (add 1 a)) '((a 3))) evaluates to 2 ; (my-eval '(div (add (mul -1 b) (sqrt D)) (mul 2 a)) '((a 2) (b -2) (c -12) (D (sub (mul b b) (mul 4 a c))))) evaluates to 3 ; (my-eval '(div 1 0) '()) evaluates to '(err "Dividing by zero") ; (my-eval '5 '()) evaluates to 5 ; (my-eval 'a '()) evaluates to '(err "Unknown symbol or cyclic definition") ; (my-eval 'a '((a b) (b a))) evaluates to '(err "Unknown symbol or cyclic definition") ; ; For other examples see tests below. #lang r5rs ; ; ; ; ; ;;; ;;; ;; ; ; ; ; ; ; ; ;;;; ; ;; ;; ;;;; ;; ;;; ;;;;; ; ;;;;; ; ; ; ;; ; ; ; ;; ; ; ; ; ; ;;;;;; ; ; ; ;;;;;; ; ;;;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;; ;;;;; ;;;;; ;;;; ;;;;; ;;;;; ;;;;; ; ; ; ;;; ; ; ;;; the following two higher-order functions you know from the lectures ;;; they are often directly implemented in Scheme but not implemented in R5RS (define (filter pred lst) (cond ((null? lst) '()) ((pred (car lst)) (cons (car lst) (filter pred (cdr lst)))) (else (filter pred (cdr lst))) ) ) (define (foldr op acc lst) (if (null? lst) acc (op (car lst) (foldr op acc (cdr lst))) ) ) ;;; checks if symbol is defined by pair (define (defined? symbol pair) (and (pair? pair) ; pair has to be a list (= (length pair) 2) ; of length 2 (eqv? (car pair) symbol) ; whose first component is equal to symbol ) ) ;;; finds out whether lst contains a pair defining symbol ;;; if yes then it returns its value (define (contains? symbol lst) (let ( (filtered-lst (filter (lambda (p) (defined? symbol p)) lst)) ) ; filter definition of symbol from lst (if (null? filtered-lst) ; if there is none #f ; return false (cadar filtered-lst) ; otherwise take the first pair defining the symbol and return its definition ) ) ) ;;; Substracts args; returns error if the number of args is not 2 (define (apply-sub args) (cond ((not (= (length args) 2)) '(err "Subtraction has arity 2")) (else (- (car args) (cadr args))) ) ) ;;; Divides args; returns error if the number of args is not 2 or the 2nd argument is 0 (define (apply-div args) (cond ((not (= (length args) 2)) '(err "Division has arity 2")) ((= (cadr args) 0) '(err "Dividing by zero")) (else (/ (car args) (cadr args))) ) ) ;;; Computes squre root of args; returns error if the number of args is not 1 or the argument is negative (define (apply-sqrt args) (cond ((not (= (length args) 1)) '(err "Sqrt has arity 1")) ((< (car args) 0) '(err "Can't make a square root of negative numbers")) (else (sqrt (car args))) ) ) ; ; ; ; ; ;;; ;;; ; ;;; ; ; ;; ;; ; ; ; ;; ;; ;;;; ;;; ;; ;; ;;;;;; ;; ;; ;; ;; ;;; ; ;;;;; ;;; ;;;; ;; ;; ; ; ; ; ; ; ; ;; ; ; ; ; ;; ; ; ;; ; ; ; ; ;; ; ; ; ; ; ;;;;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;; ;;; ;; ;;;;; ;;; ;;; ;;;;;; ;; ;; ;;; ;;; ;;;; ;;; ;;;;; ;;;; ;;; ;;; ; ; ; ; ;;; Main evaluation function (define (my-eval expr defs) (define (apply-op op args) (define vals (map (lambda (e) (my-eval e defs)) args)) ; evaluate subexpressions in args (let ((err-msg (contains? 'err vals))) ; is some of the subexpression evaluated as error? (cond (err-msg (list 'err err-msg)) ; if yes, return that error ((eqv? op 'add) (foldr + 0 vals)) ((eqv? op 'mul) (foldr * 1 vals)) ((eqv? op 'sub) (apply-sub vals)) ((eqv? op 'div) (apply-div vals)) ((eqv? op 'sqrt) (apply-sqrt vals)) (else '(err "Unknown operation")) ) ) ) (cond ((null? expr) '(err "Empty expression")) ((number? expr) expr) ; if expr is a number then return just the number ((symbol? expr) (let ( ; if expr is a symbol (def (contains? expr defs)) ; try to extract its definition (pred (lambda (x) (not (defined? expr x)))) ; in order to protect evaluation process against circular definitions, prepare a predicate to filter the definition out of defs ) (if def ; if expr is defined (my-eval def (filter pred defs)) ; evaluate the extracted definition and remove it from defs '(err "Unknown symbol or cyclic definition") ; otherwise throw an error ) ) ) (else (apply-op (car expr) (cdr expr))) ; if expr is of the form (op e1 ... en) extract op and args and call apply-op ) ) ; ; ; ; ; ;;;;;;; ; ; ; ; ; ; ; ;;;; ;;;;; ;;;;; ;;;;; ; ; ; ; ; ; ; ; ; ; ; ;;;;;; ;;;; ; ;;;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;;;; ;;;;; ;;; ;;;;; ; ; ; ; ;;; checks if x equals y (define (assert-equal msg x y) (if (equal? x y) (map display (list msg " = " x ", expected " y ", Ok")) (map display (list msg " = " x ", expected " y ", Wrong")) ) (newline) ) ;;; tests for defined? (display "Tests for defined?") (newline) (assert-equal "(defined? 'a '(a (add 5 3)))" (defined? 'a '(a (add 5 3))) #t) (assert-equal "(defined? 'a '(b 5))" (defined? 'a '(b 5)) #f) (assert-equal "(defined? 'a 3)" (defined? 'a 3) #f) (assert-equal "(defined? 'a '(a 5 8))" (defined? 'a '(a 5 8)) #f) ;;; tests for contains? (newline) (display "Tests for contains?") (newline) (assert-equal "(contains? 'a '(b (a 2) d))" (contains? 'a '(b (a 2) d)) 2) (assert-equal "(contains? 'a '(b (a 2) d (a 5)))" (contains? 'a '(b (a 2) d (a 5))) 2) ; returns the first definition (assert-equal "(contains? 'a '(b (c 2) d))" (contains? 'a '(b (c 2) d)) #f) (assert-equal "(contains? 'a '(b a d))" (contains? 'a '(b a d)) #f) (assert-equal "(contains? 'err '(b (err \"Unknown symbol\") d))" (contains? 'err '(b (err "Unknown symbol") d)) "Unknown symbol") (assert-equal "(contains? 'a '())" (contains? 'a '()) #f) ;;; tests for apply-sub (newline) (display "Tests for apply-sub") (newline) (assert-equal "3 - 5" (apply-sub '(3 5)) -2) (assert-equal "(apply-sub '(3))" (apply-sub '(3)) '(err "Subtraction has arity 2")) (assert-equal "(apply-sub '(3 5 8))" (apply-sub '(3 5 8)) '(err "Subtraction has arity 2")) ;;; tests for apply-div (newline) (display "Tests for apply-div") (newline) (assert-equal "3 / 5" (apply-div '(3 5)) 3/5) (assert-equal "(apply-div '(3))" (apply-div '(3)) '(err "Division has arity 2")) (assert-equal "(apply-div '(3 5 8))" (apply-div '(3 5 8)) '(err "Division has arity 2")) (assert-equal "1 / 0" (apply-div '(1 0)) '(err "Dividing by zero")) ;;; tests for apply-sqrt (newline) (display "Tests for apply-sqrt") (newline) (assert-equal "(apply-sqrt '(81))" (apply-sqrt '(81)) 9) (assert-equal "(apply-sqrt '(3 5 8))" (apply-sqrt '(3 5 8)) '(err "Sqrt has arity 1")) (assert-equal "(apply-sqrt '(-1))" (apply-sqrt '(-1)) '(err "Can't make a square root of negative numbers")) ;;; tests for my-eval (newline) (display "Tests for my-eval") (newline) (assert-equal "5" (my-eval '5 '()) 5) (assert-equal "Let a = 5. Then a" (my-eval 'a '((a 5))) 5) (assert-equal "a" (my-eval 'a '()) '(err "Unknown symbol or cyclic definition")) (assert-equal "()" (my-eval '() '()) '(err "Empty expression")) (assert-equal "(sqrt 100)" (my-eval '(sqrt 100) '()) 10) (assert-equal "(sqrt -1)" (my-eval '(sqrt -1) '()) '(err "Can't make a square root of negative numbers")) (assert-equal "1 + 1 + 1" (my-eval '(add 1 1 1) '()) 3) (assert-equal "Sum of a single number 1" (my-eval '(add 1) '()) 1) (assert-equal "Empty sum" (my-eval '(add) '()) 0) (assert-equal "1 * 2 * 3" (my-eval '(mul 1 2 3) '()) 6) (assert-equal "Product of a single number 2" (my-eval '(mul 2) '()) 2) (assert-equal "Empty product" (my-eval '(mul) '()) 1) (assert-equal "5 - 3" (my-eval '(sub 5 3) '()) 2) (assert-equal "(my-eval '(sub 5) '())" (my-eval '(sub 5) '()) '(err "Subtraction has arity 2")) (assert-equal "(my-eval '(sub) '())" (my-eval '(sub) '()) '(err "Subtraction has arity 2")) (assert-equal "5 / 3" (my-eval '(div 5 3) '()) 5/3) (assert-equal "(my-eval '(div 5) '())" (my-eval '(div 5) '()) '(err "Division has arity 2")) (assert-equal "1 / 0" (my-eval '(div 1 0) '()) '(err "Dividing by zero")) (assert-equal "( (-1) * (-2) + (sqrt 100) ) / (2 * 2)" (my-eval '(div (add (mul -1 -2) (sqrt 100)) (mul 2 2)) '()) 3) (define defs '((a 2) (b -2) (c -12) (D (sub (mul b b) (mul 4 a c))))) (define expr '(div (add (mul -1 b) (sqrt D)) (mul 2 a))) (assert-equal "Let a = 2, b = -2, c = -12, D = b*b - 4*a*c. Then ( -b + (sqrt D) ) / 2*a" (my-eval expr defs) 3) (assert-equal "Let a = b, b = a. Then a" (my-eval 'a '((a b) (b a))) '(err "Unknown symbol or cyclic definition")) (assert-equal "Let a = b*c, b = 1, c = a. Then a + a" (my-eval '(add a a) '((a (mul b c)) (b 1) (c a))) '(err "Unknown symbol or cyclic definition")) (assert-equal "(my-eval '(3 4) '())" (my-eval '(3 4) '()) '(err "Unknown operation")) (assert-equal "(my-eval '(rtt 3) '())" (my-eval '(rtt 3) '()) '(err "Unknown operation")) ;(require racket/trace) ;(trace my-eval)