/[emacs]/emacs/lisp/calc/calc-frac.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-frac.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:04:13 2001 UTC
# Line 1  Line 1 
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.
# Line 32  Line 32 
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)
# Line 46  Line 45 
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)
# Line 60  Line 58 
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)
# Line 76  Line 72 
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    
# Line 99  Line 94 
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)
# Line 113  Line 107 
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)
# Line 124  Line 117 
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)
# Line 135  Line 127 
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    
# Line 183  Line 174 
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)))
# Line 207  Line 197 
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))
# Line 218  Line 207 
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    
# Line 230  Line 218 
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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26