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 |
|
|
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 |
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) |
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) |
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 |