(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 件のコメント:
コメントを投稿