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 ;; Maintainer: Colin Walters <walters@debian.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
29 ;; This file is autoloaded from calc-ext.el.
34 (defun calc-Need-calc-frac () nil
)
36 (defun calc-fdiv (arg)
39 (calc-binary-op ":" 'calcFunc-fdiv arg
1)))
42 (defun calc-fraction (arg)
45 (let ((func (if (calc-is-hyperbolic) 'calcFunc-frac
'calcFunc-pfrac
)))
47 (calc-enter-result 2 "frac" (list func
50 (calc-enter-result 1 "frac" (list func
52 (prefix-numeric-value (or arg
0))))))))
55 (defun calc-over-notation (fmt)
58 (completing-read "Fraction separator: " (mapcar (lambda (s)
60 '(":" "::" "/" "//" ":/"))
63 (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt
)
65 (if (/= (match-end 0) (match-end 1))
66 (setq n
(string-to-int (substring fmt
(match-end 1)))
67 fmt
(math-match-substring fmt
1)))
68 (if (eq n
0) (error "Bad denominator"))
69 (calc-change-mode 'calc-frac-format
(list fmt n
) t
))
70 (error "Bad fraction separator format"))))
72 (defun calc-slash-notation (n)
75 (calc-change-mode 'calc-frac-format
(if n
'("//" nil
) '("/" nil
)) t
)))
78 (defun calc-frac-mode (n)
81 (calc-change-mode 'calc-prefer-frac n nil t
)
82 (message (if calc-prefer-frac
83 "Integer division will now generate fractions"
84 "Integer division will now generate floating-point results"))))
89 ;;; Build a normalized fraction. [R I I]
90 ;;; (This could probably be implemented more efficiently than using
91 ;;; the plain gcd algorithm.)
92 (defun math-make-frac (num den
)
93 (if (Math-integer-negp den
)
94 (setq num
(math-neg num
)
96 (let ((gcd (math-gcd num den
)))
100 (list 'frac num den
))
102 (math-quotient num gcd
)
103 (list 'frac
(math-quotient num gcd
) (math-quotient den gcd
))))))
105 (defun calc-add-fractions (a b
)
106 (if (eq (car-safe a
) 'frac
)
107 (if (eq (car-safe b
) 'frac
)
108 (math-make-frac (math-add (math-mul (nth 1 a
) (nth 2 b
))
109 (math-mul (nth 2 a
) (nth 1 b
)))
110 (math-mul (nth 2 a
) (nth 2 b
)))
111 (math-make-frac (math-add (nth 1 a
)
112 (math-mul (nth 2 a
) b
))
114 (math-make-frac (math-add (math-mul a
(nth 2 b
))
118 (defun calc-mul-fractions (a b
)
119 (if (eq (car-safe a
) 'frac
)
120 (if (eq (car-safe b
) 'frac
)
121 (math-make-frac (math-mul (nth 1 a
) (nth 1 b
))
122 (math-mul (nth 2 a
) (nth 2 b
)))
123 (math-make-frac (math-mul (nth 1 a
) b
)
125 (math-make-frac (math-mul a
(nth 1 b
))
128 (defun calc-div-fractions (a b
)
129 (if (eq (car-safe a
) 'frac
)
130 (if (eq (car-safe b
) 'frac
)
131 (math-make-frac (math-mul (nth 1 a
) (nth 2 b
))
132 (math-mul (nth 2 a
) (nth 1 b
)))
133 (math-make-frac (nth 1 a
)
134 (math-mul (nth 2 a
) b
)))
135 (math-make-frac (math-mul a
(nth 2 b
))
139 ;;; Convert a real value to fractional form. [T R I; T R F] [Public]
140 (defun calcFunc-frac (a &optional tol
)
141 (or tol
(setq tol
0))
144 ((memq (car a
) '(cplx polar vec hms date sdev intv mod
))
145 (cons (car a
) (mapcar (function
147 (calcFunc-frac x tol
)))
149 ((Math-messy-integerp a
)
152 (math-neg (calcFunc-frac (math-neg a
) tol
)))
153 ((not (eq (car a
) 'float
))
154 (if (math-infinitep a
)
156 (if (math-provably-integerp a
)
158 (math-reject-arg a
'numberp
))))
161 (setq tol
(+ tol calc-internal-prec
)))
162 (calcFunc-frac a
(list 'float
5
163 (- (+ (math-numdigs (nth 1 a
))
166 ((not (eq (car tol
) 'float
))
168 (calcFunc-frac a
(math-float tol
))
169 (math-reject-arg tol
'realp
)))
171 (calcFunc-frac a
(math-neg tol
)))
174 ((not (math-lessp-float tol
'(float 1 0)))
179 (let ((cfrac (math-continued-fraction a tol
))
180 (calc-prefer-frac t
))
181 (math-eval-continued-fraction cfrac
)))))
183 (defun math-continued-fraction (a tol
)
184 (let ((calc-internal-prec (+ calc-internal-prec
2)))
187 (calc-prefer-frac nil
)
189 (while (or (null cfrac
)
190 (and (not (Math-zerop aa
))
191 (not (math-lessp-float
194 (let ((f (math-eval-continued-fraction
196 (math-working "Fractionalize" f
)
199 (setq int
(math-trunc aa
)
201 cfrac
(cons int cfrac
))
203 (setq aa
(math-div 1 aa
))))
206 (defun math-eval-continued-fraction (cf)
210 (while (setq cf
(cdr cf
))
211 (setq temp
(math-add (math-mul (car cf
) n
) d
)
218 (defun calcFunc-fdiv (a b
) ; [R I I] [Public]
219 (if (Math-num-integerp a
)
220 (if (Math-num-integerp b
)
222 (math-reject-arg a
"*Division by zero")
223 (math-make-frac (math-trunc a
) (math-trunc b
)))
224 (math-reject-arg b
'integerp
))
225 (math-reject-arg a
'integerp
)))
227 ;;; calc-frac.el ends here