/[emacs]/emacs/lisp/calc/calc-math.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-math.el

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

revision 1.5.4.2 by miles, Tue Oct 14 23:35:48 2003 UTC revision 1.5.4.3 by miles, Wed Dec 8 23:36:21 2004 UTC
# Line 3  Line 3 
3  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
4    
5  ;; Author: David Gillespie <daveg@synaptics.com>  ;; Author: David Gillespie <daveg@synaptics.com>
6  ;; Maintainers: D. Goel <deego@gnufans.org>  ;; Maintainer: Jay Belanger <belanger@truman.edu>
 ;;              Colin Walters <walters@debian.org>  
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
9    
# Line 28  Line 27 
27  ;;; Code:  ;;; Code:
28    
29  ;; This file is autoloaded from calc-ext.el.  ;; This file is autoloaded from calc-ext.el.
 (require 'calc-ext)  
30    
31    (require 'calc-ext)
32  (require 'calc-macs)  (require 'calc-macs)
33    
 (defun calc-Need-calc-math () nil)  
   
   
34  (defun calc-sqrt (arg)  (defun calc-sqrt (arg)
35    (interactive "P")    (interactive "P")
36    (calc-slow-wrapper    (calc-slow-wrapper
# Line 574  Line 570 
570             (and root (list 'polar root (math-div (nth 2 a) n)))))             (and root (list 'polar root (math-div (nth 2 a) n)))))
571          (t nil)))          (t nil)))
572    
573  (defun math-nth-root-float (a n &optional guess)  ;; The variables math-nrf-n, math-nrf-nf and math-nrf-nfm1 are local
574    ;; to math-nth-root-float, but are used by math-nth-root-float-iter,
575    ;; which is called by math-nth-root-float.
576    (defvar math-nrf-n)
577    (defvar math-nrf-nf)
578    (defvar math-nrf-nfm1)
579    
580    (defun math-nth-root-float (a math-nrf-n &optional guess)
581    (math-inexact-result)    (math-inexact-result)
582    (math-with-extra-prec 1    (math-with-extra-prec 1
583      (let ((nf (math-float n))      (let ((math-nrf-nf (math-float math-nrf-n))
584            (nfm1 (math-float (1- n))))            (math-nrf-nfm1 (math-float (1- math-nrf-n))))
585        (math-nth-root-float-iter a (or guess        (math-nth-root-float-iter a (or guess
586                                        (math-make-float                                        (math-make-float
587                                         1 (/ (+ (math-numdigs (nth 1 a))                                         1 (/ (+ (math-numdigs (nth 1 a))
588                                                 (nth 2 a)                                                 (nth 2 a)
589                                                 (/ n 2))                                                 (/ math-nrf-n 2))
590                                              n)))))))                                              math-nrf-n)))))))
591    
592  (defun math-nth-root-float-iter (a guess)   ; uses "n", "nf", "nfm1"  (defun math-nth-root-float-iter (a guess)
593    (math-working "root" guess)    (math-working "root" guess)
594    (let ((g2 (math-div-float (math-add-float (math-mul nfm1 guess)    (let ((g2 (math-div-float (math-add-float (math-mul math-nrf-nfm1 guess)
595                                              (math-div-float                                              (math-div-float
596                                               a (math-ipow guess (1- n))))                                               a (math-ipow guess (1- math-nrf-n))))
597                              nf)))                              math-nrf-nf)))
598      (if (math-nearly-equal-float g2 guess)      (if (math-nearly-equal-float g2 guess)
599          g2          g2
600        (math-nth-root-float-iter a g2))))        (math-nth-root-float-iter a g2))))
601    
602  (defun math-nth-root-integer (a n &optional guess)   ; [I I S]  ;; The variable math-nri-n is local to math-nth-root-integer, but
603    ;; is used by math-nth-root-int-iter, which is called by
604    ;; math-nth-root-int.
605    (defvar math-nri-n)
606    
607    (defun math-nth-root-integer (a math-nri-n &optional guess)   ; [I I S]
608    (math-nth-root-int-iter a (or guess    (math-nth-root-int-iter a (or guess
609                                  (math-scale-int 1 (/ (+ (math-numdigs a)                                  (math-scale-int 1 (/ (+ (math-numdigs a)
610                                                          (1- n))                                                          (1- math-nri-n))
611                                                       n)))))                                                       math-nri-n)))))
612    
613  (defun math-nth-root-int-iter (a guess)   ; uses "n"  (defun math-nth-root-int-iter (a guess)
614    (math-working "root" guess)    (math-working "root" guess)
615    (let* ((q (math-idivmod a (math-ipow guess (1- n))))    (let* ((q (math-idivmod a (math-ipow guess (1- math-nri-n))))
616           (s (math-add (car q) (math-mul (1- n) guess)))           (s (math-add (car q) (math-mul (1- math-nri-n) guess)))
617           (g2 (math-idivmod s n)))           (g2 (math-idivmod s math-nri-n)))
618      (if (Math-natnum-lessp (car g2) guess)      (if (Math-natnum-lessp (car g2) guess)
619          (math-nth-root-int-iter a (car g2))          (math-nth-root-int-iter a (car g2))
620        (cons (and (equal (car g2) guess)        (cons (and (equal (car g2) guess)
# Line 1247  Line 1255 
1255               (math-div (calcFunc-ln x) 0)               (math-div (calcFunc-ln x) 0)
1256             (math-reject-arg b "*Logarithm base one")))             (math-reject-arg b "*Logarithm base one")))
1257          ((math-equal-int x 1)          ((math-equal-int x 1)
1258           (if (or (math-floatp a) (math-floatp b)) '(float 0 0) 0))           (if (math-floatp b) '(float 0 0) 0))
1259          ((and (Math-ratp x) (Math-ratp b)          ((and (Math-ratp x) (Math-ratp b)
1260                (math-posp x) (math-posp b)                (math-posp x) (math-posp b)
1261                (let* ((sign 1) (inv nil)                (let* ((sign 1) (inv nil)
# Line 1676  Line 1684 
1684          (t (list 'calcFunc-deg a))))          (t (list 'calcFunc-deg a))))
1685  (put 'calcFunc-deg 'math-expandable t)  (put 'calcFunc-deg 'math-expandable t)
1686    
1687    (provide 'calc-math)
1688    
1689  ;;; arch-tag: c7367e8e-d0b8-4f70-8577-2fb3f31dbb4c  ;;; arch-tag: c7367e8e-d0b8-4f70-8577-2fb3f31dbb4c
1690  ;;; calc-math.el ends here  ;;; calc-math.el ends here

Legend:
Removed from v.1.5.4.2  
changed lines
  Added in v.1.5.4.3

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