/[emacs]/emacs/lisp/calc/calcalg2.el
ViewVC logotype

Diff of /emacs/lisp/calc/calcalg2.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by walters, Wed Nov 14 09:08:48 2001 UTC revision 1.3 by walters, Mon Nov 19 07:43:15 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-alg-2.el]  ;;; calcalg2.el --- more algebraic functions for Calc
2    
3  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
4  ;; Written by Dave Gillespie, daveg@synaptics.com.  
5    ;; Author: David Gillespie <daveg@synaptics.com>
6    ;; Maintainer: Colin Walters <walters@debian.org>
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
9    
# Line 19  Line 22 
22  ;; file named COPYING.  Among other things, the copyright notice  ;; file named COPYING.  Among other things, the copyright notice
23  ;; and this notice must be preserved on all copies.  ;; and this notice must be preserved on all copies.
24    
25    ;;; Commentary:
26    
27    ;;; Code:
28    
29  ;; This file is autoloaded from calc-ext.el.  ;; This file is autoloaded from calc-ext.el.
30  (require 'calc-ext)  (require 'calc-ext)
# Line 32  Line 37 
37  (defun calc-derivative (var num)  (defun calc-derivative (var num)
38    (interactive "sDifferentiate with respect to: \np")    (interactive "sDifferentiate with respect to: \np")
39    (calc-slow-wrapper    (calc-slow-wrapper
40     (and (< num 0) (error "Order of derivative must be positive"))     (when (< num 0)
41         (error "Order of derivative must be positive"))
42     (let ((func (if (calc-is-hyperbolic) 'calcFunc-tderiv 'calcFunc-deriv))     (let ((func (if (calc-is-hyperbolic) 'calcFunc-tderiv 'calcFunc-deriv))
43           n expr)           n expr)
44       (if (or (equal var "") (equal var "$"))       (if (or (equal var "") (equal var "$"))
# Line 40  Line 46 
46                 expr (calc-top-n 2)                 expr (calc-top-n 2)
47                 var (calc-top-n 1))                 var (calc-top-n 1))
48         (setq var (math-read-expr var))         (setq var (math-read-expr var))
49         (if (eq (car-safe var) 'error)         (when (eq (car-safe var) 'error)
50             (error "Bad format in expression: %s" (nth 1 var)))           (error "Bad format in expression: %s" (nth 1 var)))
51         (setq n 1         (setq n 1
52               expr (calc-top-n 1)))               expr (calc-top-n 1)))
53       (while (>= (setq num (1- num)) 0)       (while (>= (setq num (1- num)) 0)
# Line 592  Line 598 
598                     (math-derivative (nth 2 expr)))))))                     (math-derivative (nth 2 expr)))))))
599    
600    
601    (defvar math-integ-var '(var X ---))
602    (defvar math-integ-var-2 '(var Y ---))
603    (defvar math-integ-vars (list 'f math-integ-var math-integ-var-2))
604  (setq math-integ-var '(var X ---))  (defvar math-integ-var-list (list math-integ-var))
605  (setq math-integ-var-2 '(var Y ---))  (defvar math-integ-var-list-list (list math-integ-var-list))
 (setq math-integ-vars (list 'f math-integ-var math-integ-var-2))  
 (setq math-integ-var-list (list math-integ-var))  
 (setq math-integ-var-list-list (list math-integ-var-list))  
606    
607  (defmacro math-tracing-integral (&rest parts)  (defmacro math-tracing-integral (&rest parts)
608    (list 'and    (list 'and
# Line 1704  Line 1707 
1707    
1708    
1709    
1710    (defvar math-tabulate-initial nil)
1711    (defvar math-tabulate-function nil)
1712  (defun calcFunc-table (expr var &optional low high step)  (defun calcFunc-table (expr var &optional low high step)
1713    (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))    (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
1714    (or high (setq high low low 1))    (or high (setq high low low 1))
# Line 1761  Line 1766 
1766                     (list low high))                     (list low high))
1767                (and step (list step))))))                (and step (list step))))))
1768    
 (setq math-tabulate-initial nil)  
 (setq math-tabulate-function nil)  
   
1769  (defun math-scan-for-limits (x)  (defun math-scan-for-limits (x)
1770    (cond ((Math-primp x))    (cond ((Math-primp x))
1771          ((and (eq (car x) 'calcFunc-subscr)          ((and (eq (car x) 'calcFunc-subscr)
# Line 1785  Line 1787 
1787             (math-scan-for-limits (car x))))))             (math-scan-for-limits (car x))))))
1788    
1789    
1790    (defvar math-disable-sums nil)
1791  (defun calcFunc-sum (expr var &optional low high step)  (defun calcFunc-sum (expr var &optional low high step)
1792    (if math-disable-sums (math-reject-arg))    (if math-disable-sums (math-reject-arg))
1793    (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))    (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
1794                  (math-sum-rec expr var low high step)))                  (math-sum-rec expr var low high step)))
1795           (math-disable-sums t))           (math-disable-sums t))
1796      (math-normalize res)))      (math-normalize res)))
 (setq math-disable-sums nil)  
