Function: math-try-solve-for
math-try-solve-for is a byte-compiled function defined in
calcalg2.el.gz.
Signature
(math-try-solve-for SOLVE-LHS SOLVE-RHS &optional TRY-SOLVE-SIGN NO-POLY)
Source Code
;; Defined in /usr/src/emacs/lisp/calc/calcalg2.el.gz
(defun math-try-solve-for
(solve-lhs solve-rhs &optional try-solve-sign no-poly)
(let ((math-solve-lhs solve-lhs)
(math-solve-rhs solve-rhs)
(math-try-solve-sign try-solve-sign)
math-t1 math-t2 math-t3)
(cond ((equal math-solve-lhs math-solve-var)
(setq math-solve-sign math-try-solve-sign)
(if (eq math-solve-full 'all)
(let ((vec (list 'vec (math-evaluate-expr math-solve-rhs)))
newvec var p)
(while math-solve-ranges
(setq p (car math-solve-ranges)
var (car p)
newvec (list 'vec))
(while (setq p (cdr p))
(setq newvec (nconc newvec
(cdr (math-expr-subst
vec var (car p))))))
(setq vec newvec
math-solve-ranges (cdr math-solve-ranges)))
(math-normalize vec))
math-solve-rhs))
((Math-primp math-solve-lhs)
nil)
((and (eq (car math-solve-lhs) '-)
(eq (car-safe (nth 1 math-solve-lhs)) (car-safe (nth 2 math-solve-lhs)))
(Math-zerop math-solve-rhs)
(= (length (nth 1 math-solve-lhs)) 2)
(= (length (nth 2 math-solve-lhs)) 2)
(setq math-t1 (get (car (nth 1 math-solve-lhs)) 'math-inverse))
(setq math-t2 (funcall math-t1 '(var SOLVEDUM SOLVEDUM)))
(eq (math-expr-contains-count math-t2 '(var SOLVEDUM SOLVEDUM)) 1)
(setq math-t3 (math-solve-above-dummy math-t2))
(setq math-t1 (math-try-solve-for
(math-sub (nth 1 (nth 1 math-solve-lhs))
(math-expr-subst
math-t2 math-t3
(nth 1 (nth 2 math-solve-lhs))))
0)))
math-t1)
((eq (car math-solve-lhs) 'neg)
(math-try-solve-for (nth 1 math-solve-lhs) (math-neg math-solve-rhs)
(and math-try-solve-sign (- math-try-solve-sign))))
((and (not (eq math-solve-full 't)) (math-try-solve-prod)))
((and (not no-poly)
(setq math-t2
(math-decompose-poly math-solve-lhs
math-solve-var 15 math-solve-rhs)))
(setq math-t1 (cdr (nth 1 math-t2))
math-t1 (let ((math-solve-ranges math-solve-ranges))
(cond ((= (length math-t1) 5)
(apply 'math-solve-quartic (car math-t2) math-t1))
((= (length math-t1) 4)
(apply 'math-solve-cubic (car math-t2) math-t1))
((= (length math-t1) 3)
(apply 'math-solve-quadratic (car math-t2) math-t1))
((= (length math-t1) 2)
(apply 'math-solve-linear
(car math-t2) math-try-solve-sign math-t1))
((= (length math-t1) 1)
;; Constant polynomial.
(if (eql (nth 2 math-t2) 1)
nil ; No possible solution.
;; Root of the factor, if any.
(math-try-solve-for (nth 2 math-t2) 0 nil t)))
(math-solve-full
(math-poly-all-roots (car math-t2) math-t1))
(calc-symbolic-mode nil)
(t
(math-try-solve-for
(car math-t2)
(math-poly-any-root (reverse math-t1) 0 t)
nil t)))))
(if math-t1
(if (eq (nth 2 math-t2) 1)
math-t1
(math-solve-prod math-t1 (math-try-solve-for (nth 2 math-t2) 0 nil t)))
(calc-record-why "*Unable to find a symbolic solution")
nil))
((and (math-solve-find-root-term math-solve-lhs nil)
(eq (math-expr-contains-count math-solve-lhs math-t1) 1)) ; just in case
(math-try-solve-for (math-simplify
(math-sub (if (or math-t3 (math-evenp math-t2))
(math-pow math-t1 math-t2)
(math-neg (math-pow math-t1 math-t2)))
(math-expand-power
(math-sub (math-normalize
(math-expr-subst
math-solve-lhs math-t1 0))
math-solve-rhs)
math-t2 math-solve-var)))
0))
((eq (car math-solve-lhs) '+)
(cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs)
(math-sub math-solve-rhs (nth 1 math-solve-lhs))
math-try-solve-sign))
((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 1 math-solve-lhs)
(math-sub math-solve-rhs (nth 2 math-solve-lhs))
math-try-solve-sign))))
((eq (car math-solve-lhs) 'calcFunc-eq)
(math-try-solve-for (math-sub (nth 1 math-solve-lhs) (nth 2 math-solve-lhs))
math-solve-rhs math-try-solve-sign no-poly))
((eq (car math-solve-lhs) '-)
(cond ((or (and (eq (car-safe (nth 1 math-solve-lhs)) 'calcFunc-sin)
(eq (car-safe (nth 2 math-solve-lhs)) 'calcFunc-cos))
(and (eq (car-safe (nth 1 math-solve-lhs)) 'calcFunc-cos)
(eq (car-safe (nth 2 math-solve-lhs)) 'calcFunc-sin)))
(math-try-solve-for (math-sub (nth 1 math-solve-lhs)
(list (car (nth 1 math-solve-lhs))
(math-sub
(math-quarter-circle t)
(nth 1 (nth 2 math-solve-lhs)))))
math-solve-rhs))
((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs)
(math-sub (nth 1 math-solve-lhs) math-solve-rhs)
(and math-try-solve-sign
(- math-try-solve-sign))))
((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 1 math-solve-lhs)
(math-add math-solve-rhs (nth 2 math-solve-lhs))
math-try-solve-sign))))
((and (eq math-solve-full 't) (math-try-solve-prod)))
((and (eq (car math-solve-lhs) '%)
(not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var)))
(math-try-solve-for (nth 1 math-solve-lhs) (math-add math-solve-rhs
(math-solve-get-int
(nth 2 math-solve-lhs)))))
((eq (car math-solve-lhs) 'calcFunc-log)
(cond ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 1 math-solve-lhs)
(math-pow (nth 2 math-solve-lhs) math-solve-rhs)))
((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs) (math-pow
(nth 1 math-solve-lhs)
(math-div 1 math-solve-rhs))))))
((and (= (length math-solve-lhs) 2)
(symbolp (car math-solve-lhs))
(setq math-t1 (get (car math-solve-lhs) 'math-inverse))
(setq math-t2 (funcall math-t1 math-solve-rhs)))
(setq math-t1 (get (car math-solve-lhs) 'math-inverse-sign))
(math-try-solve-for (nth 1 math-solve-lhs) (math-normalize math-t2)
(and math-try-solve-sign math-t1
(if (integerp math-t1)
(* math-t1 math-try-solve-sign)
(funcall math-t1 math-solve-lhs
math-try-solve-sign)))))
((and (symbolp (car math-solve-lhs))
(setq math-t1 (get (car math-solve-lhs) 'math-inverse-n))
(setq math-t2 (funcall math-t1 math-solve-lhs math-solve-rhs)))
math-t2)
((setq math-t1 (math-expand-formula math-solve-lhs))
(math-try-solve-for math-t1 math-solve-rhs math-try-solve-sign))
(t
(calc-record-why "*No inverse known" math-solve-lhs)
nil))))