2010年11月5日金曜日

deriv

file:comm.lisp
(defun deriv (e) ;; e <- (((MEXPT SIMP) $X 2) $X 1)
  (prog (exp z count) 
           (cond ((null e) (wna-err '$diff))
    ((null (cdr e)) (return (stotaldiff (car e))))
    ((null (cddr e)) (nconc e '(1))))
     (setq exp (car e) z (setq e (copy-list e)))
     loop (if (or (null derivlist) (member (cadr z) derivlist :test #'equal)) (go doit))
     ; DERIVLIST is set by $EV
     (setq z (cdr z))
     loop2(cond ((cdr z) (go loop))
  ((null (cdr e)) (return exp))
  (t (go noun)))
     doit (cond ((nonvarcheck (cadr z) '$diff))
  ((null (cddr z)) (wna-err '$diff)) ;;(cddr z) <- (1)
  ((not (eq (ml-typep (caddr z)) 'fixnum)) (go noun)) ;;(caddr z) <- 1
  ((minusp (setq count (caddr z))) ;; count <- 1
   (merror (intl:gettext "diff: order of derivative must be a nonnegative integer; found ~M") count)))
     ;;z <-((MEXPT SIMP) $X 2)
     loop1 (cond ((zerop count) (rplacd z (cdddr z)) (go loop2))
           ;;(sdiff ((MEXPT SIMP) $X 2) $X)
           ((equal (setq exp (sdiff exp (cadr z))) 0) (return 0))))
     (setq count (1- count))
     (go loop1)
     noun (return (diff%deriv (cons exp (cdr e))))))

0 件のコメント:

コメントを投稿