1 |
;; Calculator for GNU Emacs, part II [calc-alg-3.el] |
;;; calcalg3.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) |
606 |
(set (nth 2 (aref math-root-vars m)) (car p))) |
(set (nth 2 (aref math-root-vars m)) (car p))) |
607 |
(setq expr-val (math-evaluate-expr expr) |
(setq expr-val (math-evaluate-expr expr) |
608 |
jacob-val (math-evaluate-expr jacob)) |
jacob-val (math-evaluate-expr jacob)) |
609 |
(or (and (math-constp expr-val) |
(unless (and (math-constp expr-val) |
610 |
(math-constp jacob-val)) |
(math-constp jacob-val)) |
611 |
(math-reject-arg guess "*Newton's method encountered a singularity")) |
(math-reject-arg guess "*Newton's method encountered a singularity")) |
612 |
(setq next (math-add guess (math-div (math-float (math-neg expr-val)) |
(setq next (math-add guess (math-div (math-float (math-neg expr-val)) |
613 |
(math-float jacob-val))) |
(math-float jacob-val))) |
614 |
p guess p2 next) |
p guess p2 next) |
631 |
(var-DUMMY nil) |
(var-DUMMY nil) |
632 |
(jacob (list 'vec)) |
(jacob (list 'vec)) |
633 |
p p2 m row) |
p p2 m row) |
634 |
(or (eq (car-safe var) 'vec) |
(unless (eq (car-safe var) 'vec) |
635 |
(math-reject-arg var 'vectorp)) |
(math-reject-arg var 'vectorp)) |
636 |
(or (= (length var) (1+ n)) |
(unless (= (length var) (1+ n)) |
637 |
(math-dimension-error)) |
(math-dimension-error)) |
638 |
(setq expr (copy-sequence expr)) |
(setq expr (copy-sequence expr)) |
639 |
(while (>= n (length math-root-vars)) |
(while (>= n (length math-root-vars)) |
640 |
(let ((symb (intern (concat "math-root-v" |
(let ((symb (intern (concat "math-root-v" |
653 |
(while (setq p2 (cdr p2)) |
(while (setq p2 (cdr p2)) |
654 |
(setcar p2 (math-expr-subst (car p2) (car p) |
(setcar p2 (math-expr-subst (car p2) (car p) |
655 |
(aref math-root-vars m))))) |
(aref math-root-vars m))))) |
656 |
(or (eq (car-safe guess) 'vec) |
(unless (eq (car-safe guess) 'vec) |
657 |
(math-reject-arg guess 'vectorp)) |
(math-reject-arg guess 'vectorp)) |
658 |
(or (= (length guess) (1+ n)) |
(unless (= (length guess) (1+ n)) |
659 |
(math-dimension-error)) |
(math-dimension-error)) |
660 |
(setq guess (copy-sequence guess) |
(setq guess (copy-sequence guess) |
661 |
p guess) |
p guess) |
662 |
(while (setq p (cdr p)) |
(while (setq p (cdr p)) |
682 |
(setq m (math-abs-approx guess)) |
(setq m (math-abs-approx guess)) |
683 |
(math-newton-multi expr jacob n guess guess |
(math-newton-multi expr jacob n guess guess |
684 |
(if (math-zerop m) '(float 1 3) (math-mul m 10)))) |
(if (math-zerop m) '(float 1 3) (math-mul m 10)))) |
685 |
(or (eq (car-safe var) 'var) |
(unless (eq (car-safe var) 'var) |
686 |
(math-reject-arg var "*Expected a variable")) |
(math-reject-arg var "*Expected a variable")) |
687 |
(or (math-expr-contains expr var) |
(unless (math-expr-contains expr var) |
688 |
(math-reject-arg expr "*Formula does not contain specified variable")) |
(math-reject-arg expr "*Formula does not contain specified variable")) |
689 |
(if (assq (car expr) calc-tweak-eqn-table) |
(if (assq (car expr) calc-tweak-eqn-table) |
690 |
(setq expr (math-sub (nth 1 expr) (nth 2 expr)))) |
(setq expr (math-sub (nth 1 expr) (nth 2 expr)))) |
691 |
(math-with-extra-prec 2 |
(math-with-extra-prec 2 |
763 |
a |
a |
764 |
(math-reject-arg a 'realp)))) |
(math-reject-arg a 'realp)))) |
765 |
|
|
766 |
|
(defvar math-min-or-max "minimum") |
767 |
|
|
768 |
;;; A bracket for a minimum is a < b < c where f(b) < f(a) and f(b) < f(c). |
;;; A bracket for a minimum is a < b < c where f(b) < f(a) and f(b) < f(c). |
769 |
|
|
1151 |
(if isvec |
(if isvec |
1152 |
(list 'vec vec (nth 2 res)) |
(list 'vec vec (nth 2 res)) |
1153 |
(list 'vec (nth 1 vec) (nth 2 res))))))) |
(list 'vec (nth 1 vec) (nth 2 res))))))) |
|
(setq math-min-or-max "minimum") |
|
1154 |
|
|
1155 |
(defun calcFunc-minimize (expr var guess) |
(defun calcFunc-minimize (expr var guess) |
1156 |
(let ((calc-internal-prec (max (/ calc-internal-prec 2) 3)) |
(let ((calc-internal-prec (max (/ calc-internal-prec 2) 3)) |
1395 |
|
|
1396 |
;;; The following algorithms come from Numerical Recipes, chapter 14. |
;;; The following algorithms come from Numerical Recipes, chapter 14. |
1397 |
|
|
1398 |
(setq math-dummy-vars [(var DUMMY var-DUMMY)]) |
(defvar math-dummy-vars [(var DUMMY var-DUMMY)]) |
1399 |
(setq math-dummy-counter 0) |
(defvar math-dummy-counter 0) |
|
|
|
1400 |
(defun math-dummy-variable () |
(defun math-dummy-variable () |
1401 |
(if (= math-dummy-counter (length math-dummy-vars)) |
(if (= math-dummy-counter (length math-dummy-vars)) |
1402 |
(let ((symb (intern (format "math-dummy-%d" math-dummy-counter)))) |
(let ((symb (intern (format "math-dummy-%d" math-dummy-counter)))) |
1407 |
(aref math-dummy-vars math-dummy-counter) |
(aref math-dummy-vars math-dummy-counter) |
1408 |
(setq math-dummy-counter (1+ math-dummy-counter)))) |
(setq math-dummy-counter (1+ math-dummy-counter)))) |
1409 |
|
|
1410 |
|
(defvar math-in-fit 0) |
1411 |
|
(defvar calc-fit-to-trail nil) |
1412 |
|
|
1413 |
(defun calcFunc-fit (expr vars &optional coefs data) |
(defun calcFunc-fit (expr vars &optional coefs data) |
1414 |
(let ((math-in-fit 10)) |
(let ((math-in-fit 10)) |
1713 |
'(var nan var-nan))) |
'(var nan var-nan))) |
1714 |
expr)))) |
expr)))) |
1715 |
|
|
|
(setq math-in-fit 0) |
|
|
(setq calc-fit-to-trail nil) |
|
1716 |
|
|
1717 |
(defun calcFunc-fitvar (x) |
(defun calcFunc-fitvar (x) |
1718 |
(if (>= math-in-fit 2) |
(if (>= math-in-fit 2) |