1 ;;; calc-frac.el --- fraction functions for Calc
3 ;; Copyright (C) 1990-1993, 2001-2016 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; This file is autoloaded from calc-ext.el.
31 (defun calc-fdiv (arg)
34 (calc-binary-op ":" 'calcFunc-fdiv arg
1)))
37 (defun calc-fraction (arg)
40 (let ((func (if (calc-is-hyperbolic) 'calcFunc-frac
'calcFunc-pfrac
)))
42 (calc-enter-result 2 "frac" (list func
45 (calc-enter-result 1 "frac" (list func
47 (prefix-numeric-value (or arg
0))))))))
50 (defun calc-over-notation (fmt)
51 (interactive "sFraction separator: ")
53 (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt
)
55 (if (/= (match-end 0) (match-end 1))
56 (setq n
(string-to-number (substring fmt
(match-end 1)))
57 fmt
(math-match-substring fmt
1)))
58 (if (eq n
0) (error "Bad denominator"))
59 (calc-change-mode 'calc-frac-format
(list fmt n
) t
))
60 (error "Bad fraction separator format"))))
62 (defun calc-slash-notation (n)
65 (calc-change-mode 'calc-frac-format
(if n
'("//" nil
) '("/" nil
)) t
)))
68 (defun calc-frac-mode (n)
71 (calc-change-mode 'calc-prefer-frac n nil t
)
72 (message (if calc-prefer-frac
73 "Integer division will now generate fractions"
74 "Integer division will now generate floating-point results"))))
79 ;;; Build a normalized fraction. [R I I]
80 ;;; (This could probably be implemented more efficiently than using
81 ;;; the plain gcd algorithm.)
82 (defun math-make-frac (num den
)
83 (if (Math-integer-negp den
)
84 (setq num
(math-neg num
)
86 (let ((gcd (math-gcd num den
)))
92 (math-quotient num gcd
)
93 (list 'frac
(math-quotient num gcd
) (math-quotient den gcd
))))))
95 (defun calc-add-fractions (a b
)
96 (if (eq (car-safe a
) 'frac
)
97 (if (eq (car-safe b
) 'frac
)
98 (math-make-frac (math-add (math-mul (nth 1 a
) (nth 2 b
))
99 (math-mul (nth 2 a
) (nth 1 b
)))
100 (math-mul (nth 2 a
) (nth 2 b
)))
101 (math-make-frac (math-add (nth 1 a
)
102 (math-mul (nth 2 a
) b
))
104 (math-make-frac (math-add (math-mul a
(nth 2 b
))
108 (defun calc-mul-fractions (a b
)
109 (if (eq (car-safe a
) 'frac
)
110 (if (eq (car-safe b
) 'frac
)
111 (math-make-frac (math-mul (nth 1 a
) (nth 1 b
))
112 (math-mul (nth 2 a
) (nth 2 b
)))
113 (math-make-frac (math-mul (nth 1 a
) b
)
115 (math-make-frac (math-mul a
(nth 1 b
))
118 (defun calc-div-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 2 b
))
122 (math-mul (nth 2 a
) (nth 1 b
)))
123 (math-make-frac (nth 1 a
)
124 (math-mul (nth 2 a
) b
)))
125 (math-make-frac (math-mul a
(nth 2 b
))
129 ;;; Convert a real value to fractional form. [T R I; T R F] [Public]
130 (defun calcFunc-frac (a &optional tol
)
131 (or tol
(setq tol
0))
134 ((memq (car a
) '(cplx polar vec hms date sdev intv mod
))
135 (cons (car a
) (mapcar (function
137 (calcFunc-frac x tol
)))
139 ((Math-messy-integerp a
)
142 (math-neg (calcFunc-frac (math-neg a
) tol
)))
143 ((not (eq (car a
) 'float
))
144 (if (math-infinitep a
)
146 (if (math-provably-integerp a
)
148 (math-reject-arg a
'numberp
))))
151 (setq tol
(+ tol calc-internal-prec
)))
152 (calcFunc-frac a
(list 'float
5
153 (- (+ (math-numdigs (nth 1 a
))
156 ((not (eq (car tol
) 'float
))
158 (calcFunc-frac a
(math-float tol
))
159 (math-reject-arg tol
'realp
)))
161 (calcFunc-frac a
(math-neg tol
)))
164 ((not (math-lessp-float tol
'(float 1 0)))
169 (let ((cfrac (math-continued-fraction a tol
))
170 (calc-prefer-frac t
))
171 (math-eval-continued-fraction cfrac
)))))
173 (defun math-continued-fraction (a tol
)
174 (let ((calc-internal-prec (+ calc-internal-prec
2)))
177 (calc-prefer-frac nil
)
179 (while (or (null cfrac
)
180 (and (not (Math-zerop aa
))
181 (not (math-lessp-float
184 (let ((f (math-eval-continued-fraction
186 (math-working "Fractionalize" f
)
189 (setq int
(math-trunc aa
)
191 cfrac
(cons int cfrac
))
193 (setq aa
(math-div 1 aa
))))
196 (defun math-eval-continued-fraction (cf)
200 (while (setq cf
(cdr cf
))
201 (setq temp
(math-add (math-mul (car cf
) n
) d
)
206 (defun calcFunc-fdiv (a b
) ; [R I I] [Public]
208 ((Math-num-integerp a
)
210 ((Math-num-integerp b
)
212 (math-reject-arg a
"*Division by zero")
213 (math-make-frac (math-trunc a
) (math-trunc b
))))
214 ((eq (car-safe b
) 'frac
)
215 (if (Math-zerop (nth 1 b
))
216 (math-reject-arg a
"*Division by zero")
217 (math-make-frac (math-mul (math-trunc a
) (nth 2 b
)) (nth 1 b
))))
218 (t (math-reject-arg b
'integerp
))))
219 ((eq (car-safe a
) 'frac
)
221 ((Math-num-integerp b
)
223 (math-reject-arg a
"*Division by zero")
224 (math-make-frac (cadr a
) (math-mul (nth 2 a
) (math-trunc b
)))))
225 ((eq (car-safe b
) 'frac
)
226 (if (Math-zerop (nth 1 b
))
227 (math-reject-arg a
"*Division by zero")
228 (math-make-frac (math-mul (nth 1 a
) (nth 2 b
)) (math-mul (nth 2 a
) (nth 1 b
)))))
229 (t (math-reject-arg b
'integerp
))))
231 (math-reject-arg a
'integerp
))))
235 ;;; calc-frac.el ends here