src/elim.lisp

   1 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
   2
   3 (in-package :maxima)
   4
   5 (defmfun $eliminate (eqns vars)
   6   (let ((sv nil)
   7         (l ($length eqns))
   8         (flag nil)
   9         ($dispflag nil))
  10     (declare (special $dispflag))
  11     (unless (and ($listp eqns) ($listp vars))
  12       (merror (intl:gettext "eliminate: arguments must both be lists.")))
  13     (when (> ($length vars) l)
  14       (merror (intl:gettext "eliminate: more variables than equations.")))
  15     (when (= l 1)
  16       (merror (intl:gettext "eliminate: can't eliminate from only one equation.")))
  17     (when (= ($length vars) l)
  18       (setq vars ($reverse vars))
  19       (setq sv (maref vars 1))
  20       (setq vars ($reverse (simplify ($rest vars))))
  21       (setq flag t))
  22     (setq eqns (simplify (map1 (getopr 'meqhk) eqns)))
  23     (dolist (v (cdr vars))
  24       (let ((teqns '((mlist))))
  25         (do ((j 1 (1+ j)))
  26             ((or (> j l) (not ($freeof v (simplify ($first eqns))))))
  27           (setq teqns ($cons (simplify ($first eqns)) teqns))
  28           (setq eqns (simplify ($rest eqns))))
  29         (cond ((like eqns '((mlist)))
  30                (setq eqns teqns))
  31               (t
  32                (setq teqns ($append teqns (simplify ($rest eqns))))
  33                (setq eqns (simplify ($first eqns)))
  34                (decf l)
  35                (let ((se '((mlist))))
  36                  (dotimes (j l)         ;maxima starts indices with 1, therefore the 1+
  37                    (setq se ($cons (simplify ($resultant eqns (maref teqns (1+ j)) v)) se)))
  38                  (setq eqns se))))))
  39     (if flag
  40         (list '(mlist) ($rhs (simplify (mfuncall '$ev (simplify ($last (simplify ($solve (maref eqns 1) sv)))) '$eval))))
  41         eqns)))