1 ;;; calc-frac.el --- fraction functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainers: D. Goel <deego@gnufans.org>
7 ;; Colin Walters <walters@debian.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY. No author or distributor
13 ;; accepts responsibility to anyone for the consequences of using it
14 ;; or for whether it serves any particular purpose or works at all,
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public
16 ;; License for full details.
18 ;; Everyone is granted permission to copy, modify and redistribute
19 ;; GNU Emacs, but only under the conditions described in the
20 ;; GNU Emacs General Public License. A copy of this license is
21 ;; supposed to have been given to you along with GNU Emacs so you
22 ;; can know your rights and responsibilities. It should be in a
23 ;; file named COPYING. Among other things, the copyright notice
24 ;; and this notice must be preserved on all copies.
30 ;; This file is autoloaded from calc-ext.el.
35 (defun calc-Need-calc-frac () nil)
37 (defun calc-fdiv (arg)
40 (calc-binary-op ":" 'calcFunc-fdiv arg 1)))
43 (defun calc-fraction (arg)
46 (let ((func (if (calc-is-hyperbolic) 'calcFunc-frac 'calcFunc-pfrac)))
48 (calc-enter-result 2 "frac" (list func
51 (calc-enter-result 1 "frac" (list func
53 (prefix-numeric-value (or arg 0))))))))
56 (defun calc-over-notation (fmt)
57 (interactive "sFraction separator: ")
59 (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt)
61 (if (/= (match-end 0) (match-end 1))
62 (setq n (string-to-int (substring fmt (match-end 1)))
63 fmt (math-match-substring fmt 1)))
64 (if (eq n 0) (error "Bad denominator"))
65 (calc-change-mode 'calc-frac-format (list fmt n) t))
66 (error "Bad fraction separator format"))))
68 (defun calc-slash-notation (n)
71 (calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t)))
74 (defun calc-frac-mode (n)
77 (calc-change-mode 'calc-prefer-frac n nil t)
78 (message (if calc-prefer-frac
79 "Integer division will now generate fractions"
80 "Integer division will now generate floating-point results"))))
85 ;;; Build a normalized fraction. [R I I]
86 ;;; (This could probably be implemented more efficiently than using
87 ;;; the plain gcd algorithm.)
88 (defun math-make-frac (num den)
89 (if (Math-integer-negp den)
90 (setq num (math-neg num)
92 (let ((gcd (math-gcd num den)))
98 (math-quotient num gcd)
99 (list 'frac (math-quotient num gcd) (math-quotient den gcd))))))
101 (defun calc-add-fractions (a b)
102 (if (eq (car-safe a) 'frac)
103 (if (eq (car-safe b) 'frac)
104 (math-make-frac (math-add (math-mul (nth 1 a) (nth 2 b))
105 (math-mul (nth 2 a) (nth 1 b)))
106 (math-mul (nth 2 a) (nth 2 b)))
107 (math-make-frac (math-add (nth 1 a)
108 (math-mul (nth 2 a) b))
110 (math-make-frac (math-add (math-mul a (nth 2 b))
114 (defun calc-mul-fractions (a b)
115 (if (eq (car-safe a) 'frac)
116 (if (eq (car-safe b) 'frac)
117 (math-make-frac (math-mul (nth 1 a) (nth 1 b))
118 (math-mul (nth 2 a) (nth 2 b)))
119 (math-make-frac (math-mul (nth 1 a) b)
121 (math-make-frac (math-mul a (nth 1 b))
124 (defun calc-div-fractions (a b)
125 (if (eq (car-safe a) 'frac)
126 (if (eq (car-safe b) 'frac)
127 (math-make-frac (math-mul (nth 1 a) (nth 2 b))
128 (math-mul (nth 2 a) (nth 1 b)))
129 (math-make-frac (nth 1 a)
130 (math-mul (nth 2 a) b)))
131 (math-make-frac (math-mul a (nth 2 b))
135 ;;; Convert a real value to fractional form. [T R I; T R F] [Public]
136 (defun calcFunc-frac (a &optional tol)
137 (or tol (setq tol 0))
140 ((memq (car a) '(cplx polar vec hms date sdev intv mod))
141 (cons (car a) (mapcar (function
143 (calcFunc-frac x tol)))
145 ((Math-messy-integerp a)
148 (math-neg (calcFunc-frac (math-neg a) tol)))
149 ((not (eq (car a) 'float))
150 (if (math-infinitep a)
152 (if (math-provably-integerp a)
154 (math-reject-arg a 'numberp))))
157 (setq tol (+ tol calc-internal-prec)))
158 (calcFunc-frac a (list 'float 5
159 (- (+ (math-numdigs (nth 1 a))
162 ((not (eq (car tol) 'float))
164 (calcFunc-frac a (math-float tol))
165 (math-reject-arg tol 'realp)))
167 (calcFunc-frac a (math-neg tol)))
170 ((not (math-lessp-float tol '(float 1 0)))
175 (let ((cfrac (math-continued-fraction a tol))
176 (calc-prefer-frac t))
177 (math-eval-continued-fraction cfrac)))))
179 (defun math-continued-fraction (a tol)
180 (let ((calc-internal-prec (+ calc-internal-prec 2)))
183 (calc-prefer-frac nil)
185 (while (or (null cfrac)
186 (and (not (Math-zerop aa))
187 (not (math-lessp-float
190 (let ((f (math-eval-continued-fraction
192 (math-working "Fractionalize" f)
195 (setq int (math-trunc aa)
197 cfrac (cons int cfrac))
199 (setq aa (math-div 1 aa))))
202 (defun math-eval-continued-fraction (cf)
206 (while (setq cf (cdr cf))
207 (setq temp (math-add (math-mul (car cf) n) d)
214 (defun calcFunc-fdiv (a b) ; [R I I] [Public]
215 (if (Math-num-integerp a)
216 (if (Math-num-integerp b)
218 (math-reject-arg a "*Division by zero")
219 (math-make-frac (math-trunc a) (math-trunc b)))
220 (math-reject-arg b 'integerp))
221 (math-reject-arg a 'integerp)))
223 ;;; arch-tag: 89d65274-0b3b-42d8-aacd-eaf86da5b4ea
224 ;;; calc-frac.el ends here