;;; calcalg2.el --- more algebraic functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainer: Jay Belanger <belanger@truman.edu>
+;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
;; This file is part of GNU Emacs.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(prefix-numeric-value nterms))))))
-;; The following are global variables used by math-derivative and some
+;; The following are global variables used by math-derivative and some
;; related functions
(defvar math-deriv-var)
(defvar math-deriv-total)
(list 'calcFunc-sec u)))))))
(put 'calcFunc-sec\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
+ (function (lambda (u) (math-to-radians-2
(math-mul
(math-normalize
(list 'calcFunc-sec u))
(list 'calcFunc-tan u)))))))
(put 'calcFunc-csc\' 'math-derivative-1
- (function (lambda (u) (math-neg
+ (function (lambda (u) (math-neg
(math-to-radians-2
(math-mul
(math-normalize
;; which are called (directly or indirectly) by math-try-integral.
(defvar math-integ-depth)
;; math-integ-level is a local variable for math-try-integral, but is used
-;; by math-integral, math-do-integral, math-tracing-integral,
-;; math-sub-integration, math-integrate-by-parts and
-;; math-integrate-by-substitution, which are called (directly or
+;; by math-integral, math-do-integral, math-tracing-integral,
+;; math-sub-integration, math-integrate-by-parts and
+;; math-integrate-by-substitution, which are called (directly or
;; indirectly) by math-try-integral.
(defvar math-integ-level)
;; math-integral-limit is a local variable for calcFunc-integ, but is
-;; used by math-tracing-integral, math-sub-integration and
-;; math-try-integration.
+;; used by math-tracing-integral, math-sub-integration and
+;; math-try-integration.
(defvar math-integral-limit)
(defmacro math-tracing-integral (&rest parts)
(setq math-integ-msg (format
"Working... Integrating %s"
(math-format-flat-expr expr 0)))
- (message math-integ-msg)))
+ (message "%s" math-integ-msg)))
(if math-cur-record
(setcar (cdr math-cur-record)
(if same-as-above (vector simp) 'busy))
"simplification...\n")
(setq val (math-integral simp 'no t))))))))
(if (eq calc-display-working-message 'lots)
- (message math-integ-msg)))
+ (message "%s" math-integ-msg)))
(setcar (cdr math-cur-record) (or val
(if (or math-enable-subst
(not math-any-substs))
;; used by math-sub-integration.
(defvar math-old-integ)
-;; The variables math-t1, math-t2 and math-t3 are local to
+;; The variables math-t1, math-t2 and math-t3 are local to
;; math-do-integral, math-try-solve-for and math-decompose-poly, but
-;; are used by functions they call (directly or indirectly);
+;; are used by functions they call (directly or indirectly);
;; math-do-integral calls math-do-integral-methods;
-;; math-try-solve-for calls math-try-solve-prod,
+;; math-try-solve-for calls math-try-solve-prod,
;; math-solve-find-root-term and math-solve-find-root-in-prod;
;; math-decompose-poly calls math-solve-poly-funny-powers and
;; math-solve-crunch-poly.
(list 'calcFunc-integfailed expr)))
;; math-so-far is a local variable for math-do-integral-methods, but
-;; is used by math-integ-try-linear-substitutions and
+;; is used by math-integ-try-linear-substitutions and
;; math-integ-try-substitutions.
(defvar math-so-far)
;; math-integ-expr is a local variable for math-do-integral-methods,
-;; but is used by math-integ-try-linear-substitutions and
+;; but is used by math-integ-try-linear-substitutions and
;; math-integ-try-substitutions.
(defvar math-integ-expr)
(calcFunc-expand temp)
(setq v (list 'var 'PARTS math-cur-record)
temp (let (calc-next-why)
- (math-solve-for (math-sub v temp) 0 v nil)))
- (and temp (not (integerp temp))
- (math-simplify-extended temp)))))
+ (math-simplify-extended
+ (math-solve-for (math-sub v temp) 0 v nil)))
+ temp (if (and (eq (car-safe temp) '/)
+ (math-zerop (nth 2 temp)))
+ nil temp)))))
(setcar (cdr math-cur-record) 'busy)))))
;;; This tries two different formulations, hoping the algebraic simplifier
(math-defintegral calcFunc-sec
(and (equal u math-integ-var)
(math-from-radians-2
- (list 'calcFunc-ln
+ (list 'calcFunc-ln
(math-add
(list 'calcFunc-sec u)
(list 'calcFunc-tan u))))))
(math-defintegral calcFunc-csc
(and (equal u math-integ-var)
(math-from-radians-2
- (list 'calcFunc-ln
+ (list 'calcFunc-ln
(math-sub
(list 'calcFunc-csc u)
(list 'calcFunc-cot u))))))
(defvar math-tabulate-initial nil)
(defvar math-tabulate-function nil)
-;; The variables calc-low and calc-high are local to calcFunc-table,
-;; but are used by math-scan-for-limits.
+;; These variables are local to calcFunc-table, but are used by
+;; math-scan-for-limits.
(defvar calc-low)
(defvar calc-high)
+(defvar var)
(defun calcFunc-table (expr var &optional calc-low calc-high step)
- (or calc-low
+ (or calc-low
(setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf)))
(or calc-high (setq calc-high calc-low calc-low 1))
(and (or (math-infinitep calc-low) (math-infinitep calc-high))
n (1+ n)
t1 (cdr t1)))
(setq n (math-build-polynomial-expr poly high))
- (if (memq low '(0 1))
+ (if (= low 1)
n
(math-sub n (math-build-polynomial-expr poly
(math-sub low 1))))))
(defvar math-solve-ranges nil)
(defvar math-solve-sign)
-;;; Attempt to reduce math-solve-lhs = math-solve-rhs to
+;;; Attempt to reduce math-solve-lhs = math-solve-rhs to
;;; math-solve-var = math-solve-rhs', where math-solve-var appears
-;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs';
+;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs';
;;; return math-solve-rhs'.
;;; Uses global values: math-solve-var, math-solve-full.
(defvar math-solve-var)
(defvar math-solve-full)
-;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign
-;; are local to math-try-solve-for, but are used by math-try-solve-prod.
-;; (math-solve-lhs and math-solve-rhs are is also local to
+;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign
+;; are local to math-try-solve-for, but are used by math-try-solve-prod.
+;; (math-solve-lhs and math-solve-rhs are is also local to
;; math-decompose-poly, but used by math-solve-poly-funny-powers.)
(defvar math-solve-lhs)
(defvar math-solve-rhs)
(defvar math-try-solve-sign)
-(defun math-try-solve-for
+(defun math-try-solve-for
(math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly)
(let (math-t1 math-t2 math-t3)
(cond ((equal math-solve-lhs math-solve-var)
(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
+ (setq math-t1 (math-try-solve-for
(math-sub (nth 1 (nth 1 math-solve-lhs))
(math-expr-subst
math-t2 math-t3
(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
+ (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))
((= (length math-t1) 3)
(apply 'math-solve-quadratic (car math-t2) math-t1))
((= (length math-t1) 2)
- (apply 'math-solve-linear
+ (apply 'math-solve-linear
(car math-t2) math-try-solve-sign math-t1))
(math-solve-full
(math-poly-all-roots (car math-t2) math-t1))
((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
+ (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)
(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-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
(and math-try-solve-sign math-t1
(if (integerp math-t1)
(* math-t1 math-try-solve-sign)
- (funcall math-t1 math-solve-lhs
+ (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))
(cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs)
(math-div math-solve-rhs (nth 1 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 1 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-div math-solve-rhs (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs))))
((Math-zerop math-solve-rhs)
(math-solve-prod (let ((math-solve-ranges math-solve-ranges))
(cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs)
(math-div (nth 1 math-solve-lhs) math-solve-rhs)
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 1 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-mul math-solve-rhs (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs))))
((setq math-t1 (math-try-solve-for (math-sub (nth 1 math-solve-lhs)
(math-mul (nth 2 math-solve-lhs)
(math-normalize math-t2)))
((math-looks-negp (nth 2 math-solve-lhs))
(math-try-solve-for
- (list '^ (nth 1 math-solve-lhs)
+ (list '^ (nth 1 math-solve-lhs)
(math-neg (nth 2 math-solve-lhs)))
(math-div 1 math-solve-rhs)))
((and (eq math-solve-full t)
(Math-integerp (nth 2 math-solve-lhs))
(math-known-realp (nth 1 math-solve-lhs)))
(setq math-t1 (math-normalize
- (list 'calcFunc-nroot math-solve-rhs
+ (list 'calcFunc-nroot math-solve-rhs
(nth 2 math-solve-lhs))))
(if (math-evenp (nth 2 math-solve-lhs))
(setq math-t1 (math-solve-get-sign math-t1)))
(nth 1 math-solve-lhs) math-t1
(and math-try-solve-sign
(math-oddp (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs)))))
(t (math-try-solve-for
(nth 1 math-solve-lhs)
(nth 2 math-solve-lhs))))
(and math-try-solve-sign
(math-oddp (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs)))))))))
(t nil)))
(setq math-t2 (math-mul (or math-poly-mult-powers 1)
(let ((calc-prefer-frac t))
(math-div 1 math-poly-frac-powers)))
- math-t1 (math-is-polynomial
+ math-t1 (math-is-polynomial
(math-simplify (calcFunc-expand math-t1)) math-solve-b 50))))
;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2".
(setq math-t3 (cons scale (cdr math-t3))
math-t1 new-t1))))
(setq scale (1- scale)))
- (setq math-t3 (list (math-mul (car math-t3) math-t2)
+ (setq math-t3 (list (math-mul (car math-t3) math-t2)
(math-mul count math-t2)))
(<= (1- (length math-t1)) max-degree)))))
(and (not (equal math-solve-b math-solve-lhs))
(or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
(setq math-t3 '(1 0) math-t2 1
- math-t1 (math-is-polynomial math-solve-lhs
+ math-t1 (math-is-polynomial math-solve-lhs
math-solve-b 50))
(if (and (equal math-poly-neg-powers '(1))
(memq math-poly-mult-powers '(nil 1))
(and (not (math-expr-contains (nth 2 x) math-solve-var))
(math-solve-find-root-in-prod (nth 1 x))))))))
-;; The variable math-solve-vars is local to math-solve-system,
+;; The variable math-solve-vars is local to math-solve-system,
;; but is used by math-solve-system-rec.
(defvar math-solve-vars)
(while (and e2
(setq res2 (or (and (eq (car e2) eprev)
res2)
- (math-solve-for (car e2) 0
+ (math-solve-for (car e2) 0
math-solve-system-vv
math-solve-full))))
(setq eprev (car e2)
solns)))
(if elim
s
- (cons (cons
- math-solve-system-vv
+ (cons (cons
+ math-solve-system-vv
(apply 'append math-solve-system-res))
s)))))
(not math-solve-system-res))))
(lambda (r)
(if math-solve-simplifying
(math-simplify
- (math-expr-subst
+ (math-expr-subst
(car x) math-solve-system-vv r))
- (math-expr-subst
+ (math-expr-subst
(car x) math-solve-system-vv r))))
(car res2)))
x (cdr x)
(provide 'calcalg2)
-;;; arch-tag: f2932ec8-dd63-418b-a542-11a644b9d4c4
+;; arch-tag: f2932ec8-dd63-418b-a542-11a644b9d4c4
;;; calcalg2.el ends here
HCoop / bpt / emacs.git / blobdiff