You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
113 lines
4.3 KiB
113 lines
4.3 KiB
;;; |
|
;;; infix-math - calculate infix math strings in slope |
|
;;; Author: sloum |
|
;;; Version: 0.1.0 |
|
;;; |
|
|
|
(define is-keyword? (lambda (val) (or (is-op? val) (member? ["(" ")"] val)))) |
|
(define is-op? (lambda (val) (member? ["-" "+" "*" "/" "<" ">" "="] val))) |
|
(define is-digit? (lambda (val) (and (>= (string->rune val) 48) (<= (string->rune val) 57)))) |
|
(define op-associativity (lambda (op) (if (member? ["-" "+" "*" "/"] op) -1 1))) |
|
|
|
(define op-precedence |
|
(lambda (op) |
|
(cond |
|
((member? ["=" "<" ">"] op) 1) |
|
((member? ["+" "-"] op) 2) |
|
((member? ["*" "/"] op) 3) |
|
((equal? "^" op) 4) |
|
(else 0)))) |
|
|
|
(define op-actions (lambda (stmt stack) |
|
(define tok-prec (op-precedence (car stmt))) |
|
(define tok-assoc (op-associativity (car stmt))) |
|
(define stack-op (if (not (null? stack)) (car stack) [])) |
|
(define stack-prec (if (not (null? stack-op)) (op-precedence stack-op) 0)) |
|
(if |
|
(or |
|
(and (negative? tok-assoc) (<= tok-prec stack-prec)) |
|
(and (positive? tok-assoc) (< tok-prec stack-prec))) |
|
(cons stack-op (shunting-yard stmt (cdr stack))) |
|
(shunting-yard (cdr stmt) (cons (car stmt) stack))))) |
|
|
|
(define stack-ops (lambda (stack) |
|
(cond |
|
((and (not (null? stack)) (equal? (car stack) "(")) |
|
(! "Unbalanced parens")) |
|
((null? stack) stack) |
|
(else (cons (car stack) (shunting-yard [] (cdr stack))))))) |
|
|
|
(define shunting-yard (lambda (stmt stack) |
|
(cond |
|
((null? stmt) |
|
(stack-ops stack)) |
|
((string->number (car stmt)) |
|
(cons (car stmt) (shunting-yard (cdr stmt) stack))) |
|
((is-op? (car stmt)) |
|
(op-actions stmt stack)) |
|
((equal? (car stmt) "(") |
|
(shunting-yard (cdr stmt) (cons (car stmt) stack))) |
|
((equal? (car stmt) ")") |
|
(if (and (pair? stack) (equal? "(" (car stack))) |
|
(shunting-yard (cdr stmt) (cdr stack)) |
|
(cons (car stack) (shunting-yard stmt (cdr stack)))))))) |
|
|
|
(define prefix-calc (lambda (arr) |
|
(define s []) |
|
(if (null? arr) |
|
0 |
|
(begin |
|
(for-each |
|
(lambda (v) |
|
(if (is-op? v) |
|
(cond |
|
((equal? v "+") (set! s (cons (+ (car (cdr s)) (car s)) (cdr (cdr s))))) |
|
((equal? v "-") (set! s (cons (- (car (cdr s)) (car s)) (cdr (cdr s))))) |
|
((equal? v "*") (set! s (cons (* (car (cdr s)) (car s)) (cdr (cdr s))))) |
|
((equal? v "/") (set! s (cons (/ (car (cdr s)) (car s)) (cdr (cdr s)))))) |
|
(set! s (cons (string->number v) s)))) |
|
(shunting-yard arr [])) |
|
(if (not (equal? (length s) 1)) (! "Invalid prefix expression") (car s)))))) |
|
|
|
(define parse-string (lambda (input) |
|
(set! input (append "" input)) |
|
(define prev "") |
|
(reverse |
|
(reduce |
|
(lambda (val acc) |
|
(begin0 |
|
(cond |
|
((member? [" " "\t" "\n" "\r"] val) acc) |
|
((and (is-digit? val) (not (null? acc)) (equal? prev "-")) |
|
(cons (append (car acc) val) (cdr acc))) |
|
((is-keyword? val) (cons val acc)) |
|
((and (not (null? acc)) (is-keyword? (car acc))) (cons val acc)) |
|
(else (if (null? acc) (cons val acc) (cons (append (car acc) val) (cdr acc))))) |
|
(set! prev val))) |
|
[] |
|
(string->list input))))) |
|
|
|
(define replace-vars (lambda (ex en) |
|
(define panic? (exception-mode-panic?)) |
|
(if panic? (exception-mode-pass)) |
|
(begin0 |
|
(if (or (null? en) (not (assoc? en))) |
|
ex |
|
(map |
|
(lambda (e) |
|
(if (not (exception? (assoc en e))) |
|
(append "" (assoc en e)) |
|
e)) |
|
ex)) |
|
(if panic? (exception-mode-panic))))) |
|
|
|
(define calc (lambda (exp ...) |
|
(if (list? exp) |
|
(set! exp (map (lambda (v) (append "" v)) exp)) |
|
(set! exp (parse-string exp))) |
|
(if (and (not (null? ...)) (assoc? (car ...))) |
|
(set! exp (replace-vars exp (car ...)))) |
|
(prefix-calc exp))) |
|
|
|
(define _USAGE [ |
|
["calc" "(infix-math::calc [problem: string|list] [[vars: assoc]]) => number\n\nThe available operations for a problem are:\n\n\t+, -, *, /, (, and )\n\nPositive, negative, floating point, and integer numbers are all supported. If using subtraction there must be a space between the operator and the operand so-as to prevent confusion between a negative number and a subtraction operation. Variables should be given as an associative list of key value pairs. The key should be a string as it would appear in the problem and the value will replace it in the actual calculation"]])
|
|
|