src/desoln.lisp

   1 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
   2
   3 (in-package :maxima)
   4
   5 (defmfun $desolve (eqns vars)
   6   (let (teqns tvars ovar (lvar ($gensym)) (flag nil) ($dispflag nil))
   7     (declare (special $dispflag))
   8     (unless ($listp vars)
   9       (setq eqns (list '(mlist) eqns))
  10       (setq vars (list '(mlist) vars))
  11       (setq flag t))
  12     (setq ovar (maref vars 1))
  13     (unless (= ($length ovar) 1)
  14       (merror (intl:gettext "desolve: more than one independent variable: ~M") ovar))
  15     (setq ovar (simplify ($inpart ovar 1)))
  16     (setq teqns
  17      (simplify (map1 (getopr (m-tlambda&env (($z) (ovar lvar))
  18                                             nil
  19                                             (simplify ($laplace $z ovar lvar))))
  20                      eqns)))
  21     (setq tvars
  22      (simplify (map1 (getopr (m-tlambda&env (($z) (ovar lvar))
  23                                             nil
  24                                             (simplify `((%laplace) ,$z ,ovar ,lvar))))
  25                      vars)))
  26     (setq teqns
  27           (let ((errcatch (cons bindlist loclist))
  28                 (ret (errset (simplify ($solve teqns tvars)) lisperrprint)))
  29             (when (null ret)
  30               (errlfun1 errcatch))
  31             (cons '(mlist) ret)))
  32     (when (or (like teqns '((mlist)))
  33               (like teqns (list '(mlist) '((mlist)))))
  34       ;; NOT CLEAR WHAT IS THE PROBLEM. SHOULD BE MORE EXPLICIT.
  35       (merror (intl:gettext "desolve: can't handle this case.")))
  36     (setq teqns (simplify ($first teqns)))
  37     (unless (like flag t)
  38       (setq teqns (simplify ($first teqns))))
  39     (setq teqns
  40      (simplify (map1 (getopr (m-tlambda&env (($z) (lvar ovar))
  41                                             nil
  42                                             (simplify ($ilt $z lvar ovar))))
  43                      teqns)))
  44     (if (and flag (= ($length tvars) 1))
  45         (maref teqns 1)
  46         teqns)))
  47
  48 (add2lnc '$desolve $props)