1 ;; Calculator for GNU Emacs, part II [calc-stuff.el]
2 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3 ;; Written by Dave Gillespie, daveg@synaptics.com.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is distributed in the hope that it will be useful,
8 ;; but WITHOUT ANY WARRANTY. No author or distributor
9 ;; accepts responsibility to anyone for the consequences of using it
10 ;; or for whether it serves any particular purpose or works at all,
11 ;; unless he says so in writing. Refer to the GNU Emacs General Public
12 ;; License for full details.
14 ;; Everyone is granted permission to copy, modify and redistribute
15 ;; GNU Emacs, but only under the conditions described in the
16 ;; GNU Emacs General Public License. A copy of this license is
17 ;; supposed to have been given to you along with GNU Emacs so you
18 ;; can know your rights and responsibilities. It should be in a
19 ;; file named COPYING. Among other things, the copyright notice
20 ;; and this notice must be preserved on all copies.
24 ;; This file is autoloaded from calc-ext.el.
29 (defun calc-Need-calc-stuff () nil
)
32 (defun calc-num-prefix (n)
33 "Use the number at the top of stack as the numeric prefix for the next command.
34 With a prefix, push that prefix as a number onto the stack."
38 (calc-enter-result 0 "" (prefix-numeric-value n
))
39 (let ((num (calc-top 1)))
40 (if (math-messy-integerp num
)
41 (setq num
(math-trunc num
)))
43 (error "Argument must be a small integer"))
46 (message "%d-" num
))))) ; a (lame) simulation of the real thing...
49 (defun calc-more-recursion-depth (n)
53 (calc-less-recursion-depth n
)
54 (let ((n (if n
(prefix-numeric-value n
) 2)))
56 (setq max-specpdl-size
(* max-specpdl-size n
)
57 max-lisp-eval-depth
(* max-lisp-eval-depth n
))))
58 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth
))))
60 (defun calc-less-recursion-depth (n)
62 (let ((n (if n
(prefix-numeric-value n
) 2)))
64 (setq max-specpdl-size
65 (max (/ max-specpdl-size n
) 600)
67 (max (/ max-lisp-eval-depth n
) 200))))
68 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth
))
71 (defun calc-explain-why (why &optional more
)
74 (let* ((pred (car why
))
76 (msg (cond ((not pred
) "Wrong type of argument")
78 ((eq pred
'integerp
) "Integer expected")
80 (if (and arg
(Math-objvecp arg
) (not (Math-integerp arg
)))
82 "Nonnegative integer expected"))
84 (if (and arg
(Math-objvecp arg
) (not (Math-integerp arg
)))
86 "Positive integer expected"))
88 (if (and arg
(Math-integerp arg
))
89 "Small integer expected"
91 ((eq pred
'fixnatnump
)
92 (if (and arg
(Math-natnump arg
))
93 "Small integer expected"
94 (if (and arg
(Math-objvecp arg
)
95 (not (Math-integerp arg
)))
97 "Nonnegative integer expected")))
98 ((eq pred
'fixposintp
)
99 (if (and arg
(Math-integerp arg
) (Math-posp arg
))
100 "Small integer expected"
101 (if (and arg
(Math-objvecp arg
)
102 (not (Math-integerp arg
)))
104 "Positive integer expected")))
105 ((eq pred
'posp
) "Positive number expected")
106 ((eq pred
'negp
) "Negative number expected")
107 ((eq pred
'nonzerop
) "Nonzero number expected")
108 ((eq pred
'realp
) "Real number expected")
109 ((eq pred
'anglep
) "Real number expected")
110 ((eq pred
'hmsp
) "HMS form expected")
112 (if (and arg
(Math-objectp arg
)
113 (not (Math-realp arg
)))
114 "Real number or date form expected"
115 "Date form expected"))
116 ((eq pred
'numberp
) "Number expected")
117 ((eq pred
'scalarp
) "Number expected")
118 ((eq pred
'vectorp
) "Vector or matrix expected")
119 ((eq pred
'numvecp
) "Number or vector expected")
120 ((eq pred
'matrixp
) "Matrix expected")
121 ((eq pred
'square-matrixp
)
122 (if (and arg
(math-matrixp arg
))
123 "Square matrix expected"
125 ((eq pred
'objectp
) "Number expected")
126 ((eq pred
'constp
) "Constant expected")
127 ((eq pred
'range
) "Argument out of range")
128 (t (format "%s expected" pred
))))
130 (calc-can-abbrev-vectors t
))
131 (while (setq why
(cdr why
))
133 (setq msg
(concat msg punc
(if (stringp (car why
))
135 (math-format-flat-expr (car why
) 0)))
137 (message "%s%s" msg
(if more
" [w=more]" ""))))
141 (if (not (eq this-command last-command
))
142 (if (eq last-command calc-last-why-command
)
143 (setq calc-which-why
(cdr calc-why
))
144 (setq calc-which-why calc-why
)))
147 (calc-explain-why (car calc-which-why
) (cdr calc-which-why
))
148 (setq calc-which-why
(cdr calc-which-why
)))
151 (message "(No further explanations available)")
152 (setq calc-which-why calc-why
))
153 (message "No explanations available"))))
154 (setq calc-which-why nil
)
155 (setq calc-last-why-command nil
)
158 (defun calc-version ()
160 (message "Calc %s, installed %s" calc-version calc-installed-date
))
163 (defun calc-flush-caches ()
166 (setq math-lud-cache nil
168 math-radix-digits-cache nil
169 math-radix-float-cache-tag nil
170 math-random-cache nil
171 math-max-digits-cache nil
172 math-checked-rewrites nil
173 math-integral-cache nil
175 math-decls-cache-tag nil
176 math-eval-rules-cache-tag t
177 math-graph-var-cache nil
178 math-graph-data-cache nil
179 math-format-date-cache nil
180 math-holidays-cache-tag t
)
181 (mapcar (function (lambda (x) (set x -
100))) math-cache-list
)
182 (message "All internal calculator caches have been reset.")))
187 (defun calc-clean (n)
190 (calc-with-default-simplification
191 (let ((func (if (calc-is-hyperbolic) 'calcFunc-clean
'calcFunc-pclean
)))
192 (calc-enter-result 1 "cln"
194 (let ((n (prefix-numeric-value n
)))
198 (+ n calc-internal-prec
)
200 (list func
(calc-top-n 1))))))))
202 (defun calc-clean-num (num)
204 (calc-clean (- (if num
205 (prefix-numeric-value num
)
206 (if (and (>= last-command-char ?
0)
207 (<= last-command-char ?
9))
208 (- last-command-char ?
0)
209 (error "Number required"))))))
212 (defun calcFunc-clean (a &optional prec
) ; [X X S] [Public]
214 (cond ((Math-messy-integerp prec
)
215 (calcFunc-clean a
(math-trunc prec
)))
216 ((or (not (integerp prec
))
218 (calc-record-why "*Precision must be an integer 3 or above")
219 (list 'calcFunc-clean a prec
))
220 ((not (Math-objvecp a
))
221 (list 'calcFunc-clean a prec
))
222 (t (let ((calc-internal-prec prec
)
223 (math-chopping-small t
))
224 (calcFunc-clean (math-normalize a
)))))
225 (cond ((eq (car-safe a
) 'polar
)
226 (let ((theta (math-mod (nth 2 a
)
227 (if (eq calc-angle-mode
'rad
)
234 (calcFunc-clean (nth 1 a
))
235 (calcFunc-clean theta
)))))))
236 ((memq (car-safe a
) '(vec date hms
))
237 (cons (car a
) (mapcar 'calcFunc-clean
(cdr a
))))
238 ((memq (car-safe a
) '(cplx mod sdev intv
))
239 (math-normalize (cons (car a
) (mapcar 'calcFunc-clean
(cdr a
)))))
240 ((eq (car-safe a
) 'float
)
241 (if math-chopping-small
242 (if (or (> (nth 2 a
) (- calc-internal-prec
))
243 (Math-lessp (- calc-internal-prec
) (calcFunc-xpon a
)))
244 (if (and (math-num-integerp a
)
245 (math-lessp (calcFunc-xpon a
) calc-internal-prec
))
251 ((math-infinitep a
) a
)
252 (t (list 'calcFunc-clean a
)))))
253 (setq math-chopping-small nil
)
255 (defun calcFunc-pclean (a &optional prec
)
256 (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec
)))
259 (defun calcFunc-pfloat (a)
260 (math-map-over-constants 'math-float a
))
262 (defun calcFunc-pfrac (a &optional tol
)
263 (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol
)))
266 (defun math-map-over-constants (func expr
)
267 (math-map-over-constants-rec expr
))
269 (defun math-map-over-constants-rec (expr)
270 (cond ((or (Math-primp expr
)
271 (memq (car expr
) '(intv sdev
)))
272 (or (and (Math-objectp expr
)
275 ((and (memq (car expr
) '(^ calcFunc-subscr
))
276 (eq func
'math-float
)
278 (Math-integerp (nth 2 expr
)))
280 (math-map-over-constants-rec (nth 1 expr
))
282 (t (cons (car expr
) (mapcar 'math-map-over-constants-rec
(cdr expr
))))))
284 ;;; calc-stuff.el ends here