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 |
|
|
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) |
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 "$")) |
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) |
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 |
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)) |
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) |
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))) |
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) |
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) |
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))) |
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-*. |
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) '*) |
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) |
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)) |
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) |