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

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

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

revision 1.2 by walters, Wed Nov 14 09:08:56 2001 UTC revision 1.3 by walters, Mon Nov 19 07:43:23 2001 UTC
# Line 1  Line 1 
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    
# 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 601  Line 606 
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)
# Line 626  Line 631 
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"
# Line 648  Line 653 
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))
# Line 677  Line 682 
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
# Line 758  Line 763 
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    
# Line 1145  Line 1151 
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))
# Line 1390  Line 1395 
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))))
# Line 1403  Line 1407 
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))
# Line 1708  Line 1713 
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)

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