1797    
1798  (defun math-sum-rec (expr var &optional low high step)  (defun math-sum-rec (expr var &optional low high step)
1799    (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))    (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
# Line 1941  Line 1943 
1943                     (setq temp (list '* (car not-const) temp)))                     (setq temp (list '* (car not-const) temp)))
1944                   temp)))))                   temp)))))
1945    
1946    (defvar math-sum-int-pow-cache (list '(0 1)))
1947  ;; Following is from CRC Math Tables, 27th ed, pp. 52-53.  ;; Following is from CRC Math Tables, 27th ed, pp. 52-53.
1948  (defun math-sum-integer-power (pow)  (defun math-sum-integer-power (pow)
1949    (let ((calc-prefer-frac t)    (let ((calc-prefer-frac t)
# Line 1963  Line 1966 
1966                (nconc math-sum-int-pow-cache (list (nreverse new)))                (nconc math-sum-int-pow-cache (list (nreverse new)))
1967                n (1+ n))))                n (1+ n))))
1968      (nth pow math-sum-int-pow-cache)))      (nth pow math-sum-int-pow-cache)))
 (setq math-sum-int-pow-cache (list '(0 1)))  
1969    
1970  (defun math-to-exponentials (expr)  (defun math-to-exponentials (expr)
1971    (and (consp expr)    (and (consp expr)
# Line 2013  Line 2015 
2015           (cons (car expr) (mapcar 'math-to-exps (cdr expr))))))           (cons (car expr) (mapcar 'math-to-exps (cdr expr))))))
2016    
2017    
2018    (defvar math-disable-prods nil)
2019  (defun calcFunc-prod (expr var &optional low high step)  (defun calcFunc-prod (expr var &optional low high step)
2020    (if math-disable-prods (math-reject-arg))    (if math-disable-prods (math-reject-arg))
2021    (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))    (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
2022                  (math-prod-rec expr var low high step)))                  (math-prod-rec expr var low high step)))
2023           (math-disable-prods t))           (math-disable-prods t))
2024      (math-normalize res)))      (math-normalize res)))
 (setq math-disable-prods nil)  
2025    
2026  (defun math-prod-rec (expr var &optional low high step)  (defun math-prod-rec (expr var &optional low high step)
2027    (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))    (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
# Line 2165  Line 2167 
2167    
2168    
2169    
2170    (defvar math-solve-ranges nil)
2171  ;;; Attempt to reduce lhs = rhs to solve-var = rhs', where solve-var appears  ;;; Attempt to reduce lhs = rhs to solve-var = rhs', where solve-var appears
2172  ;;; in lhs but not in rhs or rhs'; return rhs'.  ;;; in lhs but not in rhs or rhs'; return rhs'.
2173  ;;; Uses global values: solve-*.  ;;; Uses global values: solve-*.
# Line 2311  Line 2314 
2314             (calc-record-why "*No inverse known" lhs)             (calc-record-why "*No inverse known" lhs)
2315             nil))))             nil))))
2316    
 (setq math-solve-ranges nil)  
2317    
2318  (defun math-try-solve-prod ()  (defun math-try-solve-prod ()
2319    (cond ((eq (car lhs) '*)    (cond ((eq (car lhs) '*)
# Line 2656  Line 2658 
2658                  (math-div a 4))))                  (math-div a 4))))
2659     nil t))     nil t))
2660    
2661    (defvar math-symbolic-solve nil)
2662    (defvar math-int-coefs nil)
2663  (defun math-poly-all-roots (var p &optional math-factoring)  (defun math-poly-all-roots (var p &optional math-factoring)
2664    (catch 'ouch    (catch 'ouch
2665      (let* ((math-symbolic-solve calc-symbolic-mode)      (let* ((math-symbolic-solve calc-symbolic-mode)
# Line 2750  Line 2754 
2754                      vec                      vec
2755                      (math-solve-get-int 1 (1- (length orig-p)) 1))                      (math-solve-get-int 1 (1- (length orig-p)) 1))
2756              vec))))))              vec))))))
 (setq math-symbolic-solve nil)  
2757    
2758  (defun math-lcm-denoms (&rest fracs)  (defun math-lcm-denoms (&rest fracs)
2759    (let ((den 1))    (let ((den 1))
# Line 2870  Line 2873 
2873                                  (math-mul (math-sqrt (math-sub (math-sqr aa)                                  (math-mul (math-sqrt (math-sub (math-sqr aa)
2874                                                                 rnd0))                                                                 rnd0))
2875                                            (if (math-negp xim) -1 1)))))))))))                                            (if (math-negp xim) -1 1)))))))))))
 (setq math-int-coefs nil)  
2876    
2877  ;;; The following routine is from Numerical Recipes, section 9.5.  ;;; The following routine is from Numerical Recipes, section 9.5.
2878  (defun math-poly-laguerre-root (p x polish)  (defun math-poly-laguerre-root (p x polish)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26