(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))))))
2010年11月5日金曜日
deriv
file:comm.lisp
登録:
コメントの投稿 (Atom)
0 件のコメント:
コメントを投稿