1;;; calc-frac.el --- fraction functions for Calc
2
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: David Gillespie <daveg@synaptics.com>
7;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;;; Code:
29
30;; This file is autoloaded from calc-ext.el.
31
32(require 'calc-ext)
33(require 'calc-macs)
34
35(defun calc-fdiv (arg)
36  (interactive "P")
37  (calc-slow-wrapper
38   (calc-binary-op ":" 'calcFunc-fdiv arg 1)))
39
40
41(defun calc-fraction (arg)
42  (interactive "P")
43  (calc-slow-wrapper
44   (let ((func (if (calc-is-hyperbolic) 'calcFunc-frac 'calcFunc-pfrac)))
45     (if (eq arg 0)
46	 (calc-enter-result 2 "frac" (list func
47					   (calc-top-n 2)
48					   (calc-top-n 1)))
49       (calc-enter-result 1 "frac" (list func
50					 (calc-top-n 1)
51					 (prefix-numeric-value (or arg 0))))))))
52
53
54(defun calc-over-notation (fmt)
55  (interactive "sFraction separator: ")
56  (calc-wrapper
57   (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt)
58       (let ((n nil))
59	 (if (/= (match-end 0) (match-end 1))
60	     (setq n (string-to-number (substring fmt (match-end 1)))
61		   fmt (math-match-substring fmt 1)))
62	 (if (eq n 0) (error "Bad denominator"))
63	 (calc-change-mode 'calc-frac-format (list fmt n) t))
64     (error "Bad fraction separator format"))))
65
66(defun calc-slash-notation (n)
67  (interactive "P")
68  (calc-wrapper
69   (calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t)))
70
71
72(defun calc-frac-mode (n)
73  (interactive "P")
74  (calc-wrapper
75   (calc-change-mode 'calc-prefer-frac n nil t)
76   (message (if calc-prefer-frac
77		"Integer division will now generate fractions"
78	      "Integer division will now generate floating-point results"))))
79
80
81;;;; Fractions.
82
83;;; Build a normalized fraction.  [R I I]
84;;; (This could probably be implemented more efficiently than using
85;;;  the plain gcd algorithm.)
86(defun math-make-frac (num den)
87  (if (Math-integer-negp den)
88      (setq num (math-neg num)
89	    den (math-neg den)))
90  (let ((gcd (math-gcd num den)))
91    (if (eq gcd 1)
92	(if (eq den 1)
93	    num
94	  (list 'frac num den))
95      (if (equal gcd den)
96	  (math-quotient num gcd)
97	(list 'frac (math-quotient num gcd) (math-quotient den gcd))))))
98
99(defun calc-add-fractions (a b)
100  (if (eq (car-safe a) 'frac)
101      (if (eq (car-safe b) 'frac)
102	  (math-make-frac (math-add (math-mul (nth 1 a) (nth 2 b))
103				    (math-mul (nth 2 a) (nth 1 b)))
104			  (math-mul (nth 2 a) (nth 2 b)))
105	(math-make-frac (math-add (nth 1 a)
106				  (math-mul (nth 2 a) b))
107			(nth 2 a)))
108    (math-make-frac (math-add (math-mul a (nth 2 b))
109			      (nth 1 b))
110		    (nth 2 b))))
111
112(defun calc-mul-fractions (a b)
113  (if (eq (car-safe a) 'frac)
114      (if (eq (car-safe b) 'frac)
115	  (math-make-frac (math-mul (nth 1 a) (nth 1 b))
116			  (math-mul (nth 2 a) (nth 2 b)))
117	(math-make-frac (math-mul (nth 1 a) b)
118			(nth 2 a)))
119    (math-make-frac (math-mul a (nth 1 b))
120		    (nth 2 b))))
121
122(defun calc-div-fractions (a b)
123  (if (eq (car-safe a) 'frac)
124      (if (eq (car-safe b) 'frac)
125	  (math-make-frac (math-mul (nth 1 a) (nth 2 b))
126			  (math-mul (nth 2 a) (nth 1 b)))
127	(math-make-frac (nth 1 a)
128			(math-mul (nth 2 a) b)))
129    (math-make-frac (math-mul a (nth 2 b))
130		    (nth 1 b))))
131
132
133;;; Convert a real value to fractional form.  [T R I; T R F] [Public]
134(defun calcFunc-frac (a &optional tol)
135  (or tol (setq tol 0))
136  (cond ((Math-ratp a)
137	 a)
138	((memq (car a) '(cplx polar vec hms date sdev intv mod))
139	 (cons (car a) (mapcar (function
140				(lambda (x)
141				  (calcFunc-frac x tol)))
142			       (cdr a))))
143	((Math-messy-integerp a)
144	 (math-trunc a))
145	((Math-negp a)
146	 (math-neg (calcFunc-frac (math-neg a) tol)))
147	((not (eq (car a) 'float))
148	 (if (math-infinitep a)
149	     a
150	   (if (math-provably-integerp a)
151	       a
152	     (math-reject-arg a 'numberp))))
153	((integerp tol)
154	 (if (<= tol 0)
155	     (setq tol (+ tol calc-internal-prec)))
156	 (calcFunc-frac a (list 'float 5
157				(- (+ (math-numdigs (nth 1 a))
158				      (nth 2 a))
159				   (1+ tol)))))
160	((not (eq (car tol) 'float))
161	 (if (Math-realp tol)
162	     (calcFunc-frac a (math-float tol))
163	   (math-reject-arg tol 'realp)))
164	((Math-negp tol)
165	 (calcFunc-frac a (math-neg tol)))
166	((Math-zerop tol)
167	 (calcFunc-frac a 0))
168	((not (math-lessp-float tol '(float 1 0)))
169	 (math-trunc a))
170	((Math-zerop a)
171	 0)
172	(t
173	 (let ((cfrac (math-continued-fraction a tol))
174	       (calc-prefer-frac t))
175	   (math-eval-continued-fraction cfrac)))))
176
177(defun math-continued-fraction (a tol)
178  (let ((calc-internal-prec (+ calc-internal-prec 2)))
179    (let ((cfrac nil)
180	  (aa a)
181	  (calc-prefer-frac nil)
182	  int)
183      (while (or (null cfrac)
184		 (and (not (Math-zerop aa))
185		      (not (math-lessp-float
186			    (math-abs
187			     (math-sub a
188				       (let ((f (math-eval-continued-fraction
189						 cfrac)))
190					 (math-working "Fractionalize" f)
191					 f)))
192			    tol))))
193	(setq int (math-trunc aa)
194	      aa (math-sub aa int)
195	      cfrac (cons int cfrac))
196	(or (Math-zerop aa)
197	    (setq aa (math-div 1 aa))))
198      cfrac)))
199
200(defun math-eval-continued-fraction (cf)
201  (let ((n (car cf))
202	(d 1)
203	temp)
204    (while (setq cf (cdr cf))
205      (setq temp (math-add (math-mul (car cf) n) d)
206	    d n
207	    n temp))
208    (math-div n d)))
209
210
211
212(defun calcFunc-fdiv (a b)   ; [R I I] [Public]
213  (if (Math-num-integerp a)
214      (if (Math-num-integerp b)
215	  (if (Math-zerop b)
216	      (math-reject-arg a "*Division by zero")
217	    (math-make-frac (math-trunc a) (math-trunc b)))
218	(math-reject-arg b 'integerp))
219    (math-reject-arg a 'integerp)))
220
221(provide 'calc-frac)
222
223;;; arch-tag: 89d65274-0b3b-42d8-aacd-eaf86da5b4ea
224;;; calc-frac.el ends here
225