[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

A question for DEFUN



Hello everybody,

I wrote a simple equation solver in LISP (see below). If a function
that uses the macro "equation" is defined before the file "eqsolver.lsp"
is loaded, everything seems all right. For example,


> (fmakunbound 'equation)
EQUATION
> (makunbound 'a)
A
> (makunbound 'b)
B
> (defun foo (a b) (equation a = b))
FOO
> (load "eqsolver.lsp")
;; Loading file EQSOLVER.LSP ...
;; Loading of file EQSOLVER.LSP is finished.
T
> (setq a nil b 5)
5
> (foo a b)
5 ;
A
> (foo nil b)
5 ;
A
> (equation a = b)
5 ;
A

However, when the function is defined after, then the result becomes as
follow:


> (load "eqsolver.lsp")
;; Loading file EQSOLVER.LSP ...
;; Loading of file EQSOLVER.LSP is finished.
T
> (makunbound 'a)
A
> (makunbound 'b)
B
> (defun foo (a b) (equation a = b))

*** - EVAL: variable B has no value     <--- Why does "defun" need to evaluate
1. Break>                                    the arguments of a function.

> (setq a nil b nil)
NIL
> (defun foo (a b) (equation a = b))
FOO             <--- O.K. But,
> (setq b 5)
5
> (foo a b)
NIL ;           <--- the output value is wrong.
A
> a
NIL
> b
5
> (equation a = b)
5 ;             <--- It's correct.
A

What's wrong with it? 
Thanks in advance.

Chun Yu Lee
e-mail: d791013@ce.ntu.edu.tw


=================File: EQSOLVER.LSP =============================

;;;
;;;  A Simple Equation Solver (SES)
;;;
;;; created: 18 April 1994
;;; updated: 29 April 1994
;;; author: Chun Yu Lee

  ; The following functions and macros serve to
  ; solve an equation that has less then one unknown and with three parts of
  ; expressions, the LHS, relationship, and RHS. No more than one unknown
  ; (variable) can be appeared in the LHS or RHS of the equation.
  ; A symbol name which is unbound or nil in the equation is an unknown.
  ; The operators or predicates used in expressions must be complyed with
  ; those specified in the exchanging rules depicted in global variable
  ; *X-operators*. However, any valid LISP forms other than specified in
  ; *X-operators* can be used in the expression which is on the opposite
  ; side to the one the unknown is stayed.
  ;
  ; The macro "symbol-equation" returns three values: the solved expression
  ; in symbolic form, the unknown variable, and the operater. But there is
  ; only one value will be returned, when the unknown cannot be found, to be
  ; true (T) or false (NIL) according to the evaluation of the equation.
  ;
  ; The macro "equation" returns two values: the evaluated result of solved
  ; equation and the unknown found. While the macro "nequation" is a
  ; destructive version of "equation" and returns only the evaluated result.
  ; The side effect of "nequation" is that the unbound (or nilled) variable
  ; will be bound to the result.
  ;
  ; SES can solve equations like followings:
  ;
  ;         a * b = c + 4  -- (1),
  ; or      b*x^2 + c = d  -- (2).
  ;
  ; Eqn. (1) can be called as:
  ;
  ;
  ; > (setq a 3 b 4)
  ; 4
  ; > (symbol-equation (* a b) = (+ c 4))
  ; (- (* A B) 4) ;
  ; C ;
  ; =
  ; > (equation (* a b) = (+ c 4))
  ; 8 ;
  ; C
  ; > (boundp 'c)
  ; NIL
  ; > (nequation (* a b) = (+ c 4))
  ; 8
  ; > c
  ; 8
  ;
  ; In the similar way, eqn. (2) can be called as:
  ;
  ; > (setq x nil b 3 c 4 d 5)
  ; 5
  ; > (symbol-equation (+ (* b (expt x 2)) c) = d)
  ; (EXPT (/ (- D C) B) (/ 1 2)) ;
  ; X ;
  ; =
  ; >
  ;

;;; Begining of the equation solver.
(defvar *X-operators*
  '((+ . -) (* . /) (expt . expt) (exp . log)
    (sin . asin) (cos . acos) (tan . atan)
    (sinh . asinh) (cosh . acosh) (tanh . atanh)
) )

(defmacro equation (&body eqn)
  (multiple-value-bind (value var) (eval (cons 'symbol-equation eqn))
    `(values ,(eval value) ',var)
) )

(defmacro nequation (&body eqn)  ;destructive version
  (multiple-value-bind (value var) (eval (cons 'symbol-equation eqn))
    (if var `(setq ,var ,(eval value)) value)
) )

(defmacro symbol-equation (lhs op rhs)
    (let* ((args (explode-list (list lhs rhs)))
           (var
            (nth
             (or (position-if-not
                  #'(lambda (x)
                      (or (numberp x) (boundp x) (fboundp x)))
                  args)
                 (position nil
                   (mapcar
                     #'(lambda (x)
                         (if (or (numberp x) (fboundp x)) x (eval x)))
                    args)
                 )
                 (return-from symbol-equation `(,op ,lhs ,rhs))
             )
           args)))
     `(values ',(solve-linear-eqn lhs rhs var) ',var ',op)
) )

(defun solve-linear-eqn (lhs rhs var)
  (if (or (and (atom rhs) (equal rhs var))
          (and (consp rhs) (member var (explode-list rhs))))
    (solve-linear-eqn-r rhs lhs var)
    (solve-linear-eqn-r lhs rhs var)
) )

(defun solve-linear-eqn-r (lhs rhs var)
  (if (atom lhs) (if (equal lhs var) rhs nil)
    (let ((op (pop lhs)) (result nil) lhs1)
      (push (or (cdr (assoc op *X-operators*))
                (car (rassoc op *X-operators*))) result)
      (push rhs result)
      (if (equal op 'expt) (setf (cadr lhs) `(/ 1 ,(cadr lhs))))
      (dolist (ivar lhs)
        (if (or (and (atom ivar) (equal ivar var))
                (and (consp ivar) (member var (explode-list ivar))))
            (setq lhs1 ivar)
            (push ivar result))
      )
      (solve-linear-eqn-r lhs1 (reverse result) var)
) ) )

(defun explode-list (lst)
  (if (null lst) nil
    (if (atom lst) (list lst)
      (append (explode-list (car lst)) (explode-list (cdr lst)))
) ) )

;;; End of equation solver.