1 ;;; calc-stuff.el --- miscellaneous functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Colin Walters <walters@debian.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
29 ;; This file is autoloaded from calc-ext.el.
34 (defun calc-Need-calc-stuff () nil
)
37 (defun calc-num-prefix (n)
38 "Use the number at the top of stack as the numeric prefix for the next command.
39 With a prefix, push that prefix as a number onto the stack."
43 (calc-enter-result 0 "" (prefix-numeric-value n
))
44 (let ((num (calc-top 1)))
45 (if (math-messy-integerp num
)
46 (setq num
(math-trunc num
)))
48 (error "Argument must be a small integer"))
51 (message "%d-" num
))))) ; a (lame) simulation of the real thing...
54 (defun calc-more-recursion-depth (n)
58 (calc-less-recursion-depth n
)
59 (let ((n (if n
(prefix-numeric-value n
) 2)))
61 (setq max-specpdl-size
(* max-specpdl-size n
)
62 max-lisp-eval-depth
(* max-lisp-eval-depth n
))))
63 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth
))))
65 (defun calc-less-recursion-depth (n)
67 (let ((n (if n
(prefix-numeric-value n
) 2)))
69 (setq max-specpdl-size
70 (max (/ max-specpdl-size n
) 600)
72 (max (/ max-lisp-eval-depth n
) 200))))
73 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth
))
76 (defvar calc-which-why nil
)
77 (defvar calc-last-why-command nil
)
78 (defun calc-explain-why (why &optional more
)
81 (let* ((pred (car why
))
83 (msg (cond ((not pred
) "Wrong type of argument")
85 ((eq pred
'integerp
) "Integer expected")
87 (if (and arg
(Math-objvecp arg
) (not (Math-integerp arg
)))
89 "Nonnegative integer expected"))
91 (if (and arg
(Math-objvecp arg
) (not (Math-integerp arg
)))
93 "Positive integer expected"))
95 (if (and arg
(Math-integerp arg
))
96 "Small integer expected"
98 ((eq pred
'fixnatnump
)
99 (if (and arg
(Math-natnump arg
))
100 "Small integer expected"
101 (if (and arg
(Math-objvecp arg
)
102 (not (Math-integerp arg
)))
104 "Nonnegative integer expected")))
105 ((eq pred
'fixposintp
)
106 (if (and arg
(Math-integerp arg
) (Math-posp arg
))
107 "Small integer expected"
108 (if (and arg
(Math-objvecp arg
)
109 (not (Math-integerp arg
)))
111 "Positive integer expected")))
112 ((eq pred
'posp
) "Positive number expected")
113 ((eq pred
'negp
) "Negative number expected")
114 ((eq pred
'nonzerop
) "Nonzero number expected")
115 ((eq pred
'realp
) "Real number expected")
116 ((eq pred
'anglep
) "Real number expected")
117 ((eq pred
'hmsp
) "HMS form expected")
119 (if (and arg
(Math-objectp arg
)
120 (not (Math-realp arg
)))
121 "Real number or date form expected"
122 "Date form expected"))
123 ((eq pred
'numberp
) "Number expected")
124 ((eq pred
'scalarp
) "Number expected")
125 ((eq pred
'vectorp
) "Vector or matrix expected")
126 ((eq pred
'numvecp
) "Number or vector expected")
127 ((eq pred
'matrixp
) "Matrix expected")
128 ((eq pred
'square-matrixp
)
129 (if (and arg
(math-matrixp arg
))
130 "Square matrix expected"
132 ((eq pred
'objectp
) "Number expected")
133 ((eq pred
'constp
) "Constant expected")
134 ((eq pred
'range
) "Argument out of range")
135 (t (format "%s expected" pred
))))
137 (calc-can-abbrev-vectors t
))
138 (while (setq why
(cdr why
))
140 (setq msg
(concat msg punc
(if (stringp (car why
))
142 (math-format-flat-expr (car why
) 0)))
144 (message "%s%s" msg
(if more
" [w=more]" ""))))
148 (if (not (eq this-command last-command
))
149 (if (eq last-command calc-last-why-command
)
150 (setq calc-which-why
(cdr calc-why
))
151 (setq calc-which-why calc-why
)))
154 (calc-explain-why (car calc-which-why
) (cdr calc-which-why
))
155 (setq calc-which-why
(cdr calc-which-why
)))
158 (message "(No further explanations available)")
159 (setq calc-which-why calc-why
))
160 (message "No explanations available"))))
163 (defun calc-version ()
165 (message "Calc %s" calc-version
))
168 (defun calc-flush-caches ()
171 (setq math-lud-cache nil
173 math-radix-digits-cache nil
174 math-radix-float-cache-tag nil
175 math-random-cache nil
176 math-max-digits-cache nil
177 math-checked-rewrites nil
178 math-integral-cache nil
180 math-decls-cache-tag nil
181 math-eval-rules-cache-tag t
182 math-graph-var-cache nil
183 math-graph-data-cache nil
184 math-format-date-cache nil
185 math-holidays-cache-tag t
)
186 (mapcar (function (lambda (x) (set x -
100))) math-cache-list
)
187 (message "All internal calculator caches have been reset")))
192 (defun calc-clean (n)
195 (calc-with-default-simplification
196 (let ((func (if (calc-is-hyperbolic) 'calcFunc-clean
'calcFunc-pclean
)))
197 (calc-enter-result 1 "cln"
199 (let ((n (prefix-numeric-value n
)))
203 (+ n calc-internal-prec
)
205 (list func
(calc-top-n 1))))))))
207 (defun calc-clean-num (num)
209 (calc-clean (- (if num
210 (prefix-numeric-value num
)
211 (if (and (>= last-command-char ?
0)
212 (<= last-command-char ?
9))
213 (- last-command-char ?
0)
214 (error "Number required"))))))
217 (defvar math-chopping-small nil
)
218 (defun calcFunc-clean (a &optional prec
) ; [X X S] [Public]
220 (cond ((Math-messy-integerp prec
)
221 (calcFunc-clean a
(math-trunc prec
)))
222 ((or (not (integerp prec
))
224 (calc-record-why "*Precision must be an integer 3 or above")
225 (list 'calcFunc-clean a prec
))
226 ((not (Math-objvecp a
))
227 (list 'calcFunc-clean a prec
))
228 (t (let ((calc-internal-prec prec
)
229 (math-chopping-small t
))
230 (calcFunc-clean (math-normalize a
)))))
231 (cond ((eq (car-safe a
) 'polar
)
232 (let ((theta (math-mod (nth 2 a
)
233 (if (eq calc-angle-mode
'rad
)
240 (calcFunc-clean (nth 1 a
))
241 (calcFunc-clean theta
)))))))
242 ((memq (car-safe a
) '(vec date hms
))
243 (cons (car a
) (mapcar 'calcFunc-clean
(cdr a
))))
244 ((memq (car-safe a
) '(cplx mod sdev intv
))
245 (math-normalize (cons (car a
) (mapcar 'calcFunc-clean
(cdr a
)))))
246 ((eq (car-safe a
) 'float
)
247 (if math-chopping-small
248 (if (or (> (nth 2 a
) (- calc-internal-prec
))
249 (Math-lessp (- calc-internal-prec
) (calcFunc-xpon a
)))
250 (if (and (math-num-integerp a
)
251 (math-lessp (calcFunc-xpon a
) calc-internal-prec
))
257 ((math-infinitep a
) a
)
258 (t (list 'calcFunc-clean a
)))))
260 (defun calcFunc-pclean (a &optional prec
)
261 (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec
)))
264 (defun calcFunc-pfloat (a)
265 (math-map-over-constants 'math-float a
))
267 (defun calcFunc-pfrac (a &optional tol
)
268 (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol
)))
271 (defun math-map-over-constants (func expr
)
272 (math-map-over-constants-rec expr
))
274 (defun math-map-over-constants-rec (expr)
275 (cond ((or (Math-primp expr
)
276 (memq (car expr
) '(intv sdev
)))
277 (or (and (Math-objectp expr
)
280 ((and (memq (car expr
) '(^ calcFunc-subscr
))
281 (eq func
'math-float
)
283 (Math-integerp (nth 2 expr
)))
285 (math-map-over-constants-rec (nth 1 expr
))
287 (t (cons (car expr
) (mapcar 'math-map-over-constants-rec
(cdr expr
))))))
289 ;;; calc-stuff.el ends here