1 |
;; Calculator for GNU Emacs, part II [calc-frac.el] |
;; Calculator for GNU Emacs, part II [calc-frac.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
32 |
(defun calc-fdiv (arg) |
(defun calc-fdiv (arg) |
33 |
(interactive "P") |
(interactive "P") |
34 |
(calc-slow-wrapper |
(calc-slow-wrapper |
35 |
(calc-binary-op ":" 'calcFunc-fdiv arg 1)) |
(calc-binary-op ":" 'calcFunc-fdiv arg 1))) |
|
) |
|
36 |
|
|
37 |
|
|
38 |
(defun calc-fraction (arg) |
(defun calc-fraction (arg) |
45 |
(calc-top-n 1))) |
(calc-top-n 1))) |
46 |
(calc-enter-result 1 "frac" (list func |
(calc-enter-result 1 "frac" (list func |
47 |
(calc-top-n 1) |
(calc-top-n 1) |
48 |
(prefix-numeric-value (or arg 0))))))) |
(prefix-numeric-value (or arg 0)))))))) |
|
) |
|
49 |
|
|
50 |
|
|
51 |
(defun calc-over-notation (fmt) |
(defun calc-over-notation (fmt) |
58 |
fmt (math-match-substring fmt 1))) |
fmt (math-match-substring fmt 1))) |
59 |
(if (eq n 0) (error "Bad denominator")) |
(if (eq n 0) (error "Bad denominator")) |
60 |
(calc-change-mode 'calc-frac-format (list fmt n) t)) |
(calc-change-mode 'calc-frac-format (list fmt n) t)) |
61 |
(error "Bad fraction separator format."))) |
(error "Bad fraction separator format.")))) |
|
) |
|
62 |
|
|
63 |
(defun calc-slash-notation (n) |
(defun calc-slash-notation (n) |
64 |
(interactive "P") |
(interactive "P") |
65 |
(calc-wrapper |
(calc-wrapper |
66 |
(calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t)) |
(calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t))) |
|
) |
|
67 |
|
|
68 |
|
|
69 |
(defun calc-frac-mode (n) |
(defun calc-frac-mode (n) |
72 |
(calc-change-mode 'calc-prefer-frac n nil t) |
(calc-change-mode 'calc-prefer-frac n nil t) |
73 |
(message (if calc-prefer-frac |
(message (if calc-prefer-frac |
74 |
"Integer division will now generate fractions." |
"Integer division will now generate fractions." |
75 |
"Integer division will now generate floating-point results."))) |
"Integer division will now generate floating-point results.")))) |
|
) |
|
76 |
|
|
77 |
|
|
78 |
|
|
94 |
(list 'frac num den)) |
(list 'frac num den)) |
95 |
(if (equal gcd den) |
(if (equal gcd den) |
96 |
(math-quotient num gcd) |
(math-quotient num gcd) |
97 |
(list 'frac (math-quotient num gcd) (math-quotient den gcd))))) |
(list 'frac (math-quotient num gcd) (math-quotient den gcd)))))) |
|
) |
|
98 |
|
|
99 |
(defun calc-add-fractions (a b) |
(defun calc-add-fractions (a b) |
100 |
(if (eq (car-safe a) 'frac) |
(if (eq (car-safe a) 'frac) |
107 |
(nth 2 a))) |
(nth 2 a))) |
108 |
(math-make-frac (math-add (math-mul a (nth 2 b)) |
(math-make-frac (math-add (math-mul a (nth 2 b)) |
109 |
(nth 1 b)) |
(nth 1 b)) |
110 |
(nth 2 b))) |
(nth 2 b)))) |
|
) |
|
111 |
|
|
112 |
(defun calc-mul-fractions (a b) |
(defun calc-mul-fractions (a b) |
113 |
(if (eq (car-safe a) 'frac) |
(if (eq (car-safe a) 'frac) |
117 |
(math-make-frac (math-mul (nth 1 a) b) |
(math-make-frac (math-mul (nth 1 a) b) |
118 |
(nth 2 a))) |
(nth 2 a))) |
119 |
(math-make-frac (math-mul a (nth 1 b)) |
(math-make-frac (math-mul a (nth 1 b)) |
120 |
(nth 2 b))) |
(nth 2 b)))) |
|
) |
|
121 |
|
|
122 |
(defun calc-div-fractions (a b) |
(defun calc-div-fractions (a b) |
123 |
(if (eq (car-safe a) 'frac) |
(if (eq (car-safe a) 'frac) |
127 |
(math-make-frac (nth 1 a) |
(math-make-frac (nth 1 a) |
128 |
(math-mul (nth 2 a) b))) |
(math-mul (nth 2 a) b))) |
129 |
(math-make-frac (math-mul a (nth 2 b)) |
(math-make-frac (math-mul a (nth 2 b)) |
130 |
(nth 1 b))) |
(nth 1 b)))) |
|
) |
|
131 |
|
|
132 |
|
|
133 |
|
|
174 |
(t |
(t |
175 |
(let ((cfrac (math-continued-fraction a tol)) |
(let ((cfrac (math-continued-fraction a tol)) |
176 |
(calc-prefer-frac t)) |
(calc-prefer-frac t)) |
177 |
(math-eval-continued-fraction cfrac)))) |
(math-eval-continued-fraction cfrac))))) |
|
) |
|
178 |
|
|
179 |
(defun math-continued-fraction (a tol) |
(defun math-continued-fraction (a tol) |
180 |
(let ((calc-internal-prec (+ calc-internal-prec 2))) |
(let ((calc-internal-prec (+ calc-internal-prec 2))) |
197 |
cfrac (cons int cfrac)) |
cfrac (cons int cfrac)) |
198 |
(or (Math-zerop aa) |
(or (Math-zerop aa) |
199 |
(setq aa (math-div 1 aa)))) |
(setq aa (math-div 1 aa)))) |
200 |
cfrac)) |
cfrac))) |
|
) |
|
201 |
|
|
202 |
(defun math-eval-continued-fraction (cf) |
(defun math-eval-continued-fraction (cf) |
203 |
(let ((n (car cf)) |
(let ((n (car cf)) |
207 |
(setq temp (math-add (math-mul (car cf) n) d) |
(setq temp (math-add (math-mul (car cf) n) d) |
208 |
d n |
d n |
209 |
n temp)) |
n temp)) |
210 |
(math-div n d)) |
(math-div n d))) |
|
) |
|
211 |
|
|
212 |
|
|
213 |
|
|
218 |
(math-reject-arg a "*Division by zero") |
(math-reject-arg a "*Division by zero") |
219 |
(math-make-frac (math-trunc a) (math-trunc b))) |
(math-make-frac (math-trunc a) (math-trunc b))) |
220 |
(math-reject-arg b 'integerp)) |
(math-reject-arg b 'integerp)) |
221 |
(math-reject-arg a 'integerp)) |
(math-reject-arg a 'integerp))) |
|
) |
|
222 |
|
|
223 |
|
;;; calc-frac.el ends here |