VPF::Помогите создать функцию "Calculate"

donserj

Дата 23.3.2011, 23:58 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 24.2.2011
Где: Moldova,Floresti

Репутация: нет
Всего: нет

Пример: >(Calculate '((2 + 4) * 3)
Результат= 18

k0rvin

Дата 24.3.2011, 19:14 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 442
Регистрация: 24.1.2010

Репутация: нет
Всего: 5

ты бы хоть написал, на каком диалекте.
на CL влоб:

Код


(defparameter *operators* (make-hash-table :test #'eq))

(defun set-operator (symbol priority function)
  (setf (gethash symbol *operators*)
        (cons priority function)))

(defun get-operator-priority (symbol)
  (multiple-value-bind (op foundp) (gethash symbol *operators*)
    (when foundp (car op))))

(defun get-operator-function (symbol)
  (multiple-value-bind (op foundp) (gethash symbol *operators*)
    (when foundp (cdr op))))

(defun operator-p (symbol &optional (errorp nil))
  (multiple-value-bind (op foundp) (gethash symbol *operators*)
    (declare (ignore op))
    (if (eq errorp t)
        (or foundp (error "Unknown operator ~a" symbol))
      foundp)))



(defun eval-infix (expr)
  (do ((expr expr))
      ((atom expr) expr)
    (destructuring-bind (left &rest rest) expr
      (if (null rest)
          (setf expr left)
        (destructuring-bind (op &rest rest) rest
          (operator-p op t)
          (if (null rest)
              (error "No right operand in (~s ~s)" left op)
            (destructuring-bind (right &rest rest) rest
              (if (null rest)
                  (setf expr
                        (funcall (get-operator-function op)
                                 (eval-infix left)
                                 (eval-infix right)))
                (destructuring-bind (rest-op &rest rest) rest
                  (operator-p rest-op t)
                  (let ((p1 (get-operator-priority op))
                        (p2 (get-operator-priority rest-op)))
                    (setf expr
                          (if (> p2 p1)
                              (list left op (eval-infix (list* right rest-op rest)))
                              (list* (funcall (get-operator-function op)
                                              (eval-infix left)
                                              (eval-infix right))
                                     rest-op
                                     rest)))))))))))))

(set-operator '+ 0 #'+)
(set-operator '- 0 #'-)
(set-operator '* 2 #'*)
(set-operator '/ 2 #'/)
(set-operator '^ 4 #'expt)

(defun calculate (expr)
  (eval-infix expr))

примеры использования:

Код


CL-USER 6 > (calculate '((1 + 2) * 3))
9

CL-USER 7 > (calculate '(1 + 2 * 3))
7

CL-USER 8 > (calculate '(1 + 2 * 3 ^ 4))
163

CL-USER 9 > (calculate '(1 * 2 / 3))
2/3

CL-USER 10 >

--------------------

“Object-oriented design is the roman numerals of computing.” — Rob Pike
All software sucks

_sg

Дата 25.4.2014, 15:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 119
Регистрация: 16.5.2007

Репутация: 2
Всего: 2

как вариант:

Код


(defun prefix (w)
  (if (atom w) w `(,(cadr w) ,(prefix (car w)) ,(prefix (caddr w)))))

(defun calculate (w)
  (eval (prefix w)))

> (calculate '((2 + 4) * 3))
18

--------------------

vk.com/ansicommonlisp

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| LISP \| Следующая тема »